#############################################################################
#### R-code for all the plots in the article ################################
#### LIA csv files: Shang_LIA; Western_Zhou_LIA; Eastern_Zhou_LIA ###########
#### Compositional csv files: 1stShang; 2ndShang_West_East ##################
#### Functions: CIplot_uni #############################################

#### Place the function files and csv files in the same #####################
#### working directory as this script ####################################### 
#### Packages called in script - Best to run the script in order ############ 
#############################################################################

rm(list=ls(all=TRUE))

#### set working directory

setwd("C:/XXXX")
getwd()

#############################################################################
####CHRONOLOGICAL AND LEAD ISOTOPE DATA ANALYSIS#############################
#############################################################################

library(ggplot2)
library(MASS)
library(car)
library(grid)
library(plyr)
library(dplyr)

#### read and prepare data
dataS<- read.csv("Shang_LIA.csv", header=TRUE, check.names=FALSE)
dataW<- read.csv("Western_Zhou_LIA.csv", header=TRUE, check.names=FALSE)
dataE<- read.csv("Eastern_Zhou_LIA.csv", header=TRUE, check.names=FALSE)

#############################################################################
#####FIGURE 2 Histograms based on chronologies of vessels ################### 

#Shang
dim(dataS)
head(dataS)

dataS.subcol <- select(dataS, Dynasty, Cat_Number, Chronological_typology)

head(dataS.subcol)

#remove repeat values Shang (i.e. one chronology for each vessel remains)

dataS.subcol_vessels_part<-distinct(dataS.subcol, Cat_Number, .keep_all = TRUE)

head(dataS.subcol_vessels_part)

#Add Shang vessels without LIA

Dynasty <- c("Shang", "Shang", "Shang", "Shang", "Shang", "Shang")
Cat_Number <- c(33, 62, 65 ,69 ,78 ,81 )
Chronological_typology<-c(-1250,-1250, -1100,-1050,-1150,-1050) 
vessels_NO_LIA_Shang <- data.frame(Dynasty, Cat_Number, Chronological_typology)

dataS.subcol_vessels<- rbind(dataS.subcol_vessels_part, vessels_NO_LIA_Shang)

#Western Zhou
dim(dataW)
head(dataW)

dataW.subcol <- select(dataW, Dynasty, Cat_Number, Chronological_typology)

head(dataW.subcol)

#remove repeat values Western Zhou (i.e. one chronology for each vessel remains)

dataW.subcol_vessels_part<-distinct(dataW.subcol, Cat_Number, .keep_all = TRUE)

head(dataW.subcol_vessels_part)
dim(dataW.subcol_vessels_part)

#Add Western Zhou vessels without LIA

Dynasty <- c("Western Zhou", "Western Zhou", "Western Zhou", "Western Zhou")
Cat_Number <- c(46, 48, 60 ,76)
Chronological_typology<-c(-1013,-1013, -1013,-1013) 
vessels_NO_LIA_WZhou <- data.frame(Dynasty, Cat_Number, Chronological_typology)

dataW.subcol_vessels<- rbind(dataW.subcol_vessels_part, vessels_NO_LIA_WZhou)

#Eastern Zhou
dim(dataE)
head(dataE)

dataE.subcol <- select(dataE, Dynasty, Cat_Number, Chronological_typology)

head(dataE.subcol)

#remove repeat values Eastern Zhou (i.e. one chronology for each vessel remains)

dataE.subcol_vessels_part<-distinct(dataE.subcol, Cat_Number, .keep_all = TRUE)

head(dataE.subcol_vessels_part)

#Add Eastern Zhou vessels without LIA

Dynasty <- c("Eastern Zhou", "Eastern Zhou", "Eastern Zhou", "Eastern Zhou", 
"Eastern Zhou", "Eastern Zhou", "Eastern Zhou", "Eastern Zhou", 
"Eastern Zhou", "Eastern Zhou", "Eastern Zhou")
Cat_Number <- c(6, 7, 14 ,33, 46, 52,64,66,81,82,83)
Chronological_typology<-c(-700,-650,-575, -550, -300,-300,-700,-450,-300,-300,-200) 
vessels_NO_LIA_EZhou <- data.frame(Dynasty, Cat_Number, Chronological_typology)

dataE.subcol_vessels<- rbind(dataE.subcol_vessels_part, vessels_NO_LIA_EZhou)

#combine into one dataset and plot

