I'm new to R shiny and I'm building a R shiny app that allows users to update values on a matrixInput. When that values are change the app update my datasets with the new information. I would like to have a button ("Reset Button") that allows to show the matrix with the values in their original form (ie with my original dataset when it opens for the first time in the app), but i would like to do that without close/open the app.
this is part of the code:
library(shiny)
library(shinyjs)
library(data.table)
ui:
shinyUI(pageWithSidebar(
headerPanel("title"),
sidebarPanel(conditionalPanel(condition="input.tabselected==1",
selectInput("equip_input", "Equip", choices=c("Total", equip_order)),
matrixInput("matrix_aux",
value = matrix_aux,
cols = list(names = TRUE)),
useShinyjs(),
actionButton("action_simulation", "Simulation"),
actionButton("reset_button","Reset")))))
And in the server i tried to "reload" my R environment, that's where i have the datasets without changes:
shinyServer(function(input,output, session)({
var_aux1 <- reactive({
table_input = as.matrix(input$matrix_aux)
var_aux1 = table_input[,2]
return (var_aux1)})
var_aux2 <- reactive({
table_input = as.matrix(input$matrix_aux)
var_aux2 = table_input[,3]
return (var_aux2) })
var_aux3 <- reactive({
table_input = as.matrix(input$matrix_aux)
var_aux3 = table_input[,4]
return (var_aux3)})
observeEvent(input$action_simulation, {
var_aux1 <- as.numeric(var_aux1())
var_aux2<- as.numeric(var_aux2())
var_aux3 <- as.numeric(var_aux3())
v1[(v1$Equip == as.character(input$equip_input),]$var1 <<- var_aux1
v1[(v1$Equip == as.character(input$equip_input),]$var2 <<- var_aux2
v1[(v1$Equip == as.character(input$equip_input),]$var3 <<- var_aux3
}
#this button doesn't do what i want
observeEvent(input$reset_button, {
rm(list=ls())
load("mydata") })}))
But it doesn't work. How can I do it??
Example:
When the user change the values in the matrix, the app updates my datasets with the new values:
observeEvent(input$action_simulation, {
v1[(v1$Equip == as.character(input$equip_input),]$var1 <<- var_aux1
v1[(v1$Equip == as.character(input$equip_input),]$var2 <<- var_aux2
v1[(v1$Equip == as.character(input$equip_input),]$var3 <<- var_aux3
}})
And I would like to have a option to make reset to the original values without changes
Related
I have a Shiny app (please see end for a minimum working example) with a "parent" reactable table and a drilldown table that pops up when a user clicks on a row of the parent table. The information on which row is selected in the parent is obtained via reactable::getReactableState(). However, when the user switches to a different "parent" table, the function returns the row selection for the outdated table, not the updated one.
This occurs event though the output for the new parent table has completed it's calculations and is fully updated by the time the drilldown table starts it's calculations. After the whole systems finished and the app is idle, something (and I'm not sure what) triggers the input to reactable::getReactableState() to be invalidated, and the reactives fire again, but this time using the updated (or "correct" from my perspective) tables, and returns the expected result, which is that now row is selected.
Referring to the reactive graph below, what I want to do is have input$tables-table_parent__reactable__selected set not NULL every time input$tables-data_set changes.
I have tried to do this via the session$sendCustomMessage() and Shiny.addCustomMessageHandler approach found here: Change the input value in shiny from server, but I find that, although I can change input$tables-table_parent__reactable__selected value it doesn't seem to send send the info to the browser until after all the outputs are done caculating when input$tables-data_set is changed.
A minimum working example:
UI module:
drilldownUI <- function(id) {
ns <- NS(id)
tagList(
tags$script("
Shiny.addCustomMessageHandler('tables-table_parent__reactable__selected', function(value) {
Shiny.setInputValue('tables-table_parent__reactable__selected', value);
});
"),
shiny::selectizeInput(
inputId = ns("data_set"),
label = "Data set",
choices = c("iris", "cars"),
selected = "iris"
),
reactable::reactableOutput(outputId = ns("table_parent"),
width = "100%"),
reactable::reactableOutput(
outputId = NS(id, "drilldown_table"),
width = "100%"
)
)
}
Server module:
drilldownServer <- function(id, dat) {
moduleServer(id, function(input, output, session) {
dataset <- reactive({
data_list <-
list(iris = as.data.table(iris), cars = as.data.table(MASS::Cars93))
data_list[[input$data_set]]
})
data_grouped <- reactive({
dataset()[, .N, by = c(grouping_var())]
})
grouping_var <- reactive({
if (input$data_set == "iris") {
return("Species")
}
"Origin"
})
output$table_parent <- reactable::renderReactable({
req(input$data_set)
reactable::reactable(
data_grouped(),
selection = "single",
onClick = "select"
)
})
selected <- reactive({
out <- reactable::getReactableState("table_parent", "selected")
if(is.null(out)||out=="NULL") return(NULL)
out
})
output$drilldown_table <- reactable::renderReactable({
req(selected())
# This should only fire after a new parent table is generated and the row selection is
# reset to NULL, but it fires once the new table is generated and BEFORE the row selection
# is reset to NULL
selected_group <- data_grouped()[selected(), ][[grouping_var()]]
drilldown_data <- dataset()[get(grouping_var()) == selected_group]
reactable::reactable(drilldown_data)
})
observeEvent(input$data_set, {
session$sendCustomMessage("tables-table_parent__reactable__selected", 'NULL')
})
})
App:
library(shiny)
library(reactable)
library(data.table)
# Define UI for application that draws a histogram
ui <- fluidPage(
drilldownUI("tables")
)
# Define server logic required to draw a histogram
server <- function(input, output) {
drilldownServer("tables")
}
# Run the application
shinyApp(ui = ui, server = server)
I found the solution thanks in part to this SO answer https://stackoverflow.com/a/39440482/9474704.
The key was to consider the row selection a state, rather than just reacting to input changes. Then, by using reactiveValues() instead of reactive(), I could update the state in multiple places using observeEvent().
An important additonal piece of information was that observe functions are eager, and you can set a priority, so when the user changes the input$data_set, I could reset the row selection to 0 before the drilldown reactable::renderReactable() section was evaluated.
The updates to the server module below for an example of the working solution:
drilldownServer <- function(id, dat) {
moduleServer(id, function(input, output, session) {
dataset <- reactive({
data_list <-
list(iris = as.data.table(iris), cars = as.data.table(MASS::Cars93))
data_list[[input$data_set]]
})
data_grouped <- reactive({
dataset()[, .N, by = c(grouping_var())]
})
grouping_var <- reactive({
if (input$data_set == "iris") {
return("Species")
}
"Origin"
})
# Create output for parent table
output$table_parent <- reactable::renderReactable({
req(input$data_set)
reactable::reactable(data_grouped(),
selection = "single",
onClick = "select")
})
# Create state variable
selected <- reactiveValues(n = 0)
currentSelected <- reactive({
reactable::getReactableState("table_parent", "selected")
})
observeEvent(currentSelected(), priority = 0, {
selected$n <- currentSelected()
})
# When data set input changes, set the selected number of rows to 0e
observeEvent(input$data_set,
label = "reset_selection",
priority = 9999, {
selected$n <- 0
})
# Create output for drilldown table
output$drilldown_table <- reactable::renderReactable({
req(selected$n > 0)
selected_group <-
data_grouped()[selected$n, ][[grouping_var()]]
drilldown_data <-
dataset()[get(grouping_var()) == selected_group]
reactable::reactable(drilldown_data)
})
})
}
I'm writing a shiny app that has a table (using DT::renderDataTable) from which users can select a row. But I want the user to also be able to add new row(s) if what they want is not already in the table. I'm using input controls for the user to enter new data, and I have an action button which, if pressed, should create a new row of data in the table from the input values. But pressing the button does not update the table.
A minimal example:
library(shiny)
library(DT)
mydata = data.frame(id=letters[1:5], val=sample(10,5,T))
ui = fluidPage(dataTableOutput("table"),
textInput('NewID', 'Enter new ID'),
numericInput('NewVal', 'Enter new val', 1),
actionButton("goButton", "Update Table"))
server = function(input,output){
output$table = renderDataTable(mydata)
update = eventReactive(input$goButton, {
newrow = data.frame(id = input$NewID, val = input$NewVal)
mydata = rbind(mydata, newrow)
})
}
shinyApp(ui,server)
Clearly, this is the wrong way to approach this. I've tried various combinations of wrapping both renderDataTable and the code to update mydata inside renderUI, observe and reactive, but I can't find the right way to do this.
This is my first shiny app, so maybe there is a basic concept that I'm not quite grasping. What is the right way?
You can render the result of eventReactive, where you return the updated dataset. Don't forget to use <<- to modify the global dataset as well:
server = function(input,output){
output$table <- renderDataTable( df())
df <- eventReactive(input$goButton, {
if(input$NewID!="" && !is.null(input$NewVal) && input$goButton>0){
newrow = data.table(id = input$NewID,
val = input$NewVal)
mydata <<- rbind(mydata, newrow)
}
mydata
}, ignoreNULL = FALSE)
}
You should use replaceData() function from package DT. Example:
...
dataTableOutput("OPreview"),
actionButton("BRefresh","Refresh"),
...
in server part(assuming ds is a dataset to show):
output$OPreview<-renderDataTable({ ds })
onclick("BRefresh",{
proxy=dataTableProxy("OPreview")
replaceData(proxy,ds)
})
I am working on building a shiny App. I have used some filters and rendered a data frame and the data frame changes dynamically as per the user input. But I cannot store a particular column value from a data frame into a vector. I need to store the reactive output every time into a vector so that I can use the values later again. Here the values are stored in text_vec and i need to pass that into the API but I cannot access the values from text_vec and i have to pass the updated values every time into the API
library(dplyr)
library(shiny)
shinyApp(ui = fluidPage(
sidebarLayout(
sidebarPanel(
selectInput(inputId = "cyl",
label = "Number cylinders:",
choices = c("all",sort(unique(mtcars$cyl))),
selected = "all"),
actionButton("capture",
"capture value")
), # closes sidebarPanel
mainPanel(
tableOutput("text"),
tableOutput("text2"),
tableOutput("text3"),
tableOutput("table")
) # closes mainPanel
) # closes sidebarLayout
), # closes fluidPage
server = function(input, output) {
# some example reactive data
cars_react <- reactive({
mtcars %>%
filter(cyl == input$cyl | input$cyl == "all")
})
# simply global assignment of a reactive vector
observeEvent(cars_react(), {
# here is a globally assigned vector taken from the reactive data
# reused in a render statement it will not react to change, since it is not reactive
test_vec3 <<- unique(cars_react()$hp)
})
# here a file is written to the working directory of your shiny app
# everytime cars_react() changes write (and overwrite) vector to a file
observeEvent(cars_react(), {
test_vec = unique(cars_react()$hp)
saveRDS(test_vec, file = "test_vec.Rdata")
})
# same as above but the file is gradually growing and not overwritten
# everytime cars_react() changes add vector to a (over several sessions growing) list
observeEvent(cars_react(), {
test_vec2 = unique(cars_react()$hp)
if (file.exists("test_list.Rdata")) {
temp = readRDS("test_list.Rdata")
test_list = c(temp, list(test_vec2))
} else {
test_list = list(test_vec2)
}
saveRDS(test_list, file = "test_list.Rdata")
})
# here we access the reactive data with isolate and make it non-reactive, but can update the values through a button click
text_vec <<- eventReactive(input$capture, {
isolate(unique(cars_react()$hp))
})
# output of our reactive data as table
output$table <- renderTable({
cars_react()
})
# text output of globally assigned non-reactive vector test_vec3 (not changing!)
output$text <- renderText({
test_vec3
})
# you can capture values of reactives with isolate, but then, they don't change anymore
# text output of isolated formely reactive vector unique(cars_react()$hp (not changing!)
output$text2 <- renderText({
isolate(unique(cars_react()$hp))
})
# text output of new reactive vector (changes when input$capture button is clicked)
output$text3 <- renderText({
text_vec()
})
for (i in text_vec)
{
url = "https://oscar.com/prweb/PRRestService/"
parameters<-'{
{
"Reference":"Account"
,"ReferenceValue":""
}'
b<-fromJSON(parameters)
b["ReferenceValue"]=i
r <- POST(url, body = parameters,encode = "json")
r_c<-toJSON(content(r))
print(r_c)
}
}
)
A simple way to get a data frame to persist across all environments used within your Shiny app, is to use the '<<-' assignment instead of the '<-" assignment. This is not a great programming technique, but it may be what you're hoping to find.
# To get a data frame to persist, use
a <<- b
# instead of
a <- b
** Updated answer **
Based on your updated answer, I would wrap you API call into an observeEvent which gets triggered once the action button is pressed. Since you do not provide a working example with some real code, I am not sure whether the example below is of help. I further assume that your for loop is correct and working (on my end, I cannot know without a real API and some real values).
library(dplyr)
library(shiny)
library(httr)
library(jsonlite)
shinyApp(ui = fluidPage(
selectInput(inputId = "cyl",
label = "Number cylinders:",
choices = c("all",sort(unique(mtcars$cyl))),
selected = "all"),
actionButton("capture",
"capture value")
), # closes fluidPage
server = function(input, output) {
# some example reactive data
cars_react <- reactive({
mtcars %>%
filter(cyl == input$cyl | input$cyl == "all")
})
# here we access the reactive data with isolate and make it non-reactive, but can update the values through a button click
observeEvent(input$capture, {
for (i in unique(cars_react()$hp))
{
url = "https://oscar.com/prweb/PRRestService/"
parameters<-'{
"Reference":"Account"
,"ReferenceValue":""
}'
b<-fromJSON(parameters)
b["ReferenceValue"]=i
r <- POST(url, body = parameters,encode = "json")
r_c<-toJSON(content(r))
print(r_c)
}
})
}
)
Old answer
It is not clear from your question how, where and how often you want to use the vector of your reactive data frame. But it is an important question, since the concept of reactivity and how to access it is very hard to grasp when you come from a pure non reactive R environment.
Below is a simple example app which shows how to access vectors in reactive data frames, and how they could be used.
I hope it helps to get a better understanding of reactivity in shiny.
library(dplyr)
library(shiny)
shinyApp(ui = fluidPage(
sidebarLayout(
sidebarPanel(
selectInput(inputId = "cyl",
label = "Number cylinders:",
choices = c("all",sort(unique(mtcars$cyl))),
selected = "all"),
actionButton("capture",
"capture value")
), # closes sidebarPanel
mainPanel(
tableOutput("text"),
tableOutput("text2"),
tableOutput("text3"),
tableOutput("table")
) # closes mainPanel
) # closes sidebarLayout
), # closes fluidPage
server = function(input, output) {
# some example reactive data
cars_react <- reactive({
mtcars %>%
filter(cyl == input$cyl | input$cyl == "all")
})
# simply global assignment of a reactive vector
observeEvent(cars_react(), {
# here is a globally assigned vector taken from the reactive data
# reused in a render statement it will not react to change, since it is not reactive
test_vec3 <<- unique(cars_react()$hp)
})
# here a file is written to the working directory of your shiny app
# everytime cars_react() changes write (and overwrite) vector to a file
observeEvent(cars_react(), {
test_vec = unique(cars_react()$hp)
saveRDS(test_vec, file = "test_vec.Rdata")
})
# same as above but the file is gradually growing and not overwritten
# everytime cars_react() changes add vector to a (over several sessions growing) list
observeEvent(cars_react(), {
test_vec2 = unique(cars_react()$hp)
if (file.exists("test_list.Rdata")) {
temp = readRDS("test_list.Rdata")
test_list = c(temp, list(test_vec2))
} else {
test_list = list(test_vec2)
}
saveRDS(test_list, file = "test_list.Rdata")
})
# here we access the reactive data with isolate and make it non-reactive, but can update the values through a button click
text_vec <- eventReactive(input$capture, {
isolate(unique(cars_react()$hp))
})
# output of our reactive data as table
output$table <- renderTable({
cars_react()
})
# text output of globally assigned non-reactive vector test_vec3 (not changing!)
output$text <- renderText({
test_vec3
})
# you can capture values of reactives with isolate, but then, they don't change anymore
# text output of isolated formely reactive vector unique(cars_react()$hp (not changing!)
output$text2 <- renderText({
isolate(unique(cars_react()$hp))
})
# text output of new reactive vector (changes when input$capture button is clicked)
output$text3 <- renderText({
text_vec()
})
}
)
I am building a shiny app for doing some network analyses. I want to calculate properties for the network using a function that is stored in global.R. However, I am not able to get the table output.
Here is the the part of my ui.R where I set the output for the table
# More ui.R above
mainPanel(
tabsetPanel(id = "conditionedPanels",
tabPanel("Network Properties",br(),value = 1,
actionButton('netproperty', label='Calculate Properties',class="btn btn-primary"),
h3(textOutput("Data Summary", container = span)),
tableOutput('prop_table')),
##... More ui.R code below
and here is my server.R:
shinyServer( function(input, output, session) {
## Get the properties
props <- reactive({
if (input$netproperty <= 0){
return(NULL)
}
result <- isolate({
input$netproperty
tryCatch ({
if(input$data_input_type=="example"){
if(input$datasets == "Network1"){
load("data/Network1.rda")
props <- graph_topology(g)
props
} else if (input$datasets == "Network2"){
load("data/Network1.rda")
props <- graph_topology(g)
props
} else if (input$datasets == "Network3"){
el <- read.delim("data/Network3.txt")
g <- graph.data.frame(el, directed = FALSE)
props <- graph_topology(g)
props
} else if (input$datasets == "Network4") {
el <- read.delim("data/Network4.txt")
g <- graph.data.frame(el, directed = FALSE)
props <- graph_topology(g)
props
}
} else if (input$data_input_type=="custom"){
if (is.null(input$dt_file))
return(NULL)
inFile <- input$dt_file
dataDT <- as.matrix(read.delim(inFile$datapah, sep="\t", header = FALSE, fill = TRUE))
g <- graph.data.frame(dataDT, directed = FALSE)
props <- graph_topology(g)
props
}
},
error = function(err) {
print(paste("Select Example or custom data set"))
})
})
result
})
## Output properties table
output$prop_table <- renderTable({
props()
})
}
When I press the button calculate properties, I get the error message always, telling me that I need to select example or custom data. I have tried with custom and example datasets, and the error remains. If I remove the tryCatch command in server.R I get the error of length equal zero. It seems that the function graph_topology in my global.R files is not working properly, but if I run it outside of the shiny app I get a matrix, that I thought it could be easily visualize with renderTable. I have also tried instead of using uiOutput in the ui.R using tableOutput but I have the same problem.
I am making an R shiny app (I am quite new to R shiny) which gets data as an input and projects the data as a table (using DT package). However when new data is inserted and submitted new rows are not being added, but rather the previous observation (previous submitted data is simply updated. Thus, what can I do to make save the new data data ?
The main problem in your code was you were creating a new data frame and replacing it with the previous one. I have slightly modified your server code. I have added a global variable TabData to save the previous data in the data table and rbind it with the new data to be added to the table. Please see the modified code below:
library(shiny)
library(car) # Import library to use recode() function
shinyServer(function(input, output) {
#Global variable to save the previous data in the data table
TabData <- data.frame()
values <- reactiveValues()
# Calculate damage and loss (just ab experiment)
observe({
input$action_Calc
values$int <- isolate({input$reduction * 10})
values$amt <- isolate({input$lost}) + values$int
values$com<-isolate({input$community})
values$disaster <- isolate({input$disaster})
values$name <- isolate({input$name})
})
# Display values entered
output$text_principal <- renderText({
input$action_Calc
paste("reduction: ", isolate(input$reduction))
})
output$text_intrate <- renderText({
input$action_Calc
paste("Vegetation: ", isolate(input$veg))
})
output$text_int <- renderText({
if(input$action_Calc == 0) ""
else
paste("Damage:", values$int)
})
output$text_amt <- renderText({
if(input$action_Calc == 0) ""
else
paste("Loss:", values$amt)
})
Data <- reactive({
browser()
if (input$action_Calc > 0) {
df <- data.frame(
Community= values$com,
Disaster = values$disaster,
Name = values$name,
Damage=values$amt,
Loss=values$int
)
return(list(df=df))
}
})
output$responses <- DT::renderDataTable(DT::datatable({
if (is.null(Data())) {return()}
#Row bind the new data to be added to the table
TabData <<- rbind(TabData, Data()$df)
datum<-TabData
datum
}))
})
Hope it helps!