我正在尝试构建一个闪亮的仪表板应用程序,我在其中处理输入数据并根据用户提供的分组变量生成摘要统计信息。最后一步,我被困住了 实现一个工作函数,使用户能够在计算摘要统计信息后选择仅显示列的子集。 我的尝试是在global.R中输出$ select_col之后的行。现在每次我尝试使用选择器闪亮崩溃时出现错误“维数不正确”。
global.R
# Shiny
library(shiny)
library(shinydashboard)
library(shinyjs)
# Data tools
library(dplyr)
library(tidyr)
library(tibble)
library(data.table)
server.R
server <- function(input, output) {
raw_tables<-reactive({
mtcars
})
output$cyl <- renderUI({
selectInput(inputId = "cyl",
label = "Which number of cyl to consider",
choices = c(4,6,8),
selected = NULL,
multiple=TRUE)
})
filtered_tables<-
reactive({
if(is.null(input$cyl)){
data_filtered <- raw_tables()
}
else{
data_filtered <- raw_tables() %>% filter(cyl %in% input$cyl)
}
})
new_statistics <- reactive({
if(is.null(filtered_tables())){
return(NULL)
}
if(length(input$grouping_variables) == 0){
op <- filtered_tables() %>%
ungroup()
} else {
op <- filtered_tables() %>%
group_by_(.dots = input$grouping_variables)
}
op %>% #
summarise(nr_cars = n(),
mean_mpg = mean(mpg,na.rm=T),
sd_mpg = sd(mpg,na.rm=T))
})
nice_table <-reactive({
if(is.null(new_statistics())){
return(NULL)
}
DT::datatable(new_statistics(),
colnames = c(
"nbr cars"="nr_cars" ,
"mean mpg"="mean_mpg",
"sd mpg"="sd_mpg"
), selection = list(target = 'column') , extensions = c('ColReorder'), options = list(colReorder = TRUE)
) %>%
DT::formatRound(columns=c(
"nbr cars" ,
"mean mpg",
"sd mpg"),
digits=2)
})
output$select_col <- renderUI({
if(is.null(nice_table())){
return(NULL)
}
selectInput("col", "Select columns:", choices = colnames(nice_table()), selected=NULL, multiple=TRUE)
})
output$statistics = DT::renderDataTable({
if(length(input$col)>0)
{
return(DT::datatable(nice_table()[, colnames(nice_table()) %in% input$col]))
}
else
{
return(NULL)
}
})
}
ui.R
dbHeader <- dashboardHeader(title = "test",
titleWidth = 250)
sidebar <- dashboardSidebar(
width = sidebarWidth,
br(),
sidebarMenu(
menuItem(text = "Data View",
tabName = "dat_view",
icon = icon("cloud-download")
)
)
)
body <- dashboardBody(
# Add shinyJS mini-sidebar
shinyjs::useShinyjs(),
tabItems(
tabItem(tabName = "dat_view",
fluidPage(
sidebarLayout(
sidebarPanel(width=2,
selectInput(inputId = 'grouping_variables',
label = 'Which grouping var?',
choices = c("cyl","gear","carb"),
selected = NULL,
multiple=TRUE,
selectize=TRUE),
uiOutput("cyl"),
uiOutput("select_col")
)
,
mainPanel(
tabsetPanel(id="dat_view_tabs",
tabPanel(
'statistics',
DT::dataTableOutput(outputId='statistics')
)
)
)
)))))
ui <- dashboardPage(skin = "blue",
header = dbHeader,
sidebar = sidebar,
body = body)