DATA.subcol<-rbind(dataS.subcol_vessels,dataW.subcol_vessels,dataE.subcol_vessels)

group.names <- DATA.subcol[,1]

group.names<-factor(group.names,levels=c("Shang", "Western Zhou", "Eastern Zhou"))

ggplot(DATA.subcol, aes(x=Chronological_typology))+geom_histogram(binwidth=50,fill="white", colour="black", size=1.1)+
facet_grid(group.names)+ scale_x_continuous(breaks = round(seq(min(DATA.subcol$Chronological_typology), max(DATA.subcol$Chronological_typology), by = 200),1))+
theme_bw()+ xlab("Chronology BCE")

#############################################################################
####FIGURE 3 LIA plot for Shang, Western Zhou and Eastern Zhou ##############

#combine Shang, Western Zhou and Eastern Zhou LIA datasets

DATA<-rbind(dataS,dataW,dataE)

DATA$Pb208overPb204<-DATA$"Pb208_Pb206"*DATA$"Pb206_Pb204"

colnames(DATA)[10] <- "Pb208_Pb204"

dim(DATA)
head(DATA)

Figure_3<-scatterplot(Pb208_Pb204 ~ Pb206_Pb204 | Dynasty, data=DATA,
   xlab="206Pb/204Pb", ylab="208Pb/204Pb",xlim=c(17,25),ylim=c(37,46),
main=NULL,regLine=FALSE, legend=FALSE, grid=TRUE,
        smooth=FALSE, col=c("forestgreen","red","blue"), pch=c(5, 2, 0))
legend("bottomright",
       legend = c("Shang","Western Zhou","Eastern Zhou"),
       col = c("forestgreen", "red", "blue"),
    pch=c(5,2,0), bty="n", cex=0.9)
abline(v=19.5, col="black", lty=2)
text(x = 18, y = 45.5, "common") 
text(x = 21, y = 45.5, "radiogenic")

#############################################################################
####FIGURE 4 Histograms delineated dynasties showing Groups (A B C)##########

DATA$Dynasty<-factor(DATA$Dynasty)
levels(DATA$Dynasty)

dim(DATA)
head(DATA)

A_labels <- data.frame(Dynasty = c("Shang"), label = c("A"))
B_labels <- data.frame(Dynasty = c("Shang"), label = c("B"))
C_labels <- data.frame(Dynasty = c("Shang"), label = c("C"))

ggplot(DATA, aes(x=Pb_crustal_age_Ma,))+geom_histogram(binwidth=100, fill="white", colour="black", size=1.1)+ 
facet_grid(Dynasty~.)+theme_bw()+ labs(x="Pb crustal age (Ma)")+
  geom_text(x = -2200, y = 25, aes(label = label), data = A_labels, colour="blue")+
  geom_text(x = -730, y =25, aes(label = label), data = B_labels, colour="blue")+
  geom_text(x = 750, y =25, aes(label = label), data = C_labels, colour="blue")+
geom_segment(aes(x = -1500, y = 0, xend = -1500, yend = 25),linetype="dashed", color = "red")+
geom_segment(aes(x = 0, y = 0, xend = 0, yend = 25),linetype="dashed", color = "red")

##############################################################################
####FIGURE 5 Histograms of chronologies of Shang delineated by Group########## 

dataS<- read.csv("Shang_LIA.csv", header=TRUE, check.names=FALSE)

#For number of Shang vessels (i.e. not number of analyses)
#make new dataframe

dataS.subcol <- select(dataS, Cat_Number, Chronological_typology, GROUP)

head(dataS.subcol)

#remove repeat values (i.e. one chronology for each vessel remains)

dataS.subcol_vessels<-distinct(dataS.subcol, Cat_Number, .keep_all = TRUE)

head(dataS.subcol_vessels)

dataS.subcol_vessels$GROUP<-revalue(dataS.subcol_vessels$GROUP, c("A"="Shang A", B="Shang B", "C"="Shang C"))

ggplot(dataS.subcol_vessels, aes(x=Chronological_typology))+geom_histogram(binwidth=50,fill="white", colour="black", size=1.1)+
facet_grid(GROUP~.)+theme_bw()+
xlab("Chronology BCE")

#mean and median of the chronologies of the vessels

