将 dplyr 中的 get(paste0()) 对象解析为 Shiny 应用程序答案

【问题标题】：Parsing get(paste0()) objects within dplyr into a Shiny app将 dplyr 中的 get(paste0()) 对象解析为 Shiny 应用程序
【发布时间】：2015-07-02 20:48:18
【问题描述】：

我正在 Shiny 中构建一个新应用程序，它需要执行灵活/反应性的聚合数据集，这些数据集包含一些 inputID。我真的很喜欢 dplyr，所以我用它来创建这个数据集。但我在解析命令时遇到错误

... %>% summarise(get(paste0(substr(dis,1,4),".mean")) = mean(dis), count = n())

这是数据集的一个例子：

n=100
taxi <- data.frame(conversion=c(rep(1,20),rep(0,80)),
             day = sample(1:7, n, TRUE),
             hour = sample(0:23,n, TRUE),
             source= sample(1:4, n, TRUE),
             service= sample(1:5, n, TRUE),
             relevancy= sample(1:4, n, TRUE),
             tollfree= sample(c(0,1), n, TRUE),
             distance= sample(0:15, n, TRUE),
             similarity= sample(seq(0,1,0.01), n, TRUE),
             simi.names= sample(c('[0,0.25)','[0.25,0.5)','[0.5,0.75)','[0.75,1]'), n, TRUE),
             dist.names= sample(c('[0,1)','[1,2)','[2,3)','[3,4)','[4,15]'), n, TRUE),
             week= sample(1:7, n, TRUE),
             rel= sample(c(1,4), n, TRUE))

这是我最后一次尝试的样子： Ui.R

shinyUI(navbarPage("",
               tabPanel("Data",
                        sidebarLayout(
                          sidebarPanel(
                            selectInput("dataset", h5("Choose a dataset:"), choices = c("taxicabs", "liquor stores")),
                            radioButtons("discrete", h5("I want to discretize:"), choices = c("similarity", "distance","similarity & distance","none"),
                                               inline=F, selected = "none"),
                            radioButtons("agg", h5("I want to aggregate:"), choices = c("day in weekdays/weekends", "revelancy in binary revelancy",
                                                                                             "day in weekdays/weekends &  revelancy in binary revelancy","none"),
                                         inline=F, selected = "none"),
                            checkboxGroupInput("checkGroup", label = h5("Dataset Features:"), 
                                               choices = c("day","hour","source","service","relevancy","tollfree","distance","similarity"), inline = F,
                                               selected = c("day","hour","source","service","relevancy","tollfree","distance","similarity"))
                          ),
                          mainPanel(
                            numericInput("obs", label = h5("Number of observations to view"), 10, min = 5, max = 15, step = 1),
                            tableOutput("view") 
                          )
                        )
               ),
               tabPanel("Model",
                        h3("Best logistic model with logit link and variable selection via stepwise AIC "),
                        verbatimTextOutput("model"),
                        h3("MSE"),
                        tableOutput("measures")
               ),
               tabPanel("Graphs",
                        sidebarLayout(
                          sidebarPanel(    
                            selectInput('zcol', 'Variable to be fixed',  names(taxi[,-c(1,4,5,7,8,9,10,11)])),
                            selectInput("levels", "Levels",1:5)
                          ),
                          mainPanel(
                            plotOutput('plot3'),
                            plotOutput('plot1'),
                            plotOutput('plot2')
                          )
                        ))

 ))

Server.R

