library(magrittr)
library(reshape2)
library(bestNormalize)
library(readr)
library(ggbiplot)
library(lawstat)
library(cluster)
library(factoextra)
library(psych)

data <- read_csv("core_data.csv")

####SI1: Univariate Analysis####

#SI1.1: Raw Material Use
#Table SI.1
ftable(data$AssID, data$RawMat)

kruskal.test(data$Weight~data$RawMat)
Weight_RawMat <- describeBy(data$Weight,data$RawMat)
Weight_RawMat <- do.call("rbind", (Weight_RawMat))

Weight_RawMat <- cbind(rownames(Weight_RawMat), Weight_RawMat)

write_csv(Weight_RawMat, "Weight_RawMat.csv")
boxplot(data$Weight~data$RawMat)

#SI1.2: Reduction Intensity
kruskal.test(data$Weight~data$Site)
boxplot(data$Weight~data$Site, col = "lightgrey")
pairwise.wilcox.test(data$Weight, data$Site, p.adjust.method="BH")
Weight_Site <- describeBy(data$Weight,data$Site)
Weight_Site <- do.call("rbind", (Weight_Site))
Weight_Site <- cbind(rownames(Weight_Site), Weight_Site)
write_csv(Weight_Site, "Weight_Site.csv")

kruskal.test(data$Weight~data$Region)
boxplot(data$Weight~data$Region, col = "lightgrey")
pairwise.wilcox.test(data$Weight, data$Region, p.adjust.method="BH")
Weight_Region <- describeBy(data$Weight,data$Region)
Weight_Region <- do.call("rbind", (Weight_Region)) 
write_csv(Weight_Region, "Weight_Region.csv")

#SI1.3: Core Shaping

#flatness

kruskal.test(data$Flatness~data$Site)
boxplot(data$Flatness~data$Site, col = "lightgrey")
pairwise.wilcox.test(data$Flatness, data$Site, p.adjust.method="BH")
Flat_Site <- describeBy(data$Flatness,data$Site)
Flat_Site <- do.call("rbind", (Flat_Site)) 
Flat_Site <- cbind(rownames(Flat_Site), Flat_Site)
write_csv(Flat_Site, "Flat_Site.csv")

kruskal.test(data$Flatness~data$Region)
boxplot(data$Flatness~data$Region, col = "lightgrey")
pairwise.wilcox.test(data$Flatness, data$Region, p.adjust.method="BH")
Flat_Region <- describeBy(data$Flatness,data$Region)
Flat_Region <- do.call("rbind", (Flat_Region)) 
write_csv(Flat_Region, "Flat_Region.csv")

#elongation

kruskal.test(data$Elongation~data$Site)
boxplot(data$Elongation~data$Site, col = "lightgrey")
kruskal.test(data$Elongation~data$Region)
boxplot(data$Elongation~data$Region, col = "lightgrey")
pairwise.wilcox.test(data$Elongation, data$Region, p.adjust.method="BH")
Elong_Region <- describeBy(data$Elongation,data$Region)
Elong_Region <- do.call("rbind", (Elong_Region))
Elong_Region <- cbind(rownames(Elong_Region), Elong_Region)
write_csv(Elong_Region, "Elong_Region.csv")

#prox shape

kruskal.test(data$ProxShp~data$Site)
boxplot(data$ProxShp~data$Site, col = "lightgrey")
pairwise.wilcox.test(data$ProxShp, data$Site, p.adjust.method="BH")
PShp_Site <- describeBy(data$ProxShp,data$Site)
PShp_Site <- do.call("rbind", (PShp_Site)) 
PShp_Site <- cbind(rownames(PShp_Site), PShp_Site)
write_csv(PShp_Site, "PShp_Site.csv")

kruskal.test(data$ProxShp~data$Region)
boxplot(data$ProxShp~data$Region, col = "lightgrey")
pairwise.wilcox.test(data$ProxShp, data$Region, p.adjust.method="BH")
PShp_Region <- describeBy(data$ProxShp,data$Region)
PShp_Region <- do.call("rbind", (PShp_Region)) 
write_csv(PShp_Region, "PShp_Region.csv")

#dist shape

kruskal.test(data$DistShp~data$Site)
boxplot(data$DistShp~data$Site, col = "lightgrey")
pairwise.wilcox.test(data$DistShp, data$Site, p.adjust.method="BH")
DShp_Site <- describeBy(data$DistShp,data$Site)
DShp_Site <- do.call("rbind", (DShp_Site)) 
DShp_Site <- cbind(rownames(DShp_Site), DShp_Site)
write_csv(DShp_Site, "DShp_Site.csv")

