--- title: "Dhallucatus_cranialdivergence" output: pdf_document: default html_document: default --- ```{r setup, include=FALSE} knitr::opts_knit$set(root.dir = '.../Specimens', echo = FALSE) #load libraries library(rgl) library(rlang) library(geomorph) library(ggplot2) library(raster) library(vegan) library(ALA4R) library(Morpho) library(dplyr) if(!require(devtools)) install.packages("devtools") library(devtools) devtools::install_github("TGuillerme/landvR") library(landvR) ``` ```{r load data} #Import 3D coordinates from all specimens coords.3D <- t (read.csv(".../Data/NquollShapeVariation_LMcoords.csv", header = TRUE, row.names = 1)) #Convert 2D metadata into a 3D array A <- arrayspecs(coords.3D, 900, 3) dim(A) #check dimensions of 3D array (number of specimens in z) Ahead <- head(dimnames(A))[3] #specimen names #Load the classifier quollsdata <- read.csv(".../Data/NquollShapeVariation_data.csv", header=T) Data.pops <- quollsdata$Population is.factor(Data.pops) # check that it is a factor #give museum ID row names to quolls data rownames(quollsdata)<-quollsdata$Museum_ID #Rearrange coordinate names and classifier file names in the same order names_array <- dimnames(A)[[3]] names_classifier <- rownames(quollsdata) match(names_array, names_classifier) A_reorder <- A[,,match(names_classifier, names_array)] names_Areorder <- dimnames(A_reorder)[[3]] match(names_Areorder, names_classifier) #subset Dasyurus hallucatus Dhallucatuscoords <- A_reorder[,,-which(quollsdata$Population=="Other species")] Dhallucatusdata <- quollsdata[-which(quollsdata$Population=='Other species'),] Dhallucatusdata <- droplevels(Dhallucatusdata) #check that specimens ID in coords array mirror specimen ID in classifier file dimnames(Dhallucatuscoords)[[3]]==rownames(Dhallucatusdata) #retrieve vegetation type, land cover, distance to permanent water, primary productivity and elevation from spatial data of the Atlas of Living Australia and integrate in data frame Dhallgps <- data.frame(Dhallucatusdata$Latitude, Dhallucatusdata$Longitude) evariables <- c("cl620", "cl618", "el830", "el1077", "el674") retrieved.evariables <- intersect_points(Dhallgps, evariables) retrieved.evariables$vegetationTypesPresent<-as.factor(retrieved.evariables$vegetationTypesPresent) retrieved.evariables$landCover<-as.factor(retrieved.evariables$landCover) retrieved.evariables$distanceToPermanentWaterWeighted[is.na(retrieved.evariables$distanceToPermanentWaterWeighted)]<-0 retrieved.evariables$elevation[is.na(retrieved.evariables$elevation)]<-0 data.evariables <- data.frame(Dhallucatusdata$Museum_ID, Dhallucatusdata$Latitude, Dhallucatusdata$Longitude, Dhallucatusdata$Vegetation_type) levels(data.evariables$Dhallucatusdata.Vegetation_type)[levels(data.evariables$Dhallucatusdata.Vegetation_type)=="Eucalypt open forests"]<-"Eucalyptus open forest" levels(data.evariables$Dhallucatusdata.Vegetation_type)[levels(data.evariables$Dhallucatusdata.Vegetation_type)=="Eucalypt open woodlands"]<-"Eucalyptus open woodlands" levels(data.evariables$Dhallucatusdata.Vegetation_type)[levels(data.evariables$Dhallucatusdata.Vegetation_type)=="Eucalypt woodlands"]<-"Eucalyptus woodlands" levels(retrieved.evariables$vegetationTypesPresent)[levels(retrieved.evariables$vegetationTypesPresent)==""]<-"Unknown/no data" levels(retrieved.evariables$landCover)[levels(retrieved.evariables$landCover)==""]<-"Unknown/no data" data.evariables$Dhallucatusdata.Vegetation_type <- factor(data.evariables$Dhallucatusdata.Vegetation_type, levels=levels(retrieved.evariables$vegetationTypesPresent)) retrieved.evariables$vegetationTypesPresent==data.evariables$Dhallucatusdata.Vegetation_type vegtypefill <- coalesce(data.evariables$Dhallucatusdata.Vegetation_type, retrieved.evariables$vegetationTypesPresent) Dhallucatusdata$landCover <- retrieved.evariables$landCover Dhallucatusdata$distanceTowater <- retrieved.evariables$distanceToPermanentWaterWeighted Dhallucatusdata$Vegetation_type <- vegtypefill Dhallucatusdata$primprod <- retrieved.evariables$grossPrimaryProductivity20120313 Dhallucatusdata$elevation <- retrieved.evariables$elevation ``` ```{r Generalized Procrustes Analyses, extraction of climatic variables and dataframing for geomorph, include=TRUE} #Generalized Procrustes Analysis on all Dasyurus hallucatus specimens gpahallucatus<-gpagen(Dhallucatuscoords, curves = NULL, surfaces = NULL, PrinAxes = TRUE, max.iter = NULL, ProcD = TRUE, Proj = TRUE, print.progress = TRUE) #extract climatic variables (precipitation and temperature) rclim<- getData("worldclim",var="bio",res=10) #run in console rclim <- rclim[[c(1,12)]] names(rclim) <- c("Temp","Prec") lons <- Dhallucatusdata$Longitude lats <- Dhallucatusdata$Latitude coordsgps <- data.frame(lons, lats) valuestemp <- extract(rclim,coordsgps) Dhallucatusworldclim <- cbind.data.frame(coordsgps,valuestemp) #geomorph data frame gdfhallucatus <- geomorph.data.frame(gpahallucatus, Population = Dhallucatusdata$Population, Sex = Dhallucatusdata$Sex, MuseumID = Dhallucatusdata$Museum_ID, Latitude = Dhallucatusdata$Latitude, Longitude = Dhallucatusdata$Longitude, main_island = Dhallucatusdata$Island_Mainland, IBRA = Dhallucatusdata$IBRA_7_Regions, Datcoll = Dhallucatusdata$Date_collected, conservationstatus = Dhallucatusdata$Conservation_status, Aridity = Dhallucatusdata$Aridity_index, precipitation = Dhallucatusdata$Precipitation, habitat = Dhallucatusdata$Forest_habitat, vegtype = Dhallucatusdata$Vegetation_type, landcover = Dhallucatusdata$landCover, distwater = Dhallucatusdata$distanceTowater, elevation = Dhallucatusdata$elevation, climate = Dhallucatusdata$Climate_classification, ppworldclim = Dhallucatusworldclim$Prec, tempworldclim = Dhallucatusworldclim$Temp, Species = Dhallucatusdata$Species) #subtracting island specimens (small sample size for population analysis) except Groote Dhallminusisland<-Dhallucatuscoords[,,-which(Dhallucatusdata$Population=="island")] Dhalldataminusisland <- Dhallucatusdata[-which(Dhallucatusdata$Population=="island"),] Dhalldataminusisland<-droplevels(Dhalldataminusisland) #Generalized Procrustes Analysis on all Dasyurus hallucatus specimens except Dolphin island specimens gpadhallminusisland <- gpagen(Dhallminusisland, curves = NULL, surfaces = NULL, PrinAxes = TRUE, max.iter = NULL, ProcD = TRUE, Proj = TRUE, print.progress = TRUE) #extract climatic variables rclim<- getData("worldclim",var="bio",res=10) #run in console rclim <- rclim[[c(1,12)]] names(rclim) <- c("Temp","Prec") lons <- Dhalldataminusisland$Longitude lats <- Dhalldataminusisland$Latitude coordsgps <- data.frame(lons, lats) valuestemp <- extract(rclim,coordsgps) Dhallucatusworldclimminusisland <- cbind.data.frame(coordsgps,valuestemp) #dataframe for geomorph gdfhallucatusminusisland <- geomorph.data.frame(gpadhallminusisland, Population = Dhalldataminusisland$Population, Sex = Dhalldataminusisland$Sex, MuseumID = Dhalldataminusisland$Museum_ID, Latitude = Dhalldataminusisland$Latitude, Longitude = Dhalldataminusisland$Longitude, main_island = Dhalldataminusisland$Island_Mainland, IBRA = Dhalldataminusisland$IBRA_7_Regions, Datcoll = Dhalldataminusisland$Date_collected, conservationstatus = Dhalldataminusisland$Conservation_status, Aridity = Dhalldataminusisland$Aridity_index, precipitation = Dhalldataminusisland$Precipitation, habitat = Dhalldataminusisland$Forest_habitat, vegtype = Dhalldataminusisland$Vegetation_type, climate = Dhalldataminusisland$Climate_classification, ppworldclim = Dhallucatusworldclimminusisland$Prec, tempworldclim = Dhallucatusworldclimminusisland$Temp, Species = Dhalldataminusisland$Species, Dhalldataminusisland, landcover = Dhalldataminusisland$landCover, Distancetowater = Dhalldataminusisland$distanceTowater, elevation = Dhalldataminusisland$elevation) ``` ```{r test of shape and size differences associated with latitude, longitude, temperature and precipiation} # subtraction of all island specimens, data preparation Mainlanddata <- Dhallucatusdata[-which(Dhallucatusdata$Island_Mainland=="island"),] Mainlanddata <- droplevels(Mainlanddata) coordsmainland <- Dhallucatuscoords[,,-which(Dhallucatusdata$Island_Mainland=="island")] gpamainland<-gpagen(coordsmainland, curves = NULL, surfaces = NULL, PrinAxes = TRUE, max.iter = NULL, ProcD = TRUE, Proj = TRUE, print.progress = TRUE) rclimmainland<- getData("worldclim",var="bio",res=10) rclimmainland <- rclimmainland[[c(1,12)]] names(rclimmainland) <- c("Temp","Prec") lonsmain <- Mainlanddata$Longitude latsmain <- Mainlanddata$Latitude coordsgpsmain <- data.frame(lonsmain, latsmain) valuesclimmain <- extract(rclimmainland,coordsgpsmain) Dhallucatusworldclimmain <- cbind.data.frame(coordsgpsmain,valuesclimmain) gdfmainland <- geomorph.data.frame(gpamainland, Population = Mainlanddata$Population, Sex = Mainlanddata$Sex, MuseumID = Mainlanddata$Museum_ID, Latitude = Mainlanddata$Latitude, Longitude = Mainlanddata$Longitude, main_island = Mainlanddata$Island_Mainland, IBRA = Mainlanddata$IBRA_7_Regions, Datcoll = Mainlanddata$Date_collected, conservationstatus = Mainlanddata$Conservation_status, Aridity = Mainlanddata$Aridity_index, precipitation = Mainlanddata$Precipitation, habitat = Mainlanddata$Forest_habitat, vegtype = Mainlanddata$Vegetation_type,landcover = Mainlanddata$landCover, distwater = Mainlanddata$distanceTowater, elevation = Mainlanddata$elevation, climate = Mainlanddata$Climate_classification, ppworldclim = Dhallucatusworldclimmain$Prec, tempworldclim = Dhallucatusworldclimmain$Temp, primprod = Mainlanddata$primprod, Species = Mainlanddata$Species) #ProcANOVA of environmental and geophysical variables on shape (Table 2) fitshapelat<-procD.lm(gdfmainland$coords~latsmain, effect.type = "F") summary(fitshapelat) fitshapelon<-procD.lm(gdfmainland$coords~lonsmain, effect.type = "F") summary(fitshapelon) lmsizelat<-lm(gdfmainland$Csize~latsmain) anova(lmsizelat) summary(lmsizelat) lmsizelon<-lm(gdfmainland$Csize~lonsmain) anova(lmsizelon) summary(lmsizelon) fitshapetempmain <- procD.lm(gdfmainland$coords~Dhallucatusworldclimmain$Temp, effect.type = "F") summary(fitshapetempmain) fitshapeppmain <- procD.lm(gdfmainland$coords~Dhallucatusworldclimmain$Prec, effect.type = "F") summary(fitshapeppmain) lmsizetempmain <- lm(gdfmainland$Csize~Dhallucatusworldclimmain$Temp) anova(lmsizetempmain) summary(lmsizetempmain) lmsizeppmain <- lm(gdfmainland$Csize~Dhallucatusworldclimmain$Prec) anova(lmsizeppmain) summary(lmsizeppmain) fitshapedistwatermain <- procD.lm(gdfmainland$coords~Mainlanddata$distanceTowater, effect.type = "F") summary(fitshapedistwatermain) lmsizedistwatermain <- lm(gdfmainland$Csize~Mainlanddata$distanceTowater) anova(lmsizedistwatermain) summary(lmsizedistwatermain) fitshapeelevmain <- procD.lm(gdfmainland$coords~Mainlanddata$elevation, effect.type = "F") summary(fitshapeelevmain) lmsizeelevmain <- lm(gdfmainland$Csize~Mainlanddata$elevation) anova(lmsizeelevmain) summary(lmsizeelevmain) fitshapeprimprodmain <- procD.lm(gdfmainland$coords~Mainlanddata$primprod, effect.type = "F") summary(fitshapeprimprodmain) lmsizeprimprodmain <- lm(gdfmainland$Csize~Mainlanddata$primprod) anova(lmsizeprimprodmain) summary(lmsizeprimprodmain) fitshapevegtypemain <- procD.lm(gdfmainland$coords~Mainlanddata$Vegetation_type, effect.type = "F") summary(fitshapevegtypemain) lmsizevegtypemain <- lm(gdfmainland$Csize~Mainlanddata$Vegetation_type) anova(lmsizevegtypemain) ``` ```{r morphological differences between populations, exploratory analysis PCA, include=TRUE} #Principal Components Analysis on all mainland and Groote Eylandt specimens (Supplementary Figure 3) PCAminusisland <- plotTangentSpace(gdfhallucatusminusisland$coords, warpgrids = FALSE, mesh = FALSE, groups = gdfhallucatusminusisland$Population, legend = TRUE) summary(PCAminusisland) PCAminusislandplot <- plot(PCAminusisland$pc.scores[,1], PCAminusisland$pc.scores[,2], bg = gdfhallucatusminusisland$Population, pch = 21, cex = 1.5, asp = T, xlab="Principal Component 1 (24.58%)", ylab="Principal Component 2 (11.58%)") legend("topright", legend=unique(gdfhallucatusminusisland$Population), pch=19, col=unique(gdfhallucatusminusisland$Population), cex=1.3) #run in console Population <- gdfhallucatusminusisland$Population Sex <- gdfhallucatusminusisland$Sex dataPCA <- data.frame(PCAminusisland$pc.scores[,1], PCAminusisland$pc.scores[,2], Population, Sex) plotPCA <- ggplot(dataPCA, aes(x=PCAminusisland.pc.scores...1., y=PCAminusisland.pc.scores...2., colour = Population, shape = Sex)) + labs(x = "PC 1 (24.58%)", y = "PC 2 (11.58%)") + geom_point(size = 8, alpha = 0.8) + theme_bw() + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(), legend.text = element_text(size = 25), legend.title = element_text(size = 25), axis.title.x = element_text(size = 25), axis.title.y = element_text(size = 25), axis.text = element_text(size = 20), legend.justification = "center") plot(plotPCA) ``` ``` {r Figure 1 shape changes associated to PC1 and allometry, include=TRUE} #shape changes associated with PC1 (Figure 1a) mshapePC1minmax<-coordinates.difference(PCAminusisland$pc.shapes$PC1min,PCAminusisland$pc.shapes$PC1max, type = "spherical") procrustes.var.plot(PCAminusisland$pc.shapes$PC1min, PCAminusisland$pc.shapes$PC1max, col = list(grDevices::heat.colors, "black"), col.val = mshapePC1minmax[[1]][,"radius"], col.range = c(0, 0.015), pt.size = 0.5) rgl.viewpoint(180, -90, fov = 0, zoom = 0.5) rgl.snapshot(".../Analysis/Figures/Fig1_PC1variation", fmt = "png") #shape changes associated with allometry (Figure 1b) predshapesize <- shape.predictor(gpadhallminusisland$coords, x=gpadhallminusisland$Csize, Intercept = TRUE, predmin = min(gpadhallminusisland$Csize), predmax = max(gpadhallminusisland$Csize)) allomshapediff <- coordinates.difference(predshapesize$predmin, predshapesize$predmax, type = "spherical") procrustes.var.plot(predshapesize$predmin, predshapesize$predmax, col = list(grDevices::heat.colors, "black"), allomshapediff[[1]][,"radius"], col.range = c(0, 0.015), pt.size = 0.5) rgl.viewpoint(180, -90, fov = 0, zoom = 0.5) rgl.snapshot(".../Analysis/Figures/Fig1_Allometryvariation", fmt = "png") #shape changes associated with precipitation (Figure 1c) predshapepp <- shape.predictor(gpadhallminusisland$coords, x=gdfhallucatusminusisland$ppworldclim, Intercept = TRUE, predmin = min(gdfhallucatusminusisland$ppworldclim), predmax = max(gdfhallucatusminusisland$ppworldclim)) ppshapediff <- coordinates.difference(predshapepp$predmax, predshapepp$predmin, type = "spherical") procrustes.var.plot(predshapepp$predmax, predshapepp$predmin, col = list(grDevices::heat.colors, "black"), ppshapediff[[1]][,"radius"], col.range = c(0, 0.015), pt.size = 0.5) rgl.viewpoint(180, -90, fov = 0, zoom = 0.5) rgl.snapshot(".../Analysis/Figures/Fig1_ppvariation", fmt = "png") #shape changes associated with temperature predshapetemp <- shape.predictor(gpadhallminusisland$coords, x=gdfhallucatusminusisland$tempworldclim, Intercept = TRUE, predmin = min(gdfhallucatusminusisland$tempworldclim), predmax = max(gdfhallucatusminusisland$tempworldclim)) tempshapediff <- coordinates.difference(predshapetemp$predmax, predshapetemp$predmin, type = "spherical") procrustes.var.plot(predshapetemp$predmax, predshapetemp$predmin, col = list(grDevices::heat.colors, "black"), tempshapediff[[1]][,"radius"], col.range = c(0, 0.015), pt.size = 0.5) rgl.viewpoint(180, -90, fov = 0, zoom = 0.5) rgl.snapshot(".../Analysis/Figures/Fig1_tempvariation", fmt = "png") ``` ``` {r Procrustes ANOVA and pairwise comparisons between shape and centroid size means of each population, include=TRUE} #Procrustes ANOVA and pairwise comparisons between shape means of each population (Figure 2) fit1 <- procD.lm(gpadhallminusisland$coords~Dhalldataminusisland$Population, iter = 999, effect.type = "F") summary(fit1) PW1 <- pairwise(fit1, groups = Dhalldataminusisland$Population) sumPW1 <- summary(PW1, test.tpe = "dist", confidence = 0.95, stat.table = FALSE) sumPW1 #Bonferroni correction PW1.pvals <- sumPW1$pairwise.tables$P[c(2:5,8:10,14:15,20)] PW1.pvals.adj <- p.adjust(PW1.pvals, "bonferroni") PW1.pvals.adj #pairwise comparison between centroid size means of each population (Supplementary Table 2) fit2 <- procD.lm(gpadhallminusisland$Csize~Dhalldataminusisland$Population, iter = 999, effect.type = "F") summary(fit2) PW2<- pairwise(fit2, groups = Dhalldataminusisland$Population) sumPW2 <- summary(PW2, test.type = "dist", confidence = 0.95, stat.table = FALSE) sumPW2 #Are there differences in shape and size between island and mainland individuals? (Table 1 and Figure 3) fitisl <- procD.lm(gpahallucatus$coords~Dhallucatusdata$Island_Mainland, iter = 999, effect.type = "F") sumPW3 <- summary(fitisl, test.type ="dist") sumPW3 fitsizeisl <- lm(gpahallucatus$Csize~Dhallucatusdata$Island_Mainland) anova(fitsizeisl) summary(fitsizeisl) ``` ```{r calculate residual shape and test residual shape differences between populations and pairwise comparisons} #calculate residual shape fit.size <- procD.lm(f1 = coords~Csize, data = gdfhallucatusminusisland, print.progress = FALSE) main_residuals3D <- arrayspecs(fit.size$residuals, 900, 3) allom_resplusconsensus <- main_residuals3D + array(gpadhallminusisland$consensus,dim(main_residuals3D)) #Generalized Procrusted Analysis on residual shape gpares<-gpagen(allom_resplusconsensus, curves = NULL, surfaces = NULL, PrinAxes = TRUE, max.iter = NULL, ProcD = TRUE, Proj = TRUE, print.progress = TRUE) #geomorph data frame for residual shape data gdfres <- geomorph.data.frame(gpares, Population = Dhalldataminusisland$Population, Sex = Dhalldataminusisland$Sex, MuseumID = Dhalldataminusisland$Museum_ID, Latitude = Dhalldataminusisland$Latitude, Longitude = Dhalldataminusisland$Longitude, main_island = Dhalldataminusisland$Island_Mainland, IBRA = Dhalldataminusisland$IBRA_7_Regions, Datcoll = Dhalldataminusisland$Date_collected, conservationstatus = Dhalldataminusisland$Conservation_status, Aridity = Dhalldataminusisland$Aridity_index, precipitation = Dhalldataminusisland$Precipitation, habitat = Dhalldataminusisland$Forest_habitat, vegtype = Dhalldataminusisland$Vegetation_type, climate = Dhalldataminusisland$Climate_classification, Species = Dhalldataminusisland$Species, landcover = Dhalldataminusisland$landCover, Distancetowater = Dhalldataminusisland$distanceTowater) #Principal Components Analysis on residual shape labeling populations PCAres <- plotTangentSpace(gdfres$coords, warpgrids = FALSE, mesh = NULL, label = TRUE, groups = gdfres$Population, legend = FALSE) summary(PCAres) #Procrustes ANOVA of population identity on residual shape and pairwise comparisons among populations (Figure 2) fit1resshape <- procD.lm(gpares$coords~Dhalldataminusisland$Population) anova(fit1resshape) PW1resshape <- pairwise(fit1resshape, groups = Dhalldataminusisland$Population) sumPW1resshape <- summary(PW1resshape, test.type = "dist", confidence = 0.95, stat.table = FALSE) PW1resshape.pvals <- sumPW1resshape$pairwise.tables$P[c(2:5,8:10,14:15,20)] PW1resshape.pvals.adj <- p.adjust(PW1resshape.pvals, "bonferroni") PW1resshape.pvals.adj ``` ```{r Figure 2: Heat plot visualizations of mean shape differences and residual mean shape differences between between populations,and distribution map of specimens used for this Figure with populations labelled, include=TRUE} #calculate mean shapes of each population gpaPilbaracoords <- gpadhallminusisland$coords[,,which(gdfhallucatusminusisland$Population=="Pilbara")] mshapePilbara <- mshape(gpaPilbaracoords) class(mshapePilbara) <- "matrix" gpaNTcoords <- gpadhallminusisland$coords[,,which(gdfhallucatusminusisland$Population=="Northern Territory")] mshapeNT <- mshape(gpaNTcoords) class(mshapeNT) <- "matrix" gpaQLDcoords <- gpadhallminusisland$coords[,,which(gdfhallucatusminusisland$Population=="Queensland")] mshapeQLD <- mshape(gpaQLDcoords) class(mshapeQLD) <- "matrix" gpaKimberleycoords <- gpadhallminusisland$coords[,,which(gdfhallucatusminusisland$Population=="Kimberley")] mshapeKimberley <- mshape(gpaKimberleycoords) class(mshapeKimberley) <- "matrix" gpaGrootecoords <- gpadhallminusisland$coords[,,which(gdfhallucatusminusisland$Population=="Groote")] mshapeGroote <- mshape(gpaGrootecoords) class(mshapeGroote) <- "matrix" ## Calculate the pairwise interlandmark differences among population mean shapes mshapegrootekimberley <- coordinates.difference(mshapeGroote, mshapeKimberley, type = "spherical") mshapegrootePilbara <- coordinates.difference(mshapeGroote, mshapePilbara, type = "spherical") mshapegrooteNT <- coordinates.difference(mshapeGroote, mshapeNT, type = "spherical") mshapegrooteQLD <- coordinates.difference(mshapeGroote, mshapeQLD, type = "spherical") mshapeQLDpilbara <- coordinates.difference(mshapeQLD, mshapePilbara, type = "spherical") mshapeQLDNT <- coordinates.difference(mshapeQLD, mshapeNT, type = "spherical") mshapeQLDKimberley <- coordinates.difference(mshapeQLD, mshapeKimberley, type = "spherical") mshapeNTKimberley <- coordinates.difference(mshapeNT, mshapeKimberley, type = "spherical") mshapeNTPilbara <- coordinates.difference(mshapeNT, mshapePilbara, type = "spherical") mshapeKimberleyPilbara <- coordinates.difference(mshapeKimberley, mshapePilbara, type = "spherical") ## Plot each individual pair of pairwise differences relative to all the pairs of pairwise differences (absolute color range from 0 to maximum shape change in all pairwise differences) (Figure 2) procrustes.var.plot(mshapeGroote, mshapeKimberley, col = list(grDevices::heat.colors, "black"), col.val = mshapegrootekimberley[[1]][,"radius"], pt.size = 0.8, col.range = c(0, 0.0031)) rgl.viewpoint(180, -90, fov = 0, zoom = 0.5) rgl.snapshot(".../Analysis/Figures/Fig2_mshapegrootekimberley", fmt = "png") procrustes.var.plot(mshapeGroote, mshapePilbara, col = list(grDevices::heat.colors, "black"), col.val = mshapegrootePilbara[[1]][,"radius"], pt.size = 0.8, col.range = c(0, 0.0031)) rgl.viewpoint(180, -90, fov = 0, zoom = 0.5) rgl.snapshot(".../Analysis/Figures/Fig2_mshapegrootepilbara", fmt = "png") procrustes.var.plot(mshapeGroote, mshapeNT, col = list(grDevices::heat.colors, "black"), col.val = mshapegrooteNT[[1]][,"radius"], pt.size = 0.8, col.range = c(0, 0.0031)) rgl.viewpoint(180, -90, fov = 0, zoom = 0.5) rgl.snapshot(".../Analysis/Figures/Fig2_mshapegrooteNT", fmt = "png") procrustes.var.plot(mshapeGroote, mshapeQLD, col = list(grDevices::heat.colors, "black"), col.val = mshapegrooteQLD[[1]][,"radius"], pt.size = 0.8, col.range = c(0, 0.0031)) rgl.viewpoint(180, -90, fov = 0, zoom = 0.5) rgl.snapshot("...s/Analysis/Figures/Fig2_mshapegrooteQLD", fmt = "png") procrustes.var.plot(mshapeQLD, mshapePilbara, col = list(grDevices::heat.colors, "black"), col.val = mshapeQLDpilbara[[1]][,"radius"], pt.size = 0.8, col.range = c(0, 0.0031)) rgl.viewpoint(180, -90, fov = 0, zoom = 0.5) rgl.snapshot(".../Analysis/Figures/Fig2_mshapeQLDPilbara", fmt = "png") procrustes.var.plot(mshapeQLD, mshapeNT, col = list(grDevices::heat.colors, "black"), col.val = mshapeQLDNT[[1]][,"radius"], pt.size = 0.8, col.range = c(0, 0.0031)) rgl.viewpoint(180, -90, fov = 0, zoom = 0.5) rgl.snapshot(".../Analysis/Figures/Fig2_mshapeQLDNT", fmt = "png") procrustes.var.plot(mshapeQLD, mshapeKimberley, col = list(grDevices::heat.colors, "black"), col.val = mshapeQLDKimberley[[1]][,"radius"], pt.size = 0.8, col.range = c(0, 0.0031)) rgl.viewpoint(180, -90, fov = 0, zoom = 0.5) rgl.snapshot(".../Analysis/Figures/Fig2_mshapeQLDKimberley", fmt = "png") procrustes.var.plot(mshapeNT, mshapeKimberley, col = list(grDevices::heat.colors, "black"), col.val = mshapeNTKimberley[[1]][,"radius"], pt.size = 0.8, col.range = c(0, 0.0031)) rgl.viewpoint(180, -90, fov = 0, zoom = 0.5) rgl.snapshot(".../Analysis/Figures/Fig2_mshapeNTKimberley", fmt = "png") procrustes.var.plot(mshapeNT, mshapePilbara, col = list(grDevices::heat.colors, "black"), col.val = mshapeNTPilbara[[1]][,"radius"], pt.size = 0.8, col.range = c(0, 0.0031)) rgl.viewpoint(180, -90, fov = 0, zoom = 0.5) rgl.snapshot(".../Analysis/Figures/Fig2_mshapeNTPilbara", fmt = "png") procrustes.var.plot(mshapeKimberley, mshapePilbara, col = list(grDevices::heat.colors, "black"), col.val = mshapeKimberleyPilbara[[1]][,"radius"], pt.size = 0.8, col.range = c(0, 0.0031)) rgl.viewpoint(180, -90, fov = 0, zoom = 0.5) rgl.snapshot(".../Analysis/Figures/Fig2_mshapeKimberleyPilbara", fmt = "png") #RESIDUAL SHAPE COMPARISONS #calculate mean residual shapes of each population gpaPilbaracoordsres <- gpares$coords[,,which(gdfres$Population=="Pilbara")] mshapePilbarares <- mshape(gpaPilbaracoordsres) class(mshapePilbarares) <- "matrix" gpaNTcoordsres <- gpares$coords[,,which(gdfres$Population=="Northern Territory")] mshapeNTres <- mshape(gpaNTcoordsres) class(mshapeNTres) <- "matrix" gpaQLDcoordsres <- gpares$coords[,,which(gdfres$Population=="Queensland")] mshapeQLDres <- mshape(gpaQLDcoordsres) class(mshapeQLDres) <- "matrix" gpaKimberleycoordsres <- gpares$coords[,,which(gdfres$Population=="Kimberley")] mshapeKimberleyres <- mshape(gpaKimberleycoordsres) class(mshapeKimberleyres) <- "matrix" gpaGrootecoordsres <- gpares$coords[,,which(gdfres$Population=="Groote")] mshapeGrooteres <- mshape(gpaGrootecoordsres) class(mshapeGrooteres) <- "matrix" ## Calculate the pairwise interlandmark differences among population mean residual shapes mshapeGrootekimberleyres <- coordinates.difference(mshapeGrooteres, mshapeKimberleyres, type = "spherical") mshapeGrootePilbarares <- coordinates.difference(mshapeGrooteres, mshapePilbarares, type = "spherical") mshapeGrooteNTres <- coordinates.difference(mshapeGrooteres, mshapeNTres, type = "spherical") mshapeGrooteQLDres <- coordinates.difference(mshapeGrooteres, mshapeQLDres, type = "spherical") mshapeQLDpilbarares <- coordinates.difference(mshapeQLDres, mshapePilbarares, type = "spherical") mshapeQLDNTres <- coordinates.difference(mshapeQLDres, mshapeNTres, type = "spherical") mshapeQLDKimberleyres <- coordinates.difference(mshapeQLDres, mshapeKimberleyres, type = "spherical") mshapeNTKimberleyres <- coordinates.difference(mshapeNTres, mshapeKimberleyres, type = "spherical") mshapeNTPilbarares <- coordinates.difference(mshapeNTres, mshapePilbarares, type = "spherical") mshapeKimberleyPilbarares <- coordinates.difference(mshapeKimberleyres, mshapePilbarares, type = "spherical") ## Plot each individual pair of pairwise differences relative to all the pairs of pairwise differences (absolute color range from 0 to maximum shape change in all pairwise differences) (Figure 2) procrustes.var.plot(mshapeGrooteres, mshapeKimberleyres, col = list(grDevices::heat.colors, "black"), col.val = mshapeGrootekimberleyres[[1]][,"radius"], pt.size = 0.8, col.range = c(0, 0.0031)) rgl.viewpoint(180, -90, fov = 0, zoom = 0.5) rgl.snapshot(".../Analysis/Figures/Fig2_mshapeGrootekimberleyres", fmt = "png") procrustes.var.plot(mshapeGrooteres, mshapePilbarares, col = list(grDevices::heat.colors, "black"), col.val = mshapeGrootePilbarares[[1]][,"radius"], pt.size = 0.8, col.range = c(0, 0.0031)) rgl.viewpoint(180, -90, fov = 0, zoom = 0.5) rgl.snapshot(".../Analysis/Figures/Fig2_mshapeGrootepilbarares", fmt = "png") procrustes.var.plot(mshapeGrooteres, mshapeNTres, col = list(grDevices::heat.colors, "black"), col.val = mshapeGrooteNTres[[1]][,"radius"], pt.size = 0.8, col.range = c(0, 0.0031)) rgl.viewpoint(180, -90, fov = 0, zoom = 0.5) rgl.snapshot(".../Analysis/Figures/Fig2_mshapeGrooteNTres", fmt = "png") procrustes.var.plot(mshapeGrooteres, mshapeQLDres, col = list(grDevices::heat.colors, "black"), col.val = mshapeGrooteQLDres[[1]][,"radius"], pt.size = 0.8, col.range = c(0, 0.0031)) rgl.viewpoint(180, -90, fov = 0, zoom = 0.5) rgl.snapshot(".../Analysis/Figures/Fig2_mshapeGrooteQLDres", fmt = "png") procrustes.var.plot(mshapeQLDres, mshapePilbarares, col = list(grDevices::heat.colors, "black"), col.val = mshapeQLDpilbarares[[1]][,"radius"], pt.size = 0.8, col.range = c(0, 0.0031)) rgl.viewpoint(180, -90, fov = 0, zoom = 0.5) rgl.snapshot(".../Analysis/Figures/Fig2_mshapeQLDPilbarares", fmt = "png") procrustes.var.plot(mshapeQLDres, mshapeNTres, col = list(grDevices::heat.colors, "black"), col.val = mshapeQLDNTres[[1]][,"radius"], pt.size = 0.7, col.range = c(0, 0.0031)) rgl.viewpoint(180, -90, fov = 0, zoom = 0.5) rgl.snapshot(".../Analysis/Figures/Fig2_mshapeQLDNTres", fmt = "png") procrustes.var.plot(mshapeQLDres, mshapeKimberleyres, col = list(grDevices::heat.colors, "black"), col.val = mshapeQLDKimberleyres[[1]][,"radius"], pt.size = 0.8, col.range = c(0, 0.0031)) rgl.viewpoint(180, -90, fov = 0, zoom = 0.5) rgl.snapshot(".../Analysis/Figures/Fig2_mshapeQLDKimberleyres", fmt = "png") procrustes.var.plot(mshapeNTres, mshapeKimberleyres, col = list(grDevices::heat.colors, "black"), col.val = mshapeNTKimberleyres[[1]][,"radius"], pt.size = 0.8, col.range = c(0, 0.0031)) rgl.viewpoint(180, -90, fov = 0, zoom = 0.5) rgl.snapshot(".../Analysis/Figures/Fig2_mshapeNTKimberleyres", fmt = "png") procrustes.var.plot(mshapeNTres, mshapePilbarares, col = list(grDevices::heat.colors, "black"), col.val = mshapeNTPilbarares[[1]][,"radius"], pt.size = 0.8, col.range = c(0, 0.0031)) rgl.viewpoint(180, -90, fov = 0, zoom = 0.5) rgl.snapshot(".../Analysis/Figures/Fig2_mshapeNTPilbarares", fmt = "png") procrustes.var.plot(mshapeKimberleyres, mshapePilbarares, col = list(grDevices::heat.colors, "black"), col.val = mshapeKimberleyPilbarares[[1]][,"radius"], pt.size = 0.8, col.range = c(0, 0.0031)) rgl.viewpoint(180, -90, fov = 0, zoom = 0.5) rgl.snapshot(".../Analysis/Figures/Fig2_mshapeKimberleyPilbarares", fmt = "png") ###Distribution map of specimens used in this study labelled by population (Figure 2) library(ggplot2) library(ggmap) library(maps) library(ggsn) range(Dhalldataminusisland$Longitude, na.rm = TRUE, finite = TRUE) range(Dhalldataminusisland$Latitude, na.rm = TRUE, finite = TRUE) sbbox <- make_bbox(lon = Dhalldataminusisland$Longitude , lat = Dhalldataminusisland$Latitude, f = .1) base <- get_map(location=sbbox, maptype="satellit", source = "google", zoom = 7) map1 <- ggmap(base) map1 Dhallgps1 <- data.frame(Dhalldataminusisland$Population, Dhalldataminusisland$Latitude, Dhalldataminusisland$Longitude) map2 <- map1+ geom_point(data=Dhallgps1, aes(x=Dhalldataminusisland.Longitude, y=Dhalldataminusisland.Latitude, fill =Dhalldataminusisland.Population) ,pch=21, size=20, alpha=I(0.7))+ theme(legend.position = c(1,0.8), legend.justification = c(0,1), legend.key = element_blank(), legend.title = element_text(size = 20), legend.text = element_text(size = 18))+ labs(fill="Population") map2 north2 (map2, .15, .8, scale = 0.2, symbol = 1) ``` ``` {r boxplot figure, include = TRUE} #Figure 3: boxplot of centroid size for island and mainland individuals df.hallucatusislmain <- data.frame(gdfhallucatus$Csize, gdfhallucatus$main_island) islmainbplot <- ggplot(df.hallucatusislmain, aes(x = gdfhallucatus.main_island, y = gdfhallucatus.Csize, fill = gdfhallucatus.main_island)) + scale_fill_manual(values = c("gray88", "gray62")) + labs(x= NULL, y= "Centroid size", title= NULL) + geom_boxplot() + geom_point() + theme_classic() + theme(legend.position = "none", axis.text = element_text(size = 25), axis.title.y = element_text(size=25)) #boxplot of centroid size for males and females df.hallucatussex <- data.frame(gdfsex$Csize, gdfsex$Sex) Sexbplot <- ggplot(df.hallucatussex, aes(x = gdfsex.Sex, y = gdfsex.Csize, fill = gdfsex.Sex)) + scale_fill_manual(values = c("gray88", "gray62")) + labs(x= NULL, y= NULL, title= NULL) + geom_boxplot() + geom_point() + theme_classic() + theme(legend.position = "none", axis.text = element_text(size = 25), axis.text.y = element_blank()) #boxplot of centroid size for populations df.hallucatuspop <- data.frame(gdfhallucatusminusisland$Csize, gdfhallucatusminusisland$Population) Popbplot <- ggplot(df.hallucatuspop, aes(x = reorder(gdfhallucatusminusisland.Population, gdfhallucatusminusisland.Csize, FUN = median), y = gdfhallucatusminusisland.Csize, fill = gdfhallucatusminusisland.Population)) + labs(x= NULL, y= NULL, title= NULL) + geom_boxplot() + geom_point() + theme_classic() + theme(legend.position = "none", axis.text = element_text(size = 25), axis.text.y = element_blank()) + scale_x_discrete(labels=c("Groote" = "GTE", "Kimberley" = "KIM", "Pilbara"="PIL", "Queensland"="QLD", "Northern Territory"="NT")) #multiple boxplot of centroid size (Figure 3) multiplot <- function(..., plotlist = NULL, file, cols = 1, layout = NULL) { require(grid) plots <- c(list(...), plotlist) numPlots = length(plots) if (is.null(layout)) { layout <- matrix(seq(1, cols * ceiling(numPlots/cols)), ncol = cols, nrow = ceiling(numPlots/cols)) } if (numPlots == 1) { print(plots[[1]]) } else { grid.newpage() pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout)))) for (i in 1:numPlots) { matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE)) print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row, layout.pos.col = matchidx$col)) } } } multiplot(islmainbplot, Sexbplot, Popbplot, cols = 3) ``` ```{r sexual dimorphism and allometry, data preparation of size-corrected shape, include=TRUE} #first drop unknown sex and redo gpa Sexdata <- Dhallucatusdata[-which(Dhallucatusdata$Sex=="unknown"),] Sexdata <- droplevels(Sexdata) coordssex <- Dhallucatuscoords[,,-which(Dhallucatusdata$Sex=="unknown")] gpasex<-gpagen(coordssex, curves = NULL, surfaces = NULL, PrinAxes = TRUE, max.iter = NULL, ProcD = TRUE, Proj = TRUE, print.progress = TRUE) gdfsex <- geomorph.data.frame(gpasex, Population = Sexdata$Population, Sex = Sexdata$Sex, MuseumID = Sexdata$Museum_ID, Latitude = Sexdata$Latitude, Longitude = Sexdata$Longitude, main_island = Sexdata$Island_Mainland, IBRA= Sexdata$IBRA_7_Regions, Datcoll = Sexdata$Date_collected, conservationstatus = Sexdata$Conservation_status, Aridity = Sexdata$Aridity_index, precipitation = Sexdata$Precipitation, habitat = Sexdata$Forest_habitat, vegtype = Sexdata$Vegetation_type, climate = Sexdata$Climate_classification, landcover = Sexdata$landCover, Distancetowater = Sexdata$distanceTowater) #PCA with sexes labelled PCAsex <- plotTangentSpace(gdfsex$coords, warpgrids = FALSE, mesh = NULL, groups = gdfsex$Sex, legend = TRUE) summary(PCAsex) plot(PCAsex$pc.scores[,1], PCAsex$pc.scores[,2], bg = gdfsex$Sex, pch = 21, cex = 2, asp = T) legend("bottomright", legend=unique(gdfsex$Sex), pch=19, col=unique(gdfsex$Sex), cex=0.75) #Are sexes different in shape? (Table 1) fit.shapesex <- procD.lm(coords~Sex, data = gdfsex, effect.type = "F") summary(fit.shapesex) #Is there a common allometry or are there unique allometries across sexes? (Table 1) fit.sex.uni <- procD.lm(f1 = coords~Csize*Sex, data = gdfsex, effect.type = "F") summary(fit.sex.uni) #Are there shape differences between sexes there are after correcting for size? (Table 1) fit.sex <- procD.lm(f1 = coords~Csize+Sex, data = gdfsex, effect.type = "F") summary(fit.sex) #Are sexes different in Centroid Size (proxy for size)? (Table 1) lmsizesex <- lm(gdfsex$Csize~gdfsex$Sex) anova(lmsizesex) summary(lmsizesex) #Here, we extract the residuals of allometry of each specimen and we add them up to the consensus shape obtained from GPA fit.size.sex <- procD.lm(f1 = coords~Csize, data = gdfsex, print.progress = FALSE) main_residuals3D.sex <- arrayspecs(fit.size.sex$residuals, 900, 3) allom_resplusconsensus.sex <- main_residuals3D.sex + array(gpasex$consensus,dim(main_residuals3D.sex)) gparessex<-gpagen(allom_resplusconsensus.sex, curves = NULL, surfaces = NULL, PrinAxes = TRUE, max.iter = NULL, ProcD = TRUE, Proj = TRUE, print.progress = TRUE) gdfressex <- geomorph.data.frame(gparessex, Population = Sexdata$Population, Sex = Sexdata$Sex, MuseumID = Sexdata$Museum_ID, Latitude = Sexdata$Latitude, Longitude =Sexdata$Longitude) #Are sexes different in size-corrected shape? fit1resshapesex <- procD.lm(coords~Sex, data = gdfressex, effect.type = "F") summary(fit1resshapesex) #Significant size-corrected shape differences between sexes, but very little #sexual shape differences between sexes, heatplot (Supplementary Figure 4) malecoords <- gpasex$coords[,,which(gdfsex$Sex=="male")] mshapemale <- mshape(malecoords) class(mshapemale) <- "matrix" femalecoords <- gpasex$coords[,,which(gdfsex$Sex=="female")] mshapefemale <- mshape(femalecoords) class(mshapefemale) <- "matrix" mshapefemalemale <- coordinates.difference(mshapefemale, mshapemale, type = "spherical") procrustes.var.plot(mshapefemale, mshapemale, col = list(grDevices::heat.colors, "black"), col.val = mshapefemalemale[[1]][,"radius"], pt.size = 0.5, col.range = c(0, 0.015)) rgl.viewpoint(180, -90, fov = 0, zoom = 0.5) rgl.snapshot(".../Analysis/Figures/SuppFig5_sexshapechanges", fmt = "png") #size-corrected shape differences between sexes, heatplot (Supplementary Figure 4) malecoordsres <- gparessex$coords[,,which(gdfressex$Sex=="male")] mshapemaleres <- mshape(malecoordsres) class(mshapemaleres) <- "matrix" femalecoordsres <- gparessex$coords[,,which(gdfressex$Sex=="female")] mshapefemaleres <- mshape(femalecoordsres) class(mshapefemaleres) <- "matrix" mshapefemalemaleres <- coordinates.difference(mshapefemaleres, mshapemaleres, type = "spherical") procrustes.var.plot(mshapefemaleres, mshapemaleres, col = list(grDevices::heat.colors, "black"), col.val = mshapefemalemaleres[[1]][,"radius"], pt.size = 0.5, col.range = c(0, 0.015)) rgl.viewpoint(180, -90, fov = 0, zoom = 0.5) rgl.snapshot(".../Analysis/Figures/SuppFig5_sexshapechanges_res", fmt = "png") ###POPULATION ANALYSIS OF ALLOMETRY### #Is there allometry in the entire dataset and how much? (Table 1) fit.size <- procD.lm(f1 = coords~Csize, data = gdfhallucatusminusisland, print.progress = FALSE) fit.size.plot <- plotAllometry(fit.size, size = gdfhallucatusminusisland$Csize, logsz = FALSE, method = "RegScore", pch = 19, col = as.numeric(gdfhallucatusminusisland$Population)) anova(fit.size) #Figure 4: Allometry plot, shape score vs centroid size (proxy for body size) Population <- gdfhallucatusminusisland$Population Sex <- gdfhallucatusminusisland$Sex dataallometryplot <- data.frame(fit.size.plot$size.var, fit.size.plot$RegScore, Population, Sex) plotallom <- ggplot(dataallometryplot, aes(x=fit.size.plot.size.var, y=fit.size.plot.RegScore, colour = Population, shape = Sex)) + labs(x = "Centroid Size", y = "Shape Score") + geom_point(size = 8, alpha = 0.8) + theme_bw() + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(), legend.text = element_text(size = 25), legend.title = element_text(size = 25), axis.title.x = element_text(size = 25), axis.title.y = element_text(size = 25), axis.text = element_text(size = 20), legend.justification = "center") plot(plotallom) #unique allometries by population? (Table 1) fit.size.uni <- procD.lm(f1 = coords~Csize*Population, data = gdfhallucatusminusisland, print.progress = FALSE, effect.type = "F") plotAllometry(fit.size.uni, size = gdfhallucatusminusisland$Csize, logsz = FALSE, method = "RegScore", pch = 19, col = as.numeric(gdfhallucatusminusisland$Population)) anova(fit.size.uni) #common allometry across all populations, allometry-corrected shape differences between populations? (Table 1) fit.size.common<- procD.lm(f1 = coords~Csize+Population, data = gdfhallucatusminusisland, print.progress = FALSE) plotAllometry(fit.size.common, size = gdfhallucatusminusisland$Csize, logsz = FALSE, method = "RegScore", pch = 19, col = as.numeric(gdfhallucatusminusisland$Population)) legend("bottomright", legend=unique(gdfhallucatusminusisland$Population), pch=19, col=unique(gdfhallucatusminusisland$Population), cex = 1.3) summary(fit.size.common) #plot allometry labelling sexes plotAllometry(fit.size.common, size = gdfhallucatusminusisland$Csize, logsz = FALSE, method = "RegScore", pch = 19, col = as.numeric(gdfhallucatusminusisland$Sex)) legend("bottomright", legend=unique(gdfhallucatusminusisland$Sex), pch=19, col=unique(gdfhallucatusminusisland$Sex), cex = 1.3) ``` ```{r morpological disparity differences between populations, between sexes, and between island and mainland populations, include=TRUE} #morpological disparity differences between populations (Supplementary Table 3) fitpop <- procD.lm(gpadhallminusisland$coords~Dhalldataminusisland$Population, iter = 999, effect.type = "F") disparitypops <- morphol.disparity(fitpop, groups = ~ Population, data = gdfhallucatusminusisland, iter = 999) summary(disparitypops) PWpop <- pairwise(fitpop, groups = gdfhallucatusminusisland$Population) PWpop.sum <- summary(PWpop, test.type = "var") PWpop.sum$summary.table #morphological disparity differences between sexes fitsex <- procD.lm(coords~Sex, data = gdfsex, effect.type = "F") disparitysex <- morphol.disparity(fitsex, groups = ~ Sex, data = gdfsex, iter = 999) summary(disparitysex) PWsex <- pairwise(fitsex, groups = gdfsex$Sex) PWsex.sum <- summary(PWsex, test.type = "var") PWsex.sum$summary.table #morphological disparity differences between island and mainland individuals fitisl <- procD.lm(gpahallucatus$coords~Dhallucatusdata$Island_Mainland, iter = 999, effect.type = "F") disparitymainisl <- morphol.disparity(fitisl, groups= ~ main_island, data = gdfhallucatus, iter=999) summary(disparitymainisl) PWisl <- pairwise(fitisl, groups = gdfhallucatus$main_island) PWisl.sum <- summary(PWisl, test.type = "var") PWisl.sum$summary.table ``` ``` {r variation partitioning analysis on mainland specimens, include = TRUE} #Perform a PCA to overcome autocorrelation issues that may arise from geographic distances specgeodist <- data.frame(gdfmainland$Latitude,gdfmainland$Longitude) mat.specgeodist <- dist(specgeodist, method="euclidean", diag=F, upper=F) pcnm <- pcnm(mat.specgeodist) sum(pcnm$values[1:10]/sum(pcnm$values[1:24])) spat.data<-pcnm$vectors[,1:10] array2mat <- function(array,inds,vars){ if(class(array)=="matrix"){array<-array(array,dim=c(nrow(array),ncol(array),1))} X1 <-aperm(array,c(3,2,1)) dim(X1)<- c(inds, vars) if(!is.null(dimnames(array)[3])){rownames(X1)<-unlist(dimnames(array)[3])}else{rownames(X1)<-c(1:nrow(X1))} return(X1) } mymat<-array2mat(gpamainland$coords,89,2700) ### Figure 4: full variation partitioning model, from vegan library, test for constrained variation mainprectemp <- data.frame(gdfmainland$ppworldclim, gdfmainland$tempworldclim/10) matprectemp <- as.matrix(mainprectemp) matCsizemain <- gpamainland$Csize mod<-varpart(mymat,~spat.data, ~matCsizemain, ~matprectemp[,c(1:2)]) showvarparts(3, bg = c("blue", "red", "black"), Xnames=c("Geography","Size","Climate"), cex = 2, id.size = 2) plot(mod, bg = c("blue", "red", "black"), Xnames=c("Geography","Size","Climate"), cex = 2, id.size = 2) full_rda<-vegan::rda(mymat~spat.data+matprectemp[,c(1:2)]+matCsizemain)### full model geo.rda<-vegan::rda(mymat~spat.data+Condition(matprectemp[,c(1:2)])+Condition(matCsizemain))### fraction variance of the variable clim.rda.shape<-vegan::rda(mymat~matprectemp[,c(1:2)]+Condition(spat.data)+Condition(matCsizemain)) size.rda.shape<-vegan::rda(mymat~matCsizemain+Condition(spat.data)+Condition(matprectemp[,c(1:2)])) anova(full_rda) RsquareAdj(full_rda) anova(geo.rda) RsquareAdj(geo.rda) anova(clim.rda.shape) RsquareAdj(clim.rda.shape) anova(size.rda.shape) RsquareAdj(size.rda.shape) Eclim<-vegan::rda(mymat~matprectemp[,c(1:2)]) anova(Eclim) RsquareAdj(Eclim) Egeo<-vegan::rda(mymat~spat.data) anova(Egeo) RsquareAdj(Egeo) Ecsize<-vegan::rda(mymat~matCsizemain) anova(Ecsize) RsquareAdj(Ecsize) ``` ``` {r phenograms, include = TRUE} #Build phenogram based on Euclidean distances among population mean shapes (Supp. Fig. 5) CVAquollspops <- CVA(gdfhallucatusminusisland$coords, groups = gdfhallucatusminusisland$Population, weighting = TRUE, plot = TRUE, rounds = 100) Euclidist_quollspops <- CVAquollspops$Dist$GroupdistEuclid the.cluster.means <- hclust(Euclidist_quollspops, method = "average") plot(the.cluster.means) #Build phenogram based on Euclidean distances among individuals (Supp. Fig. 6) labelling populations by color Euclidist_inds <- dist(gpadhallminusisland$procD, method = "euclidean") the.cluster.inds <- as.dendrogram(hclust(Euclidist_inds, method = "average")) library(dendextend) population <- factor(gdfhallucatusminusisland$Population) n_population <- length(unique(population)) cols_4 <- colorspace::rainbow_hcl(n_population) col_population <- cols_4[population] labels_colors(the.cluster.inds) <- col_population[order.dendrogram(the.cluster.inds)] par(cex=2) plot(the.cluster.inds, main="", xlab="") ```