R Shiny DT - edit values in table with reactive
I am not sure if I understand you correctly, but maybe this solution might help you a bit. I changed your reactive into a reactiveValues object and I removed the replaceData line.
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
DTOutput('x1'),
verbatimTextOutput("print")
),
server = function(input, output, session) {
x = reactiveValues(df = NULL)
observe({
df <- iris
df$Date = Sys.time() + seq_len(nrow(df))
x$df <- df
})
output$x1 = renderDT(x$df, selection = 'none', editable = TRUE)
proxy = dataTableProxy('x1')
observeEvent(input$x1_cell_edit, {
info = input$x1_cell_edit
str(info)
i = info$row
j = info$col
v = info$value
# problem starts here
x$df[i, j] <- isolate(DT::coerceValue(v, x$df[i, j]))
})
output$print <- renderPrint({
x$df
})
}
)
Shiny: Reactive Value to DT:datatable
Here's how I solved it! Note: There are several v$data.. which I would like to use in order, depending on what my user has already done.
#Count the number of recoding terms to render
counter <- reactiveValues(n = 0)
#Recoding button functionality
observeEvent(input$add_recode, {counter$n <- counter$n + 1})
observeEvent(input$rm_recode, {
if(counter$n > 0) counter$n <- counter$n - 1
})
recoding_i <- reactive({
n <- counter$n
if(n>0){
isolate({
lapply(seq_len(n),function(i){
fluidRow(
column(width=4,
textInput(inputId=paste0('recode_name',i),
label=paste0("Variable Name",i))),
column(width=4,
textInput(inputId = paste0('recode_call',i),
label=paste0('Code',i)))
)
}
)
})
}
})
output$recoding <- renderUI({ recoding_i() })
#Observes press of recode button.
observeEvent(input$'execute_recode',{
v[["print_execute_complete"]] <- TRUE
})
#Observes press of recode button.
observeEvent(input$'reset_recode',{
v[["print_execute_complete"]] <- FALSE
})
#Loop over recoding input boxes.
observeEvent(v$print_execute_complete, {
if(v[["print_execute_complete"]] == TRUE){
n <- counter$n
if(n==0){
if(is.null(v$datafiltered)){
v$datarecoded <- myData()
} else {
v$datarecoded <- v$datafiltered
}
} else {
if(is.null(v$datafiltered)){
v$datarecoded <- myData()
} else {
v$datarecoded <- v$datafiltered
lapply(seq_len(n), function(i){
recode_call_i <- rlang::parse_expr(rlang::eval_tidy(rlang::parse_expr(eval(paste0("input$recode_call",i)))))
var_name_i <- rlang::sym(rlang::eval_tidy(rlang::parse_expr(paste0("input$recode_name",i))))
v$datarecoded <- mutate(v$datarecoded,!!var_name_i := !!recode_call_i)
}
)
}
}
}
}
)
#Confirmation text
output$execute_complete <- renderText({
req(v[["print_execute_complete"]])
if(v[["print_execute_complete"]] == TRUE){
"Recoding Complete."
}
})
#Render recoded data table
output$recoded_dt <- DT::renderDataTable({
req(v[["print_execute_complete"]] == TRUE)
if(!is.null(v[["datarecoded"]])){
return(DT::datatable(v[["datarecoded"]], filter='top'))
} else if(v[["print_filter_complete"]] == TRUE & !is.null(v[["datafiltered"]])) {
return(DT::datatable(v[["datafiltered"]], filter='top'))
} else {
DT::datatable(myData(),filter='top')
}
})
Persistent data in reactive editable table in Shiny app using DT
The issue is that input$edit_cell_edit$row and input$edit_cell_edit$col are provided according to the subsetted dataframe that is displayed whereas you are changing the values on complete dataframe.
Use this in observeEvent -
observeEvent(input$edit_cell_edit, {
inds <- which(gtcars_tbl$ctry_origin == input$country)
gtcars_tbl[inds[input$edit_cell_edit$row],input$edit_cell_edit$col] <- input$edit_cell_edit$value
write.csv(gtcars_tbl, "gtcars_tbl.csv", row.names = FALSE)
})
R Shiny update DT cell based on reactivity within same table
Here is a solution. You have to update the <select> as well.
library(shiny)
library(DT)
ui <- fluidPage(
h4("Reactivity within table: no response."),
fluidRow(
DTOutput(outputId = "tableNR"),
verbatimTextOutput('selectedGroupNR')
)
)
group <- function(letter){
paste0(
'<select id="selectNR" class="form-control">',
ifelse(letter == "A",
'<option value="A" selected>A</option>',
'<option value="A">A</option>'),
ifelse(letter == "B",
'<option value="B" selected>B</option>',
'<option value="B">B</option>'),
ifelse(letter == "C",
'<option value="C" selected>C</option>',
'<option value="C">C</option>'),
'</select>'
)
}
server <- function(input, output, session) {
getData <- reactive({
data.frame(
GROUP = '<select id="selectNR" class="form-control">
<option value="A">A</option>
<option value="B">B</option>
<option value="C">C</option>
</select>',
ANIMAL = 'Dog',
stringsAsFactors = FALSE, check.names = FALSE)
})
output$tableNR <- renderDT({
datatable(data = isolate(getData()),
selection = "none",
escape = FALSE,
rownames = TRUE,
options =
list(dom = 't',
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
))
})
# Set up proxy to update table when new selection is done.
proxyNR <- dataTableProxy('tableNR')
observeEvent(input$selectNR, {
toReplace <- getData()
toReplace$GROUP <- group(input$selectNR)
toReplace$ANIMAL <- switch(input$selectNR,
'A' = 'Dog',
'B' = 'Cat',
'C' = 'Fish')
replaceData(proxyNR, toReplace, resetPaging = FALSE)
})
# As a check
output$selectedGroupNR <- renderPrint({
paste0('Selected group = ', input$selectNR)
})
}
shinyApp(ui = ui, server = server)
R shiny editable table with reactive filters - update filters with table edits
Perhaps you are looking for this
### DT updates filters
shinyApp(
ui = fluidPage(
DT::dataTableOutput('x1')
),
server = function(input, output, session) {
dfx <- reactiveValues(data=NULL)
observe({
x <- iris
x$Date = Sys.time() + seq_len(nrow(x))
dfx$data <- x
})
output$x1 = renderDT(dfx$data, editable = TRUE, filter = "top", selection = 'none', rownames = FALSE)
#proxy = dataTableProxy('x1')
observeEvent(input$x1_cell_edit, {
info = input$x1_cell_edit
str(info)
i = info$row
j = info$col + 1
v = info$value
dfx$data[i, j] <<- DT:::coerceValue(v, dfx$data[i, j])
#replaceData(proxy, x, resetPaging = FALSE, rownames = FALSE)
})
}
)
Modify a column of a reactive data table in Shiny
This should get you some of the way. Let me know what is still needed. See Unable to pass user inputs into R shiny modules. The main point is that you need to pass inputs from the main app as reactives to the module.
library(lubridate)
library(shiny)
library(shinyjs)
library(tidyverse)
library(DT)
test_data<- data.frame(matrix(data=round(rnorm(8*5),2),ncol=8,nrow=5))
mod_data <- function(input, output, session, data_in, var_1) {
data_x <- reactiveValues(
data=data_in
)
proxy = dataTableProxy("data_in")
# observe({
# newvar <- var_1()
# data_x$data[, 1] <<- newvar
# replaceData(proxy, data_x$data, resetPaging = FALSE)
# })
observeEvent(var_1(), {
isolate(data_x$data[1, 1] <<- var_1())
replaceData(proxy, data_x$data, resetPaging = FALSE) # replaces data displayed by the updated table
})
#manual element update
observeEvent(input$data_mod_cell_edit, {
info = input$data_mod_cell_edit
str(info)
i = info$row
j = info$col+1
k = info$value
str(info)
isolate(
if (j %in% match(c("X1","X2"), names(data_x$data))) {
data_x$data[i, j] <<- DT::coerceValue(k, data_x$data[i, j])
}
)
replaceData(proxy, data_x$data, resetPaging = FALSE) # replaces data displayed by the updated table
})
output$data_mod <- DT::renderDataTable({
DT::datatable(
data=data_x$data,
editable = TRUE,
rownames = FALSE,
class="compact cell-border",
selection = list(mode = "single",
target = "row"
),
options = list(
dom="t",
autoWidth=TRUE,
scrollX = TRUE,
ordering=FALSE,
pageLength = 16,
bLengthChange= FALSE,
searching=FALSE
)
)
})
}
modFunctionUI <- function(id) {
ns <- NS(id)
DT::dataTableOutput(ns(id))
}
# Define UI
#ui----
ui= fluidPage(
fluidRow(
br(),
br(),
column(1,selectInput(inputId="var_1", label = h5("var 1"), choices=c(555,444),selected = 555)),
column(4, tableOutput("data")),
column(4, modFunctionUI("data_mod"))
),
#set font size of tables
useShinyjs(),
inlineCSS(list("table" = "font-size: 12px"))
)
#shiny server ----
server=function(input,output,session){
#normal table
global <- reactiveValues( df =test_data )
observe({ global$df$X1 <- input$var_1 })
output$data <- renderTable({global$df })
#datatable
callModule(module=mod_data,
id="data_mod",
data_in=test_data,
var_1=reactive(input$var_1)
)
}
# Run the application
shinyApp(ui = ui, server = server)
Related Topics
Replace Na with Previous and Next Rows Mean in R
Vary the Color Gradient on a Scatter Plot Created with Ggplot2
Extract Hyperlink from Excel File in R
Extract Data Between a Pattern from a Text File
R: Calculate Means for Subset of a Group
R - Replace Specific Value Contents with Na
Convert from K to Thousand (1000) in R
Hyperlink Bar Chart in Highcharter
Dividing Each Cell in a Data Set by the Column Sum in R
R Group By, Counting Non-Na Values
Create a New Variable Based on the First 7 Characters of Existing Variable