kruskal.test(data$DistShp~data$Region)
boxplot(data$DistShp~data$Region, col = "lightgrey")
pairwise.wilcox.test(data$DistShp, data$Region, p.adjust.method="BH")
DShp_Region <- describeBy(data$DistShp,data$Region)
DShp_Region <- do.call("rbind", (DShp_Region)) 
write_csv(DShp_Region, "DShp_Region.csv")

#Scars_greater_than_5mm

kruskal.test(df3$Scars_greater_than_5mm~df3$Site)
boxplot(df3$Scars_greater_than_5mm~df3$Site, col = "lightgrey")
pairwise.wilcox.test(df3$Scars_greater_than_5mm, df3$Site, p.adjust.method="BH")
Scars_greater_than_5mm <- describeBy(df3$Scars_greater_than_5mm,df3$Site)
Scars_greater_than_5mm <- do.call("rbind", (Scars_greater_than_5mm)) 
Scars_greater_than_5mm <- cbind(rownames(Scars_greater_than_5mm), Scars_greater_than_5mm)
write_csv(Scars_greater_than_5mm, "Scars_greater_than_5mm.csv")

kruskal.test(df3$Scars_greater_than_5mm~df3$Region)
boxplot(df3$Scars_greater_than_5mm~df3$Region, col = "lightgrey")
pairwise.wilcox.test(df3$Scars_greater_than_5mm, df3$Region, p.adjust.method="BH")
Scars_greater_than_5mm_Region <- describeBy(df3$Scars_greater_than_5mm,df3$Region)
Scars_greater_than_5mm_Region <- do.call("rbind", (Scars_greater_than_5mm_Region)) 
write_csv(Scars_greater_than_5mm_Region, "Scars_greater_than_5mm_Region.csv")

#DSP

ftable(data$Site, data$DSP2)
chisq.test(data$Site, data$DSP2)
ftable(data$Region, data$DSP2)
chisq.test(data$Region, data$DSP2)

#SI1.4: Striking Platform Preparation
ftable(data$Site, data$Ptype)
chisq.test(data$Site, data$Ptype)
ftable(data$Region, data$Ptype)
chisq.test(data$Region, data$Ptype)

kruskal.test(data$PlatformWidth~data$Site)
boxplot(data$PlatformWidth~data$AssID, col = "lightgrey")
pairwise.wilcox.test(data$PlatformWidth, data$Site, p.adjust.method="BH")
PW_Site <- describeBy(data$PlatformWidth,data$Site)
PW_Site <- do.call("rbind", (PW_Site)) 
PW_Site <- cbind(rownames(PW_Site), PW_Site)
write_csv(PW_Site, "PW_Site.csv")

kruskal.test(data$PlatformWidth~data$Region)
boxplot(data$PlatformWidth~data$Region, col = "lightgrey")
pairwise.wilcox.test(data$PlatformWidth, data$Region, p.adjust.method="BH")
PW_Region <- describeBy(data$PlatformWidth,data$Site)
PW_Region <- do.call("rbind", (PW_Region)) 
write_csv(PW_Region, "PW_Region.csv")

#SI1.5: Flake Production

#IPA

kruskal.test(data$IPA~data$Site)
boxplot(data$IPA~data$Site, col = "lightgrey")
pairwise.wilcox.test(data$IPA, data$Site, p.adjust.method="BH")
IPA_Site <- describeBy(data$IPA,data$Site)
IPA_Site <- do.call("rbind", (IPA_Site)) 
IPA_Site <- cbind(rownames(IPA_Site), IPA_Site)
write_csv(IPA_Site, "IPA_Site.csv")

kruskal.test(data$IPA~data$Region)
boxplot(data$IPA~data$Region, col = "lightgrey")
pairwise.wilcox.test(data$IPA, data$Region, p.adjust.method="BH")
IPA_Region <- describeBy(data$IPA,data$Site)
IPA_Region <- do.call("rbind", (IPA_Region)) 
write_csv(IPA_Region, "IPA_Region.csv")

#elong

kruskal.test(data$ScarElong~data$Site)
boxplot(data$ScarElong~data$Site, col = "lightgrey")
pairwise.wilcox.test(data$ScarElong, data$Site, p.adjust.method="BH")
SElong_Site <- describeBy(data$ScarElong,data$Site)
SElong_Site <- do.call("rbind", (SElong_Site)) 
SElong_Site <- cbind(rownames(SElong_Site), SElong_Site)
write_csv(SElong_Site, "SElong_Site.csv")

