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
|
gendata <- function(fit, ...) UseMethod("gendata")
gendata.default <- function(fit, ...) gendata.Design(obj, ...)
gendata.Design <- function(fit, nobs, viewvals=FALSE,
editor=.Options$editor, ..., factors) {
at <- fit$Design
if(!length(at)) at <- getOldDesign(fit)
nam <- at$name[at$assume!="interaction"]
if(!length(editor) && exists('using.X') && using.X()) editor <- "xedit"
if(!missing(nobs) && !is.logical(nobs)) {
df <- predictDesign(fit, type="adjto.data.frame")
df[1:nobs,] <- df
cat("Edit the list of variables you would like to vary.\nVariables not listed will be set to reference values.\n")
if(editor=="xedit") cat("To delete an individual variable, type Cntl-k\nTo delete blocks of variables, highlight the block by holding down the left\nmouse button, then type Cntl-w.\n")
nam.sub <- if(.R.)edit(nam, editor=editor) else ed(nam, editor=editor)
if(!all(nam.sub %in% nam)) stop("misspelled a variable name")
df.sub <- as.data.frame(df[,nam.sub]) #df[,] was returning list (?)
cat("Edit the predictor settings to use.\n")
if(viewvals &&
length(val <- Getlim(at, allow.null=TRUE, need.all=FALSE)$values[nam.sub])) {
cat("A window is being opened to list the valid values of discrete variables.\n")
sink(tf <- tempfile())
print.datadist(list(values=val))
sink()
if(.R.)file.show(tf) else page(filename=tf)
}
if(existsFunction('Edit.data')) {
stop('use of S-PLUS 4.x GUI not yet implemented for gendata')
assign('.df.sub.', df.sub, where=1)
Edit.data(.df.sub., '.df.sub.')
df.sub <- get('.df.sub.', where=1)
remove('.df.sub.', where=1)
}
else if(existsFunction('data.ed')) {
# if(!(exists('using.X') && using.X()))
# stop("must be using X-windows to use interactive data.ed")
df.sub <- data.ed(df.sub)
}
else if(existsFunction('data.entry')) df.sub <- data.entry(df.sub)
df[nam.sub] <- df.sub
return(structure(df, names.subset=nam.sub))
}
factors <- if(missing(factors)) list(...) else factors
fnam <- names(factors)
nf <- length(factors)
if(nf==0) return(predictDesign(fit, type="adjto.data.frame"))
which <- charmatch(fnam, nam, 0)
if(any(which==0)) stop(paste("factor(s) not in design:",
paste(names(factors)[which==0],collapse=" ")))
settings <- if(nf<length(nam)) predictDesign(fit, type="adjto.data.frame") else
list()
settings <- oldUnclass(settings)
if(nf>0) for(i in 1:nf) settings[[fnam[i]]] <- factors[[i]]
if(nf==0) return(as.data.frame(settings))
expand.grid(settings)
}
|
