Data frame won't update using observeEvent in Shiny R - r

I am a novice programmer, please excuse if I am not clear or missing relevant information. I have a shiny app written that imports a dataframe from another set of code. I would like to update that dataframe with user input in the app. I have gotten this to work where I upload the dataframe as a reactive variable using the code below:
DATA
current.shiny <- data.frame("Task" = as.character(c("Task 1", "Task 2", "Task 3")), "Completed" = as.character(c("Yes", "NO", "Yes")),"Date.Completed" = as.Date(c("2020-10-19","2020-10-20", "2020-10-21")))
UI
ui<- fluidPage(
# Application title
titlePanel("Week of 11.02.2020"),
# Sidebar with reactive inputs
sidebarLayout(
sidebarPanel(
selectInput(inputId = "task.choice", label = "Task",
choices = c(as.list(current.shiny$Task))),
selectInput(inputId = "completed", label = "Completed?",
choices = c("Yes" = "Yes", "No" = "No")),
dateInput(inputId = "date.completed", label ="Date Completed"),
actionButton("update","Update Sheet")
),
# a table of reactive outputs
mainPanel(
mainPanel(
#DT::dataTableOutput("dt_table", width = 500)
)
)
),
# column(12,
# DT::dataTableOutput("data", width = "100%")),
column(12,
DT::dataTableOutput("xchange", width = "100%"))
)
SERVER 1
server <- function(input, output) {
# # Re-read data for any changes, write to csv new changes, ignore startup
observeEvent(input$update,{
test.data<-current.shiny
test.data$Completed[test.data$Task == input$task.choice]<-as.character(input$completed)
ignoreInit=T
})
# #Reactive variable xchange that updates the values of data
xchange<-reactive({
test.data<-current.shiny
test.data$Completed[test.data$Task == input$task.choice]<-as.character(input$completed)
test.data$Date.Completed[test.data$Task == input$task.choice]<-as.Date(input$date.completed)
test.data
})
#Display the most recent file, with the most recent changes
output$xchange <- renderDataTable({
datatable(xchange(), options = list(dom = "t"))
})
}
shinyApp(ui,server)
This works to a degree. However, it is over-reactive in that I need it to only update the table once a button is pressed. The observeEvent function in the above code doesn't seem to do anything (it was mostly copy/pasted from another stack overflow thread). I've tried to set this up below, but I cannot get it to run.
SERVER 2
server <- function(input, output, session) {
rxframe <- reactiveVal(
as.data.frame(current.shiny)
)
observeEvent(input$update, {
rxframe$Completed[rxframe$Task == input$task.choice]<-as.character(input$completed)
})
output$xchange <- shiny::renderTable( rxframe() )
}
shinyApp(ui, server)
Can anyone see some way that I am calling the observeEvent incorrectly that is causing it to not function properly? Any insight would be greatly appreciated, I've been stuck on this for some time.

Your code directly reacted to every change because you are using reactive.
If you want to delay the reaction you can use observeEvent along with reactiveValues or eventReactive.
Here is an example using reactiveVal and observeEvent:
library(shiny)
library(DT)
current.shiny <- data.frame(
"Task" = as.character(c("Task 1", "Task 2", "Task 3")),
"Completed" = as.character(c("Yes", "NO", "Yes")),
"Date.Completed" = as.Date(c("2020-10-19", "2020-10-20", "2020-10-21"))
)
ui <- fluidPage(
# Application title
titlePanel("Week of 11.02.2020"),
# Sidebar with reactive inputs
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "task.choice",
label = "Task",
choices = c(as.list(current.shiny$Task))
),
selectInput(
inputId = "completed",
label = "Completed?",
choices = c("Yes" = "Yes", "No" = "No")
),
dateInput(inputId = "date.completed", label = "Date Completed"),
actionButton("update", "Update Sheet")
),
mainPanel(column(
12,
DT::dataTableOutput("xchangeOut", width = "100%")
))
))
server <- function(input, output) {
xchange <- reactiveVal(current.shiny)
observeEvent(input$update, {
test.data <- xchange()
test.data$Completed[test.data$Task == input$task.choice] <-input$completed
test.data$Date.Completed[test.data$Task == input$task.choice] <- input$date.completed
xchange(test.data)
# write.csv
})
#Display the most recent file, with the most recent changes
output$xchangeOut <- renderDataTable({
datatable(xchange(), options = list(dom = "t"))
})
}
shinyApp(ui, server)