kruskal.test(data$ScarElong~data$Region)
boxplot(data$ScarElong~data$Region, col = "lightgrey")
pairwise.wilcox.test(data$ScarElong, data$Region, p.adjust.method="BH")
SElong_Region <- describeBy(data$ScarElong,data$Site)
SElong_Region <- do.call("rbind", (SElong_Region)) 
write_csv(SElong_Region, "SElong_Region.csv")

#prox shp

kruskal.test(data$ScarProxShp~data$Site)
boxplot(data$ScarProxShp~data$Site, col = "lightgrey")
pairwise.wilcox.test(data$ScarProxShp, data$Site, p.adjust.method="BH")
SPShp_Site <- describeBy(data$ScarProxShp,data$Site)
SPShp_Site <- do.call("rbind", (SPShp_Site))
SPShp_Site <- cbind(rownames(SPShp_Site), SPShp_Site)
write_csv(SPShp_Site, "SPShp_Site.csv")

kruskal.test(data$ScarProxShp~data$Region)
boxplot(data$ScarProxShp~data$Region, col = "lightgrey")
pairwise.wilcox.test(data$ScarProxShp, data$Region, p.adjust.method="BH")
SPShp <- describeBy(data$ScarProxShp,data$Region)
SPShp_Region <- do.call("rbind", (SPShp_Region)) 
write_csv(SPShp_Region, "SPShp_Region.csv")

#dist shp

kruskal.test(data$ScarDistShp~data$Site)
boxplot(data$ScarDistShp~data$Site, col = "lightgrey")
pairwise.wilcox.test(data$ScarDistShp, data$Site, p.adjust.method="BH")
SDShp_Site <- describeBy(data$ScarDistShp,data$Site)
SDShp_Site <- do.call("rbind", (SDShp_Site)) 
SDShp_Site <- cbind(rownames(SDShp_Site), SDShp_Site)
write_csv(SDShp_Site, "SDShp_Site.csv")

kruskal.test(data$ScarDistShp~data$Region)
boxplot(data$ScarDistShp~data$Region, col = "lightgrey")
pairwise.wilcox.test(data$ScarDistShp, data$Region, p.adjust.method="BH")
SDShp <- describeBy(data$ScarDistShp,data$Region)
SDShp_Region <- do.call("rbind", (SDShp_Region)) 
write_csv(SDShp_Region, "SDShp_Region.csv")

ftable(data$Site, data$Ttype2)
chisq.test(data$Site, data$Ttype2)
ftable(data$Region, data$Ttype2)
chisq.test(data$Region, data$Ttype2)

#scar area

kruskal.test(data$ScarFaceAreaRatio~data$Site)
boxplot(data$ScarFaceAreaRatio~data$Site, col = "lightgrey")
pairwise.wilcox.test(data$ScarFaceAreaRatio, data$Site, p.adjust.method="BH")
SFAR_Site <- describeBy(data$ScarFaceAreaRatio,data$Site)
SFAR_Site <- do.call("rbind", (SFAR_Site)) 
SFAR_Site <- cbind(rownames(SFAR_Site), SFAR_Site)
write_csv(SFAR_Site, "SFAR_Site.csv")

kruskal.test(data$ScarFaceAreaRatio~data$Region)
boxplot(data$ScarFaceAreaRatio~data$Region, col = "lightgrey")
pairwise.wilcox.test(data$ScarFaceAreaRatio, data$Region, p.adjust.method="BH")
SFAR_Region <- describeBy(data$ScarFaceAreaRatio,data$Region)
SFAR_Region <- do.call("rbind", (SFAR_Region)) 
write_csv(SFAR_Region, "SFAR_Region.csv")

####SI2: Multivariate Analysis####

####SI2.1: Global Attributes####
data2 <- data.frame(data$Weight, data$MaxDimension, 
  data$AxialLength, data$ProxAxialWidth, data$MedAxialWidth, data$DistAxialWidth, data$MedThickness,
  data$Elongation, data$Flatness, data$DistShp, data$ProxShp, 
  data$PlatformWidth, data$IPA, 
  data$Scars_greater_than_5mm,
  data$DominantScarLength, data$DominantScarProxWidth, data$DominantScarMedWidth, data$DominantScarDistWidth, 
  data$ScarElong, data$ScarProxShp, data$ScarDistShp
) %>% na.omit()
vars <- data[-na.action(data2),]

