R Under development (unstable) (2023-12-02 r85657 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2023 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> # test.sign.R
> 
> # Test the use of sign.location and sign.nominal in clm.control():
> 
> library(ordinal)
> 
> fm1 <- clm(rating ~ temp + contact, data=wine)
> fm2 <- clm(rating ~ temp + contact, data=wine,
+            sign.location="positive")
> # dput(names(fm1))
> keep <- c("aliased", "alpha", "cond.H", 
+           "contrasts", "convergence", "df.residual", "edf", 
+           "fitted.values", "formula", "formulas", "gradient", 
+           "info", "link", "logLik", "maxGradient", "message", "model", 
+           "n", "niter", "nobs", "start", "terms", "Theta", "threshold", 
+           "tJac", "xlevels", "y", "y.levels")
> check <- mapply(function(x, y) isTRUE(all.equal(x, y)), fm1[keep], fm2[keep])
> stopifnot(all(check))
> stopifnot(isTRUE(all.equal(
+   fm1$beta, - fm2$beta
+ )))
> 
> fm1 <- clm(rating ~ temp, nominal=~ contact, data=wine)
> fm2 <- clm(rating ~ temp, nominal=~ contact, data=wine,
+            sign.nominal="negative")
> keep <- c("aliased", "beta", "cond.H", 
+           "contrasts", "convergence", "df.residual", "edf", 
+           "fitted.values", "formula", "formulas", "gradient", 
+           "info", "link", "logLik", "maxGradient", "message", "model", 
+           "n", "niter", "nobs", "start", "terms", "Theta", "threshold", 
+           "tJac", "xlevels", "y", "y.levels")
> # check <- mapply(function(x, y) isTRUE(all.equal(x, y)), fm1, fm2)
> check <- mapply(function(x, y) isTRUE(all.equal(x, y)), fm1[keep], fm2[keep])
> stopifnot(all(check))
> stopifnot(isTRUE(all.equal(
+   fm1$alpha[5:8], -fm2$alpha[5:8]
+ )))
> 
> 
> fm1 <- clm(rating ~ temp, nominal=~ contact, data=wine)
> fm2 <- clm(rating ~ temp, nominal=~ contact, data=wine,
+            sign.nominal="negative", sign.location="positive")
> keep <- c("aliased", "cond.H", 
+           "contrasts", "convergence", "df.residual", "edf", 
+           "fitted.values", "formula", "formulas", "gradient", 
+           "info", "link", "logLik", "maxGradient", "message", "model", 
+           "n", "niter", "nobs", "start", "terms", "Theta", "threshold", 
+           "tJac", "xlevels", "y", "y.levels")
> # check <- mapply(function(x, y) isTRUE(all.equal(x, y)), fm1, fm2)
> check <- mapply(function(x, y) isTRUE(all.equal(x, y)), fm1[keep], fm2[keep])
> stopifnot(all(check))
> stopifnot(
+   isTRUE(all.equal(fm1$alpha[5:8], -fm2$alpha[5:8])),
+   isTRUE(all.equal(fm1$beta, -fm2$beta))
+ )
> 
> # Check predict method:
> newData <- with(wine, expand.grid(temp=levels(temp), contact=levels(contact)))
> (p1 <- predict(fm1, newdata=newData))
$fit
            1          2         3         4           5
1 0.210312404 0.56637121 0.1953950 0.0185460 0.009375394
2 0.020998377 0.19781391 0.5182972 0.1577343 0.105156202
3 0.050301839 0.38380275 0.4329644 0.1065821 0.026348960
4 0.004247588 0.05393811 0.2862121 0.4040930 0.251509196

> (p2 <- predict(fm2, newdata=newData))
$fit
            1          2         3         4           5
1 0.210312404 0.56637121 0.1953950 0.0185460 0.009375394
2 0.020998377 0.19781391 0.5182972 0.1577343 0.105156202
3 0.050301839 0.38380275 0.4329644 0.1065821 0.026348960
4 0.004247588 0.05393811 0.2862121 0.4040930 0.251509196

> stopifnot(isTRUE(all.equal(p1, p2)))
> 
> stopifnot(isTRUE(
+   all.equal(predict(fm1, newdata=wine, se=TRUE, interval=TRUE),
+             predict(fm2, newdata=wine, se=TRUE, interval=TRUE))
+ ))
> 
> # Check profile and confint methods:
> confint.default(fm1)
                     2.5 %     97.5 %
1|2.(Intercept) -2.4250844 -0.2210024
2|3.(Intercept)  0.3158056  2.1770814
3|4.(Intercept)  2.2642614  4.8358258
4|5.(Intercept)  2.9738888  6.3466053
1|2.contactyes  -3.8921464  0.6620280
2|3.contactyes  -2.6692032 -0.3539315
3|4.contactyes  -2.9464535 -0.4030579
4|5.contactyes  -2.8077520  0.7065061
tempwarm         1.4703720  3.5677176
> confint.default(fm2)
                     2.5 %     97.5 %
1|2.(Intercept) -2.4250844 -0.2210024
2|3.(Intercept)  0.3158056  2.1770814
3|4.(Intercept)  2.2642614  4.8358258
4|5.(Intercept)  2.9738888  6.3466053
1|2.contactyes  -0.6620280  3.8921464
2|3.contactyes   0.3539315  2.6692032
3|4.contactyes   0.4030579  2.9464535
4|5.contactyes  -0.7065061  2.8077520
tempwarm        -3.5677176 -1.4703720
> 
> stopifnot(
+   isTRUE(all.equal(confint(fm1), -confint(fm2)[, 2:1, drop=FALSE], 
+                    check.attributes=FALSE))
+ )
> 
> fm1 <- clm(rating ~ temp + contact, data=wine)
> fm2 <- clm(rating ~ temp + contact, data=wine,
+            sign.location="positive")
> pr1 <- profile(fm1)
> pr2 <- profile(fm2)
> stopifnot(
+   isTRUE(all.equal(confint(fm1), - confint(fm2)[, 2:1], check.attributes=FALSE))
+ )
> 
> 
> proc.time()
   user  system elapsed 
   1.75    0.23    1.95