This is my first question, so please be patient with me.
I am trying to pass a dataset into an interactive shiny plot.
Here is the gist of what I have on the server side.
sliceData<-reactive({
sData<-my_data() %>%
select(one_of(c(input$e1,input$e2,input$e3,input$e4,input$e5)))
return(sData)
})
vals <- reactiveValues(
keeprows = rep(TRUE, nrow(sliceData()))
)
IA_Plot<-reactive({
# Plot the kept and excluded points as two separate data sets
keep <- sliceData()[ vals$keeprows, , drop = FALSE]
exclude <- sliceData()[!vals$keeprows, , drop = FALSE]
IAP<-ggplot(keep, aes(input$e3, input$e4)) + geom_point() +
geom_smooth(method = lm, fullrange = TRUE, color = "black") +
geom_point(data = exclude, shape = 21, fill = NA, color = "black", alpha = 0.25) +
coord_cartesian(xlim = c(1.5, 5.5), ylim = c(5,35))
IAP
})
# Create single graph plot for interaction ----
output$sPlot <- renderPlot({
IA_Plot()
})
# Toggle points that are clicked ----
observeEvent(input$sPlot_click, {
res <- nearPoints(sliceData(), input$sPlot_click, allRows = TRUE)
vals$keeprows <- xor(vals$keeprows, res$selected_)
})
# Toggle points that are brushed, when button is clicked ----
observeEvent(input$exclude_toggle, {
res <- brushedPoints(sliceData(), input$sPlot_brush, allRows = TRUE)
vals$keeprows <- xor(vals$keeprows, res$selected_)
})
# Reset all points ----
observeEvent(input$exclude_reset, {
vals$keeprows <- rep(TRUE, nrow(sliceData()))
})
Here is the error I got from R Studio:
Warning: Error in .getReactiveEnvironment()$currentContext: Operation
not allowed without an active reactive context. (You tried to do
something that can only be done from inside a reactive expression or
observer.)
Could someone help me with what I am missing?
Thanks!!
Related
I am trying to use a logical vector from a reactive expression. This generates an error in a function xor() when I try to perform a logical operation on this vector in another reactive expression. I would like to generate a reactive expression (logical vector), and then use it in another reactive function. A toy example below. The error appears when points on the plot are clicked.
In the original here, keeprows() is not reactive, but I would like to make this structured as on the schematic below (from Shiny website). The fist object is input for a reactive expression, and then a second (reactive) object (which is a user-subsetted table) is used for point selection, etc. The elements after bifurcation are the tables with the kept and excluded points. I have a problem in making this last subsetting to work.
Could someone explain to me the root of this problem?
library(ggplot2)
library(shiny)
library(dplyr)
ui <- fluidPage(
fluidRow(
column(width = 6,
plotOutput("plot1", height = 350,
click = "plot1_click",
brush = brushOpts(
id = "plot1_brush"
)
),
actionButton("exclude_toggle", "Toggle points"),
sliderInput(inputId = "efficiency", value = 20, label = "MPG", min = min(mtcars$mpg), max = max(mtcars$mpg))
)
)
)
server <- function(input, output) {
# For storing which rows have been excluded
mt_subset <- reactive(mtcars %>% filter(mpg > input$efficiency))
vals <- reactiveValues()
vals$keeprows <- reactive(rep(TRUE, nrow(mt_subset()), label = "TuProblem", quoted = FALSE))
output$plot1 <- renderPlot({
# Plot the kept and excluded points as two separate data sets
keep <- mt_subset()[ vals$keeprows(), , drop = FALSE]
exclude <- mt_subset()[!vals$keeprows(), , drop = FALSE]
ggplot(keep, aes(wt, mpg)) + geom_point() +
geom_smooth(method = lm, fullrange = TRUE, color = "black") +
geom_point(data = exclude, shape = 21, fill = NA, color = "black", alpha = 0.25) +
coord_cartesian(xlim = c(1.5, 5.5), ylim = c(5,35))
})
# Toggle points that are clicked
observeEvent(input$plot1_click, {
res <- nearPoints(mt_subset(), input$plot1_click, allRows = TRUE)
vals$keeprows <- xor(as.logical(vals$keeprows()), as.logical(res$selected_))
})
# Toggle points that are brushed, when button is clicked
observeEvent(input$exclude_toggle, {
res <- brushedPoints(mt_subset(), input$plot1_brush, allRows = TRUE)
vals$keeprows <- xor(vals$keeprows(), res$selected_)
})
}
shinyApp(ui, server)
I'm not sure if this is the output you're looking for, but this code reads in a local file and then performs the brushing point selection, greying out the brushed points after "toggle points" is hit and also adjusting the correlation.
library(ggplot2)
library(Cairo) # For nicer ggplot2 output when deployed on Linux
library(shiny)
library(readxl)
data(iris)
write.xlsx(x = iris, file = "iris.xlsx")
ui <- fluidPage(
fluidRow(
fileInput(inputId = "file",
label = "Load file"),
column(width = 6,
plotOutput("plot1", height = 350,
click = "plot1_click",
brush = brushOpts(
id = "plot1_brush"
)
),
actionButton("exclude_toggle", "Toggle points"),
actionButton("exclude_reset", "Reset")
)
)
)
server <- function(input, output) {
# Get file
getFile <- reactive({ if (is.null(input$file)) {
return(NULL)
} else {
return(input$file)
}})
# Read data
data <- reactive({ if (is.null(getFile())) {
return(NULL)
} else {
as.data.frame(read_excel(getFile()$datapath))
}})
# For storing which rows have been excluded
vals <- reactiveValues()
observeEvent(data(), {
vals$keeprows <- rep(T, nrow(data()))
})
# Toggle points that are clicked
observeEvent(input$plot1_click, {
res <- nearPoints(data(), input$plot1_click, allRows = TRUE)
vals$keeprows <- xor(vals$keeprows, res$selected_)
})
# Toggle points that are brushed, when button is clicked
observeEvent(input$exclude_toggle, {
res <- brushedPoints(data(), input$plot1_brush, allRows = TRUE)
vals$keeprows <- xor(vals$keeprows, res$selected_)
})
# Reset all points
observeEvent(input$exclude_reset, {
vals$keeprows <- rep(TRUE, nrow(data()))
})
output$plot1 <- renderPlot({
if (is.null(data())) {
return(NULL)
} else {
# Indices for keep and exclude
keep_v <- which(vals$keeprows)
exclude_v <- which(!vals$keeprows)
# Subset data
keep <- data()[keep_v, , drop = F]
exclude <- data()[exclude_v, , drop = F]
ggplot(keep, aes(Sepal.Length, Sepal.Width)) + geom_point() +
geom_smooth(method = lm, fullrange = TRUE, color = "black") +
geom_point(data = exclude, shape = 21, fill = NA, color = "black", alpha = 0.25)
}
})
}
shinyApp(ui, server)
Solved:
library(ggplot2)
library(shiny)
library(dplyr)
ui <- fluidPage(
fluidRow(
column(width = 6,
plotOutput("plot1", height = 350,
click = "plot1_click",
brush = brushOpts(
id = "plot1_brush"
)
),
actionButton("exclude_toggle", "Toggle points"),
sliderInput(inputId = "efficiency", value = 20, label = "MPG", min = min(mtcars$mpg), max = max(mtcars$mpg))
)
)
)
server <- function(input, output) {
mt_subset <- reactive(mtcars %>% filter(mpg > input$efficiency))
vals <- reactiveValues()
observeEvent(mt_subset(), {
vals$keeprows <- rep(TRUE, nrow(mt_subset()), label = "TuProblem", quoted = FALSE)
})
output$plot1 <- renderPlot({
# Plot the kept and excluded points as two separate data sets
keep <- mt_subset()[ vals$keeprows, , drop = FALSE]
exclude <- mt_subset()[!vals$keeprows, , drop = FALSE]
ggplot(keep, aes(wt, mpg)) + geom_point() +
geom_smooth(method = lm, fullrange = TRUE, color = "black") +
geom_point(data = exclude, shape = 21, fill = NA, color = "black", alpha = 0.25) +
coord_cartesian(xlim = c(1.5, 5.5), ylim = c(5,35))
})
observeEvent(input$plot1_click, {
res <- nearPoints(mt_subset(), input$plot1_click, allRows = TRUE)
vals$keeprows <- xor(vals$keeprows, res$selected_)
})
observeEvent(input$exclude_toggle, {
res <- brushedPoints(mt_subset(), input$plot1_brush, allRows = TRUE)
vals$keeprows <- xor(vals$keeprows, res$selected_)
})
}
shinyApp(ui, server)
Based on this question, I found a nice example to remove points from a plot using ggplot2.
My question now is: once I delete a data point I would like to get rid of it permanently. The way it works now, every time the brush covers a coordinate where a deleted point was, that point comes back in. Any thoughts?
Example:
library(ggplot2)
library(Cairo) # For nicer ggplot2 output when deployed on Linux
ui <- fluidPage(
fluidRow(
column(width = 6,
plotOutput("plot1", height = 350,
click = "plot1_click",
brush = brushOpts(
id = "plot1_brush"
)
),
actionButton("exclude_toggle", "Toggle points"),
actionButton("exclude_reset", "Reset")
)
)
)
server <- function(input, output) {
# For storing which rows have been excluded
vals <- reactiveValues(
keeprows = rep(TRUE, nrow(mtcars))
)
output$plot1 <- renderPlot({
# Plot the kept and excluded points as two separate data sets
keep <- mtcars[ vals$keeprows, , drop = FALSE]
exclude <- mtcars[!vals$keeprows, , drop = FALSE]
ggplot(keep, aes(wt, mpg)) + geom_point() +
geom_smooth(method = lm, fullrange = TRUE, color = "black") +
geom_point(data = exclude, shape = 21, fill = NA, color = "black", alpha = 0.25) +
coord_cartesian(xlim = c(1.5, 5.5), ylim = c(5,35))
})
# Toggle points that are clicked
observeEvent(input$plot1_click, {
res <- nearPoints(mtcars, input$plot1_click, allRows = TRUE)
vals$keeprows <- xor(vals$keeprows, res$selected_)
})
# Toggle points that are brushed, when button is clicked
observeEvent(input$exclude_toggle, {
res <- brushedPoints(mtcars, input$plot1_brush, allRows = TRUE)
vals$keeprows <- xor(vals$keeprows, res$selected_)
})
# Reset all points
observeEvent(input$exclude_reset, {
vals$keeprows <- rep(TRUE, nrow(mtcars))
})
}
shinyApp(ui, server)
I have a question about the data selection of interactive toggle shiny app. I would like to make the data selected from selectInput but the error say: Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
Is there any way to make the data interactive with the input?
Thank you!
Here is my app:
app.r:
ui <- fluidPage(
fluidRow(
column(width = 6,
selectInput("vsselection", "Choose a vs:",
choices = names(table(data.frame(mtcars$vs))),selected=0),
plotOutput("plot1", height = 350,
click = "plot1_click",
brush = brushOpts(
id = "plot1_brush"
)
),
actionButton("exclude_toggle", "Toggle points"),
actionButton("exclude_reset", "Reset")
)
)
)
server <- function(input, output) {
# For storing which rows have been excluded
vals <- reactiveValues(
keeprows = rep(TRUE, nrow(mtcars[which(mtcars$vs==input$vsselection),]))
)
output$plot1 <- renderPlot({
# Plot the kept and excluded points as two separate data sets
keep <- mtcars[which(mtcars$vs==input$vsselection),][ vals$keeprows, , drop = FALSE]
exclude <- mtcars[which(mtcars$vs==input$vsselection),][!vals$keeprows, , drop = FALSE]
ggplot(keep, aes(wt, mpg)) + geom_point() +
geom_smooth(method = lm, fullrange = TRUE, color = "black") +
geom_point(data = exclude, shape = 21, fill = NA, color = "black", alpha = 0.25) +
coord_cartesian(xlim = c(1.5, 5.5), ylim = c(5,35))
})
# Toggle points that are clicked
observeEvent(input$plot1_click, {
res <- nearPoints(mtcars[which(mtcars$vs==input$vsselection),], input$plot1_click, allRows = TRUE)
vals$keeprows <- xor(vals$keeprows, res$selected_)
})
# Toggle points that are brushed, when button is clicked
observeEvent(input$exclude_toggle, {
res <- brushedPoints(mtcars[which(mtcars$vs==input$vsselection),], input$plot1_brush, allRows = TRUE)
vals$keeprows <- xor(vals$keeprows, res$selected_)
})
# Reset all points
observeEvent(input$exclude_reset, {
vals$keeprows <- rep(TRUE, nrow(mtcars[which(mtcars$vs==input$vsselection),]))
})
}
shinyApp(ui, server)
I guess the first thing you should to, is to change vals to vals <- reactive({...}) and then when referring to it, add parenthesis, e.g. vals()$keeprows. This should solve the reactivity problem.
Finally, I solved this issue by removing the interactive part from the object of reactiveValues() by keep the interactive part of Vals.
Note that values taken from the reactiveValues object are reactive, but the reactiveValues object itself is not.
Here is my app:
app.r:
ui <- fluidPage(
fluidRow(
column(width = 6,
selectInput("vsselection", "Choose a vs:",
choices = names(table(data.frame(mtcars$vs))),selected=0),
plotOutput("plot1", height = 350,
click = "plot1_click",
brush = brushOpts(
id = "plot1_brush"
)
),
actionButton("exclude_toggle", "Toggle points"),
actionButton("exclude_reset", "Reset")
)
)
)
server <- function(input, output) {
# For storing which rows have been excluded
vals <- reactiveValues(
keeprows = rep(TRUE, nrow(mtcars))
)
output$plot1 <- renderPlot({
# Plot the kept and excluded points as two separate data sets
keep <- mtcars[which(mtcars$vs==input$vsselection),][ vals$keeprows, , drop = FALSE]
exclude <- mtcars[which(mtcars$vs==input$vsselection),][!vals$keeprows, , drop = FALSE]
ggplot(keep, aes(wt, mpg)) + geom_point(color = "blue") +
geom_smooth(method = lm, fullrange = TRUE, color = "black") +
geom_point(data = exclude, shape = 21, fill = NA, color = "black", alpha = 0.25)
})
# Toggle points that are clicked
observeEvent(input$plot1_click, {
res <- nearPoints(mtcars[which(mtcars$vs==input$vsselection),], input$plot1_click, allRows = TRUE)
vals$keeprows <- xor(vals$keeprows, res$selected_)
})
# Toggle points that are brushed, when button is clicked
observeEvent(input$exclude_toggle, {
res <- brushedPoints(mtcars[which(mtcars$vs==input$vsselection),], input$plot1_brush, allRows = TRUE)
vals$keeprows <- xor(vals$keeprows, res$selected_)
})
# Reset all points
observeEvent(input$exclude_reset, {
vals$keeprows <- rep(TRUE, nrow(mtcars[which(mtcars$vs==input$vsselection),]))
})
}
Please run the reproducible code here first.
Here are two box plots created. The upper one is simple. The bottom one is a box plot with facet_grid.
The idea is to link them together. Brushing points in one of them will highlight the points and the ones in the other box plot.
Now, selecting points in one box plot seems not to be functioning well.
And the box plot with facet_grid even doesn't work with itself.
library(shiny)
library(ggplot2)
server <- function(input, session, output) {
mtcars$cyl = as.character(mtcars$cyl)
mtcars$gear = as.character(mtcars$gear)
vals <- reactiveValues( keeprows = FALSE)
observeEvent(input$brush_1,{
Res=brushedPoints(mtcars,input$brush_1,allRows = TRUE)
vals$keeprows = Res$selected_
})
observeEvent(input$brush_2,{
Res=brushedPoints(mtcars,input$brush_2,allRows = TRUE)
vals$keeprows = Res$selected_
})
output$table1 = renderPrint({
brushedPoints(mtcars,input$brush_1,allRows = TRUE)
})
output$table2 = renderPrint({
brushedPoints(mtcars,input$brush_2,allRows = TRUE)
})
output$plot_1 = renderPlot({
set.seed(123)
ggplot(mtcars,aes(x=cyl,y=mpg)) +
geom_boxplot(outlier.shape = NA) +
geom_jitter(aes(color=vals$keeprows),width=0.2)+
scale_color_manual(values = c("black","red"),guide=FALSE)
})
output$plot_2 = renderPlot({
set.seed(123)
ggplot(mtcars,aes(x=cyl,y=mpg)) +
facet_grid(.~gear)+
geom_boxplot(outlier.shape = NA) +
geom_jitter(aes(color=vals$keeprows),width=0.2)+
scale_color_manual(values = c("black","red"),guide=FALSE)
})
}
ui <- fluidPage(
plotOutput("plot_1",brush = brushOpts("brush_1",resetOnNew = FALSE)),
plotOutput("plot_2",brush = brushOpts("brush_2",resetOnNew = FALSE)),
splitLayout(verbatimTextOutput("table1"),verbatimTextOutput("table2"))
)
shinyApp(ui = ui, server = server)
I believe the key issue lies in the facet_grid function.
How can we make facet_grid work fine with brush.
Thanks.
I have built a Shiny app with a database backend -
Im trying to reload the dataframe current_data_frame and redraw the plot using it when input$draw_plot (action button) is pressed.
I am having trouble re-drawing the plot after recalling the data frame?
Any ideas what I am missing??
snippet from server.R
current_data_frame = data.frame(matrix(ncol = 4, nrow = 0))
names( current_data_frame ) <- c("sample_id", "call", "intensity_A" , "intensity_B")
# OBSERVE BUTTON PRESS & UPDATE DATA FRAME
observeEvent( input$draw_plot, {
current_data_frame <- get_data_frame( input$probeset_id , input$study_id , input$batch_id)
})
vals <- reactiveValues(
keeprows = rep(TRUE, nrow( current_data_frame ))
)
output$call_plot <- renderPlot({
# Lists for holding unactive_points
keep <- current_data_frame[ vals$keeprows, , drop = FALSE]
exclude <- current_data_frame[ !vals$keeprows, , drop = FALSE]
# Le plot
ggplot(keep, aes( intensity_A , intensity_B)) +
geom_point(aes(colour = factor(call), shape = factor(call)) ) #+
#geom_point(data = exclude, shape = 21 , fill = NA, colour = "black", alpha = 0.25)
})
# Toggle click points
observeEvent( input$call_plot_click, {
res <- nearPoints(current_data_frame, input$call_plot_click, allRows = TRUE)
vals$keeprows <- xor(vals$keeprows, res$selected_)
})
# Toggle points that are brushed when clicked
observeEvent(input$exclude_toggle, {
res <- brushedPoints(current_data_frame, input$call_plot_brush, allRows = TRUE)
vals$keeprows <- xor(vals$keeprows, res$selected_)
})
# Reset all points
observeEvent( input$exclude_reset, {
vals$keeprows <- rep( TRUE, nrow(current_data_frame))
})
})
You probably need to make current_data_frame a reactive value. You can either do that by returning it inside of a reactive or by adding it to your vals object, including using vals$current_data_frame everywhere you currently use current_data_frame and changing vals to look something like this:
vals <- reactiveValues(keeprows = rep(TRUE, nrow( current_data_frame )),
current_data_frame = current_data_frame
)
which will set vals$current_data_frame to the default you defined at the start of your code the first time, then allow you to change it every time the observeEvent is triggered.
Managed to answer this myself -
Wrapped the whole output$call_plot in the response function. Now it redraws + fetches new data each time the button is pressed.
Code below...
observeEvent( input$draw_plot, {
current_data_frame <- get_data_frame( input$probeset_id , input$study_id , input$batch_id)
vals <- reactiveValues(
keeprows = rep(TRUE, nrow( current_data_frame ))
)
output$call_plot <- renderPlot({
# Lists for holding unactive_points
keep <- current_data_frame[ vals$keeprows, , drop = FALSE]
exclude <- current_data_frame[ !vals$keeprows, , drop = FALSE]
# Le plot
ggplot(keep, aes( intensity_A , intensity_B)) +
geom_point(aes(colour = factor(call), shape = factor(call)) ) #+
#geom_point(data = exclude, shape = 21 , fill = NA, colour = "black", alpha = 0.25)
})
# Toggle click points
observeEvent( input$call_plot_click, {
res <- nearPoints(current_data_frame, input$call_plot_click, allRows = TRUE)
vals$keeprows <- xor(vals$keeprows, res$selected_)
})
# Toggle points that are brushed when clicked
observeEvent(input$exclude_toggle, {
res <- brushedPoints(current_data_frame, input$call_plot_brush, allRows = TRUE)
vals$keeprows <- xor(vals$keeprows, res$selected_)
})
# Reset all points
observeEvent( input$exclude_reset, {
vals$keeprows <- rep( TRUE, nrow(current_data_frame))
})
})
})