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
|
which.influence <- function(fit, cutoff=.2) {
cox <- inherits(fit,"cph") || (length(fit$fitFunction) &&
any(fit$fitFunction=='cph'))
##14Nov00 22May01
stats <- resid(fit, "dfbetas")
stats <- stats[!is.na(stats[,1]), ] ##delete rows added back due to NAs
rnam <- dimnames(stats)[[1]]
if(!length(rnam)) rnam <- 1:nrow(stats)
at <- fit$Design
if(!length(at)) at <- getOldDesign(fit)
w <- list()
namw <- NULL
k <- 0
# .Options$warn <- -1 14Sep00
oldopt <- options(warn=-1)
on.exit(options(oldopt))
if(!cox) {
ww <- rnam[abs(stats[,1])>=cutoff]
if(length(ww)) {
k <- k+1
w[[k]] <- ww
namw <- "Intercept"
}
}
Assign <- fit$assign
nm <- names(Assign)[1]
if(nm=="Intercept" | nm=="(Intercept)") Assign[[1]] <- NULL
##remove and re-number
j <- 0
for(i in (1:length(at$name))[at$assume.code!=8]) {
j <- j+1
as <- Assign[[j]]
if(length(as)==1) ww <- rnam[abs(stats[,as])>=cutoff]
else {
z <- rep(FALSE,length(rnam))
for(r in as)
z <- z | abs(stats[,r])>=cutoff
ww <- rnam[z]
}
if(length(ww)) {
k <- k+1
w[[k]] <- ww
namw <- c(namw, at$name[i])
}
TRUE
}
if(length(w))names(w) <- namw
w }
##show.influence was written by:
##Jens Oehlschlaegel-Akiyoshi
##oehl@psyres-stuttgart.de
##Center for Psychotherapy Research
##Christian-Belser-Strasse 79a
##D-70597 Stuttgart Germany
show.influence <- function(object, dframe, report=NULL, sig=NULL, id=NULL) {
who <- unlist(object)
nam <- names(object) # was names(w) 24Nov00
## In future parse out interaction components in case main effects
## not already selected 24Nov00
ia <- grep('\\*',nam) # remove interactions 28may02
if(length(ia)) nam <- nam[-ia]
nam <- nam[nam %nin% 'Intercept'] # remove Intercept
rnam <- dimnames(dframe)[[1]]
if(!length(rnam)) rnam <- 1:nrow(dframe)
if (length(report)) col <- c(nam,
dimnames(dframe[,report,drop=FALSE])[[2]] )
else col <- nam
row <- rnam %in% who
if(any(col %nin% names(dframe)))
stop(paste('needed variables not in dframe:',
paste(col[col %nin% names(dframe)],collapse=' ')))
dframe <- dframe[row,col,drop=FALSE]
rnam <- rnam[row]
Count <- table(who)
Count <- as.vector(Count[match(rnam,names(Count))])
for (i in 1:length(nam)){
ni <- nam[i] # 24Nov00
val <- dframe[,ni] #i]
if (length(sig) && is.numeric(val)) val <- signif(val, sig) else
val <- format(val)
dframe[,ni] <- paste(ifelse(rnam %in% object[[ni]],"*",""), val, sep = "")
## In future change i to also find any object containing the
## variable (e.g., interaction) was object[[i]] dframe[,i] 24Nov00
}
if (length(sig) && length(report))
for (i in (length(nam)+1):dim(dframe)[2])
if(is.numeric(dframe[,i]))
dframe[,i] <- signif(dframe[,i],sig)
dframe <- data.frame(Count,dframe)
if(length(id)) row.names(dframe) <- id[as.numeric(row.names(dframe))]
## 24Nov00
print(dframe, quote=FALSE)
invisible(dframe)
}
|
