ggplotly fails with an empty layer of geom_vline

ggplotly fails when there is a geom_vline-layer that does not contain any lines. For me, this happens in a setting where I have a function that computes a set of x-values at which I want to have vertical lines. Sometimes it happens that no vertical line is needed, and then ggplotly fails with the following error message:

Fehler in fix.by(by.y, y) : 'by' must specify a uniquely valid column

Minimal example:

do_plot <- function(xintercepts) {
  ggplot(mtcars, aes(mpg, carb)) + geom_point() +
    geom_vline(xintercept = xintercepts)
}
plotly::ggplotly(do_plot(23))        # works fine
plotly::ggplotly(do_plot(c(15, 25))) # works fine
plotly::ggplotly(do_plot(numeric())) # produces error (but works without call to ggplotly)

I have the same issue; ggplot2 works well as is but when passed to plotly it fails - expected behaviour is no vertical line drawn but the rest of the plot yes.

Here is my traceback; I'm using shiny + plotly:

traceback()

194: `$.ggproto`(self, "compute_group")
193: self$compute_group
192: environment(x)
191: formals(environment(x)$f)
190: ggproto_formals(self$compute_group)
189: parameters(..., self = self)
188: self$parameters()
187: intersect(names(params), self$parameters())
186: compute_layer(..., self = self)
185: self$stat$compute_layer(data, self$computed_stat_params, layout)
184: compute_statistic(..., self = self)
183: l$compute_statistic(d, layout)
182: f(l = layers[[i]], d = data[[i]])
181: withCallingHandlers(expr, condition = function(cnd) {
         {
             .__handler_frame__. <- TRUE
             .__setup_frame__. <- frame
             if (inherits(cnd, "message")) {
                 except <- c("warning", "error")
             }
             else if (inherits(cnd, "warning")) {
                 except <- "error"
             }
             else {
                 except <- ""
             }
         }
         while (!is_null(cnd)) {
             if (inherits(cnd, "error")) {
                 out <- handlers[[1L]](cnd)
                 if (!inherits(out, "rlang_zap")) 
                     throw(out)
             }
             inherit <- .subset2(.subset2(cnd, "rlang"), "inherit")
             if (is_false(inherit)) {
                 return()
             }
             cnd <- .subset2(cnd, "parent")
         }
     })
180: doTryCatch(return(expr), name, parentenv, handler)
179: tryCatchOne(expr, names, parentenv, handlers[[1L]])
178: tryCatchList(expr, classes, parentenv, handlers)
177: tryCatch(withCallingHandlers(expr, condition = function(cnd) {
         {
             .__handler_frame__. <- TRUE
             .__setup_frame__. <- frame
             if (inherits(cnd, "message")) {
                 except <- c("warning", "error")
             }
             else if (inherits(cnd, "warning")) {
                 except <- "error"
             }
             else {
                 except <- ""
             }
         }
         while (!is_null(cnd)) {
             if (inherits(cnd, "error")) {
                 out <- handlers[[1L]](cnd)
                 if (!inherits(out, "rlang_zap")) 
                     throw(out)
             }
             inherit <- .subset2(.subset2(cnd, "rlang"), "inherit")
             if (is_false(inherit)) {
                 return()
             }
             cnd <- .subset2(cnd, "parent")
         }
     }), stackOverflowError = handlers[[1L]])
176: try_fetch(for (i in seq_along(data)) {
         out[[i]] <- f(l = layers[[i]], d = data[[i]])
     }, error = function(cnd) {
         cli::cli_abort(c("Problem while {step}.", i = "Error occurred in the {ordinal(i)} layer."), 
             call = layers[[i]]$constructor, parent = cnd)
     })
175: by_layer(function(l, d) l$compute_statistic(d, layout), layers, 
         data, "computing stat")
174: ggplot_build.ggplot(x)
173: ggplot_build(x)
172: print.ggplot(p)
171: print(p) at render_macd_chart.R#31
170: renderPlot()
169: ..stacktraceon..(renderPlot())
168: func()
167: force(expr)
166: withVisible(force(expr))
165: withCallingHandlers(expr, error = doCaptureStack)
164: domain$wrapSync(expr)
163: promises::with_promise_domain(createStackTracePromiseDomain(), 
         expr)
