Utilisez la méthode insertUI pour créer différents widgets brillants
J'ai l'application brillante ci-dessous dans laquelle l'utilisateur peut choisir entre un ou plusieurs noms de colonne dans le bloc de données.
name<-c("John","Jack","Bill")
value1<-c(2,4,6)
add<-c("SDF","GHK","FGH")
value2<-c(3,4,5)
dt<-data.frame(name,value1,add,value2)
Ensuite, pour chaque sélection qu'il fait, le relatif pickerInput()peut être affiché ci-dessous. Peut-être que je pourrais utiliser ifpour chaque cas, mais le problème est que mon ensemble de données réel peut être beaucoup plus grand et a des noms de colonnes différents à chaque fois, donc je cherche un moyen de connecter instantanément le pickerInput()nom sélectionné avec la création du parent pickerInput()qui inclura les valeurs de colonne . Par exemple, si quelqu'un sélectionne les 4 noms de colonne, 4 pickerInput()doit être créé avec le nom de colonne relatif comme étiquette.
Ma méthode est la insertUIméthode, mais je dois trouver un moyen de créer un widget avec des choix et une étiquette différents à chaque fois et de le supprimer également lorsque vous désélectionnez la valeur relative du 1er pickerInput().
library(shiny)
library(shinyWidgets)
library(DT)
# ui object
ui <- fluidPage(
titlePanel(p("Spatial app", style = "color:#3474A7")),
sidebarLayout(
sidebarPanel(
pickerInput(
inputId = "p1",
label = "Select Column headers",
choices = colnames( dt),
multiple = TRUE,
options = list(`actions-box` = TRUE)
)
),
mainPanel(
)
)
)
# server()
server <- function(input, output) {
observeEvent(input$p1, {
insertUI(
selector = "#p1",
where = "afterEnd",
ui = pickerInput(
inputId = #The colname of selected column
,
label = #The colname of selected column
,
choices = #all rows of selected column
,
multiple = TRUE,
options = list(`actions-box` = TRUE)
)
)
})
}
# shinyApp()
shinyApp(ui = ui, server = server)
Réponses
Je n'aime pas vraiment utiliser lapplypour créer un élément d'entrée en brillant, car lorsque vous ajoutez un élément, les interfaces utilisateur d'entrée pour les entrées déjà existantes (sélectionnées) sont écrasées, et donc tout est remis aux valeurs par défaut et aux valeurs précédemment choisies pour celles-ci les entrées sont perdues.
Vous pouvez associer insertUIavec removeUIet une variable pour garder une trace des colonnes précédemment sélectionnées. Ensuite, vous pouvez ajouter / supprimer dynamiquement des éléments d'interface utilisateur et conserver les autres entrées inchangées.
library(shiny)
library(shinyWidgets)
library(DT)
name<-c("John","Jack","Bill")
value1<-c(2,4,6)
add<-c("SDF","GHK","FGH")
value2<-c(3,4,5)
dt<-data.frame(name,value1,add,value2)
# ui object
ui <- fluidPage(
titlePanel(p("Spatial app", style = "color:#3474A7")),
sidebarLayout(
sidebarPanel(
pickerInput(
inputId = "p1",
label = "Select Column headers",
choices = colnames( dt),
multiple = TRUE,
options = list(`actions-box` = TRUE)
),
tags$div(id = "add_ui_here") ), mainPanel( ) ) ) # server() server <- function(input, output) { # store currently selected columns selected_columns <- c() observeEvent(input$p1, {
# determine pickerInputs to remove
input_remove <- !selected_columns %in% input$p1 input_remove <- selected_columns[input_remove] # remove inputs if (!is.null(input_remove) && length(input_remove) > 0) { for (input_element in input_remove) { removeUI(selector = paste0("#", input_element, "_remove_id")) } } # determine pickerInputs to add input_add <- !input$p1 %in% selected_columns
input_add <- input$p1[input_add] # add inputs if (length(input_add) > 0) { for (input_element in input_add) { insertUI( selector = "#add_ui_here", where = "afterEnd", ui = tags$div(id = paste0(input_element, "_remove_id"),
pickerInput(
inputId = input_element
,
label = input_element
,
choices = dt[, input_element]
,
multiple = TRUE,
options = list(`actions-box` = TRUE)
))
)
}
}
# update the currently stored column variable
selected_columns <<- input$p1
},
ignoreNULL = FALSE)
}
# shinyApp()
shinyApp(ui = ui, server = server)
J'ai enveloppé les insérés pickerInputsdans un div, il est donc plus facile de les retirer. En outre, vous devez définir ignoreNULL = FALSEpour l'observateur, de sorte qu'il soit également déclenché si tous les éléments sont désélectionnés.
Vous pouvez utiliser lapplyavec renderUIau lieu deinsertUI
name<-c("John","Jack","Bill")
value1<-c(2,4,6)
add<-c("SDF","GHK","FGH")
value2<-c(3,4,5)
#Add stringsAsFactor=F to correctly display options of name and add
dt<-data.frame(name,value1,add,value2,stringsAsFactors = F)
library(shiny)
library(shinyWidgets)
library(DT)
# ui object
ui <- fluidPage(
titlePanel(p("Spatial app", style = "color:#3474A7")),
sidebarLayout(
sidebarPanel(
pickerInput(
inputId = "p1",
label = "Select Column headers",
choices = colnames( dt),
multiple = TRUE,
options = list(`actions-box` = TRUE)
),
#Add the output for new pickers
uiOutput("pickers")
),
mainPanel(
)
)
)
# server()
server <- function(input, output) {
observeEvent(input$p1, { #Create the new pickers output$pickers<-renderUI({
div(lapply(input$p1, function(x){
pickerInput(
inputId = x#The colname of selected column
,
label = x #The colname of selected column
,
choices = dt[,x]#all rows of selected column
,
multiple = TRUE,
options = list(`actions-box` = TRUE)
)
}))
})
})
}
# shinyApp()
shinyApp(ui = ui, server = server)
Une solution possible est de générer la pickerInputliste et de rendre l'aide tagListen renderUI:
# Data
name<-c("John","Jack","Bill")
value1<-c(2,4,6)
add<-c("SDF","GHK","FGH")
value2<-c(3,4,5)
dt<-data.frame(name,value1,add,value2)
# App
library(shiny)
library(shinyWidgets)
library(DT)
# ui object
ui <- fluidPage(
titlePanel(p("Spatial app", style = "color:#3474A7")),
sidebarLayout(
sidebarPanel(
uiOutput("pickers")
),
mainPanel(
)
)
)
# server()
server <- function(input, output) {
pickers <- colnames(dt)
output$pickers <- renderUI({
l <- list()
for (i in 1:length(pickers)) {
l[[i]] <- pickerInput(pickers[i],pickers[i],dt[[pickers[i]]])
}
tagList(l)
})
}
# shinyApp()
shinyApp(ui = ui, server = server)
