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
|
Predict.Plot <- function(model, pred.var, ...,
type='response', add=FALSE, plot.args=list(),
n.points=100, ref.val,
ref.col='green', ref.lty=1, data ) {
x2 <- list(...)
if(missing(pred.var)) pred.var <- names(x2)[1]
if(is.character(plot.args)) plot.args <- eval(parse(text=plot.args))
getdata <- function(model) {
if ('data' %in% names(model)) return(model$data)
tmpcall <- model$call
tmpcall[[1]] <- as.name('glm')
model <- eval(tmpcall)
model$data
}
if( pred.var %in% names(x2) ) {
if (length(x2[[pred.var]]) > 1) {
tmp.x <- seq( min(x2[[pred.var]]), max(x2[[pred.var]]),
length.out=n.points)
} else {
if( missing(data) ) data <- getdata(model)
ref.val <- x2[[pred.var]]
tmp.x <- seq( min(data[[pred.var]]), max(data[[pred.var]]),
length.out=n.points)
}
} else {
if( missing(data) ) data <- getdata(model)
tmp.x <- seq( min(data[[pred.var]]), max(data[[pred.var]]),
length.out=n.points)
}
x2[[pred.var]] <- tmp.x
x <- as.data.frame(x2)
yhat <- predict(model, x, type=type)
if(add){
plot.args$x <- x[[pred.var]]
plot.args$y <- yhat
do.call(lines, plot.args)
} else {
nms <- names(plot.args)
plot.args$x=x[[pred.var]]
plot.args$y=yhat
if( !( 'ylab' %in% nms ) ) plot.args$ylab='Predicted Value'
if( !( 'xlab' %in% nms ) ) plot.args$xlab=pred.var
if( !( 'type' %in% nms ) ) plot.args$type='l'
do.call(plot, plot.args)
}
if(!missing(ref.val)){
tmp.x <- list(...)
tmp.x[[pred.var]] <- ref.val
yhat <- predict(model, as.data.frame(tmp.x), type=type)
usr <- par('usr')
lines( c(ref.val,ref.val,usr[1]), c(usr[3],yhat,yhat),
col=ref.col, lty=ref.lty)
}
}
TkPredict <- function(model, data, pred.var, ...){
if( missing(data) ){
if( class(model)[1] == 'lm' ){
tmpcall <- model$call
tmpcall[[1]] <- as.name('glm')
model2 <- eval(tmpcall)
} else {
model2 <- model
}
data <- model2$data
}
tr <- delete.response( terms(model) )
x <- get_all_vars(tr, data)
if(missing(pred.var)) pred.var <- names(x)[1]
lst <- list()
lst$pred.var <- list('radiobuttons',values=names(x), init=pred.var)
lst[[2]] <- list()
for ( v in names(x) ) {
tmp.x <- x[[v]]
if( is.factor(tmp.x) ) {
lvls <- levels(tmp.x)
if(length(lvls) < 11 ) {
lst[[2]][[v]] <- list('radiobuttons', values=lvls,
init=lvls[1] )
} else {
lst[[2]][[v]] <- list('Entry', init=lvls[1])
}
} else {
tmp.min <- min(tmp.x)
tmp.max <- max(tmp.x)
tmp.med <- median(tmp.x)
lst[[2]][[v]] <- list('slider',from=tmp.min, to=tmp.max,
init=tmp.med, resolution=signif( (tmp.max-tmp.min)/100, 2 ) )
}
}
lst[[3]] <- list()
lst[[3]]$plot.args <- list( 'entry', init='list()' )
lst[[3]]$type <- list('entry', init='response')
cl <- as.call( substitute( Predict.Plot(model) ) )
eval(substitute(tkexamp( cl, lst, plotloc='left' )))
}
|
