Select 一个 DT 行，然后在闪亮的应用程序中根据小部件选择输入和 actionButton() 更改该行的一个单元格的值

Question

我在下面有闪亮的应用程序，当我点击一行时，我希望能够 select 它，然后通过按下 actionButton() Edit 后左侧边栏中的相关小部件。例如，如果我单击第二行，然后将 Security Type 小部件从 Stock 更改为 Load Fund，则第二行的 Security Type 列应变为 Load Fund。

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(DT)
library(tibble)
Input <- structure(list(`Security Type` = c("Stock", "Stock", "Load Fund"), Ticker = c("XOM", "NFLX", "AMCPX"), `Purchase Date` = structure(c(
  16070,
  17084, 17084
), class = "Date"), `Sale Date` = structure(c(
  18627,
  NA, 18545
), class = "Date"), `Amount Invested` = c(
  ",000",
  ",000", ",000"
)), class = c(
  "spec_tbl_df", "tbl_df", "tbl",
  "data.frame"
), row.names = c(NA, -3L))
shinyApp(
  ui = tags$body(class = "skin-blue sidebar-mini control-sidebar-open", dashboardPage(
    options = list(sidebarExpandOnHover = TRUE),
    header = dashboardHeader(title = "Investment Advisor Monitoring - Insider Trading", titleWidth = 450),
    sidebar = dashboardSidebar(
      minified = F, collapsed = F,
      selectInput(
        "sectype", "Security Type",
        c(unique(Input$`Security Type`))
      ),
      selectInput(
        "sectick", "Ticker",
        c(unique(Input$Ticker))
      ),
      dateInput("PurDate", "Purchase Date", value = as.Date("2013-12-31")),
      dateInput("selDate", "Sale Date", value = as.Date("2019-01-31")),
      selectInput(
        "aminv", "Amount Invested",
        c(unique(Input$`Amount Invested`))
      ),
      actionButton("edit", "Edit")
      
      
    ),
    body = dashboardBody(
      h3("Results"),
      tabsetPanel(
        id = "tabs",
        tabPanel(
          "InsiderTraining",
          dataTableOutput("TBL1")
        )
      )
    ),
    controlbar = dashboardControlbar(width = 300),
    title = "DashboardPage"
  )),
  server = function(input, output) {
    # Init with some example data
    data <- reactiveVal(Input)
    
    
   
    observeEvent(input$edit,{
      
      if (!is.null(input$TBL1_rows_selected)) {

      }
    })
    output$TBL1 <- renderDataTable(
      data(),selection="single"
    )
  }
)

Answer 1

首先，我们可以将呈现的 table 与选定的行一起保存在 reactiveValues 对象中：

rv <- reactiveValues(df = Input, row_selected = NULL)

其次，每次按下 edit 按钮时，都会保存所选行并使用 walk2 循环遍历所有列来更新数据。

  observeEvent(input$edit,{
    
    if (!is.null(input$TBL1_rows_selected)) {
      cols_to_edit <- c('sectype', 'sectick', 'PurDate', 'selDate', 'aminv')
      colnms <- c('Security Type', 'Ticker', 'Purchase Date', 'Sale Date', 'Amount Invested')
      "remember the row selected"
      rv$row_selected <- input$TBL1_rows_selected
      
      walk2(cols_to_edit, colnms, ~{rv$df[input$TBL1_rows_selected, ..2] <<- input[[..1]]}) 
      
    }
  
    })

应用程序：

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(DT)
library(tidyverse)

Input <- structure(list(`Security Type` = c("Stock", "Stock", "Load Fund"), Ticker = c("XOM", "NFLX", "AMCPX"), `Purchase Date` = structure(c(
  16070,
  17084, 17084
), class = "Date"), `Sale Date` = structure(c(
  18627,
  NA, 18545
), class = "Date"), `Amount Invested` = c(
  ",000",
  ",000", ",000"
)), class = c(
  "spec_tbl_df", "tbl_df", "tbl",
  "data.frame"
), row.names = c(NA, -3L))

ui = tags$body(class = "skin-blue sidebar-mini control-sidebar-open", dashboardPage(
  options = list(sidebarExpandOnHover = TRUE),
  header = dashboardHeader(title = "Investment Advisor Monitoring - Insider Trading", titleWidth = 450),
  sidebar = dashboardSidebar(
    minified = F, collapsed = F,
    selectInput(
      "sectype", "Security Type",
      c(unique(Input$`Security Type`))
    ),
    selectInput(
      "sectick", "Ticker",
      c(unique(Input$Ticker))
    ),
    dateInput("PurDate", "Purchase Date", value = as.Date("2013-12-31")),
    dateInput("selDate", "Sale Date", value = as.Date("2019-01-31")),
    selectInput(
      "aminv", "Amount Invested",
      c(unique(Input$`Amount Invested`))
    ),
    actionButton("edit", "Edit")
    
    
  ),
  body = dashboardBody(
    h3("Results"),
    tabsetPanel(
      id = "tabs",
      tabPanel(
        "InsiderTraining",
        dataTableOutput("TBL1")
      )
    )
  ),
  controlbar = dashboardControlbar(width = 300),
  title = "DashboardPage"
))


server = function(input, output) {
  # I want to remember the row that was selected 
  rv <- reactiveValues(df = Input, row_selected = NULL)
  
  
  
  observeEvent(input$edit,{
    
    if (!is.null(input$TBL1_rows_selected)) {
      cols_to_edit <- c('sectype', 'sectick', 'PurDate', 'selDate', 'aminv')
      colnms <- c('Security Type', 'Ticker', 'Purchase Date', 'Sale Date', 'Amount Invested')
      "remember the row selected"
      rv$row_selected <- input$TBL1_rows_selected
      
      walk2(cols_to_edit, colnms, ~{rv$df[input$TBL1_rows_selected, ..2] <<- input[[..1]]}) 
      
    }
  
    })
  
  
  output$TBL1 <- DT::renderDataTable({
    DT::datatable(rv$df, selection = list(target = "row",  selected = rv$row_selected))
  })
  
}


shinyApp(ui,server)

Select 一个 DT 行，然后在闪亮的应用程序中根据小部件选择输入和 actionButton() 更改该行的一个单元格的值

Select a DT row and then change the value of one cell of this row based on widget selection input and actionButton() in a shiny app

r

shiny

dt