Related
I am trying to make a Shiny app that I can toggle a table on the graph. Sometimes the values on the graph will be covered by the table, so this is the solution I thought of.
I cannot figure out how to format the if statement in the ggplot setup to make the table toggle. I included the entire example code below with two different attempts where the toggle does not accomplish anything. What is the correct way to code the toggle?
Alternatively, if there is a better way to avoid the table overlapping the data issue please let me know.
library(shiny)
library(ggplot2)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
checkboxInput("checkbox",label = "Graph legend on/off (not working yet)", value = TRUE)
),
mainPanel(
verbatimTextOutput("value"),
plotOutput("p")
)))
server <- function(input, output) {
output$value <- renderText({input$checkbox})
xvalues <- 1:5
yvalues <- round(runif(5),2)
graphableDF <- data.frame(xvalues, yvalues)
mytable <- cbind(X = xvalues,Y = yvalues)
# You can comment this and uncomment the next if statement to see what the goal is
# output$p <- renderPlot({
# p <- ggplot(graphableDF, aes(x=xvalues, y=yvalues)) +
# geom_line(color="black") +
# ylim(0,1) +
# annotation_custom(tableGrob(mytable), xmin = 4.5, ymin = .65)
# p
# })
#Currently, this entire section does nothing even if the button is toggled
# if (renderText({input$checkbox}) = TRUE) {
# output$p <- renderPlot({
# p <- ggplot(graphableDF, aes(x=xvalues, y=yvalues)) +
# geom_line(color="grey") +
# ylim(0,1) +
# annotation_custom(tableGrob(mytable), xmin = 4.5, ymin = .65)
# p
# })}else{
# output$p <- renderPlot({
# p <- ggplot(graphableDF, aes(x=xvalues, y=yvalues)) +
# geom_line(color="grey") +
# ylim(0,1)
# p
# })}
#Also does not work
# output$p <- renderPlot({
# p <- ggplot(graphableDF, aes(x=xvalues, y=yvalues)) +
# geom_line(color="black") +
# ylim(0,1) +
# if (renderText({input$checkbox}) = TRUE) {
# annotation_custom(tableGrob(mytable), xmin = 4.5, ymin = .65)
# }
# p
# })
}
shinyApp(ui, server)
Try this
library(shiny)
library(ggplot2)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
checkboxInput("checkbox",label = "Graph legend on/off", value = TRUE)
),
mainPanel(
verbatimTextOutput("value"),
plotOutput("p")
)))
server <- function(input, output) {
output$value <- renderText({input$checkbox})
xvalues <- 1:5
yvalues <- round(runif(5),2)
graphableDF <- data.frame(xvalues, yvalues)
mytable <- cbind(X = xvalues,Y = yvalues)
# works fine
output$p <- renderPlot({
p <- ggplot(graphableDF, aes(x=xvalues, y=yvalues)) +
geom_line(color="black") +
{if (input$checkbox) annotation_custom(tableGrob(mytable), xmin = 4.5, ymin = .65) } +
ylim(0,1) + xlim(1,5.7)
p
})
}
shinyApp(ui, server)
I am trying to update text and plot both with ActionButton click.
My Attempt-
library(shiny)
library(ggplot2)
library(shinyWidgets)
ui <- fluidPage(
actionGroupButtons(
inputIds = c("Bar", "Histogram", "Line"),
labels = list("Bar", "Histogram","Line"),
status = "danger",
fullwidth = T
),
plotOutput('plot',height = '563px'),
verbatimTextOutput('text')
)
server <- function(input, output) {
output$plot <- renderPlot({
if(req(input$Bar)!=0) {
isolate({
data <- iris
ggplot(data, aes(Species,Petal.Length)) +
geom_bar(stat="identity")
})
} else if(req(input$Histogram)>0){
isolate({
data <- iris
ggplot(data, aes(Petal.Length)) +
geom_histogram()
})
} else if(req(input$Line)>0){
isolate({
data <- iris
ggplot(data, aes(Petal.Length,Sepal.Length)) +
geom_line()
})
}
})
output$text <- renderText({
if(req(input$Bar)!=0) {
"Bar"
} else if(req(input$Histogram)>0){
"Histogram"
} else if(req(input$Line)>0){
"Line"
}
})
}
shinyApp(ui, server)
I want to change plot and text when the appropriate action button is clicked.
Here would be one way to do it.
In it's essence the approach is pointed out in the action button example no. 3 from RStudio.
library(shiny)
library(ggplot2)
library(shinyWidgets)
ui <- fluidPage(
actionGroupButtons(
inputIds = c("Bar", "Histogram", "Line"),
labels = list("Bar", "Histogram","Line"),
status = "danger",
fullwidth = T
),
plotOutput('plot',height = '563px'),
verbatimTextOutput('text')
)
server <- function(input, output) {
v <- reactiveValues(data = iris,
plot = NULL,
text = NULL)
observeEvent(input$Bar, {
v$plot <- ggplot(v$data, aes(Species,Petal.Length)) +
geom_bar(stat="identity")
v$text <- "Bar"
})
observeEvent(input$Histogram, {
data <- iris
v$plot <- ggplot(v$data, aes(Petal.Length)) +
geom_histogram()
v$text <- "Histogram"
})
observeEvent(input$Line, {
data <- iris
v$plot <- ggplot(v$data, aes(Petal.Length,Sepal.Length)) +
geom_line()
v$text <- "Line"
})
output$plot <- renderPlot({
if (is.null(v$plot)) return()
v$plot
})
output$text <- renderText({
if (is.null(v$text)) return()
v$text
})
}
shinyApp(ui, server)
Update
In case you are using Input filters on your data in a reactive, then you have to adjust the Approach above a litte:
library(shiny)
library(ggplot2)
library(shinyWidgets)
ui <- fluidPage(
selectInput(inputId = "species", label = "Select species:",
choices = unique(as.character(iris$Species)),
selected = "setosa"),
sliderInput("sepal_length", "Limit sepal length:",
round = 0,
min = range(iris$Sepal.Length)[1], max = range(iris$Sepal.Length)[2],
range(iris$Sepal.Length),
step = 0.1),
actionGroupButtons(
inputIds = c("Bar", "Histogram", "Line"),
labels = list("Bar", "Histogram","Line"),
status = "danger",
fullwidth = T
),
plotOutput('plot',height = '563px'),
verbatimTextOutput('text')
)
server <- function(input, output) {
data <- reactive({
temp <- subset(iris, Species == input$species)
subset(temp, Sepal.Length < input$sepal_length)
})
v <- reactiveValues(plot = NULL,
text = NULL)
observeEvent(input$Bar, {
v$plot <- ggplot(data(), aes(Species,Petal.Length)) +
geom_bar(stat="identity")
v$text <- "Bar"
})
observeEvent(input$Histogram, {
v$plot <- ggplot(data(), aes(Petal.Length)) +
geom_histogram()
v$text <- "Histogram"
})
observeEvent(input$Line, {
v$plot <- ggplot(data(), aes(Petal.Length,Sepal.Length)) +
geom_line()
v$text <- "Line"
})
output$plot <- renderPlot({
if (is.null(v$plot)) return()
v$plot
})
output$text <- renderText({
if (is.null(v$text)) return()
v$text
})
}
shinyApp(ui, server)
Running the below code as a app.r renders a ggplotly for p2 in a shiny app, but not p1, though p1 does render in the RStudio plot pane. I want to be able to get plotly plots of p1 and p2 in the app and on Shiny. What am I missing?
library(shiny)
library(plotly)
library(ggplot2)
x <- seq(1:100)
y <- rnorm(100)
df <- data.frame(x,y)
p1 <- ggplot(df, aes(x,y)) + geom_line()
p2 <- ggplot(df, aes(x,y)) + geom_point()
ui <- fluidPage(
fluidRow(
column(width=8,
radioButtons("radioInput", "Radio Button Header", choices =
c("name of plot 1 for user" = "plot 1",
"name of plot 2 for user" = "plot 2"
) )
)
),
plotlyOutput("distPlot", height="700px")
)
server <- function(input, output) {
output$distPlot <- renderPlotly({
if (input$radioInput == "plot 1") {
p1 <- ggplotly(p1)
print(p1)}
if (input$radioInput == "plot 2") {
p2 <- ggplotly(p2)
print(p2)}
})
}
shinyApp(ui = ui, server = server)
Without plotly (removing ggplotly calls and changing plotlyOutput back to plotOutput, and renderPlotly back to renderPlot), Shiny plots both:
library(shiny)
library(plotly)
library(ggplot2)
x <- seq(1:100)
y <- rnorm(100)
df <- data.frame(x,y)
p1 <- ggplot(df, aes(x,y)) + geom_line()
p2 <- ggplot(df, aes(x,y)) + geom_point()
ui <- fluidPage(
fluidRow(
column(width=8,
radioButtons("radioInput", "Radio Button Header", choices =
c("name of plot 1 for user" = "plot 1",
"name of plot 2 for user" = "plot 2"
) )
)
),
plotOutput("distPlot", height="700px")
)
server <- function(input, output) {
output$distPlot <- renderPlot({
if (input$radioInput == "plot 1") {
print(p1) }
if (input$radioInput == "plot 2") {
print(p2)}
})
}
shinyApp(ui = ui, server = server)
You're missing an else if:
library(shiny)
library(plotly)
library(ggplot2)
x <- seq(1:100)
y <- rnorm(100)
df <- data.frame(x,y)
p1 <- ggplot(df, aes(x,y)) + geom_line()
p2 <- ggplot(df, aes(x,y)) + geom_point()
ui <- fluidPage(
fluidRow(
column(width=8,
radioButtons("radioInput", "Radio Button Header", choices =
c("name of plot 1 for user" = "plot 1",
"name of plot 2 for user" = "plot 2"
) )
)
),
plotlyOutput("distPlot", height="700px")
)
server <- function(input, output) {
output$distPlot <- renderPlotly({
if (input$radioInput == "plot 1") {
p1 <- ggplotly(p1)
print(p1) }
else if (input$radioInput == "plot 2") {
p2 <- ggplotly(p2)
print(p2)}
})
}
shinyApp(ui = ui, server = server)
I'm new here as a user but I have searched like crazy for a problem I have encountered while trying to create a data visualization app with shiny in Rstudio.
The thing is, I want to read a .csv, understand it's columns, select wich column I want as x and as y axis, plot them with the type of graph I have chosen and be able to zoom in in a secondary plot whenever I want.
I'm almost there, the thing is that the zoom with brush that I have tried to do is no working properly. It doesn't understand the values of the axis correctly, instead it works as if both axis where only from 0 to 1, and then zoom in the correct way but with the wrong xlim and ylim.
Here is my ui.R:
library(shiny)
library(ggplot2)
base = read.csv("TESTE.csv", sep = ";")
tipos <- c("Dispersão", "Histograma", "Boxplot", "Área")
shinyUI(fluidPage(
titlePanel("MGM"),
sidebarLayout(
sidebarPanel(
selectInput("selectedColX", "Select colum for X axis", choices = colnames(base), selected = colnames(base)[7]),
selectInput("selectedColY", "Select colum for Y axis", choices = colnames(base), selected = colnames(base)[4]),
selectInput("selectedColor", "Select colum for colour axis", choices = colnames(base), selected = colnames(base)[6]),
selectInput("seletedGraph", "Select type of graph", choices = tipos, selected = tipos[1])
),
fluidRow(
column(width = 12, class = "well",
h4("Left plot controls right plot"),
fluidRow(
column(width = 10,
plotOutput("Disp", height = 300,
brush = brushOpts(
id = "Disp_brush",
clip = TRUE,
resetOnNew = TRUE
)
)
),
column(width = 10,
plotOutput("DispZoom", height = 300)
)
)
)
)
# mainPanel(
#
# plotOutput("Hist"),
# plotOutput("Box"),
# plotOutput("Ar")
# )
)
))
And then my Server.R:
library(shiny)
library(ggplot2)
base = read.csv("TESTE.csv", sep = ";")
tipos <- c("Dispersão", "Histograma", "Boxplot", "Área")
shinyServer(function(input, output) {
output$Disp <- renderPlot({
validate(need(input$seletedGraph=="Dispersão", message=FALSE))
y_axis <- input$selectedColY
x_axis <- input$selectedColX
color_axis <- input$selectedColor
gg <- ggplot(base, aes_string(x = x_axis, y = y_axis, color = color_axis))
gg <- gg + geom_point()
plot(gg)
})
ranges2 <- reactiveValues(x = NULL, y = NULL)
output$DispZoom <- renderPlot({
validate(need(input$seletedGraph=="Dispersão", message=FALSE))
y_axis <- input$selectedColY
x_axis <- input$selectedColX
color_axis <- input$selectedColor
gg <- ggplot(base, aes_string(x = x_axis, y = y_axis, color = color_axis)) + geom_point() + coord_cartesian(xlim = ranges2$x, ylim = ranges2$y)
plot(gg)
})
output$Hist <- renderPlot({
validate(need(input$seletedGraph=="Histograma", message=FALSE))
y_axis <- input$selectedColY
x_axis <- input$selectedColX
color_axis <- input$selectedColor
gg <- ggplot(base, aes_string(x = x_axis))
gg <- gg + geom_histogram()
gg
})
output$Box <- renderPlot({
validate(need(input$seletedGraph=="Boxplot", message=FALSE))
y_axis <- input$selectedColY
x_axis <- input$selectedColX
color_axis <- input$selectedColor
gg <- ggplot(base, aes_string(x = x_axis, y = y_axis, color = color_axis))
gg <- gg + geom_boxplot()
gg
})
output$Ar <- renderPlot({
validate(need(input$seletedGraph=="Área", message=FALSE))
y_axis <- input$selectedColY
x_axis <- input$selectedColX
color_axis <- input$selectedColor
gg <- ggplot(base, aes_string(x = x_axis, y = y_axis, color = color_axis))
gg <- gg + geom_area()
gg
})
observe({
brush <- input$Disp_brush
if (!is.null(brush)) {
ranges2$x <- c(brush$xmin, brush$xmax)
ranges2$y <- c(brush$ymin, brush$ymax)
} else {
ranges2$x <- NULL
ranges2$y <- NULL
}
})
})
Just ignore the other plots that are not the geom_point. As soon as I get this one working the others should work just fine, I guess...
Thank you so much, I'm having such a pain trying to figure this out!
Some texts are in portuguese, but I think everything is understandable enough.
Your brushed points are on scale from 0 to 1 in the brushOpts because you print or plot your variable instead of just returning it.
1. Short desmonstration
This short app show the difference between the brushed points scales according to how it has been returned.
library(shiny)
ui <- fluidPage(
fluidRow(
column(6,
# My plot rendering with print or plot
h4("Plot with print or plot variable"),
plotOutput("plot1", height = 300, brush = brushOpts(id = "plot1_brush", clip = TRUE, resetOnNew = TRUE)),
p(),
# Brushed points
"Brushed points informations, scale from 0 to 1",
verbatimTextOutput("brush1")
),
column(6,
# My plot rendering without print or plot
h4("Plot with a return variable"),
plotOutput("plot2", height = 300, brush = brushOpts(id = "plot2_brush", clip = TRUE, resetOnNew = TRUE)),
p(),
# Brushed points
"Brushed points informations, scale according to x and y variables",
verbatimTextOutput("brush2")
)
)
)
server <- function(input, output) {
data <- iris
# Plot1 I render with print or plot
output$plot1 <- renderPlot({
gg <- ggplot(data, aes(x = Sepal.Length, y = Petal.Length, color = Species)) + geom_point()
plot(gg)
})
# Brush points from plot1
output$brush1 <- renderPrint({
input$plot1_brush
})
# Plot2 I render just returning the variable
output$plot2 <- renderPlot({
gg <- ggplot(data, aes(x = Sepal.Length, y = Petal.Length, color = Species)) + geom_point()
return(gg)
})
# Brush points from plot2
output$brush2 <- renderPrint({
input$plot2_brush
})
}
shinyApp(ui = ui, server = server)
2. Reproductible example from your question
Herebelow I made a reproductible example using the iris dataset.
Also, I changed some characters because of accents.
ui.R
library(shiny)
library(ggplot2)
shinyUI(fluidPage(
titlePanel("MGM"),
sidebarLayout(
sidebarPanel(
uiOutput("plots_parameters")
),
mainPanel(
fluidRow(
column(12,
h4("Plot without zoom"),
plotOutput("Disp", height = 300, brush = brushOpts(id = "Disp_brush", clip = TRUE, resetOnNew = TRUE))
)
),
fluidRow(
column(12,
h4("Zoomed plot"),
plotOutput("DispZoom", height = 300)
)
)
)
)
))
server.R
library(shiny)
library(ggplot2)
base = iris
shinyServer(function(input, output) {
output$plots_parameters <- renderUI({
tipos <- c("Dispersao", "Histograma", "Boxplot", "Área")
choices <- colnames(base)
div(
selectInput("selectedColX", "Select colum for X axis", choices = choices, selected = "Sepal.Length"),
selectInput("selectedColY", "Select colum for Y axis", choices = choices, selected = "Petal.Length"),
selectInput("selectedColor", "Select colum for colour axis", choices = choices, selected = "Species"),
selectInput("seletedGraph", "Select type of graph", choices = tipos, selected = "Dispersao")
)
})
output$Disp <- renderPlot({
req(input$seletedGraph == "Dispersao")
y_axis <- input$selectedColY
x_axis <- input$selectedColX
color_axis <- input$selectedColor
gg <- ggplot(base, aes_string(x = x_axis, y = y_axis, color = color_axis))
gg <- gg + geom_point()
# Return variable without print or plot
gg
})
ranges2 <- reactiveValues(x = NULL, y = NULL)
output$DispZoom <- renderPlot({
req(input$seletedGraph == "Dispersao")
y_axis <- input$selectedColY
x_axis <- input$selectedColX
color_axis <- input$selectedColor
gg <- ggplot(base, aes_string(x = x_axis, y = y_axis, color = color_axis)) + geom_point() +
coord_cartesian(xlim = ranges2$x, ylim = ranges2$y)
# Return variable without print or plot
gg
})
observe({
brush <- input$Disp_brush
if (!is.null(brush)) {
ranges2$x <- c(brush$xmin, brush$xmax)
ranges2$y <- c(brush$ymin, brush$ymax)
} else {
ranges2$x <- NULL
ranges2$y <- NULL
}
})
})
In a shiny plot I am trying to highlight points matching a clicked point (based on nearPoints() and click).
It sort of works. However, the reactive parts of the shiny app are refreshed twice and the second iteration seems to clear the clicked information.
How can I avoid the second refresh of the app?
Here is the MWE:
library("Cairo")
library("ggplot2")
library("shiny")
ui <- fluidPage(
fluidRow(
titlePanel('Phenotype Plots')
),
fluidRow(
uiOutput("plotui")
),
hr(),
fluidRow(
wellPanel(
h4("Selected"),
tableOutput("info_clicked")
##dataTableOutput("info_clicked") ## overkill here
)
)
)
server <- function(input, output, session) {
selected_line <- reactive({
nearPoints(mtcars, input$plot_click,
maxpoints = 1,
addDist = TRUE)
})
output$plotui <- renderUI({
plotOutput("plot", height=600,
click = "plot_click"
)
})
output$plot <- renderPlot({
p <- ggplot(mtcars) +
facet_grid(am ~ cyl) +
theme_bw() +
geom_point(aes(x=wt, y=mpg))
sline <- selected_line()
if (nrow(sline) > 0) {
p <- p +
geom_point(aes(x=wt, y=mpg),
data=mtcars[mtcars$gear == sline$gear,],
colour="darkred",
size=1)
}
p
})
##output$info_clicked <- renderDataTable({
output$info_clicked <- renderTable({
res <- selected_line()
## datatable(res)
res
})
}
shinyApp(ui, server)
Finally(!) found a workaround for avoiding double refresh on click in Shiny: capture click to a reactiveValue(), using the observeEvent(). Seemingly works on my project, and for your MWE, too. See updated code section below.
library("Cairo")
library("ggplot2")
library("shiny")
ui <- fluidPage(
fluidRow(
titlePanel('Phenotype Plots')
),
fluidRow(
uiOutput("plotui")
),
hr(),
fluidRow(
wellPanel(
h4("Selected"),
tableOutput("info_clicked")
##dataTableOutput("info_clicked") ## overkill here
)
)
)
server <- function(input, output, session) {
## CHANGE HERE
## Set up buffert, to keep the click.
click_saved <- reactiveValues(singleclick = NULL)
## CHANGE HERE
## Save the click, once it occurs.
observeEvent(eventExpr = input$plot_click, handlerExpr = { click_saved$singleclick <- input$plot_click })
## CHANGE HERE
selected_line <- reactive({
nearPoints(mtcars, click_saved$singleclick, ## changed from "input$plot_click" to saved click.
maxpoints = 1,
addDist = TRUE)
})
output$plotui <- renderUI({
plotOutput("plot", height=600,
click = "plot_click"
)
})
output$plot <- renderPlot({
p <- ggplot(mtcars) +
facet_grid(am ~ cyl) +
theme_bw() +
geom_point(aes(x=wt, y=mpg))
sline <- selected_line()
if (nrow(sline) > 0) {
p <- p +
geom_point(aes(x=wt, y=mpg),
data=mtcars[mtcars$gear == sline$gear,],
colour="darkred",
size=1)
}
p
})
##output$info_clicked <- renderDataTable({
output$info_clicked <- renderTable({
res <- selected_line()
## datatable(res)
res
})
}
shinyApp(ui, server)