rshinygolem

Show elements between rows in a table


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")

      })
    })

  })
}

Solution

  • 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)