Lentil Diversity Panel
A population representing global genetic diversity in cultivated lentil varieties
Prepare Data
# devtools::install_github("derekmichaelwright/agData")
library(agData)
library(rworldmap) # mapBubbles()
library(plotly) # plot_ly()
library(leaflet) # leaflet()
library(htmlwidgets) # saveWidget()
# Prep data
<- "www.dblogr.com/ or derekmichaelwright.github.io/dblogr/ | Data: AGILE"
myCaption <- c("darkred", "darkgreen", "darkorange3", "steelblue", "grey")
rColors <- c("darkred", "darkorange3", "darkgoldenrod2", "deeppink3",
cColors "steelblue", "darkorchid4", "cornsilk4", "darkgreen")
<- c("deeppink3", "darkblue", "darkorchid4", "darkorange3", "steelblue",
sColors "darkgoldenrod2", "darkred", "darkgreen", "cornsilk4")
#
<- read.csv("data_ldp.csv") %>%
dd mutate(DTF_Cluster = factor(DTF_Cluster))
Create custom mapBubbles function
<- function (dF = "", nameX = "longitude", nameY = "latitude",
mapBubbles2 nameZSize = "", nameZColour = "", nameZFill = "",
colourPalette = "heat", fillPalette = "heat",
pch = 21, symbolSize = 1, maxZVal = NA, main = nameZSize,
numCats = 5, catMethod = "categorical",
xlim = NA, ylim = NA, mapRegion = "world", borderCol = "grey",
oceanCol = NA, landCol = NA, addLegend = TRUE, legendBg = "white",
legendVals = "", legendPos = "bottomright", legendHoriz = FALSE,
legendTitle = nameZSize, addColourLegend = TRUE, colourLegendPos = "bottomleft",
colourLegendTitle = nameZColour, add = FALSE, plotZeroVals = TRUE,
lwd = 0.5, lwdSymbols = 1, ...)
{<- as.character(sys.call()[[1]])
functionName if (class(dF) == "character" && dF == "") {
message(paste("using example data because no file specified in",
functionName))= getMap()@data
dF = "LON"
nameX = "LAT"
nameY if (nameZSize == "")
= "POP_EST"
nameZSize if (nameZColour == "")
= "continent"
nameZColour
}if (class(dF) == "SpatialPolygonsDataFrame") {
<- coordinates(dF)
centroidCoords "nameX"]] <- centroidCoords[, 1]
dF[["nameY"]] <- centroidCoords[, 2]
dF[[<- "nameX"
nameX <- "nameY"
nameY if (!add) {
rwmNewMapPlot(mapToPlot = dF, oceanCol = oceanCol,
mapRegion = mapRegion, xlim = xlim, ylim = ylim)
plot(dF, add = TRUE, border = borderCol, col = landCol,
main = main, lwd = lwd)
}<- dF@data
dF
}else if (!add) {
rwmNewMapPlot(mapToPlot = getMap(), oceanCol = oceanCol,
mapRegion = mapRegion, xlim = xlim, ylim = ylim)
plot(getMap(), add = TRUE, border = borderCol, col = landCol,
main = main, lwd = lwd)
}#
<- FALSE
singleColour if (nameZColour == "")
<- "black"
nameZColour if (is.na(match(nameZColour, names(dF)))) {
if (!tryCatch(is.matrix(col2rgb(nameZColour)), error = function(e) FALSE)) {
stop("your chosen nameZColour :'", nameZColour,
"' is not a colour and seems not to exist in your data, columns = ",
paste(names(dF), ""))
return(FALSE)
}else singleColour <- TRUE
}<- colourVector <- NA
cutVector if (!singleColour) {
<- dF[, nameZColour]
dataCategorised if (!is.numeric(dataCategorised) && catMethod != "categorical") {
= "categorical"
catMethod message(paste("using catMethod='categorical' for non numeric data in",
functionName))
}if (length(catMethod) == 1 && catMethod == "categorical") {
<- as.factor(dataCategorised)
dataCategorised <- levels(dataCategorised)
cutVector if (length(cutVector) > 15)
warning("with catMethod='categorical' you have > 15 categories, you may want to try a different catMethod, e.g. quantile")
}else {
if (is.character(catMethod) == TRUE) {
<- rwmGetClassBreaks(dataCategorised,
cutVector catMethod = catMethod, numCats = numCats, verbose = TRUE)
}else if (is.numeric(catMethod) == TRUE) {
<- catMethod
cutVector
}<- cut(dataCategorised, cutVector,
dataCategorised include.lowest = TRUE)
<- function(x, y) c(paste(x, "-", y[1 +
func which(y == x)], sep = ""))
<- sapply(cutVector, cutVector, FUN = func)
tmp <- tmp[1:length(tmp) - 1]
cutVector
}<- nameZColour
colNameRaw <- paste(colNameRaw, "categorised",
colNameCat sep = "")
<- dataCategorised
dF[[colNameCat]] <- length(levels(dataCategorised))
numColours <- rwmGetColours(colourPalette, numColours)
colourVector <- as.numeric(dataCategorised)
dataCatNums
}#
<- FALSE
singleFill if (nameZFill == "")
<- "red"
nameZFill if (is.na(match(nameZFill, names(dF)))) {
if (!tryCatch(is.matrix(col2rgb(nameZFill)), error = function(e) FALSE)) {
stop("your chosen nameZFill :'", nameZFill,
"' is not a Fill and seems not to exist in your data, columns = ",
paste(names(dF), ""))
return(FALSE)
}else singleFill <- TRUE
}<- fillVector <- NA
cutVector if (!singleFill) {
<- dF[, nameZFill]
dataCategorised if (!is.numeric(dataCategorised) && catMethod != "categorical") {
= "categorical"
catMethod message(paste("using catMethod='categorical' for non numeric data in",
functionName))
}if (length(catMethod) == 1 && catMethod == "categorical") {
<- as.factor(dataCategorised)
dataCategorised <- levels(dataCategorised)
cutVector if (length(cutVector) > 15)
warning("with catMethod='categorical' you have > 15 categories, you may want to try a different catMethod, e.g. quantile")
}else {
if (is.character(catMethod) == TRUE) {
<- rwmGetClassBreaks(dataCategorised,
cutVector catMethod = catMethod, numCats = numCats, verbose = TRUE)
}else if (is.numeric(catMethod) == TRUE) {
<- catMethod
cutVector
}<- cut(dataCategorised, cutVector,
dataCategorised include.lowest = TRUE)
<- function(x, y) c(paste(x, "-", y[1 +
func which(y == x)], sep = ""))
<- sapply(cutVector, cutVector, FUN = func)
tmp <- tmp[1:length(tmp) - 1]
cutVector
}<- nameZFill
colNameRaw <- paste(colNameRaw, "categorised",
colNameCat sep = "")
<- dataCategorised
dF[[colNameCat]] <- length(levels(dataCategorised))
numFills <- rwmGetColours(fillPalette, numFills)
fillVector <- as.numeric(dataCategorised)
dataCatNums
}#
if (singleColour)
= nameZColour
col else col = colourVector[dataCatNums]
#
if (singleFill)
= nameZFill
bg else bg = fillVector[dataCatNums]
#
if (is.na(maxZVal))
<- max(dF[, nameZSize], na.rm = TRUE)
maxZVal = symbolSize * 4/sqrt(maxZVal)
fMult = fMult * sqrt(dF[, nameZSize])
cex points(dF[, nameX], dF[, nameY], pch = pch, cex = cex, col = col,
bg = bg, lwd = lwdSymbols)
if (addLegend && sum(as.numeric(abs(dF[, nameZSize])), na.rm = TRUE) !=
0) {
if (length(legendVals) > 1) {
<- fMult * sqrt(legendVals)
legendSymbolSizes
}else {
<- 3
sigFigs <- max(dF[, nameZSize], na.rm = TRUE)
maxVal <- min(dF[, nameZSize], na.rm = TRUE)
minVal <- c(signif(minVal, sigFigs), signif(minVal +
legendVals 0.5 * (maxVal - minVal), sigFigs), signif(maxVal,
sigFigs))<- fMult * sqrt(legendVals)
legendSymbolSizes
}= c(pch, pch, pch)
legendSymbolChars <- "black"
colour4LegendPoints if (plotZeroVals && legendSymbolSizes[1] == 0) {
1] <- 1
legendSymbolSizes[1] <- 3
legendSymbolChars[
}= symbolSize * 1.3
x.intersp = symbolSize * 1.3
y.intersp legend(x = legendPos, legend = legendVals, pt.cex = legendSymbolSizes,
pch = legendSymbolChars, col = colour4LegendPoints,
bg = legendBg, title = legendTitle, horiz = legendHoriz,
y.intersp = y.intersp, x.intersp = x.intersp)
}if (addColourLegend && !singleColour) {
addMapLegendBoxes(colourVector = colourVector, cutVector = cutVector,
x = colourLegendPos, title = colourLegendTitle)
}invisible(list(colourVector = colourVector, cutVector = cutVector))
}
Origins
Countries
# Prep data
<- dd %>%
xx group_by(Origin, Region) %>%
summarise(Count = n()) %>%
arrange(Count) %>%
mutate(Origin = factor(Origin, levels = .$Origin))
# Plot
<- ggplot(xx, aes(x = Origin, y = Count, fill = Region)) +
mp geom_col(color = "black", alpha = 0.7) +
facet_grid(. ~ Region, scales = "free", space = "free") +
scale_fill_manual(values = rColors) +
theme_agData(legend.position = "none",
panel.grid.major.x = element_blank(),
axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "Lentil Diversity Panel Origins", x = NULL,
caption = myCaption)
ggsave("lentil_diversity_panel_1_01.png", mp, width = 8, height = 4)
Map
# Prep data
<- dd %>%
xx mutate(Lat = ifelse(is.na(Lat), Country_Lat, Lat),
Lon = ifelse(is.na(Lon), Country_Lon, Lon),
Lat = ifelse(duplicated(Lat), jitter(Lat, 1, 1), Lat),
Lon = ifelse(duplicated(Lon), jitter(Lon, 1, 1), Lon),
Size = 1)
# Plot png
png("lentil_diversity_panel_1_02.png", width = 3600, height = 2055, res = 600)
par(mai = c(0.2,0,0.25,0), xaxs = "i", yaxs = "i")
mapBubbles2(dF = xx, nameX = "Lon", nameY = "Lat",
nameZColour = alpha("darkred",0.8),
nameZFill = alpha("darkgoldenrod2",0.8),
nameZSize = "Size", symbolSize = 0.2, addLegend = F,
xlim = c(-140,110), ylim = c(5,20), lwd = 1,
oceanCol = "grey90", landCol = "white", borderCol = "black")
title(main = "Lentil Diversity Panel Origins", line = 0.25, cex = 3)
title(sub = myCaption, line = 0, cex.sub = 0.75, adj = 1)
dev.off()
Country Map
# Prep data
<- dd %>%
xx filter(Origin != "Unknown") %>%
mutate(Origin = recode(Origin, "ICARDA"="Syria", "USDA"="USA")) %>%
group_by(Origin, Country_Lat, Country_Lon) %>%
summarise(Count = n()) %>%
as.data.frame()
# Plot
png("lentil_diversity_panel_1_03.png", width = 3600, height = 2055, res = 600)
par(mai = c(0.2,0,0.25,0), xaxs = "i",yaxs = "i")
mapBubbles2(dF = xx, nameX = "Country_Lon", nameY = "Country_Lat",
nameZColour = alpha("darkgoldenrod2",0.8),
nameZFill = alpha("darkgreen",0.8),
nameZSize = "Count", legendPos = "bottomleft",
xlim = c(-140,110), ylim = c(5,20), lwd = 1,
oceanCol = "grey90", landCol = "white", borderCol = "black")
title(main = "Lentil Diversity Panel Origins", line = 0.25, cex = 3)
title(sub = myCaption, line = 0, cex.sub = 0.75, adj = 1)
dev.off()
Genotype PCA By Region
<- plot_ly(dd, x = ~myG_PC1, y = ~myG_PC3, z = ~myG_PC2,
mp color = ~Region, colors = rColors, hoverinfo = "text",
text = ~paste(Name,
"\nOrigin:", Origin,
"\nSource:", Source,
"\nCollDate:", CollDate,
"\nSTR_Group:", STR_Group,
"\nDTF_Cluster:", DTF_Cluster)) %>%
add_markers()
saveWidget(as_widget(mp), "lentil_diversity_panel_1_04.html")
Genetic Structure Analyis
Genotype Composition
# Prep data
<- dd %>%
xx select(Name, Origin, Region, G1, G2, G3, G4, G5, G6, G7, G8) %>%
arrange(G1, G2, G3, G4, G5, G6, G7, G8) %>%
gather(Group, Value, G1, G2, G3, G4, G5, G6, G7, G8) %>%
mutate(Name = factor(Name, unique(Name)))
# Plot
<- ggplot(xx, aes(x = Name, y = Value, fill = Group)) +
mp geom_col(position = "stack") +
scale_fill_manual(name = NULL, values = sColors) +
guides(fill = guide_legend(nrow = 1)) +
theme_agData(legend.position = "bottom",
axis.ticks.x = element_blank(),
axis.text.x = element_blank()) +
labs(title = "Lentil Diversity Panel", y = NULL, x = NULL,
caption = myCaption)
ggsave("lentil_diversity_panel_2_01.png", mp, width = 10, height = 4)
Genotype Composition By Region
# Prep data
<- dd %>%
xx select(Name, Origin, Region, G1, G2, G3, G4, G5, G6, G7, G8) %>%
arrange(G1, G2, G3, G4, G5, G6, G7, G8) %>%
gather(Group, Value, G1, G2, G3, G4, G5, G6, G7, G8) %>%
mutate(Name = factor(Name, unique(Name)))
# Plot
<- ggplot(xx, aes(x = Name, y = Value, fill = Group)) +
mp geom_col(position = "stack") +
facet_grid(. ~ Region, scales = "free_x", space = "free_x") +
scale_fill_manual(name = NULL, values = sColors) +
guides(fill = guide_legend(nrow = 1)) +
theme_agData(legend.position = "bottom",
axis.ticks.x = element_blank(),
axis.text.x = element_blank()) +
labs(title = "Lentil Diversity Panel", y = NULL, x = NULL,
caption = myCaption)
ggsave("lentil_diversity_panel_2_02.png", mp, width = 10, height = 4)
Genetic Structure Pie Map
# Prep data
<- c("G1","G2","G3","G4","G5","G6","G7","G8", "Mix")
myG <- dd %>%
xx filter(!Origin %in% c("ICARDA","USDA","Unknown")) %>%
group_by(Origin, STR_Group, Country_Lat, Country_Lon) %>%
summarise(Count = n()) %>%
spread(STR_Group, Count) %>%
as.data.frame()
# Plot
png("lentil_diversity_panel_2_03.png", width = 3600, height = 2055, res = 600)
par(mai = c(0.2,0,0.25,0), xaxs = "i", yaxs = "i")
mapPies(dF = xx, nameX = "Country_Lon", nameY = "Country_Lat",
zColours = sColors, nameZs = myG, lwd = 1,
xlim = c(-140,110), ylim = c(5,20), addCatLegend = F,
oceanCol = "grey90", landCol = "white", borderCol = "black")
legend(-138.5, 15.5, title = "STR Group", legend = myG, col = sColors,
pch = 16, cex = 0.8, pt.cex = 1.25, box.lwd = 2)
title(main = "Lentil Diversity Panel Origins", line = 0.25, cex = 3)
title(sub = myCaption, line = 0, cex.sub = 0.75, adj = 1)
dev.off()
Genetic Structure Map
# Prep data
<- c("G1","G2","G3","G4","G5","G6","G7","G8", "Mix")
myG <- dd %>%
xx mutate(Lat = ifelse(is.na(Lat), Country_Lat, Lat),
Lon = ifelse(is.na(Lon), Country_Lon, Lon),
Lat = ifelse(duplicated(Lat), jitter(Lat, 1, 1), Lat),
Lon = ifelse(duplicated(Lon), jitter(Lon, 1, 1), Lon),
Size = 1)
# Plot png
png("lentil_diversity_panel_2_04.png", width = 3600, height = 2055, res = 600)
par(mai = c(0.2,0,0.25,0), xaxs = "i", yaxs = "i")
mapBubbles2(dF = xx, nameX = "Lon", nameY = "Lat",
nameZFill = "STR_Group",
fillPalette = alpha(sColors,0.8),
nameZSize = "Size", symbolSize = 0.2,
xlim = c(-140,110), ylim = c(5,20), lwd = 1, lwdSymbols = 0.4,
addColourLegend = F, addLegend = F,
oceanCol = "grey90", landCol = "white", borderCol = "black")
legend(-138.5, 13, title = "STR Group", legend = myG, col = sColors,
pch = 16, cex = 0.8, pt.cex = 1.5, box.lwd = 2)
title(main = "Lentil Diversity Panel Origins", line = 0.25, cex = 3)
title(sub = myCaption, line = 0, cex.sub = 0.75, adj = 1)
dev.off()
# Plot html
<- colorFactor(sColors, domain = myG)
pal <- leaflet() %>%
mp addProviderTiles(providers$CartoDB.Positron) %>%
addCircles(lng = xx$Lon, lat = xx$Lat, weight = 10,
color = pal(xx$STR_Group), opacity = 1, fillOpacity = 1,
popup = paste(xx$Entry,"|",xx$Name)) %>%
addLegend("bottomleft", pal = pal, values = xx$STR_Group,
title = "STR Group", opacity = 1)
saveWidget(mp, file="lentil_diversity_panel_2_04.html")
Genetic Structure Origin Pies
# Prep data
<- c("South America", "Central America", "Northern America",
myLevels "Western Europe", "Eastern Europe", "Southern Europe",
"Western Asia", "Central Asia",
"Northern Africa", "Eastern Africa", "Southern Asia", "Other")
<- dd %>%
x1 group_by(STR_Group, SubRegion) %>%
summarise(Count = n())
<- dd %>%
x2 group_by(SubRegion) %>%
summarise(Total = n())
<- left_join(x1, x2, by = "SubRegion") %>%
xx mutate(Percent = 100 * Count / Total) %>%
mutate(SubRegion = factor(SubRegion, levels = myLevels))
# Plot
<- ggplot(xx, aes(x = "", y = Percent, fill = STR_Group)) +
mp geom_col(color = "black", alpha = 0.7) +
coord_polar("y", start = 0) +
facet_wrap(. ~ SubRegion + paste("n =", Total), ncol = 6) +
scale_fill_manual(values = sColors) +
theme_agData_pie(legend.position = "bottom") +
guides(fill = guide_legend(nrow = 1)) +
labs(title = "Lentil Diversity Panel Origins", x = NULL,
caption = myCaption)
ggsave("lentil_diversity_panel_2_05.png", mp, width = 12, height = 6)
Genotype PCA By Structure Group
<- plot_ly(dd, x = ~myG_PC1, y = ~myG_PC2, z = ~myG_PC3, hoverinfo = "text",
mp color = ~STR_Group, colors = sColors[c(9,1:8)],
text = ~paste(Name,
"\nOrigin:", Origin,
"\nSource:", Source,
"\nCollDate:", CollDate,
"\nSTR_Group:", STR_Group,
"\nDTF_Cluster:", DTF_Cluster)) %>%
add_markers()
saveWidget(as_widget(mp), "lentil_diversity_panel_2_06.html")
DTF
DTF Cluster Pie Map
# Prep data
<- dd %>%
xx filter(!Origin %in% c("ICARDA","USDA","Unknown")) %>%
group_by(Origin, DTF_Cluster, Country_Lat, Country_Lon) %>%
summarise(Count = n()) %>%
spread(DTF_Cluster, Count) %>%
as.data.frame()
# Plot
png("lentil_diversity_panel_3_01.png", width = 3600, height = 2055, res = 600)
par(mai = c(0.2,0,0.25,0), xaxs = "i", yaxs = "i")
mapPies(dF = xx, nameX = "Country_Lon", nameY = "Country_Lat",
zColours = cColors, nameZs = c("1","2","3","4","5","6","7","8"),
xlim = c(-140,110), ylim = c(5,20), addCatLegend = F, lwd = 1,
oceanCol = "grey90", landCol = "white", borderCol = "black")
legend(-138.5, 13, title = "DTF Cluster", legend = 1:8, col = cColors,
pch = 16, cex = 0.8, pt.cex = 1.5, box.lwd = 2)
title(main = "Lentil Diversity Panel Origins", line = 0.25, cex = 3)
title(sub = myCaption, line = 0, cex.sub = 0.75, adj = 1)
dev.off()
DTF Cluster Map
# Prep data
<- dd %>%
xx mutate(Lat = ifelse(is.na(Lat), Country_Lat, Lat),
Lon = ifelse(is.na(Lon), Country_Lon, Lon),
Lat = ifelse(duplicated(Lat), jitter(Lat, 1, 1), Lat),
Lon = ifelse(duplicated(Lon), jitter(Lon, 1, 1), Lon),
Size = 1)
# Plot png
png("lentil_diversity_panel_3_02.png", width = 3600, height = 2055, res = 600)
par(mai = c(0.2,0,0.25,0), xaxs = "i", yaxs = "i")
mapBubbles2(dF = xx, nameX = "Lon", nameY = "Lat",
nameZFill = "DTF_Cluster",
fillPalette = alpha(cColors,0.8),
nameZSize = "Size", symbolSize = 0.2,
xlim = c(-140,110), ylim = c(5,20), lwd = 1, lwdSymbols = 0.4,
addColourLegend = F, addLegend = F,
oceanCol = "grey90", landCol = "white", borderCol = "black")
legend(-138.5, 13, title = "DTF Cluster", legend = 1:8, col = cColors,
pch = 16, cex = 0.8, pt.cex = 1.5, box.lwd = 2)
title(main = "Lentil Diversity Panel Origins", line = 0.25, cex = 3)
title(sub = myCaption, line = 0, cex.sub = 0.75, adj = 1)
dev.off()
# Plot html
<- colorFactor(cColors, domain = 1:8)
pal <- leaflet() %>%
mp addProviderTiles(providers$CartoDB.Positron) %>%
addCircles(lng = xx$Lon, lat = xx$Lat, weight = 10,
color = pal(xx$DTF_Cluster), opacity = 1, fillOpacity = 1,
popup = paste(xx$Entry,"|",xx$Name)) %>%
addLegend("bottomleft", pal = pal, values = xx$DTF_Cluster,
title = "DTF Cluster", opacity = 1)
saveWidget(mp, file="lentil_diversity_panel_3_02.html")
DTF PCA Clusters
From phenology paper
<- plot_ly(dd, x = ~DTF_PC1, y = ~DTF_PC2*2.5, z = ~DTF_PC3*2.5,
mp color = ~DTF_Cluster, colors = cColors, hoverinfo = "text",
text = ~paste(Name,
"\nOrigin:", Origin,
"\nSource:", Source,
"\nCollDate:", CollDate,
"\nSTR_Group:", STR_Group,
"\nDTF_Cluster:", DTF_Cluster)) %>%
add_markers()
saveWidget(as_widget(mp), "lentil_diversity_panel_3_03.html")
<- dd %>%
xx mutate(DTF_PC1 = scales::rescale(DTF_PC1),
DTF_PC2 = scales::rescale(DTF_PC2),
DTF_PC3 = scales::rescale(DTF_PC3))
<- plot_ly(dd, x = ~DTF_PC1, y = ~DTF_PC2, z = ~DTF_PC3,
mp color = ~STR_Group, colors = sColors, hoverinfo = "text",
text = ~paste(Name,
"\nOrigin:", Origin,
"\nSource:", Source,
"\nCollDate:", CollDate,
"\nSTR_Group:", STR_Group,
"\nDTF_Cluster:", DTF_Cluster)) %>%
add_markers()
saveWidget(as_widget(mp), "lentil_diversity_panel_3_04.html")
DTF Cluster Origin Pies
# Prep data
<- c("South America", "Central America", "Northern America",
myLevels "Western Europe", "Eastern Europe", "Southern Europe",
"Western Asia", "Central Asia",
"Northern Africa", "Eastern Africa", "Southern Asia", "Other")
<- dd %>%
x1 group_by(DTF_Cluster, SubRegion) %>%
summarise(Count = n())
<- dd %>%
x2 group_by(SubRegion) %>%
summarise(Total = n())
<- left_join(x1, x2, by = "SubRegion") %>%
xx mutate(Percent = 100 * Count / Total) %>%
mutate(SubRegion = factor(SubRegion, levels = myLevels))
# Plot
<- ggplot(xx, aes(x = "", y = Percent, fill = DTF_Cluster)) +
mp geom_col(color = "black", alpha = 0.7) +
coord_polar("y", start = 0) +
facet_wrap(. ~ SubRegion + paste("n =", Total), ncol = 6) +
scale_fill_manual(values = cColors) +
theme_agData_pie(legend.position = "bottom") +
guides(fill = guide_legend(nrow = 1)) +
labs(title = "Lentil Diversity Panel Origins", x = NULL,
caption = myCaption)
ggsave("lentil_diversity_panel_3_04.png", width = 12, height = 6)
Genotype PCA By DTF Clusters
From phenology paper
<- plot_ly(dd, x = ~myG_PC1, y = ~myG_PC2, z = ~myG_PC3,
mp color = ~DTF_Cluster, colors = cColors, hoverinfo = "text",
text = ~paste(Name,
"\nOrigin:", Origin,
"\nSource:", Source,
"\nCollDate:", CollDate,
"\nSTR_Group:", STR_Group,
"\nDTF_Cluster:", DTF_Cluster)) %>%
add_markers()
saveWidget(as_widget(mp), "lentil_diversity_panel_3_05.html")
Cotyledon Color
Eurasia Map
# Prep data
<- alpha(c("darkred", "darkgoldenrod2"), 0.7)
myColors <- dd %>%
xx filter(CotyledonColor %in% c("Red", "Yellow"),
%in% c("Asia","Europe","Africa")) %>%
Region mutate(Lat = ifelse(is.na(Lat), Country_Lat, Lat),
Lon = ifelse(is.na(Lon), Country_Lon, Lon),
Lat = ifelse(duplicated(Lat), jitter(Lat, 1, 1), Lat),
Lon = ifelse(duplicated(Lon), jitter(Lon, 1, 1), Lon),
Size = 1)
# Plot png
png("lentil_diversity_panel_4_01.png", width = 3600, height = 2055, res = 600)
par(mai = c(0.2,0,0.25,0), xaxs = "i", yaxs = "i")
mapBubbles2(dF = xx, nameX = "Lon", nameY = "Lat",
nameZFill = "CotyledonColor",
fillPalette = myColors,
nameZSize = "SeedMass1000",
symbolSize = 0.5, lwd = 1, lwdSymbols = 0.5,
addColourLegend = F, addLegend = F,
xlim = c(-25,110), ylim = c(15,35),
oceanCol = "grey90", landCol = "white", borderCol = "black")
legend(55, 3, title = "Cotyledon Color",
legend = c("Red", "Yellow"), col = myColors,
pch = 16, cex = 0.8, pt.cex = 1.5, box.lwd = 2)
title(main = "Lentil Diversity Panel Origins", line = 0.25, cex = 3)
title(sub = myCaption, line = 0, cex.sub = 0.75, adj = 1)
dev.off()
Mass of 1000 Seeds
# Prep data
<- c("darkred", "darkgoldenrod2")
myColors <- dd %>% filter(CotyledonColor %in% c("Red", "Yellow"))
xx # Plot
<- ggplot(xx, aes(x = CotyledonColor, y = SeedMass1000,
mp fill = CotyledonColor, size = SeedMass1000)) +
geom_quasirandom(alpha = 0.7, pch = 21, color = "black") +
scale_fill_manual(values = myColors) +
theme_agData(legend.position = "none") +
labs(title = "Lentil Diversity Panel",
y = "Mass of 1000 Seeds (g)",
x = "Cotyledon Color",
caption = myCaption)
ggsave("lentil_diversity_panel_4_02.png", mp, width = 6, height = 4)
Str Group
# Plot
<- ggplot(xx, aes(x = CotyledonColor, y = SeedMass1000,
mp fill = STR_Group, size = SeedMass1000)) +
geom_quasirandom(alpha = 0.7, pch = 21, color = "black") +
facet_grid(. ~ Region) +
scale_fill_manual(values = sColors) +
guides(size = "none") +
theme_agData() +
labs(caption = myCaption)
ggsave("lentil_diversity_panel_4_03.png", mp, width = 10, height = 4)
DTF Cluster
# Plot
<- ggplot(xx, aes(x = CotyledonColor, y = SeedMass1000,
mp fill = DTF_Cluster, size = SeedMass1000)) +
geom_quasirandom(alpha = 0.7, pch = 21, color = "black") +
facet_grid(. ~ Region) +
scale_fill_manual(values = cColors) +
guides(size = "none") +
theme_agData() +
labs(caption = myCaption)
ggsave("lentil_diversity_panel_4_04.png", mp, width = 10, height = 4)