cor_matrix <- cor(data2)
cor_matrix

cortest.bartlett(cor_matrix, n = nrow(data)) #Bartlett test for sphericity

BNdata <- lapply(data2, function(x) bestNormalize(x)) #normalises the data
BNdata <- data.frame(lapply(BNdata, function(x) x$x.t)) #selects the transformed data

pca1 <- prcomp(BNdata, center = T, scale. = T)
fviz_eig(pca1)
pca1$sdev
pca1$rotation
cumsum(pca1$sdev^2 / sum(pca1$sdev^2))

x <- rbind(pca1$sdev^2, cumsum(pca1$sdev^2 / sum(pca1$sdev^2)), pca1$rotation)
write.csv(x, "pca1.csv")

####SI2.2: core Shaping####

data2 <- data.frame(data$Weight, 
  data$Elongation, data$Flatness, data$DistShp) %>% na.omit()
vars <- data[-na.action(data2),]

cor_matrix <- cor(data2)
cor_matrix

cortest.bartlett(cor_matrix, n = nrow(data))

BNdata <- lapply(data2, function(x) bestNormalize(x)) #normalises the data
BNdata <- data.frame(lapply(BNdata, function(x) x$x.t)) #selects the transformed data

pca1 <- prcomp(BNdata, center = T, scale. = T)
fviz_eig(pca1)
pca1$sdev
pca1$rotation

cumsum(pca1$sdev^2 / sum(pca1$sdev^2))

x <- rbind(pca1$sdev^2, cumsum(pca1$sdev^2 / sum(pca1$sdev^2)), pca1$rotation)
write.csv(x, "pca2.csv")

Region <- factor(vars$Region, levels = c("Africa", "Arabia", "Levant"))

pc <- data.frame(pca1$x)
pc <- pc[,1:2]
q <- split(pc, Region)
r <- lapply(q, chull)

C2 <- list(rgb(0, 0.6, 0, 0.1), rgb(0.2, 0.2, 1, 0.1), rgb(1, 0, 0, 0.1))
C1 <- list(rgb(0, 0.6, 0), rgb(0.2, 0.2, 1), rgb(1, 0, 0))
C3 <- list(rgb(0, 0.6, 0, 0.5), rgb(0.2, 0.2, 1, 0.5), rgb(1, 0, 0, 0.5))
marker <- list(15, 16, 17)

#Figure 2a
pdf("regionPCA.pdf", width = 8, height = 6)
par(mar=c(5.1, 4.1, 4.1, 12.1), mfrow=c(1,1))
plot(1, type = "n", xlab = "PC1", ylab = "PC2", xlim=c(-5,4), ylim=c(-3,3.5))
abline(v=0, h=0, col="grey30", lty=5)
for(i in 1:length(q)){points(x=q[[i]]$PC1, y=q[[i]]$PC2, pch=marker[[i]], col = C3[[i]])}
for(i in 1:length(q)){polygon(q[[i]]$PC1[r[[i]]],q[[i]]$PC2[r[[i]]], col = C2[[i]], border = C1[[i]])}
for(i in 1:length(q)){points(x = mean(q[[i]]$PC1),y = mean(q[[i]]$PC2), col = C1[[i]], pch = marker[[i]], cex = 2)}
legend("topright", pch = c(15, 16, 17), col = unlist(C1), legend = c("Eastern Africa", "Arabia", "Levant")) #inset=c(-0.5,0)
dev.off()

#Figure 2b
pdf("regionboxplot.pdf", width = 4, height = 6)
par(mfrow=c(2,1), mai = c(0.1, 1, 0.1, 0.1))
boxplot(pc$PC1~Region, ylab = "PC1", col = unlist(C1), xaxt="n")
abline(h=0, lty=5, col="grey30")
boxplot(pc$PC2~Region, col = unlist(C1), ylab = "PC2", xaxt="n")
abline(h=0, lty=5, col="grey30")
dev.off()

pc <- data.frame(pca1$x)

pairwise.wilcox.test(pc$PC1, vars$Site, p.adjust.method="BH")
pairwise.wilcox.test(pc$PC1, vars$Region, p.adjust.method="BH")
pca2_pc1 <- describeBy(pc$PC1,vars$Site)
pca2_pc1 <- do.call("rbind", (pca2_pc1)) 
pca2_pc1 <- cbind(rownames(pca2_pc1), pca2_pc1)
write_csv(pca2_pc1, "pca2_pc1.csv")
pca2_pc1 <- describeBy(pc$PC1,vars$Region)
pca2_pc1 <- do.call("rbind", (pca2_pc1)) 
pca2_pc1 <- cbind(rownames(pca2_pc1), pca2_pc1)
write_csv(pca2_pc1, "pca2_pc1_reg.csv")

