Below is functioning code for a basic shiny app that allows the user to pick a column and then plots a ggplot::histogram() of the selected column:
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
titlePanel("ggplot"),
sidebarLayout(
sidebarPanel(
uiOutput("column_select")
),
mainPanel(plotOutput("plot"))
)
)
# Define server logic required to draw a histogram
server <- function(input, output){
dat <- reactive({iris})
output$column_select <- renderUI({selectInput("col", label = "column", choices = as.list(names(iris)), selected = "Sepal.Length")})
output$plot <- renderPlot({ggplot(dat(), aes_string(x = input$col)) +
geom_histogram()})
p <- ggplot(dat(), aes_string(x = input$col)) +
geom_histogram()
renderPlot
}
# Run the application
shinyApp(ui = ui, server = server)
I am not sure, however, why I am unable to remove the ggplot() function from within renderPlot() and still get the same result. I have tried:
p <- reactive({ggplot(dat(), aes_string(x = input$col)) +
geom_histogram()})
outputPlot <- renderPlot({p})
But this results in no plot being drawn.
I assume there is a simple fix to this, but thus far it escapes me.
Related
I am using a brushed histogram to query samples in a shiny app. In my full application, I overlay a new histogram that highlights the selected region and update a DT data table showing properties of the filtered samples.
I've noticed that a reactive that depends on the brush gets called twice each time I move it. For example, the table_data reactive below gets called twice each time I brush the histogram.
app.R
library(ggplot2)
library(shiny)
df <- data.frame(x = rnorm(1000))
base_histogram <- ggplot(df, aes(x)) +
geom_histogram(bins = 30)
# Define UI for application that draws a histogram
ui <- fluidPage(
column(
plotOutput("histogram", brush = brushOpts(direction = "x", id = "brush", delay=500, delayType = "debounce")),
width = 6
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$histogram <- renderPlot({
p <- base_histogram
current <- table_data()
if (nrow(current) > 0) {
p <- p + geom_histogram(data = current, fill = "red", bins = 30)
}
p
})
table_data <- reactive({
print("called")
brushedPoints(df, input$brush)
})
}
# Run the application
shinyApp(ui = ui, server = server)
In this toy example, it's barely noticeable. But in my full app, a heavy calculation has to be done within the table_data reactive, and this the double call is unnecessarily slowing everything down.
Is there any way to structure the app so that the reactive only executes once whenever a brush is ended?
Here is a GIF that shows that the table_data is being executed twice per brush.
try this, only trigger once on each brush movement.
library(ggplot2)
library(shiny)
df <- data.frame(x = rnorm(1000))
base_histogram <- ggplot(df, aes(x)) +
geom_histogram(bins = 30)
# Define UI for application that draws a histogram
ui <- fluidPage(
column(
plotOutput("histogram", brush = brushOpts(direction = "x", id = "brush", delay=500, delayType = "debounce")),
width = 6
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$histogram <- renderPlot({
p <- base_histogram
if(!is.null(table_data())) {
p <- p + geom_histogram(data = table_data(), fill = "red", bins = 30)
}
p
})
table_data <- reactive({
if(is.null(input$brush)) return()
print("called")
brushedPoints(df, input$brush)
})
}
shinyApp(ui, server)
For the first time I really can't find this answer here already, so I hope you all can help me, I'm sure there is a pretty easy fix.
I am making a Shiny volcano plot with clickable points to give me a table with the data about that point. If I use a trans function (that I found here, thank you helpful stranger) within scale_y_continuous() in my plot, points in the scaled region are no longer clickable. How can I scale the axis this way and still be able to have the clickable points?
My code, with some fake data that has the same problem:
## Read in necessary libraries, function, and data
library(shiny)
library(ggplot2)
library(dplyr)
library(scales)
reverselog_trans <- function(base = exp(1)) {
trans <- function(x) -log(x, base)
inv <- function(x) base^(-x)
trans_new(paste0("reverselog-", format(base)), trans, inv,
log_breaks(base = base),
domain = c(1e-100, Inf))
}
pretend_data <- tibble(data=1:5, estimate = runif(5, min = -1, max = 2), plot = c(1e-50, 2e-35, 5e-1, 1, 50))
# Define UI for application that draws a volcano plot
ui <- fluidPage(
# Application title
titlePanel("Pretend Plot"),
plotOutput("plot", click = "plot_click"),
tableOutput("data")
)
# Define server logic required to draw a volcano plot
server <- function(input, output, session) {
output$plot <- renderPlot({
ggplot(data = pretend_data, aes(x=estimate, y=plot)) +
geom_vline(xintercept=c(-1, 1), linetype=3) +
geom_hline(yintercept=0.01, linetype=3) +
geom_point() +
scale_y_continuous(trans = reverselog_trans(10))
}, res = 96)
output$data <- renderTable({
req(input$plot_click)
nearPoints(pretend_data, input$plot_click)
})
}
# Run the application
shinyApp(ui = ui, server = server)
The problem is that input$plot_click returns the coordinates on the transformed scale. nearPoints tries then to match those to the original scale which does not work.
You have a couple of options though:
Transform the data yourself and adapt y axis ticks via scale_y_continuous
Adapt pretend_data in the nearPoints call.
Option 1
This requires that you control y axis tick marks yourself and would need some more fiddling to get the exact same reuslts as in your example.
pretend_data_traf <- pretend_data %>%
mutate(plot = reverselog_trans(10)$transform(plot))
# Define UI for application that draws a volcano plot
ui <- fluidPage(
# Application title
titlePanel("Pretend Plot"),
plotOutput("plot", click = "plot_click"),
tableOutput("data")
)
# Define server logic required to draw a volcano plot
server <- function(input, output, session) {
output$plot <- renderPlot({
ggplot(data = pretend_data_traf, aes(x=estimate, y=plot)) +
geom_vline(xintercept=c(-1, 1), linetype=3) +
geom_hline(yintercept=0.01, linetype=3) +
geom_point() +
## would need to define breaks = to get same tick mark positions
scale_y_continuous(labels = reverselog_trans(10)$inverse)
}, res = 96)
output$data <- renderTable({
req(input$plot_click)
nearPoints(pretend_data_traf, input$plot_click)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Option 2
pretend_data_traf <- pretend_data %>%
mutate(plot = reverselog_trans(10)$transform(plot))
# Define UI for application that draws a volcano plot
ui <- fluidPage(
# Application title
titlePanel("Pretend Plot"),
plotOutput("plot", click = "plot_click"),
tableOutput("data")
)
# Define server logic required to draw a volcano plot
server <- function(input, output, session) {
output$plot <- renderPlot({
ggplot(data = pretend_data, aes(x=estimate, y=plot)) +
geom_vline(xintercept=c(-1, 1), linetype=3) +
geom_hline(yintercept=0.01, linetype=3) +
geom_point() +
scale_y_continuous(trans = reverselog_trans(10))
}, res = 96)
output$data <- renderTable({
req(input$plot_click)
nearPoints(pretend_data_traf, input$plot_click) %>%
mutate(plot = reverselog_trans(10)$inverse(plot))
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have imported the dataset = students for generating the reactive plots but proper plot is not generated .I am using ggplot for plots so could you
please tell me whats wrong in my code.
library(shiny)
library(ggplot2)
ui <- navbarPage("A SHINY APP!! ",
tabPanel("Plots",headerPanel("Different plots of data"),
sidebarLayout(
sidebarPanel(
selectInput("x.col","x.variable",choices=names(students))
),
mainPanel(plotOutput("histPlot")))
)
)
server <- function(input, output) {
plot <- reactive({ ggplot(students,aes(x=input$x.col))
})
output$histPlot <- renderPlot({
plot() + geom_histogram(stat = "count",bins = 30)
})
}
shinyApp(ui = ui, server = server
Try with get() function like the following:
ggplot(students, aes(x = get(input$x.col)))
When the shiny app below is run I initially get the error - invalid type/length (symbol/0) in vector allocation. However, as soon as I click "Submit" the app functions as intended.
Is there a way to avoid this launch error and have it work correctly from the start?
plot_and_summary <- function(dat, col){
summary <- dat %>% summarize_(mean = interp(~mean(x), x = as.name(col)),
sd = interp(~sd(x), x = as.name(col)))
plot <- ggplot(dat, aes_string(x = col)) + geom_histogram()
return(list(summary = summary, plot = plot))
}
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
titlePanel(""),
sidebarLayout(
sidebarPanel(
uiOutput("column_select"),
submitButton("Submit")
),
mainPanel(
tableOutput("summary"),
plotOutput("plot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output){
dat <- reactive({iris})
output$column_select <- renderUI({selectInput("col", label = "select column", choices = as.list(names(dat())))})
pas <- reactive({plot_and_summary(dat(), input$col)})
output$plot <- renderPlot({pas()$plot})
output$summary <- renderTable({pas()$summary})
}
shinyApp(ui = ui, server = server)
The req function should solve your problem
http://shiny.rstudio.com/reference/shiny/latest/req.html
pas <- reactive({plot_and_summary(dat(), req(input$col))})
I am building a Shiny app that helps user to create pie chart with ggplot2 on their own. Therefore, it would have a selector input for user to select variables from different dataframes. I was stuck with the input$ statements, it seemed that Shiny took the input$ with double quotes as a character, instead of a variable. Below is a simplified version of code, kindly let me know how to fix this. Thanks in advance!
library(ggplot2)
server <- function(input, output) {
output$var_selector <- renderUI({
selectInput('var_selector', 'Please select:', choices = names(mtcars))
})
output$pie_plot <- renderPlot({
ggplot(mtcars, aes(x = factor(1), fill = factor(input$var_selector))) + geom_bar(width = 1) + coord_polar(theta = "y")
})
output$text <- renderText({
print(input$var_selector)
})
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
h3('ggplot2 pie chart'),
uiOutput('var_selector')
),
mainPanel(
plotOutput('pie_plot')
)
)
)
shinyApp(ui = ui, server = server)