チャートの下にDTパッケージのチャートとHTML5データテーブルを持つ光沢のあるダッシュボードを作成しようとしています。グラフは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)
これは数日間苦労しています。どんな助けでも大歓迎です。