---
title: "Analysis for Schauer et al: British Neolithic axe distributions and their implications"
output: html_document
---

This code requires the following libraries:

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(spatstat)
library(cluster)
library(rgdal)
library(raster)
library(maptools)
library(rgeos)
library(colorspace)
library(rcarbon)
source("r/nm.functions.R")
```

Set-up
```{r}
## Some global parameters (reduce nsim here to run a toy version)
sbw <- scalesize <- 30000 
cellres <- 2000
nsim <- 1000

## Load data
load("data/extras.rda")
myproj <- CRS("+init=epsg:27700")
stoneaxesall <- read.csv("data/stone.csv", header=TRUE, stringsAsFactors=FALSE, encoding="UTF-8",na.strings=c("NA",""),strip.white=TRUE)
coordinates(stoneaxesall) <- ~Easting+Northing
proj4string(stoneaxesall) <- proj4string(englandwales)
stoneaxesall$Basic[stoneaxesall$group %in% c("VI", "XI", "VII", "XXI")] <- "stone"
stoneaxesall$Basic[stoneaxesall$group=="flint"] <- "flint"
```


Figure 1.

```{r}
w <- as.owin(englandwales)
allaxes.ppp <- ppp(coordinates(stoneaxesall)[,1],coordinates(stoneaxesall)[,2],w)
allaxes.dens <- density(allaxes.ppp, eps=cellres, sigma=sbw, edge=FALSE)
## Plot 
tiff(file="output/figure01_densall.tiff", height = 2160, width = 1600, units = "px", compression="lzw", res=300)
par(mar=c(0.1, 0.1, 0.1, 0.1)) #c(bottom, left, top, right)
plot(englandwales, col="grey75", border="white", lwd=0.1)
plot(allaxes.dens, main="", box=FALSE, add=TRUE)
plot(englandwales, border="white", lwd=0.1, add=TRUE)
points(allaxes.ppp, pch=19, cex=0.5, col="black")
plotlim <- par("usr") 
textx <- plotlim[1]*2 
texty <- plotlim[4]*.96 
xpos <- plotlim[2]*.75 
ypos <- plotlim[4]*.8
xlimramp <- c((plotlim[2]*.8), (plotlim[2]*.85))
ylimramp <- c((plotlim[4]*.65), (plotlim[4]*.85))
legend("topright", legend=paste0("all axes (n=",nrow(stoneaxesall),")"), bty="n", cex=0.8, text.font=2, inset=c(0.05,0.05))
xmax <- max(allaxes.dens)
xticks <- seq(0,xmax,xmax/4)
xticks.text <- signif(xticks, digits=3)
xticks.text[1] <- "0" 
plot(colourmap(Kovesi$values[[29]],range=c(0,xmax)), vertical=TRUE, main="", ylim=ylimramp, xlim=xlimramp, cex.axis=0.6, las=2, add=TRUE, at=reScale(xticks,to=c(ylimramp[1],ylimramp[2])), labels=xticks.text)
lines(c(xpos,xpos),c(ypos-scalesize,ypos+scalesize),col="black")
polygon(c(xpos,xpos-(scalesize/10),xpos,xpos+(scalesize/10),xpos),c((ypos+scalesize/1.5),(ypos+scalesize/1.5),(ypos+scalesize),(ypos+scalesize/1.5),(ypos+scalesize/1.5)), col="black")
text(xpos,ypos, "N", cex=0.8, col="black", font=1)
scalebar <- (sbw/3)*5
lines(c(xpos-scalebar*.5,xpos+scalebar*.5),c(ypos-scalesize*1.5,ypos-scalesize*1.5),col="black")
text(xpos,ypos-scalesize*2, paste0(scalebar/1000,"km"), cex=0.6, col="black", font=1)

