firmo23
Reputation: 8404
Update widget values based on datatable row selection
I have the shiny app below in which I can add a row with the values of the widgets or select a row and delete it. Also if I click on a row and the change a widget value and press Edit the relative cell value is changing.
What I want to add is when I click on a row all the widget values to be replaced by the relative selected row values.
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"
)
}
)
Upvotes: 1
Views: 285
Answers (1)
jpdugo17
Reputation: 7106
We can add an observer that every time a row is selected (in this case only one at a time) then the Widgets will update to the values contained in that row.
Since all widgets display only one value we can use exec and loop through all of them like this:
Beware that missing values (like in the second row) will produce the widget to be empty.
##### 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 = ))
})
app code:
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"
)
}
)
Upvotes: 2
Related Questions
- How to update datatable after selecting data source from radio button?
- Keep the values of widgets and adding a new row in DTtable?
- Create a dynamic table on shiny app based on shiny widget and row selection of another datatable
- 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
- Updating DataTable using DropDown Within DataTable
- Choose a datatable row either by clicking, actionButton() or shiny widget
- Select specific row of a datatable with a shiny widget
- Update shiny input based on datatable settings
- Replace value into a datatable based on if condition of a shiny widget
- Select a datatable value and update it via a shiny widget