Как добавить раскрывающееся меню к одной строке таблицы, отображаемой с помощью rhandsontable, в то время как другие строки содержат числовые значения?

Ниже приведено решение с использованием Javascript, которое должно это сделать:

• Мы используем событие afterInit , где вызывается updateSettings. Это определяет настройки раскрывающегося списка в последней строке.

  instance.updateSettings({
      cells: function(row, col, prop) {
          var cellProperties;
          if (row === 2) {
              cellProperties = {
                  type: 'dropdown',
                  allowInvalid: false,
                  source: select_option,
              };
              return cellProperties;
          }
      }
  });
  

  Обратите внимание, что select_option — это вектор, определенный в R, который я передал ниже объекту rhandsontable, чтобы я мог использовать его в JS, обратившись к instance.params. Однако я обернул код в небольшой setTimeout, потому что кажется, что непосредственно при вызове afterInitparams недоступен. Единственная причина его использования заключается в том, что вы можете определить параметры в R. Если у вас нет проблем с их определением непосредственно в JS, вы можете опустить их ниже. Я также пробовал другие мероприятия, но у меня возникло несколько проблем, которые могут возникнуть из-за shiny окружающей среды.

• rhandsontable не поддерживается уже несколько лет и, в частности, зависит от handsontable 6.2.2. В более старой версии (см. handontable/handsontable#7689 ) была ошибка, из-за которой заголовки столбцов отображались неправильно после использования updateSettings. По крайней мере, это похоже на проблему, которая была и у меня, поэтому я использовал то, что было зафиксировано, чтобы решить эту проблему в afterRenderer событии:

  function(TD, row, column, prop, value, cellProperties) {
      this.view.wt.wtOverlays.adjustElementsSize();
  }
  

Это будет выглядеть так:

library(rhandsontable)
library(shiny)

ui <- 
  fluidPage(
    rHandsontableOutput('hottable_1'),
    actionButton("addSeries","Add series")
  ) 

server <- function(input,output,session)({
  seriesTbl_1 <- reactiveVal(
    data.frame(
      'Series 1' = c(1,24,NA),
      row.names = c("Row_A_numeric","Row_B_numeric","Row_C_dropdown")
    )
  ) 
  
  observeEvent(input$hottable_1, {seriesTbl_1(hot_to_r(input$hottable_1))})
  
  output$hottable_1 <- renderRHandsontable({
    tbl <- seriesTbl_1()
    rhandsontable(
      tbl,
      rowHeaderWidth = 200, 
      useTypes = TRUE,
      selectCallback = TRUE,
      overflow = "visible",
      select_option = c(NA_character_, "Item A", "Item B"),
      afterInit = htmlwidgets::JS(" 
            function() {
              let instance = this;
              setTimeout(function (){
                select_option = instance.params.select_option
                select_option = select_option instanceof Array ? select_option : [select_option]
          
                instance.updateSettings({
                  cells: function(row, col, prop) {
                           var cellProperties;
                           if (row === 2) {
                             cellProperties = {
                               type: 'dropdown',
                               allowInvalid: false,
                               source: select_option,
                             };
                             return cellProperties;
                           }
                         }       
                });
             }, 50); 
           }"),
      afterRenderer =  htmlwidgets::JS(
        "function (TD, row, column, prop, value, cellProperties) {
            this.view.wt.wtOverlays.adjustElementsSize();
         }
        ")
    ) %>%
      hot_table(id = "hottable_1") 
  })
  
  observeEvent(input$addSeries, {
    newSeriesCol_1 <- data.frame(c(1,24,NA)) 
    names(newSeriesCol_1) <- paste("Series", ncol(hot_to_r(input$hottable_1)) + 1)
    seriesTbl_1(cbind(seriesTbl_1(), newSeriesCol_1))
  })
  
  seriesTbl_1_DF <- reactive({seriesTbl_1()})
})

shinyApp(ui, server)

Судя по комментарию исмиршерегала, приведенное ниже сообщение работает. Изменения в коде OP заключаются в замене NA в настройке фрейма данных на NA_character_ и добавлении htmlwidgets::onRender(...) к output$hottable:

library(rhandsontable)
library(shiny)

ui <- fluidPage(
  rHandsontableOutput('hottable_1'),
  actionButton("addSeries", "Add series")
)

server <- function(input, output, session) {
  seriesTbl_1 <- reactiveVal(
    data.frame(
      'Series 1' = c(1, 24, NA_character_),
      row.names = c("Row_A_numeric", "Row_B_numeric", "Row_C_dropdown"),
      stringsAsFactors = FALSE
    )
  )
  
  observeEvent(input$hottable_1, {seriesTbl_1(hot_to_r(input$hottable_1))})
  
  output$hottable_1 <- renderRHandsontable({
    tbl <- seriesTbl_1()
    rhandsontable(
      tbl, 
      rowHeaderWidth = 200, 
      useTypes = TRUE, 
      selectCallback = TRUE, 
      overflow = "visible"
      ) %>%
      hot_table(id = "hottable_1") %>%
      htmlwidgets::onRender("
        function(el, x) {
          var hot = this.hot;
          hot.updateSettings({
            cells: function (row, col, prop) {
              var cellProperties = {};
              if (row === 2) {  // Third row
                cellProperties.type = 'dropdown';
                cellProperties.source = ['Item A', 'Item B'];
              } else {  // First two rows
                cellProperties.type = 'numeric';
              }
              return cellProperties;
            }
          });
        }
      ")
  })
  
  observeEvent(input$addSeries, {
    newSeriesCol_1 <- data.frame(
      c(1, 24, NA_character_), 
      stringsAsFactors = FALSE
      ) 
    names(newSeriesCol_1) <- paste("Series", ncol(hot_to_r(input$hottable_1)) + 1)
    seriesTbl_1(cbind(seriesTbl_1(), newSeriesCol_1))
  })
}

shinyApp(ui, server)