2017-04-12 13 views
-1

차트 아래에 차트와 DT 패키지의 HTML5 DataTable이있는 반짝이는 대시 보드를 만들려고합니다. 차트가 DataTable에 연결되어 DataTable을 필터링하면 차트가 필터링됩니다.Shiny & DT DataTable을 사용하여 ggvis 스택 막대 차트를 만들 때 "오류 : 길이 : 논리 인덱스 벡터 길이"

나는 성공적으로 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) 

며칠 동안 고생했습니다. 어떤 도움이라도 대단히 감사하겠습니다.

답변

0

처음에는 input$html_data_table_rows_allNULL이므로이 현상이 발생합니다. 따라서 반응 코드가 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") 
    } 
    }) 
} 

희망 하시겠습니까?