Shiny app: Matrix-checkbox

[hohenc]

Hello!

I'm searching for an opportunity to create a checkbox in the right sidebar of my shiny app, wich looks like a matrix. Then it should be possible to select like this f. e.:

                            Name         Time           Budget
Project A                    [ ]         [ ]              [x]
Project B                    [x]         [x]              [ ]

How can I do this? Does anybody know?

Greets Christina

[nirgrahamuk]

columns <- c("name","time","budget")
projects <- c("A","B")

library(shiny)
library(tidyverse)
library(glue)

ui <- fluidPage(
  uiOutput("myui"),
  verbatimTextOutput("tout")
)

server <- function(input, output, session) {
output$myui <- renderUI({
  tagList(
    map(
      projects,
      ~ {
        div(
          style = "grid-gap: 1em;display:flex;align-items: center;",
          tags$label(glue("Project {.}")),
          shiny::checkboxGroupInput(
            inputId = glue("project_{.}"),
            label = "",
            choices = columns,
            inline = TRUE
          )
        )
      }
    )
  )
})

output$tout <- renderPrint({
 inputs_gathered <-  map(
    projects,
    ~input[[glue("project_{.}")]]) %>% set_names(projects)
 str(inputs_gathered)
})
}

shinyApp(ui, server)

[pieterjanvc]

Hi,

Welcome to the RStudio community!

Here is another way of doing this. It might be a bit more convoluted, but I think the result is visually pretty

library(shiny)
library(DT)

ui <- fluidPage(
  dataTableOutput("myTable")
)

server <- function(input, output, session) {
  
  #The proxy to update the DT
  proxy <- dataTableProxy('myTable')
  
  #The initial data for the checkboxes
  checkboxes = data.frame(
    Name = c(NA, as.character(icon("ok", lib = "glyphicon"))),
    Time = c(NA, as.character(icon("ok", lib = "glyphicon"))),
    Budget = c(as.character(icon("ok", lib = "glyphicon")), NA),
    row.names = paste("Project", 1:2)
  )
  
  #The reactive version of the data
  tableData = reactiveValues(checkboxes = checkboxes)
  
  #Update the table when clicked
  observeEvent(req(input$myTable_cells_selected), {
    tableData$checkboxes[input$myTable_cells_selected] =
      ifelse(is.na(tableData$checkboxes[input$myTable_cells_selected]),
             as.character(icon("ok", lib = "glyphicon")), NA)
    
    #Send proxy (no need to refresh whole table)
    replaceData(proxy, tableData$checkboxes)
    
  })
 
  #The "checkbox" table
  output$myTable = renderDataTable({
    
    checkboxes
    
  }, 
  #These are options to make the table look like checkboxes
  selection = list(mode = "single", target = 'cell'), 
  options = list(
    columnDefs = list(list(className = 'dt-center', targets = "_all")),
    dom = "t", ordering = F
  ),
  escape = F)
  
}

shinyApp(ui, server)

The trick I did was use the datatable package to put icons (checkmarks) into the cells and use the proxy to update the table when a specific cell is clicked. This way there is minimal data transfer. The great thing about this approach is that the data will always be in a nice grid and scale with page (you can change that of course). Also, you are now able to use both rows and column names, which is not possible with the traditional checkboxes.

To get the actual list of "checked boxes", you can simply convert the table to a logical matrix when you need it

!is.na(tableData$checkboxes)
           Name  Time Budget
Project 1 FALSE FALSE   TRUE
Project 2  TRUE  TRUE  FALSE

Hope this helps,
PJ

[hohenc]

Hey nirgrahamuk,

thank you for your solution. By running there occurs the Error: 'AMapEnv' is not an exportet Object from 'namespace:maps'...

I don't know how to fix it.

Christina

[hohenc]

Hi pieterjanvc,

thank you for your solution. I'm right there with you - the Matrix is really pretty and I'm going to use your code now. Thanks a lot!

Christina

[nirgrahamuk]

The map function should be purrr::map