Shiny & Plotly reactive amount rows in subplots based on length of CheckBoxGroupButtons (ERROR: (list) object cannot be coerced to type 'double')

Shiny & Plotly reactive amount rows in subplots based on length of CheckBoxGroupButtons (ERROR: (list) object cannot be coerced to type 'double')

任何帮助将不胜感激我已经为此苦苦挣扎了一段时间。下面的 Reprex。

我正在尝试使用闪亮的复选框输入 plotly::subplot(nrows = ?)。

输入是数据集,因此它们都有不同的 Y 值,但将沿着相同的 X 轴绘制,因此 shareX = TRUE。

如果我指定 nrow = 3 并且所有的框都被选中,我可以绘制轨迹,但我希望它以所选输入的 数量 为条件。只选择了两个输入?绘制两行。只选择了一个输入?甚至不要使用子图。这就是为什么我包括了 nrows = length(input$choices)。当所有三个都被检查时,这才有效!

但是当我把它分成“if else”语句来指定我是否想要子图时它不起作用,当我检查 n < 3 个输入时它不起作用。

相反,我得到了错误:(list) object cannot be coerced to type 'double'

我认为错误来自条件语句如何解释长度(输入$选择)和/或子图如何解释要绘制的轨迹列表。

library(shiny)
library(plotly)
library(dplyr)
library(tidyverse)

ui <- fluidPage(
    
    sidebarLayout(
        sidebarPanel(
            checkboxGroupInput("choices",
                        "Inputs:",
                        choices = c("Three", "Four", "Five"))
        ),

        mainPanel(
           plotlyOutput("distPlot")
        )
    )
)

server <- function(input, output) {
    gear5 <- reactive({
        req("Five" %in% input$choices)
    mtcars %>% filter(gear == 5)})
    
    gear4 <- reactive({
        req("Four" %in% input$choices)
        mtcars %>% filter(gear == 4)})
    
    gear3 <- reactive({
        req("Three" %in% input$choices)
        mtcars %>% filter(gear == 3)})
    
    output$distPlot <- renderPlotly({
        if (length(input$choices) > 1) {
        fig <- plot_ly() %>% add_trace(data = gear3(), x = gear3()$mpg, y = gear3()$disp, type = "scatter", mode = "lines") %>% 
                add_trace(data = gear4(), x = gear4()$mpg, y = gear4()$wt, type = "scatter", mode = "lines") %>% 
                add_trace(data = gear5(), x = gear5()$mpg, y = gear5()$qsec, type = "scatter", mode = "lines") 
        
        subplot(fig, shareX = TRUE, nrows = length(input$choices))

        }
        else if (length(input$choices) == 1) {
            plot_ly() %>% add_trace(data = gear3(), x = gear3()$mpg, y = gear3()$disp, type = "scatter", mode = "lines") %>% 
                add_trace(data = gear4(), x = gear4()$mpg, y = gear4()$wt, type = "scatter", mode = "lines") %>% 
                add_trace(data = gear5(), x = gear5()$mpg, y = gear5()$qsec, type = "scatter", mode = "lines")
        }
        
        
    })
}

shinyApp(ui = ui, server = server)

这里是成功制作所需图形但对所选输入或所选输入数量没有反应的绘图代码。

例如这是包含所有三个输入的图形的图片。1 <- 所需输出

 output$distPlot <- renderPlotly({
        fig1 <- plot_ly() %>% add_trace(data = gear3(), x = gear3()$mpg, y = gear3()$disp, type = "scatter", mode = "lines")
        fig2 <- plot_ly() %>% add_trace(data = gear4(), x = gear4()$mpg, y = gear4()$wt, type = "scatter", mode = "lines") 
        fig3 <- plot_ly() %>% add_trace(data = gear5(), x = gear5()$mpg, y = gear5()$qsec, type = "scatter", mode = "lines") 
        
        subplot(fig1, fig2, nrows = 2, shareX = TRUE)
        
        
    })

一旦指定了要绘制的对象,它就会起作用。这是满足您需求的一种方式。

试试这个:

server <- function(input, output) {
  gear5 <- reactive({
    if ("Five" %in% req(input$choices)) mtcars %>% filter(gear == 5)
    else return(NULL)
    })
  
  gear4 <- reactive({
    if ("Four" %in% req(input$choices))
    mtcars %>% filter(gear == 4)})
  
  gear3 <- reactive({
    if ("Three" %in% req(input$choices))
    mtcars %>% filter(gear == 3)})
  
  output$distPlot <- renderPlotly({
    req(input$choices)
    if (!is.null(gear3())) {
      fig3 <- plot_ly() %>% 
        add_trace(data = gear3(), x = gear3()$mpg, y = gear3()$disp, type = "scatter", mode = "lines") 
    }
    if (!is.null(gear4())) {
      fig4 <- plot_ly() %>% 
        add_trace(data = gear4(), x = gear4()$mpg, y = gear4()$disp, type = "scatter", mode = "lines") 
    }
    if (!is.null(gear5())) {
      fig5 <- plot_ly() %>% 
        add_trace(data = gear5(), x = gear5()$mpg, y = gear5()$disp, type = "scatter", mode = "lines") 
    }
    
    if (length(input$choices) > 1) {
      # fig <- plot_ly() %>% 
      #   add_trace(data = gear3(), x = gear3()$mpg, y = gear3()$disp, type = "scatter", mode = "lines") %>% 
      #   add_trace(data = gear4(), x = gear4()$mpg, y = gear4()$wt, type = "scatter", mode = "lines") %>% 
      #   add_trace(data = gear5(), x = gear5()$mpg, y = gear5()$qsec, type = "scatter", mode = "lines") 
      
      if (length(input$choices)==3){
        myplots <- list(fig3, fig4, fig5)
      }else{
        if (is.null(gear3())) myplots <- list(fig4, fig5)
        else if (is.null(gear4())) myplots <- list(fig3, fig5)
        else if (is.null(gear5())) myplots <- list(fig3, fig4)
      }
      
      fig <- subplot(myplots, shareX = TRUE, nrows = length(input$choices))
      
    }
    else if (length(input$choices) == 1) {
      fig <- plot_ly() %>% 
        add_trace(data = gear3(), x = gear3()$mpg, y = gear3()$disp, type = "scatter", mode = "lines") %>% 
        add_trace(data = gear4(), x = gear4()$mpg, y = gear4()$wt, type = "scatter", mode = "lines") %>% 
        add_trace(data = gear5(), x = gear5()$mpg, y = gear5()$qsec, type = "scatter", mode = "lines")
    }
    fig
    
  })
}

YBS 发布了一个很好的答案,但如果人们有 4 个输入而不是 3 个,我想添加。如果是这样,您必须在条件语句中使用 &&。

这是我一直在处理的案例中的一个示例。

if ( is.null(gitDataEDA()) && is.null(gitDataHRV()) ) myplots <- list(fig3, fig4) ## temp bvp
else if ( is.null(gitDataBVP()) && is.null(gitDataTEMP()) ) myplots <- list(fig1, fig2) # eda hrv
else if ( is.null(gitDataHRV()) && is.null(gitDataTEMP()) ) myplots <- list(fig1, fig4) #eda bvp 
else if ( is.null(gitDataBVP()) && is.null(gitDataHRV()) ) myplots <- list(fig1, fig3) #temp eda
else if ( is.null(gitDataTEMP()) && is.null(gitDataEDA()) ) myplots <- list(fig2, fig4) #hrv bvp
else if ( is.null(gitDataBVP()) && is.null(gitDataEDA()) ) myplots <- list(fig3, fig2) #temp hrv