Creating baseline comparison data in shiny R - Duplicating inputted dataframe - r

Question

The aim of this exercise is to allow users to compare two different models based on their inputs. To do this, I have created an action button that asks users to specify their base model, and a reset button that takes the dataset back to before the baseline was added. The "base" logical determines whether the user wishes to include the base or not.
Once the add baseline actionbutton is clicked, the current state of the data.frame is saved and grouping variable is renamed with "baseline" added before it (using paste). Users can select a different model which renders in comparison to this static base.
For some reason, I cannot get the observe event to change the dataset. The observe event creates the baseline dataset fine (tested with print() ), however, the if() function does not alter "data" and therefore stops the base added to the ggplot. The code is written like this for two reasons. 1) by including the if() function after the observe event, any further changes to data only changes "data", it then gets added to the unchanged baseline data. 2) Also allows for the creation of the reset button which simply resets the data.frame to before the rbinding took place.
This small issue has infuriated me and I cannot see where I am going wrong. Cheers in advance for any help people can provide. There are simplier ways to do this (open to suggestions), however, the iris data is only an example of the function, and the actual version is more complex.
library("ggplot2")
if (interactive()) {
ui <- fluidPage(
selectInput("rows", label = h3("Choose your species"),
choices = list("setosa", "versicolor", "virginica")
),
actionButton("base", "Create baseline"),
actionButton("reset", "Reset baseline"),
plotOutput(outputId = "plot")
) # close fluid page
server <- function(input, output) {
output$plot <- renderPlot({ # create plot
base <- "no" # create baseline indicator which we can change once the observeevent below is changed
data <- iris
data <- iris[which(data$Species == input$rows),] # Get datasubset based on user input
observeEvent(input$base, { # If base is Pressed, run code below:
baseline <- data # Make Baseline Data by duplicating the users' specification
baseline$Species <- paste("Baseline",
data$Species, sep = "_") # Rename the grouping variable to add Baseline B4 it
base <- "yes" # Change our indicator of whether a baseline had been made to yes
}) # Close observe Event
observeEvent(input$reset, {
base <- "no" # This is placed before the rbind so that if we want to reset it will stop the merging of the two dataframes before it happens.
})
if (base == "yes") {
data <- rbind(data, baseline) # Run once the observe event has changed baseline to yes.This is kept seperatel that way any subsequent changes to data will not effect
# the final data. This command will simple add the base onto the changed "data" before plotting
}
observeEvent(input$reset, {
base <- "no"
})
ggplot(data, aes(x=Petal.Width, y = as.numeric(Sepal.Width), colour = Species)) + # variable = each dataset selected, value = respective values for that model
labs(x="Hypothetical X", y="Hypothetical X") +
geom_line()
}) # Close Render Plot
} # Close Serve Function
shinyApp(ui, server)
}
EXAMPLE TWO WITH REACTIVE OBJECT
library(shiny)
library(ggplot2)
library("tidyr")
library("dplyr")
library("data.table")
# Lets make a fake dataset called "Data". Has 4 variable options and
the Ages each data point relates to.
Ages <- 1:750
Variable1 <- rnorm(n=750, sd = 2, mean = 0)
Variable2 <- rnorm(n=750, sd = 1, mean = 2)
Variable3 <- rnorm(n=750, sd = 8, mean = 6)
Variable4 <- rnorm(n=750, sd = 3, mean = 3)
Data <- as.data.frame(cbind(Ages, Variable1, Variable2, Variable3,
Variable4) )
### UI
ui <- fluidPage(
checkboxGroupInput(inputId = "columns",
label = h4("Which Variables would you like in your
model?"), # Input Checkbox
choices = c("Variable1", "Variable2", "Variable3",
"Variable4")),
plotOutput(outputId = "plot"),
# Lets have our plot
actionButton("base", "Create baseline"),
# Baseline action
actionButton("reset", "Reset baseline") # Reset Action
) # Close UI
server <- function(input, output) {
output$plot <- renderPlot({
validate(need(!is.null(input$columns), 'Please tick a box to show a
plot.')) # Place a please choose columns for null input
data <- gather(select(Data, "Ages", input$columns), variable, value, -
Ages) ## Just doing a little data manipulation to change from wide to
long form. This allows for calculations down the track and easier
plotting
# Now we can modify the data in some way, for example adding 1. Will
eventually add lots of model modifications here.
data$value <- data$value + 1
rVals <- reactiveValues() # Now we create the reactive
values object
rVals[['data']] <- data # Making a reactive values
function. Place Data as "data".
observeEvent(input$base,{
baseline <- data
baseline$variable <- paste("Baseline",
baseline$variable, sep = "_")
# Rename Variables to Baseline preamble
rVals[['baseline']] <- baseline
# Put the new data into the reactive object under "baseline"
})
observeEvent(input$reset,{ # Reset button will wipe the
data
rVals[['baseline']] <- NULL
})
if(!is.null(rVals[['baseline']])) # if a baseline has been .
created, then
{rVals[['final']] <- bind_rows(rVals[['data']], rVals[['baseline']])
# Here we can simply bind the two datasets together if Baseline exists
} else {rVals[['final']] <- rVals[['data']]}
# Otherwise we can use keep it as it is
## Make our Plot !
ggplot(rVals[['final']], aes(x=Ages, y = as.numeric(value), colour =
variable)) + # variable = each dataset selected, value = respective
values for that model
labs(x="Age", y="value") +
geom_line()
}) ## Close the render plot
} ## Close the server
shinyApp(ui, server)

Answer 1

You have observer inside reactive expression, i have seen this causing problems on number of occasions when i was correcting shiny code. Create reactive expression (your plot function) and observers only to specify which is the baseline value of species (character string) then feed this to filtering data inside the plot function:
library(shiny)
library(ggplot2)
ui <- fluidPage(
selectInput("rows", label = h3("Choose your species"),
choices = list("setosa", "versicolor", "virginica")
),
actionButton("base", "Create baseline"),
actionButton("reset", "Reset baseline"),
plotOutput(outputId = "plot")
) # close fluid page
server <- function(input, output) {
rVals = reactiveValues()
rVals[['data']] = iris
rVals[['baseline']] = NULL
output$plot <- renderPlot({
# here we duplicate table to manipulate it before rendering
# the reason for duplicate is that you dont want to affect your
# base data as it may be used elsewhere
# note that due to R's copy-on-write this may be expensive operation and
# have impact on app performance
# in all cases using data.table package is recommended to mitigate
# some of the CoW implications
render.data = rVals[['data']][rVals[['data']][['Species']] %in% c(rVals[['baseline']],input$rows),]
# here manipulate render.data
# and then continue with plot
ggplot(data=render.data,
aes(x=Petal.Width, y = as.numeric(Sepal.Width), colour = Species,group=Species)
) +
labs(x="Hypothetical X", y="Hypothetical X") +
geom_line()
})
observeEvent(input$base,{
rVals[['baseline']]=input$rows
})
observeEvent(input$reset,{
rVals[['baseline']]=NULL
})
}
shinyApp(ui, server)