Блог

Главная - Вопросы по программированию - оператор if со всеми комбинациями selectizeInput Shiny

оператор if со всеми комбинациями selectizeInput Shiny

#r #if-statement #shiny #flextable

#r #if-оператор #блестящий #гибкий

Вопрос:

У меня есть 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)

так, например, когда выбраны все переменные:

введите описание изображения здесь

Я хочу вернуть:

введите описание изображения здесь

но когда, скажем, выбираются только две переменные:

введите описание изображения здесь

Я хочу, чтобы соответствующая таблица была возвращена:

введите описание изображения здесь

и т.д…

Я думаю, мне нужно включить an if statement в server функцию, но я не уверен, как это сделать. Я думал о чем-то вроде следующего, но я не уверен, как сделать это более гибким, чтобы включить все комбинации, а также не уверен, как включить его в 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"

Есть какие-нибудь предложения?

Спасибо

Ответ №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)

Комментарии:

1. спасибо, это работает хорошо, но я не хочу включать код модели в shiny себя. Запуск реальных моделей занимает много времени, поэтому я собираюсь их «предварительно запустить» и сохранить в списке, чтобы список можно было быстро прочитать, когда я открываю приложение. Предпринимая вашу вторую попытку, я, по сути, хочу удалить строки с 5 по 14 вашего server кода и прочитать в предварительно сохраненном списке, например. сохранить saveRDS(model_coeff_ft, "testlist.rds") и прочитать обратно, model_coeff_ft <- readRDS("testlist.rds") но это не работает. Знаете ли вы, как этого добиться? Я надеюсь, что это имеет смысл!

Метки: