【问题标题】:R shiny Hide/Show action buttonR 闪亮的隐藏/显示操作按钮
【发布时间】:2018-09-06 00:04:12
【问题描述】:

感谢这里的几个主题,我已经开始创建一个小程序,但是我有一些小问题: 在“第 1 页”选项卡上,当我单击“add_btn”操作按钮时,会出现一个框,允许记录一个新人。但是当所有输入为空时,我想隐藏操作按钮“add_btn”。你可以看到我尝试用shinyjs 只输入一个输入:input$fname_1,但按钮仍然显示。 其次,在创建的名为“persons”的数据表中,我没有成功带回第一个变量“value_i”中的计数器值。

拜托,你能告诉我我的程序有什么问题吗?

非常感谢。

界面:

 library(shiny)
 library(shinydashboard)
 library(shinyBS)
 library(shinyjs)

 ui <- dashboardPage(  

 dashboardHeader(
title = "Test",
titleWidth = 500),

  dashboardSidebar(
    sidebarMenu(id = "Menu1",
            sidebarMenuOutput("Menu"))),

  dashboardBody(
    shinyjs::useShinyjs(), # required to enable Shinyjs
    tabItems(

      tabItem(tabName = "HF_Page1",
          box(title = "A. People who live in the house", width = NULL, solidHeader = TRUE, status = "primary",
              uiOutput("HF_Page1"),
              actionButton("add_btn", "Add a person"),
              actionButton("rm_btn", "Remove last person"),
              textOutput("counter"))),

      tabItem(tabName = "HF_Page2",
          box(title = "B. Responses", width = NULL, solidHeader = TRUE, status = "primary",
              DT::dataTableOutput("persons", width = 300), tags$hr()))

    ) # tabItems
  ) # dashboardBody
) # dashboardPage

和服务器:

 fields <- c("value_i", "fname_1", "lname_1", "sex1", "birth_year1", "spouse1", "mother1", "father1", "time1_1", "time1_2")

 # Save a response
 saveData <- function(data) {
   data <- as.data.frame(t(data))
   if (exists("persons")) {
     persons <<- rbind(persons, data)
   } else {
     persons <<- data
   }
 }

 loadData <- function() {
   if (exists("persons")) {
     persons
   }
 }

 server <- shinyServer(function(input, output, session) {

   session$onSessionEnded(stopApp)

   output$Menu <- renderMenu({

     sidebarMenu(
       menuItem(strong("House Form"), tabName = "HF", icon = icon("home"), selected = TRUE),
       menuSubItem("Page 1", tabName = "HF_Page1"),
       menuSubItem("Page 2", tabName = "HF_Page2"),
       menuSubItem("Page 3", tabName = "HF_Page3"),
       menuItem(strong("Individual Form"), tabName = "IF", icon = icon("user")),
       menuSubItem("Page 1", tabName = "IF_Page1"),
       menuSubItem("Page 2", tabName = "IF_Page2"),
       menuItem(strong("Close application"), tabName = "Close", icon = icon("remove"))

     ) # sidebarMenu

   }) # renderMenu

   # Track the number of each person
   counter <- reactiveValues(n = 0)

   #observeEvent(input$add_btn, {
   #  counter$n <- counter$n + 1
   #  saveData(formData())
   #})

   observeEvent(input$rm_btn, {
     if (counter$n > 0)
       counter$n <- counter$n - 1
   })

   # Print counter value
   output$counter <- renderPrint(print(counter$n))

   # render a number of topic ui elements based on the counter
   topics <- reactive({
     n <- counter$n
     if (n > 0)
       lapply(seq_len(n), topic_ui)
   })



   observeEvent(input$add_btn,{
     observe(
       if(is.null(input$fname_1) || input$fname_1 == "" || is.null(input$lname_1) || input$lname_1 == "" || is.null(input$birth_year1) || input$birth_year1 == ""){
         disable("add_btn")
       }
       else{
         enable("add_btn")
       }
     )
     counter$n <- counter$n + 1
     saveData(formData())
   })
   # Rendering the UI
   output$HF_Page1 <- renderUI(topics())

   # Whenever a field is filled, aggregate all form data
   formData <- reactive({
     data <- sapply(fields, function(x) input[[x]])
     data
   })

   # When the Add button is clicked, save the form data
   #observeEvent(input$add_btn, {
   #  saveData(formData())
   #})

   # Show the previous responses
   # (update with current response when Submit is clicked)
   output$persons <- DT::renderDataTable({
     input$add_btn
     loadData()
   })

   # Render table of people recorded
   output$HF_Page2 <- renderUI(
     DT::dataTableOutput("persons", width = 300), tags$hr())

 })

 topic_ui <- function(i) {

   box(title = paste("Person", i), width = NULL, solidHeader = FALSE,      status = "primary",
       column(width = 6,

         div(style = "display:inline-block", print(h3(i))),
         div(style = "display:inline-block", textInput("fname_1", "First name", value = "", width = '250px')),
         div(style = "display:inline-block", textInput("lname_1", "Last name", value = "", width = '250px')),
         div(style = "display:inline-block", selectInput("sex1", "Sex", choices = list("M" = "1", "F" = "2"),
                                                         selected = "", width = '55px')),
         div(style = "display:inline-block", textInput("birth_year1", "Birth year", value = "", width = '125px'))),

       column(width = 4,

         div(style = "display:inline-block", textInput("spouse1", "Spouse's line number", value = "", width = '150px')),
         div(style = "display:inline-block", textInput("mother1", "Mother's line number", value = "", width = '150px')),
         div(style = "display:inline-block", textInput("father1", "Father's line number", value = "", width = '150px'))),

       column(width = 2,

         checkboxInput("time1_1", label = "Half time", FALSE),

         bsTooltip("time1_1",
                   "Test Tooltip1"), placement = "bottom", trigger = "hover",

         checkboxInput("time1_2", label = "More than half time", FALSE),

         bsTooltip("time1_2",
                   "Test Tooltip2"), placement = "bottom", trigger = "hover")

   ) # box

 }