```

Figures 2 to 6.

```{r}
axetypes <- unique(stoneaxesall$group)
axetypes <- sort(axetypes)
axetypes <- c(axetypes[-which(axetypes == "flint")], axetypes[which(axetypes == "flint")])
axetypes <- c(axetypes[-which(axetypes =="other")])
labellist <- vector(mode = "list", length = length(axetypes))
for (a in 1:length(axetypes)) {
  if (axetypes[a] != "flint") {
    labellist[a] <- paste("Group ",axetypes[a]," (n=",nrow(stoneaxesall[stoneaxesall$group %in% axetypes[a],]),")",sep="" )
  } else {
    labellist[a] <- paste(axetypes[a]," (n=",nrow(stoneaxesall[stoneaxesall$group %in% axetypes[a],]),")",sep="" )
  }
}
alllabel <- paste("all axes (n=",nrow(stoneaxesall),")",sep="" )
pal1 <- rainbow_hcl(length(axetypes), start=30, end=300)
proplist1 <- vector(mode="list", length=length(axetypes))
sourceppp <- vector(mode="list", length=length(axetypes))
distmaplist <- vector(mode="list", length=length(axetypes))
brks <- seq(0,1000,50)
mids <- seq(25,975,50)
## Distance maps by stone type
for (a in 1:length(axetypes)) {
  sourceppp[[a]] <- ppp(coordinates(sources[sources$BritPetroGroup==axetypes[a],])[,1],coordinates(sources[sources$BritPetroGroup==axetypes[a],])[,2],w) 
  distmaplist[[a]] <- distmap(sourceppp[[a]],cellres)
  tmpdists <- na.omit(extract(raster(distmaplist[[a]]),stoneaxesall[stoneaxesall$group==axetypes[a],]) /1000)
  tmpalldists <- na.omit(extract(raster(distmaplist[[a]]),stoneaxesall) /1000)
  proplist1[[a]] <- data.frame(kmMidBin=mids,axesFromSource=hist(tmpdists,brks, plot=FALSE)$counts,axesAll=hist(tmpalldists,brks, plot=FALSE)$counts)
  proplist1[[a]]$percAllAxes <- proplist1[[a]]$axesFromSource / proplist1[[a]]$axesAll * 100
  proplist1[[a]][proplist1[[a]]$kmMidBin==975,"percAllAxes"] <- 0
}
labellist <- c(labellist,alllabel)
axeppp <- vector(mode = "list", length = length(axetypes))
dens <- vector(mode = "list", length = length(axetypes))
dens.prop <- vector(mode = "list", length = length(axetypes))
allaxes <- ppp(coordinates(stoneaxesall)[,1],coordinates(stoneaxesall)[,2],w)
alldens <- density(allaxes, eps=cellres, sigma=sbw, edge=FALSE)
## Intensity maps by stone type
for (a in 1:length(axetypes)) {
  subtype <- stoneaxesall[stoneaxesall$group==axetypes[a],]
  axeppp[[a]] <- ppp(x=coordinates(subtype)[,1],y=coordinates(subtype)[,2],w)
  dens[[a]] <- density(axeppp[[a]], sigma=sbw, eps=cellres, edge=FALSE)
  dens.prop[[a]] <- dens[[a]] / alldens
}
xest <- seq(0,1000,1)
predpoints.gauss <- vector(mode = "list", length = length(axetypes))
sigma.list <- vector(mode = "list", length = length(axetypes)+1)
y.list <- vector(mode = "list", length = length(axetypes)+1)
df <- rowSums(sapply(proplist1, "[[", "percAllAxes"), na.rm = FALSE)
df <- df/length(axetypes)
df <- data.frame(x=proplist1[[1]]$kmMidBin, y=df)
df <- df[!is.nan(df$y),]
fit1 <- nls(y ~ max(df$y)*exp(-1/2*(x)^2/sigma^2), start=list(sigma=250), data=df)
estall <- predict(fit1, list(x=xest))
fitall <- round(as.numeric(coef(fit1)),5)
fittext <- summary(fit1)
fitallerr <- round(fittext$coefficients[2],5)
yintall <- as.numeric(round(max(df$y),5))
## Calculate and plot 1D and 2D fall-off (note the large loop)
samplename <- "all axes"
for (a in 1:length(axetypes)){
    if (a==1){
        cat(paste("Beginning ",nsim, " simulations for each of ",length(axetypes), " stone types...\n", sep=""))
    }
    tmp <- proplist1[[a]]
    df <- data.frame(x=tmp[!is.na(tmp$percAllAxes),"kmMidBin"], y=tmp[!is.na(tmp$percAllAxes),"percAllAxes"])
    fit1 <- nls(y ~ max(df$y)*exp(-1/2*(x)^2/sigma^2),data=df, start=list(sigma=250))
    est1 <- predict(fit1, list(x=xest))
    modeltext2 <- round(as.numeric(coef(fit1)),5)
    sigma.list[a] <- modeltext2
    modeltext2 <- paste0("sigma ",  modeltext2)
    y.list[a] <- as.numeric(round(max(df$y),5))
    fittext <- summary(fit1)
    fiterr <- round(fittext$coefficients[2],5)
    pred <- distmaplist[[a]]/1000
    pred <- pred*-1
    pred <- -1/2*pred^2
    pred <- pred/coef(fit1)^2
    pred <- exp(pred)
    pred <- pred*max(df$y)
    sf <- stoneaxesall
    sf$Dist <- extract(raster(as(distmaplist[[a]],"SpatialGridDataFrame")),sf) / 1000
    sf$Prob <- extract(raster(as(pred,"SpatialGridDataFrame")),sf)
    sf <- sf[!is.na(sf$Prob),]
    for (d in 1:nsim){
        cat(paste(d,";",sep=""))
        v <- rep(NA, nrow(sf))
        for (h in 1:nrow(sf)){
            v[h] <- sample(c(TRUE,FALSE),size=1,prob=c(sf@data[h,"Prob"],abs(100-sf@data[h,"Prob"])))
        }
        pred.points <- sf[v,]
        b <- sf[!v,]
        prop1D <- data.frame(kmMidBin=mids,axesFromSource=hist(pred.points$Dist,brks, plot=FALSE)$counts,axesAll=hist(c(pred.points$Dist,b$Dist),brks, plot=FALSE)$counts)
        prop1D$percAllAxes <- prop1D$axesFromSource / prop1D$axesAll * 100
        prop1D[prop1D$kmMidBin==975,"percAllAxes"] <- 0
        if (d==1){
            allsims <- prop1D$percAllAxes
        } else {
            allsims <- rbind(allsims,prop1D$percAllAxes)
        }
    }
    for (k in 1:nrow(allsims)){
        tmp <- allsims[k,]
        tmp[which(is.na(tmp))] <- approx(tmp, xout=which(is.na(tmp)))$y
        allsims[k,] <- tmp
    }
    lo <- apply(allsims,2,quantile,prob=0.025)
    hi <- apply(allsims,2,quantile,prob=0.975) 
    tiff(file = paste0("output/figure0",a+1,"_",axetypes[a],".tiff"), height = 2160, width = 2160, units = "px", compression="lzw", res=300) 
    layout(matrix(c(1,1,1,2,3,4), 2, 3, byrow=TRUE), widths=c(2.5,2.5,2.5), heights=c(3.5,3.5))
    par(mar=c(4, 4, 1, 1))
    yscalemax <- max(round(max(estall)+5,-1), round(max(proplist1[[a]]$percAllAxes[!is.na(proplist1[[a]]$percAllAxes)])+5,-1))
    if (yscalemax > 100) { ymax <- 100 } 
    plot(proplist1[[a]]$km[!is.na(proplist1[[a]]$percAllAxes)],proplist1[[a]]$percAllAxes[!is.na(proplist1[[a]]$percAllAxes)], type="l", xlab="km from source", ylab=paste0("% of ",samplename), col=pal1[a], lwd=2, ylim=c(0,yscalemax), xlim=c(0,800), cex.axis=0.6, mgp=c(2,1,0), cex.lab=0.8)
    polygon(x=c(mids,rev(mids),mids[1]),y=c(lo,rev(hi),lo[1]), col="grey75", border=NA)
    lines(proplist1[[a]]$km[!is.na(proplist1[[a]]$percAllAxes)],proplist1[[a]]$percAllAxes[!is.na(proplist1[[a]]$percAllAxes)], col=pal1[a], lwd=2)
    lines(xest,est1, lty="dotted", lwd=0.5)
    lines(xest,estall, lty=2, lwd=1, col="grey50")
    legend("topright", col=c(pal1[a],"black", "grey50"), legend=c(labellist[a], paste0("fitted  (",modeltext2,", y-intercept ",y.list[a], ")"), paste0("mean (sigma ",fitall,", y-intercept ", yintall,")")), lwd=c(2,1,1), bty="n", cex=0.8, lty=c(1,3,2))
    plotlim<-par("usr")
    textx <- plotlim[1]*.60 
    texty <- plotlim[4]*.95 
    text(textx, texty, labels="A")
    par(mar=c(0.1, 0.1, 0.1, 0.1))
    plot(englandwales, border="white")
    image(dens[[a]], add=TRUE)
    points(axeppp[[a]], pch=19, cex=0.3, col="grey50")
    points(sourceppp[[a]],pch=5, col="black", cex=1)
    plot(englandwales, border="white", lwd=0.1, add=TRUE)
    if (axetypes[a] == "flint") {
        legend("topright", legend=paste0("observed \n",axetypes[a]), bty="n", cex=0.8, text.font=2, inset=c(0.05,0))
    } else {
        legend("topright", legend=paste0("observed \nGroup ",axetypes[a]), bty="n", cex=0.8, text.font=2, inset=c(0.05,0))
    }
    plotlim<-par("usr")
    textx <- plotlim[1]*2 
    texty <- plotlim[4]*.95 
    xpos <- plotlim[2]*.75
    ypos <- plotlim[4]*.75
    xlimramp <- c((plotlim[2]*.8), (plotlim[2]*.85))
    ylimramp <- c((plotlim[4]*.6), (plotlim[4]*.8))
    text(textx, texty, labels="B")
    xmax <- max(dens[[a]])
    xticks <- seq(0,xmax,xmax/4)
    xticks.text <- signif(xticks, digits=3)
    xticks.text[1] <- "0"
    plot(colourmap(Kovesi$values[[29]],range=c(0,xmax)), vertical=TRUE, main="", ylim=ylimramp, xlim=xlimramp, cex.axis=0.6, las=2, add=TRUE, at=reScale(xticks,to=c(ylimramp[1],ylimramp[2])), labels=xticks.text)
    nm.northarrow()
    subtypeproptc <- nm.colourful(dens.prop[[a]])
    plot(englandwales, border="white")
    image(dens.prop[[a]], add=TRUE, col=subtypeproptc)
    points(axeppp[[a]], pch=19, cex=0.3, col="grey50")
    points(sourceppp[[a]],pch=5, col="black", cex=1)
    plot(englandwales, border="black", add=TRUE, lwd=0.5)
    if (axetypes[a] == "flint") {
        legend("topright", legend=paste0("observed proportion\n",axetypes[a]), bty="n", cex=0.8, text.font=2, inset=c(0.05,0))
    } else {
        legend("topright", legend=paste0("observed proportion\nGroup ",axetypes[a]), bty="n", cex=0.8, text.font=2, inset=c(0.05,0))
    }
    text(textx, texty, labels="C")
    xmax <- max(dens.prop[[a]])
    xticks <- seq(0,xmax,xmax/4)
    xticks.text <- paste0(round(100*xticks,digits=2),"%")
    xticks.text[1] <- "0"
    colramp <- nm.rybcolourmap(c(0,xmax), sealevel=xmax/2)
    colscale <- colourmap(col=attr(colramp,"stuff")$outputs, breaks=attr(colramp,"stuff")$breaks)
    plot(colscale, vertical=TRUE, main="", ylim=ylimramp, xlim=xlimramp, cex.axis=0.6, las=2, add=TRUE, at=reScale(xticks,to=c(ylimramp[1],ylimramp[2])), labels=xticks.text)
    nm.northarrow()
    pred.ppp <- ppp(x=coordinates(pred.points)[,1],y=coordinates(pred.points)[,2],w)
    pred.dens <- density(pred.ppp, sigma=sbw, eps=cellres, edge=FALSE)
    pred.prop <- pred.dens / alldens
    subtypeproptc <- nm.colourful(pred.prop)
    plot(englandwales, border="white")
    image(pred.prop, add=TRUE, col=subtypeproptc)
    points(pred.points,pch=19,cex=0.3, col="grey50")
    plot(englandwales, border="black", add=TRUE, lwd=0.5)
    if (axetypes[a] == "flint") {
        legend("topright", legend=paste0("simulated proportion\n", axetypes[a]), bty="n", cex=0.8, text.font=2, inset=c(0.05,0.03))
    } else {
        legend("topright", legend=paste0("simulated proportion\nGroup ", axetypes[a]), bty="n", cex=0.8, text.font=2, inset=c(0.05,0.03))
    }
    text(textx, texty, labels="D")
    xmax <- max(pred.prop)
    xticks <- seq(0,xmax,xmax/4)
    xticks.text <- paste0(round(100*xticks,digits=2),"%")
    xticks.text[1] <- "0"
    colramp <- nm.rybcolourmap(c(0,xmax), sealevel=xmax/2)
    colscale <- colourmap(col=attr(colramp,"stuff")$outputs, breaks=attr(colramp,"stuff")$breaks)
    plot(colscale, vertical=TRUE, main="", ylim=ylimramp, xlim=xlimramp, cex.axis=0.6, las=2, add=TRUE, at=reScale(xticks,to=c(ylimramp[1],ylimramp[2])), labels=xticks.text)
    nm.northarrow()
    dev.off()
    cat("\n")
}
sigma.list[a + 1] <- fitall
y.list[a + 1] <- yintall
save(predpoints.gauss,sigma.list,y.list, file="output/nm.falloff.rda")
```

Figure 7.

```{r}
alllabel <- paste("all axes (n=",nrow(stoneaxesall),")",sep="" )
allaxes.ppp <- ppp(coordinates(stoneaxesall)[,1],coordinates(stoneaxesall)[,2],w)
allaxes.dens <- density(allaxes.ppp, eps=cellres, sigma=sbw, edge = FALSE)
axetypes <- unique(stoneaxesall$macrogroup)
axetypes <- sort(axetypes)
axetypes <- c(axetypes[-which(axetypes == "flint/chert")], axetypes[which(axetypes == "flint/chert")])
axetypes <- c(axetypes[-which(axetypes == "other")], axetypes[which(axetypes == "other")])
pal1 <- rainbow_hcl(length(axetypes), start=30, end=300)
proplist <- vector(mode = "list", length = length(axetypes))
pointlist <- vector(mode = "list", length = length(axetypes))
for (a in 1:length(axetypes)) {
  pointlist[[a]] <- ppp(coordinates(stoneaxesall[stoneaxesall$macrogroup==axetypes[a],])[,1],coordinates(stoneaxesall[stoneaxesall$macrogroup==axetypes[a],])[,2],w)
  tmpdens <- density(pointlist[[a]], eps=cellres, sigma=sbw, edge=FALSE)
  proplist[[a]] <- tmpdens / allaxes.dens
}
axeclusters <- length(axetypes)
Allims <- stack(lapply(proplist,raster))
allims.val <- getValues(Allims)
allims.nona <- which(!is.na(allims.val))
allims.val <- na.omit(allims.val)
set.seed(123)
E <- kmeans(allims.val, axeclusters, iter.max=100, nstart=10)
axekmeans <- raster(Allims)
axekmeans[allims.nona] <- E$cluster
axekmeansp <- rasterToPolygons(raster(as(axekmeans,"SpatialPixelsDataFrame")), dissolve=TRUE)
proj4string(axekmeansp) <- myproj
stoneaxesall$axekmeans <- as.numeric(over(stoneaxesall,axekmeansp)[,1])
axesbycluster <- data.frame(Group=axetypes, SortCol=1:length(axetypes))
for (a in 1:axeclusters) {
  tmp <- as.data.frame(table(stoneaxesall@data[stoneaxesall$axekmeans==a & !is.na(stoneaxesall$axekmeans),"macrogroup"]), stringsAsFactors=FALSE)
  names(tmp) <- c("Group",paste0("C",a))
  axesbycluster <- merge(axesbycluster,tmp, by="Group", all.x=TRUE)
}
axesbycluster[is.na(axesbycluster)] <- 0
axesbycluster <- axesbycluster[with(axesbycluster, order(SortCol)), ]
axesbycluster$SortCol <- NULL
tmp <- as.character(axesbycluster$Group)
axesbycluster <- as.data.frame(t(axesbycluster[,2:ncol(axesbycluster)]), stringsAsFactors=FALSE)
names(axesbycluster) <- tmp
axesbycluster
## Plot
tiff(file="output/figure07_kmeans.tiff", height = 2160, width = 3840, units="px", compression="lzw", res=300) 
layout(matrix(c(1,2,2,3,3,1,4,4,5,5,1,6,6,7,7,1,8,9,10,11), 4, 5, byrow=TRUE), widths=c(4,1,1,1,1), heights=c(2,2,2,2))
par(mar=c(4, 4, 1, 1))
plot(englandwales, border="white")
image(axekmeans, col=gray.colors(axeclusters), add=TRUE)
plot(englandwales, border="black", add=TRUE, lwd=0.5)
for (a in 1:length(pointlist)) {
  points(pointlist[[a]], pch=19, cex=0.2, col="grey10")
}
lineoff <- 18000
lineoff2 <- 14000
for (a in 1:length(sourceslist)) {
  points(sourceslist[[a]], pch=19, cex=1, col=pal1[a])  
}
loc<-c(sourceslist[[1]][1,]@coords[1]-4000, sourceslist[[1]][1,]@coords[2]+70000)
text(x=loc[1], y=loc[2], labels=LETTERS[1], col=pal1[1], cex=3, font=2)
for (a in 1:length(sourceslist[[1]])) {
  segments(x0=loc[1], y0=loc[2]-lineoff, x1=sourceslist[[1]][a,]@coords[1], y1=sourceslist[[1]][a,]@coords[2], lty=1, col=pal1[1]) 
}
loc<-c(sourceslist[[2]][1,]@coords[1]-60000, sourceslist[[2]][1,]@coords[2] )
text(x=loc[1], y=loc[2], labels=LETTERS[2], col=pal1[2], cex=3, font=2)
for (a in 1:length(sourceslist[[2]])) {
  segments(x0=loc[1]+lineoff2, y0=loc[2], x1=sourceslist[[2]][a,]@coords[1], y1=sourceslist[[2]][a,]@coords[2], lty=1, col=pal1[2]) 
}
loc<-c(sourceslist[[3]][1,]@coords[1]-55000, sourceslist[[3]][1,]@coords[2]+40000)
text(x=loc[1], y=loc[2], labels=LETTERS[3], col=pal1[3], cex=3, font=2)
for (a in 1:length(sourceslist[[3]])) {
  segments(x0=loc[1]+lineoff2, y0=loc[2], x1=sourceslist[[3]][a,]@coords[1], y1=sourceslist[[3]][a,]@coords[2], lty=1, col=pal1[3]) 
}
loc<-c(sourceslist[[4]][1,]@coords[1]-75000, sourceslist[[4]][1,]@coords[2]+30000)
text(x=loc[1], y=loc[2], labels=LETTERS[4], col=pal1[4], cex=3, font=2)
for (a in 1:length(sourceslist[[4]])) {
  segments(x0=loc[1]+lineoff, y0=loc[2], x1=sourceslist[[4]][a,]@coords[1], y1=sourceslist[[4]][a,]@coords[2], lty=1, col=pal1[4]) 
}
loc<-c(sourceslist[[5]][1,]@coords[1], sourceslist[[5]][1,]@coords[2]-65000)
text(x=loc[1], y=loc[2], labels=LETTERS[5], col=pal1[5], cex=3, font=2)
for (a in 1:length(sourceslist[[5]])) {
  segments(x0=loc[1], y0=loc[2]+lineoff, x1=sourceslist[[5]][a,]@coords[1], y1=sourceslist[[5]][a,]@coords[2], lty=1, col=pal1[5]) 
}
for (a in 1:axeclusters) {
  text(coordinates(axekmeansp[axekmeansp$layer==a,]), as.character(a), font=2, col="black", cex=2.5)
}
save(axekmeans,axekmeansp, file="output/nm.axekmeansp.rda")
axelist <- LETTERS[1:length(axetypes)]
axelabels <- c("A. Cornwall (I, II, IV, XVI, XVII)", "B. Cumbria (VI, XI)", "C. Wales North (VII, XXI)", "D. Wales South (VIII)", "E. flint/chert", "F. other")
text(500000, 650000, paste0(axelabels,collapse="\n"), font=2, cex=1, adj=c(0,NA))
for (a in 1:axeclusters) {
  barplot(height=as.numeric(axesbycluster[a,]), names.arg=axelist, col=c(pal1[1:length(axetypes)]), border=NA, cex.axis=0.8, cex.names=0.8)
  mtext(as.character(a), side=3, line=-2, font=2, adj=1, cex=1.2, col="grey25")
}
axeclusters.b <- c(2,3,4,8)
for (a in 1:length(axeclusters.b)) {
    set.seed(123)
    E <- kmeans(allims.val, axeclusters.b[a], iter.max=100, nstart=10)
    axekmeans <- raster(Allims)
    axekmeans[allims.nona] <- E$cluster
    axekmeansp <- rasterToPolygons(raster(as(axekmeans,"SpatialPixelsDataFrame")), dissolve=TRUE)
    proj4string(axekmeansp) <- myproj
    stoneaxesall$axekmeans <- as.numeric(over(stoneaxesall,axekmeansp)[,1])
    par(mar=c(0.1, 0.1, 0.1, 0.1))
    plot(englandwales, border="white")
    image(axekmeans, col=gray.colors(axeclusters.b[a]), add=TRUE)
    plot(englandwales, border="black", add=TRUE, lwd=0.5)
    text(500000, 650000, paste0(axeclusters.b[a]," clusters"), font=2, cex=1, adj=c(0,NA))
}
dev.off()
```

Figure 8.

```{r}
## For simplicity, we do not reproduce the processing behind this figure, only the resulting SPDs and final output. However the radiocarbon dates for this are taken mostly from Bevan et al 2017, while extra mine dates are published by Edinborough et al (in press, Radiocarbon)
hinterland <- 1000
BCstart <- -6500
BCend <- -1500
toMatchM <- c("GB","GBF")
minename <- c("stone","flint")
cols <- c("#00a7b9","#ff7d00")
cols2 <- gray.colors(length(toMatchM), start=0.5, end=0.6)
## Plot
tiff(file="output/figure08_stoneflintspd.tiff", height=1024, width=1920, units="px", compression="lzw", res=300) 
layout(matrix(c(1,3,2,3), 2, 2, byrow=TRUE), widths=c(2,1), heights=c(0.5,0.5,1))
par(mar=c(3,0,0,0))
for (a in 1:length(toMatchM)) {
  ymax <- max(minedatesenv[[a]]$hi)
  plot(1, ylim=c(0,ymax * 1.05), xlim=c(BCstart,BCend), yaxt='n', xaxt='n')
  mxspd <- 1950 - minedatesenv[[a]]$calBP
  lo <-datesbwsenv[[a]]$lo
  hi <- datesbwsenv[[a]]$hi
  hi <- hi/(max(hi)/ymax)
  lo <- lo/(max(lo)/ymax)
  polygon(x=c(mxspd,rev(mxspd)),y=c(lo,rev(hi)),border=NA,col="grey75")
  lo <- minedatesenv[[a]]$lo
  hi <- minedatesenv[[a]]$hi
  polygon(x=c(mxspd,rev(mxspd)),y=c(lo,rev(hi)),border=NA,col=cols[a])
  meandatesbwsspd[[a]] <- meandatesbwsspd[[a]]/(max(meandatesbwsspd[[a]])/ymax)
  lines(mxspd, meandatesbwsspd[[a]], lty = 1, col = cols2[a], lwd=1)
  lines(mxspd, meanspd[[a]], lty = "dotted", col = "black", lwd=1)
  legend(x = "topleft", legend = c(minelabellist[a],hinterlabellist[a]), col = c(cols[a], cols2[a]), lty = 1, lwd = c(1, 2), cex = 0.6, bg = "white")
  box(lty = "solid", col = "black")
  xticks <- seq(BCstart, BCend, 500)
  axis(side = 1, at = xticks, labels = xticks, las = 2, cex.axis = 0.6)
}
par(mar=c(0, 0, 0, 0))
plot(englandwales, col="grey75", border="grey40") 
points(stoneaxesall[stoneaxesall$Basic %in% minename[1],], col=cols[1], pch=19, cex=0.1)
points(stoneaxesall[stoneaxesall$Basic %in% minename[2],], col=cols[2], pch=19, cex=0.1)
points(plotminedates[[1]], col="grey25" , bg=cols[1], pch=21, cex=1)
points(plotminedates[[2]], col="grey25" , bg=cols[2], pch=21, cex=1)
legend("topright", legend=c("dated stone sources", "dated flint sources", "stone axes", "flint axes"),  cex=0.5, text.font=1, bty="n", inset=c(0.05,0.02), pch=c(21,21,20,20), col=c("grey25","grey25",cols), pt.bg=cols, pt.cex = 0.9,)
plotlim <- par("usr")
xpos <- plotlim[2]*.75
ypos <- plotlim[4]*.8
lines(c(xpos,xpos),c(ypos-scalesize,ypos+scalesize),col="black")
polygon(c(xpos,xpos-(scalesize/10),xpos,xpos+(scalesize/10),xpos),c((ypos+scalesize/1.5),(ypos+scalesize/1.5),(ypos+scalesize),(ypos+scalesize/1.5),(ypos+scalesize/1.5)), col="black")
text(xpos,ypos, "N", cex=0.8, col="black", font=1)
scalebar <- (sbw/3)*5
lines(c(xpos-scalebar*.5,xpos+scalebar*.5),c(ypos-scalesize*1.5,ypos-scalesize*1.5),col="black")
text(xpos,ypos-scalesize*2, paste0(scalebar/1000,"km"), cex=0.6, col="black", font=1)
dev.off()
```

Figure 9 and Table 2.

```{r}
BCstart <- -4100
BCend <- -3400
dates.ppp <- ppp(x=coordinates(datelocations)[,1], y=coordinates(datelocations)[,2], w)
dates.dens <- density(dates.ppp, eps=cellres, sigma=sbw, edge=FALSE)
datelabel <- paste0("dates ",BCstart, " to ", BCend, " (n=", npoints(dates.ppp),")")
enclosures <- read.csv("data/enclosures.csv", header=TRUE, stringsAsFactors=FALSE, encoding="UTF-8",na.strings=c("NA",""),strip.white=TRUE)
coordinates(enclosures) <- ~Easting+Northing
proj4string(enclosures) <- proj4string(englandwales)
enc.ppp <- ppp(x=coordinates(enclosures)[,1], y=coordinates(enclosures)[,2], w)
enc.dens <- density(enc.ppp, sigma=sbw, eps=cellres, edge=FALSE)
load("output/nm.axekmeansp.rda")
## Plot
tiff(file="output/figure09_densdatesenclosures.tiff", height=2160, width=3200, units="px", compression="lzw", res=300)
layout(matrix(c(1,2), 1, 2, byrow=TRUE), widths=c(1,1), heights=c(1,1))
par(mar=c(0.1, 0.1, 0.1, 0.1)) 
plot(englandwales, col="grey75", border="white", lwd=0.1)
plot(dates.dens, main="", box=FALSE, add=TRUE)
plot(englandwales, border="white", lwd=0.1, add=TRUE)
points(dates.ppp, pch=19, cex=0.5, col="black")
plot(axekmeansp, lty = "solid", add = TRUE, border="white") 
for (a in 1:length(axekmeansp$layer)) {
  if (a == 1) { text(coordinates(axekmeansp[axekmeansp$layer==a,]), as.character(a), font=2, col="white", cex=1.5, adj=c(-1,0)) }
  else {
    text(coordinates(axekmeansp[axekmeansp$layer==a,]), as.character(a), font=2, col="white", cex=1.5)
  }
}
plotlim <- par("usr")
textx <- plotlim[1]*2 
texty <- plotlim[4]*.96 
xpos <- plotlim[2]*.75 
ypos <- plotlim[4]*.8
xlimramp <- c((plotlim[2]*.8), (plotlim[2]*.85))
ylimramp <- c((plotlim[4]*.65), (plotlim[4]*.85))
text(textx, texty, labels="A")
legend("topright", legend=datelabel, bty="n", cex=0.8, text.font=2, inset=c(0.05,0.05), pch=19, col="black")
xmax <- max(dates.dens)
xticks <- seq(0,xmax,xmax/4)
xticks.text <- signif(xticks, digits=3)
xticks.text[1] <- "0"
plot(colourmap(Kovesi$values[[29]],range=c(0,xmax)), vertical=TRUE, main="", ylim=ylimramp, xlim=xlimramp, cex.axis=0.6, las=2, add=TRUE, at=reScale(xticks,to=c(ylimramp[1],ylimramp[2])), labels=xticks.text)
nm.northarrow()
plot(englandwales, border="white", lwd=0.1)
image(enc.dens, add=TRUE)
points(enc.ppp, pch=1, cex=0.8, col="black")
plot(axekmeansp, lty = "solid", add = TRUE, border="white") 
for (a in 1:length(axekmeansp$layer)) {
  if (a == 1) { text(coordinates(axekmeansp[axekmeansp$layer==a,]), as.character(a), font=2, col="white", cex=1.5, adj=c(-1,0)) }
  else {
    text(coordinates(axekmeansp[axekmeansp$layer==a,]), as.character(a), font=2, col="white", cex=1.5)
  }
}
text(textx, texty, labels="B")
legend("topright", legend=paste0("enclosures (n=",npoints(enc.ppp),")"), bty="n", cex=0.8, text.font=2, inset=c(0.05,0.05), pch=1, col="black")
xmax <- max(enc.dens)
xticks <- seq(0,xmax,xmax/4)
xticks.text <- signif(xticks, digits=3)
xticks.text[1] <- "0"
plot(colourmap(Kovesi$values[[29]],range=c(0,xmax)), vertical=TRUE, main="", ylim=ylimramp, xlim=xlimramp, cex.axis=0.6, las=2, add=TRUE, at=reScale(xticks,to=c(ylimramp[1],ylimramp[2])), labels=xticks.text)
nm.northarrow()
dev.off()

