R闪亮的“隐藏/显示”动作按钮

Question

Thanks to several topics here, I have started to create a little program, but I have some little problems : On the tab "Page 1", when I click the "add_btn" action button, a box appears allowing to record a new person. But I would like to hide the action button "add_btn" when all inputs are empty. You can see that I try to do it with shinyjs with just one input : input$fname_1, but the button is still be shown. Second, in the data table created, named "persons", I dont succeed to bring back the counter value in the first variable "value_i".

Please, could you tell me what it is wrong in my program ?

Thank you very much.

Ui :

 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

and the Server :

 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

 }

Answer 1

Using observeEvent may not be appropriate here (or probably I didn't know to solve it with that), so what we can do is it coupling an observeEvent that tracks the button add_btn click and within that an observe always listening to that filed fname_1 .

server.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

}

Also in the

ui.R

you should add 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