使用输入变量进行动态dplyr数据表创建的Shiny R [英] Shiny R using input-variables for dynamic dplyr creation of dataTables

问题描述

目标:构建一个闪亮的应用程序，使用户可以通过Groupcheckboxfields进行3个输入:

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

• 分组变量
• 指标变量
• 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?

推荐答案

也许试试看:

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)

这篇关于使用输入变量进行动态dplyr数据表创建的Shiny R的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！