1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
|
### 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))
|
