Www.barbicanra.co.uk



Figures for ‘Basic Statistical Graphics for Archaeology with R: Life Beyond Excel’ – R code This document is an accompaniment to the documents Basic Statistical Graphics for Archaeology with R: Life Beyond Excel and Data Sets for ‘Basic Statistical Graphics for Archaeology with R: Life Beyond Excel’.For those who have not already done so the suite of files is available on both of the authors’ academia.edu web pages, and on the Barbican web site .This is a Word document. It should be possible to copy-and-paste the text for the figures, labelled as they are in the main text, into R and reproduce the figures there. To do so requires that the data sets, in Excel, also be imported into R, with the names we have given them, as described in Chapter 2 of the main text.The Excel files give the complete data sets used; in some cases only a subset is reproduced in the main text. Likewise we give full code for all the figures here. In the main text presentational arguments, which occupy much of the coding effort, were sometime left implicit. To reproduce exactly what is in the main text you will need the code here and the appropriately named and structured data files. The code here may also form a template for analyses of you own data – in a similar way – if this of interest.In the text, code was sometimes embedded within a user-defined function and sometimes not. Here, unless the code chunk is very short, most of what’s presented is within a user-defined function and we recommend this for reasons discussed in Chapter 5 of the text.The way this works is that you create an ‘empty’ function in R using function_name <- function( ) { } and then sandwich code between the curly brackets, { }. The figure will only be produced when you type function_name().Code for Figure 12.5 is not provided; it is illustrative and would have involved more detail than we wished to provide. We have, similarly, not provided code for examples of what we consider to be bad practice, which we would not wish to encourage. This applies principally to material in Chapters 9 and 10.The code to follow was constructed within R then copied into the present document. This ensures that it should work when copied into R – both authors have tested this. If you copy R code from other sources, or create it outside of R in the first instance, you may have problems for reasons that are not always obvious. For example, if you type quotation marks within R it emerges as " ", whereas importing something like “ “, which is what we get on our keyboard outside of R, doesn’t work for us. We have occasionally experienced similar problems when attempting to copy code from published papers.A final word of warning is that R is regularly updated as are some user-contributed package. Over the period the text was written – during 2016 but drawing on earlier work and code – we had no problems with backward compatibility of R, but did experience problems with some user-contributed packages. These seem mainly to be associated with packages inspired by and drawing on ggplot2, which we have used a lot. We think the problems arose because ggplot2 was updated in a way that necessitated changes to some user-contributed packages that drew on it.The other problem we had was that packages we have used in the past were withdrawn. As noted, everything here has been tested recently (October 2016) by both of us so should work. Any queries about the code can be addressed to the first author; either author may be approached with queries about the data.Mike Baxtermichaelj.baxter@Hilary Coolhilary@October2016Figure 4.3a – Based on Table 4.2 (pins)Length <- pins$Lengthhist(Length)Figure 4.3b – Based on Table 4. 2 (pins)Length <- pins$Lengthhist(Length, breaks = 20, main = " ", col = "skyblue",xlab = "Romano-British hairpin lengths (mm)",cex.main = 1.4, cex.lab = 1.3, cex.axis = 1.2)Figure 4.4a – Based on Table 4. 2 (pins)Length <- pins$Lengthhist(Length, breaks = 30, main = " ", col = "grey80",xlab = "Romano-British hairpin lengths (mm)",cex.main = 1.4, cex.lab = 1.3, cex.axis = 1.2)Figure 4.4b – Based on Table 4. 2 (pins)Length <- pins$Lengthhist(Length, breaks = 20, freq = FALSE, main = " ", border = "skyblue", col = "skyblue",xlab = "Romano-British hairpin lengths (mm)",cex.main = 1.4, cex.lab = 1.3, cex.axis = 1.2)lines(density(Length, bw = 4), lwd = 2, col = "red")Figure 4.5a – Based on Table 4. 2 (pins)library(ggplot2); library(grid)ggplot(data = pins, aes(x = Length)) + geom_histogram(bins = 20)Figure 4.5b – Based on Table 4.2 (pins)fig4.5b <- function() {library(ggplot2); library(grid)ggplot(data = pins, aes(x = Length)) +geom_histogram(bins = 20, fill = "white", colour = "black") +# remove minor grid lines# The # symbol comments out what follow ittheme(panel.grid.minor = element_blank()) +# add labels, title etc. and control their appearancexlab("lengths (mm)") + ggtitle("Romano-British hairpin lengths") +theme(axis.text=element_text(size=12),axis.title=element_text(size=14)) +theme(plot.title = element_text(size = 16, face="bold"))}fig4.5b()Figure 4.6a – Based on Table 4.3 (pillar)Percentage <- pillar$Percentage; Period <- pillar$Periodbarplot(Percentage, names.arg = Period, xlab = "Period ", ylab = "Percentage ", cex.names = 0.7)Figure 4.6b – Based on Table 4. 3 (pillar)Percentage <- pillar$Percentage; Period <- pillar$Period Width <- pillar$Widthbarplot(Percentage/Width, space = 0, width = Width, col = "skyblue", names.arg = Period, xlab = "Period", axes = F, cex.names = 0.5) Figure 4.7 – Based on Table 4.2 (pins)fig4.7 <- function() {library(ggplot2); library(grid)p <- ggplot(data = pins, aes(x = Length)) +geom_histogram(bins = 20, fill = "white", colour = "black") +facet_grid(Date ~ .) +theme(panel.grid.minor = element_blank()) +xlab("lengths (mm)") + ggtitle("Romano-British hairpin lengths") +theme(axis.text=element_text(size=12),axis.title=element_text(size=14)) +theme(plot.title = element_text(size = 16, face="bold"))p}fig4.7()Figure 4.8a – Based on Table 4.2 (pins)fig4.8a <- function() {Length <- pins$Length; Date <- pins$DateEarly <- Length[Date == "Early"]Late <- Length[Date == "Late"]Breaks <- seq(50, 140, 5)hist(Early, breaks = Breaks, ylim = c(0, 15),col = "#FF000060", main = " ",xlab = "Romano-British hairpin lengths (mm)",cex.lab = 1.3, cex.axis = 1.2)hist(Late, breaks = Breaks, col = "#0000FF60",add = T)legend("topright", c("Early", "Late"),fill = c("#FF000060", "#0000FF60"),bty = "n", cex = 1.5)}fig4.8a()Figure 4.8b – Based on Table 4.2 (pins)fig4.8b <- function() {library(ggplot2); library(grid)p <- ggplot(data = pins, aes(x = Length, fill = Date)) +geom_histogram(binwidth = 5, boundary = 50,position = "identity", alpha = 0.6) +scale_fill_manual(values = c("red", "blue")) +xlab("Romano-British hairpin lengths (mm)") +theme(panel.grid.minor = element_blank()) +theme(axis.text=element_text(size=12),axis.title=element_text(size=14)) +theme(plot.title = element_text(size = 16, face="bold")) +theme(legend.position="top",legend.text=element_text(size=14),legend.title=element_text(size=16),legend.key.height=unit(.8, "cm"), legend.key.width=unit(.8, "cm"))p}fig4.8b()Figure 4.9a – Based on Table 4.2 (pins)fig4.9a <- function() {library(ggplot2); library(grid)p <- ggplot(pins, aes(x = Length)) + geom_freqpoly(binwidth = 5) +xlab("Lengths (mm)") + ylab("Count") + ggtitle("Romano-British hairpin lengths") +theme(axis.text=element_text(size=12), axis.title=element_text(size=14)) +theme(plot.title = element_text(size = 16, face="bold"))p}fig4.9a()Figure 4.9 b – Based on Table 4.2 (pins)fig4.9b <- function() {library(ggplot2); library(grid)p <- ggplot(pins, aes(x = Length, colour = Date)) +geom_freqpoly(binwidth = 5, size = 1.2) +xlab("Lengths (mm)") + ylab("Count") + ggtitle("Romano-British hairpin lengths") +theme(axis.text=element_text(size=12), axis.title=element_text(size=14)) +theme(plot.title = element_text(size = 16, face="bold")) +theme(legend.position="top", legend.text=element_text(size=14), legend.title=element_text(size=16), legend.key.height=unit(.8, "cm"), legend.key.width=unit(.8, "cm"))p}fig4.9b()Figure 6.3a – Based on Table 6.1 (loomweights.all)plot(density(loomweights.all$Weight))Figure 6.3b – Based on Table 6.1 (loomweights.all)library(ggplot2); library(grid)ggplot(loomweights.all, aes(x=Weight)) + geom_density()NOTE: For several figures to follow a data set, loomweights, has been created that omits eight outliers at the end of loomweights.all. This is done usingloomweights <- loomweights.all[1:135, ]Weight <- loomweights$Weight; Height <- loomweights$Heightwhere Weight and Height are used in some later analyses.Figure 6.4a – Based on Table 6.1 omitting eight outliers (loomweights)fig6.4a <- function() {kde_lw <- density(Weight, adjust = 0.6)plot(kde_lw, xlab = "Weight", main = "", lwd = 3,col = "blue", cex.axis = 1.2, cex.lab = 1.3)lines(density(Weight, adjust = 1), col = "red", lwd = 3, lty = 2)legend("topright", c("26.85", "16.11"), col = c("red", "blue"),lwd = c(3, 3), lty = c(2, 1), title = "Bandwidth", bty = "n", cex = 1.5)}fig6.4a()Figure 6.4b – Based on Table 6.1 omitting eight outliers (loomweights)fig6.4b <- function() {library(ggplot2); library(grid)ggplot(loomweights.all[1:135,], aes(x=Weight)) +geom_line(stat = "density", adjust=0.5, colour="blue",size=1.3) + xlim(0, 450) +geom_line(stat="density", adjust=1.0, colour="red",linetype="dashed", size=1.3) +xlab("weight") + ylab("density") +theme(panel.grid.minor = element_blank()) +theme(axis.text=element_text(size=12),axis.title=element_text(size=14)) +theme(plot.title = element_text(size = 16, face="bold")) +theme(legend.position="top",legend.text=element_text(size=14),legend.title=element_text(size=16),legend.key.height=unit(.8, "cm"), legend.key.width=unit(.8, "cm"))}fig6.4b()Figure 6.6a – Based on Table 6.1 omitting eight outliers (loomweights)hist(Weight, breaks = 20, freq = FALSE, main = " ", col = "skyblue",xlab = "Weights (g)", ylab = "Density", xlim = c(0,450),cex.main = 1.4, cex.lab = 1.3, cex.axis = 1.2)lines(density(Weight, bw = 20), lwd = 2, col = "red")Figure 6.6b – Based on Table 6.1 omitting eight outliers (loomweights)fig6.6b <- function() {library(ggplot2); library(grid)ggplot(loomweights, aes(x = Weight, y = ..density..)) +geom_histogram(binwidth = 20, fill = "skyblue") +geom_density(adjust = 0.6, size = 1.1) + xlim(0,450) +xlab("weight") + ylab("density") +theme(panel.grid.minor = element_blank()) +theme(axis.text=element_text(size=12),axis.title=element_text(size=14)) +theme(plot.title = element_text(size = 16, face="bold")) +theme(legend.position="top",legend.text=element_text(size=14),legend.title=element_text(size=16),legend.key.height=unit(.8, "cm"), legend.key.width=unit(.8, "cm"))}fig6.6b()Figure 6.7a – Based on Table 4.2 (pins)fig6.7a <- function() {Length <- pins$Length; Date <- pins$DateEarly <- Length[Date == "Early"]Late <- Length[Date == "Late"]plot(density(Early), lwd = 3, main = "",xlab = "Romano-British hairpin lengths (mm)",col = "blue", xlim = c(40, 140),cex.main = 1.4, cex.lab = 1.3, cex.axis = 1.2)lines(density(Late), lwd = 2, col = "red")legend("topright", c("Early", "Late"), col = c("blue", "red"),lwd = c(3,3), lty = c(1,1), bty = "n", cex = 1.5)}fig6.7a()Figure 6.7b – Based on Table 4.2 (pins)fig6.7b<- function() {library(ggplot2); library(grid)ggplot(pins, aes(x = Length, colour = Date)) +geom_density(size = 1.3) + xlim(40,140) +scale_colour_manual(values = c("blue", "red")) +xlab("Length (mm)") + ylab("Density") +theme(panel.grid.minor = element_blank()) +theme(axis.text=element_text(size=12),axis.title=element_text(size=14)) +theme(plot.title = element_text(size = 16, face="bold")) +theme(legend.position="top",legend.text=element_text(size=14),legend.title=element_text(size=16),legend.key.height=unit(.8, "cm"), legend.key.width=unit(.8, "cm"))}fig6.7b()NOTE: As it stands the following code will generate Figure 6.8a. To get the other plots you have to edit the function to comment out the code for Figure 6.8a, and uncomment the code for each of the other plots in turn. That is, the function needs to be run four times.Figure 6.8a-d – Based on Table 6.1 omitting eight outliers (loomweights)fig6.8 <- function() {library(ggplot2); library(grid) ggplot(loomweights, aes(x=Weight, y=Height)) +geom_point(size=3) +stat_density2d(aes(colour="red"), size=1.1, h=c(100,20)) + # a#stat_density2d(aes(fill=..level..), geom="polygon", h=c(100,20)) + # b#stat_density2d(aes(fill=..density..), geom="raster", contour=FALSE, # c#h=c(100,20)) + # c#stat_density2d(aes(alpha =..density..), geom="tile", contour=FALSE, # d#h=c(100,20)) + # dxlim(50,450) + ylim(40,130) +theme(panel.grid.minor = element_blank()) +theme(axis.text=element_text(size=12),axis.title=element_text(size=14)) +theme(legend.position="none")}fig6.8()Figure 6.9a – Based on Table 6.1 omitting eight outliers (loomweights)Weight <- loomweights$Weight; Height <- loomweights$Heightlibrary(MASS)dens <- kde2d(Weight, Height, h = c(120, 20), n = 100,lims = c(50, 450, 40, 130))image(dens, xlab = "Weight", ylab = "Height")Figure 6.9b – Based on Table 6.1 omitting eight outliers (loomweights)Weight <- loomweights$Weight; Height <- loomweights$Heightlibrary(MASS)dens <- kde2d(Weight, Height, h = c(120, 20), n = 100,lims = c(50, 450, 40, 130))persp(dens, col = "green", theta = 30, phi = 25,ticktype = "detailed", nticks = 3,xlab = "Height", ylab = "Weight", zlab = "Density",cex.lab = 1.3, cex.axis = 1.2)Figure 6.10a – Based on Table 6.1 omitting eight outliers (loomweights)Weight <- loomweights$Weight; Height <- loomweights$Heightfig6.10a <- function() {library(MASS)dens <- kde2d(Weight, Height, h = c(120, 20), n = 100,lims = c(50, 450, 40, 130))contour(dens, xlim = c(40, 440), ylim = c(40,130), lwd = 2, col = "red", drawlabels = F, main = "Diagonal bandwidth matrix", xlab = "Weight (g)", ylab = "Height (mm)", cex.lab = 1.3, cex.axis = 1.2, cex.main = 1.4, cex = 1.2)points(loomweights, pch = 16)}fig6.10a()Figure 6.10b – Based on Table 6.1 omitting eight outliers (loomweights)fig6.10b <- function() {library(ks)H <- Hpi(loomweights)KH <- kde(loomweights, 2*H)plot(KH, cont = c(seq(25, 95, 10)), xlim = c(40, 440), ylim = c(40,130), lwd = 2, col = "red", drawlabels = F, main = "Non-diagonal bandwidth matrix", xlab = "Weight (g)", ylab = "Height (mm)",cex.lab = 1.3, cex.axis = 1.2, cex.main = 1.4, cex = 1.2)points(loomweights, pch = 16)}fig6.10b()NOTE: If you have not already created a variable Early from the pins data precede the next three chunks of code withDate <- pins$Date; Early <- Length[Date == "Early"]Figure 7.1a – Based on Table 4.2 (pins)boxplot(Early)Figure 7.1b – Based on Table 4.2 (pins)library(vioplot); vioplot(Early)Figure 7.1c – Based on Table 4.2 (pins)library(beanplot); beanplot(Early)Figure 7.2a – Based on Table 7.1 (lwphased)boxplot(Weight ~ Phase, data = lwphased, boxwex = .5, xlab = "Phase", ylab = "Weight (g)", main = "Base R boxplot", cex.axis = 1.2, cex.lab = 1.3, cex.main = 1.4)Figure 7.2b – Based on Table 7.1 (lwphased)library(beanplot)beanplot(Weight ~ Phase, data = lwphased, bw = 25, xlab = "Phase", ylab = "Weight (g)", main = "Beanplot", cex.axis = 1.2, cex.lab = 1.3, cex.main = 1.4)Figure 7.3 – Based on Table 7.1 (lwphased)fig7.3 <- function () {library(ggplot2); library(grid)p <- ggplot(lwphased, aes(x= Weight, colour = Phase)) +geom_density(size = 1.3, adjust = 0.8) + coord_fixed(40000) +xlim(0, 500) + ylab("Density") +xlab("Weights of loomweights (g)") +theme(panel.grid.minor = element_blank()) +theme(axis.text=element_text(size=12), axis.title=element_text(size=14)) +theme(plot.title = element_text(size = 16, face="bold")) +theme(legend.position="top", legend.text=element_text(size=14),legend.title=element_text(size=16),legend.key.height=unit(.8, "cm"), legend.key.width=unit(.8, "cm"))p}fig7.3()Figure 7.4a – Based on Table 7.1 (lwphased)fig7.4a <- function () {library(ggplot2); library(grid)p <- ggplot(lwphased, aes(x = Phase, y = Weight)) + geom_boxplot(fill = "skyblue", width = 0.5) +theme(panel.grid.minor = element_blank()) + ylab("Weight (g)") + ggtitle("Weights of Loomweights by Phase - Boxplots") +theme(axis.text=element_text(size=12), axis.title=element_text(size=14)) +theme(plot.title = element_text(size = 16, face="bold")) +theme(legend.position = "none")p}fig7.4a()Figure 7.4b – Based on Table 7.1 (lwphased)fig7.4b <- function() {library(ggplot2); library(grid)p <- ggplot(lwphased, aes(x = Phase, y = Weight)) + geom_violin(fill = "magenta", adjust = .9, trim = TRUE) +theme(panel.grid.minor = element_blank()) + ylab("Weight (g)") + ggtitle("Weights of Loomweights by Phase - Violin Plots") +theme(axis.text=element_text(size=12), axis.title=element_text(size=14)) +theme(plot.title = element_text(size = 16, face="bold")) +theme(legend.position = "none")p}fig7.4b()Figure 7.5a – Based on Table 4.2 (pins)fig7.5a <- function() {boxplot(Length ~ Date, data = pins, notch = T, col = c("red", "skyblue"), varwidth = TRUE, xlab = "Date", ylab = "Length (mm)", main = "Romano-British hairpin lengths (mm)", pch = 16, boxwex = 0.4, cex = 1.2, cex.axis = 1.2, cex.lab = 1.3, cex.main = 1.4)}fig7.5a()Figure 7.5b – Based on Table 4.2 (pins)fig7.5b <- function() {library(ggplot2); library(grid)p <- ggplot(pins, aes(x = Date, y = Length)) + geom_boxplot(aes(fill = Date), notch = TRUE, width = 0.4, varwidth = TRUE, outlier.shape = 16, outlier.size = 2) +scale_fill_manual(values = c("red", "skyblue")) +theme(panel.grid.minor = element_blank()) + ylab("Length (mm)") + ggtitle("Romano-British hairpin lengths (mm)") +theme(axis.text=element_text(size=12), axis.title=element_text(size=14)) +theme(plot.title = element_text(size = 16, face="bold")) +theme(legend.position = "none")p}fig7.5b()Figure 7.5c – Based on Table 4.2 (pins)fig7.5c <- function() {library(ggplot2); library(grid)p <- ggplot(pins, aes(x = Date, y = Length)) + geom_violin(aes(fill=Date), adjust=0.95, trim=FALSE, scale = "count", draw_quantiles = c(0.25, 0.5, 0.75)) + ylim(40,140) + scale_fill_manual(values = c("red", "skyblue")) +theme(panel.grid.minor = element_blank()) + ylab("Length (mm)") + ggtitle("Romano-British hairpin lengths (mm)") +theme(axis.text=element_text(size=12), axis.title=element_text(size=14)) +theme(plot.title = element_text(size = 16, face="bold")) +theme(legend.position="none")p}fig7.5c()NOTE: The code for Figures 8.2a and 8.2b is for basic, labelled scatterplots using base R and ggplot2 respectively. Figures 8.6 and 8.8 simply require extra lines to be provided to the base code, and only the additions will be presented.Figure 8.2a – Based on Table 6.1 omitting eight outliers (loomweights)fig8.2a <- function(){plot(Height ~ Weight, data = loomweights,xlim = c(50,450), ylim = c(50,130), # Modify plot limitsxlab = "Weight (g)", ylab = "Height (mm)", # Add axis labelsmain = "A base R scatterplot", # Add a titlecol = "red", pch = 16, cex = 1.2, # colour, shape, size of plot symbolscex.axis = 1.2, cex.lab = 1.3, cex.main = 1.4) # Text sizes, axis}fig8.2a()Figure 8.2b – Based on Table 6.1 omitting eight outliers (loomweights)fig8.2b <- function() {library(ggplot2); library(grid)p <- ggplot(loomweights, aes(x = Weight, y = Height)) +geom_point(size = 3, colour = "blue", shape = 15) + xlim(50,450) + ylim(50,130) +xlab("Weight (g)") + ylab("Height (mm)") + ggtitle("A ggplot2 scatterplot") +theme(panel.grid.minor = element_blank()) +theme(axis.text=element_text(size=12), axis.title=element_text(size=14)) +theme(plot.title = element_text(size = 16, face="bold"))p}fig8.2b()Figure 8.6a – Based on Table 6.1 omitting eight outliers (loomweights)Add the following three lines to the code for Figure 8.2a before the closing }.abline(v = 220, lty = 2, lwd = 2)abline(h = 80, lty = 2, lwd = 2)segments(100, 85, 350, 60, lwd = 2)Figure 8.6b – Based on Table 6.1 omitting eight outliers (loomweights)Add the following three lines to the code for Figure 8.2b after the line geom_point(size = 3, colour = "blue", shape = 15) + geom_vline(xintercept = 220, linetype = "dashed") +geom_hline(yintercept = 80, linetype = "dashed") +geom_segment(x = 100, y = 85, xend = 350, yend = 60) +Figure 8.8a – Based on Table 6.1 omitting eight outliers (loomweights)Add the following four lines to the code for Figure 8.2a before the closing }.z1 <- lm(Height ~ Weight, data = loomweights)lines(loomweights$Weight, predict(z1), lwd = 2)z2 <- loess(Height ~ Weight, data = loomweights, span = 0.6)lines(loomweights$Weight, predict(z2), lty = 2, lwd = 2)Figure 8.8b – Based on Table 6.1 omitting eight outliers (loomweights)Add the following two lines to the code for Figure 8.2b after the line geom_point(size = 3, colour = "blue", shape = 15) + stat_smooth(span = 0.6, se = F, colour = "black", linetype = "dashed") + stat_smooth(method = lm, se = F, colour = "black") +Figure 8.9a – Based on Table 6.1 omitting eight outliers (loomweights). Additionally a data frame outliers, consisting of the last eight lines of loomweights is needed.In the code for Figure 8.2a change xlim = c(50,450), ylim = c(50,130) toxlim = c(50,800), ylim = c(50,140) and add the following three lines before the closing } .points(outliers$Weight, outliers$Height, pch = 17, col = "blue", cex = 1.2)legend("bottomright", c("No", "Yes"), col = c("red", "blue"),pch = c(16, 17), title = "Outlier", bty = "n", cex = 1.3)Figure 8.9b – Based on loom.all which is loomweights with an extra column indicating if a case is an outlier or not.fig8.9b <- function() {library(ggplot2); library(grid)p <- ggplot(loom.all, aes(x = Weight, y = Height, colour = Outlier, shape = Outlier)) + geom_point(size = 3) +xlab("Weight (g)") + ylab("Height (mm)") + ggtitle("") +theme(panel.grid.minor = element_blank()) +scale_colour_manual(values=c("red","blue")) +scale_shape_manual(values=c(16,17)) +theme(axis.text=element_text(size=12), axis.title=element_text(size=14)) +theme(plot.title = element_text(size = 16, face="bold")) +theme(legend.position="top", legend.text=element_text(size=14), legend.title=element_text(size=16), legend.key.height=unit(.8, "cm"), legend.key.width=unit(.8, "cm"))p}fig8.9b()Figure 8.10a – Based on Table 7.1 (lwphased)fig8.10a <- function() {plot(lwphased$Weight, lwphased$Height, pch = c(21,22,24,25)[as.numeric(lwphased$Phase)], bg = c("red","blue","magenta","green2")[as.numeric(lwphased$Phase)], cex = 1.2,xlab = "Weight (g)", ylab = "Height (mm)", cex.axis = 1.2, cex.lab = 1.3, cex.main = 1.4)legend("topleft", c("I", "II", "III", "IV"), pt.bg =c("red", "blue", "magenta", "green2"), pch = c(21,22,24,25), title = "Phase", bty = "n", cex = 1.3)}fig8.10a()Figure 8.10b – Based on Table 7.1 (lwphased)fig8.10b <- function() {library(ggplot2); library(grid)p <- ggplot(lwphased, aes(x = Weight, y = Height)) +geom_point(aes(shape = Phase, colour = Phase), size = 3) +xlim(50,450) + ylim(50,130) +xlab("Weight (g)") + ylab("Height (mm)") + ggtitle("") +theme(panel.grid.minor = element_blank()) +theme(axis.text=element_text(size=12), axis.title=element_text(size=14)) +theme(plot.title = element_text(size = 16, face="bold")) +theme(legend.position="top", legend.text=element_text(size=14), legend.title=element_text(size=16), legend.key.height=unit(.8, "cm"), legend.key.width=unit(.8, "cm"))p}fig8.10b()Figure 8.11a – Based on Table 7.1 (lwphased)fig8.11a <- function() {library(ggplot2); library(grid); library(RColorBrewer)p <- ggplot(lwphased, aes(x = Weight, y = Height)) + #, colour = "black", shape = Phase, fill = Phase)) + geom_point(aes(shape = Phase, fill = Phase), size = 3) +xlab("Weight (g)") + ylab("Height (mm)") + ggtitle("") +theme(panel.grid.minor = element_blank()) +scale_shape_manual(values = c(21,22,24,25)) +scale_fill_manual(values = c("red", "blue", "magenta", "green2")) +#scale_fill_brewer(palette = "Dark2") +theme(axis.text=element_text(size=12), axis.title=element_text(size=14)) +theme(plot.title = element_text(size = 16, face="bold")) +theme(legend.position="top", legend.text=element_text(size=14), legend.title=element_text(size=16), legend.key.height=unit(.8, "cm"), legend.key.width=unit(.8, "cm"))p}fig8.11a()Figure 8.11b – Based on Table 7.1 (lwphased)As code for fig8.11a but comment out the scale_fill_manual command and uncomment scale_fill_brewer.Figure 8.12 – Based on Table 7.1 (lwphased)pairs(lwphased[, 1:6]Figure 8.13 – Based on Table 7.1 (lwphased)fig8.13 <- function() {pairs(lwphased[, 1:6], pch = c(15,16,17,1)[as.numeric(lwphased$Phase)], col = c("red", "green", "blue", "black")[as.numeric(lwphased$Phase)])}fig8.13()Figure 8.14 – Based on Table 7.1 (lwphased)fig8.14 <- function() {library(ggplot2); library(grid); library(GGally)ggpairs(data=lwphased, columns=1:6,upper = list(continuous = "density"),lower = list(continuous = "points"))}fig8.14()Figure 10.1a – Based on Table 10.1 (amphora)Amphora <- amphora$Amphora; barplot(Amphora)Figure 10.1b – Based on Table 10.1 (amphora)fig10.1b <- function() {row.names(amphora)[6] <- "Ivy Chimneys"Amphora <- amphora$AmphoraSite <- row.names(amphora)#Site[6] <- "Ivy Chimneys"Colour = c("red","skyblue","skyblue","orange","yellowgreen","yellowgreen","grey70","pink")bar <- barplot(Amphora, ylab = "Percentage", col = Colour,legend.text = c("Military", "Urban", "Suburban", "Rural","Roadside", "Villa"),args.legend = list(fill = c("red","skyblue","orange","yellowgreen","grey70","pink")))axis(1, at = bar, labels = F, tick = F)text(x=bar, y=-1.25, Site, xpd=TRUE, srt=45, pos=2)}fig10.1b()Figure 10.2a – Based on Table 10.3 (faunalR)tab <- as.matrix(faunalR)barplot(tab, beside = FALSE)Figure 10.2b – Based on Table 10.3 (faunalR)tab <- as.matrix(faunalR)barplot(tab, beside = TRUE)Figure 10.3a – Based on Table 10.3 (faunalR)fig10.3a <- function() {tab1 <- as.matrix(faunalR)bar <- barplot(tab1, beside = F, ylab = "Percentage", main = "Stacked barplot - base R", yaxt = "n", legend.text = T, names.arg = rep("",6), ylim = c(0,120), args.legend = list(x = "top", horiz = TRUE, title = "Species", cex = 1.3, bty = "n"), cex.names = 0.8, cex.lab = 1.3, cex.main = 1.4)axis(2, at = seq(0,100,20))text(x=bar, y=-2, names(faunalR), xpd=TRUE, srt=45, pos=2)}fig10.3a()Figure 10.3b – Based on Table 10.3 (faunalR)fig10.3b <- function() {tab1 <- as.matrix(faunalR)bar <- barplot(tab1, beside = TRUE, ylab = "Percentage", main = "Clustered barplot - base R", yaxt = "n", legend.text = T, names.arg = rep("",6), ylim = c(0,80), args.legend = list(x = "top", horiz = TRUE, title = "Species", cex = 1.3, bty = "n"), cex.names = 0.8, cex.lab = 1.3, cex.main = 1.4)text(x=bar[2,], y=-2, names(faunalR), xpd=TRUE, srt=45, pos=2)}fig10.3b()Figure 10.4a – Based on Table 10.4 (faunalG)ggplot(faunalG, aes(Site, Percentage, fill = Species)) +geom_bar(position = "dodge", stat="identity")Figure 10.4b – Based on Table 10.4 (faunalG)ggplot(faunalG, aes(Site, Percentage, fill = Species)) +geom_bar(stat="identity")Figure 10.5 – Based on Table 10.4 (faunalG)fig10.5 <- function() {library(ggplot2);library(grid)# Re-order factor levelsfaunalG$Site <- factor(faunalG$Site, levels = c("Castleford-F", "Ribchester", "Castleford-V", "Wroxeter", "Leicester", "Wilcote"))p <- ggplot(faunalG, aes(Site, Percentage, fill = Species)) + geom_bar(width = 0.6, position = "dodge", stat="identity") +theme(panel.grid.minor = element_blank()) + xlab("Site") + coord_fixed(ratio = 1/20) +scale_fill_manual(values=c("chartreuse3", "orchid", "skyblue")) +theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1)) +theme(axis.text=element_text(size=12), axis.title=element_text(size=14)) +theme(plot.title = element_text(size = 18, face="bold")) +theme(legend.position="top", legend.text=element_text(size=14), legend.title=element_text(size=16, face="bold"), legend.key.height=unit(.8, "cm"), legend.key.width=unit(.8, "cm")) p}fig10.5()Figure 10.7 – Based on Table 10.5 (countersgraves)fig10.7 <- function() {data <- countersgravesbarplot(t(as.matrix(data)), beside = T, ylim = c(0,60), xlab = "Diameter (mm)",ylab = "Count", legend.text = T, col = c("orange", "black"),names.arg = 5:27,args.legend = list(legend = c("Insula VI.1", "Graves"),title = "Diameter (mm)",cex = 1.3, title = "Context", bty = "n"),cex.names = .7, cex.axis = 1.2, cex.lab = 1.3, cex.main = 1.4)}fig10.7()Figure 11.1a – Based on Table 11.1(Ksar)library(ggplot2);library(grid); library(ggtern)ggtern(data=Ksar[,1:4],aes(Cores, Blanks, Tools, label=Levels)) +geom_point(size = 3) + theme_showarrows()Figure 11.1b – Based on Table 11.1 (Ksar)library(ggplot2);library(grid); library(ggtern)ggtern(data=Ksar[,1:4],aes(Cores, Blanks, Tools, label=Levels)) +geom_text() + theme_showarrows()Figure 11.2upper – Based on Table 11.2 (King)library(ggplot2}; library(grid); library(ggtern)ggtern(data=King,aes(C, P, SG, colour=Type, shape=Type, fill = Type)) +geom_point() + theme_showarrows()Figure 11.2lower – Based on Table 11.2 (King)fig11.2lower <- function() {library(ggplot2); library(grid); library(grid); library(ggtern)King$Type <- factor(King$Type, labels = c("Rural settlement", "Urban site", "Vicus", "Villa"))p <- ggtern(data=King,aes(C, P, SG, colour=Type, shape=Type, fill=Type)) +geom_point(size = 3) + theme_showarrows() +scale_shape_manual(values=c(21,22,24,25)) +scale_colour_manual(values=rep("black", 4)) +scale_fill_manual(values=c("skyblue", "red", "yellow", "white")) +theme_legend_position("tl") +theme(legend.title=element_text(size=16),legend.key.height=unit(1, "cm"), legend.key.width=unit(1, "cm"))p}fig11.2lower ()Figure 11.3 – Based on Table 11.2 (King)fig11.3 <- function() {library(ggplot2); library(grid); library(ggtern)King$Type <- factor(King$Type, labels = c("Rural settlement","Urban site","Small town", "Villa"))p <- ggtern(data=King,aes(C, P, SG, colour=Type, shape=Type, fill=Type)) + geom_point(aes(size = Type)) + theme_showarrows() +# Not especially nice so manually set point sizesscale_size_manual(values = c(3,3,.5,.5)) +scale_shape_manual(values=c(21,22,24,25)) +scale_colour_manual(values=rep("black", 4)) +scale_fill_manual(values=c("skyblue", "red", "yellow", "white")) +theme_legend_position("tl") +theme(legend.title=element_text(size=16),legend.key.height=unit(1,"cm"), legend.key.width=unit(1,"cm"))p}fig11.3()Figure 11.4 – Based on Table 11.2 (King)fig11.4 <- function() {library(ggplot2); library(grid); library(ggtern)ggtern(data=King, aes(C, P, SG)) + theme_showarrows() +stat_density_tern(geom="polygon", n=200, aes(fill=..level..)) +geom_point() + scale_fill_gradient(low="blue", high="red") + guides(color = "none", fill = "none")}fig11.4()Figure 11.5a – Based on Table 11.2 (King)fig11.5a <- function() {library(ggplot2); library(grid); library(ggtern)ggtern(data= King[King$Type=="Settlement", ], aes(C, P, SG)) + theme_showarrows() +stat_density_tern(geom='polygon', n=200, aes(fill=..level..)) +geom_point() + scale_fill_gradient(low="blue", high="red") + guides(color = "none", fill = "none") +ggtitle("Rural settlements") +theme(plot.title = element_text(size = 20, face="bold"))}fig11.5a()Figures 11.5b-d – Based on Table 11.2 (King)To get the remaining plots for Figure 5 replace "Settlement" in the third line with "Urban", "Villa" and "Vici/small towns" respectively and adjust the text of ggtitle as necessary.Figure 11.7 – Based on Table 11.3 (staffgold)fig11.7 <- function() {library(ggplot2); library(grid); library(ggtern)p <- ggtern(data=staffgold, aes(Cu, Ag, Au, colour=Artefact,shape = Artefact, fill=Artefact)) +geom_point(size = 3) + theme_showarrows() +scale_shape_manual(values=c(21,22,21,23,24,25)) +scale_colour_manual(values=rep("black", 6)) +scale_fill_manual(values=c(NA, "yellow", "skyblue", "darkorange","purple", NA)) +theme_legend_position("tl") + theme(legend.title=element_text(size=16),legend.key.height=unit(1, "cm"), legend.key.width=unit(1, "cm")) +tern_limits(T = .4, L = .4, R = 1)p}fig11.7()Figure 12.2a – Based on Table 12.1 (brooches)library(MASS)biplot(corresp(brooches[,2:7], nf = 2))Figure 12.2b – Based on Table 12.1 (brooches)library(ca)plot(ca(brooches[,2:7]))Figure 12.3a – Based on Table 12.1 (brooches)fig12.3a <- function() {library(ca)df <- brooches[-c(4,7,15),] # omit outliersregions <- df[,-c(1,8)] # extract regional dataCA <- ca(regions) # carry out CAx1 <- CA$rowcoord[,1]; x2 <- CA$rowcoord[,2]; x3 <- CA$rowcoord[,3]y1 <- CA$colcoord[,1]; y2 <- CA$colcoord[,2]; y3 <- CA$colcoord[,3]xlab <- df$Periodylab = names(regions)PCH <- rep(c(16,3,7,8,15,2,17), c(4,7,5,5,8,12,7))plot(x1, x2, asp = 1, pch = PCH, xlab = "Axis 1 (inertia = 53.8%)",ylab = "Axis 2 (inertia = 21.1%)", cex.axis=1.2, cex.lab=1.3, cex=1.2)text(y1, y2, ylab, cex=1.2)arrows(0, 0, .85*y1, .85*y2, length = .15, angle = 10, lwd = 2)legend("topleft", c("IA", "AT", "CN", "FL", "TH", "AS", "L"),pch = c(16,3,7,8,15,2,17), title = "Period", bty = "n", cex = 1.2)}fig12.3a()Figure 12.3b – Based on Table 12.1 (brooches)fig12.3b <- function() {library(ca)df <- brooches[-c(4,7,15),] # omit outliersregions <- df[,-c(1,8)] # extract regional dataCA <- ca(regions) # carry out CAx1 <- CA$rowcoord[,1]; x2 <- CA$rowcoord[,2]; x3 <- CA$rowcoord[,3]y1 <- CA$colcoord[,1]; y2 <- CA$colcoord[,2]; y3 <- CA$colcoord[,3]xlab <- df$Period; ylab = names(regions)PCH <- rep(c(16,3,7,8,15,2,17), c(4,7,5,5,8,12,7))plot(x1, x3, asp = 1, pch = PCH, xlab = "Axis 1 (inertia = 53.8%)",ylab = "Axis 3 (inertia = 15.5%)", cex.axis=1.2, cex.lab=1.3, cex=1.2)text(y1, y3, ylab, cex=1.2)arrows(0, 0, .85*y1, .85*y3, length = .15, angle = 10, lwd = 2)legend("topleft", c("IA", "AT", "CN", "FL", "TH", "AS", "L"),pch = c(16,3,7,8,15,2,17), title = "Period", bty = "n", cex = 1.2)}fig12.3b()Figure 12.4a – Based on Table 12.1 (brooches)fig12.4a <- function() {library(ca); library(ggplot2); library(grid); library(scales)df <- brooches[-c(4,7,15),] # omit outliersregions <- df[,-c(1,8)] # extract regional dataCA <- ca(regions) # carry out CAx1 <- CA$rowcoord[,1]; x2 <- CA$rowcoord[,2]; x3 <- CA$rowcoord[,3]y1 <- CA$colcoord[,1]; y2 <- CA$colcoord[,2]; y3 <- CA$colcoord[,3]Period <- data.frame(df$Period)dfscores <- data.frame(cbind(Period, x1, x2, x3))names(dfscores) <- c("Period", "X1", "X2", "X3")dfscores$Period <- factor(dfscores$Period, levels = c("IA", "AT", "CN", "FL", "TH", "AS", "L"))colnames <- data.frame(names(regions))colscores <- data.frame(cbind(y1, y2, y3))dfcols <- cbind(colnames, colscores)names(dfcols) <- c("Region", "Y1", "Y2", "Y3")dfcols$angle <- with(dfcols, (180/pi) * atan(Y2/Y1))p <- ggplot(dfscores, aes(x=X1, y=X2)) +xlab("Axis 1 (inertia = 53.8%)") + ylab("Axis 2 (inertia = 21.1%)") + coord_fixed() +geom_point(data=dfscores, aes(x=X1, y=X2, shape=Period,colour=Period), size=3) + geom_segment(data=dfcols, aes(x=0, y=0, xend=Y1*.8, yend=Y2*.8), arrow=arrow(length =unit(1/2, "picas")), color=muted("red")) +geom_text(data=dfcols, aes(label=Region,x=Y1*1, y=Y2*1, angle = angle), color="darkred", size=5) +scale_colour_manual(values=c("darkred", "brown", "green3", "black", "blue","red", "magenta","red")) +scale_shape_manual(values=c(16,3,7,8,15,2,17,16)) + xlim(-3,3) +theme(axis.text=element_text(size=12), axis.title=element_text(size=14)) +theme(panel.grid.minor = element_blank()) +theme(legend.position="top", legend.text=element_text(size=12),legend.title=element_text(size=14), legend.key.height=unit(.8, "cm"),legend.key.width=unit(.8, "cm"))p}fig12.4a()Figure 12.4b – Based on Table 12.1 (brooches)Code is mostly the same as for Figure 12.3a. In the last block change X2 to X3 and Y2 to Y3, where they occur. Change ylab("Axis 2 (inertia = 21.1%)") to ylab("Axis 3 (inertia = 15.5%)")Figure 12.5 – Based on Table 9.3 (countercolour)fig12.5 <- function() {library(ca)countersCA <- ca(countercolour[,-c(1)])x1 <- countersCA$rowcoord[,1]; x2 <- countersCA$rowcoord[,2]y1 <- countersCA$colcoord[,1]; y2 <- countersCA$colcoord[,2]plot(x1, x2, asp = 1, type = "n", xlab = "axis 1 (inertia = 49.1%)",ylab = "axis 2 (inertia = 29.6%)", main = "",cex.axis = 1.2, cex.lab = 1.3, cex.main = 1.3, xlim = c(-3.5,3.5))text(x1, x2, countercolour[,1], col = "black", cex = 0.8)text(y1, y2, c("C1BC", "AugT", "AugN", "Post 62", "Modern"),col = "red", cex = 1.3)segments(y1[1:4], y2[1:4], y1[2:5], y2[2:5], lwd = 2)}fig12.5()Figure 12.8 – Based on Table 12.2 (Flavian)fig12.8 <- function() {library(ca)EVE <- Flavian[, 2:8] # extract EVE countsCA <- ca(EVE) # undertake the CA# extract plotting coordinatesx1 <- CA$rowcoord[,1]; x2 <- CA$rowcoord[,2]y1 <- CA$colcoord[,1]; y2 <- CA$colcoord[,2]#Set up plot symbols and colours to be usedCol <- c(rep("pink", 3), rep("yellowgreen", 2), rep("skyblue", 5))Sym <- c(rep(16, 3), rep(17, 2), rep(15, 5))# Row plot – Figure 12.8awin.graph()plot(x1, x2, asp = 1, pch = Sym, col = Col, cex = 3,main = "CA (row plot) of Flavian drinking vessels")text(x1, x2, 1:10, cex = 1)abline(h=0, v=0, lty = 2, lwd = 1.5)legend("topright", c("North", "Midlands", "South"),col = c("pink", "yellowgreen", "skyblue"),pch = c(16,17,15), cex = 1.2, bty = "n")# Column plot – Figure 12.8bwin.graph()plot(y1,y2, asp = 1, type = "n",main = "CA (column plot) of Flavian drinking vessels")text(y1, y2, names(EVE), cex = 1.5)abline(h=0, v=0, lty = 2, lwd = 1.5)}fig12.8()NOTE: The use of win.graph() ensures that both graphs will be printed and retained on the screen, but will be completely overlaid so you need to click on the visible one and use the mouse to move it to another part of the screen to see what’s beneath. ................
................

In order to avoid copyright disputes, this page is only a partial summary.

Google Online Preview   Download