Related

How to clear the mainPanel if a selectInput choice has changed?

I am trying to create an app that will show you results depending on a selectInput and the changes are controlled by actionButtons.
When you launch the app, you have to select a choice: Data 1 or Data 2. Once you have selected your choice (e.g. Data 1), you have to click the actionButton "submit type of data". Next, you go to the second tab, choose a column and then click "submit".
The output will be: one table, one text and one plot.
Then, if you go back to the first tab and select "Data 2", everything that you have generated is still there (as it is expected, since you didn't click any button).
However, I would like to remove everything that is in the mainPanel if I change my first selectInput as you could see it when you launch the app for the first time.
The idea is that since you have changed your first choice, you will have to do the same steps again (click everything again).
I would like to preserve and control the updates with actionButtons as I have in my code (since I am working with really long datasets and I don't want to depend on the speed of loading things that I don't want until I click the button). Nevertheless, I cannot think a way to remove everything from mainPanel if I change the choice of the first selectInput.
Does anybody have an idea how I can achieve this?
Thanks in advance
Code:
library(shiny)
library(shinyWidgets)
library(shinyFeedback)
library(DT)
library(datasets)
ui <- fluidPage(
sidebarPanel(
tabsetPanel(id="histogram",
tabPanel("Selection",
useShinyFeedback(),
selectInput(inputId = "type", label = "Select your data",
choices = c("Data 1" = "data1",
"Data 2" = "data2")),
conditionalPanel(
condition = "input.type == 'data2'",
div(style = "position:absolute;right:2.5em;",
actionButton(
inputId = "button_more_info_data2",
label = "More info",
icon = icon("info-circle"))
)
),
actionButton(
inputId = "button",
label = "Submit type of data",
icon = icon("check")
)
),
tabPanel("Pick the column",
br(),
selectizeInput(inputId = "list_columns", label = "Choose the column:", choices=character(0)),
actionButton(
inputId = "button2",
label = "Submit")
))
),
mainPanel(
dataTableOutput("table"),
textOutput("text"),
plotOutput("myplot")
)
)
server <- function(input, output, session) {
observeEvent(input$type,{
feedbackWarning(inputId = "type",
show = ("data2" %in% input$type),
text ="This data is... Please, be careful..."
)
})
mydata <- reactive({
if(input$type == "data1"){
mtcars
}else{
iris
}
}) %>% bindEvent(input$button2)
# This is to generate the choices (gene list) depending on the user's input.
observeEvent(input$button, {
updateSelectizeInput(
session = session,
inputId = "list_columns",
choices = colnames(trees), options=list(maxOptions = length(colnames(trees))),
server = TRUE
)
})
output$table <- renderDataTable({
req(input$button2)
mydata()
})
output$text <- renderText({
req(input$button2)
input$list_columns
})
output$myplot <- renderPlot({
req(input$button2, input$button)
hist(trees[,input$list_columns])
})
}
if (interactive())
shinyApp(ui, server)
Here is an example using a reset button - using the selectInput you'll end up with a circular reference:
library(shiny)
library(shinyWidgets)
library(shinyFeedback)
library(DT)
library(datasets)
ui <- fluidPage(sidebarPanel(tabsetPanel(
id = "histogram",
tabPanel(
"Selection",
useShinyFeedback(),
selectInput(
inputId = "type",
label = "Select your data",
choices = c("Data 1" = "data1",
"Data 2" = "data2")
),
conditionalPanel(
condition = "input.type == 'data2'",
div(
style = "position:absolute;right:2.5em;",
actionButton(
inputId = "button_more_info_data2",
label = "More info",
icon = icon("info-circle")
)
)
),
actionButton(
inputId = "button",
label = "Submit type of data",
icon = icon("check")
),
actionButton(
inputId = "reset",
label = "Reset",
icon = icon("xmark")
)
),
tabPanel(
"Pick the column",
br(),
selectizeInput(
inputId = "list_columns",
label = "Choose the column:",
choices = character(0)
),
actionButton(inputId = "button2",
label = "Submit")
)
)),
mainPanel(
dataTableOutput("table"),
textOutput("text"),
plotOutput("myplot")
))
server <- function(input, output, session) {
observeEvent(input$type, {
feedbackWarning(
inputId = "type",
show = ("data2" %in% input$type),
text = "This data is... Please, be careful..."
)
})
mydata <- reactiveVal(NULL)
observe({
if (input$type == "data1") {
mydata(mtcars)
} else if (input$type == "data2") {
mydata(iris)
} else {
mydata(data.frame())
}
}) %>% bindEvent(input$button2)
observeEvent(input$reset, {
mydata(data.frame())
})
# This is to generate the choices (gene list) depending on the user's input.
observeEvent(input$button, {
updateSelectizeInput(
session = session,
inputId = "list_columns",
choices = colnames(trees),
options = list(maxOptions = length(colnames(trees))),
server = TRUE
)
})
output$table <- renderDataTable({
req(input$button2)
mydata()
})
output$text <- renderText({
req(input$button2)
input$list_columns
})
output$myplot <- renderPlot({
req(input$button2, input$button)
hist(trees[, input$list_columns])
})
}
shinyApp(ui, server)

Subset data in R Shiny using Multiple Variables

I am new to R Shiny. I am attempting to create an app that allows a user to subset a data.frame based on multiple variables and then see the resulting data.
Here is a small example data set:
iter,wave,apples
1,1,600
1,1,500
1,1,400
1,2,300
1,2,200
1,2,100
2,1,1000
2,1,1100
2,1,1200
2,2,1300
2,2,1400
2,2,1500
3,1,1100
3,1,2200
3,1,3300
3,2,4400
3,2,5500
3,2,6600
I would like the user to be able to specify the value of iter and of wave and see the resulting data.
Here is my attempt at the Shiny code. I realize I must be making several silly mistakes.
Edit
Here is my revised code. The end result now comes pretty close to what I want. The sidebar is still not being displayed perfectly.
library(shiny)
setwd('C:/Users/mark_/Documents/simple_RShiny_files/explore')
apple.data <- read.csv('subset_data_based_on_multiple_variables.csv',
header = TRUE, stringsAsFactors = FALSE)
ui <- fluidPage(
titlePanel("Subsetting Apple Dataset"),
sidebarLayout(
sidebarPanel(
uiOutput("codePanel")
),
mainPanel(
tableOutput("view")
)
),
selectInput("codeInput", inputId ="data1", label = "Choose Iter", choices = unique(apple.data$iter)),
selectInput("codeInput", inputId ="data2", label = "Choose Wave", choices = unique(apple.data$wave))
)
server <- function(input, output) {
output$codePanel <- renderUI({
})
dataset <- reactive({
subset(apple.data, (iter == input$data1 & wave == input$data2))
})
output$view <- renderTable(dataset())
}
shinyApp(ui = ui, server = server)
The output
The problem is that both selectInputs have the same inputId. This works:
library(shiny)
apple.data <- data.frame(
iter = c(1L,1L,1L,1L,1L,1L,2L,2L,2L,2L,2L,
2L,3L,3L,3L,3L,3L,3L),
wave = c(1L,1L,1L,2L,2L,2L,1L,1L,1L,2L,2L,
2L,1L,1L,1L,2L,2L,2L),
apples = c(600L,500L,400L,300L,200L,100L,1000L,
1100L,1200L,1300L,1400L,1500L,1100L,2200L,3300L,4400L,
5500L,6600L)
)
ui <- fluidPage(
titlePanel("Subsetting Apple Dataset"),
sidebarLayout(
sidebarPanel(
selectInput("codeInput1", label = "Choose Iter", choices = unique(apple.data$iter)),
selectInput("codeInput2", label = "Choose Wave", choices = unique(apple.data$wave))
),
mainPanel(
tableOutput("view")
)
)
)
server <- function(input, output) {
dataset <- reactive({
return(subset(apple.data, (iter == input$codeInput1 & wave == input$codeInput2)))
})
output$view <- renderTable(dataset())
}
shinyApp(ui = ui, server = server)

Plot data after browsing input files with Shiny

I am trying to build a Shiny App that does the following:
1) Browse a value file that looks like
Sample x y
A 1 3
B 2 1
C 3 6
D 4 4
2) Browse a second info file,
Sample Country Status
A US OK
B UK OK
C UK NOPE
D US OK
3) When I press a Submit button,
4) I merge the two files by the Sample column,
5) And make a scatter plot with ggplot, with a dropdown menu that allows me to color the points according to the names of the columns from the info file.
With the code below, I am facing two problems: (i) after I load my files and press the Submit button, nothing happens, and (ii) how could I mention in my selectInput block for my dropdown menu the number of possible choices (assuming I do not know them in advance)?
library(shiny)
library(ggplot2)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput(
inputId = "user_value_file",
label = "Choose a file with numeric values"
),
fileInput(
inputId = "user_info_file",
label = "Choose a file with sample info"
),
actionButton(
inputId = "my_button",
label = "Submit"
)
),
mainPanel(
# browse sample annotation file
selectInput(
inputId = "info_col",
label = "Choose an info to color",
choices = c("Country", "Status") # I am cheating here because I know in advance what are the colnames of the info file
),
# outputs
plotOutput(
outputId = "my_scatter_plot"
)
)
)
)
server <- function(input, output) {
output$contents <- renderTable(
{
valueFile <- input$user_value_file
if (is.null(valueFile))
return(NULL)
infoFile <- input$user_info_file
if (is.null(infoFile))
return(NULL)
}
)
randomVals <- eventReactive(
input$goButton,
{
my_val <- read.table(valueFile$datapath, header = T, sep = "\t")
my_info <- read.table(infoFile$datapath, header = T, sep = "\t")
df <- merge(my_val, my_info, by="Sample")
output$my_scatter_plot <- renderPlot(
{
ggplot(df, aes_string(x=df$x, y=df$y, color=input$info_col)) +
geom_point()
}
)
}
)
}
shinyApp(ui = ui, server = server)
A few things noted to get it working:
the inputID in the layout needs to match the server renderTable parameters (e.g., input$goButton should be input$my_button)
renderPlot was moved from eventReactive, and calls randomVals to get the data frame df
To get choices from the user info file, added session to server function and updateSelectInput (note depending on that file structure you probably want to do something like remove first column name or other changes)
Otherwise left things as they are. Please let me know if this has the behavior you were looking for.
library(shiny)
library(ggplot2)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput(
inputId = "user_value_file",
label = "Choose a file with numeric values"
),
fileInput(
inputId = "user_info_file",
label = "Choose a file with sample info"
),
actionButton(
inputId = "my_button",
label = "Submit"
)
),
mainPanel(
# browse sample annotation file
selectInput(
inputId = "info_col",
label = "Choose an info to color",
choices = NULL # Get colnames from user_info_file later on
),
# outputs
plotOutput(
outputId = "my_scatter_plot"
)
)
)
)
server <- function(input, output, session) {
output$contents <- renderTable({
valueFile <- input$user_value_file
if (is.null(valueFile))
return(NULL)
infoFile <- input$user_info_file
if (is.null(infoFile))
return(NULL)
})
randomVals <- eventReactive(input$my_button, {
my_val <- read.table(input$user_value_file$datapath, header = T, sep = "\t")
my_info <- read.table(input$user_info_file$datapath, header = T, sep = "\t")
updateSelectInput(session, "info_col", "Choose an info to color", choices = names(my_info)[-1])
merge(my_val, my_info, by="Sample")
})
output$my_scatter_plot <- renderPlot({
df <- randomVals()
ggplot(df, aes_string(x=df$x, y=df$y, color=input$info_col)) +
geom_point()
})
}
shinyApp(ui, server)