pairwise.wilcox.test(pc$PC2, vars$Site, p.adjust.method="BH")
pairwise.wilcox.test(pc$PC2, vars$Region, p.adjust.method="BH")
pca2_pc2 <- describeBy(pc$PC2,vars$Site)
pca2_pc2 <- do.call("rbind", (pca2_pc2)) 
pca2_pc2 <- cbind(rownames(pca2_pc2), pca2_pc2)
write_csv(pca2_pc2, "pca2_pc2.csv")
pca2_pc2 <- describeBy(pc$PC2,vars$Region)
pca2_pc2 <- do.call("rbind", (pca2_pc2)) 
pca2_pc2 <- cbind(rownames(pca2_pc2), pca2_pc2)
write_csv(pca2_pc2, "pca2_pc2_reg.csv")


####SI2.3: Flake Production####


data2 <- data.frame(data$Weight, 
  data$DistShp,
  data$IPA, 
  data$Scars_greater_than_5mm,
  data$ScarElong, data$ScarProxShp, 
  data$ScarDistShp,
  data$ScarFaceAreaRatio
) %>% na.omit()
vars <- data[-na.action(data2),]

cor_matrix <- cor(data2)
cor_matrix

cortest.bartlett(cor_matrix, n = nrow(data))

BNdata <- lapply(data2, function(x) bestNormalize(x)) #normalises the data
BNdata <- data.frame(lapply(BNdata, function(x) x$x.t)) #selects the transformed data

pca1 <- prcomp(BNdata, center = T, scale. = T)
fviz_eig(pca1)
pca1$sdev
pca1$rotation

cumsum(pca1$sdev^2 / sum(pca1$sdev^2))

write.csv(rbind(pca1$sdev^2, cumsum(pca1$sdev^2 / sum(pca1$sdev^2)), pca1$rotation), "pca3.csv")

Region <- factor(vars$Region, levels = c("Africa", "Arabia", "Levant"))

pc <- data.frame(pca1$x)
pc <- pc[,1:2]
q <- split(pc, Region)
r <- lapply(q, chull)

C2 <- list(rgb(0, 0.6, 0, 0.1), rgb(0.2, 0.2, 1, 0.1), rgb(1, 0, 0, 0.1))
C1 <- list(rgb(0, 0.6, 0), rgb(0.2, 0.2, 1), rgb(1, 0, 0))
C3 <- list(rgb(0, 0.6, 0, 0.5), rgb(0.2, 0.2, 1, 0.5), rgb(1, 0, 0, 0.5))
marker <- list(15, 16, 17)

#Figure 3a
pdf("regionPCA2.pdf", width = 8, height = 6)
par(mar=c(5.1, 4.1, 4.1, 12.1), mfrow=c(1,1))
plot(1, type = "n", xlab = "PC1", ylab = "PC2", xlim=c(-3,4.5), ylim=c(-3,4))
abline(v=0, h=0, col="grey30", lty=5)
for(i in 1:length(q)){points(x=q[[i]]$PC1, y=q[[i]]$PC2, pch=marker[[i]], col = C3[[i]])}
for(i in 1:length(q)){polygon(q[[i]]$PC1[r[[i]]],q[[i]]$PC2[r[[i]]], col = C2[[i]], border = C1[[i]])}
for(i in 1:length(q)){points(x = mean(q[[i]]$PC1),y = mean(q[[i]]$PC2), col = C1[[i]], pch = marker[[i]], cex = 2)}
legend("topright", pch = c(15, 16, 17), col = unlist(C1), legend = c("Eastern Africa", "Arabia", "Levant")) #inset=c(-0.5,0)
dev.off()

#Figure 3b
pdf("regionboxplot2.pdf", width = 4, height = 6)
par(mfrow=c(3,1), mai = c(0.1, 1, 0.1, 0.1))
boxplot(pc$PC1~Region, ylab = "PC1", col = unlist(C1), xaxt="n")
abline(h=0, lty=5, col="grey30")
boxplot(pc$PC2~Region, col = unlist(C1), ylab = "PC2", xaxt="n")
abline(h=0, lty=5, col="grey30")
boxplot(pc$PC3~Region, col = unlist(C1), ylab = "PC3", xaxt="n")
abline(h=0, lty=5, col="grey30")
dev.off()

