Disecting lentil crop growth across multi-environment trials using unoccupied aerial vehicles
Unpublished
Introduction
This vignette contains the R
code and analysis done for
the paper:
which is follow-up to:
- Sandesh Neupane, Derek Wright, Raul Martinez, Jakob Butler, Jim Weller, Kirstin Bett. Focusing the GWAS Lens on days to flower using latent variable phenotypes derived from global multi-environment trials. The Plant Genome. (2022) 16(1): e20269.
- https://github.com/derekmichaelwright/AGILE_LDP_GWAS_Phenology
- Derek M Wright, Sandesh Neupane, Taryn Heidecker, Teketel A Haile, Clarice J Coyne, Rebecca J McGee, Sripada Udupa, Fatima Henkrar, Eleonora Barilli, Diego Rubiales, Tania Gioia, Giuseppina Logozzo, Stefania Marzario, Reena Mehra, Ashutosh Sarker, Rajeev Dhakal, Babul Anwar, Debashish Sarker, Albert Vandenberg, and Kirstin E. Bett. Understanding photothermal interactions can help expand production range and increase genetic diversity of lentil (Lens culinaris Medik.). Plants, People, Planet. (2021) 3(2): 171-181.
- https://github.com/derekmichaelwright/AGILE_LDP_Phenology
This work done as part of the AGILE and P2IRC projects at the University of Saskatchewan.
Load Libraries
library(tidyverse)
library(ggbeeswarm)
library(ggpubr)
library(plotly)
library(htmlwidgets)
library(growthcurver)
library(FactoMineR)
library(ggrepel)
#
<- theme_bw() +
theme_AGL theme(strip.background = element_rect(colour = "black", fill = NA, size = 0.5),
panel.background = element_rect(colour = "black", fill = NA, size = 0.5),
panel.border = element_rect(colour = "black", size = 0.5),
panel.grid = element_line(color = alpha("black", 0.1), size = 0.5),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank())
#
<- c("Metaponto, Italy 2017", "Rosthern, Canada 2017",
myExpts1 "Sutherland, Canada 2017", "Sutherland, Canada 2018")
<- c("It17", "Ro17", "Su17", "Su18")
myExpts2 <- c("darkred", "darkgreen", "darkblue", "steelblue")
myColors_Expt <- c("red4", "darkorange3", "blue2", "deeppink3",
myColors_Cluster "steelblue", "darkorchid4", "darkslategray", "chartreuse4")
Load The Data
Load manual phenotypes
<- read.csv("myLDP.csv")
myLDP #
<- read.csv("Data_Manual/LDP_Italy_2017_Phenotypes.csv")
it17_f <- read.csv("Data_Manual/LDP_Rosthern_2017_Phenotypes.csv")
ro17_f <- read.csv("Data_Manual/LDP_Sutherland_2017_Phenotypes.csv")
su17_f <- read.csv("Data_Manual/LDP_Sutherland_2018_Phenotypes.csv") su18_f
Load Drone phenotypes
# function to read in the drone data
<- function(folder, colNum, xf) {
readDrone <- list.files(folder)
fnames <- NULL
xx for(i in fnames) {
<- read.csv(paste0(folder, i))
xi <- bind_rows(xx, xi)
xx
}<- xx %>%
xx rename(Plot=plot_name, Date=mission_date, Sensor=sensor_type) %>%
mutate(Plot = as.integer(Plot)) %>%
gather(Trait, Value, colNum:ncol(.)) %>%
left_join(xf[,1:10], by = "Plot") %>%
filter(!is.na(Entry), !is.na(Value)) %>%
mutate(DAP = as.numeric(as.Date(Date) - as.Date(Planting.Date)),
Value_f = Value) %>%
select(Expt, Row, Column, Plot, Rep, Entry, Name,
Planting.Date, DAP, Date, Sensor, Trait, Value, Value_f)
xx
}# Load drone data
<- readDrone(folder = "Data_Drone/LDP_Italy_2017/",
it17_d colNum = 6, xf = it17_f)
<- readDrone(folder = "Data_Drone/LDP_Rosthern_2017/",
ro17_d colNum = 7, xf = ro17_f)
<- readDrone(folder = "Data_Drone/LDP_Sutherland_2017/",
su17_d colNum = 7, xf = su17_f)
<- readDrone(folder = "Data_Drone/LDP_Sutherland_2018/",
su18_d colNum = 7, xf = su18_f)
Gather manual phenotypes
<- it17_f %>% gather(Trait, Value, 11:ncol(.))
it17_f <- ro17_f %>% gather(Trait, Value, 11:ncol(.))
ro17_f <- su17_f %>% gather(Trait, Value, 11:ncol(.))
su17_f <- su18_f %>% gather(Trait, Value, 11:ncol(.)) su18_f
Prepare the Data
Filter Outliers and add extra data points for aiding growth curves
# Function to add data points
<- function(xx, myTrait, myDAP, myValue) {
traitAdd for(i in unique(xx$Plot)) {
<- xx %>%
xi filter(Trait == myTrait, Plot == i) %>%
slice(1) %>%
mutate(DAP = myDAP, Sensor = "NA",
Date = as.character(as.Date(Planting.Date) + myDAP),
Value = NA, Value_f = myValue)
<- bind_rows(xi,xx)
xx
}
xx
}# Function to add a data point during the "stationary phase"
<- function(xx, myDAP, myTrait) {
traitPredict for(i in unique(xx$Plot)) {
<- xx %>% filter(Plot == i, Trait == myTrait)
xi if(sum(!is.na(xi$Value_f)) > 0) {
<- xi %>% pull(Value_f) %>% max(na.rm = T)
myVal <- xi %>% slice(1) %>%
xi mutate(DAP = myDAP, Sensor = "NA",
Date = as.character(as.Date(Planting.Date) + myDAP),
Value = NA,
Value_f = myVal)
<- bind_rows(xx, xi)
xx
}
}
xx
}# Function to find outliers after a certain DAP based on decreases from max
<- function(xx, myDAP, myThreshold = 1,
outliers_Maturity predict = T,
myTrait, myOtherTraits ) {<- NULL
yy for(i in unique(xx$Plot)) {
<- max(xx %>% filter(Plot == i, Trait == myTrait) %>% pull(Value_f), na.rm = T)
myMax <- xx %>% filter(Plot == i)
xi <- xi %>%
daps_r filter(DAP >= myDAP, Trait == myTrait, Value_f < myMax * myThreshold ) %>%
pull(DAP)
<- c(daps_r, unique(xi$DAP)[unique(xi$DAP)>daps_r])
daps_r <- xi %>%
xi mutate(Value_f = ifelse(DAP %in% daps_r, NA, Value_f))
if(predict == T) {
<- xi %>%
xi mutate(Value_f = ifelse(DAP %in% daps_r & Trait == myTrait,
*0.99, Value_f))
myMaxfor(k in myOtherTraits) {
<- max(xi %>% filter(Trait == k) %>% pull(Value_f), na.rm = T)
myMax <- xi %>%
xi mutate(Value_f = ifelse(DAP %in% daps_r & Trait == k,
*0.99, Value_f))
myMax
}
}<- bind_rows(yy, xi)
yy
}
yy
}# Function to identify and fix outliers
<- function(xx, myTrait) {
outliers_Fix for(i in unique(xx$Plot)) {
<- xx %>% filter(Plot == i, Trait == myTrait) %>%
xi mutate(Change = NA, PercChange = NA)
<-2
jfor(j in 2:nrow(xi)) {
<- max(xi$Value_f[1:(j-1)], na.rm = T)
x1 <- xi$Value_f[j]
x2 $Change[j] <- x2 - x1
xi$PercChange[j] <- 100 * xi$Change[j] / x1
xi
}for(j in 2:(nrow(xi)-1)) {
$Value_f[xx$Plot == i & xx$Trait == myTrait & xx$DAP == xi$DAP[j]] <-
xxifelse(xi$PercChange[j] > 30 & xi$PercChange[j+1] < -30, NA, xi$Value_f[j])
}
}
xx }
Italy 2017
#
<- traitAdd(xx = it17_d, myDAP = 0, myValue = 0,
it17_d myTrait = "crop_volume_m3_excess.green.based")
<- traitAdd(xx = it17_d, myDAP = 0, myValue = 0,
it17_d myTrait = "crop_area_m2_excess.green.based")
<- traitAdd(xx = it17_d, myDAP = 0, myValue = 0,
it17_d myTrait = "mean_crop_height_m_excess.green.based")
#
<- c(619, 782, 713, 746, 10, 722, 796, 717, 829,
myPs 874, 767, 903, 866, 8, 707, 876, 24, 958, 614, 618,
397, 2, 687, 12,
456, 665)
#
<- it17_d %>%
it17_d mutate(Value_f = ifelse(Plot %in% myPs, NA, Value_f),
Value_f = ifelse(Plot == 3 & grepl("height|Volume",Trait) & DAP %in% c(101,119),
NA, Value_f),
Value_f = ifelse(Plot == 11 & grepl("height|Volume",Trait) & DAP == 119,
NA, Value_f),
Value_f = ifelse(Plot == 4 & grepl("height|Volume",Trait) & DAP == 101,
NA, Value_f),
Value_f = ifelse(Plot == 5 & grepl("height|Volume",Trait) & DAP == 164,
NA, Value_f),
Value_f = ifelse(Plot == 17 & grepl("height|Volume",Trait) & DAP == 164,
NA, Value_f)
)#
<- outliers_Maturity(xx = it17_d, myDAP = 163,
it17_d myTrait = "mean_crop_height_m_excess.green.based",
myOtherTraits = c("crop_area_m2_excess.green.based",
"crop_volume_m3_excess.green.based",
"median_crop_height_m_excess.green.based",
"max_crop_height_m_excess.green.based") )
<- outliers_Maturity(xx = it17_d, myDAP = 163,
it17_d myTrait = "crop_volume_m3_excess.green.based",
myOtherTraits = c("crop_area_m2_excess.green.based",
"mean_crop_height_m_excess.green.based",
"median_crop_height_m_excess.green.based",
"max_crop_height_m_excess.green.based") )
#
<- traitPredict(xx = it17_d, myDAP = 180,
it17_d myTrait = "crop_volume_m3_excess.green.based")
<- traitPredict(xx = it17_d, myDAP = 180,
it17_d myTrait = "crop_area_m2_excess.green.based")
<- traitPredict(xx = it17_d, myDAP = 180,
it17_d myTrait = "mean_crop_height_m_excess.green.based")
<- traitPredict(xx = it17_d, myDAP = 210,
it17_d myTrait = "crop_volume_m3_excess.green.based")
<- traitPredict(xx = it17_d, myDAP = 210,
it17_d myTrait = "crop_area_m2_excess.green.based")
<- traitPredict(xx = it17_d, myDAP = 210,
it17_d myTrait = "mean_crop_height_m_excess.green.based")
#
<- traitPredict(xx = it17_d, myDAP = 200,
it17_d myTrait = "crop_volume_m3_excess.green.based")
#
<- it17_d %>%
xx filter(Plot %in% c(456,665) & DAP %in% c(93,94),
== "crop_volume_m3_excess.green.based") %>%
Trait mutate(Sensor = "NA", DAP = 10,
Date = as.character(as.Date(Planting.Date) + DAP),
Value = NA, Value_f = 0.001)
<- it17_d %>% bind_rows(xx)
it17_d #
write.csv(it17_d, "Data_Drone/final_it17_d.csv", row.names = F)
Rosthern 2017
#
<- traitAdd(xx = ro17_d, myDAP = 0, myValue = 0,
ro17_d myTrait = "crop_volume_m3_blue.ndvi.based")
<- traitAdd(xx = ro17_d, myDAP = 0, myValue = 0,
ro17_d myTrait = "crop_area_m2_blue.ndvi.based")
<- traitAdd(xx = ro17_d, myDAP = 0, myValue = 0,
ro17_d myTrait = "mean_crop_height_m_blue.ndvi.based")
#
<- ro17_d %>%
ro17_d mutate(Value_f = ifelse(Trait == "crop_volume_m3_blue.ndvi.based" &
%in% c("2017-06-12", "2017-06-20"),
Date NA, Value_f),
#
Value_f = ifelse(Trait == "crop_area_m2_blue.ndvi.based" &
%in% c("2017-06-12","2017-06-20","2017-06-27"),
Date NA, Value_f),
#
Value_f = ifelse(Trait == "mean_crop_height_m_blue.ndvi.based" &
%in% c("2017-06-12","2017-06-20") &
Date > 0.2,
Value NA, Value_f),
Value_f = ifelse(Trait == "mean_crop_height_m_blue.ndvi.based" &
== "2017-06-28" &
Date > 0.3,
Value NA, Value_f) )
#
<- outliers_Maturity(xx = ro17_d, myDAP = 75,
ro17_d myTrait = "crop_volume_m3_blue.ndvi.based",
myOtherTraits = c("crop_area_m2_blue.ndvi.based",
"mean_crop_height_m_blue.ndvi.based",
"median_crop_height_m_blue.ndvi.based",
"max_crop_height_m_blue.ndvi.based"))
#
<- traitPredict(xx = ro17_d, myDAP = 105,
ro17_d myTrait = "crop_volume_m3_blue.ndvi.based")
<- traitPredict(xx = ro17_d, myDAP = 105,
ro17_d myTrait = "crop_area_m2_blue.ndvi.based")
<- traitPredict(xx = ro17_d, myDAP = 105,
ro17_d myTrait = "mean_crop_height_m_blue.ndvi.based")
<- traitPredict(xx = ro17_d, myDAP = 110,
ro17_d myTrait = "crop_volume_m3_blue.ndvi.based")
<- traitPredict(xx = ro17_d, myDAP = 110,
ro17_d myTrait = "crop_area_m2_blue.ndvi.based")
<- traitPredict(xx = ro17_d, myDAP = 110,
ro17_d myTrait = "mean_crop_height_m_blue.ndvi.based")
#
write.csv(ro17_d, "Data_Drone/final_ro17_d.csv", row.names = F)
Sutherland 2017
#
<- su17_d %>%
su17_d mutate(Value_f = ifelse(Value_f == 0, NA, Value_f))
#
<- traitAdd(xx = su17_d, myDAP = 0, myValue = 0,
su17_d myTrait = "crop_volume_m3_blue.ndvi.based")
<- traitAdd(xx = su17_d, myDAP = 0, myValue = 0,
su17_d myTrait = "crop_area_m2_blue.ndvi.based")
<- traitAdd(xx = su17_d, myDAP = 0, myValue = 0,
su17_d myTrait = "mean_crop_height_m_blue.ndvi.based")
#
<- su17_d %>%
su17_d mutate(Value_f = ifelse(Sensor == "ILCE-QX1" & Date == "2017-07-04",
NA, Value_f),
#
Value_f = ifelse(Trait == "crop_volume_m3_blue.ndvi.based" &
== "2017-06-05",
Date NA, Value_f),
#
Value_f = ifelse(Trait == "crop_area_m2_blue.ndvi.based" &
%in% c("2017-06-05", "2017-06-12"),
Date NA, Value_f),
#
Value_f = ifelse(Trait == "mean_crop_height_m_blue.ndvi.based" &
%in% c("2017-06-05", "2017-06-13",
Date "2017-06-19", "2017-06-24") &
> 0.2,
Value_f NA, Value_f),
#
Value_f = ifelse(Trait %in% c("crop_volume_m3_blue.ndvi.based",
"mean_crop_height_m_blue.ndvi.based") &
== 5573 & DAP == 51,
Plot NA, Value_f),
Value_f = ifelse(Trait %in% c("crop_volume_m3_blue.ndvi.based",
"mean_crop_height_m_blue.ndvi.based") &
== 5588,
Plot NA, Value_f),
Value_f = ifelse(Plot == 6030, NA, Value_f))
#
<- outliers_Maturity(xx = su17_d, myDAP = 76,
su17_d myTrait = "crop_volume_m3_blue.ndvi.based",
myOtherTraits = c("crop_area_m2_blue.ndvi.based",
"mean_crop_height_m_blue.ndvi.based",
"median_crop_height_m_blue.ndvi.based",
"max_crop_height_m_blue.ndvi.based"))
#
<- traitPredict(xx = su17_d, myDAP = 95,
su17_d myTrait = "crop_volume_m3_blue.ndvi.based")
<- traitPredict(xx = su17_d, myDAP = 95,
su17_d myTrait = "crop_area_m2_blue.ndvi.based")
<- traitPredict(xx = su17_d, myDAP = 95,
su17_d myTrait = "mean_crop_height_m_blue.ndvi.based")
<- traitPredict(xx = su17_d, myDAP = 105,
su17_d myTrait = "crop_volume_m3_blue.ndvi.based")
<- traitPredict(xx = su17_d, myDAP = 105,
su17_d myTrait = "crop_area_m2_blue.ndvi.based")
<- traitPredict(xx = su17_d, myDAP = 105,
su17_d myTrait = "mean_crop_height_m_blue.ndvi.based")
#
write.csv(su17_d, "Data_Drone/final_su17_d.csv", row.names = F)
Sutherland 2018
#
<- traitAdd(xx = su18_d, myDAP = 0, myValue = 0,
su18_d myTrait = "crop_volume_m3_excess.green.based")
<- traitAdd(xx = su18_d, myDAP = 0, myValue = 0,
su18_d myTrait = "crop_area_m2_excess.green.based")
<- traitAdd(xx = su18_d, myDAP = 0, myValue = 0,
su18_d myTrait = "mean_crop_height_m_excess.green.based")
#
<- traitAdd(xx = su18_d, myDAP = 30, myValue = 0.01,
su18_d myTrait = "crop_volume_m3_excess.green.based")
<- traitAdd(xx = su18_d, myDAP = 30, myValue = 0.05,
su18_d myTrait = "crop_area_m2_excess.green.based")
<- traitAdd(xx = su18_d, myDAP = 30, myValue = 0.01,
su18_d myTrait = "mean_crop_height_m_excess.green.based")
#
<- su18_d %>%
su18_d mutate(Value_f = ifelse(DAP %in% c(42,55,58), NA, Value_f),
#
Value_f = ifelse(Trait == "mean_crop_height_m_excess.green.based" &
< 65 & Value_f > 0.2,
DAP NA, Value_f),
Value_f = ifelse(Plot == 5689, NA, Value_f),
Value_f = ifelse(Plot %in% c(5301,5648) & DAP == 61, NA, Value_f))
#
<- su18_d %>% filter(Trait == "mean_crop_height_m_excess.green.based" &
xx < 65 & Value > 0.2)
DAP #
<- su18_d %>%
su18_d mutate(Value_f = ifelse(paste(Plot, DAP, Trait) %in%
paste(xx$Plot, xx$DAP, "crop_volume_m3_excess.green.based"),
NA, Value_f))
#
<- traitPredict(xx = su18_d, myDAP = 95,
su18_d myTrait = "crop_volume_m3_excess.green.based")
<- traitPredict(xx = su18_d, myDAP = 95,
su18_d myTrait = "crop_area_m2_excess.green.based")
<- traitPredict(xx = su18_d, myDAP = 95,
su18_d myTrait = "mean_crop_height_m_excess.green.based")
<- traitPredict(xx = su18_d, myDAP = 105,
su18_d myTrait = "crop_volume_m3_excess.green.based")
<- traitPredict(xx = su18_d, myDAP = 105,
su18_d myTrait = "crop_area_m2_excess.green.based")
<- traitPredict(xx = su18_d, myDAP = 105,
su18_d myTrait = "mean_crop_height_m_excess.green.based")
#
write.csv(su18_d, "Data_Drone/final_su18_d.csv", row.names = F)
Check Data
<- function(xd = it17_d, xf = it17_f,
ggDroneCheck myTitle = NULL,
myFilename = "DataCheck/RawDrone_Italy_2017.pdf",
xt = c("crop_volume_m3_excess.green.based",
"crop_area_m2_excess.green.based",
"mean_ndyi",
"mean_crop_height_m_excess.green.based",
"median_crop_height_m_excess.green.based",
"max_crop_height_m_excess.green.based") ) {
<- c("darkgreen", "darkorange", "darkred")
myColors <- xd %>% arrange(Entry)
xd #
pdf(myFilename, width = 16, height = 10)
for(i in unique(xd$Entry)) {
<- xd %>% filter(Entry == i)
xdi <- xf %>% filter(Entry == i)
xfi <- unique(xdi$Name)
j #
<- function(xti=xt[1]) {
ggPlotDrone <- max(xd%>%filter(Trait==xti)%>%pull(Value_f), na.rm = T)
yMax <- max(c(xd$DAP, xf%>%filter(Trait=="DTM")%>%pull(Value)), na.rm = T)
xMax <- xfi %>% filter(Trait == "DTF")
xdtf <- xfi %>% filter(Trait == "DTM")
xdtm <- xdi %>% filter(Trait == xti)
xd <- xd %>% filter(!is.na(Value_f))
xd2 ggplot(xd, aes(x = DAP, y = Value)) +
geom_line(alpha = 0.2, color = "black", size = 1) +
geom_line(data = xd2, aes(y = Value_f, color = as.factor(Rep)),
size = 1.5, alpha = 0.7) +
geom_point(aes(y = Value_f), color = "red", size = 0.5) +
geom_point(aes(shape = Sensor)) +
geom_vline(data = xdtf, aes(xintercept = Value),
alpha = 0.5, color = "darkgreen") +
geom_vline(data = xdtm, aes(xintercept = Value),
alpha = 0.5, color = "darkorange", lty = 2) +
facet_grid(. ~ paste(Rep, "-", Plot), scales = "free_y") +
scale_color_manual(values = myColors) +
+
theme_AGL theme(legend.position = "none") +
coord_cartesian(ylim = c(0,yMax), xlim = c(0,xMax)) +
labs(y = xti)
}#
<- ggPlotDrone(xti = xt[1])
mp1 <- ggPlotDrone(xti = xt[2])
mp2 <- ggPlotDrone(xti = xt[3])
mp3 #
<- ggarrange(mp1, mp2, mp3, ncol = 1, nrow = 3) %>%
mp annotate_figure(top = text_grob(paste(myTitle, "Entry", i, j)))
print(mp)
}dev.off()
}
Italy 2017
Additional/ggDroneCheck_It17.pdf
ggDroneCheck(xd = it17_d, xf = it17_f, myTitle = "Italy 2017",
myFilename = "Additional/ggDroneCheck_It17.pdf",
xt = c("crop_volume_m3_excess.green.based",
"mean_crop_height_m_excess.green.based",
"crop_area_m2_excess.green.based") )
Rosthern 2017
Additional/ggDroneCheck_Ro17.pdf
ggDroneCheck(xd = ro17_d, xf = ro17_f, myTitle = "Rosthern 2017",
myFilename = "Additional/ggDroneCheck_Ro17.pdf",
xt = c("crop_volume_m3_blue.ndvi.based",
"mean_crop_height_m_blue.ndvi.based",
"crop_area_m2_blue.ndvi.based") )
Sutherland 2017
Additional/ggDroneCheck_Su17.pdf
ggDroneCheck(xd = su17_d, xf = su17_f, myTitle = "Sutherland 2017",
myFilename = "Additional/ggDroneCheck_Su17.pdf",
xt = c("crop_volume_m3_blue.ndvi.based",
"mean_crop_height_m_blue.ndvi.based",
"crop_area_m2_blue.ndvi.based") )
Sutherland 2018
Additional/ggDroneCheck_Su18.pdf
ggDroneCheck(xd = su18_d, xf = su18_f, myTitle = "Sutherland 2018",
myFilename = "Additional/ggDroneCheck_Su18.pdf",
xt = c("crop_volume_m3_excess.green.based",
"mean_crop_height_m_excess.green.based",
"crop_area_m2_excess.green.based") )
Summarise Drone Data
<- function(xx, myTitle, myDAPs = NULL, myTraits, myTraitNames) {
ggDroneTrait # Prep data
if(is.null(myDAPs)) { myDAPs <- unique(xx$DAP)[order(unique(xx$DAP))] }
<- xx %>% filter(Trait %in% myTraits, DAP %in% myDAPs) %>%
xx mutate(Trait = plyr::mapvalues(Trait, myTraits, myTraitNames),
Trait = factor(Trait, levels = myTraitNames),
Group = factor(paste("Rep", Rep),
levels = c("Rep 1", "Rep 2", "Rep 3", "Outliers")),
DAP = paste("DAP", DAP),
DAP = factor(DAP, levels = paste("DAP", myDAPs)))
<- xx %>% filter(!is.na(Value_f))
xx # Plot
ggplot(xx, aes(x = Rep, color = Group, pch = Group)) +
geom_quasirandom(aes(y = Value_f), alpha = 0.25) +
facet_grid(Trait ~ DAP, scales = "free_y", switch = "y") +
scale_color_manual(name = NULL,
values = c("darkslategray","steelblue","darkslategray4","black")) +
scale_shape_manual(name = NULL, values = c(20,20,20,10)) +
scale_y_continuous(sec.axis = sec_axis(~ .)) +
+
theme_AGL theme(legend.position = "bottom",
axis.text.x = element_blank(),
axis.ticks.x = element_blank()) +
labs(title = myTitle, y = NULL, x = NULL)
}# Italy 2017
<- it17_d %>%
xx mutate(DAP = plyr::mapvalues(DAP, c(93, 101, 119, 133, 163),
c(94, 100, 118, 132, 164)))
<- ggDroneTrait(xx = xx, myTitle = "Italy 2017",
mp myDAPs = c(94,100,118,132,164),
myTraits = c("crop_volume_m3_excess.green.based",
"mean_crop_height_m_excess.green.based",
"crop_area_m2_excess.green.based"),
myTraitNames = c("Volume", "Height", "Area"))
ggsave("Additional/ggDroneTrait_It17.png", mp, width = 10, height = 4.5)
# Rosthern 2017
<- ggDroneTrait(xx = ro17_d, myTitle = "Rosthern 2017",
mp myDAPs = c(24,32,40,54,61,67,74,80,89,95),
myTraits = c("crop_volume_m3_blue.ndvi.based",
"mean_crop_height_m_blue.ndvi.based",
"crop_area_m2_blue.ndvi.based"),
myTraitNames = c("Volume", "Height", "Area"))
ggsave("Additional/ggDroneTrait_Ro17.png", mp, width = 12, height = 3.5)
# Sutherland 2017
<- ggDroneTrait(xx = su17_d, myTitle = "Sutherland 2017",
mp myDAPs = c(32,40,46,51,57,61,68,72,75,77,83),
myTraits = c("crop_volume_m3_blue.ndvi.based",
"mean_crop_height_m_blue.ndvi.based",
"crop_area_m2_blue.ndvi.based"),
myTraitNames = c("Volume", "Height", "Area"))
ggsave("Additional/ggDroneTrait_Su17.png", mp, width = 12, height = 3.5)
# Sutherland 2018
<- ggDroneTrait(xx = su18_d, myTitle = "Sutherland 2018",
mp myDAPs = c(42,55,58,61,65,68,72,76,79,86),
myTraits = c("crop_volume_m3_excess.green.based",
"mean_crop_height_m_excess.green.based",
"crop_area_m2_excess.green.based"),
myTraitNames = c("Volume", "Height", "Area"))
ggsave("Additional/ggDroneTrait_Su18.png", mp, width = 12, height = 3.5)
Model Growth Curves
<- function(xd, xf, myFolder, myFilename,
myGrowthCurve myOrder = "Entries") {
myTrait, #
<- xd %>% filter(Trait == myTrait)
xd <- xf %>% select(Plot, Rep, Entry, Name, Expt, Planting.Date) %>%
xm filter(!duplicated(Plot))
#
<- NULL # Growth curve coefficients
xg <- NULL # Predicted Values
xp for(i in unique(xd$Plot)) {
<- NULL
xgi <- xd %>% arrange(DAP) %>%
xdi filter(Plot == i, !is.na(Value_f))
#
if(nrow(xdi) > 2) {
<- SummarizeGrowth(data_t = xdi$DAP,
fit data_n = xdi$Value_f,
bg_correct = "none")
#
suppressMessages( xgi <- bind_rows(xgi, data.frame(t(c(i, unlist(fit$vals))))) )
#
<- xgi %>% rename(y0=n0, y0_se=n0_se, y0_p=n0_p, x_mid=t_mid)
xgi for(k in 1:(ncol(xgi)-1)) { xgi[,k] <- as.numeric(xgi[,k]) }
<- xgi %>% mutate(y_mid = k/(1 + ((k - y0)/y0) * exp(-r * x_mid)),
xgi b = -((r * x_mid) - y_mid) )
#
<- min(xd$DAP):max(xd$DAP)
myDays <- data.frame(Plot = i, DAP = myDays,
xpi Predicted.Values = xgi$k/(1 + ((xgi$k - xgi$y0)/xgi$y0) * exp(-xgi$r * myDays)))
<- bind_rows(xp, xpi)
xp #
<- xpi %>% filter(DAP > (xgi$x_mid - 3), DAP < (xgi$x_mid + 3))
gdays if(nrow(gdays)>0) {
<- lm(Predicted.Values ~ DAP, gdays)
myLM <- xgi %>% mutate(g.b = myLM[[1]][1],
xgi g.r = myLM[[1]][2] )
}#
<- xpi %>% filter(Predicted.Values >= xgi$k*0.95) %>% arrange(Predicted.Values) %>% slice(1)
xpi_max if(nrow(xpi_max)==0) {
<- xpi %>%
xpi_max filter(Predicted.Values >= xgi$k*0.94) %>%
arrange(Predicted.Values) %>% slice(1)
}if(nrow(xpi_max)==0) {
<- xpi %>%
xpi_max filter(Predicted.Values >= xgi$k*0.90) %>%
arrange(Predicted.Values) %>% slice(1)
}<- xpi %>% filter(Predicted.Values >= xgi$k*0.05) %>% arrange(Predicted.Values) %>% slice(1)
xpi_min $x.max <- ifelse(is.null(nrow(xpi_max)), max(xpi$DAP), xpi_max$DAP)
xgi$x.min <- xpi_min$DAP
xgi$x.d <- xgi$x.max - xgi$x_mid
xgi<- bind_rows(xg, xgi)
xg
}
}#
=="0"] <- NA
xg[xg<- xg %>% rename(Plot=1) %>%
xg mutate(Plot = as.integer(Plot)) %>%
left_join(xm, by = "Plot") %>%
select(Plot, Rep, Entry, Name, Expt, Planting.Date,
x.mid=x_mid, x.max,
r, b, g.r, g.b, k, x.min, x.gen=t_gen, auc.l=auc_l, auc.e=auc_e, y0, sigma,
x.d, r.se=r_se, r.p=r_p, k.se=k_se, k.p=k_p, y0.se=y0_se, y0.p=y0_p, df, note)
<- xp %>%
xp left_join(xm, by = "Plot") %>%
select(Plot, Rep, Entry, Name, Expt, Planting.Date, DAP, Predicted.Values)
#
<- max(xd$Value_f, na.rm = T)
yMax <- max(xd$DAP, na.rm = T)
xMax <- NULL
xpm #
if(myOrder == "Entries") { myOrders <- 1:324 }
if(myOrder == "DTF") { myOrders <- xg %>% arrange(k) %>% pull(Entries) %>% unique() }
#
pdf(paste0(myFolder, "PDF_", myFilename, ".pdf"), width = 8, height = 4)
for(i in myOrders) {
<- xd %>% filter(Entry == i, !is.na(Value_f))
xdi <- xf %>% filter(Entry == i)
xfi <- xg %>% filter(Entry == i)
xgi <- xp %>% filter(Entry == i)
xpi #
<- xpi %>% group_by(Entry, Name, DAP) %>%
xpmi summarise(Predicted.Values = mean(Predicted.Values, na.rm = T))
<- bind_rows(xpm, xpmi)
xpm #
<- xfi %>% filter(Trait == "DTF")
xdtf <- xfi %>% filter(Trait == "DTM")
xdtm <- xdtf %>% group_by(Entry) %>% summarise(Value = mean(Value, na.rm =T))
xdtf2 <- xdtm %>% group_by(Entry) %>% summarise(Value = mean(Value, na.rm =T))
xdtm2 <- min(xdi$DAP):max(xdi$DAP)
myDays #
<- unique(paste(stringr::str_pad(xdi$Entry, 3, pad = "0"), "|", xdi$Name))
myTitle #
<- ggplot(xdi, aes(x = DAP)) +
mp1 geom_vline(data = xdtf, aes(xintercept = Value), color = "darkgreen", alpha = 0.5) +
geom_vline(data = xdtm, aes(xintercept = Value), color = "darkorange", alpha = 0.5) +
geom_point(aes(y = Value_f), color = "red", alpha = 0.7) +
geom_point(aes(y = Value), alpha = 0.5) +
geom_line(data = xpi, aes(y = Predicted.Values), alpha = 0.8) +
facet_grid(. ~ paste(Rep, Plot, sep = "-")) +
coord_cartesian(ylim = c(0,yMax), xlim = c(0,xMax)) +
+
theme_AGL labs(title = myTitle, y = myTrait)
<- ggplot(xpi, aes(x = DAP, y = Predicted.Values)) +
mp2 geom_vline(data = xdtf2, aes(xintercept = Value), color = "darkgreen", alpha = 0.5) +
geom_vline(data = xdtm2, aes(xintercept = Value), color = "darkorange", alpha = 0.5) +
geom_line(alpha = 0.3, aes(group = Plot)) +
geom_line(data = xpmi, color = "red") +
facet_grid(. ~ paste("Entry",Entry)) +
coord_cartesian(ylim = c(0,yMax), xlim = c(0,xMax)) +
+
theme_AGL labs(title = "")
<- ggarrange(mp1, mp2, widths = c(1,0.5))
mp print(mp)
}dev.off()
#
list(xd, # input data
# Growth curve coefficients
xg, # Predicted Values
xp, #
xpm)
}<- function(xpm, myTitle = NULL,
ggGrowthCurve myEntries = c(9, 35, 73, 94, 113),
myColors = c("darkgreen", "darkgoldenrod3", "darkred",
"steelblue4", "darkslategray") ) {
#
if(sum(colnames(xpm)=="Expt")==0) { xpm <- xpm %>% mutate(Expt = myTitle) }
<- xpm %>% filter(Entry %in% myEntries) %>%
xpe mutate(Entry = factor(Entry, levels = myEntries))
<- ggplot(xpm, aes(x = DAP, y = Predicted.Values, group = Entry, key1 = Name)) +
mp geom_line(alpha = 0.05) +
geom_line(data = xpe, size = 2, aes(color = paste0(Name," (",Entry,")"))) +
facet_grid(. ~ Expt, scales = "free_x", space = "free_x") +
scale_color_manual(name = NULL, values = myColors) +
+
theme_AGL labs(x = "Days After Planting")
mp }
Italy 2017
Additional/ggpGrowthCurves_It17_volume.html
Additional/ggpGrowthCurves_It17_area.html
Additional/ggpGrowthCurves_It17_height.html
<- myGrowthCurve(xd = it17_d, xf = it17_f,
it17_gc.v myFolder = "Additional/", myFilename = "It17_volume",
myTrait = "crop_volume_m3_excess.green.based")
<- ggGrowthCurve(xpm = it17_gc.v[[4]], myTitle = "Italy 2017 - Volume")
mp ggsave("Additional/ggGrowthCurves_It17_volume.png", mp, width = 8, height = 4)
<- ggplotly(mp)
mp saveWidget(mp, file="Additional/ggpGrowthCurves_It17_volume.html")
#
<- myGrowthCurve(xd = it17_d, xf = it17_f,
it17_gc.a myFolder = "Additional/", myFilename = "It17_area",
myTrait = "crop_area_m2_excess.green.based")
<- ggGrowthCurve(xpm = it17_gc.a[[4]], myTitle = "Italy 2017 - Area")
mp ggsave("Additional/ggGrowthCurves_It17_area.png", mp, width = 8, height = 4)
<- ggplotly(mp)
mp saveWidget(mp, file="Additional/ggpGrowthCurves_It17_area.html")
#
<- myGrowthCurve(xd = it17_d, xf = it17_f,
it17_gc.h myFolder = "Additional/", myFilename = "It17_height",
myTrait = "mean_crop_height_m_excess.green.based")
<- ggGrowthCurve(xpm = it17_gc.h[[4]], myTitle = "Italy 2017 - Height")
mp ggsave("Additional/ggGrowthCurves_It17_height.png", mp, width = 8, height = 4)
<- ggplotly(mp)
mp ::saveWidget(mp, file="Additional/ggpGrowthCurves_It17_height.html") htmlwidgets
Rosthern 2017
Additional/ggpGrowthCurves_Ro17_volume.html
Additional/ggpGrowthCurves_Ro17_area.html
Additional/ggpGrowthCurves_Ro17_height.html
<- myGrowthCurve(xd = ro17_d, xf = ro17_f,
ro17_gc.v myFolder = "Additional/", myFilename = "Ro17_volume",
myTrait = "crop_volume_m3_blue.ndvi.based")
<- ggGrowthCurve(xpm = ro17_gc.v[[4]], myTitle = "Rosthern 2017 - Volume")
mp ggsave("Additional/ggGrowthCurves_Ro17_volume.png", mp, width = 8, height = 4)
<- ggplotly(mp)
mp ::saveWidget(mp, file="Additional/ggpGrowthCurves_Ro17_volume.html")
htmlwidgets#
<- myGrowthCurve(xd = ro17_d, xf = ro17_f,
ro17_gc.a myFolder = "Additional/", myFilename = "Ro17_area",
myTrait = "crop_area_m2_blue.ndvi.based")
<- ggGrowthCurve(xpm = ro17_gc.a[[4]], myTitle = "Rosthern 2017 - Area")
mp ggsave("Additional/ggGrowthCurves_Ro17_area.png", mp, width = 8, height = 4)
<- ggplotly(mp)
mp ::saveWidget(mp, file="Additional/ggpGrowthCurves_Ro17_area.html")
htmlwidgets#
<- myGrowthCurve(xd = ro17_d, xf = ro17_f,
ro17_gc.h myFolder = "Additional/", myFilename = "Ro17_height",
myTrait = "mean_crop_height_m_blue.ndvi.based")
<- ggGrowthCurve(xpm = ro17_gc.h[[4]], myTitle = "Rosthern 2017 - Height")
mp ggsave("Additional/ggGrowthCurves_Ro17_height.png", mp, width = 8, height = 4)
<- ggplotly(mp)
mp ::saveWidget(mp, file="Additional/ggpGrowthCurves_Ro17_height.html") htmlwidgets
Sutherland 2017
Additional/ggpGrowthCurves_Su17_volume.html
Additional/ggpGrowthCurves_Su17_area.html
Additional/ggpGrowthCurves_Su17_height.html
<- myGrowthCurve(xd = su17_d %>% filter(Plot!=5604),
su17_gc.v xf = su17_f,
myFolder = "Additional/", myFilename = "Su17_volume",
myTrait = "crop_volume_m3_blue.ndvi.based")
<- ggGrowthCurve(xpm = su17_gc.v[[4]], myTitle = "Sutherland 2017 - Volume")
mp ggsave("Additional/ggGrowthCurves_Su17_volume.png", mp, width = 8, height = 4)
<- ggplotly(mp)
mp ::saveWidget(mp, file="Additional/ggpGrowthCurves_Su17_volume.html")
htmlwidgets#
<- myGrowthCurve(xd = su17_d, xf = su17_f,
su17_gc.a myFolder = "Additional/", myFilename = "Su17_area",
myTrait = "crop_area_m2_blue.ndvi.based")
<- ggGrowthCurve(xpm = su17_gc.a[[4]], myTitle = "Sutherland 2017 - Area")
mp ggsave("Additional/ggGrowthCurves_Su17_area.png", mp, width = 8, height = 4)
<- ggplotly(mp)
mp ::saveWidget(mp, file="Additional/ggpGrowthCurves_Su17_area.html")
htmlwidgets#
<- myGrowthCurve(xd = su17_d, xf = su17_f,
su17_gc.h myFolder = "Additional/", myFilename = "Su17_height",
myTrait = "mean_crop_height_m_blue.ndvi.based")
<- ggGrowthCurve(xpm = su17_gc.h[[4]], myTitle = "Sutherland 2017 - Height")
mp ggsave("Additional/ggGrowthCurves_Su17_height.png", mp, width = 8, height = 4)
<- ggplotly(mp)
mp ::saveWidget(mp, file="Additional/ggpGrowthCurves_Su17_height.html") htmlwidgets
Sutherland 2018
Additional/ggpGrowthCurves_Su18_volume.html
Additional/ggpGrowthCurves_Su18_area.html
Additional/ggpGrowthCurves_Su18_height.html
<- myGrowthCurve(xd = su18_d, xf = su18_f,
su18_gc.v myFolder = "Additional/", myFilename = "Su18_volume",
myTrait = "crop_volume_m3_excess.green.based")
<- ggGrowthCurve(xpm = su18_gc.v[[4]], myTitle = "Sutherland 2018 - Volume")
mp ggsave("Additional/ggGrowthCurves_Su18_volume.png", mp, width = 8, height = 4)
<- ggplotly(mp)
mp ::saveWidget(mp, file="Additional/ggpGrowthCurves_Su18_volume.html")
htmlwidgets#
<- myGrowthCurve(xd = su18_d, xf = su18_f,
su18_gc.a myFolder = "Additional/", myFilename = "Su18_area",
myTrait = "crop_area_m2_excess.green.based")
<- ggGrowthCurve(xpm = su18_gc.a[[4]], myTitle = "Sutherland 2018 - Area")
mp ggsave("Additional/ggGrowthCurves_Su18_area.png", mp, width = 8, height = 4)
<- ggplotly(mp)
mp ::saveWidget(mp, file="Additional/ggpGrowthCurves_Su18_area.html")
htmlwidgets#
<- myGrowthCurve(xd = su18_d, xf = su18_f,
su18_gc.h myFolder = "Additional/", myFilename = "Su18_height",
myTrait = "mean_crop_height_m_excess.green.based")
<- ggGrowthCurve(xpm = su18_gc.h[[4]], myTitle = "Sutherland 2018 - Height")
mp ggsave("Additional/ggGrowthCurves_Su18_height.png", mp, width = 8, height = 4)
<- ggplotly(mp)
mp ::saveWidget(mp, file="Additional/ggpGrowthCurves_Su18_height.html") htmlwidgets
Figure 1 - EnvData
# Prep data
<- read.csv("https://raw.githubusercontent.com/derekmichaelwright/AGILE_LDP_Phenology/master/data/data_env.csv") %>%
xE rename(`Days After Planting`=DaysAfterPlanting) %>%
filter(Expt %in% myExpts1) %>%
select(Expt, `Days After Planting`, DayLength, Temp_mean) %>%
gather(Trait, Value, DayLength, Temp_mean) %>%
mutate(Unit = ifelse(Trait == "DayLength", "Hours", "Degrees Celcius"),
Trait = plyr::mapvalues(Trait, c("DayLength", "Temp_mean"),
c("DayLength", "Mean Temperature")))
<- bind_rows(it17_f %>% filter(Trait == "DTF"),
yy %>% filter(Trait == "DTF"),
ro17_f %>% filter(Trait == "DTF"),
su17_f %>% filter(Trait == "DTF") ) %>%
su18_f mutate(Expt = plyr::mapvalues(Expt, myExpts2, myExpts1)) %>%
group_by(Expt, Name) %>%
summarise(Value = mean(Value, na.rm = T))
# Plot
<- ggplot(yy, aes(x = Value, fill = Expt)) +
mp1 geom_density(alpha = 0.7) +
scale_fill_manual(name = NULL, values = myColors_Expt) +
scale_x_continuous(breaks = seq(30, 160, by = 10)) +
+
theme_AGL theme(legend.position = "none") +
labs(title = "A) Days to Flower",
x = "Days After Planting", y = "Density")
<- ggplot(xE %>% filter(Trait == "DayLength"),
mp2 aes(x = `Days After Planting`, y = Value, color = Expt)) +
geom_line(size = 1.25, alpha = 0.7) +
scale_color_manual(name = NULL, values = myColors_Expt) +
+
theme_AGL theme(legend.position = "bottom") +
labs(title = "B) Day Length",
y = "Hours", x = "Days After Planting")
<- ggplot(xE %>% filter(Trait == "Mean Temperature"),
mp3 aes(x = `Days After Planting`, y = Value, color = Expt)) +
geom_line(size = 0.75, alpha = 0.7) +
scale_color_manual(name = NULL, values = myColors_Expt) +
+
theme_AGL theme(legend.position = "bottom") +
labs(title = "C) Mean Temperature",
y = "Degrees Celcius", x = "Days After Planting")
<- ggarrange(mp1, ggarrange(mp2, mp3, ncol = 2, nrow = 1,
mp common.legend = T, legend = "bottom"),
ncol = 1, nrow = 2, heights = c(0.75,1) )
ggsave("Figure_01.png", mp, width = 8, height = 6, dpi = 600, bg = "white")
Figure 2 - Growth Curve Coefficients
# Create plotting function
<- function(xd, xf, myPlot, myYmax = NULL,
ggGrowthCoefs minDAP = NULL, maxDAP = NULL,
myTitle = NULL, mySubtitle = F) {
#
if(is.null(minDAP)) { minDAP <- min(xd[[3]]$DAP) }
if(is.null(maxDAP)) { maxDAP <- max(xd[[3]]$DAP) }
if(is.null(myYmax)) { myYmax <- max(xd[[2]]$k) }
#
<- xd[[2]] %>% filter(Plot == myPlot)
x1 <- xd[[3]] %>% filter(Plot == myPlot)
x2 #
if(mySubtitle == T) {
<- paste("Plot", x1$Plot, "| Entry", x1$Entry, "|", x1$Name)
mySubtitle else { mySubtitle <- NULL }
} #
ggplot(x1) +
#
geom_hline(yintercept = 0, lty = 2, alpha = 0.5) +
geom_line(data = x2, aes(x = DAP, y = Predicted.Values), size = 1.5) +
#
geom_hline(aes(yintercept = k, color = "k"), size = 1) +
geom_abline(aes(slope = g.r, intercept = g.b, color = "g.r"), size = 1) +
geom_point(aes(x = x.mid, y = k/2)) +
#
geom_point(aes(x = x.min), y = 0) +
geom_text(aes(x = x.min), y = -0.01, label = "x.min") +
#
geom_segment(y = 0, aes(x = x.mid, xend = x.mid, yend = k/2), lty = 2) +
geom_point(y = 0, aes(x = x.mid)) +
geom_text(y = -0.01, aes(x = x.mid, label = "x.mid")) +
#
geom_segment(y = 0, aes(x = x.max, xend = x.max, yend = k), lty = 2) +
geom_point(aes(x = x.max, y = k)) +
geom_point(aes(x = x.max, y = 0)) +
geom_text(aes(x = x.max, y = -0.01), label = "x.max") +
#
geom_segment(aes(x = x.mid, xend = x.max, y = k/10, yend = k/10), lty = 2) +
geom_text(aes(x = x.max-((x.max-x.mid)/2), y = 1.5*k/10), label = "x.d") +
#
+
theme_AGL scale_color_manual(name = NULL, breaks = c("k","r","g.r"),
values = c("purple","steelblue","darkgreen")) +
scale_x_continuous(limits = c(minDAP, maxDAP), expand = c(0,0)) +
ylim(c(-0.01,myYmax)) +
labs(title = myTitle, subtitle = mySubtitle,
y = "Predicted Value (y)", x = "Days After Planting (x)",
caption = "y = k / (1 + ((k - y0) / y0) * exp(-r * x))")
}#
<- ggGrowthCoefs(xd = ro17_gc.v, xf = ro17_f, myPlot = 6322,
mp myYmax = 0.175, minDAP = 20, maxDAP = 65)
ggsave("Figure_02.png", mp, width = 6, height = 3, dpi = 600)
Additional Figures 1 - Growth Curve Coefficients
# Italy - Entry 221 vs 295
<- ggGrowthCoefs(xd = it17_gc.v, xf = it17_f, myPlot = 229,
mp1 myTitle = "Italy 2017 - Entry 221",
myYmax = 0.5, minDAP = 100, maxDAP = 145)
<- ggGrowthCoefs(xd = it17_gc.v, xf = it17_f, myPlot = 225,
mp2 myTitle = "Italy 2017 - Entry 295",
myYmax = 0.5, minDAP = 100, maxDAP = 145)
<- ggarrange(mp1, mp2, ncol = 1)
mp ggsave("Additional/Additional_Figure_01_1.png", mp, width = 8, height = 6)
# Rosthern - Entry 76 vs 94
<- ggGrowthCoefs(xd = ro17_gc.v, xf = ro17_f, myPlot = 6986,
mp1 myTitle = "Rosthern 2017 - Entry 76",
myYmax = 0.25, minDAP = 25, maxDAP = 65)
<- ggGrowthCoefs(xd = ro17_gc.v, xf = ro17_f, myPlot = 6322,
mp2 myTitle = "Rosthern 2017 - Entry 94",
myYmax = 0.25, minDAP = 25, maxDAP = 65)
<- ggarrange(mp1, mp2, ncol = 1)
mp ggsave("Additional/Additional_Figure_01_2.png", mp, width = 8, height = 6)
# Entry 107 - Italy vs Rosthern
<- ggGrowthCoefs(xd = it17_gc.v, xf = it17_f, myPlot = 242,
mp1 myTitle = "Italy 2017 - Entry 107",
myYmax = 0.45, minDAP = 0, maxDAP = 155)
<- ggGrowthCoefs(xd = ro17_gc.v, xf = ro17_f, myPlot = 6380,
mp2 myTitle = "Rosthern 2017 - Entry 107",
myYmax = 0.45, minDAP = 0, maxDAP = 155)
<- ggarrange(mp1, mp2, ncol = 1)
mp ggsave("Additional/Additional_Figure_01_3.png", mp, width = 8, height = 6)
Supplemental Figure 1 - Drone Data
<- function(xx, myTitle, myDAPs = NULL, myTraits,
ggDroneTrait myTraitNames = myTraits ) {
# Prep data
if(is.null(myDAPs)) { myDAPs <- unique(xx$DAP)[order(unique(xx$DAP))] }
<- xx %>% filter(Trait %in% myTraits, DAP %in% myDAPs) %>%
xx mutate(Trait = plyr::mapvalues(Trait, myTraits, myTraitNames),
Trait = factor(Trait, levels = myTraitNames),
Rep = factor(paste("Rep", Rep)),
DAP = paste("DAP", DAP),
DAP = factor(DAP, levels = paste("DAP", myDAPs)) ) %>%
filter(!is.na(Value_f), !is.na(Value))
# Plot
ggplot(xx, aes(x = Rep, color = Rep, pch = Rep)) +
geom_quasirandom(aes(y = Value_f), size = 0.3, alpha = 0.7) +
facet_grid(Trait ~ DAP, scales = "free_y", switch = "y") +
scale_color_manual(name = NULL,
values = c("darkslategray","slategray4","darkslategray4")) +
scale_shape_manual(name = NULL, values = c(16,15,18)) +
scale_y_continuous(sec.axis = sec_axis(~ .)) +
+
theme_AGL theme(strip.placement = "outside",
axis.text.x = element_blank(),
axis.ticks.x = element_blank()) +
guides(colour = guide_legend(override.aes = list(size = 3, alpha = 1))) +
labs(title = myTitle, y = NULL, x = NULL,
caption = paste("Number of data points =", nrow(xx)))
}# Italy 2017
<- it17_d %>%
xx mutate(DAP = plyr::mapvalues(DAP, c(93, 101, 119, 133, 163),
c(94, 100, 118, 132, 164)))
<- ggDroneTrait(xx = xx, myTitle = "A) Metaponto, Italy 2017",
mp1 myDAPs = c(94,100,118,132,164),
myTraits = c("crop_volume_m3_excess.green.based",
"mean_crop_height_m_excess.green.based",
"crop_area_m2_excess.green.based"),
myTraitNames = c("Volume", "Height", "Area"))
# Rosthern 2017
<- ggDroneTrait(xx = ro17_d, myTitle = "B) Rosthern, Canada",
mp2 myDAPs = c(24,32,40,54,61,67,74,80,89,95),
myTraits = c("crop_volume_m3_blue.ndvi.based",
"mean_crop_height_m_blue.ndvi.based",
"crop_area_m2_blue.ndvi.based"),
myTraitNames = c("Volume", "Height", "Area"))
# Sutherland 2017
<- ggDroneTrait(xx = su17_d, myTitle = "C) Sutherland, Canada",
mp3 myDAPs = c(32,40,46,51,57,61,68,72,75,77,83),
myTraits = c("crop_volume_m3_blue.ndvi.based",
"mean_crop_height_m_blue.ndvi.based",
"crop_area_m2_blue.ndvi.based"),
myTraitNames = c("Volume", "Height", "Area"))
# Sutherland 2018
<- ggDroneTrait(xx = su18_d, myTitle = "D) Sutherland, Canada 2018",
mp4 myDAPs = c(42,55,58,61,65,68,72,76,79,86),
myTraits = c("crop_volume_m3_excess.green.based",
"mean_crop_height_m_excess.green.based",
"crop_area_m2_excess.green.based"),
myTraitNames = c("Volume", "Height", "Area"))
#
<- ggarrange(mp1, mp2, mp3, mp4, ncol = 1, nrow = 4,
mp common.legend = T, legend = "bottom")
ggsave("Supplemental_Figure_01.png", mp,
width = 8, height = 11, dpi = 600, bg = "white")
ggsave("Additional/Supplemental_Figure_01_A.png", mp1, width = 10, height = 4.5)
ggsave("Additional/Supplemental_Figure_01_B.png", mp2, width = 12, height = 3.5)
ggsave("Additional/Supplemental_Figure_01_C.png", mp3, width = 12, height = 3.5)
ggsave("Additional/Supplemental_Figure_01_D.png", mp4, width = 12, height = 3.5)
Supplemental Figure 2 - Correlation Plots
# Create plotting function
<- function(xd, xf, myTitle, myTrait, xLab, yLab, myColor = "darkgreen") {
ggDroneCorr # Prep data
<- xd[[2]] %>% select(Plot, k)
xd <- xf %>% filter(Trait == myTrait) %>% select(Plot, Entry, Name, Value)
xf <- left_join(xf, xd, by = "Plot") %>%
xx group_by(Entry, Name) %>%
summarise(Value = mean(Value, na.rm = T),
k = mean(k, na.rm = T)) %>%
ungroup()
<- cor(xx$Value, xx$k, use = "complete.obs")^2
myCorr <- paste("italic(R)^2 ==", round(myCorr,2))
myLabel1 # Plot
ggplot(xx, aes(x = Value, y = k)) +
stat_smooth(geom = "line", method = "lm", se = F,
size = 1, color = "black") +
geom_point(alpha = 0.6, pch = 16, color = myColor) +
geom_label(label = myLabel1, hjust = 0, parse = T,
x = -Inf, y = Inf, vjust = 1 ) +
facet_grid(. ~ as.character(myTitle)) +
+
theme_AGL labs(x = xLab, y = yLab)
}#
<- ggDroneCorr(xd = it17_gc.h, xf = it17_f, myColor = myColors_Expt[1],
mp1 myTitle = "Metaponto, Italy 2017", yLab = "Plot Height (UAV)",
myTrait = "Canopy.Height", xLab = "Canopy Height (Manual)")
<- ggDroneCorr(xd = ro17_gc.h, xf = ro17_f, myColor = myColors_Expt[2],
mp2 myTitle = "Rosthern, Canada 2017", yLab = "Plot Height (UAV)",
myTrait = "Canopy.Height", xLab = "Canopy Height (Manual)")
<- ggDroneCorr(xd = su17_gc.h, xf = su17_f, myColor = myColors_Expt[3],
mp3 myTitle = "Sutherland, Canada 2017", yLab = "Plot Height (UAV)",
myTrait = "Canopy.Height", xLab = "Canopy Height (Manual)")
<- ggDroneCorr(xd = su18_gc.h, xf = su18_f, myColor = myColors_Expt[4],
mp4 myTitle = "Sutherland, Canada 2018", yLab = "Plot Height (UAV)",
myTrait = "CanopyHeight", xLab = "Canopy Height (Manual)")
<- ggarrange(mp1, mp2, mp3, mp4, ncol = 4, nrow = 1) %>%
mp_a annotate_figure(fig.lab = "A) Plot Height (UAV) x Canopy Height (Manual)",
fig.lab.pos = "top.left", fig.lab.size = 13, top = "") +
theme(plot.margin=unit(c(0.1,0,0,0), 'cm'))
#
<- ggDroneCorr(xd = it17_gc.v, xf = it17_f, myColor = myColors_Expt[1],
mp1 myTitle = "Metaponto, Italy 2017", yLab = "Plot Volume (UAV)",
myTrait = "Plot.Biomass", xLab = "Total Biomass (Manual)")
<- ggDroneCorr(xd = ro17_gc.v, xf = ro17_f, myColor = myColors_Expt[2],
mp2 myTitle = "Rosthern, Canada 2017", yLab = "Plot Volume (UAV)",
myTrait = "Plot.Biomass", xLab = "Total Biomass (Manual)")
<- ggDroneCorr(xd = su17_gc.v, xf = su17_f, myColor = myColors_Expt[3],
mp3 myTitle = "Sutherland, Canada 2017", yLab = "Plot Volume (UAV)",
myTrait = "Plot.Biomass", xLab = "Total Biomass (Manual)")
<- ggDroneCorr(xd = su18_gc.v, xf = su18_f, myColor = myColors_Expt[4],
mp4 myTitle = "Sutherland, Canada 2018", yLab = "Plot Volume (UAV)",
myTrait = "Plot.Biomass", xLab = "Total Biomass (Manual)")
<- ggarrange(mp1, mp2, mp3, mp4, ncol = 4, nrow = 1) %>%
mp_b annotate_figure(fig.lab = "B) Plot Volume (UAV) x Biomass (Manual)",
fig.lab.pos = "top.left", fig.lab.size = 13, top = "") +
theme(plot.margin=unit(c(0.1,0,0,0), 'cm'))
<- ggarrange(mp_a, mp_b, nrow = 2)
mp ggsave("Supplemental_Figure_02.png", mp, width = 10, height = 6, dpi = 600, bg = "white")
Additional Figures 2 - Volume x Biomass x Yield
# Volume x Biomass
<- ggDroneCorr(xd = it17_gc.v, xf = it17_f, myColor = myColors_Expt[1],
mp1 myTitle = "Metaponto, Italy 2017", yLab = "Plot Volume (UAV)",
myTrait = "Straw.Biomass", xLab = "Straw Biomass (Manual)")
<- ggDroneCorr(xd = ro17_gc.v, xf = ro17_f, myColor = myColors_Expt[2],
mp2 myTitle = "Rosthern, Canada 2017", yLab = "Plot Volume (UAV)",
myTrait = "Straw.Biomass", xLab = "Straw Biomass (Manual)")
<- ggDroneCorr(xd = su17_gc.v, xf = su17_f, myColor = myColors_Expt[3],
mp3 myTitle = "Sutherland, Canada 2017", yLab = "Plot Volume (UAV)",
myTrait = "Straw.Biomass", xLab = "Straw Biomass (Manual)")
<- ggDroneCorr(xd = su18_gc.v, xf = su18_f, myColor = myColors_Expt[4],
mp4 myTitle = "Sutherland, Canada 2018", yLab = "Plot Volume (UAV)",
myTrait = "Straw.Biomass", xLab = "Straw Biomass (Manual)")
<- ggarrange(mp1, mp2, mp3, mp4, ncol = 4, nrow = 1) %>%
mp annotate_figure(top = "Plot Volume (UAV) x Straw Biomass (Manual)")
ggsave("Additional/Additional_Figure_02_1.png", mp,
width = 10, height = 3, dpi = 600, bg = "white")
# Volume x Yield
<- ggDroneCorr(xd = it17_gc.v, xf = it17_f, myColor = myColors_Expt[1],
mp1 myTitle = "Italy 2017", yLab = "Plot Volume (UAV)",
myTrait = "Seed.Mass", xLab = "Plot Yield (Manual)")
<- ggDroneCorr(xd = ro17_gc.v, xf = ro17_f, myColor = myColors_Expt[2],
mp2 myTitle = "Rosthern 2017", yLab = "Plot Volume (UAV)",
myTrait = "Seed.Mass", xLab = "Plot Yeild (Manual)")
<- ggDroneCorr(xd = su17_gc.v, xf = su17_f, myColor = myColors_Expt[3],
mp3 myTitle = "Sutherland 2017", yLab = "Plot Volume (UAV)",
myTrait = "Seed.Mass", xLab = "Plot Yield (Manual)")
<- ggDroneCorr(xd = su18_gc.v, xf = su18_f, myColor = myColors_Expt[4],
mp4 myTitle = "Sutherland 2018", yLab = "Plot Volume (UAV)",
myTrait = "Seed.Mass", xLab = "Plot Yield (Manual)")
<- ggarrange(mp1, mp2, mp3, mp4, ncol = 4, nrow = 1) %>%
mp annotate_figure(top = "Plot Volume (UAV) x Plot Yield (Manual)")
ggsave("Additional/Additional_Figure_02_2.png", mp,
width = 10, height = 3, dpi = 600, bg = "white")
# Volume x Growth Habit
<- ggDroneCorr(xd = it17_gc.v, xf = it17_f, myColor = myColors_Expt[1],
mp1 myTitle = "Italy 2017", yLab = "Plot Volume (Drone)",
myTrait = "Nodes.At.Flower", xLab = "Nodes at Flowering (Manual)")
<- ggDroneCorr(xd = ro17_gc.v, xf = ro17_f, myColor = myColors_Expt[2],
mp2 myTitle = "Rosthern 2017", yLab = "Plot Volume (Drone)",
myTrait = "Nodes.At.Flower", xLab = "Nodes at Flowering (Manual)")
<- ggDroneCorr(xd = su17_gc.v, xf = su17_f, myColor = myColors_Expt[3],
mp3 myTitle = "Sutherland 2017", yLab = "Plot Volume (Drone)",
myTrait = "Nodes.At.Flower", xLab = "Nodes at Flowering (Manual)")
<- ggDroneCorr(xd = su18_gc.v, xf = su18_f, myColor = myColors_Expt[4],
mp4 myTitle = "Sutherland 2018", yLab = "Plot Volume (Drone)",
myTrait = "Growth.Habit", xLab = "Growth Habit (Manual)")
<- ggarrange(mp1, mp2, mp3, mp4, ncol = 4, nrow = 1) %>%
mp annotate_figure(top = "Plot Volume x Growth Habit")
ggsave("Additional/Additional_Figure_02_3.png", mp,
width = 10, height = 3, dpi = 600, bg = "white")
Figure 3 - Growth Curves
# Create plotting function
<- function(xpm, xF, myTitle = NULL,
ggGrowthCurve xlab = "Days After Planting", ylab = "Predicted Values",
myEntries = c(19, 94, 107, 27), #252
myColors = c("chartreuse4", "red4", "blue2", "steelblue"),
linesize = 1.75 ) {
#
<- xF %>% filter(Trait == "DTF", Entry %in% myEntries) %>%
xF group_by(Name, Entry) %>% summarise(Value = mean(Value, na.rm = T))
if(sum(colnames(xpm)=="Expt")==0) { xpm <- xpm %>% mutate(Expt = myTitle) }
<- xpm %>% filter(Entry %in% myEntries) %>%
xpe mutate(Entry = factor(Entry, levels = myEntries)) %>%
arrange(Entry) %>%
mutate(Name = factor(Name))
<- ggplot(xpm, aes(x = DAP, y = Predicted.Values, group = Entry, key1 = Name)) +
mp geom_line(alpha = 0.1) +
geom_line(data = xpe, size = linesize, alpha = 0.8,
aes(color = Name)) +
geom_point(data = xF, y = 0, size = 1.5, alpha = 0.8, pch = 16,
aes(x = Value, color = Name)) +
facet_grid(. ~ Expt, scales = "free_x", space = "free_x") +
scale_color_manual(name = NULL, values = myColors) +
+
theme_AGL labs(x = xlab, y = ylab)
mp }
# Italy 2017
<- ggGrowthCurve(xpm = it17_gc.v[[4]], xF = it17_f, xlab = "",
mp1 ylab = "Plot Volume", myTitle = "Metaponto, Italy 2017")
<- ggGrowthCurve(xpm = it17_gc.h[[4]], xF = it17_f, xlab = "",
mp2 ylab = "Plot Height", myTitle = "Metaponto, Italy 2017")
<- ggGrowthCurve(xpm = it17_gc.a[[4]], xF = it17_f, xlab = "",
mp3 ylab = "Plot Area", myTitle = "Metaponto, Italy 2017")
# Sutherland 2017
<- ggGrowthCurve(xpm = su17_gc.v[[4]], xF = su17_f, xlab = "",
mp4 ylab = "", myTitle = "Sutherland, Canada 2017")
<- ggGrowthCurve(xpm = su17_gc.h[[4]], xF = su17_f, xlab = "",
mp5 ylab = "", myTitle = "Sutherland, Canada 2017")
<- ggGrowthCurve(xpm = su17_gc.a[[4]], xF = su17_f, xlab = "Days After Planting",
mp6 ylab = "", myTitle = "Sutherland, Canada 2017")
# Rosthern 2017
<- ggGrowthCurve(xpm = ro17_gc.v[[4]], xF = ro17_f, xlab = "",
mp7 ylab = "", myTitle = "Rosthern, Canada 2017")
<- ggGrowthCurve(xpm = ro17_gc.h[[4]], xF = ro17_f, xlab = "",
mp8 ylab = "", myTitle = "Rosthern, Canada 2017")
<- ggGrowthCurve(xpm = ro17_gc.a[[4]], xF = ro17_f, xlab = "",
mp9 ylab = "", myTitle = "Rosthern, Canada 2017")
#
<- ggarrange(mp1, mp4, mp7, mp2, mp5, mp8, mp3, mp6, mp9,
mp ncol = 3, nrow = 3, common.legend = T)
ggsave("Figure_03.png", mp, width = 8, height = 6, dpi = 600, bg = "white")
Additional Figures 3 - Growth Curves
# Plot
<- ggGrowthCurve(xpm = it17_gc.h[[4]], xF = it17_f,
mp1 xlab = "Days After Planting", ylab = "Plot Height",
myTitle = "Metaponto, Italy 2017")
<- ggGrowthCurve(xpm = su17_gc.h[[4]], xF = su17_f,
mp2 xlab = "Days After Planting", ylab = "",
myTitle = "Sutherland, Canada 2017")
<- ggGrowthCurve(xpm = it17_gc.a[[4]], xF = it17_f,
mp3 xlab = "Days After Planting", ylab = "Plot Area",
myTitle = "Metaponto, Italy 2017")
<- ggGrowthCurve(xpm = su17_gc.a[[4]], xF = su17_f,
mp4 xlab = "Days After Planting", ylab = "",
myTitle = "Sutherland, Canada 2017")
<- ggarrange(mp1, mp2, mp3, mp4, ncol = 2, nrow = 2, common.legend = T)
mp ggsave("Additional/Additional_Figure_03_1.png", mp,
width = 8, height = 6, dpi = 600, bg = "white")
# Clusters 1 + 7
= c(83, 94)
myEntries = myColors_Cluster[c(7,1)]
myColors #
<- ggGrowthCurve(xpm = it17_gc.v[[4]], xF = it17_f,
mp1 myEntries = myEntries, myColors = myColors,
myTitle = "Italy 2017 - Volume", linesize = 3)
<- ggGrowthCurve(xpm = it17_gc.h[[4]], xF = it17_f,
mp2 myEntries = myEntries, myColors = myColors,
myTitle = "Italy 2017 - Height", linesize = 3)
<- ggGrowthCurve(xpm = it17_gc.a[[4]], xF = it17_f,
mp3 myEntries = myEntries, myColors = myColors,
myTitle = "Italy 2017 - Area", linesize = 3)
#
<- ggGrowthCurve(xpm = su17_gc.v[[4]], xF = su17_f,
mp4 myEntries = myEntries, myColors = myColors,
myTitle = "Sutherland 2017 - Volume", linesize = 3)
<- ggGrowthCurve(xpm = su17_gc.h[[4]], xF = su17_f,
mp5 myEntries = myEntries, myColors = myColors,
myTitle = "Sutherland 2017 - Height", linesize = 3)
<- ggGrowthCurve(xpm = su17_gc.a[[4]], xF = su17_f,
mp6 myEntries = myEntries, myColors = myColors,
myTitle = "Sutherland 2017 - Area", linesize = 3)
<- ggarrange(mp1, mp4, mp2, mp5, mp3, mp6, ncol = 2, nrow = 3, common.legend = T)
mpA ggsave("Additional/Additional_Figure_03_2.png", mpA,
width = 10, height = 8, dpi = 600, bg = "white")
# Clusters 4 + 5
= c(107, 27)
myEntries = myColors_Cluster[c(4,5)]
myColors #
<- ggGrowthCurve(xpm = it17_gc.v[[4]], xF = it17_f,
mp1 myEntries = myEntries, myColors = myColors,
myTitle = "Italy 2017 - Volume", linesize = 3)
<- ggGrowthCurve(xpm = it17_gc.h[[4]], xF = it17_f,
mp2 myEntries = myEntries, myColors = myColors,
myTitle = "Italy 2017 - Height", linesize = 3)
<- ggGrowthCurve(xpm = it17_gc.a[[4]], xF = it17_f,
mp3 myEntries = myEntries, myColors = myColors,
myTitle = "Italy 2017 - Area", linesize = 3)
#
<- ggGrowthCurve(xpm = su17_gc.v[[4]], xF = su17_f,
mp4 myEntries = myEntries, myColors = myColors,
myTitle = "Sutherland 2017 - Volume", linesize = 3)
<- ggGrowthCurve(xpm = su17_gc.h[[4]], xF = su17_f,
mp5 myEntries = myEntries, myColors = myColors,
myTitle = "Sutherland 2017 - Height", linesize = 3)
<- ggGrowthCurve(xpm = su17_gc.a[[4]], xF = su17_f,
mp6 myEntries = myEntries, myColors = myColors,
myTitle = "Sutherland 2017 - Area", linesize = 3)
<- ggarrange(mp1, mp4, mp2, mp5, mp3, mp6, ncol = 2, nrow = 3, common.legend = T)
mpB ggsave("Additional/Additional_Figure_03_3.png", mpB,
width = 10, height = 8, dpi = 600, bg = "white")
# Clusters 6 + 8
= c(22, 311)
myEntries = myColors_Cluster[c(8,6)]
myColors #
<- ggGrowthCurve(xpm = it17_gc.v[[4]], xF = it17_f,
mp1 myEntries = myEntries, myColors = myColors,
myTitle = "Italy 2017 - Volume", linesize = 3)
<- ggGrowthCurve(xpm = it17_gc.h[[4]], xF = it17_f,
mp2 myEntries = myEntries, myColors = myColors,
myTitle = "Italy 2017 - Height", linesize = 3)
<- ggGrowthCurve(xpm = it17_gc.a[[4]], xF = it17_f,
mp3 myEntries = myEntries, myColors = myColors,
myTitle = "Italy 2017 - Area", linesize = 3)
#
<- ggGrowthCurve(xpm = su17_gc.v[[4]], xF = su17_f,
mp4 myEntries = myEntries, myColors = myColors,
myTitle = "Sutherland 2017 - Volume", linesize = 3)
<- ggGrowthCurve(xpm = su17_gc.h[[4]], xF = su17_f,
mp5 myEntries = myEntries, myColors = myColors,
myTitle = "Sutherland 2017 - Height", linesize = 3)
<- ggGrowthCurve(xpm = su17_gc.a[[4]], xF = su17_f,
mp6 myEntries = myEntries, myColors = myColors,
myTitle = "Sutherland 2017 - Area", linesize = 3)
<- ggarrange(mp1, mp4, mp2, mp5, mp3, mp6, ncol = 2, nrow = 3, common.legend = T)
mpC ggsave("Additional/Additional_Figure_03_4.png", mpC,
width = 10, height = 8, dpi = 600, bg = "white")
# Clusters 2 + 3
= c(33, 30)
myEntries = myColors_Cluster[c(2,3)]
myColors #
<- ggGrowthCurve(xpm = it17_gc.v[[4]], xF = it17_f,
mp1 myEntries = myEntries, myColors = myColors,
myTitle = "Italy 2017 - Volume", linesize = 3)
<- ggGrowthCurve(xpm = it17_gc.h[[4]], xF = it17_f,
mp2 myEntries = myEntries, myColors = myColors,
myTitle = "Italy 2017 - Height", linesize = 3)
<- ggGrowthCurve(xpm = it17_gc.a[[4]], xF = it17_f,
mp3 myEntries = myEntries, myColors = myColors,
myTitle = "Italy 2017 - Area", linesize = 3)
#
<- ggGrowthCurve(xpm = su17_gc.v[[4]], xF = su17_f,
mp4 myEntries = myEntries, myColors = myColors,
myTitle = "Sutherland 2017 - Volume", linesize = 3)
<- ggGrowthCurve(xpm = su17_gc.h[[4]], xF = su17_f,
mp5 myEntries = myEntries, myColors = myColors,
myTitle = "Sutherland 2017 - Height", linesize = 3)
<- ggGrowthCurve(xpm = su17_gc.a[[4]], xF = su17_f,
mp6 myEntries = myEntries, myColors = myColors,
myTitle = "Sutherland 2017 - Area", linesize = 3)
<- ggarrange(mp1, mp4, mp2, mp5, mp3, mp6, ncol = 2, nrow = 3, common.legend = T)
mpD ggsave("Additional/Additional_Figure_03_5.png", mpD,
width = 10, height = 8, dpi = 600, bg = "white")
pdf("Additional/Additional_Figure_03.pdf", width = 8, height = 8)
for (i in myPCA %>% arrange(Cluster) %>% pull(Entry) ) {
#
= myColors_Cluster[myPCA$Cluster[myPCA$Entry==i]]
myColors #
<- ggGrowthCurve(xpm = it17_gc.v[[4]], xF = it17_f,
mp1 myEntries = i, myTitle = "It17 - Plot Volume",
myColors = myColors, linesize = 3)
<- ggGrowthCurve(xpm = it17_gc.h[[4]], xF = it17_f,
mp2 myEntries = i, myTitle = "It17 - Canopy Height",
myColors = myColors, linesize = 3)
<- ggGrowthCurve(xpm = it17_gc.a[[4]], xF = it17_f,
mp3 myEntries = i, myTitle = "It17 - Plot Area",
myColors = myColors, linesize = 3)
#
<- ggGrowthCurve(xpm = su17_gc.v[[4]], xF = su17_f,
mp4 myEntries = i, myTitle = "Su17 - Plot Volume",
myColors = myColors, linesize = 3)
<- ggGrowthCurve(xpm = su17_gc.h[[4]], xF = su17_f,
mp5 myEntries = i, myTitle = "Su17 - Canopy Height",
myColors = myColors, linesize = 3)
<- ggGrowthCurve(xpm = su17_gc.a[[4]], xF = su17_f,
mp6 myEntries = i, myTitle = "Su17 - Plot Area",
myColors = myColors, linesize = 3)
#
<- ggGrowthCurve(xpm = ro17_gc.v[[4]], xF = ro17_f,
mp7 myEntries = i, myTitle = "Ro17 - Plot Volume",
myColors = myColors, linesize = 3)
<- ggGrowthCurve(xpm = ro17_gc.h[[4]], xF = ro17_f,
mp8 myEntries = i, myTitle = "Ro17 - Canopy Height",
myColors = myColors, linesize = 3)
<- ggGrowthCurve(xpm = ro17_gc.a[[4]], xF = ro17_f,
mp9 myEntries = i, myTitle = "Ro17 - Plot Area",
myColors = myColors, linesize = 3)
<- ggarrange(mp1, mp4, mp7, mp2, mp5, mp8, mp3, mp6, mp9,
mp ncol = 3, nrow = 3, common.legend = T)
print(mp)
}dev.off() #dev.set(dev.next())
Figure 4 - Canada vs Iran vs India
Additional/Figure_04_A.html Additional/Figure_04_B.html Additional/Figure_04_C.html
# Prep data
<- c("darkgreen","darkorange", "darkred", "black")
myColors_Origins <- c("India", "Iran", "Canada", "Other")
myOrigins <- c("Italy 2017", "Rosthern 2017", "Sutherland 2017", "Sutherland 2018")
myExpts3 #
<- rbind(it17_gc.h[[2]], ro17_gc.h[[2]], su17_gc.h[[2]]) %>%
xH select(Plot, Entry, Name, Expt, Height=k)
<- rbind(it17_gc.a[[2]], ro17_gc.a[[2]], su17_gc.a[[2]]) %>%
xA select(Plot, Entry, Name, Expt, Area=k)
<- rbind(it17_gc.v[[2]], ro17_gc.v[[2]], su17_gc.v[[2]]) %>%
xV select(Plot, Entry, Name, Expt, Volume=k)
<- rbind(it17_f %>% filter(Trait == "Seed.Mass"),
xS %>% filter(Trait == "Seed.Mass"),
ro17_f %>% filter(Trait == "Seed.Mass"),
su17_f %>% filter(Trait == "Seed.Mass")) %>%
su18_f select(Plot, Entry, Name, Expt, Seed.Mass=Value)
<- rbind(it17_f %>% filter(Trait == "DTF"),
xD %>% filter(Trait == "DTF"),
ro17_f %>% filter(Trait == "DTF"),
su17_f %>% filter(Trait == "DTF")) %>%
su18_f select(Plot, Entry, Name, Expt, DTF=Value)
<- read.csv("myPCA.csv") %>%
xP mutate(Cluster = factor(Cluster)) %>%
select(Entry, Name, Cluster, Origin)
#
<- left_join(xH, xA, by = c("Plot","Entry","Name","Expt")) %>%
xx left_join(xV, by = c("Plot","Entry","Name","Expt")) %>%
left_join(xS, by = c("Plot","Entry","Name","Expt")) %>%
left_join(xD, by = c("Plot","Entry","Name","Expt")) %>%
group_by(Entry, Name, Expt) %>%
summarise(Height = mean(Height, na.rm = T),
Area = mean(Area, na.rm = T),
Volume = mean(Volume, na.rm = T),
Seed.Mass = mean(Seed.Mass, na.rm = T),
DTF = mean(DTF, na.rm = T)) %>%
ungroup() %>%
left_join(xP, by = c("Entry", "Name")) %>%
mutate(Group = ifelse(Origin %in% myOrigins[1:3], Origin, myOrigins[4]),
Expt = plyr::mapvalues(Expt, myExpts3, myExpts1)) %>%
arrange(desc(Group))
# Plot
<- ggplot(xx, aes(x = Area, y = Height, color = Group, alpha = Group)) +
mp1 geom_point(aes(key1 = Origin, key2 = Entry, key3 = Name), pch = 16) +
facet_grid(. ~ Expt) +
scale_color_manual(name = "Accession Origin", values = myColors_Origins) +
scale_alpha_manual(name = "Accession Origin", values = c(0.8,0.8,0.8,0.2)) +
+
theme_AGL labs(title = "A) Height x Area", y = "Plot Height", x = "Plot Area")
#
<- ggplot(xx, aes(x = Volume, y = Seed.Mass, color = Group, alpha = Group)) +
mp2 geom_point(aes(key1 = Origin, key2 = Entry, key3 = Name), pch = 16) +
facet_grid(. ~ Expt) +
scale_color_manual(name = "Accession Origin", values = myColors_Origins) +
scale_alpha_manual(name = "Accession Origin", values = c(0.8,0.8,0.8,0.2)) +
+
theme_AGL labs(title = "B) Yield x Volume", x = "Plot Volume", y = "Plot Yield")
#
<- ggplot(xx, aes(x = DTF, y = Volume, key1 = Origin, color = Group, alpha = Group)) +
mp3 geom_point(aes(key1 = Origin, key2 = Entry, key3 = Name), pch = 16) +
facet_grid(. ~ Expt, scales = "free") +
scale_color_manual(name = "Accession Origin", values = myColors_Origins) +
scale_alpha_manual(name = "Accession Origin", values = c(0.8,0.8,0.8,0.2)) +
+
theme_AGL labs(title = "C) Volume x DTF", x = "Days From Sowing To Flower (DTF)", y = "Plot Volume")
#
<- ggarrange(mp1, mp2, mp3, nrow = 3, ncol = 1, common.legend = T, legend = "bottom")
mp ggsave("Figure_04.png", mp, width = 6, height = 7, dpi = 600, bg = "white")
#
ggsave("Additional/Figure_04_A.png", mp1, width = 8, height = 2.5, dpi = 600)
ggsave("Additional/Figure_04_B.png", mp2, width = 8, height = 2.5, dpi = 600)
ggsave("Additional/Figure_04_C.png", mp3, width = 8, height = 2.5, dpi = 600)
#
saveWidget(ggplotly(mp1), file="Additional/Figure_04_A.html")
saveWidget(ggplotly(mp2), file="Additional/Figure_04_B.html")
saveWidget(ggplotly(mp3), file="Additional/Figure_04_C.html")
PCA
# Function for adding phenology related traits with growth data
<- function(xd, xf) {
phenolGrowth <- xf %>% filter(Trait == "DTF") %>% select(Plot, DTF=Value)
xf1 <- xf %>% filter(Trait == "DTM") %>% select(Plot, DTM=Value)
xf2 %>%
xd left_join(xf1, by = "Plot") %>%
left_join(xf2, by = "Plot") %>%
mutate(xmid.DTF = x.mid - DTF,
xmax.DTF = x.max - DTF,
perc.DTF = 100 * (k / (1 + ((k - y0) / y0) * exp(-r * DTF))) / k,
at.DTF = k / (1 + ((k - y0) / y0) * exp(-r * DTF)),
at.DTM = k / (1 + ((k - y0) / y0) * exp(-r * DTM)),
xmid.DTM = x.mid - DTM,
xmax.DTM = x.max - DTM) %>%
select(Plot, xmid.DTF, xmax.DTF, perc.DTF,
xmid.DTM, xmax.DTM, at.DTF, at.DTM)
}# Function for performing PCA
<- function(xx, clustNum = 8) {
pca_gc <- PCA(xx, ncp = 10, graph = F)
mypca <- HCPC(mypca, nb.clust = clustNum, graph = F)
mypcaH <- round(mypca[[1]][,2], 1)
perc <- mypcaH[[1]] %>% rownames_to_column("Name")
x1 <- mypca[[3]]$coord %>% as.data.frame() %>% rownames_to_column("Name")
x2 <- left_join(x1, x2, by = "Name") %>%
pca select(Name, Cluster=clust,
PC1=Dim.1, PC2=Dim.2, PC3=Dim.3, PC4=Dim.4, PC5=Dim.5, PC6=Dim.6)
pca }
# Prep data
<- 8
myClustnum # Italy 2017 data
<- it17_gc.v[[2]] %>%
x1 select(Plot, Entry, Name, k, x.mid, x.d, g.r) %>%
left_join(phenolGrowth(xd = it17_gc.v[[2]], xf = it17_f), by = "Plot") %>%
select(-xmid.DTF, -xmid.DTM, -xmax.DTM, -at.DTM)
colnames(x1)[4:ncol(x1)] <- paste0("It17_v.", colnames(x1)[4:ncol(x1)])
<- it17_gc.a[[2]] %>%
x2 select(Plot, Entry, Name, k, x.mid, x.d, g.r) %>%
left_join(phenolGrowth(xd = it17_gc.a[[2]], xf = it17_f), by = "Plot") %>%
select(-xmid.DTF, -xmid.DTM, -xmax.DTM, -at.DTM)
colnames(x2)[4:ncol(x2)] <- paste0("It17_a.", colnames(x2)[4:ncol(x2)])
<- it17_gc.h[[2]] %>%
x3 select(Plot, Entry, Name, k, x.mid, x.d, g.r) %>%
left_join(phenolGrowth(xd = it17_gc.h[[2]], xf = it17_f), by = "Plot") %>%
select(-xmid.DTF, -xmid.DTM, -xmax.DTM, -at.DTM)
colnames(x3)[4:ncol(x3)] <- paste0("It17_h.", colnames(x3)[4:ncol(x3)])
<- left_join(x2, x3, by = c("Plot","Entry","Name")) %>%
myX1 left_join(x1, by = c("Plot","Entry","Name")) %>%
select(-Plot) %>%
gather(Trait, Value, 3:ncol(.)) %>%
group_by(Entry, Name, Trait) %>%
summarise(Value = mean(Value, na.rm = T)) %>%
ungroup() %>%
spread(Trait, Value) %>% select(-Entry)
# Sutherland 2017 data
<- su17_gc.v[[2]] %>%
x1 select(Plot, Entry, Name, k, x.mid, x.d, g.r) %>%
left_join(phenolGrowth(xd = su17_gc.v[[2]], xf = su17_f), by = "Plot") %>%
select(-xmid.DTF, -xmid.DTM, -xmax.DTM, -at.DTM)
colnames(x1)[4:ncol(x1)] <- paste0("Su17_v.", colnames(x1)[4:ncol(x1)])
<- su17_gc.a[[2]] %>%
x2 select(Plot, Entry, Name, k, x.mid, x.d, g.r) %>%
left_join(phenolGrowth(xd = su17_gc.a[[2]], xf = su17_f), by = "Plot") %>%
select(-xmid.DTF, -xmid.DTM, -xmax.DTM, -at.DTM)
colnames(x2)[4:ncol(x2)] <- paste0("Su17_a.", colnames(x2)[4:ncol(x2)])
<- su17_gc.h[[2]] %>%
x3 select(Plot, Entry, Name, k, x.mid, x.d, g.r) %>%
left_join(phenolGrowth(xd = su17_gc.h[[2]], xf = su17_f), by = "Plot") %>%
select(-xmid.DTF, -xmid.DTM, -xmax.DTM, -at.DTM)
colnames(x3)[4:ncol(x3)] <- paste0("Su17_h.", colnames(x3)[4:ncol(x3)])
<- left_join(x2, x3, by = c("Plot","Entry","Name")) %>%
myX2 left_join(x1, by = c("Plot","Entry","Name")) %>%
select(-Plot) %>%
gather(Trait, Value, 3:ncol(.)) %>%
group_by(Entry, Name, Trait) %>%
summarise(Value = mean(Value, na.rm = T)) %>%
ungroup() %>%
spread(Trait, Value) %>% select(-Entry)
#
<- left_join(myX1, myX2, by = "Name") %>%
myPCAinput column_to_rownames("Name")
sum(is.na(myPCAinput))
#
<- PCA(myPCAinput, ncp = 10, graph = F)
mypca <- HCPC(mypca, nb.clust = myClustnum, graph = F)
mypcaH <- round(mypca[[1]][,2], 1)
perc <- mypcaH[[1]] %>% rownames_to_column("Name")
x1 <- mypca[[3]]$coord %>% as.data.frame() %>% rownames_to_column("Name")
x2 <- left_join(x1, x2, by = "Name") %>%
myPCA select(Name, Cluster=clust,
PC1=Dim.1, PC2=Dim.2, PC3=Dim.3, PC4=Dim.4, PC5=Dim.5, PC6=Dim.6,
PC7=Dim.7, PC8=Dim.8, PC9=Dim.9) %>%
left_join(myLDP, by = "Name") %>%
select(Entry, Name, Origin, Region, everything())
write.csv(myPCA, "myPCA.csv", row.names = F)
write.csv(myPCAinput, "myPCAinput.csv", row.names = F)
Additional Figures - Cluster Tests
# Create function
<- function(cnum) {
ggHC_test #
<- HCPC(mypca, nb.clust = cnum, graph = F)
mypcaH <- mypcaH[[1]] %>% rownames_to_column("Name") %>% select(Name, Cluster=clust)
x1 #
<- c("It17_v.k", "It17_h.k", "It17_a.k",
myTraits "It17_h.x.mid", "It17_a.x.mid",
"It17_v.perc.DTF",
#
"Su17_v.k", "Su17_h.k", "Su17_a.k",
"Su17_h.x.mid", "Su17_a.x.mid",
"Su17_v.perc.DTF")
<- c("A) It17 Max V", "B) It17 Max H", "C) It17 Max A",
myTraits_new "D) It17 H x.mid", "E) It17 A x.mid",
"F) It17 % V at DTF",
#
"G) Su17 Max V", "H) Su17 Max H", "I) Su17 Max A",
"J) Su17 H x.mid", "K) Su17 A x.mid",
"L) Su17 % V at DTF")
#
<- myPCAinput %>% rownames_to_column("Name") %>%
xx left_join(x1, by = "Name") %>%
select(Name, Cluster, everything()) %>%
gather(Trait, Value, 3:ncol(.)) %>%
filter(Trait %in% myTraits) %>%
mutate(Trait = plyr::mapvalues(Trait, myTraits, myTraits_new),
Trait = factor(Trait, levels = myTraits_new))
# Plot
<- ggplot(xx, aes(x = Cluster, y = Value, color = Cluster)) +
mp geom_quasirandom(alpha = 0.7) +
facet_wrap(Trait ~ ., scales = "free_y", ncol = 6) +
scale_color_manual(values = c(myColors_Cluster, "violetred3", "tan3") ) +
+
theme_AGL theme(legend.position = "bottom") +
guides(color = guide_legend(nrow = 1)) +
labs(x = NULL, y = NULL)
mp
}ggsave("Additional/PCA_test/Cluster02.png", ggHC_test(2), width = 10, height = 4, dpi = 600)
ggsave("Additional/PCA_test/Cluster03.png", ggHC_test(3), width = 10, height = 4, dpi = 600)
ggsave("Additional/PCA_test/Cluster04.png", ggHC_test(4), width = 10, height = 4, dpi = 600)
ggsave("Additional/PCA_test/Cluster05.png", ggHC_test(5), width = 10, height = 4, dpi = 600)
ggsave("Additional/PCA_test/Cluster06.png", ggHC_test(6), width = 10, height = 4, dpi = 600)
ggsave("Additional/PCA_test/Cluster07.png", ggHC_test(7), width = 10, height = 4, dpi = 600)
ggsave("Additional/PCA_test/Cluster08.png", ggHC_test(8), width = 10, height = 4, dpi = 600)
ggsave("Additional/PCA_test/Cluster09.png", ggHC_test(9), width = 10, height = 4, dpi = 600)
ggsave("Additional/PCA_test/Cluster10.png", ggHC_test(10), width = 10, height = 4, dpi = 600)
Supplemental Figure 3 - PCA
# Prep data
<- round(mypca[[1]][,2], 1)
perc # Plot (a) PCA 1v2
<- function(df) df[chull(df[,"PC1"], df[,"PC2"]), ]
find_hull <- plyr::ddply(myPCA, "Cluster", find_hull) %>% mutate(Cluster = factor(Cluster))
polys .1 <- ggplot(myPCA) +
mp1geom_polygon(data = polys, alpha = 0.15, aes(x = PC1, y = PC2, fill = Cluster)) +
geom_point(aes(x = PC1, y = PC2, colour = Cluster), size = 0.2) +
scale_fill_manual(values = myColors_Cluster) +
scale_color_manual(values = myColors_Cluster) +
+
theme_AGL theme(legend.position = "none", panel.grid = element_blank()) +
labs(title = "A)",
x = paste0("PC1 (", perc[1], "%)"),
y = paste0("PC2 (", perc[2], "%)"))
# Plot (a) PCA 1v3
<- function(df) df[chull(df[,"PC1"], df[,"PC3"]), ]
find_hull <- plyr::ddply(myPCA, "Cluster", find_hull) %>% mutate(Cluster = factor(Cluster))
polys .2 <- ggplot(myPCA) +
mp1geom_polygon(data = polys, alpha = 0.15, aes(x = PC1, y = PC3, fill = Cluster)) +
geom_point(aes(x = PC1, y = PC3, colour = Cluster), size = 0.2) +
scale_fill_manual(values = myColors_Cluster) +
scale_color_manual(values = myColors_Cluster) +
+
theme_AGL theme(legend.position = "none", panel.grid = element_blank()) +
labs(title = "",
x = paste0("PC1 (", perc[1], "%)"),
y = paste0("PC3 (", perc[3], "%)"))
# Plot (a) PCA 2v3
<- function(df) df[chull(df[,"PC2"], df[,"PC3"]), ]
find_hull <- plyr::ddply(myPCA, "Cluster", find_hull) %>% mutate(Cluster = factor(Cluster))
polys .3 <- ggplot(myPCA) +
mp1geom_polygon(data = polys, alpha = 0.15, aes(x = PC2, y = PC3, fill = Cluster)) +
geom_point(aes(x = PC2, y = PC3, colour = Cluster), size = 0.2) +
scale_fill_manual(values = myColors_Cluster) +
scale_color_manual(values = myColors_Cluster) +
+
theme_AGL theme(legend.position = "none", panel.grid = element_blank()) +
labs(title = "",
x = paste0("PC2 (", perc[2], "%)"),
y = paste0("PC3 (", perc[3], "%)"))
# Append
<- ggarrange(mp1.1, mp1.2, mp1.3, nrow = 1, ncol = 3, hjust = 0)
mp1 #
<- data.frame(x = 1:12, y = perc[1:12])
xx # Plot
<- ggplot(xx, aes(x = x, y = y)) +
mp2 geom_line(size = 1, alpha = 0.7) +
geom_point(size = 2, color = "grey50") +
scale_x_continuous(breaks = 1:12, labels = paste0("PC",1:12)) +
+
theme_AGL labs(title = "B)", y = "Percent of Variation", x = NULL)
<- ggarrange(mp1, mp2, ncol = 1, nrow = 2, heights = c(0.75,1))
mp ggsave("Supplemental_Figure_03.png", mp, width = 6, height = 4.5, dpi = 600)
Figure 5 - PCA Summary
# Prep data
<- c("It17_v.k", "It17_h.k", "It17_a.k",
myTraits "It17_h.x.mid", "It17_a.x.mid",
"It17_v.perc.DTF", "It17_v.at.DTF",
#
"Su17_v.k", "Su17_h.k", "Su17_a.k",
"Su17_h.x.mid", "Su17_a.x.mid",
"Su17_v.perc.DTF", "Su17_v.at.DTF" )
<- c("A) It17 Max V", "B) It17 Max H", "C) It17 Max A",
myTraits_new "D) It17 H x.mid", "E) It17 A x.mid",
"F) It17 % V at DTF", "G) It17 V at DTF",
#
"H) Su17 Max V", "I) Su17 Max H", "J) Su17 Max A",
"K) Su17 H x.mid", "L) Su17 A x.mid",
"M) Su17 % V at DTF", "N) Su17 V at DTF")
<- myPCAinput %>% rownames_to_column("Name") %>%
xx left_join(select(myPCA, Entry, Name, Origin, Cluster), by = "Name") %>%
select(Entry, Name, Origin, Cluster, everything()) %>%
gather(Trait, Value, 5:ncol(.)) %>%
filter(Trait %in% myTraits) %>%
mutate(Trait = plyr::mapvalues(Trait, myTraits, myTraits_new),
Trait = factor(Trait, levels = myTraits_new))
# Plot
<- ggplot(xx, aes(x = Cluster, y = Value, color = Cluster)) +
mp geom_quasirandom(alpha = 0.7, pch = 16) +
facet_wrap(Trait ~ ., scales = "free_y", ncol = 7) +
scale_color_manual(values = myColors_Cluster) +
+
theme_AGL theme(legend.position = "bottom",
legend.margin = margin(c(0,0,0,0)),
axis.text.x = element_blank(),
axis.ticks.x = element_blank()) +
guides(color = guide_legend(nrow = 1)) +
labs(x = NULL, y = NULL)
ggsave("Figure_05.png", mp, width = 12, height = 4, dpi = 600)
Supplemental Figure 4 - PCA Inputs
#
<- c("It17_v.k", "It17_h.k", "It17_a.k", "It17_v.x.mid", "It17_h.x.mid", "It17_a.x.mid",
myTraits1 "Su17_v.k", "Su17_h.k", "Su17_a.k", "Su17_v.x.mid", "Su17_h.x.mid", "Su17_a.x.mid",
#
"It17_v.perc.DTF", "It17_h.perc.DTF", "It17_a.perc.DTF",
"It17_v.at.DTF", "It17_h.at.DTF", "It17_a.at.DTF",
#
"Su17_v.perc.DTF", "Su17_h.perc.DTF", "Su17_a.perc.DTF",
"Su17_v.at.DTF", "Su17_h.at.DTF", "Su17_a.at.DTF",
"It17_v.xmax.DTF", "It17_h.xmax.DTF", "It17_a.xmax.DTF",
"Su17_v.xmax.DTF", "Su17_h.xmax.DTF", "Su17_a.xmax.DTF",
#
"It17_v.x.d", "It17_h.x.d", "It17_a.x.d", "It17_v.g.r", "It17_h.g.r", "It17_a.g.r",
"Su17_v.x.d", "Su17_h.x.d", "Su17_a.x.d", "Su17_v.g.r", "Su17_h.g.r", "Su17_a.g.r" )
#
<- myPCAinput %>% rownames_to_column("Name") %>%
xx left_join(select(myPCA, Entry, Name, Origin, Cluster), by = "Name") %>%
select(Entry, Name, Origin, Cluster, everything()) %>%
gather(Trait, Value, 5:ncol(.)) %>%
mutate(Trait = factor(Trait, levels = myTraits1))
# Plot
<- ggplot(xx, aes(x = Cluster, y = Value, color = Cluster)) +
mp geom_quasirandom(alpha = 0.7, pch = 16) +
facet_wrap(Trait ~ ., scales = "free_y", ncol = 6) +
scale_color_manual(values = myColors_Cluster) +
+
theme_AGL theme(axis.text.x = element_blank(),
axis.ticks.x = element_blank()) +
labs(x = NULL, y = NULL)
ggsave("Supplemental_Figure_04.png", mp, width = 15, height = 14, dpi = 600)
Additional Figure 4 - PCA Map
# Prep data
library(rworldmap)
<- read.csv("https://raw.githubusercontent.com/derekmichaelwright/AGILE_LDP_Phenology/master/data/data_countries.csv") %>%
yy select(Origin=Country, Lat, Lon)
<- myPCA %>%
xx left_join(yy, by = "Origin") %>%
filter(!Origin %in% c("ICARDA","USDA","Unknown")) %>%
group_by(Origin, Cluster, Lat, Lon) %>%
summarise(Count = n()) %>%
spread(Cluster, Count) %>%
as.data.frame()
# Plot
png("Additional/Additional_Figure_04.png", width = 3600, height = 2055, res = 600)
par(mai = c(0,0,0,0), xaxs = "i", yaxs = "i")
mapPies(dF = xx, nameX = "Lon", nameY = "Lat",
zColours = myColors_Cluster, nameZs = as.character(1:8), lwd = 1,
xlim = c(-140,110), ylim = c(5,20), addCatLegend = F,
oceanCol = "grey90", landCol = "white", borderCol = "black")
legend(-138.5, 15.5, title = "PCA Cluster", legend = as.character(1:8),
col = myColors_Cluster, pch = 16, cex = 0.8, pt.cex = 1.25, box.lwd = 2)
dev.off()
Additional Figure 5 - AH x Clusters
# Prep data
<- read.csv("myPCA.csv") %>% mutate(Cluster = factor(Cluster))
myPCA <- left_join(
x1 2]] %>% select(Plot, Entry, Expt, Height=k),
it17_gc.h[[2]] %>% select(Plot, Entry, Expt, Area=k),
it17_gc.a[[by = c("Plot", "Entry", "Expt"))
<- left_join(
x2 2]] %>% select(Plot, Entry, Expt, Height=k),
su17_gc.h[[2]] %>% select(Plot, Entry, Expt, Area=k),
su17_gc.a[[by = c("Plot", "Entry", "Expt"))
<- bind_rows(x1, x2) %>%
xx group_by(Expt, Entry) %>%
summarise(Area = mean(Area, na.rm = T),
Height = mean(Height, na.rm = T)) %>%
left_join(select(myPCA, Entry, Cluster), by = "Entry")
# Plot
<- ggplot(xx, aes(x = Area, y = Height, color = Cluster, alpha = Cluster)) +
mp geom_point(pch = 16) +
facet_grid(. ~ Expt) +
scale_color_manual(values = myColors_Cluster) +
guides(colour = guide_legend(nrow = 1)) +
+
theme_AGL labs(y = "Plot Height", x = "Plot Area")
<- mp + scale_alpha_manual(values = c(0.9,0.1,0.1,0.1,0.1,0.1,0.1,0.9), guide = F)
mp1 <- mp + scale_alpha_manual(values = c(0.1,0.9,0.1,0.1,0.1,0.1,0.9,0.1), guide = F)
mp2 <- mp + scale_alpha_manual(values = c(0.1,0.1,0.1,0.9,0.1,0.9,0.1,0.1), guide = F)
mp3 <- mp + scale_alpha_manual(values = c(0.1,0.1,0.9,0.1,0.9,0.1,0.1,0.1), guide = F)
mp4 <- ggarrange(mp1, mp2, mp3, mp4, ncol = 2, nrow = 2,
mp common.legend = T, legend = "bottom")
ggsave("Additional/Additional_Figure_05.png", mp,
width = 8, height = 6, dpi = 600, bg = "white")
Additional Figure 6 - DTF x Volume
# Prep data
<- rbind(it17_f %>% filter(Trait %in% c("DTF", "Seed.Mass")),
x1 %>% filter(Trait %in% c("DTF", "Seed.Mass")),
ro17_f %>% filter(Trait %in% c("DTF", "Seed.Mass"))) %>%
su17_f spread(Trait, Value) %>%
group_by(Expt) %>%
mutate(Seed.Mass_scaled = scales::rescale(Seed.Mass))
<- rbind(it17_gc.v[[2]],
x2 2]],
ro17_gc.v[[2]]) %>%
su17_gc.v[[select(Plot, Volume=k)
<- read.csv("myPCA.csv") %>%
x3 select(Name, Cluster)
<- left_join(x1, x2, by = "Plot") %>%
xx left_join(x3, by = "Name") %>%
mutate(Cluster = factor(Cluster))
# Plot
<- ggplot(xx, aes(x = DTF, y = Volume, color = Cluster)) +
mp1 geom_point(alpha = 0.7) +
facet_wrap(Expt ~ ., scales = "free") +
scale_color_manual(values = myColors_Cluster) +
theme_AGL<- ggplot(xx, aes(x = DTF, y = Seed.Mass, color = Cluster)) +
mp2 geom_point(alpha = 0.7) +
facet_wrap(Expt ~ ., scales = "free") +
scale_color_manual(values = myColors_Cluster) +
scale_size_continuous(range = c(0.25,3)) +
theme_AGL<- ggarrange(mp1, mp2, ncol = 1, nrow = 2)
mp ggsave("Additional/Additional_Figure_06.png", mp, width = 9, height = 6)
Additional Figures 7 - VHA x Seed Mass
# Volume
.1 <- rbind(it17_gc.v[[2]], ro17_gc.v[[2]], su17_gc.v[[2]]) %>%
x1select(Plot, Name, Expt, Value=k)
<- rbind(it17_f %>% filter(Trait == "Seed.Mass"),
x2 %>% filter(Trait == "Seed.Mass"),
ro17_f %>% filter(Trait == "Seed.Mass") ) %>%
su17_f select(Plot, Name, Expt, Seed.Mass=Value)
<- read.csv("myPCA.csv") %>%
x3 mutate(Cluster = factor(Cluster)) %>%
select(Name, Entry, Cluster)
<- x1.1 %>%
xx1 left_join(x2, by = c("Plot","Name","Expt")) %>%
left_join(x3, by = "Name") %>%
group_by(Entry, Name, Expt, Cluster) %>%
summarise(Seed.Mass = mean(Seed.Mass, na.rm = T),
Value = mean(Value, na.rm = T)) %>%
mutate(Adapted = ifelse(Expt == "Italy 2017" & Seed.Mass > 150, "Adapted", "Unadapted"),
Adapted = ifelse(Expt == "Sutherland 2017" & Seed.Mass > 300, "Adapted", Adapted),
Adapted = ifelse(Expt == "Rosthern 2017" & Seed.Mass > 300, "Adapted", Adapted),
Trait = "Volume")
# Plot
<- ggplot(xx1, aes(x = Value, y = Seed.Mass,
mp1 color = Cluster, alpha = Adapted)) +
geom_point(pch = 16) +
facet_wrap(Expt ~ ., scales = "free") +
scale_color_manual(values = myColors_Cluster) +
scale_alpha_manual(values = c(0.7, 0.1)) +
+
theme_AGL labs(y = "Plot Yield (g)", x = "Volume")
ggsave("Additional/Additional_Figure_07_1.png", mp1, width = 10, height = 3.5, dpi = 600)
# Height
.2 <- rbind(it17_gc.h[[2]], ro17_gc.h[[2]], su17_gc.h[[2]]) %>%
x1select(Plot, Name, Expt, Value=k)
<- x1.2 %>%
xx2 left_join(x2, by = c("Plot","Name","Expt")) %>%
left_join(x3, by = "Name") %>%
group_by(Entry, Name, Expt, Cluster) %>%
summarise(Seed.Mass = mean(Seed.Mass, na.rm = T),
Value = mean(Value, na.rm = T)) %>%
mutate(Adapted = ifelse(Expt == "Italy 2017" & Seed.Mass > 150, "Adapted", "Unadapted"),
Adapted = ifelse(Expt == "Sutherland 2017" & Seed.Mass > 300, "Adapted", Adapted),
Adapted = ifelse(Expt == "Rosthern 2017" & Seed.Mass > 300, "Adapted", Adapted),
Trait = "Height")
# Plot
<- ggplot(xx2, aes(x = Value, y = Seed.Mass,
mp2 color = Cluster, alpha = Adapted)) +
geom_point(pch = 16) +
facet_wrap(Expt ~ ., scales = "free") +
scale_color_manual(values = myColors_Cluster) +
scale_alpha_manual(values = c(0.7, 0.1)) +
+
theme_AGL labs(y = "Plot Yield (g)", x = "Height")
ggsave("Additional/Additional_Figure_07_2.png", mp2, width = 10, height = 3.5, dpi = 600)
# Area
.3 <- rbind(it17_gc.a[[2]], ro17_gc.a[[2]], su17_gc.a[[2]]) %>%
x1select(Plot, Name, Expt, Value=k)
<- x1.3 %>%
xx3 left_join(x2, by = c("Plot","Name","Expt")) %>%
left_join(x3, by = "Name") %>%
group_by(Entry, Name, Expt, Cluster) %>%
summarise(Seed.Mass = mean(Seed.Mass, na.rm = T),
Value = mean(Value, na.rm = T)) %>%
mutate(Adapted = ifelse(Expt == "Italy 2017" & Seed.Mass > 150, "Adapted", "Unadapted"),
Adapted = ifelse(Expt == "Sutherland 2017" & Seed.Mass > 300, "Adapted", Adapted),
Adapted = ifelse(Expt == "Rosthern 2017" & Seed.Mass > 300, "Adapted", Adapted),
Trait = "Area")
# Plot
<- ggplot(xx3, aes(x = Value, y = Seed.Mass,
mp3 color = Cluster, alpha = Adapted)) +
geom_point(pch = 16) +
facet_wrap(Expt ~ ., scales = "free") +
scale_color_manual(values = myColors_Cluster) +
scale_alpha_manual(values = c(0.7, 0.1)) +
+
theme_AGL labs(y = "Plot Yield (g)", x = "Area")
ggsave("Additional/Additional_Figure_07_3.png", mp3, width = 10, height = 3.5, dpi = 600)
# Prep data
<- bind_rows(xx1, xx2, xx3)
xx # Plot
<- ggplot(xx, aes(y = Value, x = Seed.Mass,
mp color = Cluster, alpha = Adapted)) +
geom_point(pch = 16) +
facet_grid(Trait ~ Expt, scales = "free") +
scale_color_manual(values = myColors_Cluster) +
scale_alpha_manual(values = c(0.7, 0.1)) +
+
theme_AGL labs(x = "Plot Yield (g)", y = NULL)
ggsave("Additional/Additional_Figure_07.png", mp, width = 8, height = 6, dpi = 600)
Additional Figure 8 - VH/A x Cluster
# Prep data
<- myPCAinput %>% rownames_to_column("Name") %>% as.data.frame() %>%
xx select(Name, It17_h.k, It17_a.k, It17_v.k, Su17_h.k, Su17_a.k, Su17_v.k)
<- xx %>%
x1 mutate(It17 = It17_h.k / It17_a.k,
Su17 = Su17_h.k / Su17_a.k) %>%
select(Name, It17, Su17) %>%
gather(Expt, HA_Ratio, It17, Su17)
<- xx %>% select(Name, It17=It17_v.k, Su17=Su17_v.k) %>%
x2 mutate(It17 = scales::rescale(It17),
Su17 = scales::rescale(Su17)) %>%
gather(Expt, Volume, It17, Su17)
<- left_join(x1, x2, by = c("Name", "Expt")) %>%
xx left_join(select(myPCA, Name, Cluster), by = "Name")
# Plot
<- ggplot(xx, aes(x = Cluster, y = HA_Ratio, size = Volume, fill = Cluster)) +
mp1 geom_quasirandom(pch = 21, alpha = 0.7) +
facet_wrap(Expt ~ .) +
scale_fill_manual(values = myColors_Cluster, guide = F) +
scale_size_continuous(name = "Scaled Volume", range = c(0.25, 3.5)) +
+
theme_AGL theme(legend.position = "top") +
labs(y = "Height / Area")
# Prep data
<- myPCAinput %>% rownames_to_column("Name") %>%
xx as.data.frame() %>%
select(Name, It17_h.k, It17_a.k, It17_v.k, Su17_h.k, Su17_a.k, Su17_v.k) %>%
mutate(It17 = It17_v.k * It17_h.k / It17_a.k,
Su17 = Su17_v.k * Su17_h.k / Su17_a.k) %>%
left_join(select(myPCA, Name, Cluster), by = "Name") %>%
select(Name, Cluster, It17, Su17) %>%
gather(Expt, Value, It17, Su17) %>%
left_join(x2, by = c("Name", "Expt"))
# Plot
<- ggplot(xx, aes(x = Cluster, y = Value, size = Volume, fill = Cluster)) +
mp2 geom_quasirandom(pch = 21, alpha = 0.7) +
facet_wrap(Expt ~ .) +
scale_fill_manual(values = myColors_Cluster) +
scale_size_continuous(name = "Scaled Volume", range = c(0.25, 3.5)) +
+
theme_AGL theme(legend.position = "none") +
labs(y = "Volume * Height / Area")
#
<- ggarrange(mp1, mp2, nrow = 2, heights = c(1,0.85))
mp ggsave("Additional/Additional_Figure_08.png", mp, width = 8, height = 7, dpi = 600)
Additional Figures 9 - Harvest Index
# Prep data
<- bind_rows(it17_f %>% filter(Trait == "Seed.Mass") %>%
x1 select(Plot, Expt, Entry, Name, Seed.Mass=Value),
%>% filter(Trait == "Seed.Mass") %>%
su17_f select(Plot, Expt, Entry, Name, Seed.Mass=Value) )
<- bind_rows(it17_gc.v[[2]] %>% select(Plot, Expt, Entry, Name, Volume=k),
x2 2]] %>% select(Plot, Expt, Entry, Name, Volume=k) )
su17_gc.v[[<- full_join(x1, x2, by = c("Plot", "Expt", "Entry", "Name")) %>%
xx left_join(select(myPCA, Entry, Cluster), by = "Entry") %>%
mutate(`Harvest Index` = Seed.Mass / Volume) %>%
group_by(Expt, Entry, Name, Cluster) %>%
summarise(`Harvest Index` = mean(`Harvest Index`, na.rm = T),
`Seed Mass` = mean(Seed.Mass, na.rm = T)) %>%
mutate(Expt = plyr::mapvalues(Expt, c("Italy 2017","Sutherland 2017"), c("It17", "Su17")))
# Plot
<- ggplot(xx, aes(x = Cluster, y = `Harvest Index`, fill = Cluster, size = `Seed Mass`)) +
mp1 geom_quasirandom(pch = 21, alpha = 0.7, color = "black") +
facet_grid(. ~ Expt) +
scale_fill_manual(values = myColors_Cluster, guide = F) +
scale_size_continuous(range = c(0.2,4)) +
theme_AGL#
<- ggplot(xx, aes(x = Expt, y = `Harvest Index`, fill = Cluster, group = Entry)) +
mp2 geom_line(alpha = 0.1) +
geom_point(aes(size = `Seed Mass`), pch = 21, alpha = 0.7, color = "black") +
facet_grid(. ~ Cluster) +
scale_fill_manual(values = myColors_Cluster, guide = F) +
scale_size_continuous(range = c(0.2,4)) +
+
theme_AGL theme(axis.text.x = element_text(angle = 45, hjust = 1))
#
<- xx %>% select(-`Seed Mass`) %>%
xx spread(Expt, `Harvest Index`) %>%
mutate(Diff = `Su17` - `It17`)
<- ggplot(xx, aes(x = Cluster, y = Diff, fill = Cluster)) +
mp3 geom_quasirandom(pch = 21, alpha = 0.7, color = "black", size = 2.5) +
scale_fill_manual(values = myColors_Cluster, guide = F) +
+
theme_AGL labs(y = "Difference (Su17 - It17)")
#
<- ggarrange(mp1, mp2, mp3, ncol = 1, nrow = 3, align = "h", common.legend = T)
mp ggsave("Additional/Additional_Figure_09.png", mp,
width = 8, height = 10, dpi = 600, bg = "white")
Additional Figure 10 - Harvest Index x DTF
# Prep data
<- it17_f %>% filter(Trait == "Seed.Mass") %>% select(Plot, Name, Seed.Mass=Value)
y1 <- it17_gc.v[[2]] %>% select(Plot, Volume=k)
y2 <- left_join(y1, y2, by = "Plot") %>%
x1 mutate(Expt = "Italy 2017",
`Harvest Index` = Seed.Mass / Volume)
#
<- su17_f %>% filter(Trait == "Seed.Mass") %>% select(Plot, Name, Seed.Mass=Value)
y1 <- su17_gc.v[[2]] %>% select(Plot, Volume=k)
y2 <- left_join(y1, y2, by = "Plot") %>%
x2 mutate(Expt = "Sutherland 2017",
`Harvest Index` = Seed.Mass / Volume)
<- bind_rows(x1, x2) %>%
xx group_by(Name, Expt) %>%
summarise(`Harvest Index` = mean(`Harvest Index`, na.rm = T)) %>%
left_join(select(myPCA, Name, Cluster), by = "Name") %>%
left_join(myPCAinput %>% rownames_to_column("Name") %>%
select(Name, Su17_v.perc.DTF, It17_v.perc.DTF ), by = "Name")
# Plot
<- ggplot(xx, aes(x = Expt, y = `Harvest Index`, color = Cluster)) +
mp1 geom_quasirandom(pch = 16, alpha = 0.7) +
scale_color_manual(values = myColors_Cluster)
<- ggplot(xx %>% filter(Expt == "Italy 2017"),
mp2 aes(x = It17_v.perc.DTF, y = `Harvest Index`, color = Cluster)) +
geom_quasirandom(pch = 16, alpha = 0.7) +
scale_color_manual(values = myColors_Cluster)
<- ggplot(xx %>% filter(Expt == "Sutherland 2017"),
mp3 aes(x = Su17_v.perc.DTF, y = `Harvest Index`, color = Cluster)) +
geom_quasirandom(pch = 16, alpha = 0.7) +
scale_color_manual(values = myColors_Cluster)
<- ggarrange(mp1, ggarrange(mp2, mp3, ncol = 2, common.legend = T),
mp ncol = 1, common.legend = T, legend = "bottom")
ggsave("Additional/Additional_Figure_10.png", mp,
width = 8, height = 8, dpi = 600, bg = "white")
Figure 06 - EnvChange
# Prep data
<- left_join(it17_gc.a[[2]] %>% select(Plot, Name, Expt, Area=k),
x1 2]] %>% select(Plot, Height=k), by = "Plot") %>%
it17_gc.h[[left_join(it17_gc.v[[2]] %>% select(Plot, Volume=k))
<- left_join(ro17_gc.a[[2]] %>% select(Plot, Name, Expt, Area=k),
x2 2]] %>% select(Plot, Height=k), by = "Plot") %>%
ro17_gc.h[[left_join(ro17_gc.v[[2]] %>% select(Plot, Volume=k))
<- left_join(su17_gc.a[[2]] %>% select(Plot, Name, Expt, Area=k),
x3 2]] %>% select(Plot, Height=k), by = "Plot") %>%
su17_gc.h[[left_join(su17_gc.v[[2]] %>% select(Plot, Volume=k))
#
<- bind_rows(x1, x2, x3) %>%
xx left_join(select(myPCA, Name, Cluster), by = "Name") %>%
select(Plot, Name, Expt, everything()) %>%
group_by( Name, Expt, Cluster) %>%
summarise_at(vars(Area, Height, Volume), funs(mean), na.rm = T)
#
<- xx %>%
yy gather(Trait, Value, Area, Height, Volume) %>%
mutate(Trait = paste("Plot", Trait)) %>%
spread(Expt, Value) %>%
mutate(EnvChange = `Italy 2017` - `Sutherland 2017`)
<- ggplot(yy, aes(x = Cluster, y = EnvChange, color = Cluster)) +
mp1 geom_hline(yintercept = 0, alpha = 0.7) +
geom_quasirandom(pch = 16, alpha = 0.7) +
+
theme_AGL theme(legend.position = "bottom",
legend.margin=margin(c(0,0,0,0)),
panel.grid.major.x = element_blank(),
axis.text.x = element_blank(),
axis.ticks.x = element_blank()) +
facet_wrap(. ~ Trait, scales = "free_y") +
scale_color_manual(values = myColors_Cluster) +
guides(color = guide_legend(nrow = 1, override.aes = list(size = 2, alpha = 1))) +
labs(title = "A)", y = "Change (It17 - Su17)", x = NULL)
#
<- myPCAinput %>% rownames_to_column("Name") %>%
zz select(Name, It17_v.perc.DTF, Su17_v.perc.DTF)
<- yy %>%
yy select(Name, Cluster, Trait, EnvChange) %>%
spread(Trait, EnvChange) %>%
left_join(zz, by = "Name" ) %>%
mutate(v.perc.DTF = It17_v.perc.DTF - Su17_v.perc.DTF,
Group = ifelse(`Plot Area` > 0 | `Plot Height` > 0, "abnormal", "normal"),
Group = ifelse(`Plot Area` > 0 & `Plot Height` > 0, "normal", Group))
#
<- ggplot(yy) +
mp2 geom_label(x = -0.3, y = 0.14, size = 3, label = "Taller\n&\nThiner") +
geom_label(x = 1.2, y = -0.05, size = 3, label = "Shorter\n&\nWider") +
geom_point(aes(x = `Plot Area`, y = `Plot Height`, color = Cluster),
pch = 16, alpha = 0.7) +
geom_point(data = yy %>% filter(Group == "abnormal"),
aes(x = `Plot Area`, y = `Plot Height`), pch = 21) +
geom_vline(xintercept = 0, size = 1, alpha = 0.7) +
geom_hline(yintercept = 0, size = 1, alpha = 0.7) +
scale_color_manual(values = myColors_Cluster) +
scale_size_continuous(range = c(0.5, 3)) +
+
theme_AGL theme(legend.position = "none") +
labs(title = "B)",
x = "Change in Plot Area (It17 - Su17)",
y = "Change in Plot Height (It17 - Su17)")
#
<- yy %>% ungroup() %>%
yy select(Name, Cluster, It17=It17_v.perc.DTF, Su17=Su17_v.perc.DTF) %>%
gather(Expt, Value, 3:4)
#
<- ggplot(yy, aes(x = Expt, y = Value, color = Cluster)) +
mp3 geom_beeswarm(pch = 16, alpha = 0.7) +
scale_color_manual(values = myColors_Cluster) +
+
theme_AGL theme(legend.position = "none") +
labs(title = "C)", y = "% of Volume Growth at Flowering", x = "")
<- ggarrange(mp1, ggarrange(mp2, mp3, ncol = 2, nrow = 1), ncol = 1, nrow = 2, align = "h")
mp ggsave("Figure_06.png", mp, width = 8, height = 6, dpi = 600, bg = "white")
Prepare Data for GWAS
<- function(xx) {
fixNames %>% mutate(Name = gsub(" ", "_", Name),
xx Name = gsub("-", "\\.", Name),
Name = plyr::mapvalues(Name, "3156.11_AGL", "X3156.11_AGL"))
}
Raw Drone Data
# Italy 2017
<- c("crop_volume_m3_excess.green.based",
myT1 "crop_area_m2_excess.green.based",
"mean_crop_height_m_excess.green.based")
<- c("Plot.Volume", "Plot.Area", "Plot.Height")
myT2 <- it17_d %>%
xx mutate(DAP = plyr::mapvalues(DAP, c(93, 101, 119, 133, 163),
c(94, 100, 118, 132, 164)),
DAP = plyr::mapvalues(DAP, c(94, 100, 118, 132, 164),
c("094","100","118","132","164"))) %>%
filter(Trait %in% myT1, DAP %in% c("094","100","118","132","164")) %>%
group_by(Name, DAP, Trait) %>%
summarise(Value_f = mean(Value_f, na.rm = T)) %>%
ungroup() %>%
mutate(Trait = plyr::mapvalues(Trait, myT1, myT2),
Trait = paste0("It17_",Trait, ".d", DAP)) %>%
select(-DAP) %>%
spread(Trait, Value_f) %>%
fixNames()
<- xx %>% gather(Trait, Value, 2:ncol(.)) %>% filter(!is.na(Value)) %>%
yy group_by(Trait) %>% summarise(n = n())
write.csv(xx, "Data_GWAS/myY_it17_d.csv", row.names = F)
# Rosthern 2017
<- c("crop_volume_m3_blue.ndvi.based",
myT1 "crop_area_m2_blue.ndvi.based",
"mean_crop_height_m_blue.ndvi.based")
<- ro17_d %>%
xx filter(Trait %in% myT1, DAP %in% c(24,32,39,40,54,61,67,74,80,89,95)) %>%
mutate(DAP = paste0("0", DAP)) %>%
group_by(Name, DAP, Trait) %>%
summarise(Value_f = mean(Value_f, na.rm = T)) %>%
ungroup() %>%
mutate(Trait = plyr::mapvalues(Trait, myT1, myT2),
Trait = paste0("Ro17_", Trait, ".d", DAP)) %>%
select(-DAP) %>%
spread(Trait, Value_f) %>%
fixNames()
sum(is.na(xx))
is.na(xx)] <- NA
xx[<- xx %>% gather(Trait, Value, 2:ncol(.)) %>% filter(!is.na(Value)) %>%
yy group_by(Trait) %>% summarise(n = n())
<- xx %>%
xx select(-Ro17_Plot.Area.d024,-Ro17_Plot.Area.d032, -Ro17_Plot.Area.d039,
-Ro17_Plot.Volume.d024, -Ro17_Plot.Volume.d032)
write.csv(xx, "Data_GWAS/myY_Ro17_d.csv", row.names = F)
#
<- c("crop_volume_m3_blue.ndvi.based",
myT1 "crop_area_m2_blue.ndvi.based",
"mean_crop_height_m_blue.ndvi.based")
<- su17_d %>%
xx filter(Trait %in% myT1, DAP %in% c(32,40,46,51,57,61,68,72,75,77,83)) %>%
mutate(DAP = paste0("0", DAP)) %>%
group_by(Name, DAP, Trait) %>%
summarise(Value_f = mean(Value_f, na.rm = T)) %>%
ungroup() %>%
mutate(Trait = plyr::mapvalues(Trait, myT1, myT2),
Trait = paste0("Su17_", Trait, ".d", DAP)) %>%
select(-DAP) %>%
spread(Trait, Value_f) %>%
fixNames()
sum(is.na(xx))
is.na(xx)] <- NA
xx[<- xx %>% gather(Trait, Value, 2:ncol(.)) %>% filter(!is.na(Value)) %>%
yy group_by(Trait) %>% summarise(n = n())
<- xx %>% select(-Su17_Plot.Area.d032, -Su17_Plot.Volume.d032)
xx write.csv(xx, "Data_GWAS/myY_Su17_d.csv", row.names = F)
#
<- c("crop_volume_m3_excess.green.based",
myT1 "crop_area_m2_excess.green.based",
"mean_crop_height_m_excess.green.based")
<- su18_d %>%
xx filter(Trait %in% myT1, DAP %in% c(61,65,68,72,76,79,86)) %>%
mutate(DAP = paste0("0", DAP)) %>%
group_by(Name, DAP, Trait) %>%
summarise(Value_f = mean(Value_f, na.rm = T)) %>%
ungroup() %>%
mutate(Trait = plyr::mapvalues(Trait, myT1, myT2),
Trait = paste0("Su18_",Trait, ".d", DAP)) %>%
select(-DAP) %>%
spread(Trait, Value_f) %>%
fixNames()
#
<- xx %>% gather(Trait, Value, 2:ncol(.)) %>% filter(!is.na(Value)) %>%
yy group_by(Trait) %>% summarise(n = n())
write.csv(xx, "Data_GWAS/myY_Su18_d.csv", row.names = F)
Growth Curve Data
# Italy 2017
<- it17_gc.v[[2]] %>% mutate(Expt = "It17_gc.v")
x1 <- it17_gc.h[[2]] %>% mutate(Expt = "It17_gc.h")
x2 <- it17_gc.a[[2]] %>% mutate(Expt = "It17_gc.a")
x3 <- bind_rows(x1,x2,x3) %>%
xx select(Name, Expt, r, b, g.r, g.b, k,
%>%
x.min, x.mid, x.max, x.d, x.gen, auc.l, auc.e) gather(Trait, Value, 3:ncol(.)) %>%
group_by(Name, Expt, Trait) %>%
summarise(Value = mean(Value, na.rm = T)) %>%
ungroup() %>% mutate(Trait = paste(Expt, Trait, sep = ".")) %>%
select(-Expt) %>% spread(Trait, Value) %>%
fixNames()
write.csv(xx, "Data_GWAS/myY_it17_gc.csv", row.names = F)
# Rosthern 2017
<- ro17_gc.v[[2]] %>% mutate(Expt = "Ro17_gc.v")
x1 <- ro17_gc.h[[2]] %>% mutate(Expt = "Ro17_gc.h")
x2 <- ro17_gc.a[[2]] %>% mutate(Expt = "Ro17_gc.a")
x3 <- bind_rows(x1,x2,x3) %>%
xx select(Name, Expt, r, b, g.r, g.b, k,
%>%
x.min, x.mid, x.max, x.d, x.gen, auc.l, auc.e ) gather(Trait, Value, 3:ncol(.)) %>%
group_by(Name, Expt, Trait) %>%
summarise(Value = mean(Value, na.rm = T)) %>%
ungroup() %>% mutate(Trait = paste(Expt, Trait, sep = ".")) %>%
select(-Expt) %>% spread(Trait, Value) %>%
fixNames()
write.csv(xx, "Data_GWAS/myY_ro17_gc.csv", row.names = F)
# Sutherland 2017
<- su17_gc.v[[2]] %>% mutate(Expt = "Su17_gc.v")
x1 <- su17_gc.h[[2]] %>% mutate(Expt = "Su17_gc.h")
x2 <- su17_gc.a[[2]] %>% mutate(Expt = "Su17_gc.a")
x3 <- bind_rows(x1,x2,x3) %>%
xx select(Name, Expt, r, b, g.r, g.b, k,
%>%
x.min, x.mid, x.max, x.d, x.gen, auc.l, auc.e) gather(Trait, Value, 3:ncol(.)) %>%
group_by(Name, Expt, Trait) %>%
summarise(Value = mean(Value, na.rm = T)) %>%
ungroup() %>% mutate(Trait = paste(Expt, Trait, sep = ".")) %>%
select(-Expt) %>% spread(Trait, Value) %>%
fixNames()
write.csv(xx, "Data_GWAS/myY_su17_gc.csv", row.names = F)
# Italy 2017
<- it17_gc.a[[2]] %>%
x1 select(Plot, Entry, Name) %>%
left_join(phenolGrowth(xd = it17_gc.a[[2]], xf = it17_f), by = "Plot") %>%
mutate(Expt = "It17_", Prefix = "gc.a.")
<- it17_gc.h[[2]] %>%
x2 select(Plot, Entry, Name) %>%
left_join(phenolGrowth(xd = it17_gc.h[[2]], xf = it17_f), by = "Plot") %>%
mutate(Expt = "It17_", Prefix = "gc.h.")
<- it17_gc.v[[2]] %>%
x3 select(Plot, Entry, Name) %>%
left_join(phenolGrowth(xd = it17_gc.v[[2]], xf = it17_f), by = "Plot") %>%
mutate(Expt = "It17_", Prefix = "gc.v.")
<- bind_rows(x1, x2, x3) %>%
xx select(Expt, Prefix, everything()) %>%
gather(Trait, Value, 6:ncol(.)) %>%
group_by(Name, Expt, Prefix, Trait) %>%
summarise(Value = mean(Value, na.rm = T)) %>%
ungroup() %>%
mutate(Trait = paste0(Expt, Prefix, Trait)) %>%
select(-Expt, -Prefix) %>%
spread(Trait, Value)
write.csv(xx, "Data_GWAS/myY_it17_pg.csv", row.names = F)
# Rosthern 2017
<- ro17_gc.a[[2]] %>%
x1 select(Plot, Entry, Name) %>%
left_join(phenolGrowth(xd = ro17_gc.a[[2]], xf = ro17_f), by = "Plot") %>%
mutate(Expt = "Ro17_", Prefix = "gc.a.")
<- ro17_gc.h[[2]] %>%
x2 select(Plot, Entry, Name) %>%
left_join(phenolGrowth(xd = ro17_gc.h[[2]], xf = ro17_f), by = "Plot") %>%
mutate(Expt = "Ro17_", Prefix = "gc.h.")
<- ro17_gc.v[[2]] %>%
x3 select(Plot, Entry, Name) %>%
left_join(phenolGrowth(xd = ro17_gc.v[[2]], xf = ro17_f), by = "Plot") %>%
mutate(Expt = "Ro17_", Prefix = "gc.v.")
<- bind_rows(x1, x2, x3) %>%
xx select(Expt, Prefix, everything()) %>%
gather(Trait, Value, 6:ncol(.)) %>%
group_by(Name, Expt, Prefix, Trait) %>%
summarise(Value = mean(Value, na.rm = T)) %>%
ungroup() %>%
mutate(Trait = paste0(Expt, Prefix, Trait)) %>%
select(-Expt, -Prefix) %>%
spread(Trait, Value)
write.csv(xx, "Data_GWAS/myY_ro17_pg.csv", row.names = F)
# Sutherland 2017
<- su17_gc.a[[2]] %>%
x1 select(Plot, Entry, Name) %>%
left_join(phenolGrowth(xd = su17_gc.a[[2]], xf = su17_f), by = "Plot") %>%
mutate(Expt = "Su17_", Prefix = "gc.a.")
<- su17_gc.h[[2]] %>%
x2 select(Plot, Entry, Name) %>%
left_join(phenolGrowth(xd = su17_gc.h[[2]], xf = su17_f), by = "Plot") %>%
mutate(Expt = "Su17_", Prefix = "gc.h.")
<- su17_gc.v[[2]] %>%
x3 select(Plot, Entry, Name) %>%
left_join(phenolGrowth(xd = su17_gc.v[[2]], xf = su17_f), by = "Plot") %>%
mutate(Expt = "Su17_", Prefix = "gc.v.")
<- bind_rows(x1, x2, x3) %>%
xx select(Expt, Prefix, everything()) %>%
gather(Trait, Value, 6:ncol(.)) %>%
group_by(Name, Expt, Prefix, Trait) %>%
summarise(Value = mean(Value, na.rm = T)) %>%
ungroup() %>%
mutate(Trait = paste0(Expt, Prefix, Trait)) %>%
select(-Expt, -Prefix) %>%
spread(Trait, Value)
write.csv(xx, "Data_GWAS/myY_su17_pg.csv", row.names = F)
Manual Phenotypes
Run GWAS
#
<- read.csv("Data_GWAS/myY_it17_d.csv")
myY_it17_d <- read.csv("Data_GWAS/myY_ro17_d.csv")
myY_ro17_d <- read.csv("Data_GWAS/myY_su17_d.csv")
myY_su17_d <- read.csv("Data_GWAS/myY_su18_d.csv")
myY_su18_d #
<- read.csv("Data_GWAS/myY_su17_gc.csv")
myY_it17_gc <- read.csv("Data_GWAS/myY_su17_gc.csv")
myY_ro17_gc <- read.csv("Data_GWAS/myY_su17_gc.csv")
myY_su17_gc #
<- read.csv("Data_GWAS/myY_su17_pg.csv")
myY_it17_pg <- read.csv("Data_GWAS/myY_su17_pg.csv")
myY_ro17_pg <- read.csv("Data_GWAS/myY_su17_pg.csv")
myY_su17_pg #
<- read.csv("Data_GWAS/myY_myF.csv")
myY_myF #
<- read.csv("myG_LDP.csv", header = F)
myG #
setwd("GWAS_Results/")
<- GAPIT(Y = myY_it17_d, G = myG, PCA.total = 4,
myGAPIT model = myModels, Phenotype.View = F)
<- GAPIT(Y = myY_ro17_d, G = myG, PCA.total = 4,
myGAPIT model = myModels, Phenotype.View = F)
<- GAPIT(Y = myY_su17_d, G = myG, PCA.total = 4,
myGAPIT model = myModels, Phenotype.View = F)
<- GAPIT(Y = myY_su18_d, G = myG, PCA.total = 4,
myGAPIT model = myModels, Phenotype.View = F)
#
<- GAPIT(Y = myY_it17_gc, G = myG, PCA.total = 4,
myGAPIT model = myModels, Phenotype.View = F)
<- GAPIT(Y = myY_ro17_gc, G = myG, PCA.total = 4,
myGAPIT model = myModels, Phenotype.View = F)
<- GAPIT(Y = myY_su17_gc, G = myG, PCA.total = 4,
myGAPIT model = myModels, Phenotype.View = F)
#
<- GAPIT(Y = myY_it17_pg, G = myG, PCA.total = 4,
myGAPIT model = myModels, Phenotype.View = F)
<- GAPIT(Y = myY_ro17_pg, G = myG, PCA.total = 4,
myGAPIT model = myModels, Phenotype.View = F)
<- GAPIT(Y = myY_su17_pg, G = myG, PCA.total = 4,
myGAPIT model = myModels, Phenotype.View = F)
#
<- GAPIT(Y = myY_myF, G = myG, PCA.total = 4,
myGAPIT model = myModels, Phenotype.View = F)
Post GWAS
# devtools::install_github("derekmichaelwright/gwaspr")
library(gwaspr)
#
<- list_Traits("GWAS_Results/")
myTraits <- list_Result_Files("GWAS_Results/") myResults
order_GWAS_Results(folder = "GWAS_Results/", files = myResults)
<- table_GWAS_Results("GWAS_Results/", myResults, threshold = 6.7, sug.threshold = 5.3)
xx write.csv(xx, "Supplemental_Table_01.csv", row.names = F)
#
<- c("Lcu.2RBY.Chr2p42556949", "Lcu.2RBY.Chr5p1069654", "Lcu.2RBY.Chr6p2528817")
myMarkersd <- c(myMarkersd, "Lcu.2RBY.Chr1p2011396", "Lcu.2RBY.Chr7p527137890")
myMarkers <- c(rep("darkgreen",3), rep("darkred",4)) myMColors
Significant Markers
# Create function
<- function(myG, myY, trait, marker, marker2 = NULL,
gg_PlotMarker colors = c("darkgreen", "darkorange", "steelblue", "darkred")) {
#
<- data.frame(stringsAsFactors = F,
gwaspr_dna Symbol = c("A", "C", "G", "T", "U", "R", "Y", "S", "W", "K", "M", "N"),
Value = c("AA","CC","GG","TT","UU","AG","CT","GC","AT","GT","AC","NN"))
<- myG %>% filter(rs == marker)
x1 <- read.csv("myPCA.csv") %>%
myPCA mutate(Name = gsub(" ", "_", Name),
Name = gsub("-", "\\.", Name),
Name = plyr::mapvalues(Name, "3156.11_AGL", "X3156.11_AGL")) %>%
mutate(Cluster = factor(Cluster))
if(!is.null(marker2)) {
<- myG %>% filter(rs == marker2) %>%
x2 gather(Name, Allele2, 12:ncol(.)) %>%
select(Name, Allele2)
}<- paste(trait, marker, marker2, "png", sep = ".")
fname <- paste(trait, marker, marker2, sep = " | ")
title <- x1 %>% gather(Name, Allele, 12:ncol(.)) %>%
xx select(Name, Allele) %>%
mutate(Allele = plyr::mapvalues(Allele, gwaspr_dna$Symbol, gwaspr_dna$Value),
Allele = factor(Allele, levels = gwaspr_dna$Value)) %>%
filter(!Allele %in% c("AG","CT","GC","AT","GT","AC","NN"))
if (!is.null(marker2)) { xx <- xx %>% left_join(x2, by = "Name") }
<- xx %>%
xx left_join(select(myPCA, Name, Cluster)) %>%
left_join(myY, by = "Name") %>%
filter(!is.na(get(trait))) %>%
mutate(Allele = plyr::mapvalues(Allele, gwaspr_dna$Symbol, gwaspr_dna$Value))
if(is.null(marker2)) {
<- ggplot(xx, aes(x = Allele, y = get(trait))) +
mp geom_beeswarm(aes(color = Cluster), cex = 2.5, size = 1, pch = 16, alpha = 0.6) +
geom_boxplot(fill = alpha("white",0), color = alpha("black",0.8),
lwd = 0.5, width = 0.2, outlier.shape = NA, coef = 0) +
facet_grid(. ~ as.character(trait)) +
scale_color_manual(values = myColors_Cluster) +
+
theme_AGL guides(colour = guide_legend(nrow = 1)) +
labs(y = NULL, x = NULL)
else {
} <- xx %>%
xx mutate(Allele2 = plyr::mapvalues(Allele2, gwaspr_dna$Symbol, gwaspr_dna$Value)) %>%
filter(!Allele2 %in% c("AG","CT","GC","AT","GT","AC","NN")) %>%
mutate(Allele3 = paste(Allele, Allele2, sep = "-"))
<- xx %>% group_by(Allele3) %>% summarise(Value = mean(get(trait))) %>%
morder arrange(Value) %>% pull(Allele3)
<- xx %>% mutate(Allele3 = factor(Allele3, levels = morder))
xx <- ggplot(xx, aes(x = Allele3, y = get(trait))) +
mp geom_beeswarm(aes(color = Cluster), cex = 2.5, size = 1, pch = 16, alpha = 0.6) +
geom_boxplot(fill = alpha("white",0), color = alpha("black",0.8),
lwd = 0.5, width = 0.2, outlier.shape = NA, coef = 0) +
facet_grid(. ~ as.character(trait)) +
scale_color_manual(values = myColors_Cluster) +
+
theme_AGL guides(colour = guide_legend(nrow = 1)) +
labs(y = NULL, x = NULL)
}
mp }
<- read.csv("Supplemental_Table_01.csv")
xx <- xx %>% filter(!duplicated(SNP)) %>% pull(SNP)
myMarkers_all <- read.csv("myG_LDP.csv", header = T)
myG <- left_join(
myY read.csv("Data_GWAS/myY_it17_gc.csv") %>%
mutate(Name = gsub(" ", "_", Name),
Name = gsub("-", "\\.", Name),
Name = plyr::mapvalues(Name, "3156.11_AGL", "X3156.11_AGL")) %>%
as.data.frame() %>%
select(Name, It17_gc.h.k, It17_gc.a.k, It17_gc.v.k),
read.csv("Data_GWAS/myY_ro17_gc.csv") %>%
mutate(Name = gsub(" ", "_", Name),
Name = gsub("-", "\\.", Name),
Name = plyr::mapvalues(Name, "3156.11_AGL", "X3156.11_AGL")) %>%
as.data.frame() %>%
select(Name, Ro17_gc.h.k, Ro17_gc.a.k, Ro17_gc.v.k), by = "Name") %>%
left_join(
read.csv("Data_GWAS/myY_su17_gc.csv") %>%
mutate(Name = gsub(" ", "_", Name),
Name = gsub("-", "\\.", Name),
Name = plyr::mapvalues(Name, "3156.11_AGL", "X3156.11_AGL")) %>%
as.data.frame() %>%
select(Name, Su17_gc.h.k, Su17_gc.a.k, Su17_gc.v.k), by = "Name") %>%
left_join(
read.csv("Data_GWAS/myY_myF.csv") %>%
mutate(Name = gsub(" ", "_", Name),
Name = gsub("-", "\\.", Name),
Name = plyr::mapvalues(Name, "3156.11_AGL", "X3156.11_AGL")) %>%
as.data.frame() %>%
select(Name, contains("Yield")), by = "Name")
#
for(i in myMarkers_all) {
<- substr(i, 13, 13)
myChr <- gg_PlotMarker(myG, myY, "It17_gc.h.k", i)
mp1 <- gg_PlotMarker(myG, myY, "It17_gc.a.k", i)
mp2 <- gg_PlotMarker(myG, myY, "It17_gc.v.k", i)
mp3 <- gg_PlotMarker(myG, myY, "Su17_gc.h.k", i)
mp4 <- gg_PlotMarker(myG, myY, "Su17_gc.a.k", i)
mp5 <- gg_PlotMarker(myG, myY, "Su17_gc.v.k", i)
mp6 <- gg_PlotMarker(myG, myY, "Ro17_gc.h.k", i)
mp7 <- gg_PlotMarker(myG, myY, "Ro17_gc.a.k", i)
mp8 <- gg_PlotMarker(myG, myY, "Ro17_gc.v.k", i)
mp9 <- ggarrange(mp1, mp2, mp3, mp4, mp5, mp6, mp7, mp8, mp9,
mp ncol = 3, nrow = 3, common.legend = T, legend = "bottom") %>%
annotate_figure(top = text_grob(i, hjust = 1.75))
ggsave(paste0("additional/Markers/Chr", myChr, "/", i, ".png"), mp,
width = 8, height = 6, bg = "white")
}#
<- 1
counter for(i in myMarkers_all[1:200]) {
<- gg_PlotMarker(myG, myY, "It17_gc.h.k", i)
mp1 <- gg_PlotMarker(myG, myY, "It17_gc.a.k", i)
mp2 <- gg_PlotMarker(myG, myY, "It17_gc.v.k", i)
mp3 <- gg_PlotMarker(myG, myY, "Su17_gc.h.k", i)
mp4 <- gg_PlotMarker(myG, myY, "Su17_gc.a.k", i)
mp5 <- gg_PlotMarker(myG, myY, "Su17_gc.v.k", i)
mp6 <- gg_PlotMarker(myG, myY, "Ro17_gc.h.k", i)
mp7 <- gg_PlotMarker(myG, myY, "Ro17_gc.a.k", i)
mp8 <- gg_PlotMarker(myG, myY, "Ro17_gc.v.k", i)
mp9 <- ggarrange(mp1, mp2, mp3, mp4, mp5, mp6, mp7, mp8, mp9,
mp ncol = 3, nrow = 3, common.legend = T, legend = "bottom") %>%
annotate_figure(top = text_grob(i, hjust = 1.75))
ggsave(paste0("additional/Markers/Top/",
::str_pad(counter,3,pad = "0"),"_",i,".png"), mp,
stringrwidth = 12, height = 8, bg = "white")
<- counter + 1
counter }
Manhattan Plots
for(i in myTraits) {
<- gg_Manhattan(folder = "GWAS_Results/", trait = i, facet = F,
mp models = c("MLM", "FarmCPU", "BLINK"),
threshold = 7.3, sug.threshold = 6.7, pmax = 12,
vlines = myMarkers)
ggsave(paste0("Additional/ManH/Multi_",i,".png"),
width = 12, height = 4, bg = "white")
mp, }
Figure 07 - GWAS Summary
# Prep data
<- read.csv("Supplemental_Table_01.csv")
xx <- read.csv("myG_LDP.csv", header = T) %>%
myG select(SNP=1, Chr=3, Pos=4)
# Create plotting function
<- function(xx, myTs, myR = 2000000, myTitle = "",
gg_GWAS_Hits myYlab = "Significant Associations",
sigThresh = round(length(myTs)/10), sigMin = 0,
vlines = NULL, vline.colors = rep("red", length(vlines)) ) {
#
<- c("darkgreen", "darkorange3", "darkslategray4","darkblue")
myCs <- xx %>% filter(Trait %in% myTs) %>% mutate(Hits = NA)
xx #
<-1
ifor(i in 1:nrow(xx)) {
<- xx$Chr[i]
myChr <- xx$Pos[i]
myPos <- xx$Model[i]
myMod <- xx %>%
xi filter(Chr == myChr, Model == myMod,
> myPos-myR, Pos < myPos+myR)
Pos $Hits[i] <- nrow(xi)
xx<- xi %>% filter(!(SNP == xx$SNP[i] & Trait == xx$Trait[i]))
xi $Pos[xx$SNP %in% xi$SNP & xx$Trait %in% xi$Trait] <- NA
xx
}<- xx %>% filter(!is.na(Pos), Hits > sigMin) %>%
xx mutate(Model = factor(Model, levels = c("MLM", "FarmCPU", "BLINK")))
#
<- max(xx$Hits)
ymax #
<- ggplot(xx, aes(x = Pos / 100000000) ) +
mp geom_blank(data = myG)
if(!is.null(vlines)) {
<- myG %>%
myGM filter(SNP %in% vlines) %>%
mutate(SNP = factor(SNP, levels = vlines)) %>%
arrange(SNP)
<- mp +
mp geom_vline(data = myGM, alpha = 0.7,
aes(xintercept = Pos/1e+08, color = SNP)) +
scale_color_manual(name = NULL, values = vline.colors)
}<- mp +
mp geom_point(aes(y = Hits, size = Hits, key1 = SNP,
fill = Model, shape = Model), alpha = 0.7) +
facet_grid(paste(myTitle) ~ paste("Chr", Chr),
space = "free_x", scales = "free_x") +
scale_shape_manual(values = c(21,24:25), breaks = c("MLM","FarmCPU","BLINK")) +
scale_fill_manual(values = myCs, breaks = c("MLM","FarmCPU","BLINK")) +
scale_size_continuous(range = c(0.5,3)) +
scale_y_continuous(labels = scales::label_number(accuracy = 1),
limits = c(0,ymax)) +
+
theme_AGL theme(legend.position = "bottom") +
guides(color = F, size = F) +
labs(x = "100 Mbp", y = myYlab)
mp
}#
<- gg_GWAS_Hits(xx, myTitle = "Manual", myYlab = "",
mp1 myTs = myTraits[grepl("Canopy.Height|Plant.Length|Biomass|Plant.Mass|Yield|Seed.Mass", myTraits)],
vlines = myMarkers, vline.colors = myMColors)
<- gg_GWAS_Hits(xx, myTitle = "UAV", myYlab = "Number of Significant Associations",
mp2 myTs = myTraits[grepl("Plot.Height|Plot.Area|Plot.Volume", myTraits)],
vlines = myMarkers, vline.colors = myMColors)
<- gg_GWAS_Hits(xx, myTitle = "Growth Curves", myYlab = "",
mp3 myTs = myTraits[grepl("gc.h|gc.a|gc.v", myTraits)],
vlines = myMarkers, vline.colors = myMColors)
<- ggarrange(mp1, mp2, mp3, ncol = 1, nrow = 3,
mp common.legend = T, legend = "bottom")
ggsave("Figure_07.png", mp, width = 10, height = 8, dpi = 600, bg = "white")
Supplemental Figure 5
# Prep data
<- gg_GWAS_Hits(xx, myTitle = "Height", myYlab = "",
mp1 myTs = myTraits[grepl("Height|gc.h|Plant.Length", myTraits)],
vlines = myMarkers, vline.colors = myMColors)
<- gg_GWAS_Hits(xx, myTitle = "Area", myYlab = "Number of Significant Associations",
mp2 myTs = myTraits[grepl("Area|gc.a|Width|Node|Lowest.Pod", myTraits)],
vlines = myMarkers, vline.colors = myMColors)
<- gg_GWAS_Hits(xx, myTitle = "Volume", myYlab = "",
mp3 myTs = myTraits[grepl("Volume|gc.v|Biomass|Plant.Mass", myTraits)],
vlines = myMarkers, vline.colors = myMColors)
# Plot
<- ggarrange(mp1, mp2, mp3, ncol = 1, nrow = 3,
mp common.legend = T, legend = "bottom")
ggsave("Supplemental_Figure_05.png", mp, width = 10, height = 8, dpi = 600, bg = "white")
Additional Figures 11
Additional/Additional_Figure_11_1.html
Additional/Additional_Figure_11_2.html
Additional/Additional_Figure_11_3.html
Additional/Additional_Figure_11_4.html
Additional/Additional_Figure_11_5.html
Additional/Additional_Figure_11_6.html
Additional/Additional_Figure_11_7.html
# Plot
<- gg_GWAS_Hits(xx, myTitle = "Manual", myYlab = "",
mp1 myTs = myTraits[grepl("Canopy.Height|Plant.Length|Biomass|Plant.Mass|Yield|Seed.Mass", myTraits)],
vlines = myMarkers, vline.colors = myMColors)
<- gg_GWAS_Hits(xx, myTitle = "UAV", myYlab = "Number of Significant Associations",
mp2 myTs = myTraits[grepl("Plot.Height|Plot.Area|Plot.Volume", myTraits)],
vlines = myMarkers, vline.colors = myMColors)
<- gg_GWAS_Hits(xx, myTitle = "Growth Curves", myYlab = "",
mp3 myTs = myTraits[grepl("gc.h|gc.a|gc.v", myTraits)],
vlines = myMarkers, vline.colors = myMColors)
#
<- gg_GWAS_Hits(xx, myTitle = "Height", myYlab = "",
mp4 myTs = myTraits[grepl("Height|gc.h|Plant.Length", myTraits)],
vlines = myMarkers, vline.colors = myMColors)
<- gg_GWAS_Hits(xx, myTitle = "Area", myYlab = "Number of Significant Associations",
mp5 myTs = myTraits[grepl("Area|gc.a|Width|Node|Lowest.Pod", myTraits)],
vlines = myMarkers, vline.colors = myMColors)
<- gg_GWAS_Hits(xx, myTitle = "Volume", myYlab = "",
mp6 myTs = myTraits[grepl("Volume|gc.v|Biomass|Plant.Mass", myTraits)],
vlines = myMarkers, vline.colors = myMColors)
#
<- gg_GWAS_Hits(xx, myTitle = "Volume + Height + Area",
mp7 myTs = c(myTraits[grepl("Height|gc.h|Plant.Length|", myTraits)],
grepl("Area|gc.a|Width|Node|Lowest.Pod", myTraits)],
myTraits[grepl("Volume|gc.v|Biomass|Plant.Mass", myTraits)]),
myTraits[vlines = myMarkers, vline.colors = myMColors, sigThresh = 20)
#
ggsave("Additional/Additional_Figure_11_1.png", mp1, width = 10, height = 5, dpi = 600)
ggsave("Additional/Additional_Figure_11_2.png", mp2, width = 10, height = 5, dpi = 600)
ggsave("Additional/Additional_Figure_11_3.png", mp3, width = 10, height = 5, dpi = 600)
ggsave("Additional/Additional_Figure_11_4.png", mp4, width = 10, height = 5, dpi = 600)
ggsave("Additional/Additional_Figure_11_5.png", mp5, width = 10, height = 5, dpi = 600)
ggsave("Additional/Additional_Figure_11_6.png", mp6, width = 10, height = 5, dpi = 600)
ggsave("Additional/Additional_Figure_11_7.png", mp7, width = 10, height = 5, dpi = 600)
#
saveWidget(ggplotly(mp1), file="Additional/Additional_Figure_11_1.html")
saveWidget(ggplotly(mp2), file="Additional/Additional_Figure_11_2.html")
saveWidget(ggplotly(mp3), file="Additional/Additional_Figure_11_3.html")
saveWidget(ggplotly(mp4), file="Additional/Additional_Figure_11_4.html")
saveWidget(ggplotly(mp5), file="Additional/Additional_Figure_11_5.html")
saveWidget(ggplotly(mp6), file="Additional/Additional_Figure_11_6.html")
saveWidget(ggplotly(mp7), file="Additional/Additional_Figure_11_7.html")
Additional Figures 12
Additional/Additional_Figure_12_1.html
Additional/Additional_Figure_12_2.html
Additional/Additional_Figure_12_3.html
Additional/Additional_Figure_12_4.html
Additional/Additional_Figure_12_5.html
Additional/Additional_Figure_12_6.html
Additional/Additional_Figure_12_7.html
Additional/Additional_Figure_12_8.html
Additional/Additional_Figure_12_9.html
# Prep data
<- read.csv("Supplemental_Table_01.csv")
xx <- substr(myTraits, 1, regexpr("_", myTraits)-1)
myExpts <- unique(substr(myTraits, regexpr("_", myTraits)+1, nchar(myTraits)))
myPhenos #
# Drone Data
#
<- myTraits[grepl("Plot.Height", myTraits)]
myTi <- gg_GWAS_Summary(folder = "GWAS_Results/", traits = myTi, threshold = 6.7, sug.threshold = 5.3,
mp1 hlines = c(7.5, 18.5, 28.5),
vlines = myMarkers, vline.colors = myMColors, vline.legend = F)
#
<- myTraits[grepl("Plot.Area", myTraits)]
myTi <- gg_GWAS_Summary(folder = "GWAS_Results/", traits = myTi, threshold = 6.7, sug.threshold = 5.3,
mp2 hlines = c(7.5, 17.5, 25.5),
vlines = myMarkers, vline.colors = myMColors, vline.legend = F)
#
<- myTraits[grepl("Plot.Volume", myTraits)]
myTi <- gg_GWAS_Summary(folder = "GWAS_Results/", traits = myTi, threshold = 6.7, sug.threshold = 5.3,
mp3 hlines = c(7.5, 17.5, 25.5),
vlines = myMarkers, vline.colors = myMColors, vline.legend = F)
#
# Growth Curves
#
<- myTraits[grepl("gc.h", myTraits)]
myTi <- gg_GWAS_Summary(folder = "GWAS_Results/", traits = myTi, threshold = 6.7, sug.threshold = 5.3,
mp4 hlines = c(12.5, 24.5),
vlines = myMarkers, vline.colors = myMColors, vline.legend = F)
#
<- myTraits[grepl("gc.a", myTraits)]
myTi <- gg_GWAS_Summary(folder = "GWAS_Results/", traits = myTi, threshold = 6.7, sug.threshold = 5.3,
mp5 hlines = c(12.5, 24.5),
vlines = myMarkers, vline.colors = myMColors, vline.legend = F)
#
<- myTraits[grepl("gc.v", myTraits)]
myTi <- gg_GWAS_Summary(folder = "GWAS_Results/", traits = myTi, threshold = 6.7, sug.threshold = 5.3,
mp6 hlines = c(12.5, 24.5),
vlines = myMarkers, vline.colors = myMColors, vline.legend = F)
#
# Manual Measurements
#
<- c(myTraits[grepl("Canopy.Height", myTraits)], myTraits[grepl("Plant.Length", myTraits)])
myTi <- gg_GWAS_Summary(folder = "GWAS_Results/", traits = myTi, threshold = 6.7, sug.threshold = 5.3,
mp7 hlines = c(9.5),
vlines = myMarkers, vline.colors = myMColors, vline.legend = F)
#
<- c(myTraits[grepl("Plot.Biomass", myTraits)], myTraits[grepl("Straw.Biomass", myTraits)],
myTi grepl("Plant.Mass", myTraits)] )
myTraits[<- gg_GWAS_Summary(folder = "GWAS_Results/", traits = myTi, threshold = 6.7, sug.threshold = 5.3,
mp8 hlines = c(4.5, 19.5),
vlines = myMarkers, vline.colors = myMColors, vline.legend = F)
#
<- c(myTraits[grepl("Canopy.Width", myTraits)],
myTi grepl("Lowest.Pod.H", myTraits)], myTraits[grepl("Flower.Branch", myTraits)],
myTraits[grepl("Nodes.At.Flower", myTraits)], myTraits[grepl("Node.Of.Flower", myTraits)] )
myTraits[<- gg_GWAS_Summary(folder = "GWAS_Results/", traits = myTi, threshold = 6.7, sug.threshold = 5.3,
mp9 hlines = c(4.5, 12.5, 16.5, 27.5),
vlines = myMarkers, vline.colors = myMColors, vline.legend = F)
#
ggsave("Additional/Additional_Figure_12_1.png", mp1,
width = 15, height = 8, dpi = 600)
ggsave("Additional/Additional_Figure_12_2.png", mp2,
width = 15, height = 8, dpi = 600)
ggsave("Additional/Additional_Figure_12_3.png", mp3,
width = 15, height = 8, dpi = 600)
ggsave("Additional/Additional_Figure_12_4.png", mp4,
width = 15, height = 8, dpi = 600)
ggsave("Additional/Additional_Figure_12_5.png", mp5,
width = 15, height = 8, dpi = 600)
ggsave("Additional/Additional_Figure_12_6.png", mp6,
width = 15, height = 8, dpi = 600)
ggsave("Additional/Additional_Figure_12_7.png", mp7,
width = 15, height = 8, dpi = 600)
ggsave("Additional/Additional_Figure_12_8.png", mp8,
width = 15, height = 8, dpi = 600)
ggsave("Additional/Additional_Figure_12_9.png", mp9,
width = 15, height = 8, dpi = 600)
#
gg_GWAS_plotly(mp1, filename = "Additional/Additional_Figure_12_1.html")
gg_GWAS_plotly(mp2, filename = "Additional/Additional_Figure_12_2.html")
gg_GWAS_plotly(mp3, filename = "Additional/Additional_Figure_12_3.html")
gg_GWAS_plotly(mp4, filename = "Additional/Additional_Figure_12_4.html")
gg_GWAS_plotly(mp5, filename = "Additional/Additional_Figure_12_5.html")
gg_GWAS_plotly(mp6, filename = "Additional/Additional_Figure_12_6.html")
gg_GWAS_plotly(mp7, filename = "Additional/Additional_Figure_12_7.html")
gg_GWAS_plotly(mp8, filename = "Additional/Additional_Figure_12_8.html")
gg_GWAS_plotly(mp9, filename = "Additional/Additional_Figure_12_9.html")
Figure 08 - Markers
# Prep data
<- read.csv("Supplemental_Table_01.csv")
xx <- read.csv("myG_LDP.csv", header = T)
myG <- left_join(
myY select(read.csv("Data_GWAS/myY_it17_gc.csv"), Name, It17_gc.v.k, It17_gc.h.k, It17_gc.a.k),
select(read.csv("Data_GWAS/myY_su17_gc.csv"), Name, Su17_gc.v.k, Su17_gc.h.k, Su17_gc.a.k),
by = "Name") %>% as.data.frame()
#
<- data.frame(stringsAsFactors = F,
gwaspr_dna Symbol = c("A", "C", "G", "T", "U", "R", "Y", "S", "W", "K", "M", "N"),
Value = c("AA","CC","GG","TT","UU","AG","CT","GC","AT","GT","AC","NN"))
<- myG %>% filter(rs %in% myMarkers[4:5])
x1 <- read.csv("myPCA.csv") %>%
myPCA mutate(Name = gsub(" ", "_", Name),
Name = gsub("-", "\\.", Name),
Name = plyr::mapvalues(Name, "3156.11_AGL", "X3156.11_AGL")) %>%
mutate(Cluster = factor(Cluster))
#
<- x1 %>% gather(Name, Allele, 12:ncol(.)) %>%
xx select(Name, rs, Allele) %>%
mutate(Allele = plyr::mapvalues(Allele, gwaspr_dna$Symbol, gwaspr_dna$Value),
Allele = factor(Allele, levels = gwaspr_dna$Value)) %>%
filter(Allele %in% c("AA","CC","TT","GG")) %>%
spread(rs, Allele) %>%
left_join(select(myPCA, Name, Cluster)) %>%
left_join(myY, by = "Name")
<- xx %>%
x1 gather(Expt, Height, It17_gc.h.k, Su17_gc.h.k) %>%
mutate(Expt = plyr::mapvalues(Expt, c("It17_gc.h.k", "Su17_gc.h.k"),
c("Metaponto, Italy 2017", "Sutherland, Canada 2017")))
<- xx %>%
x2 gather(Expt, Area, It17_gc.a.k, Su17_gc.a.k) %>%
mutate(Expt = plyr::mapvalues(Expt, c("It17_gc.a.k", "Su17_gc.a.k"),
c("Metaponto, Italy 2017", "Sutherland, Canada 2017")))
# Plot
<- ggplot(x1 %>% filter(!is.na(Lcu.2RBY.Chr1p2011396)),
mp1 aes(x = Lcu.2RBY.Chr1p2011396, y = Height)) +
geom_beeswarm(aes(color = Cluster), pch = 16, alpha = 0.6, size = 0.75, cex = 2) +
geom_boxplot(fill = alpha("white",0), color = alpha("black",0.7),
lwd = 0.75, width = 0.1, outlier.shape = NA, coef = 0) +
facet_wrap(Expt ~ ., scales = "free_y", ncol = 2) +
scale_color_manual(values = myColors_Cluster) +
+
theme_AGL guides(colour = guide_legend(nrow = 1, override.aes = list(size = 1.5, alpha = 1))) +
labs(subtitle = "A) Lcu.2RBY.Chr1p2011396", y = "Plot Height", x = NULL)
<- ggplot(x2 %>% filter(!is.na(Lcu.2RBY.Chr7p527137890)),
mp2 aes(x = Lcu.2RBY.Chr7p527137890, y = Area)) +
geom_beeswarm(aes(color = Cluster), pch = 16, alpha = 0.6, size = 0.75, cex = 2) +
geom_boxplot(fill = alpha("white",0), color = alpha("black",0.7),
lwd = 0.75, width = 0.1, outlier.shape = NA, coef = 0) +
facet_wrap(Expt ~ ., scales = "free_y", ncol = 2) +
scale_color_manual(values = myColors_Cluster) +
+
theme_AGL guides(colour = guide_legend(nrow = 1, override.aes = list(size = 1.5, alpha = 1))) +
labs(subtitle = "B) Lcu.2RBY.Chr7p527137890", y = "Plot Area", x = NULL)
<- ggarrange(mp1, mp2, ncol = 1, nrow = 2, common.legend = T, legend = "bottom")
mp ggsave("Figure_08.png", mp, width = 6, height = 5, dpi = 600, bg = "white")
Supplemental Figure 06 - AH by FTb
# Prep data
<- read.csv("Data_GWAS/myY_su17_gc.csv") %>%
myY mutate(Name = gsub(" ", "_", Name),
Name = gsub("-", "\\.", Name),
Name = plyr::mapvalues(Name, "3156.11_AGL", "X3156.11_AGL")) %>%
as.data.frame() %>%
select(Name, Su17_gc.h.k, Su17_gc.a.k, Su17_gc.v.k)
<- read.csv("myPCA.csv") %>% select(Name, Origin) %>%
myPCA mutate(Name = gsub(" ", "_", Name),
Name = gsub("-", "\\.", Name),
Name = plyr::mapvalues(Name, "3156.11_AGL", "X3156.11_AGL"))
<- myG %>% filter(rs %in% myMarkersd[3]) %>%
xx gather(Name, Allele, 12:ncol(.)) %>%
select(Name, rs, Allele) %>%
mutate(Allele = plyr::mapvalues(Allele, gwaspr_dna$Symbol, gwaspr_dna$Value),
Allele = factor(Allele, levels = gwaspr_dna$Value)) %>%
filter(Allele %in% c("AA","CC","TT","GG")) %>%
spread(rs, Allele) %>%
left_join(select(myPCA, Name, Origin)) %>%
left_join(myY, by = "Name") %>%
mutate(Origin = ifelse(Origin == "Canada", Origin, "Other")) %>%
arrange(Lcu.2RBY.Chr6p2528817, rev(Origin))
# Plot
<- ggplot(xx, aes(x = Su17_gc.a.k, y = Su17_gc.h.k,
mp fill = Lcu.2RBY.Chr6p2528817,
pch = Lcu.2RBY.Chr6p2528817,
color = Origin), size = 2.5) +
geom_point() +
geom_point(data = xx %>% filter(Lcu.2RBY.Chr6p2528817 == "CC")) +
scale_fill_manual(name = "FTb", values = c("darkred", alpha("steelblue",0.25))) +
scale_color_manual(values = c("black","grey70")) +
scale_shape_manual(name = "FTb", values = c(21,22)) +
facet_grid(. ~ "Sutherland, Canada 2017") +
+
theme_AGL labs(x = "Plot Area", y = "Plot Height")
ggsave("Supplemental_Figure_06.png", mp, width = 5, height = 3, dpi = 600)
Supplemental Figure 7 - Markers
# Prep data
<- read.csv("Supplemental_Table_01.csv") %>%
xx filter(Model != "MLMM")
<- left_join(
myY read.csv("Data_GWAS/myY_it17_gc.csv") %>%
mutate(Name = gsub(" ", "_", Name),
Name = gsub("-", "\\.", Name),
Name = plyr::mapvalues(Name, "3156.11_AGL", "X3156.11_AGL")) %>%
as.data.frame() %>%
select(Name, It17_gc.h.k, It17_gc.a.k, It17_gc.v.k),
read.csv("Data_GWAS/myY_ro17_gc.csv") %>%
mutate(Name = gsub(" ", "_", Name),
Name = gsub("-", "\\.", Name),
Name = plyr::mapvalues(Name, "3156.11_AGL", "X3156.11_AGL")) %>%
as.data.frame() %>%
select(Name, Ro17_gc.h.k, Ro17_gc.a.k, Ro17_gc.v.k), by = "Name") %>%
left_join(
read.csv("Data_GWAS/myY_su17_gc.csv") %>%
mutate(Name = gsub(" ", "_", Name),
Name = gsub("-", "\\.", Name),
Name = plyr::mapvalues(Name, "3156.11_AGL", "X3156.11_AGL")) %>%
as.data.frame() %>%
select(Name, Su17_gc.h.k, Su17_gc.a.k, Su17_gc.v.k), by = "Name") %>%
left_join(
read.csv("Data_GWAS/myY_myF.csv") %>%
mutate(Name = gsub(" ", "_", Name),
Name = gsub("-", "\\.", Name),
Name = plyr::mapvalues(Name, "3156.11_AGL", "X3156.11_AGL")) %>%
as.data.frame() %>%
select(Name, contains("Yield")), by = "Name")
# Create plotting function
<- function(xh, xa, xf, markers1, markers2 = myMarkersd,
gg_HAMarker mypchs = c(2,6,16,15), myTitle = "",
colors = c("deeppink4", "darkgreen",
"darkgoldenrod3", "darkred", "purple4", "darkblue",
"steelblue4",
"palevioletred3", "wheat3", "darkseagreen4", "darkorange4",
"tomato4", "slategray4", "aquamarine4",
"magenta4", "dodgerblue4")
) {# Prep data
<- xh[[2]] %>% group_by(Entry) %>%
xh summarise(Height = mean(k, na.rm = T))
<- xa[[2]] %>% group_by(Entry) %>%
xa summarise(Area = mean(k, na.rm = T))
<- xf %>% filter(Trait == "Seed.Mass") %>%
xs group_by(Entry) %>% summarise(Yield = mean(Value, na.rm = T))
<- xf %>% filter(Trait == "DTF") %>%
xd group_by(Entry) %>% summarise(DTF = mean(Value, na.rm = T))
<- read.csv("myPCA.csv") %>%
myPCA mutate(Name = gsub(" ", "_", Name),
Name = gsub("-", "\\.", Name),
Name = plyr::mapvalues(Name, "3156.11_AGL", "X3156.11_AGL")) %>%
mutate(Cluster = factor(Cluster))
#
<- myG %>% filter(rs %in% markers1) %>%
x1 gather(Name, Allele, 12:ncol(.)) %>%
select(Name, rs, Allele) %>%
spread(rs, Allele)
$Alleles1 <- ""
x1<- ncol(x1)
j for(i in 2:(j-1)) { x1$Alleles1 <- paste0(x1[,j], x1[,i]) }
#
<- myG %>% filter(rs %in% markers2) %>%
x2 gather(Name, Allele, 12:ncol(.)) %>%
select(Name, rs, Allele) %>%
spread(rs, Allele)
$Alleles2 <- ""
x2<- ncol(x2)
j #
for(i in 2:(j-1)) { x2$Alleles2 <- paste0(x2[,j], x2[,i]) }
#
<- paste(paste(markers1, collapse = "."), "png", sep = ".")
fname <- paste0(paste(markers1, collapse = " & "), " = Sig Markers\n",
title "\n", paste(markers2[1:2], collapse = " & "), " = Early DTF",
"\n", markers2[3], " = Late DTF ")
<- left_join(x1, x2, by = "Name") %>%
xx mutate(Alleles = paste0(Alleles1, Alleles2),
Alleles2 = ifelse(Lcu.2RBY.Chr6p2528817 == "C", "L-DTF", Alleles2),
Alleles2 = ifelse(Lcu.2RBY.Chr2p42556949 == "C",
"E-DTF", Alleles2),
Alleles2 = ifelse(Lcu.2RBY.Chr5p1069654 == "A",
"E-DTF", Alleles2),
Alleles1 = ifelse(Alleles2 %in% c("E-DTF", "L-DTF"), Alleles2, Alleles1))
#
for(k in c(markers1)) {
<- xx %>%
xx mutate(Alleles1 = ifelse(!get(k) %in% c("A","G","C","T") &
!Alleles1 %in% c("E-DTF", "L-DTF"),
"NN", as.character(Alleles1)))
}#
<- unique(xx$Alleles1)[!unique(xx$Alleles1)%in%c("L-DTF","E-DTF","NN")]
myAs <- c("TT", "CT", "TC", "CC")
myAs <- c("TT-TT", "CC-TT", "TT-CC", "CC-CC")
myAs2 <- xx %>%
xx left_join(select(myPCA, Name, Entry, Cluster, Origin), by = "Name") %>%
left_join(xh, by = "Entry") %>%
left_join(xa, by = "Entry") %>%
left_join(xs, by = "Entry") %>%
left_join(xd, by = "Entry") %>%
arrange(Yield) %>%
mutate(Alleles = factor(Alleles, levels = unique(.$Alleles)),
Alleles1 = plyr::mapvalues(Alleles1, myAs, myAs2),
Alleles1 = factor(Alleles1, levels = unique(c("E-DTF", "L-DTF", myAs2, "NN"))),
Alleles2 = factor(Alleles2, levels = c("E-DTF", "L-DTF"))
)#
<- xx %>% filter(Alleles1 != "NN")
xx #
<- ggplot(xx, aes(x = Area, y = Height,
mp1 color = Alleles1, alpha = Alleles1,
pch = Alleles1, size = Alleles1)) +
geom_point() +
scale_color_manual(name = NULL, values = colors) +
scale_shape_manual(name = "DTF", values = mypchs) +
scale_alpha_manual(values = c(0.6,0.6, rep(0.8,length(myAs)), 0.6)) +
scale_size_manual(values = c(0.8,0.8, rep(2.5, length(myAs)), 0.8)) +
+
theme_AGL labs(title = myTitle, y = "Plot Height", x = "Plot Area")
<- ggplot(xx, aes(x = Alleles1, y = Yield,
mp2 color = Alleles1, pch = Alleles1)) +
geom_quasirandom(alpha = 0.6) +
scale_color_manual(name = NULL, values = colors) +
scale_shape_manual(name = "DTF", values = mypchs) +
+
theme_AGL labs(title = "", x = NULL, y = "Yield (g/plot)")
<- ggplot(xx, aes(x = Alleles1, y = DTF,
mp3 color = Alleles1, pch = Alleles1)) +
geom_quasirandom(alpha = 0.6) +
scale_color_manual(name = NULL, values = colors) +
scale_shape_manual(name = "DTF", values = mypchs) +
+
theme_AGL labs(x = "Alleles", y = "DTF")
<- ggarrange(mp1, ggarrange(mp2, mp3, ncol = 1, nrow = 2, legend = "none", align = "v"),
mp ncol = 2, nrow = 1, legend = "none")
mp
}#
<- c("Lcu.2RBY.Chr1p382800064", "Lcu.2RBY.Chr2p12871875")
myM1 # Plot
<- gg_HAMarker(xh=it17_gc.h, xa=it17_gc.a, xf = it17_f,
mp1 markers1 = myM1, markers2 = myMarkersd,
mypchs = c(2,6,20,18,20,18,1),
myTitle = "A) Metaponto, Italy 2017")
<- gg_HAMarker(xh=su17_gc.h, xa=su17_gc.a, xf = su17_f,
mp2 markers1 = myM1, markers2 = myMarkersd,
mypchs = c(2,6,20,18,20,18,1),
myTitle = "B) Sutherland, Canada 2017")
<- ggarrange(mp1, mp2, ncol = 1, nrow = 2)
mp ggsave("Supplemental_Figure_07.png", mp, width = 7, height = 7, dpi = 600, bg = "white")
© Derek Michael Wright