162: captureStackTraces({
         result <- withVisible(force(expr))
         if (promises::is.promising(result$value)) {
             p <- promise_chain(valueWithVisible(result), ..., catch = catch, 
                 finally = finally)
             runFinally <- FALSE
             p
         }
         else {
             result <- Reduce(function(v, func) {
                 if (v$visible) {
                     withVisible(func(v$value))
                 }
                 else {
                     withVisible(func(invisible(v$value)))
                 }
             }, list(...), result)
             valueWithVisible(result)
         }
     })
161: doTryCatch(return(expr), name, parentenv, handler)
160: tryCatchOne(expr, names, parentenv, handlers[[1L]])
159: tryCatchList(expr, classes, parentenv, handlers)
158: tryCatch({
         captureStackTraces({
             result <- withVisible(force(expr))
             if (promises::is.promising(result$value)) {
                 p <- promise_chain(valueWithVisible(result), ..., 
                     catch = catch, finally = finally)
                 runFinally <- FALSE
                 p
             }
             else {
                 result <- Reduce(function(v, func) {
                     if (v$visible) {
                       withVisible(func(v$value))
                     }
                     else {
                       withVisible(func(invisible(v$value)))
                     }
                 }, list(...), result)
                 valueWithVisible(result)
             }
         })
     }, error = function(e) {
         if (!is.null(catch)) 
             catch(e)
         else stop(e)
     }, finally = if (runFinally && !is.null(finally)) finally())
157: do()
156: hybrid_chain(func(), function(value) {
         res <- withVisible(value)
         if (res$visible) {
             print.ggplot <- custom_print.ggplot
             utils::capture.output({
                 result <- ..stacktraceon..(print(res$value))
             })
             result
         }
         else {
             NULL
         }
     }, function(value) {
         list(plotResult = value, recordedPlot = grDevices::recordPlot(), 
             coordmap = getCoordmap(value, width * pixelratio, height * 
                 pixelratio, res * pixelratio), pixelratio = pixelratio, 
             alt = if (anyNA(alt)) getAltText(value) else alt, res = res)
     })
155: force(expr)
154: domain$wrapSync(expr)
153: promises::with_promise_domain(domain, {
         hybrid_chain(func(), function(value) {
             res <- withVisible(value)
             if (res$visible) {
                 print.ggplot <- custom_print.ggplot
                 utils::capture.output({
                     result <- ..stacktraceon..(print(res$value))
                 })
                 result
             }
             else {
                 NULL
             }
         }, function(value) {
             list(plotResult = value, recordedPlot = grDevices::recordPlot(), 
                 coordmap = getCoordmap(value, width * pixelratio, 
                     height * pixelratio, res * pixelratio), pixelratio = pixelratio, 
                 alt = if (anyNA(alt)) getAltText(value) else alt, 
                 res = res)
         })
     })
152: force(expr)
151: withVisible(force(expr))
150: withCallingHandlers(expr, error = doCaptureStack)
149: domain$wrapSync(expr)
148: promises::with_promise_domain(createStackTracePromiseDomain(), 
         expr)
147: captureStackTraces({
         result <- withVisible(force(expr))
         if (promises::is.promising(result$value)) {
             p <- promise_chain(valueWithVisible(result), ..., catch = catch, 
                 finally = finally)
             runFinally <- FALSE
             p
         }
         else {
             result <- Reduce(function(v, func) {
                 if (v$visible) {
                     withVisible(func(v$value))
                 }
                 else {
                     withVisible(func(invisible(v$value)))
                 }
             }, list(...), result)
             valueWithVisible(result)
         }
     })
