2

因此，您解决了一个问题并遇到了下一个问题。

我现在已经成功构建了动态创建 uiOutput 的部分代码，即许多滑块、按钮和/或文本字段，它们的数量取决于在更早的步骤中从我的模型中推出的值。

但是，我对如何观察它们是否被用户“点击”/“更改”一无所知。可以说，模型给出了一个 nr 12 然后服务器告诉我的 ui 制作 12 个按钮。我想知道用户何时按下任何按钮以及它是哪个按钮

举一个清晰的例子：如果用户单击按钮 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')
          )


   )
  )
)
4

1 回答 1

0

好的，经过长时间的困惑，我设法找到了一个有效的答案：

服务器.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 中的每个组散布它自己的颜色，以及“多选检查框，以便用户可以突出显示 1 个组或多个。

我们现在拥有的是：

var 'ob' 报告最后点击的按钮 var 'dl' 给出 0 和 1 的列表以查看谁被突出显示/点击 var 'pallete 将点击转换为“红色”或“灰色”状态

接下来，我将致力于构建文本输入字段以向组添加名称，可能是颜色选择器，以便用户可以自定义组合他/她自己的调色板，并将 bsButtons 修改为 YES/NO 按钮，方法是将标签有条件地呈现为 YES或否，就像我对突出显示/取消突出显示按钮所做的那样，以允许用户选择要“保留”哪些组以及要在下一个聚类阶段“删除”哪些组。

仍然想知道是否可以使用 BigDataScientist 开始的观察者结构实现相同的功能............

于 2017-04-29T18:25:31.367 回答