pc <- data.frame(pca1$x)

pairwise.wilcox.test(pc$PC1, vars$Site, p.adjust.method="BH")
pairwise.wilcox.test(pc$PC1, vars$Region, p.adjust.method="BH")
pca3_pc1 <- describeBy(pc$PC1,vars$Site)
pca3_pc1 <- do.call("rbind", (pca3_pc1)) 
pca3_pc1 <- cbind(rownames(pca3_pc1), pca3_pc1)
write_csv(pca3_pc1, "pca3_pc1.csv")
pca3_pc1 <- describeBy(pc$PC1,vars$Region)
pca3_pc1 <- do.call("rbind", (pca3_pc1)) 
pca3_pc1 <- cbind(rownames(pca3_pc1), pca3_pc1)
write_csv(pca3_pc1, "pca3_pc1_reg.csv")

pairwise.wilcox.test(pc$PC2, vars$Site, p.adjust.method="BH")
pairwise.wilcox.test(pc$PC2, vars$Region, p.adjust.method="BH")
pca3_pc2 <- describeBy(pc$PC2,vars$Site)
pca3_pc2 <- do.call("rbind", (pca3_pc2)) 
pca3_pc2 <- cbind(rownames(pca3_pc2), pca3_pc2)
write_csv(pca3_pc2, "pca3_pc2.csv")
pca3_pc2 <- describeBy(pc$PC2,vars$Region)
pca3_pc2 <- do.call("rbind", (pca3_pc2)) 
pca3_pc2 <- cbind(rownames(pca3_pc2), pca3_pc2)
write_csv(pca3_pc2, "pca3_pc2_reg.csv")

pairwise.wilcox.test(pc$PC3, vars$Site, p.adjust.method="BH")
pairwise.wilcox.test(pc$PC3, vars$Region, p.adjust.method="BH")
pca3_pc3 <- describeBy(pc$PC3,vars$Site)
pca3_pc3 <- do.call("rbind", (pca3_pc3)) 
pca3_pc3 <- cbind(rownames(pca3_pc3), pca3_pc3)
write_csv(pca3_pc3, "pca3_pc3.csv")
pca3_pc3 <- describeBy(pc$PC3,vars$Region)
pca3_pc3 <- do.call("rbind", (pca3_pc3)) 
pca3_pc3 <- cbind(rownames(pca3_pc3), pca3_pc3)
write_csv(pca3_pc3, "pca3_pc3_reg.csv")

####SI2.4 Mantel####

####behaviour####
data2 <- data.frame(data$Weight, 
                  data$Elongation, 
                  data$Flatness, 
                  data$DistShp,
                  data$IPA, 
                  data$Scars_greater_than_5mm,
                  data$ScarElong, 
                  data$ScarProxShp, 
                  data$ScarDistShp,
                  data$ScarFaceAreaRatio) %>% na.omit()
vars <- data[-na.action(data2),]

BNdata <- lapply(data2, function(x) bestNormalize(x)) #normalises the data
BNdata <- data.frame(lapply(BNdata, function(x) x$x.t)) #selects the transformed data

rownames(BNdata) <- paste(vars$AssID, vars$NewID, sep="_")
BNdata <- BNdata[order(rownames(BNdata)),]

cs <- dist(data.frame(BNdata$data.Weight, BNdata$data.Elongation, BNdata$data.Flatness, BNdata$data.DistShp))
fp <- dist(data.frame(BNdata$data.Weight, BNdata$data.DistShp, BNdata$data.IPA, BNdata$data.Scars_greater_than_5mm, BNdata$data.ScarElong, BNdata$data.ScarProxShp, BNdata$data.ScarDistShp, BNdata$data.ScarFaceAreaRatio))

ibd <- list(cs = cs, fp = fp)
scale_ibd <- lapply(ibd, function(x) x/max(x))


library(raster)
library(rgdal)
library(readr)
library(HistDAWass)
library(magrittr)
library(dendextend)

####histodata####

lig1 <- raster("lig_30s_bio_1.bil")
lig12 <- raster("lig_30s_bio_12.bil")
srtm <- raster("SRTM_1km.tif")


points <- c(30,55,-15,35) #crop to area

lig1_2<- crop(lig1, points)
lig12_2<- crop(lig12, points)
srtm_2 <- crop(srtm, points)

