Caching a huge data table with knitr - r

I am trying to cache a big data.table and then make a plot out of it, the code is as follow:
{r gen-data, tidy=TRUE, warning=FALSE, tidy.opts=list(width.cutoff=60), cache = TRUE, cache.lazy=FALSE}
DT = fread("reference.txt.gz", header = FALSE)
vc = c("chromosome_1", "chromosome_2", "chromosome_3", "chromosome_4", "chromosome_5", "chromosome_6")
colnames(DT) = c("chrom", "position", "score", "corrected base", "score of the corrected base")
DT=setDT(DT, key = "chrom")[J(vc), nomatch = 0]
{r, cache=TRUE, tidy=TRUE, warning=FALSE, tidy.opts=list(width.cutoff=60), dependson='gen-data'}
plot = ggplot(data = DT) + geom_line(aes(x = position, y = score, group = 1), stat = "summary_bin", fun.y = "mean", binwidth = 100000, color = ghibli_palette("MononokeMedium")[2])
ttle = paste0("coverage of the 6 longest scaffolds of Shasta + instagraal assembly")
plot = plot + labs(
title = ttle) + theme(plot.title = element_markdown(lineheight = 1.5, size = 12), legend.text = element_markdown(size = 14))
plot = plot + theme(axis.title = element_markdown(size = 12)) + theme(axis.text.x = element_text(size=5)) + theme(axis.text.y = element_text(size=3))
plot = plot + theme(legend.title = element_markdown(size = 12))
p = plot + facet_wrap(~chrom, scales = "free_x") +xlab( "position") + ylab("mean score per 100 Kb windows")
v = ggplotly(p) %>%
layout(
xaxis = list(automargin=TRUE),
yaxis = list(automargin=TRUE)
)
v
So what I was thinking, is that the first chunk read the data into a data.table, then apply the relevant selection, and finally cache a DT object.
However, the first chunk is evaluated every time, no matter what. Therefore I must be doing something wrong but I can't see what.
Thanks for any help.
EDIT:
adding some of the, here is the reference.txt sample (yes it's normal it has only 3 column entries, some lines can have up to 5).
chromosome_1 1 91
chromosome_1 2 91
chromosome_1 3 91
chromosome_1 4 91
chromosome_1 5 91
chromosome_1 6 91
chromosome_1 7 91
chromosome_1 8 91
chromosome_1 9 91
chromosome_1 10 91

Related

Using plotmath with geom_label_repel to have subscripts within the labels

I am trying to have subscripts in my geom_label. e.g.
Maine
Apo (km/h) = 9
Qt (m/s) = 90
I am aware of using [x] to get subscripts but I am not sure how to achieve that when I want to get the label values (partly) from a column. I tried using tidyeval (!!) to no avail. Even simply changing parse = T gives me errors. It could be something rudimentary that I am overlooking, but after reading this thread using plotmath in ggrepel labels, I am not sure if it is as simple as I thought.
Here is with what I have so far. I provided the packages and the data I have used, along with data cleaning/preparation steps. Finally, I've shown the code that I have used for creating the "preliminary" plot.
library(tidyverse)
library(stringr)
library(usmap)
library(ggrepel)
library(rlang)
read.table(text = "State Apo Qt
NJ 1 10
MO 2 20
SD 3 30
NY 4 40
FL 5 50
OK 6 60
NE 7 70
KY 8 80
ME 9 90
CA 10 100
NC 11 110
MA 12 120
CT 13 140", header = T, stringsAsFactor = F) -> ex1
# get the states full names
region <- state.name[match(ex1$State,state.abb)]
region <- str_to_title(region)
# US map data (50 States)
us1 <- usmap::us_map()
# adding full names to the dataset
ex_df <- cbind(region = region, ex1)
# adding dataset values to the map data (only states with data)
us_val1 <- left_join(ex_df, us1, by = c("region" = "full"))
# full map dataset joined by ex1 dataset to draw the map
us_map1 <- left_join(us1, ex_df, by = c("full" ="region")) %>%
mutate(qQt = replace_na(Qt, 0))
# creating a dataset with centroids of the states (only the ones in ex1)
us_centroids1 <-
us_val1 %>%
group_by(region) %>%
summarise(centroid.x = mean(range(x)),
centroid.y = mean(range(y)),
label = unique(State),
`Apo` = unique(Apo),
`Qt` = unique(Qt))
## drawing the plot
ggplot() +
geom_polygon(data = us_map1,
aes(x,y, group = group, fill = Qt),
color = "black",
size = .1) +
geom_label_repel(data = us_centroids1,
aes(centroid.x, centroid.y,
label = paste(region, "\n Apo (km/h) = ", `Apo`, "\n Qt (m/s) =", `Qt`)),
size = 5/14*8,
box.padding = 1,
parse = F) +
scale_fill_gradientn(name = expression(Q[t]~(m/s)),
breaks = c(0, seq(10,130,20)),
labels = c("", seq(10,130,20)),
limits = c(0, 130),
colors = c("#DCDCDC", "lightblue", "green"),
guide = guide_colorbar(barwidth = 0.8, barheight = 18)) +
theme_void()
This is kind of a pain, since plotmath doesn't appear to have line breaks. Thus, you have to work around it with atop(). Use bquote() to insert variable values into the expression. This only works on one element at once, thus we have to pmap() over the three variables.
ggplot() +
geom_polygon(data = us_map1,
aes(x,y, group = group, fill = Qt),
color = "black",
size = .1) +
geom_label_repel(data = us_centroids1,
aes(centroid.x, centroid.y,
label = pmap(list(region, Apo, Qt),
\(x,y,z) bquote(atop(.(x), # first line of lab
atop(A[po] (km/h) == .(y), # second line
Q[t] (m/s) == .(z)) # third line
)
)
)
),
size = 5/14*8,
box.padding = 1,
parse = T) +
scale_fill_gradientn(name = expression(Q[t]~(m/s)),
breaks = c(0, seq(10,130,20)),
labels = c("", seq(10,130,20)),
limits = c(0, 130),
colors = c("#DCDCDC", "lightblue", "green"),
guide = guide_colorbar(barwidth = 0.8, barheight = 18)) +
theme_void()
Created on 2022-07-31 by the reprex package (v2.0.1)

Change legend labels and position dodge

I created with ggplot an interaction plot and added with a different dataframe outliers into the same plot. I want to change the legend's labels (yes and no), but a new legend is added instead of changing them. Here is the Code:
the theme I'm using:
theme_apa(
legend.pos = "right",
legend.use.title = FALSE,
legend.font.size = 12,
x.font.size = 12,
y.font.size = 12,
facet.title.size = 12,
remove.y.gridlines = TRUE,
remove.x.gridlines = TRUE
)
the plot:
InteractionWithOutliers <- ggplot() +
geom_line(data=data2, aes(x=Messzeitpunkt,
y = Sum_PCLMean,group = TB2,linetype=TB2),) +
scale_color_manual(labels = c("test", "test"),values=c('#000000','#000000'))+
geom_point(data = outliersDF, aes(Messzeitpunkt,Sum_PCL,
shape=TB2, color=TB2, size=TB2),) +
geom_point(data = data2, aes(Messzeitpunkt,Sum_PCLMean,
shape=TB2, color=TB2, size=TB2), ) +
scale_shape_manual(values=c(15, 17))+
scale_size_manual(values=c(2,2)) +
ylim(0, 60) +
scale_x_continuous(breaks = seq(0,2)) +
geom_errorbar(data=data2,aes(x = Messzeitpunkt,ymin=Sum_PCLMean-Sum_PCLSD, ymax=Sum_PCLMean+Sum_PCLSD), width=.2,)
InteractionWithOutliers + theme_apa() +
labs(x ="Measurement Period", y = "PTSS mean scores")
Image of the Graph:
Furthermore, when i try to use position dodge to split the position of the interaction plot and the outliers, not everything moves the same way.
Code:
InteractionWithOutliers <- ggplot() +
geom_line(data=data2, aes(x=Messzeitpunkt,
y = Sum_PCLMean,group = TB2,linetype=TB2),position = position_dodge(width = 0.4)) +
scale_color_manual(labels = c("test", "test"),values=c('#000000','#000000'))+
geom_point(data = outliersDF, aes(Messzeitpunkt,Sum_PCL,
shape=TB2, color=TB2, size=TB2),position = position_dodge(width = 0.4)) +
geom_point(data = data2, aes(Messzeitpunkt,Sum_PCLMean,
shape=TB2, color=TB2, size=TB2),position = position_dodge(width = 0.4) ) +
scale_shape_manual(values=c(15, 17))+
scale_size_manual(values=c(2,2)) +
ylim(0, 60) +
scale_x_continuous(breaks = seq(0,2)) +
geom_errorbar(data=data2,aes(x = Messzeitpunkt,ymin=Sum_PCLMean-Sum_PCLSD, ymax=Sum_PCLMean+Sum_PCLSD),
width=.2,position = position_dodge(width = 0.4))
InteractionWithOutliers + theme_apa() +
labs(x ="Measurement Period", y = "PTSS mean scores")
Thank you for your help!
Edit: Data for the Outliers:
Messzeitpunkt Sum_PCL TB2
0 38 no
0 37 yes
0 40 yes
0 41 yes
0 38 yes
1 56 no
1 33 no
2 39 no
2 33 no
Data for the interaction plots:
Messzeitpunkt Sum_PCLMean TB2 Sum_PCLSD
0 9 no 11
0 12 yes 11
1 9 no 15
1 18 yes 16
2 8 no 12
2 14 yes 12
Merging legends can sometimes be painful. If your variables are already labelled (like in your example), then you also don't need to stipulate breaks or labels. (see first example).
However, a good rule is - don't add an aesthetic if you don't really need it. Size and color are constant aesthetics in your case, thus you could (and should) add it as a constant aesthetic outside of aes.
P.S. I have slightly changed the plot in order to make the essential more visible. I personally prefer to keep my plots in an order geoms->scales->coordinates->labels->theme, this helps me keeping an overview over the layers.
library(ggplot2)
data2 <- read.table(text = "Messzeitpunkt Sum_PCL TB2
0 38 no
0 37 yes
0 40 yes
0 41 yes
0 38 yes
1 56 no
1 33 no
2 39 no
2 33 no", head = T)
outliersDF <- read.table(text = "Messzeitpunkt Sum_PCLMean TB2 Sum_PCLSD
0 9 no 11
0 12 yes 11
1 9 no 15
1 18 yes 16
2 8 no 12
2 14 yes 12", head = T)
ggplot() +
geom_line(data = data2, aes(
x = Messzeitpunkt,
y = Sum_PCL, group = TB2, linetype = TB2
)) +
geom_point(data = outliersDF, aes(Messzeitpunkt, Sum_PCLMean,
shape = TB2, color = TB2, size = TB2
)) +
geom_point(data = data2, aes(Messzeitpunkt, Sum_PCL,
shape = TB2, color = TB2, size = TB2
)) +
## if your variable is labelled, no need to specify breaks or labels
scale_color_manual(values = c("#000000", "#000000")) +
scale_shape_manual(values = c(15, 17)) +
scale_size_manual(values = c(2, 2))
## Better, if you have constant aesthetics, not to use aes(), but
## add the values as constants instead
ggplot() +
geom_line(data = data2, aes(
x = Messzeitpunkt,
y = Sum_PCL, group = TB2, linetype = TB2
)) +
geom_point(data = outliersDF, aes(Messzeitpunkt, Sum_PCLMean,
shape = TB2
), size = 2) +
geom_point(data = data2, aes(Messzeitpunkt, Sum_PCL,
shape = TB2
## black color is default, this is just for demonstration
), color = "black", size = 2) +
scale_shape_manual(values = c(15, 17))
Created on 2022-07-15 by the reprex package (v2.0.1)

ggplot, facet, piechart, missing values

This is my final dataset. I originally obtained this table by calculating the values separately and doing rbind between females (F) and males (M) from an original bigger dataset.
I am trying to make a handsome piechart, with the percentage labels outside and I've encountered ALL problems possible for which I cannot find a solution.
Notice there is no value A for males in the dataframe.
Dataframe:
sex ms n_ms n msPerc value
1 F A 1 91 0.01098901 1.098901
2 F B 18 91 0.19780220 19.780220
3 F C 65 91 0.71428571 71.428571
4 F D 7 91 0.07692308 7.692308
5 M B 11 108 0.10185185 10.185185
6 M C 86 108 0.79629630 79.629630
7 M D 11 108 0.10185185 10.185185
library(ggplot2)
library(ggrepel)
library(tidyverse)
n<- c(91, 91 , 91, 91, 108, 108, 108 )
n_ms<-c(1,18,65,7,11,86,11)
sex<- c("F","F","F","F", "M"," M","M")
ms<- c("A","B","C","D","B","C","D")
df <- data.frame(sex, ms, n_ms, n)
df[is.na(df)]<- 0
df$msPerc <- df$n_ms /df$n
df$value <- 100*df$n_ms /df$n
df$n_ms<- as.integer(df$n_ms) # original big dataframe (doing for replication purposes)
df$n<- as.integer(df$n)
#creating position of labels
df2 <- df %>%
mutate(csum = rev(cumsum(rev(value))),
pos = value/2 + lead(csum, 1),
pos = if_else(is.na(pos), value/2, pos))
ms_pie<-ggplot(df, aes(x="", y=msPerc, group=sex, fill=ms)) +
geom_bar(width = 1, stat = "identity") +
coord_polar("y", start=0) +
facet_grid(.~ sex) +
theme_void()+
theme(legend.position="top",
legend.text = element_text(size = 9),
legend.title = element_text(size = 9,face = "bold"))+
scale_fill_manual(values=c("#d7191c", "#fdae61", "#abd9e9","#5e3c99"),
name="Moulting stage",
labels=c("A","B","C","D"))+
# geom_label(aes(label = percent(msPerc)),
# position = position_stack(vjust = 0.5),
# show.legend = FALSE)
# geom_text(aes(label = percent(msPerc)),size = 3,color = "black",
# position = position_stack(vjust = 0.5),
# show.legend = FALSE)
geom_label_repel(data = df2,
aes(y = pos, label = paste0(value, "%")),
size = 4.5, nudge_x = 1, show.legend = FALSE)
ms_pie
This is what happens...
What I would like is a piechart like this one from https://r-charts.com/part-whole/pie-chart-labels-outside-ggplot2/ but including facet_grid in variable "sex".
So far this is the closest I've got. Using geom_label, however my values overlap and I do not know how to separate them either... the joys of being a beginner in R.
I also tried the solutions provided in ggplot, facet, piechart: placing text in the middle of pie chart slices but coor_polar won't work with scales "free".
I would much appreciate the help.
Kind regards.
There are several problems with your code I've tried to clean (see comments preceeded by ####) - this should get you closer:
library(ggplot2)
library(ggrepel)
library(tidyverse)
library(scales) #### using scales for number formatting
n<- c(91, 91 , 91, 91, 108, 108, 108 )
n_ms<-c(1,18,65,7,11,86,11)
sex<- c("F","F","F","F", "M","M","M") #### changed " M" to "M" at last but one element
ms<- c("A","B","C","D","B","C","D")
df <- data.frame(sex, ms, n_ms, n)
df[is.na(df)]<- 0
df$msPerc <- df$n_ms /df$n
df$value <- 100*df$n_ms /df$n
df$n_ms<- as.integer(df$n_ms) # original big dataframe (doing for replication purposes)
df$n<- as.integer(df$n)
#creating position of labels
df2 <- df %>% group_by(sex) %>% #### you need to group your data by the facets you want to show
mutate(csum = cumsum(msPerc), #### adjusted example code to use "msPerc"
pos = msPerc/2 + lag(csum, 1),
pos = if_else(is.na(pos), msPerc/2, pos))
ms_pie<-ggplot(df, aes(x="", y=msPerc, group=sex, fill=ms)) +
geom_col(width = 1) +
coord_polar("y", start=0) +
facet_grid(~sex) +
theme_void()+
theme(legend.position="top",
legend.text = element_text(size = 9),
legend.title = element_text(size = 9,face = "bold"))+
scale_fill_manual(values=c("#d7191c", "#fdae61", "#abd9e9","#5e3c99"),
name="Moulting stage",
labels=c("A","B","C","D"))+
geom_label_repel(data = df2,
aes(y = pos, label = percent(msPerc, digits = 1)),
size = 4.5, nudge_x = 1, show.legend = FALSE)
ms_pie

How to add a label to each stratum to display additional information in a rank-change chart using alluvial in R?

I am relatively new to graphing with ggplot2, I am currently working on data visualization, specifically I am developing alluvial graph that aims to support decision making. I have been working for days and I have two problems that I have not been able to solve
I am graphing from an Excel file that contains the following:
PositionRank AlarmsName AlarmCount Week RankMove
1 Alarm F 272 LastWeek DOWN
2 Alarm B 231 LastWeek DOWN
3 Alarm A 221 LastWeek DOWN
4 Alarm C 125 LastWeek UP
5 Alarm E 112 LastWeek DOWN
6 Alarm D 108 LastWeek DOWN
7 Alarm H 102 LastWeek DOWN
8 Alarm G 98 LastWeek DOWN
9 Alarm I 88 LastWeek UP
10 Alarm J 80 LastWeek UP
1 Alarm C 221 CurrentWeek UP
2 Alarm F 165 CurrentWeek DOWN
3 Alarm B 133 CurrentWeek DOWN
4 Alarm A 124 CurrentWeek DOWN
5 Alarm J 109 CurrentWeek UP
6 Alarm E 105 CurrentWeek DOWN
7 Alarm H 101 CurrentWeek DOWN
8 Alarm I 95 CurrentWeek UP
9 Alarm D 90 CurrentWeek DOWN
10 Alarm G 80 CurrentWeek DOWN
Based on other questions asked in this community and some documentation, I have obtained the following flood graph where the left and right areas indicate the 10 alarms that were most activated (denoted by 10 colored blocks).
Here two colors are used: red represents the alarm that appears or increases in the ranking; green indicates the alarm that disappears or decreases in the ranking.
First of all I need to show last week on the left side and current
week on the right side, I have tried doing this by trying to reverse the order of the data frame but have not had any results.
Secondly I would like to show the name of the alarm, show the number
of times it was activated during the week(AlarmCount), here I have tried to add
labels with geom_text () but I have not obtained results worth
showing.
My idea is to get a graph similar to this:
This is the code I have been using and the excel file.
library(dplyr, warn.conflicts = FALSE)#install.packages("dplyr")
library(readxl) #install.packages("readxl")
library(ggplot2)#install.packages("ggplot2")
library(ggalluvial)
PositionRank=rep(seq(1,10,1), times = 2)
AlarmsName =c("Alarm F","Alarm B","Alarm A","Alarm C","Alarm E","Alarm D","Alarm H","Alarm G","Alarm
I","Alarm J"
,"Alarm C","Alarm F","Alarm B","Alarm A","Alarm J","Alarm E","Alarm H","Alarm I","Alarm
D","Alarm G")
AlarmCount= c(272,231,221,125,112,108,102,98,88,80,
221,165,133,124,109,105,101,95,90,80)
Week =
c("CurrentWeek","CurrentWeek","CurrentWeek","CurrentWeek","CurrentWeek","CurrentWeek","CurrentWeek","CurrentWeek","CurrentWeek","CurrentWeek",
"LastWeek","LastWeek","LastWeek","LastWeek","LastWeek","LastWeek","LastWeek","LastWeek","LastWeek","LastWeek")
RankMove = c("DOWN","DOWN","DOWN","UP","DOWN","DOWN","DOWN","DOWN","UP","UP"
,"UP","DOWN","DOWN","DOWN","UP","DOWN","DOWN","UP","DOWN","DOWN")
data = data.frame(PositionRank,AlarmsName,AlarmCount,Week,RankMove)
print(data)
ggplot(data,
aes(x = Week, stratum = AlarmsName, alluvium = AlarmsName,
fill = RankMove, label = AlarmsName, y = AlarmCount ))+
scale_fill_manual(values = c("green3", "red"))+
geom_stratum(alpha = 1, decreasing = FALSE,)+
geom_alluvium(decreasing = FALSE,knot.pos = 0)+
geom_text(stat = "stratum", size = 5, decreasing = FALSE)+
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),panel.background =
element_blank(),text = element_text(size = 10))
I also leave the excel if necessary, which is exactly the same as the dataframe created in the code.
Excel File
Thank you very much in advance and good morning.
Using the code below, you can get this graph. I don't know if it is exactly what you are looking for. I am not sure how to draw the boxes for the labels so that they are the same height as the segment.
data = data.frame(PositionRank,AlarmsName,AlarmCount,Week,RankMove)
After creating the data frame, I am factoring the Week variable so that it appears in the order you want. Then I am adding two variables for the labels in the graph. The running totals allow me to put the values where they need to be in the graph.
data2 <- data %>%
mutate(Week = factor(Week, levels = c("LastWeek", "CurrentWeek"))) %>%
arrange(Week, AlarmCount) %>%
group_by(Week) %>%
mutate(running_total_Last = ifelse(Week == "LastWeek",
cumsum(AlarmCount) - .5 * AlarmCount, NA_integer_),
running_total_Current = ifelse(Week == "CurrentWeek",
cumsum(AlarmCount) - .5 * AlarmCount, NA_integer_)) %>%
ungroup() %>%
arrange(Week, PositionRank)
In the plot, I am using the running totals to create the labels with geom_label.
You may need to play around with the nudge_x arguments to get it to look right for the dimensions you are using to visualize the graph.
ggplot(data2,
aes(x = Week, stratum = AlarmsName, alluvium = AlarmsName,
fill = RankMove, label = AlarmsName, y = AlarmCount))+
scale_fill_manual(values = c("red", "green3"))+
scale_color_manual(values = c("red", "green3"))+ #Making the color the same as the fill
geom_stratum(alpha = 1, decreasing = FALSE, show.legend = FALSE)+
geom_alluvium(decreasing = FALSE,knot.pos = 0, show.legend = FALSE)+
geom_text(stat = "stratum", size = 5, decreasing = FALSE)+
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),panel.background =
element_blank(),text = element_text(size = 10)) +
geom_label(aes(y = running_total_Last, label = AlarmCount, color = RankMove),
fill = "white", nudge_x = -.22, show.legend = FALSE) +
geom_label(aes(y = running_total_Current, label = AlarmCount, color = RankMove),
fill = "white", nudge_x = .22, show.legend = FALSE)+
theme(axis.ticks.y = element_blank(),
axis.text.y = element_blank(),
axis.title.y = element_blank())

Add several lines of variable text in fixed positions to a ggplot facet

I am tryig to add several lines of text to this facet. Sorry about the mess of code
From the object means1 I want to add the values of the variables "pCensCom" "pCensEx" and "pCensReg" for each facet, as described in the following figure
This is the object 'censTot1' used to build the chart
censo censTot tipoAni censAn año pCensAn
1: 2010-01-01 42 Hembra adulta 27 2010 64.285714
2: 2010-01-01 42 Joven 4 2010 9.523810
3: 2010-01-01 42 Macho adulto 1 2010 2.380952
4: 2010-01-01 42 Ternero 10 2010 23.809524
5: 2010-01-02 42 Hembra adulta 27 2010 64.285714
---
7300: 2014-12-30 57 Ternero 16 2014 28.070175
7301: 2014-12-31 57 Hembra adulta 32 2014 56.140351
7302: 2014-12-31 57 Joven 7 2014 12.280702
7303: 2014-12-31 57 Macho adulto 2 2014 3.508772
7304: 2014-12-31 57 Ternero 16 2014 28.070175
The following describes the code used to design the figure
# Plot color background
# %%%%%%%%%%%%%%%%%%%%%%
bg0<-data.table()
for(i in 1:5){
bg<-data.table(xstart=c(as.Date(paste0(años[i],"-01-01"), format="%Y-%m-%d"),as.Date(paste0(años[i],"-03-21"), format="%Y-%m-%d"), as.Date(paste0(años[i],"-06-21"),format = "%Y-%m-%d"),as.Date(paste0(años[i],"-09-21"),format = "%Y-%m-%d"),
as.Date(paste0(años[i],"-12-21"),format = "%Y-%m-%d")),xend=c(as.Date(paste0(años[i],"-03-21"), format="%Y-%m-%d"),
as.Date(paste0(años[i],"-06-21"),format = "%Y-%m-%d"), as.Date(paste0(años[i],"-09-21"),format = "%Y-%m-%d"),
as.Date(paste0(años[i],"-12-21"),format = "%Y-%m-%d"),as.Date(paste0(años[i],"-12-31"),format = "%Y-%m-%d")),
Estacion=c("Invierno","Primavera","Verano","Otoño","Invierno"))
l=list(bg0,bg); bg0<-rbindlist(l, fill=TRUE)
}
bg0<-bg0[,Estacion:=factor(ordered(Estacion,levels=c("Invierno","Primavera", "Verano", "Otoño")))]
cbPalette<-c("#FF3300","#006633","#FFFF00","#0000FF")
plotbg<-ggplot()+ geom_rect(data = bg0, aes(xmin = xstart, xmax = xend, ymin = 0, ymax = Inf, fill = Estacion), alpha = 0.10)+ scale_fill_manual(values=cbPalette)+ guides(fill=FALSE)+theme_bw()
means1<-data.table(tipoAni=c("Hembra adulta","Joven","Macho adulto","Ternero"),pCensCom=c(62.3,17.8,0.9,19.37),pCensEx=c(61.4,16.1,1.9,20.6),pCensReg=c(63.0,17.9,1.6,24.7))
# Plot
# %%%%
plotbg + geom_line(data=censTot1,aes(x=censo,y=pCensAn))+ facet_grid(tipoAni ~ .)+ xlab("Censos diarios") + ylab("Animales (%)") +theme_bw()+ theme(strip.text.x = element_text(size=8),strip.text.y = element_text(size=10, face="bold"),strip.background = element_rect(colour="red", fill="#CCCCFF"))
Please I need help, I tried several times using the functions annotation_custom, grobTree and textGrob and I have not been able to achieve
Here is a simplified answer. First I simulate some data dat, then a second data.table backgr that has the information for the background, and lastly textdt, which holds the information about the text elements.
The code looks like this:
library(data.table)
library(ggplot2)
library(scales)
dat <- data.table(x = rep(1:100, 2),
group = rep(LETTERS[1:2], each = 100),
val = rnorm(200))
dat[, price := 100 + cumsum(val), by = group]
# plot empty
ggplot(dat, aes(x = x, y = price)) +
geom_line() +
facet_grid(group~.)
# plot with added polygons
# for the background colors
backgr <- data.table(minval = c(10, 40, 60, 90),
maxval = c(20, 60, 80, 100),
backgroup = LETTERS[1:4])
# for the text elements
textdt <- data.table(xval = c(10, 50, 70),
yval = c(105, 100, 95),
textlabel = c("foo", "bar", "lorum"),
group = c("A", "A", "B"))
# plot
ggplot() +
geom_rect(data = backgr, aes(xmin = minval, xmax = maxval, ymin = -Inf,
ymax = Inf, fill = backgroup)) +
geom_line(data = dat, aes(x = x, y = price)) +
geom_text(data = textdt, aes(x = xval, y = yval, label = textlabel,
group = group)) +
facet_grid(group~.) +
scale_fill_manual(values = alpha(c("red", "green", "blue", "yellow"), 0.5))
Which results in a plot like this, which you can adjust to fit your data:

Resources