【问题讨论】:

    标签: r shiny


    【解决方案1】:

    在这里使用observeEvent 可能不合适(或者我可能不知道用它来解决它),所以我们可以做的是耦合一个observeEvent 来跟踪按钮add_btn 点击并在其中observe 一直在收听提交的 fname_1

    服务器.R

    fields <- c("value_i", "fname_1", "lname_1", "sex1", "birth_year1", "spouse1", "mother1", "father1", "time1_1", "time1_2")
    
    # Save a response
    saveData <- function(data) {
      data <- as.data.frame(t(data))
      if (exists("persons")) {
        persons <<- rbind(persons, data)
      } else {
        persons <<- data
      }
    }
    
    loadData <- function() {
      if (exists("persons")) {
        persons
      }
    }
    
    server <- shinyServer(function(input, output, session) {
    
      session$onSessionEnded(stopApp)
    
      output$Menu <- renderMenu({
    
        sidebarMenu(
          menuItem(strong("House Form"), tabName = "HF", icon = icon("home"), selected = TRUE),
          menuSubItem("Page 1", tabName = "HF_Page1"),
          menuSubItem("Page 2", tabName = "HF_Page2"),
          menuSubItem("Page 3", tabName = "HF_Page3"),
          menuItem(strong("Individual Form"), tabName = "IF", icon = icon("user")),
          menuSubItem("Page 1", tabName = "IF_Page1"),
          menuSubItem("Page 2", tabName = "IF_Page2"),
          menuItem(strong("Close application"), tabName = "Close", icon = icon("remove"))
    
        ) # sidebarMenu
    
      }) # renderMenu
    
      # Track the number of each person
      counter <- reactiveValues(n = 0)
    
      observeEvent(input$add_btn, {
        counter$n <- counter$n + 1
        saveData(formData())
      })
    
      observeEvent(input$rm_btn, {
        if (counter$n > 0)
          counter$n <- counter$n - 1
      })
    
      # Print counter value
      output$counter <- renderPrint(print(counter$n))
    
      # render a number of topic ui elements based on the counter
      topics <- reactive({
        n <- counter$n
        if (n > 0)
          lapply(seq_len(n), topic_ui)
      })
    
    
    
      observeEvent(input$add_btn,{
        observe(
          if(is.null(input$fname_1) || input$fname_1 == ""){
            disable("add_btn")
          }
          else{
            enable("add_btn")
          }
        )
    
      })
      # Rendering the UI
      output$HF_Page1 <- renderUI(topics())
    
      # Whenever a field is filled, aggregate all form data
      formData <- reactive({
        data <- sapply(fields, function(x) input[[x]])
        data
      })
    
      # When the Add button is clicked, save the form data
      observeEvent(input$add_btn, {
        saveData(formData())
      })
    
      # Show the previous responses
      # (update with current response when Submit is clicked)
      output$persons <- DT::renderDataTable({
        input$add_btn
        loadData()
      })
    
      # Render table of people recorded
      output$HF_Page2 <- renderUI(
        DT::dataTableOutput("persons", width = 300), tags$hr())
    
    })
    
    topic_ui <- function(i) {
    
      box(title = paste("Person", i), width = NULL, solidHeader = FALSE, status = "primary",
          column(width = 6,
    
                 div(style = "display:inline-block", print(h3(i))),
                 div(style = "display:inline-block", textInput("fname_1", "First name", value = "", width = '250px')),
                 div(style = "display:inline-block", textInput("lname_1", "Last name", value = "", width = '250px')),
                 div(style = "display:inline-block", selectInput("sex1", "Sex", choices = list("M" = "1", "F" = "2"),
                                                                 selected = "", width = '55px')),
                 div(style = "display:inline-block", textInput("birth_year1", "Birth year", value = "", width = '125px'))),
    
          column(width = 4,
    
                 div(style = "display:inline-block", textInput("spouse1", "Spouse's line number", value = "", width = '150px')),
                 div(style = "display:inline-block", textInput("mother1", "Mother's line number", value = "", width = '150px')),
                 div(style = "display:inline-block", textInput("father1", "Father's line number", value = "", width = '150px'))),
    
          column(width = 2,
    
                 checkboxInput("time1_1", label = "Half time", FALSE),
    
                 bsTooltip("time1_1",
                           "Test Tooltip1"), placement = "bottom", trigger = "hover",
    
                 checkboxInput("time1_2", label = "More than half time", FALSE),
    
                 bsTooltip("time1_2",
                           "Test Tooltip2"), placement = "bottom", trigger = "hover")
    
      ) # box
    
    }
    

    同样在

    ui.R

    你应该添加 use ``useShinyjs()`

    library(shiny)
    library(shinydashboard)
    library(shinyBS)
    library(shinyjs)
    
    ui <- dashboardPage(
    
      dashboardHeader(
        title = "Test",
        titleWidth = 500),
    
      dashboardSidebar(
        sidebarMenu(id = "Menu1",
                    sidebarMenuOutput("Menu"))),
    
      dashboardBody(
        shinyjs::useShinyjs(), # required to enable Shinyjs
        tabItems(
    
          tabItem(tabName = "HF_Page1",
                  box(title = "A. People who live in the house", width = NULL, solidHeader = TRUE, status = "primary",
                      uiOutput("HF_Page1"),
                      actionButton("add_btn", "Add a person"),
                      actionButton("rm_btn", "Remove last person"),
                      textOutput("counter"))),
    
          tabItem(tabName = "HF_Page2",
                  box(title = "B. Responses", width = NULL, solidHeader = TRUE, status = "primary",
                      DT::dataTableOutput("persons", width = 300), tags$hr()))
    
        ) # tabItems
      ) # dashboardBody
    ) # dashboardPage
    

    【讨论】:

    • 非常感谢@amrss,我已经修改了我的脚本,现在,该按钮被禁用,直到四个第一个 TextInput 被填充。我只是有一个小问题:当我单击“add_btn”时,会出现另一个框,允许记录第二个人,但是由于第一个人的 TextInputs 是空的,当我完成输入第二个人时,add_btn 仍然被禁用人。请问,您知道如何保留以前 textInputs 中输入的所有信息吗?非常感谢。 PS:我已经编辑了我的测试脚本。
    • @Mickey_NC 嘿,这很好。您能否将此答案标记为已回答并发布一个新问题,其中包含问题的详细信息和您更新的代码?
    猜你喜欢
    • 2019-09-28
    • 2013-11-19
    • 1970-01-01
    • 2016-04-17
    • 2018-10-09
    • 1970-01-01
    • 2017-02-16
    • 2021-09-10
    • 2018-10-17
    相关资源
    最近更新 更多