146: doTryCatch(return(expr), name, parentenv, handler)
145: tryCatchOne(expr, names, parentenv, handlers[[1L]])
144: tryCatchList(expr, classes, parentenv, handlers)
143: tryCatch({
         captureStackTraces({
             result <- withVisible(force(expr))
             if (promises::is.promising(result$value)) {
                 p <- promise_chain(valueWithVisible(result), ..., 
                     catch = catch, finally = finally)
                 runFinally <- FALSE
                 p
             }
             else {
                 result <- Reduce(function(v, func) {
                     if (v$visible) {
                       withVisible(func(v$value))
                     }
                     else {
                       withVisible(func(invisible(v$value)))
                     }
                 }, list(...), result)
                 valueWithVisible(result)
             }
         })
     }, error = function(e) {
         if (!is.null(catch)) 
             catch(e)
         else stop(e)
     }, finally = if (runFinally && !is.null(finally)) finally())
142: do()
141: hybrid_chain(promises::with_promise_domain(domain, {
         hybrid_chain(func(), function(value) {
             res <- withVisible(value)
             if (res$visible) {
                 print.ggplot <- custom_print.ggplot
                 utils::capture.output({
                     result <- ..stacktraceon..(print(res$value))
                 })
                 result
             }
             else {
                 NULL
             }
         }, function(value) {
             list(plotResult = value, recordedPlot = grDevices::recordPlot(), 
                 coordmap = getCoordmap(value, width * pixelratio, 
                     height * pixelratio, res * pixelratio), pixelratio = pixelratio, 
                 alt = if (anyNA(alt)) getAltText(value) else alt, 
                 res = res)
         })
     }), finally = function() {
         grDevices::dev.off(device)
         if (length(showtextOpts)) {
             showtext::showtext_opts(showtextOpts)
         }
     })
140: force(expr)
139: withVisible(force(expr))
138: withCallingHandlers(expr, error = doCaptureStack)
137: domain$wrapSync(expr)
136: promises::with_promise_domain(createStackTracePromiseDomain(), 
         expr)
135: captureStackTraces({
         result <- withVisible(force(expr))
         if (promises::is.promising(result$value)) {
             p <- promise_chain(valueWithVisible(result), ..., catch = catch, 
                 finally = finally)
             runFinally <- FALSE
             p
         }
         else {
             result <- Reduce(function(v, func) {
                 if (v$visible) {
                     withVisible(func(v$value))
                 }
                 else {
                     withVisible(func(invisible(v$value)))
                 }
             }, list(...), result)
             valueWithVisible(result)
         }
     })
134: doTryCatch(return(expr), name, parentenv, handler)
133: tryCatchOne(expr, names, parentenv, handlers[[1L]])
132: tryCatchList(expr, classes, parentenv, handlers)
131: tryCatch({
         captureStackTraces({
             result <- withVisible(force(expr))
             if (promises::is.promising(result$value)) {
                 p <- promise_chain(valueWithVisible(result), ..., 
                     catch = catch, finally = finally)
                 runFinally <- FALSE
                 p
             }
             else {
                 result <- Reduce(function(v, func) {
                     if (v$visible) {
                       withVisible(func(v$value))
                     }
                     else {
                       withVisible(func(invisible(v$value)))
                     }
                 }, list(...), result)
                 valueWithVisible(result)
             }
         })
     }, error = function(e) {
         if (!is.null(catch)) 
             catch(e)
         else stop(e)
     }, finally = if (runFinally && !is.null(finally)) finally())
130: do()
129: hybrid_chain(hybrid_chain(promises::with_promise_domain(domain, 
         {
             hybrid_chain(func(), function(value) {
                 res <- withVisible(value)
                 if (res$visible) {
                     print.ggplot <- custom_print.ggplot
                     utils::capture.output({
                       result <- ..stacktraceon..(print(res$value))
                     })
                     result
                 }
                 else {
                     NULL
                 }
             }, function(value) {
                 list(plotResult = value, recordedPlot = grDevices::recordPlot(), 
                     coordmap = getCoordmap(value, width * pixelratio, 
                       height * pixelratio, res * pixelratio), pixelratio = pixelratio, 
                     alt = if (anyNA(alt)) getAltText(value) else alt, 
                     res = res)
             })
         }), finally = function() {
         grDevices::dev.off(device)
         if (length(showtextOpts)) {
             showtext::showtext_opts(showtextOpts)
         }
     }), function(result) {
         result$img <- dropNulls(list(src = session$fileUrl(name, 
             outfile, contentType = "image/png"), width = width, height = height, 
             alt = result$alt, coordmap = result$coordmap, error = attr(result$coordmap, 
                 "error", exact = TRUE)))
         result
     }, finally = function() {
         unlink(outfile)
     })
