Why are the colors wrong? - r

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()

Related

R ggplot vs barplot 2

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)

Getting old api error in gganimate while animating cartogram plot in r

I am new to cartogram, geospatial & gganimate and was recreating animated plot by using code from website: https://www.r-graph-gallery.com/a-smooth-transition-between-chloropleth-and-cartogram.html
But at the last step of animating I am now getting this error:
Error: It appears that you are trying to use the old API, which has been deprecated. Please update your code to the new API or install the old version of gganimate from https://github.com/thomasp85/gganimate/releases/tag/v0.1.1
My Code (with different object names from website):
library(tidyverse)
library(maptools)
library(cartogram)
library(viridis)
library(sf)
library(mapproj)
library(gganimate)
library(tweenr)
data("wrld_simpl")
cartogram_data = wrld_simpl[wrld_simpl$REGION==2,]
cartogram_data_sf <- st_as_sf(cartogram_data)
cartogram_sf_proj = st_transform(cartogram_data_sf,3857)
cartogram_plot <- cartogram::cartogram(cartogram_sf_proj, "POP2005", itermax =7)
cartogram_data_df <- broom::tidy(cartogram_data) %>%
dplyr::left_join(cartogram_data#data, by=c("id"="ISO3"))
cartogram_df <- broom::tidy(cartogram_data) %>%
dplyr::left_join(cartogram_data#data, by=c("id"="ISO3"))
Here it uses tweenr which I have never seen before:
cartogram_data_df$id <- seq(1,nrow(cartogram_data_df))
cartogram_df$id <- seq(1,nrow(cartogram_df))
data <- rbind(cartogram_df, cartogram_data_df, cartogram_df)
# Set transformation type + time
data$ease <- "cubic-in-out"
data$time <- rep(c(1:3), each=nrow(cartogram_df))
# Calculate the transition between these 2 objects?
dt <- tween_elements(data, time='time', group='id', ease='ease', nframes = 30)
# check a few frame
ggplot() +
geom_polygon(data = dt %>% filter(.frame==0) %>% arrange(order),
aes(fill = POP2005, x = long, y = lat, group = group), size=0, alpha=0.9
)
ggplot() +
geom_polygon(data = dt %>% filter(.frame==5) %>% arrange(order),
aes(fill = POP2005, x = long, y = lat, group = group) , size=0, alpha=0.9
)
ggplot() +
geom_polygon(data = dt %>% filter(.frame==10) %>% arrange(order),
aes(fill = POP2005, x = long, y = lat, group = group) , size=0, alpha=0.9
)
Animation Code: (this step/code chunk gives an error)
africa_plt <- ggplot() +
geom_polygon(data = dt %>% arrange(order) , aes(fill = POP2005/1000000, x = long, y = lat, group = group, frame=.frame) , size=0, alpha=0.9) +
theme_void() +
scale_fill_viridis(
name="Population (M)", breaks=c(1,50,100, 140),
guide = guide_legend(
keyheight = unit(3, units = "mm"), keywidth=unit(12, units = "mm"),
label.position = "bottom", title.position = 'top', nrow=1)
) +
labs( title = "Africa", subtitle="Population per country in 2005" ) +
ylim(-35,35) +
theme(
text = element_text(color = "#22211d"),
plot.background = element_rect(fill = "#f5f5f4", color = NA),
panel.background = element_rect(fill = "#f5f5f4", color = NA),
legend.background = element_rect(fill = "#f5f5f4", color = NA),
plot.title = element_text(size= 22, hjust=0.5, color = "#4e4d47", margin = margin(b = -0.1, t = 0.4, l = 2, unit = "cm")),
plot.subtitle = element_text(size= 13, hjust=0.5, color = "#4e4d47", margin = margin(b = -0.1, t = 0.4, l = 2, unit = "cm")),
legend.position = c(0.2, 0.26)
) +
coord_map() +
# transition_manual(F)
# Make the animation
#animation::ani.options(interval = 1/9)
gganimate(africa_plt, "Animated_Africa.gif", title_frame = F)
I have tried using transition_manual(F) instead of gganimate(africa_plt, "Animated_Africa.gif", title_frame = F) but that didn't work either.

Text color with geom_label_repel

Not specific to any particular piece of code, is there a relatively straightforward way to change the color of the text in a geom_label_repel box?
Specifically, I have code that produces the below chart
The percentage in the label box is the percent change in 7-day moving average for the most recent week over the week prior. I'd simply like to color the text red when the value is positive and green when it is negative.
The dataframe for this chart can be copied from here.
The plot code is
#endpoint layer
BaseEndpoints <- smDailyBaseData %>% filter(Base %in% AFMCbases) %>%
group_by(Base) %>%
filter(DaysSince == max(DaysSince)) %>%
select(Base, abbv, DaysSince, newRate,label) %>%
ungroup()
ZoomEndpoints <- BaseEndpoints %>% filter(Base != 'Edwards') %>%
mutate(zoom = TRUE)
CAEndPoint <- BaseEndpoints %>% filter(Base == 'Edwards') %>%
mutate(zoom = FALSE)
ZoomEndpoints <- rbind(ZoomEndpoints, CAEndPoint)
BasePlot <- smDailyBaseData %>% filter(Base %in% AFMCbases) %>%
ggplot(mapping = aes(x = as.numeric(DaysSince), y = newRate)) +
geom_line(aes(color=abbv),show.legend = FALSE) +
scale_color_ucscgb() +
geom_point(data = BaseEndpoints,size = 1.5,shape = 21,
aes(color = abbv,fill = abbv), show.legend = FALSE) +
geom_label_repel(data=ZoomEndpoints, aes(label=label), show.legend = FALSE,
vjust = 0, xlim=c(105,200), size=3, direction='y') +
labs(x = "Days Since First Confirmed Case",
y = "% Local Population Infected Daily") +
theme(plot.title = element_text(size = rel(1), face = "bold"),
plot.subtitle = element_text(size = rel(0.7)),
plot.caption = element_text(size = rel(1))) +
facet_zoom(xlim = c(50,120), ylim=c(0,0.011),zoom.data=zoom)
print(BasePlot)
Yes, it's as simple as this:
library(ggplot2)
df <- data.frame(x = c(-1, -1, 1, 1), y = c(-1, 1, 1, -1), value = c(-2, -1, 1, 2))
ggplot(df, aes(x, y)) +
geom_point(size = 3) +
ggrepel::geom_label_repel(aes(label = value, colour = factor(sign(value)))) +
lims(x = c(-100, 100), y = c(-100, 100)) +
scale_colour_manual(values = c("red", "forestgreen"))
EDIT
Now we have a more concrete example, I can see the problem more clearly. There are workarounds such as using ggnewscale or a hand-crafted solution such as Ian Campbell's thorough example. Personally, I would just note that you haven't used the fill scale yet, and this looks pretty good to my eye:
Here's a bit of a hacky solution since you can't have two scale_color_*'s at the same time:
The approach centers on manually assigning the color outside of aes in the geom_label_repel call. Adding one to the grepl result that searches for the minus sign in the label allows you to subset the two colors. You need two colors for each label, I assume for the box and for the text, so I used rep.
smDailyBaseData %>%
ggplot(mapping = aes(x = as.numeric(DaysSince), y = newRate)) +
geom_line(aes(color=abbv),show.legend = FALSE) +
scale_color_ucscgb() +
geom_point(data = BaseEndpoints,size = 1.5,shape = 21,
aes(color = abbv,fill = abbv), show.legend = FALSE) +
geom_label_repel(data=ZoomEndpoints, aes(label=label),
color = rep(c("green","red")[1+grepl("\\-\\d",as.factor(ZoomEndpoints$label))],times = 2),
show.legend = FALSE, vjust = 0, xlim=c(105,200),
size=3, direction='y') +
labs(x = "Days Since First Confirmed Case",
y = "% Local Population Infected Daily") +
theme(plot.title = element_text(size = rel(1), face = "bold"),
plot.subtitle = element_text(size = rel(0.7)),
plot.caption = element_text(size = rel(1))) +
facet_zoom(xlim = c(50,120), ylim=c(0,0.011),zoom.data=zoom)
Data Setup
#source("https://pastebin.com/raw/Vn2abQ4a")
BaseEndpoints <- smDailyBaseData %>%
group_by(Base) %>%
dplyr::filter(DaysSince == max(DaysSince)) %>%
dplyr::select(Base, abbv, DaysSince, newRate,label) %>%
ungroup()
ZoomEndpoints <- BaseEndpoints %>% filter(Base != 'Edwards') %>%
mutate(zoom = TRUE)
CAEndPoint <- BaseEndpoints %>% filter(Base == 'Edwards') %>%
mutate(zoom = FALSE)
ZoomEndpoints <- rbind(ZoomEndpoints, CAEndPoint)

Complex Chart in R/ggplot with Proper Legend Display

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")))

Increase spacing on y axis tick labels ggplot2 [duplicate]

This question already has answers here:
Expand spacing between tick marks on x axis
(2 answers)
Closed 8 months ago.
I would like to increase the spacing of the y-axis ticks in order to make the graph (labels) more readable. How can I achieve this?
packages_list <- c("dplyr", "data.table", "ggplot2", "mondate", "tidyr",
"lubridate", "stringr", "ggrepel")
lapply(packages_list, require, character.only = TRUE)
company <- paste(1:61, rep(LETTERS), sep = "")
mort_table <- rep_len(c(6065, 7680, 8590, 9500), length.out = 61)
disc_rate <- rep_len(c(3,4), length.out = 61)
data <- data_frame(company = company, disc_rate = disc_rate, mort_table =
mort_table)
ggplot(data, aes(x = company, y= disc_rate, label = disc_rate)) +
geom_point(aes(color = factor(mort_table)), size = 6, show.legend = T) +
geom_text(color = "white", size = 1.5) +
geom_hline(yintercept=3.5, size=1, linetype="dotted", color="red") +
theme(panel.grid.major.x = element_line(), legend.position = "top") +
coord_flip()
This is the best I could come up with. This reduces the number of tick labels to 5.
library(ggplot2)
library(dplyr, warn.conflicts = FALSE)
library(forcats)
company <- paste(1:61, rep(LETTERS), sep = "")
mort_table <- rep_len(c(6065, 7680, 8590, 9500), length.out = 61)
disc_rate <- rep_len(c(3,4), length.out = 61)
data <- tibble(company, disc_rate, mort_table)
axis_levels <-
data %>%
mutate(company = fct_inorder(company)) %>%
pull(company) %>%
.[seq(1, nlevels(.), length = 5)] %>%
as.character()
data %>%
mutate(company = fct_inorder(company)) %>%
ggplot(aes(x = company, y = disc_rate, label = disc_rate)) +
geom_point(aes(color = factor(mort_table)), size = 6, show.legend = TRUE) +
geom_text(color = "white", size = 1.5) +
geom_hline(yintercept = 3.5, size = 1, linetype = "dotted", color = "red") +
theme(panel.grid.major.x = element_line(), legend.position = "top") +
scale_x_discrete(breaks = axis_levels) +
coord_flip()
Created on 2021-03-25 by the reprex package (v1.0.0)

Resources