首页 > 解决方案 > 基于 CheckBoxGroupButtons 长度的子图中的闪亮和 Plotly 反应量行(错误:(列表)对象不能被强制输入“双”)

问题描述

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

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

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

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

但是当我将它拆分为“if else”语句以指定我是否想要子图时它不起作用,并且当我检查 n < 3 个输入时它不起作用。

相反,我得到了错误:(列表)对象不能被强制输入'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)
        
        
    })

标签: rcheckboxshinyplotly

解决方案


一旦你指定了你想要绘制的那些,它就可以工作了。这是满足您需求的一种方式。

试试这个:

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
    
  })
}

输出


推荐阅读