I am trying to combine two things into 1 violin plot.
In my Shiny app user can choose variable he want to have in violin plot (X variable).
As a Y variable I have age which can have range chosen by user:
There is no problem if I just pick a variable and stay with full range of income.
However, when I want to have a different range I get an error.
To show the problem more visible:
- this works ok, I can change the X variable and it is fine with the full range of income
if I change the income range I get error
I think that the problem appears because the X variable has different range.
I don't know how and where to change it to make it work.
If I drop the X interactivity it works:
renderPlot({
data %>%
filter(
between(Age, input$income[1], input$income[2])) %>%
ggplot(aes(x=Sex, y=Age)) +
geom_violin(aes(fill=Sex), trim=FALSE) +
geom_boxplot(width=0.3)+
stat_summary(fun=mean, geom="point", shape=20, size=5)+
ggtitle(input$var)})
But I want it to stay interactive. Do you have any solution for that?
Here is a code with titanic dataset showing the same problem which you can copy-paste:
---
title: "dataset"
output:
flexdashboard::flex_dashboard:
orientation: rows
vertical_layout: fill
runtime: shiny
---
```{r global, include=FALSE}
#dataset, libraries and other global things
library(flexdashboard)
library(ggplot2)
library(tidyverse)
library(dplyr)
library(titanic)
data("titanic_train")
data<-na.omit(titanic_train)
```
Dashboard {data-orientation=rows}
=====================================
Inputs {.sidebar}
-------------------------------------
**Age by:**
```{r plot-option}
selectInput("var", label = "Please choose variable:",
choices = names(subset(data, select=c(Sex ,Pclass, SibSp))))
sliderInput("income", HTML("Income interval:"),
min = min(data$Age), max = max(data$Age), value = c(min(data$Age), max(data$Age)), step =1)
```
Row
-------------------------------------
### Age by: {data-width=450}
```{r}
selected <- reactive({ data[, c(input$var)] })
renderPlot({
data %>%
filter(
between(Age, input$income[1], input$income[2])) %>%
ggplot(aes(x=selected(), y=Age)) +
geom_violin(aes(fill=input$var), trim=FALSE) +
geom_boxplot(width=0.3)+
stat_summary(fun=mean, geom="point", shape=20, size=5)+
ggtitle(input$var)})
```
As #Ben says; there is a difference in the number of rows selected. I'm somewhat new with Shiny, but why do you need to subset the data in the reactive part? It's not needed (you filter it later on) and it's less efficient since you're effectively subsetting your data every time you change the selected variable (granted, not a big problem in a small dataset, but still..)
So I suggest:
renderPlot({
data %>%
filter(
between(MonthlyIncome, input$income[1], input$income[2])) %>%
ggplot(aes_string(x= input$var, y=data$MonthlyIncome)) +
geom_violin(aes(fill=input$var), trim=FALSE) +
geom_boxplot(width=0.3)+
stat_summary(fun=mean, geom="point", shape=20, size=5)+
ggtitle(input$var)})
Define UI for application
ui <- fluidPage(
# Application title
titlePanel("Iris"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput("Variables","Choose a Variable",
choices = c(colnames(iris)),
selected = "Species"),
sliderInput("PetalLength", "Length Interval",
min = 0.1, max = 10, value = c(0.5, 7.5), step = 0.1)
)
,
# Show a plot of the generated distribution
mainPanel(
plotOutput("irisPlot")
)
)
)
Define server logic
server <- function(input, output) {
data(iris)
output$irisPlot <- renderPlot({
iris_data <- filter(iris, between(Petal.Length, input$PetalLength[1], input$PetalLength[2]))
ggplot(iris_data, aes_string(x= input$Variables, y=iris_data$Petal.Length)) +
geom_violin(aes(fill=input$Variables), trim=FALSE) +
geom_boxplot(width=0.3)+
stat_summary(fun=mean, geom="point", shape=20, size=5)+
ggtitle(input$Variables)})
}
Run the application
shinyApp(ui = ui, server = server)
Related
I am trying to implement a slider in a very simple Shiny application. The main idea is to change the values with the slider and see the visualized result in Chart 2. Below you can see my code
---
title: "Test App"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny
---
```{r setup, include=FALSE}
library(flexdashboard)
library(shiny)
library(tidyverse)
# Data Set 1
df<-data.frame( cyl=c("4","6","8"),
Multiplier=c(2,4,6))
# Data Set 2
df1 <- mtcars
df1$cyl <- as.factor(df1$cyl)
```
Column {.sidebar}
-----------------------------------------------------------------------
```{r}
selectInput("clusterNum",
label = h4("Charts"),
choices = list("Chart1" = "Chart1", "Chart2" = "Chart2"),
selected = "Chart1"
)
# Sidebar to demonstrate various slider options ----
sidebarPanel(
# Input: Simple integer interval ----
sliderInput("integer", "Integer:",
min = 0, max = 8,
value = 1),)
```
Column {data-width=650}
-----------------------------------------------------------------------
### Chart
```{r}
# First chart
Chart1 <- ggplot(df1, aes(x = wt, y = mpg)) +
geom_point()
# Second chart
Chart2_df1<-df1%>%
dplyr::left_join(df,df1,by = c("cyl"="cyl"))
Chart2_df1<-Chart2_df1%>%
dplyr::mutate(mpg_new=(mpg*Multiplier))
Chart2 <- ggplot(Chart2_df1, aes(x = wt, y = mpg_new)) + geom_point()
# Visualization of the selected chart
renderPlot({
switch(input$clusterNum,
"Chart1" = Chart1,
"Chart2" = Chart2
)
})
```
With the values from the slider, I want to change the value in df for column Multiplier. These values, after changing, are part of the formula of the second chart for multiplying with the value from df1, with column mpg. After this operation, the next step is showing result on chart 2.
So can anybody help me how to implement this similar as picture below ?
In order for the plot to be reactive to an input, we need it to be within reactive or processing within the renderPlot (which is reactive in nature).
One way to do this is to make Chart2 a reactive plot, and then "call" it with Chart2() (the way to get at reactive data/plots):
# First chart
Chart1 <- ggplot(df1, aes(x = wt, y = mpg)) +
geom_point()
# Second chart
Chart2 <- reactive({
dplyr::left_join(df, df1, by = c("cyl" = "cyl")) %>%
dplyr::mutate(mpg_new = (mpg * Multiplier * input$integer)) %>%
ggplot(aes(x = wt, y = mpg_new)) +
geom_point()
})
# Visualization of the selected chart
renderPlot({
switch(input$clusterNum,
"Chart1" = Chart1,
"Chart2" = Chart2()
)
})
Note that Chart1 is unmodified, and since it is not a reactive component, we continue to reference it as Chart1 (no ()) just as we would any other regular R object. Since Chart2 is a shiny-reactive object, though, we need the () to get at the updated value.
If you will be doing something with this data in addition to plotting it, one might choose to make the altered data available as one reactive component and then use it in the other(s).
# Second chart data
Chart2_dat <- reactive({
dplyr::left_join(df, df1, by = c("cyl" = "cyl")) %>%
dplyr::mutate(mpg_new = (mpg * Multiplier * input$integer))
})
# Second chart
Chart2 <- reactive({
Chart2_dat() %>%
ggplot(aes(x = wt, y = mpg_new)) +
geom_point()
})
# Visualization of the selected chart
renderPlot({
switch(input$clusterNum,
"Chart1" = Chart1,
"Chart2" = Chart2()
)
})
and any other components (e.g., tables, additional plots) can also use Chart2_dat() to see the joined/updated data.
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 working on a school project where I have a few dyplr queries where I need to make them interactive using the Shiny library. Now I have a query in dyplr where i can see the Revenue for every country from a Indian takeaway restaurant. I have the following query:
```
df %>%
group_by(Origin, Jaar = year(Order.Date), Maand = month(Order.Date, label = TRUE), Kwartaal = quarter(Order.Date)) %>%
summarize(omzet = sum(regelomzet)) %>%
ggplot(aes(reorder(Origin, omzet), omzet)) +
facet_grid(~Jaar) +
geom_col() +
ggtitle("Omzet per land van herkomst") +
coord_flip() +
theme(axis.text.x = element_text(angle = 90))
```
This gives me the following output:
Now if I change the facet_grid to for example kwartaal (quarters in a year) I get the following output:
Now I would like to apply this plot in a interactive Shiny app. i use the following code for this:
```
```{r}
library(shiny)
ui <- fluidPage(
titlePanel("Indian takeaway"),
navlistPanel("Kies een plot",
tabPanel("Omzet per land van herkomst",
selectInput(inputId = "Select_unit",
label = "Selecteer op basis van wat je de grafiek wilt zien",
choices = c("Jaar", "Kwartaal", "Maand"),
selected = "Jaar"
),
plotOutput(outputId = "plot3")
)
)
)
server <- function(input, output, session) {
output$plot3 <- renderPlot({
df %>%
group_by(Origin, Jaar = year(Order.Date), Maand = month(Order.Date, label = TRUE), Kwartaal = quarter(Order.Date)) %>%
summarize(omzet = sum(regelomzet)) %>%
ggplot(aes(reorder(Origin, omzet), omzet)) +
facet_grid(~input$Select_unit) +
geom_col() +
ggtitle("Omzet per land van herkomst") +
coord_flip() +
theme(axis.text.x = element_text(angle = 90))
})
}
shinyApp(ui, server)
```
Here I make a slicer and show the plot on the Shiny app. To change the facet_wrap I use the input function that is linked to the input box now if I change the variable in the input box I would expect it to show the graph like in the above two pictures.
Now if I start the shiny app you can see that there isn't any facet_grid in the first place not even on the variable that is standard. My question is why does it do this because I did include it in my query. Because I have no clue I don't know how I could fix this and already did google this but couldn't find anything helpfull
I found the following information on another stack overflow post:
R Shiny: Issue with facet_wrap in ggplot
I use facet_grid(~input$Select_unit), using the following line of code the problem will be sovled
facet_grid(~get(input$Select_unit))
With the introduction of the .data pronoun, the best way to turn a string into a variable for ggplot would be with .data[[variable]]. Also we can use the non-formula syntax for facet_grid which allows specifying rows= and cols= as vars() lists. For example
facet_grid(cols=vars(.data[[input$Select_unit]]))
I have a dataset with home values for all 50 states over ~30 years. Columns include State, Year, Value, etc. I am trying to create an interactive Shiny app where the user can select certain states so they will be the only ones displayed in the plot. I have successfully created the plot of all states independently where Year is on the x-axis and Value is on the y-axis, colored by State, and also have successfully subset the dataset so that only one state plots.
I am new to Shiny and having issues having anything other than the Input checkBox feature work in this. Is there something obvious I am missing?
ui <- fluidPage(
checkboxGroupInput(inputId = "state", label = "States", choices = levels(AllData2$STATE),
plotOutput(outputId = "hist")))
server <- function(input, output) {
output$hist <- renderPlot({
plot(data = subset(AllData2, AllData2 == input$state), mapping = aes(x = Date, y = HomeValue,
color = STATE) + geom_line(size=2, alpha=0.8) +
scale_y_continuous(breaks = seq(0, 1000000, 50000)) +
scale_x_continuous(breaks = seq(1975, 2020, 5)) +
ylab("Value in Dollars") + xlab("Year"))
})
}
shinyApp(ui = ui, server = server)
I get no output in my Shiny App except the checkbox options. Thank you for any help.
There are only syntax errors in your code. Many of them:
You have included plotOutput() inside the checkbox group, please place it outside it.
Use ggplot() instead of plot()
You have included everything inside plot() If you use ggplot() the syntax is: ggplot(data=AllData,mapping=aes())+geom_line()+scale_y_continuous()+scale_x_continuous()+labs(x="This is X label",y="This is ylab",color="This is the color legend label")
Your code will work after fixing these problems
Just copy paste this if you want instant result:
library(shiny)
library(ggplot2)
library(dplyr)
ui <- fluidPage(
column(12,checkboxGroupInput(inputId = "state", label = "States", choices = c(1,2,3,4,5))),
column(12,plotOutput(outputId = "hist")))
server <- function(input, output) {
output$hist <- renderPlot({
ggplot(data = subset(AllData2, AllData2$STATE %in% input$state), mapping = aes(x = Date, y = HomeValue,
color = STATE)) + geom_line(size=2, alpha=0.8) +
scale_y_continuous(breaks = seq(0, 1000000, 50000)) +
scale_x_continuous(breaks = seq(1975, 2020, 5)) +labs(x="Value in Dollars",y="Year")
})
}
shinyApp(ui = ui, server = server)
When I do a facet_grid in ggplotly() for a Shiny App, with a large number of faceting groups, the plot is messed up. However it works correctly outside Shiny.
How can I fix this?
I suspect it is linked to the Y scale but I couldn't find the solution.
Here's a reproducible example based on diamonds example from plotly.
Comparison of Shiny vs non Shiny outputs : Comparison of facet_grid outside and within Shiny
Code
Outside Shiny:
library(ggplot2)
data(diamonds, package = "ggplot2")
# new faceting group
diamonds$rdmGroup <- as.factor(sample(LETTERS, dim(diamonds)[1], replace=TRUE))
# subset of diamonds
diamonds <- diamonds[sample(nrow(diamonds), 1000),]
ggplot(diamonds , aes_string(x = diamonds$x, y = diamonds$y, color = diamonds$x)) +
geom_point() + facet_grid(rdmGroup~.) +
guides(color=FALSE) +
labs(x = "X", y="Y")
The same code in a Shiny App:
library(shiny)
library(plotly)
library(ggplot2)
data(diamonds, package = "ggplot2")
# new faceting group
diamonds$rdmGroup <- as.factor(sample(LETTERS, dim(diamonds)[1], replace=TRUE))
# subset of diamonds
diamonds <- diamonds[sample(nrow(diamonds), 1000),]
ui <- fluidPage(
headerPanel("Diamonds Explorer"),
sidebarPanel(
sliderInput('plotHeight', 'Height of plot (in pixels)',
min = 100, max = 2000, value = 1000)
),
mainPanel(
plotlyOutput('trendPlot')
)
)
server <- function(input, output) {
output$trendPlot <- renderPlotly({
p <- ggplot(diamonds, aes_string(x = diamonds$x, y =diamonds$y, color = diamonds$x)) +
geom_point()+ facet_grid(rdmGroup~., scales = "free_y") +
labs(x = "X", y="Y")
ggplotly(p) %>%
layout(height = input$plotHeight, autosize=TRUE)
})
}
shinyApp(ui, server)
PS: I used aes_string() instead of aes() intentionally as I need it in my real app.
The first thing to note is that the problem has nothing to do with Shiny but rather your use of ggplotly. The problem can be replicated with just:
library(ggplot2)
library(plotly)
data(diamonds, package = "ggplot2")
# new faceting group
diamonds$rdmGroup <- as.factor(sample(LETTERS, dim(diamonds)[1], replace=TRUE))
# subset of diamonds
diamonds <- diamonds[sample(nrow(diamonds), 1000),]
p <- ggplot(diamonds , aes_string(x = diamonds$x, y = diamonds$y, color = diamonds$x)) +
geom_point() + facet_grid(rdmGroup~.)
ggplotly(p)
though you will need something to view the output in, which may well be shiny.
In answer to your question, the problem seems to be that you cannot have more than 25 facets. If you remove any single group from rdmGroup then the plotly output works fine e.g.
diamonds <- subset(diamonds, rdmGroup != "Q")
To update your shiny example:
library(shiny)
library(plotly)
library(ggplot2)
data(diamonds, package = "ggplot2")
# new faceting group
diamonds$rdmGroup <- as.factor(sample(LETTERS, dim(diamonds)[1], replace=TRUE))
# subset of diamonds
diamonds <- diamonds[sample(nrow(diamonds), 1000),]
diamonds <- subset(diamonds, rdmGroup != "Q")
ui <- fluidPage(
headerPanel("Diamonds Explorer"),
sidebarPanel(
sliderInput('plotHeight', 'Height of plot (in pixels)',
min = 100, max = 2000, value = 1000)
),
mainPanel(
plotlyOutput('trendPlot')
)
)
server <- function(input, output) {
output$trendPlot <- renderPlotly({
p <- ggplot(diamonds, aes_string(x = diamonds$x, y =diamonds$y, color = diamonds$x)) +
geom_point()+ facet_grid(rdmGroup~., scales = "free_y") +
labs(x = "X", y="Y")
ggplotly(p) %>%
layout(height = input$plotHeight, autosize=TRUE)
})
}
shinyApp(ui, server)
provides the following output:
A workaround could be to simply have more than one plot, splitting the dataset into groups of 25.
EDIT: I did some more research and the plot stops displaying as expected when the panel margins are too large to allow all of the plots to display. You can display all 26 by reducing the panel.spacing.y but this will only go so far depending on how many rows you need:
p <- ggplot(diamonds, aes_string(x = diamonds$x, y =diamonds$y, color = diamonds$x)) +
geom_point()+ facet_grid(rdmGroup~., scales = "free_y") +
labs(x = "X", y="Y") + theme(panel.spacing.y = unit(0.2, "lines"))