shiny app can run well on localhost but fails on the server

876 views
Skip to first unread message

xiao xu

unread,
Jul 17, 2017, 1:59:15 PM7/17/17
to Shiny - Web Framework for R
Dear all, I recently ran into a very weird issue, I generated a shiny app to produce circlize plot for my input, it runs well on localhost:8888, however, it keeps crushing on the R shiny server with error message pop up

The application unexpectedly existed 
diagnostic information has been dumped to javascript console

I checked log file, the error message appears to trace back from one or two R statements, I double checked R server the rehape2 package is indeed installed, so what could be the issue here?


 *** caught illegal operation ***
address 0x7f91bb065c20, cause 'illegal operand'

Traceback:
 1: FUN(X[[i]], ...)
 2: lapply(vars, id, drop = drop)
 3: cast(data, formula, fun.aggregate, ..., subset = subset, fill = fill,     drop = drop, value.var = value.var)
 4: dcast(state$use.dat.annot, Gnames + Description + Class_MB +     location_abbr ~ CellType, mean, value = "value")
 5: eventReactiveHandler(...)
 6: ..stacktraceon..(eventReactiveHandler(...))
 7: handlerFunc()
 8: ..stacktraceon..(expr)
 9: contextFunc()
10: env$runWith(self, func)
11: withReactiveDomain(.domain, {    env <- .getReactiveEnvironment()    .graphEnterContext(id)    on.exit(.graphExitContext(id), add = TRUE)    env$runWith(self, func)})
12: ctx$run(function() {    ..stacktraceon..(expr)})
13: ..stacktraceoff..(ctx$run(function() {    ..stacktraceon..(expr)}))
14: isolate(handlerFunc())
15: `<reactive:eventReactive(input$clicks)>`(...)
16: .func()
17: withVisible(.func())
18: withCallingHandlers({    .error <<- FALSE    withVisible(.func())}, error = function(cond) {    .value <<- cond    .error <<- TRUE    .visible <<- FALSE})
19: contextFunc()
20: env$runWith(self, func)
21: withReactiveDomain(.domain, {    env <- .getReactiveEnvironment()    .graphEnterContext(id)    on.exit(.graphExitContext(id), add = TRUE)    env$runWith(self, func)})
22: ctx$run(function() {    result <- withCallingHandlers({        .error <<- FALSE        withVisible(.func())    }, error = function(cond) {        .value <<- cond        .error <<- TRUE        .visible <<- FALSE    })    .value <<- result$value    .visible <<- result$visible})
23: self$.updateValue()
24: ..stacktraceoff..(self$.updateValue())
25: gannot()
26: renderDataTable(...)
27: func()
28: origRenderFunc(...)
29: `output$table`(...)
30: ..stacktraceon..(`output$table`(...))
31: orig(name = name, shinysession = self)
32: func()
33: withCallingHandlers(expr, error = function(e) {    if (is.null(attr(e, "stack.trace", exact = TRUE))) {        calls <- sys.calls()        attr(e, "stack.trace") <- calls        stop(e)    }})
34: captureStackTraces(expr)
35: withCallingHandlers(captureStackTraces(expr), error = function(e) {    if (inherits(e, "shiny.silent.error"))         return()    handle <- getOption("shiny.error")    if (is.function(handle))         handle()})
36: shinyCallingHandlers(func())
37: doTryCatch(return(expr), name, parentenv, handler)
38: tryCatchOne(expr, names, parentenv, handlers[[1L]])
39: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
40: doTryCatch(return(expr), name, parentenv, handler)
41: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]),     names[nh], parentenv, handlers[[nh]])
42: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
43: doTryCatch(return(expr), name, parentenv, handler)
44: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]),     names[nh], parentenv, handlers[[nh]])
45: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
46: doTryCatch(return(expr), name, parentenv, handler)
47: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]),     names[nh], parentenv, handlers[[nh]])
48: tryCatchList(expr, classes, parentenv, handlers)
49: tryCatch(shinyCallingHandlers(func()), shiny.custom.error = function(cond) {    if (isTRUE(getOption("show.error.messages")))         printError(cond)    structure(list(), class = "try-error", condition = cond)}, shiny.output.cancel = function(cond) {    structure(list(), class = "cancel-output")}, shiny.silent.error = function(cond) {    structure(list(), class = "try-error", condition = cond)}, error = function(cond) {    if (isTRUE(getOption("show.error.messages")))         printError(cond)    if (getOption("shiny.sanitize.errors", FALSE)) {        cond <- simpleError(paste("An error has occurred. Check your",             "logs or contact the app author for", "clarification."))    }    invisible(structure(list(), class = "try-error", condition = cond))}, finally = {    private$sendMessage(recalculating = list(name = name, status = "recalculated"))})
50: observerFunc()
51: doTryCatch(return(expr), name, parentenv, handler)
52: tryCatchOne(expr, names, parentenv, handlers[[1L]])
53: tryCatchList(expr, classes, parentenv, handlers)
54: tryCatch(if (..stacktraceon) ..stacktraceon..(observerFunc()) else observerFunc(),     shiny.silent.error = function(e) NULL)
55: contextFunc()
56: env$runWith(self, func)
57: withReactiveDomain(.domain, {    env <- .getReactiveEnvironment()    .graphEnterContext(id)    on.exit(.graphExitContext(id), add = TRUE)    env$runWith(self, func)})
58: ctx$run(.func)
59: run()
60: withCallingHandlers(expr, error = function(e) {    if (is.null(attr(e, "stack.trace", exact = TRUE))) {        calls <- sys.calls()        attr(e, "stack.trace") <- calls        stop(e)    }})
61: captureStackTraces(expr)
62: withCallingHandlers(captureStackTraces(expr), error = function(e) {    if (inherits(e, "shiny.silent.error"))         return()    handle <- getOption("shiny.error")    if (is.function(handle))         handle()})
63: shinyCallingHandlers(run())
64: doTryCatch(return(expr), name, parentenv, handler)
65: tryCatchOne(expr, names, parentenv, handlers[[1L]])
66: tryCatchList(expr, classes, parentenv, handlers)
67: tryCatch({    if (!.destroyed)         shinyCallingHandlers(run())}, error = function(e) {    printError(e)    if (!is.null(.domain)) {        .domain$unhandledError(e)    }})
68: flushCallback()
69: FUN(X[[i]], ...)
70: lapply(.flushCallbacks, function(flushCallback) {    flushCallback()})
71: ctx$executeFlushCallbacks()
72: .getReactiveEnvironment()$flush()
73: flushReact()
74: force(expr)
75: withRestoreContext(shinysession$restoreContext, {    msg$data <- applyInputHandlers(msg$data)    switch(msg$method, init = {        serverFunc <- withReactiveDomain(NULL, serverFuncSource())        if (!identicalFunctionBodies(serverFunc, appvars$server)) {            appvars$server <- serverFunc            if (!is.null(appvars$server)) {                attr(appvars$server, "shinyServerFunction") <- TRUE                registerDebugHook("server", appvars, "Server Function")            }        }        if (.globals$showcaseOverride && exists(".clientdata_url_search",             where = msg$data)) {            mode <- showcaseModeOfQuerystring(msg$data$.clientdata_url_search)            if (!is.null(mode)) shinysession$setShowcase(mode)        }        shinysession$manageInputs(msg$data)        if (!is.null(msg$data$.clientdata_singletons)) {            shinysession$singletons <- strsplit(msg$data$.clientdata_singletons,                 ",")[[1]]        }        local({            args <- argsForServerFunc(serverFunc, shinysession)            withReactiveDomain(shinysession, {                do.call(wrapFunctionLabel(appvars$server, "server",                   ..stacktraceon = TRUE), args)            })        })    }, update = {        shinysession$manageInputs(msg$data)    }, shinysession$dispatch(msg))    shinysession$manageHiddenOutputs()    if (exists(".shiny__stdout", globalenv()) && exists("HTTP_GUID",         ws$request)) {        shiny_stdout <- get(".shiny__stdout", globalenv())        writeLines(paste("_n_flushReact ", get("HTTP_GUID", ws$request),             " @ ", sprintf("%.3f", as.numeric(Sys.time())), sep = ""),             con = shiny_stdout)        flush(shiny_stdout)        flushReact()        writeLines(paste("_x_flushReact ", get("HTTP_GUID", ws$request),             " @ ", sprintf("%.3f", as.numeric(Sys.time())), sep = ""),             con = shiny_stdout)        flush(shiny_stdout)    }    else {        flushReact()    }    flushAllSessions()})
76: withReactiveDomain(shinysession, {    if (is.character(msg))         msg <- charToRaw(msg)    traceOption <- getOption("shiny.trace", FALSE)    if (isTRUE(traceOption) || traceOption == "recv") {        if (binary)             message("RECV ", "$$binary data$$")        else message("RECV ", rawToChar(msg))    }    if (identical(charToRaw("\003\xe9"), msg))         return()    msg <- decodeMessage(msg)    if (is.null(shinysession$restoreContext)) {        bookmarkStore <- getShinyOption("bookmarkStore", default = "disable")        if (bookmarkStore == "disable") {            shinysession$restoreContext <- RestoreContext$new()        }        else {            shinysession$restoreContext <- RestoreContext$new(msg$data$.clientdata_url_search)        }    }    withRestoreContext(shinysession$restoreContext, {        msg$data <- applyInputHandlers(msg$data)        switch(msg$method, init = {            serverFunc <- withReactiveDomain(NULL, serverFuncSource())            if (!identicalFunctionBodies(serverFunc, appvars$server)) {                appvars$server <- serverFunc                if (!is.null(appvars$server)) {                  attr(appvars$server, "shinyServerFunction") <- TRUE                  registerDebugHook("server", appvars, "Server Function")                }            }            if (.globals$showcaseOverride && exists(".clientdata_url_search",                 where = msg$data)) {                mode <- showcaseModeOfQuerystring(msg$data$.clientdata_url_search)                if (!is.null(mode)) shinysession$setShowcase(mode)            }            shinysession$manageInputs(msg$data)            if (!is.null(msg$data$.clientdata_singletons)) {                shinysession$singletons <- strsplit(msg$data$.clientdata_singletons,                   ",")[[1]]            }            local({                args <- argsForServerFunc(serverFunc, shinysession)                withReactiveDomain(shinysession, {                  do.call(wrapFunctionLabel(appvars$server, "server",                     ..stacktraceon = TRUE), args)                })            })        }, update = {            shinysession$manageInputs(msg$data)        }, shinysession$dispatch(msg))        shinysession$manageHiddenOutputs()        if (exists(".shiny__stdout", globalenv()) && exists("HTTP_GUID",             ws$request)) {            shiny_stdout <- get(".shiny__stdout", globalenv())            writeLines(paste("_n_flushReact ", get("HTTP_GUID",                 ws$request), " @ ", sprintf("%.3f", as.numeric(Sys.time())),                 sep = ""), con = shiny_stdout)            flush(shiny_stdout)            flushReact()            writeLines(paste("_x_flushReact ", get("HTTP_GUID",                 ws$request), " @ ", sprintf("%.3f", as.numeric(Sys.time())),                 sep = ""), con = shiny_stdout)            flush(shiny_stdout)        }        else {            flushReact()        }        flushAllSessions()    })})
77: messageHandler(binary, msg)
78: withCallingHandlers(expr, error = function(e) {    if (is.null(attr(e, "stack.trace", exact = TRUE))) {        calls <- sys.calls()        attr(e, "stack.trace") <- calls        stop(e)    }})
79: captureStackTraces(expr)
80: withCallingHandlers(captureStackTraces(expr), error = function(cond) {    if (inherits(cond, "shiny.silent.error"))         return()    if (isTRUE(getOption("show.error.messages"))) {        printError(cond, full = full, offset = offset)    }})
81: withLogErrors(messageHandler(binary, msg))
82: handler(binary, message)
83: doTryCatch(return(expr), name, parentenv, handler)
84: tryCatchOne(expr, names, parentenv, handlers[[1L]])
85: tryCatchList(expr, classes, parentenv, handlers)
86: tryCatch(expr, error = function(e) {    call <- conditionCall(e)    if (!is.null(call)) {        if (identical(call[[1L]], quote(doTryCatch)))             call <- sys.call(-4L)        dcall <- deparse(call)[1L]        prefix <- paste("Error in", dcall, ": ")        LONG <- 75L        msg <- conditionMessage(e)        sm <- strsplit(msg, "\n")[[1L]]        w <- 14L + nchar(dcall, type = "w") + nchar(sm[1L], type = "w")        if (is.na(w))             w <- 14L + nchar(dcall, type = "b") + nchar(sm[1L],                 type = "b")        if (w > LONG)             prefix <- paste0(prefix, "\n  ")    }    else prefix <- "Error : "    msg <- paste0(prefix, conditionMessage(e), "\n")    .Internal(seterrmessage(msg[1L]))    if (!silent && identical(getOption("show.error.messages"),         TRUE)) {        cat(msg, file = stderr())        .Internal(printDeferredWarnings())    }    invisible(structure(msg, class = "try-error", condition = e))})
87: try(handler(binary, message))
88: (function (handle, binary, message) {    for (handler in .wsconns[[as.character(handle)]]$.messageCallbacks) {        result <- try(handler(binary, message))        if (inherits(result, "try-error")) {            .wsconns[[as.character(handle)]]$close()            return()        }    }})("64145616", FALSE, "{\"method\":\"update\",\"data\":{\"clicks:shiny.action\":1}}")
89: eval(substitute(expr), envir, enclos)
90: evalq((function (handle, binary, message) {    for (handler in .wsconns[[as.character(handle)]]$.messageCallbacks) {        result <- try(handler(binary, message))        if (inherits(result, "try-error")) {            .wsconns[[as.character(handle)]]$close()            return()        }    }})("64145616", FALSE, "{\"method\":\"update\",\"data\":{\"clicks:shiny.action\":1}}"),     <environment>)
91: doTryCatch(return(expr), name, parentenv, handler)
92: tryCatchOne(expr, names, parentenv, handlers[[1L]])
93: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
94: doTryCatch(return(expr), name, parentenv, handler)
95: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]),     names[nh], parentenv, handlers[[nh]])
96: tryCatchList(expr, classes, parentenv, handlers)
97: tryCatch(evalq((function (handle, binary, message) {    for (handler in .wsconns[[as.character(handle)]]$.messageCallbacks) {        result <- try(handler(binary, message))        if (inherits(result, "try-error")) {            .wsconns[[as.character(handle)]]$close()            return()        }    }})("64145616", FALSE, "{\"method\":\"update\",\"data\":{\"clicks:shiny.action\":1}}"),     <environment>), error = function (x) x, interrupt = function (x) x)
98: .Call("httpuv_run", PACKAGE = "httpuv", timeoutMillis)
99: run(timeoutMs)
100: service(timeout)
101: serviceApp()
102: withCallingHandlers(expr, error = function(e) {    if (is.null(attr(e, "stack.trace", exact = TRUE))) {        calls <- sys.calls()        attr(e, "stack.trace") <- calls        stop(e)    }})
103: captureStackTraces({    scheduleFlush()    while (!.globals$stopped) {        serviceApp()        Sys.sleep(0.001)    }})
104: ..stacktraceoff..(captureStackTraces({    scheduleFlush()    while (!.globals$stopped) {        serviceApp()        Sys.sleep(0.001)    }}))
105: runApp(Sys.getenv("SHINY_APP"), port = port, launch.browser = FALSE,     workerId = Sys.getenv("WORKER_ID"))
An irrecoverable exception occurred. R is aborting now ...

