如何根據該表中的觸發器將反應值插入到使用rhandsontable呈現的表中？

在運行本文底部提供的代碼時，使用 rhandsontable 包在視窗的右下角呈現了一個表（“熱表”），該表的第 2 行反映了用戶從立即呈現的input$choices物件輸入的內容selectInput()它上面。相反，我想改變這一點，從而將資料框“table1”中的“END”值反映在左側的基本 Shiny 表中，并反映在標記為“Floating reactive”的 rhandsontable“hottable”的第二行中，如如下圖所示，其中從該資料框中選擇“END”的行是由標記為“Term A”的 rhandsontable 第 1 行中的值觸發的。請問，關于如何做到這一點有什么建議嗎？

代碼：

library(rhandsontable)
library(shiny)
library(shinyjs)

mydata <- data.frame('Series 1' = c(1,1,0,1), check.names = FALSE)
rownames(mydata) <- c('Term A','Floating reactive','Term C','Term D') 

ui <- fluidPage(br(),
  column(6,
    sliderInput("periods","Nbr of months",min=1,max=20,value=10,step=1),
    sliderInput("beginAmt","Begin amount",min=100,max=500,value=250,step=50),
    sliderInput("npr","NPR",min=0.1,max=1,value=.3,step=0.1)
    ),
  column(6,
    sliderInput("mpr","MPR",min=0.1,max=1,value=.3,step=0.1),
    sliderInput("dft","DFT",min=0.1,max=1,value=.3,step=0.1),
    uiOutput("choices"),br(),
    ),
  br(),
  column(6,tableOutput("table1")),
  column(6,
         rHandsontableOutput('hottable'),
         fluidRow(column(1,br(),actionButton("addSeries", "Add",width = '70px')))
  )
)

server <- server <- function(input, output, session) {
  npr_vector <- reactive(rep(input$npr,input$periods))
  mpr_vector <- reactive(rep(input$mpr,input$periods))
  dft_vector <- reactive(rep(input$dft,input$periods))
  table2 <- reactiveVal(mydata)
  
  runOff <- reactive({
    f      <- function(x,y){x*(1 npr_vector()[y]-mpr_vector()[y]-dft_vector()[y]/12)}
    res    <- Reduce(f,seq(input$periods),init=input$beginAmt,accumulate=TRUE)
    b      <- head(res,-1)
    result <- data.frame(MO = seq(input$periods), 
                         NP = b*npr_vector(),  
                         MP = b*mpr_vector(), 
                         DFT = b*dft_vector()/12,   
                         END = res[-1]
                         )
  })
  
  output$table1 <- renderTable(runOff())
  
  observeEvent(input$hottable, {table2(hot_to_r(input$hottable))})
  
  output$hottable <- renderRHandsontable({rhandsontable(table2(),rowHeaderWidth=100,useTypes=TRUE)})
  
  observe({
    req(input$choices)
    tmpTable <- table2()
    tmpTable[2,] <- as.numeric(input$choices)
    table2(tmpTable)
  })
  
  output$choices <- 
    renderUI({
      selectInput(
        "choices", 
        label = "User selects value to reflect in row 2 of table below:",
        choices = c(1,2,3)
      )
    })
  
  observeEvent(input$addSeries, {
    newCol <- data.frame(c(1,1,0,1)) 
    newCol[2,] <- as.numeric(input$choices) 
    names(newCol) <- paste("Series", ncol(hot_to_r(input$hottable))   1)
    table2(cbind(table2(), newCol))
  })
}

shinyApp(ui, server)

uj5u.com熱心網友回復：

請檢查修改后的observe呼叫：

library(rhandsontable)
library(shiny)
library(shinyjs)

mydata <- data.frame('Series 1' = c(1,1,0,1), check.names = FALSE)
rownames(mydata) <- c('Term A','Floating reactive','Term C','Term D') 

ui <- fluidPage(br(),
                column(6,
                       sliderInput("periods","Nbr of months",min=1,max=20,value=10,step=1),
                       sliderInput("beginAmt","Begin amount",min=100,max=500,value=250,step=50)
                ),
                column(6,
                       sliderInput("mpr","MPR",min=0.1,max=1,value=.3,step=0.1),
                       sliderInput("dft","DFT",min=0.1,max=1,value=.3,step=0.1)
                ),
                column(12, sliderInput("npr","NPR",min=0.1,max=1,value=.3,step=0.1)),
                br(),
                column(6,tableOutput("table1")),
                column(6,
                       rHandsontableOutput('hottable'),
                       fluidRow(column(1,br(),actionButton("addSeries", "Add",width = '70px')))
                )
)

server <- server <- function(input, output, session) {
  npr_vector <- reactive(rep(input$npr,input$periods))
  mpr_vector <- reactive(rep(input$mpr,input$periods))
  dft_vector <- reactive(rep(input$dft,input$periods))
  table2 <- reactiveVal(mydata)
  
  runOff <- reactive({
    f      <- function(x,y){x*(1 npr_vector()[y]-mpr_vector()[y]-dft_vector()[y]/12)}
    res    <- Reduce(f,seq(input$periods),init=input$beginAmt,accumulate=TRUE)
    b      <- head(res,-1)
    result <- data.frame(MO = seq(input$periods), 
                         NP = b*npr_vector(),  
                         MP = b*mpr_vector(), 
                         DFT = b*dft_vector()/12,   
                         END = res[-1]
    )
  })
  
  output$table1 <- renderTable(runOff())
  
  observeEvent(input$hottable, {table2(hot_to_r(input$hottable))})
  
  output$hottable <- renderRHandsontable({rhandsontable(table2(),rowHeaderWidth=100,useTypes=TRUE)})
  
  observe({
    req(runOff(), table2())
    tmpTable <- table2()
    tmpTable[2,] <- runOff()$END[unlist(table2()[1,])]
    table2(tmpTable)
  })

  observeEvent(input$addSeries, {
    newCol <- data.frame(c(1,1,0,1)) 
    names(newCol) <- paste("Series", ncol(hot_to_r(input$hottable))   1)
    table2(cbind(table2(), newCol))
  })
}

shinyApp(ui, server)

標籤：r闪亮的观察员闪亮反应rhandsontable

上一篇：在R中插入相應值為零的缺失子類別行

下一篇：如何使用R將向量中包含的字符替換為另一個單個字符