aggregate(dataS.subcol_vessels$Chronological_typology, list(dataS.subcol_vessels$GROUP), FUN=mean)
aggregate(dataS.subcol_vessels$Chronological_typology, list(dataS.subcol_vessels$GROUP), FUN=median)

#############################################################################
#####COMPOSITIONAL###########################################################
#############################################################################

rm(list=ls(all=TRUE))

### set working directory

setwd("C:/XXXX")
getwd()

### packages easyCODA, ellipse, boot and coin required
library(easyCODA)
library(ellipse)
library(boot)
library(coin)

#packages CIplot and colorspace required
library(CIplot)
library(colorspace)

#add path for function: CIplot_uni
source("C:/XXXX/CIplot_uni.R")

#############################################################################
####FIGURE 6 LRA plot for Shang (First Analysis)#############################

### read and prepare data
data<- read.csv("1stShang.csv", header=TRUE, check.names=FALSE)

dim(data)
head(data)

group.names <- data[,3]

### coda is the 94 x 12 compositional data matrix, closed to sum to 1
coda <- data[,4:15] / rowSums(data[,4:15])

group.names<-factor(group.names,levels=c("ShangA", "ShangB","ShangC"))

table(group.names)

### samples are already grouped in alphabetic order ShangA, ShangB, ShangC
### so set up short names as row labels, and group numbers
group.names.short <- c(rep("A",44), rep("B",19), rep("C",31))
group.nums <- c(rep(1,44),rep(2,19),rep(3,31))
coda <- as.matrix(coda)
rownames(coda) <- group.names.short

### group variances
LR.VAR(CLR(coda[group.names.short=="A",], weight=FALSE)$LR)

LR.VAR(CLR(coda[group.names.short=="B",], weight=FALSE)$LR)

LR.VAR(CLR(coda[group.names.short=="C",], weight=FALSE)$LR)

### group colours
group.cols <- c("purple","chocolate","forestgreen")

### logratio analysis (LRA) of coda matrix
coda.lra <- LRA(coda,weight=FALSE)


par(mar=c(4.2,4,4.5,2), mgp=c(2,0.7,0), font.lab=2, cex.axis=0.8)

### LRA plot
PLOT.LRA(coda.lra, map="asymmetric", rescale=1.0, cols=c("grey","red"), cexs=c(0.4,0.8),
         main=NULL)

### add 95% confidence ellipses
set.seed(123)
CIplot_biv(coda.lra$rowpcoord[1:94,1], coda.lra$rowpcoord[1:94,2], group=group.nums,
           groupcols=group.cols, add=TRUE, shade=TRUE, shownames=FALSE, alpha=0.95)

### group colours
group.cols <- c("black","black","black") 

set.seed(123)
CIplot_biv(coda.lra$rowpcoord[1:94,1], coda.lra$rowpcoord[1:94,2], group=group.nums,,
           groupcols=group.cols, add=TRUE, groupnames=c("A","B","C"), alpha=0.95, cex=0.7)

### permutation tests between groups (uses vegan package, loaded with easyCODA)
### tests performed on CLRs

coda.clr <- CLR(coda, weight=FALSE)$LR
 
### between ShangB and ShangC
foo.rda <- rda(coda.clr[group.names.short!="A",] ~ group.names.short[group.names.short!="A"]) 
set.seed(123)
anova(foo.rda, permutations=1000)

### between ShangA and ShangC
foo.rda <- rda(coda.clr[group.names.short!="B",] ~ group.names.short[group.names.short!="B"]) 
set.seed(123)
anova(foo.rda, permutations=1000)

### between ShangA and ShangB
foo.rda <- rda(coda.clr[group.names.short!="C",] ~ group.names.short[group.names.short!="C"]) 
set.seed(123)
anova(foo.rda, permutations=1000)

##############################################################################
####TABLE 3 - Summary of descriptive statistics of raw data###################

rm(list=ls(all=TRUE))

### read and prepare data

data<- read.csv("2ndShang_West_East.csv", header=TRUE, check.names=FALSE)

dim(data)
head(data)

rawdata<-data[,c(3, 5:12)]

library(psych)

describeBy(rawdata,"GROUP", omit=TRUE)

##############################################################################
####FIGURE 7 - LRA plot for Shang, Western Zhou and Eastern Zhou (2nd analysis)

rm(list=ls(all=TRUE))

### read and prepare data

data<- read.csv("2ndShang_West_East.csv", header=TRUE, check.names=FALSE)

#add path for function: CIplot_uni

