I am trying to replicate the stacked bar chart built via ggplot() into a chart that uses barplot(). My code is below. My problem is that barplot() produces not a stacked chart. What do I do in a wrong way here? Thanks!
Data is accessible at the following link.
# link to the data: https://drive.google.com/file/d/16FQ7APc0r1IYS_geMdeBRoMiUMaF01t3/view?usp=sharing
df <- read.csv("US Sectoral Balances 3.csv")
# ggplot()
df %>%
# Plotting the data via ggplot2()
ggplot(aes(x = TimePeriod, y = DataValue_per_GDP, color = Sectors, fill = Sectors)) +
geom_col(aes(fill = Sectors), position = "stack", width = 1) +
scale_y_continuous(labels = percent,
sec.axis = sec_axis(~., name = "", labels = percent)) +
scale_x_discrete(name=NULL, breaks = brks) +
scale_fill_manual(values=c("#FF3399", "#3399FF", "#66CC99","#0022CC","#11AA00")) +
scale_color_manual(values=c("#FF3399", "#3399FF", "#66CC99","#0022CC","#11AA00")) +
guides(fill = guide_legend(title.theme =
element_text(size = 9, face = "bold",
colour = "black", angle = 0))) +
labs(x ="", y = "(% of GDP)",
subtitle = "Three-sector breakdown",
title = paste0("U.S. Sectoral Balances",
" through ", year(max(df$date))," ",quarters(max(df$date))),
caption = paste0("\nNote: data is from the BEA's Table 5.1. Saving and Investment by Sector.",
"\n\nSource: BEA.")) +
theme(axis.text.x = element_text(angle = 90, hjust = 1, size = 10),
plot.caption = element_text(hjust = 0, size = 8))
# barplot()
l <- min(
length(df[substr(df$Sectors,1,1)=="A",]$DataValue_per_GDP),
length(df[substr(df$Sectors,1,1)=="B",]$DataValue_per_GDP),
length(df[substr(df$Sectors,1,1)=="C",]$DataValue_per_GDP)
)
bar_data <- matrix(data = rbind(df[substr(df$Sectors,1,1)=="A",]$DataValue_per_GDP*100,
df[substr(df$Sectors,1,1)=="B",]$DataValue_per_GDP*100,
df[substr(df$Sectors,1,1)=="C",]$DataValue_per_GDP*100),
nrow = 3, ncol = l)
colnames(bar_data) <- df[substr(df$Sectors,1,1)=="A",]$TimePeriod[1:l]
rownames(bar_data) <- c("A. General government","B. Private","C. External")
barplot(bar_data, col=c("red","blue","green"), beside = FALSE)
barplot(bar_data, col=c("red","blue","green"), beside = TRUE)
Related
I have shiny app to shows some line plots, and I have used ggplotly with ggplot structure, everything was nice, but I was informed that I need to add stacked barplot in addition to line, I will add what I found on internet to modify my code.
options(scipen = 999)
df <- data.frame (country = c("Estonia", "Latvia", "Lithuania", "Estonia", "Latvia", "Lithuania"),
obs_week = c(0,1, 0, 1, 0, 1),
wbeg = c("2022-12-26","2023-01-02", "2022-12-26","2023-01-02","2022-12-26","2023-01-02"),
vp = c(5000000, 6000000, 7000000, 5000000, 6000000, 7000000))
filteredDataplot <- df %>%
filter(obs_week != -1) %>%
group_by(obs_week, wbeg, country) %>%
summarise(vp = sum(vp, na.rm = T)) %>% ungroup()
p <- ggplotly(ggplot(filteredDataplot, aes_string(x= "obs_week", y = "vp", key = "wbeg", fill = "country")) +
geom_bar(stat="identity", position = "stack", color = 'white', size = 0.3) +
stat_summary(aes(group = 1, color = "Total"), fun = sum, geom = "line", color="black") +
stat_summary(aes(group = 1, color = "Total"), fun = sum, geom = "point", color="black") +
geom_vline(xintercept = lubridate::week(Sys.Date()), colour = "red") +
scale_fill_manual(values = c("Estonia" = "#009900",
"Lithuania" = "#1DE6E6",
"Latvia" = "#6666FF"
)
) +
# facet_wrap(~country + time_horizon,
# scales = "free_y",
# ncol = 3) +
#expand_limits(y = 0) +
scale_x_continuous(labels = comma) +
scale_y_continuous(labels = comma) +
theme_bw() +
labs(
title = "Variable profit (Euro)
<span style='font-size:11pt'></span>",
x = "Week", y = "VP (Euro)"
#caption = "<b>Source</b>: "
) +
th`your text`eme_minimal() +
theme(
plot.title = element_markdown(lineheight = 1.1, size = 25),
text = element_text(size = 13),
legend.text = element_markdown(size = 11),
plot.caption = element_markdown(size = 11)
), source = "select", tooltip = c("vp","obs_week","key"))
for (i in 1:length(p$x$data)) {
p$x$data[[i]]$base <- c()
tmp <- p$x$data[[i]]
p$x$data[[i]] <- p$x$data[[length(p$x$data) - i + 1]]
p$x$data[[length(p$x$data) - i + 1]] <- tmp
}
p
so I added simple data here, my main problem is that, legend filtration works well for stacked barplot but I want to make interactive filtration for barplot and line both of them together, for example if you unselect Estonia in legend, then showing sum of only Lithuania and Latvia for line plot, and respective stacked bar plot... and have some more countries and different range of numbers, if you select small range country, then Y axis should also need to be small to see more effectively.
I hope I could explain what I would like to see, thanks a lot
I have a dataframe that has daily data about Covid19 (such as: total_cases,total_deaths) in European countries (there are 49 countries in total). You can see a preview here and you can have the whole dataframe here. I want to create a Bar Chart Race for the variable total_cases for all the European countries with ggplot. So, I followed the steps from this link or (this video) and I wrote the below code:
library(ggplot2)
g1 = ggplot(data = data.europe,
aes(x = as.Date(date),y = total_cases,group = location,
color = location)) + geom_line(size = 0.5) +
labs(y = "Total Cases", x = "Date") +
theme(legend.position = "bottom",legend.box = "vertical",
legend.title = element_blank(),
legend.text = element_text(size = 10))
Then I wrote the below code in order to create the dynamic plot
g1_star = ggplot(data = data.europe,
aes(x = as.Date(date),y = total_cases,group = location,
color = location)) + geom_line(aes(group = as.Date(date)),linetype=1) +
labs(y= "Total Cases", x = "Date") +
theme(legend.position = "bottom",legend.box = "vertical",
legend.title = element_blank(),
legend.text = element_text(size = 10)) +
transition_reveal(as.Date(date))
#We wil create the an animation
library(gifski)
library(gganimate)
animate(g1_star,height= 538,width = 866)
data_star = data.europe %>% group_by(as.Date(date))
However when I wrote these lines:
g1_star_anim = ggplot(data_star,aes(x = as.Date(date),
y = total_cases,
group = location,
fill = location,
color = location)) +
geom_tile(aes(height = total_cases,width = 0.9), alpha = 0.8,color = NA) +
geom_text(aes(y = 0, label = paste(location, " ")), vjust = 0.2, hjust = 1) +
scale_y_continuous(labels = scales::comma) + theme(axis.line=element_blank())
anim1 = g1_star_anim + transition_states(as.Date(date), transition_length = 4,
state_length = 1) +
view_follow(fixed_x = TRUE) +
labs(title = 'Total_cases per year')
The result is:
which isn't expected.
What should I change? Or which code should I write? Can anyone help me because I have been searching for a very long time?
Thanks in advance!
I found that this code shows the top 10 countries based on their total_cases
library(gganimate)
library(hrbrthemes)
library(tidyverse)
data.europe.not.na.star = data.europe.not.na %>%
group_by(as.Date(date)) %>%
arrange(-total_cases) %>%
mutate(rank = row_number()) %>%
filter(rank<=10)
col = c("cadetblue1","aquamarine","chocolate1","gray13","blue3","darkgoldenrod2",
"darkolivegreen1","darkorchid1","lightcoral","deeppink","greenyellow","mediumvioletred",
"midnightblue","olivedrab1","mediumaquamarine","red","seagreen1")
p = data.europe.not.na.star %>%
ggplot(aes(x = -rank,y = total_cases, group = location)) +
geom_tile(aes(y = total_cases / 2, height = total_cases,fill = location),width = 0.9) +
geom_text(aes(label = location), hjust = "right", colour = "gold",fontface = "bold",
nudge_y = -100000) +
geom_text(aes(label = scales::comma(total_cases)), hjust = "left",nudge_y = 100000,
colour = "grey30") +
coord_flip(clip="off") +
scale_fill_manual(name = 'location', values = col) +
scale_x_discrete("") +
scale_y_continuous("",labels=scales::comma) +
hrbrthemes::theme_ipsum(plot_title_size = 32, subtitle_size = 24,caption_size = 20,
base_size = 20) +
theme(panel.grid.major.y=element_blank(),
panel.grid.minor.x=element_blank(),
plot.margin = margin(1,1,1,2,"cm"),
axis.text.y=element_blank()) +
# gganimate code to transition by year:
transition_time(as.Date(date)) +
ease_aes('cubic-in-out') +
labs(title='Bar Char Race of Total Cases in Europe(Top 10)',
subtitle='Total Cases in {round(frame_time,0)}')
animate(p, nframes = 750, fps = 25, end_pause = 50, width = 1200, height = 900)
The result is here
I am using ggplot/usmap libararies to plot highly skewed data onto a map.
Because the data is so skewed, I created uneven interval brackets. See below;
My Code:
library(dplyr)
library(tidyverse)
library(usmap)
library(ggplot2)
library(readxl)
library(rgdal)
plot_usmap(regions = "states",
# fill = 'orange',
labels = TRUE) +
geom_point(data = grant_sh,
size = 5,
aes(x = x,
y = y,
color = funding_cat)) +
theme(
legend.title = element_text(size = 16),
#change legend title font size
legend.text = element_text(size = 14),
#change legend text font size
legend.position = 'left',
plot.title = element_text(size = 22),
plot.subtitle = element_text(size = 16)
) + #+
scale_color_manual(
values = c('#D4148C', # pink muesaum
'#049CFC', #library,blue
'#1C8474',
'#7703fC'),
name = "Map Key",
labels = c(
'$1,500 - $4,000 (n = 7)',
'$4,001 - $6,000 (n = 12)',
'$6,001 - $20,000 (n = 6)',
'$20,001 - $40,000 (n = 25)'
)
) +
guides(colour = guide_legend(override.aes = list(size = 3)))
Current Output
Desired Output
I would like to adjust the legend key to reflect the size of each interval. So, for example 1500-400 would be the smallest icon, and 20,001-40,000 would be the largest.
I want to do this so that the viewer immediately knows that the intervals are not even. Any solution to achieve this outcome is greatly appreciated!
See how the sign/oval next to each interval represents the range of the interval in my example below.
One option to create this kind of legend would be to make it as a second plot and glue it to the main plot using e.g. patchwork.
Note: Especially with a map as the main plot and the export size if any, this approach requires some fiddling to position the legend, e.g. in my code below a added a helper row to the patchwork design to shift the legend upwards.
UPDATE: Update the code to include the counts in the labels. Added a second approach to make the legend using geom_col and a separate dataframe.
library(dplyr, warn = FALSE)
library(usmap)
library(ggplot2)
library(patchwork)
# Make example data
set.seed(123)
cat1 <- c(1500, 4001, 6001, 20001)
cat2 <- c(4000, 6000, 2000, 40000)
n = c(7, 12, 6, 25)
funding_cat <- paste0("$", cat1, " - $", cat2, " (n=", n, ")")
funding_cat <- factor(funding_cat, levels = rev(funding_cat))
grant_sh <- utils::read.csv(system.file("extdata", "us_states_centroids.csv", package = "usmapdata"))
grant_sh$funding_cat = sample(funding_cat, 51, replace = TRUE, prob = n / sum(n))
# Make legend plot
grant_sh_legend <- data.frame(
funding_cat = funding_cat,
n = c(7, 12, 6, 25)
)
legend <- ggplot(grant_sh, aes(y = funding_cat, fill = funding_cat)) +
geom_bar(width = .6) +
scale_y_discrete(position = "right") +
scale_fill_manual(
values = c('#D4148C',
'#049CFC',
'#1C8474',
'#7703fC')
) +
theme_void() +
theme(axis.text.y = element_text(hjust = 0),
plot.title = element_text(size = rel(1))) +
guides(fill = "none") +
labs(title = "Map Key")
map <- plot_usmap(regions = "states",
labels = TRUE) +
geom_point(data = grant_sh,
size = 5,
aes(x = x,
y = y,
color = funding_cat)) +
theme(
legend.position = 'none',
plot.title = element_text(size = 22),
plot.subtitle = element_text(size = 16)
) + #+
scale_color_manual(
values = c('#D4148C', # pink muesaum
'#049CFC', #library,blue
'#1C8474',
'#7703fC'),
name = "Map Key",
labels = c(
'$1,500 - $4,000 (n = 7)',
'$4,001 - $6,000 (n = 12)',
'$6,001 - $20,000 (n = 6)',
'$20,001 - $40,000 (n = 25)'
)
) +
guides(colour = guide_legend(override.aes = list(size = 3)))
# Glue together
design <- "
#B
AB
#B
"
legend + map + plot_layout(design = design, heights = c(5, 1, 1), widths = c(1, 10))
Using geom_bar the counts are computed from your dataset grant_sh. A second option would be to compute the counts manually or use a manually created dataframe and then use geom_col for the legend plot:
grant_sh_legend <- data.frame(
funding_cat = funding_cat,
n = c(7, 12, 6, 25)
)
legend <- ggplot(grant_sh, aes(y = funding_cat, n = n, fill = funding_cat)) +
geom_col(width = .6) +
scale_y_discrete(position = "right") +
scale_fill_manual(
values = c('#D4148C',
'#049CFC',
'#1C8474',
'#7703fC')
) +
theme_void() +
theme(axis.text.y = element_text(hjust = 0),
plot.title = element_text(size = rel(1))) +
guides(fill = "none") +
labs(title = "Map Key")
I have a graph made with ggplot2, I chose a color for the fill and another for the border, but the border color is overlapping the fill color, even if I decrease its size. Generating the graph on macOS doesn't return any errors, only on Windows.
I'm using the same version of R and ggplot2 in the two systems.
Graph on Windows 10:
Graph on macOS Catalina:
Code used in both systems:
library(tidyverse)
library(zoo)
library(httr)
library(openxlsx)
url <- httr::GET("https://xx9p7hp1p7.execute-api.us-east-1.amazonaws.com/prod/PortalGeral",
httr::add_headers("X-Parse-Application-Id" =
"unAFkcaNDeXajurGB7LChj8SgQYS2ptm")) %>%
httr::content() %>%
'[['("results") %>%
'[['(1) %>%
'[['("arquivo") %>%
'[['("url")
dados <- openxlsx::read.xlsx(url) %>%
filter(is.na(municipio), is.na(codmun))
for(i in 9:16) {
dados[,i] <- as.numeric(dados[,i])
}
dados[,8] <- convertToDate(dados[,8])
dados_mm7d <- dados %>%
mutate(mm7dCasos = rollmean(casosNovos, 7, fill = list(NA, NULL, NA), align = "right"),
mm7dCasos = ifelse(is.na(mm7dCasos), 0, mm7dCasos),
mm7dCasos = ifelse(is.infinite(mm7dCasos), 0, mm7dCasos)) %>%
filter(data > "2020-03-30", !is.na(estado))
dados %>%
filter(data > "2020-03-23", !is.na(estado)) %>%
ggplot() +
geom_col(aes(x = data, y = casosNovos), na.rm = TRUE, color = "black", fill = "#0181ae", size = 0.1, width = 0.6) +
geom_line(data = dados_mm7d, aes(x = data, y = mm7dCasos), color = "#dd0533", size = 0.7) +
scale_y_continuous(trans = 'log2', labels = scales::comma) +
labs(x = "", y = "") +
coord_cartesian(ylim = c(2, 8192)) +
scale_x_date(date_labels = "%b %d", date_breaks = "2 week") +
theme(text = element_text(size = 10), axis.text.x = element_text(angle = 90, hjust = 1)) +
theme(panel.background = element_rect(fill = "white", colour = "grey10", linetype = "solid")) +
facet_wrap(~estado, nrow = 3)
You can plot your graph using Cairo to get anti-aliased graphs on Windows:
install.packages("Cairo")
library(Cairo)
Cairo("graph.png", units="in", width=8, height=7, dpi=200)
here goes your plot code
dev.off()
This is my first question to StackExchange, and I've searched for answers that have been helpful, but haven't really gotten me to where I'd like to be.
This is a stacked bar chart, combined with a point chart, combined with a line.
Here's my code:
theme_set(theme_light())
library(lubridate)
FM <- as.Date('2018-02-01')
x.range <- c(FM - months(1) - days(1) - days(day(FM) - 1), FM - days(day(FM) - 1) + months(1))
x.ticks <- seq(x.range[1] + days(1), x.range[2], by = 2)
#populate example data
preds <- data.frame(FM = FM, DATE = seq(x.range[1] + days(1), x.range[2] - days(1), by = 1))
preds <- data.frame(preds, S_O = round(seq(1, 1000000, by = 1000000/nrow(preds))))
preds <- data.frame(preds, S = round(ifelse(month(preds$FM) == month(preds$DATE), day(preds$DATE) / 30.4, 0) * preds$S_O))
preds <- data.frame(preds, O = preds$S_O - preds$S)
preds <- data.frame(preds, pred_sales = round(1000000 + rnorm(nrow(preds), 0, 10000)))
preds$ma <- with(preds, stats::filter(pred_sales, rep(1/5, 5), sides = 1))
y.max <- ceiling(max(preds$pred_sales) / 5000) * 5000 + 15000
line.cols <- c(O = 'palegreen4', S = 'steelblue4',
P = 'maroon', MA = 'blue')
fill.cols <- c(O = 'palegreen3', S = 'steelblue3',
P = 'red')
p <- ggplot(data = preds,
mapping = aes(DATE, pred_sales))
p <- p +
geom_bar(data = reshape2::melt(preds[,c('DATE', 'S', 'O')], id.var = 'DATE'),
mapping = aes(DATE, value, group = 1, fill = variable, color = variable),
width = 1,
stat = 'identity',
alpha = 0.5) +
geom_point(mapping = aes(DATE, pred_sales, group = 2, fill = 'P', color = 'P'),
shape = 22, #square
alpha = 0.5,
size = 2.5) +
geom_line(data = preds[!is.na(preds$ma),],
mapping = aes(DATE, ma, group = 3, color = 'MA'),
alpha = 0.8,
size = 1) +
geom_text(mapping = aes(DATE, pred_sales, label = formatC(pred_sales / 1000, format = 'd', big.mark = ',')),
angle = 90,
size = 2.75,
hjust = 1.25,
vjust = 0.4) +
labs(title = sprintf('%s Sales Predictions - %s', 'Overall', format(FM, '%b %Y')),
x = 'Date',
y = 'Volume in MMlbs') +
theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1, size = 8),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
legend.title = element_blank(),
legend.position = 'bottom',
legend.text = element_text(size = 8),
legend.margin = margin(t = 0.25, unit = 'cm')) +
scale_x_date(breaks = x.ticks,
date_labels = '%b %e',
limits = x.range) +
scale_y_continuous(limits = c(0, y.max),
labels = function(x) { formatC(x / 1000, format='d', big.mark=',') }) +
scale_color_manual(values = line.cols,
breaks = c('MA'),
labels = c(MA = 'Mvg Avg (5)')) +
scale_fill_manual(values = fill.cols,
breaks = c('P', 'O', 'S'),
labels = c(O = 'Open Orders', S = 'Sales', P = 'Predictions'))
p
The chart it generates is this:
As you can see, the legend does a couple of funky things. It's close, but not quite there. I only want boxes with exterior borders for Predictions, Open Orders, and Sales, and only a blue line for the Mvg Avg (5).
Any advice would be appreciated.
Thanks!
Rather late, but if you are still interested to understand this problem, the following should work. Explanations are included as comments within the code:
library(dplyr)
preds %>%
# scale the values for ALL numeric columns in the dataset, before
# passing the dataset to ggplot()
mutate_if(is.numeric, ~./1000) %>%
# since x / y mappings are stated in the top level ggplot(), there's
# no need to repeat them in the subsequent layers UNLESS you want to
# override them
ggplot(mapping = aes(x = DATE, y = pred_sales)) +
# 1. use data = . to inherit the top level data frame, & modify it on
# the fly for this layer; this is neater as you are essentially
# using a single data source for the ggplot object.
# 2. geom_col() is a more succinct way to say geom_bar(stat = "identity")
# (I'm using tidyr rather than reshape package, since ggplot2 is a
# part of the tidyverse packages, & the two play together nicely)
geom_col(data = . %>%
select(S, O, DATE) %>%
tidyr::gather(variable, value, -DATE),
aes(y = value, fill = variable, color = variable),
width = 1, alpha = 0.5) +
# don't show legend for this layer (o/w the fill / color legend would
# include a square shape in the centre of each legend key)
geom_point(aes(fill = 'P', color = 'P'),
shape = 22, alpha = 0.5, size = 2.5, show.legend = FALSE) +
# use data = . %>% ... as above.
# since the fill / color aesthetic mappings from the geom_col layer would
# result in a border around all fill / color legends, avoid it all together
# here by hard coding the line color to "blue", & map its linetype instead
# to create a separate linetype-based legend later.
geom_line(data = . %>% na.omit(),
aes(y = ma, linetype = 'MA'),
color = "blue", alpha = 0.8, size = 1) +
# scales::comma is a more succinct alternative to formatC for this use case
geom_text(aes(label = scales::comma(pred_sales)),
angle = 90, size = 2.75, hjust = 1.25, vjust = 0.4) +
labs(title = sprintf('%s Sales Predictions - %s', 'Overall', format(FM, '%b %Y')),
x = 'Date',
y = 'Volume in MMlbs') +
theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1, size = 8),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
legend.title = element_blank(),
legend.position = 'bottom',
legend.text = element_text(size = 8),
legend.margin = margin(t = 0.25, unit = 'cm')) +
scale_x_date(breaks = x.ticks,
date_labels = '%b %e',
limits = x.range) +
# as above, scales::comma is more succinct
scale_y_continuous(limits = c(0, y.max / 1000),
labels = scales::comma) +
# specify the same breaks & labels for the manual fill / color scales, so that
# a single legend is created for both
scale_color_manual(values = line.cols,
breaks = c('P', 'O', 'S'),
labels = c(O = 'Open Orders', S = 'Sales', P = 'Predictions')) +
scale_fill_manual(values = fill.cols,
breaks = c('P', 'O', 'S'),
labels = c(O = 'Open Orders', S = 'Sales', P = 'Predictions')) +
# create a separate line-only legend using the linetype mapping, with
# value = 1 (i.e. unbroken line) & specified alpha / color to match the
# geom_line layer
scale_linetype_manual(values = 1,
label = 'Mvg Avg (5)',
guide = guide_legend(override.aes = list(alpha = 1,
color = "blue")))