So I want to annotate outside my plot to create a new x-axis, as is shown here by Henrik: Multi-row x-axis labels in ggplot line chart
But everything breaks when I try to add a log y axis.
Here's my example data:
# Data
Type = rep(c("type1", "type2"), each = 6)
Gen = rep(rep(c("-", "G+"), each = 3), 2)
A = c(4.98E+05, 5.09E+05, 1.03E+05, 3.08E+05, 5.07E+03, 4.22E+04, 6.52E+05, 2.51E+04, 8.66E+05, 8.10E+04, 6.50E+06, 1.64E+06)
B = c(6.76E+07, 3.25E+07, 1.11E+07, 2.34E+06, 4.10E+04, 1.20E+06, 7.50E+07, 1.65E+05, 9.52E+06, 5.92E+06, 3.11E+08, 1.93E+08)
df = melt(data.frame(Type, Gen, A, B))
Here's my code showing what I want the x axis to look like, but without a log y axis:
# main graph without log y axis
g1 <- ggplot(data = df, aes(x = interaction(Type, Gen, lex.order = TRUE), y = value, group = 1)) +
stat_summary(fun.y = "mean", geom = "bar") +
scale_x_discrete(limits = c("type1.-", "type2.-", "type1.G+", "type2.G+")) +
coord_cartesian(ylim = c(1, 10^9), expand = FALSE) +
annotate(geom = "text", x = (1:4), y = -1*10^8, label = c("type1", "type2", "type1", "type2"), size = 4) +
annotate(geom = "text", x = 3.5, y = -2*10^8, label = "G+", size = 4) +
geom_segment(aes(x = 3, y = -1.5*10^8, xend = 4, yend = -1.5*10^8))+
theme(plot.margin = unit(c(1, 1, 4, 1), "lines"),
axis.title.x = element_blank(),
axis.text.x = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank())
# turning off clipping
g2 <- ggplot_gtable(ggplot_build(g1))
g2$layout$clip[g2$layout$name == "panel"] <- "off"
grid::grid.draw(g2)
This is all fine, but as soon as I toss in
scale_y_log10()
To yield:
# main graph with log y axis
g1 <- ggplot(data = df, aes(x = interaction(Type, Gen, lex.order = TRUE), y = value, group = 1)) +
scale_y_log10() +
stat_summary(fun.y = "mean", geom = "bar") +
scale_x_discrete(limits=c("type1.-", "type2.-", "type1.G+", "type2.G+")) +
coord_cartesian(ylim = c(1, 10^9), expand = FALSE) +
annotate(geom = "text", x = (1:4), y = -1*10^2, label = c("type1","type2","type1","type2"), size = 4) +
annotate(geom = "text", x = 3.5, y = -2*10^2, label = "G+", size = 4) +
geom_segment(aes(x = 3, y = -1.5*10^2, xend = 4, yend = -1.5*10^2)) +
theme(plot.margin = unit(c(1, 1, 4, 1), "lines"),
axis.title.x = element_blank(),
axis.text.x = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank())
# turning off clipping
g2 <- ggplot_gtable(ggplot_build(g1))
g2$layout$clip[g2$layout$name == "panel"] <- "off"
grid::grid.draw(g2)
it all stops working and I get errors:
1: In self$trans$transform(x) : NaNs produced
2: Transformation introduced infinite values in continuous y-axis
3: Removed 4 rows containing missing values (geom_text).
(You actually get more errors, but they're just repeats for each annotation you add)
Can anyone offer some suggestions?
Related
I am trying to reproduce this kind of Figure, with two densities, a first one pointing upwards and a second one pointing downwards. I would also like to have some blank space between the two densities.
Here is the code I am currently using.
library(hrbrthemes)
library(tidyverse)
library(RWiener)
# generating data
df <- rwiener(n = 1e2, alpha = 2, tau = 0.3, beta = 0.5, delta = 0.5)
df %>%
ggplot(aes(x = q) ) +
geom_density(
data = . %>% filter(resp == "upper"),
aes(y = ..density..),
colour = "steelblue", fill = "steelblue",
outline.type = "upper", alpha = 0.8, adjust = 1, trim = TRUE
) +
geom_density(
data = . %>% filter(resp == "lower"),
aes(y = -..density..), colour = "orangered", fill = "orangered",
outline.type = "upper", alpha = 0.8, adjust = 1, trim = TRUE
) +
# stimulus onset
geom_vline(xintercept = 0, lty = 1, col = "grey") +
annotate(
geom = "text",
x = 0, y = 0,
# hjust = 0,
vjust = -1,
size = 3, angle = 90,
label = "stimulus onset"
) +
# aesthetics
theme_ipsum_rc(base_size = 12) +
theme(axis.text.y = element_blank() ) +
labs(x = "Reaction time (in seconds)", y = "") +
xlim(0, NA)
Which results in something like...
How could I add some vertical space between the two densities to reproduce the above Figure?
If you want to try without faceting, you're probably best to just plot the densities as polygons with adjusted y values according to your desired spacing:
s <- 0.25 # set to change size of the space
ud <- density(df$q[df$resp == "upper"])
ld <- density(df$q[df$resp == "lower"])
x <- c(ud$x[1], ud$x, ud$x[length(ud$x)],
ld$x[1], ld$x, ld$x[length(ld$x)])
y <- c(s, ud$y + s, s, -s, -ld$y - s, -s)
df2 <- data.frame(x = x, y = y,
resp = rep(c("upper", "lower"), each = length(ud$x) + 2))
df2 %>%
ggplot(aes(x = x, y = y, fill = resp, color = resp) ) +
geom_polygon(alpha = 0.8) +
scale_fill_manual(values = c("steelblue", "orangered")) +
scale_color_manual(values = c("steelblue", "orangered"), guide = guide_none()) +
geom_vline(xintercept = 0, lty = 1, col = "grey") +
annotate(
geom = "text",
x = 0, y = 0,
# hjust = 0,
vjust = -1,
size = 3, angle = 90,
label = "stimulus onset"
) +
# aesthetics
theme_ipsum_rc(base_size = 12) +
theme(axis.text.y = element_blank() ) +
labs(x = "Reaction time (in seconds)", y = "")
you can try facetting
set.seed(123)
q=rbeta(100, 0.25, 1)
df_dens =data.frame(gr=1,
x=density(df$q)$x,
y=density(df$q)$y)
df_dens <- rbind(df_dens,
data.frame(gr=2,
x=density(df$q)$x,
y=-density(df$q)$y))
ggplot(df_dens, aes(x, y, fill = factor(gr))) +
scale_x_continuous(limits = c(0,1)) +
geom_area(show.legend = F) +
facet_wrap(~gr, nrow = 2, scales = "free_y") +
theme_minimal() +
theme(strip.background = element_blank(),
strip.text.x = element_blank(),
axis.text.y = element_blank(),
axis.title.y = element_blank())
The space between both plots can be increased using panel.spacing = unit(20, "mm"). Instead of facet_grid you can also try facet_grid(gr~., scales = "free_y")
I would like to produce a graphic combining four facets of a graph with insets in each facet showing a detail of the respective plot. This is one of the things I tried:
#create data frame
n_replicates <- c(rep(1:10,15),rep(seq(10,100,10),15),rep(seq(100,1000,100),15),rep(seq(1000,10000,1000),15))
sim_years <- rep(sort(rep((1:15),10)),4)
sd_data <- rep (NA,600)
for (i in 1:600) {
sd_data[i]<-rnorm(1,mean=exp(0.1 * sim_years[i]), sd= 1/n_replicates[i])
}
max_rep <- sort(rep(c(10,100,1000,10000),150))
data_frame <- cbind.data.frame(n_replicates,sim_years,sd_data,max_rep)
#do first basic plot
library(ggplot2)
plot1<-ggplot(data=data_frame, aes(x=sim_years,y=sd_data,group =n_replicates, col=n_replicates)) +
geom_line() + theme_bw() +
labs(title ="", x = "year", y = "sd")
plot1
#make four facets
my_breaks = c(2, 10, 100, 1000, 10000)
facet_names <- c(
`10` = "2, 3, ..., 10 replicates",
`100` = "10, 20, ..., 100 replicates",
`1000` = "100, 200, ..., 1000 replicates",
`10000` = "1000, 2000, ..., 10000 replicates"
)
plot2 <- plot1 +
facet_wrap( ~ max_rep, ncol=2, labeller = as_labeller(facet_names)) +
scale_colour_gradientn(name = "number of replicates", trans = "log",
breaks = my_breaks, labels = my_breaks, colours = rainbow(20))
plot2
#extract inlays (this is where it goes wrong I think)
library(ggpmisc)
library(tibble)
library(dplyr)
inset <- tibble(x = 0.01, y = 10.01,
plot = list(plot2 +
facet_wrap( ~ max_rep, ncol=2, labeller = as_labeller(facet_names)) +
coord_cartesian(xlim = c(13, 15),
ylim = c(3, 5)) +
labs(x = NULL, y = NULL, color = NULL) +
scale_colour_gradient(guide = FALSE) +
theme_bw(10)))
plot3 <- plot2 +
expand_limits(x = 0, y = 0) +
geom_plot_npc(data = inset, aes(npcx = x, npcy = y, label = plot)) +
annotate(geom = "rect",
xmin = 13, xmax = 15, ymin = 3, ymax = 5,
linetype = "dotted", fill = NA, colour = "black")
plot3
That leads to the following graphic:
As you can see, the colours in the insets are wrong, and all four of them appear in each of the facets even though I only want the corresponding inset of course. I read through a lot of questions here (to even get me this far) and also some examples in the ggpmisc user guide but unfortunately I am still a bit lost on how to achieve what I want. Except maybe to do it by hand extracting four insets and then combining them with plot2. But I hope there will be a better way to do this. Thank you for your help!
Edit: better graphic now thanks to this answer, but problem remains partially unsolved:
The following code does good insets, but unfortunately the colours are not preserved. As in the above version each inset does its own rainbow colours anew instead of inheriting the partial rainbow scale from the facet it belongs to. Does anyone know why and how I could change this? In comments I put another (bad) attempt at solving this, it preserves the colors but has the problem of putting all four insets in each facet.
library(ggpmisc)
library(tibble)
library(dplyr)
# #extract inlays: good colours, but produces four insets.
# fourinsets <- tibble(#x = 0.01, y = 10.01,
# x = c(rep(0.01, 4)),
# y = c(rep(10.01, 4)),
# plot = list(plot2 +
# facet_wrap( ~ max_rep, ncol=2) +
# coord_cartesian(xlim = c(13, 15),
# ylim = c(3, 5)) +
# labs(x = NULL, y = NULL, color = NULL) +
# scale_colour_gradientn(name = "number of replicates", trans = "log", guide = FALSE,
# colours = rainbow(20)) +
# theme(
# strip.background = element_blank(),
# strip.text.x = element_blank()
# )
# ))
# fourinsets$plot
library(purrr)
pp <- map(unique(data_frame$max_rep), function(x) {
plot2$data <- plot2$data %>% filter(max_rep == x)
plot2 +
coord_cartesian(xlim = c(12, 14),
ylim = c(3, 4)) +
labs(x = NULL, y = NULL) +
theme(
strip.background = element_blank(),
strip.text.x = element_blank(),
legend.position = "none",
axis.text=element_blank(),
axis.ticks=element_blank()
)
})
#pp[[2]]
inset_new <- tibble(x = c(rep(0.01, 4)),
y = c(rep(10.01, 4)),
plot = pp,
max_rep = unique(data_frame$max_rep))
final_plot <- plot2 +
geom_plot_npc(data = inset_new, aes(npcx = x, npcy = y, label = plot, vp.width = 0.3, vp.height =0.6)) +
annotate(geom = "rect",
xmin = 12, xmax = 14, ymin = 3, ymax = 4,
linetype = "dotted", fill = NA, colour = "black")
#final_plot
final_plot then looks like this:
I hope this clarifies the problem a bit. Any ideas are very welcome :)
Modifying off #user63230's excellent answer:
pp <- map(unique(data_frame$max_rep), function(x) {
plot2 +
aes(alpha = ifelse(max_rep == x, 1, 0)) +
coord_cartesian(xlim = c(12, 14),
ylim = c(3, 4)) +
labs(x = NULL, y = NULL) +
scale_alpha_identity() +
facet_null() +
theme(
strip.background = element_blank(),
strip.text.x = element_blank(),
legend.position = "none",
axis.text=element_blank(),
axis.ticks=element_blank()
)
})
Explanation:
Instead of filtering the data passed into plot2 (which affects the mapping of colours), we impose a new aesthetic alpha, where lines belonging to the other replicate numbers are assigned 0 for transparency;
Use scale_alpha_identity() to tell ggplot that the alpha mapping is to be used as-is: i.e. 1 for 100%, 0 for 0%.
Add facet_null() to override plot2's existing facet_wrap, which removes the facet for the inset.
Everything else is unchanged from the code in the question.
I think this will get you started although its tricky to get the size of the inset plot right (when you include a legend).
#set up data
library(ggpmisc)
library(tibble)
library(dplyr)
library(ggplot2)
# create data frame
n_replicates <- c(rep(1:10, 15), rep(seq(10, 100, 10), 15), rep(seq(100,
1000, 100), 15), rep(seq(1000, 10000, 1000), 15))
sim_years <- rep(sort(rep((1:15), 10)), 4)
sd_data <- rep(NA, 600)
for (i in 1:600) {
sd_data[i] <- rnorm(1, mean = exp(0.1 * sim_years[i]), sd = 1/n_replicates[i])
}
max_rep <- sort(rep(c(10, 100, 1000, 10000), 150))
data_frame <- cbind.data.frame(n_replicates, sim_years, sd_data, max_rep)
# make four facets
my_breaks = c(2, 10, 100, 1000, 10000)
facet_names <- c(`10` = "2, 3, ..., 10 replicates", `100` = "10, 20, ..., 100 replicates",
`1000` = "100, 200, ..., 1000 replicates", `10000` = "1000, 2000, ..., 10000 replicates")
Get overall plot:
# overall facet plot
overall_plot <- ggplot(data = data_frame, aes(x = sim_years, y = sd_data, group = n_replicates, col = n_replicates)) +
geom_line() +
theme_bw() +
labs(title = "", x = "year", y = "sd") +
facet_wrap(~max_rep, ncol = 2, labeller = as_labeller(facet_names)) +
scale_colour_gradientn(name = "number of replicates", trans = "log", breaks = my_breaks, labels = my_breaks, colours = rainbow(20))
#plot
overall_plot
which gives:
Then from the overall plot you want to extract each plot, see here. We can map over the list to extract one at a time:
pp <- map(unique(data_frame$max_rep), function(x) {
overall_plot$data <- overall_plot$data %>% filter(max_rep == x)
overall_plot + # coord_cartesian(xlim = c(13, 15), ylim = c(3, 5)) +
labs(x = NULL, y = NULL) +
theme_bw(10) +
theme(legend.position = "none")
})
If we look at one of these (I've removed the legend) e.g.
pp[[1]]
#pp[[2]]
#pp[[3]]
#pp[[4]]
Gives:
Then we want to add these inset plots into a dataframe so that each plot has its own row:
inset <- tibble(x = c(rep(0.01, 4)),
y = c(rep(10.01, 4)),
plot = pp,
max_rep = unique(data_frame$max_rep))
Then merge this into the overall plot:
overall_plot +
expand_limits(x = 0, y = 0) +
geom_plot_npc(data = inset, aes(npcx = x, npcy = y, label = plot, vp.width = 0.8, vp.height = 0.8))
Gives:
Here is a solution based on Z. Lin's answer, but using ggforce::facet_wrap_paginate() to do the filtering and keeping colourscales consistent.
First, we can make the 'root' plot containing all the data with no facetting.
library(ggpmisc)
library(tibble)
library(dplyr)
n_replicates <- c(rep(1:10,15),rep(seq(10,100,10),15),rep(seq(100,1000,100),15),rep(seq(1000,10000,1000),15))
sim_years <- rep(sort(rep((1:15),10)),4)
sd_data <- rep (NA,600)
for (i in 1:600) {
sd_data[i]<-rnorm(1,mean=exp(0.1 * sim_years[i]), sd= 1/n_replicates[i])
}
max_rep <- sort(rep(c(10,100,1000,10000),150))
data_frame <- cbind.data.frame(n_replicates,sim_years,sd_data,max_rep)
my_breaks = c(2, 10, 100, 1000, 10000)
facet_names <- c(
`10` = "2, 3, ..., 10 replicates",
`100` = "10, 20, ..., 100 replicates",
`1000` = "100, 200, ..., 1000 replicates",
`10000` = "1000, 2000, ..., 10000 replicates"
)
base <- ggplot(data=data_frame,
aes(x=sim_years,y=sd_data,group =n_replicates, col=n_replicates)) +
geom_line() +
theme_bw() +
scale_colour_gradientn(
name = "number of replicates",
trans = "log10", breaks = my_breaks,
labels = my_breaks, colours = rainbow(20)
) +
labs(title ="", x = "year", y = "sd")
Next, the main plot will be just the root plot with facet_wrap().
main <- base + facet_wrap(~ max_rep, ncol = 2, labeller = as_labeller(facet_names))
Then the new part is to use facet_wrap_paginate with nrow = 1 and ncol = 1 for every max_rep, which we'll use as insets. The nice thing is that this does the filtering and it keeps colour scales consistent with the root plot.
nmax_rep <- length(unique(data_frame$max_rep))
insets <- lapply(seq_len(nmax_rep), function(i) {
base + ggforce::facet_wrap_paginate(~ max_rep, nrow = 1, ncol = 1, page = i) +
coord_cartesian(xlim = c(12, 14), ylim = c(3, 4)) +
guides(colour = "none", x = "none", y = "none") +
theme(strip.background = element_blank(),
strip.text = element_blank(),
axis.title = element_blank(),
plot.background = element_blank())
})
insets <- tibble(x = rep(0.01, nmax_rep),
y = rep(10.01, nmax_rep),
plot = insets,
max_rep = unique(data_frame$max_rep))
main +
geom_plot_npc(data = insets,
aes(npcx = x, npcy = y, label = plot,
vp.width = 0.3, vp.height = 0.6)) +
annotate(geom = "rect",
xmin = 12, xmax = 14, ymin = 3, ymax = 4,
linetype = "dotted", fill = NA, colour = "black")
Created on 2020-12-15 by the reprex package (v0.3.0)
I have the code below, and it works fine. The problem is, I would like to add "k" and plot a straight line similar to "z", but "k" is a vector of different numbers. Each element in "k" should be plotted as a line on the 3 facets created. If k was a singular value, I would just repeat the geom_segment() command with different y limits. Is there an easy way to do this? The final output should look like attached, assuming I could draw straight lines.
x <- iris[-1:-3]
bw <- 1
nbin <- 100
y <- head(iris, 50)[2]
z <- 1
k <- c(2, 3, 4)
ggplot(x, aes(x = Petal.Width)) +
geom_density(aes(y = bw *..count.., fill = Species), size = 1, alpha = 0.4) +
geom_segment(aes(x = 5, y = 250, xend = z, yend = 250, color = "red")) +
facet_wrap(~Species)+
scale_x_continuous(labels = scales::math_format(10^.x), limits = c(0, 5), expand = c(0,0)) +
scale_y_continuous(expand = c(0,0), limits = c(0, NA)) +
annotation_logticks(sides = "b", short=unit(-1,"mm"), mid=unit(-2,"mm"), long=unit(-3,"mm")) +
coord_cartesian(clip='off') + theme(panel.background = element_blank(),
panel.border = element_rect(colour = "black", fill=NA))
you can try this. Assuming that your plot is saved as p1.
k_data = data.frame(k, Species = levels(x$Species))
p1 + geom_segment(data = k_data, aes(x =5, y = 200, xend = k, yend = 200),
color = "blue", inherit.aes = F)
The idea is to create a dataframe with the columns k and Species and use this data exclusivley in a geom by setting inherit.aes = F
In this solution, the value of k is made part of the data set being plotted through a pipe. It is a temporary modification of the data set, since it is not assigned back to it nor to any other data set.
library(ggplot2)
library(dplyr)
x <- iris[-1:-3]
str(x)
bw <- 1
nbin <- 100
y <- head(iris, 50)[2]
z <- 1
k <- c(2, 3, 4)
x %>%
mutate(k = rep(k, each = 50)) %>%
ggplot(aes(x = Petal.Width)) +
geom_density(aes(y = bw *..count.., fill = Species), size = 1, alpha = 0.4) +
geom_segment(aes(x = 5, y = 250, xend = z, yend = 250), color = "red") +
geom_segment(aes(x = 5, y = 200, xend = k, yend = 200), color = "blue") +
facet_wrap(~Species)+
scale_x_continuous(labels = scales::math_format(10^.x), limits = c(0, 5), expand = c(0,0)) +
scale_y_continuous(expand = c(0,0), limits = c(0, NA)) +
annotation_logticks(sides = "b", short=unit(-1,"mm"), mid=unit(-2,"mm"), long=unit(-3,"mm")) +
coord_cartesian(clip='off') +
theme(panel.background = element_blank(),
panel.border = element_rect(colour = "black", fill=NA))
I'm running some cluster analysis and I'm using pvclust as showed below:
d.pv <- pvclust(t(mtcars), method = "euclidean",
method.hclust = "complete", nboot = 10)
plot(d.pv)
I want to edit the graph and remove red, green numbers, and grey numbers.
Also I want to color label on x axis according to a a specific column mtcars$cyl
To remove the red, green, and grey numbers use the following:
plot(d.pv, print.num = FALSE, print.pv = FALSE)
Colouring the labels is trickier within the confines of plot.pvclust. I'd suggest converting it into ggplot2 for more flexibility.
# Run pvclust and restructure data
d.pv <- as.dendrogram(pvclust(t(mtcars), method = "euclidean",
method.hclust = "complete", nboot = 10)$hclust)
ddata <- dendro_data(d.pv, type = "rectangle")
# Get data frames to plot
df_seg <- segment(ddata)
df_labs <- data.frame(label(ddata), cyl = as.factor(mtcars[match(label(ddata)$label, rownames(mtcars)), "cyl"]))
# Create ggplot dendrogram
p <- ggplot()
p <- p + geom_segment(data = df_seg,
aes(x = x, y = y, xend = xend, yend = yend),
size = 1.25,
colour = "darkgray",
lineend = "round")
p <- p + geom_text(data = df_labs,
aes(x = x,
y = y,
label = label,
colour = cyl),
nudge_y = -10,
family = "serif",
size = 5,
angle = 90,
hjust = 1)
p <- p + xlab("") + ylab("Height")
p <- p + theme(axis.line.x = element_blank(),
axis.text.x = element_blank(),
axis.ticks.x = element_blank(),
text = element_text(family = "serif"))
p <- p + scale_y_continuous(expand = expand_scale(add = c(85, 0)))
p
I wrote the following code to produce graphs like the one at the end. The thing is that I need to modify the dates shown in the x axis to make the image more understandable (ideally showing a point every two quarters)
Here is the dataset
And here is the code, which works fin until I try to modify scale_x_date. I tried to change in several ways the way in which the dates are introduced in the plot without success. I'd appreciate any help.
#rm(list=ls())
library(urca)
library(ggplot2)
library(ggrepel)
library(reshape2)
library(pracma)
library(extrafont)
library(dplyr)
library(lubridate)
library(zoo)
loadfonts(device = "win")
### Data set
info <- read.csv("base_completa_frame.csv",header=TRUE,dec=",", sep = ";")
info <- ts(info,frequency =4, c(1982,1))
info <- window(info, start=c(2000,4))
### Transf.
data_var <- diff(info,4)/ts(head(info,dim(info)[1]-4), start = c(2001,4), frequency = 4)
data_var <- ts(data_var,frequency =4, c(2001,4))
data_var <- window(data_var, start = c(2002,4))
data_var[,c(25:27)] <- window(info[,c(25:27)], start = c(2002,4))
data_var[,c(7,8,13,14)] <- window(diff(info[,c(7,8,13,14)]), start = c(2002,4))
data_var[,c(25:27,48:50)] <- window(diff(info[,c(25:27,48:50)],4), start = c(2002,4))
colnames(data_var) <- colnames(info)
data_var <- data_var[,-11:-12]
### Graphs
# Growth
time_ref <- time(data_var)
time_rec <- format(date_decimal(as.numeric(time_ref)),"%Y-%m-%d")
time_rec <- seq(as.Date(time_rec[1]), length = length(time_rec)[1], by = "quarter")
time_rec <- na.omit(time_rec[2*(1:length(time_rec))])
label_rec <- as.yearqtr(time_rec)
data_plot <- data.frame(data_var)
data_plot[,"time_ref"] <- time_ref
data_melt <- melt(data_plot, id = "time_ref")
for (i in nomb_melt){
ts_ref <- data_melt[which(data_melt$variable == i),]
ts_ref[,"value"] <- 100*ts_ref[,"value"]
sd_ref <- sd(ts_ref[,"value"])
t_ref <- qt(0.975,dim(ts_ref)[1]-5)*sd_ref/sqrt(dim(ts_ref)[1]-4)
test_L <- tail(ts_ref[,"value"],dim(ts_ref)[1]-4) < head(ts_ref[,"value"],dim(ts_ref)[1]-4) - t_ref
test_L <- which(test_L == TRUE)
test_U <- tail(ts_ref[,"value"],dim(ts_ref)[1]-4) > head(ts_ref[,"value"],dim(ts_ref)[1]-4) + t_ref
test_U <- which(test_U == TRUE)
ts_ref <- tail(ts_ref,dim(ts_ref)[1]-4)
ind_test <- 1:dim(ts_ref)[1]
ind_test[test_L] <- "Menor"
ind_test[test_U] <- "Mayor"
ind_test[-c(test_L,test_U)] <- "Igual"
ts_ref[,"ind_test"] <- ind_test
peaks <- findpeaks(ts_ref[,"value"], sortstr=TRUE)[1:4,2]
mins <- findpeaks(-ts_ref[,"value"], sortstr=TRUE)[1:4,2]
p <- ggplot(ts_ref, aes(x = time_ref, y = value, color = variable)) +
geom_rect(aes(xmin = time_ref,xmax = dplyr::lead(time_ref),
ymin = -Inf, ymax = Inf, fill = factor(ind_test)),
alpha = .2, linetype=0) +
scale_fill_manual(values = alpha(c("yellow","green", "red"), .2)) +
geom_line() + scale_color_manual(values="black") +
labs(x =" ", y = "Porcentaje") +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5),
legend.position="none",
panel.border = element_blank(),
axis.line = element_line(colour = "black"),
strip.text = element_text(size=14),
text=element_text(family="Calibri"),
axis.text.x = element_text(angle=0)) +
geom_label_repel(
data = ts_ref[peaks,],
aes(label = format(round(ts_ref[peaks,"value"],2), 2)),
size = 3,
nudge_y = 1,
arrow = arrow(length = unit(0.01, 'npc')),
point.padding = unit(0.02, 'npc'),
label.size = NA, fill = "white") +
geom_label_repel(
data = ts_ref[mins,],
aes(label = format(round(ts_ref[mins,"value"],2), 2)),
size = 3,
nudge_y = -1,
arrow = arrow(length = unit(0.01, 'npc')),
point.padding = unit(0.02, 'npc'),
label.size = NA, fill = "white") +
scale_x_date(breaks = as.Date(time_rec),
labels = label_rec)
print(p)
}
Finally, here is one of the almost ready plots
I also didn't find a way to solve using scale_x_date. However, since you're using as.yearqtr to create the labels, I tried scale_x_yearqtr and it worked. For simplicity, I'm going to plot for PIB_Colombia and will only include here the code for the plot:
ggplot(ts_ref, aes(x = time_ref, y = value, color = variable)) +
geom_rect(aes(xmin = time_ref,xmax = dplyr::lead(time_ref),
ymin = -Inf, ymax = Inf, fill = factor(ind_test)),
alpha = .2, linetype=0) +
scale_fill_manual(values = alpha(c("yellow","green", "red"), .2)) +
geom_line() + scale_color_manual(values="black") +
labs(x =" ", y = "Porcentaje") +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5),
legend.position="none",
panel.border = element_blank(),
axis.line = element_line(colour = "black"),
strip.text = element_text(size=14),
#text=element_text(family="Calibri"),
axis.text.x = element_text(angle=0)) +
geom_label_repel(
data = ts_ref[peaks,],
aes(label = format(round(ts_ref[peaks,"value"],2), 2)),
size = 3,
nudge_y = 1,
arrow = arrow(length = unit(0.01, 'npc')),
point.padding = unit(0.02, 'npc'),
label.size = NA, fill = "white") +
geom_label_repel(
data = ts_ref[mins,],
aes(label = format(round(ts_ref[mins,"value"],2), 2)),
size = 3,
nudge_y = -1,
arrow = arrow(length = unit(0.01, 'npc')),
point.padding = unit(0.02, 'npc'),
label.size = NA, fill = "white") +
scale_x_yearqtr(format = "%Y Q%q", n=length(time_rec))
This yielded the plot:
I used exactly the number of breaks you wanted to include, but you can control that by changing n within scale_x_yearqtr.