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
|
vis.boxcoxu.old <-
function(lambda = sample( c(-1, -0.5, 0, 1/3, 1/2, 1, 2), 1)) {
if( !requireNamespace('tkrplot', quietly = TRUE) ) stop('This function depends on the tkrplot package being available')
y <- rnorm(1000, 7, 2)
if( min(y) <= 0 ) y <- y - min(y)+0.05
if (lambda==0) {
y <- exp(y)
} else {
y <- y^(1/lambda)
}
if(!exists('slider.env')) slider.env <<-new.env()
#library(tcltk)
lam <- 1 ; assign('lam',tcltk::tclVar(lam), envir=slider.env)
bc.refresh <- function(...){
lam <- as.numeric(evalq(tcltk::tclvalue(lam), envir=slider.env))
old.par <- par(mfcol=c(2,2))
on.exit(par(old.par))
ty <- bct(y,lam)
hist(y, prob=T, xlab='x', main='Histogram of x')
xx <- seq(min(y),max(y), length=250)
lines(xx, dnorm( xx, mean(y), sqrt(var(y)) ))
qqnorm(y, xlab='x')
qqline(y)
hist(ty, prob=T, xlab='Transformed x', main = 'Histogram of Transformed x')
xx <- seq(min(ty),max(ty), length=250)
lines(xx,dnorm(xx, mean(ty), sqrt(var(ty)) ) )
qqnorm(ty, xlab='Transformed x')
qqline(ty)
}
m <- tcltk::tktoplevel()
tcltk::tkwm.title(m, 'Box Cox Transform')
tcltk::tkwm.geometry(m,'+0+0')
tcltk::tkpack(fr <- tcltk::tkframe(m), side='top')
tcltk::tkpack(tcltk::tklabel(fr, text='lambda', width='10'), side='right')
tcltk::tkpack(sc <- tcltk::tkscale(fr, command=bc.refresh, from=-2, to=3, orient='horiz',
resolution=0.1, showvalue=T),
side='left')
assign('sc',sc,envir=slider.env)
evalq(tcltk::tkconfigure(sc, variable=lam), envir=slider.env)
tcltk::tkpack(tcltk::tkbutton(m, text="Refresh", command=bc.refresh), side='left')
tcltk::tkpack(tcltk::tkbutton(m, text="Exit", command=function()tcltk::tkdestroy(m)),
side='right')
}
vis.boxcoxu <- function(lambda = sample( c(-1,-0.5,0,1/3,1/2,1,2), 1),
y, xlab=deparse(substitute(y)),
hscale=1.5, vscale=1.5, wait=FALSE) {
if( missing(y) ) {
if(missing(xlab)) xlab <- 'y'
y <- rnorm(1000, 7, 2)
if( min(y) <= 0 ) y <- y - min(y) + 0.05
if(lambda==0) {
y <- exp(y)
} else {
y <- y^(1/lambda)
}
}
lam <- tcltk::tclVar()
tcltk::tclvalue(lam) <- 1
hsc <- tcltk::tclVar()
tcltk::tclvalue(hsc) <- hscale
vsc <- tcltk::tclVar()
tcltk::tclvalue(vsc) <- hscale
replot <- function(...) {
tmp.l <- as.numeric(tcltk::tclvalue(lam))
par(mfcol=c(2,2))
ty <- bct(y,tmp.l)
hist(y, prob=TRUE, xlab=xlab, main = paste('Histogram of',xlab))
xx <- seq(min(y),max(y), length=250)
lines(xx, dnorm(xx, mean(y), sd(y)) )
qqnorm(y, xlab=xlab)
qqline(y)
hist(ty, prob=TRUE, xlab=paste("Transformed",xlab),
main=paste("Histogram of Transformed",xlab))
xx <- seq(min(ty),max(ty), length=250)
lines(xx,dnorm(xx, mean(ty), sd(ty)))
qqnorm(ty, xlab=paste("Transformed",xlab))
qqline(ty)
}
tt <- tcltk::tktoplevel()
tcltk::tkwm.title(tt, "Box Cox Demo")
img <- tkrplot::tkrplot(tt, replot, vscale=vscale, hscale=hscale)
tcltk::tkpack(img, side='top')
tcltk::tkpack(fr <- tcltk::tkframe(tt), side='top')
tcltk::tkpack(tcltk::tklabel(fr, text='lambda: '), side='left', anchor='s')
tcltk::tkpack(tcltk::tkscale(fr, variable=lam, orient='horizontal',
command=function(...) tkrplot::tkrreplot(img,
hscale=as.numeric(tcltk::tclvalue(hsc)),
vscale=as.numeric(tcltk::tclvalue(vsc)) ),
from=-2, to=4, resolution=.05), side='right')
tcltk::tkpack(tfr <- tcltk::tkframe(tt), side='bottom', fill='x')
tcltk::tkpack(tcltk::tkbutton(tfr, text="Refresh", command=function() tkrplot::tkrreplot(img,
hscale=as.numeric(tcltk::tclvalue(hsc)),
vscale=as.numeric(tcltk::tclvalue(vsc)) ) ),
side='left',anchor='s')
tcltk::tkpack(tcltk::tkbutton(tfr, text="Exit", command=function()tcltk::tkdestroy(tt)),
side='right',anchor='s')
tcltk::tkpack(tfr <- tcltk::tkframe(tt), side='bottom', fill='x')
tcltk::tkpack(tcltk::tklabel(tfr,text="Hscale: "), side='left')
tcltk::tkpack(tcltk::tkentry(tfr,textvariable=hsc,width=6), side='left')
tcltk::tkpack(tcltk::tklabel(tfr,text=" Vscale: "), side='left')
tcltk::tkpack(tcltk::tkentry(tfr,textvariable=vsc,width=6), side='left')
if(wait) {
tcltk::tkwait.window(tt)
return( list(lambda = as.numeric(tcltk::tclvalue(lam)),
y = y,
ty = bct(y,as.numeric(tcltk::tclvalue(lam))) ) )
} else {
return(invisible(NULL))
}
}
|
