RoSA manuscript fig4 gonadsi fatness entry timing
Neil Thompson
Last Updated: 2020-05-14
Code to recreate fig 4 in the RoSA ms
This is going to be a multi panel figure. The estuary sampling date in the left panel (full height) with the gonadsi and fatness data in the right panel.
library(tidyverse)
library(cowplot)
dir.create("outputs/105", recursive = TRUE, showWarnings = FALSE)rosa_data <- read_rds("./data/101-RoSA-klamath-estuary-samples.rds")
estuary_meta <- read_csv("./data/102-Klamath-entryDATA_withNMFSID.csv")## Warning: Missing column names filled in: 'X16' [16]rosa_meta <- left_join(estuary_meta, rosa_data, by = c("NMFS ID" = "NMFS_DNA_ID")) %>%
dplyr::select(-ID) %>%
rename(NMFS_DNA_ID = "NMFS ID") %>%
dplyr::select(NMFS_DNA_ID, rosa, everything())Remove all samples with ANY missing data. And the recombinant genotypes.
rosa_plot <- rosa_meta %>%
filter(
!str_detect(rosa, "\\?"),
rosa %in% c("EEEEEEEE", "HHHHHHHH", "LLLLLLLL")
)sex_names <- list(
"f" = "Female",
"m" = "Male",
"EEEEEEEE" = "EE",
"HHHHHHHH" = "EL",
"LLLLLLLL" = "LL"
)
sex_labeller <- function(variable, value) {
return(sex_names[value])
}
rosa_meta %>%
filter(!str_detect(rosa, "\\?")) %>%
mutate(comp_geno = factor(rosa, levels = c("EEEEEEEE", "HHHHHHHH", "LLLLLLLL", "HHHEEEEE", "LLLLHHLL"))) %>%
ggplot(., aes(x = julian, y = gsi, fill = comp_geno, colour = comp_geno)) +
geom_point() +
xlab(label = "Estuary sampling date") +
ylab(label = "Gonadosomatic Index") +
scale_fill_discrete(name = "Genotype") +
scale_colour_discrete(name = "Genotype") +
theme_bw() +
scale_x_continuous(breaks = c(121, 152, 182, 213, 244, 274, 305), labels = c(
"May-01", "June-01",
"July-01", "Aug-01", "Sept-01", "Oct-01", "Nov-01"
)) +
theme(
axis.text = element_text(size = 12),
axis.title = element_text(size = 14), axis.text.x = element_text(angle = 45, hjust = 1), strip.background = element_blank()
) +
facet_grid(. ~ sex, labeller = sex_labeller)## Warning: The labeller API has been updated. Labellers taking `variable` and
## `value` arguments are now deprecated. See labellers documentation.
recreate plot from above with recombinant genotypes.
gonadsi_figure <- rosa_plot %>%
mutate(comp_geno = factor(rosa, levels = c("EEEEEEEE", "HHHHHHHH", "LLLLLLLL"))) %>%
ggplot(., aes(x = julian, y = gsi, fill = comp_geno, colour = comp_geno)) +
geom_point(alpha = 0.75) +
xlab(label = "Estuary sampling date") +
ylab(label = "Gonadosomatic Index") +
scale_fill_discrete(name = "Genotype") +
scale_colour_manual(name = "Genotype", values = c("gold", "tan2", "blue"), labels = c("EE", "EL", "LL")) +
theme_bw() +
scale_x_continuous(limits = c(121, 305), breaks = c(121, 152, 182, 213, 244, 274, 305), labels = c("", "", "", "", "", "", "")) +
scale_y_continuous(breaks = c(0, 0.05, 0.10, 0.15), labels = c(0, 0.05, 0.10, 0.15), limits = c(0, 0.16), position = "right") +
theme(
axis.text = element_text(size = 12, family = "serif"),
axis.title = element_text(size = 12, family = "serif"), axis.text.x = element_text(angle = 45, hjust = 1, family = "serif"),
strip.background = element_blank(), legend.position = "none",
panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
axis.title.x = element_blank(), strip.text.x = element_text(size = 14, family = "serif"), plot.margin = unit(c(0, 0, 0, 0), "lines")
) +
facet_grid(. ~ sex, labeller = sex_labeller)## Warning: The labeller API has been updated. Labellers taking `variable` and
## `value` arguments are now deprecated. See labellers documentation.gonadsi_figure
Now lets do that with the fatness data
fatness_figure <- rosa_plot %>%
mutate(comp_geno = factor(rosa, levels = c("EEEEEEEE", "HHHHHHHH", "LLLLLLLL"))) %>%
ggplot(., aes(x = julian, y = drywet, fill = comp_geno, colour = comp_geno)) +
geom_point(alpha = 0.75) +
xlab(label = "Estuary sampling date") +
ylab(label = "Liver NWF") +
scale_fill_discrete(name = "Genotype") +
scale_colour_manual(name = "Genotype", values = c("gold", "tan2", "blue"), labels = c("EE", "EL", "LL")) +
theme_bw() +
scale_x_continuous(limits = c(121, 305), breaks = c(121, 152, 182, 213, 244, 274, 305), labels = c("1 May", "1 Jun", "1 Jul", "1 Aug", "1 Sep", "1 Oct", "1 Nov")) +
scale_y_continuous(position = "right") +
theme(
axis.text = element_text(size = 12, family = "serif"),
axis.title = element_text(size = 14, family = "serif"), axis.text.x = element_text(angle = 45, hjust = 1, family = "serif"),
strip.background = element_blank(), legend.position = "none",
panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
strip.text.x = element_blank(), plot.margin = unit(c(-0.5, .2, 0.2, 0.2), "lines")
) +
facet_grid(. ~ sex, labeller = sex_labeller)## Warning: The labeller API has been updated. Labellers taking `variable` and
## `value` arguments are now deprecated. See labellers documentation.fatness_figure
Make the estuary date by RoSA genotype figure.
entry_figure <- rosa_plot %>%
mutate(comp_geno = factor(rosa, levels = c("EEEEEEEE", "HHHHHHHH", "LLLLLLLL"))) %>%
ggplot(., aes(x = julian, fill = comp_geno)) +
geom_bar(stat = "count", width = 1, position = "dodge") +
xlab(label = "Estuary sampling date") +
ylab(label = "Count") +
scale_fill_manual(
values = c("gold", "tan2", "blue"),
breaks = c("EEEEEEEE", "HHHHHHHH", "LLLLLLLL"),
labels = c("EE", "EL", "LL"),
name = "RoSA genotype"
) +
theme_bw() +
background_grid(major = "xy", minor = "none") +
scale_x_continuous(limits = c(121, 305), breaks = c(121, 152, 182, 213, 244, 274, 305), labels = c("1 May", "1 Jun", "1 Jul", "1 Aug", "1 Sep", "1 Oct", "1 Nov")) +
scale_y_continuous(limits = c(0, 30)) +
theme(
axis.text = element_text(size = 12, family = "serif"),
axis.title = element_text(size = 14, family = "serif"), axis.text.x = element_text(angle = 45, hjust = 1, family = "serif"),
strip.background = element_blank(), strip.text.y = element_blank(), legend.position = "none",
panel.grid.major = element_blank(), panel.grid.minor = element_blank()
) +
facet_grid(comp_geno ~ .)
entry_figure
Need to harvest a legend from one of the plots
entry_figure_legend <- rosa_plot %>%
mutate(comp_geno = factor(rosa, levels = c("EEEEEEEE", "HHHHHHHH", "LLLLLLLL"))) %>%
ggplot(., aes(x = julian, fill = comp_geno)) +
geom_bar(stat = "count", width = 1, position = "dodge") +
xlab(label = "Estuary sampling date") +
ylab(label = "Count") +
scale_fill_manual(
values = c("gold", "tan2", "blue"),
breaks = c("EEEEEEEE", "HHHHHHHH", "LLLLLLLL"),
labels = c("EE", "EL", "LL"),
name = "RoSA genotype"
) +
theme_bw() +
background_grid(major = "xy", minor = "none") +
scale_x_continuous(limits = c(121, 305), breaks = c(121, 152, 182, 213, 244, 274, 305), labels = c("1 May", "1 Jun", "1 Jul", "1 Aug", "1 Sep", "1 Oct", "1 Nov")) +
scale_y_continuous(limits = c(0, 30)) +
theme(
axis.text = element_text(size = 12, family = "serif"),
axis.title = element_text(size = 14, family = "serif"), axis.text.x = element_text(angle = 45, hjust = 1, family = "serif"),
strip.background = element_blank(), strip.text.y = element_blank(),
panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
legend.text = element_text(size = 10, family = "serif"),
legend.title = element_text(size = 10, family = "serif"), legend.key.size = unit(1, "line")
) +
facet_grid(comp_geno ~ .)
legend <- get_legend(entry_figure_legend + theme(legend.position = "top", legend.direction = "horizontal"))cowplot em together
library(cowplot)
pheno_traits <- plot_grid(gonadsi_figure, fatness_figure, labels = c("B", "C"), ncol = 1, align = "v", label_y = c(0.85, 1.05))
entry_trait <- plot_grid(entry_figure, ncol = 1, labels = c("A"))
all_panel <- plot_grid(entry_trait, pheno_traits, ncol = 2, align = "hv", rel_widths = c(0.75, 1))
plot_grid(legend, all_panel, ncol = 1, rel_heights = c(0.05, 1))
ggsave("./outputs/105/RoSA_figure4_multipanel_estuary_gonadsi_fatness.pdf", width = 7.5, height = 4)
ggsave("./outputs/105/RoSA_figure4_multipanel_estuary_gonadsi_fatness.png", width = 7.5, height = 4)Make a supplemental entry date figure showing all recombinants
rosa_meta %>%
filter(!str_detect(rosa, "\\?")) %>%
mutate(comp_geno = factor(rosa, levels = c("EEEEEEEE", "HHHHHHHH", "LLLLLLLL", "HHHEEEEE", "LLLLHHLL"))) %>%
ggplot(., aes(x = julian, fill = comp_geno)) +
geom_bar(stat = "count", width = 1, position = "dodge") +
xlab(label = "Estuary sampling date") +
ylab(label = "Count") +
scale_fill_manual(
values = c("gold", "tan2", "blue", "black", "black"),
breaks = c("EEEEEEEE", "HHHHHHHH", "LLLLLLLL", "HHHEEEEE", "LLLLHHLL"),
name = "RoSA genotype"
) +
theme_bw() +
background_grid(major = "xy", minor = "none") +
scale_x_continuous(limits = c(121, 305), breaks = c(121, 152, 182, 213, 244, 274, 305), labels = c("1 May", "1 Jun", "1 Jul", "1 Aug", "1 Sep", "1 Oct", "1 Nov")) +
scale_y_continuous(limits = c(0, 20), breaks = seq(0, 20, 5), labels = seq(0, 20, 5)) +
theme(
axis.text = element_text(size = 12, family = "serif"),
axis.title = element_text(size = 14, family = "serif"), axis.text.x = element_text(angle = 45, hjust = 1, family = "serif"),
strip.background = element_blank(), strip.text.y = element_text(size = 8),
panel.grid.major = element_blank(), panel.grid.minor = element_blank(), legend.position = "none"
) +
facet_grid(comp_geno ~ year) +
ggtitle("all RoSA genotypes by estuary sampling date")## Warning: Removed 3 rows containing missing values (geom_bar).
Make a supplemental gonadsi figure showing all recombinants
all_nads_09 <- rosa_meta %>%
filter(
!str_detect(rosa, "\\?"),
year == "2009"
) %>%
mutate(
hapstr = factor(rosa, levels = c("EEEEEEEE", "HHHHHHHH", "LLLLLLLL", "HHHEEEEE", "LLLLHHLL")),
sex = str_replace(sex, "f", "Female"),
sex = ifelse(sex == "m", "Male", sex)
) %>%
ggplot(., aes(x = julian, y = gsi, fill = hapstr, colour = hapstr)) +
geom_point() +
xlab(label = "Estuary sampling date") +
ylab(label = "Gonadosomatic Index") +
scale_color_manual(
values = c("gold", "tan2", "blue", "black", "black"),
breaks = c("EEEEEEEE", "HHHHHHHH", "LLLLLLLL", "HHHEEEEE", "LLLLHHLL"),
name = "RoSA genotype"
) +
theme_bw() +
scale_x_continuous(limits = c(121, 305), breaks = c(121, 152, 182, 213, 244, 274, 305), labels = c("1 May", "1 Jun", "1 Jul", "1 Aug", "1 Sep", "1 Oct", "1 Nov")) +
scale_y_continuous(breaks = c(0, 0.05, 0.10, 0.15), labels = c(0, 0.05, 0.10, 0.15), limits = c(0, 0.16)) +
theme(
axis.text = element_text(size = 12, family = "serif"),
axis.title = element_text(size = 14, family = "serif"), axis.text.x = element_text(angle = 45, hjust = 1, family = "serif"),
strip.background = element_blank(), strip.text.y = element_text(size = 8),
panel.grid.major = element_blank(), panel.grid.minor = element_blank(), legend.position = "none"
) +
facet_grid(hapstr ~ sex) +
ggtitle("2009") +
theme(plot.title = element_text(hjust = 0.5))
all_nads_10 <- rosa_meta %>%
filter(
!str_detect(rosa, "\\?"),
year == "2010"
) %>%
mutate(
hapstr = factor(rosa, levels = c("EEEEEEEE", "HHHHHHHH", "LLLLLLLL", "HHHEEEEE", "LLLLHHLL")),
sex = str_replace(sex, "f", "Female"),
sex = ifelse(sex == "m", "Male", sex)
) %>%
ggplot(., aes(x = julian, y = gsi, fill = hapstr, colour = hapstr)) +
geom_point() +
xlab(label = "Estuary sampling date") +
ylab(label = "Gonadosomatic Index") +
scale_color_manual(
values = c("gold", "tan2", "blue"),
breaks = c("EEEEEEEE", "HHHHHHHH", "LLLLLLLL"),
name = "RoSA genotype"
) +
theme_bw() +
scale_x_continuous(limits = c(121, 305), breaks = c(121, 152, 182, 213, 244, 274, 305), labels = c("1 May", "1 Jun", "1 Jul", "1 Aug", "1 Sep", "1 Oct", "1 Nov")) +
scale_y_continuous(breaks = c(0, 0.05, 0.10, 0.15), labels = c(0, 0.05, 0.10, 0.15), limits = c(0, 0.16)) +
theme(
axis.text = element_text(size = 12, family = "serif"),
axis.title = element_text(size = 14, family = "serif"), axis.text.x = element_text(angle = 45, hjust = 1, family = "serif"),
strip.background = element_blank(), strip.text.y = element_text(size = 8),
panel.grid.major = element_blank(), panel.grid.minor = element_blank(), legend.position = "none"
) +
facet_grid(hapstr ~ sex) +
ggtitle("2010") +
theme(plot.title = element_text(hjust = 0.5))
plot_grid(all_nads_09, all_nads_10)
# ggsave("./outputs/RoSA_klamath_estuary_gonadsi_supplemental_all_haplos_byYear.pdf", width=11, height=8)
# ggsave("./outputs/RoSA_klamath_estuary_gonadsi_supplemental_all_haplos_byYear.png", width=11, height=8)now fatness supplemental
rosa_meta %>%
filter(!str_detect(rosa, "\\?")) %>%
mutate(
hapstr = factor(rosa, levels = c("EEEEEEEE", "HHHHHHHH", "LLLLLLLL", "HHHEEEEE", "LLLLHHLL")),
sex = str_replace(sex, "f", "Female"),
sex = ifelse(sex == "m", "Male", sex)
) %>%
ggplot(., aes(x = julian, y = drywet, colour = hapstr)) +
geom_point() +
xlab(label = "Estuary sampling date") +
ylab(label = "Liver NWF") +
scale_color_manual(
values = c("gold", "tan2", "blue", "black", "red"),
breaks = c("EEEEEEEE", "HHHHHHHH", "LLLLLLLL", "HHHEEEEE", "LLLLHHLL"),
name = "RoSA genotype"
) +
theme_bw() +
scale_x_continuous(limits = c(121, 305), breaks = c(121, 152, 182, 213, 244, 274, 305), labels = c("1 May", "1 Jun", "1 Jul", "1 Aug", "1 Sep", "1 Oct", "1 Nov")) +
theme(
axis.text = element_text(size = 12, family = "serif"),
axis.title = element_text(size = 14, family = "serif"), axis.text.x = element_text(angle = 45, hjust = 1, family = "serif"),
strip.background = element_blank(), # legend.position = "none",
panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
plot.margin = unit(c(0, .2, 0.2, 0.2), "lines")
) +
facet_grid(year ~ sex)
ggsave("./outputs/105/RoSA_klamath_estuary_fatness_supplemental_all_haplos_byYear.pdf", width = 6, height = 4)
ggsave("./outputs/105/RoSA_klamath_estuary_fatness_supplemental_all_haplos_byYear.png", width = 6, height = 4)Session Info
sessioninfo::session_info()## ─ Session info ───────────────────────────────────────────────────────────────
## setting value
## version R version 3.6.2 (2019-12-12)
## os macOS Sierra 10.12.6
## system x86_64, darwin15.6.0
## ui X11
## language (EN)
## collate en_US.UTF-8
## ctype en_US.UTF-8
## tz America/Denver
## date 2020-05-14
##
## ─ Packages ───────────────────────────────────────────────────────────────────
## package * version date lib source
## assertthat 0.2.1 2019-03-21 [1] CRAN (R 3.6.0)
## backports 1.1.6 2020-04-05 [1] CRAN (R 3.6.2)
## broom 0.5.6 2020-04-20 [1] CRAN (R 3.6.2)
## cellranger 1.1.0 2016-07-27 [1] CRAN (R 3.6.0)
## cli 2.0.2 2020-02-28 [1] CRAN (R 3.6.0)
## colorspace 1.4-1 2019-03-18 [1] CRAN (R 3.6.0)
## cowplot * 1.0.0 2019-07-11 [1] CRAN (R 3.6.0)
## crayon 1.3.4 2017-09-16 [1] CRAN (R 3.6.0)
## DBI 1.1.0 2019-12-15 [1] CRAN (R 3.6.0)
## dbplyr 1.4.3 2020-04-19 [1] CRAN (R 3.6.2)
## digest 0.6.25 2020-02-23 [1] CRAN (R 3.6.0)
## dplyr * 0.8.5 2020-03-07 [1] CRAN (R 3.6.0)
## ellipsis 0.3.0 2019-09-20 [1] CRAN (R 3.6.0)
## evaluate 0.14 2019-05-28 [1] CRAN (R 3.6.0)
## fansi 0.4.1 2020-01-08 [1] CRAN (R 3.6.0)
## farver 2.0.3 2020-01-16 [1] CRAN (R 3.6.0)
## forcats * 0.5.0 2020-03-01 [1] CRAN (R 3.6.0)
## fs 1.4.1 2020-04-04 [1] CRAN (R 3.6.2)
## generics 0.0.2 2018-11-29 [1] CRAN (R 3.6.0)
## ggplot2 * 3.3.0 2020-03-05 [1] CRAN (R 3.6.0)
## glue 1.4.0 2020-04-03 [1] CRAN (R 3.6.2)
## gtable 0.3.0 2019-03-25 [1] CRAN (R 3.6.0)
## haven 2.2.0 2019-11-08 [1] CRAN (R 3.6.0)
## hms 0.5.3 2020-01-08 [1] CRAN (R 3.6.0)
## htmltools 0.4.0 2019-10-04 [1] CRAN (R 3.6.0)
## httr 1.4.1 2019-08-05 [1] CRAN (R 3.6.0)
## jsonlite 1.6.1 2020-02-02 [1] CRAN (R 3.6.0)
## knitr 1.28 2020-02-06 [1] CRAN (R 3.6.0)
## labeling 0.3 2014-08-23 [1] CRAN (R 3.6.0)
## lattice 0.20-38 2018-11-04 [2] CRAN (R 3.6.2)
## lifecycle 0.2.0 2020-03-06 [1] CRAN (R 3.6.0)
## lubridate 1.7.8 2020-04-06 [1] CRAN (R 3.6.2)
## magrittr 1.5 2014-11-22 [1] CRAN (R 3.6.0)
## modelr 0.1.6 2020-02-22 [1] CRAN (R 3.6.0)
## munsell 0.5.0 2018-06-12 [1] CRAN (R 3.6.0)
## nlme 3.1-142 2019-11-07 [2] CRAN (R 3.6.2)
## pillar 1.4.3 2019-12-20 [1] CRAN (R 3.6.0)
## pkgconfig 2.0.3 2019-09-22 [1] CRAN (R 3.6.0)
## purrr * 0.3.4 2020-04-17 [1] CRAN (R 3.6.2)
## R6 2.4.1 2019-11-12 [1] CRAN (R 3.6.0)
## Rcpp 1.0.4 2020-03-17 [1] CRAN (R 3.6.0)
## readr * 1.3.1 2018-12-21 [1] CRAN (R 3.6.0)
## readxl 1.3.1 2019-03-13 [1] CRAN (R 3.6.0)
## reprex 0.3.0 2019-05-16 [1] CRAN (R 3.6.0)
## rlang 0.4.5 2020-03-01 [1] CRAN (R 3.6.0)
## rmarkdown 2.1 2020-01-20 [1] CRAN (R 3.6.0)
## rstudioapi 0.11 2020-02-07 [1] CRAN (R 3.6.0)
## rvest 0.3.5 2019-11-08 [1] CRAN (R 3.6.0)
## scales 1.1.0 2019-11-18 [1] CRAN (R 3.6.0)
## sessioninfo 1.1.1 2018-11-05 [1] CRAN (R 3.6.0)
## stringi 1.4.6 2020-02-17 [1] CRAN (R 3.6.0)
## stringr * 1.4.0 2019-02-10 [1] CRAN (R 3.6.0)
## tibble * 3.0.1 2020-04-20 [1] CRAN (R 3.6.2)
## tidyr * 1.0.2 2020-01-24 [1] CRAN (R 3.6.0)
## tidyselect 1.0.0 2020-01-27 [1] CRAN (R 3.6.0)
## tidyverse * 1.3.0 2019-11-21 [1] CRAN (R 3.6.0)
## vctrs 0.2.4 2020-03-10 [1] CRAN (R 3.6.0)
## withr 2.2.0 2020-04-20 [1] CRAN (R 3.6.2)
## xfun 0.13 2020-04-13 [1] CRAN (R 3.6.2)
## xml2 1.3.2 2020-04-23 [1] CRAN (R 3.6.2)
## yaml 2.2.1 2020-02-01 [1] CRAN (R 3.6.0)
##
## [1] /Users/eriq/Library/R/3.6/library
## [2] /Library/Frameworks/R.framework/Versions/3.6/Resources/libraryRunning Time
Running the code and rendering this notebook required approximately this much time on a Mac laptop of middling speed:
Sys.time() - start_time## Time difference of 8.703839 secs