我正在尝试构建一个闪亮的仪表板,其中包含图表和图表下方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)
这几天一直在努力。任何帮助将不胜感激。
答案 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")
}
})
}
希望它有所帮助!