--- title: "Code for He 2024 Pilbara Fat-Tailed Kangaroo: Using Multivariate and Morphometric Analyses to explore spatial and stylistic variability" output: html_document date: "2024-03-18" --- Import packages. Tidyverse for data tasks, readxl to read the spreadsheet, FactoMineR and factoextra for pca/mca, zoo to help with missing data and geomorph for morphometrics. ```{r} library(tidyverse) library(readxl) library(FactoMineR) library(factoextra) library(geomorph) library(zoo) ``` ## Figure 3 Significant variable relationships in MCA Dimension 1 and Dimension 2 Importing the attribute data for MCA, from just the complete motifs. We are interested in which variables influence the analysis most. ```{r} # import data df_mca <- read_excel('he2024_supp1.xlsx', sheet = 'Complete_motifs') df_mca[df_mca == ''] <- NA # covert character to factor df_mca[sapply(df_mca, is.character)] <- lapply(df_mca[sapply(df_mca, is.character)], as.factor) df_new <-df_mca[,c(11,14,15,16,17,24,27,28,30,31,33,34,35,36,37,38,39,42)] res.mca <- MCA(df_new, graph = TRUE) ggsave('figures/fig3.png', width=6 , height = 6 , bg='white') ``` ## Figure 4: MCA results showing the stylistic clustering of motifs between Murujuga and inland examples, based largely on technique, form and decoration. Print the individual points and colour it by area. ```{r} fviz_mca_ind(res.mca, repel = TRUE, # Avoid text overlapping (slow if many point) label='none', habillage = df_mca$Area, palette = c('Inland' = 'brown', 'Murujuga' = 'navy', 'NA' = 'grey'), geom.ind = c("text"), addEllipses = TRUE, ggtheme = theme_bw()) + theme(legend.position = 'bottom') + geom_point(aes(colour = df_mca$Area, shape=df_mca$Area)) + labs(colour = 'Area' , shape = 'Area', fill = 'Area' ) ggsave('figures/fig4.png', height=5, width = 7, bg='white') ``` # PCA Run the PCA against traditional morphometrics ```{r} # read data df <- read_excel('he2024_supp1.xlsx', sheet = 'Morphometrics') %>% column_to_rownames('Distance') %>% mutate_all(as.numeric) # Replace 0 with "Murujuga" and 1 with "Inland" in the "Area" column df$Area <- ifelse(df$Area == 0, "Murujuga", "Inland") %>% as.factor() # fill na with mean, drop area variable df_n <- na.aggregate(df[,-9]) # get pca, excluding araa variable data.pca <- prcomp(df_n, scale = TRUE) summary(data.pca) ``` ## Figure 11 The PCA variables contributing to Dimension 1 and Dimension 2 Check which variables contribute most to the PCA ```{r} # Graph of the variables fviz_pca_var(data.pca,ggtheme=theme_bw(), col.var='cos2', gradient.cols = viridisLite::magma(10, direction=1, end=.8) ) + xlim(-1.2,1.2) ggsave('figures/fig11.png', width=5 , height = 4 , bg='white') ``` Two clusters is optimal: ```{r} sils <- fviz_nbclust(df_n, kmeans, method = "silhouette") sils$data fviz_nbclust(df_n, kmeans, method = "silhouette", linecolor = "black",)+ labs(subtitle = "Silhouette method") ggsave('figures/clusters.png', width=6 , height = 3.5 , bg='white') ``` ## Figure 12: The two PCA clusters distinguished by the screen plot; blue circle indicates the overlap. K-means clustering ```{r} # K-Means Cluster Analysis set.seed(42) fit <- kmeans(df_n, 3) # 2 cluster solution fviz_cluster(fit, data=df_n, ellipse = FALSE, geom = 'point', ggtheme = theme_bw(), show.clust.cent=FALSE, pointsize = 4) + scale_shape_manual(values= c('1' = '1', '2'='2', '3' = '3'), guide=NULL) + scale_colour_manual(values= c('1' = 'navy', '2'='brown', '3' = 'forestgreen'), guide=NULL) + ggtitle('') ggsave('figures/fig12.png', width=7 , height = 5 , bg='white') ``` ## Figure 13: Samples in Cluster 1 and Cluster 2 showing their geographic distribution. Compare clustering to place ```{r} tibble(Area = df$Area, Cluster = fit$cluster) %>% ggplot(aes(Area, fill = Area)) + geom_bar() + geom_text(aes(label = after_stat(count)), stat = "count", vjust = -.3, colour = "black") + scale_fill_manual(values= c('Inland' = 'brown', 'Murujuga' = 'navy'), guide='none') + facet_grid(cols = vars(Cluster)) + theme_bw() ggsave('figures/fig13.png', width=7 , height = 5, bg='white') ``` ## Figure 14: Bivariate cluster showing distribution according to location. Run a PCA for traditional morphometrics ```{r} fviz_pca_ind(data.pca, label="none", habillage=fit$cluster, ggtheme=theme_bw(), addEllipses=TRUE, ellipse.level=NULL, legend.title = "Cluster") + scale_colour_manual(values= c('1' = 'navy', '2'='brown', '3' = 'forestgreen'), aesthetics = c('colour', 'fill')) + scale_shape_manual(values = c('1' = 16, '2' = 17, '3' = 18)) + theme(legend.position = 'bottom') + ggtitle('Individual PCA - by computed cluster') ggsave('figures/fig14.png', width=5 , height = 5, bg='white') ``` ```{r} fviz_pca_ind(data.pca, label="none", habillage=df$Area, ggtheme=theme_bw(), addEllipses=TRUE, ellipse.level=NULL, legend.title = "Area") + scale_colour_manual(values= c('Inland' = 'brown', 'Murujuga' = 'navy'), aesthetics = c('colour', 'fill')) + scale_shape_manual(values = c('Murujuga' = 16, 'Inland' = 17, '3' = 18)) + theme(legend.position = 'bottom') + ggtitle('Individual PCA - by known area') ggsave('figures/fig14b.png', width=5 , height = 5, bg='white') ``` ## Figure 15: PCA Bivariate distribution of individual motifs. ```{r} fviz_pca_ind(data.pca, col.ind = "cos2", gradient.cols = viridisLite::magma(10, direction=1, end=.8), repel = FALSE, ggtheme=theme_bw()) ggsave('figures/fig15.png', width=7 , height = 5, bg='white') ``` ## Figure 16 PCA Bivariate plot with three motifs from the inland (right) cluster and four dispersed examples (left) – both inland and coastal - showing more diverse schema. # Geomorph ## Figure 17: Geometric Morphometric Distribution of X-Y landmarks for 155 samples. ```{r} x <- read_excel("he2024_supp1.xlsx", sheet = "X") %>% select(-1) %>% sapply(as.numeric) %>% as.matrix() %>% t() y <- read_excel("he2024_supp1.xlsx", sheet = "Y") %>% select(-1) %>% sapply(as.numeric) %>% as.matrix() %>% t() colnames(x) <- paste0('X', 1:30) colnames(y) <- paste0('Y', 1:30) order <- paste0(1:30) %>% rep(2) %>% as.numeric %>% sort %>% paste0(rep(c('X', 'Y'), 30),.) xy <- cbind(x,-y)[,order] coords <- arrayspecs(xy, p=30, k=2, sep='.') coords[is.nan(coords)] <- NA filled <- estimate.missing(coords, method = "TPS") plotAllSpecimens(filled) ``` ```{r} # Identify which individuals (i.e., slices along the last dimension) have no NA values across all rows and columns complete_individuals <- apply(coords, 3, function(x) all(!is.na(x))) # Subset the array to keep only complete individuals clean_coords <- coords[, , complete_individuals, drop = FALSE] ``` ## Figure 18: Ten macropod motifs displayed in outline form, based on their landmark coordinates. ## Figure 19: PCA Bivariate distribution on PC2 and PC2 with motif’s regional location coded. ```{r} gpa <- gpagen(filled, curves = NULL, surfaces = NULL, PrinAxes = TRUE, max.iter = NULL, ProcD = TRUE, Proj = TRUE, print.progress = TRUE) plotAllSpecimens(gpa$coords,mean=TRUE) ``` ```{r} PCA <- gm.prcomp(gpa$coords) pca_plot <- plot(PCA) pca_plotdata <- tibble( pc1 = pca_plot$PC.points[,'Comp1'], pc2 = pca_plot$PC.points[,'Comp2'], area = df$Area ) ggplot(pca_plotdata, aes(pc1, pc2, colour = area, shape=area, fill = area)) + geom_point() + labs(colour = 'Area' , shape = 'Area', fill = 'Area') + stat_ellipse(type = "norm", geom = 'polygon', alpha=0.1) + scale_colour_manual(values= c('Inland' = 'brown', 'Murujuga' = 'navy'), aesthetics = c('colour', 'fill')) + xlab(pca_plot$plot_args$xlab) + ylab(pca_plot$plot_args$ylab) + theme_bw() + geom_hline(yintercept = 0, linetype = "dashed") + geom_vline(xintercept = 0, linetype = "dashed") + ggtitle('Individuals - PCA Morphometric') + theme(legend.position = 'bottom') ggsave('figures/fig19.png', width=7 , height = 5, bg='white') ``` ## Size Ranges ```{r} attributes <- read_excel('he2024_supp1.xlsx', sheet = 'Whole_Attribute_data_V16') %>% mutate(Length_CM = parse_number(Length_CM)) t.test(Length_CM ~ Area, data = attributes) ggplot(attributes, aes(y=Length_CM, fill = Area)) + geom_histogram(binwidth = 25) + facet_grid(cols = vars(Area)) + scale_fill_manual(values= c('Inland' = 'brown', 'Murujuga' = 'navy'), guide='none') + scale_y_continuous(breaks = seq(0,350,50)) + theme_bw() + labs(y = 'Length (cm)', x = 'Count') ggsave('figures/sizes.png', width=7, height = 5, bg='white') ``` ## Contrast State ```{r} attributes %>% filter(Contrast_States %in% c(1,2,3,4)) %>% ggplot(aes(y=Contrast_States, fill = Area)) + geom_bar() + geom_text(aes(label = after_stat(count), x=after_stat(count)-5), stat = "count", colour = "white")+ facet_grid(cols = vars(Area), scales = 'free_x') + scale_fill_manual(values= c('Inland' = 'brown', 'Murujuga' = 'navy'), guide='none') + scale_x_continuous(breaks = seq(0,100,25)) + theme_bw() + labs(y = 'Contrast State', x = 'Count') ggsave('figures/fig3.png', width=5, height = 3, bg='white') ``` ```{r} cs <- table(attributes$Contrast_States, attributes$Area)[c(1,2,3,5),] chisq <- chisq.test(cs) chisq library(corrplot) corrplot(chisq$residuals, is.cor = FALSE) ``` ```{r} panels <- read_excel('he2024_supp1.xlsx', sheet = 'Panel v motif size (all panels)') %>% mutate(dip = case_match(Panel_dip, 'Horizontal' ~ 90, 'Incline' ~ 60, 'Oblique' ~ 30, 'Acute' ~ 0, 'Vertical' ~ -30, )) ggplot(panels, aes(x = dip, fill = Area)) + geom_bar(width = 25) + geom_text(aes(label = after_stat(count)), y= 23 , stat = "count", colour = "grey10") + coord_radial(start = -.1 * pi, end = 0.55 * pi, inner.radius = 0.3) + scale_y_continuous(expand = c(0, -0.5)) + scale_x_continuous( expand = c(.05, .05), breaks = c(-30, 0, 30, 60, 90), minor_breaks = NULL, labels = c("Vertical", "Acute", "Oblique", "Incline", "Horizontal")) + facet_grid(cols = vars(Area), scales = 'free_x') + scale_fill_manual(values= c('Inland' = 'brown', 'Murujuga' = 'navy'), guide='none') + theme_minimal() + labs(x= NULL, y = 'Count by panel dip') + theme(strip.text.x = element_text(size = 12)) ggsave('figures/dip_h.png', width=6, height = 2.5, bg='white') ``` ```{r} dip <- table(panels$Panel_dip, panels$Area) chisq <- chisq.test(dip) chisq library(corrplot) corrplot(chisq$residuals, is.cor = FALSE) ``` ```{r} size_motif <- table(panels$Motif_composition_size_category, panels$Area) chisq <- chisq.test(size_motif) chisq library(corrplot) corrplot(chisq$residuals, is.cor = FALSE) ``` ```{r} size_panel <- table(panels$Panel_size_category, panels$Area) chisq <- chisq.test(size_panel) chisq library(corrplot) corrplot(chisq$residuals, is.cor = FALSE) ``` ```{r} panels_pivot <- panels %>% pivot_longer(cols = c(Panel_size_category, Motif_composition_size_category), names_to = "type", values_to = "size_category") %>% mutate(type = case_when( type == "Panel_size_category" ~ "panel", type == "Motif_composition_size_category" ~ "motif", TRUE ~ type )) ggplot(panels_pivot, aes(y=size_category, fill = type)) + geom_bar() + scale_fill_manual(values= c('Inland' = 'brown', 'Murujuga' = 'navy'), guide='none') + theme_bw() + labs(y = 'Length (cm)', x = 'Count') table(panels$Panel_size_category, panels$Motif_composition_size_category) ``` ```{r} use_percent <- table(panels$`%_of_panel_used`, panels$Area) chisq <- chisq.test(use_percent) chisq library(corrplot) corrplot(chisq$residuals, is.cor = FALSE) ``` ```{r} panels %>% mutate(Motif_length = parse_number(Motif_length)) %>% pivot_longer(cols = c(Panel_length, Motif_length), names_to = "length_type", values_to = "length") %>% mutate(length_type = str_remove(length_type, '_length')) %>% ggplot(aes(x=length_type, y = length, colour=length)) + geom_point() + geom_line(aes(group=Original_panel_ID)) + scale_color_gradientn(colors = viridisLite::magma(10, direction = 1, end = 0.8), guide = 'none') + theme_bw() + labs(y = 'Length (cm)', x = '') ``` ```{r} panels %>% mutate(Motif_length = parse_number(Motif_length)) %>% ggplot(aes(Panel_length, Motif_length)) + geom_smooth(method='lm', se = FALSE, colour='black') + geom_point(aes(colour=Area), alpha=0.8) + scale_colour_manual(values= c('Inland' = 'brown', 'Murujuga' = 'navy')) + theme_bw() + labs(x = 'Panel length', y = 'Motif length') ggsave('figures/size_comparison.png', width=6, height = 4, bg='white') ``` ```{r} library(report) panels_fixed <- panels %>% mutate(Motif_length = parse_number(Motif_length)) report(lm(Motif_length ~ Panel_length, data = panels_fixed)) ``` ## New Figure 3 options for Peer Review ```{r} attributes %>% mutate(Techniques = case_match(Techniques, 'scratched' ~ 'Scratched', .default = Techniques )) %>% ggplot(aes(y=Techniques, fill = Area)) + geom_bar(position = position_dodge(preserve='single')) + scale_fill_manual(values= c('Inland' = 'brown', 'Murujuga' = 'navy')) + scale_x_continuous(breaks = seq(0,150,25)) + theme_bw() + labs(y = 'Technique', x = 'Count') + theme(legend.position = c(0.9, 0.1), legend.justification = c(1, 0)) ggsave('figures/fig3-new.png', width=6, height = 4, bg='white') ``` ```{r} attributes %>% mutate(Techniques = case_match(Techniques, 'scratched' ~ 'Scratched', 'Abraded; Pecked' ~ 'Pecked; Abraded', 'Abraded; Pecked; Scratched' ~ 'Pecked; Abraded; Scratched', .default = Techniques), Techniques = gsub(";", " +", Techniques) ) %>% ggplot(aes(y=Techniques, fill = Area)) + geom_bar(position = position_dodge(preserve='single')) + scale_fill_manual(values= c('Inland' = 'brown', 'Murujuga' = 'navy')) + scale_x_continuous(breaks = seq(0,150,25)) + theme_bw() + labs(y = 'Technique', x = 'Count') + theme(legend.position = c(0.9, 0.1), legend.justification = c(1, 0)) ggsave('figures/fig3-new.png', width=6, height = 4, bg='white') ``` ```{r} attributes %>% mutate(Techniques = case_match(Techniques, 'scratched' ~ 'Scratched', 'Abraded; Pecked' ~ 'Pecked; Abraded', 'Abraded; Pecked; Scratched' ~ 'Pecked; Abraded; Scratched', .default = Techniques), Techniques = gsub(";", " +", Techniques) ) %>% ggplot(aes(x = Forms, y = Techniques)) + geom_tile(aes(fill = ..count..), stat = "bin2d", binwidth = c(1, 1)) + geom_text(aes(label = ..count..), stat = "bin2d", binwidth = c(1, 1), vjust = 0.5, hjust = 0.5) + scale_fill_gradient(low = "white", high = "lightblue") + theme_bw() + labs(y = 'Technique', x = 'Form') + theme( legend.position = "none", axis.text.x = element_text(angle = 45, hjust = 1), legend.justification = c(1, 0), strip.background = element_rect(fill = c("brown", "brown")), # Set strip background colors strip.text = element_text(color = "white") ) + facet_wrap(~ Area) ggsave('figures/fig3-comparison2.png', width=6, height = 4, bg='white') ```