Блог

У меня есть блестящее приложение ниже, в котором я могу добавить строку со значениями виджетов или выбрать строку и удалить ее. Также, если я нажму на строку и изменю значение виджета и нажму Edit , значение относительной ячейки изменится.

Что я хочу добавить, так это когда я нажимаю на строку, все значения виджета должны быть заменены относительными выбранными значениями строк.

 library(shiny) library(shinydashboard) library(shinydashboardPlus) library(DT) library(tidyverse)  Input lt;- 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 lt;- reactiveVal(Input)  rv lt;- reactiveValues(df = Input, row_selected = NULL)     observeEvent(  input$add,  {  # start with current data  rv$df lt;- rv$df %gt;%  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)  )# %gt;%  # update data value  #data()      }  )  observeEvent(input$deleteRows,{    if (!is.null(input$TBL1_rows_selected)) {  #data(data()[-as.numeric(input$TBL1_rows_selected),])  rv$df lt;- rv$df[-as.numeric(input$TBL1_rows_selected), ]  }  })    observeEvent(input$edit,{    if (!is.null(input$TBL1_rows_selected)) {  cols_to_edit lt;- c('sectype', 'sectick', 'PurDate', 'selDate', 'aminv')  colnms lt;- c('Security Type', 'Ticker', 'Purchase Date', 'Sale Date', 'Amount Invested')  "remember the row selected"  rv$row_selected lt;- input$TBL1_rows_selected    walk2(cols_to_edit, colnms, ~{rv$df[input$TBL1_rows_selected, ..2] lt;lt;- input[[..1]]})     }    })  output$TBL1 lt;- renderDataTable(  rv$df,selection="single"  )  } )  

Мы можем добавить наблюдателя, который каждый раз, когда выбирается строка (в данном случае только по одной за раз), виджеты будут обновляться до значений, содержащихся в этой строке.

Поскольку все виджеты отображают только одно значение, мы можем использовать exec и перебирать их все следующим образом:

Имейте в виду, что пропущенные значения (например, во второй строке) приведут к тому, что виджет будет пустым.

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