R 只有激活另一个小部件,闪亮的小部件才会工作

R 只有激活另一个小部件,闪亮的小部件才会工作,r,shiny,R,Shiny,我有一个功能强大的闪亮应用程序,其逻辑如下所述: 应用程序的逻辑: 用户使用selectInput标签选择其中一个测试。这是主操作,然后他可以修改它的名称,例如test1到testa。然后用户可以通过Test中的numericInput items在Test中添加项。这些是全部项目。正如您将看到的,测试中的项目数与choosen测试的hot3表中的“Avail”列相同。通过选择项目,他可以选择要在hot5表中显示的特定项目。然后,用户可以单击hot5表来选择特定的项目,并且针对该特定测试,所选项

我有一个功能强大的闪亮应用程序,其逻辑如下所述:

应用程序的逻辑:

用户使用selectInput标签选择其中一个测试。这是主操作,然后他可以修改它的名称,例如test1到testa。然后用户可以通过Test中的numericInput items在Test中添加项。这些是全部项目。正如您将看到的,测试中的项目数与choosen测试的hot3表中的“Avail”列相同。通过选择项目,他可以选择要在hot5表中显示的特定项目。然后,用户可以单击hot5表来选择特定的项目,并且针对该特定测试,所选项目或行的数量显示在hot3表的Sel列下。“选择的项目”仅显示在“选择项目”中选择的项目数。请注意,对表进行的每一次修改都不依赖于其他小部件。例如,这意味着无需更改标签名称

问题:

问题是,现在左边的hot 3表没有更新,除非我更改标签名称,标签名称不应该是这样的,因为它和其他东西一样是可选功能。例如,我可以选择测试1,但我不想更改其名称。然后,如果选择submitbutton,则左侧的表不会更新。如果我将它重命名为其他名称,即使是测试1,它也可以工作。但无论如何它都应该起作用

library(shiny)
    library(DT)
    library(rhandsontable)
    #library(tidyverse)

    ui <- navbarPage(
      "Application",
      tabPanel("Booklets",
               sidebarLayout(
                 sidebarPanel(
                   uiOutput("tex2"),
                   rHandsontableOutput("hot3")
                 ),
                 mainPanel(
                   fluidRow(
                     wellPanel(
                       fluidRow(
                         column(4,
                                DT::dataTableOutput("hot5")
                         ),
                         column(4,
                                fluidRow(
                                  uiOutput("book3"),
                                  uiOutput("book6")

                                ),
                                fluidRow(
                                  uiOutput("book1"),
                                  uiOutput("book10"),
                                  uiOutput("book11")
                                ),
                                fluidRow(actionButton("submit","submit"))
                         )
                       ))
                   )
                 )
               )
      )
    )
    #server
    server <- function(input, output, session) {

      rv<-reactiveValues()

      output$tex2<-renderUI({
        numericInput("text2", "#tests", value = 1, min=1)
      })

      output$book1<-renderUI({
        numericInput("bk1",
                     "Items in test",
                     value = 1,
                     min = 1)
      })

      output$book3<-renderUI({

        selectInput("bk3",
                    "Label",
                    choices=(paste("Test",1:input$text2)))

      })


      output$book6<-renderUI({
        textInput("bk6", "Change to",
                  value=NULL
        )
      })


      output$book10<-renderUI({
        # changed from selectize
        selectizeInput(
          "bk10", "Select Items", choices =1:10000,multiple =T,selected = 1,
          options = list(maxItems = input$bk1))#changed from
      })
      output$book11<-renderUI({
        textInput("bk11", "Items chosen",
                  value = nrow(rt5())
        )
      })

      #rt4<-reactive({
      observe({
        req(input$text2)

        rv$rt4 = data.frame(
          SNo = rep(TRUE, input$text2),
          Test=paste(1:input$text2),
          Label=paste("Test",1:input$text2),
          Avail=1L,
          Sel =as.integer(rep.int(0,input$text2)),
          stringsAsFactors = FALSE)
      })

      observeEvent(input$submit,{

     # rt4 <- reactive({
        if (is.null( rv$rt4))
          return(NULL)

        if(!is.null(input$bk6) && input$bk6!=""){
          rv$rt4[ rv$rt4$Label==input$bk3, "Avail"] <- input$bk1
          rv$rt4[ rv$rt4$Label==(input$bk3), "Sel"] <- length(input$hot5_rows_selected)

          rv$rt4[ rv$rt4$Label==input$bk3, "Label"] <- input$bk6
        }
        # if(!is.null(input$hot5_rows_selected) && input$hot5_rows_selected!=""){
        #
        # }
      })

      observeEvent(input$submit,{

        updateSelectInput(session,"bk3","Label", choices=rv$rt4$Label)
      }
      )


      rt55<-reactive({
        DF=data.frame(
          Id=  input$bk10,
          Label=paste("Item",input$bk10),
          Pf=0,
          stringsAsFactors = FALSE
        )
      })

      rt5<-reactive({
        DF=data.frame(
          Id=  input$bk10,
          Label=paste("Item",input$bk10),
          Pf=0,
          stringsAsFactors = FALSE
        )
        cbind(id=rowSelected(), DF)
      })

      rowSelected <- reactive({
        x <- numeric(nrow(rt55()))
        x[input$hot5_rows_selected] <- 1
        x
      })

      output$hot5 <- renderDT(datatable(rt5()[,-1],
                                        selection = list(mode = "multiple",
                                                         selected = (1:nrow(rt5()[,-1]))[as.logical(rowSelected())],
                                                         target = "row"),rownames = F)
      )

      output$hot3 <-renderRHandsontable({
        req(input$text2)
        rhandsontable(rv$rt4)
      })
    }
    shinyApp(ui,server)