shinyServer(function(input, output, session) {
datasetInput <- reactive({
switch(input$dataset,
       "taxicabs" = taxi,
       "liquor stores" = liq)
 })

observe({
if (input$discrete == 'none' & input$agg == 'none') {
  updateCheckboxGroupInput(session, "checkGroup", choices = c("day","hour","source","service","relevancy","tollfree","distance","similarity"),
                           inline=F, selected =c("day","hour","source","service","relevancy","tollfree","distance","similarity"))
} else if (input$discrete == 'none' & input$agg == 'day in weekdays/weekends'){
  updateCheckboxGroupInput(session, "checkGroup", choices = c("week","hour","source","service","relevancy","tollfree","distance","similarity"),
                           inline=F, selected =c("week","hour","source","service","relevancy","tollfree","distance","similarity"))
} else if (input$discrete == 'none' & input$agg == 'revelancy in binary revelancy'){
  updateCheckboxGroupInput(session, "checkGroup", choices = c("day","hour","source","service","rel","tollfree","distance","similarity"),
                           inline=F, selected =c("day","hour","source","service","rel","tollfree","distance","similarity"))
} else if (input$discrete == 'none' & input$agg == 'day in weekdays/weekends &  revelancy in binary revelancy'){
  updateCheckboxGroupInput(session, "checkGroup", choices = c("week","hour","source","service","rel","tollfree","distance","similarity"),
                           inline=F, selected =c("week","hour","source","service","rel","tollfree","distance","similarity"))
}

  else if(input$discrete == 'similarity' & input$agg == 'none') {
  updateCheckboxGroupInput(session, "checkGroup", choices = c("day","hour","source","service","relevancy","tollfree","distance","simi.names"),
                           inline=F, selected = c("day","hour","source","service","relevancy","tollfree","distance","simi.names"))
  } else if (input$discrete == 'similarity' & input$agg == 'day in weekdays/weekends'){
    updateCheckboxGroupInput(session, "checkGroup", choices = c("week","hour","source","service","relevancy","tollfree","distance","simi.names"),
                             inline=F, selected =c("week","hour","source","service","relevancy","tollfree","distance","simi.names"))
  } else if (input$discrete == 'similarity' & input$agg == 'revelancy in binary revelancy'){
    updateCheckboxGroupInput(session, "checkGroup", choices = c("day","hour","source","service","rel","tollfree","distance","simi.names"),
                             inline=F, selected =c("day","hour","source","service","rel","tollfree","distance","simi.names"))
  } else if (input$discrete == 'similarity' & input$agg == 'day in weekdays/weekends &  revelancy in binary revelancy'){
    updateCheckboxGroupInput(session, "checkGroup", choices = c("week","hour","source","service","rel","tollfree","distance","simi.names"),
                             inline=F, selected =c("week","hour","source","service","rel","tollfree","distance","simi.names"))
  }

  else if(input$discrete == 'distance' & input$agg == 'none') {
  updateCheckboxGroupInput(session, "checkGroup", choices = c("day","hour","source","service","relevancy","tollfree","dist.names","similarity"),
                           inline=F, selected =c("day","hour","source","service","relevancy","tollfree","dist.names","similarity"))
  } else if (input$discrete == 'distance' & input$agg == 'day in weekdays/weekends'){
    updateCheckboxGroupInput(session, "checkGroup", choices = c("week","hour","source","service","relevancy","tollfree","dist.names","similarity"),
                             inline=F, selected =c("week","hour","source","service","relevancy","tollfree","dist.names","similarity"))
  } else if (input$discrete == 'distance' & input$agg == 'revelancy in binary revelancy'){
    updateCheckboxGroupInput(session, "checkGroup", choices = c("day","hour","source","service","rel","tollfree","dist.names","similarity"),
                             inline=F, selected =c("day","hour","source","service","rel","tollfree","dist.names","similarity"))
  } else if (input$discrete == 'distance' & input$agg == 'day in weekdays/weekends &  revelancy in binary revelancy'){
    updateCheckboxGroupInput(session, "checkGroup", choices = c("week","hour","source","service","rel","tollfree","dist.names","similarity"),
                             inline=F, selected =c("week","hour","source","service","rel","tollfree","dist.names","similarity"))
  }

  else if(input$discrete == 'similarity & distance' & input$agg == 'none') {
  updateCheckboxGroupInput(session, "checkGroup", choices = c("day","hour","source","service","relevancy","tollfree","dist.names","simi.names"),
                           inline=F, selected =c("day","hour","source","service","relevancy","tollfree","dist.names","simi.names"))
  } else if (input$discrete == 'similarity & distance' & input$agg == 'day in weekdays/weekends'){
    updateCheckboxGroupInput(session, "checkGroup", choices = c("week","hour","source","service","relevancy","tollfree","dist.names","simi.names"),
                             inline=F, selected =c("week","hour","source","service","relevancy","tollfree","dist.names","simi.names"))
  } else if (input$discrete == 'similarity & distance' & input$agg == 'revelancy in binary revelancy'){
    updateCheckboxGroupInput(session, "checkGroup", choices = c("day","hour","source","service","rel","tollfree","dist.names","simi.names"),
                             inline=F, selected =c("day","hour","source","service","rel","tollfree","dist.names","simi.names"))
  } else if (input$discrete == 'similarity & distance' & input$agg == 'day in weekdays/weekends &  revelancy in binary revelancy'){
    updateCheckboxGroupInput(session, "checkGroup", choices = c("week","hour","source","service","rel","tollfree","dist.names","simi.names"),
                             inline=F, selected =c("week","hour","source","service","rel","tollfree","dist.names","simi.names"))
  }
 })

 observe({ 
if(input$discrete == "similarity & distance") {

  #all discrete 
  datasetagg <- reactive({ 
    eval(substitute(right_join(
      datasetInput() %>% select(cg) %>% group_by(cg) %>% summarise(count=n()),
      datasetInput() %>% filter(conversion==1) %>% select(icg) %>% count(cg)
    ) %>% mutate(prop.conv = n/count), 
    list(cg=as.symbol(input$checkGroup))))
  })

} else if(input$discrete == "similarity" | "distance") {

  # one continuous
  datasetagg <- reactive({ 
    eval(substitute(right_join( # the error is in the next line!
      datasetInput() %>% select(cg) %>% group_by(cg[-which(cg == dis)]) %>% summarise(get(paste0(substr(dis,1,4),".mean"))=mean(dis),count=n()),
      datasetInput() %>% filter(conversion==1) %>% select(cg) %>% count(cg[-which(cg == dis)])
    ) %>% mutate(prop.conv = n/count), 
    list(cg=as.symbol(input$checkGroup),
         dis=as.symbol(input$discrete))))
  })

} else if(input$discrete == "none") {

  # two  
  datasetagg <- reactive({ 
    eval(substitute(right_join(
      datasetInput() %>% select(cg) %>% group_by(cg[-which(cg == c('distance','similarity'))]) %>% summarise(dist.mean=mean(distance),simi.mean=mean(similarity),count=n()),
      datasetInput() %>% filter(conversion==1) %>% select(cg) %>% count(cg[-which(cg == c('distance','similarity'))])
    ) %>% mutate(prop.conv = n/count), 
    list(cg=as.symbol(input$checkGroup))))
  })
}
})

# head of the table  
output$view <- renderTable({
head(datasetagg(), n = input$obs)
})


 })