## Table 2.
axeclusters <- 6
allaxes.ppp <- ppp(coordinates(stoneaxesall)[,1],coordinates(stoneaxesall)[,2],w)
datacollection <- data.frame(matrix(ncol=6, nrow=axeclusters + 1))
colnames(datacollection) <- c("cluster", "axecount", "datecount", "dateaxeppm", "enccount", "encaxeppm")
## Address each axe cluster in turn
for (a in 1:axeclusters) {
  datacollection$cluster[a] <- a
  wax <- as.owin(axekmeansp[a,])
  tmpaxe <- stoneaxesall[!is.na(over(stoneaxesall, axekmeansp[a,])[,1]), ]
  datacollection$axecount[a] <- nrow(tmpaxe)
  tmpaxe.ppp <- ppp(x=coordinates(tmpaxe)[,1],y=coordinates(tmpaxe)[,2],wax)
  tmpaxe.ppp <- rescale(tmpaxe.ppp, 1000)
  tmpdates <- datelocations[!is.na(over(datelocations, axekmeansp[a,])[,1]), ]
  datacollection$datecount[a] <- length(tmpdates)
  tmpdate.ppp <- ppp(x=coordinates(tmpdates)[,1],y=coordinates(tmpdates)[,2],wax)
  tmpdate.ppp <- rescale(tmpdate.ppp, 1000)
  tmpdate.dens <- density(tmpdate.ppp, sigma=sbw/1000, eps=cellres/1000, edge=FALSE)
  ppmresult <- ppm(tmpaxe.ppp ~ tmpdate.dens)
  testresult <- summary(ppmresult)
  labelresult <- paste(nm.sig(testresult$coefs.SE.CI$Zval[2]), testresult$coefs.SE.CI$Ztest[2], sep = " ")
  datacollection$dateaxeppm[a] <- labelresult
  tmpenc <- enclosures[!is.na(over(enclosures, axekmeansp[a,])[,1]), ]
  datacollection$enccount[a] <- nrow(tmpenc)
  tmpenc.ppp <- ppp(x=coordinates(tmpenc)[,1],y=coordinates(tmpenc)[,2],wax)
  tmpenc.ppp <- rescale(tmpenc.ppp, 1000)
  tmpenc.dens <- density(tmpenc.ppp, sigma=sbw/1000, eps=cellres/1000, edge=FALSE)
  ppmresult <- ppm(tmpaxe.ppp ~ tmpenc.dens)
  testresult <- summary(ppmresult)
  labelresult <- paste(nm.sig(testresult$coefs.SE.CI$Zval[2]), testresult$coefs.SE.CI$Ztest[2], sep = " ")
  datacollection$encaxeppm[a] <- labelresult
}
a <- a+1
datacollection$cluster[a] <- "all"
datacollection$axecount[a] <- nrow(stoneaxesall)
datacollection$datecount[a] <- length(datelocations)
datacollection$enccount[a] <- nrow(enclosures)
tmpaxes <- rescale(allaxes.ppp,1000)
enc.ppp <- ppp(x=coordinates(enclosures)[,1],y=coordinates(enclosures)[,2],w)
enc.ppp <- rescale(enc.ppp, 1000)
enc.dens <- density(enc.ppp, sigma=sbw/1000, eps=cellres/1000, edge=FALSE)
ppmresult <- ppm(tmpaxes ~ enc.dens)
testresult <- summary(ppmresult)
labelresult <- paste(nm.sig(testresult$coefs.SE.CI$Zval[2]), testresult$coefs.SE.CI$Ztest[2], sep = " ")
datacollection$encaxeppm[a] <- labelresult
tmpdates <- rescale(dates.ppp,1000)
tmpdates <- density(tmpdates, sigma=sbw/1000, eps=cellres/1000, edge=FALSE)
ppmresult <- ppm(tmpaxes ~ tmpdates)
testresult <- summary(ppmresult)
labelresult <- paste(nm.sig(testresult$coefs.SE.CI$Zval[2]), testresult$coefs.SE.CI$Ztest[2], sep = " ")
datacollection$dateaxeppm[a] <- labelresult
names(datacollection) <- c("Cluster", "AxeCount", "DateCount", "zDatesVsAxes", "EnclosureCount", "zEncsVsAxes")
write.csv(datacollection,file="output/figure09_table2.csv", row.names=FALSE, na="")
```

Figure 10 and Table 3.

```{r}
## Table 3
axetypes <- unique(stoneaxesall$group)
axetypes <- sort(axetypes)
axetypes <- c(axetypes[-which(axetypes == "flint")], axetypes[which(axetypes == "flint")])
axetypes <- c(axetypes[-which(axetypes =="other")])
b <- 6 # number of axe clusters
sourceppp <- vector(mode="list", length=length(axetypes))
distmaplist <- vector(mode="list", length=length(axetypes))
for (a in 1:length(axetypes)) {
  sourceppp[[a]] <- ppp(coordinates(sources[sources$BritPetroGroup==axetypes[a],])[,1],coordinates(sources[sources$BritPetroGroup==axetypes[a],])[,2],w) 
  distmaplist[[a]] <- distmap(sourceppp[[a]],cellres)/1000
}
decaysrast <- vector(mode="list", length=length(axetypes))
for (a in 1:length(axetypes)) {
  decaysrast[[a]] <- raster(nm.decay(distmaplist[[a]],ymax=as.numeric(y.list[a]),s=as.numeric(sigma.list[a])))
}
vardecays <- brick(decaysrast)
names(vardecays) <- axetypes
c1 <- length(axetypes)+1
meandecaysrast <- vector(mode="list", length=length(axetypes))
for (a in 1:length(axetypes)) {
  meandecaysrast[[a]] <- raster(nm.decay(distmaplist[[a]],ymax=as.numeric(y.list[c1]),s=as.numeric(sigma.list[c1])))
}
meandecays <- brick(meandecaysrast)
names(meandecays) <- axetypes
stoneaxesall$Region <- extract(axekmeans, stoneaxesall)
obsaxes <- stoneaxesall
tmp <- extract(meandecays[[1]], obsaxes)
obsaxes <- obsaxes[!is.na(tmp),]
nrow(stoneaxesall)
nrow(obsaxes)
obsaxes$MacroGroup <- obsaxes$group
obsaxes@data <- obsaxes@data[,c("ArtefactID","Region","MacroGroup"),drop=FALSE]
obdivs <- as.data.frame.matrix(xtabs(~Region + MacroGroup, data=obsaxes[,2:3]))
round(obdivs$other / rowSums(obdivs)*100,1)
obdivs <- obdivs[,axetypes]
obdivstats <- round(apply(obdivs, 1, "nm.simpson"),4)
set.seed(123)
randomfinds <- nm.simFinds(obsaxes, obsaxes$MacroGroup, toinclude=axetypes, nsim=nsim, model="random")
set.seed(123)
meandecayfinds <- nm.simFinds(obsaxes, obsaxes$MacroGroup, toinclude=axetypes, decaymaps=meandecays, nsim=nsim, model="decay")
set.seed(123)
vardecayfinds <- nm.simFinds(obsaxes, obsaxes$MacroGroup, toinclude=axetypes, decaymaps=vardecays, nsim=nsim, model="decay")
statsdf <- as.data.frame(matrix(ncol=b+1, nrow=4), stringsAsFactors=FALSE)
names(statsdf) <- c(paste("Region",1:b),"Rsq")
row.names(statsdf) <- c("Observed", "Random", "Average Distance Decay", "Variable Distance Decay")
randomdivs <- nm.regDiversity(randomfinds, "Region", toinclude=axetypes, divtype="nm.simpson")
statsdf[1,1:b] <- obdivstats
statsdf[2,1:b] <- round(apply(randomdivs,2,mean),4)
meandecaydivs <- nm.regDiversity(meandecayfinds, "Region", toinclude=axetypes, divtype="nm.simpson")
statsdf[3,1:b] <- round(apply(meandecaydivs,2,mean),4)
vardecaydivs <- nm.regDiversity(vardecayfinds, "Region", toinclude=axetypes, divtype="nm.simpson")
statsdf[4,1:b] <- round(apply(vardecaydivs,2,mean),4)
statsdf[2,b+1] <- cor(as.numeric(statsdf[1,1:b]), as.numeric(statsdf[2,1:b]))
statsdf[3,b+1] <- cor(as.numeric(statsdf[1,1:b]), as.numeric(statsdf[3,1:b]))
statsdf[4,b+1] <- cor(as.numeric(statsdf[1,1:b]), as.numeric(statsdf[4,1:b]))
write.csv(statsdf, file="output/figure10_table3stats.csv", row.names=TRUE)
pvaldf <- statsdf
pvaldf[] <- NA
for (a in 1:ncol(randomdivs)){
  pvaldf[1,a] <- nm.pfromrank(obdivstats[a],randomdivs[,a])
}
for (a in 1:ncol(meandecaydivs)){
  pvaldf[2,a] <- nm.pfromrank(obdivstats[a],meandecaydivs[,a])
}
for (a in 1:ncol(vardecaydivs)){
  pvaldf[3,a] <- nm.pfromrank(obdivstats[a],vardecaydivs[,a])
}
write.csv(pvaldf, file="output/figure10_table3p.csv", row.names=TRUE)

