Adding a Legend in ggplot with multiple datasets - r

I am trying to combine multiple datasets into one figure in r. My code doesn't seem to be generating a legend for this data.
My two questions are:
Can I add some code expression into my lines to generate a legend element for each set of data? I thought this would be a command such as 'fill' or 'shape' - but I am wrong
Is there a reason why I am not g generating a legend full stop? I was expecting at least a legend with one set of data - but it appears with none - is one deconflicting with another?
If the above cannot be done, then is there a straightforward way to plot this figure using a 3 column data table using the groupings of each data?
The code is below. You wont be able to reproduce it as I would need to send you the CSV files ( the datasets).
I have included the output figure from the code copied below. Idealy I would like a legend that lists a label for each different line/point +/- a text label at each line.
Thank you for any help!
library(tidyverse)
#These are the datasets I am turning into three dataframes #
bowen.data <- bowen
df <- data.frame(bowen)
lit.data <- lit_data
df <- data.frame(lit_data)
shock.data <- shock_tube_tests
df <- data.frame(shock_tube_tests)
high.data <- high_shock_data
df <- data.frame(high_shock_data)
low.data <- low_shock_data
df <- data.frame(low_shock_data)
#setting limit for my axis#
options(scipen = 1000000)
library(ggplot2)
#Now I wish to plot alll this data on one figure. This data describes duration and peak overpressure of shock waves. Each line of geom_line is trying to plot each datasset to produce each line, or points. I then set the X & Y limiitss, the labelss and the colours. #
ggplot(bowen.data, aes(x=Duration)) +
geom_line(aes(y = survival99), color = "cornflowerblue", linetype="longdash") + geom_line(aes(y = survival90), color="dodgerblue1", linetype="dashed") +
geom_line(aes(y = survival50), color="steelblue", linetype="solid") +
geom_line(aes(y = survival10), color="dodgerblue2", linetype="dotdash") +
geom_line(aes(y = survival1), color="dodgerblue3", linetype="twodash") + geom_line(aes(y = lung), color="darkslategrey", linetype="solid") +
ylim(100,1100000) + xlim(0.2,20) + ylab("Peak Overpressure") + xlab("Duration") +
geom_point(data=high.data, aes(x=duration, y=high), color='seagreen4') +
geom_point(data=low.data, aes(x=duration, y=low), color='indianred') +
geom_point(data=low.data, aes(x=duration, y=low), color='indianred', shape = 13) +
geom_point(data=shock.data, aes(x=duration, y=tube), color='violetred4', shape = 17) +
geom_point(data=lit.data, aes(x=dura, y=lit), color='orange')
Using dput:
structure(list(Duration = c(0.2, 0.3, 0.4, 0.5, 0.6), survival99 = c(3509982.865,
2422907.195, 1883026.274, 1555445.788, 1348277.839), survival90 = c(4138911.806,
2846984, 2206434.933, 1822870.548, 1566705.278), survival50 = c(5104973.144,
3490782.825, 2693285.691, 2217270.161, 1900462.526), survival10 = c(6313217.275,
4294375.461, 3299414.021, 2705203.586, 2313630.72), survival1 = c(7513231.158,
5090961.551, 3899360.722, 3190981.429, 2711178.007), lung = c(1020994.629,
698156.565, 538657.1381, 443454.0321, 380092.5051), X8 = c(NA,
NA, NA, NA, NA)), row.names = c(NA, -5L), class = c("tbl_df",
"tbl", "data.frame"))
[
shock data
structure(list(duration = c(1.00244911, 0.947052916, 1.675566344,
1.6586253, 1.837305476), tube = c(24973.80469, 28125.45703, 169033.3438,
165488.6719, 285638.9375)), row.names = c(NA, -5L), class = c("tbl_df",
"tbl", "data.frame"))
lit data
structure(list(dura = c(2, 6, 1.3, 6.9, 2), lit = c(1000000,
1000000, 760000, 760000, 450000)), row.names = c(NA, -5L), class = c("tbl_df",
"tbl", "data.frame"))
[ `enter image description here][1]

I don't see your desired output. The idea is to assign a colour to each line by mapping the colour aesthetic to a constant string. The simplest option is to select the string that will appear in the legend. It is critical that this is done within the aes call; you are creating a mapping to this variable.
These strings can now be mapped to the appropriate colours by scale color manual.
library(ggplot2)
library(tidyverse)
library(ggthemes)
ggplot(bowen.data, aes(x=Duration)) +
geom_line(aes(y = survival99, color="survival99"), linetype="longdash", size=2) +
geom_line(aes(y = survival90, color="survival90"), linetype="dashed", size=2) +
geom_line(aes(y = survival50, color="survival50"), linetype="solid", size=2) +
geom_line(aes(y = survival10, color="survival10"), linetype="dotdash", size=2) +
geom_line(aes(y = survival1, color="survival1"), linetype="twodash", size=2) +
geom_line(aes(y = lung, color="Lung"), linetype="solid", size=2) +
ylim(100,1100000) + xlim(0.2,20) + ylab("Peak Overpressure") + xlab("Duration") +
#geom_point(data=high.data, aes(x=duration, y=high), color='seagreen4') +
#geom_point(data=low.data, aes(x=duration, y=low), color='indianred') +
#geom_point(data=low.data, aes(x=duration, y=low), color='indianred', shape = 13) +
geom_point(data=shock.data, aes(x=duration, y=tube, color='shock.data'), shape = 17, size=3) +
geom_point(data=lit.data, aes(x=dura, y=lit, color='lit.data'), size=3)+
theme_pander()+
theme(axis.text.x = element_text( hjust = 1, face="bold", size=12, color="black"),
axis.title.x = element_text(face="bold", size=16, color="black"),
axis.text.y = element_text(face="bold", size=12, color="black"),
axis.title.y = element_text(face="bold", size=16, color="black"),
legend.title=element_blank(),
legend.text = element_text(family="Times", color = "black", size = 16,face="bold"))+
scale_color_manual(values = c("survival1"="dodgerblue3","survival10"="dodgerblue2", "survival50"="steelblue", "survival90"="dodgerblue1", "survival99"="cornflowerblue", "lit.data"="orange","Lung"="darkslategrey","shock.data"="violetred4"))
Plot:
Also you need to adjust the range of the ylim and xlim. Below ylim(0,6600000) + xlim(0.2, 8)
If you want to add labels to lines (bowen.data), I recommend using the using the directlabels library.
Sample code:
library(dplyr)
library(ggplot2)
library(ggthemes)
library(directlabels)
bowen.data%>%
pivot_longer(cols = -1) %>%
ggplot(aes(x=Duration,y=value))+
geom_line(aes(linetype=name, color=name), size=2 )+
scale_color_manual(values = c("lung"="darkslategrey", "survival1"="dodgerblue3","survival10"="dodgerblue2", "survival50"="steelblue", "survival90"="dodgerblue1", "survival99"="cornflowerblue"))+
scale_linetype_manual(values=c("lung"="solid","survival1" = "twodash", "survival10" = "dotdash", "survival50" = "solid" , "survival90" = "dashed", "survival99" = "longdash"))+
geom_dl(aes(label = name), method = list(dl.trans(x = x + 0.2),"last.points", cex = 1.2, fontface='bold'))+
ylim(0,6600000) + xlim(0.2, 8) +
labs(x="Duration",y="Peak Overpressure", fill="Factors") +
theme_pander()+
theme(axis.text.x = element_text( hjust = 1, face="bold", size=12, color="black"),
axis.title.x = element_text(face="bold", size=16, color="black"),
axis.text.y = element_text(face="bold", size=12, color="black"),
axis.title.y = element_text(face="bold", size=16, color="black"),
legend.title=element_blank(),
legend.text = element_text(family="Times", color = "black", size = 16,face="bold"))
Plot:
Sample data:
bowen.data <-
structure(
list(
Duration = c(0.2, 0.3, 0.4, 0.5, 0.6),
survival99 = c(
3509982.865,
2422907.195,
1883026.274,
1555445.788,
1348277.839
),
survival90 = c(4138911.806,
2846984, 2206434.933, 1822870.548, 1566705.278),
survival50 = c(
5104973.144,
3490782.825,
2693285.691,
2217270.161,
1900462.526
),
survival10 = c(6313217.275,
4294375.461, 3299414.021, 2705203.586, 2313630.72),
survival1 = c(
7513231.158,
5090961.551,
3899360.722,
3190981.429,
2711178.007
),
lung = c(1020994.629,
698156.565, 538657.1381, 443454.0321, 380092.5051),
X8 = c(NA,
NA, NA, NA, NA)
),
row.names = c(NA,-5L),
class = c("tbl_df",
"tbl", "data.frame")
)
shock.data<-structure(
list(
duration = c(1.00244911, 0.947052916, 1.675566344,
1.6586253, 1.837305476),
tube = c(
24973.80469,
28125.45703,
169033.3438,
165488.6719,
285638.9375
)
),
row.names = c(NA,-5L),
class = c("tbl_df",
"tbl", "data.frame")
)
lit.data<-structure(
list(
dura = c(2, 6, 1.3, 6.9, 2),
lit = c(1000000,
1000000, 760000, 760000, 450000)
),
row.names = c(NA,-5L),
class = c("tbl_df",
"tbl", "data.frame")
)
#These are the datasets I am turning into three dataframes #
bowen.data <- bowen
df <- data.frame(bowen)
lit.data <- lit_data
df <- data.frame(lit_data)
shock.data <- shock_tube_tests
df <- data.frame(shock_tube_tests)
#high.data <- high_shock_data
#df <- data.frame(high_shock_data)
#low.data <- low_shock_data
#df <- data.frame(low_shock_data)
#setting limit for my axis#
#options(scipen = 1000000)

Related

Display the basic summary statistics next to the ggplot2 boxplot

Is it possible to display the summary statistics next to the boxplot like:
throu<-structure(list(case_id = c("WC4132791", "WC4130879", "WC4128064",
"WC4121569", "WC4121568", "WC4130112", "WC4131829", "WC4130841",
"WC4130306", "WC4130417", "WC4124741", "WC4130114", "WC4131990",
"WC4121986", "WC4128062", "WC4122478", "WC4130337", "WC4125822",
"WC4127231", "WC4124761", "WC4129398", "WC4131040", "WC4123072",
"WC4131822", "WC4120712", "WC4121978", "WC4130110", "WC4123522",
"WC4130307", "WC4122643", "WC4130383", "WC4122248", "WC4122299",
"WC4122727", "WC4126769", "WC4131186", "WC4125978", "WC4129089",
"WC4121339", "WC4126469", "WC4131800", "WC4125572", "WC4132378",
"WC4123345", "WC4130314", "WC4127722", "WC4129978", "WC4131838",
"WC4130812", "WC4126953"), throughput_time = c(134.283333333333,
93.0756944444445, 83.5340277777778, 67.7833333333333, 65.3069444444444,
63.5402777777778, 59.6861111111111, 56.9791666666667, 55.9048611111111,
54.3826388888889, 52.6958333333333, 52.5125, 51.1680555555556,
50.9520833333333, 50.5402777777778, 49.9291666666667, 49.8201388888889,
49.7375, 49.0916666666667, 46.3069444444444, 45.30625, 45.2451388888889,
44.9722222222222, 44.8215277777778, 44.8048611111111, 43.0701388888889,
42.6840277777778, 42.6576388888889, 42.55, 42.2868055555556,
42.2805555555556, 41.9027777777778, 41.7409722222222, 41.6506944444444,
41.3527777777778, 40.7305555555556, 40.2861111111111, 40.2159722222222,
40.0854166666667, 40.0486111111111, 39.7930555555556, 39.6576388888889,
39.4638888888889, 39.4527777777778, 39.3569444444444, 39.3513888888889,
39.1854166666667, 39.0791666666667, 39.0743055555556, 39.0055555555556
)), row.names = c(NA, 50L), class = "data.frame")
I also have already extracted those in a separate dataframe:
quarts<- structure(list(min = 0, q1 = 7.1515625, median = 11.4881944444444,
mean = 12.3112423835125, q3 = 14.8456597222222, max = 93.0756944444445,
st_dev = 6.72704434885421, iqr = 7.69409722222222), class = "data.frame", row.names = c(NA,
-1L))
# A really basic boxplot.
ggplot(throu, aes( y=throughput_time)) +
geom_boxplot(fill="slateblue", alpha=0.2,width=0.05) +
xlim(-0.1, 0.1) +
xlab("")+ylab("Case duration in days")+ theme_classic()+
theme(axis.ticks.x = element_blank(),
axis.text.x = element_blank())
You could do this using annotate
ggplot(throu, aes( y=throughput_time)) +
geom_boxplot(fill="slateblue", alpha=0.2, width=0.05) +
annotate(geom = 'text', x = 0.05, y = 60, hjust = 0, color = 'gray50',
label = paste(names(quarts), collapse = '\n')) +
annotate(geom = 'text', x = 0.07, y = 60, hjust = 0,
label = paste(round(unlist(quarts), 3), collapse = '\n')) +
xlim(-0.1, 0.1) +
xlab("")+
ylab("Case duration in days")+
theme_classic()+
theme(axis.ticks.x = element_blank(),
axis.text.x = element_blank())

How do I change the symbol for just one legend entry using ggplot2?

I am trying to change the orange dot in the legend to be a diamond with a line through it. I have been unable to change only the one symbol; my attempts have either changed all of the symbols to diamonds, or the legend lists the shapes and colors separately.
Here's reproducible data:
data <- structure(list(Period = c(1, 2, 5, 4, 3),
y1 = c(0.0540540540540541, 0.0256410256410256, 0.454545454545455, 0.451612903225806, 0.333333333333333),
y2 = c(0.157894736842105, 0.163265306122449, 0.277027027027027, 0.289473684210526, 0.318181818181818),
y3 = c(0.0917, 0.1872, 0.1155, 0.0949, 0.2272)), row.names = c(NA, -5L),
class = c("tbl_df", "tbl", "data.frame"))
and
CIinfo <- structure(list(Period = c(1, 2, 3, 4, 5),
PointEstimate = c(0.09170907, 0.18715355, 0.22718774, 0.09494454, 0.11549015),
LowerCI = c(0.02999935,0.09032183, 0.1859676, 0.06469029, 0.08147854),
UpperCI = c(0.1534188, 0.2839853, 0.2684079, 0.1251988, 0.1495018)),
row.names = c(NA, 5L), class = "data.frame")
To generate the plot:
library(ggplot2)
library(ggtext) #text box for plot title
scatter <- ggplot(data) +
geom_point(aes(x=Period, y=y1, colour="prevalence"), size=4) + #colour is for legend label
geom_segment(data = CIinfo, aes(x=Period, y=LowerCI, xend=Period, yend=UpperCI, #bars for 95% CI
colour="estimated probability and 95%CI"),
size=2, lineend = "round", alpha=0.7, show.legend = FALSE) + #alpha is transparency
geom_point(aes(x=Period, y=y2, colour="median prevalence"), size=3) +
geom_point(aes(x=Period, y=y3, colour="estimated probability and 95%CI"), size=4, shape=18) +
theme_minimal() +
scale_color_manual(values = c("#d2d2d2","#365C8DFF","#EB6529FF"),
breaks = c("prevalence","median prevalence","estimated probability and 95%CI"), #set order of legend
labels = ~ stringr::str_wrap(.x, width = 28)) + #width of legend
labs(x = "Time Period",
title ="Estimated Probability and Prevalence Rates") +
theme(plot.title = element_textbox(hjust = 0.5, #center title
margin = margin(b = 15)), #pad under the title
plot.title.position = "plot",
axis.title.x = element_text(margin = margin(t = 10, r = 0, b = 0, l = 0)), #pad x axis label
axis.title.y = element_blank(), # remove y-axis label
axis.text = element_text(face="bold"), #bold axis labels
panel.grid.minor.x = element_blank(), # remove vertical minor gridlines
legend.title = element_blank(), # remove legend label
legend.spacing.y = unit(8, "pt") # space legend entries
) +
guides(colour = guide_legend(byrow = TRUE)) + # space legend entries
scale_y_continuous(labels = scales::percent, limits = c(0, .5)) # y-axis as %
scatter
Does something like this help? I'm using a random example, but hopefully it points you in the right direction:
library(tidyverse)
draw_key_custom <- function(data, params, size) {
if (data$colour == "orange") {
data$size <- .5
draw_key_pointrange(data, params, size)
} else {
data$size <- 2
draw_key_point(data, params, size)
}
}
mtcars |>
ggplot(aes(hp, mpg, color = as.factor(cyl)))+
geom_point(key_glyph = "custom")+
guides(color = guide_legend(
override.aes = list(shape = c(16,16,18),
color= c("black", "black", "orange")))
)
P.S. I borrowed some code from this question: R rotate vline in ggplot legend with scale_linetype_manual

How to update to custom tool tip for ggbarplot when converting to ggplotly / plotly?

I am creating a bar plot using ggbarplot. I am converting the ggbarplot to plotly so that the graph is interactive in the Shiny app. I want the tooltip to not only show the x and y axis but additional detail (i.e. Frequency).
I know in ggplot you can add the text parameter and include that in the ggplotly function. I am not sure how I can achieve the same result when I am using ggbarplot.
Here is my data and code:
data <- structure(list(`concept name` = structure(4:1, .Label = c("NERVOUS SYSTEM",
"ANTIBACTERIALS FOR SYSTEMIC USE", "ANTIINFECTIVES FOR SYSTEMIC USE",
"CARDIOVASCULAR SYSTEM"), class = "factor", scores = structure(c(`ANTIBACTERIALS FOR SYSTEMIC USE` = 189734,
`ANTIINFECTIVES FOR SYSTEMIC USE` = 200931, `CARDIOVASCULAR SYSTEM` = 201684,
`NERVOUS SYSTEM` = 188122), .Dim = 4L, .Dimnames = list(c("ANTIBACTERIALS FOR SYSTEMIC USE",
"ANTIINFECTIVES FOR SYSTEMIC USE", "CARDIOVASCULAR SYSTEM", "NERVOUS SYSTEM"
)))), `# of Patients` = c(201684, 200931, 189734, 188122), w_cond_rate = c(0.8921,
0.8888, 0.8392, 0.8321), w_exp_rate = c(85.26, 83.92, 73.55,
69.24), freq = c(89.21, 88.88, 83.93, 83.21)), class = c("data.table",
"data.frame"), row.names = c(NA, -4L), .internal.selfref = <pointer: 0x55b1b7cd6e90>)
p <- ggbarplot(
data = data,
y = "# of Patients",
x = "concept name",
orientation = "horiz",
fill = "#D91E49",
color = "#D91E49",
ylab = "Cohort Population",
xlab = "",
width = .5,
text = paste("Freq:", data$freq)
) + theme(legend.title = element_blank()) +
theme(plot.title = element_text(vjust = 1)) +
theme_bw() +
ggtitle("Distribution of Drug Treatments in US population") +
theme(plot.title = element_text(size = 10, face = "bold")) +
theme(plot.caption = element_text(size = 7, color = "red")) +
theme(legend.title = element_blank())
ggplotly(p)
I want to add values from column 'freq' displayed in the hovertext.
Link Shows the solution for ggplot with ggplolty. I am looking to do the same with ggbarplot.
You you achieve your desired result via + aes(text = paste("Freq:", freq)) which adds your tooltip to the set of global aesthetics:
library(ggpubr)
library(plotly)
p <- ggbarplot(
data = data,
y = "# of Patients",
x = "concept name",
orientation = "horiz",
fill = "#D91E49",
color = "#D91E49",
ylab = "Cohort Population",
xlab = "",
width = .5
) +
aes(text = paste("Freq:", freq)) +
theme(legend.title = element_blank()) +
theme(plot.title = element_text(vjust = 1)) +
theme_bw() +
ggtitle("Distribution of Drug Treatments in US population") +
theme(plot.title = element_text(size = 10, face = "bold")) +
theme(plot.caption = element_text(size = 7, color = "red")) +
theme(legend.title = element_blank())
ggplotly(p)

