从闪亮的app中的表达式中选择列

时间:2017-09-14 17:22:02

标签: r shiny

我正在尝试构建一个闪亮的仪表板应用程序,我在其中处理输入数据并根据用户提供的分组变量生成摘要统计信息。最后一步,我被困住了 实现一个工作函数,使用户能够在计算摘要统计信息后选择仅显示列的子集。 我的尝试是在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)

0 个答案:

没有答案