128: drawPlot(name = "macd_chart", session = <environment>, func = structure(function () 
     {
         ..stacktraceon..(renderPlot())
     }, wrappedFunc = function () 
     {
         dt <- dt_reactive()
         p <- macd_chart(dt)
         print(p)
     }), width = 1086.47827148438, height = 199.992141723633, alt = NA, 
         pixelratio = 1.02, res = 72)
127: do.call("drawPlot", c(list(name = outputName, session = session, 
         func = func, width = dims$width, height = dims$height, alt = altWrapper(), 
         pixelratio = pixelratio, res = res), args))
126: force(expr)
125: withVisible(force(expr))
124: withCallingHandlers(expr, error = doCaptureStack)
123: domain$wrapSync(expr)
122: promises::with_promise_domain(createStackTracePromiseDomain(), 
         expr)
121: captureStackTraces({
         result <- withVisible(force(expr))
         if (promises::is.promising(result$value)) {
             p <- promise_chain(valueWithVisible(result), ..., catch = catch, 
                 finally = finally)
             runFinally <- FALSE
             p
         }
         else {
             result <- Reduce(function(v, func) {
                 if (v$visible) {
                     withVisible(func(v$value))
                 }
                 else {
                     withVisible(func(invisible(v$value)))
                 }
             }, list(...), result)
             valueWithVisible(result)
         }
     })
120: doTryCatch(return(expr), name, parentenv, handler)
119: tryCatchOne(expr, names, parentenv, handlers[[1L]])
118: tryCatchList(expr, classes, parentenv, handlers)
117: tryCatch({
         captureStackTraces({
             result <- withVisible(force(expr))
             if (promises::is.promising(result$value)) {
                 p <- promise_chain(valueWithVisible(result), ..., 
                     catch = catch, finally = finally)
                 runFinally <- FALSE
                 p
             }
             else {
                 result <- Reduce(function(v, func) {
                     if (v$visible) {
                       withVisible(func(v$value))
                     }
                     else {
                       withVisible(func(invisible(v$value)))
                     }
                 }, list(...), result)
                 valueWithVisible(result)
             }
         })
     }, error = function(e) {
         if (!is.null(catch)) 
             catch(e)
         else stop(e)
     }, finally = if (runFinally && !is.null(finally)) finally())
116: do()
115: hybrid_chain({
         dims <- if (execOnResize) 
             getDims()
         else isolate(getDims())
         pixelratio <- session$clientData$pixelratio %||% 1
         do.call("drawPlot", c(list(name = outputName, session = session, 
             func = func, width = dims$width, height = dims$height, 
             alt = altWrapper(), pixelratio = pixelratio, res = res), 
             args))
     }, catch = function(reason) {
         getDims()
         stop(reason)
     })
114: `<reactive:plotObj>`(...)
113: ..stacktraceon..(`<reactive:plotObj>`(...))
112: .func()
111: withVisible(.func())
110: withCallingHandlers({
         .error <<- FALSE
         withVisible(.func())
     }, error = function(cond) {
         .value <<- cond
         .error <<- TRUE
         .visible <<- FALSE
     })
109: contextFunc()
108: env$runWith(self, func)
107: force(expr)
106: domain$wrapSync(expr)
105: promises::with_promise_domain(createVarPromiseDomain(.globals, 
         "domain", domain), expr)
104: withReactiveDomain(.domain, {
         env <- .getReactiveEnvironment()
         rLog$enter(.reactId, id, .reactType, .domain)
         on.exit(rLog$exit(.reactId, id, .reactType, .domain), add = TRUE)
         env$runWith(self, func)
     })
