Last updated on 2020-02-19 10:49:14 CET.
| Flavor | Version | Tinstall | Tcheck | Ttotal | Status | Flags |
|---|---|---|---|---|---|---|
| r-devel-linux-x86_64-debian-clang | 1.2 | 20.05 | 148.19 | 168.24 | ERROR | |
| r-devel-linux-x86_64-debian-gcc | 1.2 | 17.20 | 110.59 | 127.79 | ERROR | |
| r-devel-linux-x86_64-fedora-clang | 1.2 | 197.37 | ERROR | |||
| r-devel-linux-x86_64-fedora-gcc | 1.2 | 207.33 | ERROR | |||
| r-devel-windows-ix86+x86_64 | 1.2 | 41.00 | 146.00 | 187.00 | OK | |
| r-devel-windows-ix86+x86_64-gcc8 | 1.2 | 70.00 | 208.00 | 278.00 | OK | |
| r-patched-linux-x86_64 | 1.2 | 16.95 | 135.16 | 152.11 | OK | |
| r-patched-solaris-x86 | 1.2 | 278.00 | OK | |||
| r-release-linux-x86_64 | 1.2 | 17.57 | 135.00 | 152.57 | OK | |
| r-release-windows-ix86+x86_64 | 1.2 | 41.00 | 145.00 | 186.00 | OK | |
| r-release-osx-x86_64 | 1.2 | OK | ||||
| r-oldrel-windows-ix86+x86_64 | 1.2 | 22.00 | 148.00 | 170.00 | OK | |
| r-oldrel-osx-x86_64 | 1.2 | OK |
Version: 1.2
Check: examples
Result: ERROR
Running examples in 'VRPM-Ex.R' failed
The error most likely occurred in:
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: ccchart
> ### Title: Cumulative contribution chart.
> ### Aliases: ccchart ccchart.coxph ccchart.default ccchart.glm ccchart.ksvm
> ### ccchart.multinom
>
> ### ** Examples
>
> #### logistic regression
> mydata <- read.csv("https://stats.idre.ucla.edu/stat/data/binary.csv")
> mydata$rank <- factor(mydata$rank)
> fit <- glm(admit ~ gre + gpa + rank, data = mydata, family = "binomial")
> patient1=data.frame(gre=386,gpa=3.58,rank=3)
> ccchart(fit,obs=patient1,filename="ccchart1")
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
VRPM
--- call from context ---
ccchart.default(x2, obs = obs, filename, zerolevel, risklabel = x2$risklabel,
riskcutoff, type = type, sorted, time, xmin, xmax)
--- call from argument ---
if (!class(fpatient) %in% c("vector", "matrix")) {
fpatient = as.matrix(fpatient)
}
--- R stacktrace ---
where 1: ccchart.default(x2, obs = obs, filename, zerolevel, risklabel = x2$risklabel,
riskcutoff, type = type, sorted, time, xmin, xmax)
where 2: ccchart(x2, obs = obs, filename, zerolevel, risklabel = x2$risklabel,
riskcutoff, type = type, sorted, time, xmin, xmax)
where 3: ccchart.glm(fit, obs = patient1, filename = "ccchart1")
where 4: ccchart(fit, obs = patient1, filename = "ccchart1")
--- value of length: 2 type: logical ---
[1] FALSE TRUE
--- function from context ---
function (x, obs, filename, zerolevel = "zero", risklabel = "Estimated risk",
riskcutoff = 0.1, type = "logistic", sorted = FALSE, time,
xmin, xmax)
{
x$sorted = sorted
x$zerolevel = zerolevel
x <- check_data(x, type = "ccchart")
if (dim(x$x)[2] != length(obs)) {
stop("The dimension of the given data set does not match with the length of obs. Please adapt in order to continue.")
}
x2 = precolplot(x, filename, coloroptions = 1, zerolevel = zerolevel,
risklabel = risklabel, adverse = FALSE, obs = obs, xmin,
xmax)
f = x2$f
fpatient = x2$fpatient
fzero = x2$fzero
d = x2$d
n = x2$n
thisrisk = x2$thisrisk
devheight = dim(f)[2] + 2
devwidth = 10
png(paste0(ifelse(hasArg(filename), filename, "ccchart"),
".png"), width = devwidth, height = devheight, units = "in",
res = 120)
if (!class(fpatient) %in% c("vector", "matrix")) {
fpatient = as.matrix(fpatient)
}
if (x$sorted == TRUE) {
xorder = order(fpatient)
}
else {
xorder = seq(1, length(fpatient), 1)
}
maxdata = apply(fzero, 2, max)
maxscore = max(apply(f, 1, sum))
minscore = min(apply(f, 1, sum))
allrisks <- x$getriskestimate(rowSums(f), x, rowSums(f))[[2]]
maxrisk = max(allrisks)
minrisk = min(allrisks)
maxscore = max(apply(fzero, 1, sum))
minscore = min(apply(fzero, 1, sum))
if (!is.nan(minrisk)) {
if (type == "survival") {
maxscore = max(apply(f, 1, sum))
minscore = min(apply(f, 1, sum))
maxrisk <- x$getriskestimate(rowSums(f), x, maxscore)[[2]][1]
minrisk <- x$getriskestimate(rowSums(f), x, minscore)[[2]][1]
minrisk = 1 - minrisk
maxrisk = 1 - maxrisk
thisrisk = 1 - thisrisk
risklabel = paste0("1-", risklabel)
}
}
if (!is.nan(thisrisk)) {
if (thisrisk < riskcutoff) {
riskcolor = "green"
}
else {
riskcolor = "red"
}
}
else {
riskcolor = "orange"
}
d2 = dim(f)[2] - d
if (d2 > 0) {
if (d2 == 1) {
posint = which(max(f[, seq(d + 1, d + d2, 1)]) -
min(f[, seq(d + 1, d + d2, 1)]) != 0)
}
else {
posint = which(apply(f[, seq(d + 1, d + d2, 1)],
2, max) - apply(f[, seq(d + 1, d + d2, 1)], 2,
min) != 0)
}
names2 = rep("", times = d + d2)
names2[1:d] = x$names
for (i in seq(d + 1, dim(f)[2])) {
names2[i] = paste(x$names[x$interactions[i - d, 1]],
" : ", x$names[x$interactions[i - d, 2]])
}
names2 = names2[c(seq(1, d, by = 1), posint + d)]
fpatient = fpatient[c(seq(1, d, by = 1), posint + d)]
fzero = fzero[c(seq(1, d, by = 1), posint + d)]
if (x$sorted == TRUE) {
xorder = order(fpatient)
}
else {
xorder = seq(1, length(fpatient), 1)
}
}
else {
names2 = x$names
}
thisseq = c(length(fpatient):1)
par(mar = c(5 + 2, 8 + 8, 4, 2))
cumsumfpatient = cumsum(fpatient[xorder])
plotgrey = numeric(length = length(fpatient))
plotblack = numeric(length = length(fpatient))
plotgrey2 = numeric(length = length(fpatient))
plotblack2 = numeric(length = length(fpatient))
plotwhite = numeric(length = length(fpatient))
i = 1
if (fpatient[xorder[i]] > 0) {
plotgrey[i] = cumsumfpatient[i]
}
if (fpatient[xorder[i]] < 0) {
plotblack[i] = cumsumfpatient[i]
}
for (i in seq(2, length(fpatient), 1)) {
if (cumsumfpatient[i] == 0) {
if (fpatient[xorder[i]] > 0) {
plotgrey[i] = cumsumfpatient[i - 1]
}
if (fpatient[xorder[i]] < 0) {
plotblack[i] = cumsumfpatient[i - 1]
}
}
if (cumsumfpatient[i] > 0) {
if (fpatient[xorder[i]] > 0) {
plotgrey[i] = cumsumfpatient[i]
plotwhite[i] = cumsumfpatient[i - 1]
}
if (fpatient[xorder[i]] < 0) {
plotblack[i] = cumsumfpatient[i - 1]
plotwhite[i] = cumsumfpatient[i]
}
}
if (cumsumfpatient[i] < 0) {
if (fpatient[xorder[i]] > 0) {
plotgrey[i] = cumsumfpatient[i - 1]
plotwhite[i] = cumsumfpatient[i]
}
if (fpatient[xorder[i]] < 0) {
plotblack[i] = cumsumfpatient[i]
plotwhite[i] = cumsumfpatient[i - 1]
}
}
}
diffsign = c("FALSE", abs(diff(sign(cumsumfpatient))) ==
2)
diffinds = which(diffsign == "TRUE")
for (i in seq(along = diffinds)) {
if (cumsumfpatient[diffinds[i]] > 0 & fpatient[xorder[diffinds[i]]] >
0) {
plotgrey2[diffinds[i]] = cumsumfpatient[diffinds[i] -
1]
plotwhite[diffinds[i]] = 0
}
if (cumsumfpatient[diffinds[i]] < 0 & fpatient[xorder[diffinds[i]]] <
0) {
plotblack2[diffinds[i]] = cumsumfpatient[diffinds[i] -
1]
plotwhite[diffinds[i]] = 0
}
}
plotgrey = plotgrey[thisseq]
plotblack = plotblack[thisseq]
plotwhite = plotwhite[thisseq]
plotgrey2 = plotgrey2[thisseq]
plotblack2 = plotblack2[thisseq]
yaxiscolor = rep("black", length(thisseq))
yaxiscolor[which(cumsumfpatient < min(-0.5, minscore))] = "grey"
if (!is.nan(thisrisk)) {
temp = barplot(c(min(0, cumsumfpatient), 0, min(0, cumsumfpatient),
min(0, cumsumfpatient), plotgrey), horiz = TRUE,
xlim = c(min(0, cumsumfpatient), max(0, maxscore) +
0.5), width = rep(10, length(fpatient) + 4),
axes = FALSE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
barplot(c(maxscore, min(0, cumsumfpatient), maxscore,
min(0, cumsumfpatient), plotgrey2), horiz = TRUE,
xlim = c(min(0, cumsumfpatient), max(0, maxscore) +
0.5), width = rep(10, length(fpatient) + 1),
axes = FALSE, col = c("grey", riskcolor, "grey",
riskcolor, rep("grey", length(fpatient))), add = TRUE,
space = 0, border = NA, names.arg = c(rep("", length(fpatient) +
4)))
if (maxscore >= 0) {
barplot(c(maxscore, thisrisk/maxrisk * maxscore,
maxscore, sum(fpatient), plotblack), horiz = TRUE,
xlim = c(min(0, cumsumfpatient), max(0, maxscore) +
0.5), width = rep(10, length(fpatient) + 1),
axes = FALSE, col = c("grey", riskcolor, "grey",
riskcolor, rep("black", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
barplot(c(maxscore, thisrisk/maxrisk * maxscore,
maxscore, sum(fpatient), plotblack2), horiz = TRUE,
xlim = c(min(0, cumsumfpatient), max(0, maxscore) +
0.5), width = rep(10, length(fpatient) + 1),
axes = FALSE, col = c("grey", riskcolor, "grey",
riskcolor, rep("black", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
barplot(c(0, 0, 0, 0, plotwhite), horiz = TRUE, xlim = c(min(0,
cumsumfpatient), max(0, maxscore) + 0.5), width = rep(10,
length(fpatient) + 1), axes = FALSE, col = c("grey",
riskcolor, "grey", riskcolor, rep("white", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
}
if (maxscore < 0) {
barplot(c(min(0, cumsumfpatient), thisrisk/maxrisk *
maxscore, min(0, cumsumfpatient), sum(fpatient),
plotblack), horiz = TRUE, xlim = c(min(0, cumsumfpatient),
max(0, maxscore) + 0.5), width = rep(10, length(fpatient) +
1), axes = FALSE, col = c("grey", riskcolor,
"grey", riskcolor, rep("black", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
barplot(c(min(0, cumsumfpatient), thisrisk/maxrisk *
maxscore, min(0, cumsumfpatient), sum(fpatient),
plotblack2), horiz = TRUE, xlim = c(min(0, cumsumfpatient),
max(0, maxscore) + 0.5), width = rep(10, length(fpatient) +
1), axes = FALSE, col = c("grey", riskcolor,
"grey", riskcolor, rep("black", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
barplot(c(maxscore, min(0, cumsumfpatient) + (thisrisk)/maxrisk *
abs(maxscore - min(0, cumsumfpatient)), maxscore,
0, plotwhite), horiz = TRUE, xlim = c(min(0,
cumsumfpatient), max(0, maxscore) + 0.5), width = rep(10,
length(fpatient) + 1), axes = FALSE, col = c("white",
"white", "white", "white", rep("white", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
}
if (sum(fpatient) < 0) {
barplot(c(0, 0, 0, sum(fpatient), numeric(length = length(plotwhite))),
horiz = TRUE, xlim = c(min(0, cumsumfpatient),
max(0, maxscore) + 0.5), width = rep(10, length(fpatient) +
1), axes = FALSE, col = c("grey", "white",
"grey", "white", rep("white", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
}
lines(c(0, 0), c(temp[4], temp[length(temp)]) + diff(temp)[1]/2,
lty = 2)
if (nchar(risklabel) < 20) {
axis(side = 2, at = c(temp), labels = c("", risklabel,
"", "Score", names2[xorder[thisseq]]), las = 2,
lty = "blank", font = 2, cex.axis = 1.5)
}
else {
axis(side = 2, at = c(temp), labels = c("", "Risk",
"", "Score", names2[xorder[thisseq]]), las = 2,
lty = "blank", font = 2, cex.axis = 1.5)
mtext(paste("Risk equals", risklabel), col = "black",
font = 2, side = 1, line = 2, adj = 0)
}
xrange = c(min(0, minscore), max(0, maxscore) + 0.5)
xrange[1] = ceiling(xrange[1])
xrange[2] = floor(xrange[2])
if ("colplotpref" %in% names(x)) {
axis(side = 3)
}
else {
axis(side = 3, at = seq(xrange[1], xrange[2], 1))
}
lines(c(min(0, cumsumfpatient), min(0, cumsumfpatient)),
c(temp[1] - diff(temp)[1]/2, temp[length(temp)] +
diff(temp)[1]/2), lty = 1)
for (i in seq(along = seq(1, length(fpatient)))) {
color = "dodgerblue"
if (xorder[i] <= d) {
if (x$vartypes[xorder[i]] == "cont") {
text(min(0, cumsumfpatient), temp[thisseq[i] +
4], round(obs[xorder[i]], 2), col = color,
pos = 4, font = 4, srt = 20)
}
else {
if ("glm" %in% names(x)) {
if (class(x$x[, i]) == "factor") {
text(min(0, cumsumfpatient), temp[thisseq[i] +
4], x$levelnames[[2]][[xorder[i]]][as.integer(obs[xorder[i]])],
col = color, pos = 4, font = 4, srt = 20)
}
else {
text(min(0, cumsumfpatient), temp[thisseq[i] +
4], obs[xorder[i]], col = color, pos = 4,
font = 4, srt = 20)
}
}
else {
text(min(0, cumsumfpatient), temp[thisseq[i] +
4], x$levelnames[[1]][[xorder[i]]][[match(unlist(obs[xorder[i]]),
x$levelnames[[2]][[xorder[i]]])]], col = color,
pos = 4, font = 4, srt = 20)
}
}
}
if (maxscore >= 0) {
if (cumsumfpatient[i] > maxscore) {
text(maxscore, temp[thisseq[i] + 4] - 3, round(fpatient[xorder[i]],
2), col = "black", pos = 2, font = 2)
}
else if (cumsumfpatient[i] < min(0, minscore)) {
text(min(0, cumsumfpatient), temp[thisseq[i] +
4] - 3, round(fpatient[xorder[i]], 2), col = "grey",
pos = 4, font = 2)
}
else {
text(cumsumfpatient[i], temp[thisseq[i] + 4] -
3, round(fpatient[xorder[i]], 2), col = "grey",
pos = 4, font = 2)
}
}
else {
if (cumsumfpatient[i] > maxscore) {
text(fpatient[xorder[i]], temp[thisseq[i] +
4] - 3, round(fpatient[xorder[i]], 2), col = "black",
pos = 2, font = 2)
}
else if (cumsumfpatient[i] < min(0, minscore)) {
text(min(0, cumsumfpatient), temp[thisseq[i] +
4] - 3, round(fpatient[xorder[i]], 2), col = "grey",
pos = 4, font = 2)
}
else {
text(cumsumfpatient[i], temp[thisseq[i] + 4] -
3, round(fpatient[xorder[i]], 2), col = "grey",
pos = 4, font = 2)
}
}
lines(c(cumsumfpatient[i], cumsumfpatient[i]), c(temp[thisseq[i] +
4], temp[thisseq[i] + 3]) + diff(temp)[1]/2)
lines(c(cumsumfpatient[i], cumsumfpatient[i + 1]),
c(temp[thisseq[i] + 3], temp[thisseq[i] + 3]) +
diff(temp)[1]/2)
}
if (sum(fpatient) < 0.9 * maxscore & sum(fpatient) >=
minscore) {
text(sum(fpatient), temp[4], round(sum(fpatient),
2), col = riskcolor, font = 2, pos = 4)
}
else if (sum(fpatient) >= 0.9 * maxscore) {
text(maxscore, temp[4], round(sum(fpatient), 2),
col = "black", font = 2, pos = 2)
}
else if (sum(fpatient) < minscore & sum(fpatient) > min(cumsumfpatient)) {
text(sum(fpatient), temp[4], round(sum(fpatient),
2), col = riskcolor, font = 2, pos = 4)
}
else if (sum(fpatient) <= min(cumsumfpatient)) {
text(min(0, cumsumfpatient), temp[4], round(sum(fpatient),
2), col = "black", font = 2, pos = 4)
}
text(min(0, cumsumfpatient), temp[3], "max. score", col = "black",
font = 3, pos = 4)
if (maxscore >= 0) {
text(maxscore, temp[3], round(maxscore, 2), col = "black",
font = 2, pos = 2)
}
else {
text(min(0, cumsumfpatient), temp[3], substitute(bold(phantom("max. score ") *
a), list(a = round(maxscore, 2))), col = "black",
font = 2, pos = 4)
}
if (maxscore >= 0) {
if (sum(fpatient) < maxscore & sum(fpatient) > minscore) {
text(thisrisk/maxrisk * maxscore, temp[2], round(thisrisk,
2), col = riskcolor, font = 2, pos = 4)
}
else if (sum(fpatient) >= maxscore) {
text(maxscore, temp[2], round(thisrisk, 2), col = "black",
font = 2, pos = 2)
}
else if (sum(fpatient) <= minscore & sum(fpatient) >
min(cumsumfpatient)) {
text(thisrisk/maxrisk * maxscore, temp[2], round(thisrisk,
2), col = riskcolor, font = 2, pos = 4)
}
else if (sum(fpatient) <= min(cumsumfpatient)) {
text(min(0, cumsumfpatient), temp[2], round(thisrisk,
2), col = "black", font = 2, pos = 4)
}
}
else {
if (sum(fpatient) < maxscore & sum(fpatient) > minscore) {
text(min(0, cumsumfpatient) + (thisrisk)/maxrisk *
abs(maxscore - min(0, cumsumfpatient)), temp[2],
round(thisrisk, 2), col = riskcolor, font = 2,
pos = 4)
}
else if (sum(fpatient) >= maxscore) {
text(maxscore, temp[2], round(thisrisk, 2), col = "black",
font = 2, pos = 2)
}
else if (sum(fpatient) <= minscore & sum(fpatient) >
min(cumsumfpatient)) {
text(thisrisk/maxrisk * maxscore, temp[2], round(thisrisk,
2), col = riskcolor, font = 2, pos = 4)
}
else if (sum(fpatient) <= min(cumsumfpatient)) {
text(min(0, cumsumfpatient), temp[2], round(thisrisk,
2), col = "black", font = 2, pos = 4)
}
}
text(min(0, cumsumfpatient), temp[1], "max. risk", col = "black",
font = 3, pos = 4)
if (maxscore >= 0) {
text(maxscore, temp[1], round(maxrisk, 2), col = "black",
font = 2, pos = 2)
}
else {
text(min(0, cumsumfpatient), temp[1], substitute(bold(phantom("max. risk ") *
a), list(a = round(maxrisk, 2))), col = "black",
font = 2, pos = 4)
}
}
else {
temp = barplot(c(min(cumsumfpatient), min(cumsumfpatient),
plotgrey), horiz = TRUE, xlim = c(min(0, cumsumfpatient),
max(maxscore) + 0.5), width = rep(10, length(fpatient) +
2), axes = FALSE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 2)))
barplot(c(maxscore, min(cumsumfpatient), plotgrey2),
horiz = TRUE, xlim = c(min(0, cumsumfpatient), max(maxscore) +
0.5), width = rep(10, length(fpatient) - 1),
axes = FALSE, col = c("grey", riskcolor, rep("grey",
length(fpatient))), add = TRUE, space = 0, border = NA,
names.arg = c(rep("", length(fpatient) + 2)))
barplot(c(maxscore, sum(fpatient), plotblack), horiz = TRUE,
xlim = c(min(0, cumsumfpatient), max(maxscore) +
0.5), width = rep(10, length(fpatient) + 1),
axes = FALSE, col = c("grey", riskcolor, rep("black",
length(fpatient))), add = TRUE, space = 0, border = NA,
names.arg = c(rep("", length(fpatient) + 2)))
barplot(c(maxscore, sum(fpatient), plotblack2), horiz = TRUE,
xlim = c(min(0, cumsumfpatient), max(maxscore) +
0.5), width = rep(10, length(fpatient) + 1),
axes = FALSE, col = c("grey", riskcolor, rep("black",
length(fpatient))), add = TRUE, space = 0, border = NA,
names.arg = c(rep("", length(fpatient) + 2)))
barplot(c(0, 0, plotwhite), horiz = TRUE, xlim = c(min(0,
cumsumfpatient), max(maxscore) + 0.5), width = rep(10,
length(fpatient) + 1), axes = FALSE, col = c(rep("white",
length(fpatient))), add = TRUE, space = 0, border = NA,
names.arg = c(rep("", length(fpatient) + 2)))
if (sum(fpatient) < 0) {
barplot(c(0, sum(fpatient), numeric(length = length(plotwhite))),
horiz = TRUE, xlim = c(min(0, cumsumfpatient),
max(maxscore) + 0.5), width = rep(10, length(fpatient) +
1), axes = FALSE, col = c("grey", "white",
rep("white", length(fpatient))), add = TRUE,
space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 2)))
}
lines(c(0, 0), c(temp[2], temp[length(temp)]) + diff(temp)[1]/2,
lty = 2)
axis(side = 2, at = c(temp), labels = c("", "Score",
names2[xorder[thisseq]]), las = 2, lty = "blank",
font = 2, cex.axis = 1.5)
xrange = c(min(0, cumsumfpatient), max(maxscore) + 0.5)
xrange[1] = ceiling(xrange[1])
xrange[2] = floor(xrange[2])
axis(side = 3, at = seq(xrange[1], xrange[2], 1))
lines(c(min(0, cumsumfpatient), min(0, cumsumfpatient)),
c(temp[1] - diff(temp)[1]/2, temp[length(temp)] +
diff(temp)[1]/2), lty = 1)
for (i in seq(along = seq(1, length(fpatient)))) {
color = "dodgerblue"
if (xorder[i] <= d) {
if (x$vartypes[xorder[i]] == "cont") {
text(min(0, cumsumfpatient), temp[thisseq[i] +
2], round(obs[xorder[i]], 2), col = color,
pos = 4, font = 4, srt = 20)
}
else {
if ("glm" %in% names(x)) {
if (class(x$x[, i]) == "factor") {
text(min(0, cumsumfpatient), temp[thisseq[i] +
2], x$levelnames[[2]][[xorder[i]]][as.integer(obs[xorder[i]])],
col = color, pos = 4, font = 4, srt = 20)
}
else {
text(min(0, cumsumfpatient), temp[thisseq[i] +
2], obs[xorder[i]], col = color, pos = 4,
font = 4, srt = 20)
}
}
else {
text(min(0, cumsumfpatient), temp[thisseq[i] +
2], x$levelnames[[1]][[xorder[i]]][[match(unlist(obs[xorder[i]]),
x$levelnames[[2]][[xorder[i]]])]], col = color,
pos = 4, font = 4, srt = 20)
}
}
}
if (cumsumfpatient[i] > maxscore) {
text(maxscore, temp[thisseq[i] + 2] - 3, round(fpatient[xorder[i]],
2), col = "black", pos = 2, font = 2)
}
else if (cumsumfpatient[i] < min(0, cumsumfpatient)) {
text(min(0, cumsumfpatient), temp[thisseq[i] +
2] - 3, round(fpatient[xorder[i]], 2), col = "grey",
pos = 4, font = 2)
}
else {
text(cumsumfpatient[i], temp[thisseq[i] + 2] -
3, round(fpatient[xorder[i]], 2), col = "grey",
pos = 4, font = 2)
}
lines(c(cumsumfpatient[i], cumsumfpatient[i]), c(temp[thisseq[i] +
2], temp[thisseq[i] + 1]) + diff(temp)[1]/2)
lines(c(cumsumfpatient[i], cumsumfpatient[i + 1]),
c(temp[thisseq[i] + 1], temp[thisseq[i] + 1]) +
diff(temp)[1]/2)
}
if (sum(fpatient) < 0.9 * maxscore & sum(fpatient) >=
min(cumsumfpatient)) {
text(sum(fpatient), temp[2], round(sum(fpatient),
2), col = riskcolor, font = 2, pos = 4)
}
else if (sum(fpatient) >= 0.9 * maxscore) {
text(maxscore, temp[2], round(sum(fpatient), 2),
col = "black", font = 2, pos = 2)
}
else if (sum(fpatient) < min(cumsumfpatient)) {
text(min(0, cumsumfpatient), temp[2], round(sum(fpatient),
2), col = "black", font = 2, pos = 2)
}
text(min(0, cumsumfpatient), temp[1], "max. score", col = "black",
font = 3, pos = 4)
text(maxscore, temp[1], round(maxscore, 2), col = "black",
font = 2, pos = 2)
mtext(paste("Score equals", risklabel), col = "black",
font = 2, side = 1, line = 2, adj = 0)
}
x0 = ceiling(par("usr")[1])
unit = (par("usr")[2] - par("usr")[1])/7.5
mtext(expression(bold(phantom("legend of reported figures: ")) *
"blue - predictor value"), col = color, font = 2, side = 1,
line = 0, adj = 0)
mtext(expression(bold("legend of reported figures: ") * phantom("blue - predictor value")),
col = "black", font = 2, side = 1, line = 0, adj = 0)
mtext(expression(bold(phantom("legend of reported figures: ")) *
"gray - contribution to score"), col = "grey", font = 2,
side = 1, line = 1, adj = 0)
for (i in seq(1, length(thisseq), 1)) {
if (!is.nan(thisrisk)) {
axis(side = 2, at = c(temp[i + 4]), labels = names2[xorder[thisseq]][i],
las = 2, lty = "blank", font = 2, cex.axis = 1.5,
col.axis = yaxiscolor[thisseq][i])
}
else {
axis(side = 2, at = c(temp[i + 2]), labels = names2[xorder[thisseq]][i],
las = 2, lty = "blank", font = 2, cex.axis = 1.5,
col.axis = yaxiscolor[thisseq][i])
}
}
garbage <- dev.off()
}
<bytecode: 0x8701970>
<environment: namespace:VRPM>
--- function search by body ---
Function ccchart.default in namespace VRPM has this body.
----------- END OF FAILURE REPORT --------------
Error in if (!class(fpatient) %in% c("vector", "matrix")) { :
the condition has length > 1
Calls: ccchart -> ccchart.glm -> ccchart -> ccchart.default
Execution halted
Flavor: r-devel-linux-x86_64-debian-clang
Version: 1.2
Check: for non-standard things in the check directory
Result: NOTE
Found the following files/directories:
'multinom_divorced.png' 'multinom_married.png'
'multinom_patientsummary.png' 'multinom_patientsummary2.png'
'multinom_widowed.png' 'multinomp_divorced.png'
'multinomp_divorced_wing.png' 'multinomp_married.png'
'multinomp_married_wing.png' 'multinomp_single.png'
'multinomp_widowed.png' 'multinomp_widowed_wing.png' 'mysummary.Rnw'
'mysummary.html' 'mysummary1.Rnw' 'mysummary1.html'
Flavors: r-devel-linux-x86_64-debian-clang, r-devel-linux-x86_64-debian-gcc, r-devel-linux-x86_64-fedora-clang, r-devel-linux-x86_64-fedora-gcc
Version: 1.2
Check: examples
Result: ERROR
Running examples in ‘VRPM-Ex.R’ failed
The error most likely occurred in:
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: ccchart
> ### Title: Cumulative contribution chart.
> ### Aliases: ccchart ccchart.coxph ccchart.default ccchart.glm ccchart.ksvm
> ### ccchart.multinom
>
> ### ** Examples
>
> #### logistic regression
> mydata <- read.csv("https://stats.idre.ucla.edu/stat/data/binary.csv")
> mydata$rank <- factor(mydata$rank)
> fit <- glm(admit ~ gre + gpa + rank, data = mydata, family = "binomial")
> patient1=data.frame(gre=386,gpa=3.58,rank=3)
> ccchart(fit,obs=patient1,filename="ccchart1")
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
VRPM
--- call from context ---
ccchart.default(x2, obs = obs, filename, zerolevel, risklabel = x2$risklabel,
riskcutoff, type = type, sorted, time, xmin, xmax)
--- call from argument ---
if (!class(fpatient) %in% c("vector", "matrix")) {
fpatient = as.matrix(fpatient)
}
--- R stacktrace ---
where 1: ccchart.default(x2, obs = obs, filename, zerolevel, risklabel = x2$risklabel,
riskcutoff, type = type, sorted, time, xmin, xmax)
where 2: ccchart(x2, obs = obs, filename, zerolevel, risklabel = x2$risklabel,
riskcutoff, type = type, sorted, time, xmin, xmax)
where 3: ccchart.glm(fit, obs = patient1, filename = "ccchart1")
where 4: ccchart(fit, obs = patient1, filename = "ccchart1")
--- value of length: 2 type: logical ---
[1] FALSE TRUE
--- function from context ---
function (x, obs, filename, zerolevel = "zero", risklabel = "Estimated risk",
riskcutoff = 0.1, type = "logistic", sorted = FALSE, time,
xmin, xmax)
{
x$sorted = sorted
x$zerolevel = zerolevel
x <- check_data(x, type = "ccchart")
if (dim(x$x)[2] != length(obs)) {
stop("The dimension of the given data set does not match with the length of obs. Please adapt in order to continue.")
}
x2 = precolplot(x, filename, coloroptions = 1, zerolevel = zerolevel,
risklabel = risklabel, adverse = FALSE, obs = obs, xmin,
xmax)
f = x2$f
fpatient = x2$fpatient
fzero = x2$fzero
d = x2$d
n = x2$n
thisrisk = x2$thisrisk
devheight = dim(f)[2] + 2
devwidth = 10
png(paste0(ifelse(hasArg(filename), filename, "ccchart"),
".png"), width = devwidth, height = devheight, units = "in",
res = 120)
if (!class(fpatient) %in% c("vector", "matrix")) {
fpatient = as.matrix(fpatient)
}
if (x$sorted == TRUE) {
xorder = order(fpatient)
}
else {
xorder = seq(1, length(fpatient), 1)
}
maxdata = apply(fzero, 2, max)
maxscore = max(apply(f, 1, sum))
minscore = min(apply(f, 1, sum))
allrisks <- x$getriskestimate(rowSums(f), x, rowSums(f))[[2]]
maxrisk = max(allrisks)
minrisk = min(allrisks)
maxscore = max(apply(fzero, 1, sum))
minscore = min(apply(fzero, 1, sum))
if (!is.nan(minrisk)) {
if (type == "survival") {
maxscore = max(apply(f, 1, sum))
minscore = min(apply(f, 1, sum))
maxrisk <- x$getriskestimate(rowSums(f), x, maxscore)[[2]][1]
minrisk <- x$getriskestimate(rowSums(f), x, minscore)[[2]][1]
minrisk = 1 - minrisk
maxrisk = 1 - maxrisk
thisrisk = 1 - thisrisk
risklabel = paste0("1-", risklabel)
}
}
if (!is.nan(thisrisk)) {
if (thisrisk < riskcutoff) {
riskcolor = "green"
}
else {
riskcolor = "red"
}
}
else {
riskcolor = "orange"
}
d2 = dim(f)[2] - d
if (d2 > 0) {
if (d2 == 1) {
posint = which(max(f[, seq(d + 1, d + d2, 1)]) -
min(f[, seq(d + 1, d + d2, 1)]) != 0)
}
else {
posint = which(apply(f[, seq(d + 1, d + d2, 1)],
2, max) - apply(f[, seq(d + 1, d + d2, 1)], 2,
min) != 0)
}
names2 = rep("", times = d + d2)
names2[1:d] = x$names
for (i in seq(d + 1, dim(f)[2])) {
names2[i] = paste(x$names[x$interactions[i - d, 1]],
" : ", x$names[x$interactions[i - d, 2]])
}
names2 = names2[c(seq(1, d, by = 1), posint + d)]
fpatient = fpatient[c(seq(1, d, by = 1), posint + d)]
fzero = fzero[c(seq(1, d, by = 1), posint + d)]
if (x$sorted == TRUE) {
xorder = order(fpatient)
}
else {
xorder = seq(1, length(fpatient), 1)
}
}
else {
names2 = x$names
}
thisseq = c(length(fpatient):1)
par(mar = c(5 + 2, 8 + 8, 4, 2))
cumsumfpatient = cumsum(fpatient[xorder])
plotgrey = numeric(length = length(fpatient))
plotblack = numeric(length = length(fpatient))
plotgrey2 = numeric(length = length(fpatient))
plotblack2 = numeric(length = length(fpatient))
plotwhite = numeric(length = length(fpatient))
i = 1
if (fpatient[xorder[i]] > 0) {
plotgrey[i] = cumsumfpatient[i]
}
if (fpatient[xorder[i]] < 0) {
plotblack[i] = cumsumfpatient[i]
}
for (i in seq(2, length(fpatient), 1)) {
if (cumsumfpatient[i] == 0) {
if (fpatient[xorder[i]] > 0) {
plotgrey[i] = cumsumfpatient[i - 1]
}
if (fpatient[xorder[i]] < 0) {
plotblack[i] = cumsumfpatient[i - 1]
}
}
if (cumsumfpatient[i] > 0) {
if (fpatient[xorder[i]] > 0) {
plotgrey[i] = cumsumfpatient[i]
plotwhite[i] = cumsumfpatient[i - 1]
}
if (fpatient[xorder[i]] < 0) {
plotblack[i] = cumsumfpatient[i - 1]
plotwhite[i] = cumsumfpatient[i]
}
}
if (cumsumfpatient[i] < 0) {
if (fpatient[xorder[i]] > 0) {
plotgrey[i] = cumsumfpatient[i - 1]
plotwhite[i] = cumsumfpatient[i]
}
if (fpatient[xorder[i]] < 0) {
plotblack[i] = cumsumfpatient[i]
plotwhite[i] = cumsumfpatient[i - 1]
}
}
}
diffsign = c("FALSE", abs(diff(sign(cumsumfpatient))) ==
2)
diffinds = which(diffsign == "TRUE")
for (i in seq(along = diffinds)) {
if (cumsumfpatient[diffinds[i]] > 0 & fpatient[xorder[diffinds[i]]] >
0) {
plotgrey2[diffinds[i]] = cumsumfpatient[diffinds[i] -
1]
plotwhite[diffinds[i]] = 0
}
if (cumsumfpatient[diffinds[i]] < 0 & fpatient[xorder[diffinds[i]]] <
0) {
plotblack2[diffinds[i]] = cumsumfpatient[diffinds[i] -
1]
plotwhite[diffinds[i]] = 0
}
}
plotgrey = plotgrey[thisseq]
plotblack = plotblack[thisseq]
plotwhite = plotwhite[thisseq]
plotgrey2 = plotgrey2[thisseq]
plotblack2 = plotblack2[thisseq]
yaxiscolor = rep("black", length(thisseq))
yaxiscolor[which(cumsumfpatient < min(-0.5, minscore))] = "grey"
if (!is.nan(thisrisk)) {
temp = barplot(c(min(0, cumsumfpatient), 0, min(0, cumsumfpatient),
min(0, cumsumfpatient), plotgrey), horiz = TRUE,
xlim = c(min(0, cumsumfpatient), max(0, maxscore) +
0.5), width = rep(10, length(fpatient) + 4),
axes = FALSE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
barplot(c(maxscore, min(0, cumsumfpatient), maxscore,
min(0, cumsumfpatient), plotgrey2), horiz = TRUE,
xlim = c(min(0, cumsumfpatient), max(0, maxscore) +
0.5), width = rep(10, length(fpatient) + 1),
axes = FALSE, col = c("grey", riskcolor, "grey",
riskcolor, rep("grey", length(fpatient))), add = TRUE,
space = 0, border = NA, names.arg = c(rep("", length(fpatient) +
4)))
if (maxscore >= 0) {
barplot(c(maxscore, thisrisk/maxrisk * maxscore,
maxscore, sum(fpatient), plotblack), horiz = TRUE,
xlim = c(min(0, cumsumfpatient), max(0, maxscore) +
0.5), width = rep(10, length(fpatient) + 1),
axes = FALSE, col = c("grey", riskcolor, "grey",
riskcolor, rep("black", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
barplot(c(maxscore, thisrisk/maxrisk * maxscore,
maxscore, sum(fpatient), plotblack2), horiz = TRUE,
xlim = c(min(0, cumsumfpatient), max(0, maxscore) +
0.5), width = rep(10, length(fpatient) + 1),
axes = FALSE, col = c("grey", riskcolor, "grey",
riskcolor, rep("black", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
barplot(c(0, 0, 0, 0, plotwhite), horiz = TRUE, xlim = c(min(0,
cumsumfpatient), max(0, maxscore) + 0.5), width = rep(10,
length(fpatient) + 1), axes = FALSE, col = c("grey",
riskcolor, "grey", riskcolor, rep("white", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
}
if (maxscore < 0) {
barplot(c(min(0, cumsumfpatient), thisrisk/maxrisk *
maxscore, min(0, cumsumfpatient), sum(fpatient),
plotblack), horiz = TRUE, xlim = c(min(0, cumsumfpatient),
max(0, maxscore) + 0.5), width = rep(10, length(fpatient) +
1), axes = FALSE, col = c("grey", riskcolor,
"grey", riskcolor, rep("black", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
barplot(c(min(0, cumsumfpatient), thisrisk/maxrisk *
maxscore, min(0, cumsumfpatient), sum(fpatient),
plotblack2), horiz = TRUE, xlim = c(min(0, cumsumfpatient),
max(0, maxscore) + 0.5), width = rep(10, length(fpatient) +
1), axes = FALSE, col = c("grey", riskcolor,
"grey", riskcolor, rep("black", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
barplot(c(maxscore, min(0, cumsumfpatient) + (thisrisk)/maxrisk *
abs(maxscore - min(0, cumsumfpatient)), maxscore,
0, plotwhite), horiz = TRUE, xlim = c(min(0,
cumsumfpatient), max(0, maxscore) + 0.5), width = rep(10,
length(fpatient) + 1), axes = FALSE, col = c("white",
"white", "white", "white", rep("white", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
}
if (sum(fpatient) < 0) {
barplot(c(0, 0, 0, sum(fpatient), numeric(length = length(plotwhite))),
horiz = TRUE, xlim = c(min(0, cumsumfpatient),
max(0, maxscore) + 0.5), width = rep(10, length(fpatient) +
1), axes = FALSE, col = c("grey", "white",
"grey", "white", rep("white", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
}
lines(c(0, 0), c(temp[4], temp[length(temp)]) + diff(temp)[1]/2,
lty = 2)
if (nchar(risklabel) < 20) {
axis(side = 2, at = c(temp), labels = c("", risklabel,
"", "Score", names2[xorder[thisseq]]), las = 2,
lty = "blank", font = 2, cex.axis = 1.5)
}
else {
axis(side = 2, at = c(temp), labels = c("", "Risk",
"", "Score", names2[xorder[thisseq]]), las = 2,
lty = "blank", font = 2, cex.axis = 1.5)
mtext(paste("Risk equals", risklabel), col = "black",
font = 2, side = 1, line = 2, adj = 0)
}
xrange = c(min(0, minscore), max(0, maxscore) + 0.5)
xrange[1] = ceiling(xrange[1])
xrange[2] = floor(xrange[2])
if ("colplotpref" %in% names(x)) {
axis(side = 3)
}
else {
axis(side = 3, at = seq(xrange[1], xrange[2], 1))
}
lines(c(min(0, cumsumfpatient), min(0, cumsumfpatient)),
c(temp[1] - diff(temp)[1]/2, temp[length(temp)] +
diff(temp)[1]/2), lty = 1)
for (i in seq(along = seq(1, length(fpatient)))) {
color = "dodgerblue"
if (xorder[i] <= d) {
if (x$vartypes[xorder[i]] == "cont") {
text(min(0, cumsumfpatient), temp[thisseq[i] +
4], round(obs[xorder[i]], 2), col = color,
pos = 4, font = 4, srt = 20)
}
else {
if ("glm" %in% names(x)) {
if (class(x$x[, i]) == "factor") {
text(min(0, cumsumfpatient), temp[thisseq[i] +
4], x$levelnames[[2]][[xorder[i]]][as.integer(obs[xorder[i]])],
col = color, pos = 4, font = 4, srt = 20)
}
else {
text(min(0, cumsumfpatient), temp[thisseq[i] +
4], obs[xorder[i]], col = color, pos = 4,
font = 4, srt = 20)
}
}
else {
text(min(0, cumsumfpatient), temp[thisseq[i] +
4], x$levelnames[[1]][[xorder[i]]][[match(unlist(obs[xorder[i]]),
x$levelnames[[2]][[xorder[i]]])]], col = color,
pos = 4, font = 4, srt = 20)
}
}
}
if (maxscore >= 0) {
if (cumsumfpatient[i] > maxscore) {
text(maxscore, temp[thisseq[i] + 4] - 3, round(fpatient[xorder[i]],
2), col = "black", pos = 2, font = 2)
}
else if (cumsumfpatient[i] < min(0, minscore)) {
text(min(0, cumsumfpatient), temp[thisseq[i] +
4] - 3, round(fpatient[xorder[i]], 2), col = "grey",
pos = 4, font = 2)
}
else {
text(cumsumfpatient[i], temp[thisseq[i] + 4] -
3, round(fpatient[xorder[i]], 2), col = "grey",
pos = 4, font = 2)
}
}
else {
if (cumsumfpatient[i] > maxscore) {
text(fpatient[xorder[i]], temp[thisseq[i] +
4] - 3, round(fpatient[xorder[i]], 2), col = "black",
pos = 2, font = 2)
}
else if (cumsumfpatient[i] < min(0, minscore)) {
text(min(0, cumsumfpatient), temp[thisseq[i] +
4] - 3, round(fpatient[xorder[i]], 2), col = "grey",
pos = 4, font = 2)
}
else {
text(cumsumfpatient[i], temp[thisseq[i] + 4] -
3, round(fpatient[xorder[i]], 2), col = "grey",
pos = 4, font = 2)
}
}
lines(c(cumsumfpatient[i], cumsumfpatient[i]), c(temp[thisseq[i] +
4], temp[thisseq[i] + 3]) + diff(temp)[1]/2)
lines(c(cumsumfpatient[i], cumsumfpatient[i + 1]),
c(temp[thisseq[i] + 3], temp[thisseq[i] + 3]) +
diff(temp)[1]/2)
}
if (sum(fpatient) < 0.9 * maxscore & sum(fpatient) >=
minscore) {
text(sum(fpatient), temp[4], round(sum(fpatient),
2), col = riskcolor, font = 2, pos = 4)
}
else if (sum(fpatient) >= 0.9 * maxscore) {
text(maxscore, temp[4], round(sum(fpatient), 2),
col = "black", font = 2, pos = 2)
}
else if (sum(fpatient) < minscore & sum(fpatient) > min(cumsumfpatient)) {
text(sum(fpatient), temp[4], round(sum(fpatient),
2), col = riskcolor, font = 2, pos = 4)
}
else if (sum(fpatient) <= min(cumsumfpatient)) {
text(min(0, cumsumfpatient), temp[4], round(sum(fpatient),
2), col = "black", font = 2, pos = 4)
}
text(min(0, cumsumfpatient), temp[3], "max. score", col = "black",
font = 3, pos = 4)
if (maxscore >= 0) {
text(maxscore, temp[3], round(maxscore, 2), col = "black",
font = 2, pos = 2)
}
else {
text(min(0, cumsumfpatient), temp[3], substitute(bold(phantom("max. score ") *
a), list(a = round(maxscore, 2))), col = "black",
font = 2, pos = 4)
}
if (maxscore >= 0) {
if (sum(fpatient) < maxscore & sum(fpatient) > minscore) {
text(thisrisk/maxrisk * maxscore, temp[2], round(thisrisk,
2), col = riskcolor, font = 2, pos = 4)
}
else if (sum(fpatient) >= maxscore) {
text(maxscore, temp[2], round(thisrisk, 2), col = "black",
font = 2, pos = 2)
}
else if (sum(fpatient) <= minscore & sum(fpatient) >
min(cumsumfpatient)) {
text(thisrisk/maxrisk * maxscore, temp[2], round(thisrisk,
2), col = riskcolor, font = 2, pos = 4)
}
else if (sum(fpatient) <= min(cumsumfpatient)) {
text(min(0, cumsumfpatient), temp[2], round(thisrisk,
2), col = "black", font = 2, pos = 4)
}
}
else {
if (sum(fpatient) < maxscore & sum(fpatient) > minscore) {
text(min(0, cumsumfpatient) + (thisrisk)/maxrisk *
abs(maxscore - min(0, cumsumfpatient)), temp[2],
round(thisrisk, 2), col = riskcolor, font = 2,
pos = 4)
}
else if (sum(fpatient) >= maxscore) {
text(maxscore, temp[2], round(thisrisk, 2), col = "black",
font = 2, pos = 2)
}
else if (sum(fpatient) <= minscore & sum(fpatient) >
min(cumsumfpatient)) {
text(thisrisk/maxrisk * maxscore, temp[2], round(thisrisk,
2), col = riskcolor, font = 2, pos = 4)
}
else if (sum(fpatient) <= min(cumsumfpatient)) {
text(min(0, cumsumfpatient), temp[2], round(thisrisk,
2), col = "black", font = 2, pos = 4)
}
}
text(min(0, cumsumfpatient), temp[1], "max. risk", col = "black",
font = 3, pos = 4)
if (maxscore >= 0) {
text(maxscore, temp[1], round(maxrisk, 2), col = "black",
font = 2, pos = 2)
}
else {
text(min(0, cumsumfpatient), temp[1], substitute(bold(phantom("max. risk ") *
a), list(a = round(maxrisk, 2))), col = "black",
font = 2, pos = 4)
}
}
else {
temp = barplot(c(min(cumsumfpatient), min(cumsumfpatient),
plotgrey), horiz = TRUE, xlim = c(min(0, cumsumfpatient),
max(maxscore) + 0.5), width = rep(10, length(fpatient) +
2), axes = FALSE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 2)))
barplot(c(maxscore, min(cumsumfpatient), plotgrey2),
horiz = TRUE, xlim = c(min(0, cumsumfpatient), max(maxscore) +
0.5), width = rep(10, length(fpatient) - 1),
axes = FALSE, col = c("grey", riskcolor, rep("grey",
length(fpatient))), add = TRUE, space = 0, border = NA,
names.arg = c(rep("", length(fpatient) + 2)))
barplot(c(maxscore, sum(fpatient), plotblack), horiz = TRUE,
xlim = c(min(0, cumsumfpatient), max(maxscore) +
0.5), width = rep(10, length(fpatient) + 1),
axes = FALSE, col = c("grey", riskcolor, rep("black",
length(fpatient))), add = TRUE, space = 0, border = NA,
names.arg = c(rep("", length(fpatient) + 2)))
barplot(c(maxscore, sum(fpatient), plotblack2), horiz = TRUE,
xlim = c(min(0, cumsumfpatient), max(maxscore) +
0.5), width = rep(10, length(fpatient) + 1),
axes = FALSE, col = c("grey", riskcolor, rep("black",
length(fpatient))), add = TRUE, space = 0, border = NA,
names.arg = c(rep("", length(fpatient) + 2)))
barplot(c(0, 0, plotwhite), horiz = TRUE, xlim = c(min(0,
cumsumfpatient), max(maxscore) + 0.5), width = rep(10,
length(fpatient) + 1), axes = FALSE, col = c(rep("white",
length(fpatient))), add = TRUE, space = 0, border = NA,
names.arg = c(rep("", length(fpatient) + 2)))
if (sum(fpatient) < 0) {
barplot(c(0, sum(fpatient), numeric(length = length(plotwhite))),
horiz = TRUE, xlim = c(min(0, cumsumfpatient),
max(maxscore) + 0.5), width = rep(10, length(fpatient) +
1), axes = FALSE, col = c("grey", "white",
rep("white", length(fpatient))), add = TRUE,
space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 2)))
}
lines(c(0, 0), c(temp[2], temp[length(temp)]) + diff(temp)[1]/2,
lty = 2)
axis(side = 2, at = c(temp), labels = c("", "Score",
names2[xorder[thisseq]]), las = 2, lty = "blank",
font = 2, cex.axis = 1.5)
xrange = c(min(0, cumsumfpatient), max(maxscore) + 0.5)
xrange[1] = ceiling(xrange[1])
xrange[2] = floor(xrange[2])
axis(side = 3, at = seq(xrange[1], xrange[2], 1))
lines(c(min(0, cumsumfpatient), min(0, cumsumfpatient)),
c(temp[1] - diff(temp)[1]/2, temp[length(temp)] +
diff(temp)[1]/2), lty = 1)
for (i in seq(along = seq(1, length(fpatient)))) {
color = "dodgerblue"
if (xorder[i] <= d) {
if (x$vartypes[xorder[i]] == "cont") {
text(min(0, cumsumfpatient), temp[thisseq[i] +
2], round(obs[xorder[i]], 2), col = color,
pos = 4, font = 4, srt = 20)
}
else {
if ("glm" %in% names(x)) {
if (class(x$x[, i]) == "factor") {
text(min(0, cumsumfpatient), temp[thisseq[i] +
2], x$levelnames[[2]][[xorder[i]]][as.integer(obs[xorder[i]])],
col = color, pos = 4, font = 4, srt = 20)
}
else {
text(min(0, cumsumfpatient), temp[thisseq[i] +
2], obs[xorder[i]], col = color, pos = 4,
font = 4, srt = 20)
}
}
else {
text(min(0, cumsumfpatient), temp[thisseq[i] +
2], x$levelnames[[1]][[xorder[i]]][[match(unlist(obs[xorder[i]]),
x$levelnames[[2]][[xorder[i]]])]], col = color,
pos = 4, font = 4, srt = 20)
}
}
}
if (cumsumfpatient[i] > maxscore) {
text(maxscore, temp[thisseq[i] + 2] - 3, round(fpatient[xorder[i]],
2), col = "black", pos = 2, font = 2)
}
else if (cumsumfpatient[i] < min(0, cumsumfpatient)) {
text(min(0, cumsumfpatient), temp[thisseq[i] +
2] - 3, round(fpatient[xorder[i]], 2), col = "grey",
pos = 4, font = 2)
}
else {
text(cumsumfpatient[i], temp[thisseq[i] + 2] -
3, round(fpatient[xorder[i]], 2), col = "grey",
pos = 4, font = 2)
}
lines(c(cumsumfpatient[i], cumsumfpatient[i]), c(temp[thisseq[i] +
2], temp[thisseq[i] + 1]) + diff(temp)[1]/2)
lines(c(cumsumfpatient[i], cumsumfpatient[i + 1]),
c(temp[thisseq[i] + 1], temp[thisseq[i] + 1]) +
diff(temp)[1]/2)
}
if (sum(fpatient) < 0.9 * maxscore & sum(fpatient) >=
min(cumsumfpatient)) {
text(sum(fpatient), temp[2], round(sum(fpatient),
2), col = riskcolor, font = 2, pos = 4)
}
else if (sum(fpatient) >= 0.9 * maxscore) {
text(maxscore, temp[2], round(sum(fpatient), 2),
col = "black", font = 2, pos = 2)
}
else if (sum(fpatient) < min(cumsumfpatient)) {
text(min(0, cumsumfpatient), temp[2], round(sum(fpatient),
2), col = "black", font = 2, pos = 2)
}
text(min(0, cumsumfpatient), temp[1], "max. score", col = "black",
font = 3, pos = 4)
text(maxscore, temp[1], round(maxscore, 2), col = "black",
font = 2, pos = 2)
mtext(paste("Score equals", risklabel), col = "black",
font = 2, side = 1, line = 2, adj = 0)
}
x0 = ceiling(par("usr")[1])
unit = (par("usr")[2] - par("usr")[1])/7.5
mtext(expression(bold(phantom("legend of reported figures: ")) *
"blue - predictor value"), col = color, font = 2, side = 1,
line = 0, adj = 0)
mtext(expression(bold("legend of reported figures: ") * phantom("blue - predictor value")),
col = "black", font = 2, side = 1, line = 0, adj = 0)
mtext(expression(bold(phantom("legend of reported figures: ")) *
"gray - contribution to score"), col = "grey", font = 2,
side = 1, line = 1, adj = 0)
for (i in seq(1, length(thisseq), 1)) {
if (!is.nan(thisrisk)) {
axis(side = 2, at = c(temp[i + 4]), labels = names2[xorder[thisseq]][i],
las = 2, lty = "blank", font = 2, cex.axis = 1.5,
col.axis = yaxiscolor[thisseq][i])
}
else {
axis(side = 2, at = c(temp[i + 2]), labels = names2[xorder[thisseq]][i],
las = 2, lty = "blank", font = 2, cex.axis = 1.5,
col.axis = yaxiscolor[thisseq][i])
}
}
garbage <- dev.off()
}
<bytecode: 0x565009ecb1b0>
<environment: namespace:VRPM>
--- function search by body ---
Function ccchart.default in namespace VRPM has this body.
----------- END OF FAILURE REPORT --------------
Error in if (!class(fpatient) %in% c("vector", "matrix")) { :
the condition has length > 1
Calls: ccchart -> ccchart.glm -> ccchart -> ccchart.default
Execution halted
Flavor: r-devel-linux-x86_64-debian-gcc
Version: 1.2
Check: examples
Result: ERROR
Running examples in ‘VRPM-Ex.R’ failed
The error most likely occurred in:
> ### Name: ccchart
> ### Title: Cumulative contribution chart.
> ### Aliases: ccchart ccchart.coxph ccchart.default ccchart.glm ccchart.ksvm
> ### ccchart.multinom
>
> ### ** Examples
>
> #### logistic regression
> mydata <- read.csv("https://stats.idre.ucla.edu/stat/data/binary.csv")
> mydata$rank <- factor(mydata$rank)
> fit <- glm(admit ~ gre + gpa + rank, data = mydata, family = "binomial")
> patient1=data.frame(gre=386,gpa=3.58,rank=3)
> ccchart(fit,obs=patient1,filename="ccchart1")
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
VRPM
--- call from context ---
ccchart.default(x2, obs = obs, filename, zerolevel, risklabel = x2$risklabel,
riskcutoff, type = type, sorted, time, xmin, xmax)
--- call from argument ---
if (!class(fpatient) %in% c("vector", "matrix")) {
fpatient = as.matrix(fpatient)
}
--- R stacktrace ---
where 1: ccchart.default(x2, obs = obs, filename, zerolevel, risklabel = x2$risklabel,
riskcutoff, type = type, sorted, time, xmin, xmax)
where 2: ccchart(x2, obs = obs, filename, zerolevel, risklabel = x2$risklabel,
riskcutoff, type = type, sorted, time, xmin, xmax)
where 3: ccchart.glm(fit, obs = patient1, filename = "ccchart1")
where 4: ccchart(fit, obs = patient1, filename = "ccchart1")
--- value of length: 2 type: logical ---
[1] FALSE TRUE
--- function from context ---
function (x, obs, filename, zerolevel = "zero", risklabel = "Estimated risk",
riskcutoff = 0.1, type = "logistic", sorted = FALSE, time,
xmin, xmax)
{
x$sorted = sorted
x$zerolevel = zerolevel
x <- check_data(x, type = "ccchart")
if (dim(x$x)[2] != length(obs)) {
stop("The dimension of the given data set does not match with the length of obs. Please adapt in order to continue.")
}
x2 = precolplot(x, filename, coloroptions = 1, zerolevel = zerolevel,
risklabel = risklabel, adverse = FALSE, obs = obs, xmin,
xmax)
f = x2$f
fpatient = x2$fpatient
fzero = x2$fzero
d = x2$d
n = x2$n
thisrisk = x2$thisrisk
devheight = dim(f)[2] + 2
devwidth = 10
png(paste0(ifelse(hasArg(filename), filename, "ccchart"),
".png"), width = devwidth, height = devheight, units = "in",
res = 120)
if (!class(fpatient) %in% c("vector", "matrix")) {
fpatient = as.matrix(fpatient)
}
if (x$sorted == TRUE) {
xorder = order(fpatient)
}
else {
xorder = seq(1, length(fpatient), 1)
}
maxdata = apply(fzero, 2, max)
maxscore = max(apply(f, 1, sum))
minscore = min(apply(f, 1, sum))
allrisks <- x$getriskestimate(rowSums(f), x, rowSums(f))[[2]]
maxrisk = max(allrisks)
minrisk = min(allrisks)
maxscore = max(apply(fzero, 1, sum))
minscore = min(apply(fzero, 1, sum))
if (!is.nan(minrisk)) {
if (type == "survival") {
maxscore = max(apply(f, 1, sum))
minscore = min(apply(f, 1, sum))
maxrisk <- x$getriskestimate(rowSums(f), x, maxscore)[[2]][1]
minrisk <- x$getriskestimate(rowSums(f), x, minscore)[[2]][1]
minrisk = 1 - minrisk
maxrisk = 1 - maxrisk
thisrisk = 1 - thisrisk
risklabel = paste0("1-", risklabel)
}
}
if (!is.nan(thisrisk)) {
if (thisrisk < riskcutoff) {
riskcolor = "green"
}
else {
riskcolor = "red"
}
}
else {
riskcolor = "orange"
}
d2 = dim(f)[2] - d
if (d2 > 0) {
if (d2 == 1) {
posint = which(max(f[, seq(d + 1, d + d2, 1)]) -
min(f[, seq(d + 1, d + d2, 1)]) != 0)
}
else {
posint = which(apply(f[, seq(d + 1, d + d2, 1)],
2, max) - apply(f[, seq(d + 1, d + d2, 1)], 2,
min) != 0)
}
names2 = rep("", times = d + d2)
names2[1:d] = x$names
for (i in seq(d + 1, dim(f)[2])) {
names2[i] = paste(x$names[x$interactions[i - d, 1]],
" : ", x$names[x$interactions[i - d, 2]])
}
names2 = names2[c(seq(1, d, by = 1), posint + d)]
fpatient = fpatient[c(seq(1, d, by = 1), posint + d)]
fzero = fzero[c(seq(1, d, by = 1), posint + d)]
if (x$sorted == TRUE) {
xorder = order(fpatient)
}
else {
xorder = seq(1, length(fpatient), 1)
}
}
else {
names2 = x$names
}
thisseq = c(length(fpatient):1)
par(mar = c(5 + 2, 8 + 8, 4, 2))
cumsumfpatient = cumsum(fpatient[xorder])
plotgrey = numeric(length = length(fpatient))
plotblack = numeric(length = length(fpatient))
plotgrey2 = numeric(length = length(fpatient))
plotblack2 = numeric(length = length(fpatient))
plotwhite = numeric(length = length(fpatient))
i = 1
if (fpatient[xorder[i]] > 0) {
plotgrey[i] = cumsumfpatient[i]
}
if (fpatient[xorder[i]] < 0) {
plotblack[i] = cumsumfpatient[i]
}
for (i in seq(2, length(fpatient), 1)) {
if (cumsumfpatient[i] == 0) {
if (fpatient[xorder[i]] > 0) {
plotgrey[i] = cumsumfpatient[i - 1]
}
if (fpatient[xorder[i]] < 0) {
plotblack[i] = cumsumfpatient[i - 1]
}
}
if (cumsumfpatient[i] > 0) {
if (fpatient[xorder[i]] > 0) {
plotgrey[i] = cumsumfpatient[i]
plotwhite[i] = cumsumfpatient[i - 1]
}
if (fpatient[xorder[i]] < 0) {
plotblack[i] = cumsumfpatient[i - 1]
plotwhite[i] = cumsumfpatient[i]
}
}
if (cumsumfpatient[i] < 0) {
if (fpatient[xorder[i]] > 0) {
plotgrey[i] = cumsumfpatient[i - 1]
plotwhite[i] = cumsumfpatient[i]
}
if (fpatient[xorder[i]] < 0) {
plotblack[i] = cumsumfpatient[i]
plotwhite[i] = cumsumfpatient[i - 1]
}
}
}
diffsign = c("FALSE", abs(diff(sign(cumsumfpatient))) ==
2)
diffinds = which(diffsign == "TRUE")
for (i in seq(along = diffinds)) {
if (cumsumfpatient[diffinds[i]] > 0 & fpatient[xorder[diffinds[i]]] >
0) {
plotgrey2[diffinds[i]] = cumsumfpatient[diffinds[i] -
1]
plotwhite[diffinds[i]] = 0
}
if (cumsumfpatient[diffinds[i]] < 0 & fpatient[xorder[diffinds[i]]] <
0) {
plotblack2[diffinds[i]] = cumsumfpatient[diffinds[i] -
1]
plotwhite[diffinds[i]] = 0
}
}
plotgrey = plotgrey[thisseq]
plotblack = plotblack[thisseq]
plotwhite = plotwhite[thisseq]
plotgrey2 = plotgrey2[thisseq]
plotblack2 = plotblack2[thisseq]
yaxiscolor = rep("black", length(thisseq))
yaxiscolor[which(cumsumfpatient < min(-0.5, minscore))] = "grey"
if (!is.nan(thisrisk)) {
temp = barplot(c(min(0, cumsumfpatient), 0, min(0, cumsumfpatient),
min(0, cumsumfpatient), plotgrey), horiz = TRUE,
xlim = c(min(0, cumsumfpatient), max(0, maxscore) +
0.5), width = rep(10, length(fpatient) + 4),
axes = FALSE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
barplot(c(maxscore, min(0, cumsumfpatient), maxscore,
min(0, cumsumfpatient), plotgrey2), horiz = TRUE,
xlim = c(min(0, cumsumfpatient), max(0, maxscore) +
0.5), width = rep(10, length(fpatient) + 1),
axes = FALSE, col = c("grey", riskcolor, "grey",
riskcolor, rep("grey", length(fpatient))), add = TRUE,
space = 0, border = NA, names.arg = c(rep("", length(fpatient) +
4)))
if (maxscore >= 0) {
barplot(c(maxscore, thisrisk/maxrisk * maxscore,
maxscore, sum(fpatient), plotblack), horiz = TRUE,
xlim = c(min(0, cumsumfpatient), max(0, maxscore) +
0.5), width = rep(10, length(fpatient) + 1),
axes = FALSE, col = c("grey", riskcolor, "grey",
riskcolor, rep("black", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
barplot(c(maxscore, thisrisk/maxrisk * maxscore,
maxscore, sum(fpatient), plotblack2), horiz = TRUE,
xlim = c(min(0, cumsumfpatient), max(0, maxscore) +
0.5), width = rep(10, length(fpatient) + 1),
axes = FALSE, col = c("grey", riskcolor, "grey",
riskcolor, rep("black", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
barplot(c(0, 0, 0, 0, plotwhite), horiz = TRUE, xlim = c(min(0,
cumsumfpatient), max(0, maxscore) + 0.5), width = rep(10,
length(fpatient) + 1), axes = FALSE, col = c("grey",
riskcolor, "grey", riskcolor, rep("white", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
}
if (maxscore < 0) {
barplot(c(min(0, cumsumfpatient), thisrisk/maxrisk *
maxscore, min(0, cumsumfpatient), sum(fpatient),
plotblack), horiz = TRUE, xlim = c(min(0, cumsumfpatient),
max(0, maxscore) + 0.5), width = rep(10, length(fpatient) +
1), axes = FALSE, col = c("grey", riskcolor,
"grey", riskcolor, rep("black", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
barplot(c(min(0, cumsumfpatient), thisrisk/maxrisk *
maxscore, min(0, cumsumfpatient), sum(fpatient),
plotblack2), horiz = TRUE, xlim = c(min(0, cumsumfpatient),
max(0, maxscore) + 0.5), width = rep(10, length(fpatient) +
1), axes = FALSE, col = c("grey", riskcolor,
"grey", riskcolor, rep("black", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
barplot(c(maxscore, min(0, cumsumfpatient) + (thisrisk)/maxrisk *
abs(maxscore - min(0, cumsumfpatient)), maxscore,
0, plotwhite), horiz = TRUE, xlim = c(min(0,
cumsumfpatient), max(0, maxscore) + 0.5), width = rep(10,
length(fpatient) + 1), axes = FALSE, col = c("white",
"white", "white", "white", rep("white", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
}
if (sum(fpatient) < 0) {
barplot(c(0, 0, 0, sum(fpatient), numeric(length = length(plotwhite))),
horiz = TRUE, xlim = c(min(0, cumsumfpatient),
max(0, maxscore) + 0.5), width = rep(10, length(fpatient) +
1), axes = FALSE, col = c("grey", "white",
"grey", "white", rep("white", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
}
lines(c(0, 0), c(temp[4], temp[length(temp)]) + diff(temp)[1]/2,
lty = 2)
if (nchar(risklabel) < 20) {
axis(side = 2, at = c(temp), labels = c("", risklabel,
"", "Score", names2[xorder[thisseq]]), las = 2,
lty = "blank", font = 2, cex.axis = 1.5)
}
else {
axis(side = 2, at = c(temp), labels = c("", "Risk",
"", "Score", names2[xorder[thisseq]]), las = 2,
lty = "blank", font = 2, cex.axis = 1.5)
mtext(paste("Risk equals", risklabel), col = "black",
font = 2, side = 1, line = 2, adj = 0)
}
xrange = c(min(0, minscore), max(0, maxscore) + 0.5)
xrange[1] = ceiling(xrange[1])
xrange[2] = floor(xrange[2])
if ("colplotpref" %in% names(x)) {
axis(side = 3)
}
else {
axis(side = 3, at = seq(xrange[1], xrange[2], 1))
}
lines(c(min(0, cumsumfpatient), min(0, cumsumfpatient)),
c(temp[1] - diff(temp)[1]/2, temp[length(temp)] +
diff(temp)[1]/2), lty = 1)
for (i in seq(along = seq(1, length(fpatient)))) {
color = "dodgerblue"
if (xorder[i] <= d) {
if (x$vartypes[xorder[i]] == "cont") {
text(min(0, cumsumfpatient), temp[thisseq[i] +
4], round(obs[xorder[i]], 2), col = color,
pos = 4, font = 4, srt = 20)
}
else {
if ("glm" %in% names(x)) {
if (class(x$x[, i]) == "factor") {
text(min(0, cumsumfpatient), temp[thisseq[i] +
4], x$levelnames[[2]][[xorder[i]]][as.integer(obs[xorder[i]])],
col = color, pos = 4, font = 4, srt = 20)
}
else {
text(min(0, cumsumfpatient), temp[thisseq[i] +
4], obs[xorder[i]], col = color, pos = 4,
font = 4, srt = 20)
}
}
else {
text(min(0, cumsumfpatient), temp[thisseq[i] +
4], x$levelnames[[1]][[xorder[i]]][[match(unlist(obs[xorder[i]]),
x$levelnames[[2]][[xorder[i]]])]], col = color,
pos = 4, font = 4, srt = 20)
}
}
}
if (maxscore >= 0) {
if (cumsumfpatient[i] > maxscore) {
text(maxscore, temp[thisseq[i] + 4] - 3, round(fpatient[xorder[i]],
2), col = "black", pos = 2, font = 2)
}
else if (cumsumfpatient[i] < min(0, minscore)) {
text(min(0, cumsumfpatient), temp[thisseq[i] +
4] - 3, round(fpatient[xorder[i]], 2), col = "grey",
pos = 4, font = 2)
}
else {
text(cumsumfpatient[i], temp[thisseq[i] + 4] -
3, round(fpatient[xorder[i]], 2), col = "grey",
pos = 4, font = 2)
}
}
else {
if (cumsumfpatient[i] > maxscore) {
text(fpatient[xorder[i]], temp[thisseq[i] +
4] - 3, round(fpatient[xorder[i]], 2), col = "black",
pos = 2, font = 2)
}
else if (cumsumfpatient[i] < min(0, minscore)) {
text(min(0, cumsumfpatient), temp[thisseq[i] +
4] - 3, round(fpatient[xorder[i]], 2), col = "grey",
pos = 4, font = 2)
}
else {
text(cumsumfpatient[i], temp[thisseq[i] + 4] -
3, round(fpatient[xorder[i]], 2), col = "grey",
pos = 4, font = 2)
}
}
lines(c(cumsumfpatient[i], cumsumfpatient[i]), c(temp[thisseq[i] +
4], temp[thisseq[i] + 3]) + diff(temp)[1]/2)
lines(c(cumsumfpatient[i], cumsumfpatient[i + 1]),
c(temp[thisseq[i] + 3], temp[thisseq[i] + 3]) +
diff(temp)[1]/2)
}
if (sum(fpatient) < 0.9 * maxscore & sum(fpatient) >=
minscore) {
text(sum(fpatient), temp[4], round(sum(fpatient),
2), col = riskcolor, font = 2, pos = 4)
}
else if (sum(fpatient) >= 0.9 * maxscore) {
text(maxscore, temp[4], round(sum(fpatient), 2),
col = "black", font = 2, pos = 2)
}
else if (sum(fpatient) < minscore & sum(fpatient) > min(cumsumfpatient)) {
text(sum(fpatient), temp[4], round(sum(fpatient),
2), col = riskcolor, font = 2, pos = 4)
}
else if (sum(fpatient) <= min(cumsumfpatient)) {
text(min(0, cumsumfpatient), temp[4], round(sum(fpatient),
2), col = "black", font = 2, pos = 4)
}
text(min(0, cumsumfpatient), temp[3], "max. score", col = "black",
font = 3, pos = 4)
if (maxscore >= 0) {
text(maxscore, temp[3], round(maxscore, 2), col = "black",
font = 2, pos = 2)
}
else {
text(min(0, cumsumfpatient), temp[3], substitute(bold(phantom("max. score ") *
a), list(a = round(maxscore, 2))), col = "black",
font = 2, pos = 4)
}
if (maxscore >= 0) {
if (sum(fpatient) < maxscore & sum(fpatient) > minscore) {
text(thisrisk/maxrisk * maxscore, temp[2], round(thisrisk,
2), col = riskcolor, font = 2, pos = 4)
}
else if (sum(fpatient) >= maxscore) {
text(maxscore, temp[2], round(thisrisk, 2), col = "black",
font = 2, pos = 2)
}
else if (sum(fpatient) <= minscore & sum(fpatient) >
min(cumsumfpatient)) {
text(thisrisk/maxrisk * maxscore, temp[2], round(thisrisk,
2), col = riskcolor, font = 2, pos = 4)
}
else if (sum(fpatient) <= min(cumsumfpatient)) {
text(min(0, cumsumfpatient), temp[2], round(thisrisk,
2), col = "black", font = 2, pos = 4)
}
}
else {
if (sum(fpatient) < maxscore & sum(fpatient) > minscore) {
text(min(0, cumsumfpatient) + (thisrisk)/maxrisk *
abs(maxscore - min(0, cumsumfpatient)), temp[2],
round(thisrisk, 2), col = riskcolor, font = 2,
pos = 4)
}
else if (sum(fpatient) >= maxscore) {
text(maxscore, temp[2], round(thisrisk, 2), col = "black",
font = 2, pos = 2)
}
else if (sum(fpatient) <= minscore & sum(fpatient) >
min(cumsumfpatient)) {
text(thisrisk/maxrisk * maxscore, temp[2], round(thisrisk,
2), col = riskcolor, font = 2, pos = 4)
}
else if (sum(fpatient) <= min(cumsumfpatient)) {
text(min(0, cumsumfpatient), temp[2], round(thisrisk,
2), col = "black", font = 2, pos = 4)
}
}
text(min(0, cumsumfpatient), temp[1], "max. risk", col = "black",
font = 3, pos = 4)
if (maxscore >= 0) {
text(maxscore, temp[1], round(maxrisk, 2), col = "black",
font = 2, pos = 2)
}
else {
text(min(0, cumsumfpatient), temp[1], substitute(bold(phantom("max. risk ") *
a), list(a = round(maxrisk, 2))), col = "black",
font = 2, pos = 4)
}
}
else {
temp = barplot(c(min(cumsumfpatient), min(cumsumfpatient),
plotgrey), horiz = TRUE, xlim = c(min(0, cumsumfpatient),
max(maxscore) + 0.5), width = rep(10, length(fpatient) +
2), axes = FALSE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 2)))
barplot(c(maxscore, min(cumsumfpatient), plotgrey2),
horiz = TRUE, xlim = c(min(0, cumsumfpatient), max(maxscore) +
0.5), width = rep(10, length(fpatient) - 1),
axes = FALSE, col = c("grey", riskcolor, rep("grey",
length(fpatient))), add = TRUE, space = 0, border = NA,
names.arg = c(rep("", length(fpatient) + 2)))
barplot(c(maxscore, sum(fpatient), plotblack), horiz = TRUE,
xlim = c(min(0, cumsumfpatient), max(maxscore) +
0.5), width = rep(10, length(fpatient) + 1),
axes = FALSE, col = c("grey", riskcolor, rep("black",
length(fpatient))), add = TRUE, space = 0, border = NA,
names.arg = c(rep("", length(fpatient) + 2)))
barplot(c(maxscore, sum(fpatient), plotblack2), horiz = TRUE,
xlim = c(min(0, cumsumfpatient), max(maxscore) +
0.5), width = rep(10, length(fpatient) + 1),
axes = FALSE, col = c("grey", riskcolor, rep("black",
length(fpatient))), add = TRUE, space = 0, border = NA,
names.arg = c(rep("", length(fpatient) + 2)))
barplot(c(0, 0, plotwhite), horiz = TRUE, xlim = c(min(0,
cumsumfpatient), max(maxscore) + 0.5), width = rep(10,
length(fpatient) + 1), axes = FALSE, col = c(rep("white",
length(fpatient))), add = TRUE, space = 0, border = NA,
names.arg = c(rep("", length(fpatient) + 2)))
if (sum(fpatient) < 0) {
barplot(c(0, sum(fpatient), numeric(length = length(plotwhite))),
horiz = TRUE, xlim = c(min(0, cumsumfpatient),
max(maxscore) + 0.5), width = rep(10, length(fpatient) +
1), axes = FALSE, col = c("grey", "white",
rep("white", length(fpatient))), add = TRUE,
space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 2)))
}
lines(c(0, 0), c(temp[2], temp[length(temp)]) + diff(temp)[1]/2,
lty = 2)
axis(side = 2, at = c(temp), labels = c("", "Score",
names2[xorder[thisseq]]), las = 2, lty = "blank",
font = 2, cex.axis = 1.5)
xrange = c(min(0, cumsumfpatient), max(maxscore) + 0.5)
xrange[1] = ceiling(xrange[1])
xrange[2] = floor(xrange[2])
axis(side = 3, at = seq(xrange[1], xrange[2], 1))
lines(c(min(0, cumsumfpatient), min(0, cumsumfpatient)),
c(temp[1] - diff(temp)[1]/2, temp[length(temp)] +
diff(temp)[1]/2), lty = 1)
for (i in seq(along = seq(1, length(fpatient)))) {
color = "dodgerblue"
if (xorder[i] <= d) {
if (x$vartypes[xorder[i]] == "cont") {
text(min(0, cumsumfpatient), temp[thisseq[i] +
2], round(obs[xorder[i]], 2), col = color,
pos = 4, font = 4, srt = 20)
}
else {
if ("glm" %in% names(x)) {
if (class(x$x[, i]) == "factor") {
text(min(0, cumsumfpatient), temp[thisseq[i] +
2], x$levelnames[[2]][[xorder[i]]][as.integer(obs[xorder[i]])],
col = color, pos = 4, font = 4, srt = 20)
}
else {
text(min(0, cumsumfpatient), temp[thisseq[i] +
2], obs[xorder[i]], col = color, pos = 4,
font = 4, srt = 20)
}
}
else {
text(min(0, cumsumfpatient), temp[thisseq[i] +
2], x$levelnames[[1]][[xorder[i]]][[match(unlist(obs[xorder[i]]),
x$levelnames[[2]][[xorder[i]]])]], col = color,
pos = 4, font = 4, srt = 20)
}
}
}
if (cumsumfpatient[i] > maxscore) {
text(maxscore, temp[thisseq[i] + 2] - 3, round(fpatient[xorder[i]],
2), col = "black", pos = 2, font = 2)
}
else if (cumsumfpatient[i] < min(0, cumsumfpatient)) {
text(min(0, cumsumfpatient), temp[thisseq[i] +
2] - 3, round(fpatient[xorder[i]], 2), col = "grey",
pos = 4, font = 2)
}
else {
text(cumsumfpatient[i], temp[thisseq[i] + 2] -
3, round(fpatient[xorder[i]], 2), col = "grey",
pos = 4, font = 2)
}
lines(c(cumsumfpatient[i], cumsumfpatient[i]), c(temp[thisseq[i] +
2], temp[thisseq[i] + 1]) + diff(temp)[1]/2)
lines(c(cumsumfpatient[i], cumsumfpatient[i + 1]),
c(temp[thisseq[i] + 1], temp[thisseq[i] + 1]) +
diff(temp)[1]/2)
}
if (sum(fpatient) < 0.9 * maxscore & sum(fpatient) >=
min(cumsumfpatient)) {
text(sum(fpatient), temp[2], round(sum(fpatient),
2), col = riskcolor, font = 2, pos = 4)
}
else if (sum(fpatient) >= 0.9 * maxscore) {
text(maxscore, temp[2], round(sum(fpatient), 2),
col = "black", font = 2, pos = 2)
}
else if (sum(fpatient) < min(cumsumfpatient)) {
text(min(0, cumsumfpatient), temp[2], round(sum(fpatient),
2), col = "black", font = 2, pos = 2)
}
text(min(0, cumsumfpatient), temp[1], "max. score", col = "black",
font = 3, pos = 4)
text(maxscore, temp[1], round(maxscore, 2), col = "black",
font = 2, pos = 2)
mtext(paste("Score equals", risklabel), col = "black",
font = 2, side = 1, line = 2, adj = 0)
}
x0 = ceiling(par("usr")[1])
unit = (par("usr")[2] - par("usr")[1])/7.5
mtext(expression(bold(phantom("legend of reported figures: ")) *
"blue - predictor value"), col = color, font = 2, side = 1,
line = 0, adj = 0)
mtext(expression(bold("legend of reported figures: ") * phantom("blue - predictor value")),
col = "black", font = 2, side = 1, line = 0, adj = 0)
mtext(expression(bold(phantom("legend of reported figures: ")) *
"gray - contribution to score"), col = "grey", font = 2,
side = 1, line = 1, adj = 0)
for (i in seq(1, length(thisseq), 1)) {
if (!is.nan(thisrisk)) {
axis(side = 2, at = c(temp[i + 4]), labels = names2[xorder[thisseq]][i],
las = 2, lty = "blank", font = 2, cex.axis = 1.5,
col.axis = yaxiscolor[thisseq][i])
}
else {
axis(side = 2, at = c(temp[i + 2]), labels = names2[xorder[thisseq]][i],
las = 2, lty = "blank", font = 2, cex.axis = 1.5,
col.axis = yaxiscolor[thisseq][i])
}
}
garbage <- dev.off()
}
<bytecode: 0x794edf8>
<environment: namespace:VRPM>
--- function search by body ---
Function ccchart.default in namespace VRPM has this body.
----------- END OF FAILURE REPORT --------------
Error in if (!class(fpatient) %in% c("vector", "matrix")) { :
the condition has length > 1
Calls: ccchart -> ccchart.glm -> ccchart -> ccchart.default
Execution halted
Flavor: r-devel-linux-x86_64-fedora-clang
Version: 1.2
Check: examples
Result: ERROR
Running examples in ‘VRPM-Ex.R’ failed
The error most likely occurred in:
> ### Name: ccchart
> ### Title: Cumulative contribution chart.
> ### Aliases: ccchart ccchart.coxph ccchart.default ccchart.glm ccchart.ksvm
> ### ccchart.multinom
>
> ### ** Examples
>
> #### logistic regression
> mydata <- read.csv("https://stats.idre.ucla.edu/stat/data/binary.csv")
> mydata$rank <- factor(mydata$rank)
> fit <- glm(admit ~ gre + gpa + rank, data = mydata, family = "binomial")
> patient1=data.frame(gre=386,gpa=3.58,rank=3)
> ccchart(fit,obs=patient1,filename="ccchart1")
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
VRPM
--- call from context ---
ccchart.default(x2, obs = obs, filename, zerolevel, risklabel = x2$risklabel,
riskcutoff, type = type, sorted, time, xmin, xmax)
--- call from argument ---
if (!class(fpatient) %in% c("vector", "matrix")) {
fpatient = as.matrix(fpatient)
}
--- R stacktrace ---
where 1: ccchart.default(x2, obs = obs, filename, zerolevel, risklabel = x2$risklabel,
riskcutoff, type = type, sorted, time, xmin, xmax)
where 2: ccchart(x2, obs = obs, filename, zerolevel, risklabel = x2$risklabel,
riskcutoff, type = type, sorted, time, xmin, xmax)
where 3: ccchart.glm(fit, obs = patient1, filename = "ccchart1")
where 4: ccchart(fit, obs = patient1, filename = "ccchart1")
--- value of length: 2 type: logical ---
[1] FALSE TRUE
--- function from context ---
function (x, obs, filename, zerolevel = "zero", risklabel = "Estimated risk",
riskcutoff = 0.1, type = "logistic", sorted = FALSE, time,
xmin, xmax)
{
x$sorted = sorted
x$zerolevel = zerolevel
x <- check_data(x, type = "ccchart")
if (dim(x$x)[2] != length(obs)) {
stop("The dimension of the given data set does not match with the length of obs. Please adapt in order to continue.")
}
x2 = precolplot(x, filename, coloroptions = 1, zerolevel = zerolevel,
risklabel = risklabel, adverse = FALSE, obs = obs, xmin,
xmax)
f = x2$f
fpatient = x2$fpatient
fzero = x2$fzero
d = x2$d
n = x2$n
thisrisk = x2$thisrisk
devheight = dim(f)[2] + 2
devwidth = 10
png(paste0(ifelse(hasArg(filename), filename, "ccchart"),
".png"), width = devwidth, height = devheight, units = "in",
res = 120)
if (!class(fpatient) %in% c("vector", "matrix")) {
fpatient = as.matrix(fpatient)
}
if (x$sorted == TRUE) {
xorder = order(fpatient)
}
else {
xorder = seq(1, length(fpatient), 1)
}
maxdata = apply(fzero, 2, max)
maxscore = max(apply(f, 1, sum))
minscore = min(apply(f, 1, sum))
allrisks <- x$getriskestimate(rowSums(f), x, rowSums(f))[[2]]
maxrisk = max(allrisks)
minrisk = min(allrisks)
maxscore = max(apply(fzero, 1, sum))
minscore = min(apply(fzero, 1, sum))
if (!is.nan(minrisk)) {
if (type == "survival") {
maxscore = max(apply(f, 1, sum))
minscore = min(apply(f, 1, sum))
maxrisk <- x$getriskestimate(rowSums(f), x, maxscore)[[2]][1]
minrisk <- x$getriskestimate(rowSums(f), x, minscore)[[2]][1]
minrisk = 1 - minrisk
maxrisk = 1 - maxrisk
thisrisk = 1 - thisrisk
risklabel = paste0("1-", risklabel)
}
}
if (!is.nan(thisrisk)) {
if (thisrisk < riskcutoff) {
riskcolor = "green"
}
else {
riskcolor = "red"
}
}
else {
riskcolor = "orange"
}
d2 = dim(f)[2] - d
if (d2 > 0) {
if (d2 == 1) {
posint = which(max(f[, seq(d + 1, d + d2, 1)]) -
min(f[, seq(d + 1, d + d2, 1)]) != 0)
}
else {
posint = which(apply(f[, seq(d + 1, d + d2, 1)],
2, max) - apply(f[, seq(d + 1, d + d2, 1)], 2,
min) != 0)
}
names2 = rep("", times = d + d2)
names2[1:d] = x$names
for (i in seq(d + 1, dim(f)[2])) {
names2[i] = paste(x$names[x$interactions[i - d, 1]],
" : ", x$names[x$interactions[i - d, 2]])
}
names2 = names2[c(seq(1, d, by = 1), posint + d)]
fpatient = fpatient[c(seq(1, d, by = 1), posint + d)]
fzero = fzero[c(seq(1, d, by = 1), posint + d)]
if (x$sorted == TRUE) {
xorder = order(fpatient)
}
else {
xorder = seq(1, length(fpatient), 1)
}
}
else {
names2 = x$names
}
thisseq = c(length(fpatient):1)
par(mar = c(5 + 2, 8 + 8, 4, 2))
cumsumfpatient = cumsum(fpatient[xorder])
plotgrey = numeric(length = length(fpatient))
plotblack = numeric(length = length(fpatient))
plotgrey2 = numeric(length = length(fpatient))
plotblack2 = numeric(length = length(fpatient))
plotwhite = numeric(length = length(fpatient))
i = 1
if (fpatient[xorder[i]] > 0) {
plotgrey[i] = cumsumfpatient[i]
}
if (fpatient[xorder[i]] < 0) {
plotblack[i] = cumsumfpatient[i]
}
for (i in seq(2, length(fpatient), 1)) {
if (cumsumfpatient[i] == 0) {
if (fpatient[xorder[i]] > 0) {
plotgrey[i] = cumsumfpatient[i - 1]
}
if (fpatient[xorder[i]] < 0) {
plotblack[i] = cumsumfpatient[i - 1]
}
}
if (cumsumfpatient[i] > 0) {
if (fpatient[xorder[i]] > 0) {
plotgrey[i] = cumsumfpatient[i]
plotwhite[i] = cumsumfpatient[i - 1]
}
if (fpatient[xorder[i]] < 0) {
plotblack[i] = cumsumfpatient[i - 1]
plotwhite[i] = cumsumfpatient[i]
}
}
if (cumsumfpatient[i] < 0) {
if (fpatient[xorder[i]] > 0) {
plotgrey[i] = cumsumfpatient[i - 1]
plotwhite[i] = cumsumfpatient[i]
}
if (fpatient[xorder[i]] < 0) {
plotblack[i] = cumsumfpatient[i]
plotwhite[i] = cumsumfpatient[i - 1]
}
}
}
diffsign = c("FALSE", abs(diff(sign(cumsumfpatient))) ==
2)
diffinds = which(diffsign == "TRUE")
for (i in seq(along = diffinds)) {
if (cumsumfpatient[diffinds[i]] > 0 & fpatient[xorder[diffinds[i]]] >
0) {
plotgrey2[diffinds[i]] = cumsumfpatient[diffinds[i] -
1]
plotwhite[diffinds[i]] = 0
}
if (cumsumfpatient[diffinds[i]] < 0 & fpatient[xorder[diffinds[i]]] <
0) {
plotblack2[diffinds[i]] = cumsumfpatient[diffinds[i] -
1]
plotwhite[diffinds[i]] = 0
}
}
plotgrey = plotgrey[thisseq]
plotblack = plotblack[thisseq]
plotwhite = plotwhite[thisseq]
plotgrey2 = plotgrey2[thisseq]
plotblack2 = plotblack2[thisseq]
yaxiscolor = rep("black", length(thisseq))
yaxiscolor[which(cumsumfpatient < min(-0.5, minscore))] = "grey"
if (!is.nan(thisrisk)) {
temp = barplot(c(min(0, cumsumfpatient), 0, min(0, cumsumfpatient),
min(0, cumsumfpatient), plotgrey), horiz = TRUE,
xlim = c(min(0, cumsumfpatient), max(0, maxscore) +
0.5), width = rep(10, length(fpatient) + 4),
axes = FALSE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
barplot(c(maxscore, min(0, cumsumfpatient), maxscore,
min(0, cumsumfpatient), plotgrey2), horiz = TRUE,
xlim = c(min(0, cumsumfpatient), max(0, maxscore) +
0.5), width = rep(10, length(fpatient) + 1),
axes = FALSE, col = c("grey", riskcolor, "grey",
riskcolor, rep("grey", length(fpatient))), add = TRUE,
space = 0, border = NA, names.arg = c(rep("", length(fpatient) +
4)))
if (maxscore >= 0) {
barplot(c(maxscore, thisrisk/maxrisk * maxscore,
maxscore, sum(fpatient), plotblack), horiz = TRUE,
xlim = c(min(0, cumsumfpatient), max(0, maxscore) +
0.5), width = rep(10, length(fpatient) + 1),
axes = FALSE, col = c("grey", riskcolor, "grey",
riskcolor, rep("black", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
barplot(c(maxscore, thisrisk/maxrisk * maxscore,
maxscore, sum(fpatient), plotblack2), horiz = TRUE,
xlim = c(min(0, cumsumfpatient), max(0, maxscore) +
0.5), width = rep(10, length(fpatient) + 1),
axes = FALSE, col = c("grey", riskcolor, "grey",
riskcolor, rep("black", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
barplot(c(0, 0, 0, 0, plotwhite), horiz = TRUE, xlim = c(min(0,
cumsumfpatient), max(0, maxscore) + 0.5), width = rep(10,
length(fpatient) + 1), axes = FALSE, col = c("grey",
riskcolor, "grey", riskcolor, rep("white", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
}
if (maxscore < 0) {
barplot(c(min(0, cumsumfpatient), thisrisk/maxrisk *
maxscore, min(0, cumsumfpatient), sum(fpatient),
plotblack), horiz = TRUE, xlim = c(min(0, cumsumfpatient),
max(0, maxscore) + 0.5), width = rep(10, length(fpatient) +
1), axes = FALSE, col = c("grey", riskcolor,
"grey", riskcolor, rep("black", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
barplot(c(min(0, cumsumfpatient), thisrisk/maxrisk *
maxscore, min(0, cumsumfpatient), sum(fpatient),
plotblack2), horiz = TRUE, xlim = c(min(0, cumsumfpatient),
max(0, maxscore) + 0.5), width = rep(10, length(fpatient) +
1), axes = FALSE, col = c("grey", riskcolor,
"grey", riskcolor, rep("black", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
barplot(c(maxscore, min(0, cumsumfpatient) + (thisrisk)/maxrisk *
abs(maxscore - min(0, cumsumfpatient)), maxscore,
0, plotwhite), horiz = TRUE, xlim = c(min(0,
cumsumfpatient), max(0, maxscore) + 0.5), width = rep(10,
length(fpatient) + 1), axes = FALSE, col = c("white",
"white", "white", "white", rep("white", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
}
if (sum(fpatient) < 0) {
barplot(c(0, 0, 0, sum(fpatient), numeric(length = length(plotwhite))),
horiz = TRUE, xlim = c(min(0, cumsumfpatient),
max(0, maxscore) + 0.5), width = rep(10, length(fpatient) +
1), axes = FALSE, col = c("grey", "white",
"grey", "white", rep("white", length(fpatient))),
add = TRUE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 4)))
}
lines(c(0, 0), c(temp[4], temp[length(temp)]) + diff(temp)[1]/2,
lty = 2)
if (nchar(risklabel) < 20) {
axis(side = 2, at = c(temp), labels = c("", risklabel,
"", "Score", names2[xorder[thisseq]]), las = 2,
lty = "blank", font = 2, cex.axis = 1.5)
}
else {
axis(side = 2, at = c(temp), labels = c("", "Risk",
"", "Score", names2[xorder[thisseq]]), las = 2,
lty = "blank", font = 2, cex.axis = 1.5)
mtext(paste("Risk equals", risklabel), col = "black",
font = 2, side = 1, line = 2, adj = 0)
}
xrange = c(min(0, minscore), max(0, maxscore) + 0.5)
xrange[1] = ceiling(xrange[1])
xrange[2] = floor(xrange[2])
if ("colplotpref" %in% names(x)) {
axis(side = 3)
}
else {
axis(side = 3, at = seq(xrange[1], xrange[2], 1))
}
lines(c(min(0, cumsumfpatient), min(0, cumsumfpatient)),
c(temp[1] - diff(temp)[1]/2, temp[length(temp)] +
diff(temp)[1]/2), lty = 1)
for (i in seq(along = seq(1, length(fpatient)))) {
color = "dodgerblue"
if (xorder[i] <= d) {
if (x$vartypes[xorder[i]] == "cont") {
text(min(0, cumsumfpatient), temp[thisseq[i] +
4], round(obs[xorder[i]], 2), col = color,
pos = 4, font = 4, srt = 20)
}
else {
if ("glm" %in% names(x)) {
if (class(x$x[, i]) == "factor") {
text(min(0, cumsumfpatient), temp[thisseq[i] +
4], x$levelnames[[2]][[xorder[i]]][as.integer(obs[xorder[i]])],
col = color, pos = 4, font = 4, srt = 20)
}
else {
text(min(0, cumsumfpatient), temp[thisseq[i] +
4], obs[xorder[i]], col = color, pos = 4,
font = 4, srt = 20)
}
}
else {
text(min(0, cumsumfpatient), temp[thisseq[i] +
4], x$levelnames[[1]][[xorder[i]]][[match(unlist(obs[xorder[i]]),
x$levelnames[[2]][[xorder[i]]])]], col = color,
pos = 4, font = 4, srt = 20)
}
}
}
if (maxscore >= 0) {
if (cumsumfpatient[i] > maxscore) {
text(maxscore, temp[thisseq[i] + 4] - 3, round(fpatient[xorder[i]],
2), col = "black", pos = 2, font = 2)
}
else if (cumsumfpatient[i] < min(0, minscore)) {
text(min(0, cumsumfpatient), temp[thisseq[i] +
4] - 3, round(fpatient[xorder[i]], 2), col = "grey",
pos = 4, font = 2)
}
else {
text(cumsumfpatient[i], temp[thisseq[i] + 4] -
3, round(fpatient[xorder[i]], 2), col = "grey",
pos = 4, font = 2)
}
}
else {
if (cumsumfpatient[i] > maxscore) {
text(fpatient[xorder[i]], temp[thisseq[i] +
4] - 3, round(fpatient[xorder[i]], 2), col = "black",
pos = 2, font = 2)
}
else if (cumsumfpatient[i] < min(0, minscore)) {
text(min(0, cumsumfpatient), temp[thisseq[i] +
4] - 3, round(fpatient[xorder[i]], 2), col = "grey",
pos = 4, font = 2)
}
else {
text(cumsumfpatient[i], temp[thisseq[i] + 4] -
3, round(fpatient[xorder[i]], 2), col = "grey",
pos = 4, font = 2)
}
}
lines(c(cumsumfpatient[i], cumsumfpatient[i]), c(temp[thisseq[i] +
4], temp[thisseq[i] + 3]) + diff(temp)[1]/2)
lines(c(cumsumfpatient[i], cumsumfpatient[i + 1]),
c(temp[thisseq[i] + 3], temp[thisseq[i] + 3]) +
diff(temp)[1]/2)
}
if (sum(fpatient) < 0.9 * maxscore & sum(fpatient) >=
minscore) {
text(sum(fpatient), temp[4], round(sum(fpatient),
2), col = riskcolor, font = 2, pos = 4)
}
else if (sum(fpatient) >= 0.9 * maxscore) {
text(maxscore, temp[4], round(sum(fpatient), 2),
col = "black", font = 2, pos = 2)
}
else if (sum(fpatient) < minscore & sum(fpatient) > min(cumsumfpatient)) {
text(sum(fpatient), temp[4], round(sum(fpatient),
2), col = riskcolor, font = 2, pos = 4)
}
else if (sum(fpatient) <= min(cumsumfpatient)) {
text(min(0, cumsumfpatient), temp[4], round(sum(fpatient),
2), col = "black", font = 2, pos = 4)
}
text(min(0, cumsumfpatient), temp[3], "max. score", col = "black",
font = 3, pos = 4)
if (maxscore >= 0) {
text(maxscore, temp[3], round(maxscore, 2), col = "black",
font = 2, pos = 2)
}
else {
text(min(0, cumsumfpatient), temp[3], substitute(bold(phantom("max. score ") *
a), list(a = round(maxscore, 2))), col = "black",
font = 2, pos = 4)
}
if (maxscore >= 0) {
if (sum(fpatient) < maxscore & sum(fpatient) > minscore) {
text(thisrisk/maxrisk * maxscore, temp[2], round(thisrisk,
2), col = riskcolor, font = 2, pos = 4)
}
else if (sum(fpatient) >= maxscore) {
text(maxscore, temp[2], round(thisrisk, 2), col = "black",
font = 2, pos = 2)
}
else if (sum(fpatient) <= minscore & sum(fpatient) >
min(cumsumfpatient)) {
text(thisrisk/maxrisk * maxscore, temp[2], round(thisrisk,
2), col = riskcolor, font = 2, pos = 4)
}
else if (sum(fpatient) <= min(cumsumfpatient)) {
text(min(0, cumsumfpatient), temp[2], round(thisrisk,
2), col = "black", font = 2, pos = 4)
}
}
else {
if (sum(fpatient) < maxscore & sum(fpatient) > minscore) {
text(min(0, cumsumfpatient) + (thisrisk)/maxrisk *
abs(maxscore - min(0, cumsumfpatient)), temp[2],
round(thisrisk, 2), col = riskcolor, font = 2,
pos = 4)
}
else if (sum(fpatient) >= maxscore) {
text(maxscore, temp[2], round(thisrisk, 2), col = "black",
font = 2, pos = 2)
}
else if (sum(fpatient) <= minscore & sum(fpatient) >
min(cumsumfpatient)) {
text(thisrisk/maxrisk * maxscore, temp[2], round(thisrisk,
2), col = riskcolor, font = 2, pos = 4)
}
else if (sum(fpatient) <= min(cumsumfpatient)) {
text(min(0, cumsumfpatient), temp[2], round(thisrisk,
2), col = "black", font = 2, pos = 4)
}
}
text(min(0, cumsumfpatient), temp[1], "max. risk", col = "black",
font = 3, pos = 4)
if (maxscore >= 0) {
text(maxscore, temp[1], round(maxrisk, 2), col = "black",
font = 2, pos = 2)
}
else {
text(min(0, cumsumfpatient), temp[1], substitute(bold(phantom("max. risk ") *
a), list(a = round(maxrisk, 2))), col = "black",
font = 2, pos = 4)
}
}
else {
temp = barplot(c(min(cumsumfpatient), min(cumsumfpatient),
plotgrey), horiz = TRUE, xlim = c(min(0, cumsumfpatient),
max(maxscore) + 0.5), width = rep(10, length(fpatient) +
2), axes = FALSE, space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 2)))
barplot(c(maxscore, min(cumsumfpatient), plotgrey2),
horiz = TRUE, xlim = c(min(0, cumsumfpatient), max(maxscore) +
0.5), width = rep(10, length(fpatient) - 1),
axes = FALSE, col = c("grey", riskcolor, rep("grey",
length(fpatient))), add = TRUE, space = 0, border = NA,
names.arg = c(rep("", length(fpatient) + 2)))
barplot(c(maxscore, sum(fpatient), plotblack), horiz = TRUE,
xlim = c(min(0, cumsumfpatient), max(maxscore) +
0.5), width = rep(10, length(fpatient) + 1),
axes = FALSE, col = c("grey", riskcolor, rep("black",
length(fpatient))), add = TRUE, space = 0, border = NA,
names.arg = c(rep("", length(fpatient) + 2)))
barplot(c(maxscore, sum(fpatient), plotblack2), horiz = TRUE,
xlim = c(min(0, cumsumfpatient), max(maxscore) +
0.5), width = rep(10, length(fpatient) + 1),
axes = FALSE, col = c("grey", riskcolor, rep("black",
length(fpatient))), add = TRUE, space = 0, border = NA,
names.arg = c(rep("", length(fpatient) + 2)))
barplot(c(0, 0, plotwhite), horiz = TRUE, xlim = c(min(0,
cumsumfpatient), max(maxscore) + 0.5), width = rep(10,
length(fpatient) + 1), axes = FALSE, col = c(rep("white",
length(fpatient))), add = TRUE, space = 0, border = NA,
names.arg = c(rep("", length(fpatient) + 2)))
if (sum(fpatient) < 0) {
barplot(c(0, sum(fpatient), numeric(length = length(plotwhite))),
horiz = TRUE, xlim = c(min(0, cumsumfpatient),
max(maxscore) + 0.5), width = rep(10, length(fpatient) +
1), axes = FALSE, col = c("grey", "white",
rep("white", length(fpatient))), add = TRUE,
space = 0, border = NA, names.arg = c(rep("",
length(fpatient) + 2)))
}
lines(c(0, 0), c(temp[2], temp[length(temp)]) + diff(temp)[1]/2,
lty = 2)
axis(side = 2, at = c(temp), labels = c("", "Score",
names2[xorder[thisseq]]), las = 2, lty = "blank",
font = 2, cex.axis = 1.5)
xrange = c(min(0, cumsumfpatient), max(maxscore) + 0.5)
xrange[1] = ceiling(xrange[1])
xrange[2] = floor(xrange[2])
axis(side = 3, at = seq(xrange[1], xrange[2], 1))
lines(c(min(0, cumsumfpatient), min(0, cumsumfpatient)),
c(temp[1] - diff(temp)[1]/2, temp[length(temp)] +
diff(temp)[1]/2), lty = 1)
for (i in seq(along = seq(1, length(fpatient)))) {
color = "dodgerblue"
if (xorder[i] <= d) {
if (x$vartypes[xorder[i]] == "cont") {
text(min(0, cumsumfpatient), temp[thisseq[i] +
2], round(obs[xorder[i]], 2), col = color,
pos = 4, font = 4, srt = 20)
}
else {
if ("glm" %in% names(x)) {
if (class(x$x[, i]) == "factor") {
text(min(0, cumsumfpatient), temp[thisseq[i] +
2], x$levelnames[[2]][[xorder[i]]][as.integer(obs[xorder[i]])],
col = color, pos = 4, font = 4, srt = 20)
}
else {
text(min(0, cumsumfpatient), temp[thisseq[i] +
2], obs[xorder[i]], col = color, pos = 4,
font = 4, srt = 20)
}
}
else {
text(min(0, cumsumfpatient), temp[thisseq[i] +
2], x$levelnames[[1]][[xorder[i]]][[match(unlist(obs[xorder[i]]),
x$levelnames[[2]][[xorder[i]]])]], col = color,
pos = 4, font = 4, srt = 20)
}
}
}
if (cumsumfpatient[i] > maxscore) {
text(maxscore, temp[thisseq[i] + 2] - 3, round(fpatient[xorder[i]],
2), col = "black", pos = 2, font = 2)
}
else if (cumsumfpatient[i] < min(0, cumsumfpatient)) {
text(min(0, cumsumfpatient), temp[thisseq[i] +
2] - 3, round(fpatient[xorder[i]], 2), col = "grey",
pos = 4, font = 2)
}
else {
text(cumsumfpatient[i], temp[thisseq[i] + 2] -
3, round(fpatient[xorder[i]], 2), col = "grey",
pos = 4, font = 2)
}
lines(c(cumsumfpatient[i], cumsumfpatient[i]), c(temp[thisseq[i] +
2], temp[thisseq[i] + 1]) + diff(temp)[1]/2)
lines(c(cumsumfpatient[i], cumsumfpatient[i + 1]),
c(temp[thisseq[i] + 1], temp[thisseq[i] + 1]) +
diff(temp)[1]/2)
}
if (sum(fpatient) < 0.9 * maxscore & sum(fpatient) >=
min(cumsumfpatient)) {
text(sum(fpatient), temp[2], round(sum(fpatient),
2), col = riskcolor, font = 2, pos = 4)
}
else if (sum(fpatient) >= 0.9 * maxscore) {
text(maxscore, temp[2], round(sum(fpatient), 2),
col = "black", font = 2, pos = 2)
}
else if (sum(fpatient) < min(cumsumfpatient)) {
text(min(0, cumsumfpatient), temp[2], round(sum(fpatient),
2), col = "black", font = 2, pos = 2)
}
text(min(0, cumsumfpatient), temp[1], "max. score", col = "black",
font = 3, pos = 4)
text(maxscore, temp[1], round(maxscore, 2), col = "black",
font = 2, pos = 2)
mtext(paste("Score equals", risklabel), col = "black",
font = 2, side = 1, line = 2, adj = 0)
}
x0 = ceiling(par("usr")[1])
unit = (par("usr")[2] - par("usr")[1])/7.5
mtext(expression(bold(phantom("legend of reported figures: ")) *
"blue - predictor value"), col = color, font = 2, side = 1,
line = 0, adj = 0)
mtext(expression(bold("legend of reported figures: ") * phantom("blue - predictor value")),
col = "black", font = 2, side = 1, line = 0, adj = 0)
mtext(expression(bold(phantom("legend of reported figures: ")) *
"gray - contribution to score"), col = "grey", font = 2,
side = 1, line = 1, adj = 0)
for (i in seq(1, length(thisseq), 1)) {
if (!is.nan(thisrisk)) {
axis(side = 2, at = c(temp[i + 4]), labels = names2[xorder[thisseq]][i],
las = 2, lty = "blank", font = 2, cex.axis = 1.5,
col.axis = yaxiscolor[thisseq][i])
}
else {
axis(side = 2, at = c(temp[i + 2]), labels = names2[xorder[thisseq]][i],
las = 2, lty = "blank", font = 2, cex.axis = 1.5,
col.axis = yaxiscolor[thisseq][i])
}
}
garbage <- dev.off()
}
<bytecode: 0x9c3e600>
<environment: namespace:VRPM>
--- function search by body ---
Function ccchart.default in namespace VRPM has this body.
----------- END OF FAILURE REPORT --------------
Error in if (!class(fpatient) %in% c("vector", "matrix")) { :
the condition has length > 1
Calls: ccchart -> ccchart.glm -> ccchart -> ccchart.default
Execution halted
Flavor: r-devel-linux-x86_64-fedora-gcc