将dplyr中的get（paste0（））对象解析为Shiny应用程序

debugcn 发表于 Dev

加布里埃拉·奥林托（Gabriela Olinto）

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

...％>％summarise（get（paste0（substr（dis，1,4），“。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')
                          )
                        ))

 ))

服务器

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)
})


 })

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

尼克·肯尼迪

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

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

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

我仍然不确定某些输出是否恰好是您想要的，特别是比例列，但这应该可以为您提供一些依据。

用户界面

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")
                              )
                            ))

))

服务器

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)
  })

})

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。