Show elements between rows in a table

Question

I have a df dataframe. I would like to display each row. I would like to add on each line a button Show_Hide which will display other ui element below line l (between lines l and l+1).

How can I do this ? I was thinking of created a conditionalPanel but how can I test if the button is clicked?

I created a lapply loop to listen to all Show_Hide buttons but i get an error

mod_test_ui <- function(id){ ns <- NS(id) tagList( 
   uiOutput(ns("table")))}


mod_test_server <- function(id){ moduleServer( id, function(input, output, session){ ns <- session$ns

    df <- reactiveVal(data.frame(index = 1:5, nom = c("Alice", "Bob", "Charlie", "David", "Eve"), val1 = c(10, 20, 30, 40, 50), val2 = c(5, 4, 3, 2, 1)))

    df2 <- data.frame(matrix(rnorm(20 * 10), nrow = 20))

    output$table <- renderUI({
      lapply(1:nrow(df()), function(i) {
        id_sh <- paste0("sh", df()$index[i])
        condition_sh <- sprintf("input.%s %% 2 === 0", id_sh)
        id_del <- paste0("del", df()$index[i])
        id_table <- paste0("t", df()$index[i])
        id_name <- paste0("name", df()$index[i])
        fluidRow(
          column(2, p(df()$index[i])),
          column(2, textInput(ns(id_name), label = NULL, value = df()$nom[i])),
          column(2, p(df()$val1[i])),
          column(2, p(df()$val2[i])),
          column(2, actionButton(ns(id_sh), label = "Show_Hide")),
          column(2, actionButton(ns(id_del), label = "Delete")),
          column(
            12,
              dataTableOutput(ns(id_table)),
          ),
        )})})

    #Observe button "Show_Hide"
      lapply(1:nrow(df()), function(i) {
        observeEvent(input[[paste0("sh", df()$index[i])]], {
          cat("Button Show_Hide pressed : ", paste0("sh", df()$index[i]), "\n")
          id_table <- paste("t", i)
          output[[id_table]] <- renderTable(head(df2))
        })})
})}

When I run the application golem::run_dev() I get an error:

Warning: Error in .getReactiveEnvironment()$currentContext: Operation not allowed without an active reactive context.
• You tried to do something that can only be done from inside a reactive consumer.

---

mod_test_ui <- function(id){
  ns <- NS(id)
  tagList(
    uiOutput(ns("table"))
  )
}

mod_test_server <- function(id){
  moduleServer( id, function(input, output, session){
    ns <- session$ns

    df <- reactiveVal(data.frame(
      index = 1:5,
      nom = c("Alice", "Bob", "Charlie", "David", "Eve"),
      val1 = c(10, 20, 30, 40, 50),
      val2 = c(5, 4, 3, 2, 1)
    ))

    df2 <- data.frame(matrix(rnorm(20 * 10), nrow = 20))

    output$table <- renderUI({
      if(nrow(df()!= 0)){
        lapply(1:nrow(df()), function(i) {
          id_sh <- paste0("sh", df()$index[i])
          condition_sh <- sprintf("input.%s %% 2 === 0", id_sh)
          id_del <- paste0("del", df()$index[i])
          id_table <- paste0("t", df()$index[i])
          id_name <- paste0("name", df()$index[i])
          fluidRow(
            column(2, p(df()$index[i])),
            column(2, textInput(ns(id_name), label = NULL, value = df()$nom[i])),
            column(2, p(df()$val1[i])),
            column(2, p(df()$val2[i])),
            column(2, actionButton(ns(id_sh), label = "Show_Hide")),
            column(2, actionButton(ns(id_del), label = "Delete")),
            column(
              12,
              uiOutput(ns(id_table)),
            ),
          )
        })
      }
    })


    lapply(1:5, function(i) {
      observeEvent(input[[paste0("del", i)]], {
        df(subset(df(), index != i))
      })
    })

    lapply(1:5, function(i) {
      observeEvent(input[[paste0("sh", i)]], {
        id_t <- paste0("t", i)
        if(input[[paste0("sh", i)]]%%2 == 0){
          output[[id_t]] <- renderTable(NULL)
        } else {
          output[[id_t]] <- renderTable(head(df2))
        }
        cat("Bouton cliqué:", id_t, "\n")

      })
    })

  })
}

Answer 1

I think I misunderstood where you want to place the conditional panel but here is the idea.

An action button initially takes the value 0, and this value is incremented by 1 each time you click the button. So, if you want to detect the click in a conditional panel, you can check whether the value is odd or even, i.e. whether it equals 0 modulo 2:

input.theButtonId % 2 === 0

Thus:

library(shiny)

mod_test_ui <- function(id){ 
  ns <- NS(id) 
  tagList( 
    uiOutput(ns("table"))
  )
}

mod_test_server <- function(id){
  moduleServer(id, function(input, output, session){ 
    ns <- session$ns
    
    df <- reactiveVal(data.frame(
      index = 1:5, 
      nom = c("Alice", "Bob", "Charlie", "David", "Eve"), 
      val1 = c(10, 20, 30, 40, 50), 
      val2 = c(5, 4, 3, 2, 1)
    ))
    
    output$table <- renderUI({
      lapply(1:nrow(df()), function(i) {
        id_sh <- paste0("sh", df()$index[i])
        condition_sh <- sprintf("input.%s %% 2 === 0", id_sh)
        id_del <- paste0("del", df()$index[i])
        fluidRow(
          column(2, p(df()$index[i])),
          column(
            2, 
            conditionalPanel(
              condition = condition_sh,
              textInput(
                ns(paste0("nom_", df()$index[i])), 
                label = NULL, value = df()$nom[i]
              ),
              ns = ns
            )
          ),
          column(2, p(df()$val1[i])),
          column(2, p(df()$val2[i])),
          column(2, actionButton(ns(id_sh), label = "Show_Hide")),
          column(2, actionButton(ns(id_del), label = "Delete"))
        )
      })
    })
    
  })
}

ui <- fluidPage(
  mod_test_ui("x")
)
server <- function(input, output, session) {
  mod_test_server("x")
}

shinyApp(ui, server)