R Shiny click on table field

user_18259063 0
Viewed 294

I am currently learning R. I have a small project where a timetable is displayed and the user has the option to enter a subject.

After adding the subject to the timetable, it should be possible to click on it to open the modalDialog. Unfortunately my code does not work. I have tried it here:

observeEvent(input$mytable_cells_selected, {
    showModal(modalDialog(
      title = "Somewhat important message",
      "This is a somewhat important message.",
      easyClose = TRUE,
      footer = NULL))
  })

Can someone help me and tell where my error is?

ui <- fluidPage(
    theme = bs_theme(version = 4, bootswatch = "minty"),
      titlePanel(h1("My timetable", align = "center" )),
      sidebarLayout(
        position = c("left"),
        sidebarPanel(
          width = 4,
          selectInput("select1", label = h5("Event:"),
                      choices = c("math" , "sience", "sport") ,
                      selected = 1,
                      width = 400),
          actionButton("action", label = "Add")),
        mainPanel(
          width = 8,
          tableOutput('mytable')),
      ),
    )

and server:

server <- function(input, output, session) {
  
  timetable <- reactiveVal(
    data.frame(monday = c("","","","",""),
               tuesday = c("","","","",""),
               wednesday = c("","","","",""),
               thursday = c("","","","",""),
               friday = c("","","","",""))
  )
   
  output$mytable <- renderTable(timetable(), 
          bordered = TRUE, 
          spacing = c('l'), 
          width = "100%",
          striped = TRUE,
          align = 'c',
          rownames = TRUE,
          selection = list(target = 'cell'))
  
  observeEvent(input$action, { 
    tmp <- timetable()
    tmp[1, "monday"] <- input$select1
    timetable(tmp)
  })

  observeEvent(input$mytable_cells_selected, {
      showModal(modalDialog(
         title = "message",
         "This is a somewhat important message.",
         easyClose = TRUE,
         footer = NULL))
})
}

shinyApp(ui, server)
shiny r
1 Answers

As mentioned in the comment, you can use the DT library. Here is a complete example.

Use dataTableOutput in your ui for your data table.

In server, you can include renderDataTable and customize here. In this case, selection is set for single cells.

You can capture the selection event (or can capture clicked event) with input$my_table_cells_selected. In my version I used an underscore for my_table. This information will include the row and column values of the cell selected.

Note that the DT data table could be editable and allow for other interactivity, depending on your needs.

library(shiny)
library(bslib)
library(DT)

ui <- fluidPage(
  theme = bs_theme(version = 4, bootswatch = "minty"),
  titlePanel(h1("My timetable", align = "center" )),
  sidebarLayout(
    position = c("left"),
    sidebarPanel(
      width = 4,
      selectInput("select1", label = h5("Event:"),
                  choices = c("math" , "sience", "sport") ,
                  selected = 1,
                  width = 400),
      actionButton("action", label = "Add")),
    mainPanel(
      width = 8,
      dataTableOutput('my_table')
    )
  )
)

server <- function(input, output, session) {
  
  timetable <- reactiveVal(
    data.frame(monday = c("","","","",""),
               tuesday = c("","","","",""),
               wednesday = c("","","","",""),
               thursday = c("","","","",""),
               friday = c("","","","",""))
  )
   
  output$my_table = renderDataTable(timetable(), selection = list(mode = "single", target = "cell"))
  
  observeEvent(input$action, { 
    tmp <- timetable()
    tmp[1, "monday"] <- input$select1
    timetable(tmp)
  })
  
  observeEvent(input$my_table_cells_selected, {
    req(input$my_table_cells_selected)
    showModal(modalDialog(
      title = "message",
      paste("This is a somewhat important message:", 
            input$my_table_cells_selected[1],
            input$my_table_cells_selected[2]),
      easyClose = TRUE,
      footer = NULL))
  })
  
}

shinyApp(ui, server)
user_34606700
Related