#Unraveling the Spatial Imprint of Hominin and Carnivore Accumulations in Early Pleistocene African Sites
#Amanda Merino-Pelaz, Lucía Cobo-Sánchez, Elia Organista, Enrique Baquedano, Manuel Domínguez-Rodrigo

#Libraries
library("spatstat")
library("sparr")
library("ggcorrplot")
library("FactoMineR")
library("factoextra")

#Set working directory

setwd("C:/Users/")


#OPEN SITE

w<-read.table(file="flkn12_w.txt",header=TRUE) #select txt with window's coordinates
s<-read.table(file="flkn12.txt",header=TRUE) #select txt with site's coordinates
w<-owin(poly=list(list(x=w$x, y=w$y)))
site<-ppp(s$x,s$y,window=w,marks=factor(s[,3]))
plot(site,cols=c("red","blue"),cex=0.3,pch=19,main="")

#Subset point pattern to obtain ppp of bones and lithics separately.
bones<-subset(site, marks=="B")
lithics<-subset(site,marks=="L")
plot(bones,legend=FALSE,cols="red",cex=0.3,pch=19,main="Bones")
plot(lithics,legend=FALSE,cols="blue",cex=0.3,pch=19,main="Lithics")


#1. EXPLORATORY ANALYSIS
#1.1.Inhomogeneity and spatially varying intensity estimation

#Hopkins-Skelam index. Performed by applying the Cumulative Distribution Function method for edge correction and indicating “clustered” as the alternative hypothesis.
hopskel.test(site,correction="cdf",alternative="clustered")#CSR: A=1. Agglomerative pattern: A<1. Regular pattern: A>1

#Kernel estimation of intensity
D1<-density(site,sigma=bw.ppl,diggle=TRUE, eps=0.1,positive=TRUE) #eps=0.1 to improve resolution
plot(D1)

#Relative risk maps
h0 <- OS(site, nstar="geometric")
rr1<-risk(bones,lithics,h0=h0,adapt=TRUE,tolerate=TRUE,hp=OS(site)/2,pilot.symmetry="pooled",davies.baddeley=0.05)
plot(rr1)
rr2<-risk(lithics,bones,h0=h0,adapt=TRUE,tolerate=TRUE,hp=OS(site)/2,pilot.symmetry="pooled",davies.baddeley=0.05)
plot(rr2)


#Inhomogeneous pair-correlation function
d<-density(site,bw.ppl,adjust=2,positive=TRUE)
p<-pcfinhom(site,d,nlarge=Inf)
plot(p)
myP<-function(X,...){
  d<-density(X,bw.ppl,adjust=2,positive=TRUE)
  Pi<-pcfinhom(X,bo,...)
  return(Pi)
}
EP<-envelope(site, myP, simulate=expression(rpoispp(d)),nsim=39)
plot(EP,lwd=2)
plot(EP, . - mmean~ r, lwd=2)

#1.2. Overall interdependence and association types among remains

#Mean nearest-neighbor distances
mean(nndist(site))
#Nearest-neighbor correlation
nncorr(site)#Performed only on the overall multitype point pattern

#Mark connection function
MC<-alltypes(site, markconnect)
plot(MC)

#2. MEASURE SPATIAL VARIABLES FROM MAIN HIGH-DENSITY AREAS

#1. Detection of significant high-density areas

sk<-bw.ppl(site)
shak<-sharpen(site,sigma=sk,edgecorrect = TRUE)
LRk<-scanLRTS(site,r=2*bw.ppl(site))
pvalsk<-eval.im(pchisq(LRk,df=1,lower.tail=FALSE))
plot(shak,main="",pch=".",cex=2)
plot(LRk)
plot(pvalsk<0.05, col=c("white", "cadetblue3"))
plot(site, pch=20, add=TRUE)
plot(w,add=TRUE)

#2. Creation of point pattern with main hign-density area (HDA)
#Cluster polygonal window

hda<-clickpoly(add=TRUE,col=2,type="l") #Draw area of main HDA

saveRDS(hda,"hda.rds")

hda<-readRDS("hda.rds")
plot(hda,col=3)

hda$bdry
v<-hda$bdry[[1]]
tpK<-cbind(v$x,v$y)
head(tpK)
 
write.table(tpK,file="hda.txt")

#add header to table in Excel

setwd("C:/Users/")
clA<-read.table(file="hda.txt",header=TRUE)
clAw<-owin(poly=list(list(x=clA$X, y=clA$Y)))
plot(clAw)

#Distinction of points inside and outside the HDA

clus1points<-which(inside.owin(x=site$x,y=site$y,w=cluster))
clus2points<-which(inside.owin(x=site$x,y=site$y,w=w))
npoints(site)
clus1index<-rep(NA,npoints(site))
clus1index[clus2points]<-"OUT"
clus1index[clus1points]<-"IN"

clus <- cbind(s,clus1index)#s is the original table of the site with the remains and its coordinates
names(clus)
saveRDS(clus,"clus.rds")

#New point pattern with the HDA points
mcl<-clus[,4]
CK<-ppp(clus$x,clus$y,window=clAw,marks=mcl)
CK<-as.ppp(CK)
plot(CK)

#Point pattern of centroid

