Search code examples
rshinymodulereactable

shiny return selected table row from module if button pressed


I have at Reactable in a module and like to get the selected value if a button in the module is pressed. With the return value I like to open another tabItem with the value. But the return value from the module never is delivered to the main app. I made a empty value when nothing happened and the selected row if the button is pressed.

      sel <- reactiveVal()
      observeEvent(input$fn,{
        sel <- selected() # This is the selected row from the reactable
        return(reactive(sel))
      })
      return(sel)

Whats the best way doing this?

Here is the full example

library(shiny)
library(reactable)
library(shinyWidgets)


ui_mod <- function(id) {
  ns <- NS(id)
  tagList(
    textOutput(ns("text"))
  )
}
server_mod <- function(id, row, parent ) {
  moduleServer(id,
    function(input, output, session) {
      updateTabsetPanel(parent, "mainPanel", selected = "tab2")
      output$text <- renderText({paste("X =",row)})
    })
}

ui_tab <-  function(id) {
  ns <- NS(id)
  tagList(
    
    # dataTableOutput(ns("datatable"))
    reactableOutput(ns("datatable")),
    actionBttn(ns("fn"), label  = "button")
    
    
  )
}

server_tab <- function(id, row, parent ) {
  moduleServer(id,
    function(input, output, session) {
      X = data.frame(
        ID = c("Click here then press button for jump to tab2 and pass value", 
          "Click here then Jump to tab2 and pass row number to tab2",
          "Click here then Jump to tab2 and pass row number to to tab2"),
        x = c(1,2,3),
        y = c(10,2,4)    
      )
      
      selected <- reactive(getReactableState("datatable", "selected"))
      output$datatable = renderReactable(reactable({X}, 
        selection = "single"
      ))
      
      sel <- reactiveVal()
      observeEvent(input$fn,{
        sel <- selected()
        return(reactive(sel))
      })
      return(sel)
    })
}


ui <- fluidPage(
  tabsetPanel(id = "mainPanel", 
    tabPanel("tab1",ui_tab("tabelle")),
    tabPanel("tab2",ui_mod("test"))
  )
)
server <- function(input, output, session) {
  row_sel <- server_tab("tabelle")
  observe({
    row <- row_sel()
    print(row)
    if(!is.null(row)) server_mod("test", row = row, parent = session)
  })  
}

shinyApp(ui = ui, server = server)

I have tried several possibilities but only the row selection direct without the button is working.

Thanks for any help on this!


Solution

  • Try sel(selected()). It works.

    library(shiny)
    library(reactable)
    library(shinyWidgets)
    
    ui_mod <- function(id) {
      ns <- NS(id)
      tagList(
        textOutput(ns("text"))
      )
    }
    server_mod <- function(id, row, parent ) {
      moduleServer(id,
                   function(input, output, session) {
                     updateTabsetPanel(parent, "mainPanel", selected = "tab2")
                     output$text <- renderText({paste("X =",row)})
                   })
    }
    
    ui_tab <-  function(id) {
      ns <- NS(id)
      tagList(
        
        # dataTableOutput(ns("datatable"))
        reactableOutput(ns("datatable")),
        actionBttn(ns("fn"), label  = "button")
        
      )
    }
    
    server_tab <- function(id) {
      moduleServer(id,
                   function(input, output, session) {
                     X = data.frame(
                       ID = c("Click here then press button for jump to tab2 and pass value", 
                              "Click here then Jump to tab2 and pass row number to tab2",
                              "Click here then Jump to tab2 and pass row number to to tab2"),
                       x = c(1,2,3),
                       y = c(10,2,4)    
                     )
                     
                     selected <- reactive(getReactableState("datatable", "selected"))
                     output$datatable = renderReactable(reactable({X}, 
                                                                  selection = "single"
                     ))
                     
                     sel <- reactiveVal()
                     observeEvent(input$fn,{
                       sel(selected())
                       return(reactive(sel))
                     })
                     return(sel)
                   })
    }
    
    
    ui <- fluidPage(
      tabsetPanel(id = "mainPanel", 
                  tabPanel("tab1",ui_tab("tabelle")),
                  tabPanel("tab2",ui_mod("test"))
      )
    )
    server <- function(input, output, session) {
      row_sel <- server_tab("tabelle")
      observeEvent(row_sel(), {
        row <- row_sel()
        print(row)
        if(!is.null(row)) { 
          server_mod("test", row = row, parent = session)
        }
      })
    }
    
    shinyApp(ui = ui, server = server)