Search code examples
rif-statementshinyflextable

if statement with all combinations selectizeInput Shiny

I have a list of model tables based on all combinations of variables in a dataset. Depending on what variables are chosen in selectizeInput I want to return the associated model table in 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:

enter image description here

I want to return:

enter image description here

but when only say, two variables are chosen:

enter image description here

I want the associated table returned:

enter image description here

etc...

I think i need to include an if statement in the server function but I'm unsure how to do this. I was thinking something along the lines of the following but I'm not sure how to make this more flexible to include all combinations and also unsure how to include it in the server side.

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

Any suggestions?

thanks

Solution

  • Here is a first pass:

    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)

    I will try improve on it shortly.

    Update

    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)

    Update 2 - based on comment below

    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)