r闪亮：基于其他用户更新的列，{rhsonsontable}列会自动更新

问题描述

用户首先选择一个值。在此基础上，出现一个rhsonsontable，其中包含多个空列以及下拉选项-最后一个列Type_action除外。该列（只读）应基于Y和Z列中的值自动更新，如下所示：如果Y列中的值小于Z列中的值，则Type_action应采用值“ Upgrade”，否则应采用值“ Downgrade”

以下是我的尝试，该尝试无法为Type_action列生成任何值：

library(shiny)
library(rhandsontable)
library(dplyr)
library(shinydashboard)

ui <-  fluidPage( fluidRow(column(6,uIoUtput("selA"))),fluidRow(column(6,rHandsontableOutput('tbl1'))
           ) 
      ) 


server <- function(input,output,session){

  dt0 <- data.frame( A = c("S2","S2","S4","S4"),B = c("1","2","3","1","3"),C = c(10,20,30,40,15,25),D  = c("A","B","C","D","E","F"))

# get the data for the selected BA
dt <- reactive(subset(dt0,A %in% input$selA))

# Render selectInput selBA
output$selA <- renderUI({
   ba <- as.vector( unique(dt0$A) )
   selectInput("selA","Choose BA",choices = ba)    
})

DF <- data.frame("X" = c(""),"Y" = c(""),"Z" = c(""),"Type_action" = c(""))

 values <- reactiveValues(data = DF)
 Y      <- reactiveVal()
 Z      <- reactiveVal()

observe({
 if(!is.null(input$tbl1)){
   values$data <- as.data.frame(hot_to_r(req(input$tbl1)))
    }
})

observeEvent(input$tbl1,{
       Y(hot_to_r(input$tbl1)$Y)},ignoreInit= TRUE
)

observeEvent(input$tbl1,{
   Z(hot_to_r(input$tbl1)$Z)},ignoreInit= TRUE
)

output$tbl1 = renderRHandsontable({
  req(input$selA)

  tmpTable <- rhandsontable(values$data,rowHeaders = FALSE,selectCallback = TRUE,width = 
                            1000,height = 500) %>% 
              hot_table(highlightCol = TRUE,highlightRow = TRUE,stretchH = "all") %>% 
              hot_col(col = "X",type = "dropdown",colWidths = 90,source = 
                       sort(unique(dt()$B))) %>% 
              hot_col(col = "Y",colWidths = 65,source = 
                      sort(unique(dt()$D))) %>% 
              hot_col(col = "Z",colWidths = 60,source = 
                      sort(unique(dt()$D))) %>% 
              hot_col(col = "Type_action",colWidths = 50,readOnly = TRUE,type = "text")  


 if(!is.null(input$tbl1_select$select$r) && !is.na(values$data$Y[input$tbl1_select$select$r]) 
  && !is.na(values$data$Z[input$tbl1_select$select$r])){
   tmpTable <- hot_col(tmpTable,col = "Type_action",type = "text",source = ifelse(as.numeric(factor(Y())) < as.numeric(factor(Z())),"u","d"))  
                       
  }
 tmpTable
 })
}

shinyApp(ui,server)

解决方法

source的{{1}}自变量

选择，下拉列表和自动填充列类型的选择向量

未实现修改文本单元格的内容（如您在上面的代码中所尝试的那样）。

我们可以通过更改基础（反应性）data.frame来修改文本列。

请检查以下内容：

hot_col

rhandsontable shiny