source("C:/XXXX/CIplot_uni.R")

dim(data)
head(data)
 
group.names <- data[,3]

### coda is the 369 x 8 compositional data matrix, closed to sum to 1
coda <- data[,5:12] / rowSums(data[,5:12])

group.names<-factor(group.names,levels=c("ShangA", "ShangB","ShangC", "WestZhou", "EastZhou"))

table(group.names)

### set up short names as row labels, and group numbers
group.names.short <- c(rep("A",49), rep("B", 24), rep("C", 38),rep("W",160), rep("E",98))
group.names.short<-factor(group.names.short,levels=c("A", "B", "C","W","E"))
group.nums <- c(rep(1,49), rep(2, 24), rep(3, 38),rep(4,160),rep(5,98))
coda <- as.matrix(coda)
rownames(coda) <- group.names.short

### group variances
LR.VAR(CLR(coda[group.names.short=="A",], weight=FALSE)$LR)

LR.VAR(CLR(coda[group.names.short=="B",], weight=FALSE)$LR)

LR.VAR(CLR(coda[group.names.short=="C",], weight=FALSE)$LR)

LR.VAR(CLR(coda[group.names.short=="W",], weight=FALSE)$LR)

LR.VAR(CLR(coda[group.names.short=="E",], weight=FALSE)$LR)
	
### Introduce amalgamation Cu+Sn,  remove Cu and Sn
Cu_Sn <- coda[,"Cu"]+coda[,"Sn"] 
codaX <- cbind(coda[,-c(1,2)], Cu_Sn)
colnames(codaX)[7] <- "Cu&Sn" 

### group variances after amalgamation

LR.VAR(CLR(codaX[group.names.short=="A",], weight=FALSE)$LR)

LR.VAR(CLR(codaX[group.names.short=="B",], weight=FALSE)$LR)

LR.VAR(CLR(codaX[group.names.short=="C",], weight=FALSE)$LR)

LR.VAR(CLR(codaX[group.names.short=="W",], weight=FALSE)$LR)

LR.VAR(CLR(codaX[group.names.short=="E",], weight=FALSE)$LR)

### group colours
group.cols <- c("purple","chocolate","forestgreen","red", "blue") 

### logratio analysis (LRA) of coda matrix
coda.lra <- LRA(codaX,weight=FALSE)

par(mar=c(4.2,4,4.5,2), mgp=c(2,0.7,0), font.lab=2, cex.axis=0.8)

### LRA plot
PLOT.LRA(coda.lra, map="asymmetric", rescale=1.0, cols=c("grey","red"), cexs=c(0.4,0.8),
         main=NULL)

### add 95% confidence ellipses
set.seed(123)
CIplot_biv(coda.lra$rowpcoord[1:369,1], coda.lra$rowpcoord[1:369,2], group=group.nums,
           groupcols=group.cols, add=TRUE, shade=TRUE, shownames=FALSE, alpha=0.95)

### group colours
group.cols <- c("black","black","black","black","black") 

set.seed(123)
CIplot_biv(coda.lra$rowpcoord[1:369,1], coda.lra$rowpcoord[1:369,2], group=group.nums,,
           groupcols=group.cols, add=TRUE, groupnames=c("A","B", "C", "W","E"), alpha=0.95, cex=0.7)

##############################################################################
####FIGURE 8 PCA of six selected ratios ######################################

### logratio analysis (LRA) of coda matrix
coda.lra <- LRA(coda,weight=FALSE)

### Introduce amalgamation Cu+Sn,  remove Cu and Sn
Cu_Sn <- coda[,"Cu"]+coda[,"Sn"] 
codaX <- cbind(coda[,-c(1,2)], Cu_Sn)
colnames(codaX)[7] <- "Cu&Sn" 

###The function STEP has the first argument the data used for constructing logratios
### to explain the logratio variance in the second matrix (datatarget).
###The option "top" specifies how many logratios to list in decreasing order of variance explained.
###The option "previous" gives the logratios already selected, which are in $logratios of the STEP object.

### STEP 1
coda.step1 <- STEP(codaX, datatarget=coda, weight=FALSE, nsteps=1, top=5)
cbind(coda.step1$ratios.top, round(coda.step1$R2.top, 3))

# Pb/Zn chosen, first one in step1

