带有所有组合的 if 语句 selectizeInput Shiny

Question

我有一个基于数据集中所有变量组合的模型表 list。根据selectizeInput 中选择的变量，我想在Shiny 中返回关联的模型表。

library(shiny)
library(flextable)
library(tidyverse)
vars <- names(iris)[-1]
vars_comb <- unlist(lapply(seq_along(vars), function(n) combn(vars, n, simplify = FALSE)), recursive = FALSE)
model_formula <- lapply(vars_comb, function(v) reformulate(v, "Sepal.Length"))
#create models
models <- lapply(model_formula, function(x) glm(x, data = iris))
names(models) <- model_formula
#create list of tables (flextable)
model_coeff_ft <- map(models, function(x) data.frame(x$coefficients) %>% 
                        rownames_to_column("Variables") %>% 
                     flextable() %>% 
                     set_caption("Table 1: Coefficients"))
#return table e.g.
model_coeff_ft[[15]] 


#shiny:
variable_names <- c("Sepal width" = "Sepal.Width", "Petal length" = "Petal.Length", "Petal width" = "Petal.Width", "Species" =  "Species")
ui <- fluidPage(
  titlePanel("Models"),
  sidebarLayout(
    sidebarPanel(
      selectizeInput("variables",
                     label = "Choose variable", choices = variable_names, multiple = TRUE, 
                     options = list(plugins = list('remove_button', 'drag_drop')))
    ),
    mainPanel(
      uiOutput("dataset_flextable")
    )
  )
)
#I NEED TO PUT IF STATEMENT IN HERE:
server <- function(input, output) {
  output$dataset_flextable <- renderUI({
    req(input$variables)
    get(input$variables) %>%
      htmltools_value()
  })
}
shinyApp(ui = ui, server = server)

so for example, when all variables are chosen:

我想回来：

但是当只说时，选择了两个变量：

我想要返回关联的表：

等等……

我认为我需要在server 函数中包含一个if statement，但我不确定如何执行此操作。我正在考虑以下内容，但我不确定如何使其更灵活以包含所有组合，也不确定如何将其包含在 server 一侧。

#vars
# [1] "Sepal.Width"  "Petal.Length" "Petal.Width"  "Species" 
#grepl or str_detect - if all variables selected then print model_coeff_ft[[15]]
if (all(str_detect(names(model_coeff_ft)[[15]], vars)) == TRUE) {
  model_coeff_ft[[15]]
}
#but i really need to reference all combinations somehow
names(model_coeff_ft)
# [1] "Sepal.Length ~ Sepal.Width"                                        "Sepal.Length ~ Petal.Length"                                      
#  [3] "Sepal.Length ~ Petal.Width"                                        "Sepal.Length ~ Species"                                           
#  [5] "Sepal.Length ~ Sepal.Width + Petal.Length"                         "Sepal.Length ~ Sepal.Width + Petal.Width"                         
#  [7] "Sepal.Length ~ Sepal.Width + Species"                              "Sepal.Length ~ Petal.Length + Petal.Width"                        
#  [9] "Sepal.Length ~ Petal.Length + Species"                             "Sepal.Length ~ Petal.Width + Species"                             
# [11] "Sepal.Length ~ Sepal.Width + Petal.Length + Petal.Width"           "Sepal.Length ~ Sepal.Width + Petal.Length + Species"              
# [13] "Sepal.Length ~ Sepal.Width + Petal.Width + Species"                "Sepal.Length ~ Petal.Length + Petal.Width + Species"              
# [15] "Sepal.Length ~ Sepal.Width + Petal.Length + Petal.Width + Species"

有什么建议吗？

谢谢

Answer 1

这是第一关：

library(shiny)
library(flextable)
library(tidyverse)


#shiny:
variable_names <- c("Sepal width" = "Sepal.Width", "Petal length" = "Petal.Length", "Petal width" = "Petal.Width", "Species" =  "Species")
ui <- fluidPage(
    titlePanel("Models"),
    sidebarLayout(
        sidebarPanel(
            selectizeInput("variables",
                           label = "Choose variable", choices = variable_names, multiple = TRUE, 
                           options = list(plugins = list('remove_button', 'drag_drop')))
        ),
        mainPanel(
            uiOutput("dataset_flextable")
        )
    )
)
#I NEED TO PUT IF STATEMENT IN HERE:
server <- function(input, output) {
    output$dataset_flextable <- renderUI({
        req(input$variables)
        vars <- input$variables
        vars_comb <- unlist(lapply(seq_along(vars), function(n) combn(vars, n, simplify = FALSE)), recursive = FALSE)
        model_formula <- lapply(vars_comb, function(v) reformulate(v, "Sepal.Length"))
        #create models
        models <- lapply(model_formula, function(x) glm(x, data = iris))
        names(models) <- model_formula
        #create list of tables (flextable)
        model_coeff_ft <- map(models, function(x) data.frame(x$coefficients) %>% 
                                  rownames_to_column("Variables") %>% 
                                  flextable() %>% 
                                  set_caption("Table 1: Coefficients"))
        #return table e.g.
        model_coeff_ft[[length(model_coeff_ft)]] %>% htmltools_value()
        
    })
}
shinyApp(ui = ui, server = server)