103: domain$wrapSync(expr)
102: promises::with_promise_domain(reactivePromiseDomain(), {
         withReactiveDomain(.domain, {
             env <- .getReactiveEnvironment()
             rLog$enter(.reactId, id, .reactType, .domain)
             on.exit(rLog$exit(.reactId, id, .reactType, .domain), 
                 add = TRUE)
             env$runWith(self, func)
         })
     })
101: ctx$run(function() {
         result <- withCallingHandlers({
             .error <<- FALSE
             withVisible(.func())
         }, error = function(cond) {
             .value <<- cond
             .error <<- TRUE
             .visible <<- FALSE
         })
         .value <<- result$value
         .visible <<- result$visible
     })
100: self$.updateValue()
99: ..stacktraceoff..(self$.updateValue())
98: drawReactive()
97: force(expr)
96: withVisible(force(expr))
95: withCallingHandlers(expr, error = doCaptureStack)
94: domain$wrapSync(expr)
93: promises::with_promise_domain(createStackTracePromiseDomain(), 
        expr)
92: captureStackTraces({
        result <- withVisible(force(expr))
        if (promises::is.promising(result$value)) {
            p <- promise_chain(valueWithVisible(result), ..., catch = catch, 
                finally = finally)
            runFinally <- FALSE
            p
        }
        else {
            result <- Reduce(function(v, func) {
                if (v$visible) {
                    withVisible(func(v$value))
                }
                else {
                    withVisible(func(invisible(v$value)))
                }
            }, list(...), result)
            valueWithVisible(result)
        }
    })
91: doTryCatch(return(expr), name, parentenv, handler)
90: tryCatchOne(expr, names, parentenv, handlers[[1L]])
89: tryCatchList(expr, classes, parentenv, handlers)
88: tryCatch({
        captureStackTraces({
            result <- withVisible(force(expr))
            if (promises::is.promising(result$value)) {
                p <- promise_chain(valueWithVisible(result), ..., 
                    catch = catch, finally = finally)
                runFinally <- FALSE
                p
            }
            else {
                result <- Reduce(function(v, func) {
                    if (v$visible) {
                      withVisible(func(v$value))
                    }
                    else {
                      withVisible(func(invisible(v$value)))
                    }
                }, list(...), result)
                valueWithVisible(result)
            }
        })
    }, error = function(e) {
        if (!is.null(catch)) 
            catch(e)
        else stop(e)
    }, finally = if (runFinally && !is.null(finally)) finally())
87: do()
86: hybrid_chain(drawReactive(), function(result) {
        dims <- getDims()
        pixelratio <- session$clientData$pixelratio %||% 1
        result <- do.call("resizeSavedPlot", c(list(name, shinysession, 
            result, dims$width, dims$height, altWrapper(), pixelratio, 
            res), args))
        result$img
    })
85: renderFunc(...)
84: `output$macd_chart`(...)
83: ..stacktraceon..(`output$macd_chart`(...))
82: orig(name = name, shinysession = self)
81: func()
80: withCallingHandlers(expr, error = doCaptureStack)
79: domain$wrapSync(expr)
78: promises::with_promise_domain(createStackTracePromiseDomain(), 
        expr)
77: captureStackTraces(expr)
76: withCallingHandlers(captureStackTraces(expr), error = function(e) {
        if (cnd_inherits(e, "shiny.silent.error")) 
            return()
        handle <- getOption("shiny.error")
        if (is.function(handle)) 
            handle()
    })
75: shinyCallingHandlers(func())
74: force(expr)
73: domain$wrapSync(expr)
72: promises::with_promise_domain(createVarPromiseDomain(private, 
        "currentOutputName", name), expr)
71: private$withCurrentOutput(name, {
        shinyCallingHandlers(func())
    })
70: force(expr)
69: withVisible(force(expr))
68: withCallingHandlers(expr, error = doCaptureStack)
67: domain$wrapSync(expr)
66: promises::with_promise_domain(createStackTracePromiseDomain(), 
        expr)