#project rasters
lig1_3 <- projectRaster(lig1_2, crs = "+proj=merc +lon_0=0 +k=1 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs ")
lig12_3 <- projectRaster(lig12_2, crs = "+proj=merc +lon_0=0 +k=1 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs ")
srtm_3 <- projectRaster(srtm_2, crs = "+proj=merc +lon_0=0 +k=1 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs ")

#generate terrain roughness from DEM
slope2 <- terrain(srtm_3, opt='slope', unit = 'tangent', neighbours=8, filename = "slope2.tif", overwrite=T) #calculate slope from DEM
cw <- function(x){((280.5*x^5)-(58.7*x^4)-(76.8*x^3)+(51.9*x^2)+(19.6*x)+2.5)*60} #from Minetti et al. (2013)
slope3 <- cw(slope2)

ls <- list(Altitude = srtm_3, Energy = slope3, LIGTemp = lig1_3, LIGPrecip = lig12_3)

scale_fun <- function(x){(x-min(x))/(max(x)-min(x))} #scales to 0:1

sites <- data.frame(site = data$Site, E= as.numeric(data$E), N= as.numeric(data$N))
mp <- unique(sites)

mp_1 <- SpatialPointsDataFrame(mp[,c("E", "N")], mp, proj4string = CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs  ") )
mp_2 <- spTransform(mp_1, CRSobj = "+proj=merc +lon_0=0 +k=1 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs")

ls2 <- list()
length(ls2) <- length(ls)
ls3 <- list()
length(ls3) <- length(ls)
ls4 <- list()
length(ls4) <- length(ls)
stats <- list()
length(stats) <- length(ls)
stats2 <- list()
length(stats2) <- length(ls)

#this is currently set at 5km buffers; change buffer size and file output for 50km

for(i in 1:length(ls)){
  ls2[[i]] <- raster::extract(ls[[i]], mp_2, buffer=5000)
  stats[[i]] <- lapply(ls2[[i]], function (x) summary(x))
  stats2[[i]] <- do.call(rbind, lapply(lapply(stats[[i]], unlist), "[",unique(unlist(c(sapply(stats[[i]],names))))))
  rownames(stats2[[i]]) <- mp$X
  colnames(stats2[[i]]) <- paste(names(ls[i]), colnames(stats2[[i]]), sep = "_")
  #turn to integers to make it easy to merge
  library(plyr)
  ls2[[i]] <- lapply(ls2[[i]], function(x) as.integer(x))
  #turn to frequency data
  ls2[[i]] <- lapply(ls2[[i]], function(x) count(x))
  #splits out the count data from values, uses values as row names
  ls3[[i]] <- lapply(ls2[[i]], function(x) x[,1])
  ls4[[i]] <- lapply(ls2[[i]], function(x) x[,2])
  for(k in 1:length(ls4[[i]])){names(ls4[[i]][[k]]) <- ls3[[i]][[k]]}
  #aggregates the count data by value
  ls2[[i]] <- as.data.frame(do.call(rbind, lapply(lapply(ls4[[i]], unlist), "[", unique(unlist(c(sapply(ls4[[i]],names)))))))
  names(ls2[[i]]) <- unique(unlist(c(sapply(ls4[[i]],names))))
  ls2[[i]][is.na(ls2[[i]])] <- 0
  ls3[[i]] <- colSums(ls2[[i]])>0
  ls2[[i]] <- ls2[[i]][ls3[[i]]]
  ls2[[i]] <- data.frame(t(ls2[[i]]))#transpose so sites are columns
  ls3[[i]] <- as.numeric(row.names(ls2[[i]])) # row names as numbers
  ls2[[i]] <- ls2[[i]][ order(ls3[[i]]), ] # put in ascending order
  ls2[[i]] <- cumsum(ls2[[i]]) # turn to cumulative frequency
  colnames(ls2[[i]]) <- mp$X # add site names
  ls2[[i]] <- rbind(0, ls2[[i]]) # add an intial value of 0 necessary from clustering
  for(k in 1:length(ls2[[i]])){ls2[[i]][,k] <- scale_fun(ls2[[i]][,k])} # scale from 0 to 1
  ls2[[i]] <- cbind(Value = (c((sort(ls3[[i]])[1]-1), sort(ls3[[i]]))), ls2[[i]]) #df with values in col 1 and sites in rest of df
  for(k in 2:length(ls2[[i]])){ls4[[i]][[k]]<-distributionH(x=ls2[[i]]$Value, p=ls2[[i]][,k])} # create list of distributionH
  ls4[[i]] <- ls4[[i]][-1] #removes value column}
names(ls4) <- names(ls)

allhists <- list()
for(k in 1:length(ls4)){
  jistlist <- data.frame()
  for(i in 1:length(ls4[[k]])){for(z in 1:length(ls4[[k]])){jistlist[i,z] <- WassSqDistH(ls4[[k]][[i]], ls4[[k]][[z]])}}
  colnames(jistlist) <- mp$X
  row.names(jistlist) <- mp$X
  allhists[[k]] <- jistlist}
names(allhists) <- names(ls)

for (i in 1:length(allhists)) {write.csv(allhists[i], file=paste0(names(allhists)[i], "5km.csv"))}

####costpath####

mp <- data.frame(site = data$Site, E= as.numeric(data$E), N= as.numeric(data$N)) %>% unique()

mp_1 <- SpatialPointsDataFrame(mp[,c("E", "N")], mp, proj4string = CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs  ") )
mp_2 <- spTransform(mp_1, CRSobj = "+proj=merc +lon_0=0 +k=1 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs")

mp_3 <- data.frame(as.numeric(mp$E), as.numeric(mp$N))
mp_3 <- SpatialPoints(mp_3)
proj4string(mp_3) <- CRS("+proj=longlat + ellps=WGS84")
mp_3 <- project(coordinates(mp_3), "+proj=merc +lon_0=0 +k=1 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs") 

library(gdistance) # for costpath methods see package notes

altDiff <- function(x){x[2] - x[1]}
hd <- transition(ls$Altitude, altDiff, 8, symm=FALSE)
slope <- geoCorrection(hd)
adj <- adjacent(ls$Altitude, cells=1:ncell(ls$Altitude), pairs=TRUE, directions=8)
speed <- slope
speed[adj] <- 6 * exp(-3.5 * abs(slope[adj] + 0.05)) #Toblers
Conductance <- geoCorrection(speed)
costpath <- costDistance(Conductance, mp_3)
row.names(costpath) <- mp$site
colnames(costpath) <- mp$site
write.csv(costpath, "MIS5_cores_costpath.csv")

####mantel####

distances <- list(costpath = read.csv("MIS5_cores_costpath.csv"), 
                  altitude = read.csv("altitude50km.csv"), 
                  energy = read.csv("energy50km.csv"), 
                  LIGprecip = read.csv("LIGPrecip50km.csv"), 
                  LIGtemp = read.csv("LIGTemp50km.csv"), 
                  altitude5km = read.csv("altitude5km.csv"), 
                  energy5km = read.csv("energy5km.csv"), 
                  LIGprecip5km = read.csv("LIGPrecip5km.csv"), 
                  LIGtemp5km = read.csv("LIGTemp5km.csv")) # load distance matrices

names <- as.character(distances$costpath$X) # name index
distances2 <- lapply(distances, "rownames<-", names) #add row names
distances3 <- lapply(distances2, function(x) x[-1]) #remove came column
distances4 <- lapply(distances3, "colnames<-", names) # add col names


idx <- rep(1:ncol(distances4$costpath),as.vector(ftable(vars$Site)))#site index
dupdf <- lapply(distances4, function(x) x[,idx]) #mutiplies by col to match core data
dupdf2 <- lapply(dupdf, function(x) x[idx,]) #multiplies by row to match core data

distances5 <- lapply(dupdf2, function(x) as.dist(x)) #turn to distance matrices
distances6 <- lapply(distances5, function(x) x/max(x)) #scale between min-1


km50dist <- distances6[1:5] # subset 50km variables with cost path
km5dist <- distances6[c(1, 6:9)] # subset 5km variables with cost path

CS_50km <- phytools::multi.mantel(scale_ibd$cs, km50dist, nperm=9999) #mmr coreshaping/50km
write.csv(capture.output(CS_50km), "CS_50km.csv")
FP_50km <- phytools::multi.mantel(scale_ibd$fp, km50dist, nperm=9999) #mmr flakeproduction/50km
write.csv(capture.output(FP_50km), "FP_50km.csv")

CS_5km <- phytools::multi.mantel(scale_ibd$cs, km5dist, nperm=9999)#mmr coreshaping/5km
write.csv(capture.output(CS_5km), "CS_5km.csv")
FP_5km <- phytools::multi.mantel(scale_ibd$fp, km5dist, nperm=9999)#mmr flakeproduction/5km
write.csv(capture.output(FP_5km), "FP_5km.csv")