![](/img/trans.png)
[英]How to use customjs to update dropdown menu choices dynamically in Bokeh
[英]In Shiny need to dynamically update dropdown choices with updateRadioGroupButtons
在R Shiny 組按鈕與單獨的 hover 下拉選擇之后,需要根據某些條件動態更新單選按鈕組。 按鈕的數量可能會改變。
我至少有以下與以下代碼相關的查詢。 1)標簽是否屬於服務器? 2)如何在服務器代碼中動態乘以selectInput? 3) output如何動態乘法? 我已更改您的實現以更適合我的應用程序。 如果按鈕要顯示為下拉列表,則所有下拉列表都具有相同的選擇,這是在 dropdownTRUE 中動態計算的。 如果 dropdownTRUE==F,我不需要下拉菜單。
library(shiny)
library(shinyWidgets)
js <- "
function qTip() {
$('#THE_INPUT_ID .radiobtn').each(function(i, $el){
var value = $(this).find('input[type=radio]').val();
var selector = '#select' + value;
$(this).qtip({
overwrite: true,
content: {
text: $(selector).parent().parent()
},
position: {
my: 'top left',
at: 'bottom right'
},
show: {
ready: false
},
hide: {
event: 'unfocus'
},
style: {
classes: 'qtip-blue qtip-rounded'
},
events: {
blur: function(event, api) {
api.elements.tooltip.hide();
}
}
});
});
}
function qTip_delayed(x){
setTimeout(function(){qTip();}, 500);
}
$(document).on('shiny:connected', function(){
Shiny.addCustomMessageHandler('qTip', qTip_delayed);
});
"
ui <- fluidPage(
tags$head( # does this belong to server?
tags$link(rel = "stylesheet", href = "jquery.qtip.min.css"),
tags$script(src = "jquery.qtip.min.js"),
tags$script(HTML(js))
),
br(),
uiOutput('bttns'),
verbatimTextOutput("selection1")
)
server <- function(input, output, session) {
session$sendCustomMessage("qTip", "")
output$bttns<-renderUI({
bttnchoices=c("A", "B", "C")
lenchoice=length(bttnchoices)
dropdownTRUE=sample(c(T,F),lenchoice,T,rep(.5,2)) ##bttns for which dropdown is to be shown
dropchoices = c("Apple", "Banana")# same choices to be shown for all buttons with dropdownTRUE
radioGroupButtons(
inputId = "THE_INPUT_ID",
individual = TRUE,
label = "Make a choice: ",
choices = bttnchoices
)
div(
style = "display: none;",
shinyInput(lenchoice,selectInput, # struggling with dynamic multiplication of selectInput, lapply?
"select",
label = "Select a fruit",
choices=dropchoices,
selectize = FALSE
))
})
observeEvent(input[["select1"]], {
if(input[["select1"]] == "Banana"){
session$sendCustomMessage("qTip", "")
output$bttns<-renderUI({
bttnchoices=c("D", "A")
lenchoice=length(bttnchoices)
dropdownTRUE=sample(c(T,F),lenchoice,T,rep(.5,2))
dropchoices = c("Peach", "Pear")
radioGroupButtons(
inputId = "THE_INPUT_ID",
individual = TRUE,
label = "Make a choice: ",
choices = bttnchoices
)
div(
style = "display: none;",
shinyInput(lenchoice,selectInput,
"select",
label = "Select a fruit",
choices = dropchoices,
selectize = FALSE
))
})
}
output$selection1<-input$select1 # struggling with dynamic multiplication of outputs, lapply?
})
}
shinyApp(ui, server)
這是方法。 單選按鈕的值必須與selectInput
的 id 的后綴相對應。 這里A
, B
, C
, D
是值,然后selectInput
的 id 是selectA
, selectB
, selectC
, selectD
。 如果您想為單選按鈕使用其他名稱,請執行choices = list("name1" = "A", "name2" = "B", "name3" = "C", "name4" = "D")
。
library(shiny)
library(shinyWidgets)
js <- "
function qTip() {
$('#THE_INPUT_ID .radiobtn').each(function(i, $el){
var value = $(this).find('input[type=radio]').val();
var selector = '#select' + value;
$(this).qtip({
overwrite: true,
content: {
text: $(selector).parent().parent()
},
position: {
my: 'top left',
at: 'bottom right'
},
show: {
ready: false
},
hide: {
event: 'unfocus'
},
style: {
classes: 'qtip-blue qtip-rounded'
},
events: {
blur: function(event, api) {
api.elements.tooltip.hide();
}
}
});
});
}
function qTip_delayed(x){
setTimeout(function(){qTip();}, 500);
}
$(document).on('shiny:connected', function(){
Shiny.addCustomMessageHandler('qTip', qTip_delayed);
});
"
ui <- fluidPage(
tags$head(
tags$link(rel = "stylesheet", href = "jquery.qtip.min.css"),
tags$script(src = "jquery.qtip.min.js"),
tags$script(HTML(js))
),
br(),
radioGroupButtons(
inputId = "THE_INPUT_ID",
individual = TRUE,
label = "Make a choice: ",
choices = c("A", "B", "C")
),
br(), br(), br(),
verbatimTextOutput("selectionA"),
verbatimTextOutput("selectionB"),
verbatimTextOutput("selectionC"),
verbatimTextOutput("selectionD"),
div(
style = "display: none;",
selectInput(
"selectA",
label = "Select a fruit",
choices = c("Apple", "Banana"),
selectize = FALSE
),
selectInput(
"selectB",
label = "Select a fruit",
choices = c("Lemon", "Orange"),
selectize = FALSE
),
selectInput(
"selectC",
label = "Select a fruit",
choices = c("Strawberry", "Pineapple"),
selectize = FALSE
),
selectInput(
"selectD",
label = "Select a fruit",
choices = c("Pear", "Peach"),
selectize = FALSE
)
)
)
server <- function(input, output, session) {
session$sendCustomMessage("qTip", "")
output[["selectionA"]] <- renderPrint(input[["selectA"]])
output[["selectionB"]] <- renderPrint(input[["selectB"]])
output[["selectionC"]] <- renderPrint(input[["selectC"]])
output[["selectionD"]] <- renderPrint(input[["selectD"]])
observeEvent(input[["selectA"]], {
if(input[["selectA"]] == "Banana"){
updateRadioGroupButtons(session, inputId = "THE_INPUT_ID",
label = "Make NEW choice: ",
choices = c("D","A"))
session$sendCustomMessage("qTip", "")
}
})
}
shinyApp(ui, server)
以下方式允許為選定的單選按鈕列表設置下拉列表。
library(shiny)
library(shinyWidgets)
js <- "
function qTip(values, ids) {
$('#THE_INPUT_ID .radiobtn').each(function(i, $el){
var value = $(this).find('input[type=radio]').val();
if(values.indexOf(value) > -1){
var selector = '#' + ids[value];
$(this).qtip({
overwrite: true,
content: {
text: $(selector).parent().parent()
},
position: {
my: 'top left',
at: 'bottom right'
},
show: {
ready: false
},
hide: {
event: 'unfocus'
},
style: {
classes: 'qtip-blue qtip-rounded'
},
events: {
blur: function(event, api) {
api.elements.tooltip.hide();
}
}
});
}
});
}
function qTip_delayed(mssg){
$('[data-hasqtip]').qtip('destroy', true);
setTimeout(function(){qTip(mssg.values, mssg.ids);}, 500);
}
$(document).on('shiny:connected', function(){
Shiny.addCustomMessageHandler('qTip', qTip_delayed);
});
"
ui <- fluidPage(
tags$head(
tags$link(rel = "stylesheet", href = "jquery.qtip.min.css"),
tags$script(src = "jquery.qtip.min.js"),
tags$script(HTML(js))
),
br(),
radioGroupButtons(
inputId = "THE_INPUT_ID",
individual = TRUE,
label = "Make a choice: ",
choices = c("A", "B", "C")
),
br(), br(), br(),
uiOutput("selections"),
uiOutput("dropdowns")
)
server <- function(input, output, session) {
dropdowns <- reactiveVal(list( # initial dropdowns
A = c("Apple", "Banana"),
B = c("Lemon", "Orange"),
C = c("Strawberry", "Pineapple")
))
flag <- reactiveVal(FALSE)
prefix <- reactiveVal("")
observeEvent(dropdowns(), {
if(flag()) prefix(paste0("x",prefix()))
flag(TRUE)
}, priority = 2)
observeEvent(input[["selectA"]], {
if(input[["selectA"]] == "Banana"){
updateRadioGroupButtons(session, inputId = "THE_INPUT_ID",
label = "Make NEW choice: ",
choices = c("D","A","B"))
dropdowns( # new dropdowns, only for D and B
list(
D = c("Pear", "Peach"),
B = c("Watermelon", "Mango")
)
)
}
})
observeEvent(dropdowns(), {
req(dropdowns())
session$sendCustomMessage(
"qTip",
list(
values = as.list(names(dropdowns())),
ids = setNames(
as.list(paste0(prefix(), "select", names(dropdowns()))),
names(dropdowns())
)
)
)
})
observeEvent(dropdowns(), {
req(dropdowns())
lapply(names(dropdowns()), function(value){
output[[paste0("selection",value)]] <-
renderPrint(input[[paste0(prefix(), "select", value)]])
})
})
output[["dropdowns"]] <- renderUI({
req(dropdowns())
selectInputs <- lapply(names(dropdowns()), function(value){
div(style = "display: none;",
selectInput(
paste0(prefix(), "select", value),
label = "Select a fruit",
choices = dropdowns()[[value]],
selectize = FALSE
)
)
})
do.call(tagList, selectInputs)
})
output[["selections"]] <- renderUI({
req(dropdowns())
verbOutputs <- lapply(names(dropdowns()), function(value){
verbatimTextOutput(
paste0("selection", value)
)
})
do.call(tagList, verbOutputs)
})
}
shinyApp(ui, server)
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.