Select columns from expression in shiny app - r

Question

I am trying to build a shiny dashboard app, where I process the input data and produce summary statistics based on the user supplied grouping variables. The last step, where I am stuck is to
implement a working function , which enables the user to select to display only a subset of the columns after the calculation of the summary statistics.
My attempt is in the lines after output$select_col in global.R . Right now each time I try to use the selector shiny crashes with the error "incorrect number of dimensions".
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)