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

Posted 2023-03-24

【中文标题】选择一个 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

【发布时间】：2022-01-08 01:13:19

【问题描述】：

我在下面有闪亮的应用程序，当我单击一行时，我希望能够选择它，然后在按下 @987654321 后通过左侧边栏中的相关小部件更改该行的选定列的值@。例如，如果我单击第二行，然后将 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(
  "$10,000",
  "$8,000", "$10,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"
    )
  
)

【参考方案1】：

首先，我们可以将呈现的表格连同被选中的行一起保存在 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(
  "$10,000",
  "$8,000", "$10,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)

【讨论】：

我喜欢我们的回答并接受了它，但我想在同一个数据集中结合更多功能***.com/questions/70186250/…

你能看看这个闪亮的问题吗？ ***.com/questions/71023022/…