### STEP 2
coda.step2 <- STEP(codaX, datatarget=coda, weight=FALSE, nsteps=1, top=5, previous=coda.step1$logratios.top[,1])
cbind(coda.step2$ratios.top, round(coda.step2$R2.top, 3))

# Sb/Cu+Sn chosen, first one in step2

### STEP 3
coda.step3 <- STEP(codaX, datatarget=coda, weight=FALSE, nsteps=1, top=5, previous=cbind(coda.step1$logratios.top[,1],coda.step2$logratios.top[,1]))
cbind(coda.step3$ratios.top, round(coda.step3$R2.top, 3))

# Pb/Cu+Sn chosen, fifth one in step3

### STEP 4
coda.step4 <- STEP(codaX, datatarget=coda, weight=FALSE, nsteps=1, top=5, 
                      previous=cbind(coda.step1$logratios.top[,1],coda.step2$logratios.top[,1], coda.step3$logratios.top[,5]))
cbind(coda.step4$ratios.top, round(coda.step4$R2.top, 3))

# Au/Cu+Sn chosen, first one in step4

### STEP 5
coda.step5 <- STEP(codaX, datatarget=coda, weight=FALSE, nsteps=1, top=5, 
                      previous=cbind(coda.step1$logratios.top[,1],coda.step2$logratios.top[,1], coda.step3$logratios.top[,5],coda.step4$logratios.top[,1]))
cbind(coda.step5$ratios.top, round(coda.step5$R2.top, 3))

# As/Cu+Sn chosen, second one in step5

### STEP 6
coda.step6 <- STEP(codaX, datatarget=coda, weight=FALSE, nsteps=1, top=5, 
                      previous=cbind(coda.step1$logratios.top[,1],coda.step2$logratios.top[,1], coda.step3$logratios.top[,5],coda.step4$logratios.top[,1],coda.step5$logratios.top[,2] ))
cbind(coda.step6$ratios.top, round(coda.step6$R2.top, 3))

# Pb/Ag chosen, third one in step6

coda.choice <- cbind(coda.step1$logratios.top[,c(1)],coda.step2$logratios.top[,1],
coda.step3$logratios.top[,5], coda.step4$logratios.top[,1],coda.step5$logratios.top[,2],coda.step6$logratios.top[,3])  

### group colours
group.cols <- c("purple","chocolate","forestgreen","red", "blue") 

colnames(coda.choice)<- c("Pb/Zn","Sb/Cu&Sn","Pb/Cu&Sn","Au/Cu&Sn", "As/Cu&Sn", "Pb/Ag")

### settle on six logratios, explaining 92.1% of total logratio variance

### PCA showing selected ratios ####
coda.choice.pca <- PCA(coda.choice, weight=FALSE)
par(mar=c(4.2,4,4.5,2), mgp=c(2,0.7,0), font.lab=2, cex.axis=0.8)
PLOT.PCA(coda.choice.pca, map="asymmetric", rescale=1, cols=c("grey","red"), cexs=c(0.4,0.8),
         main=NULL, axes.inv=c(1,-1))

### add 95% confidence ellipses (note reverse of second coordinates, because of axes.inv option in PLOT.PCA)
set.seed(123)
CIplot_biv(coda.choice.pca$rowpcoord[1:369,1], -coda.choice.pca$rowpcoord[1:369,2], group=group.nums,
           groupcols=group.cols, add=TRUE, shade=TRUE, shownames=FALSE, alpha=0.95)

### group colours
group.cols <- c("black","black","black", "black", "black")

set.seed(123)
CIplot_biv(coda.choice.pca$rowpcoord[1:369,1], -coda.choice.pca$rowpcoord[1:369,2], group=group.nums,
           groupcols=group.cols, add=TRUE, groupnames=c("A","B", "C", "W","E"), alpha=0.95, cex=0.7)

##############################################################################
#### FIGURE 9 - Univariate plots #############################################

par(mar=c(4.2,4,2,2), mgp=c(2,0.7,0), font.lab=2, las=1, mfrow=c(2,3))

# Pb/Zn  (#1 in choice)
CIplot_uni(coda.choice[,1], group=factor(group.names.short), 
           shade=TRUE, cols=c("purple","chocolate","forestgreen","red", "blue"),
           main="log(Pb/Zn)", ylim=c(5, 8.5))

