### R script: 'Holey' niche! Conceicao and Morimoto. ### # Torus and sphere # library(hypervolume) library(dplyr) library(ggplot2) library(patchwork) library(TDAstats) sphere <- read.csv("sphere3-pointcloud.csv", header = TRUE) head(sphere) names(sphere) <- c("row", "x1", "x2", "x3") ## Running persistence homology ## sphere_short <- sphere %>% sample_n(100) sphere_PH <- calculate_homology(cbind(sphere_short$x1, sphere_short$x2, sphere_short$x3), dim = 2) torus_short <- torus %>% sample_n(200) torus_PH <- calculate_homology(cbind(torus_short$x1, torus_short$x2, torus_short$x3), dim = 2) thresh <- any(class(id_significant(features = as.data.frame(torus_PH), dim = 3, reps = 500, cutoff = 0.975) == "error")) plot_persist(torus_PH, flat = TRUE) + geom_hline(yintercept = thresh) thresh id_significant_adapted <- function (features, dim = 1, reps = 100, cutoff = 0.975) { colnames(features) <- c("dimension", "birth", "death") features <- features[features[, 1] == dim, ] if (nrow(features) < 1) { stop(paste("There are too few (< 1) features of the", "desired dimension in the feature matrix.")) } features$persist <- features$death - features$birth ans <- numeric(reps) for (i in 1:reps) { curr_sample <- sample(x = features$persist, size = nrow(features), replace = TRUE) ans[i] <- mean(curr_sample) } stats::quantile(ans, cutoff, names = FALSE) } id_significant_adapted(features = as.data.frame(sphere_PH), dim = 0, reps = 500, cutoff = 0.975) get_sign_dims <- function(hom_data, dim, reps = 500, cutoff = 0.975) { output <- c() for(j in 1:(dim+1)) { output <- rbind(output, id_significant_adapted(features = as.data.frame(hom_data), dim = j - 1, reps = reps, cutoff = cutoff)) } dimension <- seq(0:dim) - 1 output2 <- as.data.frame(cbind(output, dimension)) colnames(output2) <- c("threshold", 'dimension') return(output2) } assign_cols_PH <- function(data){ possbilities <- c("0 no", "0 sig", "1 sig","1 no", "2 no", "2 sig") data$temp <- with(data, as.factor(paste(dimension, colour))) data$colvar <- ifelse(data$temp == "0 no", "grey49", ifelse(data$temp == "1 no", "grey50", ifelse(data$temp == "2 no", "grey51", ifelse(data$temp == "0 sig", 'firebrick2', ifelse(data$temp == '1 sig', 'steelblue2', 'chartreuse3'))))) return(data) } ##### To do ###### # a) Run PH in normal and yper sphere and torus # Torus and sphere # library(hypervolume) library(dplyr) library(ggplot2) library(patchwork) library(TDAstats) # Sphere sphere <- read.csv("sphere3-pointcloud.csv", header = TRUE) head(sphere) names(sphere) <- c("row", "x1", "x2", "x3") # Torus torus <- read.csv("torus3-pointcloud.csv", header = TRUE) head(torus) names(torus) <- c("row", "x1", "x2", "x3") ## Calculating the hypervolume of the spere and the torus ## spherehyper <- hypervolume(data = sphere[2:4], name = 'Sphere') torushyper <- hypervolume(data = torus[2:4], name = 'Torus') ## Finding holes ## # Sphere # sphereconvex <- expectation_convex(hypervolume_thin(spherehyper, num.points = 200), check.memory=FALSE,use.random=TRUE) spherefeature <- hypervolume_holes(spherehyper , sphereconvex, set.check.memory=FALSE) spherefeatures_segmented <- hypervolume_segment(spherefeature, check.memory=FALSE,distance.factor=2) spherefeatures_segmented_pruned <- hypervolume_prune(spherefeatures_segmented, volume.min=0.02) # Torus # torusconvex <- expectation_convex(hypervolume_thin(torushyper, num.points = 200), check.memory=FALSE,use.random=TRUE) torusfeature <- hypervolume_holes(torushyper , torusconvex, set.check.memory=FALSE) torusfeatures_segmented <- hypervolume_segment(torusfeature, check.memory=FALSE,distance.factor=2) torusfeatures_segmented_pruned <- hypervolume_prune(torusfeatures_segmented, volume.min=0.02) ## Running persistence homology ## sphere_short <- sphere %>% sample_n(300) sphere_PH <- calculate_homology(cbind(sphere_short$x1, sphere_short$x2, sphere_short$x3), dim = 2) spherehyper_dt_short <- data.frame(spherehyper@RandomPoints) %>% sample_n(300) spherehyper_PH <- calculate_homology(cbind(spherehyper_dt_short$x1, spherehyper_dt_short$x2, spherehyper_dt_short$x3), dim = 2) torus_short <- torus %>% sample_n(300) torus_PH <- calculate_homology(cbind(torus_short$x1, torus_short$x2, torus_short$x3), dim = 2) torushyper_dt_short <- data.frame(torushyper@RandomPoints) %>% sample_n(300) torushyper_PH <- calculate_homology(cbind(torushyper_dt_short$x1, torushyper_dt_short$x2, torushyper_dt_short$x3), dim = 2) ## obtaining significance thresholds sphere_PH_sig <- get_sign_dims(sphere_PH, dim =2) spherehyper_PH_sig <- get_sign_dims(spherehyper_PH, dim =2) torus_PH_sig <- get_sign_dims(torus_PH, dim =2) torushyper_PH_sig <- get_sign_dims(torushyper_PH, dim =2) ## Data frame for plotting sphere_PH_plotting <- assign_cols_PH(inner_join(as.data.frame(sphere_PH), sphere_PH_sig) %>% mutate(colour = ifelse(.$death - .$birth > threshold, 'sig', 'no'))) spherehyper_PH_plotting <- assign_cols_PH(inner_join(as.data.frame(spherehyper_PH), spherehyper_PH_sig) %>% mutate(colour = ifelse(.$death - .$birth > threshold, 'sig', 'no'))) torus_PH_plotting <- assign_cols_PH(inner_join(as.data.frame(torus_PH), torus_PH_sig) %>% mutate(colour = ifelse(.$death - .$birth > threshold, 'sig', 'no'))) torushyper_PH_plotting <- assign_cols_PH(inner_join(as.data.frame(torushyper_PH), torushyper_PH_sig) %>% mutate(colour = ifelse(.$death - .$birth > threshold, 'sig', 'no'))) ## plotting ## sphere_PH_sig_plot <- ggplot(sphere_PH_plotting, aes(x = birth, y = death, shape = as.factor(dimension), col = paste(dimension, colour))) + geom_point(size = 2) + xlab('Birth') + ylab('Death') + ggtitle('Sphere') + geom_abline(slope = 1, intercept = 0, col = 'black', size = 0.4) + scale_color_manual('Dimension', values = c("0 no" = "grey70", "0 sig" = 'firebrick1', "1 no" = "grey70", "1 sig" = 'royalblue2', "2 no" = "grey70", "2 sig" = 'orchid1')) + scale_shape_manual('Dimension', values = c(15, 17, 19)) + theme_linedraw() + theme(panel.grid = element_blank(), axis.text = element_text(size = 11), axis.title = element_text(size = 12), plot.title = element_text(size = 11, face = 'bold', hjust = 0.5), legend.position = "none") sphere_PH_sig_plot spherehyper_PH_sig_plot <- ggplot(spherehyper_PH_plotting, aes(x = birth, y = death, shape = as.factor(dimension), col = paste(dimension, colour))) + geom_point(size = 2) + xlab('Birth') + ylab('Death') + ggtitle('Sphere (homology)') + geom_abline(slope = 1, intercept = 0, col = 'black', size = 0.4) + scale_color_manual('Dimension', values = c("0 no" = "grey70", "0 sig" = 'firebrick1', "1 no" = "grey70", "1 sig" = 'royalblue2', "2 no" = "grey70", "2 sig" = 'orchid1')) + scale_shape_manual('Dimension', values = c(15, 17, 19)) + theme_linedraw() + theme(panel.grid = element_blank(), axis.text = element_text(size = 11), axis.title = element_text(size = 12), plot.title = element_text(size = 11, face = 'bold', hjust = 0.5), legend.position = "none") spherehyper_PH_sig_plot torus_PH_sig_plot <- ggplot(torus_PH_plotting, aes(x = birth, y = death, shape = as.factor(dimension), col = paste(dimension, colour))) + geom_point(size = 2) + xlab('Birth') + ylab('Death') + ggtitle('Torus') + geom_abline(slope = 1, intercept = 0, col = 'black', size = 0.4) + scale_color_manual('Dimension', values = c("0 no" = "grey70", "0 sig" = 'firebrick1', "1 no" = "grey70", "1 sig" = 'royalblue2', "2 no" = "grey70", "2 sig" = 'orchid1')) + scale_shape_manual('Dimension', values = c(15, 17, 19)) + theme_linedraw() + theme(panel.grid = element_blank(), axis.text = element_text(size = 11), axis.title = element_text(size = 12), plot.title = element_text(size = 11, face = 'bold', hjust = 0.5), legend.position = "none") torus_PH_sig_plot torushyper_PH_sig_plot <- ggplot(torushyper_PH_plotting, aes(x = birth, y = death, shape = as.factor(dimension), col = paste(dimension, colour))) + geom_point(size = 2) + xlab('Birth') + ylab('Death') + ggtitle('Torus (homology)') + geom_abline(slope = 1, intercept = 0, col = 'black', size = 0.4) + scale_color_manual('Dimension', values = c("0 no" = "grey70", "0 sig" = 'firebrick1', "1 no" = "grey70", "1 sig" = 'royalblue2', "2 no" = "grey70", "2 sig" = 'orchid1')) + scale_shape_manual('Dimension', values = c(15, 17, 19)) + theme_linedraw() + theme(panel.grid = element_blank(), axis.text = element_text(size = 11), axis.title = element_text(size = 12), plot.title = element_text(size = 11, face = 'bold', hjust = 0.5), legend.position = "none") torushyper_PH_sig_plot library(patchwork) sphere_plot <- ggplot(data.frame(sphere), aes(x = x1, y = x2, col = x3)) + geom_point() + scale_color_continuous(type = 'viridis') + theme_linedraw() + ggtitle('Sphere') + theme(panel.grid = element_blank(), axis.text = element_text(size = 11), axis.title = element_text(size = 12), plot.title = element_text(size = 11, face = 'bold', hjust = 0.5)) torus_plot <- ggplot(data.frame(torus), aes(x = x1, y = x2, col = x3)) + geom_point() + scale_color_continuous(type = 'viridis') + theme_linedraw() + ggtitle('Torus') + theme(panel.grid = element_blank(), axis.text = element_text(size = 11), axis.title = element_text(size = 12), plot.title = element_text(size = 11, face = 'bold', hjust = 0.5)) wrap_plots(sphere_plot, torus_plot, sphere_PH_sig_plot, torus_PH_sig_plot, spherehyper_PH_sig_plot, torushyper_PH_sig_plot, ncol = 2) # b) Run PH in normal and hyper species ## Loading Soberon data ## data <- readxl::read_xlsx("GBIF_Thinned_2.xlsx") levels(as.factor(data$Family)) head(data) ## subsetting some species ## data_short_gamba <- data %>% filter(Family == 'DIDELPHIDAE') %>% filter(Species == 'marsupialis') data_short_antilope$Name data_short_tamandua <- data %>% filter(Family == 'MYRMECOPHAGIDAE') %>% filter(Species == 'mexicana') data_short_lynx <- data %>% filter(Family == 'FELIDAE') %>% filter(Species == 'canadensis') data_short_coyote <- data %>% filter(Family == 'SORICIDAE') %>% filter(Species == 'brevicauda') data_short_antilope <- data %>% filter(Family == 'ANTILOCAPRIDAE') %>% filter(Species == 'americana') ### Hypervolumes ### # Gamba gambahyper <- hypervolume(data = data_short_gamba[13:15], name = 'Gamba') gambaconvex <- expectation_convex(hypervolume_thin(gambahyper, num.points = 200), check.memory=FALSE,use.random=TRUE) gambafeature <- hypervolume_holes(gambahyper , gambaconvex, set.check.memory=FALSE) data_short_gamba_selected <- data_short_gamba %>% dplyr::select(bio5, bio6, bio12, Family, Genus, Species, Name) gamba_PH <- calculate_homology(cbind(data_short_gamba_selected$bio5, data_short_gamba_selected$bio6, data_short_gamba_selected$bio12), dim = 2) gambahyper_short <- data.frame(gambahyper@RandomPoints) %>% sample_n(300) gambahyper_PH <- calculate_homology(cbind(gambahyper_short$bio5, gambahyper_short$bio6, gambahyper_short$bio12), dim = 2) ## obtaining significance thresholds gamba_PH_sig <- get_sign_dims(gamba_PH, dim = 1) gambahyper_PH_sig <- get_sign_dims(gambahyper_PH, dim =2) ## Data frame for plotting gamba_PH_plotting <- assign_cols_PH(inner_join(as.data.frame(gamba_PH), gamba_PH_sig) %>% mutate(colour = ifelse(.$death - .$birth > threshold, 'sig', 'no'))) gambahyper_PH_plotting <- assign_cols_PH(inner_join(as.data.frame(gambahyper_PH), gambahyper_PH_sig) %>% mutate(colour = ifelse(.$death - .$birth > threshold, 'sig', 'no'))) head(data_short_gamba_selected) ## plotting ## gamba_plot <- ggplot(as.data.frame(gambahyper@RandomPoints), aes(x = bio5, y = bio6, col = bio12)) + geom_point() + scale_color_continuous(type = 'viridis') + theme_linedraw() + ggtitle('D. marsupialis') + theme(panel.grid = element_blank(), axis.text = element_text(size = 8), axis.title = element_text(size = 12), plot.title = element_text(size = 11, face = 'bold', hjust = 0.5)) gamba_PH_sig_plot <- ggplot(gamba_PH_plotting, aes(x = birth, y = death, shape = as.factor(dimension), col = paste(dimension, colour))) + geom_point(size = 2) + xlab('Birth') + ylab('Death') + ggtitle('D. marsupialis') + geom_abline(slope = 1, intercept = 0, col = 'black', size = 0.4) + scale_color_manual('Dimension', values = c("0 no" = "grey70", "0 sig" = 'firebrick1', "1 no" = "grey70", "1 sig" = 'royalblue2', "2 no" = "grey70", "2 sig" = 'orchid1')) + scale_shape_manual('Dimension', values = c(15, 17, 19)) + theme_linedraw() + theme(panel.grid = element_blank(), axis.text = element_text(size = 11), axis.title = element_text(size = 12), plot.title = element_text(size = 11, face = 'bold', hjust = 0.5), legend.position = "none") gamba_PH_sig_plot ## hyper gambahyper_PH_sig_plot <- ggplot(gambahyper_PH_plotting, aes(x = birth, y = death, shape = as.factor(dimension), col = paste(dimension, colour))) + geom_point(size = 2) + xlab('Birth') + ylab('Death') + ggtitle('D. marsupialis (homology)') + geom_abline(slope = 1, intercept = 0, col = 'black', size = 0.4) + scale_color_manual('Dimension', values = c("0 no" = "grey70", "0 sig" = 'firebrick1', "1 no" = "grey70", "1 sig" = 'royalblue2', "2 no" = "grey70", "2 sig" = 'orchid1')) + scale_shape_manual('Dimension', values = c(15, 17, 19)) + theme_linedraw() + theme(panel.grid = element_blank(), axis.text = element_text(size = 11), axis.title = element_text(size = 12), plot.title = element_text(size = 11, face = 'bold', hjust = 0.5), legend.position = "none") gambahyper_PH_sig_plot #Tamandua tamanduahyper <- hypervolume(data = data_short_tamandua[13:15], name = 'Tamandua') tamanduaconvex <- expectation_convex(hypervolume_thin(tamanduahyper, num.points = 200), check.memory=FALSE,use.random=TRUE) tamanduafeature <- hypervolume_holes(tamanduahyper , tamanduaconvex, set.check.memory=FALSE) # tamandua data_short_tamandua_selected <- data_short_tamandua %>% dplyr::select(bio5, bio6, bio12, Family, Genus, Species, Name) tamandua_PH <- calculate_homology(cbind(data_short_tamandua_selected$bio5, data_short_tamandua_selected$bio6, data_short_tamandua_selected$bio12), dim = 2) tamanduahyper_short <- data.frame(tamanduahyper@RandomPoints) %>% sample_n(300) tamanduahyper_PH <- calculate_homology(cbind(tamanduahyper_short$bio5, tamanduahyper_short$bio6, tamanduahyper_short$bio12), dim = 2) ## obtaining significance thresholds tamandua_PH_sig <- get_sign_dims(tamandua_PH, dim = 0) tamanduahyper_PH_sig <- get_sign_dims(tamanduahyper_PH, dim =2) ## Data frame for plotting tamandua_PH_plotting <- assign_cols_PH(inner_join(as.data.frame(tamandua_PH), tamandua_PH_sig) %>% mutate(colour = ifelse(.$death - .$birth > threshold, 'sig', 'no'))) tamanduahyper_PH_plotting <- assign_cols_PH(inner_join(as.data.frame(tamanduahyper_PH), tamanduahyper_PH_sig) %>% mutate(colour = ifelse(.$death - .$birth > threshold, 'sig', 'no'))) head(data_short_tamandua_selected) ## plotting ## tamandua_plot <- ggplot(as.data.frame(tamanduahyper@RandomPoints), aes(x = bio5, y = bio6, col = bio12)) + geom_point() + scale_color_continuous(type = 'viridis') + theme_linedraw() + ggtitle('T. mexicana') + theme(panel.grid = element_blank(), axis.text = element_text(size = 8), axis.title = element_text(size = 12), plot.title = element_text(size = 11, face = 'bold', hjust = 0.5)) tamandua_PH_sig_plot <- ggplot(tamandua_PH_plotting, aes(x = birth, y = death, shape = as.factor(dimension), col = paste(dimension, colour))) + geom_point(size = 2) + xlab('Birth') + ylab('Death') + ggtitle('T. mexicana') + geom_abline(slope = 1, intercept = 0, col = 'black', size = 0.4) + scale_color_manual('Dimension', values = c("0 no" = "grey70", "0 sig" = 'firebrick1', "1 no" = "grey70", "1 sig" = 'royalblue2', "2 no" = "grey70", "2 sig" = 'orchid1')) + scale_shape_manual('Dimension', values = c(15, 17, 19)) + theme_linedraw() + theme(panel.grid = element_blank(), axis.text = element_text(size = 11), axis.title = element_text(size = 12), plot.title = element_text(size = 11, face = 'bold', hjust = 0.5), legend.position = "none") tamandua_PH_sig_plot ## hyper tamanduahyper_PH_sig_plot <- ggplot(tamanduahyper_PH_plotting, aes(x = birth, y = death, shape = as.factor(dimension), col = paste(dimension, colour))) + geom_point(size = 2) + xlab('Birth') + ylab('Death') + ggtitle('T. mexicana (homology)') + geom_abline(slope = 1, intercept = 0, col = 'black', size = 0.4) + scale_color_manual('Dimension', values = c("0 no" = "grey70", "0 sig" = 'firebrick1', "1 no" = "grey70", "1 sig" = 'royalblue2', "2 no" = "grey70", "2 sig" = 'orchid1')) + scale_shape_manual('Dimension', values = c(15, 17, 19)) + theme_linedraw() + theme(panel.grid = element_blank(), axis.text = element_text(size = 11), axis.title = element_text(size = 12), plot.title = element_text(size = 11, face = 'bold', hjust = 0.5), legend.position = "none") tamanduahyper_PH_sig_plot ## Lynx lynxhyper <- hypervolume(data = data_short_lynx[13:15], name = 'lynx') lynxconvex <- expectation_convex(hypervolume_thin(lynxhyper, num.points = 200), check.memory=FALSE,use.random=TRUE) #lynxfeature <- hypervolume_holes(lynxhyper , lynxconvex, set.check.memory=FALSE) data_short_lynx_selected <- data_short_lynx %>% dplyr::select(bio5, bio6, bio12, Family, Genus, Species, Name) lynx_PH <- calculate_homology(cbind(data_short_lynx_selected$bio5, data_short_lynx_selected$bio6, data_short_lynx_selected$bio12), dim = 2) lynxhyper_short <- data.frame(lynxhyper@RandomPoints) %>% sample_n(300) lynxhyper_PH <- calculate_homology(cbind(lynxhyper_short$bio5, lynxhyper_short$bio6, lynxhyper_short$bio12), dim = 2) ## obtaining significance thresholds lynx_PH_sig <- get_sign_dims(lynx_PH, dim = 2) lynxhyper_PH_sig <- get_sign_dims(lynxhyper_PH, dim =2) ## Data frame for plotting lynx_PH_plotting <- assign_cols_PH(inner_join(as.data.frame(lynx_PH), lynx_PH_sig) %>% mutate(colour = ifelse(.$death - .$birth > threshold, 'sig', 'no'))) lynxhyper_PH_plotting <- assign_cols_PH(inner_join(as.data.frame(lynxhyper_PH), lynxhyper_PH_sig) %>% mutate(colour = ifelse(.$death - .$birth > threshold, 'sig', 'no'))) ## plotting ## lynx_plot <- ggplot(as.data.frame(lynxhyper@RandomPoints), aes(x = bio5, y = bio6, col = bio12)) + geom_point() + scale_color_continuous(type = 'viridis') + theme_linedraw() + ggtitle('L. canadensis') + theme(panel.grid = element_blank(), axis.text = element_text(size = 8), axis.title = element_text(size = 12), plot.title = element_text(size = 11, face = 'bold', hjust = 0.5)) lynx_PH_sig_plot <- ggplot(lynx_PH_plotting, aes(x = birth, y = death, shape = as.factor(dimension), col = paste(dimension, colour))) + geom_point(size = 2) + xlab('Birth') + ylab('Death') + ggtitle('L. canadensis') + geom_abline(slope = 1, intercept = 0, col = 'black', size = 0.4) + scale_color_manual('Dimension', values = c("0 no" = "grey70", "0 sig" = 'firebrick1', "1 no" = "grey70", "1 sig" = 'royalblue2', "2 no" = "grey70", "2 sig" = 'orchid1')) + scale_shape_manual('Dimension', values = c(15, 17, 19)) + theme_linedraw() + theme(panel.grid = element_blank(), axis.text = element_text(size = 11), axis.title = element_text(size = 12), plot.title = element_text(size = 11, face = 'bold', hjust = 0.5), legend.position = "none") lynx_PH_sig_plot ## hyper lynxhyper_PH_sig_plot <- ggplot(lynxhyper_PH_plotting, aes(x = birth, y = death, shape = as.factor(dimension), col = paste(dimension, colour))) + geom_point(size = 2) + xlab('Birth') + ylab('Death') + ggtitle('L. canadensis (homology)') + geom_abline(slope = 1, intercept = 0, col = 'black', size = 0.4) + scale_color_manual('Dimension', values = c("0 no" = "grey70", "0 sig" = 'firebrick1', "1 no" = "grey70", "1 sig" = 'royalblue2', "2 no" = "grey70", "2 sig" = 'orchid1')) + scale_shape_manual('Dimension', values = c(15, 17, 19)) + theme_linedraw() + theme(panel.grid = element_blank(), axis.text = element_text(size = 11), axis.title = element_text(size = 12), plot.title = element_text(size = 11, face = 'bold', hjust = 0.5), legend.position = "none") lynxhyper_PH_sig_plot ## Coyote # coyote coyotehyper <- hypervolume(data = data_short_coyote[13:15], name = 'coyote') coyoteconvex <- expectation_convex(hypervolume_thin(coyotehyper, num.points = 200), check.memory=FALSE,use.random=TRUE) #coyotefeature <- hypervolume_holes(coyotehyper , coyoteconvex, set.check.memory=FALSE) data_short_coyote_selected <- data_short_coyote %>% dplyr::select(bio5, bio6, bio12, Family, Genus, Species, Name) coyote_PH <- calculate_homology(cbind(data_short_coyote_selected$bio5, data_short_coyote_selected$bio6, data_short_coyote_selected$bio12), dim = 2) coyotehyper_short <- data.frame(coyotehyper@RandomPoints) %>% sample_n(300) coyotehyper_PH <- calculate_homology(cbind(coyotehyper_short$bio5, coyotehyper_short$bio6, coyotehyper_short$bio12), dim = 2) ## obtaining significance thresholds coyote_PH_sig <- get_sign_dims(coyote_PH, dim = 2) coyotehyper_PH_sig <- get_sign_dims(coyotehyper_PH, dim =2) ## Data frame for plotting coyote_PH_plotting <- assign_cols_PH(inner_join(as.data.frame(coyote_PH), coyote_PH_sig) %>% mutate(colour = ifelse(.$death - .$birth > threshold, 'sig', 'no'))) coyotehyper_PH_plotting <- assign_cols_PH(inner_join(as.data.frame(coyotehyper_PH), coyotehyper_PH_sig) %>% mutate(colour = ifelse(.$death - .$birth > threshold, 'sig', 'no'))) head(data_short_coyote_selected) ## plotting ## coyote_plot <- ggplot(as.data.frame(coyotehyper@RandomPoints), aes(x = bio5, y = bio6, col = bio12)) + geom_point() + scale_color_continuous(type = 'viridis') + theme_linedraw() + ggtitle('B. brevicauda') + theme(panel.grid = element_blank(), axis.text = element_text(size = 8), axis.title = element_text(size = 12), plot.title = element_text(size = 11, face = 'bold', hjust = 0.5)) coyote_PH_sig_plot <- ggplot(coyote_PH_plotting, aes(x = birth, y = death, shape = as.factor(dimension), col = paste(dimension, colour))) + geom_point(size = 2) + xlab('Birth') + ylab('Death') + ggtitle('B. brevicauda') + geom_abline(slope = 1, intercept = 0, col = 'black', size = 0.4) + scale_color_manual('Dimension', values = c("0 no" = "grey70", "0 sig" = 'firebrick1', "1 no" = "grey70", "1 sig" = 'royalblue2', "2 no" = "grey70", "2 sig" = 'orchid1')) + scale_shape_manual('Dimension', values = c(15, 17, 19)) + theme_linedraw() + theme(panel.grid = element_blank(), axis.text = element_text(size = 11), axis.title = element_text(size = 12), plot.title = element_text(size = 11, face = 'bold', hjust = 0.5), legend.position = "none") coyote_PH_sig_plot ## hyper coyotehyper_PH_sig_plot <- ggplot(coyotehyper_PH_plotting, aes(x = birth, y = death, shape = as.factor(dimension), col = paste(dimension, colour))) + geom_point(size = 2) + xlab('Birth') + ylab('Death') + ggtitle('B. brevicauda (homology)') + geom_abline(slope = 1, intercept = 0, col = 'black', size = 0.4) + scale_color_manual('Dimension', values = c("0 no" = "grey70", "0 sig" = 'firebrick1', "1 no" = "grey70", "1 sig" = 'royalblue2', "2 no" = "grey70", "2 sig" = 'orchid1')) + scale_shape_manual('Dimension', values = c(15, 17, 19)) + theme_linedraw() + theme(panel.grid = element_blank(), axis.text = element_text(size = 11), axis.title = element_text(size = 12), plot.title = element_text(size = 11, face = 'bold', hjust = 0.5), legend.position = "none") coyotehyper_PH_sig_plot ### Antilope # antilope antilopehyper <- hypervolume(data = data_short_antilope[13:15], name = 'antilope') antilopeconvex <- expectation_convex(hypervolume_thin(antilopehyper, num.points = 200), check.memory=FALSE,use.random=TRUE) #antilopefeature <- hypervolume_holes(antilopehyper , antilopeconvex, set.check.memory=FALSE) data_short_antilope_selected <- data_short_antilope %>% dplyr::select(bio5, bio6, bio12, Family, Genus, Species, Name) antilope_PH <- calculate_homology(cbind(data_short_antilope_selected$bio5, data_short_antilope_selected$bio6, data_short_antilope_selected$bio12), dim = 2) antilopehyper_short <- data.frame(antilopehyper@RandomPoints) %>% sample_n(300) antilopehyper_PH <- calculate_homology(cbind(antilopehyper_short$bio5, antilopehyper_short$bio6, antilopehyper_short$bio12), dim = 2) ## obtaining significance thresholds antilope_PH_sig <- get_sign_dims(antilope_PH, dim = 2) antilopehyper_PH_sig <- get_sign_dims(antilopehyper_PH, dim =2) ## Data frame for plotting antilope_PH_plotting <- assign_cols_PH(inner_join(as.data.frame(antilope_PH), antilope_PH_sig) %>% mutate(colour = ifelse(.$death - .$birth > threshold, 'sig', 'no'))) antilopehyper_PH_plotting <- assign_cols_PH(inner_join(as.data.frame(antilopehyper_PH), antilopehyper_PH_sig) %>% mutate(colour = ifelse(.$death - .$birth > threshold, 'sig', 'no'))) head(data_short_antilope_selected) ## plotting ## antilope_plot <- ggplot(as.data.frame(antilopehyper@RandomPoints), aes(x = bio5, y = bio6, col = bio12)) + geom_point() + scale_color_continuous(type = 'viridis') + theme_linedraw() + ggtitle('A. americana') + theme(panel.grid = element_blank(), axis.text = element_text(size = 8), axis.title = element_text(size = 12), plot.title = element_text(size = 11, face = 'bold', hjust = 0.5)) antilope_PH_sig_plot <- ggplot(antilope_PH_plotting, aes(x = birth, y = death, shape = as.factor(dimension), col = paste(dimension, colour))) + geom_point(size = 2) + xlab('Birth') + ylab('Death') + ggtitle('A. americana') + geom_abline(slope = 1, intercept = 0, col = 'black', size = 0.4) + scale_color_manual('Dimension', values = c("0 no" = "grey70", "0 sig" = 'firebrick1', "1 no" = "grey70", "1 sig" = 'royalblue2', "2 no" = "grey70", "2 sig" = 'orchid1')) + scale_shape_manual('Dimension', values = c(15, 17, 19)) + theme_linedraw() + theme(panel.grid = element_blank(), axis.text = element_text(size = 11), axis.title = element_text(size = 12), plot.title = element_text(size = 11, face = 'bold', hjust = 0.5), legend.position = "none") antilope_PH_sig_plot ## hyper antilopehyper_PH_sig_plot <- ggplot(antilopehyper_PH_plotting, aes(x = birth, y = death, shape = as.factor(dimension), col = paste(dimension, colour))) + geom_point(size = 2) + xlab('Birth') + ylab('Death') + ggtitle('A. americana (homology)') + geom_abline(slope = 1, intercept = 0, col = 'black', size = 0.4) + scale_color_manual('Dimension', values = c("0 no" = "grey70", "0 sig" = 'firebrick1', "1 no" = "grey70", "1 sig" = 'royalblue2', "2 no" = "grey70", "2 sig" = 'orchid1')) + scale_shape_manual('Dimension', values = c(15, 17, 19)) + theme_linedraw() + theme(panel.grid = element_blank(), axis.text = element_text(size = 11), axis.title = element_text(size = 12), plot.title = element_text(size = 11, face = 'bold', hjust = 0.5), legend.position = "none") antilopehyper_PH_sig_plot wrap_plots(gamba_plot, tamandua_plot, coyote_plot, lynx_plot, antilope_plot, gambahyper_PH_sig_plot, tamanduahyper_PH_sig_plot, coyotehyper_PH_sig_plot, lynxhyper_PH_sig_plot, antilopehyper_PH_sig_plot, ncol = 5) + plot_annotation(tag_levels = 'a', tag_suffix = '.')