I am creating a plot in R shiny app based on usr input. My filtering of data is a bit complicated and I am unsure fow to pass it to "fill" in ggplot. Below is my code:
data <- reactive({
req(input$name)
req(input$type)
fp %>%
dplyr::filter(
name %in% input$name,
if_any(
matches(
str_c('status___', tolower(input$type))), ~
.x ==2),
on_date >= input$Dates[1] &
off_date <= input$Dates[2]
) %>%
group_by(country) %>%
summarize(All = n(), .groups = "drop")
})
##Plot
output$plot <- renderPlot({
g <- ggplot(data(), aes( y = All, x = country)) #this is wehere I want to use fill to color the plot by "type"
g + geom_bar(stat = "sum")
})
When you want to pass reactive input as variables in the ggplot aes() you need to use aes_string().
Try this ggplot code :
geom_bar(data = data(),
aes_string(y = "All",
x = "country",
fill = input$type),
stat = "sum")
Your problem is that your data() does not contain a column called type. You can verify that, by including a dataTableOutput element to your UI and render data to that. summarize will include only the grouping variables (country in your case) and the aggregated column (All).
Maybe you can provide a full reprex then we cna help better.
Related
Consider the plot produced by the following reprex. Note that the ggplot has sensible legends, while in plotly, the legend is heavily duplicated, with one entry for each time the same category ("manufacturer") appears in each facet. How do I make the plotly legend better match that of the ggplot2 one?
library(plotly)
library(ggplot2)
p <- mpg %>%
ggplot(aes(year)) +
geom_ribbon(aes(ymin=cty, ymax=hwy, fill = manufacturer), alpha=0.2) +
geom_line(aes(y = hwy, col=manufacturer)) +
facet_wrap(~class)
p
plotly::ggplotly(p)
Adapting my answer on this post to your case (which draws on this answer) one option would be to manipulate the plotly object.
The issue is that with facetting we end up with one legend entry for each facet in which a group is present, i.e. the numbers in the legend entries correspond to the number of the facet or panel.
In plotly one could prevent the duplicated legend entries via the legendgroup argument. One option to achieve the same result when using ggplotly would be to assign the legendgroup manually like so:
library(plotly)
library(ggplot2)
p <- mpg %>%
ggplot(aes(year)) +
geom_ribbon(aes(ymin=cty, ymax=hwy, fill = manufacturer), alpha=0.2) +
geom_line(aes(y = hwy, col=manufacturer)) +
facet_wrap(~class)
gp <- ggplotly(p = p)
# Get the names of the legend entries
df <- data.frame(id = seq_along(gp$x$data), legend_entries = unlist(lapply(gp$x$data, `[[`, "name")))
# Extract the group identifier
df$legend_group <- gsub("^\\((.*?),\\d+\\)", "\\1", df$legend_entries)
# Add an indicator for the first entry per group
df$is_first <- !duplicated(df$legend_group)
for (i in df$id) {
# Is the layer the first entry of the group?
is_first <- df$is_first[[i]]
# Assign the group identifier to the name and legendgroup arguments
gp$x$data[[i]]$name <- df$legend_group[[i]]
gp$x$data[[i]]$legendgroup <- gp$x$data[[i]]$name
# Show the legend only for the first layer of the group
if (!is_first) gp$x$data[[i]]$showlegend <- FALSE
}
gp
Thanks, #stefan, for your excellent answer that has both taught me about plotly objects and inspired me to take your concept further.
I've created this function with the following features:
It translates your logic into a function that uses the plotly object as an input.
It applies the purrr library.
The function accepts an optional second parameter (.new_legend) that allows overwriting the legend entries.
The code is certainly longer than your code, though it's elongated by the function, assign_leg_grp, that enables overwriting and also by my "spread out" style.
library(plotly)
library(ggplot2)
library(purrr)
library(stringr)
p <- mpg %>%
ggplot(aes(year)) +
geom_ribbon(aes(ymin=cty, ymax=hwy, fill = manufacturer), alpha=0.2) +
geom_line(aes(y = hwy, col=manufacturer)) +
facet_wrap(~class)
gp <- ggplotly(p = p)
clean_pltly_legend <- function(.pltly_obj, .new_legend = c()) {
# Cleans up a plotly object legend, particularly when ggplot is facetted
assign_leg_grp <- function(.legend_group, .leg_nms) {
# Assigns a legend group from the list of possible entries
# Used to modify the legend settings for a plotly object
leg_nms_rem <- .leg_nms
parse_leg_nms <- function(.leg_options) {
# Assigns a .leg_name, if possible
# .leg_options is a 2-element list: 1 = original value; 2 = remaining options
if (is.na(.leg_options)) {
.leg_options
} else if(length(leg_nms_rem) == 0) {
# No more legend names to assign
.leg_options
} else {
# Transfer the first element of the remaining options
leg_nm_new <- leg_nms_rem[[1]]
leg_nms_rem <<- leg_nms_rem[-1]
leg_nm_new
}
}
.legend_group %>%
map(~ parse_leg_nms(.))
}
simplify_leg_grps <- function(.legendgroup_vec) {
# Simplifies legend groups by removing brackets, position numbers and then de-duplicating
leg_grp_cln <-
map_chr(.legendgroup_vec, ~ str_replace_all(., c("^\\(" = "", ",\\d+\\)$" = "")))
modify_if(leg_grp_cln, duplicated(leg_grp_cln), ~ NA_character_)
}
pltly_obj_data <-
.pltly_obj$x$data
pltly_leg_grp <-
# pltly_leg_grp is a character vector where each element represents a legend group. Element is NA if legend group not required or doesn't exist
pltly_obj_data%>%
map(~ pluck(., "legendgroup")) %>%
map_chr(~ if (is.null(.)) {NA_character_} else {.}) %>%
# Elements where showlegend = FALSE have legendgroup = NULL.
simplify_leg_grps() %>%
assign_leg_grp(.new_legend)
pltly_obj_data_new <-
pltly_obj_data %>%
map2(pltly_leg_grp, ~ list_modify(.x, legendgroup = .y)) %>%
map2(pltly_leg_grp, ~ list_modify(.x, name = .y)) %>%
map2(pltly_leg_grp, ~ list_modify(.x, showlegend = !is.na(.y)))
# i.e. showlegend set to FALSE when is.na(pltly_leg_grp), TRUE when not is.na(pltly_leg_grp)
.pltly_obj$x$data <- pltly_obj_data_new
.pltly_obj
}
clean_pltly_legend(gp)
I am trying to make a shiny app that plots a custom ggplot plot1 depending on the different dates.
The parameter of plot1 is days which plots by different dates as the days are specified accordingly. However, I just can't figure out how to integrate into the server part of shiny. Here is my best approach:
# create sample data frame with dates
set.seed(1)
date = seq(Sys.Date(), by = "day", length.out = 30)
number = 100 * rnorm(30)
df = data.frame(date = date, number = number)
head(df)
# Plot
library(ggplot2)
library(shiny)
library(dplyr)
plot1 <- function(days) {
df %>% filter(between(date, max(df$date) - days, max(df$date))) %>%
ggplot(aes(x = date, y = number)) +
geom_line() +
theme_classic()
}
# Shiny
ui <- fluidPage(
dateRangeInput(
inputId = "daterange",
label = "Select the date range",
start = min(df$date),
end = max(df$date),
),
plotOutput("plotA")
)
server <- function(input, output, session) {
output$plotA <- renderPlot({
plot1(input$daterange)
})
}
shinyApp(ui, server)
Is filter a masked function for you? You can try using a qualified function call to filter via dplyr::filter().
Other than that, as the other user pointed out, input$daterange is a vector with 2 values - a "beginning" (input$daterange[1]) and an "end" (input$daterange[2]). You mentioned that you tried changing input$daterange[1] or [2], but it doesn't work: I presume that means you changed your call to plot(input$daterange) in server, right? You should be changing and specifying that up in your declaration of that function. Since you define the date from input$daterange based on min(df$date) and max(df$date) already, you can just use days[1] and days[2] to refer to the min and max of the user input. Maybe like this?
plot1 <- function(days) {
df %>% dplyr::filter(between(date, days[1], days[2])) %>%
ggplot(aes(x = date, y = number)) +
geom_line() +
theme_classic()
}
Finally, I have had some issues displaying plots from ggplot in shiny apps myself. In order to show the plot, I store in a variable, and then explicity show the plot with print(). Example:
myPlot <- ggplot(df, aes(x=..., y=...)) + geoms_...
print(myPlot)
If I simply call ggplot without the print() after, it does not always work as intended.
I am new to creating R Shiny apps. So far I'm making a part of my app where I am trying to generate different plots depending on which variable selected to analyze. I will use the built-in dataset iris as an example.
library(shiny)
library(tidyverse)
ui <- fluidPage(
titlePanel("Title"),
sidebarLayout(
sidebarPanel("Create plots of mean variables by species. ",
varSelectInput("vars", h5("Choose a variable to display."),
data = iris,
selected = "Sepal.Length"),
sliderInput("toprange", h5("Display Number of Species"),
min = 1, max = 3, value = 3)),
#in my actual dataset there are more than 30 different levels.
mainPanel(plotOutput("bars"))
)
)
server <- function(input, output) {
output$bars <- renderPlot({
species_plot(input$vars, input$toprange)
})
}
shinyApp(ui = ui, server = server)
Here is the function used to create the plots:
species_plot <- function(variable, min) {
iris %>%
group_by(Species) %>%
filter(Species != "") %>%
summarize(avg = mean({{variable}})) %>%
top_n(avg, min) %>%
ggplot(aes(x = reorder(Species, avg), y = avg)) +
geom_col() +
labs(x = "Species", y = paste("Mean", toString(sym(variable)))) +
ggtitle(paste("Mean", toString(sym(variable)), "by Species")) +
coord_flip()
}
When I run the app, the everything on the sidebar shows, but on the main panel an error "missing value where TRUE/FALSE needed" pops up, and I am not sure where this is stemming from. I don't see a conditional anywhere, for example, that would output this error.
The problem is in your plotting function, not your shiny code. The approach you're using to pass a quoted variable name to filter doesn't work. See this Q&A for one that does. In your function, that looks like...
species_plot <- function(variable, min) {
iris %>%
group_by(Species) %>%
filter(Species != "") %>%
summarize(avg = mean(!!sym(variable))) %>%
top_n(avg, min) %>%
ggplot(aes(x = reorder(Species, avg), y = avg)) +
geom_col() +
labs(x = "Species", y = paste("Mean", variable)) +
ggtitle(paste("Mean", variable, "by Species")) +
coord_flip()
}
Note that this also means you don't need all that toString(sym(variable)) stuff later in the function either. It's already a string, so just pass variable.
As a side note, I think top_n isn't doing what you think it's doing in that function, either. After you've run summarize, each group only has one value, so top_n throws an error message. The function works anyway because it just ignores that illogical call and moves on. But whatever it is you're trying to do there, you're going to need to do differently.
In my shiny app, I have a data.frame that is reactive. The data.frame is then given to ggplot and the barchart is made. However, I would like to set the exact order of the bars in the barchart.
This I can do with
JOIN11$ID_Polymer <- factor(JOIN11$ID_Polymer,
levels=JOIN11$ID_Polymer[order(JOIN11[["Content"]])])
in my R script (a function() that prepares the data outside the shiny server).
I would like to set the order in the shiny server so the user can change the ordering argument (the user can decide if he wants to order the data.frame by "Content" or by some other column that he chooses).
I was trying something like this:
dataforplot <- reactive({
plot_data <- data() %>%
filter(Name %in% input$polymers)
plot_data$ID_Polymer <- factor(plot_data$ID_Polymer,
levels =plot_data$ID_Polymer[ order(plot_data[["Content"]])])
})
which does not work (the ggplot is not displayed), the error says: data must be a data frame, or other object coercible byfortify(), not a factor.
the function for ggplot goes like this:
plotInput <- reactive({
ggplot(data = dataforplot(), aes(x = ID_Polymer, y = value), position = position_dodge(width = 1)) +
geom_bar(aes_string( fill=razeni()), position = position_dodge(width = 1), stat="identity", color="white")+
theme_minimal() +
theme(legend.text=element_text(size=21))+
theme(text = element_text(size=21))+
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) +
ggtitle(input$title_text_box_id) +
labs(x = "", y = input$ylabel_text_box_id) +
geom_text(aes(x = ID_Polymer, y = value,Group=Polymer,label=value),
position = position_dodge(width = 1),vjust=2, size=5,colour = "white", fontface = "bold") +
scale_fill_tableau("Tableau 10")+
scale_x_discrete(labels=c(xpopisky()))#puts a reactive in x labels
})
It works when I am not trying to set the order to the data.fram, when I leave out the
plot_data$ID_Polymer <- factor(plot_data$ID_Polymer,
levels =plot_data$ID_Polymer[ order(plot_data[["Content"]])])
How to solve this?
When you use:
dataforplot <- reactive({
plot_data <- data() %>%
filter(Name %in% input$polymers)
plot_data$ID_Polymer <- factor(plot_data$ID_Polymer,
levels =plot_data$ID_Polymer[ order(plot_data[["Content"]])])
})
The last line of whatever is inside your reactive() is returned as the value of that reactive element. Hence, in your case plot_data$ID_Polymer(which is not a dataframe, but a factor column of the dataframe) is returned as dataforplot(). This is the reason for the error. Change you dataforplot() definition to:
dataforplot <- reactive({
plot_data <- data() %>%
filter(Name %in% input$polymers)
plot_data$ID_Polymer <- factor(plot_data$ID_Polymer,
levels =plot_data$ID_Polymer[ order(plot_data[["Content"]])])
# Add return statement for returning the dataframe
return(plot_data)
})
I am new to Shiny and I've been struggling with the following. In the ui I define a set of variables that users can choose. However, when I call upon the input variable the correct label for the variable displays on the x-axis but there is no data. When I change the input$variable to any of the actual variable names, the correct results display. What am I doing wrong?
output$analysis1 <- renderPlot({
df <- m1
df <- subset(df, df$rcid %in% unique(Select_voting()$rcid))
ggplot(subset(df, unsc_region == 'Latin America'), aes(x = input$variable, y = reorder(CountryAbb, input$variable),
color = ordvote)) +
geom_point(size=3) + theme_light() + ggtitle("Latin America") + scale_colour_manual(values=vcolors)
})