有什么建议吗？感谢您的帮助！

【问题讨论】：

尝试输入 dplyr:summarise - 我遇到了加载错误函数的问题
没有帮助.. 到目前为止，我得到的最好的答案是：setNames()，但我仍然得到Error in head(datasetagg(), n = input$obs) : could not find function "datasetagg"。

标签： r shiny dplyr

【解决方案1】：

但是，真正的问题是您尝试使用get(paste0(substr(dis,1,4),".mean")) 作为摘要中的参数名称。 R 中的命名参数不被评估，它们只是一段文本。

您粘贴的代码需要大量重写。

顶部的第一个 observe 部分不必要地令人费解 - 它可以简化为 4 个 if 语句，如图所示。
您不能像以前那样动态定义reactives。您需要使用其中的所有条件逻辑声明一个 reactive。在 dplyr 代码之外对输入变量进行任何必要的处理也更加简洁。
当您为select、group_by 等动态定义列时，您可以使用您最初打算使用eval(substitute()) 的方法，但它会使代码更难正确编写。在我看来，使用函数的标准评估版本要好得多，例如select_ 和 group_by_。对于input$checkgroup，需要使用.dots参数（count_需要使用vars参数）。
在您的原始代码中，您将input$checkgroup 变量强制转换为一个符号，该符号仅采用向量的第一个元素。
在summarise_ 中动态命名列的方法是使用setNames 和.dots 参数。

我仍然不确定某些输出是否正是您想要的，尤其是比例列，但这应该可以为您提供一些可以在此基础上构建的东西。

ui.R

library(shiny)

shinyUI(navbarPage("",
                   tabPanel("Data",
                            sidebarLayout(
                              sidebarPanel(
                                selectInput("dataset", h5("Choose a dataset:"), choices = c("taxicabs", "liquor stores")),
                                radioButtons("discrete", h5("I want to discretize:"), choices = c("similarity", "distance","similarity & distance","none"),
                                             inline=F, selected = "none"),
                                radioButtons("agg", h5("I want to aggregate:"), choices = c("day in weekdays/weekends", "relevancy in binary relevancy",
                                                                                            "day in weekdays/weekends &  relevancy in binary relevancy","none"),
                                             inline=F, selected = "none"),
                                checkboxGroupInput("checkGroup", label = h5("Dataset Features:"), 
                                                   choices = c("day","hour","source","service","relevancy","tollfree","distance","similarity"), inline = F,
                                                   selected = c("day","hour","source","service","relevancy","tollfree","distance","similarity"))
                              ),
                              mainPanel(
                                numericInput("obs", label = h5("Number of observations to view"), 10, min = 5, max = 15, step = 1),
                                tableOutput("view") 
                              )
                            )
                   ),
                   tabPanel("Model",
                            h3("Best logistic model with logit link and variable selection via stepwise AIC "),
                            verbatimTextOutput("model"),
                            h3("MSE"),
                            tableOutput("measures")
                   ),
                   tabPanel("Graphs",
                            sidebarLayout(
                              sidebarPanel(    
                                selectInput("zcol", "Variable to be fixed",  c("hour", "source", "tollfree", "rel")),
                                selectInput("levels", "Levels",1:5)
                              ),
                              mainPanel(
                                plotOutput("plot3"),
                                plotOutput("plot1"),
                                plotOutput("plot2")
                              )
                            ))

))

server.R

library("shiny")
library("dplyr")