#Sb/(Cu+Sn)(#2 in choice)
CIplot_uni(coda.choice[,2], group=factor(group.names.short),  
           shade=TRUE, cols=c("purple","chocolate","forestgreen","red", "blue"),
           main="log(Sb/(Cu+Sn))", ylim=c(-9.5,-6.5))

# Pb/Cu+Sn (#3 in choice)
CIplot_uni(coda.choice[,3], group=factor(group.names.short),  
           shade=TRUE, cols=c("purple","chocolate","forestgreen","red", "blue"),
           main="log(Pb/(Cu+Sn))", ylim=c(-4.5,-1.5))
 
# Au/Cu&Sn(#4 in choice)
CIplot_uni(coda.choice[,4], group=factor(group.names.short),  
           shade=TRUE, cols=c("purple","chocolate","forestgreen","red", "blue"),
           main="log(Au/(Cu+Sn))", ylim=c(-12.5,-10))

# As/Cu+Sn (#5 in choice)
CIplot_uni(coda.choice[,5], group=factor(group.names.short),  
           shade=TRUE, cols=c("purple","chocolate","forestgreen","red", "blue"),
           main="log(As/(Cu+Sn))", ylim=c(-7.5,-5))

# Pb/Ag    (#6 in choice)
CIplot_uni(coda.choice[,6], group=factor(group.names.short),  
           shade=TRUE, cols=c("purple","chocolate","forestgreen","red", "blue"),
           main="log(Pb/Ag)", ylim=c(3,5.5))
 
##############################################################################
####FIGURE 13 - logratio plot of two logratios as simple scatterplot ###

par(mar=c(4.2,4,2,2), mgp=c(2,0.7,0), font.lab=2, mfrow=c(1,1),cex.axis=0.8)

group.cols <- c( "purple","chocolate","forestgreen","red", "blue") 

plot(coda.choice[,c(5,2)], type="n", xlab="log(As/(Cu+Sn))", ylab="log(Sb/(Cu+Sn))", xlim=c(-9.5,-2.5))
text(coda.choice[,c(5,2)], labels=rownames(coda), cex=0.7, font=2, col=c("grey"))
abline(a=0.3, b=1.3, h=NULL, v=NULL, lty=2)+

segments(x0 = -10,
         x1 = -6.5,
         y0 = -8.2,
         y1 = -8.2,
         lwd = 1,
	lty=2,
         col = "blue") 

segments(x0 = -6.5,
         x1 = -6.5,
         y0 = -12.3,
         y1 = -8.2,
         lwd = 1,
	lty=2,
         col = "blue") 

### add 95% confidence ellipses
set.seed(123)
CIplot_biv(coda.choice[,5], coda.choice[,2], group=group.nums,
           groupcols=group.cols, add=TRUE, shade=TRUE, shownames=FALSE, alpha=0.95)

### group colours
group.cols <- c("black","black","black","black","black")
set.seed(123)
CIplot_biv(coda.choice[,5], coda.choice[,2], group=group.nums,
           groupcols=group.cols, add=TRUE, groupnames=c("A","B","C","W","E"), alpha=0.95, cex=0.7)

##############################################################################
####FIGURE 10 - Overlapping histograms of Cu/Sn for Shang, Western Zhou and Eastern Zhou
####Note that outliers are not plotted########################################

rm(list=ls(all=TRUE))

library(ggpattern)

### read and prepare data
data<- read.csv("2ndShang_West_East.csv", header=TRUE, check.names=FALSE)

dim(data)
head(data)
 
group.names <- data[,4]

table(group.names)

Cu_Sn<- data[,"Cu"]/data[,"Sn"] 

datx <- cbind(data, Cu_Sn)

dim(datx)
head(datx)

group.names<-factor(group.names,levels=c("Shang", "Western Zhou","Eastern Zhou"))

ggplot(datx, aes((x=Cu_Sn), fill=group.names))+
geom_histogram(position="identity", alpha=0.4, binwidth=0.5)+
  xlim(0,15)+
theme_bw()+xlab("copper/tin")+
theme(legend.position="bottom")+labs(fill="")+
    scale_fill_manual(values = c( "Shang"= "lightgreen",
                                  "Western Zhou"= "pink",
                                 "Eastern Zhou" = "blue"))

##############################################################################
####FIGURE 12 - Ternary diagram for Cu-Pb-Ag #################################

### read and prepare data
data<- read.csv("2ndShang_West_East.csv", header=TRUE, check.names=FALSE)

library(compositions)

