rm(list=ls(all=TRUE)) #The working directory should include the two csv files (ParSas.csv and AinSinu.csv) #The working directory should include the script functions (CIplot_uni.R and DOT.R) ### set working directory setwd("C:/Users/jonat/Desktop/NewR") ### packages easyCODA, ellipse, boot and coin required require(easyCODA) require(ellipse) require(boot) require(coin) #packages CIplot and colorspace required require(CIplot) require(colorspace) #add path for function: CIplot_uni source("C:/Users/jonat/Desktop/NewR/CIplot_uni.R") #add path for function:DOT source("C:/Users/jonat/Desktop/NewR/DOT.R") ### read and prepare data data <- read.csv("ParSas.csv", header=TRUE, check.names=FALSE) dim(data) # [1] 53 8 head(data) # Chronology SiO2 Al2O3 FeO MgO CaO K2O Na2O # 1 Parthian 62.54 2.57 3.71 3.20 7.78 4.82 8.17 # 2 Parthian 66.07 3.66 1.43 4.09 7.27 4.64 10.27 # 3 Parthian 62.99 5.95 1.16 3.67 6.32 5.61 13.37 # 4 Parthian 62.19 6.01 2.70 6.34 11.16 3.87 5.90 # 5 Parthian 61.78 5.88 2.72 3.38 5.40 4.94 12.87 # 6 Parthian 69.92 7.26 1.08 2.51 5.17 5.74 6.41 group.names <- data[,1] ### coda is the 53 x 7 compositional data matrix, closed to sum to 1 coda <- data[,2:8] / rowSums(data[,2:8]) table(group.names) # Parthian Parthian-Sasanian Sasanian # 15 11 27 ### samples are already grouped in alphabetic order Parthian, Parthian-Sasanian, Sasanian ### so set up short names as row labels, and group numbers group.names.short <- c(rep("P",15), rep("P-S",11), rep("S",27)) group.nums <- c(rep(1,15),rep(2,11),rep(3,27)) coda <- as.matrix(coda) rownames(coda) <- group.names.short ### group variances LR.VAR(CLR(coda[group.names.short=="P",], weight=FALSE)$LR) # [1] 0.1071937 LR.VAR(CLR(coda[group.names.short=="P-S",], weight=FALSE)$LR) # [1] 0.07734772 LR.VAR(CLR(coda[group.names.short=="S",], weight=FALSE)$LR) # [1] 0.0440234 ### group colours group.cols <- c("purple","chocolate","forestgreen") ### read supplementary data (Ain Sinu) and close to compositions datasup <- read.csv("AinSinu.csv", header=TRUE, check.names=FALSE) dim(datasup) # [1] 8 8 head(datasup) # Label SiO2 Al2O3 FeO MgO CaO K2O Na2O # 1 126 63.84 3.11 1.77 3.51 8.65 4.28 11.52 # 2 156 69.27 1.98 0.66 0.77 9.29 2.74 12.25 # 3 157 68.13 2.36 1.42 2.99 5.96 4.10 11.01 # 4 163 68.12 1.87 0.83 0.86 7.96 1.80 14.24 # 5 171 66.91 2.04 0.94 1.14 8.42 3.49 12.16 # 6 169 64.98 2.35 1.82 2.81 5.80 3.41 11.88 sup.names <- datasup[,1] codasup <- datasup[,2:8] / rowSums(datasup[,2:8]) codasup <- as.matrix(codasup) rownames(codasup) <- sup.names ### logratio analysis (LRA) of coda matrix, with rows 54 to 61 supplementary (i.e. the AinSinu samples) coda.lra <- LRA(rbind(coda, codasup), suprow=54:61, weight=FALSE) par(mar=c(4.2,4,4.5,2), mgp=c(2,0.7,0), font.lab=2, cex.axis=0.8) ### FIGURE 2 - LRA plot #### PLOT.LRA(coda.lra, map="asymmetric", rescale=0.2, cols=c("black","red"), cexs=c(0.7,0.8), main="Logratio analysis (LRA)") ### add 95% confidence ellipses set.seed(123) CIplot_biv(coda.lra$rowpcoord[1:53,1], coda.lra$rowpcoord[1:53,2], group=group.nums, groupcols=group.cols, add=TRUE, shade=TRUE, shownames=FALSE, alpha=0.95) set.seed(123) CIplot_biv(coda.lra$rowpcoord[1:53,1], coda.lra$rowpcoord[1:53,2], group=group.nums,, groupcols=group.cols, add=TRUE, groupnames=c("P","P-S","S"), alpha=0.95) ### permutation tests between groups (uses vegan package, loaded with easyCODA) ### tests performed on CLRs coda.clr <- CLR(coda, weight=FALSE)$LR ### between Parthian and Sasasian foo.rda <- rda(coda.clr[group.names.short!="P-S",] ~ group.names.short[group.names.short!="P-S"]) set.seed(123) anova(foo.rda, permutations=1000) # Model 1 0.08334 6.9822 0.001998 ### between Parthian-Sasasian and Sasasian foo.rda <- rda(coda.clr[group.names.short!="P",] ~ group.names.short[group.names.short!="P"]) set.seed(123) anova(foo.rda, permutations=1000) # Model 1 0.01676 1.5642 0.1868 ### between Parthian and Parthian-Sasasian foo.rda <- rda(coda.clr[group.names.short!="S",] ~ group.names.short[group.names.short!="S"]) set.seed(123) anova(foo.rda, permutations=1000) # Model 1 0.04450 1.5512 0.2088 ### stepwise selection of ratios on matrix coda ### Introduce amalgamation MgO+CaO, remove MgO and CaO MgO_CaO <- coda[,"MgO"]+coda[,"CaO"] codaX <- cbind(coda[,-c(4,5)], MgO_CaO) colnames(codaX)[6] <- "MgO&CaO" ###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=10) cbind(coda.step1$ratios.top, round(coda.step1$R2.top, 3)) # row col # SiO2/FeO 1 3 0.385 # FeO/Na2O 3 5 0.382 # FeO/MgO&CaO 3 6 0.375 # Al2O3/FeO 2 3 0.354 # FeO/K2O 3 4 0.348 # Al2O3/MgO&CaO 2 6 0.336 # SiO2/Al2O3 1 2 0.324 # Al2O3/Na2O 2 5 0.306 # Al2O3/K2O 2 4 0.290 # Na2O/MgO&CaO 5 6 0.157 # SiO2/FeO 1 3 0.385 chosen, first one in step1 ### STEP 2 coda.step2 <- STEP(codaX, datatarget=coda, weight=FALSE, nsteps=1, top=10, previous=coda.step1$logratios.top[,1]) cbind(coda.step2$ratios.top, round(coda.step2$R2.top, 3)) # row col # Al2O3/MgO&CaO 2 6 0.718 # SiO2/Al2O3 1 2 0.707 # Al2O3/FeO 2 3 0.707 # Al2O3/K2O 2 4 0.674 # Al2O3/Na2O 2 5 0.670 # K2O/MgO&CaO 4 6 0.527 # FeO/MgO&CaO 3 6 0.521 # SiO2/MgO&CaO 1 6 0.521 # Na2O/MgO&CaO 5 6 0.518 # K2O/Na2O 4 5 0.478 # SiO2/Al2O3 1 2 0.707 chosen, second one in step2 (which is also seventh in step1) ### STEP 3 ### SiO2/FeO and SiO2/Al2O3 previously selected (first and seventh of step1) coda.step3 <- STEP(codaX, datatarget=coda, weight=FALSE, nsteps=1, top=10, previous=coda.step1$logratios.top[,c(1,7)]) cbind(coda.step3$ratios.top, round(coda.step3$R2.top, 3)) # row col # K2O/MgO&CaO 4 6 0.840 # FeO/MgO&CaO 3 6 0.835 # SiO2/MgO&CaO 1 6 0.835 # Al2O3/MgO&CaO 2 6 0.835 # Na2O/MgO&CaO 5 6 0.833 # FeO/Na2O 3 5 0.802 # SiO2/Na2O 1 5 0.802 # Al2O3/Na2O 2 5 0.802 # K2O/Na2O 4 5 0.801 # Al2O3/K2O 2 4 0.772 # SiO2/MgO&CaO 1 8 0.835 <- chosen, third one in step3 ### STEP 4 coda.step4 <- STEP(codaX, datatarget=coda, weight=FALSE, nsteps=1, top=9, previous=cbind(coda.step1$logratios.top[,c(1,7)],coda.step3$logratios.top[,3])) cbind(coda.step4$ratios.top, round(coda.step4$R2.top, 3)) # row col # FeO/Na2O 3 5 0.931 # SiO2/Na2O 1 5 0.931 # Na2O/MgO&CaO 5 6 0.931 # Al2O3/Na2O 2 5 0.931 # K2O/Na2O 4 5 0.927 # Al2O3/K2O 2 4 0.884 # FeO/K2O 3 4 0.884 # SiO2/K2O 1 4 0.884 # K2O/MgO&CaO 4 6 0.884 # Na2O/MgO&CaO 7 8 0.931 chosen, third in step4 (fifth in step3) coda.choice <- cbind(coda.step1$logratios.top[,c(1,7)],coda.step3$logratios.top[,c(3,5)]) colnames(coda.choice)[3:4] <- c("SiO2/MgO&CaO","Na2O/MgO&CaO") ### settle on four logratios, explaining 93.1% of total logratio variance ### add the corresponding logratios of the supplementary data in codasup MgO_CaO.sup <- codasup[,4]+codasup[,5] codasup.choice <- log(cbind(codasup[,"SiO2"]/codasup[,"FeO"], codasup[,"SiO2"]/codasup[,"Al2O3"], codasup[,"SiO2"]/MgO_CaO.sup, codasup[,"Na2O"]/MgO_CaO.sup)) colnames(codasup.choice) <- colnames(coda.choice) ### FIGURE 3 - PCA showing selected ratios #### coda.choice.pca <- PCA(rbind(coda.choice, codasup.choice), weight=FALSE, suprow=54:61) 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=0.4, cols=c("black","red"), cexs=c(0.7,0.8), main="Principal component analysis (PCA) of chosen logratios", 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:53,1], -coda.choice.pca$rowpcoord[1:53,2], group=group.nums, groupcols=group.cols, add=TRUE, shade=TRUE, shownames=FALSE, alpha=0.95) set.seed(123) CIplot_biv(coda.choice.pca$rowpcoord[1:53,1], -coda.choice.pca$rowpcoord[1:53,2], group=group.nums,, groupcols=group.cols, add=TRUE, groupnames=c("P","P-S","S"), alpha=0.95) ### FIGURE 5 - logratio plot of first two logratios as simple scatterplot ### par(mar=c(4.2,4,2,2), mgp=c(2,0.7,0), font.lab=2, las=1) plot(rbind(coda.choice,codasup.choice)[,1:2], type="n", xlab="log(SiO2/FeO)", ylab="log(SiO2/Al2O3)", xlim=c(2.6,4.7)) text(rbind(coda.choice,codasup.choice)[,1:2], labels=rownames(rbind(coda,codasup)), cex=0.7, font=2) ### add 95% confidence ellipses set.seed(123) CIplot_biv(coda.choice[,1], coda.choice[,2], group=group.nums, groupcols=group.cols, add=TRUE, shade=TRUE, shownames=FALSE, alpha=0.95) set.seed(123) CIplot_biv(coda.choice[,1], coda.choice[,2], group=group.nums,, groupcols=group.cols, add=TRUE, groupnames=c("P","P-S","S"), alpha=0.95) ### FIGURE 4 - univariate plots ### ### extend group numbers: 4=Ain Sinu, also re-level so that "AS" is last ### Note that rows 2, 4 and 5 in the Ain Sinu dataset are Roman. group.names.short.extra <- factor(c(group.names.short,rep("AS",8)), levels=c("P","P-S","S","AS")) par(mar=c(4.2,4,2,2), mgp=c(2,0.7,0), font.lab=2, las=1, mfrow=c(2,2)) # SiO2/(MgO+CaO) (#3 in choice) CIplot_uni(c(coda.choice[,3], codasup.choice[,3]), group=factor(group.names.short.extra), shade=TRUE, cols=c("purple","chocolate","forestgreen", "gray30"), main="log(SiO2/(MgO+CaO))", ylim=c(1.2, 2.6)) DOT(c(coda.choice[,3], codasup.choice[,3]), groups=group.names.short.extra, col=adjustcolor(c("purple","chocolate","forestgreen","gray30"), alpha.f=0.2), add=TRUE) points(rep(4,3), codasup.choice[c(2,4,5),3], pch=2, cex=1.2, col="blue") # Na2O/(MgO+CaO) (#4 in choice) CIplot_uni(c(coda.choice[,4], codasup.choice[,4]), group=factor(group.names.short.extra), shade=TRUE, cols=c("purple","chocolate","forestgreen", "gray30"), main="log(NaO2/(MgO+CaO))", ylim=c(-1,1)) DOT(c(coda.choice[,4], codasup.choice[,4]), groups=group.names.short.extra, col=adjustcolor(c("purple","chocolate","forestgreen","gray30"), alpha.f=0.2), add=TRUE) points(rep(4,3), codasup.choice[c(2,4,5),4], pch=2, cex=1.2, col="blue") # SiO2/FeO (#1 in choice) CIplot_uni(c(coda.choice[,1], codasup.choice[,1]), group=factor(group.names.short.extra), shade=TRUE, cols=c("purple","chocolate","forestgreen", "gray30"), main="log(SiO2/FeO)", ylim=c(2.5,5.0)) DOT(c(coda.choice[,1], codasup.choice[,1]), groups=group.names.short.extra, col=adjustcolor(c("purple","chocolate","forestgreen","gray30"), alpha.f=0.2), add=TRUE) points(rep(4,3), codasup.choice[c(2,4,5),1], pch=2, cex=1.2, col="blue") # SiO2/Al2O3 (#2 in choice) CIplot_uni(c(coda.choice[,2], codasup.choice[,2]), group=factor(group.names.short.extra), shade=TRUE, cols=c("purple","chocolate","forestgreen", "gray30"), main="log(SiO2/Al2O3)", ylim=c(1.5,4.0)) DOT(c(coda.choice[,2], codasup.choice[,2]), groups=group.names.short.extra, col=adjustcolor(c("purple","chocolate","forestgreen","gray30"), alpha.f=0.2), add=TRUE) points(rep(4,3), codasup.choice[c(2,4,5),2], pch=2, cex=1.2, col="blue") ### tests between P, P-S and S in same order as above plots ### SiO2/(MgO+CaO) set.seed(123) oneway_test(coda.choice[,3] ~ factor(group.names)) #chi-squared = 2.4432, df = 2, p-value = 0.2948 #### Na2O/(MgO+CaO) set.seed(123) oneway_test(coda.choice[,4] ~ factor(group.names)) #chi-squared = 2.3084, df = 2, p-value = 0.3153 ### SiO2/FeO set.seed(123) oneway_test(coda.choice[,1] ~ factor(group.names)) #chi-squared = 7.3397, df = 2, p-value = 0.02548 set.seed(123) ### SiO2/Al2O3 oneway_test(coda.choice[,2] ~ factor(group.names)) #chi-squared = 12.613, df = 2, p-value = 0.001825 ### test of non-Roman Ain Sinu samples against the Par samples, for the four ratios oneway_test(c(coda.choice[group.names=="Parthian",1], codasup.choice[-c(2,4,5),1]) ~ factor(c(rep("P",15), rep("NR",5))), distribution="exact") #Z = 0.72785, p-value = 0.4787 oneway_test(c(coda.choice[group.names=="Parthian",2], codasup.choice[-c(2,4,5),2]) ~ factor(c(rep("P",15), rep("NR",5))), distribution="exact") #Z = 1.7788, p-value = 0.0725 oneway_test(c(coda.choice[group.names=="Parthian",3], codasup.choice[-c(2,4,5),3]) ~ factor(c(rep("P",15), rep("NR",5))), distribution="exact") #Z = 0.97325, p-value = 0.3459 oneway_test(c(coda.choice[group.names=="Parthian",4], codasup.choice[-c(2,4,5),4]) ~ factor(c(rep("P",15), rep("NR",5))), distribution="exact") #Z = 0.86553, p-value = 0.402