I want to use the output of ggtern() in a shiny app. However it seems to fail due to some constraints.
This is what it should look like:
This is the actual shiny output:
See here for a reproducible example:
library(shiny)
library(ggtern)
ui <- fluidPage(
mainPanel(
plotOutput("ggtern")
)
)
server <- function(input, output) {
output$ggtern <- renderPlot({
ggtern(data.frame(x=10, y=30, z=60), aes(x, y, z)) + geom_point()
})
}
shinyApp(ui = ui, server = server)
Do I overlook something?
place the plot function within a print command:
output$ggtern <- renderPlot({
print(ggtern(data.frame(x=10, y=30, z=60), aes(x, y, z)) + geom_point())
})
Related
I have a trivial question after playing with this code
library(gapminder)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
checkboxInput("fit", "Add line of best fit", FALSE),
selectInput("continents", "Continents",
choices = levels(gapminder$continent),
multiple = TRUE,
selected = 'Europe')
),
mainPanel(
plotOutput("plot")
)
)
)
server <- function(input, output) {
output$plot <- renderPlot({
data <- subset(gapminder,
continent %in% input$continents)
p <- ggplot(data, aes(gdpPercap, lifeExp)) +
geom_point() +
scale_x_log10()
if (input$fit) {
p <- p + geom_smooth(method = "lm")
}
p
})
}
shinyApp(ui = ui, server = server)
If I change part of the code above to this
if (input$fit) {
p + geom_smooth(method = "lm")
}
# p
})
}
The plot won't be displayed. Why do we have to be too verbose, that is, passing p + geom_smooth() to p, then calling p for it to work? Why can't we be more succinct by simply calling p + geom_smooth()? Is it because the code is wrapped inside renderPlot()?
Thankyou.
Based on your if statement, the plot is returned and then rendered in case input$fit is TRUE. If input$fit is FALSE, the if statement returns NULL and therefore no plot is rendered. This is the default behaviour of if() in R.
You can solve your problem by simply add else p to your if statement like
if (input$fit) p + geom_smooth(method = "lm") else p
I want to build a shiny app using Covid-19 data (https://data.europa.eu/euodp/de/data/dataset/covid-19-coronavirus-data) and I would like to show barplot with ggplot where you can see the development of worldwide cases or deaths over time. I would furthermore like to have a dateRangeInput in which you can set a time period. At the same time I have on the y axis either the possibility to choose from selectInput either the variable "cases" or "deaths". I can do this separately but I can't figure out how to have this in one final plot.
It works with the time range if I use this code:
ui <- fluidPage(
titlePanel("Covid-19 by Country"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "y", label = "Y-Axe:",
choices=c("cases", "deaths"),
selected = "cases"),
dateRangeInput("datum", "Zeitraum auswählen", start = min(covid_worldwide$dateRep), end = max(covid_worldwide$dateRep), min = min(covid_worldwide$dateRep), max = max(covid_worldwide$dateRep), format = "dd.mm.yyyy", language = "de")
),
mainPanel(
plotOutput("covidPlot")
)
)
)
server <- function(input, output, session) {
s <- reactive({
covid_worldwide %>%
filter(
as.Date(dateRep) >= as.Date(input$datum[1]),
as.Date(dateRep) <= as.Date(input$datum[2])
)
})
output$covidPlot <- renderPlot({
ggplot(data= s(), aes(x = dateRep, y = cases)) +
geom_bar(stat="identity", fill="red") + theme_classic() + xlab("Zeitraum") + ylab("Anzahl")
}
)}
shinyApp(ui = ui, server = server)
It works also if I do not change the time period but give two different variables for the y-axis, see following code (the UI is the same as above):
server <- function(input, output, session) {
s <- reactive({
covid_worldwide %>%
filter(
as.Date(dateRep) >= as.Date(input$datum[1]),
as.Date(dateRep) <= as.Date(input$datum[2])
)
})
yvar <- reactive({
if ( "cases" %in% input$y) return(covid_worldwide$cases)
if ( "deaths" %in% input$y) return(covid_worldwide$deaths)
})
output$covidPlot <- renderPlot({
ggplot(data= s(), aes(x = dateRep, y = yvar())) +
geom_bar(stat="identity", fill="red") + theme_classic() + xlab("Zeitraum") + ylab("Anzahl")
}
)}
shinyApp(ui = ui, server = server)
But if I then try to change the time period in the shiny app I receive this error: "Aesthetics must be either length 1 or the same as the data (26852): y"
Does anyone have an idea on how to make the two things in one ggplot barplot work? Thank you in advance!
You simply have to map input$y on y in your plotting code. Additionally as the input is a character it's convenient to switch to aes_string instead of aes as it allows to pass the variables as names or strings to ggplot().
The first version does not work as you map cases on y. The second one does not work as your reactive yvar extracts a vector from the original unfiltered df. Therefore the length of yvar is greater than the number of rows of the filtered df or the length of your date variable.
output$covidPlot <- renderPlot({
ggplot(data= s(), aes_string(x = "dateRep", y = input$y)) +
geom_bar(stat="identity", fill="red") + theme_classic() + xlab("Zeitraum") + ylab("Anzahl")
}
I'm creating a plot using ggplotly() and I'd like the Spearman's rank correlation [I'm storing here as the reactive value rho] to appear when hovering over the line created with geom_smooth. I found an article on the plotly website for doing this in python (https://plot.ly/python/linear-fits/) but I'm unsure how to achieve this in R. Any help or leads appreciated!!
library(shiny)
library(plotly)
ui <- fluidPage(
mainPanel(plotlyOutput("line_plot"),
verbatimTextOutput("rho"))
)
# Define server logic required to draw a histogram
server <- function(input, output) {
# calculate rho to be printed over line
rho <- reactive({ cor.test(x = iris$Sepal.Length, y = iris$Sepal.Width, method='spearman')[[4]] })
output$rho <- renderText(paste0("rho: ", rho()))
output$line_plot <- renderPlotly({
p <- ggplotly(
ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width)) +
geom_point() +
# would I add the tooltip text here?
# I know I need it to be:
# "<b> rho: </b>", rho(), "<br/>",
geom_smooth(method=lm, se=FALSE, color = "red") +
theme_minimal()
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
You can add the unoffical aesthetics text:
library(shiny)
library(plotly)
ui <- fluidPage(
mainPanel(plotlyOutput("line_plot"),
verbatimTextOutput("rho"))
)
# Define server logic required to draw a histogram
server <- function(input, output) {
# calculate rho to be printed over line
rho <- reactive({ cor.test(x = iris$Sepal.Length, y = iris$Sepal.Width, method='spearman')[[4]] })
output$rho <- renderText(paste0("rho: ", rho()))
output$line_plot <- renderPlotly({
p <- ggplotly(
ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width)) +
geom_point() +
geom_smooth(method=lm, se=FALSE, color = "red", aes(text = paste0("<b> rho: </b>", rho()))) +
theme_minimal()
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
How would you implement something like this in R?
Selection histogram
Utilizing the scatterplot selection is the hard part. I haven't seen anything similar in Shiny or plotly.
In case anybody needs it in the future.
ui.R
library(shiny)
library(ggplot2)
shinyUI(basicPage(
titlePanel("Number of forward gears of selected cars"),
plotOutput("plot",brush = "plot_brush"),
plotOutput("histo",height="200px")
))
server.R
library(shiny)
library(ggplot2)
shinyServer(function(input, output) {
output$plot <- renderPlot({
ggplot(mtcars, aes(x=wt, y=mpg,color=as.factor(gear))) + geom_point() + labs(y= 'Miles per gallon',x = 'Weight (1000 lbs)')
})
output$histo <- renderPlot({
selected_points<-brushedPoints(mtcars, input$plot_brush, xvar = "wt", yvar = "mpg")
ggplot(data=selected_points, aes(selected_points$gear,fill = as.factor(gear))) + geom_bar() + labs(x="Forward Gears", y="Count") + coord_flip() +theme_minimal()
})
})
I want to include a ternary plot in a shiny app. I'm use package ggtern.
When I run the following code:
dd <- data.frame(x=c(3,1,5), y=c(45,29,10), z=c(10,45,94),
ss=c(58,75,109))
ggtern(data=dd,
aes(x=x,y=y,z=z)) +
geom_mask() +
geom_point() +
Larrowlab("var1") + Tarrowlab("var2") + Rarrowlab("var3") +
theme_showarrows() +
theme(tern.axis.arrow.show=T)#,
#tern.axis.text.show=F)
I get:
Inside a shiny app:
library(ggtern)
library(shiny)
## data ####
dd <- data.frame(x=c(3,1,5), y=c(45,29,10), z=c(10,45,94),
ss=c(58,75,109))
################
runApp(
## UI ####
list(ui = (basicPage(
headerPanel("ternary test"),
mainPanel(
plotOutput("gg", click = "plot_click")
)
)),
## server ####
server = function(input, output) {
output$gg <- renderPlot({
ggtern(data=dd,
aes(x=x,y=y,z=z)) +
geom_mask() +
geom_point() +
Larrowlab("var1") + Tarrowlab("var2") + Rarrowlab("var3") +
theme_showarrows() +
theme(tern.axis.arrow.show=T)#,
#tern.axis.text.show=F)
})
}
))
I get this:
Why the differences?
Is this a bug? Anyway around it?
Thanks,
António
Using print(ggtern_plot), as suggested in the comments above does not translate plot clicks properly and does not scale the plot.
ggtern does not work with shiny well because ggtern overloads plot.ggplot but shiny does not use the overloaded function. I managed to fix the plot this way:
custom_print.ggplot <- function(x) {
ggtern:::ggint$set_last_plot(x) # this is line needed by ggtern
# based on ggplot2:::custom_print.ggplot
grid::grid.newpage()
data <- ggplot_build(x)
gtable <- ggplot_gtable(data)
grid::grid.draw(gtable)
invisible(data)
structure(list(
build = data,
gtable = gtable
), class = "ggplot_build_gtable")
}
assignInNamespace("custom_print.ggplot", custom_print.ggplot, "shiny")