n <- 1000
taxi <- data.frame(day = sample(1:7, n, TRUE),
                   hour = sample(0:23,n, TRUE),
                   source= sample(1:4, n, TRUE),
                   service= sample(1:5, n, TRUE),
                   relevancy= sample(1:4, n, TRUE),
                   tollfree= sample(c(0,1), n, TRUE),
                   distance= sample(0:15, n, TRUE),
                   similarity= sample(seq(0,1,0.01), n, TRUE),
                   simi.names= sample(c('[0,0.25)','[0.25,0.5)','[0.5,0.75)','[0.75,1]'), n, TRUE),
                   dist.names= sample(c('[0,1)','[1,2)','[2,3)','[3,4)','[4,15]'), n, TRUE),
                   week= sample(1:7, n, TRUE),
                   rel= sample(c(1,4), n, TRUE),
                   conversion = sample(0:1, n, TRUE))

shinyServer(function(input, output, session) {
  datasetInput <- reactive({
    switch(input$dataset,
           "taxicabs" = taxi,
           "liquor stores" = liq)
  })

  observe({
    choices <- c("day", "hour", "source", "service", "relevancy", "tollfree", "distance", "similarity")
    if (grepl("day in weekdays/weekends", input$agg))  {
      choices[1] <- "week"
    }
    if (grepl("relevancy", input$agg))  {
      choices[5] <- "rel"
    }      
    if (grepl("similarity", input$discrete)) {
      choices[8] <- "simi.names"
    }
    if (grepl("distance", input$discrete)) {
      choices[7] <- "dist.names"
    }
    updateCheckboxGroupInput(session, "checkGroup", choices = choices,
                               inline = F, selected = choices)
  })

  datasetagg <- reactive({ 
    cg <- input$checkGroup
    dis <- input$discrete
    cg_not_d_or_s <- cg[!(cg %in% c("distance", "similarity"))]
    if(input$discrete == "similarity & distance") {
      #all discrete 
      right_join(
        datasetInput() %>%
          select_(.dots = cg) %>%
          group_by_(.dots = cg) %>%
          summarise(count=n()),
        datasetInput() %>%
          filter(conversion==1) %>%
          select_(.dots = cg) %>%
          count_(vars = cg)
      ) %>% mutate(prop.conv = n/count)
    } else if(input$discrete %in% c("similarity", "distance")) {
      cg_not_dis <- cg[cg != dis]
        # one continuous
      right_join(
        datasetInput() %>%
          group_by_(.dots = cg_not_dis) %>%
          summarise_(.dots = setNames(c(paste0("mean(", dis, ")"), "n()"),
                                      c(paste0(substr(dis, 1, 4), ".mean"), "count"))) %>%
          select_(.dots = c(cg_not_dis, paste0(substr(dis, 1, 4), ".mean"), "count")),
        datasetInput() %>%
          filter(conversion==1) %>%
          select_(.dots = cg_not_dis) %>%
          count_(vars = cg_not_dis)
      ) %>% mutate(prop.conv = n/count)
    } else if(input$discrete == "none") {
      # two  
      right_join(
        datasetInput() %>%
          select_(.dots = cg) %>%
          group_by_(.dots = cg_not_d_or_s) %>%
          summarise(dist.mean=mean(distance), simi.mean=mean(similarity), count=n()),
        datasetInput() %>%
          filter(conversion==1) %>%
          select_(.dots = cg) %>%
          count_(vars = cg_not_d_or_s)
      ) %>% mutate(prop.conv = n/count)
    }
  })

  # head of the table  
  output$view <- renderTable({
    head(datasetagg(), n = input$obs)
  })

})

【讨论】：

我编辑了，现在有一个完整的代码。但我仍然在head(datasetagg(), n = input$obs) : could not find function "datasetagg"中遇到错误
@GabrielaOlinto 您的代码需要大量重写。我已经开始了，但如果您还可以提供一些至少taxi 的示例数据，那将会更有帮助。
@GabrielaOlinto 你能试着用文字解释一下你期待什么样的输出吗？您打算加入哪些列？ input$checkgroup 可能有几个值。您打算在联接的右侧计算什么？什么是转化列？
对不起，我忘记在假数据集上添加列转换。但我想要的是计算因子变量的计数和连续变量的均值。 input$checkgroup 包含我要选择的所有变量（因子和连续变量）。
应该是这样的：right_join( taxi %>% select(day ,hour, source , service , relevancy , tollfree, distance, simi.names) %>% group_by(day ,hour, source , service , relevancy , tollfree, simi.names) %>% summarise(dist.mean=mean(distance),count=n()), taxi %>% filter(conversion==1) %>% select(day ,hour, source , service , relevancy , tollfree, distance, simi.names) %>% count(day ,hour, source , service , relevancy , tollfree, simi.names) ) %>% mutate(prop.conv = n/count)