tests/regtest-interface-extended.R

In multcomp: Simultaneous Inference in General Parametric Models

### test the extended interpreter for the left hand side of linear hypotheses
### Features: 
### - fully recursive expression parser built upon a small code fragment copied over from base::codetools
### - the parser stops if any of the following conditions is not met:
###   - any variable  must be addressed only once
###   - all operators and functions must finally evaluate to a a real valued literal
###   - function parameters must not denote an effect name
###   - effects can not be multiplied or divided by another effect
###   - additive or subtractive terms involving an effect and a numeric 
###     constants must not be specified 
###   - coefficients associated with named effects must not evaluate to zero 
###
### Examples:
###   x1 + x1             == 0  -> not accepted
###   x1 + x2 -1          == 0  -> not accepted
###   x1 * x2             == 0  -> not accepted
###   x1 / x2             == 0  -> not accepted
###   f(x1)               == 0  -> not accepted if x1 denotes an effect
###   2*3                 == 6  -> not accepted because no effect was named
###   x1 + x2*0           == 0  -> not accepted because this is likely an oversight
###   x1 + 3*(4-5+1)*x2   == 0  -> not accepted because this is likely an oversight
###   x1*3/0              == 0  -> not accepted because coefficient would become infinite
###   log(-1)*x1          == 0  -> not accepted, because the result is not finite
###   x1 + x2 +0          == 0  -> accepted because adding zero does not make a difference
###   sin(pi/2) * x1      == 0  -> accepted if 'pi' is not an effect
###   sin(Pi/2) * x1      == 0  -> accepted if 'Pi' is not an effect. However, if the environment does not define Pi the evaluation may still fail.


tmp <- multcomp:::chrlinfct2matrix( c( l01 = " x1 - x2 = 2"
                                     , l02 = " x2 + 3 * x3 = 1"
                                     , l03 = " (x1 - x2) - (x3 - x4) =  0"
                                     , l04 = "+(x1 - x2)*-2 - (1/3+2)*( +x3 - 2*x4 ) = -1" 
                                     , l05 = "-(x1 - x2)*-2 - (1/3+2)*( -x3 - 2*x4 ) = -2" 
                                     , l06 = "-(x1 - x2)*-2  - (1/3+2)*( -x3 - 2*x4 )*7/-10 = -3" 
                                     , l07 = "-1*(x1:x2 - x1:x2:x3) - x3 = -4"
                                     , l08 = "-(x1:x2 - x1:x2:x3) - x3 = -4"
                                     , l09 = "-(x1:x2 - 3*x1:x2:x3)*-2 - x3 -5/3*-x4= -5"
                                     , l10 = "--cos(pi/2)*x1 - 10*(log(10^-3)+1)*-x2 -10^-3*x3 + -exp(-2)*x4= -6"
                                     , l11 = " x1 + x2 + 0 = -7"
                                     ),  c('x1','x2','x3','x4','x1:x2','x1:x2:x3') )

stopifnot(max(abs( dK <- tmp$K - 
                         rbind( c(           1,                 -1,                0,                 0,       0,     0 )
                              , c(           0,                  1,                3,                 0,       0,     0 )
                              , c(           1,                 -1,               -1,                 1,       0,     0 )
                              , c(          -2,                  2,         -(1/3+2),         2*(1/3+2),       0,     0 )
                              , c(           2,                 -2,          (1/3+2),         2*(1/3+2),       0,     0 )
                              , c(           2,                 -2,    (1/3+2)*-7/10,   2*(1/3+2)*-7/10,       0,     0 )
                              , c(           0,                  0,               -1,                 0,      -1,     1 )
                              , c(           0,                  0,               -1,                 0,      -1,     1 )
                              , c(           0,                  0,               -1,           -5/3*-1,       2,    -6 )
                              , c( --cos(pi/2),  10*(log(10^-3)+1),           -10^-3,           -exp(-2),      0,     0 )
                              , c(           1,                  1,                0,                 0,       0,     0 )
                              ))) < sqrt(.Machine$double.eps))

stopifnot(max(abs( tmp$m - 
                   c(  2
                    ,  1
                    ,  0
                    , -1
                    , -2
                    , -3
                    , -4
                    , -4
                    , -5
                    , -6
                    , -7
                    ))) < sqrt(.Machine$double.eps))

expectFail <- function(testname, x) {
 if ( class(x) != 'try-error' ) {
      stop(testname, ' unexpectedly succeeded. Result is: ', paste(x, collapse = ', '),'\n')
 }
 message(testname, ' expectedly failed. Message is: ', attr(x,'condition')$message, '\n')
}

expectSucc <- function(testname, x,expected) {
 if ( class(x) == 'try-error' ) {
      stop(testname, ' unexpectedly failed. Message is: ', attr(x,'condition')$message, '\n')
 }
      message(testname, ' expectedly succeeded.',
                        ' Expected result is: ', paste(x, collapse = ', '), ', ',
                        ' actual result is: ',   paste(x, collapse = ', '), '\n')

      stopifnot(all.equal(as.vector(x$K),expected$K))
      stopifnot(all.equal(as.vector(x$m),expected$m))
      stopifnot(all(as.vector(x$alternative) %in% expected$alternative))
}

