annotate comparison_div.r @ 0:fbffdeefb146 draft

Uploaded
author ecology
date Sun, 08 Jan 2023 23:03:35 +0000
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
1 #Rscript
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
2
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
3 ###########################################
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
4 ## Mapping alpha and beta diversity ##
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
5 ###########################################
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
6
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
7 #####Packages : stars
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
8 # utils
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
9 # biodivmapr
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
10 # raster
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
11 # sf
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
12 # mapview
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
13 # leafpop
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
14 # RColorBrewer
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
15 # labdsv
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
16 # rgdal
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
17 # ggplot2
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
18 # gridExtra
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
19 ##remotes::install_github("jbferet/biodivMapR")
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
20 #####Load arguments
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
21
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
22 args <- commandArgs(trailingOnly = TRUE)
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
23
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
24 #####Import the S2 data
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
25
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
26 if (length(args) < 1) {
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
27 stop("This tool needs at least 1 argument")
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
28 }else {
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
29 data_raster <- args[1]
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
30 rasterheader <- args[2]
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
31 data <- args[3]
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
32 plots_zip <- args[4]
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
33 choice <- as.character(args[5])
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
34 source(args[6])
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
35 # type of PCA:
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
36 # PCA: no rescaling of the data
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
37 # SPCA: rescaling of the data
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
38 typepca <- as.character(args[7])
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
39 }
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
40
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
41 ################################################################################
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
42 ## DEFINE PARAMETERS FOR DATASET TO BE PROCESSED ##
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
43 ################################################################################
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
44 if (data_raster == "") {
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
45 #Create a directory where to unzip your folder of data
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
46 dir.create("data_dir")
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
47 unzip(data, exdir = "data_dir")
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
48 # Path to raster
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
49 data_raster <- list.files("data_dir/results/Reflectance", pattern = "_Refl")
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
50 input_image_file <- file.path("data_dir/results/Reflectance", data_raster[1])
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
51 input_header_file <- file.path("data_dir/results/Reflectance", data_raster[2])
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
52
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
53 } else {
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
54 input_image_file <- file.path(getwd(), data_raster, fsep = "/")
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
55 input_header_file <- file.path(getwd(), rasterheader, fsep = "/")
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
56 }
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
57
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
58 ################################################################################
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
59 ## PROCESS IMAGE ##
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
60 ################################################################################
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
61 # 1- Filter data in order to discard non vegetated / shaded / cloudy pixels
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
62
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
63 print("PERFORM PCA ON RASTER")
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
64 pca_output <- biodivMapR::perform_PCA(Input_Image_File = input_image_file, Input_Mask_File = input_mask_file,
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
65 Output_Dir = output_dir, TypePCA = typepca, FilterPCA = filterpca, nbCPU = nbcpu, MaxRAM = maxram)
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
66
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
67 pca_files <- pca_output$PCA_Files
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
68 pix_per_partition <- pca_output$Pix_Per_Partition
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
69 nb_partitions <- pca_output$nb_partitions
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
70 # path for the updated mask
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
71 input_mask_file <- pca_output$MaskPath
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
72
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
73 # 3- Select principal components from the PCA raster
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
74 # Select components from the PCA/SPCA/MNF raster
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
75 sel_compo <- c("1\n", "2\n", "3\n", "4\n", "5\n", "6\n", "7\n", "8")
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
76 image_name <- tools::file_path_sans_ext(basename(input_image_file))
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
77 output_dir_full <- file.path(output_dir, image_name, typepca, "PCA")
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
78
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
79 write.table(sel_compo, paste0(output_dir_full, "/Selected_Components.txt"))
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
80 sel_pc <- file.path(output_dir_full, "Selected_Components.txt")
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
81
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
82
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
83 ################################################################################
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
84 ## MAP ALPHA AND BETA DIVERSITY ##
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
85 ################################################################################
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
86 print("MAP SPECTRAL SPECIES")
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
87
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
88 kmeans_info <- biodivMapR::map_spectral_species(Input_Image_File = input_image_file, Output_Dir = output_dir, PCA_Files = pca_files, Input_Mask_File = input_mask_file, Pix_Per_Partition = pix_per_partition, nb_partitions = nb_partitions, nbCPU = nbcpu, MaxRAM = maxram, nbclusters = nbclusters, TypePCA = typepca)
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
89
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
90 ################################################################################
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
91 ## COMPUTE ALPHA AND BETA DIVERSITY FROM FIELD PLOTS ##
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
92 ################################################################################
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
93 ## read selected features from dimensionality reduction
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
94
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
95 ## path for selected components
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
96
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
97 # location of the directory where shapefiles used for validation are saved
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
98 dir.create("VectorDir")
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
99 unzip(plots_zip, exdir = "VectorDir")
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
100
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
101 # list vector data
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
102 path_vector <- biodivMapR::list_shp("VectorDir")
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
103 name_vector <- tools::file_path_sans_ext(basename(path_vector))
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
104
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
105 # location of the spectral species raster needed for validation
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
106 path_spectralspecies <- kmeans_info$SpectralSpecies
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
107 # get diversity indicators corresponding to shapefiles (no partitioning of spectral dibversity based on field plots so far...)
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
108 biodiv_indicators <- biodivMapR::diversity_from_plots(Raster_SpectralSpecies = path_spectralspecies, Plots = path_vector, nbclusters = nbclusters, Raster_Functional = pca_files, Selected_Features = FALSE)
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
109
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
110 shannon_rs <- c(biodiv_indicators$Shannon)[[1]]
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
111 fric <- c(biodiv_indicators$FunctionalDiversity$FRic)
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
112 feve <- c(biodiv_indicators$FunctionalDiversity$FEve)
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
113 fdiv <- c(biodiv_indicators$FunctionalDiversity$FDiv)
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
114 # if no name for plots
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
115 biodiv_indicators$Name_Plot <- seq(1, length(biodiv_indicators$Shannon[[1]]), by = 1)
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
116
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
117
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
118 ####################################################
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
119 # write RS indicators #
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
120 ####################################################
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
121 # write a table for Shannon index
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
122
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
123 # write a table for all spectral diversity indices corresponding to alpha diversity
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
124 results <- data.frame(name_vector, biodiv_indicators$Richness, biodiv_indicators$Fisher,
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
125 biodiv_indicators$Shannon, biodiv_indicators$Simpson,
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
126 biodiv_indicators$FunctionalDiversity$FRic,
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
127 biodiv_indicators$FunctionalDiversity$FEve,
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
128 biodiv_indicators$FunctionalDiversity$FDiv)
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
129
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
130 names(results) <- c("ID_Plot", "Species_Richness", "Fisher", "Shannon", "Simpson", "fric", "feve", "fdiv")
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
131 write.table(results, file = "Diversity.tabular", sep = "\t", dec = ".", na = " ", row.names = FALSE, col.names = TRUE, quote = FALSE)
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
132
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
133 if (choice == "Y") {
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
134 # write a table for Bray Curtis dissimilarity
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
135 bc_mean <- biodiv_indicators$BCdiss
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
136 bray_curtis <- data.frame(name_vector, bc_mean)
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
137 colnames(bray_curtis) <- c("ID_Plot", bray_curtis[, 1])
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
138 write.table(bray_curtis, file = "BrayCurtis.tabular", sep = "\t", dec = ".", na = " ", row.names = FALSE, col.names = TRUE, quote = FALSE)
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
139
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
140 ####################################################
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
141 # illustrate results
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
142 ####################################################
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
143 # apply ordination using PCoA (same as done for map_beta_div)
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
144
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
145 mat_bc_dist <- as.dist(bc_mean, diag = FALSE, upper = FALSE)
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
146 betapco <- labdsv::pco(mat_bc_dist, k = 3)
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
147
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
148 # assign a type of vegetation to each plot, assuming that the type of vegetation
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
149 # is defined by the name of the shapefile
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
150
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
151 nbsamples <- shpname <- c()
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
152 for (i in 1:length(path_vector)) {
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
153 shp <- path_vector[i]
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
154 nbsamples[i] <- length(rgdal::readOGR(shp, verbose = FALSE))
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
155 shpname[i] <- tools::file_path_sans_ext(basename(shp))
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
156 }
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
157
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
158 type_vegetation <- c()
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
159 for (i in 1: length(nbsamples)) {
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
160 for (j in 1:nbsamples[i]) {
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
161 type_vegetation <- c(type_vegetation, shpname[i])
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
162 }
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
163 }
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
164
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
165 #data frame including a selection of alpha diversity metrics and beta diversity expressed as coordinates in the PCoA space
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
166 results <- data.frame("vgtype" = type_vegetation, "pco1" = betapco$points[, 1], "pco2" = betapco$points[, 2], "pco3" = betapco$points[, 3], "shannon" = shannon_rs, "fric" = fric, "feve" = feve, "fdiv" = fdiv)
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
167
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
168 #plot field data in the PCoA space, with size corresponding to shannon index
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
169 g1 <- ggplot2::ggplot(results, ggplot2::aes(x = pco1, y = pco2, color = vgtype, size = shannon)) + ggplot2::geom_point(alpha = 0.6) + ggplot2::scale_color_manual(values = c("#e6140a", "#e6d214", "#e68214", "#145ae6"))
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
170
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
171 g2 <- ggplot2::ggplot(results, ggplot2::aes(x = pco1, y = pco3, color = vgtype, size = shannon)) + ggplot2::geom_point(alpha = 0.6) + ggplot2::scale_color_manual(values = c("#e6140a", "#e6d214", "#e68214", "#145ae6"))
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
172
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
173 g3 <- ggplot2::ggplot(results, ggplot2::aes(x = pco2, y = pco3, color = vgtype, size = shannon)) + ggplot2::geom_point(alpha = 0.6) + ggplot2::scale_color_manual(values = c("#e6140a", "#e6d214", "#e68214", "#145ae6"))
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
174
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
175 #extract legend
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
176 get_legend <- function(a_gplot) {
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
177 tmp <- ggplot2::ggplot_gtable(ggplot2::ggplot_build(a_gplot))
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
178 leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
179 legend <- tmp$grobs[[leg]]
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
180 return(legend)
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
181 }
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
182
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
183 legend <- get_legend(g3)
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
184 gall <- gridExtra::grid.arrange(gridExtra::arrangeGrob(g1 + ggplot2::theme(legend.position = "none"), g2 + ggplot2::theme(legend.position = "none"), g3 + ggplot2::theme(legend.position = "none"), nrow = 1), legend, nrow = 2, heights = c(3, 2))
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
185
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
186
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
187 filename <- ggplot2::ggsave("BetaDiversity_PcoA1_vs_PcoA2_vs_PcoA3.png", gall, scale = 0.65, width = 12, height = 9, units = "in", dpi = 200, limitsize = TRUE)
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
188
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
189 filename
fbffdeefb146 Uploaded
ecology
parents:
diff changeset
190 }