---
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="")


```

