'my shiny app work locally but fail to work in server
I create a simple app use DNbuilder package to visualize the nomogram, it work efficiently but fail after publishing it to .shinyapps.io . This is the errorenter image description here
the error is check the log. the output of the log is
2022-04-11T01:57:09.371337+00:00 shinyapps[6057990]: isTRUE
2022-04-11T01:57:09.371407+00:00 shinyapps[6057990]:
2022-04-11T01:57:09.371580+00:00 shinyapps[6057990]: Loading required package: lattice
2022-04-11T01:57:09.371663+00:00 shinyapps[6057990]: Loading required package: survival
2022-04-11T01:57:09.371756+00:00 shinyapps[6057990]: Loading required package: Formula
2022-04-11T01:57:10.373348+00:00 shinyapps[6057990]:
2022-04-11T01:57:10.373439+00:00 shinyapps[6057990]: Attaching package: ‘Hmisc’
2022-04-11T01:57:10.373513+00:00 shinyapps[6057990]:
2022-04-11T01:57:10.373578+00:00 shinyapps[6057990]: The following object is masked from ‘package:plotly’:
2022-04-11T01:57:10.373624+00:00 shinyapps[6057990]:
2022-04-11T01:57:10.373685+00:00 shinyapps[6057990]: subplot
2022-04-11T01:57:10.373738+00:00 shinyapps[6057990]:
2022-04-11T01:57:10.373787+00:00 shinyapps[6057990]: The following objects are masked from ‘package:base’:
2022-04-11T01:57:10.373889+00:00 shinyapps[6057990]: format.pval, units
2022-04-11T01:57:10.373836+00:00 shinyapps[6057990]:
2022-04-11T01:57:10.373986+00:00 shinyapps[6057990]: Loading required package: SparseM
2022-04-11T01:57:10.374083+00:00 shinyapps[6057990]: Attaching package: ‘SparseM’
2022-04-11T01:57:10.373943+00:00 shinyapps[6057990]:
2022-04-11T01:57:10.374033+00:00 shinyapps[6057990]:
2022-04-11T01:57:10.374137+00:00 shinyapps[6057990]:
2022-04-11T01:57:10.374188+00:00 shinyapps[6057990]: The following object is masked from ‘package:base’:
2022-04-11T01:57:10.374257+00:00 shinyapps[6057990]:
2022-04-11T01:57:10.374309+00:00 shinyapps[6057990]: backsolve
2022-04-11T01:57:10.374465+00:00 shinyapps[6057990]: Attaching package: ‘rms’
2022-04-11T01:57:10.374412+00:00 shinyapps[6057990]:
2022-04-11T01:57:10.374364+00:00 shinyapps[6057990]:
2022-04-11T01:57:10.374561+00:00 shinyapps[6057990]: The following object is masked from ‘package:shiny’:
2022-04-11T01:57:10.374515+00:00 shinyapps[6057990]:
2022-04-11T01:57:10.374619+00:00 shinyapps[6057990]:
2022-04-11T01:57:10.374679+00:00 shinyapps[6057990]: validate
2022-04-11T01:57:10.374872+00:00 shinyapps[6057990]:
2022-04-11T01:57:10.374724+00:00 shinyapps[6057990]:
2022-04-11T01:57:10.374776+00:00 shinyapps[6057990]: Warning: namespace ‘DynNom’ is not available and has been replaced
2022-04-11T01:57:10.374823+00:00 shinyapps[6057990]: by .GlobalEnv when processing object ‘model’
2022-04-11T01:57:10.374915+00:00 shinyapps[6057990]: Listening on http://127.0.0.1:35485
2022-04-11T01:57:59.387019+00:00 shinyapps[6057990]: Warning: Error in check_aesthetics: Aesthetics must be either length 1 or the same as the data (1): text
2022-04-11T01:57:59.387097+00:00 shinyapps[6057990]: 128: <Anonymous>
2022-04-11T02:01:11.369442+00:00 shinyapps[6057990]: Warning: Error in check_aesthetics: Aesthetics must be either length 1 or the same as the data (1): text
2022-04-11T02:01:11.369502+00:00 shinyapps[6057990]: 128: <Anonymous>
2022-04-11T02:01:15.373172+00:00 shinyapps[6057990]: Warning: Error in check_aesthetics: Aesthetics must be either length 1 or the same as the data (1): text
2022-04-11T02:01:15.373265+00:00 shinyapps[6057990]: 128: <Anonymous>
2022-04-11T02:01:27.369447+00:00 shinyapps[6057990]: Warning: Error in check_aesthetics: Aesthetics must be either length 1 or the same as the data (1): text
2022-04-11T02:01:27.369528+00:00 shinyapps[6057990]: 128: <Anonymous>
2022-04-11T02:01:27.369651+00:00 shinyapps[6057990]: 128: <Anonymous>
2022-04-11T02:01:27.369602+00:00 shinyapps[6057990]: Warning: Error in check_aesthetics: Aesthetics must be either length 1 or the same as the data (1): text
2022-04-11T02:04:16.369514+00:00 shinyapps[6057990]: 128: <Anonymous>
2022-04-11T02:04:16.369442+00:00 shinyapps[6057990]: Warning: Error in check_aesthetics: Aesthetics must be either length 1 or the same as the data (1): text
2022-04-11T02:04:21.386830+00:00 shinyapps[6057990]: 128: <Anonymous>
2022-04-11T02:04:21.386768+00:00 shinyapps[6057990]: Warning: Error in check_aesthetics: Aesthetics must be either length 1 or the same as the data (1): text
2022-04-11T02:04:42.369429+00:00 shinyapps[6057990]: Warning: Error in check_aesthetics: Aesthetics must be either length 1 or the same as the data (2): text
2022-04-11T02:04:42.369496+00:00 shinyapps[6057990]: 128: <Anonymous>
the error is Error in check_aesthetics: Aesthetics must be either length 1 or the same as the data (1): text
Here is my ui.R code:
ui = bootstrapPage(fluidPage(
titlePanel('Dynamic Nomogram'),
sidebarLayout(sidebarPanel(uiOutput('manySliders'),
checkboxInput('trans', 'Alpha blending (transparency)', value = TRUE),
actionButton('add', 'Predict'),
br(), br(),
helpText('Press Quit to exit the application'),
actionButton('quit', 'Quit')
),
mainPanel(tabsetPanel(id = 'tabs',
tabPanel('Survival plot', plotOutput('plot')),
tabPanel('Predicted Survival', plotlyOutput('plot2')),
tabPanel('Numerical Summary', verbatimTextOutput('data.pred')),
tabPanel('Model Summary', verbatimTextOutput('summary'))
)
)
)))
Here is my server.R code:
server = function(input, output){
observe({if (input$quit == 1)
stopApp()})
output$manySliders <- renderUI({
slide.bars <- list()
for (j in 1:length(preds)){
if (preds[[j]]$dataClasses == "factor"){
slide.bars[[j]] <- list(selectInput(names(preds)[j], names(preds)[j], preds[[j]]$v.levels, multiple = FALSE))
}
if (preds[[j]]$dataClasses == "numeric"){
if (covariate == "slider") {
slide.bars[[j]] <- list(sliderInput(names(preds)[j], names(preds)[j],
min = preds[[j]]$v.min, max = preds[[j]]$v.max, value = preds[[j]]$v.mean))
}
if (covariate == "numeric") {
slide.bars[[j]] <- list(numericInput(names(preds)[j], names(preds)[j], value = zapsmall(preds[[j]]$v.mean, digits = 4)))
}}}
if (covariate == "slider") {
slide.bars[[length(preds) + 1]] <-
list(br(), checkboxInput("times", "Predicted Survival at this Follow Up:"),
conditionalPanel(condition = "input.times == true",
sliderInput("tim", tim[1], min = ttim$v.min, max = ttim$v.max, value = ttim$v.mean)))
} else {
slide.bars[[length(preds) + 1]] <-
list(br(), checkboxInput("times", "Predicted Survival at this Follow Up:"),
conditionalPanel(condition = "input.times == true",
numericInput("tim", tim[1], value = zapsmall(ttim$v.mean, digits = 4))))
}
do.call(tagList, slide.bars)
})
a <- 0
old.d <- NULL
new.d <- reactive({
input$add
input.v <- vector("list", length(preds) + 1)
input.v[[1]] <- isolate({ input[["tim"]] })
names(input.v)[1] <- tim[1]
for (i in 1:length(preds)) {
input.v[[i+1]] <- isolate({
input[[names(preds)[i]]]
})
names(input.v)[i+1] <- names(preds)[i]
}
out <- data.frame(lapply(input.v, cbind))
if (a == 0) {
wher <- match(names(out), names(input.data))
out <- out[wher]
input.data <<- rbind(input.data, out)
}
if (a > 0) {
wher <- match(names(out), names(input.data))
out <- out[wher]
if (!isTRUE(compare(old.d, out))) {
input.data <<- rbind(input.data, out)
}}
a <<- a + 1
out
})
p1 <- NULL
old.d <- NULL
data2 <- reactive({
if (input$add == 0)
return(NULL)
if (input$add > 0) {
if (!isTRUE(compare(old.d, new.d()))) {
OUT <- isolate({
new.d <- cbind(st.ind = 1, new.d())
names(new.d)[1] <- tim[2]
DNpred <- getpred.DN(model, new.d)
mpred <- DNpred$pred
se.pred <- DNpred$SEpred
pred <- mlinkF(mpred)
if (is.na(se.pred)) {
lwb <- NULL
upb <- NULL
} else {
lwb <- sort(mlinkF(mpred + cbind(1, -1) * (qnorm(1 - (1 - clevel)/2) * se.pred)))[1]
upb <- sort(mlinkF(mpred + cbind(1, -1) * (qnorm(1 - (1 - clevel)/2) * se.pred)))[2]
if (upb > 1) {
upb <- 1
}}
if (ptype == "st") {
d.p <- data.frame(Prediction = zapsmall(pred, digits = 2),
Lower.bound = zapsmall(lwb, digits = 2),
Upper.bound = zapsmall(upb, digits = 2))
}
if (ptype == "1-st") {
d.p <- data.frame(Prediction = zapsmall(1-pred, digits = 2),
Lower.bound = zapsmall(1-upb, digits = 2),
Upper.bound = zapsmall(1-lwb, digits = 2))
}
old.d <<- new.d[,-1]
data.p <- cbind(d.p, counter = TRUE)
if (DNpred$InRange){
p1 <<- rbind(p1[,-5], data.p)
} else{
p1 <<- rbind(p1[,-5], data.frame(Prediction = NA, Lower.bound = NA, Upper.bound = NA, counter = FALSE))
}
p1
})
} else {
p1$count <- seq(1, dim(p1)[1])
}}
p1
})
s.fr <- NULL
old.d2 <- NULL
b <- 1
dat.p <- reactive({
if (isTRUE(compare(old.d2, new.d())) == FALSE) {
if (length(levels(model$strata)) != length(levels(attr(predict(model, new.d(), type='x', expand.na=FALSE), 'strata')))){
levels(model$strata) <- levels(attr(predict(model, new.d(), type='x', expand.na=FALSE), 'strata'))
}
try.survfit <- !any(class(try(survfit(model, newdata = new.d()), silent = TRUE)) == "try-error")
if (try.survfit){
fit1 <- survfit(model, newdata = new.d())
}
if (n.strata == 0) {
sff <- data.frame(summary(fit1)[c("time", "n.risk", "surv")])
sff <- cbind(sff, event=1-sff$surv, part = b)
if (sff$time[1] != 0){
sff <- rbind(data.frame(time=0, n.risk=sff$n.risk[1] ,surv=1, event=0, part=sff$part[1]), sff)
}}
if (n.strata > 0) {
nam <- NULL
new.sub <- T
for (i in 1:(dim.terms-1)) {
if (preds[[i]]$dataClasses == "factor"){
if (preds[[i]]$IFstrata){
nam0 <- paste(names(preds[i]),'=', new.d()[[names(preds[i])]], sep = '')
if (new.sub) {
nam <- paste(nam0)
new.sub <- F
} else {
nam <- paste(nam, '.', nam0, sep = '')
}}}}
if (try.survfit){
sub.fit1 <- subset(as.data.frame(summary(fit1)[c("time", "n.risk", "strata", "surv")]), strata == nam)
} else{
sub.fit1 <- data.frame(time=NA, n.risk=NA, strata=NA, surv=NA, event=NA, part=NA)[0,]
}
if (!nam %in% strata.l){
message("The strata levels not found in the original")
sff <- cbind(sub.fit1, event=NULL, part = NULL)
b <<- b - 1
} else{
sff <- cbind(sub.fit1, event=1-sub.fit1$surv, part = b)
if (sff$time[1] != 0) {
sff <- rbind(data.frame(time=0, n.risk=sff$n.risk[1], strata=sff$strata[1] ,surv=1, event=0, part=sff$part[1]), sff)
}
sff$n.risk <- sff$n.risk/sff$n.risk[1]
}
sff$n.risk <- sff$n.risk/sff$n.risk[1]
}
s.fr <<- rbind(s.fr, sff)
old.d2 <<- new.d()
b <<- b + 1
}
s.fr
})
dat.f <- reactive({
if (nrow(data2() > 0))
cbind(input.data, data2()[1:3])
})
# KM plot
output$plot <- renderPlot({
data2()
if (input$add == 0)
return(NULL)
if (input$add > 0) {
if (ptype == "st") {
if (input$trans == TRUE) {
pl <- ggplot(data = dat.p()) +
geom_step(aes(x = time, y = surv, alpha = n.risk, group = part), color = coll[dat.p()$part])
}
if (input$trans == FALSE) {
pl <- ggplot(data = dat.p()) +
geom_step(aes(x = time, y = surv, group = part), color = coll[dat.p()$part])
}}
if (ptype == "1-st") {
if (input$trans == TRUE) {
pl <- ggplot(data = dat.p()) +
geom_step(aes(x = time, y = event, alpha = n.risk, group = part), color = coll[dat.p()$part])
}
if (input$trans == FALSE) {
pl <- ggplot(data = dat.p()) +
geom_step(aes(x = time, y = event, group = part), color = coll[dat.p()$part])
}}
pl <- pl + ylim(0, 1) + xlim(0, max(dat.p()$time) * 1.05) +
labs(title = "Estimated Survival Probability", x = "Follow Up Time", y = "S(t)") + theme_bw() +
theme(text = element_text(face = "bold", size = 12), legend.position = "none", plot.title = element_text(hjust = .5))
}
print(pl)
})
output$plot2 <- renderPlotly({
if (input$add == 0)
return(NULL)
if (is.null(new.d()))
return(NULL)
lim <- c(0, 1)
yli <- c(0 - 0.5, 10 + 0.5)
input.data = input.data[data2()$counter,]
in.d <- data.frame(input.data)
xx=matrix(paste(names(in.d), ": ",t(in.d), sep=""), ncol=dim(in.d)[1])
text.cov=apply(xx,2,paste,collapse="<br />")
if (dim(input.data)[1] > 11)
yli <- c(dim(input.data)[1] - 11.5, dim(input.data)[1] - 0.5)
dat2 <- data2()[data2()$counter,]
dat2$count = seq(1, nrow(dat2))
p <- ggplot(data = dat2, aes(x = Prediction, y = count - 1, text = text.cov,
label = Prediction, label2 = Lower.bound, label3=Upper.bound)) +
geom_point(size = 2, colour = coll[dat2$count], shape = 15) +
ylim(yli[1], yli[2]) + coord_cartesian(xlim = lim) +
labs(title = "95% Confidence Interval for Response",
x = "Survival probability", y = "") + theme_bw() +
theme(axis.text.y = element_blank(), text = element_text(face = "bold", size = 10))
if (is.numeric(dat2$Upper.bound)){
p <- p + geom_errorbarh(xmax = dat2$Upper.bound, xmin = dat2$Lower.bound,
size = 1.45, height = 0.4, colour = coll[dat2$count])
} else{
message("Confidence interval is not available as there is no standard errors available by 'cph' ")
}
if (ptype == "st") {
p <- p + labs(title = paste(clevel * 100, "% ", "Confidence Interval for Survival Probability", sep = ""),
x = DNxlab, y = DNylab)
}
if (ptype == "1-st") {
p <- p + labs(title = paste(clevel * 100, "% ", "Confidence Interval for F(t)", sep = ""),
x = DNxlab, y = DNylab)
}
gp=ggplotly(p, tooltip = c("text","label","label2","label3"))
gp$elementId <- NULL
dat.p()
gp
})
output$data.pred <- renderPrint({
if (input$add > 0) {
if (nrow(data2() > 0)) {
stargazer(dat.f(), summary = FALSE, type = "text")
}}
})
output$summary <- renderPrint({
summary(model)
})
}
I don't konow how to solve this problem, could anyone give me some suggestions?
Sources
This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.
Source: Stack Overflow
| Solution | Source |
|---|