根据数据表行选择更新小部件值

Posted

技术标签:

【中文标题】根据数据表行选择更新小部件值【英文标题】:Update widget values based on datatable row selection 【发布时间】:2022-01-10 01:02:45 【问题描述】:

我有下面的闪亮应用程序,我可以在其中添加带有小部件值的行或选择一行并将其删除。此外,如果我单击一行并更改小部件值并按Edit,则相对单元格值正在更改。

我要添加的是当我单击一行时,所有小部件值都将替换为相对选定的行值。

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(
  10000,
  8000, 10000
)), 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,
      textInput(
        "sectype", "Security Type",
        "Stock")
      ,
      textInput(
        "sectick", "Ticker",
        "XOM")
      ,
      dateInput("PurDate", "Purchase Date", value = as.Date("2013-12-31")),
      dateInput("selDate", "Sale Date", value = as.Date("2019-01-31")),
      numericInput(
        "aminv", "Amount Invested",
        10000)
      ,
      actionButton("add", "Add"),
      actionButton("edit", "Edit"),
      
      actionButton("deleteRows", "Delete Rows")
      
    ),
    body = dashboardBody(
      h3("Results"),
      tabsetPanel(
        id = "tabs",
        tabPanel(
          "InsiderTraining",
          dataTableOutput("TBL1")
        )
      )
    ),
    controlbar = dashboardControlbar(width = 300),
    title = "DashboardPage"
  )), ###### SERVER
  server = function(input, output) 
    # Init with some example data
    #data <- reactiveVal(Input)
    rv <- reactiveValues(df = Input, row_selected = NULL) 
    
    observeEvent(
      input$add,
      
        # start with current data
        rv$df <- rv$df %>%
          add_row(
            `Security Type` = isolate(input$sectype),
            Ticker = isolate(input$sectick),
            `Purchase Date` = isolate(input$PurDate),
            `Sale Date` = isolate(input$selDate),
            `Amount Invested` = isolate(input$aminv)
          )#  %>%
        # update data value
        #data()
        
        
      
    )
    observeEvent(input$deleteRows,
      
      if (!is.null(input$TBL1_rows_selected)) 
        #data(data()[-as.numeric(input$TBL1_rows_selected),])
        rv$df <- rv$df[-as.numeric(input$TBL1_rows_selected), ]
      
    )
    
    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 <- renderDataTable(
      rv$df,selection="single"
    )
  
)

【问题讨论】:

用户界面抛出此错误:Error in dashboardPage(options = list(sidebarExpandOnHover = TRUE), header = dashboardHeader(title = "Investment Advisor Monitoring - Insider Trading", : unused arguments (options = list(sidebarExpandOnHover = TRUE), controlbar = dashboardControlbar(width = 300)) 现在请朋友试试 【参考方案1】:

我们可以添加一个观察者,每次选择一行时(在这种情况下一次只选择一个),然后小部件将更新为该行中包含的值。

由于所有小部件只显示一个值,我们可以使用 exec 并像这样循环遍历所有小部件:

请注意缺失值(如第二行中的值)将导致小部件为空。

##### UPDATE WIDGETS WITH SELECTED ROW ######
widgts_nms <- c('sectype', 'sectick', 'PurDate', 'selDate', 'aminv')
update_funs <- c('updateTextInput', 'updateTextInput', 'updateDateInput', 'updateDateInput', 'updateNumericInput')
#This will happen automatically on row click.
observe(
  req(input$TBL1_rows_selected)
  
  vals <- rv$df[input$TBL1_rows_selected, ]
  
  pwalk(list(update_funs, widgts_nms, vals), ~ exec(..1, !!!list(inputId = ..2, value = ..3[1]),.env = ))
  
)

应用代码:

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(DT)
library(tidyverse)
library(fontawesome)
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(
  10000,
  8000, 10000
)), 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,
      textInput(
        "sectype", "Security Type",
        "Stock")
      ,
      textInput(
        "sectick", "Ticker",
        "XOM")
      ,
      dateInput("PurDate", "Purchase Date", value = as.Date("2013-12-31")),
      dateInput("selDate", "Sale Date", value = as.Date("2019-01-31")),
      numericInput(
        "aminv", "Amount Invested",
        10000)
      ,
      actionButton("add", "Add"),
      actionButton("edit", "Edit"),
      
      actionButton("deleteRows", "Delete Rows")
      
    ),
    body = dashboardBody(
      h3("Results"),
      tabsetPanel(
        id = "tabs",
        tabPanel(
          "InsiderTraining",
          dataTableOutput("TBL1")
        )
      )
    ),
    controlbar = dashboardControlbar(width = 300),
    title = "DashboardPage"
  )), ###### SERVER
  server = function(input, output, session) 

    rv <- reactiveValues(df = Input, row_selected = NULL) 
    
    observeEvent(
      input$add,
      
        
        rv$df <- rv$df %>%
          add_row(
            `Security Type` = isolate(input$sectype),
            Ticker = isolate(input$sectick),
            `Purchase Date` = isolate(input$PurDate),
            `Sale Date` = isolate(input$selDate),
            `Amount Invested` = isolate(input$aminv)
          )
       
        
        
        
      
    )
    observeEvent(input$deleteRows,
      
      if (!is.null(input$TBL1_rows_selected)) 
        rv$df <- rv$df[-as.numeric(input$TBL1_rows_selected), ]
      
    )
    
    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]]) 
        
      
    )
      
      
      ##### UPDATE WIDGETS WITH SELECTED ROW ######
      widgts_nms <- c('sectype', 'sectick', 'PurDate', 'selDate', 'aminv')
      update_funs <- c('updateTextInput', 'updateTextInput', 'updateDateInput', 'updateDateInput', 'updateNumericInput')
      #This will happen automatically on row click.
      observe(
        req(input$TBL1_rows_selected)
        
        vals <- rv$df[input$TBL1_rows_selected, ]
        
        pwalk(list(update_funs, widgts_nms, vals), ~ exec(..1, !!!list(inputId = ..2, value = ..3[1]),.env = ))
        
      )
      
      
      
    
    output$TBL1 <- renderDataTable(
      rv$df,selection = "single"
    )
  
  
)

【讨论】:

以上是关于根据数据表行选择更新小部件值的主要内容,如果未能解决你的问题,请参考以下文章

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

Excel VBA - 选择多个值以搜索案例

无法在 PyQGIS 中的表小部件中选择行

使用 API 数据更新小部件的 TextView

setState() 清除表单元素数据flutter中的数据

更新中带有小部件的 Django Form DateInput:丢失初始值