65: captureStackTraces({
        result <- withVisible(force(expr))
        if (promises::is.promising(result$value)) {
            p <- promise_chain(valueWithVisible(result), ..., catch = catch, 
                finally = finally)
            runFinally <- FALSE
            p
        }
        else {
            result <- Reduce(function(v, func) {
                if (v$visible) {
                    withVisible(func(v$value))
                }
                else {
                    withVisible(func(invisible(v$value)))
                }
            }, list(...), result)
            valueWithVisible(result)
        }
    })
64: doTryCatch(return(expr), name, parentenv, handler)
63: tryCatchOne(expr, names, parentenv, handlers[[1L]])
62: tryCatchList(expr, classes, parentenv, handlers)
61: tryCatch({
        captureStackTraces({
            result <- withVisible(force(expr))
            if (promises::is.promising(result$value)) {
                p <- promise_chain(valueWithVisible(result), ..., 
                    catch = catch, finally = finally)
                runFinally <- FALSE
                p
            }
            else {
                result <- Reduce(function(v, func) {
                    if (v$visible) {
                      withVisible(func(v$value))
                    }
                    else {
                      withVisible(func(invisible(v$value)))
                    }
                }, list(...), result)
                valueWithVisible(result)
            }
        })
    }, error = function(e) {
        if (!is.null(catch)) 
            catch(e)
        else stop(e)
    }, finally = if (runFinally && !is.null(finally)) finally())
60: do()
59: hybrid_chain({
        private$withCurrentOutput(name, {
            shinyCallingHandlers(func())
        })
    }, catch = function(cond) {
        if (inherits(cond, "shiny.custom.error")) {
            if (isTRUE(getOption("show.error.messages"))) 
                printError(cond)
            structure(list(), class = "try-error", condition = cond)
        }
        else if (inherits(cond, "shiny.output.cancel")) {
            structure(list(), class = "cancel-output")
        }
        else if (cnd_inherits(cond, "shiny.silent.error")) {
            while (!inherits(cond, "shiny.silent.error")) {
                cond <- cond$parent
            }
            structure(list(), class = "try-error", condition = cond)
        }
        else {
            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))
        }
    })
58: force(expr)
57: withVisible(force(expr))
56: withCallingHandlers(expr, error = doCaptureStack)
55: domain$wrapSync(expr)
54: promises::with_promise_domain(createStackTracePromiseDomain(), 
        expr)
53: captureStackTraces({
        result <- withVisible(force(expr))
        if (promises::is.promising(result$value)) {
            p <- promise_chain(valueWithVisible(result), ..., catch = catch, 
                finally = finally)
            runFinally <- FALSE
            p
        }
        else {
            result <- Reduce(function(v, func) {
                if (v$visible) {
                    withVisible(func(v$value))
                }
                else {
                    withVisible(func(invisible(v$value)))
                }
            }, list(...), result)
            valueWithVisible(result)
        }
    })
52: doTryCatch(return(expr), name, parentenv, handler)
51: tryCatchOne(expr, names, parentenv, handlers[[1L]])
50: tryCatchList(expr, classes, parentenv, handlers)
49: tryCatch({
        captureStackTraces({
            result <- withVisible(force(expr))
            if (promises::is.promising(result$value)) {
                p <- promise_chain(valueWithVisible(result), ..., 
                    catch = catch, finally = finally)
                runFinally <- FALSE
                p
            }
            else {
                result <- Reduce(function(v, func) {
                    if (v$visible) {
                      withVisible(func(v$value))
                    }
                    else {
                      withVisible(func(invisible(v$value)))
                    }
                }, list(...), result)
                valueWithVisible(result)
            }
        })
    }, error = function(e) {
        if (!is.null(catch)) 
            catch(e)
        else stop(e)
    }, finally = if (runFinally && !is.null(finally)) finally())