how to add manually a legend to ggplot [duplicate]

This question already has an answer here:
ggplot2 add manual legend for two data series
(1 answer)
Closed 2 years ago.
I want to add manually a legend to ggplot in r. The problem of my code is that it does not show the right symbols (blue point, blue dashed line and red solid line). Here the code and the plot.
predict_ID1.4.5.6.7 <- predict(lm_mRNATime, ID1.4.5.6.7)
ID1.4.5.6.7$predicted_mRNA <- predict_ID1.4.5.6.7
colors <- c("data" = "Blue", "predicted_mRNA" = "red","fit"="Blue")
ggplot( data = ID1.4.5.6.7, aes(x=Time,y=mRNA,color="data")) +
geom_point()+
scale_x_discrete(limits=c('0','20','40','60','120'))+
labs(title="ID-1,ID-4,ID-5,ID-6,ID-7",y="mRNA", x="Time [min]", color = "Legend") +
scale_color_manual(values = colors)+
geom_line(aes(x=Time,y=predicted_mRNA,color="predicted_mRNA"),lwd=1.3)+
geom_smooth(method = "lm",aes(color="fit",lty=2),se=TRUE,lty=2)+
scale_color_manual(values = colors)+
theme(plot.title = element_text(hjust = 0.5),plot.subtitle = element_text(hjust = 0.5))
How can I modify the code in order to get the symbols associated to the plot in the legend ?
The hardest part here was recreating your data set for demonstration purposes. It's always better to add a reproducible example. Anyway, the following should be close:
library(ggplot2)
set.seed(123)
ID1.4.5.6.7 <- data.frame(Time = c(rep(1, 3),
rep(c(2, 3, 4, 5), each = 17)),
mRNA = c(rnorm(3, 0.1, 0.25),
rnorm(17, 0, 0.25),
rnorm(17, -0.04, 0.25),
rnorm(17, -0.08, 0.25),
rnorm(17, -0.12, 0.25)))
lm_mRNATime <- lm(mRNA ~ Time, data = ID1.4.5.6.7)
Now we run your code with the addition of a custom colour guide:
predict_ID1.4.5.6.7 <- predict(lm_mRNATime, ID1.4.5.6.7)
ID1.4.5.6.7$predicted_mRNA <- predict_ID1.4.5.6.7
colors <- c("data" = "Blue", "predicted_mRNA" = "red", "fit" = "Blue")
p <- ggplot( data = ID1.4.5.6.7, aes(x = Time, y = mRNA, color = "data")) +
geom_point() +
geom_line(aes(x = Time, y = predicted_mRNA, color = "predicted_mRNA"),
lwd = 1.3) +
geom_smooth(method = "lm", aes(color = "fit", lty = 2),
se = TRUE, lty = 2) +
scale_x_discrete(limits = c('0', '20', '40', '60', '120')) +
scale_color_manual(values = colors) +
labs(title = "ID-1, ID-4, ID-5, ID-6, ID-7",
y = "mRNA", x = "Time [min]", color = "Legend") +
guides(color = guide_legend(
override.aes = list(shape = c(16, NA, NA),
linetype = c(NA, 2, 1)))) +
theme(plot.title = element_text(hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5),
legend.key.width = unit(30, "points"))

Error: Invalid input: date_trans works with objects of class Date only when modifyin x axis

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.

Resources