R Shiny synchronize filters on multiple tabs

I built a R Shiny application with multiple tabs, which have some filters in common. Right now, all filters are stand-alone and do not synchronize across multiple tabs. Hence, when I change selectInput1 from value "a" to value "b", I have to repeat this handling on the next tab which contains selectInput2 with the same options/meaning.
I thought about making the filters dynamic, hence rendering them using the server side of R Shiny. Then of course, I can always make selectInput2 equal to selectInput1. But what if the user changes selectInput2 rather than selectInput1? It creates kind of a loop in the logic.
I spent quite some time finding a solution for this problem, and somehow I'm sure I'm not the first one encountering this problem. Suggestions or useful links would be really helpful!
Example:
## UI.R
shinyUI(
dashboardPage("Dashboard",
# Create tabs
tabPanel("Start",
p("This is the frontpage")
),
tabPanel("tab1",
uiOutput("selectInput1")
),
tabPanel("tab2",
uiOutput("selectInput2")
)
)
)
and:
## Server.R
library(shiny)
shinyServer(function(input, output,session){
output$selectInput1 <- renderUI({
selectInput(inputId = "id1",
label = "select",
choices = c("a","b","c"),
selected = "a")
})
output$selectInput2 <- renderUI({
selectInput(inputId = "id2",
label = "select",
choices = c("a","b","c"),
selected = "a")
})
})
I would personally use a single input control to control the different tab panels. One way is to include that single input under your tabs:
shinyApp(
fluidPage(
fluidRow(
tabsetPanel(
tabPanel("Tab1",
verbatimTextOutput("choice1")),
tabPanel("Tab2",
verbatimTextOutput("choice2"))
)
),
fluidRow(
selectInput("id1", "Pick something",
choices = c("a","b","c"),
selected = "a")
)
),
function(input, output, session){
output$choice1 <- renderPrint(input$id1)
output$choice2 <- renderPrint({
paste("The choice is:", input$id1)
})
}
)
Or, as you use a shinydashboard, you could actually add that control in the sidebar, possibly again in its own row under a set of tabs if you must.
I can't think of a reason to have multiple inputs who automatigically select the same thing. Other than slowing down your app, I can't see any gain. But if you insist, you make the selected choice a reactive value using reactiveVal and you use eg observeEvent() to update that reactive value. A small example using shinydashboard:
library(shinydashboard)
library(shiny)
ui <- shinyUI(
dashboardPage(title = "Dashboard",
dashboardHeader(),
dashboardSidebar(
tabsetPanel(
tabPanel("tab1",
uiOutput("selectInput1")
),
tabPanel("tab2",
uiOutput("selectInput2")
)
)),
dashboardBody(
verbatimTextOutput("selected")
)
)
)
server <- shinyServer(function(input, output,session){
thechoice <- reactiveVal("a")
output$selectInput1 <- renderUI({
selectInput(inputId = "id1",
label = "select",
choices = c("a","b","c"),
selected = thechoice())
})
output$selectInput2 <- renderUI({
selectInput(inputId = "id2",
label = "select",
choices = c("a","b","c"),
selected = thechoice())
})
observeEvent(input$id2,{
thechoice(input$id2)
})
observeEvent(input$id1,{
thechoice(input$id1)
})
output$selected <- renderPrint({
c(input$id1, input$id2)
})
})
shinyApp(ui, server)