expectFail('test 01',  try( multcomp:::chrlinfct2matrix( c('x1 - x1  = 0'), c('x1','x2')), silent = T))

expectFail('test 02',  try( multcomp:::chrlinfct2matrix( c('x1 - X2  = 0'), c('x1','x2')), silent = T))

expectFail('test 03',  try( multcomp:::chrlinfct2matrix( c('x1 - x2 -1 = 0'), c('x1','x2')), silent = T))

expectFail('test 04',  try( multcomp:::chrlinfct2matrix( c('x1 * x2  = 0'), c('x1','x2')), silent = T))

expectFail('test 05',  try( multcomp:::chrlinfct2matrix( c('x1 / x2  = 0'), c('x1','x2')), silent = T))

expectFail('test 06',  try( multcomp:::chrlinfct2matrix( c('x1 - exp(x2)  = 0'), c('x1','x2')), silent = T))

expectFail('test 07',  try( multcomp:::chrlinfct2matrix( c('sin(Pi)*x1   = 0'), c('x1','x2')), silent = T))

expectFail('test 08',  try( multcomp:::chrlinfct2matrix( c('3*4 = 0'), c('x1','x2')), silent = T))

expectFail('test 09',  try( multcomp:::chrlinfct2matrix( c('x1 + 3*(4-5+1)*x2 = 0'), c('x1','x2')), silent = T))

expectFail('test 10',  try( multcomp:::chrlinfct2matrix( c('x1*3/0 = 0'), c('x1','x2')), silent = T))

expectFail('test 11',  try( multcomp:::chrlinfct2matrix( c('log(-1)*x1 = 0'), c('x1','x2')), silent = T))

expectSucc('test 12',  try( multcomp:::chrlinfct2matrix( c('x1 -x2 -1/2*(-x2:x3 + x4:x5) = 0'), 
                                                         c( 'x1', 'x2', 'x3', 'x4', 'x5', 'x2:x3','x4:x5')), silent = T),
                                    expected = list( K = c(    1,   -1,    0,    0,    0,     1/2,  -1/2),
                                                     m = 0, alternative = 'two.sided'))

expectSucc('test 13',  try( multcomp:::chrlinfct2matrix( c( 'x1 -x2 -1/2*(--x2:x3 + x4:x5) = 0'), 
                                                         c( 'x1', 'x2', 'x3', 'x4', 'x5', 'x2:x3','x4:x5')), silent = T),
                                    expected = list( K = c(    1,   -1,    0,    0,    0,     -1/2,  -1/2),
                                                     m = 0, alternative = 'two.sided'))

expectSucc('test 14',  try( multcomp:::chrlinfct2matrix( c( 'x1 -x2 -1/2*(`-x2:x3` + x4:x5) = 0'), 
                                                         c( 'x1', 'x2', 'x3', 'x4', 'x5', '-x2:x3','x4:x5')), silent = T),
                                    expected = list( K = c(    1,   -1,    0,    0,    0,     -1/2,  -1/2),
                                                     m = 0, alternative = 'two.sided'))                                                   

expectSucc('test 15',  try( multcomp:::chrlinfct2matrix( c( 'x1 -x2 -1/2*(-(x2:x3) + x4:x5) = 0'), 
                                                         c( 'x1', 'x2', 'x3', 'x4', 'x5', 'x2:x3','x4:x5')), silent = T),
                                    expected = list( K = c(    1,   -1,    0,    0,    0,      1/2,  -1/2),
                                                     m = 0, alternative = 'two.sided'))                                                   

expectSucc('test 16',  try( multcomp:::chrlinfct2matrix( c( 'x1 -x2 -1/2*(-1*x2:x3 + x4:x5) = 0'), 
                                                         c( 'x1', 'x2', 'x3', 'x4', 'x5', 'x2:x3','x4:x5')), silent = T),
                                    expected = list( K = c(    1,   -1,    0,    0,    0,      1/2,  -1/2),
                                                     m = 0, alternative = 'two.sided'))                                                   



expectSucc('test 17',  try( multcomp:::chrlinfct2matrix( c( 'x1 -x2 -1/2*(+-+--x2:x3:x4 + x4:x5) = 0'), 
                                                         c( 'x1', 'x2', 'x3', 'x4', 'x5', 'x2:x3:x4','x4:x5')), silent = T),
                                    expected = list( K = c(    1,   -1,    0,    0,    0,      1/2,  -1/2),
                                                     m = 0, alternative = 'two.sided'))                                                   

expectFail('test 18',  try( multcomp:::chrlinfct2matrix( c( 'x1 - x2 - 1/2 * ( x2:-x3 + x4:x5 ) = 0'), 
                                                         c( 'x1','x2','x2:x3','x4:x5')), silent = T))