48: do()
47: hybrid_chain(hybrid_chain({
        private$withCurrentOutput(name, {
            shinyCallingHandlers(func())
        })
    }, catch = function(cond) {
        if (inherits(cond, "shiny.custom.error")) {
            if (isTRUE(getOption("show.error.messages"))) 
                printError(cond)
            structure(list(), class = "try-error", condition = cond)
        }
        else if (inherits(cond, "shiny.output.cancel")) {
            structure(list(), class = "cancel-output")
        }
        else if (cnd_inherits(cond, "shiny.silent.error")) {
            while (!inherits(cond, "shiny.silent.error")) {
                cond <- cond$parent
            }
            structure(list(), class = "try-error", condition = cond)
        }
        else {
            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))
        }
    }), function(value) {
        self$requestFlush()
        private$sendMessage(recalculating = list(name = name, status = "recalculated"))
        if (inherits(value, "cancel-output")) {
            return()
        }
        private$invalidatedOutputErrors$remove(name)
        private$invalidatedOutputValues$remove(name)
        if (inherits(value, "try-error")) {
            cond <- attr(value, "condition")
            type <- setdiff(class(cond), c("simpleError", "error", 
                "condition"))
            private$invalidatedOutputErrors$set(name, list(message = cond$message, 
                call = utils::capture.output(print(cond$call)), type = if (length(type)) type))
        }
        else private$invalidatedOutputValues$set(name, value)
    })
46: observe()
45: `<observer:output$macd_chart>`(...)
44: contextFunc()
43: env$runWith(self, func)
42: force(expr)
41: domain$wrapSync(expr)
40: promises::with_promise_domain(createVarPromiseDomain(.globals, 
        "domain", domain), expr)
39: withReactiveDomain(.domain, {
        env <- .getReactiveEnvironment()
        rLog$enter(.reactId, id, .reactType, .domain)
        on.exit(rLog$exit(.reactId, id, .reactType, .domain), add = TRUE)
        env$runWith(self, func)
    })
38: domain$wrapSync(expr)
37: promises::with_promise_domain(reactivePromiseDomain(), {
        withReactiveDomain(.domain, {
            env <- .getReactiveEnvironment()
            rLog$enter(.reactId, id, .reactType, .domain)
            on.exit(rLog$exit(.reactId, id, .reactType, .domain), 
                add = TRUE)
            env$runWith(self, func)
        })
    })
36: ctx$run(.func)
35: run()
34: withCallingHandlers(expr, error = doCaptureStack)
33: domain$wrapSync(expr)
32: promises::with_promise_domain(createStackTracePromiseDomain(), 
        expr)
31: captureStackTraces(expr)
30: withCallingHandlers(captureStackTraces(expr), error = function(e) {
        if (cnd_inherits(e, "shiny.silent.error")) 
            return()
        handle <- getOption("shiny.error")
        if (is.function(handle)) 
            handle()
    })
29: shinyCallingHandlers(run())
28: force(expr)
27: withVisible(force(expr))
26: withCallingHandlers(expr, error = doCaptureStack)
25: domain$wrapSync(expr)
24: promises::with_promise_domain(createStackTracePromiseDomain(), 
        expr)
23: captureStackTraces({
        result <- withVisible(force(expr))
        if (promises::is.promising(result$value)) {
            p <- promise_chain(valueWithVisible(result), ..., catch = catch, 
                finally = finally)
            runFinally <- FALSE
            p
        }
        else {
            result <- Reduce(function(v, func) {
                if (v$visible) {
                    withVisible(func(v$value))
                }
                else {
                    withVisible(func(invisible(v$value)))
                }
            }, list(...), result)
            valueWithVisible(result)
        }
    })
