How to create an editable DataTable in Shiny with tooltips and always-visible input fields?

Question

I would like to display a data table in an R Shiny dashboard using DT, where the user can enter measurement values in the "Value" column. All other columns should not be editable. The process of entering a value in the "Value" column should work without needing to double-click on the cell. Is it possible to have the input field permanently displayed by default in all cells of the "Value" column?

library(shiny)
library(shinydashboard)
library(DT)

data <- data.frame(
  Param = c("FVC", "FEV1", "FEV1/FVC ratio"),
  Tooltip = c("forced vital capacity", "forced expiratory volume exhaled in the first second", "tiffeneau index"),
  Unit = c("l", "l", "%"),
  Value = c(NA, NA, NA)
)

data

# UI
ui <- dashboardPage(
  dashboardHeader(title = "Test"),
  dashboardSidebar(disable = TRUE),
  dashboardBody(
    DTOutput("table")
  )
)

# Server
server <- function(input, output, session) {
  output$table <- renderDT({
    datatable(
      data,
      options = list(
        dom = 't',
        paging = FALSE,
        ordering = FALSE
      ),
      selection = 'none',
      rownames = FALSE,
      editable = list(target = 'cell', disable = list(columns = c(0, 1, 2)))
    )
  }, server = FALSE)
}

# Shiny-App starten
shinyApp(ui = ui, server = server)

Answer 1

Below is a modified version of your example where the functionality is working that if you populate the inputs via the "Select dummy data" option, these values get recognized by shiny. The reason why this is not working in your example is that you created the inputs using oninput="Shiny.setInputValue(...)", but this never gets triggered when the user does not type something into the input. So shiny does not know the values in such a case.

Below I added a session$sendCustomMessage which sends the list of values to JS after populating the inputs and there triggers a Shiny.setInputValue on each of them. Then shiny knows them and also if the user changes some of the values, your previously defined Shiny.setInputValue lets shiny know the updated values.

library(shiny)
library(shinydashboard)
library(DT)

# Data frame skeleton without data
data <- data.frame(
  Param = c("FVC", "FEV1", "FEV1/FVC ratio"),
  Tooltip = c("forced vital capacity", "forced expiratory volume exhaled in the first second", "tiffeneau index"),
  Unit = c("l", "l", "%"),
  stringsAsFactors = FALSE
)

# UI
ui <- dashboardPage(
  dashboardHeader(title = "Test"),
  dashboardSidebar(disable = TRUE),
  dashboardBody(
    tags$head(tags$script('Shiny.addCustomMessageHandler("setCreatedInputs",
      function(message) {
        for (const [key, value] of Object.entries(message)) {
          Shiny.setInputValue(key, value);
        }
      })')),
    tabBox(
      id = "tabs",
      width = 12,
      tabPanel(
        "Input",
        selectInput("inputType", "Select Dummy Data:", choices = c("Empty", "Obstruction", "Restriction")),
        DTOutput("table")
      ),
      tabPanel("Output", verbatimTextOutput("outputText"))
    ),
    actionButton("createButton", "Create")
  )
)

# Server
server <- function(input, output, session) {
  
  # Function to fill the data table with dummy data."
  updateTable <- function(inputType) {
    values <- switch(inputType,
                     "Empty" = list("", "", ""),
                     "Obstruction" = list("2.5", "1.8", "72.0"),
                     "Restriction" = list("3.2", "2.9", "90.6"))
    
    data$Value <- paste0('<input type="text" style="width: 100%" id="val_', 1:3, 
                         '" value="', values, 
                         '" oninput="Shiny.setInputValue(\'val_', 1:3, '\', this.value)">')
    
    names(values) <- paste0("val_", 1:length(values))

    session$sendCustomMessage("setCreatedInputs", message = values)
    
    output$table <- renderDT({
      datatable(
        data,
        options = list(
          dom = 't',
          paging = FALSE,
          ordering = FALSE
        ),
        selection = 'none',
        rownames = FALSE,
        escape = FALSE,  # Set escape to FALSE to allow HTML input fields
        editable = list(target = 'cell', disable = list(columns = c(0, 1, 2)))
      )
    }, server = FALSE)
  }
  
  # Create Initial Data Table with Empty Text Fields
  observe({
    updateTable("Empty")
  })
  
  # Update the Data Table when the dropdown value is changed
  observeEvent(input$inputType, {
    updateTable(input$inputType)
  })
  
  # Update the output panel when the create button is clicked
  observeEvent(input$createButton, {
    # Extract and format values
    values <- sapply(1:nrow(data), function(i) {
      as.numeric(input[[paste0("val_", i)]])
    })
    
    # Check the type and structure of the values
    if (is.list(values) || any(is.na(values))) {
      # Display an error message if values is a list or contains NA values
      showModal(modalDialog(
        title = "Error",
        "The data input is incorrect. Please check the inputs and try again.",
        easyClose = TRUE,
        footer = NULL
      ))
    } else {
      # Format values to two decimal places
      formattedValues <- formatC(values, format = "f", digits = 2)
      
      # Combine parameters and formatted values
      outputText <- paste(data$Param, ":", formattedValues, data$Unit, collapse = ", ")
      
      output$outputText <- renderText({
        outputText
      })
      
      # Switch to the Output tab
      updateTabItems(session, "tabs", "Output")
    }
  })
}

# Shiny-App starten
shinyApp(ui = ui, server = server)