请看看这是否适合你

    library(shiny)
library(DT)
library(rhandsontable)
#library(tidyverse)

ui <- navbarPage(
  "Application",
  tabPanel("Booklets",
           sidebarLayout(
             sidebarPanel(
               uiOutput("tex2"),
               rHandsontableOutput("hot3")
             ),
             mainPanel(
               fluidRow(
                 wellPanel(
                   fluidRow(
                     column(4,
                            DT::dataTableOutput("hot5")
                     ),
                     column(4,
                            fluidRow(
                              uiOutput("book3"),
                              uiOutput("book6")

                            ),
                            fluidRow(
                              uiOutput("book1"),
                              uiOutput("book10"),
                              uiOutput("book11")
                            ),
                            fluidRow(actionButton("submit","submit"))
                     )
                   ))
               )
             )
           )
  )
)
#server
server <- function(input, output, session) {

  rv<-reactiveValues()

  output$tex2<-renderUI({
    numericInput("text2", "#tests", value = 1, min=1)
  })

  output$book1<-renderUI({
    numericInput("bk1",
                 "Items in test",
                 value = 1,
                 min = 1)
  })

  output$book3<-renderUI({

    selectInput("bk3",
                "Label",
                choices=(paste("Test",1:input$text2)))

  })


  output$book6<-renderUI({
    textInput("bk6", "Change to",
              value=NULL
    )
  })


  output$book10<-renderUI({
    # changed from selectize
    selectizeInput(
      "bk10", "Select Items", choices =1:10000,multiple =T,selected = 1,
      options = list(maxItems = input$bk1))#changed from
  })
  output$book11<-renderUI({
    textInput("bk11", "Items chosen",
              value = nrow(rt5())
    )
  })

  #rt4<-reactive({
  observe({
    req(input$text2)

    rv$rt4 = data.frame(
      SNo = rep(TRUE, input$text2),
      Test=paste(1:input$text2),
      Label=paste("Test",1:input$text2),
      Avail=1L,
      Sel =as.integer(rep.int(0,input$text2)),
      stringsAsFactors = FALSE)
  })

  observeEvent(input$submit,{

    # rt4 <- reactive({
    if (is.null( rv$rt4))
      return(NULL)

    if(!is.null(input$bk6) && input$bk6!=""){
      rv$rt4[ rv$rt4$Label==input$bk3, "Avail"] <- input$bk1
      rv$rt4[ rv$rt4$Label==(input$bk3), "Sel"] <- length(input$hot5_rows_selected)

      rv$rt4[ rv$rt4$Label==input$bk3, "Label"] <- input$bk6
    }
    else
    {
      rv$rt4[ rv$rt4$Label==input$bk3, "Avail"] <- input$bk1
      rv$rt4[ rv$rt4$Label==(input$bk3), "Sel"] <- length(input$hot5_rows_selected)

      #rv$rt4[ rv$rt4$Label==input$bk3, "Label"] <- input$bk6

    }
  })

  observeEvent(input$submit,{

    updateSelectInput(session,"bk3","Label", choices=rv$rt4$Label)
  }
  )


  rt55<-reactive({
    DF=data.frame(
      Id=  input$bk10,
      Label=paste("Item",input$bk10),
      Pf=0,
      stringsAsFactors = FALSE
    )
  })

  rt5<-reactive({
    DF=data.frame(
      Id=  input$bk10,
      Label=paste("Item",input$bk10),
      Pf=0,
      stringsAsFactors = FALSE
    )
    cbind(id=rowSelected(), DF)
  })

  rowSelected <- reactive({
    x <- numeric(nrow(rt55()))
    x[input$hot5_rows_selected] <- 1
    x
  })

  output$hot5 <- renderDT(datatable(rt5()[,-1],
                                    selection = list(mode = "multiple",
                                                     selected = (1:nrow(rt5()[,-1]))[as.logical(rowSelected())],
                                                     target = "row"),rownames = F)
  )

  output$hot3 <-renderRHandsontable({
    req(input$text2)
    rhandsontable(rv$rt4)
  })
}
shinyApp(ui,server)

这是一种魅力!谢谢!