I am working on an app that is modularized and contains a selectInput dropdown in Shiny. The dropdown provides a different dataset on selecting it. However, if I add a new row using the button or edit the table it effects both the tables.
Please find the dummy code below. It can all be copied and run to demonstrate the problem:
###Modularized Code###
Doc_UI <- function(id){
ns<-NS(id)
tagList(
actionButton(ns("add_btn"),"Add Row",icon("plus-circle"),
style="color: #fff; background-color: #337ab7; border-color: #202020;float:left;margin-right:5px"),
DTOutput(ns('Table')))
}
Doc_server <-function(input,output,session,x){
if(x == "iris"){
x <- iris
}else{
x<-mtcars
}
output$Table = renderDT(head(x), selection = 'single',editable = TRUE)
proxy = dataTableProxy('Table')
observeEvent(input$Table_cell_edit, {
info = input$Table_cell_edit
str(info)
i = info$row
j = info$col
v = info$value
x[i, j] <<- v
replaceData(proxy, x, resetPaging = FALSE) })
observeEvent(input$add_btn,
{newrow <- setNames(data.frame(matrix(ncol = ncol(x), nrow = 1)),
colnames(x))
x<<-rbind(newrow,x)
rownames(x) <- NULL
replaceData(proxy, x, resetPaging = F)
})
}
###App###
library(shiny)
ui <- fluidPage(
dashboardslider <- dashboardSidebar(
selectInput("select", label = "Select Data",choices = c("iris","mtcars")
)),
dashboardbody <- dashboardBody(
tabsetPanel(
tabPanel("Doc",Doc_UI("Tab1")))
))
server <- function(input, output, session)
observeEvent(input$select,
{callModule(Doc_server,"Tab1",x= input$select)})
shinyApp(ui, server)
I feel like I am making a mistake somewhere or I am missing something. I want the buttons to remain present in the modularized code as shown in the dummy. Appreciate any help or discussion.
I think this might be due to the same namespace, as the id is "Tab1" for both. Is there a way to make the id interactive in the UI?
My guess is that the problem stems from input$add_btn. Because you always use the same namespace, the input for this button is still there. If you've used it the first time with iris, its value is not 0. Therefore, when you initialise the module again, the observeEvent(input$add_btn directly fires. You can also notice that it doesn't matter how often you've clicked it in the previous version of the module, if you initialise the module again you only have one new row.
Below you find a version of the code where I only initialise the module once but change the dataset within the module, depending on the reactive input from the main server function. Notice that if you change the dataset, the added rows are not saved.
library(shiny)
library(shinydashboard)
library(DT)
Doc_UI <- function(id){
ns<-NS(id)
tagList(
actionButton(ns("add_btn"),"Add Row",icon("plus-circle"),
style="color: #fff; background-color: #337ab7; border-color: #202020;float:left;margin-right:5px"),
DTOutput(ns('Table')))
}
Doc_server <-function(input,output,session,x){
# set up reactiveVal
module_data <- reactiveVal()
observeEvent(x(), {
if(x() == "iris"){
module_data(iris)
}else{
module_data(mtcars)
}
})
output$Table = renderDT({
req(module_data())
head(module_data())}, selection = 'single',editable = TRUE)
proxy = dataTableProxy('Table')
observeEvent(input$Table_cell_edit, {
info = input$Table_cell_edit
str(info)
i = info$row
j = info$col
v = info$value
cur_data <- module_data()
cur_data[i, j] <- v
module_data(cur_data)
replaceData(proxy, module_data(), resetPaging = FALSE) })
observeEvent(input$add_btn,
{newrow <- setNames(data.frame(matrix(ncol = ncol(module_data()), nrow = 1)),
colnames(module_data()))
cur_data <- rbind(newrow, module_data())
rownames(cur_data) <- NULL
module_data(cur_data)
replaceData(proxy, module_data(), resetPaging = F)
})
}
###App###
library(shiny)
ui <- fluidPage(
dashboardslider <- dashboardSidebar(
selectInput("select", label = "Select Data",choices = c("iris","mtcars")
)),
dashboardbody <- dashboardBody(
tabsetPanel(
tabPanel("Doc",Doc_UI("Tab1")))
))
server <- function(input, output, session) {
callModule(Doc_server, "Tab1", x = reactive({input$select}))
}
shinyApp(ui, server)
Related
I have relied on the following Code so that the user can modify the shiny table.
I have a large database, before the user modifies the table I would like him to be able to filter by "material" and then he can make the corresponding modifications, especially the column "stockobj", then I would like to see the filtered table and the main table with the modifications that were made previously.
As you can see in the picture: [App][https://i.stack.imgur.com/2ecpK.png]
My code:
library(DT)
df<- tibble(material=c(12345,12345,12345,12345,12345, 67891,67891,67891,67891,67891),
centro=c("H01", "H02", "H03", "H04","H05","H01", "H02", "H03", "H04","H05" ),
rotaSem= c(0.66,0.55,0.43,0.45, 0.33, 0.34,0.78, 0.31,0.89,0.87),
stockobj=c(1,2,1,1,3,1,1,1,2,1))
shinyApp(
ui = fluidPage(
titlePanel("My app"),
selectInput("mate", "Select material", choices = unique(df$material)),
h3("Edit table"),
DTOutput('x1'),
h3("Main table"),
DTOutput("x2")
),
server = function(input, output, session) {
x = df
categ<-reactive({
x %>% filter(material==input$mate)
})
output$x1 <- renderDT(categ(), selection = 'none', rownames = F, editable = T)
output$x2 <- renderDT({
x
})
proxy = dataTableProxy('x1')
observeEvent(input$x1_cell_edit, {
info = input$x1_cell_edit
str(info)
i = info$row
j = info$col + 1 # column index offset by 1
v = info$value
x[i, j] <<- DT::coerceValue(v, x[i, j])
replaceData(proxy, x, resetPaging = FALSE, rownames = FALSE)
})
}
)```
I have been looking for a solution for several days but I have not been able to. The problem is that to modify the table I have to modify the "reactive" and I don't think it is possible. Any ideas?
[1]: https://i.stack.imgur.com/2ecpK.png
Try this
library(DT)
library(dplyr)
df<- data.frame(material=c(12345,12345,12345,12345,12345, 67891,67891,67891,67891,67891),
centro=c("H01", "H02", "H03", "H04","H05","H01", "H02", "H03", "H04","H05" ),
rotaSem= c(0.66,0.55,0.43,0.45, 0.33, 0.34,0.78, 0.31,0.89,0.87),
stockobj=c(1,2,1,1,3,1,1,1,2,1))
shinyApp(
ui = fluidPage(
titlePanel("My app"),
selectInput("mate", "Select material", choices = unique(df$material)),
h3("Edit table"),
DTOutput('x1'),
h3("Main table"),
DTOutput("x2")
),
server = function(input, output, session) {
rv <- reactiveValues(df=df,dfa=NULL,dfb=NULL)
observeEvent(input$mate, {
rv$dfa <- rv$df %>% dplyr::filter(material %in% input$mate)
rv$dfb <- rv$df %>% dplyr::filter(!(material %in% input$mate))
})
observe({
rv$df <- rbind(rv$dfa,rv$dfb)
df1 <- rv$df
newchoices <- unique(df1$material)
selected <- input$mate
updateSelectInput(inputId = 'mate', choices=newchoices, selected=selected)
})
output$x1 <- renderDT(rv$dfa, selection = 'none', rownames = F, editable = T)
output$x2 <- renderDT({ rv$df })
observeEvent(input$x1_cell_edit, {
info = input$x1_cell_edit
str(info)
i = info$row
j = info$col + 1 # column index offset by 1
v = info$value
rv$dfa[i, j] <<- DT::coerceValue(v, rv$dfa[i, j])
})
}
)
I am building a Shiny app and using the code from this question as an example: How to download editable data table in shiny. However, in my code the df <- reactiveVal(dat) does not work, because the dat itself is already a reactive value that comes from an eventReactive({}) function. This is the code I am working with, it works if I define the dat outside of the server, but not when it is created inside the server function of shiny. How do I make a copy of it so that I can show it in a new table (and potentially process further and download in later steps in the app)?
library(shiny)
library(DT)
library(shinyWidgets)
# if the data frame is just an object, it works
#dat <- iris[1:3, ]
ui <- fluidPage( actionBttn(
inputId = "btnProcess",
label = "Process",
size = "sm",
color = "success"
),
DTOutput("my_table"),
DTOutput("table2")
)
server <- function(input, output){
# if the dataframe is a reactive variable, this doesnt work.
dat <- eventReactive(input$btnProcess, {
iris[1:3, ]
})
output[["my_table"]] <- renderDT({
datatable(dat(), editable = "cell")
})
#############################
#### none of these work #####
#############################
#df <- reactiveVal(dat)
#df <- reactiveVal(dat())
#df <- dat()
#df <- dat
observeEvent(input[["my_table_cell_edit"]], {
cell <- input[["my_table_cell_edit"]]
newdf <- df()
newdf[cell$row, cell$col] <- cell$value
df(newdf)
})
output[["table2"]] <- renderDT({
datatable(df())
})
}
shinyApp(ui, server)
Try this
ui <- fluidPage( actionBttn(
inputId = "btnProcess",
label = "Process",
size = "sm",
color = "success"
),
actionBttn(inputId = "reset", label = "Reset", size="sm", color="warning"),
DTOutput("mytable"),
DTOutput("table2")
)
server <- function(input, output){
# if the dataframe is a reactive variable, this doesnt work.
dat <- eventReactive(input$btnProcess, {
iris[1:3, ]
})
mydf <- reactiveValues(data=NULL)
observe({
mydf$data <- dat()
})
output$mytable <- renderDT({
datatable(mydf$data, editable = "cell")
})
observeEvent(input$mytable_cell_edit, {
info = input$mytable_cell_edit
str(info)
i = info$row
j = info$col
v = info$value
mydf$data[i, j] <<- DT::coerceValue(v, mydf$data[i, j])
})
output[["table2"]] <- renderDT({
datatable(mydf$data)
})
observeEvent(input$reset, {
mydf$data <- dat() ## reset it to original data
})
}
shinyApp(ui, server)
I am trying to make an editable table in shiny, and would like the end user to be able to select from a dropdown list for one of the columns.
Below is a working example of an editable datatable, where the columns competitor_brand and ratio may be edited. For ratio column, it is fine as is. But, I would like for the only possible inputs for the competitor_brand column to be the list of unique(input_data$Brand)
I have had a look around for code but struggling to find what I need
Many thanks!
(Apologies if I have missed some info, I am a noob)
### Libraries
library(shiny)
library(dplyr)
library(DT)
### Data
input_data <- data.frame(Brand = c("Brand1", "Brand2","Brand3"),
competitor_brand = c("Brand1", "Brand2","Brand3"),
ratio = c (.5, .5, .5),
cost = c(2000, 3000, 4000),
stringsAsFactors = FALSE)
### Module
modFunction <- function(input, output, session, data,reset) {
v <- reactiveValues(data = data)
proxy = dataTableProxy("mod_table")
observeEvent(input$mod_table_cell_edit, {
print(names(v$data))
info = input$mod_table_cell_edit
str(info)
i = info$row
j = info$col
k = info$value
str(info)
isolate(
if (j %in% match(c("competitor_brand","ratio"), names(v$data))) {
print(match(c("competitor_brand", "ratio"), names(v$data)))
v$data[i, j] <<- DT::coerceValue(k, v$data[i, j])
print(v$data)
} else {
stop("You are not supposed to change this column.") # check to stop the user from editing only few columns
}
)
replaceData(proxy, v$data, resetPaging = FALSE) # replaces data displayed by the updated table
})
### Reset Table
observeEvent(reset(), {
v$data <- data # your default data
})
print(isolate(colnames(v$data)))
output$mod_table <- DT::renderDataTable({
DT::datatable(v$data, editable = TRUE)
})
return(v)
}
modFunctionUI <- function(id) {
ns <- NS(id)
DT::dataTableOutput(ns("mod_table"))
}
### Shiny App
shinyApp(
ui = basicPage(
mainPanel(
actionButton("reset", "Reset"),
tags$hr(),
modFunctionUI("editable")
)
),
server = function(input, output) {
demodata<-input_data
edited <- callModule(modFunction,"editable", demodata,
reset = reactive(input$reset))
observe(print(edited$data))
}
)```
I'm trying to allow the user to edit DT values, and based on those edits, run calculations on other columns. That works great on page one, but editing values on subsequent pages resets the paging back to the first page - a nightmare from a UX perspective.
Sample App demonstrating problem.
Try editing a vs value on Page 2 to see what happens...
library(shiny)
library(DT)
library(dplyr)
shinyApp(
ui = fluidPage(
DTOutput('table')
),
server = function(input, output, session) {
x = reactiveValues(df = mtcars %>% select(vs,am))
output$table = renderDT(x$df, editable = TRUE)
proxy = dataTableProxy('table')
observeEvent(input$table_cell_edit, {
info = input$table_cell_edit
str(info)
i = info$row
j = info$col
v = info$value
x$df[i, j] <- isolate(DT::coerceValue(v, x$df[i, j]))
x$df[i,which(colnames(x$df)=='am')] <- x$df[[i, j]]*2
replaceData(proxy, x$df, resetPaging = FALSE) # important I have tried with and without this line no impact on page resetting
})
}
)
Based on this post, I tried removing the reactivity, but it won't accept multiple edits. Try making two edits to vs on the first page to see what happens...
library(shiny)
library(DT)
library(dplyr)
shinyApp(
ui = fluidPage(
DTOutput('table')
),
server = function(input, output, session) {
df <- mtcars %>% select(vs,am)
output$table = renderDT(df, editable = TRUE)
proxy = dataTableProxy('table')
observeEvent(input$table_cell_edit, {
info = input$table_cell_edit
str(info)
i = info$row
j = info$col
v = info$value
df[i, j] <- isolate(DT::coerceValue(v, df[i, j]))
df[i,which(colnames(df)=='am')] <- df[[i, j]]*2
replaceData(proxy, df, resetPaging = FALSE)
})
}
)
Any pointers would be GREATLY appreciated!
SOLVED...
Thanks to this post...
R Shiny - multi-page editable DataTable jumps to row #1 after an edit
Solution is to isolate the reactive df in the renderDT() function like this...
library(shiny)
library(DT)
library(dplyr)
shinyApp(
ui = fluidPage(
DTOutput('table')
),
server = function(input, output, session) {
x = reactiveValues(df = mtcars %>% select(vs,am))
output$table = renderDT(isolate(x$df), editable = TRUE)
proxy = dataTableProxy('table')
observeEvent(input$table_cell_edit, {
info = input$table_cell_edit
str(info)
i = info$row
j = info$col
v = info$value
x$df[i, j] <- isolate(DT::coerceValue(v, x$df[i, j]))
x$df[i,which(colnames(x$df)=='am')] <- x$df[[i, j]]*2
replaceData(proxy, x$df, resetPaging = FALSE) # important I have tried with and without this line no impact on page resetting
})
}
)
Is it possible to update a reactive data source by editing the DT::DataTable? Below code is based on this code with change that x is made reactive. The problem starts when trying to change x in observeEvent.
The purpose of having x reactive is that I intend to source it from an external database, then have edits to the DT::DataTable write back to the database so that it stays in sync with what the user sees (I'm fine with doing that - it is not part of the question).
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
DTOutput('x1')
),
server = function(input, output, session) {
x = reactive({
df <- iris
df$Date = Sys.time() + seq_len(nrow(df))
df
})
output$x1 = renderDT(x(), 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()[i, j] <<- isolate(DT::coerceValue(v, x()[i, j]))
replaceData(proxy, x(), resetPaging = FALSE) # important
})
}
)
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
})
}
)
If you don't show the row names in your DT then you should add 1 to info$col to get the correct column i.e., j = info$col + 1.