## Figure 10 
endatesbyregion <- extract(raster(dates.dens), axekmeansp)
dateregion <- unlist(lapply(endatesbyregion,median,na.rm=TRUE))
resids <- as.numeric(obdivstats - statsdf[4,1:b])
residmod <- lm(dateregion~resids)
tiff(file="output/figure10_sim.tiff", height=2160, width=1920, units="px", compression="lzw", res=300)
plot(resids, dateregion, xlab="Model 3 residuals", ylab="Median Radiocarbon Intensity", pch=19, cex=0.9, xlim=c(-0.25,0.25))
text(resids[c(1:b)], dateregion[c(1:b)], paste("Region", c(1:b)), cex=0.6, adj=c(1.2))
abline(residmod, lty="dotted", col="grey50", lwd=2)
plotlim<-par("usr")
text((plotlim[1]*.9), (plotlim[4]*.95), paste("intercept: ",formatC(coef(residmod)[1], format="e", digits=2),sep=""), font=3, cex=0.8, col="grey50", pos=4)
text((plotlim[1]*.9), (plotlim[4]*.92), paste("slope: ",formatC(coef(residmod)[2], format="e", digits=2),sep=""), font=3, cex=0.8, col="grey50", pos=4)
text((plotlim[1]*.9), (plotlim[4]*.89), paste("r2: ",round(summary(residmod)$r.squared,2),sep=""), font=3, cex=0.8, col="grey50",pos=4)
dev.off()
```

Figure 11.
```{r}
stonecols <- c("#00a7b9","#ff7d00")
## Plot
tiff(file="output/figure11_pottery.tiff", height=2160, width=3200, units="px", compression="lzw", res=300)
layout(matrix(c(1,2), 1, 2, byrow=TRUE), widths=c(1,1), heights=c(1,1))
par(mar=c(0.1, 0.1, 0.1, 0.1))
plot(englandwales, border="white", lwd=0.1, col="grey75")
col.trans1 <- adjustcolor("khaki1", alpha = 0.5) 
plot(potteryzones[[1]], lty = "solid", add = TRUE, border=NA, col=col.trans1) 
col.trans2 <- adjustcolor("darkolivegreen1", alpha = 0.5) 
plot(potteryzones[[2]], lty = "solid", add = TRUE, border=NA, col=col.trans2) 
points(stonesources, pch=19, cex=1.2, col=stonecols[1])
points(flintsources, pch=19, cex=1.2, col=stonecols[2])
text(x=coordinates(potteryzones[[1]])[,1], y=coordinates(potteryzones[[1]])[,2] * .8, "Style I-1a", col="grey25", cex=1.2)
text(coordinates(potteryzones[[2]]), "Style I-2a", col="grey25", cex=1.2)
legend("topright", legend=c("stone sources", "flint sources"), bty="n", cex=0.8, text.font=1, inset=c(0.05,0.05), col=stonecols, pch=19, title="3900-3650 BCE")
plotlim <- par("usr")
xpos <- plotlim[2]*.75
ypos <- plotlim[4]*.8
textx <- plotlim[1]*2 
texty <- plotlim[4]*.96 
text(textx, texty, labels="A")
nm.northarrow()
plot(englandwales, border="white", lwd=0.1, col="grey75")
col.trans1 <- adjustcolor("khaki1", alpha = 0.5) 
plot(potteryzones[[4]], lty = "solid", add = TRUE, border=NA, col=col.trans1) 
col.trans2 <- adjustcolor("darkolivegreen1", alpha = 0.5) 
plot(potteryzones[[3]], lty = "solid", add = TRUE, border=NA, col=col.trans2) 
col.trans3 <- adjustcolor("grey50", alpha = 0.5) 
plot(potteryzones[[5]], lty = "solid", add = TRUE, border=NA, col=col.trans3) 
points(stonesources, pch=19, cex=1.2, col=stonecols[1])
points(flintsources, pch=19, cex=1.2, col=stonecols[2])
text(coordinates(potteryzones[[4]]), "Style II-1", col="grey25", cex=1.2)
text(coordinates(potteryzones[[3]]), "Style II-2", col="grey25", cex=1.2)
text(coordinates(potteryzones[[5]]), "Style I-2a", col="grey25", cex=1.2)
legend("topright", legend=c("stone sources", "flint sources"), bty="n", cex=0.8, text.font=1, inset=c(0.05,0.05), col = stonecols, pch = 19, title = "3650-3200 BCE")
plotlim <- par("usr")
nm.northarrow()
dev.off()
```