How to overwrite output using 2nd action button

I have a shiny app which writes a dataframe to output when an action button is pressed. This is the "Go" button in the bare-bones example below. I have a reset button which resets the values of the inputs. I'm wondering how I might also reset the output (so it becomes NULL & disappears when "reset" is pressed).
I've tried to pass input$goButtonReset to the eventReactive function (with the intention of using an if statement inside to indicate which button was making the call) but this didn't seem to be possible.
Any help much appreciated!
ui <- fluidPage(title = "Working Title",
sidebarLayout(
sidebarPanel(width = 6,
# *Input() functions
selectInput("Input1", label = h3("Select Input1"),
choices = list("A" = "A", NULL = "NULL"),
selected = 1),
actionButton("goButton", "Go!"),
p("Click the button to display the table"),
actionButton("goButtonReset", "Reset"),
p("Click the button to reset your inputs.")
),
mainPanel(
# *Output() functions
tableOutput("pf"))
)
)
# build the outputs here
server <- function(input, output, session) {
observeEvent(input$goButtonReset, {
updateSelectInput(session, "Input1", selected = "NULL")
})
writePF <- eventReactive(input$goButton, {
data.frame("test output")
})
output$pf <- renderTable({
writePF()
})
}
shinyApp(ui = ui, server = server)
You could try using reactiveValues to store the data frame. This worked for me:
ui <- fluidPage(title = "Working Title",
sidebarLayout(
sidebarPanel(width = 6,
# *Input() functions
selectInput("Input1", label = h3("Select Input1"),
choices = list("A" = "A", NULL = "NULL"),
selected = 1),
actionButton("goButton", "Go!"),
p("Click the button to display the table"),
actionButton("goButtonReset", "Reset"),
p("Click the button to reset your inputs.")
),
mainPanel(
# *Output() functions
tableOutput("pf"))
)
)
# build the outputs here
server <- function(input, output, session) {
df <- reactiveValues()
observeEvent(input$goButton,{
df$writePF <- data.frame("test output")
})
observeEvent(input$goButtonReset,{
df$writePF <- NULL
})
output$pf <- renderTable({
df$writePF
})
}
shinyApp(ui = ui, server = server)

Resources