Select a DT row and then change the value of one cell of this row based on widget selection input an-CodePudding

I have the shiny app below and I when I click on a row I want to be able to select it and then change the value of a selected column of this row by the relative widget in the left sidebhar after pressing the actionButton() Edit. For example if I click on the 2nd row and then change the Security Type widget from Stock to Load Fund the Security Type column of the 2nd row should become 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"
    )
  }
)

CodePudding user response：

First, we can save the rendered table inside a reactiveValues object along with the row that was selected:

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

Second, every time the edit button get's pressed, the row selected is saved and de data updated using walk2 to loop through all the columns.

  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]]}) 
      
    }
  
    })

App:

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)