par(mar=c(4.2,4,4.5,2), mgp=c(2,0.7,0), font.lab=2, cex.axis=0.8)

x=acomp(data[,c("Cu","Pb","Ag")])
mn=mean(x)
mvr=mvar(x)
dat1=scale(x, center=TRUE, scale=TRUE)
dat2=(x-mn)/sqrt(mvr)
plot(dat1, cex=0.5, pca=TRUE,col.pca="red")

##############################################################################
####FIGURE 14 - Scatterplot for log ratio of Sb/(Cu+Sn) vs chronology of vessels

rm(list=ls(all=TRUE))

library(car)

### read and prepare data
data<- read.csv("2ndShang_West_East.csv", header=TRUE, check.names=FALSE)

dim(data)
head(data)
 
Sb_Cu_Sn<- log(data[,"Sb"]/(data[,"Cu"]+data[,"Sn"])) 

datx <- cbind(data, Sb_Cu_Sn)

colnames(datx)[13] <- "log(Sb/(Cu+Sn))"

dim(datx)
head(datx)

group.names <- datx[,3]

group.names<-factor(group.names,levels=c("ShangA","ShangB","ShangC", "WestZhou", "EastZhou"))

table(group.names)

group.cols <- c( "purple","chocolate","forestgreen","red", "blue") 

scatterplot(log(Sb/(Cu+Sn))  ~ Chronological_typology| group.names, data=datx, xlim=c(-1500, -200),
   xlab="Chronology BCE", ylab="log(Sb/(Cu+Sn))",
   main=NULL,regLine=FALSE, legend=FALSE, grid=TRUE,
        smooth=FALSE, col=c("purple","chocolate","forestgreen","red","blue"),
pch=c(5, 0, 1, 2, 0))
legend("bottomright",
       legend = c("Shang A","Shang B","Shang C","Western Zhou","Eastern Zhou"),
       col = c("purple","chocolate","forestgreen","red","blue"),
    pch=c(5, 0, 1, 2, 0), bty="n", cex=0.75)

abline(h=-8.2, col="black", lty=2)

##############################################################################
#####FIGURE 15 - Overlapping histogram of log ratio of (Pb/Zn) for dynasties

rm(list=ls(all=TRUE))

library(ggpattern)

### read and prepare data
data<- read.csv("2ndShang_West_East.csv", header=TRUE, check.names=FALSE)

dim(data)
head(data)
 
Pb_Zn<- log(data[,"Pb"]/data[,"Zn"]) 

daty <- cbind(data, Pb_Zn)

colnames(daty)[13] <- "log(Pb/Zn)"

dim(daty)
head(daty)

group.names <- data[,4]

group.names<-factor(group.names,levels=c("Shang", "Western Zhou","Eastern Zhou"))

table(group.names)

ggplot(daty, aes((Pb_Zn), fill=group.names))+
geom_histogram(position="identity", alpha=0.4, binwidth=0.5)+
 theme_bw()+xlab("log(Pb/Zn)")+
theme(legend.position="bottom")+labs(fill="")+
    scale_fill_manual(values = c( "Shang"= "lightgreen",
                                  "Western Zhou"= "pink",
                                 "Eastern Zhou" = "blue"))

##############################################################################
####FIGURE16 - Scatterplots of log ratios of (Sb/(Cu+Sn)) vs (Pb/Zn) 

rm(list=ls(all=TRUE))

### read and prepare data
data<- read.csv("2ndShang_West_East.csv", header=TRUE, check.names=FALSE)

dim(data)
head(data)

Sb_Cu_Sn<- log(data[,"Sb"]/(data[,"Cu"]+data[,"Sn"])) 
datSb_Cu_Sn <- cbind(data, Sb_Cu_Sn)

dim(datSb_Cu_Sn)
head(datSb_Cu_Sn)

Pb_Zn<- log(datSb_Cu_Sn[,"Pb"]/datSb_Cu_Sn[,"Zn"]) 
datComb <- cbind(datSb_Cu_Sn, Pb_Zn)

dim(datComb)
head(datComb)

####Figure 16A Scatterplot for Shang Groups A, B and C #######################

#new data frame for Shang Groups A, B and C

DataShang<-datComb[c(1:111),]

group.names <- DataShang[,3]

group.names<-factor(group.names,levels=c("ShangA", "ShangB", "ShangC", "WestZhou","EastZhou"))

table(group.names)