我会尽快改进它。

更新

library(shiny)
library(flextable)
library(tidyverse)


#shiny:
variable_names <- c("Sepal width" = "Sepal.Width", "Petal length" = "Petal.Length", "Petal width" = "Petal.Width", "Species" =  "Species")
ui <- fluidPage(
    titlePanel("Models"),
    sidebarLayout(
        sidebarPanel(
            selectizeInput("variables",
                           label = "Choose variable", choices = variable_names, multiple = TRUE, 
                           options = list(plugins = list('remove_button', 'drag_drop'))),
            selectInput("model", "Choose model", choices = NULL)
        ),
        mainPanel(
            uiOutput("dataset_flextable")
        )
    )
)
#I NEED TO PUT IF STATEMENT IN HERE:
server <- function(input, output, session) {
    model_coeff_ft <- reactive({
        req(input$variables)
        vars <- input$variables
        vars_comb <- unlist(lapply(seq_along(vars), function(n) combn(vars, n, simplify = FALSE)), recursive = FALSE)
        model_formula <- lapply(vars_comb, function(v) reformulate(v, "Sepal.Length"))
        #create models
        models <- lapply(model_formula, function(x) glm(x, data = iris))
        names(models) <- model_formula
        #create list of tables (flextable)
        model_coeff_ft <- map(models, function(x) data.frame(x$coefficients) %>% 
                                  rownames_to_column("Variables") %>% 
                                  flextable() %>% 
                                  set_caption("Table 1: Coefficients"))
        updateSelectInput(session, "model", choices = names(model_coeff_ft), selected = last(names(model_coeff_ft)))
        return(model_coeff_ft)
    })
    
    
    
    output$dataset_flextable <- renderUI({
        req(model_coeff_ft(), input$model, input$model %in% names(model_coeff_ft()))
        
        #return table e.g.
        model_coeff_ft()[[input$model]] %>% htmltools_value()
        
    })
}
shinyApp(ui = ui, server = server)

更新 2 - 基于下面的评论

library(shiny)
library(flextable)
library(tidyverse)

vars <- names(iris)[-1] %>% sort()
vars_comb <- unlist(lapply(seq_along(vars), function(n) combn(vars, n, simplify = FALSE)), recursive = FALSE)
model_formula <- lapply(vars_comb, function(v) reformulate(v, "Sepal.Length"))
#create models
models <- lapply(model_formula, function(x) glm(x, data = iris))
names(models) <- model_formula
#create list of tables (flextable)
model_coeff_ft <- map(models, function(x) data.frame(x$coefficients) %>% 
                          rownames_to_column("Variables") %>% 
                          flextable() %>% 
                          set_caption("Table 1: Coefficients"))

#shiny:
variable_names <- sort(c("Sepal width" = "Sepal.Width", "Petal length" = "Petal.Length", "Petal width" = "Petal.Width", "Species" =  "Species"))
ui <- fluidPage(
    titlePanel("Models"),
    sidebarLayout(
        sidebarPanel(
            selectizeInput("variables",
                           label = "Choose variable", choices = variable_names, multiple = TRUE, 
                           options = list(plugins = list('remove_button', 'drag_drop'))),
            selectInput("model", "Choose model", choices = NULL)
        ),
        mainPanel(
            uiOutput("dataset_flextable")
        )
    )
)
#I NEED TO PUT IF STATEMENT IN HERE:
server <- function(input, output, session) {
    observeEvent(input$variables, {
        vars <- input$variables %>% sort()
        vars_comb <- unlist(lapply(seq_along(vars), function(n) combn(vars, n, simplify = FALSE)), recursive = FALSE)
        model_formula <- as.character(lapply(vars_comb, function(v) reformulate(v, "Sepal.Length")))
        
        updateSelectInput(session, "model", choices = model_formula, selected = last(model_formula))
    }, ignoreNULL = FALSE, ignoreInit = TRUE)
    
    
    
    output$dataset_flextable <- renderUI({
        req(input$model, input$model %in% names(model_coeff_ft))
        
        #return table e.g.
        model_coeff_ft[[input$model]] %>% htmltools_value()
        
    })
}
shinyApp(ui = ui, server = server)