22: doTryCatch(return(expr), name, parentenv, handler)
21: tryCatchOne(expr, names, parentenv, handlers[[1L]])
20: tryCatchList(expr, classes, parentenv, handlers)
19: tryCatch({
        captureStackTraces({
            result <- withVisible(force(expr))
            if (promises::is.promising(result$value)) {
                p <- promise_chain(valueWithVisible(result), ..., 
                    catch = catch, finally = finally)
                runFinally <- FALSE
                p
            }
            else {
                result <- Reduce(function(v, func) {
                    if (v$visible) {
                      withVisible(func(v$value))
                    }
                    else {
                      withVisible(func(invisible(v$value)))
                    }
                }, list(...), result)
                valueWithVisible(result)
            }
        })
    }, error = function(e) {
        if (!is.null(catch)) 
            catch(e)
        else stop(e)
    }, finally = if (runFinally && !is.null(finally)) finally())
18: do()
17: hybrid_chain({
        if (!.destroyed) {
            shinyCallingHandlers(run())
        }
    }, catch = function(e) {
        if (cnd_inherits(e, "shiny.silent.error")) {
            return()
        }
        printError(e)
        if (!is.null(.domain)) {
            .domain$unhandledError(e)
        }
    }, finally = .domain$decrementBusyCount)
16: flushCallback()
15: FUN(X[[i]], ...)
14: lapply(.flushCallbacks, function(flushCallback) {
        flushCallback()
    })
13: ctx$executeFlushCallbacks()
12: .getReactiveEnvironment()$flush()
11: flushReact()
10: serviceApp()
9: ..stacktracefloor..(serviceApp())
8: withCallingHandlers(expr, error = doCaptureStack)
7: domain$wrapSync(expr)
6: promises::with_promise_domain(createStackTracePromiseDomain(), 
       expr)
5: captureStackTraces({
       while (!.globals$stopped) {
           ..stacktracefloor..(serviceApp())
       }
   })
4: ..stacktraceoff..(captureStackTraces({
       while (!.globals$stopped) {
           ..stacktracefloor..(serviceApp())
       }
   }))
3: runApp(x)
2: print.shiny.appobj(x)
1: (function (x, ...) 
   UseMethod("print"))(x)

I checked out the source code I believe this is where the failure is occurring; I will tinker with this today a bit:

#' @export
to_basic.GeomVline <- function(data, prestats_data, layout, params, p, ...) {
  # ugh, we can't trust the group here
  data$group <- do.call(paste,
    data[!grepl("group", names(data)) & !vapply(data, anyNA, logical(1))]
  )
  y <- if (inherits(p$coordinates, "CoordFlip")) "x" else "y"
  lay <- tidyr::pivot_longer(
    data = layout$layout, cols = paste0(y, c("_min", "_max")), values_to = y, names_to = "variable"
  ) 
  lay <- as.data.frame(lay)
  data <- merge(lay[c("PANEL", y)], data, by = "PANEL")
  data[["y"]] <- data[[y]]
  data[["x"]] <- data$xintercept
  prefix_class(data, c("GeomVline", "GeomPath"))
}

@cpsievert

This function attempts to merge these two objects:

data <- merge(lay[c("PANEL", y)], data, by = "PANEL")

I am browsing here and see that the data object is empty, and thus it cannot be merged; this will obviously throw an error. Indeed, this is the source of the error.

Can someone tell me the expected behaviour here; what should we do? A tryCatch or return some default/empty object? @cpsievert

If someone can help me understand the convention of what to return here, I'll fix it and submit a pull request for this today.

Browse[1]> lay[c("PANEL", y)]
  PANEL         y
1     1  5354.531
2     1 12343.073

Browse[1]> data
[1] group
<0 rows> (or 0-length row.names)

Note for consistency I believe that to_basic.GeomHline will have to be modified as well to allow for non-existing lines.

Navigation Menu

Repository navigation

`ggplotly` fails with an empty layer of `geom_vline` #1947

Metadata

Assignees

Labels

Type

Projects

Milestone

Relationships

Development

ggplotly fails with an empty layer of geom_vline #1947

Description

Activity

dereckmezquita commented on Apr 9, 2023

dereckmezquita commented on Apr 9, 2023

dereckmezquita commented on Apr 9, 2023

Metadata

Metadata

Assignees

Labels

Type

Projects

Milestone

Relationships

Development

Issue actions

`ggplotly` fails with an empty layer of `geom_vline` #1947