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
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
|
context("Graphics functions")
testthat::test_that("color", {
cur <- palette()
old <- lava:::mypal()
testthat::expect_equivalent(col2rgb(cur),col2rgb(old))
testthat::expect_equivalent(col2rgb(palette()),col2rgb(lava:::mypal(set=FALSE)))
testthat::expect_equivalent(Col("red",0.5),rgb(1,0,0,0.5))
testthat::expect_equivalent(Col(c("red","blue"),0.5),rgb(c(1,0),c(0,0),c(0,1),0.5))
testthat::expect_equivalent(Col(c("red","blue"),c(0.2,0.5)),rgb(c(1,0),c(0,0),c(0,1),c(0.2,0.5)))
testthat::expect_equivalent(Col(rgb(1,0,0),0.5),rgb(1,0,0,0.5))
plot(0,xlim=c(0,1),ylim=c(0,1),type="n",ann=FALSE,axes=FALSE)
devc1 <- devcoords()
par(mar=c(0,0,0,0))
plot(0,xlim=c(0,1),ylim=c(0,1),type="n",ann=FALSE,axes=FALSE)
devc2 <- devcoords()
figx <- c("fig.x1","fig.x2","fig.y1","fig.y2")
devx <- c("dev.x1","dev.x2","dev.y1","dev.y2")
testthat::expect_equivalent(devc1[figx],devc2[devx])
})
if (requireNamespace("visualTest",quietly=TRUE)) {
gropen <- function(resolution=200,...) {
tmpfile <- tempfile(fileext=".png")
png(file=tmpfile,width=200,height=200)
res <- dev.cur()
return(structure(tmpfile,dev=res))
}
grcompare <- function(file1,file2,...) {
res <- visualTest::isSimilar(file1,file2,...)
unlink(c(file1,file2))
return(res)
}
testthat::test_that("plotConf", {
set.seed(1)
x <- rnorm(50)
y <- rnorm(50,x)
z <- rbinom(50,1,0.5)
d <- data.frame(y,z,x)
l <- lm(y~x*z)
d1 <- gropen()
par(mar=c(0,0,0,0))
plotConf(l,var1="x",var2="z",col=c("black","blue"),alpha=0.5,legend=FALSE)
dev.off()
newd <- data.frame(x=seq(min(x),max(x),length.out=100))
l0 <- lm(y~x,subset(d,z==0))
ci0 <- predict(l0,newdata=newd,interval="confidence")
l1 <- lm(y~x,subset(d,z==1))
ci1 <- predict(l1,newdata=newd,interval="confidence")
d2 <- gropen()
par(mar=c(0,0,0,0))
plot(y~x,col=c("black","blue")[z+1],pch=16,ylim=c(min(ci0,ci1,y),max(ci0,ci1,y)))
lines(newd$x,ci0[,1],col="black",lwd=2)
lines(newd$x,ci1[,1],col="blue",lwd=2)
confband(newd$x,lower=ci0[,2],upper=ci0[,3],polygon=TRUE,col=Col("black",0.5),border=FALSE)
confband(newd$x,lower=ci1[,2],upper=ci1[,3],polygon=TRUE,col=Col("blue",0.5),border=FALSE)
points(y~x,col=c("black","blue")[z+1],pch=16)
dev.off()
testthat::expect_true(grcompare(d1,d2,threshold=5))
d1 <- gropen()
par(mar=c(0,0,0,0))
l <- lm(y~z)
plotConf(l,var2="z",var1=NULL,jitter=0,col="black",alpha=0.5,xlim=c(.5,2.5),ylim=range(y))
dev.off()
d2 <- gropen()
par(mar=c(0,0,0,0))
plot(y~I(z+1),ylim=range(y),xlim=c(0.5,2.5),pch=16,col=Col("black",0.5))
l0 <- lm(y~-1+factor(z))
confband(1:2,lower=confint(l0)[,1],upper=confint(l0)[,2],lwd=3,
center=coef(l0))
dev.off()
testthat::expect_true(grcompare(d1,d2,threshold=10))
})
testthat::test_that("forestplot", {
set.seed(1)
K <- 20
est <- rnorm(K); est[c(3:4,10:12)] <- NA
se <- runif(K,0.2,0.4)
x <- cbind(est,est-2*se,est+2*se,runif(K,0.5,2))
rownames(x) <- unlist(lapply(letters[seq(K)],function(x) paste(rep(x,4),collapse="")))
rownames(x)[which(is.na(est))] <- ""
signif <- sign(x[,2])==sign(x[,3])
forestplot(x)
## TODO
})
test_that("plot.sim", {
onerun2 <- function(a,b,...) {
return(cbind(a=a,b=b,c=a-1,d=a+1))
}
R <- data.frame(a=1:2,b=3:4)
val2 <- sim(onerun2,R=R,type=0)
plot(val2)
plot(val2,plot.type="single")
density(val2)
## TODO
})
test_that("spaghetti", {
K <- 5
y <- "y"%++%seq(K)
m <- lvm()
regression(m,y=y,x=~u) <- 1
regression(m,y=y,x=~s) <- seq(K)-1
regression(m,y=y,x=~x) <- "b"
d <- sim(m,5)
dd <- mets::fast.reshape(d);
dd$num <- dd$num+rnorm(nrow(dd),sd=0.5) ## Unbalance
spaghetti(y~num,dd,id="id",lty=1,col=Col(1,.4),trend=TRUE,trend.col="darkblue")
## TODO
})
test_that("ksmooth", {
## TODO
})
test_that("plot.lvm", {
## TODO
m <- lvm(y~1*u[0:1],u~1*x)
latent(m) <- ~u
plot(m)
d <- sim(m,20,seed=1)
e <- estimate(m,d)
plot(e)
plot(lava:::beautify(m))
g <- igraph.lvm(m)
testthat::expect_true(inherits(g,"igraph"))
})
test_that("images", {
## TODO
})
test_that("labels,edgelabels", {
## TODO
})
test_that("colorbar", {
## TODO
})
test_that("fplot", {
## TODO
})
test_that("interactive", {
## TODO
})
test_that("pdfconvert", {
## TODO
})
test_that("plot.estimate", {
## TODO
})
test_that("logo", {
lava(seed=1)
})
}
|
