Shiny R using input-variables for dynamic dplyr creation of dataTables

谁都会走 提交于 2021-02-08 09:55:53

问题


Target: Building a shiny-app which enables the user to make 3 inputs via Groupcheckboxfields:

  • Groupingvariables
  • Metricvariables
  • Statistics which are used in dplyr

look at this code first - it is executed without shiny and displays the to be achived results:

 library("plyr")
library("dplyr")

## Without shiny - it works!

groupss <- c("gear", "carb")
statistics <- c("min", "max", "mean")
metrics <- c("drat", "hp")

grp_cols <- names(mtcars[colnames(mtcars) %in% groupss])
dots <- lapply(grp_cols, as.symbol)

funct <- statistics
funct <- lapply(funct, as.symbol)

vars <- lapply(metrics, as.symbol)


# A table is created successfully!
mtcars %>%
  group_by_ (.dots = dots) %>%
  summarise_each_(funs_ (funct), vars)
# idea taken from http://stackoverflow.com/questions/21208801/group-by-multiple-columns-in-dplyr-using-string-vector-input

I tried to copy this behaviour to shiny, but without luck. Right now i have the problem, that no data table is shown - and also no error is given. The app basically does nothing:

library(shiny)
library(dplyr)

# Define UI for application
ui <- fluidPage(

  # Application title
  titlePanel("dplyr and shiny"),

  # Sidebar with 3 different filters
  sidebarLayout(
    sidebarPanel(
      checkboxGroupInput(inputId =  "var1_groups", 
                         label = "Grouping vars",
                         choices = colnames(mtcars[7:10])),
      checkboxGroupInput(inputId =  "var2_metrics", 
                         label = "Metric Vars",
                         choices = colnames(mtcars[1:6])),
      checkboxGroupInput(inputId =  "var3_statistics", 
                         label = "Statistics",
                         choices = c("mean", "median", "sd", "min"))
    ),

    # Show a data table when claculations from server are done
    mainPanel( dataTableOutput("x"))

  )
)


# Define server logic 
server <- function(input, output) {

  # Save inputs in vectors
  groupss <- reactive(input$var1_groups)
  metrics <- reactive(input$var2_metrics)
  statistics <- reactive(var3_statistics)

  # Try to make them to symbols for implementation in dplyr-code 
  # symbols for Grouping variables
  grp_cols <- reactive(names(mtcars[colnames(mtcars) %in% groupss]))
  grp_cols <- reactive(lapply(grp_cols(), as.symbol))

  # Symbols for metrics
  metrics <- reactive(names(mtcars[colnames(mtcars) %in% metrics]))
  metrics <- reactive(lapply(funct, as.symbol))

  # Symbols for Statistics
  statistics <- reactive(lapply(statistics, as.symbol))

 # Use the created symbols in the dplyr-function
  x <- reactive({mtcars %>%
      group_by_ (.grp_cols = grp_cols) %>%
      summarise_each_ (funs_ (statistics ), metrics)})

  renderDataTable(x)
}

# Run the application 
shinyApp(ui = ui, server = server)

Where did i go wrong - what would be another strategy to achive the desired functionality in shiy?


回答1:


Maybe try this:

library(shiny)
library(dplyr)

# Define UI for application
ui <- fluidPage(

    # Application title
    titlePanel("dplyr and shiny"),

    # Sidebar with 3 different filters
    sidebarLayout(
        sidebarPanel(
            checkboxGroupInput(inputId = "var1_groups", 
                               label = "Grouping vars",
                               choices = colnames(mtcars[7:10]),
                               selected = colnames(mtcars[7:10])),
            checkboxGroupInput(inputId = "var2_metrics", 
                               label = "Metric Vars",
                               choices = colnames(mtcars[1:6]),
                               selected = colnames(mtcars[1:6])),
            checkboxGroupInput(inputId = "var3_statistics", 
                               label = "Statistics",
                               choices = c("mean", "median", "sd", "min"),
                               selected = c("mean", "sd", "min"))
        ),

        # Show a data table when claculations from server are done
        mainPanel(dataTableOutput("x"))
    )
)

# Define server logic 
server <- function(input, output) {

    # Use the created symbols in the dplyr-function
    x <- reactive({

        req(input$var3_statistics)

        grp_cols <- lapply(input$var1_groups, as.symbol)
        metrics <- lapply(input$var2_metrics, as.symbol)
        statistics <- lapply(input$var3_statistics, as.symbol)

        a <- mtcars %>%
            group_by_ (.dots = grp_cols) %>%
            summarise_each_ (funs_ (statistics), metrics)

        return(a)
    })
    output$x <- renderDataTable({
        x()
    })
}

# Run the application 
shinyApp(ui = ui, server = server)


来源:https://stackoverflow.com/questions/42002307/shiny-r-using-input-variables-for-dynamic-dplyr-creation-of-datatables

标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!