scatterplot(Sb_Cu_Sn  ~ Pb_Zn| group.names, data=DataShang,
   xlab="log(Pb/Zn)", ylab="log(Sb/(Cu+Sn))",xlim=c(0,11),ylim=c(-12,-3),
   main=NULL,regLine=FALSE, legend=FALSE, grid=TRUE,
        smooth=FALSE, col=c("purple","chocolate","forestgreen","red","blue"), pch=c(5, 0, 1, 2,5))

legend("topleft",
       legend = c("Shang A","Shang B", "Shang C"),
       col = c("purple","chocolate","forestgreen"),
    pch=c(5, 0, 1), bty="n", cex=0.9)

abline(h=-8.2, col="black", lty=2)

arrows(12, -14, 12, -12, xpd = TRUE)
arrows(12, -14, 10, -14, xpd = TRUE)
text(x=12,y=-9.5,"deeper (copper)",srt=-270, xpd=TRUE, cex=0.9)
text(x=8.25,y=-14,"deeper (lead)",srt=0, xpd=TRUE, cex=0.9)

####FIGURE 16B Scatterplot for Western and Eastern Zhou ######################

#new data frame for Western Zhou and Eastern Zhou Groups

DataZhou<-datComb[c(112:369),]

group.names <- DataZhou[,3]

group.names<-factor(group.names,levels=c("ShangA", "ShangB", "ShangC", "WestZhou","EastZhou"))

table(group.names)

scatterplot(Sb_Cu_Sn  ~ Pb_Zn| group.names, data=DataZhou,
   xlab="log(Pb/Zn)", ylab="log(Sb/(Cu+Sn))",xlim=c(0,11),ylim=c(-12,-3),
   main=NULL,regLine=FALSE, legend=FALSE, grid=TRUE,
        smooth=FALSE, col=c("purple","chocolate","forestgreen","red","blue"), pch=c(5, 0, 1, 2 ,0))

legend("topleft",
       legend = c("Western Zhou","Eastern Zhou"),
       col = c("red","blue"),
    pch=c(2, 0), bty="n", cex=0.9)

abline(h=-8.2, col="black", lty=2)
arrows(12, -14, 12, -12, xpd = TRUE)
arrows(12, -14, 10, -14, xpd = TRUE)
text(x=12,y=-9.5,"deeper (copper)",srt=-270, xpd=TRUE, cex=0.9)
text(x=8.25,y=-14,"deeper (lead)",srt=0, xpd=TRUE, cex=0.9)

#############################################################################################
#### FIGURE 17 & 18 Boxplots with jitter for Anyang and Hanzhong unearthed bronzes###########
#### NOTE: Data collated by Liu et al. (2020a) in "Social hierarchy and the choice of metal 
#### recycling at Anyang, the last capital of Bronze Age Shang China", Scientific Reports, 10, 18974.
#### Original data sources listed in ANYANG_HANZHONG.csv file. Data used were those from 
#### samples that had measured numerical concentrations of Cu, Sn, Pb, Sb and Zn.
#### Hanzhong compositional data from Chen et al. (2009) in "Special alloys from remote frontiers of the
#### Shang Kingdom: scientific study of the Hanzhong bronzes from southwest Shaanxi, China",
#### Journal of Archaeological Science, 36, 2108-2118. Data used had values above the detection 
#### limit for Cu, Sn, Pb, Sb and Zn.

####FIGURE 17 log(Sb/(Cu+Sn)) 

rm(list=ls(all=TRUE))

library(ggplot2)
#### read and prepare data
dataA_H<- read.csv("ANYANG_HANZHONG.csv", header=TRUE, check.names=FALSE)

colnames(dataA_H)

head(dataA_H)

ggplot(dataA_H, aes(x = chronology, y = log(Sb/(Cu+Sn)), colour = chronology, shape=chronology)) + 
geom_boxplot(outlier.shape = NA) +
geom_jitter()+theme_bw() +
theme(legend.position="none")+
xlab("")+ylab("log (Sb/(Cu+Sn))")

######################################################################################
#### FIGURE 18 log(Pb/Zn)

ggplot(dataA_H, aes(x = chronology, y = log(Pb/Zn), colour = chronology, shape=chronology)) + 
geom_boxplot(outlier.shape = NA) +
geom_jitter()+theme_bw() +
theme(legend.position="none")+
xlab("")+ylab("log (Pb/Zn)")