xiao xu

unread,
Jul 17, 2017, 2:02:45 PM7/17/17
to Shiny - Web Framework for R
I ran an additional test on the server with the reshape2 package (see below), looks like the program fails again on the dcast function, and entire website stopped with similar error message, why is the server not compatible with dcast function from reshape2 package?

library(shiny)
library(reshape2)

names(airquality) <- tolower(names(airquality))
aqm <- melt(airquality, id=c("month", "day"), na.rm=TRUE)
test <- dcast(aqm, month ~ variable, mean, margins = c("month", "variable"))

ui <- shinyUI(fluidPage(
      fluidRow(
        column(12,
          tableOutput('table')
        )
      )))

server = function(input, output) {
  output$table <- renderTable(aqm)
}

shinyApp(ui = ui, server = server)

This time the error message appears like this


 *** caught illegal operation ***
address 0x7fb963457c20, cause 'illegal operand'

Traceback:
 1: id(rev(ids), drop = FALSE)
 2: cast(data, formula, fun.aggregate, ..., subset = subset, fill = fill,     drop = drop, value.var = value.var)
 3: dcast(aqm, month ~ variable, mean, margins = c("month", "variable"))
 4: ..stacktraceon..({    library(shiny)    library(reshape2)    names(airquality) <- tolower(names(airquality))    aqm <- melt(airquality, id = c("month", "day"), na.rm = TRUE)    test <- dcast(aqm, month ~ variable, mean, margins = c("month",         "variable"))    ui <- shinyUI(fluidPage(fluidRow(column(12, tableOutput("table")))))    server = function(input, output) {        output$table <- renderTable(aqm)    }    shinyApp(ui = ui, server = server)})
 5: eval(expr, envir, enclos)
 6: eval(exprs, envir)
 7: sourceUTF8(fullpath, envir = new.env(parent = globalenv()))
 8: func(fname, ...)
 9: appObj()
