使用Shiny&创建ggvis堆栈条形图时出现“错误:逻辑索引向量的长度” DT DataTable

时间:2017-04-12 09:36:32

标签: r shiny data.table ggvis dt

我正在尝试构建一个闪亮的仪表板,其中包含图表和图表下方DT Package的HTML5 DataTable。图表连接到DataTable,以便过滤DataTable将过滤图表。

我能够成功地为ggvis散点图提供此功能但是当我尝试对条形图执行相同操作时,我收到错误Error in: Length of logical index vector must be 1 or 10, got: 0

以下是适用于散点图的server.R

server <- function(input, output) { 


  server_DF <- data.frame(dataset)


  output$html_data_table <- DT::renderDataTable({
    DT::datatable(unique(server_DF[, input$show_vars, drop = FALSE]),
                  filter = "top", selection = "multiple")
  })



  filtered_rows <- reactive({
    input$html_data_table_rows_all
  })



  vis <- reactive({
        # filtered_rows <- input$html_data_table_rows_all

        xvar <- prop("x", as.symbol(input$xvar))
        yvar <- prop("y", as.symbol(input$yvar))
        colvar <- prop("fill", as.symbol(input$colvar))                                   


        p <- server_DF[filtered_rows(),] %>%
        ggvis(x = xvar, y = yvar, fill := colvar) %>%
        layer_points() %>%
        set_options(width = "auto", height = "auto", resizable=FALSE)

        p


          })



  vis %>% bind_shiny("plot", "ggvis_ui")


}

以下是条形图的代码,它给出了错误。请注意,上面代码中唯一不同的是layer_bars() layer_points()

server <- function(input, output) { 


  server_DF <- data.frame(dataset)


  output$html_data_table <- DT::renderDataTable({
    DT::datatable(unique(server_DF[, input$show_vars, drop = FALSE]),
                  filter = "top", selection = "multiple")
  })



  filtered_rows <- reactive({
    input$html_data_table_rows_all
  })



  vis <- reactive({
        # filtered_rows <- input$html_data_table_rows_all

        xvar <- prop("x", as.symbol(input$xvar))
        yvar <- prop("y", as.symbol(input$yvar))
        colvar <- prop("fill", as.symbol(input$colvar))                                   


        p <- server_DF[filtered_rows(),] %>%
        ggvis(x = xvar, y = yvar, fill := colvar) %>%
        layer_bars() %>%
        set_options(width = "auto", height = "auto", resizable=FALSE)

        p


          })



  vis %>% bind_shiny("plot", "ggvis_ui")

}

发现如果我删除fill := colvar,它会产生直方图。但是,当我按照我为散点图所做的fill := colvar时,我得到了一个错误。

以下是包含ui.R的完整代码和散点图的示例数据。只想复制下面的堆积条。

library(shiny)
library(data.table)
library(ggvis)
library(DT)


data("diamonds")

dataset <- diamonds
rm(diamonds)

axis_vars <- names(dataset)

ui <- fluidPage(pageWithSidebar(

  headerPanel("Sample Dashboard"),

  sidebarPanel(

    selectInput('xvar', 'X Axis', axis_vars, selected = axis_vars[2]),
    selectInput('yvar', 'Y Axis', axis_vars, selected = axis_vars[7]),
    selectInput("colvar", "Colour", axis_vars, selected = axis_vars[4])

  ),

  mainPanel(
    fluidRow(
      ggvisOutput("plot")
    ),

    fluidRow(
    column(width = 4,
           checkboxGroupInput('show_vars', 'Select Columns To Display',
                              names(dataset),selected = names(dataset))
           ),
    column(width = 8,
           div(style = 'overflow-x: scroll', DT::dataTableOutput('html_data_table'))
           )

    )

  )
))


server <- function(input, output) { 


  server_DF <- data.frame(dataset)


  output$html_data_table <- DT::renderDataTable({
    DT::datatable(unique(server_DF[, input$show_vars, drop = FALSE]),
                  filter = "top", selection = "multiple")
  })



  filtered_rows <- reactive({
    input$html_data_table_rows_all
  })



  vis <- reactive({
    # filtered_rows <- input$html_data_table_rows_all

    xvar <- prop("x", as.symbol(input$xvar))
    yvar <- prop("y", as.symbol(input$yvar))
    colvar <- prop("fill", as.symbol(input$colvar))                                   


    p <- server_DF[filtered_rows(),] %>%
      ggvis(x = xvar, y = yvar, fill = colvar) %>%
      layer_points()

    p


  })



  vis %>% bind_shiny("plot")


}

shinyApp(ui, server)

这几天一直在努力。任何帮助将不胜感激。

1 个答案:

答案 0 :(得分:0)

这种情况正在发生,因为input$html_data_table_rows_all在开始时是NULL。因此,只有在不是NULL时才需要保持运行该反应性代码的条件。我已经修改了你的服务器代码来做到这一点。

server <- function(input, output) { 

  server_DF <- data.frame(dataset)

  output$html_data_table <- DT::renderDataTable({
    DT::datatable(unique(server_DF[, input$show_vars, drop = FALSE]),
                  filter = "top", selection = "multiple")
  })


  filtered_rows <- reactive({
    input$html_data_table_rows_all
  })

  observe({

    #Check that the input for the plot is not NULL
    if(!is.null(input$html_data_table_rows_all)){

      vis <- reactive({
        # filtered_rows <- input$html_data_table_rows_all
        xvar <- prop("x", as.symbol(input$xvar))
        yvar <- prop("y", as.symbol(input$yvar))
        colvar <- prop("fill", as.symbol(input$colvar))                                   

        p <- server_DF[filtered_rows(),] %>%
          ggvis(x = xvar, y = yvar, fill = colvar) %>%
          layer_bars()
        p

      })

      vis %>% bind_shiny("plot")
    }
  })
} 

希望它有所帮助!