CK_IN <- clus[(clus$clus1index=='IN'),]
OK<-ppp(mean(CK_IN$x),mean(CK_IN$y),window=clAw)
plot(OK)


#3. Calculations. Both the digitalization of high-density areas (HDAs) and the calculations of their measurements can also be done in a GIS.

#Area of HDA
a<-area(clAw)#area HDA
a
A<-area(site)#area site
A

#Diameter
d<-diameter(clAw)#diameter HDA
d
D<-diameter(w) #diameter site's window
D

#Perimeter
p<-perimeter(clAw)#perimeter HDA
p
P<-perimeter(site)#Perimeter site's window
P

#Perimeter/Diameter HDA
p/d

#Length and breadth of polygon window
plot(clAw)
xK<-locator(n=2,type="l") #click two points to measure the length of the HDA
XK<-xK$x
XK

l1K<-XK[[2]]-XK[[1]]
l1K

yK<-locator(n=2,type="l") #click two points to measure the breadth of the HDA

YK<-yK$y
YK

l2K<-YK[[1]]-YK[[2]]
l2K


#Ratio length / breadth
l2K/l1K

#Mean distance from points to boundary of window
distb<-mean(bdist.points(CK))
distb*100/d


#Mean distance from points inside the HDA to centroid
N<-nncross(CK,OK)
distc<-mean(NK$dist)
distc*100/d


#Mean intensity inside and outside the HDA (difference)
I_INK<-intensity(unmark(CK))#intensity of the HDA
I_INK
I_TOTK<-intensity(unmark(site))#intensity of the site
I_INK/I_TOTK


#Mean distance to nearest neighbors
n<-mean(nndist(CK))
n*100/d


#Number of neighbor HDAs
plot(pvalsk<0.05)#Count number of neighbor HDAs
clusterK1 <- clickpoly(add=TRUE,col=2,type="l")

#Number of peaks inside main HDA
Xk<-unique(site,rule="deldir")
adenK<-adaptive.density(Xk,f=0.1,nrep=30) 
plot(adenK)
persp(density(site,bw.ppl(site)))



#3. HIERARCHICAL CLUSTERING ON PRINCIPAL COMPONENTS

#read tables with high-density area parameters
O<-read.table("overall.txt", header=TRUE)
B<-read.table("bones1.txt", header=TRUE) #with hunter-gatherers
B2<-read.table("bones2.txt", header=TRUE) #without hunter-gatherers
L<-read.table("lithics.txt", header=TRUE)

res.pca1 <- PCA(O, graph = FALSE)
res.hcpc1 <- HCPC(res.pca1, nb.clust=4, graph = FALSE)

res.pca2 <- PCA(B, graph = FALSE)
res.hcpc2 <- HCPC(res.pca2, nb.clust=4, graph = FALSE)

res.pca3 <- PCA(B2, graph = FALSE)
res.hcpc3 <- HCPC(res.pca3, nb.clust=5, graph = FALSE)

res.pca4 <- PCA(L, graph = FALSE)
res.hcpc4 <- HCPC(res.pca4, nb.clust=3, graph = FALSE)

#Plot dendrograms and cluster maps
fviz_dend(res.hcpc1, 
cex = 0.7,                     
palette = "npg",               
rect = TRUE, rect_fill = TRUE, 
rect_border = "jco",           
labels_track_height = 0.8      
)

fviz_cluster(res.hcpc1,
             repel = TRUE,            
             show.clust.cent = TRUE, 
             palette = "npg",         
             ggtheme = theme_minimal(),
             main = "Factor map"
)

fviz_dend(res.hcpc2, 
          cex = 0.7,                     
          palette = "npg",               
          rect = TRUE, rect_fill = TRUE, 
          rect_border = "jco",           
          labels_track_height = 0.8      
)

fviz_cluster(res.hcpc2,
             repel = TRUE,            
             show.clust.cent = TRUE, 
             palette = "npg",         
             ggtheme = theme_minimal(),
             main = "Factor map"
)

fviz_dend(res.hcpc3, 
          cex = 0.7,                     
          palette = "npg",               
          rect = TRUE, rect_fill = TRUE, 
          rect_border = "jco",          
          labels_track_height = 0.8     
)

fviz_cluster(res.hcpc3,
             repel = TRUE,           
             show.clust.cent = TRUE,
             palette = "npg",        
             ggtheme = theme_minimal(),
             main = "Factor map"
)

fviz_dend(res.hcpc4, 
          cex = 0.7,                     
          palette = "npg",               
          rect = TRUE, rect_fill = TRUE, 
          rect_border = "jco",          
          labels_track_height = 0.8      
)

fviz_cluster(res.hcpc4,
             repel = TRUE,           
             show.clust.cent = TRUE, 
             palette = "npg",        
             ggtheme = theme_minimal(),
             main = "Factor map"
)


#Quantitative variables that describe the most each cluster:
res.hcpc1$desc.var$quanti
res.hcpc2$desc.var$quanti
res.hcpc3$desc.var$quanti
res.hcpc4$desc.var$quanti


#Correlation variables-dimensions:
res.hcpc1$var$cor
res.hcpc2$var$cor
res.hcpc3$var$cor
res.hcpc4$var$cor