Search code examples
shinydtselectinput

How do I render choices for selectInput in DTEdit?


I am working on an RShiny app using the DTedit package to create an editable data table. The goal is to allow users to map columns from two different data frames. However, when using selectInput in the DTedit table, the select inputs are displaying blank options. I have verified that the data and column names are correct. Can anyone help me diagnose the issue and get the select inputs to show the expected choices?

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

MAPPING_TABLE <- list(
  'Standard Column 1' = list('Type'='Character'),
  'Standard Column 2' = list('Type'='Character'),
  'Standard Column 3' = list('Type'='Character')
)

format_default_mapping_table <- function(fields_list) {
  data.frame(
    'Standard Field' = names(fields_list),
    'Type' = unname(unlist(lapply(fields_list, function(field) field$Type))),
    'PY Field' = c(''),
    'CY Field' = c(''),
    check.names=FALSE
  )
}


ui <- navbarPage(
  
  title = 'Mapping Tool',
  theme = bs_theme(version=5, bootswatch='cosmo'),
  position = 'static-top',
  fluid = TRUE,
  
  tabPanel(
    'Home',
    fluidPage(
      fluidRow(
        column(width=4, uiOutput('mapping_table_explanation'), uiOutput('mapping_table_button')),
        column(width=8, uiOutput('Mapping_Table'))
      )
    )
  )
)

server <- function(input, output, session) {
  
  data_dir <- reactiveValues(
    data=list(
      'PY Data'=data.frame('col1a'=1:10, 'col2a'=11:20, 'col3a'=21:30),
      'CY Data'=data.frame('col1b'=1:10, 'col2b'=11:20, 'col3b'=21:30)
    )
  )
    
  output$mapping_table_explanation <- renderUI({
    fluidRow(
      h3(tags$b('3. Field Mapping')),
      p(
        paste(rep('Explanation goes here.', 20), collapse=' '),
        style = 'display: inline; text-align: justify;'
      )
    )
  })
  
  output$mapping_table_button <- renderUI({actionButton('confirm_mapping', 'Confirm Mapping?', width='100%')})
  
  Mapping_Table_Results <- dtedit(
    input, output,
    name = 'Mapping_Table',
    thedata = format_default_mapping_table(MAPPING_TABLE),
    edit.cols = c('PY Field', 'CY Field'),
    show.copy = FALSE,
    input.types = list(
      'PY Field' = 'selectInput',
      'CY Field' = 'selectInput'
    ),
    input.choices = list(
      'PY Field' = names(data_dir$data[['PY Data']]),
      'CY Field' = names(data_dir$data[['CY Data']])
    )
  )
  
}


shinyApp(ui, server)


Solution

  • Changing the selectInput to selectInputMultiple seems to make it work. Try this

    library(shiny)
    library(bslib)
    library(DT)
    library(DTedit)
    
    MAPPING_TABLE <- list(
      'Standard Column 1' = list('Type'='Character'),
      'Standard Column 2' = list('Type'='Character'),
      'Standard Column 3' = list('Type'='Character')
    )
    
    format_default_mapping_table <- function(fields_list) {
      data.frame(
        'Standard Field' = names(fields_list),
        'Type' = unname(unlist(lapply(fields_list, function(field) field$Type))),
        PYField = c(""),
        CYField = c(''),
        check.names=FALSE
      )
    }
    
    
    ui <- navbarPage(
      
      title = 'Mapping Tool',
      theme = bs_theme(version=5, bootswatch='cosmo'),
      position = 'static-top',
      fluid = TRUE,
      
      tabPanel(
        'Home',
        fluidPage(
          fluidRow(
            column(width=4, uiOutput('mapping_table_explanation'), uiOutput('mapping_table_button')),
            column(width=8, uiOutput('Mapping_Table'))
          )
        )
      )
    )
    
    server <- function(input, output, session) {
      
      data_dir <- reactiveValues(
        data=list(
          PYData=data.frame('col1a'=1:10, 'col2a'=11:20, 'col3a'=21:30),
          CYData=data.frame('col1b'=1:10, 'col2b'=11:20, 'col3b'=21:30)
        )
      )
      
      output$mapping_table_explanation <- renderUI({
        fluidRow(
          h3(tags$b('3. Field Mapping')),
          p(
            paste(rep('Explanation goes here.', 20), collapse=' '),
            style = 'display: inline; text-align: justify;'
          )
        )
      })
      
      output$mapping_table_button <- renderUI({actionButton('confirm_mapping', 'Confirm Mapping?', width='100%')})
      
      Mapping_Table_Results <- dtedit(
        input, output,
        name = 'Mapping_Table',
        thedata = format_default_mapping_table(MAPPING_TABLE),
        edit.cols = c('PYField', 'CYField'),
        edit.label.cols = c('PY Field', 'CY Field'),
        show.copy = FALSE,
        input.types = list(
          PYField = 'selectInputMultiple',
          CYField = 'selectInputMultiple'
        ),
        input.choices = list(
          PYField = names(data_dir$data[['PYData']]),
          CYField = names(data_dir$data[['CYData']])
        )
      )
      
    }
    
    shinyApp(ui, server)