10: handler(req)
11: handler(req)
12: handler(...)
13: handlers$invoke(req)
14: withCallingHandlers(expr, error = function(e) {    if (is.null(attr(e, "stack.trace", exact = TRUE))) {        calls <- sys.calls()        attr(e, "stack.trace") <- calls        stop(e)    }})
15: captureStackTraces(expr)
16: withCallingHandlers(captureStackTraces(expr), error = function(cond) {    if (inherits(cond, "shiny.silent.error"))         return()    if (isTRUE(getOption("show.error.messages"))) {        printError(cond, full = full, offset = offset)    }})
17: withLogErrors(handlers$invoke(req))
18: withCallingHandlers(withLogErrors(handlers$invoke(req)), error = function(cond) {    sanitizeErrors <- getOption("shiny.sanitize.errors", FALSE)    if (inherits(cond, "shiny.custom.error") || !sanitizeErrors) {        stop(cond$message, call. = FALSE)    }    else {        stop(paste("An error has occurred. Check your logs or",             "contact the app author for clarification."), call. = FALSE)    }})
19: handler(req)
20: func(req)
21: doTryCatch(return(expr), name, parentenv, handler)
22: tryCatchOne(expr, names, parentenv, handlers[[1L]])
23: tryCatchList(expr, classes, parentenv, handlers)
24: tryCatch(expr, error = function(e) {    call <- conditionCall(e)    if (!is.null(call)) {        if (identical(call[[1L]], quote(doTryCatch)))             call <- sys.call(-4L)        dcall <- deparse(call)[1L]        prefix <- paste("Error in", dcall, ": ")        LONG <- 75L        msg <- conditionMessage(e)        sm <- strsplit(msg, "\n")[[1L]]        w <- 14L + nchar(dcall, type = "w") + nchar(sm[1L], type = "w")        if (is.na(w))             w <- 14L + nchar(dcall, type = "b") + nchar(sm[1L],                 type = "b")        if (w > LONG)             prefix <- paste0(prefix, "\n  ")    }    else prefix <- "Error : "    msg <- paste0(prefix, conditionMessage(e), "\n")    .Internal(seterrmessage(msg[1L]))    if (!silent && identical(getOption("show.error.messages"),         TRUE)) {        cat(msg, file = stderr())        .Internal(printDeferredWarnings())    }    invisible(structure(msg, class = "try-error", condition = e))})
25: try({    inputStream <- if (is.null(data))         nullInputStream    else InputStream$new(data, dataLength)    req$rook.input <- inputStream    req$rook.errors <- ErrorStream$new()    req$httpuv.version <- packageVersion("httpuv")    if (!is.null(req$HTTP_CONTENT_TYPE))         req$CONTENT_TYPE <- req$HTTP_CONTENT_TYPE    if (!is.null(req$HTTP_CONTENT_LENGTH))         req$CONTENT_LENGTH <- req$HTTP_CONTENT_LENGTH    resp <- func(req)    if (is.null(resp) || length(resp) == 0)         return(NULL)    resp$headers <- lapply(resp$headers, paste)    if ("file" %in% names(resp$body)) {        filename <- resp$body[["file"]]        owned <- FALSE        if ("owned" %in% names(resp$body))             owned <- as.logical(resp$body$owned)        resp$body <- NULL        resp$bodyFile <- filename        resp$bodyFileOwned <- owned    }    resp})
26: rookCall(.app$call, req, req$.bodyData, seek(req$.bodyData))
27: (function (req) {    on.exit({        if (!is.null(req$.bodyData)) {            close(req$.bodyData)        }        req$.bodyData <- NULL    })    rookCall(.app$call, req, req$.bodyData, seek(req$.bodyData))})(<environment>)
28: eval(substitute(expr), envir, enclos)
29: evalq((function (req) {    on.exit({        if (!is.null(req$.bodyData)) {            close(req$.bodyData)        }        req$.bodyData <- NULL    })    rookCall(.app$call, req, req$.bodyData, seek(req$.bodyData))})(<environment>), <environment>)
30: doTryCatch(return(expr), name, parentenv, handler)
31: tryCatchOne(expr, names, parentenv, handlers[[1L]])
32: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
33: doTryCatch(return(expr), name, parentenv, handler)
34: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]),     names[nh], parentenv, handlers[[nh]])
35: tryCatchList(expr, classes, parentenv, handlers)
36: tryCatch(evalq((function (req) {    on.exit({        if (!is.null(req$.bodyData)) {            close(req$.bodyData)        }        req$.bodyData <- NULL    })    rookCall(.app$call, req, req$.bodyData, seek(req$.bodyData))})(<environment>), <environment>), error = function (x) x, interrupt = function (x) x)
37: .Call("httpuv_run", PACKAGE = "httpuv", timeoutMillis)
38: run(timeoutMs)
39: service(timeout)
40: serviceApp()
41: withCallingHandlers(expr, error = function(e) {    if (is.null(attr(e, "stack.trace", exact = TRUE))) {        calls <- sys.calls()        attr(e, "stack.trace") <- calls        stop(e)    }})
42: captureStackTraces({    scheduleFlush()    while (!.globals$stopped) {        serviceApp()        Sys.sleep(0.001)    }})
43: ..stacktraceoff..(captureStackTraces({    scheduleFlush()    while (!.globals$stopped) {        serviceApp()        Sys.sleep(0.001)    }}))
44: runApp(Sys.getenv("SHINY_APP"), port = port, launch.browser = FALSE,     workerId = Sys.getenv("WORKER_ID"))

Winston Chang

unread,
Jul 17, 2017, 4:07:53 PM7/17/17
to xiao xu, Shiny - Web Framework for R
This sounds like it could be a binary package incompatibility. This can happen if you recently upgraded your version of R. Please see: http://shiny.rstudio.com/articles/upgrade-R.html

--
You received this message because you are subscribed to the Google Groups "Shiny - Web Framework for R" group.
To unsubscribe from this group and stop receiving emails from it, send an email to shiny-discuss+unsubscribe@googlegroups.com.
To view this discussion on the web visit https://groups.google.com/d/msgid/shiny-discuss/8a181caf-64b5-4364-87be-df4c48a7334d%40googlegroups.com.

For more options, visit https://groups.google.com/d/optout.

Reply all
Reply to author
Forward
0 new messages