For simplicity I will only include the parts of the code that I am having issues with. This code pulls a large data set from a data base and creates tabs with different analyses. I am having issues with making my x variable reactive for ggplot graphs. If I define the x variable inside aes() the plot shows up fine but once I create a reactive input that substitutes my variable then ggplot has troubles defining the x variable. The variables I want to be able to switch are: "assay_plate_label" and "assay_read_on" from my data set.
ui.r
library(shiny)
shinyUI(fluidPage(
# Header or Title Panel
titlePanel(title = h4("HTS QC analysis", align="center")),
sidebarLayout(
# Sidebar panel
sidebarPanel(
numericInput("pg_number", "Plate Group", 4552),
actionButton('process', 'Process Plate Group Data')
),
# Main Panel
mainPanel(
tabsetPanel(type="tab",
tabPanel("Box Plot All",
selectInput('x_axis', "Choose the X axis", choices= c("Assay Plate Label"= "assay_plate_label", "Assay Date"= "assay_read_on")),
plotOutput("deviation"))
)
)
)
)
)
server.r
shinyServer(function(input, output){
x_label <- reactive({
switch(input$x_axis,
"assay_plate_label" = assay_plate_label,
"assay_read_on"= assay_read_on)
})
read.csv("table_na")
[Here is a sample of the data with the variables I use in this plot ][1]
output$deviation <- renderPlot({
table_na$assay_plate_label <- as.character(table_na$assay_plate_label)
ggplot(table_na, aes(x_label(), y=raw_assay_value, group=as.character(x_label()))) +
geom_boxplot() +
theme(axis.text.x = element_text(angle = 90, hjust = 3, vjust= 0)) +
xlab("Plate Label")+
ylab(table_na$plate_type_name)+
geom_boxplot(outlier.colour = "red", outlier.size= 1.5)+
ggtitle("All Plates Box Plot")
})
})
}
)
I had to cut down on most of the unnecessary code to make it understandable, but the code that relates to the problem it self is all here.
Difficult to know without being able to run the code, but try aes_string instead of aes.
Related
Not sure why my code shows all the countries' plots at the same time, I want to make it display only the country that's selected by the user. Does anyone know what went wrong with the code?
library(shiny)
require(readr)
countries <- read.csv("~/Desktop/share-deaths-suicide.csv")
# Define UI for application that draws a scatterplot
ui <- fluidPage(
# Application title
titlePanel("Country Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput("Entity",
"countries",
paste(countries$Entity),
selected = "China", multiple = FALSE)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("countryPlot")
)
)
)
# Define server logic required to draw a scatterplot
server <- function(input, output) {
output$countryPlot <- renderPlot({
country = input$Entity
plot(countries$Year, countries$`Deaths...Self.harm...Sex..Both...Age..All.Ages..Percent`, col=ifelse(countries$Entity==country, "red","black"),
main = "Sucide Rate of Countries", xlab = "Year", ylab = "Sucide rate",log="xy")
options(scipen=999)
})
}
# Run the application
shinyApp(ui = ui, server = server)
The issue is that you do not filter your data for the selected country. According to your code only the color is changed for the selected country.
To fix you issue you have to filter your data before passing it to plot. To this end you could add a reactive which filters the data. The filtered data could then be used via countries_filtered() where the parantheses are important. Additionally I have fixed an issue with your selectInput. Instead of passing the vector of entities use only the unique values for the choices argument.
As you provided no example data (to this end I would suggest to have a look at how to provide provide a minimal reproducible example) I use the gapminder dataset as example data:
library(shiny)
# Example data
library(gapminder)
countries <- gapminder
names(countries)[c(1, 3, 4)] <- c("Entity", "Year", "Deaths...Self.harm...Sex..Both...Age..All.Ages..Percent")
# Define UI for application that draws a scatterplot
ui <- fluidPage(
# Application title
titlePanel("Country Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput("Entity",
"countries",
choices = unique(countries$Entity),
selected = "China", multiple = FALSE)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("countryPlot")
)
)
)
# Define server logic required to draw a scatterplot
server <- function(input, output) {
countries_filtered <- reactive({
req(input$Entity)
countries[countries$Entity == input$Entity, ]
})
output$countryPlot <- renderPlot({
country = input$Entity
plot(countries_filtered()$Year, countries_filtered()$`Deaths...Self.harm...Sex..Both...Age..All.Ages..Percent`,
col=ifelse(countries$Entity==country, "red","black"),
main = "Sucide Rate of Countries", xlab = "Year", ylab = "Sucide rate",log="xy")
options(scipen=999)
})
}
# Run the application
shinyApp(ui = ui, server = server)
#>
#> Listening on http://127.0.0.1:4061
1: You need to filter the dataset for the input country
And I will demonstrate this using ggplot:
output$countryPlot <- renderPlot({
countries %>%
filter(country == input$Entity) %>%
plot(aes(Year, countries$`Deaths...Self.harm...Sex..Both...Age..All.Ages..Percent`, color= Entity)) +
geom_point() +
labs(main = paste("Sucide Rate of", input$Entity), xlab = "Year", ylab = "Sucide rate") +
scale_y_log10() +
scale_x_log10() +
scale_fill_manual(values=c("red", "black"))
options(scipen=999)
})
I am not exactly sure why you wanted to color the points of the scatter plot based on "entity" as it seems that entity is the country input and the original plot would change the color of the points based on the user selection. In my above code, it would change the entire plot to only show the selected country, and changes the title based on the country selected as well.
Is there a way to link user input (x-axis, y-axis, colour etc) to the gganimate graph in R shiny? So that when the user selects a different input (x-axis, y-axis, colour, etc.) from the drop-down list. gganimate graph will be filled with different x-axis, y-axis, colour, etc. so that it can be changed accordingly?
The coding I tried as below. And there is error due to the variable name I saved in UI (xValue, yValue, colorValue etc which are putting in ggplot function) does not apply in the Serve...
The idea of UI code come from here: https://shiny.rstudio.com/articles/layout-guide.html
And it would display sth like this:
library(shiny)
library(shinythemes)
library(palmerpenguins)
library(gganimate)
library(dplyr)
library(tidyr)
library(ggplot2)
library(gapminder)
data(package = 'palmerpenguins')
ui <- fluidPage(
navbarPage(
"Animated penguins data",
tabPanel("Navbar 2",
##########
imageOutput('plot'),
hr(),
fluidRow(
column(3,
h4("Diamonds Explorer"),
sliderInput('sampleSize', 'Sample Size',
min=1, max=nrow(penguins), value=min(1000, nrow(penguins)),
step=500, round=0),
br(),
checkboxInput('jitter', 'Jitter'),
checkboxInput('smooth', 'Smooth')
),
column(4, offset = 1,
xValue -> selectInput('x', 'X', names(penguins)),
yValue -> selectInput('y', 'Y', names(penguins), names(penguins)[[2]]),
colorValue -> selectInput('color', 'Color', c('None', names(penguins)))
),
column(4,
rowValue -> selectInput('facet_row', 'Facet Row', c(None='.', names(penguins))),
columnValue -> selectInput('facet_col', 'Facet Column', c(None='.', names(penguins)))
)
)
#########
),
) # navbarPage
) # fluidPage
The idea of serve come from here: How to create and display an animated GIF in Shiny?
The server is sth. like this
# Define server function
server <- function(input, output) {
##########################################
output$plot <- renderImage({
# A temp file to save the output.
# This file will be removed later by renderImage
outfile <- tempfile(fileext='.gif')
# now make the animation
p = myPenguins %>%
ggplot(
aes(xValue, yValue, color = colorValue)) +
geom_point() +
#geom_line() +
facet_grid(rows = vars(rowValue), cols = vars(columnValue))+
theme_bw()+
#theme_minimal() +
transition_time(year)+
labs(title = "Year: {frame_time}")+
view_follow()#+
anim_save("outfile.gif", animate(p)) # New
# Return a list containing the filename
list(src = "outfile.gif",
contentType = 'image/gif')
}, deleteFile = TRUE)
################################################################
}
shinyApp(ui = ui, server = server)
Your code is still far from minimal and I don't have many of the packages you reference, but I think the following will illustrate the techniques that will allow you to do what you want. I've based my code on the diamonds dataset, which is part of ggplot2.
Your problem is due to the fact that Shiny input widgets (generally) return strings, whereas ggplot functions expect symbols as their argument. This is a feature of the tidyverse's use of non-standard evaluation (NSE).
As a result, the interface between Shiny and the tidyverse can be perplexing when you first come across it. One solution is to use the bang-bang operator (!!) and the sym function.
The following app displays a faceted scatter plot in which the user has complete control over the variables that
are plotted on the x axis
are plotted on the y-axis
define the colours of the plotted points
define the facet rows
define the facet columns
library(shiny)
library(tidyverse)
ui <- fluidPage(
selectInput("x", "X variable:", names(diamonds)),
selectInput("y", "Y variable", names(diamonds), selected="price"),
selectInput("colour", "Colour: ", names(diamonds), selected="color"),
selectInput("facetRows", "Facet rows: ", names(diamonds), selected="clarity"),
selectInput("facetCols", "Facet columns", names(diamonds), selected="cut"),
plotOutput("plot")
)
server <- function(input, output) {
output$plot <- renderPlot({
diamonds %>%
ggplot() +
geom_point(aes(x=!!sym(input$x), y=!!sym(input$y), colour=!!sym(input$colour))) +
facet_grid(rows=vars(!!sym(input$facetRows)), cols=vars(!!sym(input$facetCols)))
})
}
shinyApp(ui = ui, server = server)
Note that the diamonds dataset is quite large and a poor choice of variables for any of the five roles I mention above can lead to lengthy delays!
I think this provides an answer to your question, but I'm not entirely sure because of the many disparate features in your code (eg saving a GIF file, use of gganimate, reference to gapminder) that do not seem relevant to the question of using UI inputs in a call to renderPlot. If I haven't given you what you want, please refine your question and code so that they reference only the elements that are critical to the fundamental issue.
This post will help you construct a minimal reproducible example.
i have the following shiny application:
Dataset:(https://www.kaggle.com/rush4ratio/video-game-sales-with-ratings)
library(shinythemes)
library(shiny)
library(ggplot2)
ui = navbarPage(theme = shinytheme("united"),"Video Games Dashboard",
tabPanel("Dashboard",
sidebarLayout(
sidebarPanel(
selectInput(inputId = "dataset",
label = "Choose a dataset:",
choices = colnames(data)),
),
mainPanel(
plotOutput(outputId = "ggPlot"),
plotOutput(outputId = "ggPlot2"),
)
)
),
tabPanel("Summary",
)
)
server <- function(input, output) {
output$ggPlot <- renderPlot({
ggplot ( data=data,aes(x=Global_Sales, y=input$dataset)) +
geom_bar(stat="identity" ,fill="steelblue") +
coord_flip() +
theme_minimal()
})
output$ggPlot2 <- renderPlot({
ggplot ( data=data,aes(x=Global_Sales, y=Platform)) +
geom_bar(stat="identity" ,fill="steelblue") +
theme_minimal()
})
}
shinyApp(ui = ui, server = server)
Which looks like this:
As you can see I want to do the same in the first plot("ggPlot") like in the second plot("ggPlot2") just that the first plot is reactive and you can select every column of the datatable to display it in the plot.
However, I get this message all the time:
Input to asJSON(keep_vec_names=TRUE) is a named vector. In a future version of jsonlite, this option will not be supported, and named vectors will be translated into arrays instead of objects. If you want JSON object output, please use a named list instead. See ?toJSON.
Does anybody know how to fix this? Is this approach even possible?
Thanks!
This warning appears when there's a single item on one of the two axes - see this shiny issue.
But your code does not produce the plot you expect: input$dataset is the name of a column of the data, hence it is a string, and then when you do aes(x = Global_Sales, y = input$dataset), the y argument of aes is not set to a variable of the data, it is set to a string. So you have a single item on the y-axis, hence the warning.
To set the arguments of aes to some variables of the data when you have the names of these variables, you can use aes_string:
aes_string(x = "Global_Sales", y = input$dataset)
This is causing me a lot of pain.
I would like to simlpy have a sliderInput that takes a Date (preferably stepping by month) and changes a simple ggplot_bar as a result. Although I can show everything there seems to be no response to the changing of the slider:
Here is my code:
ui.r
library(shiny)
# Define UI for application that draws a histogram
shinyUI(fluidPage(
# Application title
titlePanel("St Thomas' Physiology Data Console"),
# Sidebar with a slider input for the number of bins
sidebarLayout(
sidebarPanel(
sliderInput("DatesMerge",
"Dates:",
min = as.Date("2006-01-01","%Y-%m-%d"),
max = as.Date("2016-12-01","%Y-%m-%d"),
value=as.Date("2016-12-01"),timeFormat="%Y-%m-%d")
),
# Show a plot of the generated distribution
mainPanel(
tabsetPanel(
tabPanel("Breath Tests",plotOutput("distPlotLactul")),
)
)
))
server.r
library(shiny)
source("S:\\Usage.R")
# Define server logic required to draw a histogram
shinyServer(function(input, output) {
output$distPlotLactul <- renderPlot({
#Create the data
DatesMerge<-input$DatesMerge
# draw the histogram with the specified number of bins
ggplot(TotsLactul)+
geom_bar(aes(DatesMerge,fill=year))+
labs(title=paste("Num")) +
xlab("Time") +
ylab("NumP") +
theme(axis.text.x=element_text(angle=-90)) +
theme(legend.position="top")+
theme(axis.text=element_text(size=6))
})
})
I wasn't totally sure of your ggplot code, so I had to rejig into something I understood.
I also created my own data to make it reproducible.
Here is the data I made
# Generate random variates
TotsLactul <- rep(ymd("2016-01-01"),10000)
randomMonths <- round(runif(n = 10000,min = 0,max = 11),0)
randomDays <- round(runif(n = 10000,min = 0,max = 28),0)
# Increments days
month(TotsLactul) <- month(TotsLactul) + randomMonths
day(TotsLactul) <- day(TotsLactul) + randomDays
# Make it a DT
TotsLactul <- data.table(x=TotsLactul)
This is just random dates throughout the year.
UI
ui <- shinyUI(fluidPage(
# Application title
titlePanel("St Thomas' Physiology Data Console"),
# Sidebar with a slider input for the number of bins
sidebarLayout(
sidebarPanel(
sliderInput("DatesMerge",
"Dates:",
min = as.Date("2016-01-01","%Y-%m-%d"),
max = as.Date("2016-12-01","%Y-%m-%d"),
value=as.Date("2016-12-01"),
timeFormat="%Y-%m-%d")
),
mainPanel(
plotOutput("distPlotLactul"))
)
))
I amended the slider to only take 2016 values, to match my generated data
Server
server <- shinyServer(function(input, output) {
output$distPlotLactul <- renderPlot({
#Create the data
DatesMerge<-input$DatesMerge
# draw the histogram with the specified number of bins
ggplot(TotsLactul[month(x) == month(DatesMerge)],mapping=aes(x=x))+
geom_histogram(bins=100)+
labs(title=paste("Num")) +
xlab("Time") +
ylab("NumP") +
theme(axis.text.x=element_text(angle=-90)) +
theme(legend.position="top")+
theme(axis.text=element_text(size=6))
})
})
I'll be honest, I have never used ggplot like you have (just dropped in a table in a geom etc.), so I can't comment on if any of it was right / wrong. Hopefully you can follow my changes.
Changed geom_bar to geom_hist (to match my data)
The filtering happens in the data included in the plot, not within the geom.
This seems to work fine, let me know how you get on.
I have a large Shiny application that has a number of prompts, then generates tables and plot based on those inputs. I don't use rmarkdown or knitr or anything to format the output. I just use the standard Shiny elements (sidebarPanel, mainPanel, etc.). For the plots and tables I use the standard reactive renderPlot and renderTable objects.
I'm looking for an easy way to have a button called "Export to PDF" that exports the elements on the page to a PDF document.
I've looked into using knitr and rmarkdown to generate a document with some fancy formatting (see here and here for examples).
The problem is that it appears that I'll need to regenerate the tables and plots either within the Rmd file or the server.R within a downloadHandler object, and I'd like to avoid that.
Is there any way to output the page as a pdf more easily. More specifically, is there any way to directly reference the output tables and plots (i.e. the output$ objects) from within the Rmd file so that plots and tables don't need to be generated twice.
Edit: Here is some simplified code. Note getDataset() is a reactive function that queries a database based on the inputs.
My goal is to simply add an "Export" button that exports the already-generated plots and table. (Also as a side note, is there any way I can get a reactive dataset that is shared among all reactive elements? i.e. not need to have ds <- getDataset() in every object?)
Server
output$hist <- renderPlot({
ds <- getDataset()
# do data transformations
ggplot(ds, aes(val)) +
geom_histogram(binwidth = binSize, aes(fill = ..count..)) +
labs(title = "val dist", x = "val", y = "Count") +
scale_fill_gradient("Count", low = "green", high = "red", guide = FALSE) +
scale_x_continuous(limits = c(min(ds$val), quantile(ds$val, 0.99))) +
geom_hline(yintercept=maxY, linetype=3)
})
output$time <- renderPlot({
ds <- getDataset()
# do data transformations
ggplot(ds, aes(as.POSIXlt(unixTime, origin="1970-01-01", tz="UTC"), val), colour = val) +
scale_y_continuous(limits = c(min(ds$val), quantile(ds$val, 0.99))) +
labs(title = "Val Over Time", x = "Time (UTC)", y = "val (ms)") +
geom_point(alpha = 0.3, size = 0.7) +
geom_smooth()
})
output$stats <- renderTable({
statsDf = getDataset()
# do data transformations
statsDf
})
UI
ui <- fluidPage(
titlePanel("Results"),
sidebarLayout(
sidebarPanel(
dateInput("startDateTime", "Start Date:", value = "2016-10-21"),
textInput("startTime", "Start Time", "00:00:00"),
br(),
dateInput("endDateTime", "End Date:", value = "2016-10-21"),
textInput("endTime", "End Time", value = "02:00:00"),
br(),
submitButton("Submit")
),
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Plots",
plotOutput("hist"),
plotOutput("time"),
tabPanel("Statistics", tableOutput("stats"))
)
)
)
)
First of all , you should really produce a reproducible example not just a sample of your code. We should copy and paste your code and it will run.
The idea
Since you are using ggplot2 which is king of grid plots, I think one easy option to save plots/tables is to use gridExtra package. Using grid.arrange or arrangeGrobs you can save your grobs to predefined device. Then, downloadhandler will do the download.
To not regenerate all the plots each time, I think one solution is to save them in a global variable that you update each time you change the plot. Here reactiveValues come in rescue to store plots and tables ad dynamic variable.
Solution
ui.R
library(shiny)
shinyUI(fluidPage(
# Application title
titlePanel("Save ggplot plot/table without regenration"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
downloadButton('export')
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("p1"),
plotOutput("p2"),
tableOutput("t1")
)
)
))
server.R
library(shiny)
library(ggplot2)
library(gridExtra)
shinyServer(function(input, output) {
## vals will contain all plot and table grobs
vals <- reactiveValues(p1=NULL,p2=NULL,t1=NULL)
## Note that we store the plot grob before returning it
output$p1 <- renderPlot({
vals$p1 <- qplot(speed, dist, data = cars)
vals$p1
})
output$p2 <- renderPlot({
vals$p2 <- qplot(mpg, wt, data = mtcars, colour = cyl)
vals$p2
})
## same thing for th etable grob
output$t1 <- renderTable({
dx <- head(mtcars)
vals$t1 <- tableGrob(dx)
dx
})
## clicking on the export button will generate a pdf file
## containing all grobs
output$export = downloadHandler(
filename = function() {"plots.pdf"},
content = function(file) {
pdf(file, onefile = TRUE)
grid.arrange(vals$p1,vals$p2,vals$t1)
dev.off()
}
)
})