所以,你解决了一个问题并遇到了下一个问题。
我现在已经成功构建了动态创建uiOutput的代码的一部分,即一些滑块,按钮和/或文本字段,它们的数量取决于在更早的步骤中从我的模型中滚出的值。
但是,我很不知道如何观察用户是否“点击”/“更改”了这些内容。可以说,该模型给出了12号 然后服务器告诉我的ui做12个按钮。 我想知道用户何时按下任何按钮和WHICH按钮
用文字说明一个明确的例子:如果用户点击按钮8,我想让R告诉我“用户点击按钮8”。 目标是不仅具有动态按钮,还具有对它们的使用的动态反应。
我的最终目标之一是收集是/否答案列表,并为每个元素输入名称。所以我正在寻找一种通用的方法来将条件挂起到观察事件按钮“i”或文本字段“j”等等
这是我如何创建动态UI的功能完备的最小示例。
服务器:
shinyServer = function(input, output, session) {
################# start functionality HOME TAB #############################
values <- reactiveValues()
observeEvent(input$myNr, {
values$nrofelements <- input$myNr })
observeEvent(values$nrofelements, {
if (values$nrofelements > 0 & values$nrofelements < 25) {
output$sliders <- renderUI({
lapply(1:values$nrofelements, function(j) {
sliderInput(inputId = paste0("ind", j), label = paste("Individual", j),
min = 0, max = 20000, value = c(0, 500), step = 100)
})
})
output$buttons <- renderUI({
lapply(1:values$nrofelements, function(i) {
div(br(),bsButton(inputId = paste0("indr", i), label = paste("Yes", i), block = FALSE, style = "succes"), br(), br() )
})
})
}
})
observe({
if(values$nrofelements != ""){
for(nr in 1:values$nrofelements){
if(!is.null(input[[paste0("indr", nr)]])) print(paste0("Inputname 'indr", nr, "': ", "value is ", isolate(input[[paste0("indr", nr)]])))
}
}
})
}
和UI.r
library(shiny)
library(shinydashboard)
library(shinybs)
ui <- dashboardPage(
dashboardHeader(title = "FLOW C.A.R.S."),
dashboardSidebar(
sidebarMenu(id = "tabs", menuItem("Home", tabName = "Home", icon = icon("book"))
)
),
dashboardBody(
tabItems(
### HOME ###_________
tabItem(tabName = "Home", class = 'rightAlign',
h5("Enter desired nr of elements here"),
textInput(inputId ="myNr", label = NULL , placeholder = NULL),
fluidRow(
column(3,
uiOutput("sliders")),
column(1,
uiOutput("buttons")
)
),
textOutput('clickedwhat')
)
)
)
)
答案 0 :(得分:0)
好的,经过长时间的困惑,我找到了一个有效的答案:
server.R
shinyServer = function(input, output, session) {
################# start functionality HOME TAB #############################
values <- reactiveValues()
dynamicvalues <- reactiveValues()
observeEvent (input$myNr, {
values$nrofelements <- paste0(input$myNr) })
#### RENDER DYNAMIC UI
observeEvent(values$nrofelements, {
if (isolate(values$nrofelements>0)) {
output$actionbuttons <- renderUI({
lapply(1:values$nrofelements, function(ab) {
if (!is.null(dynamicvalues[[paste0("button", ab)]])) { if(dynamicvalues[[paste0("button", ab)]] == 0 ) {
div(br(), actionButton(inputId = paste0("ind", ab), label = paste("highlight", ab)), br(), br()) }
else { div(br(), actionButton(inputId = paste0("ind", ab), label = paste("unhighlight", ab)), br(), br())} }
else {
div(br(), actionButton(inputId = paste0("ind", ab), label = paste("highlight", ab)), br(), br()) }
})
})
output$allbutton <- renderUI({ div( br(), br(), actionButton(inputId = "All", label = "All"), br(), br())
})
output$buttons <- renderUI({
lapply(1:values$nrofelements, function(bsb) {
div(br(),bsButton(inputId = paste0("indr", bsb), label = paste("Yes", bsb),
block = FALSE, style = "succes", onclick = paste0("Shiny.onInputChange('rnd',", bsb,")")), br(), br() )
})
})
output$multicheckbox <- renderUI ({
div( br(), checkboxInput(inputId = "multiselect", label ="allow multiselect", value = FALSE, width = NULL), br()) })
}
})
#### OBSERVE DYNAMIC UI
observeEvent( values$nrofelements, {
if (values$nrofelements> 0) {
isolate(lapply(1:values$nrofelements, function(su) {
dynamicvalues[[paste0("button", su)]] <- 0 }))
dynamiclistB <- reactiveValuesToList(dynamicvalues)
values$dynamiclistB2 <- as.character(unlist(dynamiclistB, use.names = FALSE))
isolate(lapply(1:values$nrofelements, function(ob) {
observeEvent(input[[paste0("ind", ob)]], {
if (input$multiselect == FALSE) {
for (clicked in 1:values$nrofelements) { if ( ob != clicked) { dynamicvalues[[paste0("button", clicked)]] <- 0} }}
if (is.null(dynamicvalues[[paste0("button", ob)]])) {dynamicvalues[[paste0("button", ob)]] <- 1}
else { if (dynamicvalues[[paste0("button", ob)]] == 1) {dynamicvalues[[paste0("button", ob)]] <- 0}
else { dynamicvalues[[paste0("button", ob)]] <- 1}
}
dynamiclist <- reactiveValuesToList(dynamicvalues)
values$dynamiclist2 <- as.character(unlist(dynamiclist, use.names = FALSE))
print(paste0("dl = ", toString(values$dynamiclist2)))
print(paste("ob =", ob ))
values$button_nr_clicked <- ob
myVector <- vector(mode="character", length=values$nrofelements)
myVector <- replace(myVector, myVector == "", "GREY")
myVector[values$button_nr_clicked]="RED"
print(paste("pallete = ", toString(myVector)))
print( "-----------next click event prints the below this line--------------------------------------------------------------")
}) }) ) }})
observeEvent(input$All,{
myVector <- NULL
myVector <- vector(mode="character", length=values$nrofelements)
myVector <- replace(myVector, myVector == "", "RED")
print(paste("pallete = ", toString(myVector)))
print( "-----------next click event prints the below this line--------------------------------------------------------------")
})
}
和UI.R
library(shiny)
library(shinydashboard)
library(shinyBS)
ui <- dashboardPage(
dashboardHeader(title = "FLOW C.A.R.S."),
dashboardSidebar(
sidebarMenu(id = "tabs", menuItem("Home", tabName = "Home", icon = icon("book"))
)
),
dashboardBody(
tabItems(
### HOME ###_________
tabItem(tabName = "Home",
h5("Enter desired nr of elements here"),
textInput(inputId ="myNr", label = NULL , placeholder = "NULL"),
fluidRow(
column(3,
uiOutput("actionbuttons"),
uiOutput("allbutton")),
column(1,
uiOutput("buttons")
)
),
uiOutput("multicheckbox")
)
)
)
)
正如你所看到的,我建立了一些额外的功能,比如“全部”按钮,我将在现实中使用它来运行带有彩虹色彩的托盘(每个组在图中3D散射它自己的颜色, 和“多选复选框,以便用户可以高亮显示一组或多组。
我们现在拥有的是:
var'ob'报告最后点击的按钮 var'dl'给出0和1的列表,以查看谁突出显示/点击了 var'pallete将点击转换为“RED”或“GRAY”状态
接下来,我将处理构建文本输入字段以向组添加名称, 可能是一个颜色选择器,因此用户可以自定义组成他/她自己的托盘 将bsButtons修改为YES / NO按钮,条件是将Label标记为YES或NO,就像我使用highlight / unhighlight按钮一样,允许用户选择哪些组“保持”以及哪些组“删除”以进行下一步聚类阶段。
仍然想知道是否有可能通过观察者结构实现相同的BigDataScientist开始.............