[英]if statement with all combinations selectizeInput Shiny
我有一個基於數據集中所有變量組合的模型表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"
有什么建議?
謝謝
這是第一關:
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)
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.