From ecdd6cb10a39d73f7ce2b453111d134f8ef3ae4b Mon Sep 17 00:00:00 2001 From: tnauss Date: Wed, 26 Sep 2018 19:17:35 +0200 Subject: [PATCH 01/65] Add crosscheck routines --- src/000_set_environment.R | 47 +++++++++++++++++ src/010_rasterdb_hyperspectral_processing.R | 57 +++++++++++++++++++++ 2 files changed, 104 insertions(+) create mode 100644 src/000_set_environment.R create mode 100644 src/010_rasterdb_hyperspectral_processing.R diff --git a/src/000_set_environment.R b/src/000_set_environment.R new file mode 100644 index 0000000..a602408 --- /dev/null +++ b/src/000_set_environment.R @@ -0,0 +1,47 @@ +# Set path --------------------------------------------------------------------- +if(Sys.info()["sysname"] == "Windows"){ + filepath_base <- "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/" +} else { + filepath_base <- "/media/permanent/active/KI-Hyperspec/" +} + +path_data <- paste0(filepath_base, "/data/") +path_biodiv <- paste0(path_data, "/biodiv/") +path_org <- paste0(path_data, "/hypspec_org/") +path_plots <- paste0(path_data, "/plots/") +path_rdata <- paste0(path_data, "/rdata/") +path_temp <- paste0(path_data, "/temp/") +path_output <- paste0(path_data, "/output/") +path_vis <- paste0(path_data, "/vis/") + + +# Set libraries ---------------------------------------------------------------- +library(biodivTools) # devtools::install_github("environmentalinformatics-marburg/biodivTools") +library(doParallel) +library(CAST) +library(grid) +library(gridExtra) +library(gpm) +library(lavaan) +library(rgeos) +library(ggplot2) +library(mapview) +library(metTools) # devtools::install_github("environmentalinformatics-marburg/metTools") +library(raster) +library(reshape2) +library(rgdal) +library(satellite) +library(satelliteTools) # devtools::install_github("environmentalinformatics-marburg/satelliteTools") +library(semPlot) +library(sp) +library(vegan) +library(yaml) + +# Other settings --------------------------------------------------------------- +rasterOptions(tmpdir = path_temp) + +saga_cmd <- "C:/OSGeo4W64/apps/saga/saga_cmd.exe " +# initOTB("C:/OSGeo4W64/bin/") +initOTB("C:/OSGeo4W64/OTB-5.8.0-win64/OTB-5.8.0-win64/bin/") + + diff --git a/src/010_rasterdb_hyperspectral_processing.R b/src/010_rasterdb_hyperspectral_processing.R new file mode 100644 index 0000000..cd750d0 --- /dev/null +++ b/src/010_rasterdb_hyperspectral_processing.R @@ -0,0 +1,57 @@ +# Extract hyperspectral data from database using the extent of the plots as +# defined by polygons B + +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") + +# Set account +userpwd <- "thomas.nauss:cd7dLfgm" # use this account (if not loaded from file) + +# Open remote sensing database +remotesensing <- RemoteSensing$new("http://137.248.191.215:8081", userpwd) # remote server + +# Get rasterdb +dbs = c("kili_campaign1_hyperspectral_lvl3_2015", "kili_campaign2_hyperspectral_lvl3_2016") +for(db in dbs){ + dir.create(paste0(path_org, db), + showWarnings = FALSE) + rasterdb <- remotesensing$rasterdb(db) + bands = rasterdb$bands + saveRDS(bands, + file = paste0(path_org, db, "/bands_", db, ".rds")) + + # Get data + rg = "kili_poi_plots" + pois = remotesensing$poi_group(rg) + for(n in pois$name){ + poi <- remotesensing$poi(group_name=rg, poi_name=n) + ext <- extent_diameter(poi$x, poi$y, 100) + r <- rasterdb$raster(ext) + saveRDS(r, file = paste0(path_org, db, "/", n, ".rds")) + } +} + + +# Get data +rg = "kili_roi_plot_poles_b" +rois = remotesensing$roi_group(rg) +for(n in rois$name){ + roi <- remotesensing$roi(group_name=rg, roi_name=n) + ext <- extent(min(roi$polygon[[1]][,1]), max(roi$polygon[[1]][,1]), + min(roi$polygon[[1]][,2]), max(roi$polygon[[1]][,2])) + r <- rasterdb$raster(ext) + saveRDS(r, file = paste0(path_org, n, ".rds")) +} + + +# Check data +ds = list.files(path_org, full.names = TRUE) +pb = shapefile(paste0(path_plots, "BPolygon.shp")) + +temp = readRDS(ds[[1]]) +pb = spTransform(pb, projection(temp)) +for(d in ds){ + r = readRDS(d) + plot(r[[109]], main = substr(basename(d), 1, 4)) + plot(pb[grep(substr(basename(d), 1, 4), pb$PlotID),], add = TRUE) + mapview(r[[109]]) + pb[grep(substr(basename(d), 1, 4), pb$PlotID),] +} From 5c0c58d22308159fb8dba0df0a064191860809a1 Mon Sep 17 00:00:00 2001 From: tnauss Date: Wed, 26 Sep 2018 23:33:42 +0200 Subject: [PATCH 02/65] Update 010 --- src/010_rasterdb_hyperspectral_processing.R | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/010_rasterdb_hyperspectral_processing.R b/src/010_rasterdb_hyperspectral_processing.R index cd750d0..ada3cc0 100644 --- a/src/010_rasterdb_hyperspectral_processing.R +++ b/src/010_rasterdb_hyperspectral_processing.R @@ -31,16 +31,16 @@ for(db in dbs){ } -# Get data -rg = "kili_roi_plot_poles_b" -rois = remotesensing$roi_group(rg) -for(n in rois$name){ - roi <- remotesensing$roi(group_name=rg, roi_name=n) - ext <- extent(min(roi$polygon[[1]][,1]), max(roi$polygon[[1]][,1]), - min(roi$polygon[[1]][,2]), max(roi$polygon[[1]][,2])) - r <- rasterdb$raster(ext) - saveRDS(r, file = paste0(path_org, n, ".rds")) -} +# # Get data +# rg = "kili_roi_plot_poles_b" +# rois = remotesensing$roi_group(rg) +# for(n in rois$name){ +# roi <- remotesensing$roi(group_name=rg, roi_name=n) +# ext <- extent(min(roi$polygon[[1]][,1]), max(roi$polygon[[1]][,1]), +# min(roi$polygon[[1]][,2]), max(roi$polygon[[1]][,2])) +# r <- rasterdb$raster(ext) +# saveRDS(r, file = paste0(path_org, n, ".rds")) +# } # Check data From 992c6d80364840be00bdbbec7356b67986ce5cfb Mon Sep 17 00:00:00 2001 From: tnauss Date: Thu, 27 Sep 2018 22:07:08 +0200 Subject: [PATCH 03/65] Update --- src/Neues Textdokument.txt | 6 ++++++ 1 file changed, 6 insertions(+) create mode 100644 src/Neues Textdokument.txt diff --git a/src/Neues Textdokument.txt b/src/Neues Textdokument.txt new file mode 100644 index 0000000..e996ee2 --- /dev/null +++ b/src/Neues Textdokument.txt @@ -0,0 +1,6 @@ +1. PCA +2. PCA inverse (95%) +3. VegIndices +4. Haralick (8, 16, x), 1, 3, 9 15 30 m, welches Band? PCA 1? nur die, die gut sind +5. Openness, closeness +5. Mean, SD, Rao Q pro Datenlayer und einmal über alle, Rao Q ggf. auf Fenstern From 14d14612a4ced32edf6dce7635560c367e7b6fdd Mon Sep 17 00:00:00 2001 From: tnauss Date: Fri, 5 Oct 2018 20:00:20 +0200 Subject: [PATCH 04/65] Use filled images --- src/000_set_environment.R | 54 +- src/001_functions.R | 1120 +++++++++++++++++++ src/010_biodiv_preprocessing.R | 14 + src/010_rasterdb_hyperspectral_processing.R | 57 - src/020_rasterdb_hyperspectral_processing.R | 79 ++ src/025_extract_aoi.R | 28 + src/030_noise_removal.R | 65 ++ src/040_vegIndices.R | 46 + src/050_divIndices.R | 34 + 9 files changed, 1420 insertions(+), 77 deletions(-) create mode 100644 src/001_functions.R create mode 100644 src/010_biodiv_preprocessing.R delete mode 100644 src/010_rasterdb_hyperspectral_processing.R create mode 100644 src/020_rasterdb_hyperspectral_processing.R create mode 100644 src/025_extract_aoi.R create mode 100644 src/030_noise_removal.R create mode 100644 src/040_vegIndices.R create mode 100644 src/050_divIndices.R diff --git a/src/000_set_environment.R b/src/000_set_environment.R index a602408..80540f4 100644 --- a/src/000_set_environment.R +++ b/src/000_set_environment.R @@ -1,47 +1,61 @@ # Set path --------------------------------------------------------------------- if(Sys.info()["sysname"] == "Windows"){ - filepath_base <- "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/" + filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/" } else { - filepath_base <- "/media/permanent/active/KI-Hyperspec/" + filepath_base = "/media/permanent/active/KI-Hyperspec/" } -path_data <- paste0(filepath_base, "/data/") -path_biodiv <- paste0(path_data, "/biodiv/") -path_org <- paste0(path_data, "/hypspec_org/") -path_plots <- paste0(path_data, "/plots/") -path_rdata <- paste0(path_data, "/rdata/") -path_temp <- paste0(path_data, "/temp/") -path_output <- paste0(path_data, "/output/") -path_vis <- paste0(path_data, "/vis/") +filepath_source = paste0(filepath_base, "HySpec_KiLi/src/001_functions.R") +path_data = paste0(filepath_base, "/data/") +path_biodiv = paste0(path_data, "/biodiv/") + +path_hyp_org = paste0(path_data, "/020_hypspec_org/") +path_hyp_aio = paste0(path_data, "/025_hypspec_aio/") +path_hyp_nrm = paste0(path_data, "/030_hypspec_nrm/") +path_hyp_vegidcs = paste0(path_data, "/040_hypspec_vegidcs/") +path_hyp_dividcs = paste0(path_data, "/050_hypspec_dividcs/") + +path_plots = paste0(path_data, "/plots/") +path_rdata = paste0(path_data, "/rdata/") +path_meta = paste0(path_data, "/meta/") +path_temp = paste0(path_data, "/temp/") +path_output = paste0(path_data, "/output/") +path_vis = paste0(path_data, "/vis/") # Set libraries ---------------------------------------------------------------- library(biodivTools) # devtools::install_github("environmentalinformatics-marburg/biodivTools") -library(doParallel) library(CAST) +library(doParallel) library(grid) library(gridExtra) -library(gpm) -library(lavaan) +# library(gpm) +library(hsdar) +# library(lavaan) +# library(rPointDB) library(rgeos) library(ggplot2) library(mapview) -library(metTools) # devtools::install_github("environmentalinformatics-marburg/metTools") +# library(metTools) # devtools::install_github("environmentalinformatics-marburg/metTools") library(raster) +library(RStoolbox) library(reshape2) library(rgdal) -library(satellite) -library(satelliteTools) # devtools::install_github("environmentalinformatics-marburg/satelliteTools") -library(semPlot) +# library(satellite) +# library(satelliteTools) # devtools::install_github("environmentalinformatics-marburg/satelliteTools") +# library(semPlot) library(sp) -library(vegan) -library(yaml) +library(spacetime) +library(spectralrao) # devtools::install_github("mattmar/spectralrao") +# library(vegan) +# library(yaml) # Other settings --------------------------------------------------------------- rasterOptions(tmpdir = path_temp) -saga_cmd <- "C:/OSGeo4W64/apps/saga/saga_cmd.exe " +saga_cmd = "C:/OSGeo4W64/apps/saga/saga_cmd.exe " # initOTB("C:/OSGeo4W64/bin/") initOTB("C:/OSGeo4W64/OTB-5.8.0-win64/OTB-5.8.0-win64/bin/") +source(filepath_source) diff --git a/src/001_functions.R b/src/001_functions.R new file mode 100644 index 0000000..d1d754d --- /dev/null +++ b/src/001_functions.R @@ -0,0 +1,1120 @@ +# Visually check data +visCheck = function(datapath, polygonfile, band = 109){ + ds = list.files(datapath, full.names = TRUE) + pb = shapefile(polygonfile) + + reproj = TRUE + for(d in ds){ + r = readRDS(d) + if(reproj){ + pb = spTransform(pb, projection(r)) + reproj = FALSE + } + plot(r[[band]], main = substr(basename(d), 1, 4)) + plot(pb[grep(substr(basename(d), 1, 4), pb$PlotID),], add = TRUE) + } +} + + +# Spectral rao +######### SPECTRALRAO ############################# +## Developed by Matteo Marcantonio +## Latest update: 04th October 2018 +## ------------------------------------------------- +## Code to calculate Rao's quadratic entropy on a +## numeric matrix, RasterLayer object (or lists) +## using a moving window algorithm. +## The function also calculates Shannon-Wiener index. +## ------------------------------------------------- +## Rao's Q Min = 0, if all pixel classes have +## distance 0. If the chosen distance ranges between +## 0 and 1, Rao's Max = 1-1/S (Simpson Diversity, +## where S is the number of pixel classes). +## ------------------------------------------------- +## Find more info and application here: +## 1) https://doi.org/10.1016/j.ecolind.2016.07.039 Titel anhand dieser DOI in Citavi-Projekt übernehmen +## 2) https://besjournals.onlinelibrary.wiley.com/doi/10.1111/2041-210X.12941 %CITAVIPICKER£10.1111/2041-210X.12941£Titel anhand dieser DOI in Citavi-Projekt übernehmen£% +##################################################### +# Function +spectralrao <- function(input, distance_m="euclidean", p=NULL, window=9, mode="classic", lambda=0, shannon=FALSE, rescale=FALSE, na.tolerance=0.0, simplify=3, nc.cores=1, cluster.type="MPI", debugging=FALSE, ...) +{ + # + ## Load required packages + # + require(raster) + require(svMisc) + require(proxy) + # + ## Define function to check if a number is an integer + # + is.wholenumber <- function(x, tol = .Machine$double.eps^0.5) abs(x - round(x)) < tol + # + ## Initial checks + # + if( !(is(input,"matrix") | is(input,"SpatialGridDataFrame") | is(input,"RasterLayer") | is(input,"list")) ) { + stop("\nNot a valid input object.") + } + if( is(input,"SpatialGridDataFrame") ) { + input <- raster(input) # Change input matrix/ces names + } + if( is(input,"matrix") | is(input,"RasterLayer")) { + rasterm<-input + } else if( is(input,"list") ) { + rasterm<-input[[1]] + } + if(na.tolerance>1){ + stop("na.tolerance must be in the [0-1] interval. Exiting...") + } + # Deal with matrices and RasterLayer in a different way + # If data are raster layers + if( is(input[[1]],"RasterLayer") ) { + if( mode=="classic" ){ + isfloat<-FALSE # If data are float numbers, transform them in integer + if( !is.wholenumber(rasterm@data@min) | !is.wholenumber(rasterm@data@max) | is.infinite(rasterm@data@min) ){ + message("Converting input data in an integer matrix...") + isfloat<-TRUE + mfactor<-100^simplify + rasterm<-getValues(rasterm)*mfactor + gc() + rasterm<-as.integer(rasterm) + gc() + rasterm<-matrix(rasterm,nrow(input),ncol(input),byrow=TRUE) + gc() + }else{ + rasterm<-matrix(getValues(rasterm),ncol=ncol(input),nrow=nrow(input),byrow=T) + } + } + #Print user messages + if( mode=="classic" & shannon ){ + message("Matrix check OK: \nRao and Shannon output matrices will be returned") + }else if( mode=="classic" & !shannon ){ + message("Matrix check OK: \nRao output matrix will be returned") + }else if( mode=="multidimension" & !shannon ){ + message(("Matrix check OK: \nA matrix with multimension RaoQ will be returned")) + }else if( mode=="multidimension" & shannon ){ + stop("Matrix check failed: \nMultidimension and Shannon not compatible, set shannon=FALSE") + }else{ + stop("Matrix check failed: \nNot a valid input | method | distance, please check all these options...") + } + # If data are a matrix or a list + }else if( is(input,"matrix") | is(input,"list") ) { + if( mode=="classic" ){ + isfloat<-FALSE # If data are float numbers, transform them in integer + if( !is.integer(rasterm) ){ + message("Converting input data in an integer matrix...") + isfloat<-TRUE + mfactor<-100^simplify + rasterm<-as.integer(rasterm*mfactor) + rasterm<-matrix(rasterm,nrow(input),ncol(input),byrow=TRUE) + gc() + }else{ + rasterm<-as.matrix(rasterm) + } + } + if( mode=="classic" & shannon ){ + message("Matrix check OK: \nRao and Shannon output matrices will be returned") + }else if( mode=="classic" & !shannon ){ + message("Matrix check OK: \nRao output matrix will be returned") + }else if( mode=="multidimension" & shannon ){ + stop("Matrix check failed: \nMultidimension and Shannon not compatible, set shannon=FALSE") + }else if( mode=="multidimension" & !shannon ){ + message(("Matrix check OK: \nA matrix with multimension RaoQ will be returned")) + }else{ + stop("Matrix check failed: \nNot a valid input | method | distance, please check all these options") + } + } + + if(nc.cores>1) { + if(mode=="multidimension"){ + message( + "Multi-core is not supported for multidimensional Rao, proceding with 1 core...") + nc.cores=1 + }else{ + message(" + ##################### Starting parallel calculation #######################") + } + } + # + ## Derive operational moving window + # + if( window%%2==1 ){ + w <- (window-1)/2 + } else { + stop("Moving window size must be an odd number.") + } + # + ## Preparation of output matrices + # + if(nc.cores==1) { + raoqe<-matrix(rep(NA,dim(rasterm)[1]*dim(rasterm)[2]),nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) + } + if(shannon){ + shannond<-matrix(rep(NA,dim(rasterm)[1]*dim(rasterm)[2]),nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) + } + # + ## If mode is classic Rao + # + if(mode=="classic") { + # + # If classic RaoQ is parallelized + # + if(nc.cores>1) { + # + ## Required packages for parallel calculation + # + require(foreach) + require(doSNOW) + require(parallel) + if( cluster.type=="MPI" ){ + require(Rmpi) + } + # + ## Reshape values + # + values<-as.numeric(as.factor(rasterm)) + rasterm_1<-matrix(data=values,nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) + # + ## Add fake columns and rows for moving window + # + hor<-matrix(NA,ncol=dim(rasterm)[2],nrow=w) + ver<-matrix(NA,ncol=w,nrow=dim(rasterm)[1]+w*2) + trasterm<-cbind(ver,rbind(hor,rasterm_1,hor),ver) + rm(hor,ver,rasterm_1,values); gc() + if(debugging){cat("#check: RaoQ parallel function.")} + # + ## Derive distance matrix + # + d1<-proxy::dist(as.numeric(levels(as.factor(rasterm))),method=distance_m) + gc() + # + ## Export variables in the global environment + # + if(isfloat) { + sapply(c("mfactor"), function(x) {assign(x,get(x),envir= .GlobalEnv)}) + } + # + ## Create cluster object with given number of slaves + # + plr<<-TRUE + if( cluster.type=="SOCK" || cluster.type=="FORK" ) { + cls <- parallel::makeCluster(nc.cores,type=cluster.type, outfile="",useXDR=FALSE,methods=FALSE,output="") + } else if( cluster.type=="MPI" ) { + cls <- makeMPIcluster(nc.cores,outfile="",useXDR=FALSE,methods=FALSE,output="") + } + registerDoSNOW(cls) + clusterCall(cl=cls, function() library("parallel")) + if(isfloat) { + parallel::clusterExport(cl=cls, varlist=c("mfactor")) + } + on.exit(stopCluster(cls)) # Close the clusters on exit + gc() + # + ## Start the parallelized loop over iter + # + pb <- txtProgressBar(min = (1+w), max = dim(rasterm)[2], style = 3) + progress <- function(n) setTxtProgressBar(pb, n) + opts <- list(progress = progress) + raop <- foreach(cl=(1+w):(dim(rasterm)[2]+w),.options.snow = opts,.verbose = F) %dopar% { + if(debugging) { + cat(paste(cl)) + } + raout <- sapply((1+w):(dim(rasterm)[1]+w), function(rw) { + if( length(!which(!trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)]%in%NA)) < window^2-((window^2)*na.tolerance) ) { + vv<-NA + return(vv) + } + else { + tw<-summary(as.factor(trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)]),maxsum=10000) + if( "NA's"%in%names(tw) ) { + tw<-tw[-length(tw)] + } + if( debugging ) { + message("Working on coords ",rw,",",cl,". classes length: ",length(tw),". window size=",window) + } + tw_labels<-names(tw) + tw_values<-as.vector(tw) + if( length(tw_values) <=2 ) { + vv<-NA + return(vv) + } + else { + p <- tw_values/sum(tw_values) + p1 <- diag(0,length(tw_values)) + p1[upper.tri(p1)] <- c(combn(p,m=2,FUN=prod)) + p1[lower.tri(p1)] <- c(combn(p,m=2,FUN=prod)) + d2 <- unname(as.matrix(d1)[as.numeric(tw_labels),as.numeric(tw_labels)]) + vv <- sum(p1*d2) + return(vv) + } + } + }) + return(raout) + } # End classic RaoQ - parallelized + message(("\n\nCalculation of Rao's index complete.\n")) + # + ## If classic RaoQ is sequential + # + } else if(nc.cores==1) { + # Reshape values + values<-as.numeric(as.factor(rasterm)) + rasterm_1<-matrix(data=values,nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) + # Add fake columns and rows for moving window + hor<-matrix(NA,ncol=dim(rasterm)[2],nrow=w) + ver<-matrix(NA,ncol=w,nrow=dim(rasterm)[1]+w*2) + trasterm<-cbind(ver,rbind(hor,rasterm_1,hor),ver) + # Derive distance matrix + classes<-levels(as.factor(rasterm)) + d1<-proxy::dist(x=as.numeric(classes),method=distance_m) + # Loop over each pixel + for (cl in (1+w):(dim(rasterm)[2]+w)) { + for(rw in (1+w):(dim(rasterm)[1]+w)) { + if( length(!which(!trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)]%in%NA)) < window^2-((window^2)*na.tolerance) ) { + raoqe[rw-w,cl-w]<-NA + } else { + tw<-summary(as.factor(trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)]),maxsum=10000) + if( "NA's"%in%names(tw) ) { + tw<-tw[-length(tw)] + } + if(debugging) { + message("Working on coords ",rw ,",",cl,". classes length: ",length(tw),". window size=",window) + } + tw_labels<-names(tw) + tw_values<-as.vector(tw) + if(length(tw_values) <= 2) { + raoqe[rw-w,cl-w]<-NA + } else { + p <- tw_values/sum(tw_values) + p1 <- diag(0,length(tw_values)) + p1[upper.tri(p1)] <- c(combn(p,m=2,FUN=prod)) + p1[lower.tri(p1)] <- c(combn(p,m=2,FUN=prod)) + d2 <- unname(as.matrix(d1)[as.numeric(tw_labels),as.numeric(tw_labels)]) + if(isfloat) { + raoqe[rw-w,cl-w]<-sum(p1*d2)/mfactor + } else { + raoqe[rw-w,cl-w]<-sum(p1*d2) + } + } + } + progress(value=cl, max.value=c((dim(rasterm)[2]+w)+(dim(rasterm)[1]+w))/2, progress.bar = FALSE) + } + } # End of for loop + message(("\nCalculation of Rao's index complete.\n")) + } + } # End classic RaoQ - sequential + else if( mode=="multidimension" ){ + if(debugging) { + message("#check: Into multidimensional clause.") + } + #----------------------------------------------------# + # + ## If multimensional RaoQ + # + # Check if there are NAs in the matrices + if ( is(rasterm,"RasterLayer") ){ + if(any(sapply(lapply(unlist(input),length),is.na)==TRUE)) + message("\n Warning: One or more RasterLayers contain NA which will be threated as 0") + } else if ( is(rasterm,"matrix") ){ + if(any(sapply(input, is.na)==TRUE) ) { + message("\n Warning: One or more matrices contain NA which will be threated as 0") + } + } + # + ## Check whether the chosen distance metric is valid or not + # + if( distance_m=="euclidean" | distance_m=="manhattan" | distance_m=="canberra" | distance_m=="minkowski" | distance_m=="mahalanobis" ) { + # + ## Define distance functions + # + #euclidean + multieuclidean <- function(x) { + tmp <- lapply(x, function(y) { + (y[[1]]-y[[2]])^2 + }) + return(sqrt(Reduce(`+`,tmp))) + } + #manhattan + multimanhattan <- function(x) { + tmp <- lapply(x, function(y) { + abs(y[[1]]-y[[2]]) + }) + return(Reduce(`+`,tmp)) + } + #canberra + multicanberra <- function(x) { + tmp <- lapply(x, function(y) { + abs(y[[1]] - y[[2]]) / (abs(y[[1]]) + abs(y[[2]])) + }) + return(Reduce(`+`,tmp)) + } + #minkowski + multiminkowski <- function(x) { + tmp <- lapply(x, function(y) { + abs((y[[1]]-y[[2]])^lambda) + }) + return(Reduce(`+`,tmp)^(1/lambda)) + } + #mahalanobis + multimahalanobis <- function(x){ + tmp <- matrix(unlist(lapply(x,function(y) as.vector(y))),ncol=2) + tmp <- tmp[!is.na(tmp[,1]),] + if( length(tmp)==0 | is.null(dim(tmp)) ) { + return(NA) + } else if(rcond(cov(tmp)) <= 0.001) { + return(NA) + } else { + #return the inverse of the covariance matrix of tmp; aka the precision matrix + inverse<-solve(cov(tmp)) + if(debugging){ + print(inverse) + } + tmp<-scale(tmp,center=T,scale=F) + tmp<-as.numeric(t(tmp[1,])%*%inverse%*%tmp[1,]) + return(sqrt(tmp)) + } + } + # + ## Decide what function to use + # + if( distance_m=="euclidean") { + distancef <- get("multieuclidean") + } else if( distance_m=="manhattan" ) { + distancef <- get("multimanhattan") + } else if( distance_m=="canberra" ) { + distancef <- get("multicanberra") + } else if( distance_m=="minkowski" ) { + if( lambda==0 ) { + stop("The Minkowski Distance for lambda = 0 is Infinity; please choose another value for lambda.") + } else { + distancef <- get("multiminkowski") + } + } else if( distance_m=="mahalanobis" ) { + distancef <- get("multimahalanobis") + warning("Multimahalanobis distance is not fully supported...") + } + } else { + stop("Distance function not defined for multidimensional Rao's Q; please choose among euclidean, manhattan, canberra, minkowski, mahalanobis!") + } + # + ## Reshape values + # + vls<-lapply(input, function(x) {raster::as.matrix(x)}) + # + ## Rescale and add fake columns and rows for moving w + # + hor<-matrix(NA,ncol=dim(vls[[1]])[2],nrow=w) + ver<-matrix(NA,ncol=w,nrow=dim(vls[[1]])[1]+w*2) + if(rescale) { + trastersm<-lapply(vls, function(x) { + t1 <- raster::scale(raster(cbind(ver,rbind(hor,x,hor),ver))) + t2 <- as.matrix(t1) + return(t2) + }) + } else { + trastersm<-lapply(vls, function(x) { + cbind(ver,rbind(hor,x,hor),ver) + }) + } + # + ## Loop over all the pixels in the matrices + # + if( (ncol(vls[[1]])*nrow(vls[[1]]))> 10000) { + message("\n Warning: ",ncol(vls[[1]])*nrow(vls[[1]])*length(vls), " cells to be processed, may take some time... \n") + } + + + cores = 3 + clp = parallel::makeCluster(cores) + doParallel::registerDoParallel(clp) + on.exit(stopCluster(clp)) + + + t = foreach (cl = (1+w):(dim(vls[[1]])[2]+w), .combine="rbind", .packages="foreach") %dopar% { + foreach (rw = (1+w):(dim(vls[[1]])[1]+w), .combine="rbind") %dopar% { + if( length(!which(!trastersm[[1]][c(rw-w):c(rw+w),c(cl-w):c(cl+w)]%in%NA)) < window^2-((window^2)*na.tolerance) ) { + # raoqe[rw-w,cl-w] <- NA + return(data.frame(row=rw-w, col=cl-w, value=NA)) + } else { + tw<-lapply(trastersm, function(x) { x[(rw-w):(rw+w),(cl-w):(cl+w)] + }) + # + ## Vectorize the matrices in the list and calculate + #Among matrix pairwase distances + lv <- lapply(tw, function(x) {as.vector(t(x))}) + vcomb <- combn(length(lv[[1]]),2) + vout <- c() + for(p in 1:ncol(vcomb) ) { + lpair <- lapply(lv, function(chi) { + c(chi[vcomb[1,p]],chi[vcomb[2,p]]) + }) + vout[p] <- distancef(lpair) + } + # raoqe[rw-w,cl-w] <- sum(rep(vout,2) * (1/(window)^4),na.rm=TRUE) + return(data.frame(row=rw-w, col=cl-w, value=sum(rep(vout,2) * (1/(window)^4),na.rm=TRUE))) + } + + } + + + # do.call("rbind", lapply((1+w):(dim(vls[[1]])[1]+w), function(rw){ + # if( length(!which(!trastersm[[1]][c(rw-w):c(rw+w),c(cl-w):c(cl+w)]%in%NA)) < window^2-((window^2)*na.tolerance) ) { + # # raoqe[rw-w,cl-w] <- NA + # return(data.frame(row=rw-w, col=cl-w, value=NA)) + # } else { + # tw<-lapply(trastersm, function(x) { x[(rw-w):(rw+w),(cl-w):(cl+w)] + # }) + # # + # ## Vectorize the matrices in the list and calculate + # #Among matrix pairwase distances + # lv <- lapply(tw, function(x) {as.vector(t(x))}) + # vcomb <- combn(length(lv[[1]]),2) + # vout <- c() + # for(p in 1:ncol(vcomb) ) { + # lpair <- lapply(lv, function(chi) { + # c(chi[vcomb[1,p]],chi[vcomb[2,p]]) + # }) + # vout[p] <- distancef(lpair) + # } + # # raoqe[rw-w,cl-w] <- sum(rep(vout,2) * (1/(window)^4),na.rm=TRUE) + # return(data.frame(row=rw-w, col=cl-w, value=sum(rep(vout,2) * (1/(window)^4),na.rm=TRUE))) + # } + # })) + + + + # progress(value=cl, max.value=dim(rasterm)[2]+w, progress.bar = FALSE) + } + raoqe<-matrix(rep(NA,dim(rasterm)[1]*dim(rasterm)[2]),nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) + for(i in seq(nrow(t))){ + raoqe[t[i,"row"], t[i,"col"]] = t[i,"value"] + } + + if(exists("pb")) { + close(pb) + } + } else{ + message("Something went wrong when trying to calculate Rao's indiex.") + } # end of multimensional RaoQ + message("\nCalculation of Multidimensional Rao's index complete.\n") + + #----------------------------------------------------# + + # + ## Shannon + # + if( shannon==T ) { + message("\nStarting Shannon-Wiener index calculation:\n") + # Reshape values + values<-as.numeric(as.factor(rasterm)) + rasterm_1<-matrix(data=values,nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) + # + ## Add "fake" columns and rows for moving window + # + hor<-matrix(NA,ncol=dim(rasterm)[2],nrow=w) + ver<-matrix(NA,ncol=w,nrow=dim(rasterm)[1]+w*2) + trasterm<-cbind(ver,rbind(hor,rasterm_1,hor),ver) + # + ## Loop over all the pixels + # + for (cl in (1+w):(dim(rasterm)[2]+w)) { + for(rw in (1+w):(dim(rasterm)[1]+w)) { + if( length(!which(!trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)]%in%NA)) < window^2-((window^2)*na.tolerance) ) { + shannond[rw-w,cl-w]<-NA + } else { + tw<-summary(as.factor(trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)])) + if( "NA's"%in%names(tw) ) { + tw<-tw[-length(tw)] + } + tw[tw>1]<-1 + tw_values<-as.vector(tw) + p<-tw_values/length(tw_values) + p_log<-log(p) + shannond[rw-w,cl-w]<-(-(sum(p*p_log))) + } + } + svMisc::progress(value=cl, max.value=(c((dim(rasterm)[2]+w)+(dim(rasterm)[1]+w))/2), progress.bar = FALSE) + } + message(("\nCalculation of Shannon's index is also complete!\n")) + } # End ShannonD + + #----------------------------------------------------# + + # + ## Return multiple outputs + # + if(debugging){ + message( "#check: return function." ) + } + + if( shannon ) { + if( nc.cores>1 ) { + outl<-list(do.call(cbind,raop),shannond) + names(outl)<-c("Rao","Shannon") + return(outl) + } else if( nc.cores==1 ){ + outl<-list(raoqe,shannond) + names(outl)<-c("Rao","Shannon") + return(outl) + } + } else if( !shannon & mode=="classic" ) { + if( isfloat & nc.cores>1 ) { + #return(raop) + return(do.call(cbind,raop)/mfactor) + if(debugging){ + message("#check: return function - classic.") + } + } else if( !isfloat & nc.cores>1 ) { + outl<-list(do.call(cbind,raop)) + names(outl)<-c("Rao") + return(outl) + } else if( sfloat & nc.cores==1 ) { + outl<-list(raoqe/mfactor) + names(outl)<-c("Rao") + return(outl) + } else if( !isfloat & nc.cores==1 ) { + outl<-list(raoqe) + names(outl)<-c("Rao") + return(outl) + } else if( !isfloat & nc.cores>1 ) { + outl<-list(do.call(cbind,raoqe)) + names(outl)<-c("Rao") + return(outl) + } + } else if( !shannon & mode=="multidimension" ) { + outl<-list(raoqe) + names(outl)<-c("Multidimension_Rao") + return(outl) + } +} + + + + + + + + + +######### SPECTRALRAO ############################# +## Developed by Matteo Marcantonio +## Latest update: 04th October 2018 +## ------------------------------------------------- +## Code to calculate Rao's quadratic entropy on a +## numeric matrix, RasterLayer object (or lists) +## using a moving window algorithm. +## The function also calculates Shannon-Wiener index. +## ------------------------------------------------- +## Rao's Q Min = 0, if all pixel classes have +## distance 0. If the chosen distance ranges between +## 0 and 1, Rao's Max = 1-1/S (Simpson Diversity, +## where S is the number of pixel classes). +## ------------------------------------------------- +## Find more info and application here: +## 1) https://doi.org/10.1016/j.ecolind.2016.07.039 Titel anhand dieser DOI in Citavi-Projekt übernehmen +## 2) https://besjournals.onlinelibrary.wiley.com/doi/10.1111/2041-210X.12941 %CITAVIPICKER£10.1111/2041-210X.12941£Titel anhand dieser DOI in Citavi-Projekt übernehmen£% +##################################################### +# Function +spectralraoORG <- function(input, distance_m="euclidean", p=NULL, window=9, mode="classic", lambda=0, shannon=FALSE, rescale=FALSE, na.tolerance=0.0, simplify=3, nc.cores=1, cluster.type="MPI", debugging=FALSE, ...) +{ + # + ## Load required packages + # + require(raster) + require(svMisc) + require(proxy) + # + ## Define function to check if a number is an integer + # + is.wholenumber <- function(x, tol = .Machine$double.eps^0.5) abs(x - round(x)) < tol + # + ## Initial checks + # + if( !(is(input,"matrix") | is(input,"SpatialGridDataFrame") | is(input,"RasterLayer") | is(input,"list")) ) { + stop("\nNot a valid input object.") + } + if( is(input,"SpatialGridDataFrame") ) { + input <- raster(input) # Change input matrix/ces names + } + if( is(input,"matrix") | is(input,"RasterLayer")) { + rasterm<-input + } else if( is(input,"list") ) { + rasterm<-input[[1]] + } + if(na.tolerance>1){ + stop("na.tolerance must be in the [0-1] interval. Exiting...") + } + # Deal with matrices and RasterLayer in a different way + # If data are raster layers + if( is(input[[1]],"RasterLayer") ) { + if( mode=="classic" ){ + isfloat<-FALSE # If data are float numbers, transform them in integer + if( !is.wholenumber(rasterm@data@min) | !is.wholenumber(rasterm@data@max) | is.infinite(rasterm@data@min) ){ + message("Converting input data in an integer matrix...") + isfloat<-TRUE + mfactor<-100^simplify + rasterm<-getValues(rasterm)*mfactor + gc() + rasterm<-as.integer(rasterm) + gc() + rasterm<-matrix(rasterm,nrow(input),ncol(input),byrow=TRUE) + gc() + }else{ + rasterm<-matrix(getValues(rasterm),ncol=ncol(input),nrow=nrow(input),byrow=T) + } + } + #Print user messages + if( mode=="classic" & shannon ){ + message("Matrix check OK: \nRao and Shannon output matrices will be returned") + }else if( mode=="classic" & !shannon ){ + message("Matrix check OK: \nRao output matrix will be returned") + }else if( mode=="multidimension" & !shannon ){ + message(("Matrix check OK: \nA matrix with multimension RaoQ will be returned")) + }else if( mode=="multidimension" & shannon ){ + stop("Matrix check failed: \nMultidimension and Shannon not compatible, set shannon=FALSE") + }else{ + stop("Matrix check failed: \nNot a valid input | method | distance, please check all these options...") + } + # If data are a matrix or a list + }else if( is(input,"matrix") | is(input,"list") ) { + if( mode=="classic" ){ + isfloat<-FALSE # If data are float numbers, transform them in integer + if( !is.integer(rasterm) ){ + message("Converting input data in an integer matrix...") + isfloat<-TRUE + mfactor<-100^simplify + rasterm<-as.integer(rasterm*mfactor) + rasterm<-matrix(rasterm,nrow(input),ncol(input),byrow=TRUE) + gc() + }else{ + rasterm<-as.matrix(rasterm) + } + } + if( mode=="classic" & shannon ){ + message("Matrix check OK: \nRao and Shannon output matrices will be returned") + }else if( mode=="classic" & !shannon ){ + message("Matrix check OK: \nRao output matrix will be returned") + }else if( mode=="multidimension" & shannon ){ + stop("Matrix check failed: \nMultidimension and Shannon not compatible, set shannon=FALSE") + }else if( mode=="multidimension" & !shannon ){ + message(("Matrix check OK: \nA matrix with multimension RaoQ will be returned")) + }else{ + stop("Matrix check failed: \nNot a valid input | method | distance, please check all these options") + } + } + + if(nc.cores>1) { + if(mode=="multidimension"){ + message( + "Multi-core is not supported for multidimensional Rao, proceding with 1 core...") + nc.cores=1 + }else{ + message(" + ##################### Starting parallel calculation #######################") + } + } + # + ## Derive operational moving window + # + if( window%%2==1 ){ + w <- (window-1)/2 + } else { + stop("Moving window size must be an odd number.") + } + # + ## Preparation of output matrices + # + if(nc.cores==1) { + raoqe<-matrix(rep(NA,dim(rasterm)[1]*dim(rasterm)[2]),nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) + } + if(shannon){ + shannond<-matrix(rep(NA,dim(rasterm)[1]*dim(rasterm)[2]),nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) + } + # + ## If mode is classic Rao + # + if(mode=="classic") { + # + # If classic RaoQ is parallelized + # + if(nc.cores>1) { + # + ## Required packages for parallel calculation + # + require(foreach) + require(doSNOW) + require(parallel) + if( cluster.type=="MPI" ){ + require(Rmpi) + } + # + ## Reshape values + # + values<-as.numeric(as.factor(rasterm)) + rasterm_1<-matrix(data=values,nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) + # + ## Add fake columns and rows for moving window + # + hor<-matrix(NA,ncol=dim(rasterm)[2],nrow=w) + ver<-matrix(NA,ncol=w,nrow=dim(rasterm)[1]+w*2) + trasterm<-cbind(ver,rbind(hor,rasterm_1,hor),ver) + rm(hor,ver,rasterm_1,values); gc() + if(debugging){cat("#check: RaoQ parallel function.")} + # + ## Derive distance matrix + # + d1<-proxy::dist(as.numeric(levels(as.factor(rasterm))),method=distance_m) + gc() + # + ## Export variables in the global environment + # + if(isfloat) { + sapply(c("mfactor"), function(x) {assign(x,get(x),envir= .GlobalEnv)}) + } + # + ## Create cluster object with given number of slaves + # + plr<<-TRUE + if( cluster.type=="SOCK" || cluster.type=="FORK" ) { + cls <- parallel::makeCluster(nc.cores,type=cluster.type, outfile="",useXDR=FALSE,methods=FALSE,output="") + } else if( cluster.type=="MPI" ) { + cls <- makeMPIcluster(nc.cores,outfile="",useXDR=FALSE,methods=FALSE,output="") + } + registerDoSNOW(cls) + clusterCall(cl=cls, function() library("parallel")) + if(isfloat) { + parallel::clusterExport(cl=cls, varlist=c("mfactor")) + } + on.exit(stopCluster(cls)) # Close the clusters on exit + gc() + # + ## Start the parallelized loop over iter + # + pb <- txtProgressBar(min = (1+w), max = dim(rasterm)[2], style = 3) + progress <- function(n) setTxtProgressBar(pb, n) + opts <- list(progress = progress) + raop <- foreach(cl=(1+w):(dim(rasterm)[2]+w),.options.snow = opts,.verbose = F) %dopar% { + if(debugging) { + cat(paste(cl)) + } + raout <- sapply((1+w):(dim(rasterm)[1]+w), function(rw) { + if( length(!which(!trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)]%in%NA)) < window^2-((window^2)*na.tolerance) ) { + vv<-NA + return(vv) + } + else { + tw<-summary(as.factor(trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)]),maxsum=10000) + if( "NA's"%in%names(tw) ) { + tw<-tw[-length(tw)] + } + if( debugging ) { + message("Working on coords ",rw,",",cl,". classes length: ",length(tw),". window size=",window) + } + tw_labels<-names(tw) + tw_values<-as.vector(tw) + if( length(tw_values) <=2 ) { + vv<-NA + return(vv) + } + else { + p <- tw_values/sum(tw_values) + p1 <- diag(0,length(tw_values)) + p1[upper.tri(p1)] <- c(combn(p,m=2,FUN=prod)) + p1[lower.tri(p1)] <- c(combn(p,m=2,FUN=prod)) + d2 <- unname(as.matrix(d1)[as.numeric(tw_labels),as.numeric(tw_labels)]) + vv <- sum(p1*d2) + return(vv) + } + } + }) + return(raout) + } # End classic RaoQ - parallelized + message(("\n\nCalculation of Rao's index complete.\n")) + # + ## If classic RaoQ is sequential + # + } else if(nc.cores==1) { + # Reshape values + values<-as.numeric(as.factor(rasterm)) + rasterm_1<-matrix(data=values,nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) + # Add fake columns and rows for moving window + hor<-matrix(NA,ncol=dim(rasterm)[2],nrow=w) + ver<-matrix(NA,ncol=w,nrow=dim(rasterm)[1]+w*2) + trasterm<-cbind(ver,rbind(hor,rasterm_1,hor),ver) + # Derive distance matrix + classes<-levels(as.factor(rasterm)) + d1<-proxy::dist(x=as.numeric(classes),method=distance_m) + # Loop over each pixel + for (cl in (1+w):(dim(rasterm)[2]+w)) { + for(rw in (1+w):(dim(rasterm)[1]+w)) { + if( length(!which(!trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)]%in%NA)) < window^2-((window^2)*na.tolerance) ) { + raoqe[rw-w,cl-w]<-NA + } else { + tw<-summary(as.factor(trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)]),maxsum=10000) + if( "NA's"%in%names(tw) ) { + tw<-tw[-length(tw)] + } + if(debugging) { + message("Working on coords ",rw ,",",cl,". classes length: ",length(tw),". window size=",window) + } + tw_labels<-names(tw) + tw_values<-as.vector(tw) + if(length(tw_values) <= 2) { + raoqe[rw-w,cl-w]<-NA + } else { + p <- tw_values/sum(tw_values) + p1 <- diag(0,length(tw_values)) + p1[upper.tri(p1)] <- c(combn(p,m=2,FUN=prod)) + p1[lower.tri(p1)] <- c(combn(p,m=2,FUN=prod)) + d2 <- unname(as.matrix(d1)[as.numeric(tw_labels),as.numeric(tw_labels)]) + if(isfloat) { + raoqe[rw-w,cl-w]<-sum(p1*d2)/mfactor + } else { + raoqe[rw-w,cl-w]<-sum(p1*d2) + } + } + } + progress(value=cl, max.value=c((dim(rasterm)[2]+w)+(dim(rasterm)[1]+w))/2, progress.bar = FALSE) + } + } # End of for loop + message(("\nCalculation of Rao's index complete.\n")) + } + } # End classic RaoQ - sequential + else if( mode=="multidimension" ){ + if(debugging) { + message("#check: Into multidimensional clause.") + } + #----------------------------------------------------# + # + ## If multimensional RaoQ + # + # Check if there are NAs in the matrices + if ( is(rasterm,"RasterLayer") ){ + if(any(sapply(lapply(unlist(input),length),is.na)==TRUE)) + message("\n Warning: One or more RasterLayers contain NA which will be threated as 0") + } else if ( is(rasterm,"matrix") ){ + if(any(sapply(input, is.na)==TRUE) ) { + message("\n Warning: One or more matrices contain NA which will be threated as 0") + } + } + # + ## Check whether the chosen distance metric is valid or not + # + if( distance_m=="euclidean" | distance_m=="manhattan" | distance_m=="canberra" | distance_m=="minkowski" | distance_m=="mahalanobis" ) { + # + ## Define distance functions + # + #euclidean + multieuclidean <- function(x) { + tmp <- lapply(x, function(y) { + (y[[1]]-y[[2]])^2 + }) + return(sqrt(Reduce(`+`,tmp))) + } + #manhattan + multimanhattan <- function(x) { + tmp <- lapply(x, function(y) { + abs(y[[1]]-y[[2]]) + }) + return(Reduce(`+`,tmp)) + } + #canberra + multicanberra <- function(x) { + tmp <- lapply(x, function(y) { + abs(y[[1]] - y[[2]]) / (abs(y[[1]]) + abs(y[[2]])) + }) + return(Reduce(`+`,tmp)) + } + #minkowski + multiminkowski <- function(x) { + tmp <- lapply(x, function(y) { + abs((y[[1]]-y[[2]])^lambda) + }) + return(Reduce(`+`,tmp)^(1/lambda)) + } + #mahalanobis + multimahalanobis <- function(x){ + tmp <- matrix(unlist(lapply(x,function(y) as.vector(y))),ncol=2) + tmp <- tmp[!is.na(tmp[,1]),] + if( length(tmp)==0 | is.null(dim(tmp)) ) { + return(NA) + } else if(rcond(cov(tmp)) <= 0.001) { + return(NA) + } else { + #return the inverse of the covariance matrix of tmp; aka the precision matrix + inverse<-solve(cov(tmp)) + if(debugging){ + print(inverse) + } + tmp<-scale(tmp,center=T,scale=F) + tmp<-as.numeric(t(tmp[1,])%*%inverse%*%tmp[1,]) + return(sqrt(tmp)) + } + } + # + ## Decide what function to use + # + if( distance_m=="euclidean") { + distancef <- get("multieuclidean") + } else if( distance_m=="manhattan" ) { + distancef <- get("multimanhattan") + } else if( distance_m=="canberra" ) { + distancef <- get("multicanberra") + } else if( distance_m=="minkowski" ) { + if( lambda==0 ) { + stop("The Minkowski Distance for lambda = 0 is Infinity; please choose another value for lambda.") + } else { + distancef <- get("multiminkowski") + } + } else if( distance_m=="mahalanobis" ) { + distancef <- get("multimahalanobis") + warning("Multimahalanobis distance is not fully supported...") + } + } else { + stop("Distance function not defined for multidimensional Rao's Q; please choose among euclidean, manhattan, canberra, minkowski, mahalanobis!") + } + # + ## Reshape values + # + vls<-lapply(input, function(x) {raster::as.matrix(x)}) + # + ## Rescale and add fake columns and rows for moving w + # + hor<-matrix(NA,ncol=dim(vls[[1]])[2],nrow=w) + ver<-matrix(NA,ncol=w,nrow=dim(vls[[1]])[1]+w*2) + if(rescale) { + trastersm<-lapply(vls, function(x) { + t1 <- raster::scale(raster(cbind(ver,rbind(hor,x,hor),ver))) + t2 <- as.matrix(t1) + return(t2) + }) + } else { + trastersm<-lapply(vls, function(x) { + cbind(ver,rbind(hor,x,hor),ver) + }) + } + # + ## Loop over all the pixels in the matrices + # + if( (ncol(vls[[1]])*nrow(vls[[1]]))> 10000) { + message("\n Warning: ",ncol(vls[[1]])*nrow(vls[[1]])*length(vls), " cells to be processed, may take some time... \n") + } + for (cl in (1+w):(dim(vls[[1]])[2]+w)) { + for(rw in (1+w):(dim(vls[[1]])[1]+w)) { + if( length(!which(!trastersm[[1]][c(rw-w):c(rw+w),c(cl-w):c(cl+w)]%in%NA)) < window^2-((window^2)*na.tolerance) ) { + raoqe[rw-w,cl-w] <- NA + } else { + tw<-lapply(trastersm, function(x) { x[(rw-w):(rw+w),(cl-w):(cl+w)] + }) + # + ## Vectorize the matrices in the list and calculate + #Among matrix pairwase distances + lv <- lapply(tw, function(x) {as.vector(t(x))}) + vcomb <- combn(length(lv[[1]]),2) + vout <- c() + for(p in 1:ncol(vcomb) ) { + lpair <- lapply(lv, function(chi) { + c(chi[vcomb[1,p]],chi[vcomb[2,p]]) + }) + vout[p] <- distancef(lpair) + } + raoqe[rw-w,cl-w] <- sum(rep(vout,2) * (1/(window)^4),na.rm=TRUE) + } + } + progress(value=cl, max.value=dim(rasterm)[2]+w, progress.bar = FALSE) + } + if(exists("pb")) { + close(pb) + } + } else{ + message("Something went wrong when trying to calculate Rao's indiex.") + } # end of multimensional RaoQ + message("\nCalculation of Multidimensional Rao's index complete.\n") + + #----------------------------------------------------# + + # + ## Shannon + # + if( shannon==T ) { + message("\nStarting Shannon-Wiener index calculation:\n") + # Reshape values + values<-as.numeric(as.factor(rasterm)) + rasterm_1<-matrix(data=values,nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) + # + ## Add "fake" columns and rows for moving window + # + hor<-matrix(NA,ncol=dim(rasterm)[2],nrow=w) + ver<-matrix(NA,ncol=w,nrow=dim(rasterm)[1]+w*2) + trasterm<-cbind(ver,rbind(hor,rasterm_1,hor),ver) + # + ## Loop over all the pixels + # + for (cl in (1+w):(dim(rasterm)[2]+w)) { + for(rw in (1+w):(dim(rasterm)[1]+w)) { + if( length(!which(!trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)]%in%NA)) < window^2-((window^2)*na.tolerance) ) { + shannond[rw-w,cl-w]<-NA + } else { + tw<-summary(as.factor(trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)])) + if( "NA's"%in%names(tw) ) { + tw<-tw[-length(tw)] + } + tw[tw>1]<-1 + tw_values<-as.vector(tw) + p<-tw_values/length(tw_values) + p_log<-log(p) + shannond[rw-w,cl-w]<-(-(sum(p*p_log))) + } + } + svMisc::progress(value=cl, max.value=(c((dim(rasterm)[2]+w)+(dim(rasterm)[1]+w))/2), progress.bar = FALSE) + } + message(("\nCalculation of Shannon's index is also complete!\n")) + } # End ShannonD + + #----------------------------------------------------# + + # + ## Return multiple outputs + # + if(debugging){ + message( "#check: return function." ) + } + + if( shannon ) { + if( nc.cores>1 ) { + outl<-list(do.call(cbind,raop),shannond) + names(outl)<-c("Rao","Shannon") + return(outl) + } else if( nc.cores==1 ){ + outl<-list(raoqe,shannond) + names(outl)<-c("Rao","Shannon") + return(outl) + } + } else if( !shannon & mode=="classic" ) { + if( isfloat & nc.cores>1 ) { + #return(raop) + return(do.call(cbind,raop)/mfactor) + if(debugging){ + message("#check: return function - classic.") + } + } else if( !isfloat & nc.cores>1 ) { + outl<-list(do.call(cbind,raop)) + names(outl)<-c("Rao") + return(outl) + } else if( sfloat & nc.cores==1 ) { + outl<-list(raoqe/mfactor) + names(outl)<-c("Rao") + return(outl) + } else if( !isfloat & nc.cores==1 ) { + outl<-list(raoqe) + names(outl)<-c("Rao") + return(outl) + } else if( !isfloat & nc.cores>1 ) { + outl<-list(do.call(cbind,raoqe)) + names(outl)<-c("Rao") + return(outl) + } + } else if( !shannon & mode=="multidimension" ) { + outl<-list(raoqe) + names(outl)<-c("Multidimension_Rao") + return(outl) + } +} \ No newline at end of file diff --git a/src/010_biodiv_preprocessing.R b/src/010_biodiv_preprocessing.R new file mode 100644 index 0000000..9406418 --- /dev/null +++ b/src/010_biodiv_preprocessing.R @@ -0,0 +1,14 @@ +# Preprocess biodiversity observations. + +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") + +# Read dataset +bd = read.table(paste0(path_biodiv, "Biodiversity_Data_Marcel.csv"), + header = TRUE, sep = ";", dec = ",") + +saveRDS(as.character(bd$plotID), file = paste0(path_biodiv, "biodiv_plots.rds")) +saveRDS(bd, file = paste0(path_biodiv, "biodiv.rds")) + + + + diff --git a/src/010_rasterdb_hyperspectral_processing.R b/src/010_rasterdb_hyperspectral_processing.R deleted file mode 100644 index ada3cc0..0000000 --- a/src/010_rasterdb_hyperspectral_processing.R +++ /dev/null @@ -1,57 +0,0 @@ -# Extract hyperspectral data from database using the extent of the plots as -# defined by polygons B - -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") - -# Set account -userpwd <- "thomas.nauss:cd7dLfgm" # use this account (if not loaded from file) - -# Open remote sensing database -remotesensing <- RemoteSensing$new("http://137.248.191.215:8081", userpwd) # remote server - -# Get rasterdb -dbs = c("kili_campaign1_hyperspectral_lvl3_2015", "kili_campaign2_hyperspectral_lvl3_2016") -for(db in dbs){ - dir.create(paste0(path_org, db), - showWarnings = FALSE) - rasterdb <- remotesensing$rasterdb(db) - bands = rasterdb$bands - saveRDS(bands, - file = paste0(path_org, db, "/bands_", db, ".rds")) - - # Get data - rg = "kili_poi_plots" - pois = remotesensing$poi_group(rg) - for(n in pois$name){ - poi <- remotesensing$poi(group_name=rg, poi_name=n) - ext <- extent_diameter(poi$x, poi$y, 100) - r <- rasterdb$raster(ext) - saveRDS(r, file = paste0(path_org, db, "/", n, ".rds")) - } -} - - -# # Get data -# rg = "kili_roi_plot_poles_b" -# rois = remotesensing$roi_group(rg) -# for(n in rois$name){ -# roi <- remotesensing$roi(group_name=rg, roi_name=n) -# ext <- extent(min(roi$polygon[[1]][,1]), max(roi$polygon[[1]][,1]), -# min(roi$polygon[[1]][,2]), max(roi$polygon[[1]][,2])) -# r <- rasterdb$raster(ext) -# saveRDS(r, file = paste0(path_org, n, ".rds")) -# } - - -# Check data -ds = list.files(path_org, full.names = TRUE) -pb = shapefile(paste0(path_plots, "BPolygon.shp")) - -temp = readRDS(ds[[1]]) -pb = spTransform(pb, projection(temp)) -for(d in ds){ - r = readRDS(d) - plot(r[[109]], main = substr(basename(d), 1, 4)) - plot(pb[grep(substr(basename(d), 1, 4), pb$PlotID),], add = TRUE) - mapview(r[[109]]) + pb[grep(substr(basename(d), 1, 4), pb$PlotID),] -} diff --git a/src/020_rasterdb_hyperspectral_processing.R b/src/020_rasterdb_hyperspectral_processing.R new file mode 100644 index 0000000..a3adf70 --- /dev/null +++ b/src/020_rasterdb_hyperspectral_processing.R @@ -0,0 +1,79 @@ +# Extract hyperspectral data from database using a buffer of 100 m in diameter +# arround the center of each observation plot. + +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") + +# Set account +userpwd <- "thomas.nauss:cd7dLfgm" # use this account (if not loaded from file) + +# Open remote sensing database +remotesensing <- RemoteSensing$new("http://137.248.191.215:8081", userpwd) # remote server + +# Get rasterdb +dbs = c("kili_campaign1_hyperspectral_lvl3_2015", "kili_campaign2_hyperspectral_lvl3_2016") +for(db in dbs){ + dir.create(paste0(path_hyp_org, db), + showWarnings = FALSE) + rasterdb <- remotesensing$rasterdb(db) + bands = rasterdb$bands + saveRDS(bands, + file = paste0(path_hyp_org, db, "/bands_", db, ".rds")) + + # Get data + rg = "kili_poi_plots" + pois = remotesensing$poi_group(rg) + for(n in pois$name){ + radius = 100 + if(n == "fer3"){ + radius = 150 + } + poi <- remotesensing$poi(group_name=rg, poi_name=n) + ext <- extent_diameter(poi$x, poi$y, radius) + r <- rasterdb$raster(ext, product="gap_filling(full_spectrum)") + saveRDS(r, file = paste0(path_hyp_org, db, "/", n, ".rds")) + } +} + +# Combine from first and second flight based on filesize +# (non-observed areas have considerably smaller file sizes) +# Use foc1 and foc6 from second flight. +bd_plots = readRDS(paste0(path_biodiv, "biodiv_plots.rds")) +hd_files = list.files(path_hyp_org, recursive = TRUE, full.names = TRUE) +hd_files = hd_files[nchar(basename(hd_files)) == 8] +hd_size = lapply(hd_files, function(f){ + c = if(grepl(dbs[[1]], f)){ + c = dbs[[1]] + } else { + c = dbs[[2]] + } + data.frame(f = f, + s = file.size(f), + c = c, + plotID = substr(basename(f), 1, 4)) +}) +hd_size = do.call("rbind", hd_size) +hd_size_valid = hd_size[hd_size$s > 300000, ] +hd_size_valid$f = as.character(hd_size_valid$f) + +hd_size_valid = hd_size_valid[-grep(paste0(dbs[[1]], "/foc1.rds"), hd_size_valid$f),] +hd_size_valid = hd_size_valid[-grep(paste0(dbs[[1]], "/foc6.rds"), hd_size_valid$f),] + +hd_size_valid = hd_size_valid[substr(basename(hd_size_valid$f), 1, 4) %in% bd_plots,] + +for(f in hd_size_valid$f){ + file.copy(f, paste0(path_hyp_org, "/", basename(f))) +} + + +# Save metadata +# Combine metadata +meta = list(data.frame(hd_size_valid[, c("c", "plotID")], list = 1)) +meta[[1]]$list[meta[[1]]$c == dbs[[2]]] = 2 +meta[[2]] = list(meta_01 = readRDS(paste0(path_hyp_org, dbs[[1]], "/bands_", dbs[[1]], ".rds")), + meta_02 = readRDS(paste0(path_hyp_org, dbs[[2]], "/bands_", dbs[[2]], ".rds"))) +dir.create(path_meta, showWarnings = FALSE) +saveRDS(meta, file = paste0(path_meta, "hyp_meta.rds")) + + +# Visually check data +visCheck(datapath = path_hyp_org, polygonfile = paste0(path_plots, "BPolygon.shp")) diff --git a/src/025_extract_aoi.R b/src/025_extract_aoi.R new file mode 100644 index 0000000..27c7b4a --- /dev/null +++ b/src/025_extract_aoi.R @@ -0,0 +1,28 @@ +# Extract plot area (50 x 50 m) from hyperspectral data ans mask all NAs + +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") + +hd_files = list.files(path_hyp_org, recursive = FALSE, full.names = TRUE) +hd_files = hd_files[-grep("kili_campaign", hd_files)] +pb = shapefile(paste0(path_plots, "BPolygon.shp")) + +dir.create(paste0(path_hyp_aio), showWarnings = FALSE) + +reproj = TRUE +for(f in hd_files){ + r = readRDS(f) + if(reproj){ + pb = spTransform(pb, projection(r)) + reproj = FALSE + } + pid = substr(basename(f), 1, 4) + aoi = pb[grep(pid, pb$PlotID),] + r = raster::mask(crop(r, aoi), aoi) + # r = raster::mask(r, calc(r, fun=sum)) # We will do that later in the workflow + names(r) = paste0(pid, "_", names(r)) + saveRDS(r, file = paste0(path_hyp_aio, pid, ".rds")) +} + + +# Visually check data +visCheck(datapath = path_hyp_aio, polygonfile = paste0(path_plots, "BPolygon.shp")) diff --git a/src/030_noise_removal.R b/src/030_noise_removal.R new file mode 100644 index 0000000..84c4d60 --- /dev/null +++ b/src/030_noise_removal.R @@ -0,0 +1,65 @@ +# Compute noise removal on a per plot basis. + +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") + +hd_files = list.files(path_hyp_aio, recursive = FALSE, full.names = TRUE) +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) + +pb = shapefile(paste0(path_plots, "BPolygon.shp")) + +dir.create(paste0(path_hyp_nrm), showWarnings = FALSE) + +for(f in hd_files){ + r = readRDS(f) + + m = mnf(as(r, "SpatialGridDataFrame"), use = "complete.obs") + + thv = 1-m$values + use = which(thv > 0.1) + spplot(m$x[160]) + + for(i in use){ + m$x@data[,i] = 0 #mean(m$x@data[,i], na.rm = TRUE) + } + # focal(r, w=matrix(1/9,nrow=3,ncol=3)) + + # plot(m$values) + # mi = as.matrix(m$x@data) %*% solve(m$rotation) + mi = as.matrix(m$x@data)[, use] %*% solve(m$rotation)[use, ] + # roti = solve(e$rotation) + # xi = e$x[, -1] %*% roti[-1, ] + # xi = e$x %*% roti + tmp = r[[1]] + mir = stack(lapply(seq(ncol(mi)), function(i){ + setValues(tmp, mi[, i]) + })) + plot(mir) + plot(r) + + summary(mir[[108]] / r[[108]]) + + mir[[108]][4002] + r[[108]][4002] + + xr = as(m$x, "RasterStack") + writeRaster(xr, paste0(path_temp, "m.tif"), "GTiff", overwrite = TRUE) + writeRaster(r, paste0(path_temp, "r.tif"), "GTiff", overwrite = TRUE) +} + + + + + + +pca = rasterPCA(r) +v = pca$model$sdev**2 +thv = v-1 +use = which(thv > 2) +pcai = t(t(as.matrix(pca$map)[, use] %*% t(pca$model$loadings)[use, ]) + pca$model$center) + +tmp = r[[1]] +pcair = stack(lapply(seq(ncol(pcai)), function(i){ + setValues(tmp, pcai[, i]) +})) +plot(pcair[[108]]) +plot(r[[108]]) diff --git a/src/040_vegIndices.R b/src/040_vegIndices.R new file mode 100644 index 0000000..ac1b735 --- /dev/null +++ b/src/040_vegIndices.R @@ -0,0 +1,46 @@ +# Compute vegetation indicies + +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +if(length(showConnections()) == 0){ + cores = 3 + cl = parallel::makeCluster(cores) + doParallel::registerDoParallel(cl) +} + +hd_files = list.files(path_hyp_aio, recursive = FALSE, full.names = TRUE) +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) + +dir.create(paste0(path_hyp_vegidcs), showWarnings = FALSE) + +vis = c("CARI", + "Carter", "Carter2", "Carter3", "Carter4", "Carter5", "Carter6", + "CI", "CI2", "ClAInt", + "CRI1", "CRI2", "CRI3", "CRI4", + "Datt", "Datt2", "Datt4", "Datt5", "Datt6", + "DD", "DDn", "DWSI4", + "EVI", "GDVI_2", "GDVI_3", "GDVI_4", "GI", "Gitelson", "Gitelson2", + "GMI1", "GMI2", "GreenNDVI", "Maccioni", + "MCARI", "MCARI/OSAVI", "MCARI2", "MCARI2/OSAVI2", + "mND705", "mNDVI", "MPRI", "MSAVI", "mSR", "mSR2", "mSR705", + "MTCI", "MTVI", "NDVI", "NDVI2", "NDVI3", "NPCI", + "OSAVI", "OSAVI2", "PARS", "PRI", "PRI*CI2", "PRI_norm", "PSND", + "PSRI", "PSSR", "PWI", "RDVI", "REP_Li", "SAVI", "SIPI", "SPVI", + "SR", "SR1", "SR2", "SR3", "SR4", "SR5", "SR6", "SR7", "SR8", + "SRPI", "TCARI", "TCARI/OSAVI", "TCARI2", "TCARI2/OSAVI2", + "TGI", "TVI", "Vogelmann", "Vogelmann2", "Vogelmann4") + + +foreach(i = seq(length(hd_files))) %dopar% { + plotid = substr(basename(hd_files[[i]]), 1, 4) + m = h_meta[[2]][[h_meta[[1]]$list[grep(plotid, h_meta[[1]]$plotID)]]] + r = speclib(readRDS(hd_files[[i]]), + wavelength = m$wavelength, + fwhm = m$fwhm, + continuousdata = "auto") + v = vegindex(r, index = vis) + vr = v@spectra@spectra_ra + names(vr) = vis + saveRDS(vr, file = paste0(path_hyp_vegidcs, plotid, "_vegidcs.rds")) +} + +stopCluster(cl) diff --git a/src/050_divIndices.R b/src/050_divIndices.R new file mode 100644 index 0000000..1571222 --- /dev/null +++ b/src/050_divIndices.R @@ -0,0 +1,34 @@ +# Compute spectral diversity indicies + +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +if(length(showConnections()) == 0){ + cores = 3 + cl = parallel::makeCluster(cores) + doParallel::registerDoParallel(cl) +} + +hd_files = list.files(path_hyp_aio, recursive = FALSE, full.names = TRUE) +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) + +dir.create(paste0(path_hyp_dividcs), showWarnings = FALSE) + +foreach(i = seq(length(hd_files))) %dopar% { + plotid = substr(basename(hd_files[[i]]), 1, 4) + r = readRDS(hd_files[[i]]) + # ra = aggregate(r, fact=2, fun=mean) + Sys.time() + raomatrix <- spectralrao(as.list(r), + mode="multidimension", + distance_m="euclidean", + window=3, + shannon=FALSE, + debugging=TRUE, + simplify=3) + raor = setValues(r[[1]], raomatrix[[1]]) + names(raor) = plotid + saveRDS(raor, file = paste0(path_hyp_dividcs, + substr(basename(hd_files[[i]]), 1, 4), + "_dividcs.rds")) +} + +stopCluster(cl) From dc4ea1083f0496c2466c6a7cf1b3cc2566fe7a96 Mon Sep 17 00:00:00 2001 From: tnauss Date: Sat, 6 Oct 2018 20:30:52 +0200 Subject: [PATCH 05/65] Include MNF and PCA in noise removal --- src/030_noise_removal.R | 100 +++++++++++++++++++--------------------- 1 file changed, 48 insertions(+), 52 deletions(-) diff --git a/src/030_noise_removal.R b/src/030_noise_removal.R index 84c4d60..ac2b92d 100644 --- a/src/030_noise_removal.R +++ b/src/030_noise_removal.R @@ -1,4 +1,4 @@ -# Compute noise removal on a per plot basis. +# Compute noise removal on a per plot basis source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") @@ -9,57 +9,53 @@ pb = shapefile(paste0(path_plots, "BPolygon.shp")) dir.create(paste0(path_hyp_nrm), showWarnings = FALSE) +# for(f in hd_files){ +# r = readRDS(f) +# +# m = mnf(as(r, "SpatialGridDataFrame"), use = "complete.obs") +# +# thv = 1-m$values +# set_mean = which(thv < -0.10) +# +# for(i in use){ +# m$x@data[,i] = mean(m$x@data[,i], na.rm = TRUE) +# } +# mi = as.matrix(m$x@data) %*% solve(m$rotation) +# tmp = r[[1]] +# mir = stack(lapply(seq(ncol(mi)), function(i){ +# setValues(tmp, mi[, i]) +# })) +# +# saveRDS(mir, file = paste0(path_hyp_nrm, substr(basename(f), 1, 4), "_mnfi.rds")) +# } + +log = list() +log_entry = 0 + for(f in hd_files){ - r = readRDS(f) - - m = mnf(as(r, "SpatialGridDataFrame"), use = "complete.obs") - - thv = 1-m$values - use = which(thv > 0.1) - spplot(m$x[160]) - - for(i in use){ - m$x@data[,i] = 0 #mean(m$x@data[,i], na.rm = TRUE) - } - # focal(r, w=matrix(1/9,nrow=3,ncol=3)) - - # plot(m$values) - # mi = as.matrix(m$x@data) %*% solve(m$rotation) - mi = as.matrix(m$x@data)[, use] %*% solve(m$rotation)[use, ] - # roti = solve(e$rotation) - # xi = e$x[, -1] %*% roti[-1, ] - # xi = e$x %*% roti - tmp = r[[1]] - mir = stack(lapply(seq(ncol(mi)), function(i){ - setValues(tmp, mi[, i]) - })) - plot(mir) - plot(r) - - summary(mir[[108]] / r[[108]]) - - mir[[108]][4002] - r[[108]][4002] - - xr = as(m$x, "RasterStack") - writeRaster(xr, paste0(path_temp, "m.tif"), "GTiff", overwrite = TRUE) - writeRaster(r, paste0(path_temp, "r.tif"), "GTiff", overwrite = TRUE) + r = readRDS(f) + + all_na = grep(ncell(r), summary(r)[6,]) + if(length(all_na) > 0){ + log_entry = log_entry + 1 + log[[log_entry]] = list(file = basename(f), all_na = all_na) + r = r[[-all_na]] + } + + pca = rasterPCA(r) + v = pca$model$sdev**2 + + # Continuous Significant Dimensionality + csd = round(sum(sapply(v, function(x){min(x,1)})), 0) + use = seq(csd) + pcai = t(t(as.matrix(pca$map)[, use] %*% t(pca$model$loadings)[use, ]) + pca$model$center) + + tmp = r[[1]] + pcair = stack(lapply(seq(ncol(pcai)), function(i){ + setValues(tmp, pcai[, i]) + })) + + saveRDS(pcair, file = paste0(path_hyp_nrm, substr(basename(f), 1, 4), "_pcai.rds")) } - - - - - -pca = rasterPCA(r) -v = pca$model$sdev**2 -thv = v-1 -use = which(thv > 2) -pcai = t(t(as.matrix(pca$map)[, use] %*% t(pca$model$loadings)[use, ]) + pca$model$center) - -tmp = r[[1]] -pcair = stack(lapply(seq(ncol(pcai)), function(i){ - setValues(tmp, pcai[, i]) -})) -plot(pcair[[108]]) -plot(r[[108]]) +saveRDS(log, file = paste0(path_meta, "030_noise_removal_log.rds")) From 4a3dcf8f3186b13887de0ebc52dfb035d56faa4c Mon Sep 17 00:00:00 2001 From: tnauss Date: Sat, 6 Oct 2018 22:06:01 +0200 Subject: [PATCH 06/65] Update --- src/030_noise_removal.R | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/030_noise_removal.R b/src/030_noise_removal.R index ac2b92d..d152d3d 100644 --- a/src/030_noise_removal.R +++ b/src/030_noise_removal.R @@ -37,9 +37,9 @@ for(f in hd_files){ all_na = grep(ncell(r), summary(r)[6,]) if(length(all_na) > 0){ - log_entry = log_entry + 1 - log[[log_entry]] = list(file = basename(f), all_na = all_na) r = r[[-all_na]] + } else { + all_na = -1 } pca = rasterPCA(r) @@ -48,6 +48,11 @@ for(f in hd_files){ # Continuous Significant Dimensionality csd = round(sum(sapply(v, function(x){min(x,1)})), 0) use = seq(csd) + + log_entry = log_entry + 1 + log[[log_entry]] = list(file = basename(f), all_na = all_na, csd = csd) + + pcai = t(t(as.matrix(pca$map)[, use] %*% t(pca$model$loadings)[use, ]) + pca$model$center) tmp = r[[1]] From 16bb2e46648a4edc686ef2f6045e211e7ee0aec8 Mon Sep 17 00:00:00 2001 From: tnauss Date: Sun, 7 Oct 2018 11:19:12 +0200 Subject: [PATCH 07/65] Update noise removal --- src/.Rhistory | 54 +++++++++++++++++++++ src/020_rasterdb_hyperspectral_processing.R | 8 +-- src/025_extract_aoi.R | 2 +- src/030_noise_removal.R | 44 ++++++++++++++--- src/040_vegIndices.R | 6 +-- 5 files changed, 98 insertions(+), 16 deletions(-) create mode 100644 src/.Rhistory diff --git a/src/.Rhistory b/src/.Rhistory new file mode 100644 index 0000000..b8b70c8 --- /dev/null +++ b/src/.Rhistory @@ -0,0 +1,54 @@ +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +hd_files = list.files(path_hyp_aio, recursive = FALSE, full.names = TRUE) +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) +pb = shapefile(paste0(path_plots, "BPolygon.shp")) +dir.create(paste0(path_hyp_nrm), showWarnings = FALSE) +log = list() +log_entry = 0 +i = 1 +f = hd_files[i] +plotid = substr(basename(f), 1, 4) +r = readRDS(f) +nl = nlayers(r) +all_na = grep(ncell(r), summary(r)[6,]) +if(length(all_na) > 0){ +r = r[[-all_na]] +} else { +all_na = -1 +} +r +pca = rasterPCA(r) +v = pca$model$sdev**2 +# Continuous Significant Dimensionality +csd = round(sum(sapply(v, function(x){min(x,1)})), 0) +use = seq(csd) +log_entry = log_entry + 1 +log[[log_entry]] = list(file = basename(f), all_na = all_na, csd = csd) +pcai = t(t(as.matrix(pca$map)[, use] %*% t(pca$model$loadings)[use, ]) + pca$model$center) +tmp = r[[1]] +pcair = stack(lapply(seq(ncol(pcai)), function(i){ +setValues(tmp, pcai[, i]) +})) +pcair +all_na +if(all_na == 1){ +pcair = stack(setValues(tmp, rep(NA, ncell(tmp))), pcair) +} else if(all_na > 1){ +pcair = stack(pcair[[1:(all_na-1)]], +setValues(tmp, rep(NA, ncell(tmp))), +pcair[[(all_na):nlayers(pcair)]]) +} +pcair +names(pcair) = paste0(plotid, "_pcai_", seq(nl)) +pcair +saveRDS(pcair, file = paste0(path_hyp_nrm, substr(basename(f), 1, 4), "_pcai.rds")) +plotid +hd_files +hd_files = list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE) +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) +dir.create(paste0(path_hyp_vegidcs), showWarnings = FALSE) +i = 1 +plotid = substr(basename(hd_files[[i]]), 1, 4) +plotid +readRDS(hd_files[[i]] +) diff --git a/src/020_rasterdb_hyperspectral_processing.R b/src/020_rasterdb_hyperspectral_processing.R index a3adf70..33a044a 100644 --- a/src/020_rasterdb_hyperspectral_processing.R +++ b/src/020_rasterdb_hyperspectral_processing.R @@ -55,8 +55,8 @@ hd_size = do.call("rbind", hd_size) hd_size_valid = hd_size[hd_size$s > 300000, ] hd_size_valid$f = as.character(hd_size_valid$f) -hd_size_valid = hd_size_valid[-grep(paste0(dbs[[1]], "/foc1.rds"), hd_size_valid$f),] -hd_size_valid = hd_size_valid[-grep(paste0(dbs[[1]], "/foc6.rds"), hd_size_valid$f),] +hd_size_valid = hd_size_valid[-grep(paste0(dbs[[1]], "_fill/foc1.rds"), hd_size_valid$f),] +hd_size_valid = hd_size_valid[-grep(paste0(dbs[[1]], "_fill/foc6.rds"), hd_size_valid$f),] hd_size_valid = hd_size_valid[substr(basename(hd_size_valid$f), 1, 4) %in% bd_plots,] @@ -69,8 +69,8 @@ for(f in hd_size_valid$f){ # Combine metadata meta = list(data.frame(hd_size_valid[, c("c", "plotID")], list = 1)) meta[[1]]$list[meta[[1]]$c == dbs[[2]]] = 2 -meta[[2]] = list(meta_01 = readRDS(paste0(path_hyp_org, dbs[[1]], "/bands_", dbs[[1]], ".rds")), - meta_02 = readRDS(paste0(path_hyp_org, dbs[[2]], "/bands_", dbs[[2]], ".rds"))) +meta[[2]] = list(meta_01 = readRDS(paste0(path_hyp_org, dbs[[1]], "_fill/bands_", dbs[[1]], ".rds")), + meta_02 = readRDS(paste0(path_hyp_org, dbs[[2]], "_fill/bands_", dbs[[2]], ".rds"))) dir.create(path_meta, showWarnings = FALSE) saveRDS(meta, file = paste0(path_meta, "hyp_meta.rds")) diff --git a/src/025_extract_aoi.R b/src/025_extract_aoi.R index 27c7b4a..fe4eb7f 100644 --- a/src/025_extract_aoi.R +++ b/src/025_extract_aoi.R @@ -19,7 +19,7 @@ for(f in hd_files){ aoi = pb[grep(pid, pb$PlotID),] r = raster::mask(crop(r, aoi), aoi) # r = raster::mask(r, calc(r, fun=sum)) # We will do that later in the workflow - names(r) = paste0(pid, "_", names(r)) + names(r) = paste0(pid, "_", seq(nlayers(r))) saveRDS(r, file = paste0(path_hyp_aio, pid, ".rds")) } diff --git a/src/030_noise_removal.R b/src/030_noise_removal.R index d152d3d..9538383 100644 --- a/src/030_noise_removal.R +++ b/src/030_noise_removal.R @@ -1,6 +1,11 @@ # Compute noise removal on a per plot basis source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +if(length(showConnections()) == 0){ + cores = 3 + cl = parallel::makeCluster(cores) + doParallel::registerDoParallel(cl) +} hd_files = list.files(path_hyp_aio, recursive = FALSE, full.names = TRUE) h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) @@ -29,11 +34,11 @@ dir.create(paste0(path_hyp_nrm), showWarnings = FALSE) # saveRDS(mir, file = paste0(path_hyp_nrm, substr(basename(f), 1, 4), "_mnfi.rds")) # } -log = list() -log_entry = 0 - -for(f in hd_files){ +log = foreach (i = seq(length(hd_files)), .packages = c("raster", "RStoolbox")) %dopar% { + f = hd_files[i] + plotid = substr(basename(f), 1, 4) r = readRDS(f) + nl = nlayers(r) all_na = grep(ncell(r), summary(r)[6,]) if(length(all_na) > 0){ @@ -49,9 +54,7 @@ for(f in hd_files){ csd = round(sum(sapply(v, function(x){min(x,1)})), 0) use = seq(csd) - log_entry = log_entry + 1 - log[[log_entry]] = list(file = basename(f), all_na = all_na, csd = csd) - + log = list(file = basename(f), all_na = all_na, csd = csd) pcai = t(t(as.matrix(pca$map)[, use] %*% t(pca$model$loadings)[use, ]) + pca$model$center) @@ -59,8 +62,33 @@ for(f in hd_files){ pcair = stack(lapply(seq(ncol(pcai)), function(i){ setValues(tmp, pcai[, i]) })) + + if(all_na == 1){ + pcair = stack(setValues(tmp, rep(NA, ncell(tmp))), pcair) + } else if(all_na > 1){ + pcair = stack(pcair[[1:(all_na-1)]], + setValues(tmp, rep(NA, ncell(tmp))), + pcair[[(all_na):nlayers(pcair)]]) + } + names(pcair) = paste0(plotid, "_pcai_", seq(nl)) - saveRDS(pcair, file = paste0(path_hyp_nrm, substr(basename(f), 1, 4), "_pcai.rds")) + saveRDS(pcair, file = paste0(path_hyp_nrm, plotid, "_pcai.rds")) + + return(log) } saveRDS(log, file = paste0(path_meta, "030_noise_removal_log.rds")) + +stopCluster(cl) + + +# Cross check +log = readRDS(file = paste0(path_meta, "030_noise_removal_log.rds")) + +csd_stat = sapply(log, function(l){l$csd}) +summary(csd_stat) + +all_na_stat = sapply(log, function(l){l$all_na}) +summary(all_na_stat) + + \ No newline at end of file diff --git a/src/040_vegIndices.R b/src/040_vegIndices.R index ac1b735..1514120 100644 --- a/src/040_vegIndices.R +++ b/src/040_vegIndices.R @@ -7,7 +7,7 @@ if(length(showConnections()) == 0){ doParallel::registerDoParallel(cl) } -hd_files = list.files(path_hyp_aio, recursive = FALSE, full.names = TRUE) +hd_files = list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE) h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) dir.create(paste0(path_hyp_vegidcs), showWarnings = FALSE) @@ -30,10 +30,10 @@ vis = c("CARI", "TGI", "TVI", "Vogelmann", "Vogelmann2", "Vogelmann4") -foreach(i = seq(length(hd_files))) %dopar% { +foreach(i = seq(length(hd_files)), .packages = c("hsdar", "raster")) %dopar% { plotid = substr(basename(hd_files[[i]]), 1, 4) m = h_meta[[2]][[h_meta[[1]]$list[grep(plotid, h_meta[[1]]$plotID)]]] - r = speclib(readRDS(hd_files[[i]]), + r = hsdar::speclib(readRDS(hd_files[[i]]), wavelength = m$wavelength, fwhm = m$fwhm, continuousdata = "auto") From 7a9c0a06d05fb2a46092cda77aa4f422d7ca9590 Mon Sep 17 00:00:00 2001 From: tnauss Date: Sun, 7 Oct 2018 18:11:58 +0200 Subject: [PATCH 08/65] Update vegindices --- src/000_set_environment.R | 1 - src/040_vegIndices.R | 14 +++++++++----- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/src/000_set_environment.R b/src/000_set_environment.R index 80540f4..5fcf15a 100644 --- a/src/000_set_environment.R +++ b/src/000_set_environment.R @@ -46,7 +46,6 @@ library(rgdal) # library(semPlot) library(sp) library(spacetime) -library(spectralrao) # devtools::install_github("mattmar/spectralrao") # library(vegan) # library(yaml) diff --git a/src/040_vegIndices.R b/src/040_vegIndices.R index 1514120..486d48f 100644 --- a/src/040_vegIndices.R +++ b/src/040_vegIndices.R @@ -29,18 +29,22 @@ vis = c("CARI", "SRPI", "TCARI", "TCARI/OSAVI", "TCARI2", "TCARI2/OSAVI2", "TGI", "TVI", "Vogelmann", "Vogelmann2", "Vogelmann4") - -foreach(i = seq(length(hd_files)), .packages = c("hsdar", "raster")) %dopar% { +foreach(i = seq(length(hd_files)), .packages = c("hsdar", "raster")) %do% { plotid = substr(basename(hd_files[[i]]), 1, 4) m = h_meta[[2]][[h_meta[[1]]$list[grep(plotid, h_meta[[1]]$plotID)]]] - r = hsdar::speclib(readRDS(hd_files[[i]]), + r = hsdar::speclib(brick(readRDS(hd_files[[i]])), wavelength = m$wavelength, fwhm = m$fwhm, continuousdata = "auto") - v = vegindex(r, index = vis) + v = vegindex(r, index = vis) vr = v@spectra@spectra_ra names(vr) = vis saveRDS(vr, file = paste0(path_hyp_vegidcs, plotid, "_vegidcs.rds")) -} +} stopCluster(cl) + + +# Visually check data +visCheck(datapath = path_hyp_vegidcs, polygonfile = paste0(path_plots, "BPolygon.shp"), band = 47) +summary(unlist(lapply(files, function(f){nlayers(readRDS(files[[1]]))}))) From 9835f4b8dc47644c3cf89f99d00f3ca2b3a48641 Mon Sep 17 00:00:00 2001 From: tnauss Date: Sun, 7 Oct 2018 19:21:31 +0200 Subject: [PATCH 09/65] Update divIndices --- src/.Rhistory | 566 ++++++++++++++++++++++++++++++++++++++----- src/001_functions.R | 524 --------------------------------------- src/050_divIndices.R | 3 +- 3 files changed, 513 insertions(+), 580 deletions(-) diff --git a/src/.Rhistory b/src/.Rhistory index b8b70c8..30a54cc 100644 --- a/src/.Rhistory +++ b/src/.Rhistory @@ -1,54 +1,512 @@ -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -hd_files = list.files(path_hyp_aio, recursive = FALSE, full.names = TRUE) -h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) -pb = shapefile(paste0(path_plots, "BPolygon.shp")) -dir.create(paste0(path_hyp_nrm), showWarnings = FALSE) -log = list() -log_entry = 0 -i = 1 -f = hd_files[i] -plotid = substr(basename(f), 1, 4) -r = readRDS(f) -nl = nlayers(r) -all_na = grep(ncell(r), summary(r)[6,]) -if(length(all_na) > 0){ -r = r[[-all_na]] -} else { -all_na = -1 -} -r -pca = rasterPCA(r) -v = pca$model$sdev**2 -# Continuous Significant Dimensionality -csd = round(sum(sapply(v, function(x){min(x,1)})), 0) -use = seq(csd) -log_entry = log_entry + 1 -log[[log_entry]] = list(file = basename(f), all_na = all_na, csd = csd) -pcai = t(t(as.matrix(pca$map)[, use] %*% t(pca$model$loadings)[use, ]) + pca$model$center) -tmp = r[[1]] -pcair = stack(lapply(seq(ncol(pcai)), function(i){ -setValues(tmp, pcai[, i]) -})) -pcair -all_na -if(all_na == 1){ -pcair = stack(setValues(tmp, rep(NA, ncell(tmp))), pcair) -} else if(all_na > 1){ -pcair = stack(pcair[[1:(all_na-1)]], -setValues(tmp, rep(NA, ncell(tmp))), -pcair[[(all_na):nlayers(pcair)]]) -} -pcair -names(pcair) = paste0(plotid, "_pcai_", seq(nl)) -pcair -saveRDS(pcair, file = paste0(path_hyp_nrm, substr(basename(f), 1, 4), "_pcai.rds")) -plotid -hd_files -hd_files = list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE) -h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) -dir.create(paste0(path_hyp_vegidcs), showWarnings = FALSE) -i = 1 -plotid = substr(basename(hd_files[[i]]), 1, 4) -plotid -readRDS(hd_files[[i]] -) +if( is(input[[1]],"RasterLayer") ) { +if( mode=="classic" ){ +isfloat<-FALSE # If data are float numbers, transform them in integer +if( !is.wholenumber(rasterm@data@min) | !is.wholenumber(rasterm@data@max) | is.infinite(rasterm@data@min) ){ +message("Converting input data in an integer matrix...") +isfloat<-TRUE +mfactor<-100^simplify +rasterm<-getValues(rasterm)*mfactor +gc() +rasterm<-as.integer(rasterm) +gc() +rasterm<-matrix(rasterm,nrow(input),ncol(input),byrow=TRUE) +gc() +}else{ +rasterm<-matrix(getValues(rasterm),ncol=ncol(input),nrow=nrow(input),byrow=T) +} +} +#Print user messages +if( mode=="classic" & shannon ){ +message("Matrix check OK: \nRao and Shannon output matrices will be returned") +}else if( mode=="classic" & !shannon ){ +message("Matrix check OK: \nRao output matrix will be returned") +}else if( mode=="multidimension" & !shannon ){ +message(("Matrix check OK: \nA matrix with multimension RaoQ will be returned")) +}else if( mode=="multidimension" & shannon ){ +stop("Matrix check failed: \nMultidimension and Shannon not compatible, set shannon=FALSE") +}else{ +stop("Matrix check failed: \nNot a valid input | method | distance, please check all these options...") +} +# If data are a matrix or a list +}else if( is(input,"matrix") | is(input,"list") ) { +if( mode=="classic" ){ +isfloat<-FALSE # If data are float numbers, transform them in integer +if( !is.integer(rasterm) ){ +message("Converting input data in an integer matrix...") +isfloat<-TRUE +mfactor<-100^simplify +rasterm<-as.integer(rasterm*mfactor) +rasterm<-matrix(rasterm,nrow(input),ncol(input),byrow=TRUE) +gc() +}else{ +rasterm<-as.matrix(rasterm) +} +} +if( mode=="classic" & shannon ){ +message("Matrix check OK: \nRao and Shannon output matrices will be returned") +}else if( mode=="classic" & !shannon ){ +message("Matrix check OK: \nRao output matrix will be returned") +}else if( mode=="multidimension" & shannon ){ +stop("Matrix check failed: \nMultidimension and Shannon not compatible, set shannon=FALSE") +}else if( mode=="multidimension" & !shannon ){ +message(("Matrix check OK: \nA matrix with multimension RaoQ will be returned")) +}else{ +stop("Matrix check failed: \nNot a valid input | method | distance, please check all these options") +} +} +if(nc.cores>1) { +if(mode=="multidimension"){ +message( +"Multi-core is not supported for multidimensional Rao, proceding with 1 core...") +nc.cores=1 +}else{ +message(" +##################### Starting parallel calculation #######################") +} +} +# +## Derive operational moving window +# +if( window%%2==1 ){ +w <- (window-1)/2 +} else { +stop("Moving window size must be an odd number.") +} +# +## Preparation of output matrices +# +if(nc.cores==1) { +raoqe<-matrix(rep(NA,dim(rasterm)[1]*dim(rasterm)[2]),nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) +} +if(shannon){ +shannond<-matrix(rep(NA,dim(rasterm)[1]*dim(rasterm)[2]),nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) +} +# +## If mode is classic Rao +# +if(mode=="classic") { +# +# If classic RaoQ is parallelized +# +if(nc.cores>1) { +# +## Required packages for parallel calculation +# +require(foreach) +require(doSNOW) +require(parallel) +if( cluster.type=="MPI" ){ +require(Rmpi) +} +# +## Reshape values +# +values<-as.numeric(as.factor(rasterm)) +rasterm_1<-matrix(data=values,nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) +# +## Add fake columns and rows for moving window +# +hor<-matrix(NA,ncol=dim(rasterm)[2],nrow=w) +ver<-matrix(NA,ncol=w,nrow=dim(rasterm)[1]+w*2) +trasterm<-cbind(ver,rbind(hor,rasterm_1,hor),ver) +rm(hor,ver,rasterm_1,values); gc() +if(debugging){cat("#check: RaoQ parallel function.")} +# +## Derive distance matrix +# +d1<-proxy::dist(as.numeric(levels(as.factor(rasterm))),method=distance_m) +gc() +# +## Export variables in the global environment +# +if(isfloat) { +sapply(c("mfactor"), function(x) {assign(x,get(x),envir= .GlobalEnv)}) +} +# +## Create cluster object with given number of slaves +# +plr<<-TRUE +if( cluster.type=="SOCK" || cluster.type=="FORK" ) { +cls <- parallel::makeCluster(nc.cores,type=cluster.type, outfile="",useXDR=FALSE,methods=FALSE,output="") +} else if( cluster.type=="MPI" ) { +cls <- makeMPIcluster(nc.cores,outfile="",useXDR=FALSE,methods=FALSE,output="") +} +registerDoSNOW(cls) +clusterCall(cl=cls, function() library("parallel")) +if(isfloat) { +parallel::clusterExport(cl=cls, varlist=c("mfactor")) +} +on.exit(stopCluster(cls)) # Close the clusters on exit +gc() +# +## Start the parallelized loop over iter +# +pb <- txtProgressBar(min = (1+w), max = dim(rasterm)[2], style = 3) +progress <- function(n) setTxtProgressBar(pb, n) +opts <- list(progress = progress) +raop <- foreach(cl=(1+w):(dim(rasterm)[2]+w),.options.snow = opts,.verbose = F) %dopar% { +if(debugging) { +cat(paste(cl)) +} +raout <- sapply((1+w):(dim(rasterm)[1]+w), function(rw) { +if( length(!which(!trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)]%in%NA)) < window^2-((window^2)*na.tolerance) ) { +vv<-NA +return(vv) +} +else { +tw<-summary(as.factor(trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)]),maxsum=10000) +if( "NA's"%in%names(tw) ) { +tw<-tw[-length(tw)] +} +if( debugging ) { +message("Working on coords ",rw,",",cl,". classes length: ",length(tw),". window size=",window) +} +tw_labels<-names(tw) +tw_values<-as.vector(tw) +if( length(tw_values) <=2 ) { +vv<-NA +return(vv) +} +else { +p <- tw_values/sum(tw_values) +p1 <- diag(0,length(tw_values)) +p1[upper.tri(p1)] <- c(combn(p,m=2,FUN=prod)) +p1[lower.tri(p1)] <- c(combn(p,m=2,FUN=prod)) +d2 <- unname(as.matrix(d1)[as.numeric(tw_labels),as.numeric(tw_labels)]) +vv <- sum(p1*d2) +return(vv) +} +} +}) +return(raout) +} # End classic RaoQ - parallelized +message(("\n\nCalculation of Rao's index complete.\n")) +# +## If classic RaoQ is sequential +# +} else if(nc.cores==1) { +# Reshape values +values<-as.numeric(as.factor(rasterm)) +rasterm_1<-matrix(data=values,nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) +# Add fake columns and rows for moving window +hor<-matrix(NA,ncol=dim(rasterm)[2],nrow=w) +ver<-matrix(NA,ncol=w,nrow=dim(rasterm)[1]+w*2) +trasterm<-cbind(ver,rbind(hor,rasterm_1,hor),ver) +# Derive distance matrix +classes<-levels(as.factor(rasterm)) +d1<-proxy::dist(x=as.numeric(classes),method=distance_m) +# Loop over each pixel +for (cl in (1+w):(dim(rasterm)[2]+w)) { +for(rw in (1+w):(dim(rasterm)[1]+w)) { +if( length(!which(!trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)]%in%NA)) < window^2-((window^2)*na.tolerance) ) { +raoqe[rw-w,cl-w]<-NA +} else { +tw<-summary(as.factor(trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)]),maxsum=10000) +if( "NA's"%in%names(tw) ) { +tw<-tw[-length(tw)] +} +if(debugging) { +message("Working on coords ",rw ,",",cl,". classes length: ",length(tw),". window size=",window) +} +tw_labels<-names(tw) +tw_values<-as.vector(tw) +if(length(tw_values) <= 2) { +raoqe[rw-w,cl-w]<-NA +} else { +p <- tw_values/sum(tw_values) +p1 <- diag(0,length(tw_values)) +p1[upper.tri(p1)] <- c(combn(p,m=2,FUN=prod)) +p1[lower.tri(p1)] <- c(combn(p,m=2,FUN=prod)) +d2 <- unname(as.matrix(d1)[as.numeric(tw_labels),as.numeric(tw_labels)]) +if(isfloat) { +raoqe[rw-w,cl-w]<-sum(p1*d2)/mfactor +} else { +raoqe[rw-w,cl-w]<-sum(p1*d2) +} +} +} +progress(value=cl, max.value=c((dim(rasterm)[2]+w)+(dim(rasterm)[1]+w))/2, progress.bar = FALSE) +} +} # End of for loop +message(("\nCalculation of Rao's index complete.\n")) +} +} # End classic RaoQ - sequential +else if( mode=="multidimension" ){ +if(debugging) { +message("#check: Into multidimensional clause.") +} +#----------------------------------------------------# +# +## If multimensional RaoQ +# +# Check if there are NAs in the matrices +if ( is(rasterm,"RasterLayer") ){ +if(any(sapply(lapply(unlist(input),length),is.na)==TRUE)) +message("\n Warning: One or more RasterLayers contain NA which will be threated as 0") +} else if ( is(rasterm,"matrix") ){ +if(any(sapply(input, is.na)==TRUE) ) { +message("\n Warning: One or more matrices contain NA which will be threated as 0") +} +} +# +## Check whether the chosen distance metric is valid or not +# +if( distance_m=="euclidean" | distance_m=="manhattan" | distance_m=="canberra" | distance_m=="minkowski" | distance_m=="mahalanobis" ) { +# +## Define distance functions +# +#euclidean +multieuclidean <- function(x) { +tmp <- lapply(x, function(y) { +(y[[1]]-y[[2]])^2 +}) +return(sqrt(Reduce(`+`,tmp))) +} +#manhattan +multimanhattan <- function(x) { +tmp <- lapply(x, function(y) { +abs(y[[1]]-y[[2]]) +}) +return(Reduce(`+`,tmp)) +} +#canberra +multicanberra <- function(x) { +tmp <- lapply(x, function(y) { +abs(y[[1]] - y[[2]]) / (abs(y[[1]]) + abs(y[[2]])) +}) +return(Reduce(`+`,tmp)) +} +#minkowski +multiminkowski <- function(x) { +tmp <- lapply(x, function(y) { +abs((y[[1]]-y[[2]])^lambda) +}) +return(Reduce(`+`,tmp)^(1/lambda)) +} +#mahalanobis +multimahalanobis <- function(x){ +tmp <- matrix(unlist(lapply(x,function(y) as.vector(y))),ncol=2) +tmp <- tmp[!is.na(tmp[,1]),] +if( length(tmp)==0 | is.null(dim(tmp)) ) { +return(NA) +} else if(rcond(cov(tmp)) <= 0.001) { +return(NA) +} else { +#return the inverse of the covariance matrix of tmp; aka the precision matrix +inverse<-solve(cov(tmp)) +if(debugging){ +print(inverse) +} +tmp<-scale(tmp,center=T,scale=F) +tmp<-as.numeric(t(tmp[1,])%*%inverse%*%tmp[1,]) +return(sqrt(tmp)) +} +} +# +## Decide what function to use +# +if( distance_m=="euclidean") { +distancef <- get("multieuclidean") +} else if( distance_m=="manhattan" ) { +distancef <- get("multimanhattan") +} else if( distance_m=="canberra" ) { +distancef <- get("multicanberra") +} else if( distance_m=="minkowski" ) { +if( lambda==0 ) { +stop("The Minkowski Distance for lambda = 0 is Infinity; please choose another value for lambda.") +} else { +distancef <- get("multiminkowski") +} +} else if( distance_m=="mahalanobis" ) { +distancef <- get("multimahalanobis") +warning("Multimahalanobis distance is not fully supported...") +} +} else { +stop("Distance function not defined for multidimensional Rao's Q; please choose among euclidean, manhattan, canberra, minkowski, mahalanobis!") +} +# +## Reshape values +# +vls<-lapply(input, function(x) {raster::as.matrix(x)}) +# +## Rescale and add fake columns and rows for moving w +# +hor<-matrix(NA,ncol=dim(vls[[1]])[2],nrow=w) +ver<-matrix(NA,ncol=w,nrow=dim(vls[[1]])[1]+w*2) +if(rescale) { +trastersm<-lapply(vls, function(x) { +t1 <- raster::scale(raster(cbind(ver,rbind(hor,x,hor),ver))) +t2 <- as.matrix(t1) +return(t2) +}) +} else { +trastersm<-lapply(vls, function(x) { +cbind(ver,rbind(hor,x,hor),ver) +}) +} +# +## Loop over all the pixels in the matrices +# +if( (ncol(vls[[1]])*nrow(vls[[1]]))> 10000) { +message("\n Warning: ",ncol(vls[[1]])*nrow(vls[[1]])*length(vls), " cells to be processed, may take some time... \n") +} +cores = 3 +clp = parallel::makeCluster(cores) +doParallel::registerDoParallel(clp) +on.exit(stopCluster(clp)) +t = foreach (cl = (1+w):(dim(vls[[1]])[2]+w), .combine="rbind", .packages="foreach") %dopar% { +foreach (rw = (1+w):(dim(vls[[1]])[1]+w), .combine="rbind") %dopar% { +if( length(!which(!trastersm[[1]][c(rw-w):c(rw+w),c(cl-w):c(cl+w)]%in%NA)) < window^2-((window^2)*na.tolerance) ) { +# raoqe[rw-w,cl-w] <- NA +return(data.frame(row=rw-w, col=cl-w, value=NA)) +} else { +tw<-lapply(trastersm, function(x) { x[(rw-w):(rw+w),(cl-w):(cl+w)] +}) +# +## Vectorize the matrices in the list and calculate +#Among matrix pairwase distances +lv <- lapply(tw, function(x) {as.vector(t(x))}) +vcomb <- combn(length(lv[[1]]),2) +vout <- c() +for(p in 1:ncol(vcomb) ) { +lpair <- lapply(lv, function(chi) { +c(chi[vcomb[1,p]],chi[vcomb[2,p]]) +}) +vout[p] <- distancef(lpair) +} +# raoqe[rw-w,cl-w] <- sum(rep(vout,2) * (1/(window)^4),na.rm=TRUE) +return(data.frame(row=rw-w, col=cl-w, value=sum(rep(vout,2) * (1/(window)^4),na.rm=TRUE))) +} +} +# do.call("rbind", lapply((1+w):(dim(vls[[1]])[1]+w), function(rw){ +# if( length(!which(!trastersm[[1]][c(rw-w):c(rw+w),c(cl-w):c(cl+w)]%in%NA)) < window^2-((window^2)*na.tolerance) ) { +# # raoqe[rw-w,cl-w] <- NA +# return(data.frame(row=rw-w, col=cl-w, value=NA)) +# } else { +# tw<-lapply(trastersm, function(x) { x[(rw-w):(rw+w),(cl-w):(cl+w)] +# }) +# # +# ## Vectorize the matrices in the list and calculate +# #Among matrix pairwase distances +# lv <- lapply(tw, function(x) {as.vector(t(x))}) +# vcomb <- combn(length(lv[[1]]),2) +# vout <- c() +# for(p in 1:ncol(vcomb) ) { +# lpair <- lapply(lv, function(chi) { +# c(chi[vcomb[1,p]],chi[vcomb[2,p]]) +# }) +# vout[p] <- distancef(lpair) +# } +# # raoqe[rw-w,cl-w] <- sum(rep(vout,2) * (1/(window)^4),na.rm=TRUE) +# return(data.frame(row=rw-w, col=cl-w, value=sum(rep(vout,2) * (1/(window)^4),na.rm=TRUE))) +# } +# })) +# progress(value=cl, max.value=dim(rasterm)[2]+w, progress.bar = FALSE) +} +raoqe<-matrix(rep(NA,dim(rasterm)[1]*dim(rasterm)[2]),nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) +for(i in seq(nrow(t))){ +raoqe[t[i,"row"], t[i,"col"]] = t[i,"value"] +} +if(exists("pb")) { +close(pb) +} +} else{ +message("Something went wrong when trying to calculate Rao's indiex.") +} # end of multimensional RaoQ +message("\nCalculation of Multidimensional Rao's index complete.\n") +#----------------------------------------------------# +# +## Shannon +# +if( shannon==T ) { +message("\nStarting Shannon-Wiener index calculation:\n") +# Reshape values +values<-as.numeric(as.factor(rasterm)) +rasterm_1<-matrix(data=values,nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) +# +## Add "fake" columns and rows for moving window +# +hor<-matrix(NA,ncol=dim(rasterm)[2],nrow=w) +ver<-matrix(NA,ncol=w,nrow=dim(rasterm)[1]+w*2) +trasterm<-cbind(ver,rbind(hor,rasterm_1,hor),ver) +# +## Loop over all the pixels +# +for (cl in (1+w):(dim(rasterm)[2]+w)) { +for(rw in (1+w):(dim(rasterm)[1]+w)) { +if( length(!which(!trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)]%in%NA)) < window^2-((window^2)*na.tolerance) ) { +shannond[rw-w,cl-w]<-NA +} else { +tw<-summary(as.factor(trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)])) +if( "NA's"%in%names(tw) ) { +tw<-tw[-length(tw)] +} +tw[tw>1]<-1 +tw_values<-as.vector(tw) +p<-tw_values/length(tw_values) +p_log<-log(p) +shannond[rw-w,cl-w]<-(-(sum(p*p_log))) +} +} +svMisc::progress(value=cl, max.value=(c((dim(rasterm)[2]+w)+(dim(rasterm)[1]+w))/2), progress.bar = FALSE) +} +message(("\nCalculation of Shannon's index is also complete!\n")) +} # End ShannonD +#----------------------------------------------------# +# +## Return multiple outputs +# +if(debugging){ +message( "#check: return function." ) +} +if( shannon ) { +if( nc.cores>1 ) { +outl<-list(do.call(cbind,raop),shannond) +names(outl)<-c("Rao","Shannon") +return(outl) +} else if( nc.cores==1 ){ +outl<-list(raoqe,shannond) +names(outl)<-c("Rao","Shannon") +return(outl) +} +} else if( !shannon & mode=="classic" ) { +if( isfloat & nc.cores>1 ) { +#return(raop) +return(do.call(cbind,raop)/mfactor) +if(debugging){ +message("#check: return function - classic.") +} +} else if( !isfloat & nc.cores>1 ) { +outl<-list(do.call(cbind,raop)) +names(outl)<-c("Rao") +return(outl) +} else if( sfloat & nc.cores==1 ) { +outl<-list(raoqe/mfactor) +names(outl)<-c("Rao") +return(outl) +} else if( !isfloat & nc.cores==1 ) { +outl<-list(raoqe) +names(outl)<-c("Rao") +return(outl) +} else if( !isfloat & nc.cores>1 ) { +outl<-list(do.call(cbind,raoqe)) +names(outl)<-c("Rao") +return(outl) +} +} else if( !shannon & mode=="multidimension" ) { +outl<-list(raoqe) +names(outl)<-c("Multidimension_Rao") +return(outl) +} +} +# ra = aggregate(r, fact=2, fun=mean) +raomatrix <- spectralrao(as.list(r), +mode="multidimension", +distance_m="euclidean", +window=3, +shannon=FALSE, +debugging=TRUE, +simplify=3) +raor = setValues(r[[1]], raomatrix[[1]]) +names(raor) = plotid +raor diff --git a/src/001_functions.R b/src/001_functions.R index d1d754d..a85238d 100644 --- a/src/001_functions.R +++ b/src/001_functions.R @@ -594,527 +594,3 @@ spectralrao <- function(input, distance_m="euclidean", p=NULL, window=9, mode="c -######### SPECTRALRAO ############################# -## Developed by Matteo Marcantonio -## Latest update: 04th October 2018 -## ------------------------------------------------- -## Code to calculate Rao's quadratic entropy on a -## numeric matrix, RasterLayer object (or lists) -## using a moving window algorithm. -## The function also calculates Shannon-Wiener index. -## ------------------------------------------------- -## Rao's Q Min = 0, if all pixel classes have -## distance 0. If the chosen distance ranges between -## 0 and 1, Rao's Max = 1-1/S (Simpson Diversity, -## where S is the number of pixel classes). -## ------------------------------------------------- -## Find more info and application here: -## 1) https://doi.org/10.1016/j.ecolind.2016.07.039 Titel anhand dieser DOI in Citavi-Projekt übernehmen -## 2) https://besjournals.onlinelibrary.wiley.com/doi/10.1111/2041-210X.12941 %CITAVIPICKER£10.1111/2041-210X.12941£Titel anhand dieser DOI in Citavi-Projekt übernehmen£% -##################################################### -# Function -spectralraoORG <- function(input, distance_m="euclidean", p=NULL, window=9, mode="classic", lambda=0, shannon=FALSE, rescale=FALSE, na.tolerance=0.0, simplify=3, nc.cores=1, cluster.type="MPI", debugging=FALSE, ...) -{ - # - ## Load required packages - # - require(raster) - require(svMisc) - require(proxy) - # - ## Define function to check if a number is an integer - # - is.wholenumber <- function(x, tol = .Machine$double.eps^0.5) abs(x - round(x)) < tol - # - ## Initial checks - # - if( !(is(input,"matrix") | is(input,"SpatialGridDataFrame") | is(input,"RasterLayer") | is(input,"list")) ) { - stop("\nNot a valid input object.") - } - if( is(input,"SpatialGridDataFrame") ) { - input <- raster(input) # Change input matrix/ces names - } - if( is(input,"matrix") | is(input,"RasterLayer")) { - rasterm<-input - } else if( is(input,"list") ) { - rasterm<-input[[1]] - } - if(na.tolerance>1){ - stop("na.tolerance must be in the [0-1] interval. Exiting...") - } - # Deal with matrices and RasterLayer in a different way - # If data are raster layers - if( is(input[[1]],"RasterLayer") ) { - if( mode=="classic" ){ - isfloat<-FALSE # If data are float numbers, transform them in integer - if( !is.wholenumber(rasterm@data@min) | !is.wholenumber(rasterm@data@max) | is.infinite(rasterm@data@min) ){ - message("Converting input data in an integer matrix...") - isfloat<-TRUE - mfactor<-100^simplify - rasterm<-getValues(rasterm)*mfactor - gc() - rasterm<-as.integer(rasterm) - gc() - rasterm<-matrix(rasterm,nrow(input),ncol(input),byrow=TRUE) - gc() - }else{ - rasterm<-matrix(getValues(rasterm),ncol=ncol(input),nrow=nrow(input),byrow=T) - } - } - #Print user messages - if( mode=="classic" & shannon ){ - message("Matrix check OK: \nRao and Shannon output matrices will be returned") - }else if( mode=="classic" & !shannon ){ - message("Matrix check OK: \nRao output matrix will be returned") - }else if( mode=="multidimension" & !shannon ){ - message(("Matrix check OK: \nA matrix with multimension RaoQ will be returned")) - }else if( mode=="multidimension" & shannon ){ - stop("Matrix check failed: \nMultidimension and Shannon not compatible, set shannon=FALSE") - }else{ - stop("Matrix check failed: \nNot a valid input | method | distance, please check all these options...") - } - # If data are a matrix or a list - }else if( is(input,"matrix") | is(input,"list") ) { - if( mode=="classic" ){ - isfloat<-FALSE # If data are float numbers, transform them in integer - if( !is.integer(rasterm) ){ - message("Converting input data in an integer matrix...") - isfloat<-TRUE - mfactor<-100^simplify - rasterm<-as.integer(rasterm*mfactor) - rasterm<-matrix(rasterm,nrow(input),ncol(input),byrow=TRUE) - gc() - }else{ - rasterm<-as.matrix(rasterm) - } - } - if( mode=="classic" & shannon ){ - message("Matrix check OK: \nRao and Shannon output matrices will be returned") - }else if( mode=="classic" & !shannon ){ - message("Matrix check OK: \nRao output matrix will be returned") - }else if( mode=="multidimension" & shannon ){ - stop("Matrix check failed: \nMultidimension and Shannon not compatible, set shannon=FALSE") - }else if( mode=="multidimension" & !shannon ){ - message(("Matrix check OK: \nA matrix with multimension RaoQ will be returned")) - }else{ - stop("Matrix check failed: \nNot a valid input | method | distance, please check all these options") - } - } - - if(nc.cores>1) { - if(mode=="multidimension"){ - message( - "Multi-core is not supported for multidimensional Rao, proceding with 1 core...") - nc.cores=1 - }else{ - message(" - ##################### Starting parallel calculation #######################") - } - } - # - ## Derive operational moving window - # - if( window%%2==1 ){ - w <- (window-1)/2 - } else { - stop("Moving window size must be an odd number.") - } - # - ## Preparation of output matrices - # - if(nc.cores==1) { - raoqe<-matrix(rep(NA,dim(rasterm)[1]*dim(rasterm)[2]),nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) - } - if(shannon){ - shannond<-matrix(rep(NA,dim(rasterm)[1]*dim(rasterm)[2]),nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) - } - # - ## If mode is classic Rao - # - if(mode=="classic") { - # - # If classic RaoQ is parallelized - # - if(nc.cores>1) { - # - ## Required packages for parallel calculation - # - require(foreach) - require(doSNOW) - require(parallel) - if( cluster.type=="MPI" ){ - require(Rmpi) - } - # - ## Reshape values - # - values<-as.numeric(as.factor(rasterm)) - rasterm_1<-matrix(data=values,nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) - # - ## Add fake columns and rows for moving window - # - hor<-matrix(NA,ncol=dim(rasterm)[2],nrow=w) - ver<-matrix(NA,ncol=w,nrow=dim(rasterm)[1]+w*2) - trasterm<-cbind(ver,rbind(hor,rasterm_1,hor),ver) - rm(hor,ver,rasterm_1,values); gc() - if(debugging){cat("#check: RaoQ parallel function.")} - # - ## Derive distance matrix - # - d1<-proxy::dist(as.numeric(levels(as.factor(rasterm))),method=distance_m) - gc() - # - ## Export variables in the global environment - # - if(isfloat) { - sapply(c("mfactor"), function(x) {assign(x,get(x),envir= .GlobalEnv)}) - } - # - ## Create cluster object with given number of slaves - # - plr<<-TRUE - if( cluster.type=="SOCK" || cluster.type=="FORK" ) { - cls <- parallel::makeCluster(nc.cores,type=cluster.type, outfile="",useXDR=FALSE,methods=FALSE,output="") - } else if( cluster.type=="MPI" ) { - cls <- makeMPIcluster(nc.cores,outfile="",useXDR=FALSE,methods=FALSE,output="") - } - registerDoSNOW(cls) - clusterCall(cl=cls, function() library("parallel")) - if(isfloat) { - parallel::clusterExport(cl=cls, varlist=c("mfactor")) - } - on.exit(stopCluster(cls)) # Close the clusters on exit - gc() - # - ## Start the parallelized loop over iter - # - pb <- txtProgressBar(min = (1+w), max = dim(rasterm)[2], style = 3) - progress <- function(n) setTxtProgressBar(pb, n) - opts <- list(progress = progress) - raop <- foreach(cl=(1+w):(dim(rasterm)[2]+w),.options.snow = opts,.verbose = F) %dopar% { - if(debugging) { - cat(paste(cl)) - } - raout <- sapply((1+w):(dim(rasterm)[1]+w), function(rw) { - if( length(!which(!trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)]%in%NA)) < window^2-((window^2)*na.tolerance) ) { - vv<-NA - return(vv) - } - else { - tw<-summary(as.factor(trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)]),maxsum=10000) - if( "NA's"%in%names(tw) ) { - tw<-tw[-length(tw)] - } - if( debugging ) { - message("Working on coords ",rw,",",cl,". classes length: ",length(tw),". window size=",window) - } - tw_labels<-names(tw) - tw_values<-as.vector(tw) - if( length(tw_values) <=2 ) { - vv<-NA - return(vv) - } - else { - p <- tw_values/sum(tw_values) - p1 <- diag(0,length(tw_values)) - p1[upper.tri(p1)] <- c(combn(p,m=2,FUN=prod)) - p1[lower.tri(p1)] <- c(combn(p,m=2,FUN=prod)) - d2 <- unname(as.matrix(d1)[as.numeric(tw_labels),as.numeric(tw_labels)]) - vv <- sum(p1*d2) - return(vv) - } - } - }) - return(raout) - } # End classic RaoQ - parallelized - message(("\n\nCalculation of Rao's index complete.\n")) - # - ## If classic RaoQ is sequential - # - } else if(nc.cores==1) { - # Reshape values - values<-as.numeric(as.factor(rasterm)) - rasterm_1<-matrix(data=values,nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) - # Add fake columns and rows for moving window - hor<-matrix(NA,ncol=dim(rasterm)[2],nrow=w) - ver<-matrix(NA,ncol=w,nrow=dim(rasterm)[1]+w*2) - trasterm<-cbind(ver,rbind(hor,rasterm_1,hor),ver) - # Derive distance matrix - classes<-levels(as.factor(rasterm)) - d1<-proxy::dist(x=as.numeric(classes),method=distance_m) - # Loop over each pixel - for (cl in (1+w):(dim(rasterm)[2]+w)) { - for(rw in (1+w):(dim(rasterm)[1]+w)) { - if( length(!which(!trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)]%in%NA)) < window^2-((window^2)*na.tolerance) ) { - raoqe[rw-w,cl-w]<-NA - } else { - tw<-summary(as.factor(trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)]),maxsum=10000) - if( "NA's"%in%names(tw) ) { - tw<-tw[-length(tw)] - } - if(debugging) { - message("Working on coords ",rw ,",",cl,". classes length: ",length(tw),". window size=",window) - } - tw_labels<-names(tw) - tw_values<-as.vector(tw) - if(length(tw_values) <= 2) { - raoqe[rw-w,cl-w]<-NA - } else { - p <- tw_values/sum(tw_values) - p1 <- diag(0,length(tw_values)) - p1[upper.tri(p1)] <- c(combn(p,m=2,FUN=prod)) - p1[lower.tri(p1)] <- c(combn(p,m=2,FUN=prod)) - d2 <- unname(as.matrix(d1)[as.numeric(tw_labels),as.numeric(tw_labels)]) - if(isfloat) { - raoqe[rw-w,cl-w]<-sum(p1*d2)/mfactor - } else { - raoqe[rw-w,cl-w]<-sum(p1*d2) - } - } - } - progress(value=cl, max.value=c((dim(rasterm)[2]+w)+(dim(rasterm)[1]+w))/2, progress.bar = FALSE) - } - } # End of for loop - message(("\nCalculation of Rao's index complete.\n")) - } - } # End classic RaoQ - sequential - else if( mode=="multidimension" ){ - if(debugging) { - message("#check: Into multidimensional clause.") - } - #----------------------------------------------------# - # - ## If multimensional RaoQ - # - # Check if there are NAs in the matrices - if ( is(rasterm,"RasterLayer") ){ - if(any(sapply(lapply(unlist(input),length),is.na)==TRUE)) - message("\n Warning: One or more RasterLayers contain NA which will be threated as 0") - } else if ( is(rasterm,"matrix") ){ - if(any(sapply(input, is.na)==TRUE) ) { - message("\n Warning: One or more matrices contain NA which will be threated as 0") - } - } - # - ## Check whether the chosen distance metric is valid or not - # - if( distance_m=="euclidean" | distance_m=="manhattan" | distance_m=="canberra" | distance_m=="minkowski" | distance_m=="mahalanobis" ) { - # - ## Define distance functions - # - #euclidean - multieuclidean <- function(x) { - tmp <- lapply(x, function(y) { - (y[[1]]-y[[2]])^2 - }) - return(sqrt(Reduce(`+`,tmp))) - } - #manhattan - multimanhattan <- function(x) { - tmp <- lapply(x, function(y) { - abs(y[[1]]-y[[2]]) - }) - return(Reduce(`+`,tmp)) - } - #canberra - multicanberra <- function(x) { - tmp <- lapply(x, function(y) { - abs(y[[1]] - y[[2]]) / (abs(y[[1]]) + abs(y[[2]])) - }) - return(Reduce(`+`,tmp)) - } - #minkowski - multiminkowski <- function(x) { - tmp <- lapply(x, function(y) { - abs((y[[1]]-y[[2]])^lambda) - }) - return(Reduce(`+`,tmp)^(1/lambda)) - } - #mahalanobis - multimahalanobis <- function(x){ - tmp <- matrix(unlist(lapply(x,function(y) as.vector(y))),ncol=2) - tmp <- tmp[!is.na(tmp[,1]),] - if( length(tmp)==0 | is.null(dim(tmp)) ) { - return(NA) - } else if(rcond(cov(tmp)) <= 0.001) { - return(NA) - } else { - #return the inverse of the covariance matrix of tmp; aka the precision matrix - inverse<-solve(cov(tmp)) - if(debugging){ - print(inverse) - } - tmp<-scale(tmp,center=T,scale=F) - tmp<-as.numeric(t(tmp[1,])%*%inverse%*%tmp[1,]) - return(sqrt(tmp)) - } - } - # - ## Decide what function to use - # - if( distance_m=="euclidean") { - distancef <- get("multieuclidean") - } else if( distance_m=="manhattan" ) { - distancef <- get("multimanhattan") - } else if( distance_m=="canberra" ) { - distancef <- get("multicanberra") - } else if( distance_m=="minkowski" ) { - if( lambda==0 ) { - stop("The Minkowski Distance for lambda = 0 is Infinity; please choose another value for lambda.") - } else { - distancef <- get("multiminkowski") - } - } else if( distance_m=="mahalanobis" ) { - distancef <- get("multimahalanobis") - warning("Multimahalanobis distance is not fully supported...") - } - } else { - stop("Distance function not defined for multidimensional Rao's Q; please choose among euclidean, manhattan, canberra, minkowski, mahalanobis!") - } - # - ## Reshape values - # - vls<-lapply(input, function(x) {raster::as.matrix(x)}) - # - ## Rescale and add fake columns and rows for moving w - # - hor<-matrix(NA,ncol=dim(vls[[1]])[2],nrow=w) - ver<-matrix(NA,ncol=w,nrow=dim(vls[[1]])[1]+w*2) - if(rescale) { - trastersm<-lapply(vls, function(x) { - t1 <- raster::scale(raster(cbind(ver,rbind(hor,x,hor),ver))) - t2 <- as.matrix(t1) - return(t2) - }) - } else { - trastersm<-lapply(vls, function(x) { - cbind(ver,rbind(hor,x,hor),ver) - }) - } - # - ## Loop over all the pixels in the matrices - # - if( (ncol(vls[[1]])*nrow(vls[[1]]))> 10000) { - message("\n Warning: ",ncol(vls[[1]])*nrow(vls[[1]])*length(vls), " cells to be processed, may take some time... \n") - } - for (cl in (1+w):(dim(vls[[1]])[2]+w)) { - for(rw in (1+w):(dim(vls[[1]])[1]+w)) { - if( length(!which(!trastersm[[1]][c(rw-w):c(rw+w),c(cl-w):c(cl+w)]%in%NA)) < window^2-((window^2)*na.tolerance) ) { - raoqe[rw-w,cl-w] <- NA - } else { - tw<-lapply(trastersm, function(x) { x[(rw-w):(rw+w),(cl-w):(cl+w)] - }) - # - ## Vectorize the matrices in the list and calculate - #Among matrix pairwase distances - lv <- lapply(tw, function(x) {as.vector(t(x))}) - vcomb <- combn(length(lv[[1]]),2) - vout <- c() - for(p in 1:ncol(vcomb) ) { - lpair <- lapply(lv, function(chi) { - c(chi[vcomb[1,p]],chi[vcomb[2,p]]) - }) - vout[p] <- distancef(lpair) - } - raoqe[rw-w,cl-w] <- sum(rep(vout,2) * (1/(window)^4),na.rm=TRUE) - } - } - progress(value=cl, max.value=dim(rasterm)[2]+w, progress.bar = FALSE) - } - if(exists("pb")) { - close(pb) - } - } else{ - message("Something went wrong when trying to calculate Rao's indiex.") - } # end of multimensional RaoQ - message("\nCalculation of Multidimensional Rao's index complete.\n") - - #----------------------------------------------------# - - # - ## Shannon - # - if( shannon==T ) { - message("\nStarting Shannon-Wiener index calculation:\n") - # Reshape values - values<-as.numeric(as.factor(rasterm)) - rasterm_1<-matrix(data=values,nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) - # - ## Add "fake" columns and rows for moving window - # - hor<-matrix(NA,ncol=dim(rasterm)[2],nrow=w) - ver<-matrix(NA,ncol=w,nrow=dim(rasterm)[1]+w*2) - trasterm<-cbind(ver,rbind(hor,rasterm_1,hor),ver) - # - ## Loop over all the pixels - # - for (cl in (1+w):(dim(rasterm)[2]+w)) { - for(rw in (1+w):(dim(rasterm)[1]+w)) { - if( length(!which(!trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)]%in%NA)) < window^2-((window^2)*na.tolerance) ) { - shannond[rw-w,cl-w]<-NA - } else { - tw<-summary(as.factor(trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)])) - if( "NA's"%in%names(tw) ) { - tw<-tw[-length(tw)] - } - tw[tw>1]<-1 - tw_values<-as.vector(tw) - p<-tw_values/length(tw_values) - p_log<-log(p) - shannond[rw-w,cl-w]<-(-(sum(p*p_log))) - } - } - svMisc::progress(value=cl, max.value=(c((dim(rasterm)[2]+w)+(dim(rasterm)[1]+w))/2), progress.bar = FALSE) - } - message(("\nCalculation of Shannon's index is also complete!\n")) - } # End ShannonD - - #----------------------------------------------------# - - # - ## Return multiple outputs - # - if(debugging){ - message( "#check: return function." ) - } - - if( shannon ) { - if( nc.cores>1 ) { - outl<-list(do.call(cbind,raop),shannond) - names(outl)<-c("Rao","Shannon") - return(outl) - } else if( nc.cores==1 ){ - outl<-list(raoqe,shannond) - names(outl)<-c("Rao","Shannon") - return(outl) - } - } else if( !shannon & mode=="classic" ) { - if( isfloat & nc.cores>1 ) { - #return(raop) - return(do.call(cbind,raop)/mfactor) - if(debugging){ - message("#check: return function - classic.") - } - } else if( !isfloat & nc.cores>1 ) { - outl<-list(do.call(cbind,raop)) - names(outl)<-c("Rao") - return(outl) - } else if( sfloat & nc.cores==1 ) { - outl<-list(raoqe/mfactor) - names(outl)<-c("Rao") - return(outl) - } else if( !isfloat & nc.cores==1 ) { - outl<-list(raoqe) - names(outl)<-c("Rao") - return(outl) - } else if( !isfloat & nc.cores>1 ) { - outl<-list(do.call(cbind,raoqe)) - names(outl)<-c("Rao") - return(outl) - } - } else if( !shannon & mode=="multidimension" ) { - outl<-list(raoqe) - names(outl)<-c("Multidimension_Rao") - return(outl) - } -} \ No newline at end of file diff --git a/src/050_divIndices.R b/src/050_divIndices.R index 1571222..d651535 100644 --- a/src/050_divIndices.R +++ b/src/050_divIndices.R @@ -16,7 +16,6 @@ foreach(i = seq(length(hd_files))) %dopar% { plotid = substr(basename(hd_files[[i]]), 1, 4) r = readRDS(hd_files[[i]]) # ra = aggregate(r, fact=2, fun=mean) - Sys.time() raomatrix <- spectralrao(as.list(r), mode="multidimension", distance_m="euclidean", @@ -24,7 +23,7 @@ foreach(i = seq(length(hd_files))) %dopar% { shannon=FALSE, debugging=TRUE, simplify=3) - raor = setValues(r[[1]], raomatrix[[1]]) + raor = setValues(r[[1]], raomatrix[[1]])k, names(raor) = plotid saveRDS(raor, file = paste0(path_hyp_dividcs, substr(basename(hd_files[[i]]), 1, 4), From f58fb4e331c005d4f418c536fe944cfcd006a225 Mon Sep 17 00:00:00 2001 From: tnauss Date: Wed, 10 Oct 2018 09:37:16 +0200 Subject: [PATCH 10/65] Bugfix in vegIndices (write values to RDS now) and update divIndices --- .gitignore | 4 + src/.Rhistory | 812 +++++++++++++++++++------------------- src/000_set_environment.R | 5 +- src/001_functions.R | 12 +- src/030_noise_removal.R | 15 +- src/040_vegIndices.R | 2 +- src/050_divIndices.R | 39 +- src/src.Rproj | 13 + 8 files changed, 463 insertions(+), 439 deletions(-) create mode 100644 .gitignore create mode 100644 src/src.Rproj diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..5b6a065 --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +.Rproj.user +.Rhistory +.RData +.Ruserdata diff --git a/src/.Rhistory b/src/.Rhistory index 30a54cc..a77879f 100644 --- a/src/.Rhistory +++ b/src/.Rhistory @@ -1,409 +1,3 @@ -if( is(input[[1]],"RasterLayer") ) { -if( mode=="classic" ){ -isfloat<-FALSE # If data are float numbers, transform them in integer -if( !is.wholenumber(rasterm@data@min) | !is.wholenumber(rasterm@data@max) | is.infinite(rasterm@data@min) ){ -message("Converting input data in an integer matrix...") -isfloat<-TRUE -mfactor<-100^simplify -rasterm<-getValues(rasterm)*mfactor -gc() -rasterm<-as.integer(rasterm) -gc() -rasterm<-matrix(rasterm,nrow(input),ncol(input),byrow=TRUE) -gc() -}else{ -rasterm<-matrix(getValues(rasterm),ncol=ncol(input),nrow=nrow(input),byrow=T) -} -} -#Print user messages -if( mode=="classic" & shannon ){ -message("Matrix check OK: \nRao and Shannon output matrices will be returned") -}else if( mode=="classic" & !shannon ){ -message("Matrix check OK: \nRao output matrix will be returned") -}else if( mode=="multidimension" & !shannon ){ -message(("Matrix check OK: \nA matrix with multimension RaoQ will be returned")) -}else if( mode=="multidimension" & shannon ){ -stop("Matrix check failed: \nMultidimension and Shannon not compatible, set shannon=FALSE") -}else{ -stop("Matrix check failed: \nNot a valid input | method | distance, please check all these options...") -} -# If data are a matrix or a list -}else if( is(input,"matrix") | is(input,"list") ) { -if( mode=="classic" ){ -isfloat<-FALSE # If data are float numbers, transform them in integer -if( !is.integer(rasterm) ){ -message("Converting input data in an integer matrix...") -isfloat<-TRUE -mfactor<-100^simplify -rasterm<-as.integer(rasterm*mfactor) -rasterm<-matrix(rasterm,nrow(input),ncol(input),byrow=TRUE) -gc() -}else{ -rasterm<-as.matrix(rasterm) -} -} -if( mode=="classic" & shannon ){ -message("Matrix check OK: \nRao and Shannon output matrices will be returned") -}else if( mode=="classic" & !shannon ){ -message("Matrix check OK: \nRao output matrix will be returned") -}else if( mode=="multidimension" & shannon ){ -stop("Matrix check failed: \nMultidimension and Shannon not compatible, set shannon=FALSE") -}else if( mode=="multidimension" & !shannon ){ -message(("Matrix check OK: \nA matrix with multimension RaoQ will be returned")) -}else{ -stop("Matrix check failed: \nNot a valid input | method | distance, please check all these options") -} -} -if(nc.cores>1) { -if(mode=="multidimension"){ -message( -"Multi-core is not supported for multidimensional Rao, proceding with 1 core...") -nc.cores=1 -}else{ -message(" -##################### Starting parallel calculation #######################") -} -} -# -## Derive operational moving window -# -if( window%%2==1 ){ -w <- (window-1)/2 -} else { -stop("Moving window size must be an odd number.") -} -# -## Preparation of output matrices -# -if(nc.cores==1) { -raoqe<-matrix(rep(NA,dim(rasterm)[1]*dim(rasterm)[2]),nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) -} -if(shannon){ -shannond<-matrix(rep(NA,dim(rasterm)[1]*dim(rasterm)[2]),nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) -} -# -## If mode is classic Rao -# -if(mode=="classic") { -# -# If classic RaoQ is parallelized -# -if(nc.cores>1) { -# -## Required packages for parallel calculation -# -require(foreach) -require(doSNOW) -require(parallel) -if( cluster.type=="MPI" ){ -require(Rmpi) -} -# -## Reshape values -# -values<-as.numeric(as.factor(rasterm)) -rasterm_1<-matrix(data=values,nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) -# -## Add fake columns and rows for moving window -# -hor<-matrix(NA,ncol=dim(rasterm)[2],nrow=w) -ver<-matrix(NA,ncol=w,nrow=dim(rasterm)[1]+w*2) -trasterm<-cbind(ver,rbind(hor,rasterm_1,hor),ver) -rm(hor,ver,rasterm_1,values); gc() -if(debugging){cat("#check: RaoQ parallel function.")} -# -## Derive distance matrix -# -d1<-proxy::dist(as.numeric(levels(as.factor(rasterm))),method=distance_m) -gc() -# -## Export variables in the global environment -# -if(isfloat) { -sapply(c("mfactor"), function(x) {assign(x,get(x),envir= .GlobalEnv)}) -} -# -## Create cluster object with given number of slaves -# -plr<<-TRUE -if( cluster.type=="SOCK" || cluster.type=="FORK" ) { -cls <- parallel::makeCluster(nc.cores,type=cluster.type, outfile="",useXDR=FALSE,methods=FALSE,output="") -} else if( cluster.type=="MPI" ) { -cls <- makeMPIcluster(nc.cores,outfile="",useXDR=FALSE,methods=FALSE,output="") -} -registerDoSNOW(cls) -clusterCall(cl=cls, function() library("parallel")) -if(isfloat) { -parallel::clusterExport(cl=cls, varlist=c("mfactor")) -} -on.exit(stopCluster(cls)) # Close the clusters on exit -gc() -# -## Start the parallelized loop over iter -# -pb <- txtProgressBar(min = (1+w), max = dim(rasterm)[2], style = 3) -progress <- function(n) setTxtProgressBar(pb, n) -opts <- list(progress = progress) -raop <- foreach(cl=(1+w):(dim(rasterm)[2]+w),.options.snow = opts,.verbose = F) %dopar% { -if(debugging) { -cat(paste(cl)) -} -raout <- sapply((1+w):(dim(rasterm)[1]+w), function(rw) { -if( length(!which(!trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)]%in%NA)) < window^2-((window^2)*na.tolerance) ) { -vv<-NA -return(vv) -} -else { -tw<-summary(as.factor(trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)]),maxsum=10000) -if( "NA's"%in%names(tw) ) { -tw<-tw[-length(tw)] -} -if( debugging ) { -message("Working on coords ",rw,",",cl,". classes length: ",length(tw),". window size=",window) -} -tw_labels<-names(tw) -tw_values<-as.vector(tw) -if( length(tw_values) <=2 ) { -vv<-NA -return(vv) -} -else { -p <- tw_values/sum(tw_values) -p1 <- diag(0,length(tw_values)) -p1[upper.tri(p1)] <- c(combn(p,m=2,FUN=prod)) -p1[lower.tri(p1)] <- c(combn(p,m=2,FUN=prod)) -d2 <- unname(as.matrix(d1)[as.numeric(tw_labels),as.numeric(tw_labels)]) -vv <- sum(p1*d2) -return(vv) -} -} -}) -return(raout) -} # End classic RaoQ - parallelized -message(("\n\nCalculation of Rao's index complete.\n")) -# -## If classic RaoQ is sequential -# -} else if(nc.cores==1) { -# Reshape values -values<-as.numeric(as.factor(rasterm)) -rasterm_1<-matrix(data=values,nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) -# Add fake columns and rows for moving window -hor<-matrix(NA,ncol=dim(rasterm)[2],nrow=w) -ver<-matrix(NA,ncol=w,nrow=dim(rasterm)[1]+w*2) -trasterm<-cbind(ver,rbind(hor,rasterm_1,hor),ver) -# Derive distance matrix -classes<-levels(as.factor(rasterm)) -d1<-proxy::dist(x=as.numeric(classes),method=distance_m) -# Loop over each pixel -for (cl in (1+w):(dim(rasterm)[2]+w)) { -for(rw in (1+w):(dim(rasterm)[1]+w)) { -if( length(!which(!trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)]%in%NA)) < window^2-((window^2)*na.tolerance) ) { -raoqe[rw-w,cl-w]<-NA -} else { -tw<-summary(as.factor(trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)]),maxsum=10000) -if( "NA's"%in%names(tw) ) { -tw<-tw[-length(tw)] -} -if(debugging) { -message("Working on coords ",rw ,",",cl,". classes length: ",length(tw),". window size=",window) -} -tw_labels<-names(tw) -tw_values<-as.vector(tw) -if(length(tw_values) <= 2) { -raoqe[rw-w,cl-w]<-NA -} else { -p <- tw_values/sum(tw_values) -p1 <- diag(0,length(tw_values)) -p1[upper.tri(p1)] <- c(combn(p,m=2,FUN=prod)) -p1[lower.tri(p1)] <- c(combn(p,m=2,FUN=prod)) -d2 <- unname(as.matrix(d1)[as.numeric(tw_labels),as.numeric(tw_labels)]) -if(isfloat) { -raoqe[rw-w,cl-w]<-sum(p1*d2)/mfactor -} else { -raoqe[rw-w,cl-w]<-sum(p1*d2) -} -} -} -progress(value=cl, max.value=c((dim(rasterm)[2]+w)+(dim(rasterm)[1]+w))/2, progress.bar = FALSE) -} -} # End of for loop -message(("\nCalculation of Rao's index complete.\n")) -} -} # End classic RaoQ - sequential -else if( mode=="multidimension" ){ -if(debugging) { -message("#check: Into multidimensional clause.") -} -#----------------------------------------------------# -# -## If multimensional RaoQ -# -# Check if there are NAs in the matrices -if ( is(rasterm,"RasterLayer") ){ -if(any(sapply(lapply(unlist(input),length),is.na)==TRUE)) -message("\n Warning: One or more RasterLayers contain NA which will be threated as 0") -} else if ( is(rasterm,"matrix") ){ -if(any(sapply(input, is.na)==TRUE) ) { -message("\n Warning: One or more matrices contain NA which will be threated as 0") -} -} -# -## Check whether the chosen distance metric is valid or not -# -if( distance_m=="euclidean" | distance_m=="manhattan" | distance_m=="canberra" | distance_m=="minkowski" | distance_m=="mahalanobis" ) { -# -## Define distance functions -# -#euclidean -multieuclidean <- function(x) { -tmp <- lapply(x, function(y) { -(y[[1]]-y[[2]])^2 -}) -return(sqrt(Reduce(`+`,tmp))) -} -#manhattan -multimanhattan <- function(x) { -tmp <- lapply(x, function(y) { -abs(y[[1]]-y[[2]]) -}) -return(Reduce(`+`,tmp)) -} -#canberra -multicanberra <- function(x) { -tmp <- lapply(x, function(y) { -abs(y[[1]] - y[[2]]) / (abs(y[[1]]) + abs(y[[2]])) -}) -return(Reduce(`+`,tmp)) -} -#minkowski -multiminkowski <- function(x) { -tmp <- lapply(x, function(y) { -abs((y[[1]]-y[[2]])^lambda) -}) -return(Reduce(`+`,tmp)^(1/lambda)) -} -#mahalanobis -multimahalanobis <- function(x){ -tmp <- matrix(unlist(lapply(x,function(y) as.vector(y))),ncol=2) -tmp <- tmp[!is.na(tmp[,1]),] -if( length(tmp)==0 | is.null(dim(tmp)) ) { -return(NA) -} else if(rcond(cov(tmp)) <= 0.001) { -return(NA) -} else { -#return the inverse of the covariance matrix of tmp; aka the precision matrix -inverse<-solve(cov(tmp)) -if(debugging){ -print(inverse) -} -tmp<-scale(tmp,center=T,scale=F) -tmp<-as.numeric(t(tmp[1,])%*%inverse%*%tmp[1,]) -return(sqrt(tmp)) -} -} -# -## Decide what function to use -# -if( distance_m=="euclidean") { -distancef <- get("multieuclidean") -} else if( distance_m=="manhattan" ) { -distancef <- get("multimanhattan") -} else if( distance_m=="canberra" ) { -distancef <- get("multicanberra") -} else if( distance_m=="minkowski" ) { -if( lambda==0 ) { -stop("The Minkowski Distance for lambda = 0 is Infinity; please choose another value for lambda.") -} else { -distancef <- get("multiminkowski") -} -} else if( distance_m=="mahalanobis" ) { -distancef <- get("multimahalanobis") -warning("Multimahalanobis distance is not fully supported...") -} -} else { -stop("Distance function not defined for multidimensional Rao's Q; please choose among euclidean, manhattan, canberra, minkowski, mahalanobis!") -} -# -## Reshape values -# -vls<-lapply(input, function(x) {raster::as.matrix(x)}) -# -## Rescale and add fake columns and rows for moving w -# -hor<-matrix(NA,ncol=dim(vls[[1]])[2],nrow=w) -ver<-matrix(NA,ncol=w,nrow=dim(vls[[1]])[1]+w*2) -if(rescale) { -trastersm<-lapply(vls, function(x) { -t1 <- raster::scale(raster(cbind(ver,rbind(hor,x,hor),ver))) -t2 <- as.matrix(t1) -return(t2) -}) -} else { -trastersm<-lapply(vls, function(x) { -cbind(ver,rbind(hor,x,hor),ver) -}) -} -# -## Loop over all the pixels in the matrices -# -if( (ncol(vls[[1]])*nrow(vls[[1]]))> 10000) { -message("\n Warning: ",ncol(vls[[1]])*nrow(vls[[1]])*length(vls), " cells to be processed, may take some time... \n") -} -cores = 3 -clp = parallel::makeCluster(cores) -doParallel::registerDoParallel(clp) -on.exit(stopCluster(clp)) -t = foreach (cl = (1+w):(dim(vls[[1]])[2]+w), .combine="rbind", .packages="foreach") %dopar% { -foreach (rw = (1+w):(dim(vls[[1]])[1]+w), .combine="rbind") %dopar% { -if( length(!which(!trastersm[[1]][c(rw-w):c(rw+w),c(cl-w):c(cl+w)]%in%NA)) < window^2-((window^2)*na.tolerance) ) { -# raoqe[rw-w,cl-w] <- NA -return(data.frame(row=rw-w, col=cl-w, value=NA)) -} else { -tw<-lapply(trastersm, function(x) { x[(rw-w):(rw+w),(cl-w):(cl+w)] -}) -# -## Vectorize the matrices in the list and calculate -#Among matrix pairwase distances -lv <- lapply(tw, function(x) {as.vector(t(x))}) -vcomb <- combn(length(lv[[1]]),2) -vout <- c() -for(p in 1:ncol(vcomb) ) { -lpair <- lapply(lv, function(chi) { -c(chi[vcomb[1,p]],chi[vcomb[2,p]]) -}) -vout[p] <- distancef(lpair) -} -# raoqe[rw-w,cl-w] <- sum(rep(vout,2) * (1/(window)^4),na.rm=TRUE) -return(data.frame(row=rw-w, col=cl-w, value=sum(rep(vout,2) * (1/(window)^4),na.rm=TRUE))) -} -} -# do.call("rbind", lapply((1+w):(dim(vls[[1]])[1]+w), function(rw){ -# if( length(!which(!trastersm[[1]][c(rw-w):c(rw+w),c(cl-w):c(cl+w)]%in%NA)) < window^2-((window^2)*na.tolerance) ) { -# # raoqe[rw-w,cl-w] <- NA -# return(data.frame(row=rw-w, col=cl-w, value=NA)) -# } else { -# tw<-lapply(trastersm, function(x) { x[(rw-w):(rw+w),(cl-w):(cl+w)] -# }) -# # -# ## Vectorize the matrices in the list and calculate -# #Among matrix pairwase distances -# lv <- lapply(tw, function(x) {as.vector(t(x))}) -# vcomb <- combn(length(lv[[1]]),2) -# vout <- c() -# for(p in 1:ncol(vcomb) ) { -# lpair <- lapply(lv, function(chi) { -# c(chi[vcomb[1,p]],chi[vcomb[2,p]]) -# }) -# vout[p] <- distancef(lpair) -# } -# # raoqe[rw-w,cl-w] <- sum(rep(vout,2) * (1/(window)^4),na.rm=TRUE) -# return(data.frame(row=rw-w, col=cl-w, value=sum(rep(vout,2) * (1/(window)^4),na.rm=TRUE))) -# } -# })) -# progress(value=cl, max.value=dim(rasterm)[2]+w, progress.bar = FALSE) -} -raoqe<-matrix(rep(NA,dim(rasterm)[1]*dim(rasterm)[2]),nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) for(i in seq(nrow(t))){ raoqe[t[i,"row"], t[i,"col"]] = t[i,"value"] } @@ -510,3 +104,409 @@ simplify=3) raor = setValues(r[[1]], raomatrix[[1]]) names(raor) = plotid raor +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +if(length(showConnections()) == 0){ +cores = 3 +cl = parallel::makeCluster(cores) +doParallel::registerDoParallel(cl) +} +hd_files = list.files(path_hyp_aio, recursive = FALSE, full.names = TRUE) +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) +pb = shapefile(paste0(path_plots, "BPolygon.shp")) +dir.create(paste0(path_hyp_nrm), showWarnings = FALSE) +f = hd_files[[1]] +r = readRDS(f) +r +plot(r) +m = mnf(as(r, "SpatialGridDataFrame"), use = "complete.obs") +m$values +length(m$values) +mi = as.matrix(m$x@data) %*% solve(m$rotation) +tmp = r[[1]] +mir = stack(lapply(seq(ncol(mi)), function(i){ +setValues(tmp, mi[, i]) +})) +mir +plot(mir, 108) +plot(r, 108) +plot(r[[108]]/mir[[108]]) +(r[[108]]/mir[[108]]) +f = hd_files[[7]] +r = readRDS(f) +m = mnf(as(r, "SpatialGridDataFrame"), use = "complete.obs") +m$values +# thv = 1-m$values +# set_mean = which(thv < -0.10) +use = seq(2, length(m$values)) +mi = as.matrix(m$x@data) %*% solve(m$rotation) +tmp = r[[1]] +mir = stack(lapply(seq(ncol(mi)), function(i){ +setValues(tmp, mi[, i]) +})) +r[[108]]/mir[[108]] +f = hd_files[[1]] +r = readRDS(f) +m = mnf(as(r, "SpatialGridDataFrame"), use = "complete.obs") +m$values +# thv = 1-m$values +# set_mean = which(thv < -0.10) +use = seq(9, length(m$values)) +mi = as.matrix(m$x@data) %*% solve(m$rotation) +tmp = r[[1]] +mir = stack(lapply(seq(ncol(mi)), function(i){ +setValues(tmp, mi[, i]) +})) +r[[108]]/mir[[108]] +plot(mir[[108]]) +mi = as.matrix(m$x@data[, use]) %*% solve(m$rotation[, use]) +mi = as.matrix(m$x@data[, use]) %*% solve(m$rotation[use, ]) +str(m$x@data) +dim(m$x@data) +dim(m$rotation) +mi = as.matrix(m$x@data[, use]) %*% solve(m$rotation)[use, ] +tmp = r[[1]] +mir = stack(lapply(seq(ncol(mi)), function(i){ +setValues(tmp, mi[, i]) +})) +r[[108]]/mir[[108]] +plot(mir[[108]]) +# thv = 1-m$values +# set_mean = which(thv < -0.10) +use = seq(2, length(m$values)) +mi = as.matrix(m$x@data[, use]) %*% solve(m$rotation)[use, ] +tmp = r[[1]] +mir = stack(lapply(seq(ncol(mi)), function(i){ +setValues(tmp, mi[, i]) +})) +r[[108]]/mir[[108]] +plot(mir[[108]]) +mi = as.matrix(m$x@data[, use]) %*% solve(m$rotation)[, use] +dim(solve(m$rotation)) +mi = as.matrix(m$x@data[, use]) %*% solve(m$rotation)[, use] +# thv = 1-m$values +# set_mean = which(thv < -0.10) +use = seq(2, length(m$values)) +mi = as.matrix(m$x@data[, use]) %*% solve(m$rotation)[, use] +mi = as.matrix(m$x@data[, use]) %*% solve(m$rotation)[use, ] +r = readRDS(f) +m = mnf(as(r, "SpatialGridDataFrame"), use = "complete.obs") +# thv = 1-m$values +# set_mean = which(thv < -0.10) +use = seq(2, length(m$values)) +mi = as.matrix(m$x@data[, use]) %*% solve(m$rotation)[use, ] +tmp = r[[1]] +mir = stack(lapply(seq(ncol(mi)), function(i){ +setValues(tmp, mi[, i]) +})) +r[[108]]/mir[[108]] +plot(mir[[108]]) +plot(r[[108]]/mir[[108]]) +plot(r[[108]]) +plot(r[[60]]) +plot(r[[30]]) +plot(r[[70]]) +plot(r[[100]]) +# thv = 1-m$values +# set_mean = which(thv < -0.10) +use = seq(2, length(m$values)) +mi = as.matrix(m$x@data[, use]) %*% solve(m$rotation)[use, ] +tmp = r[[1]] +mir = stack(lapply(seq(ncol(mi)), function(i){ +setValues(tmp, mi[, i]) +})) +r[[108]]/mir[[108]] +plot(r[[100]]) +plot(mir[[100]]) +plot(r[[100]]) +plot(mir[[100]]) +r = readRDS(f) +m = mnf(as(r, "SpatialGridDataFrame"), use = "complete.obs") +# thv = 1-m$values +# set_mean = which(thv < -0.10) +use = seq(2, length(m$values)) +mi = as.matrix(m$x@data[, use]) %*% solve(m$rotation)[use, ] +tmp = r[[1]] +mir = stack(lapply(seq(ncol(mi)), function(i){ +setValues(tmp, mi[, i]) +})) +plot(r[[100]]) +plot(mir[[100]]) +plot(r[[108]]) +plot(mir[[108]]) +plot(r[[100]]) +plot(mir[[100]]) +r[[100]]/mir[[100]] +# thv = 1-m$values +# set_mean = which(thv < -0.10) +use = seq(2, length(m$values)) +mi = as.matrix(m$x@data)[, use] %*% solve(m$rotation)[use, ] +tmp = r[[1]] +mir = stack(lapply(seq(ncol(mi)), function(i){ +setValues(tmp, mi[, i]) +})) +r[[100]]/mir[[100]] +plot(r[[100]]) +plot(mir[[100]]) +r = readRDS(f) +m = mnf(as(r, "SpatialGridDataFrame"), use = "complete.obs") +# thv = 1-m$values +# set_mean = which(thv < -0.10) +use = seq(2, length(m$values)) +mi = as.matrix(m$x@data[, use]) %*% solve(m$rotation)[use, ] +tmp = r[[1]] +mir = stack(lapply(seq(ncol(mi)), function(i){ +setValues(tmp, mi[, i]) +})) +r[[100]]/mir[[100]] +r[[108]]/mir[[108]] +plot(r[[100]]) +plot(r[[108]]) +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +if(length(showConnections()) == 0){ +cores = 3 +cl = parallel::makeCluster(cores) +doParallel::registerDoParallel(cl) +} +hd_files = list.files(path_hyp_aio, recursive = FALSE, full.names = TRUE) +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) +dir.create(paste0(path_hyp_dividcs), showWarnings = FALSE) +hd_files = list.files(path_hyp_aio, recursive = FALSE, full.names = TRUE) +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) +dir.create(paste0(path_hyp_dividcs), showWarnings = FALSE) +i = 1 +plotid = substr(basename(hd_files[[i]]), 1, 4) +r = readRDS(hd_files[[i]]) +r +# ra = aggregate(r, fact=2, fun=mean) +raomatrix <- spectralrao(as.list(r), +mode="multidimension", +distance_m="euclidean", +window=3, +shannon=FALSE, +debugging=TRUE, +simplify=3) +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +# ra = aggregate(r, fact=2, fun=mean) +raomatrix <- spectralrao(as.list(r), +mode="multidimension", +distance_m="euclidean", +window=3, +shannon=FALSE, +debugging=TRUE, +simplify=3) +filepath_source +filepath_source = paste0(filepath_base, "HySpec_KiLi/src/001_functions.R") +# ra = aggregate(r, fact=2, fun=mean) +raomatrix <- spectralrao(as.list(r), +mode="multidimension", +distance_m="euclidean", +window=3, +shannon=FALSE, +debugging=TRUE, +simplify=3) +source(filepath_source) +# ra = aggregate(r, fact=2, fun=mean) +raomatrix <- spectralrao(as.list(r), +mode="multidimension", +distance_m="euclidean", +window=3, +shannon=FALSE, +debugging=TRUE, +simplify=3) +raomatrix +stopCluster(cl) +# ra = aggregate(r, fact=2, fun=mean) +raomatrix <- spectralrao(as.list(r), +mode="multidimension", +distance_m="euclidean", +window=3, +shannon=FALSE, +debugging=TRUE, +simplify=3) +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +if(length(showConnections()) == 0){ +cores = 3 +cl = parallel::makeCluster(cores) +doParallel::registerDoParallel(cl) +} +hd_files = list.files(path_hyp_aio, recursive = FALSE, full.names = TRUE) +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) +dir.create(paste0(path_hyp_dividcs), showWarnings = FALSE) +i = 1 +plotid = substr(basename(hd_files[[i]]), 1, 4) +r = readRDS(hd_files[[i]]) +# ra = aggregate(r, fact=2, fun=mean) +raomatrix <- spectralrao(as.list(r), +mode="multidimension", +distance_m="euclidean", +window=3, +shannon=FALSE, +debugging=TRUE, +simplify=3) +head(raomatrix) +raor = setValues(r[[1]], raomatrix[[1]]) +raor +plotid +names(raor) = paste0(plotid, "raoq") +raor +plot(raor) +saveRDS(raor, file = paste0(path_hyp_dividcs, +substr(basename(hd_files[[i]]), 1, 4), +"_raoq_", window, ".rds")) +# Compute Rao's Q on original band values +window = 3 +paste0(path_hyp_dividcs, +substr(basename(hd_files[[i]]), 1, 4), +"_raoq_", window, ".rds") +saveRDS(raor, file = paste0(path_hyp_dividcs, +substr(basename(hd_files[[i]]), 1, 4), +"_raoq_", window, ".rds")) +# Compute Rao's Q on original band values +windows = c(3, 10) +# Compute Rao's Q on original band values +hd_files = list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE) +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +# Compute Rao's Q on original band values +hd_files = list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE) +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) +# Compute Rao's Q on vegetation indices +hd_files = list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE) +# Compute Rao's Q on individual vegetation indices +hd_files = list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE) +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) +i = 1 +plotid = substr(basename(hd_files[[i]]), 1, 4) +r = readRDS(hd_files[[i]]) +raomatrix <- spectralrao(as.list(r), +mode="multidimension", +distance_m="euclidean", +window=w, +shannon=FALSE, +debugging=TRUE, +simplify=3) +w = 3 +raomatrix <- spectralrao(as.list(r), +mode="multidimension", +distance_m="euclidean", +window=w, +shannon=FALSE, +debugging=TRUE, +simplify=3) +plotid = substr(basename(hd_files[[i]]), 1, 4) +r = readRDS(hd_files[[i]]) +raomatrix <- spectralrao(as.list(r), +mode="multidimension", +distance_m="euclidean", +window=w, +shannon=FALSE, +debugging=TRUE, +simplify=3) +r +raomatrix <- spectralrao(as.list(r), +mode="multidimension", +distance_m="euclidean", +window=w, +shannon=FALSE, +debugging=TRUE, +simplify=3) +hd_files +plotid = substr(basename(hd_files[[i]]), 1, 4) +plotid +r = readRDS(hd_files[[i]]) +raomatrix <- spectralrao(as.list(r), +mode="multidimension", +distance_m="euclidean", +window=w, +shannon=FALSE, +debugging=TRUE, +simplify=3) +# Compute Rao's Q on original band values +hd_files = list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE) +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) +plotid = substr(basename(hd_files[[i]]), 1, 4) +r = readRDS(hd_files[[i]]) +raomatrix <- spectralrao(as.list(r), +mode="multidimension", +distance_m="euclidean", +window=w, +shannon=FALSE, +debugging=TRUE, +simplify=3) +# Compute Rao's Q on individual vegetation indices +hd_files = list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE) +plotid = substr(basename(hd_files[[i]]), 1, 4) +r = readRDS(hd_files[[i]]) +raomatrix <- spectralrao(as.list(r), +mode="multidimension", +distance_m="euclidean", +window=w, +shannon=FALSE, +debugging=TRUE, +simplify=3) +plot(r) +# Compute Rao's Q on original band and vegetation indices values +hd_files = list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE) +# Compute Rao's Q on original band and vegetation indices values +hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), +list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) +hd_files +i = 1 +basename(hd_files[[i]]) +filename = basename(hd_files[[i]]) +substr(filename, 1, nchar(filename)-4) +productid = substr(filename, 1, nchar(filename)-4) +productid +productid = paste0(substr(filename, 1, nchar(filename)-4), "_raoq") +paste0(path_hyp_dividcs, +productid, "_", w, ".rds")) +paste0(path_hyp_dividcs, +productid, "_", w, ".rds") +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +paste0(path_hyp_dividcs, +productid, "_", w, ".rds") +path_hyp_dividcs +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +path_hyp_dividcs +paste0(path_hyp_raoq, +productid, "_", w, ".rds") +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +hd_files = list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE) +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) +dir.create(paste0(path_hyp_vegidcs), showWarnings = FALSE) +vis = c("CARI", +"Carter", "Carter2", "Carter3", "Carter4", "Carter5", "Carter6", +"CI", "CI2", "ClAInt", +"CRI1", "CRI2", "CRI3", "CRI4", +"Datt", "Datt2", "Datt4", "Datt5", "Datt6", +"DD", "DDn", "DWSI4", +"EVI", "GDVI_2", "GDVI_3", "GDVI_4", "GI", "Gitelson", "Gitelson2", +"GMI1", "GMI2", "GreenNDVI", "Maccioni", +"MCARI", "MCARI/OSAVI", "MCARI2", "MCARI2/OSAVI2", +"mND705", "mNDVI", "MPRI", "MSAVI", "mSR", "mSR2", "mSR705", +"MTCI", "MTVI", "NDVI", "NDVI2", "NDVI3", "NPCI", +"OSAVI", "OSAVI2", "PARS", "PRI", "PRI*CI2", "PRI_norm", "PSND", +"PSRI", "PSSR", "PWI", "RDVI", "REP_Li", "SAVI", "SIPI", "SPVI", +"SR", "SR1", "SR2", "SR3", "SR4", "SR5", "SR6", "SR7", "SR8", +"SRPI", "TCARI", "TCARI/OSAVI", "TCARI2", "TCARI2/OSAVI2", +"TGI", "TVI", "Vogelmann", "Vogelmann2", "Vogelmann4") +i = 1 +plotid = substr(basename(hd_files[[i]]), 1, 4) +m = h_meta[[2]][[h_meta[[1]]$list[grep(plotid, h_meta[[1]]$plotID)]]] +r = hsdar::speclib(brick(readRDS(hd_files[[i]])), +wavelength = m$wavelength, +fwhm = m$fwhm, +continuousdata = "auto") +v = vegindex(r, index = vis) +vr = v@spectra@spectra_ra +names(vr) = vis +vr +?raster +inMemory(vr) +?readAll +vr = readAll(v@spectra@spectra_ra) +names(vr) = vis +vr +saveRDS(vr, file = paste0(path_hyp_vegidcs, plotid, "_vegidcs.rds")) +test = readRDS(file = paste0(path_hyp_vegidcs, plotid, "_vegidcs.rds")) +test +plot(test) diff --git a/src/000_set_environment.R b/src/000_set_environment.R index 5fcf15a..bf85094 100644 --- a/src/000_set_environment.R +++ b/src/000_set_environment.R @@ -13,7 +13,7 @@ path_hyp_org = paste0(path_data, "/020_hypspec_org/") path_hyp_aio = paste0(path_data, "/025_hypspec_aio/") path_hyp_nrm = paste0(path_data, "/030_hypspec_nrm/") path_hyp_vegidcs = paste0(path_data, "/040_hypspec_vegidcs/") -path_hyp_dividcs = paste0(path_data, "/050_hypspec_dividcs/") +path_hyp_raoq = paste0(path_data, "/050_hypspec_raoq/") path_plots = paste0(path_data, "/plots/") path_rdata = paste0(path_data, "/rdata/") @@ -50,11 +50,12 @@ library(spacetime) # library(yaml) # Other settings --------------------------------------------------------------- +source(filepath_source) + rasterOptions(tmpdir = path_temp) saga_cmd = "C:/OSGeo4W64/apps/saga/saga_cmd.exe " # initOTB("C:/OSGeo4W64/bin/") initOTB("C:/OSGeo4W64/OTB-5.8.0-win64/OTB-5.8.0-win64/bin/") -source(filepath_source) diff --git a/src/001_functions.R b/src/001_functions.R index a85238d..7e46a43 100644 --- a/src/001_functions.R +++ b/src/001_functions.R @@ -1,17 +1,17 @@ # Visually check data visCheck = function(datapath, polygonfile, band = 109){ ds = list.files(datapath, full.names = TRUE) - pb = shapefile(polygonfile) + spoly = shapefile(polygonfile) reproj = TRUE for(d in ds){ r = readRDS(d) if(reproj){ - pb = spTransform(pb, projection(r)) + spoly = spTransform(spoly, projection(r)) reproj = FALSE } plot(r[[band]], main = substr(basename(d), 1, 4)) - plot(pb[grep(substr(basename(d), 1, 4), pb$PlotID),], add = TRUE) + plot(spoly[grep(substr(basename(d), 1, 4), spoly$PlotID),], add = TRUE) } } @@ -32,8 +32,8 @@ visCheck = function(datapath, polygonfile, band = 109){ ## where S is the number of pixel classes). ## ------------------------------------------------- ## Find more info and application here: -## 1) https://doi.org/10.1016/j.ecolind.2016.07.039 Titel anhand dieser DOI in Citavi-Projekt übernehmen -## 2) https://besjournals.onlinelibrary.wiley.com/doi/10.1111/2041-210X.12941 %CITAVIPICKER£10.1111/2041-210X.12941£Titel anhand dieser DOI in Citavi-Projekt übernehmen£% +## 1) https://doi.org/10.1016/j.ecolind.2016.07.039 Titel anhand dieser DOI in Citavi-Projekt ?bernehmen +## 2) https://besjournals.onlinelibrary.wiley.com/doi/10.1111/2041-210X.12941 %CITAVIPICKER?10.1111/2041-210X.12941?Titel anhand dieser DOI in Citavi-Projekt ?bernehmen?% ##################################################### # Function spectralrao <- function(input, distance_m="euclidean", p=NULL, window=9, mode="classic", lambda=0, shannon=FALSE, rescale=FALSE, na.tolerance=0.0, simplify=3, nc.cores=1, cluster.type="MPI", debugging=FALSE, ...) @@ -422,7 +422,7 @@ spectralrao <- function(input, distance_m="euclidean", p=NULL, window=9, mode="c } - cores = 3 + cores = 2 clp = parallel::makeCluster(cores) doParallel::registerDoParallel(clp) on.exit(stopCluster(clp)) diff --git a/src/030_noise_removal.R b/src/030_noise_removal.R index 9538383..0e35f78 100644 --- a/src/030_noise_removal.R +++ b/src/030_noise_removal.R @@ -16,16 +16,14 @@ dir.create(paste0(path_hyp_nrm), showWarnings = FALSE) # for(f in hd_files){ # r = readRDS(f) -# +# # m = mnf(as(r, "SpatialGridDataFrame"), use = "complete.obs") +# +# # thv = 1-m$values +# # set_mean = which(thv < -0.10) +# use = seq(2, length(m$values)) +# mi = as.matrix(m$x@data[, use]) %*% solve(m$rotation)[use, ] # -# thv = 1-m$values -# set_mean = which(thv < -0.10) -# -# for(i in use){ -# m$x@data[,i] = mean(m$x@data[,i], na.rm = TRUE) -# } -# mi = as.matrix(m$x@data) %*% solve(m$rotation) # tmp = r[[1]] # mir = stack(lapply(seq(ncol(mi)), function(i){ # setValues(tmp, mi[, i]) @@ -34,6 +32,7 @@ dir.create(paste0(path_hyp_nrm), showWarnings = FALSE) # saveRDS(mir, file = paste0(path_hyp_nrm, substr(basename(f), 1, 4), "_mnfi.rds")) # } + log = foreach (i = seq(length(hd_files)), .packages = c("raster", "RStoolbox")) %dopar% { f = hd_files[i] plotid = substr(basename(f), 1, 4) diff --git a/src/040_vegIndices.R b/src/040_vegIndices.R index 486d48f..9c88bb7 100644 --- a/src/040_vegIndices.R +++ b/src/040_vegIndices.R @@ -37,7 +37,7 @@ foreach(i = seq(length(hd_files)), .packages = c("hsdar", "raster")) %do% { fwhm = m$fwhm, continuousdata = "auto") v = vegindex(r, index = vis) - vr = v@spectra@spectra_ra + vr = readAll(v@spectra@spectra_ra) names(vr) = vis saveRDS(vr, file = paste0(path_hyp_vegidcs, plotid, "_vegidcs.rds")) } diff --git a/src/050_divIndices.R b/src/050_divIndices.R index d651535..061bb5d 100644 --- a/src/050_divIndices.R +++ b/src/050_divIndices.R @@ -2,32 +2,39 @@ source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") if(length(showConnections()) == 0){ - cores = 3 + cores = 2 cl = parallel::makeCluster(cores) doParallel::registerDoParallel(cl) } -hd_files = list.files(path_hyp_aio, recursive = FALSE, full.names = TRUE) -h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) +dir.create(paste0(path_hyp_raoq), showWarnings = FALSE) +windows = c(3, 10) + -dir.create(paste0(path_hyp_dividcs), showWarnings = FALSE) +# Compute Rao's Q on original band and vegetation indices values +hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), + list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) + +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) foreach(i = seq(length(hd_files))) %dopar% { - plotid = substr(basename(hd_files[[i]]), 1, 4) + productid = paste0(substr(filename, 1, nchar(filename)-4), "_raoq") r = readRDS(hd_files[[i]]) # ra = aggregate(r, fact=2, fun=mean) - raomatrix <- spectralrao(as.list(r), - mode="multidimension", - distance_m="euclidean", - window=3, + for(w in windows){ + raomatrix <- spectralrao(as.list(r), + mode="multidimension", + distance_m="euclidean", + window=w, shannon=FALSE, - debugging=TRUE, - simplify=3) - raor = setValues(r[[1]], raomatrix[[1]])k, - names(raor) = plotid - saveRDS(raor, file = paste0(path_hyp_dividcs, - substr(basename(hd_files[[i]]), 1, 4), - "_dividcs.rds")) + debugging=TRUE, + simplify=3) + raor = setValues(r[[1]], raomatrix[[1]]) + names(raor) = productid + saveRDS(raor, file = paste0(path_hyp_raoq, + productid, "_", w, ".rds")) + } } + stopCluster(cl) diff --git a/src/src.Rproj b/src/src.Rproj new file mode 100644 index 0000000..8e3c2eb --- /dev/null +++ b/src/src.Rproj @@ -0,0 +1,13 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX From ae031f1ee28a3ba07fee8e188db5fa0fdb5de0b5 Mon Sep 17 00:00:00 2001 From: tnauss Date: Wed, 10 Oct 2018 09:58:36 +0200 Subject: [PATCH 11/65] Update --- src/.Rhistory | 424 +++++++++++++++++++------------------- src/000_set_environment.R | 2 +- src/040_vegIndices.R | 15 +- src/050_divIndices.R | 15 +- 4 files changed, 238 insertions(+), 218 deletions(-) diff --git a/src/.Rhistory b/src/.Rhistory index a77879f..423a9f0 100644 --- a/src/.Rhistory +++ b/src/.Rhistory @@ -1,215 +1,3 @@ -for(i in seq(nrow(t))){ -raoqe[t[i,"row"], t[i,"col"]] = t[i,"value"] -} -if(exists("pb")) { -close(pb) -} -} else{ -message("Something went wrong when trying to calculate Rao's indiex.") -} # end of multimensional RaoQ -message("\nCalculation of Multidimensional Rao's index complete.\n") -#----------------------------------------------------# -# -## Shannon -# -if( shannon==T ) { -message("\nStarting Shannon-Wiener index calculation:\n") -# Reshape values -values<-as.numeric(as.factor(rasterm)) -rasterm_1<-matrix(data=values,nrow=dim(rasterm)[1],ncol=dim(rasterm)[2]) -# -## Add "fake" columns and rows for moving window -# -hor<-matrix(NA,ncol=dim(rasterm)[2],nrow=w) -ver<-matrix(NA,ncol=w,nrow=dim(rasterm)[1]+w*2) -trasterm<-cbind(ver,rbind(hor,rasterm_1,hor),ver) -# -## Loop over all the pixels -# -for (cl in (1+w):(dim(rasterm)[2]+w)) { -for(rw in (1+w):(dim(rasterm)[1]+w)) { -if( length(!which(!trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)]%in%NA)) < window^2-((window^2)*na.tolerance) ) { -shannond[rw-w,cl-w]<-NA -} else { -tw<-summary(as.factor(trasterm[c(rw-w):c(rw+w),c(cl-w):c(cl+w)])) -if( "NA's"%in%names(tw) ) { -tw<-tw[-length(tw)] -} -tw[tw>1]<-1 -tw_values<-as.vector(tw) -p<-tw_values/length(tw_values) -p_log<-log(p) -shannond[rw-w,cl-w]<-(-(sum(p*p_log))) -} -} -svMisc::progress(value=cl, max.value=(c((dim(rasterm)[2]+w)+(dim(rasterm)[1]+w))/2), progress.bar = FALSE) -} -message(("\nCalculation of Shannon's index is also complete!\n")) -} # End ShannonD -#----------------------------------------------------# -# -## Return multiple outputs -# -if(debugging){ -message( "#check: return function." ) -} -if( shannon ) { -if( nc.cores>1 ) { -outl<-list(do.call(cbind,raop),shannond) -names(outl)<-c("Rao","Shannon") -return(outl) -} else if( nc.cores==1 ){ -outl<-list(raoqe,shannond) -names(outl)<-c("Rao","Shannon") -return(outl) -} -} else if( !shannon & mode=="classic" ) { -if( isfloat & nc.cores>1 ) { -#return(raop) -return(do.call(cbind,raop)/mfactor) -if(debugging){ -message("#check: return function - classic.") -} -} else if( !isfloat & nc.cores>1 ) { -outl<-list(do.call(cbind,raop)) -names(outl)<-c("Rao") -return(outl) -} else if( sfloat & nc.cores==1 ) { -outl<-list(raoqe/mfactor) -names(outl)<-c("Rao") -return(outl) -} else if( !isfloat & nc.cores==1 ) { -outl<-list(raoqe) -names(outl)<-c("Rao") -return(outl) -} else if( !isfloat & nc.cores>1 ) { -outl<-list(do.call(cbind,raoqe)) -names(outl)<-c("Rao") -return(outl) -} -} else if( !shannon & mode=="multidimension" ) { -outl<-list(raoqe) -names(outl)<-c("Multidimension_Rao") -return(outl) -} -} -# ra = aggregate(r, fact=2, fun=mean) -raomatrix <- spectralrao(as.list(r), -mode="multidimension", -distance_m="euclidean", -window=3, -shannon=FALSE, -debugging=TRUE, -simplify=3) -raor = setValues(r[[1]], raomatrix[[1]]) -names(raor) = plotid -raor -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -if(length(showConnections()) == 0){ -cores = 3 -cl = parallel::makeCluster(cores) -doParallel::registerDoParallel(cl) -} -hd_files = list.files(path_hyp_aio, recursive = FALSE, full.names = TRUE) -h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) -pb = shapefile(paste0(path_plots, "BPolygon.shp")) -dir.create(paste0(path_hyp_nrm), showWarnings = FALSE) -f = hd_files[[1]] -r = readRDS(f) -r -plot(r) -m = mnf(as(r, "SpatialGridDataFrame"), use = "complete.obs") -m$values -length(m$values) -mi = as.matrix(m$x@data) %*% solve(m$rotation) -tmp = r[[1]] -mir = stack(lapply(seq(ncol(mi)), function(i){ -setValues(tmp, mi[, i]) -})) -mir -plot(mir, 108) -plot(r, 108) -plot(r[[108]]/mir[[108]]) -(r[[108]]/mir[[108]]) -f = hd_files[[7]] -r = readRDS(f) -m = mnf(as(r, "SpatialGridDataFrame"), use = "complete.obs") -m$values -# thv = 1-m$values -# set_mean = which(thv < -0.10) -use = seq(2, length(m$values)) -mi = as.matrix(m$x@data) %*% solve(m$rotation) -tmp = r[[1]] -mir = stack(lapply(seq(ncol(mi)), function(i){ -setValues(tmp, mi[, i]) -})) -r[[108]]/mir[[108]] -f = hd_files[[1]] -r = readRDS(f) -m = mnf(as(r, "SpatialGridDataFrame"), use = "complete.obs") -m$values -# thv = 1-m$values -# set_mean = which(thv < -0.10) -use = seq(9, length(m$values)) -mi = as.matrix(m$x@data) %*% solve(m$rotation) -tmp = r[[1]] -mir = stack(lapply(seq(ncol(mi)), function(i){ -setValues(tmp, mi[, i]) -})) -r[[108]]/mir[[108]] -plot(mir[[108]]) -mi = as.matrix(m$x@data[, use]) %*% solve(m$rotation[, use]) -mi = as.matrix(m$x@data[, use]) %*% solve(m$rotation[use, ]) -str(m$x@data) -dim(m$x@data) -dim(m$rotation) -mi = as.matrix(m$x@data[, use]) %*% solve(m$rotation)[use, ] -tmp = r[[1]] -mir = stack(lapply(seq(ncol(mi)), function(i){ -setValues(tmp, mi[, i]) -})) -r[[108]]/mir[[108]] -plot(mir[[108]]) -# thv = 1-m$values -# set_mean = which(thv < -0.10) -use = seq(2, length(m$values)) -mi = as.matrix(m$x@data[, use]) %*% solve(m$rotation)[use, ] -tmp = r[[1]] -mir = stack(lapply(seq(ncol(mi)), function(i){ -setValues(tmp, mi[, i]) -})) -r[[108]]/mir[[108]] -plot(mir[[108]]) -mi = as.matrix(m$x@data[, use]) %*% solve(m$rotation)[, use] -dim(solve(m$rotation)) -mi = as.matrix(m$x@data[, use]) %*% solve(m$rotation)[, use] -# thv = 1-m$values -# set_mean = which(thv < -0.10) -use = seq(2, length(m$values)) -mi = as.matrix(m$x@data[, use]) %*% solve(m$rotation)[, use] -mi = as.matrix(m$x@data[, use]) %*% solve(m$rotation)[use, ] -r = readRDS(f) -m = mnf(as(r, "SpatialGridDataFrame"), use = "complete.obs") -# thv = 1-m$values -# set_mean = which(thv < -0.10) -use = seq(2, length(m$values)) -mi = as.matrix(m$x@data[, use]) %*% solve(m$rotation)[use, ] -tmp = r[[1]] -mir = stack(lapply(seq(ncol(mi)), function(i){ -setValues(tmp, mi[, i]) -})) -r[[108]]/mir[[108]] -plot(mir[[108]]) -plot(r[[108]]/mir[[108]]) -plot(r[[108]]) -plot(r[[60]]) -plot(r[[30]]) -plot(r[[70]]) -plot(r[[100]]) -# thv = 1-m$values -# set_mean = which(thv < -0.10) -use = seq(2, length(m$values)) -mi = as.matrix(m$x@data[, use]) %*% solve(m$rotation)[use, ] tmp = r[[1]] mir = stack(lapply(seq(ncol(mi)), function(i){ setValues(tmp, mi[, i]) @@ -510,3 +298,215 @@ saveRDS(vr, file = paste0(path_hyp_vegidcs, plotid, "_vegidcs.rds")) test = readRDS(file = paste0(path_hyp_vegidcs, plotid, "_vegidcs.rds")) test plot(test) +# Compute vegetation indicies +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +if(length(showConnections()) == 0){ +cores = 3 +cl = parallel::makeCluster(cores) +doParallel::registerDoParallel(cl) +} +hd_files = list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE) +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) +dir.create(paste0(path_hyp_vegidcs), showWarnings = FALSE) +vis = c("CARI", +"Carter", "Carter2", "Carter3", "Carter4", "Carter5", "Carter6", +"CI", "CI2", "ClAInt", +"CRI1", "CRI2", "CRI3", "CRI4", +"Datt", "Datt2", "Datt4", "Datt5", "Datt6", +"DD", "DDn", "DWSI4", +"EVI", "GDVI_2", "GDVI_3", "GDVI_4", "GI", "Gitelson", "Gitelson2", +"GMI1", "GMI2", "GreenNDVI", "Maccioni", +"MCARI", "MCARI/OSAVI", "MCARI2", "MCARI2/OSAVI2", +"mND705", "mNDVI", "MPRI", "MSAVI", "mSR", "mSR2", "mSR705", +"MTCI", "MTVI", "NDVI", "NDVI2", "NDVI3", "NPCI", +"OSAVI", "OSAVI2", "PARS", "PRI", "PRI*CI2", "PRI_norm", "PSND", +"PSRI", "PSSR", "PWI", "RDVI", "REP_Li", "SAVI", "SIPI", "SPVI", +"SR", "SR1", "SR2", "SR3", "SR4", "SR5", "SR6", "SR7", "SR8", +"SRPI", "TCARI", "TCARI/OSAVI", "TCARI2", "TCARI2/OSAVI2", +"TGI", "TVI", "Vogelmann", "Vogelmann2", "Vogelmann4") +foreach(i = seq(length(hd_files)), .packages = c("hsdar", "raster")) %do% { +plotid = substr(basename(hd_files[[i]]), 1, 4) +m = h_meta[[2]][[h_meta[[1]]$list[grep(plotid, h_meta[[1]]$plotID)]]] +r = hsdar::speclib(brick(readRDS(hd_files[[i]])), +wavelength = m$wavelength, +fwhm = m$fwhm, +continuousdata = "auto") +v = vegindex(r, index = vis) +vr = readAll(v@spectra@spectra_ra) +names(vr) = vis +saveRDS(vr, file = paste0(path_hyp_vegidcs, plotid, "_vegidcs.rds")) +} +stopCluster(cl) +# Visually check data +visCheck(datapath = path_hyp_vegidcs, polygonfile = paste0(path_plots, "BPolygon.shp"), band = 47) +summary(unlist(lapply(files, function(f){nlayers(readRDS(files[[1]]))}))) +path_hyp_raoq = paste0(path_data, "/060_hypspec_raoq/") +summary(unlist(lapply(files, function(f){nlayers(readRDS(files[[1]]))}))) +files +files = list.files(path_hyp_vegidcs, full.names = TRUE) +summary(unlist(lapply(files, function(f){nlayers(readRDS(files[[1]]))}))) +# Compute Rao's Q on original bands +hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), +list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) +hd_files +i = 1 +productid = paste0(substr(filename, 1, nchar(filename)-4), "_raoq") +# Compute Rao's Q on original bands +hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), +list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) +filename = basename(hd_files[1]) +productid = paste0(substr(filename, 1, nchar(filename)-4), "_raoq") +productid +i = 100 +filename = basename(hd_files[1]) +productid = paste0(substr(filename, 1, nchar(filename)-4), "_raoq") +productid +i = 100 +filename = basename(hd_files[i]) +productid = paste0(substr(filename, 1, nchar(filename)-4), "_raoq") +productid +grep("vegidcs", filename) +grepl("vegidcs", filename) +r = readRDS(hd_files[[i]]) +?norm +?scale +r +r = scale(r, center = TRUE, scale = TRUE) +r +summary(r) +r = readRDS(hd_files[[i]]) +summary(r) +r = readRDS(hd_files[[i]]) +r +summary(r) +r +filename +summary(vr) +names(vr)[32] +plot(vr[[32]]) +plot(vr[[31]]) +hd_files = list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE) +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) +dir.create(paste0(path_hyp_vegidcs), showWarnings = FALSE) +vis = c("CARI", +"Carter", "Carter2", "Carter3", "Carter4", "Carter5", "Carter6", +"CI", "CI2", "ClAInt", +"CRI1", "CRI2", "CRI3", "CRI4", +"Datt", "Datt2", "Datt4", "Datt5", "Datt6", +"DD", "DDn", "DWSI4", +"EVI", "GDVI_2", "GDVI_3", "GDVI_4", "GI", "Gitelson", "Gitelson2", +"GMI1", "GMI2", "Maccioni", +"MCARI", "MCARI/OSAVI", "MCARI2", "MCARI2/OSAVI2", +"mND705", "mNDVI", "MPRI", "MSAVI", "mSR", "mSR2", "mSR705", +"MTCI", "MTVI", "NDVI", "NDVI2", "NDVI3", "NPCI", +"OSAVI", "OSAVI2", "PARS", "PRI", "PRI*CI2", "PRI_norm", "PSND", +"PSRI", "PSSR", "PWI", "RDVI", "REP_Li", "SAVI", "SIPI", "SPVI", +"SR", "SR1", "SR2", "SR3", "SR4", "SR5", "SR6", "SR7", "SR8", +"SRPI", "TCARI", "TCARI/OSAVI", "TCARI2", "TCARI2/OSAVI2", +"TGI", "TVI", "Vogelmann", "Vogelmann2", "Vogelmann4") +# Compute vegetation indicies +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +if(length(showConnections()) == 0){ +cores = 3 +cl = parallel::makeCluster(cores) +doParallel::registerDoParallel(cl) +} +hd_files = list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE) +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) +dir.create(paste0(path_hyp_vegidcs), showWarnings = FALSE) +vis = c("CARI", +"Carter", "Carter2", "Carter3", "Carter4", "Carter5", "Carter6", +"CI", "CI2", "ClAInt", +"CRI1", "CRI2", "CRI3", "CRI4", +"Datt", "Datt2", "Datt4", "Datt5", "Datt6", +"DD", "DDn", "DWSI4", +"EVI", "GDVI_2", "GDVI_3", "GDVI_4", "GI", "Gitelson", "Gitelson2", +"GMI1", "GMI2", "Maccioni", +"MCARI", "MCARI/OSAVI", "MCARI2", "MCARI2/OSAVI2", +"mND705", "mNDVI", "MPRI", "MSAVI", "mSR", "mSR2", "mSR705", +"MTCI", "MTVI", "NDVI", "NDVI2", "NDVI3", "NPCI", +"OSAVI", "OSAVI2", "PARS", "PRI", "PRI*CI2", "PRI_norm", "PSND", +"PSRI", "PSSR", "PWI", "RDVI", "REP_Li", "SAVI", "SIPI", "SPVI", +"SR", "SR1", "SR2", "SR3", "SR4", "SR5", "SR6", "SR7", "SR8", +"SRPI", "TCARI", "TCARI/OSAVI", "TCARI2", "TCARI2/OSAVI2", +"TGI", "TVI", "Vogelmann", "Vogelmann2", "Vogelmann4") +foreach(i = seq(length(hd_files)), .packages = c("hsdar", "raster")) %do% { +plotid = substr(basename(hd_files[[i]]), 1, 4) +m = h_meta[[2]][[h_meta[[1]]$list[grep(plotid, h_meta[[1]]$plotID)]]] +r = hsdar::speclib(brick(readRDS(hd_files[[i]])), +wavelength = m$wavelength, +fwhm = m$fwhm, +continuousdata = "auto") +v = vegindex(r, index = vis) +vr = readAll(v@spectra@spectra_ra) +names(vr) = paste0(plotid, "_", vis) +saveRDS(vr, file = paste0(path_hyp_vegidcs, plotid, "_vegidcs.rds")) +} +stopCluster(cl) +# Visually check data +visCheck(datapath = path_hyp_vegidcs, polygonfile = paste0(path_plots, "BPolygon.shp"), band = 47) +files = list.files(path_hyp_vegidcs +files = list.files(path_hyp_vegidcs, full.names = TRUE) +f = files[[1]] +f +df = read(f) +df = readRDS(f) +df +is.na(df) +any(is.na(df)) +any(is.na(getValues(df))) +(is.na(getValues(df))) +summary(df) +plot(df) +is.na(getValues(df)) +sum(is.na(getValues(df))) +nlayer(df) +nlayers(df) +i = 1 +sum(is.na(df[[i]])) +df[[i]] +sum(is.na(getValues(df[[i]]))) +nasum = lapply(nlayers(df), function(i){ +sum(is.na(getValues(df[[i]]))) +}) +summary(nasum) +nasum +nasum = lapply(nlayers(df), function(i){ +sum(is.na(getValues(df[[i]]))) +}) +nasum +nlayers(df) +nasum = lapply(seq(nlayers(df), function(i){ +sum(is.na(getValues(df[[i]]))) +}) +summary(nasum) +}) +nasum = lapply(seq(nlayers(df)), function(i){ +sum(is.na(getValues(df[[i]]))) +}) +summary(nasum) +nasum +unlist(nasum) +min(unlist(nasum)) == max(unlist(nasum)) +nacheck = do.call("rbind", lapply(files, function(f){ +df = readRDS(f) +nasum = lapply(seq(nlayers(df)), function(i){ +sum(is.na(getValues(df[[i]]))) +}) +return(data.frame(f = basename(f), nacheck = min(unlist(nasum)) == max(unlist(nasum)))) +})) +nacheck +f = files[[47]] +f +df = readRDS(f) +plot(df[[1]]) +plot(df[[2]]) +nasum = lapply(seq(nlayers(df)), function(i){ +sum(is.na(getValues(df[[i]]))) +}) +nasum +nasum +min(unlist(nasum)) +max(unlist(nasum)) +unlist(nasum) +f diff --git a/src/000_set_environment.R b/src/000_set_environment.R index bf85094..b587084 100644 --- a/src/000_set_environment.R +++ b/src/000_set_environment.R @@ -13,7 +13,7 @@ path_hyp_org = paste0(path_data, "/020_hypspec_org/") path_hyp_aio = paste0(path_data, "/025_hypspec_aio/") path_hyp_nrm = paste0(path_data, "/030_hypspec_nrm/") path_hyp_vegidcs = paste0(path_data, "/040_hypspec_vegidcs/") -path_hyp_raoq = paste0(path_data, "/050_hypspec_raoq/") +path_hyp_raoq = paste0(path_data, "/060_hypspec_raoq/") path_plots = paste0(path_data, "/plots/") path_rdata = paste0(path_data, "/rdata/") diff --git a/src/040_vegIndices.R b/src/040_vegIndices.R index 9c88bb7..ca23930 100644 --- a/src/040_vegIndices.R +++ b/src/040_vegIndices.R @@ -19,7 +19,7 @@ vis = c("CARI", "Datt", "Datt2", "Datt4", "Datt5", "Datt6", "DD", "DDn", "DWSI4", "EVI", "GDVI_2", "GDVI_3", "GDVI_4", "GI", "Gitelson", "Gitelson2", - "GMI1", "GMI2", "GreenNDVI", "Maccioni", + "GMI1", "GMI2", "Maccioni", "MCARI", "MCARI/OSAVI", "MCARI2", "MCARI2/OSAVI2", "mND705", "mNDVI", "MPRI", "MSAVI", "mSR", "mSR2", "mSR705", "MTCI", "MTVI", "NDVI", "NDVI2", "NDVI3", "NPCI", @@ -38,7 +38,7 @@ foreach(i = seq(length(hd_files)), .packages = c("hsdar", "raster")) %do% { continuousdata = "auto") v = vegindex(r, index = vis) vr = readAll(v@spectra@spectra_ra) - names(vr) = vis + names(vr) = paste0(plotid, "_", vis) saveRDS(vr, file = paste0(path_hyp_vegidcs, plotid, "_vegidcs.rds")) } @@ -47,4 +47,13 @@ stopCluster(cl) # Visually check data visCheck(datapath = path_hyp_vegidcs, polygonfile = paste0(path_plots, "BPolygon.shp"), band = 47) -summary(unlist(lapply(files, function(f){nlayers(readRDS(files[[1]]))}))) + +files = list.files(path_hyp_vegidcs, full.names = TRUE) +nacheck = do.call("rbind", lapply(files, function(f){ + df = readRDS(f) + nasum = lapply(seq(nlayers(df)), function(i){ + sum(is.na(getValues(df[[i]]))) + }) + return(data.frame(f = basename(f), nacheck = min(unlist(nasum)) == max(unlist(nasum)))) +})) +nacheck diff --git a/src/050_divIndices.R b/src/050_divIndices.R index 061bb5d..700d2a3 100644 --- a/src/050_divIndices.R +++ b/src/050_divIndices.R @@ -1,4 +1,5 @@ -# Compute spectral diversity indicies +# Compute spectral diversity indicies on original band stack and +# scaled vegetation inidces stack source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") if(length(showConnections()) == 0){ @@ -11,15 +12,23 @@ dir.create(paste0(path_hyp_raoq), showWarnings = FALSE) windows = c(3, 10) -# Compute Rao's Q on original band and vegetation indices values +# Compute Rao's Q on original bands hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) foreach(i = seq(length(hd_files))) %dopar% { + filename = basename(hd_files[i]) productid = paste0(substr(filename, 1, nchar(filename)-4), "_raoq") + r = readRDS(hd_files[[i]]) + + # Scale vegetation indicies + if(grepl("vegidcs", filename)){ + r = scale(r, center = TRUE, scale = TRUE) + } + # ra = aggregate(r, fact=2, fun=mean) for(w in windows){ raomatrix <- spectralrao(as.list(r), @@ -37,4 +46,6 @@ foreach(i = seq(length(hd_files))) %dopar% { } +#check hel3 + stopCluster(cl) From 528e868e940fafa664d5549f8366c8fcfd53aa23 Mon Sep 17 00:00:00 2001 From: tnauss Date: Wed, 10 Oct 2018 10:08:43 +0200 Subject: [PATCH 12/65] Update --- src/.Rhistory | 98 ++++++++++++++++++++++---------------------- src/001_functions.R | 12 +++--- src/050_divIndices.R | 16 ++++---- 3 files changed, 63 insertions(+), 63 deletions(-) diff --git a/src/.Rhistory b/src/.Rhistory index 423a9f0..c4c8132 100644 --- a/src/.Rhistory +++ b/src/.Rhistory @@ -1,52 +1,3 @@ -tmp = r[[1]] -mir = stack(lapply(seq(ncol(mi)), function(i){ -setValues(tmp, mi[, i]) -})) -r[[108]]/mir[[108]] -plot(r[[100]]) -plot(mir[[100]]) -plot(r[[100]]) -plot(mir[[100]]) -r = readRDS(f) -m = mnf(as(r, "SpatialGridDataFrame"), use = "complete.obs") -# thv = 1-m$values -# set_mean = which(thv < -0.10) -use = seq(2, length(m$values)) -mi = as.matrix(m$x@data[, use]) %*% solve(m$rotation)[use, ] -tmp = r[[1]] -mir = stack(lapply(seq(ncol(mi)), function(i){ -setValues(tmp, mi[, i]) -})) -plot(r[[100]]) -plot(mir[[100]]) -plot(r[[108]]) -plot(mir[[108]]) -plot(r[[100]]) -plot(mir[[100]]) -r[[100]]/mir[[100]] -# thv = 1-m$values -# set_mean = which(thv < -0.10) -use = seq(2, length(m$values)) -mi = as.matrix(m$x@data)[, use] %*% solve(m$rotation)[use, ] -tmp = r[[1]] -mir = stack(lapply(seq(ncol(mi)), function(i){ -setValues(tmp, mi[, i]) -})) -r[[100]]/mir[[100]] -plot(r[[100]]) -plot(mir[[100]]) -r = readRDS(f) -m = mnf(as(r, "SpatialGridDataFrame"), use = "complete.obs") -# thv = 1-m$values -# set_mean = which(thv < -0.10) -use = seq(2, length(m$values)) -mi = as.matrix(m$x@data[, use]) %*% solve(m$rotation)[use, ] -tmp = r[[1]] -mir = stack(lapply(seq(ncol(mi)), function(i){ -setValues(tmp, mi[, i]) -})) -r[[100]]/mir[[100]] -r[[108]]/mir[[108]] plot(r[[100]]) plot(r[[108]]) source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") @@ -510,3 +461,52 @@ min(unlist(nasum)) max(unlist(nasum)) unlist(nasum) f +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +if(length(showConnections()) == 0){ +cores = 2 +cl = parallel::makeCluster(cores) +doParallel::registerDoParallel(cl) +} +path_hyp_raoq +dir.create(paste0(path_hyp_raoq), showWarnings = FALSE) +windows = c(3, 10) +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +showConnections() +dir.create(paste0(path_hyp_raoq), showWarnings = FALSE) +windows = c(3, 10) +# Compute Rao's Q on original bands stack and scaled vegetation indices stack +hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), +list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) +hd_files +i = 100 +filename = basename(hd_files[i]) +productid = paste0(substr(filename, 1, nchar(filename)-4), "_raoq") +productid +i = 1 +filename = basename(hd_files[i]) +productid = paste0(substr(filename, 1, nchar(filename)-4), "_raoq") +productid +foreach(i = seq(length(hd_files))) %dopar% { +filename = basename(hd_files[i]) +productid = paste0(substr(filename, 1, nchar(filename)-4), "_raoq") +r = readRDS(hd_files[[i]]) +# Scale vegetation indicies +if(grepl("vegidcs", filename)){ +r = scale(r, center = TRUE, scale = TRUE) +} +# ra = aggregate(r, fact=2, fun=mean) +for(w in windows){ +raomatrix <- spectralrao(as.list(r), +mode="multidimension", +distance_m="euclidean", +window=w, +shannon=FALSE, +debugging=TRUE, +simplify=3) +raor = setValues(r[[1]], raomatrix[[1]]) +names(raor) = productid +saveRDS(raor, file = paste0(path_hyp_raoq, +productid, "_", w, ".rds")) +} +} diff --git a/src/001_functions.R b/src/001_functions.R index 7e46a43..a9ab692 100644 --- a/src/001_functions.R +++ b/src/001_functions.R @@ -1,17 +1,17 @@ # Visually check data visCheck = function(datapath, polygonfile, band = 109){ ds = list.files(datapath, full.names = TRUE) - spoly = shapefile(polygonfile) + pb = shapefile(polygonfile) reproj = TRUE for(d in ds){ r = readRDS(d) if(reproj){ - spoly = spTransform(spoly, projection(r)) + pb = spTransform(pb, projection(r)) reproj = FALSE } plot(r[[band]], main = substr(basename(d), 1, 4)) - plot(spoly[grep(substr(basename(d), 1, 4), spoly$PlotID),], add = TRUE) + plot(pb[grep(substr(basename(d), 1, 4), pb$PlotID),], add = TRUE) } } @@ -32,8 +32,8 @@ visCheck = function(datapath, polygonfile, band = 109){ ## where S is the number of pixel classes). ## ------------------------------------------------- ## Find more info and application here: -## 1) https://doi.org/10.1016/j.ecolind.2016.07.039 Titel anhand dieser DOI in Citavi-Projekt ?bernehmen -## 2) https://besjournals.onlinelibrary.wiley.com/doi/10.1111/2041-210X.12941 %CITAVIPICKER?10.1111/2041-210X.12941?Titel anhand dieser DOI in Citavi-Projekt ?bernehmen?% +## 1) https://doi.org/10.1016/j.ecolind.2016.07.039 Titel anhand dieser DOI in Citavi-Projekt übernehmen +## 2) https://besjournals.onlinelibrary.wiley.com/doi/10.1111/2041-210X.12941 %CITAVIPICKER£10.1111/2041-210X.12941£Titel anhand dieser DOI in Citavi-Projekt übernehmen£% ##################################################### # Function spectralrao <- function(input, distance_m="euclidean", p=NULL, window=9, mode="classic", lambda=0, shannon=FALSE, rescale=FALSE, na.tolerance=0.0, simplify=3, nc.cores=1, cluster.type="MPI", debugging=FALSE, ...) @@ -422,7 +422,7 @@ spectralrao <- function(input, distance_m="euclidean", p=NULL, window=9, mode="c } - cores = 2 + cores = 4 clp = parallel::makeCluster(cores) doParallel::registerDoParallel(clp) on.exit(stopCluster(clp)) diff --git a/src/050_divIndices.R b/src/050_divIndices.R index 700d2a3..f096297 100644 --- a/src/050_divIndices.R +++ b/src/050_divIndices.R @@ -2,23 +2,23 @@ # scaled vegetation inidces stack source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -if(length(showConnections()) == 0){ - cores = 2 - cl = parallel::makeCluster(cores) - doParallel::registerDoParallel(cl) -} +# if(length(showConnections()) == 0){ +# cores = 2 +# cl = parallel::makeCluster(cores) +# doParallel::registerDoParallel(cl) +# } dir.create(paste0(path_hyp_raoq), showWarnings = FALSE) windows = c(3, 10) -# Compute Rao's Q on original bands +# Compute Rao's Q on original bands stack and scaled vegetation indices stack hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) -foreach(i = seq(length(hd_files))) %dopar% { +foreach (i = seq(length(hd_files))) %do% { filename = basename(hd_files[i]) productid = paste0(substr(filename, 1, nchar(filename)-4), "_raoq") @@ -48,4 +48,4 @@ foreach(i = seq(length(hd_files))) %dopar% { #check hel3 -stopCluster(cl) +# stopCluster(cl) From 42baafbf4279c8fe9a378adfd65a1491fceea862 Mon Sep 17 00:00:00 2001 From: tnauss Date: Sat, 13 Oct 2018 13:07:39 +0200 Subject: [PATCH 13/65] Add mean distance from centroid --- src/.Rhistory | 904 +++++++++++++-------------- src/000_set_environment.R | 7 +- src/050__kmdc.R | 48 ++ src/{050_divIndices.R => 060_raoq.R} | 11 +- 4 files changed, 509 insertions(+), 461 deletions(-) create mode 100644 src/050__kmdc.R rename src/{050_divIndices.R => 060_raoq.R} (84%) diff --git a/src/.Rhistory b/src/.Rhistory index c4c8132..c7884c7 100644 --- a/src/.Rhistory +++ b/src/.Rhistory @@ -1,512 +1,512 @@ -plot(r[[100]]) -plot(r[[108]]) -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -if(length(showConnections()) == 0){ -cores = 3 -cl = parallel::makeCluster(cores) -doParallel::registerDoParallel(cl) -} -hd_files = list.files(path_hyp_aio, recursive = FALSE, full.names = TRUE) -h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) -dir.create(paste0(path_hyp_dividcs), showWarnings = FALSE) -hd_files = list.files(path_hyp_aio, recursive = FALSE, full.names = TRUE) -h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) -dir.create(paste0(path_hyp_dividcs), showWarnings = FALSE) +filename = basename(hd_files[i]) +productid = paste0(substr(filename, 1, nchar(filename)-4), "_raoq") +productid i = 1 -plotid = substr(basename(hd_files[[i]]), 1, 4) +filename = basename(hd_files[i]) +productid = paste0(substr(filename, 1, nchar(filename)-4), "_raoq") +productid +foreach(i = seq(length(hd_files))) %dopar% { +filename = basename(hd_files[i]) +productid = paste0(substr(filename, 1, nchar(filename)-4), "_raoq") r = readRDS(hd_files[[i]]) -r -# ra = aggregate(r, fact=2, fun=mean) -raomatrix <- spectralrao(as.list(r), -mode="multidimension", -distance_m="euclidean", -window=3, -shannon=FALSE, -debugging=TRUE, -simplify=3) -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -# ra = aggregate(r, fact=2, fun=mean) -raomatrix <- spectralrao(as.list(r), -mode="multidimension", -distance_m="euclidean", -window=3, -shannon=FALSE, -debugging=TRUE, -simplify=3) -filepath_source -filepath_source = paste0(filepath_base, "HySpec_KiLi/src/001_functions.R") -# ra = aggregate(r, fact=2, fun=mean) -raomatrix <- spectralrao(as.list(r), -mode="multidimension", -distance_m="euclidean", -window=3, -shannon=FALSE, -debugging=TRUE, -simplify=3) -source(filepath_source) -# ra = aggregate(r, fact=2, fun=mean) -raomatrix <- spectralrao(as.list(r), -mode="multidimension", -distance_m="euclidean", -window=3, -shannon=FALSE, -debugging=TRUE, -simplify=3) -raomatrix -stopCluster(cl) -# ra = aggregate(r, fact=2, fun=mean) -raomatrix <- spectralrao(as.list(r), -mode="multidimension", -distance_m="euclidean", -window=3, -shannon=FALSE, -debugging=TRUE, -simplify=3) -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -if(length(showConnections()) == 0){ -cores = 3 -cl = parallel::makeCluster(cores) -doParallel::registerDoParallel(cl) +# Scale vegetation indicies +if(grepl("vegidcs", filename)){ +r = scale(r, center = TRUE, scale = TRUE) } -hd_files = list.files(path_hyp_aio, recursive = FALSE, full.names = TRUE) -h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) -dir.create(paste0(path_hyp_dividcs), showWarnings = FALSE) -i = 1 -plotid = substr(basename(hd_files[[i]]), 1, 4) -r = readRDS(hd_files[[i]]) # ra = aggregate(r, fact=2, fun=mean) +for(w in windows){ raomatrix <- spectralrao(as.list(r), mode="multidimension", distance_m="euclidean", -window=3, +window=w, shannon=FALSE, debugging=TRUE, simplify=3) -head(raomatrix) raor = setValues(r[[1]], raomatrix[[1]]) -raor -plotid -names(raor) = paste0(plotid, "raoq") -raor -plot(raor) -saveRDS(raor, file = paste0(path_hyp_dividcs, -substr(basename(hd_files[[i]]), 1, 4), -"_raoq_", window, ".rds")) -# Compute Rao's Q on original band values -window = 3 -paste0(path_hyp_dividcs, -substr(basename(hd_files[[i]]), 1, 4), -"_raoq_", window, ".rds") -saveRDS(raor, file = paste0(path_hyp_dividcs, -substr(basename(hd_files[[i]]), 1, 4), -"_raoq_", window, ".rds")) -# Compute Rao's Q on original band values -windows = c(3, 10) -# Compute Rao's Q on original band values -hd_files = list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE) +names(raor) = productid +saveRDS(raor, file = paste0(path_hyp_raoq, +productid, "_", w, ".rds")) +} +} source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -# Compute Rao's Q on original band values -hd_files = list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE) -h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) -# Compute Rao's Q on vegetation indices -hd_files = list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE) -# Compute Rao's Q on individual vegetation indices -hd_files = list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE) +path_hyp_specidcs = paste0(path_data, "/050_hypspec_specidcs/") +dir.create(paste0(path_hyp_specidcs), showWarnings = FALSE) +# Compute mean distance from centroid on original band stack +hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), +list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) +i = ! i = 1 -plotid = substr(basename(hd_files[[i]]), 1, 4) -r = readRDS(hd_files[[i]]) -raomatrix <- spectralrao(as.list(r), -mode="multidimension", -distance_m="euclidean", -window=w, -shannon=FALSE, -debugging=TRUE, -simplify=3) -w = 3 -raomatrix <- spectralrao(as.list(r), -mode="multidimension", -distance_m="euclidean", -window=w, -shannon=FALSE, -debugging=TRUE, -simplify=3) -plotid = substr(basename(hd_files[[i]]), 1, 4) +filename = basename(hd_files[i]) +filename +productid = paste0(substr(filename, 1, nchar(filename)-4), "_mdc") +productid r = readRDS(hd_files[[i]]) -raomatrix <- spectralrao(as.list(r), -mode="multidimension", -distance_m="euclidean", -window=w, -shannon=FALSE, -debugging=TRUE, -simplify=3) r -raomatrix <- spectralrao(as.list(r), -mode="multidimension", -distance_m="euclidean", -window=w, -shannon=FALSE, -debugging=TRUE, -simplify=3) +kmeans(r) +?kmeans +t = as .data.frame(r) +t = as.data.frame(r) +t +t = getValues(r) +dim(t) +kmenas(t) +kmeans(t) +kmeans(t, centers = 1) +kmeans(t, centers = 2) +kmeans(t, centers = 1) +kmeans(na.omit(t), centers = 1) +na.omit(t) +dim(na.omit(t)) +dim(t) +plot(t) +plot(r) +plot(r[[108]]) +plot(r[[100]]) +km = kmeans(na.omit(r), center = 1) +km = kmeans(na.omit(getValues(r)), center = 1) +km +rds = na.omit(getValues(r)) +km = kmeans(rds, center = 1) +sqrt(rowSums(rds - fitted(km))**2) +kmd = sqrt(rowSums(rds - fitted(km))**2) +plot(kmd) +mean(kmd) +sd(kmd) +var(kmd) +mean(kmd) +sd(kmd) +head(rds) +rds[1, ] +fitted(km) +str(km) +rds - fitted(km) +rds-km +rds-fitted(km) +rds[1, ] +kmd +r +rds = getValues(r) +which(is.na(rds)) +is.na(rds) +head(rds) +rds_na = which(is.na(rds)) +rds_na +rds = getValues(r) +complete.cases(rds) +which(complete.cases(rds)) +cc = which(complete.cases(rds)) +rds_cc = rds[cc, ] +dim(rds_cc) +km = kmeans(rds_cc, center = 1) +kmd = sqrt(rowSums(rds_cc - fitted(km))**2) +?setValues +rds_km = rds +str(kmd) +rds_kmd = rds[, 1] +rds_kmd +rds_kmd[cc] = kmd +rds_kmd = setValues(r[[1]], rds_kmd) +plot(rds_kmd) +mean(getValues(rds_kmd)) +mean(getValues(rds_kmd), na.rm = TRUE) +sd(getValues(rds_kmd), na.rm = TRUE) +rds = na.omit(getValues(r)) +km = kmeans(rds, center = 1) +kmd = sqrt(rowSums(rds - fitted(km))**2) +mean(kmd) +sd(kmd) +rds_kmd +names(rds_kmd) = productid +rds_kmd +productid = paste0(substr(filename, 1, nchar(filename)-4), "_kmdc") +names(rds_kmd) = productid +# Compute mean distance from centroid on original band stack +hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), +list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) hd_files -plotid = substr(basename(hd_files[[i]]), 1, 4) -plotid +i = 7 +n +filename = basename(hd_files[i]) +filename +productid = paste0(substr(filename, 1, nchar(filename)-4), "_kmdc") r = readRDS(hd_files[[i]]) -raomatrix <- spectralrao(as.list(r), -mode="multidimension", -distance_m="euclidean", -window=w, -shannon=FALSE, -debugging=TRUE, -simplify=3) -# Compute Rao's Q on original band values -hd_files = list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE) -h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) -plotid = substr(basename(hd_files[[i]]), 1, 4) +rds = getValues(r) +cc = which(complete.cases(rds)) +rds_cc = rds[cc, ] +summary(rds_cc) +dim(rds_cc) +all_na = grep(ncell(r), summary(r)[6,]) +r r = readRDS(hd_files[[i]]) -raomatrix <- spectralrao(as.list(r), -mode="multidimension", -distance_m="euclidean", -window=w, -shannon=FALSE, -debugging=TRUE, -simplify=3) -# Compute Rao's Q on individual vegetation indices -hd_files = list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE) -plotid = substr(basename(hd_files[[i]]), 1, 4) +all_na = grep(ncell(r), summary(r)[6,]) +ncell(r) +summary(r)[6,] +r +all_na = grep(ncell(r), summary(getValues(r))[6,]) +all_na +i = 6 +filename = basename(hd_files[i]) +productid = paste0(substr(filename, 1, nchar(filename)-4), "_kmdc") r = readRDS(hd_files[[i]]) -raomatrix <- spectralrao(as.list(r), -mode="multidimension", -distance_m="euclidean", -window=w, -shannon=FALSE, -debugging=TRUE, -simplify=3) -plot(r) -# Compute Rao's Q on original band and vegetation indices values -hd_files = list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE) -# Compute Rao's Q on original band and vegetation indices values +rds = getValues(r) +all_na = grep(ncell(r), summary(getValues(r))[6,]) +all_na +hd_files = list.files(path_hyp_aio, recursive = FALSE, full.names = TRUE) +f = hd_files[i] +plotid = substr(basename(f), 1, 4) +r = readRDS(f) +nl = nlayers(r) +all_na = grep(ncell(r), summary(r)[6,]) +all_na +plotid +# Compute mean distance from centroid on original band stack hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) -hd_files -i = 1 -basename(hd_files[[i]]) -filename = basename(hd_files[[i]]) -substr(filename, 1, nchar(filename)-4) -productid = substr(filename, 1, nchar(filename)-4) +filename = basename(hd_files[i]) +filename +productid = paste0(substr(filename, 1, nchar(filename)-4), "_kmdc") productid -productid = paste0(substr(filename, 1, nchar(filename)-4), "_raoq") -paste0(path_hyp_dividcs, -productid, "_", w, ".rds")) -paste0(path_hyp_dividcs, -productid, "_", w, ".rds") -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -paste0(path_hyp_dividcs, -productid, "_", w, ".rds") -path_hyp_dividcs -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -path_hyp_dividcs -paste0(path_hyp_raoq, -productid, "_", w, ".rds") -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -hd_files = list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE) -h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) -dir.create(paste0(path_hyp_vegidcs), showWarnings = FALSE) -vis = c("CARI", -"Carter", "Carter2", "Carter3", "Carter4", "Carter5", "Carter6", -"CI", "CI2", "ClAInt", -"CRI1", "CRI2", "CRI3", "CRI4", -"Datt", "Datt2", "Datt4", "Datt5", "Datt6", -"DD", "DDn", "DWSI4", -"EVI", "GDVI_2", "GDVI_3", "GDVI_4", "GI", "Gitelson", "Gitelson2", -"GMI1", "GMI2", "GreenNDVI", "Maccioni", -"MCARI", "MCARI/OSAVI", "MCARI2", "MCARI2/OSAVI2", -"mND705", "mNDVI", "MPRI", "MSAVI", "mSR", "mSR2", "mSR705", -"MTCI", "MTVI", "NDVI", "NDVI2", "NDVI3", "NPCI", -"OSAVI", "OSAVI2", "PARS", "PRI", "PRI*CI2", "PRI_norm", "PSND", -"PSRI", "PSSR", "PWI", "RDVI", "REP_Li", "SAVI", "SIPI", "SPVI", -"SR", "SR1", "SR2", "SR3", "SR4", "SR5", "SR6", "SR7", "SR8", -"SRPI", "TCARI", "TCARI/OSAVI", "TCARI2", "TCARI2/OSAVI2", -"TGI", "TVI", "Vogelmann", "Vogelmann2", "Vogelmann4") -i = 1 -plotid = substr(basename(hd_files[[i]]), 1, 4) -m = h_meta[[2]][[h_meta[[1]]$list[grep(plotid, h_meta[[1]]$plotID)]]] -r = hsdar::speclib(brick(readRDS(hd_files[[i]])), -wavelength = m$wavelength, -fwhm = m$fwhm, -continuousdata = "auto") -v = vegindex(r, index = vis) -vr = v@spectra@spectra_ra -names(vr) = vis -vr -?raster -inMemory(vr) -?readAll -vr = readAll(v@spectra@spectra_ra) -names(vr) = vis -vr -saveRDS(vr, file = paste0(path_hyp_vegidcs, plotid, "_vegidcs.rds")) -test = readRDS(file = paste0(path_hyp_vegidcs, plotid, "_vegidcs.rds")) -test -plot(test) -# Compute vegetation indicies +r +r = readRDS(hd_files[[i]]) +r +summary(r[[149]]) +summary(r[[148]]) +all_na = grep(ncell(r), summary(getValues(r))[6,]) +all_na +ncell(r) +summary(getValues(r))[6,] +summary(r[[148]]) +all_na +hd_files = list.files(path_hyp_aio, recursive = FALSE, full.names = TRUE) +i +f = hd_files[i] +f +plotid = substr(basename(f), 1, 4) +r = readRDS(f) +nl = nlayers(r) +all_na = grep(ncell(r), summary(r)[6,]) +if(length(all_na) > 0){ +r = r[[-all_na]] +} else { +all_na = -1 +} +all_na +pca = rasterPCA(r) +v = pca$model$sdev**2 +# Continuous Significant Dimensionality +csd = round(sum(sapply(v, function(x){min(x,1)})), 0) +use = seq(csd) +log = list(file = basename(f), all_na = all_na, csd = csd) +pcai = t(t(as.matrix(pca$map)[, use] %*% t(pca$model$loadings)[use, ]) + pca$model$center) +tmp = r[[1]] +pcair = stack(lapply(seq(ncol(pcai)), function(i){ +setValues(tmp, pcai[, i]) +})) +pcair +if(all_na == 1){ +pcair = stack(setValues(tmp, rep(NA, ncell(tmp))), pcair) +} else if(all_na > 1){ +pcair = stack(pcair[[1:(all_na-1)]], +setValues(tmp, rep(NA, ncell(tmp))), +pcair[[(all_na):nlayers(pcair)]]) +} +pcair +names(pcair) = paste0(plotid, "_pcai_", seq(nl)) +all_na +pcair[[149]] +# Compute mean distance from centroid on original band stack +hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), +list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) +i = 6 +filename = basename(hd_files[i]) +productid = paste0(substr(filename, 1, nchar(filename)-4), "_kmdc") +r = readRDS(hd_files[[i]]) +r[[149]] +rds = getValues(r) +all_na = grep(ncell(r), summary(getValues(r))[6,]) +all_na +ncell(r) +summary(getValues(r))[6,] +all_na = grep(ncell(r), summary(getValues(r))[7,]) +all_na +summary(r) +summary(brick(r)) +summary(getValues(r)) +nrow(rds) +all_na = grep(nrow(rds), summary(rds)[7,]) +all_na +if(length(all_na) > 0){ +r = r[[-all_na]] +} else { +all_na = -1 +} +cc = which(complete.cases(rds)) +rds_cc = rds[cc, ] +km = kmeans(rds_cc, center = 1) +kmd = sqrt(rowSums(rds_cc - fitted(km))**2) +str(rds) +rds = rds[[,-all_na]] +all_na +rds[, 1] +rds[, -149] +all_na +r = readRDS(hd_files[[i]]) +rds = getValues(r) +all_na = grep(nrow(rds), summary(rds)[7,]) +if(length(all_na) > 0){ +rds = rds[,-all_na] +} else { +all_na = -1 +} +dim(rds) +cc = which(complete.cases(rds)) +rds_cc = rds[cc, ] +km = kmeans(rds_cc, center = 1) +kmd = sqrt(rowSums(rds_cc - fitted(km))**2) +rds_kmd = rds[, 1] +rds_kmd[cc] = kmd +rds_kmd = setValues(r[[1]], rds_kmd) +mean(rds_kmd) +mean(getValues(rds_kmd)) +mean(getValues(rds_kmd), na.rm = TRUE) +sd(getValues(rds_kmd), na.rm = TRUE) +plot(rds) +plot(rds_kmd) +names(rds_kmd) = productid +i = 100 +productid +filename = basename(hd_files[i]) +productid = paste0(substr(filename, 1, nchar(filename)-4), "_kmdc") +productid +# Compute mean distance from centroid on original band stack and +# scaled vegetation inidces stack source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") if(length(showConnections()) == 0){ -cores = 3 +cores = 2 cl = parallel::makeCluster(cores) doParallel::registerDoParallel(cl) } -hd_files = list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE) +dir.create(paste0(path_hyp_specidcs), showWarnings = FALSE) +# Compute mean distance from centroid on original band stack +hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), +list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) -dir.create(paste0(path_hyp_vegidcs), showWarnings = FALSE) -vis = c("CARI", -"Carter", "Carter2", "Carter3", "Carter4", "Carter5", "Carter6", -"CI", "CI2", "ClAInt", -"CRI1", "CRI2", "CRI3", "CRI4", -"Datt", "Datt2", "Datt4", "Datt5", "Datt6", -"DD", "DDn", "DWSI4", -"EVI", "GDVI_2", "GDVI_3", "GDVI_4", "GI", "Gitelson", "Gitelson2", -"GMI1", "GMI2", "GreenNDVI", "Maccioni", -"MCARI", "MCARI/OSAVI", "MCARI2", "MCARI2/OSAVI2", -"mND705", "mNDVI", "MPRI", "MSAVI", "mSR", "mSR2", "mSR705", -"MTCI", "MTVI", "NDVI", "NDVI2", "NDVI3", "NPCI", -"OSAVI", "OSAVI2", "PARS", "PRI", "PRI*CI2", "PRI_norm", "PSND", -"PSRI", "PSSR", "PWI", "RDVI", "REP_Li", "SAVI", "SIPI", "SPVI", -"SR", "SR1", "SR2", "SR3", "SR4", "SR5", "SR6", "SR7", "SR8", -"SRPI", "TCARI", "TCARI/OSAVI", "TCARI2", "TCARI2/OSAVI2", -"TGI", "TVI", "Vogelmann", "Vogelmann2", "Vogelmann4") -foreach(i = seq(length(hd_files)), .packages = c("hsdar", "raster")) %do% { -plotid = substr(basename(hd_files[[i]]), 1, 4) -m = h_meta[[2]][[h_meta[[1]]$list[grep(plotid, h_meta[[1]]$plotID)]]] -r = hsdar::speclib(brick(readRDS(hd_files[[i]])), -wavelength = m$wavelength, -fwhm = m$fwhm, -continuousdata = "auto") -v = vegindex(r, index = vis) -vr = readAll(v@spectra@spectra_ra) -names(vr) = vis -saveRDS(vr, file = paste0(path_hyp_vegidcs, plotid, "_vegidcs.rds")) +foreach (i = seq(length(hd_files))) %dopar% { +filename = basename(hd_files[i]) +productid = paste0(substr(filename, 1, nchar(filename)-4), "_kmdc") +r = readRDS(hd_files[[i]]) +rds = getValues(r) +all_na = grep(nrow(rds), summary(rds)[7,]) +if(length(all_na) > 0){ +rds = rds[,-all_na] +} else { +all_na = -1 +} +cc = which(complete.cases(rds)) +rds_cc = rds[cc, ] +km = kmeans(rds_cc, center = 1) +kmd = sqrt(rowSums(rds_cc - fitted(km))**2) +rds_kmd = rds[, 1] +rds_kmd[cc] = kmd +rds_kmd = setValues(r[[1]], rds_kmd) +names(rds_kmd) = productid +saveRDS(rds_kmd, file=paste0(path_hyp_specidcs, productid, ".rds")) } stopCluster(cl) -# Visually check data -visCheck(datapath = path_hyp_vegidcs, polygonfile = paste0(path_plots, "BPolygon.shp"), band = 47) -summary(unlist(lapply(files, function(f){nlayers(readRDS(files[[1]]))}))) +# Set path --------------------------------------------------------------------- +if(Sys.info()["sysname"] == "Windows"){ +filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/" +} else { +filepath_base = "/media/permanent/active/KI-Hyperspec/" +} +filepath_source = paste0(filepath_base, "HySpec_KiLi/src/001_functions.R") +path_data = paste0(filepath_base, "/data/") +path_biodiv = paste0(path_data, "/biodiv/") +path_hyp_org = paste0(path_data, "/020_hypspec_org/") +path_hyp_aio = paste0(path_data, "/025_hypspec_aio/") +path_hyp_nrm = paste0(path_data, "/030_hypspec_nrm/") +path_hyp_vegidcs = paste0(path_data, "/040_hypspec_vegidcs/") +path_hyp_kmdc = paste0(path_data, "/050_hypspec_kmdc/") path_hyp_raoq = paste0(path_data, "/060_hypspec_raoq/") -summary(unlist(lapply(files, function(f){nlayers(readRDS(files[[1]]))}))) -files -files = list.files(path_hyp_vegidcs, full.names = TRUE) -summary(unlist(lapply(files, function(f){nlayers(readRDS(files[[1]]))}))) -# Compute Rao's Q on original bands +path_plots = paste0(path_data, "/plots/") +path_rdata = paste0(path_data, "/rdata/") +path_meta = paste0(path_data, "/meta/") +path_temp = paste0(path_data, "/temp/") +path_output = paste0(path_data, "/output/") +path_vis = paste0(path_data, "/vis/") +# Set libraries ---------------------------------------------------------------- +library(biodivTools) # devtools::install_github("environmentalinformatics-marburg/biodivTools") +library(CAST) +library(doParallel) +library(grid) +library(gridExtra) +# library(gpm) +library(hsdar) +# library(lavaan) +# library(rPointDB) +library(rgeos) +library(ggplot2) +library(mapview) +# library(metTools) # devtools::install_github("environmentalinformatics-marburg/metTools") +library(raster) +library(RStoolbox) +library(reshape2) +library(rgdal) +# library(satellite) +library(satelliteTools) # devtools::install_github("environmentalinformatics-marburg/satelliteTools") +# library(semPlot) +library(sp) +library(spacetime) +# library(vegan) +# library(yaml) +# Other settings --------------------------------------------------------------- +source(filepath_source) +rasterOptions(tmpdir = path_temp) +saga_cmd = "C:/OSGeo4W64/apps/saga-ltr/saga_cmd.exe" +# initOTB("C:/OSGeo4W64/bin/") +initOTB("C:/OSGeo4W64/OTB-6.2.0-Win64/bin/") +# Compute mean distance from centroid on original band stack and +# scaled vegetation inidces stack +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +if(length(showConnections()) == 0){ +cores = 2 +cl = parallel::makeCluster(cores) +doParallel::registerDoParallel(cl) +} +dir.create(paste0(path_hyp_kmdc), showWarnings = FALSE) +# Compute mean distance from centroid on original band stack hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) +foreach (i = seq(length(hd_files)), .packages = c("raster")) %dopar% { +filename = basename(hd_files[i]) +productid = paste0(substr(filename, 1, nchar(filename)-4), "_kmdc") +r = readRDS(hd_files[[i]]) +rds = getValues(r) +all_na = grep(nrow(rds), summary(rds)[7,]) +if(length(all_na) > 0){ +rds = rds[,-all_na] +} else { +all_na = -1 +} +cc = which(complete.cases(rds)) +rds_cc = rds[cc, ] +km = kmeans(rds_cc, center = 1) +kmd = sqrt(rowSums(rds_cc - fitted(km))**2) +rds_kmd = rds[, 1] +rds_kmd[cc] = kmd +rds_kmd = setValues(r[[1]], rds_kmd) +names(rds_kmd) = productid +saveRDS(rds_kmd, file=paste0(path_hyp_kmdc, productid, ".rds")) +} +stopCluster(cl) hd_files -i = 1 -productid = paste0(substr(filename, 1, nchar(filename)-4), "_raoq") -# Compute Rao's Q on original bands +# Compute mean distance from centroid on original band stack and +# scaled vegetation inidces stack +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +if(length(showConnections()) == 0){ +cores = 3 +cl = parallel::makeCluster(cores) +doParallel::registerDoParallel(cl) +} +dir.create(paste0(path_hyp_kmdc), showWarnings = FALSE) +# Compute mean distance from centroid on original band stack hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) -filename = basename(hd_files[1]) -productid = paste0(substr(filename, 1, nchar(filename)-4), "_raoq") -productid -i = 100 -filename = basename(hd_files[1]) -productid = paste0(substr(filename, 1, nchar(filename)-4), "_raoq") -productid -i = 100 +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) +foreach (i = seq(length(hd_files)), .packages = c("raster")) %dor% { filename = basename(hd_files[i]) -productid = paste0(substr(filename, 1, nchar(filename)-4), "_raoq") -productid -grep("vegidcs", filename) -grepl("vegidcs", filename) +productid = paste0(substr(filename, 1, nchar(filename)-4), "_kmdc") r = readRDS(hd_files[[i]]) -?norm -?scale -r -r = scale(r, center = TRUE, scale = TRUE) -r -summary(r) -r = readRDS(hd_files[[i]]) -summary(r) -r = readRDS(hd_files[[i]]) -r -summary(r) -r -filename -summary(vr) -names(vr)[32] -plot(vr[[32]]) -plot(vr[[31]]) -hd_files = list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE) -h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) -dir.create(paste0(path_hyp_vegidcs), showWarnings = FALSE) -vis = c("CARI", -"Carter", "Carter2", "Carter3", "Carter4", "Carter5", "Carter6", -"CI", "CI2", "ClAInt", -"CRI1", "CRI2", "CRI3", "CRI4", -"Datt", "Datt2", "Datt4", "Datt5", "Datt6", -"DD", "DDn", "DWSI4", -"EVI", "GDVI_2", "GDVI_3", "GDVI_4", "GI", "Gitelson", "Gitelson2", -"GMI1", "GMI2", "Maccioni", -"MCARI", "MCARI/OSAVI", "MCARI2", "MCARI2/OSAVI2", -"mND705", "mNDVI", "MPRI", "MSAVI", "mSR", "mSR2", "mSR705", -"MTCI", "MTVI", "NDVI", "NDVI2", "NDVI3", "NPCI", -"OSAVI", "OSAVI2", "PARS", "PRI", "PRI*CI2", "PRI_norm", "PSND", -"PSRI", "PSSR", "PWI", "RDVI", "REP_Li", "SAVI", "SIPI", "SPVI", -"SR", "SR1", "SR2", "SR3", "SR4", "SR5", "SR6", "SR7", "SR8", -"SRPI", "TCARI", "TCARI/OSAVI", "TCARI2", "TCARI2/OSAVI2", -"TGI", "TVI", "Vogelmann", "Vogelmann2", "Vogelmann4") -# Compute vegetation indicies +rds = getValues(r) +all_na = grep(nrow(rds), summary(rds)[7,]) +if(length(all_na) > 0){ +rds = rds[,-all_na] +} else { +all_na = -1 +} +cc = which(complete.cases(rds)) +rds_cc = rds[cc, ] +km = kmeans(rds_cc, center = 1) +kmd = sqrt(rowSums(rds_cc - fitted(km))**2) +rds_kmd = rds[, 1] +rds_kmd[cc] = kmd +rds_kmd = setValues(r[[1]], rds_kmd) +names(rds_kmd) = productid +saveRDS(rds_kmd, file=paste0(path_hyp_kmdc, productid, ".rds")) +} +stopCluster(cl) +stopCluster(cl) +stopCluster(cl) +# Compute mean distance from centroid on original band stack and +# scaled vegetation inidces stack source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") if(length(showConnections()) == 0){ cores = 3 cl = parallel::makeCluster(cores) doParallel::registerDoParallel(cl) } -hd_files = list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE) +dir.create(paste0(path_hyp_kmdc), showWarnings = FALSE) +# Compute mean distance from centroid on original band stack +hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), +list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) -dir.create(paste0(path_hyp_vegidcs), showWarnings = FALSE) -vis = c("CARI", -"Carter", "Carter2", "Carter3", "Carter4", "Carter5", "Carter6", -"CI", "CI2", "ClAInt", -"CRI1", "CRI2", "CRI3", "CRI4", -"Datt", "Datt2", "Datt4", "Datt5", "Datt6", -"DD", "DDn", "DWSI4", -"EVI", "GDVI_2", "GDVI_3", "GDVI_4", "GI", "Gitelson", "Gitelson2", -"GMI1", "GMI2", "Maccioni", -"MCARI", "MCARI/OSAVI", "MCARI2", "MCARI2/OSAVI2", -"mND705", "mNDVI", "MPRI", "MSAVI", "mSR", "mSR2", "mSR705", -"MTCI", "MTVI", "NDVI", "NDVI2", "NDVI3", "NPCI", -"OSAVI", "OSAVI2", "PARS", "PRI", "PRI*CI2", "PRI_norm", "PSND", -"PSRI", "PSSR", "PWI", "RDVI", "REP_Li", "SAVI", "SIPI", "SPVI", -"SR", "SR1", "SR2", "SR3", "SR4", "SR5", "SR6", "SR7", "SR8", -"SRPI", "TCARI", "TCARI/OSAVI", "TCARI2", "TCARI2/OSAVI2", -"TGI", "TVI", "Vogelmann", "Vogelmann2", "Vogelmann4") -foreach(i = seq(length(hd_files)), .packages = c("hsdar", "raster")) %do% { -plotid = substr(basename(hd_files[[i]]), 1, 4) -m = h_meta[[2]][[h_meta[[1]]$list[grep(plotid, h_meta[[1]]$plotID)]]] -r = hsdar::speclib(brick(readRDS(hd_files[[i]])), -wavelength = m$wavelength, -fwhm = m$fwhm, -continuousdata = "auto") -v = vegindex(r, index = vis) -vr = readAll(v@spectra@spectra_ra) -names(vr) = paste0(plotid, "_", vis) -saveRDS(vr, file = paste0(path_hyp_vegidcs, plotid, "_vegidcs.rds")) +foreach (i = seq(length(hd_files)), .packages = c("raster")) %do% { +filename = basename(hd_files[i]) +productid = paste0(substr(filename, 1, nchar(filename)-4), "_kmdc") +r = readRDS(hd_files[[i]]) +rds = getValues(r) +all_na = grep(nrow(rds), summary(rds)[7,]) +if(length(all_na) > 0){ +rds = rds[,-all_na] +} else { +all_na = -1 +} +cc = which(complete.cases(rds)) +rds_cc = rds[cc, ] +km = kmeans(rds_cc, center = 1) +kmd = sqrt(rowSums(rds_cc - fitted(km))**2) +rds_kmd = rds[, 1] +rds_kmd[cc] = kmd +rds_kmd = setValues(r[[1]], rds_kmd) +names(rds_kmd) = productid +saveRDS(rds_kmd, file=paste0(path_hyp_kmdc, productid, ".rds")) } stopCluster(cl) -# Visually check data -visCheck(datapath = path_hyp_vegidcs, polygonfile = paste0(path_plots, "BPolygon.shp"), band = 47) -files = list.files(path_hyp_vegidcs -files = list.files(path_hyp_vegidcs, full.names = TRUE) -f = files[[1]] -f -df = read(f) -df = readRDS(f) -df -is.na(df) -any(is.na(df)) -any(is.na(getValues(df))) -(is.na(getValues(df))) -summary(df) -plot(df) -is.na(getValues(df)) -sum(is.na(getValues(df))) -nlayer(df) -nlayers(df) -i = 1 -sum(is.na(df[[i]])) -df[[i]] -sum(is.na(getValues(df[[i]]))) -nasum = lapply(nlayers(df), function(i){ -sum(is.na(getValues(df[[i]]))) -}) -summary(nasum) -nasum -nasum = lapply(nlayers(df), function(i){ -sum(is.na(getValues(df[[i]]))) -}) -nasum -nlayers(df) -nasum = lapply(seq(nlayers(df), function(i){ -sum(is.na(getValues(df[[i]]))) -}) -summary(nasum) -}) -nasum = lapply(seq(nlayers(df)), function(i){ -sum(is.na(getValues(df[[i]]))) -}) -summary(nasum) -nasum -unlist(nasum) -min(unlist(nasum)) == max(unlist(nasum)) -nacheck = do.call("rbind", lapply(files, function(f){ -df = readRDS(f) -nasum = lapply(seq(nlayers(df)), function(i){ -sum(is.na(getValues(df[[i]]))) -}) -return(data.frame(f = basename(f), nacheck = min(unlist(nasum)) == max(unlist(nasum)))) -})) -nacheck -f = files[[47]] -f -df = readRDS(f) -plot(df[[1]]) -plot(df[[2]]) -nasum = lapply(seq(nlayers(df)), function(i){ -sum(is.na(getValues(df[[i]]))) -}) -nasum -nasum -min(unlist(nasum)) -max(unlist(nasum)) -unlist(nasum) -f +stopCluster(cl) +# Compute mean distance from centroid on original band stack and +# scaled vegetation inidces stack source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") if(length(showConnections()) == 0){ -cores = 2 +cores = 1 cl = parallel::makeCluster(cores) doParallel::registerDoParallel(cl) } -path_hyp_raoq -dir.create(paste0(path_hyp_raoq), showWarnings = FALSE) -windows = c(3, 10) -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -showConnections() -dir.create(paste0(path_hyp_raoq), showWarnings = FALSE) -windows = c(3, 10) -# Compute Rao's Q on original bands stack and scaled vegetation indices stack +dir.create(paste0(path_hyp_kmdc), showWarnings = FALSE) +# Compute mean distance from centroid on original band stack hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) -hd_files -i = 100 +foreach (i = seq(length(hd_files)), .packages = c("raster")) %do% { +print(filename) filename = basename(hd_files[i]) -productid = paste0(substr(filename, 1, nchar(filename)-4), "_raoq") -productid -i = 1 -filename = basename(hd_files[i]) -productid = paste0(substr(filename, 1, nchar(filename)-4), "_raoq") -productid -foreach(i = seq(length(hd_files))) %dopar% { -filename = basename(hd_files[i]) -productid = paste0(substr(filename, 1, nchar(filename)-4), "_raoq") +productid = paste0(substr(filename, 1, nchar(filename)-4), "_kmdc") r = readRDS(hd_files[[i]]) -# Scale vegetation indicies -if(grepl("vegidcs", filename)){ -r = scale(r, center = TRUE, scale = TRUE) -} -# ra = aggregate(r, fact=2, fun=mean) -for(w in windows){ -raomatrix <- spectralrao(as.list(r), -mode="multidimension", -distance_m="euclidean", -window=w, -shannon=FALSE, -debugging=TRUE, -simplify=3) -raor = setValues(r[[1]], raomatrix[[1]]) -names(raor) = productid -saveRDS(raor, file = paste0(path_hyp_raoq, -productid, "_", w, ".rds")) +rds = getValues(r) +all_na = grep(nrow(rds), summary(rds)[7,]) +if(length(all_na) > 0){ +rds = rds[,-all_na] +} else { +all_na = -1 } +cc = which(complete.cases(rds)) +rds_cc = rds[cc, ] +km = kmeans(rds_cc, center = 1) +kmd = sqrt(rowSums(rds_cc - fitted(km))**2) +rds_kmd = rds[, 1] +rds_kmd[cc] = kmd +rds_kmd = setValues(r[[1]], rds_kmd) +names(rds_kmd) = productid +saveRDS(rds_kmd, file=paste0(path_hyp_kmdc, productid, ".rds")) } diff --git a/src/000_set_environment.R b/src/000_set_environment.R index b587084..475b7a3 100644 --- a/src/000_set_environment.R +++ b/src/000_set_environment.R @@ -13,6 +13,7 @@ path_hyp_org = paste0(path_data, "/020_hypspec_org/") path_hyp_aio = paste0(path_data, "/025_hypspec_aio/") path_hyp_nrm = paste0(path_data, "/030_hypspec_nrm/") path_hyp_vegidcs = paste0(path_data, "/040_hypspec_vegidcs/") +path_hyp_kmdc = paste0(path_data, "/050_hypspec_kmdc/") path_hyp_raoq = paste0(path_data, "/060_hypspec_raoq/") path_plots = paste0(path_data, "/plots/") @@ -42,7 +43,7 @@ library(RStoolbox) library(reshape2) library(rgdal) # library(satellite) -# library(satelliteTools) # devtools::install_github("environmentalinformatics-marburg/satelliteTools") +library(satelliteTools) # devtools::install_github("environmentalinformatics-marburg/satelliteTools") # library(semPlot) library(sp) library(spacetime) @@ -54,8 +55,8 @@ source(filepath_source) rasterOptions(tmpdir = path_temp) -saga_cmd = "C:/OSGeo4W64/apps/saga/saga_cmd.exe " +saga_cmd = "C:/OSGeo4W64/apps/saga-ltr/saga_cmd.exe" # initOTB("C:/OSGeo4W64/bin/") -initOTB("C:/OSGeo4W64/OTB-5.8.0-win64/OTB-5.8.0-win64/bin/") +initOTB("C:/OSGeo4W64/OTB-6.2.0-Win64/bin/") diff --git a/src/050__kmdc.R b/src/050__kmdc.R new file mode 100644 index 0000000..c98d75a --- /dev/null +++ b/src/050__kmdc.R @@ -0,0 +1,48 @@ +# Compute mean distance from centroid on original band stack and +# scaled vegetation inidces stack + +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +if(length(showConnections()) == 0){ + cores = 3 + cl = parallel::makeCluster(cores) + doParallel::registerDoParallel(cl) +} + +dir.create(paste0(path_hyp_kmdc), showWarnings = FALSE) + + +hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), + list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) + +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) + +foreach (i = seq(length(hd_files)), .packages = c("raster")) %dopar% { + filename = basename(hd_files[i]) + productid = paste0(substr(filename, 1, nchar(filename)-4), "_kmdc") + + r = readRDS(hd_files[[i]]) + rds = getValues(r) + + all_na = grep(nrow(rds), colSums(is.na(rds))) + if(length(all_na) > 0){ + rds = rds[,-all_na] + } else { + all_na = -1 + } + + cc = which(complete.cases(rds)) + rds_cc = rds[cc, ] + + km = kmeans(rds_cc, center = 1) + kmd = sqrt(rowSums(rds_cc - fitted(km))**2) + + rds_kmd = rds[, 1] + rds_kmd[cc] = kmd + rds_kmd = setValues(r[[1]], rds_kmd) + + names(rds_kmd) = productid + + saveRDS(rds_kmd, file=paste0(path_hyp_kmdc, productid, ".rds")) +} + +stopCluster(cl) diff --git a/src/050_divIndices.R b/src/060_raoq.R similarity index 84% rename from src/050_divIndices.R rename to src/060_raoq.R index f096297..975361a 100644 --- a/src/050_divIndices.R +++ b/src/060_raoq.R @@ -1,5 +1,5 @@ -# Compute spectral diversity indicies on original band stack and -# scaled vegetation inidces stack +# Compute Rao's Q on original bands stack, scaled vegetation indices stack, +# and mean distance from centroid band and vegetation index data. source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") # if(length(showConnections()) == 0){ @@ -9,12 +9,11 @@ source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_e # } dir.create(paste0(path_hyp_raoq), showWarnings = FALSE) -windows = c(3, 10) +windows = c(3) - -# Compute Rao's Q on original bands stack and scaled vegetation indices stack hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), - list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) + list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE), + list.files(path_hyp_kmdc, recursive = FALSE, full.names = TRUE)) h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) From 8d04f136ebf311b473c734cb3c642aab80bf1eab Mon Sep 17 00:00:00 2001 From: tnauss Date: Sat, 13 Oct 2018 13:24:43 +0200 Subject: [PATCH 14/65] Scale VIs prior to kmdc. --- src/050__kmdc.R | 10 ++++++++++ src/060_raoq.R | 6 ++++-- 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/src/050__kmdc.R b/src/050__kmdc.R index c98d75a..05c59bd 100644 --- a/src/050__kmdc.R +++ b/src/050__kmdc.R @@ -33,6 +33,11 @@ foreach (i = seq(length(hd_files)), .packages = c("raster")) %dopar% { cc = which(complete.cases(rds)) rds_cc = rds[cc, ] + # Scale vegetation indicies + if(grepl("vegidcs", filename)){ + rds_cc = scale(rds_cc, center = TRUE, scale = TRUE) + } + km = kmeans(rds_cc, center = 1) kmd = sqrt(rowSums(rds_cc - fitted(km))**2) @@ -46,3 +51,8 @@ foreach (i = seq(length(hd_files)), .packages = c("raster")) %dopar% { } stopCluster(cl) + + +# Visually check data +visCheck(datapath = path_hyp_kmdc, polygonfile = paste0(path_plots, "BPolygon.shp"), band = 1) + diff --git a/src/060_raoq.R b/src/060_raoq.R index 975361a..9ff31f8 100644 --- a/src/060_raoq.R +++ b/src/060_raoq.R @@ -45,6 +45,8 @@ foreach (i = seq(length(hd_files))) %do% { } -#check hel3 - # stopCluster(cl) + +# Visually check data +visCheck(datapath = path_hyp_raoq, polygonfile = paste0(path_plots, "BPolygon.shp"), band = 1) + From f91a3fef309e9b17842f93d2b22ceff3fdac9bcd Mon Sep 17 00:00:00 2001 From: tnauss Date: Sat, 13 Oct 2018 18:05:21 +0200 Subject: [PATCH 15/65] Update --- src/000_set_environment.R | 6 +- src/{040_vegIndices.R => 040_comp_vegidcs.R} | 0 src/{050__kmdc.R => 050_comp_kmdc.R} | 0 src/{060_raoq.R => 060_comp_raoq.R} | 0 src/070_combine_predictors.R | 60 ++++++++++++++++++++ src/075_combine_predictores_biodiv.R | 38 +++++++++++++ src/076_combine_predictores_biodiv_tlevel.R | 56 ++++++++++++++++++ src/080_predict_biodiv.R | 31 ++++++++++ 8 files changed, 190 insertions(+), 1 deletion(-) rename src/{040_vegIndices.R => 040_comp_vegidcs.R} (100%) rename src/{050__kmdc.R => 050_comp_kmdc.R} (100%) rename src/{060_raoq.R => 060_comp_raoq.R} (100%) create mode 100644 src/070_combine_predictors.R create mode 100644 src/075_combine_predictores_biodiv.R create mode 100644 src/076_combine_predictores_biodiv_tlevel.R create mode 100644 src/080_predict_biodiv.R diff --git a/src/000_set_environment.R b/src/000_set_environment.R index 475b7a3..e965516 100644 --- a/src/000_set_environment.R +++ b/src/000_set_environment.R @@ -15,6 +15,9 @@ path_hyp_nrm = paste0(path_data, "/030_hypspec_nrm/") path_hyp_vegidcs = paste0(path_data, "/040_hypspec_vegidcs/") path_hyp_kmdc = paste0(path_data, "/050_hypspec_kmdc/") path_hyp_raoq = paste0(path_data, "/060_hypspec_raoq/") +path_hyp_pred = paste0(path_data, "/070_hypspec_pred/") +path_comb_gpm = paste0(path_data, "/075_comb_gpm/") +path_model_gpm = paste0(path_data, "/080_model_gpm/") path_plots = paste0(path_data, "/plots/") path_rdata = paste0(path_data, "/rdata/") @@ -27,10 +30,11 @@ path_vis = paste0(path_data, "/vis/") # Set libraries ---------------------------------------------------------------- library(biodivTools) # devtools::install_github("environmentalinformatics-marburg/biodivTools") library(CAST) +library(corrplot) library(doParallel) library(grid) library(gridExtra) -# library(gpm) +library(gpm) # devtools::install_github("environmentalinformatics-marburg/gpm") library(hsdar) # library(lavaan) # library(rPointDB) diff --git a/src/040_vegIndices.R b/src/040_comp_vegidcs.R similarity index 100% rename from src/040_vegIndices.R rename to src/040_comp_vegidcs.R diff --git a/src/050__kmdc.R b/src/050_comp_kmdc.R similarity index 100% rename from src/050__kmdc.R rename to src/050_comp_kmdc.R diff --git a/src/060_raoq.R b/src/060_comp_raoq.R similarity index 100% rename from src/060_raoq.R rename to src/060_comp_raoq.R diff --git a/src/070_combine_predictors.R b/src/070_combine_predictors.R new file mode 100644 index 0000000..284c50d --- /dev/null +++ b/src/070_combine_predictors.R @@ -0,0 +1,60 @@ +# Compute mean and sd of final predictor sets. + +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +if(length(showConnections()) == 0){ + cores = 3 + cl = parallel::makeCluster(cores) + doParallel::registerDoParallel(cl) +} + +dir.create(paste0(path_hyp_pred), showWarnings = FALSE) + +hd_files = c(list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE), + list.files(path_hyp_kmdc, recursive = FALSE, full.names = TRUE), + list.files(path_hyp_raoq, recursive = FALSE, full.names = TRUE)) + +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) + +preds = foreach (i = seq(length(hd_files))) %do% { + + print(i) + + r = readRDS(hd_files[[i]]) + + nms = names(r) + plotid = substr(nms[1], 1, 4) + productid = substr(nms, 6, nchar(nms)) + + l = lapply(seq(nlayers(r)), function(l){ + df = data.frame(mean(getValues(r[[l]]), na.rm = TRUE), sd(getValues(r[[l]]), na.rm = TRUE)) + colnames(df) = c(paste0(productid[l], c("_mean", "_sd"))) + return(df) + }) + df = do.call("cbind", l) + df = data.frame(plotID = plotid, df) + return(df) +} + +grp = list(grep("vegidcs.rds", hd_files), + grep("vegidcs_kmdc.rds", hd_files), + grep("vegidcs_raoq_3.rds", hd_files), + grep("vegidcs_kmdc_raoq_3.rds", hd_files), + grep("pcai_kmdc.rds", hd_files), + grep("pcai_raoq_3.rds", hd_files), + grep("pcai_kmdc_raoq_3.rds", hd_files)) + +if(length(unlist(grp)) == length(preds)){ + df = lapply(grp, function(g){ + do.call("rbind", preds[g]) + }) + df = do.call("cbind", df) + df = df[, -grep("plotID", colnames(df))[-1]] +} + +saveRDS(df, file = paste0(path_hyp_pred, "hyperspec_preds.rds")) + +stopCluster(cl) + +# Visually check data +corrplot(cor(df[, -1])) + diff --git a/src/075_combine_predictores_biodiv.R b/src/075_combine_predictores_biodiv.R new file mode 100644 index 0000000..eb402db --- /dev/null +++ b/src/075_combine_predictores_biodiv.R @@ -0,0 +1,38 @@ +# Combine hyperspectral predictores and biodiversity variables in gpm class. + +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") + + +preds = readRDS(paste0(path_hyp_pred, "hyperspec_preds.rds")) +bd = readRDS(paste0(path_biodiv, "biodiv.rds")) + +comb = merge(bd, preds, by = c("plotID"), all.x = TRUE, all.y = TRUE) + +comb$SelCat = substr(as.character(comb$plotID), 1, 3) +comb$SelNbr = substr(as.character(comb$plotID), 4, 4) + +col_selector = which(names(comb) %in% c("SelCat", "SelNbr")) + +col_diversity = seq(which("SRmammals" == colnames(comb)), + which("SRallplants" == colnames(comb))) + +col_precitors = c(which("elevation" == colnames(comb)), + seq(which("lui_biomass_removal" == colnames(comb)), + which("lui" == colnames(comb))), + seq(which("CARI_mean" == colnames(comb)), + which("pcai_kmdc_raoq_sd" == colnames(comb)))) + +col_meta = which(!seq(ncol(comb)) %in% c(col_selector, col_diversity, col_precitors)) + + +meta <- createGPMMeta(comb, type = "input", + selector = col_selector, + response = col_diversity, + predictor = col_precitors, + meta = col_meta) + +comb <- gpm(comb, meta, scale = FALSE) + +dir.create(paste0(path_comb_gpm), showWarnings = FALSE) + +saveRDS(comb, file = paste0(path_comb_gpm, "ki_hyperspec_biodiv_non_scaled.rds")) diff --git a/src/076_combine_predictores_biodiv_tlevel.R b/src/076_combine_predictores_biodiv_tlevel.R new file mode 100644 index 0000000..5b32256 --- /dev/null +++ b/src/076_combine_predictores_biodiv_tlevel.R @@ -0,0 +1,56 @@ +# Combine hyperspectral predictores and biodiversity variables in gpm class +# aggregated by trophic level. + +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") + + +preds = readRDS(paste0(path_hyp_pred, "hyperspec_preds.rds")) +bd = readRDS(paste0(path_biodiv, "biodiv.rds")) + +comb = merge(bd, preds, by = c("plotID"), all.x = TRUE, all.y = TRUE) + +trophic_levels = rbind(data.frame(tlevel = "Plants", + groups = c("SRallplants", "SRasterids", "SRconifers", "SReudicots", + "SRferns", "SRlycopodiopsida", "SRmagnoliids", + "SRmonocots", "SRrosids")), + data.frame(tlevel = "Herbivore", + groups = c("SRbees", "SRmoths", "SRorthoptera")), + data.frame(tlevel = "Decomposer", + groups = c("SRdungbeetles", "SRmillipedes", "SRcollembola")), + data.frame(tlevel = "Predators", + groups = c("SRspiders", "SRheteroptera", "SRotheraculeata", + "SRparasitoids", "SRothercoleoptera")), + data.frame(tlevel = "Flying predatores", + groups = c("SRbats", "SRbirds")), + data.frame(tlevel = "Generalist", + groups = c("SRmammals", "SRanimals", "SRsyrphids", "SRants", "SSRsnails"))) + + +comb$SelCat = substr(as.character(comb$plotID), 1, 3) +comb$SelNbr = substr(as.character(comb$plotID), 4, 4) + +col_selector = which(names(comb) %in% c("SelCat", "SelNbr")) + +col_diversity = seq(which("SRmammals" == colnames(comb)), + which("SRallplants" == colnames(comb))) + +col_precitors = c(which("elevation" == colnames(comb)), + seq(which("lui_biomass_removal" == colnames(comb)), + which("lui" == colnames(comb))), + seq(which("CARI_mean" == colnames(comb)), + which("pcai_kmdc_raoq_sd" == colnames(comb)))) + +col_meta = which(!seq(ncol(comb)) %in% c(col_selector, col_diversity, col_precitors)) + + +meta <- createGPMMeta(comb, type = "input", + selector = col_selector, + response = col_diversity, + predictor = col_precitors, + meta = col_meta) + +comb <- gpm(comb, meta, scale = FALSE) + +dir.create(paste0(path_comb_gpm), showWarnings = FALSE) + +saveRDS(comb, file = paste0(path_comb_gpm, "ki_hyperspec_biodiv_non_scaled.rds")) diff --git a/src/080_predict_biodiv.R b/src/080_predict_biodiv.R new file mode 100644 index 0000000..ef118cd --- /dev/null +++ b/src/080_predict_biodiv.R @@ -0,0 +1,31 @@ +# Combine hyperspectral predictores and biodiversity variables in gpm class. + +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +if(length(showConnections()) == 0){ + cores = 3 + cl = parallel::makeCluster(cores) + doParallel::registerDoParallel(cl) +} + +dir.create(paste0(path_model_gpm), showWarnings = FALSE) + +comb = readRDS(paste0(path_comb_gpm, "ki_hyperspec_biodiv_non_scaled.rds")) + +comb@meta$input$RESPONSE_FINAL = "SRsnails" +comb@data$input = comb@data$input[complete.cases(comb@data$input[, c(comb@meta$input$RESPONSE_FINAL, comb@meta$input$PREDICTOR_FINAL)]), ] + +comb = createIndexFolds(x = comb, nested_cv = FALSE) + +comb = trainModel(x = comb, + metric = "RMSE", + n_var = NULL, + mthd = "pls", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + + +stopCluster(cl) \ No newline at end of file From 48c25d060209f1df220ecbcf0c8502543d9b9c03 Mon Sep 17 00:00:00 2001 From: tnauss Date: Sat, 13 Oct 2018 18:34:08 +0200 Subject: [PATCH 16/65] Update src/.Rhistory --- src/.Rhistory | 42 +++++++++++++++++++++--------------------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/src/.Rhistory b/src/.Rhistory index c7884c7..83cdd60 100644 --- a/src/.Rhistory +++ b/src/.Rhistory @@ -1,24 +1,3 @@ -filename = basename(hd_files[i]) -productid = paste0(substr(filename, 1, nchar(filename)-4), "_raoq") -productid -i = 1 -filename = basename(hd_files[i]) -productid = paste0(substr(filename, 1, nchar(filename)-4), "_raoq") -productid -foreach(i = seq(length(hd_files))) %dopar% { -filename = basename(hd_files[i]) -productid = paste0(substr(filename, 1, nchar(filename)-4), "_raoq") -r = readRDS(hd_files[[i]]) -# Scale vegetation indicies -if(grepl("vegidcs", filename)){ -r = scale(r, center = TRUE, scale = TRUE) -} -# ra = aggregate(r, fact=2, fun=mean) -for(w in windows){ -raomatrix <- spectralrao(as.list(r), -mode="multidimension", -distance_m="euclidean", -window=w, shannon=FALSE, debugging=TRUE, simplify=3) @@ -510,3 +489,24 @@ rds_kmd = setValues(r[[1]], rds_kmd) names(rds_kmd) = productid saveRDS(rds_kmd, file=paste0(path_hyp_kmdc, productid, ".rds")) } +trophic_levels = rbind(data.frame(tlevel = "Plants", +groups = c("SRallplants", "SRasterids", "SRconifers", "SReudicots", +"SRferns", "SRlycopodiopsida", "SRmagnoliids", +"SRmonocots", "SRrosids")), +data.frame(tlevel = "Herbivore", +groups = c("SRbees", "SRmoths", "SRorthoptera")), +data.frame(tlevel = "Decomposer", +groups = c("SRdungbeetles", "SRmillipedes", "SRcollembola")), +data.frame(tlevel = "Predators", +groups = c("SRspiders", "SRheteroptera", "SRotheraculeata", +"SRparasitoids", "SRothercoleoptera")), +data.frame(tlevel = "Flying predatores", +groups = c("SRbats", "SRbirds")), +data.frame(tlevel = "Generalist", +groups = c("SRmammals", "SRanimals", "SRsyrphids", "SRants", "SSRsnails"))) +trophic_levels +install.packages("link2GI") +library(link2GI) +?setproj +?initproj +?initProj From 17e8b6a480819e2ce54811b1869164564c81aff7 Mon Sep 17 00:00:00 2001 From: tnauss Date: Sun, 14 Oct 2018 17:31:20 +0200 Subject: [PATCH 17/65] Update --- src/.Rhistory | 910 +++++++++++++++++++-------------------- src/080_predict_biodiv.R | 4 +- 2 files changed, 458 insertions(+), 456 deletions(-) diff --git a/src/.Rhistory b/src/.Rhistory index 83cdd60..c7d1a65 100644 --- a/src/.Rhistory +++ b/src/.Rhistory @@ -1,458 +1,3 @@ -shannon=FALSE, -debugging=TRUE, -simplify=3) -raor = setValues(r[[1]], raomatrix[[1]]) -names(raor) = productid -saveRDS(raor, file = paste0(path_hyp_raoq, -productid, "_", w, ".rds")) -} -} -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -path_hyp_specidcs = paste0(path_data, "/050_hypspec_specidcs/") -dir.create(paste0(path_hyp_specidcs), showWarnings = FALSE) -# Compute mean distance from centroid on original band stack -hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), -list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) -h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) -i = ! -i = 1 -filename = basename(hd_files[i]) -filename -productid = paste0(substr(filename, 1, nchar(filename)-4), "_mdc") -productid -r = readRDS(hd_files[[i]]) -r -kmeans(r) -?kmeans -t = as .data.frame(r) -t = as.data.frame(r) -t -t = getValues(r) -dim(t) -kmenas(t) -kmeans(t) -kmeans(t, centers = 1) -kmeans(t, centers = 2) -kmeans(t, centers = 1) -kmeans(na.omit(t), centers = 1) -na.omit(t) -dim(na.omit(t)) -dim(t) -plot(t) -plot(r) -plot(r[[108]]) -plot(r[[100]]) -km = kmeans(na.omit(r), center = 1) -km = kmeans(na.omit(getValues(r)), center = 1) -km -rds = na.omit(getValues(r)) -km = kmeans(rds, center = 1) -sqrt(rowSums(rds - fitted(km))**2) -kmd = sqrt(rowSums(rds - fitted(km))**2) -plot(kmd) -mean(kmd) -sd(kmd) -var(kmd) -mean(kmd) -sd(kmd) -head(rds) -rds[1, ] -fitted(km) -str(km) -rds - fitted(km) -rds-km -rds-fitted(km) -rds[1, ] -kmd -r -rds = getValues(r) -which(is.na(rds)) -is.na(rds) -head(rds) -rds_na = which(is.na(rds)) -rds_na -rds = getValues(r) -complete.cases(rds) -which(complete.cases(rds)) -cc = which(complete.cases(rds)) -rds_cc = rds[cc, ] -dim(rds_cc) -km = kmeans(rds_cc, center = 1) -kmd = sqrt(rowSums(rds_cc - fitted(km))**2) -?setValues -rds_km = rds -str(kmd) -rds_kmd = rds[, 1] -rds_kmd -rds_kmd[cc] = kmd -rds_kmd = setValues(r[[1]], rds_kmd) -plot(rds_kmd) -mean(getValues(rds_kmd)) -mean(getValues(rds_kmd), na.rm = TRUE) -sd(getValues(rds_kmd), na.rm = TRUE) -rds = na.omit(getValues(r)) -km = kmeans(rds, center = 1) -kmd = sqrt(rowSums(rds - fitted(km))**2) -mean(kmd) -sd(kmd) -rds_kmd -names(rds_kmd) = productid -rds_kmd -productid = paste0(substr(filename, 1, nchar(filename)-4), "_kmdc") -names(rds_kmd) = productid -# Compute mean distance from centroid on original band stack -hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), -list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) -hd_files -i = 7 -n -filename = basename(hd_files[i]) -filename -productid = paste0(substr(filename, 1, nchar(filename)-4), "_kmdc") -r = readRDS(hd_files[[i]]) -rds = getValues(r) -cc = which(complete.cases(rds)) -rds_cc = rds[cc, ] -summary(rds_cc) -dim(rds_cc) -all_na = grep(ncell(r), summary(r)[6,]) -r -r = readRDS(hd_files[[i]]) -all_na = grep(ncell(r), summary(r)[6,]) -ncell(r) -summary(r)[6,] -r -all_na = grep(ncell(r), summary(getValues(r))[6,]) -all_na -i = 6 -filename = basename(hd_files[i]) -productid = paste0(substr(filename, 1, nchar(filename)-4), "_kmdc") -r = readRDS(hd_files[[i]]) -rds = getValues(r) -all_na = grep(ncell(r), summary(getValues(r))[6,]) -all_na -hd_files = list.files(path_hyp_aio, recursive = FALSE, full.names = TRUE) -f = hd_files[i] -plotid = substr(basename(f), 1, 4) -r = readRDS(f) -nl = nlayers(r) -all_na = grep(ncell(r), summary(r)[6,]) -all_na -plotid -# Compute mean distance from centroid on original band stack -hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), -list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) -filename = basename(hd_files[i]) -filename -productid = paste0(substr(filename, 1, nchar(filename)-4), "_kmdc") -productid -r -r = readRDS(hd_files[[i]]) -r -summary(r[[149]]) -summary(r[[148]]) -all_na = grep(ncell(r), summary(getValues(r))[6,]) -all_na -ncell(r) -summary(getValues(r))[6,] -summary(r[[148]]) -all_na -hd_files = list.files(path_hyp_aio, recursive = FALSE, full.names = TRUE) -i -f = hd_files[i] -f -plotid = substr(basename(f), 1, 4) -r = readRDS(f) -nl = nlayers(r) -all_na = grep(ncell(r), summary(r)[6,]) -if(length(all_na) > 0){ -r = r[[-all_na]] -} else { -all_na = -1 -} -all_na -pca = rasterPCA(r) -v = pca$model$sdev**2 -# Continuous Significant Dimensionality -csd = round(sum(sapply(v, function(x){min(x,1)})), 0) -use = seq(csd) -log = list(file = basename(f), all_na = all_na, csd = csd) -pcai = t(t(as.matrix(pca$map)[, use] %*% t(pca$model$loadings)[use, ]) + pca$model$center) -tmp = r[[1]] -pcair = stack(lapply(seq(ncol(pcai)), function(i){ -setValues(tmp, pcai[, i]) -})) -pcair -if(all_na == 1){ -pcair = stack(setValues(tmp, rep(NA, ncell(tmp))), pcair) -} else if(all_na > 1){ -pcair = stack(pcair[[1:(all_na-1)]], -setValues(tmp, rep(NA, ncell(tmp))), -pcair[[(all_na):nlayers(pcair)]]) -} -pcair -names(pcair) = paste0(plotid, "_pcai_", seq(nl)) -all_na -pcair[[149]] -# Compute mean distance from centroid on original band stack -hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), -list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) -i = 6 -filename = basename(hd_files[i]) -productid = paste0(substr(filename, 1, nchar(filename)-4), "_kmdc") -r = readRDS(hd_files[[i]]) -r[[149]] -rds = getValues(r) -all_na = grep(ncell(r), summary(getValues(r))[6,]) -all_na -ncell(r) -summary(getValues(r))[6,] -all_na = grep(ncell(r), summary(getValues(r))[7,]) -all_na -summary(r) -summary(brick(r)) -summary(getValues(r)) -nrow(rds) -all_na = grep(nrow(rds), summary(rds)[7,]) -all_na -if(length(all_na) > 0){ -r = r[[-all_na]] -} else { -all_na = -1 -} -cc = which(complete.cases(rds)) -rds_cc = rds[cc, ] -km = kmeans(rds_cc, center = 1) -kmd = sqrt(rowSums(rds_cc - fitted(km))**2) -str(rds) -rds = rds[[,-all_na]] -all_na -rds[, 1] -rds[, -149] -all_na -r = readRDS(hd_files[[i]]) -rds = getValues(r) -all_na = grep(nrow(rds), summary(rds)[7,]) -if(length(all_na) > 0){ -rds = rds[,-all_na] -} else { -all_na = -1 -} -dim(rds) -cc = which(complete.cases(rds)) -rds_cc = rds[cc, ] -km = kmeans(rds_cc, center = 1) -kmd = sqrt(rowSums(rds_cc - fitted(km))**2) -rds_kmd = rds[, 1] -rds_kmd[cc] = kmd -rds_kmd = setValues(r[[1]], rds_kmd) -mean(rds_kmd) -mean(getValues(rds_kmd)) -mean(getValues(rds_kmd), na.rm = TRUE) -sd(getValues(rds_kmd), na.rm = TRUE) -plot(rds) -plot(rds_kmd) -names(rds_kmd) = productid -i = 100 -productid -filename = basename(hd_files[i]) -productid = paste0(substr(filename, 1, nchar(filename)-4), "_kmdc") -productid -# Compute mean distance from centroid on original band stack and -# scaled vegetation inidces stack -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -if(length(showConnections()) == 0){ -cores = 2 -cl = parallel::makeCluster(cores) -doParallel::registerDoParallel(cl) -} -dir.create(paste0(path_hyp_specidcs), showWarnings = FALSE) -# Compute mean distance from centroid on original band stack -hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), -list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) -h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) -foreach (i = seq(length(hd_files))) %dopar% { -filename = basename(hd_files[i]) -productid = paste0(substr(filename, 1, nchar(filename)-4), "_kmdc") -r = readRDS(hd_files[[i]]) -rds = getValues(r) -all_na = grep(nrow(rds), summary(rds)[7,]) -if(length(all_na) > 0){ -rds = rds[,-all_na] -} else { -all_na = -1 -} -cc = which(complete.cases(rds)) -rds_cc = rds[cc, ] -km = kmeans(rds_cc, center = 1) -kmd = sqrt(rowSums(rds_cc - fitted(km))**2) -rds_kmd = rds[, 1] -rds_kmd[cc] = kmd -rds_kmd = setValues(r[[1]], rds_kmd) -names(rds_kmd) = productid -saveRDS(rds_kmd, file=paste0(path_hyp_specidcs, productid, ".rds")) -} -stopCluster(cl) -# Set path --------------------------------------------------------------------- -if(Sys.info()["sysname"] == "Windows"){ -filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/" -} else { -filepath_base = "/media/permanent/active/KI-Hyperspec/" -} -filepath_source = paste0(filepath_base, "HySpec_KiLi/src/001_functions.R") -path_data = paste0(filepath_base, "/data/") -path_biodiv = paste0(path_data, "/biodiv/") -path_hyp_org = paste0(path_data, "/020_hypspec_org/") -path_hyp_aio = paste0(path_data, "/025_hypspec_aio/") -path_hyp_nrm = paste0(path_data, "/030_hypspec_nrm/") -path_hyp_vegidcs = paste0(path_data, "/040_hypspec_vegidcs/") -path_hyp_kmdc = paste0(path_data, "/050_hypspec_kmdc/") -path_hyp_raoq = paste0(path_data, "/060_hypspec_raoq/") -path_plots = paste0(path_data, "/plots/") -path_rdata = paste0(path_data, "/rdata/") -path_meta = paste0(path_data, "/meta/") -path_temp = paste0(path_data, "/temp/") -path_output = paste0(path_data, "/output/") -path_vis = paste0(path_data, "/vis/") -# Set libraries ---------------------------------------------------------------- -library(biodivTools) # devtools::install_github("environmentalinformatics-marburg/biodivTools") -library(CAST) -library(doParallel) -library(grid) -library(gridExtra) -# library(gpm) -library(hsdar) -# library(lavaan) -# library(rPointDB) -library(rgeos) -library(ggplot2) -library(mapview) -# library(metTools) # devtools::install_github("environmentalinformatics-marburg/metTools") -library(raster) -library(RStoolbox) -library(reshape2) -library(rgdal) -# library(satellite) -library(satelliteTools) # devtools::install_github("environmentalinformatics-marburg/satelliteTools") -# library(semPlot) -library(sp) -library(spacetime) -# library(vegan) -# library(yaml) -# Other settings --------------------------------------------------------------- -source(filepath_source) -rasterOptions(tmpdir = path_temp) -saga_cmd = "C:/OSGeo4W64/apps/saga-ltr/saga_cmd.exe" -# initOTB("C:/OSGeo4W64/bin/") -initOTB("C:/OSGeo4W64/OTB-6.2.0-Win64/bin/") -# Compute mean distance from centroid on original band stack and -# scaled vegetation inidces stack -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -if(length(showConnections()) == 0){ -cores = 2 -cl = parallel::makeCluster(cores) -doParallel::registerDoParallel(cl) -} -dir.create(paste0(path_hyp_kmdc), showWarnings = FALSE) -# Compute mean distance from centroid on original band stack -hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), -list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) -h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) -foreach (i = seq(length(hd_files)), .packages = c("raster")) %dopar% { -filename = basename(hd_files[i]) -productid = paste0(substr(filename, 1, nchar(filename)-4), "_kmdc") -r = readRDS(hd_files[[i]]) -rds = getValues(r) -all_na = grep(nrow(rds), summary(rds)[7,]) -if(length(all_na) > 0){ -rds = rds[,-all_na] -} else { -all_na = -1 -} -cc = which(complete.cases(rds)) -rds_cc = rds[cc, ] -km = kmeans(rds_cc, center = 1) -kmd = sqrt(rowSums(rds_cc - fitted(km))**2) -rds_kmd = rds[, 1] -rds_kmd[cc] = kmd -rds_kmd = setValues(r[[1]], rds_kmd) -names(rds_kmd) = productid -saveRDS(rds_kmd, file=paste0(path_hyp_kmdc, productid, ".rds")) -} -stopCluster(cl) -hd_files -# Compute mean distance from centroid on original band stack and -# scaled vegetation inidces stack -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -if(length(showConnections()) == 0){ -cores = 3 -cl = parallel::makeCluster(cores) -doParallel::registerDoParallel(cl) -} -dir.create(paste0(path_hyp_kmdc), showWarnings = FALSE) -# Compute mean distance from centroid on original band stack -hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), -list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) -h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) -foreach (i = seq(length(hd_files)), .packages = c("raster")) %dor% { -filename = basename(hd_files[i]) -productid = paste0(substr(filename, 1, nchar(filename)-4), "_kmdc") -r = readRDS(hd_files[[i]]) -rds = getValues(r) -all_na = grep(nrow(rds), summary(rds)[7,]) -if(length(all_na) > 0){ -rds = rds[,-all_na] -} else { -all_na = -1 -} -cc = which(complete.cases(rds)) -rds_cc = rds[cc, ] -km = kmeans(rds_cc, center = 1) -kmd = sqrt(rowSums(rds_cc - fitted(km))**2) -rds_kmd = rds[, 1] -rds_kmd[cc] = kmd -rds_kmd = setValues(r[[1]], rds_kmd) -names(rds_kmd) = productid -saveRDS(rds_kmd, file=paste0(path_hyp_kmdc, productid, ".rds")) -} -stopCluster(cl) -stopCluster(cl) -stopCluster(cl) -# Compute mean distance from centroid on original band stack and -# scaled vegetation inidces stack -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -if(length(showConnections()) == 0){ -cores = 3 -cl = parallel::makeCluster(cores) -doParallel::registerDoParallel(cl) -} -dir.create(paste0(path_hyp_kmdc), showWarnings = FALSE) -# Compute mean distance from centroid on original band stack -hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), -list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) -h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) -foreach (i = seq(length(hd_files)), .packages = c("raster")) %do% { -filename = basename(hd_files[i]) -productid = paste0(substr(filename, 1, nchar(filename)-4), "_kmdc") -r = readRDS(hd_files[[i]]) -rds = getValues(r) -all_na = grep(nrow(rds), summary(rds)[7,]) -if(length(all_na) > 0){ -rds = rds[,-all_na] -} else { -all_na = -1 -} -cc = which(complete.cases(rds)) -rds_cc = rds[cc, ] -km = kmeans(rds_cc, center = 1) -kmd = sqrt(rowSums(rds_cc - fitted(km))**2) -rds_kmd = rds[, 1] -rds_kmd[cc] = kmd -rds_kmd = setValues(r[[1]], rds_kmd) -names(rds_kmd) = productid -saveRDS(rds_kmd, file=paste0(path_hyp_kmdc, productid, ".rds")) -} -stopCluster(cl) stopCluster(cl) # Compute mean distance from centroid on original band stack and # scaled vegetation inidces stack @@ -510,3 +55,458 @@ library(link2GI) ?setproj ?initproj ?initProj +library(link2GI) +?initProj +envrmt = initProj(projRootDir = base_path, GRASSlocation = "data/grass", +projFolders = folders, prefix = "path_", global = FALSE) +base_path = "C:/Users/tnauss/permanent/edu/msc-phygeo-envinsys-plygrnd" +envrmt = initProj(projRootDir = base_path, GRASSlocation = "data/grass", +projFolders = folders, prefix = "path_", global = FALSE) +envrmt = initProj(projRootDir = base_path, GRASSlocation = "data/grass", +projFolders = folders, path_prefix = "path_", global = FALSE) +folders = c("data/", "data/aerial", "data/lidar", "data/grass", "data/tmp", "data/rdata", "data/results", "run", "log") +base_path = "C:/Users/tnauss/permanent/edu/msc-phygeo-envinsys-plygrnd" +envrmt = initProj(projRootDir = base_path, GRASSlocation = "data/grass", +projFolders = folders, path_prefix = "path_", global = FALSE) +envrmt +folders = c("data/", "data/aerial/", "data/lidar/", "data/grass/", "data/tmp/", "data/rdata/", "data/results/", "run/", "log/") +envrmt = initProj(projRootDir = base_path, GRASSlocation = "data/grass", +projFolders = folders, path_prefix = "path_", global = FALSE) +envrmt +lsf.str("package:link2GI") +?add2Path +=checkPCDomain +?checkPCDomain +?findGRASS +findGRASS +findGRASS() +findGRASS(searchLocation = "C:/OSGeo4W64/apps/grass") +findGRASS(searchLocation = "C:\OSGeo4W64/apps/grass") +findGRASS(searchLocation = "C:/OSGeo4W64/apps/grass") +findGRASS(searchLocation = "C:/OSGeo4W64/apps/grass") +?linkGrass +?linkGRASS7 +?findGrass +?findGRASS +t = "C:/Users/tnauss/" +t %in% paste0(LETTERS,":") +paste0(LETTERS, ":") +grass_path = findGrass() +grass_path = findGRASS() +grass_path +searchLocation = t +t +paste0(LETTERS,":") %in% searchLocation +grep(paste0(LETTERS,":"), searchLocation) +grep(searchLocation, paste0(LETTERS,":")) +pmatch(searchLocation, paste0(LETTERS,":")) +regexpr(searchLocation, paste0(LETTERS,":")) +?regexpr +gregexpr(searchLocation, paste0(LETTERS,":")) +paste(LETTERS,":", collapse="|") +grep(searchLocation, paste(LETTERS,":", collapse="|")) +grep(paste(LETTERS,":", collapse="|"), searchLocation) +paste(LETTERS,":", collapse="|") +searchLocation +grepl(paste(LETTERS,":", collapse="|"), searchLocation) +grepl(paste(LETTERS,":", collapse=" | "), searchLocation) +searchLocation = "C:" +grepl(paste(LETTERS,":", collapse=" | "), searchLocation) +paste(LETTERS,":", collapse=" | ") +paste(LETTERS,":", collapse="| ") +paste(LETTERS,":", collapse=" |") +paste(LETTERS,":", collapse="|") +?paste +paste(LETTERS,":", sep = "", collapse=" | ") +grepl(paste(LETTERS,":", sep = "", collapse=" | "), searchLocation) +grepl(paste(LETTERS,":", sep = "", collapse="|"), searchLocation) +searchLocation = t +grepl(paste(LETTERS,":", sep = "", collapse="|"), searchLocation) +grep(paste(LETTERS,":", sep = "", collapse="|"), searchLocation) +searchLocation +grep(paste(LETTERS,":", sep = "", collapse="|"), searchLocation) +searchLocation = "C/test" +grep(paste(LETTERS,":", sep = "", collapse="|"), searchLocation) +grepl(paste(LETTERS,":", sep = "", collapse="|"), searchLocation) +?paste0 +grepl(paste0(LETTERS,":", collapse="|"), searchLocation) +searchLocation = "C:/test" +grepl(paste0(LETTERS,":", collapse="|"), searchLocation) +?findGRASS +grass_path +saga_path = findSAGA() +saga_path = findSAGA() +``` +saga_path +otb_path = findOTB() +otb_path +envrmt +?base_path +?initProj +tempdir() +library(link2GI) +?initProj +filepath_base = "C:/Users/tnauss/permanent/edu/msc-phygeo-envinsys-plygrnd" +# Set project specific subfolders +project_folders = c("data/", "data/aerial/", "data/lidar/", "data/grass/", +"data/tmp/", "run/", "log/") +envrmt = initProj(projRootDir = filepath_base, GRASSlocation = "data/grass", +projFolders = folders, path_prefix = "path_", global = FALSE) +envrmt = initProj(projRootDir = filepath_base, GRASSlocation = "data/grass", +projFolders = project_folders, path_prefix = "path_", +global = FALSE) +print(envrmt) +print(unlist(envrmt)) +print(as.table(envrmt)) +print(as.table(unlist(envrmt))) +print(envrmt) +print(envrmt)[1:3] +print(envrmt[1:3]) +knitr::opts_chunk$set(echo = TRUE) +knitr::opts_chunk$set(fig.path='{{ site.baseurl }}/assets/images/rmd_images/e01-01/') +Setting up a project environment always requires the definition of different folder pathes and the loading of necessary R packages and additional functions. If additional software like GIS should also be accessible, respective binaries and software environments must be linked, too. +envrmt$path_data_temp +envrmt$path_data_tmp +envrmt = initProj(projRootDir = filepath_base, GRASSlocation = "data/grass", +projFolders = project_folders, path_prefix = "path_", +global = FALSE) +# Set libraries ---------------------------------------------------------------- +libs +# Set libraries ---------------------------------------------------------------- +libs = c(raster, +rgdal, +sp) +# Set libraries ---------------------------------------------------------------- +libs = c("raster", +"rgdal", +"sp") +lapply(libs, require, character.only = TRUE) +knitr::opts_chunk$set(echo = TRUE) +knitr::opts_chunk$set(fig.path='{{ site.baseurl }}/assets/images/rmd_images/e01-01/') +grass_path +?findGRASS +# Move markdown files and related figures to jekyll +files = list.files(dirname(rstudioapi::getActiveDocumentContext()$path), +recursive = TRUE, full.names = TRUE) +# Copy MD files +md_files = files[grep("\\.md$", files)] +target_folder = paste0(substr(md_files[1], 1, gregexpr(pattern ='staging', md_files[1])[[1]][1]-1), +"docs/_includes/") +dir.create(target_folder, showWarnings = FALSE) +for(f in md_files){ +f_in = readLines(f) +title_line = grep("title:", f_in) +header_start = grep("---", f_in)[1] +header_end = grep("---", f_in)[2] +new_header = c(f_in[header_start], f_in[title_line], "toc: true", +"toc_label: In this example", f_in[header_end]) +if(!is.na(header_end)){ +f_in = c(new_header, f_in[-seq(header_end)]) +fc = file(f, "w") +writeLines(f_in, fc) +close(fc) +} +file.copy(from=f, to=target_folder, +overwrite = TRUE, recursive = TRUE, +copy.mode = TRUE) +} +# Copy RMD figures +rmd_image_folder = dirname(files[grep("rmd_images", files)]) +target_folder = paste0(substr(rmd_image_folder[1], 1, gregexpr(pattern ='staging', rmd_image_folder[1])[[1]][1]-1), +"docs/assets/images/rmd_images/") +dir.create(target_folder, showWarnings = FALSE) +for(f in rmd_image_folder){ +file.copy(from=f, to=target_folder, +overwrite = TRUE, recursive = TRUE, +copy.mode = TRUE) +} +# Clean up +unlink(rmd_image_folder, recursive = TRUE) +file.remove(md_files) +html_files = files[grep("\\.html$", files)] +file.remove(html_files) +# Move markdown files and related figures to jekyll +files = list.files(dirname(rstudioapi::getActiveDocumentContext()$path), +recursive = TRUE, full.names = TRUE) +files +# Copy MD files +md_files = files[grep("\\.md$", files)] +md_files +target_folder = paste0(substr(md_files[1], 1, gregexpr(pattern ='staging', md_files[1])[[1]][1]-1), +"docs/_includes/") +target_folder +target_folder = paste0(substr(md_files[1], 1, gregexpr(pattern ='staging', md_files[1])[[1]][1]-1), +"docs/_includes/") +dir.create(target_folder, showWarnings = FALSE) +for(f in md_files){ +f_in = readLines(f) +title_line = grep("title:", f_in) +header_start = grep("---", f_in)[1] +header_end = grep("---", f_in)[2] +new_header = c(f_in[header_start], f_in[title_line], "toc: true", +"toc_label: In this example", f_in[header_end]) +if(!is.na(header_end)){ +f_in = c(new_header, f_in[-seq(header_end)]) +fc = file(f, "w") +writeLines(f_in, fc) +close(fc) +} +file.copy(from=f, to=target_folder, +overwrite = TRUE, recursive = TRUE, +copy.mode = TRUE) +} +# Copy RMD figures +rmd_image_folder = dirname(files[grep("rmd_images", files)]) +target_folder = paste0(substr(rmd_image_folder[1], 1, gregexpr(pattern ='staging', rmd_image_folder[1])[[1]][1]-1), +"docs/assets/images/rmd_images/") +dir.create(target_folder, showWarnings = FALSE) +for(f in rmd_image_folder){ +file.copy(from=f, to=target_folder, +overwrite = TRUE, recursive = TRUE, +copy.mode = TRUE) +} +# Clean up +unlink(rmd_image_folder, recursive = TRUE) +file.remove(md_files) +html_files = files[grep("\\.html$", files)] +file.remove(html_files) +# Move markdown files and related figures to jekyll +files = list.files(dirname(rstudioapi::getActiveDocumentContext()$path), +recursive = TRUE, full.names = TRUE) +# Copy MD files +md_files = files[grep("\\.md$", files)] +target_folder = paste0(substr(md_files[1], 1, gregexpr(pattern ='staging', md_files[1])[[1]][1]-1), +"docs/_includes/") +dir.create(target_folder, showWarnings = FALSE) +for(f in md_files){ +f_in = readLines(f) +title_line = grep("title:", f_in) +header_start = grep("---", f_in)[1] +header_end = grep("---", f_in)[2] +new_header = c(f_in[header_start], f_in[title_line], "toc: true", +"toc_label: In this example", f_in[header_end]) +if(!is.na(header_end)){ +f_in = c(new_header, f_in[-seq(header_end)]) +fc = file(f, "w") +writeLines(f_in, fc) +close(fc) +} +file.copy(from=f, to=target_folder, +overwrite = TRUE, recursive = TRUE, +copy.mode = TRUE) +} +# Copy RMD figures +rmd_image_folder = dirname(files[grep("rmd_images", files)]) +target_folder = paste0(substr(rmd_image_folder[1], 1, gregexpr(pattern ='staging', rmd_image_folder[1])[[1]][1]-1), +"docs/assets/images/rmd_images/") +dir.create(target_folder, showWarnings = FALSE) +for(f in rmd_image_folder){ +file.copy(from=f, to=target_folder, +overwrite = TRUE, recursive = TRUE, +copy.mode = TRUE) +} +# Clean up +unlink(rmd_image_folder, recursive = TRUE) +file.remove(md_files) +html_files = files[grep("\\.html$", files)] +file.remove(html_files) +# Move markdown files and related figures to jekyll +files = list.files(dirname(rstudioapi::getActiveDocumentContext()$path), +recursive = TRUE, full.names = TRUE) +# Copy MD files +md_files = files[grep("\\.md$", files)] +target_folder = paste0(substr(md_files[1], 1, gregexpr(pattern ='staging', md_files[1])[[1]][1]-1), +"docs/_includes/") +dir.create(target_folder, showWarnings = FALSE) +for(f in md_files){ +f_in = readLines(f) +title_line = grep("title:", f_in) +header_start = grep("---", f_in)[1] +header_end = grep("---", f_in)[2] +new_header = c(f_in[header_start], f_in[title_line], "toc: true", +"toc_label: In this example", f_in[header_end]) +if(!is.na(header_end)){ +f_in = c(new_header, f_in[-seq(header_end)]) +fc = file(f, "w") +writeLines(f_in, fc) +close(fc) +} +file.copy(from=f, to=target_folder, +overwrite = TRUE, recursive = TRUE, +copy.mode = TRUE) +} +# Copy RMD figures +rmd_image_folder = dirname(files[grep("rmd_images", files)]) +target_folder = paste0(substr(rmd_image_folder[1], 1, gregexpr(pattern ='staging', rmd_image_folder[1])[[1]][1]-1), +"docs/assets/images/rmd_images/") +dir.create(target_folder, showWarnings = FALSE) +for(f in rmd_image_folder){ +file.copy(from=f, to=target_folder, +overwrite = TRUE, recursive = TRUE, +copy.mode = TRUE) +} +# Clean up +unlink(rmd_image_folder, recursive = TRUE) +file.remove(md_files) +html_files = files[grep("\\.html$", files)] +file.remove(html_files) +# Move markdown files and related figures to jekyll +files = list.files(dirname(rstudioapi::getActiveDocumentContext()$path), +recursive = TRUE, full.names = TRUE) +# Copy MD files +md_files = files[grep("\\.md$", files)] +target_folder = paste0(substr(md_files[1], 1, gregexpr(pattern ='staging', md_files[1])[[1]][1]-1), +"docs/_includes/") +dir.create(target_folder, showWarnings = FALSE) +for(f in md_files){ +f_in = readLines(f) +title_line = grep("title:", f_in) +header_start = grep("---", f_in)[1] +header_end = grep("---", f_in)[2] +new_header = c(f_in[header_start], f_in[title_line], "toc: true", +"toc_label: In this example", f_in[header_end]) +if(!is.na(header_end)){ +f_in = c(new_header, f_in[-seq(header_end)]) +fc = file(f, "w") +writeLines(f_in, fc) +close(fc) +} +file.copy(from=f, to=target_folder, +overwrite = TRUE, recursive = TRUE, +copy.mode = TRUE) +} +# Copy RMD figures +rmd_image_folder = dirname(files[grep("rmd_images", files)]) +target_folder = paste0(substr(rmd_image_folder[1], 1, gregexpr(pattern ='staging', rmd_image_folder[1])[[1]][1]-1), +"docs/assets/images/rmd_images/") +dir.create(target_folder, showWarnings = FALSE) +for(f in rmd_image_folder){ +file.copy(from=f, to=target_folder, +overwrite = TRUE, recursive = TRUE, +copy.mode = TRUE) +} +# Clean up +unlink(rmd_image_folder, recursive = TRUE) +file.remove(md_files) +html_files = files[grep("\\.html$", files)] +file.remove(html_files) +# Move markdown files and related figures to jekyll +files = list.files(dirname(rstudioapi::getActiveDocumentContext()$path), +recursive = TRUE, full.names = TRUE) +# Copy MD files +md_files = files[grep("\\.md$", files)] +target_folder = paste0(substr(md_files[1], 1, gregexpr(pattern ='staging', md_files[1])[[1]][1]-1), +"docs/_includes/") +dir.create(target_folder, showWarnings = FALSE) +for(f in md_files){ +f_in = readLines(f) +title_line = grep("title:", f_in) +header_start = grep("---", f_in)[1] +header_end = grep("---", f_in)[2] +new_header = c(f_in[header_start], f_in[title_line], "toc: true", +"toc_label: In this example", f_in[header_end]) +if(!is.na(header_end)){ +f_in = c(new_header, f_in[-seq(header_end)]) +fc = file(f, "w") +writeLines(f_in, fc) +close(fc) +} +file.copy(from=f, to=target_folder, +overwrite = TRUE, recursive = TRUE, +copy.mode = TRUE) +} +# Copy RMD figures +rmd_image_folder = dirname(files[grep("rmd_images", files)]) +target_folder = paste0(substr(rmd_image_folder[1], 1, gregexpr(pattern ='staging', rmd_image_folder[1])[[1]][1]-1), +"docs/assets/images/rmd_images/") +dir.create(target_folder, showWarnings = FALSE) +for(f in rmd_image_folder){ +file.copy(from=f, to=target_folder, +overwrite = TRUE, recursive = TRUE, +copy.mode = TRUE) +} +# Clean up +unlink(rmd_image_folder, recursive = TRUE) +file.remove(md_files) +html_files = files[grep("\\.html$", files)] +file.remove(html_files) +# Move markdown files and related figures to jekyll +files = list.files(dirname(rstudioapi::getActiveDocumentContext()$path), +recursive = TRUE, full.names = TRUE) +# Copy MD files +md_files = files[grep("\\.md$", files)] +target_folder = paste0(substr(md_files[1], 1, gregexpr(pattern ='staging', md_files[1])[[1]][1]-1), +"docs/_includes/") +dir.create(target_folder, showWarnings = FALSE) +for(f in md_files){ +f_in = readLines(f) +title_line = grep("title:", f_in) +header_start = grep("---", f_in)[1] +header_end = grep("---", f_in)[2] +new_header = c(f_in[header_start], f_in[title_line], "toc: true", +"toc_label: In this example", f_in[header_end]) +if(!is.na(header_end)){ +f_in = c(new_header, f_in[-seq(header_end)]) +fc = file(f, "w") +writeLines(f_in, fc) +close(fc) +} +file.copy(from=f, to=target_folder, +overwrite = TRUE, recursive = TRUE, +copy.mode = TRUE) +} +# Copy RMD figures +rmd_image_folder = dirname(files[grep("rmd_images", files)]) +target_folder = paste0(substr(rmd_image_folder[1], 1, gregexpr(pattern ='staging', rmd_image_folder[1])[[1]][1]-1), +"docs/assets/images/rmd_images/") +dir.create(target_folder, showWarnings = FALSE) +for(f in rmd_image_folder){ +file.copy(from=f, to=target_folder, +overwrite = TRUE, recursive = TRUE, +copy.mode = TRUE) +} +# Clean up +unlink(rmd_image_folder, recursive = TRUE) +file.remove(md_files) +html_files = files[grep("\\.html$", files)] +file.remove(html_files) +# Move markdown files and related figures to jekyll +files = list.files(dirname(rstudioapi::getActiveDocumentContext()$path), +recursive = TRUE, full.names = TRUE) +# Copy MD files +md_files = files[grep("\\.md$", files)] +target_folder = paste0(substr(md_files[1], 1, gregexpr(pattern ='staging', md_files[1])[[1]][1]-1), +"docs/_includes/") +dir.create(target_folder, showWarnings = FALSE) +for(f in md_files){ +f_in = readLines(f) +title_line = grep("title:", f_in) +header_start = grep("---", f_in)[1] +header_end = grep("---", f_in)[2] +new_header = c(f_in[header_start], f_in[title_line], "toc: true", +"toc_label: In this example", f_in[header_end]) +if(!is.na(header_end)){ +f_in = c(new_header, f_in[-seq(header_end)]) +fc = file(f, "w") +writeLines(f_in, fc) +close(fc) +} +file.copy(from=f, to=target_folder, +overwrite = TRUE, recursive = TRUE, +copy.mode = TRUE) +} +# Copy RMD figures +rmd_image_folder = dirname(files[grep("rmd_images", files)]) +target_folder = paste0(substr(rmd_image_folder[1], 1, gregexpr(pattern ='staging', rmd_image_folder[1])[[1]][1]-1), +"docs/assets/images/rmd_images/") +dir.create(target_folder, showWarnings = FALSE) +for(f in rmd_image_folder){ +file.copy(from=f, to=target_folder, +overwrite = TRUE, recursive = TRUE, +copy.mode = TRUE) +} +# Clean up +unlink(rmd_image_folder, recursive = TRUE) +file.remove(md_files) +html_files = files[grep("\\.html$", files)] +file.remove(html_files) diff --git a/src/080_predict_biodiv.R b/src/080_predict_biodiv.R index ef118cd..0444e05 100644 --- a/src/080_predict_biodiv.R +++ b/src/080_predict_biodiv.R @@ -19,13 +19,15 @@ comb = createIndexFolds(x = comb, nested_cv = FALSE) comb = trainModel(x = comb, metric = "RMSE", n_var = NULL, - mthd = "pls", + mthd = "rf", mode = "ffs", seed_nbr = 11, cv_nbr = NULL, var_selection = "indv", filepath_tmp = NULL) +saveRDS(comb, file = paste0(path_comb_gpm, "ki_hyperspec_biodiv_non_scaled_modell_rf.rds")) +# saveRDS(comb, file = paste0(path_comb_gpm, "ki_hyperspec_biodiv_non_scaled_modell.rds")) stopCluster(cl) \ No newline at end of file From ac05dca6f10bede81d800fbf1f7fab1a39962966 Mon Sep 17 00:00:00 2001 From: tnauss Date: Fri, 19 Oct 2018 08:14:23 +0200 Subject: [PATCH 18/65] Update --- src/.Rhistory | 996 +++++++++--------- src/000_set_environment.R | 7 +- src/070_comp_txtr.R | 37 + src/080_predict_biodiv.R | 33 - ..._predictors.R => 090_combine_predictors.R} | 7 +- ....R => 100_combine_predictores_biodiv_sr.R} | 4 +- ...> 120_combine_predictores_biodiv_tlevel.R} | 7 + src/200_predict_biodiv_sr.R | 41 + 8 files changed, 594 insertions(+), 538 deletions(-) create mode 100644 src/070_comp_txtr.R delete mode 100644 src/080_predict_biodiv.R rename src/{070_combine_predictors.R => 090_combine_predictors.R} (90%) rename src/{075_combine_predictores_biodiv.R => 100_combine_predictores_biodiv_sr.R} (90%) rename src/{076_combine_predictores_biodiv_tlevel.R => 120_combine_predictores_biodiv_tlevel.R} (99%) create mode 100644 src/200_predict_biodiv_sr.R diff --git a/src/.Rhistory b/src/.Rhistory index c7d1a65..4e8db1d 100644 --- a/src/.Rhistory +++ b/src/.Rhistory @@ -1,512 +1,512 @@ -stopCluster(cl) -# Compute mean distance from centroid on original band stack and -# scaled vegetation inidces stack +stack(unlist(txtr_gw, recursive = TRUE)) +names(stack(unlist(txtr_gw, recursive = TRUE))) +txtr_wg = lapply(windows, function(w){ +txtr_g = lapply(n_grey, function(g){ +txtr = glcmTextures(r, kernel_size = w, +stats = c("entropy", "homogeneity", "second_moment"), +n_grey = g) +names(txtr[[1]]) = paste0(productid, "_", names(txtr[[1]]), "_w", sprintf("%02d", w), "_g", sprintf("%02d", g)) +return(txtr) +}) +}) +stack(unlist(txtr_gw, recursive = TRUE)) +txtr_wg = lapply(windows, function(w){ +txtr_g = lapply(n_grey, function(g){ +txtr = glcmTextures(r, kernel_size = w, +stats = c("entropy", "homogeneity", "second_moment"), +n_grey = g) +names(txtr[[1]]) = paste0(productid, "_", names(txtr[[1]]), "_w", sprintf("%02d", w), "_g", sprintf("%02d", g)) +return(txtr) +}) +}) +txtr_wg = lapply(windows, function(w){ +txtr_g = lapply(n_grey, function(g){ +txtr = glcmTextures(r, kernel_size = w, +stats = c("entropy", "homogeneity", "second_moment"), +n_grey = g) +names(txtr[[1]]) = paste0(productid, "_", names(txtr[[1]]), "_w", sprintf("%02d", w), "_g", sprintf("%02d", g)) +return(txtr) +}) +}) +stopCluster +stopCluster() +txtr_wg = lapply(windows, function(w){ +txtr_g = lapply(n_grey, function(g){ +txtr = glcmTextures(r, kernel_size = w, +stats = c("entropy", "homogeneity", "second_moment"), +n_grey = g) +names(txtr[[1]]) = paste0(productid, "_", names(txtr[[1]]), "_w", sprintf("%02d", w), "_g", sprintf("%02d", g)) +return(txtr) +}) +}) source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -if(length(showConnections()) == 0){ -cores = 1 -cl = parallel::makeCluster(cores) -doParallel::registerDoParallel(cl) -} -dir.create(paste0(path_hyp_kmdc), showWarnings = FALSE) -# Compute mean distance from centroid on original band stack -hd_files = c(list.files(path_hyp_nrm, recursive = FALSE, full.names = TRUE), -list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE)) +# if(length(showConnections()) == 0){ +# cores = 2 +# cl = parallel::makeCluster(cores) +# doParallel::registerDoParallel(cl) +# } +dir.create(paste0(path_hyp_txtr), showWarnings = FALSE) +hd_files = c(list.files(path_hyp_kmdc, recursive = FALSE, full.names = TRUE)) h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) -foreach (i = seq(length(hd_files)), .packages = c("raster")) %do% { -print(filename) +windows = c(3, 11, 21, 31) +n_grey = c(32, 128) +i = 1 filename = basename(hd_files[i]) -productid = paste0(substr(filename, 1, nchar(filename)-4), "_kmdc") +productid = substr(filename, 1, nchar(filename)-4) r = readRDS(hd_files[[i]]) -rds = getValues(r) -all_na = grep(nrow(rds), summary(rds)[7,]) -if(length(all_na) > 0){ -rds = rds[,-all_na] +txtr_wg = lapply(windows, function(w){ +txtr_g = lapply(n_grey, function(g){ +txtr = glcmTextures(r, kernel_size = w, +stats = c("entropy", "homogeneity", "second_moment"), +n_grey = g) +names(txtr[[1]]) = paste0(productid, "_", names(txtr[[1]]), "_w", sprintf("%02d", w), "_g", sprintf("%02d", g)) +return(txtr) +}) +}) +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +# if(length(showConnections()) == 0){ +# cores = 2 +# cl = parallel::makeCluster(cores) +# doParallel::registerDoParallel(cl) +# } +dir.create(paste0(path_hyp_txtr), showWarnings = FALSE) +hd_files = c(list.files(path_hyp_kmdc, recursive = FALSE, full.names = TRUE)) +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) +windows = c(3, 11, 21, 31) +n_grey = c(32, 128) +i = 1 +filename = basename(hd_files[i]) +productid = substr(filename, 1, nchar(filename)-4) +r = readRDS(hd_files[[i]]) +txtr_wg = lapply(windows, function(w){ +txtr_g = lapply(n_grey, function(g){ +txtr = glcmTextures(r, kernel_size = w, +stats = c("entropy", "homogeneity", "second_moment"), +n_grey = g) +names(txtr[[1]]) = paste0(productid, "_", names(txtr[[1]]), "_w", sprintf("%02d", w), "_g", sprintf("%02d", g)) +return(txtr) +}) +}) +txtr_wg +stack(unlist(txtr_gw, recursive = TRUE)) +txtr_gw +txtr_g +txtr_wg +stack(unlist(txtr_wg, recursive = TRUE)) +plot(txtr_wg) +txtr_wg = stack(unlist(txtr_wg, recursive = TRUE)) +plot(txtr_wg) +windows = c(3, 11, 21, 31, 41) +n_grey = c(32) +txtr_wg = lapply(windows, function(w){ +txtr_g = lapply(n_grey, function(g){ +txtr = glcmTextures(r, kernel_size = w, +stats = c("entropy", "homogeneity", "second_moment"), +n_grey = g) +names(txtr[[1]]) = paste0(productid, "_", names(txtr[[1]]), "_w", sprintf("%02d", w), "_g", sprintf("%02d", g)) +return(txtr) +}) +}) +txtr_wg = stack(unlist(txtr_wg, recursive = TRUE)) +plot(txtr_wg) +hd_files +plot(r) +plot(txtr_wg[[1]]) +plot(txtr_wg[[4]]) +plot(txtr_wg[[5]]) +mean(getValues(r), na.rm = TRUE) +sd(getValues(r), na.rm = TRUE)/mean(getValues(r), na.rm = TRUE) +sd(getValues(txtr_wg[[1]]), na.rm = TRUE)/mean(getValues(txtr_wg[[1]]), na.rm = TRUE) +sd(getValues(txtr_wg[[2]]), na.rm = TRUE)/mean(getValues(txtr_wg[[2]]), na.rm = TRUE) +sd(getValues(txtr_wg[[3]]), na.rm = TRUE)/mean(getValues(txtr_wg[[3]]), na.rm = TRUE) +t = as.data.frame(txtr_wg) +dim(t) +as.matrix(t) +cor(s.matrix(t)) +cor(as.matrix(t)) +c = cor(as.matrix(t)) +dim(c) +library(corrplot) +corrplot(c) +c = cor(as.matrix(t), na.rm = TRUE) +c = cor(as.matrix(t), ommit.na = TRUE) +?cor +c = cor(as.matrix(t), na.rm = TRUE) +m = as.matrix(t) +c = cor(m, na.rm = TRUE) +m = as.matrix(complete.cases(t)) +c = cor(m, na.rm = TRUE) +c = cor(m) +corrplot(c) +t +t[complete.cases(t)] +t[complete.cases(t),] +corrplot(cor(as.matric(t[complete.cases(t),]))) +corrplot(cor(as.matrix(t[complete.cases(t),]))) +windows = c(3, 11, 21, 31) +n_grey = c(32, 64) +txtr_wg = lapply(windows, function(w){ +txtr_g = lapply(n_grey, function(g){ +txtr = glcmTextures(r, kernel_size = w, +stats = c("entropy", "homogeneity", "second_moment"), +n_grey = g) +names(txtr[[1]]) = paste0(productid, "_", names(txtr[[1]]), "_w", sprintf("%02d", w), "_g", sprintf("%02d", g)) +return(txtr) +}) +}) +txtr_wg = stack(unlist(txtr_wg, recursive = TRUE)) +corrplot(cor(as.matric(t[complete.cases(t),]))) +corrplot(cor(as.matrix(t[complete.cases(t),]))) +windows = c(3, 11, 21, 31) +n_grey = c(32, 64) +txtr_wg = lapply(windows, function(w){ +txtr_g = lapply(n_grey, function(g){ +txtr = glcmTextures(r, kernel_size = w, +stats = c("entropy", "homogeneity", "second_moment"), +n_grey = g) +names(txtr[[1]]) = paste0(productid, "_", names(txtr[[1]]), "_w", sprintf("%02d", w), "_g", sprintf("%02d", g)) +return(txtr) +}) +}) +txtr_wg = stack(unlist(txtr_wg, recursive = TRUE)) +txtr_wg +stack(unlist(txtr_wg, recursive = TRUE)) +4*2*3 +txtr_wg = stack(unlist(txtr_wg, recursive = TRUE)) +corrplot(cor(as.matrix(txtr_wg))) +corrplot(cor(as.matrix(as.data.frame(txtr_wg)))) +corrplot(cor(as.matrix(t[complete.cases(t),]))) +t = as.data.frame(txtr_wg) +corrplot(cor(as.matrix(t[complete.cases(t),]))) +11/2 +31/2 +3/2 +txtr_wg +path_hyp_txtr +productid +names(txtr_wg) +# Set path --------------------------------------------------------------------- +if(Sys.info()["sysname"] == "Windows"){ +filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/" } else { -all_na = -1 +filepath_base = "/media/permanent/active/KI-Hyperspec/" } -cc = which(complete.cases(rds)) -rds_cc = rds[cc, ] -km = kmeans(rds_cc, center = 1) -kmd = sqrt(rowSums(rds_cc - fitted(km))**2) -rds_kmd = rds[, 1] -rds_kmd[cc] = kmd -rds_kmd = setValues(r[[1]], rds_kmd) -names(rds_kmd) = productid -saveRDS(rds_kmd, file=paste0(path_hyp_kmdc, productid, ".rds")) -} -trophic_levels = rbind(data.frame(tlevel = "Plants", -groups = c("SRallplants", "SRasterids", "SRconifers", "SReudicots", -"SRferns", "SRlycopodiopsida", "SRmagnoliids", -"SRmonocots", "SRrosids")), -data.frame(tlevel = "Herbivore", -groups = c("SRbees", "SRmoths", "SRorthoptera")), -data.frame(tlevel = "Decomposer", -groups = c("SRdungbeetles", "SRmillipedes", "SRcollembola")), -data.frame(tlevel = "Predators", -groups = c("SRspiders", "SRheteroptera", "SRotheraculeata", -"SRparasitoids", "SRothercoleoptera")), -data.frame(tlevel = "Flying predatores", -groups = c("SRbats", "SRbirds")), -data.frame(tlevel = "Generalist", -groups = c("SRmammals", "SRanimals", "SRsyrphids", "SRants", "SSRsnails"))) -trophic_levels -install.packages("link2GI") -library(link2GI) -?setproj -?initproj -?initProj -library(link2GI) -?initProj -envrmt = initProj(projRootDir = base_path, GRASSlocation = "data/grass", -projFolders = folders, prefix = "path_", global = FALSE) -base_path = "C:/Users/tnauss/permanent/edu/msc-phygeo-envinsys-plygrnd" -envrmt = initProj(projRootDir = base_path, GRASSlocation = "data/grass", -projFolders = folders, prefix = "path_", global = FALSE) -envrmt = initProj(projRootDir = base_path, GRASSlocation = "data/grass", -projFolders = folders, path_prefix = "path_", global = FALSE) -folders = c("data/", "data/aerial", "data/lidar", "data/grass", "data/tmp", "data/rdata", "data/results", "run", "log") -base_path = "C:/Users/tnauss/permanent/edu/msc-phygeo-envinsys-plygrnd" -envrmt = initProj(projRootDir = base_path, GRASSlocation = "data/grass", -projFolders = folders, path_prefix = "path_", global = FALSE) -envrmt -folders = c("data/", "data/aerial/", "data/lidar/", "data/grass/", "data/tmp/", "data/rdata/", "data/results/", "run/", "log/") -envrmt = initProj(projRootDir = base_path, GRASSlocation = "data/grass", -projFolders = folders, path_prefix = "path_", global = FALSE) -envrmt -lsf.str("package:link2GI") -?add2Path -=checkPCDomain -?checkPCDomain -?findGRASS -findGRASS -findGRASS() -findGRASS(searchLocation = "C:/OSGeo4W64/apps/grass") -findGRASS(searchLocation = "C:\OSGeo4W64/apps/grass") -findGRASS(searchLocation = "C:/OSGeo4W64/apps/grass") -findGRASS(searchLocation = "C:/OSGeo4W64/apps/grass") -?linkGrass -?linkGRASS7 -?findGrass -?findGRASS -t = "C:/Users/tnauss/" -t %in% paste0(LETTERS,":") -paste0(LETTERS, ":") -grass_path = findGrass() -grass_path = findGRASS() -grass_path -searchLocation = t -t -paste0(LETTERS,":") %in% searchLocation -grep(paste0(LETTERS,":"), searchLocation) -grep(searchLocation, paste0(LETTERS,":")) -pmatch(searchLocation, paste0(LETTERS,":")) -regexpr(searchLocation, paste0(LETTERS,":")) -?regexpr -gregexpr(searchLocation, paste0(LETTERS,":")) -paste(LETTERS,":", collapse="|") -grep(searchLocation, paste(LETTERS,":", collapse="|")) -grep(paste(LETTERS,":", collapse="|"), searchLocation) -paste(LETTERS,":", collapse="|") -searchLocation -grepl(paste(LETTERS,":", collapse="|"), searchLocation) -grepl(paste(LETTERS,":", collapse=" | "), searchLocation) -searchLocation = "C:" -grepl(paste(LETTERS,":", collapse=" | "), searchLocation) -paste(LETTERS,":", collapse=" | ") -paste(LETTERS,":", collapse="| ") -paste(LETTERS,":", collapse=" |") -paste(LETTERS,":", collapse="|") -?paste -paste(LETTERS,":", sep = "", collapse=" | ") -grepl(paste(LETTERS,":", sep = "", collapse=" | "), searchLocation) -grepl(paste(LETTERS,":", sep = "", collapse="|"), searchLocation) -searchLocation = t -grepl(paste(LETTERS,":", sep = "", collapse="|"), searchLocation) -grep(paste(LETTERS,":", sep = "", collapse="|"), searchLocation) -searchLocation -grep(paste(LETTERS,":", sep = "", collapse="|"), searchLocation) -searchLocation = "C/test" -grep(paste(LETTERS,":", sep = "", collapse="|"), searchLocation) -grepl(paste(LETTERS,":", sep = "", collapse="|"), searchLocation) -?paste0 -grepl(paste0(LETTERS,":", collapse="|"), searchLocation) -searchLocation = "C:/test" -grepl(paste0(LETTERS,":", collapse="|"), searchLocation) -?findGRASS -grass_path -saga_path = findSAGA() -saga_path = findSAGA() -``` -saga_path -otb_path = findOTB() -otb_path -envrmt -?base_path -?initProj -tempdir() -library(link2GI) -?initProj -filepath_base = "C:/Users/tnauss/permanent/edu/msc-phygeo-envinsys-plygrnd" -# Set project specific subfolders -project_folders = c("data/", "data/aerial/", "data/lidar/", "data/grass/", -"data/tmp/", "run/", "log/") -envrmt = initProj(projRootDir = filepath_base, GRASSlocation = "data/grass", -projFolders = folders, path_prefix = "path_", global = FALSE) -envrmt = initProj(projRootDir = filepath_base, GRASSlocation = "data/grass", -projFolders = project_folders, path_prefix = "path_", -global = FALSE) -print(envrmt) -print(unlist(envrmt)) -print(as.table(envrmt)) -print(as.table(unlist(envrmt))) -print(envrmt) -print(envrmt)[1:3] -print(envrmt[1:3]) -knitr::opts_chunk$set(echo = TRUE) -knitr::opts_chunk$set(fig.path='{{ site.baseurl }}/assets/images/rmd_images/e01-01/') -Setting up a project environment always requires the definition of different folder pathes and the loading of necessary R packages and additional functions. If additional software like GIS should also be accessible, respective binaries and software environments must be linked, too. -envrmt$path_data_temp -envrmt$path_data_tmp -envrmt = initProj(projRootDir = filepath_base, GRASSlocation = "data/grass", -projFolders = project_folders, path_prefix = "path_", -global = FALSE) +filepath_source = paste0(filepath_base, "HySpec_KiLi/src/001_functions.R") +path_data = paste0(filepath_base, "/data/") +path_biodiv = paste0(path_data, "/biodiv/") +path_hyp_org = paste0(path_data, "/020_hypspec_org/") +path_hyp_aio = paste0(path_data, "/025_hypspec_aio/") +path_hyp_nrm = paste0(path_data, "/030_hypspec_nrm/") +path_hyp_vegidcs = paste0(path_data, "/040_hypspec_vegidcs/") +path_hyp_kmdc = paste0(path_data, "/050_hypspec_kmdc/") +path_hyp_raoq = paste0(path_data, "/060_hypspec_raoq/") +path_hyp_glcm = paste0(path_data, "/070_hypspec_glcm/") +path_hyp_pred = paste0(path_data, "/090_hypspec_pred/") +path_comb_gpm_sr = paste0(path_data, "/100_comb_gpm_sr/") +path_model_gpm = paste0(path_data, "/200_model_gpm_sr/") +path_plots = paste0(path_data, "/plots/") +path_rdata = paste0(path_data, "/rdata/") +path_meta = paste0(path_data, "/meta/") +path_temp = paste0(path_data, "/temp/") +path_output = paste0(path_data, "/output/") +path_vis = paste0(path_data, "/vis/") # Set libraries ---------------------------------------------------------------- -libs -# Set libraries ---------------------------------------------------------------- -libs = c(raster, -rgdal, -sp) -# Set libraries ---------------------------------------------------------------- -libs = c("raster", -"rgdal", -"sp") -lapply(libs, require, character.only = TRUE) -knitr::opts_chunk$set(echo = TRUE) -knitr::opts_chunk$set(fig.path='{{ site.baseurl }}/assets/images/rmd_images/e01-01/') -grass_path -?findGRASS -# Move markdown files and related figures to jekyll -files = list.files(dirname(rstudioapi::getActiveDocumentContext()$path), -recursive = TRUE, full.names = TRUE) -# Copy MD files -md_files = files[grep("\\.md$", files)] -target_folder = paste0(substr(md_files[1], 1, gregexpr(pattern ='staging', md_files[1])[[1]][1]-1), -"docs/_includes/") -dir.create(target_folder, showWarnings = FALSE) -for(f in md_files){ -f_in = readLines(f) -title_line = grep("title:", f_in) -header_start = grep("---", f_in)[1] -header_end = grep("---", f_in)[2] -new_header = c(f_in[header_start], f_in[title_line], "toc: true", -"toc_label: In this example", f_in[header_end]) -if(!is.na(header_end)){ -f_in = c(new_header, f_in[-seq(header_end)]) -fc = file(f, "w") -writeLines(f_in, fc) -close(fc) -} -file.copy(from=f, to=target_folder, -overwrite = TRUE, recursive = TRUE, -copy.mode = TRUE) -} -# Copy RMD figures -rmd_image_folder = dirname(files[grep("rmd_images", files)]) -target_folder = paste0(substr(rmd_image_folder[1], 1, gregexpr(pattern ='staging', rmd_image_folder[1])[[1]][1]-1), -"docs/assets/images/rmd_images/") -dir.create(target_folder, showWarnings = FALSE) -for(f in rmd_image_folder){ -file.copy(from=f, to=target_folder, -overwrite = TRUE, recursive = TRUE, -copy.mode = TRUE) -} -# Clean up -unlink(rmd_image_folder, recursive = TRUE) -file.remove(md_files) -html_files = files[grep("\\.html$", files)] -file.remove(html_files) -# Move markdown files and related figures to jekyll -files = list.files(dirname(rstudioapi::getActiveDocumentContext()$path), -recursive = TRUE, full.names = TRUE) -files -# Copy MD files -md_files = files[grep("\\.md$", files)] -md_files -target_folder = paste0(substr(md_files[1], 1, gregexpr(pattern ='staging', md_files[1])[[1]][1]-1), -"docs/_includes/") -target_folder -target_folder = paste0(substr(md_files[1], 1, gregexpr(pattern ='staging', md_files[1])[[1]][1]-1), -"docs/_includes/") -dir.create(target_folder, showWarnings = FALSE) -for(f in md_files){ -f_in = readLines(f) -title_line = grep("title:", f_in) -header_start = grep("---", f_in)[1] -header_end = grep("---", f_in)[2] -new_header = c(f_in[header_start], f_in[title_line], "toc: true", -"toc_label: In this example", f_in[header_end]) -if(!is.na(header_end)){ -f_in = c(new_header, f_in[-seq(header_end)]) -fc = file(f, "w") -writeLines(f_in, fc) -close(fc) -} -file.copy(from=f, to=target_folder, -overwrite = TRUE, recursive = TRUE, -copy.mode = TRUE) -} -# Copy RMD figures -rmd_image_folder = dirname(files[grep("rmd_images", files)]) -target_folder = paste0(substr(rmd_image_folder[1], 1, gregexpr(pattern ='staging', rmd_image_folder[1])[[1]][1]-1), -"docs/assets/images/rmd_images/") -dir.create(target_folder, showWarnings = FALSE) -for(f in rmd_image_folder){ -file.copy(from=f, to=target_folder, -overwrite = TRUE, recursive = TRUE, -copy.mode = TRUE) -} -# Clean up -unlink(rmd_image_folder, recursive = TRUE) -file.remove(md_files) -html_files = files[grep("\\.html$", files)] -file.remove(html_files) -# Move markdown files and related figures to jekyll -files = list.files(dirname(rstudioapi::getActiveDocumentContext()$path), -recursive = TRUE, full.names = TRUE) -# Copy MD files -md_files = files[grep("\\.md$", files)] -target_folder = paste0(substr(md_files[1], 1, gregexpr(pattern ='staging', md_files[1])[[1]][1]-1), -"docs/_includes/") -dir.create(target_folder, showWarnings = FALSE) -for(f in md_files){ -f_in = readLines(f) -title_line = grep("title:", f_in) -header_start = grep("---", f_in)[1] -header_end = grep("---", f_in)[2] -new_header = c(f_in[header_start], f_in[title_line], "toc: true", -"toc_label: In this example", f_in[header_end]) -if(!is.na(header_end)){ -f_in = c(new_header, f_in[-seq(header_end)]) -fc = file(f, "w") -writeLines(f_in, fc) -close(fc) -} -file.copy(from=f, to=target_folder, -overwrite = TRUE, recursive = TRUE, -copy.mode = TRUE) -} -# Copy RMD figures -rmd_image_folder = dirname(files[grep("rmd_images", files)]) -target_folder = paste0(substr(rmd_image_folder[1], 1, gregexpr(pattern ='staging', rmd_image_folder[1])[[1]][1]-1), -"docs/assets/images/rmd_images/") -dir.create(target_folder, showWarnings = FALSE) -for(f in rmd_image_folder){ -file.copy(from=f, to=target_folder, -overwrite = TRUE, recursive = TRUE, -copy.mode = TRUE) -} -# Clean up -unlink(rmd_image_folder, recursive = TRUE) -file.remove(md_files) -html_files = files[grep("\\.html$", files)] -file.remove(html_files) -# Move markdown files and related figures to jekyll -files = list.files(dirname(rstudioapi::getActiveDocumentContext()$path), -recursive = TRUE, full.names = TRUE) -# Copy MD files -md_files = files[grep("\\.md$", files)] -target_folder = paste0(substr(md_files[1], 1, gregexpr(pattern ='staging', md_files[1])[[1]][1]-1), -"docs/_includes/") -dir.create(target_folder, showWarnings = FALSE) -for(f in md_files){ -f_in = readLines(f) -title_line = grep("title:", f_in) -header_start = grep("---", f_in)[1] -header_end = grep("---", f_in)[2] -new_header = c(f_in[header_start], f_in[title_line], "toc: true", -"toc_label: In this example", f_in[header_end]) -if(!is.na(header_end)){ -f_in = c(new_header, f_in[-seq(header_end)]) -fc = file(f, "w") -writeLines(f_in, fc) -close(fc) -} -file.copy(from=f, to=target_folder, -overwrite = TRUE, recursive = TRUE, -copy.mode = TRUE) -} -# Copy RMD figures -rmd_image_folder = dirname(files[grep("rmd_images", files)]) -target_folder = paste0(substr(rmd_image_folder[1], 1, gregexpr(pattern ='staging', rmd_image_folder[1])[[1]][1]-1), -"docs/assets/images/rmd_images/") -dir.create(target_folder, showWarnings = FALSE) -for(f in rmd_image_folder){ -file.copy(from=f, to=target_folder, -overwrite = TRUE, recursive = TRUE, -copy.mode = TRUE) -} -# Clean up -unlink(rmd_image_folder, recursive = TRUE) -file.remove(md_files) -html_files = files[grep("\\.html$", files)] -file.remove(html_files) -# Move markdown files and related figures to jekyll -files = list.files(dirname(rstudioapi::getActiveDocumentContext()$path), -recursive = TRUE, full.names = TRUE) -# Copy MD files -md_files = files[grep("\\.md$", files)] -target_folder = paste0(substr(md_files[1], 1, gregexpr(pattern ='staging', md_files[1])[[1]][1]-1), -"docs/_includes/") -dir.create(target_folder, showWarnings = FALSE) -for(f in md_files){ -f_in = readLines(f) -title_line = grep("title:", f_in) -header_start = grep("---", f_in)[1] -header_end = grep("---", f_in)[2] -new_header = c(f_in[header_start], f_in[title_line], "toc: true", -"toc_label: In this example", f_in[header_end]) -if(!is.na(header_end)){ -f_in = c(new_header, f_in[-seq(header_end)]) -fc = file(f, "w") -writeLines(f_in, fc) -close(fc) -} -file.copy(from=f, to=target_folder, -overwrite = TRUE, recursive = TRUE, -copy.mode = TRUE) -} -# Copy RMD figures -rmd_image_folder = dirname(files[grep("rmd_images", files)]) -target_folder = paste0(substr(rmd_image_folder[1], 1, gregexpr(pattern ='staging', rmd_image_folder[1])[[1]][1]-1), -"docs/assets/images/rmd_images/") -dir.create(target_folder, showWarnings = FALSE) -for(f in rmd_image_folder){ -file.copy(from=f, to=target_folder, -overwrite = TRUE, recursive = TRUE, -copy.mode = TRUE) -} -# Clean up -unlink(rmd_image_folder, recursive = TRUE) -file.remove(md_files) -html_files = files[grep("\\.html$", files)] -file.remove(html_files) -# Move markdown files and related figures to jekyll -files = list.files(dirname(rstudioapi::getActiveDocumentContext()$path), -recursive = TRUE, full.names = TRUE) -# Copy MD files -md_files = files[grep("\\.md$", files)] -target_folder = paste0(substr(md_files[1], 1, gregexpr(pattern ='staging', md_files[1])[[1]][1]-1), -"docs/_includes/") -dir.create(target_folder, showWarnings = FALSE) -for(f in md_files){ -f_in = readLines(f) -title_line = grep("title:", f_in) -header_start = grep("---", f_in)[1] -header_end = grep("---", f_in)[2] -new_header = c(f_in[header_start], f_in[title_line], "toc: true", -"toc_label: In this example", f_in[header_end]) -if(!is.na(header_end)){ -f_in = c(new_header, f_in[-seq(header_end)]) -fc = file(f, "w") -writeLines(f_in, fc) -close(fc) -} -file.copy(from=f, to=target_folder, -overwrite = TRUE, recursive = TRUE, -copy.mode = TRUE) -} -# Copy RMD figures -rmd_image_folder = dirname(files[grep("rmd_images", files)]) -target_folder = paste0(substr(rmd_image_folder[1], 1, gregexpr(pattern ='staging', rmd_image_folder[1])[[1]][1]-1), -"docs/assets/images/rmd_images/") -dir.create(target_folder, showWarnings = FALSE) -for(f in rmd_image_folder){ -file.copy(from=f, to=target_folder, -overwrite = TRUE, recursive = TRUE, -copy.mode = TRUE) +library(biodivTools) # devtools::install_github("environmentalinformatics-marburg/biodivTools") +library(CAST) +library(corrplot) +library(doParallel) +library(grid) +library(gridExtra) +library(gpm) # devtools::install_github("environmentalinformatics-marburg/gpm") +library(hsdar) +# library(lavaan) +# library(rPointDB) +library(rgeos) +library(ggplot2) +library(mapview) +# library(metTools) # devtools::install_github("environmentalinformatics-marburg/metTools") +library(raster) +library(RStoolbox) +library(reshape2) +library(rgdal) +# library(satellite) +library(satelliteTools) # devtools::install_github("environmentalinformatics-marburg/satelliteTools") +# library(semPlot) +library(sp) +library(spacetime) +# library(vegan) +# library(yaml) +# Other settings --------------------------------------------------------------- +source(filepath_source) +rasterOptions(tmpdir = path_temp) +saga_cmd = "C:/OSGeo4W64/apps/saga-ltr/saga_cmd.exe" +# initOTB("C:/OSGeo4W64/bin/") +initOTB("C:/OSGeo4W64/OTB-6.2.0-Win64/bin/") +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +dir.create(paste0(path_hyp_glcm), showWarnings = FALSE) +hd_files = c(list.files(path_hyp_kmdc, recursive = FALSE, full.names = TRUE)) +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) +windows = c(3, 11, 31) +n_grey = c(32) +i = 1 +filename = basename(hd_files[i]) +productid = substr(filename, 1, nchar(filename)-4) +r = readRDS(hd_files[[i]]) +txtr_wg = lapply(windows, function(w){ +txtr_g = lapply(n_grey, function(g){ +txtr = glcmTextures(r, kernel_size = w, +stats = c("entropy", "homogeneity", "second_moment"), +n_grey = g) +names(txtr[[1]]) = paste0(productid, "_", names(txtr[[1]]), "_w", sprintf("%02d", w), "_g", sprintf("%02d", g)) +return(txtr) +}) +}) +txtr_wg = stack(unlist(txtr_wg, recursive = TRUE)) +txtr_wg +paste0(path_hyp_glcm, productid, "_glcm.rds")) +paste0(path_hyp_glcm, productid, "_glcm.rds") +saveRDS(txtr_wg, file = paste0(path_hyp_glcm, productid, "_glcm.rds")) +dir.create(paste0(path_hyp_glcm), showWarnings = FALSE) +hd_files = c(list.files(path_hyp_kmdc, recursive = FALSE, full.names = TRUE)) +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) +windows = c(3, 11, 31) +n_grey = c(32) +foreach (i = seq(length(hd_files))) %do% { +filename = basename(hd_files[i]) +productid = substr(filename, 1, nchar(filename)-4) +r = readRDS(hd_files[[i]]) +txtr_wg = lapply(windows, function(w){ +txtr_g = lapply(n_grey, function(g){ +txtr = glcmTextures(r, kernel_size = w, +stats = c("entropy", "homogeneity", "second_moment"), +n_grey = g) +names(txtr[[1]]) = paste0(productid, "_", names(txtr[[1]]), "_w", sprintf("%02d", w), "_g", sprintf("%02d", g)) +return(txtr) +}) +}) +txtr_wg = stack(unlist(txtr_wg, recursive = TRUE)) +saveRDS(txtr_wg, file = paste0(path_hyp_glcm, productid, "_glcm.rds")) } -# Clean up -unlink(rmd_image_folder, recursive = TRUE) -file.remove(md_files) -html_files = files[grep("\\.html$", files)] -file.remove(html_files) -# Move markdown files and related figures to jekyll -files = list.files(dirname(rstudioapi::getActiveDocumentContext()$path), -recursive = TRUE, full.names = TRUE) -# Copy MD files -md_files = files[grep("\\.md$", files)] -target_folder = paste0(substr(md_files[1], 1, gregexpr(pattern ='staging', md_files[1])[[1]][1]-1), -"docs/_includes/") -dir.create(target_folder, showWarnings = FALSE) -for(f in md_files){ -f_in = readLines(f) -title_line = grep("title:", f_in) -header_start = grep("---", f_in)[1] -header_end = grep("---", f_in)[2] -new_header = c(f_in[header_start], f_in[title_line], "toc: true", -"toc_label: In this example", f_in[header_end]) -if(!is.na(header_end)){ -f_in = c(new_header, f_in[-seq(header_end)]) -fc = file(f, "w") -writeLines(f_in, fc) -close(fc) +# Compute texture metrics on mean distance from centroid datasets. +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +# if(length(showConnections()) == 0){ +# cores = 2 +# cl = parallel::makeCluster(cores) +# doParallel::registerDoParallel(cl) +# } +dir.create(paste0(path_hyp_glcm), showWarnings = FALSE) +hd_files = c(list.files(path_hyp_kmdc, recursive = FALSE, full.names = TRUE)) +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) +windows = c(3, 11, 31) +n_grey = c(32) +foreach (i = seq(length(hd_files))) %do% { +filename = basename(hd_files[i]) +productid = substr(filename, 1, nchar(filename)-4) +r = readRDS(hd_files[[i]]) +txtr_wg = lapply(windows, function(w){ +txtr_g = lapply(n_grey, function(g){ +txtr = glcmTextures(r, kernel_size = w, +stats = c("entropy", "homogeneity", "second_moment"), +n_grey = g, parallel = FALSE) +names(txtr[[1]]) = paste0(productid, "_", names(txtr[[1]]), "_w", sprintf("%02d", w), "_g", sprintf("%02d", g)) +return(txtr) +}) +}) +txtr_wg = stack(unlist(txtr_wg, recursive = TRUE)) +saveRDS(txtr_wg, file = paste0(path_hyp_glcm, productid, "_glcm.rds")) } -file.copy(from=f, to=target_folder, -overwrite = TRUE, recursive = TRUE, -copy.mode = TRUE) +# Visually check data +visCheck(datapath = path_hyp_glcm, polygonfile = paste0(path_plots, "BPolygon.shp"), band = 1) +dir.create(paste0(path_hyp_pred), showWarnings = FALSE) +hd_files = c(list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE), +list.files(path_hyp_kmdc, recursive = FALSE, full.names = TRUE), +list.files(path_hyp_glcm, recursive = FALSE, full.names = TRUE), +list.files(path_hyp_raoq, recursive = FALSE, full.names = TRUE)) +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) +if(length(showConnections()) == 0){ +cores = 3 +cl = parallel::makeCluster(cores) +doParallel::registerDoParallel(cl) } -# Copy RMD figures -rmd_image_folder = dirname(files[grep("rmd_images", files)]) -target_folder = paste0(substr(rmd_image_folder[1], 1, gregexpr(pattern ='staging', rmd_image_folder[1])[[1]][1]-1), -"docs/assets/images/rmd_images/") -dir.create(target_folder, showWarnings = FALSE) -for(f in rmd_image_folder){ -file.copy(from=f, to=target_folder, -overwrite = TRUE, recursive = TRUE, -copy.mode = TRUE) +preds = foreach (i = seq(length(hd_files))) %do% { +print(i) +r = readRDS(hd_files[[i]]) +nms = names(r) +plotid = substr(nms[1], 1, 4) +productid = substr(nms, 6, nchar(nms)) +l = lapply(seq(nlayers(r)), function(l){ +df = data.frame(mean(getValues(r[[l]]), na.rm = TRUE), sd(getValues(r[[l]]), na.rm = TRUE)) +colnames(df) = c(paste0(productid[l], c("_mean", "_sd"))) +return(df) +}) +df = do.call("cbind", l) +df = data.frame(plotID = plotid, df) +return(df) } -# Clean up -unlink(rmd_image_folder, recursive = TRUE) -file.remove(md_files) -html_files = files[grep("\\.html$", files)] -file.remove(html_files) -# Move markdown files and related figures to jekyll -files = list.files(dirname(rstudioapi::getActiveDocumentContext()$path), -recursive = TRUE, full.names = TRUE) -# Copy MD files -md_files = files[grep("\\.md$", files)] -target_folder = paste0(substr(md_files[1], 1, gregexpr(pattern ='staging', md_files[1])[[1]][1]-1), -"docs/_includes/") -dir.create(target_folder, showWarnings = FALSE) -for(f in md_files){ -f_in = readLines(f) -title_line = grep("title:", f_in) -header_start = grep("---", f_in)[1] -header_end = grep("---", f_in)[2] -new_header = c(f_in[header_start], f_in[title_line], "toc: true", -"toc_label: In this example", f_in[header_end]) -if(!is.na(header_end)){ -f_in = c(new_header, f_in[-seq(header_end)]) -fc = file(f, "w") -writeLines(f_in, fc) -close(fc) +grep("pcai_kmdc_glcm.rds", hd_files) +grep("vegidcs_kmdc_glcm.rds", hd_files) +grp = list(grep("vegidcs.rds", hd_files), +grep("vegidcs_raoq_3.rds", hd_files), +grep("vegidcs_kmdc.rds", hd_files), +grep("vegidcs_kmdc_glcm.rds", hd_files), +grep("vegidcs_kmdc_raoq_3.rds", hd_files), +grep("pcai_raoq_3.rds", hd_files), +grep("pcai_kmdc.rds", hd_files), +grep("pcai_kmdc_glcm.rds", hd_files), +grep("pcai_kmdc_raoq_3.rds", hd_files)) +length(unlist(grp)) == length(preds) +if(length(unlist(grp)) == length(preds)){ +df = lapply(grp, function(g){ +do.call("rbind", preds[g]) +}) +df = do.call("cbind", df) +df = df[, -grep("plotID", colnames(df))[-1]] } -file.copy(from=f, to=target_folder, -overwrite = TRUE, recursive = TRUE, -copy.mode = TRUE) +saveRDS(df, file = paste0(path_hyp_pred, "hyperspec_preds.rds")) +head(df) +complete.cases(df, file = paste0(path_hyp_pred, "hyperspec_preds.rds")) +complete.cases(df) +all(complete.cases(df)) +dim(df) +stopCluster(cl) +# Visually check data +corrplot(cor(df[, -1])) +?corrplot +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +path_hyp_pred +preds = readRDS(paste0(path_hyp_pred, "hyperspec_preds.rds")) +bd = readRDS(paste0(path_biodiv, "biodiv.rds")) +comb = merge(bd, preds, by = c("plotID"), all.x = TRUE, all.y = TRUE) +comb$SelCat = substr(as.character(comb$plotID), 1, 3) +comb$SelNbr = substr(as.character(comb$plotID), 4, 4) +col_selector = which(names(comb) %in% c("SelCat", "SelNbr")) +col_diversity = seq(which("SRmammals" == colnames(comb)), +which("SRallplants" == colnames(comb))) +colnames(comb) +col_precitors = c(which("elevation" == colnames(comb)), +seq(which("lui_biomass_removal" == colnames(comb)), +which("lui" == colnames(comb))), +seq(which("CARI_mean" == colnames(comb)), +which("pcai_kmdc_raoq_sd" == colnames(comb)))) +which(!seq(ncol(comb)) %in% c(col_selector, col_diversity, col_precitors)) +col_meta = which(!seq(ncol(comb)) %in% c(col_selector, col_diversity, col_precitors)) +meta <- createGPMMeta(comb, type = "input", +selector = col_selector, +response = col_diversity, +predictor = col_precitors, +meta = col_meta) +comb <- gpm(comb, meta, scale = FALSE) +dir.create(paste0(path_comb_gpm), showWarnings = FALSE) +path_comb_gpm +path_comb_gpm_sr = paste0(path_data, "/100_comb_gpm_sr/") +path_model_gpm_sr = paste0(path_data, "/200_model_gpm_sr/") +dir.create(paste0(path_comb_gpm_sr), showWarnings = FALSE) +saveRDS(comb, file = paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) +comb +comb +m1 = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled_modell.rds")) +m1 = readRDS(paste0(path_model_gpm_sr, "ki_hyperspec_biodiv_non_scaled_modell.rds")) +m2 = readRDS(paste0(path_model_gpm_sr, "ki_hyperspec_biodiv_non_scaled_modell_rf.rds")) +m1@model$pls_ffs[[1]][[1]]$model +m2@model$pls_ffs[[1]][[1]]$model +m2@model[[1]][[1]][[1]]$model +m2@model[[1]][[1]][[1]]$model$pred +m2@model[[1]][[1]][[1]]$model$finalModel$importance +m1@model[[1]][[1]][[1]]$model$finalModel$importance +m1@model[[1]][[1]][[1]]$model$finalModel$coefficients +m1@model[[1]][[1]][[1]]$model$finalModel$loadings +m1@model[[1]][[1]][[1]]$model +m1@model[[1]][[1]][[1]]$model$finalModel$loadings +m2@model[[1]][[1]][[1]]$model$finalModel$importance +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +if(length(showConnections()) == 0){ +cores = 3 +cl = parallel::makeCluster(cores) +doParallel::registerDoParallel(cl) } -# Copy RMD figures -rmd_image_folder = dirname(files[grep("rmd_images", files)]) -target_folder = paste0(substr(rmd_image_folder[1], 1, gregexpr(pattern ='staging', rmd_image_folder[1])[[1]][1]-1), -"docs/assets/images/rmd_images/") -dir.create(target_folder, showWarnings = FALSE) -for(f in rmd_image_folder){ -file.copy(from=f, to=target_folder, -overwrite = TRUE, recursive = TRUE, -copy.mode = TRUE) +dir.create(paste0(path_model_gpm_sr), showWarnings = FALSE) +comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) +comb@meta$input$RESPONSE_FINAL = "SRsnails" +comb@data$input = comb@data$input[complete.cases(comb@data$input[, c(comb@meta$input$RESPONSE_FINAL, comb@meta$input$PREDICTOR_FINAL)]), ] +comb = createIndexFolds(x = comb, nested_cv = FALSE) +comb@meta$input$PREDICTOR_FINAL +comb@meta$input$PREDICTOR_FINAL[, -seq(7)] +comb@meta$input$PREDICTOR_FINAL[, -c(1:7)] +comb@meta$input$PREDICTOR_FINAL[-c(1:7)] +comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR_FINAL[-c(1:7)] +comb = trainModel(x = comb, +metric = "RMSE", +n_var = NULL, +mthd = "rf", +mode = "ffs", +seed_nbr = 11, +cv_nbr = NULL, +var_selection = "indv", +filepath_tmp = NULL) +saveRDS(comb, file = paste0(path_model_gpm_sr, "ki_hyperspec_biodiv_non_scaled_modell_rf_rs_only.rds")) +comb@model[[1]][[1]][[1]]$model +comb@model[[1]][[1]][[2]]$model +comb@model[[1]][[2]][[1]]$model +comb@model[[1]][[1]][[1]]$model +comb@model[[1]][[1]][[1]]$model$results +comb@meta$input$TRAIN_TEST +comb@model[[1]][[1]][[1]]$model$finalModel +comb@model[[1]][[1]][[1]]$model +comb@model[[1]][[1]][[1]]$model$metric +comb@model[[1]][[1]][[1]]$model$resample +comb@model[[1]][[1]][[1]]$model +comb@model[[1]][[1]][[1]]$model$resample +comb@model[[1]][[1]][[1]]$model$resample[comb@model[[1]][[1]][[1]]$model$resample$mtry == 3,] +summary(comb@model[[1]][[1]][[1]]$model$resample[comb@model[[1]][[1]][[1]]$model$resample$mtry == 3,]) +comb@model[[1]][[1]][[1]]$model +comb@model[[1]][[1]][[1]]$model$perfNames +comb@model[[1]][[1]][[1]]$model$selectedvars +comb@model[[1]][[1]][[1]]$model$selectedvars_perf_SE +comb@model[[1]][[1]][[1]]$model$selectedvars_perf +comb@model[[1]][[1]][[1]]$model$levels +comb@model[[1]][[1]][[1]]$model$finalModel +comb@model[[1]][[1]][[1]]$model$finalModel$importance +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +if(length(showConnections()) == 0){ +cores = 3 +cl = parallel::makeCluster(cores) +doParallel::registerDoParallel(cl) } -# Clean up -unlink(rmd_image_folder, recursive = TRUE) -file.remove(md_files) -html_files = files[grep("\\.html$", files)] -file.remove(html_files) +comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) +comb@meta$input$RESPONSE_FINAL +r = comb@meta$input$RESPONSE_FINAL[[1 +]] +r +comb@meta$input$RESPONSE +comb@meta$input$RESPONSE_FINAL = r +comb@data$input = comb@data$input[complete.cases(comb@data$input[, c(comb@meta$input$RESPONSE_FINAL, comb@meta$input$PREDICTOR_FINAL)]), ] +comb@meta$input$RESPONSE_FINAL +nrow(comb@data$input) +comb@meta$input$PREDICTOR +comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[-c(1:7)] +comb@meta$input$PREDICTOR_FINAL +comb +r +paste0(path_model_gpm_sr, +"ki_hyperspec_biodiv_non_scaled_modell_rf_rs_only_", +r, +".rds") +path_model_gpm_sr +hd_files = c(list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE), +list.files(path_hyp_kmdc, recursive = FALSE, full.names = TRUE), +list.files(path_hyp_glcm, recursive = FALSE, full.names = TRUE), +list.files(path_hyp_raoq, recursive = FALSE, full.names = TRUE)) +hd_files +grp = list(grep("vegidcs.rds", hd_files), +grep("vegidcs_raoq_3.rds", hd_files), +grep("vegidcs_kmdc.rds", hd_files), +grep("vegidcs_kmdc_glcm.rds", hd_files), +grep("vegidcs_kmdc_raoq_3.rds", hd_files), +grep("pcai_raoq_3.rds", hd_files), +grep("pcai_kmdc.rds", hd_files), +grep("pcai_kmdc_glcm.rds", hd_files), +grep("pcai_kmdc_raoq_3.rds", hd_files)) +grp +hd_files[grep("cof1", hd_files)] +comb@meta$input$PREDICTOR_FINAL diff --git a/src/000_set_environment.R b/src/000_set_environment.R index e965516..1190760 100644 --- a/src/000_set_environment.R +++ b/src/000_set_environment.R @@ -15,9 +15,10 @@ path_hyp_nrm = paste0(path_data, "/030_hypspec_nrm/") path_hyp_vegidcs = paste0(path_data, "/040_hypspec_vegidcs/") path_hyp_kmdc = paste0(path_data, "/050_hypspec_kmdc/") path_hyp_raoq = paste0(path_data, "/060_hypspec_raoq/") -path_hyp_pred = paste0(path_data, "/070_hypspec_pred/") -path_comb_gpm = paste0(path_data, "/075_comb_gpm/") -path_model_gpm = paste0(path_data, "/080_model_gpm/") +path_hyp_glcm = paste0(path_data, "/070_hypspec_glcm/") +path_hyp_pred = paste0(path_data, "/090_hypspec_pred/") +path_comb_gpm_sr = paste0(path_data, "/100_comb_gpm_sr/") +path_model_gpm_sr = paste0(path_data, "/200_model_gpm_sr/") path_plots = paste0(path_data, "/plots/") path_rdata = paste0(path_data, "/rdata/") diff --git a/src/070_comp_txtr.R b/src/070_comp_txtr.R new file mode 100644 index 0000000..1ffe0b6 --- /dev/null +++ b/src/070_comp_txtr.R @@ -0,0 +1,37 @@ +# Compute texture metrics on mean distance from centroid datasets. + +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") + +dir.create(paste0(path_hyp_glcm), showWarnings = FALSE) + +hd_files = c(list.files(path_hyp_kmdc, recursive = FALSE, full.names = TRUE)) + +h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) + + +windows = c(3, 11, 31) +n_grey = c(32) + +foreach (i = seq(length(hd_files))) %do% { + filename = basename(hd_files[i]) + productid = substr(filename, 1, nchar(filename)-4) + + r = readRDS(hd_files[[i]]) + + txtr_wg = lapply(windows, function(w){ + txtr_g = lapply(n_grey, function(g){ + txtr = glcmTextures(r, kernel_size = w, + stats = c("entropy", "homogeneity", "second_moment"), + n_grey = g, parallel = FALSE) + names(txtr[[1]]) = paste0(productid, "_", names(txtr[[1]]), "_w", sprintf("%02d", w), "_g", sprintf("%02d", g)) + return(txtr) + }) + }) + txtr_wg = stack(unlist(txtr_wg, recursive = TRUE)) + + saveRDS(txtr_wg, file = paste0(path_hyp_glcm, productid, "_glcm.rds")) +} + +# Visually check data +visCheck(datapath = path_hyp_glcm, polygonfile = paste0(path_plots, "BPolygon.shp"), band = 1) + diff --git a/src/080_predict_biodiv.R b/src/080_predict_biodiv.R deleted file mode 100644 index 0444e05..0000000 --- a/src/080_predict_biodiv.R +++ /dev/null @@ -1,33 +0,0 @@ -# Combine hyperspectral predictores and biodiversity variables in gpm class. - -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -if(length(showConnections()) == 0){ - cores = 3 - cl = parallel::makeCluster(cores) - doParallel::registerDoParallel(cl) -} - -dir.create(paste0(path_model_gpm), showWarnings = FALSE) - -comb = readRDS(paste0(path_comb_gpm, "ki_hyperspec_biodiv_non_scaled.rds")) - -comb@meta$input$RESPONSE_FINAL = "SRsnails" -comb@data$input = comb@data$input[complete.cases(comb@data$input[, c(comb@meta$input$RESPONSE_FINAL, comb@meta$input$PREDICTOR_FINAL)]), ] - -comb = createIndexFolds(x = comb, nested_cv = FALSE) - -comb = trainModel(x = comb, - metric = "RMSE", - n_var = NULL, - mthd = "rf", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - -saveRDS(comb, file = paste0(path_comb_gpm, "ki_hyperspec_biodiv_non_scaled_modell_rf.rds")) - -# saveRDS(comb, file = paste0(path_comb_gpm, "ki_hyperspec_biodiv_non_scaled_modell.rds")) - -stopCluster(cl) \ No newline at end of file diff --git a/src/070_combine_predictors.R b/src/090_combine_predictors.R similarity index 90% rename from src/070_combine_predictors.R rename to src/090_combine_predictors.R index 284c50d..fd8a4e6 100644 --- a/src/070_combine_predictors.R +++ b/src/090_combine_predictors.R @@ -11,6 +11,7 @@ dir.create(paste0(path_hyp_pred), showWarnings = FALSE) hd_files = c(list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE), list.files(path_hyp_kmdc, recursive = FALSE, full.names = TRUE), + list.files(path_hyp_glcm, recursive = FALSE, full.names = TRUE), list.files(path_hyp_raoq, recursive = FALSE, full.names = TRUE)) h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) @@ -36,11 +37,13 @@ preds = foreach (i = seq(length(hd_files))) %do% { } grp = list(grep("vegidcs.rds", hd_files), - grep("vegidcs_kmdc.rds", hd_files), grep("vegidcs_raoq_3.rds", hd_files), + grep("vegidcs_kmdc.rds", hd_files), + grep("vegidcs_kmdc_glcm.rds", hd_files), grep("vegidcs_kmdc_raoq_3.rds", hd_files), - grep("pcai_kmdc.rds", hd_files), grep("pcai_raoq_3.rds", hd_files), + grep("pcai_kmdc.rds", hd_files), + grep("pcai_kmdc_glcm.rds", hd_files), grep("pcai_kmdc_raoq_3.rds", hd_files)) if(length(unlist(grp)) == length(preds)){ diff --git a/src/075_combine_predictores_biodiv.R b/src/100_combine_predictores_biodiv_sr.R similarity index 90% rename from src/075_combine_predictores_biodiv.R rename to src/100_combine_predictores_biodiv_sr.R index eb402db..bc85f57 100644 --- a/src/075_combine_predictores_biodiv.R +++ b/src/100_combine_predictores_biodiv_sr.R @@ -33,6 +33,6 @@ meta <- createGPMMeta(comb, type = "input", comb <- gpm(comb, meta, scale = FALSE) -dir.create(paste0(path_comb_gpm), showWarnings = FALSE) +dir.create(paste0(path_comb_gpm_sr), showWarnings = FALSE) -saveRDS(comb, file = paste0(path_comb_gpm, "ki_hyperspec_biodiv_non_scaled.rds")) +saveRDS(comb, file = paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) diff --git a/src/076_combine_predictores_biodiv_tlevel.R b/src/120_combine_predictores_biodiv_tlevel.R similarity index 99% rename from src/076_combine_predictores_biodiv_tlevel.R rename to src/120_combine_predictores_biodiv_tlevel.R index 5b32256..3b31c5b 100644 --- a/src/076_combine_predictores_biodiv_tlevel.R +++ b/src/120_combine_predictores_biodiv_tlevel.R @@ -25,6 +25,13 @@ trophic_levels = rbind(data.frame(tlevel = "Plants", data.frame(tlevel = "Generalist", groups = c("SRmammals", "SRanimals", "SRsyrphids", "SRants", "SSRsnails"))) +head(comb) + + + + + + comb$SelCat = substr(as.character(comb$plotID), 1, 3) comb$SelNbr = substr(as.character(comb$plotID), 4, 4) diff --git a/src/200_predict_biodiv_sr.R b/src/200_predict_biodiv_sr.R new file mode 100644 index 0000000..1a6ae20 --- /dev/null +++ b/src/200_predict_biodiv_sr.R @@ -0,0 +1,41 @@ +# Combine hyperspectral predictores and biodiversity variables in gpm class. + +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +if(length(showConnections()) == 0){ + cores = 3 + cl = parallel::makeCluster(cores) + doParallel::registerDoParallel(cl) +} + +dir.create(paste0(path_model_gpm_sr), showWarnings = FALSE) + +comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) +comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[-c(1:7)] + +lapply(comb@meta$input$RESPONSE, function(r){ + comb@meta$input$RESPONSE_FINAL = r + comb@data$input = comb@data$input[complete.cases(comb@data$input[, c(comb@meta$input$RESPONSE_FINAL, comb@meta$input$PREDICTOR_FINAL)]), ] + comb = createIndexFolds(x = comb, nested_cv = FALSE) + comb = trainModel(x = comb, + metric = "RMSE", + n_var = NULL, + mthd = "rf", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + saveRDS(comb, file = paste0(path_model_gpm_sr, + "ki_hs_bd_sr_non_scaled_rf_rso_", + r, + ".rds")) +}) + + + + + + +# saveRDS(comb, file = paste0(path_model_gpm_sr, "ki_hyperspec_biodiv_non_scaled_modell.rds")) + +stopCluster(cl) \ No newline at end of file From 39d211d02e377e2ccae82cce824aa5465f7cd045 Mon Sep 17 00:00:00 2001 From: tnauss Date: Fri, 19 Oct 2018 08:19:31 +0200 Subject: [PATCH 19/65] Update pathes --- src/000_set_environment.R | 2 +- src/200_predict_biodiv_sr.R | 6 +++++- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/src/000_set_environment.R b/src/000_set_environment.R index 1190760..86a9fff 100644 --- a/src/000_set_environment.R +++ b/src/000_set_environment.R @@ -2,7 +2,7 @@ if(Sys.info()["sysname"] == "Windows"){ filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/" } else { - filepath_base = "/media/permanent/active/KI-Hyperspec/" + filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/" } filepath_source = paste0(filepath_base, "HySpec_KiLi/src/001_functions.R") diff --git a/src/200_predict_biodiv_sr.R b/src/200_predict_biodiv_sr.R index 1a6ae20..398fcee 100644 --- a/src/200_predict_biodiv_sr.R +++ b/src/200_predict_biodiv_sr.R @@ -1,6 +1,10 @@ # Combine hyperspectral predictores and biodiversity variables in gpm class. +if(Sys.info()["sysname"] == "Windows"){ + filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" +} else { + filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" +} -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") if(length(showConnections()) == 0){ cores = 3 cl = parallel::makeCluster(cores) From 62a5850a9174332694dd8836116faf104ef2c864 Mon Sep 17 00:00:00 2001 From: tnauss Date: Fri, 19 Oct 2018 08:29:16 +0200 Subject: [PATCH 20/65] Update src/200_predict_biodiv_sr.R --- src/200_predict_biodiv_sr.R | 1 + 1 file changed, 1 insertion(+) diff --git a/src/200_predict_biodiv_sr.R b/src/200_predict_biodiv_sr.R index 398fcee..226d5a3 100644 --- a/src/200_predict_biodiv_sr.R +++ b/src/200_predict_biodiv_sr.R @@ -4,6 +4,7 @@ if(Sys.info()["sysname"] == "Windows"){ } else { filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" } +source(filepath_base) if(length(showConnections()) == 0){ cores = 3 From fe94e5462c3fd47348961838424efedf420800aa Mon Sep 17 00:00:00 2001 From: tnauss Date: Fri, 19 Oct 2018 17:08:38 +0200 Subject: [PATCH 21/65] Update --- src/.Rhistory | 10 +++++----- src/200_predict_biodiv_sr.R | 2 +- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/.Rhistory b/src/.Rhistory index 4e8db1d..092b40a 100644 --- a/src/.Rhistory +++ b/src/.Rhistory @@ -1,8 +1,3 @@ -stack(unlist(txtr_gw, recursive = TRUE)) -names(stack(unlist(txtr_gw, recursive = TRUE))) -txtr_wg = lapply(windows, function(w){ -txtr_g = lapply(n_grey, function(g){ -txtr = glcmTextures(r, kernel_size = w, stats = c("entropy", "homogeneity", "second_moment"), n_grey = g) names(txtr[[1]]) = paste0(productid, "_", names(txtr[[1]]), "_w", sprintf("%02d", w), "_g", sprintf("%02d", g)) @@ -510,3 +505,8 @@ grep("pcai_kmdc_raoq_3.rds", hd_files)) grp hd_files[grep("cof1", hd_files)] comb@meta$input$PREDICTOR_FINAL +filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" +path_model_gpm_sr +path_model_gpm_sr +filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" +path_model_gpm_sr diff --git a/src/200_predict_biodiv_sr.R b/src/200_predict_biodiv_sr.R index 226d5a3..060a63a 100644 --- a/src/200_predict_biodiv_sr.R +++ b/src/200_predict_biodiv_sr.R @@ -2,7 +2,7 @@ if(Sys.info()["sysname"] == "Windows"){ filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" } else { - filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" + filepath_base = "/mnt/sd19006/data/users/tnauss/HySpec_KiLi/src/000_set_environment.R" } source(filepath_base) From 760dbb507ba969dd2224f0a6838e242f7bb1fab0 Mon Sep 17 00:00:00 2001 From: tnauss Date: Fri, 19 Oct 2018 17:31:20 +0200 Subject: [PATCH 22/65] Update --- src/000_set_environment_linux.R | 67 +++++++++++++++++++++++++++++++++ src/200_predict_biodiv_sr.R | 2 +- 2 files changed, 68 insertions(+), 1 deletion(-) create mode 100644 src/000_set_environment_linux.R diff --git a/src/000_set_environment_linux.R b/src/000_set_environment_linux.R new file mode 100644 index 0000000..e0c974d --- /dev/null +++ b/src/000_set_environment_linux.R @@ -0,0 +1,67 @@ +# Set path --------------------------------------------------------------------- +if(Sys.info()["sysname"] == "Windows"){ + filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/" +} else { + filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/" +} + +filepath_source = paste0(filepath_base, "HySpec_KiLi/src/001_functions.R") +path_data = paste0(filepath_base, "/data/") +path_biodiv = paste0(path_data, "/biodiv/") + +path_hyp_org = paste0(path_data, "/020_hypspec_org/") +path_hyp_aio = paste0(path_data, "/025_hypspec_aio/") +path_hyp_nrm = paste0(path_data, "/030_hypspec_nrm/") +path_hyp_vegidcs = paste0(path_data, "/040_hypspec_vegidcs/") +path_hyp_kmdc = paste0(path_data, "/050_hypspec_kmdc/") +path_hyp_raoq = paste0(path_data, "/060_hypspec_raoq/") +path_hyp_glcm = paste0(path_data, "/070_hypspec_glcm/") +path_hyp_pred = paste0(path_data, "/090_hypspec_pred/") +path_comb_gpm_sr = paste0(path_data, "/100_comb_gpm_sr/") +path_model_gpm_sr = paste0(path_data, "/200_model_gpm_sr/") + +path_plots = paste0(path_data, "/plots/") +path_rdata = paste0(path_data, "/rdata/") +path_meta = paste0(path_data, "/meta/") +path_temp = paste0(path_data, "/temp/") +path_output = paste0(path_data, "/output/") +path_vis = paste0(path_data, "/vis/") + + +# Set libraries ---------------------------------------------------------------- +library(biodivTools) # devtools::install_github("environmentalinformatics-marburg/biodivTools") +library(CAST) +# library(corrplot) +library(doParallel) +library(grid) +library(gridExtra) +library(gpm) # devtools::install_github("environmentalinformatics-marburg/gpm") +# library(hsdar) +# library(lavaan) +# library(rPointDB) +# library(rgeos) +# library(ggplot2) +# library(mapview) +# library(metTools) # devtools::install_github("environmentalinformatics-marburg/metTools") +library(raster) +# library(RStoolbox) +library(reshape2) +# library(rgdal) +# library(satellite) +# library(satelliteTools) # devtools::install_github("environmentalinformatics-marburg/satelliteTools") +# library(semPlot) +# library(sp) +# library(spacetime) +# library(vegan) +# library(yaml) + +# Other settings --------------------------------------------------------------- +source(filepath_source) + +rasterOptions(tmpdir = path_temp) + +# saga_cmd = "C:/OSGeo4W64/apps/saga-ltr/saga_cmd.exe" +# initOTB("C:/OSGeo4W64/bin/") +# initOTB("C:/OSGeo4W64/OTB-6.2.0-Win64/bin/") + + diff --git a/src/200_predict_biodiv_sr.R b/src/200_predict_biodiv_sr.R index 060a63a..a3502eb 100644 --- a/src/200_predict_biodiv_sr.R +++ b/src/200_predict_biodiv_sr.R @@ -2,7 +2,7 @@ if(Sys.info()["sysname"] == "Windows"){ filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" } else { - filepath_base = "/mnt/sd19006/data/users/tnauss/HySpec_KiLi/src/000_set_environment.R" + filepath_base = "/mnt/sd19006/data/users/tnauss/HySpec_KiLi/src/000_set_environment_linux.R" } source(filepath_base) From a84c81fd7260cfefb0806ab7946a458cc2e0eb33 Mon Sep 17 00:00:00 2001 From: tnauss Date: Fri, 19 Oct 2018 17:32:35 +0200 Subject: [PATCH 23/65] Update src/000_set_environment_linux.R --- src/000_set_environment_linux.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/000_set_environment_linux.R b/src/000_set_environment_linux.R index e0c974d..bd5b933 100644 --- a/src/000_set_environment_linux.R +++ b/src/000_set_environment_linux.R @@ -5,7 +5,7 @@ if(Sys.info()["sysname"] == "Windows"){ filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/" } -filepath_source = paste0(filepath_base, "HySpec_KiLi/src/001_functions.R") +filepath_source = paste0(filepath_base, "src/001_functions.R") path_data = paste0(filepath_base, "/data/") path_biodiv = paste0(path_data, "/biodiv/") From f13edf81343383b430ad8535c0c3719631d2b4dd Mon Sep 17 00:00:00 2001 From: tnauss Date: Fri, 19 Oct 2018 17:36:26 +0200 Subject: [PATCH 24/65] Update src/000_set_environment_linux.R --- src/000_set_environment_linux.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/000_set_environment_linux.R b/src/000_set_environment_linux.R index bd5b933..c23ebf9 100644 --- a/src/000_set_environment_linux.R +++ b/src/000_set_environment_linux.R @@ -2,7 +2,7 @@ if(Sys.info()["sysname"] == "Windows"){ filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/" } else { - filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/" + filepath_base = "/mnt/sd19006/data/users/tnauss/HySpec_KiLi/" } filepath_source = paste0(filepath_base, "src/001_functions.R") From 8c886b46d5facbd41b46b327af3065efe224b4c3 Mon Sep 17 00:00:00 2001 From: tnauss Date: Fri, 19 Oct 2018 17:41:14 +0200 Subject: [PATCH 25/65] Adjust pathes --- src/000_set_environment_linux.R | 4 ++-- src/200_predict_biodiv_sr.R | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/000_set_environment_linux.R b/src/000_set_environment_linux.R index c23ebf9..e0c974d 100644 --- a/src/000_set_environment_linux.R +++ b/src/000_set_environment_linux.R @@ -2,10 +2,10 @@ if(Sys.info()["sysname"] == "Windows"){ filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/" } else { - filepath_base = "/mnt/sd19006/data/users/tnauss/HySpec_KiLi/" + filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/" } -filepath_source = paste0(filepath_base, "src/001_functions.R") +filepath_source = paste0(filepath_base, "HySpec_KiLi/src/001_functions.R") path_data = paste0(filepath_base, "/data/") path_biodiv = paste0(path_data, "/biodiv/") diff --git a/src/200_predict_biodiv_sr.R b/src/200_predict_biodiv_sr.R index a3502eb..815f646 100644 --- a/src/200_predict_biodiv_sr.R +++ b/src/200_predict_biodiv_sr.R @@ -2,7 +2,7 @@ if(Sys.info()["sysname"] == "Windows"){ filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" } else { - filepath_base = "/mnt/sd19006/data/users/tnauss/HySpec_KiLi/src/000_set_environment_linux.R" + filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" } source(filepath_base) From a1623c722a921e154bd52e525d570726dbf1229a Mon Sep 17 00:00:00 2001 From: tnauss Date: Tue, 23 Oct 2018 13:27:36 +0200 Subject: [PATCH 26/65] Changed file --- src/000_set_environment.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/000_set_environment.R b/src/000_set_environment.R index 86a9fff..87a9b76 100644 --- a/src/000_set_environment.R +++ b/src/000_set_environment.R @@ -1,4 +1,4 @@ -# Set path --------------------------------------------------------------------- +# Set path ---------------------------------------------------------------------Kommentar if(Sys.info()["sysname"] == "Windows"){ filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/" } else { From 867fbc2fea7c4399539fc663147a10496b3ffc8d Mon Sep 17 00:00:00 2001 From: tnauss Date: Tue, 23 Oct 2018 13:28:56 +0200 Subject: [PATCH 27/65] Update src/000_set_environment.R --- src/000_set_environment.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/000_set_environment.R b/src/000_set_environment.R index 87a9b76..86a9fff 100644 --- a/src/000_set_environment.R +++ b/src/000_set_environment.R @@ -1,4 +1,4 @@ -# Set path ---------------------------------------------------------------------Kommentar +# Set path --------------------------------------------------------------------- if(Sys.info()["sysname"] == "Windows"){ filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/" } else { From f00f88fa6799acfc2fe1abb694bd44bbc2157923 Mon Sep 17 00:00:00 2001 From: tnauss Date: Thu, 25 Oct 2018 18:30:46 +0200 Subject: [PATCH 28/65] Update --- src/.Rhistory | 512 -------------------------------- src/000_set_environment_linux.R | 1 + src/200_predict_biodiv_sr.R | 85 ++++-- src/300_analyse_biodiv_sr.R | 53 ++++ 4 files changed, 122 insertions(+), 529 deletions(-) delete mode 100644 src/.Rhistory create mode 100644 src/300_analyse_biodiv_sr.R diff --git a/src/.Rhistory b/src/.Rhistory deleted file mode 100644 index 092b40a..0000000 --- a/src/.Rhistory +++ /dev/null @@ -1,512 +0,0 @@ -stats = c("entropy", "homogeneity", "second_moment"), -n_grey = g) -names(txtr[[1]]) = paste0(productid, "_", names(txtr[[1]]), "_w", sprintf("%02d", w), "_g", sprintf("%02d", g)) -return(txtr) -}) -}) -stack(unlist(txtr_gw, recursive = TRUE)) -txtr_wg = lapply(windows, function(w){ -txtr_g = lapply(n_grey, function(g){ -txtr = glcmTextures(r, kernel_size = w, -stats = c("entropy", "homogeneity", "second_moment"), -n_grey = g) -names(txtr[[1]]) = paste0(productid, "_", names(txtr[[1]]), "_w", sprintf("%02d", w), "_g", sprintf("%02d", g)) -return(txtr) -}) -}) -txtr_wg = lapply(windows, function(w){ -txtr_g = lapply(n_grey, function(g){ -txtr = glcmTextures(r, kernel_size = w, -stats = c("entropy", "homogeneity", "second_moment"), -n_grey = g) -names(txtr[[1]]) = paste0(productid, "_", names(txtr[[1]]), "_w", sprintf("%02d", w), "_g", sprintf("%02d", g)) -return(txtr) -}) -}) -stopCluster -stopCluster() -txtr_wg = lapply(windows, function(w){ -txtr_g = lapply(n_grey, function(g){ -txtr = glcmTextures(r, kernel_size = w, -stats = c("entropy", "homogeneity", "second_moment"), -n_grey = g) -names(txtr[[1]]) = paste0(productid, "_", names(txtr[[1]]), "_w", sprintf("%02d", w), "_g", sprintf("%02d", g)) -return(txtr) -}) -}) -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -# if(length(showConnections()) == 0){ -# cores = 2 -# cl = parallel::makeCluster(cores) -# doParallel::registerDoParallel(cl) -# } -dir.create(paste0(path_hyp_txtr), showWarnings = FALSE) -hd_files = c(list.files(path_hyp_kmdc, recursive = FALSE, full.names = TRUE)) -h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) -windows = c(3, 11, 21, 31) -n_grey = c(32, 128) -i = 1 -filename = basename(hd_files[i]) -productid = substr(filename, 1, nchar(filename)-4) -r = readRDS(hd_files[[i]]) -txtr_wg = lapply(windows, function(w){ -txtr_g = lapply(n_grey, function(g){ -txtr = glcmTextures(r, kernel_size = w, -stats = c("entropy", "homogeneity", "second_moment"), -n_grey = g) -names(txtr[[1]]) = paste0(productid, "_", names(txtr[[1]]), "_w", sprintf("%02d", w), "_g", sprintf("%02d", g)) -return(txtr) -}) -}) -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -# if(length(showConnections()) == 0){ -# cores = 2 -# cl = parallel::makeCluster(cores) -# doParallel::registerDoParallel(cl) -# } -dir.create(paste0(path_hyp_txtr), showWarnings = FALSE) -hd_files = c(list.files(path_hyp_kmdc, recursive = FALSE, full.names = TRUE)) -h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) -windows = c(3, 11, 21, 31) -n_grey = c(32, 128) -i = 1 -filename = basename(hd_files[i]) -productid = substr(filename, 1, nchar(filename)-4) -r = readRDS(hd_files[[i]]) -txtr_wg = lapply(windows, function(w){ -txtr_g = lapply(n_grey, function(g){ -txtr = glcmTextures(r, kernel_size = w, -stats = c("entropy", "homogeneity", "second_moment"), -n_grey = g) -names(txtr[[1]]) = paste0(productid, "_", names(txtr[[1]]), "_w", sprintf("%02d", w), "_g", sprintf("%02d", g)) -return(txtr) -}) -}) -txtr_wg -stack(unlist(txtr_gw, recursive = TRUE)) -txtr_gw -txtr_g -txtr_wg -stack(unlist(txtr_wg, recursive = TRUE)) -plot(txtr_wg) -txtr_wg = stack(unlist(txtr_wg, recursive = TRUE)) -plot(txtr_wg) -windows = c(3, 11, 21, 31, 41) -n_grey = c(32) -txtr_wg = lapply(windows, function(w){ -txtr_g = lapply(n_grey, function(g){ -txtr = glcmTextures(r, kernel_size = w, -stats = c("entropy", "homogeneity", "second_moment"), -n_grey = g) -names(txtr[[1]]) = paste0(productid, "_", names(txtr[[1]]), "_w", sprintf("%02d", w), "_g", sprintf("%02d", g)) -return(txtr) -}) -}) -txtr_wg = stack(unlist(txtr_wg, recursive = TRUE)) -plot(txtr_wg) -hd_files -plot(r) -plot(txtr_wg[[1]]) -plot(txtr_wg[[4]]) -plot(txtr_wg[[5]]) -mean(getValues(r), na.rm = TRUE) -sd(getValues(r), na.rm = TRUE)/mean(getValues(r), na.rm = TRUE) -sd(getValues(txtr_wg[[1]]), na.rm = TRUE)/mean(getValues(txtr_wg[[1]]), na.rm = TRUE) -sd(getValues(txtr_wg[[2]]), na.rm = TRUE)/mean(getValues(txtr_wg[[2]]), na.rm = TRUE) -sd(getValues(txtr_wg[[3]]), na.rm = TRUE)/mean(getValues(txtr_wg[[3]]), na.rm = TRUE) -t = as.data.frame(txtr_wg) -dim(t) -as.matrix(t) -cor(s.matrix(t)) -cor(as.matrix(t)) -c = cor(as.matrix(t)) -dim(c) -library(corrplot) -corrplot(c) -c = cor(as.matrix(t), na.rm = TRUE) -c = cor(as.matrix(t), ommit.na = TRUE) -?cor -c = cor(as.matrix(t), na.rm = TRUE) -m = as.matrix(t) -c = cor(m, na.rm = TRUE) -m = as.matrix(complete.cases(t)) -c = cor(m, na.rm = TRUE) -c = cor(m) -corrplot(c) -t -t[complete.cases(t)] -t[complete.cases(t),] -corrplot(cor(as.matric(t[complete.cases(t),]))) -corrplot(cor(as.matrix(t[complete.cases(t),]))) -windows = c(3, 11, 21, 31) -n_grey = c(32, 64) -txtr_wg = lapply(windows, function(w){ -txtr_g = lapply(n_grey, function(g){ -txtr = glcmTextures(r, kernel_size = w, -stats = c("entropy", "homogeneity", "second_moment"), -n_grey = g) -names(txtr[[1]]) = paste0(productid, "_", names(txtr[[1]]), "_w", sprintf("%02d", w), "_g", sprintf("%02d", g)) -return(txtr) -}) -}) -txtr_wg = stack(unlist(txtr_wg, recursive = TRUE)) -corrplot(cor(as.matric(t[complete.cases(t),]))) -corrplot(cor(as.matrix(t[complete.cases(t),]))) -windows = c(3, 11, 21, 31) -n_grey = c(32, 64) -txtr_wg = lapply(windows, function(w){ -txtr_g = lapply(n_grey, function(g){ -txtr = glcmTextures(r, kernel_size = w, -stats = c("entropy", "homogeneity", "second_moment"), -n_grey = g) -names(txtr[[1]]) = paste0(productid, "_", names(txtr[[1]]), "_w", sprintf("%02d", w), "_g", sprintf("%02d", g)) -return(txtr) -}) -}) -txtr_wg = stack(unlist(txtr_wg, recursive = TRUE)) -txtr_wg -stack(unlist(txtr_wg, recursive = TRUE)) -4*2*3 -txtr_wg = stack(unlist(txtr_wg, recursive = TRUE)) -corrplot(cor(as.matrix(txtr_wg))) -corrplot(cor(as.matrix(as.data.frame(txtr_wg)))) -corrplot(cor(as.matrix(t[complete.cases(t),]))) -t = as.data.frame(txtr_wg) -corrplot(cor(as.matrix(t[complete.cases(t),]))) -11/2 -31/2 -3/2 -txtr_wg -path_hyp_txtr -productid -names(txtr_wg) -# Set path --------------------------------------------------------------------- -if(Sys.info()["sysname"] == "Windows"){ -filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/" -} else { -filepath_base = "/media/permanent/active/KI-Hyperspec/" -} -filepath_source = paste0(filepath_base, "HySpec_KiLi/src/001_functions.R") -path_data = paste0(filepath_base, "/data/") -path_biodiv = paste0(path_data, "/biodiv/") -path_hyp_org = paste0(path_data, "/020_hypspec_org/") -path_hyp_aio = paste0(path_data, "/025_hypspec_aio/") -path_hyp_nrm = paste0(path_data, "/030_hypspec_nrm/") -path_hyp_vegidcs = paste0(path_data, "/040_hypspec_vegidcs/") -path_hyp_kmdc = paste0(path_data, "/050_hypspec_kmdc/") -path_hyp_raoq = paste0(path_data, "/060_hypspec_raoq/") -path_hyp_glcm = paste0(path_data, "/070_hypspec_glcm/") -path_hyp_pred = paste0(path_data, "/090_hypspec_pred/") -path_comb_gpm_sr = paste0(path_data, "/100_comb_gpm_sr/") -path_model_gpm = paste0(path_data, "/200_model_gpm_sr/") -path_plots = paste0(path_data, "/plots/") -path_rdata = paste0(path_data, "/rdata/") -path_meta = paste0(path_data, "/meta/") -path_temp = paste0(path_data, "/temp/") -path_output = paste0(path_data, "/output/") -path_vis = paste0(path_data, "/vis/") -# Set libraries ---------------------------------------------------------------- -library(biodivTools) # devtools::install_github("environmentalinformatics-marburg/biodivTools") -library(CAST) -library(corrplot) -library(doParallel) -library(grid) -library(gridExtra) -library(gpm) # devtools::install_github("environmentalinformatics-marburg/gpm") -library(hsdar) -# library(lavaan) -# library(rPointDB) -library(rgeos) -library(ggplot2) -library(mapview) -# library(metTools) # devtools::install_github("environmentalinformatics-marburg/metTools") -library(raster) -library(RStoolbox) -library(reshape2) -library(rgdal) -# library(satellite) -library(satelliteTools) # devtools::install_github("environmentalinformatics-marburg/satelliteTools") -# library(semPlot) -library(sp) -library(spacetime) -# library(vegan) -# library(yaml) -# Other settings --------------------------------------------------------------- -source(filepath_source) -rasterOptions(tmpdir = path_temp) -saga_cmd = "C:/OSGeo4W64/apps/saga-ltr/saga_cmd.exe" -# initOTB("C:/OSGeo4W64/bin/") -initOTB("C:/OSGeo4W64/OTB-6.2.0-Win64/bin/") -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -dir.create(paste0(path_hyp_glcm), showWarnings = FALSE) -hd_files = c(list.files(path_hyp_kmdc, recursive = FALSE, full.names = TRUE)) -h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) -windows = c(3, 11, 31) -n_grey = c(32) -i = 1 -filename = basename(hd_files[i]) -productid = substr(filename, 1, nchar(filename)-4) -r = readRDS(hd_files[[i]]) -txtr_wg = lapply(windows, function(w){ -txtr_g = lapply(n_grey, function(g){ -txtr = glcmTextures(r, kernel_size = w, -stats = c("entropy", "homogeneity", "second_moment"), -n_grey = g) -names(txtr[[1]]) = paste0(productid, "_", names(txtr[[1]]), "_w", sprintf("%02d", w), "_g", sprintf("%02d", g)) -return(txtr) -}) -}) -txtr_wg = stack(unlist(txtr_wg, recursive = TRUE)) -txtr_wg -paste0(path_hyp_glcm, productid, "_glcm.rds")) -paste0(path_hyp_glcm, productid, "_glcm.rds") -saveRDS(txtr_wg, file = paste0(path_hyp_glcm, productid, "_glcm.rds")) -dir.create(paste0(path_hyp_glcm), showWarnings = FALSE) -hd_files = c(list.files(path_hyp_kmdc, recursive = FALSE, full.names = TRUE)) -h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) -windows = c(3, 11, 31) -n_grey = c(32) -foreach (i = seq(length(hd_files))) %do% { -filename = basename(hd_files[i]) -productid = substr(filename, 1, nchar(filename)-4) -r = readRDS(hd_files[[i]]) -txtr_wg = lapply(windows, function(w){ -txtr_g = lapply(n_grey, function(g){ -txtr = glcmTextures(r, kernel_size = w, -stats = c("entropy", "homogeneity", "second_moment"), -n_grey = g) -names(txtr[[1]]) = paste0(productid, "_", names(txtr[[1]]), "_w", sprintf("%02d", w), "_g", sprintf("%02d", g)) -return(txtr) -}) -}) -txtr_wg = stack(unlist(txtr_wg, recursive = TRUE)) -saveRDS(txtr_wg, file = paste0(path_hyp_glcm, productid, "_glcm.rds")) -} -# Compute texture metrics on mean distance from centroid datasets. -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -# if(length(showConnections()) == 0){ -# cores = 2 -# cl = parallel::makeCluster(cores) -# doParallel::registerDoParallel(cl) -# } -dir.create(paste0(path_hyp_glcm), showWarnings = FALSE) -hd_files = c(list.files(path_hyp_kmdc, recursive = FALSE, full.names = TRUE)) -h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) -windows = c(3, 11, 31) -n_grey = c(32) -foreach (i = seq(length(hd_files))) %do% { -filename = basename(hd_files[i]) -productid = substr(filename, 1, nchar(filename)-4) -r = readRDS(hd_files[[i]]) -txtr_wg = lapply(windows, function(w){ -txtr_g = lapply(n_grey, function(g){ -txtr = glcmTextures(r, kernel_size = w, -stats = c("entropy", "homogeneity", "second_moment"), -n_grey = g, parallel = FALSE) -names(txtr[[1]]) = paste0(productid, "_", names(txtr[[1]]), "_w", sprintf("%02d", w), "_g", sprintf("%02d", g)) -return(txtr) -}) -}) -txtr_wg = stack(unlist(txtr_wg, recursive = TRUE)) -saveRDS(txtr_wg, file = paste0(path_hyp_glcm, productid, "_glcm.rds")) -} -# Visually check data -visCheck(datapath = path_hyp_glcm, polygonfile = paste0(path_plots, "BPolygon.shp"), band = 1) -dir.create(paste0(path_hyp_pred), showWarnings = FALSE) -hd_files = c(list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE), -list.files(path_hyp_kmdc, recursive = FALSE, full.names = TRUE), -list.files(path_hyp_glcm, recursive = FALSE, full.names = TRUE), -list.files(path_hyp_raoq, recursive = FALSE, full.names = TRUE)) -h_meta = readRDS(paste0(path_meta, "hyp_meta.rds")) -if(length(showConnections()) == 0){ -cores = 3 -cl = parallel::makeCluster(cores) -doParallel::registerDoParallel(cl) -} -preds = foreach (i = seq(length(hd_files))) %do% { -print(i) -r = readRDS(hd_files[[i]]) -nms = names(r) -plotid = substr(nms[1], 1, 4) -productid = substr(nms, 6, nchar(nms)) -l = lapply(seq(nlayers(r)), function(l){ -df = data.frame(mean(getValues(r[[l]]), na.rm = TRUE), sd(getValues(r[[l]]), na.rm = TRUE)) -colnames(df) = c(paste0(productid[l], c("_mean", "_sd"))) -return(df) -}) -df = do.call("cbind", l) -df = data.frame(plotID = plotid, df) -return(df) -} -grep("pcai_kmdc_glcm.rds", hd_files) -grep("vegidcs_kmdc_glcm.rds", hd_files) -grp = list(grep("vegidcs.rds", hd_files), -grep("vegidcs_raoq_3.rds", hd_files), -grep("vegidcs_kmdc.rds", hd_files), -grep("vegidcs_kmdc_glcm.rds", hd_files), -grep("vegidcs_kmdc_raoq_3.rds", hd_files), -grep("pcai_raoq_3.rds", hd_files), -grep("pcai_kmdc.rds", hd_files), -grep("pcai_kmdc_glcm.rds", hd_files), -grep("pcai_kmdc_raoq_3.rds", hd_files)) -length(unlist(grp)) == length(preds) -if(length(unlist(grp)) == length(preds)){ -df = lapply(grp, function(g){ -do.call("rbind", preds[g]) -}) -df = do.call("cbind", df) -df = df[, -grep("plotID", colnames(df))[-1]] -} -saveRDS(df, file = paste0(path_hyp_pred, "hyperspec_preds.rds")) -head(df) -complete.cases(df, file = paste0(path_hyp_pred, "hyperspec_preds.rds")) -complete.cases(df) -all(complete.cases(df)) -dim(df) -stopCluster(cl) -# Visually check data -corrplot(cor(df[, -1])) -?corrplot -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -path_hyp_pred -preds = readRDS(paste0(path_hyp_pred, "hyperspec_preds.rds")) -bd = readRDS(paste0(path_biodiv, "biodiv.rds")) -comb = merge(bd, preds, by = c("plotID"), all.x = TRUE, all.y = TRUE) -comb$SelCat = substr(as.character(comb$plotID), 1, 3) -comb$SelNbr = substr(as.character(comb$plotID), 4, 4) -col_selector = which(names(comb) %in% c("SelCat", "SelNbr")) -col_diversity = seq(which("SRmammals" == colnames(comb)), -which("SRallplants" == colnames(comb))) -colnames(comb) -col_precitors = c(which("elevation" == colnames(comb)), -seq(which("lui_biomass_removal" == colnames(comb)), -which("lui" == colnames(comb))), -seq(which("CARI_mean" == colnames(comb)), -which("pcai_kmdc_raoq_sd" == colnames(comb)))) -which(!seq(ncol(comb)) %in% c(col_selector, col_diversity, col_precitors)) -col_meta = which(!seq(ncol(comb)) %in% c(col_selector, col_diversity, col_precitors)) -meta <- createGPMMeta(comb, type = "input", -selector = col_selector, -response = col_diversity, -predictor = col_precitors, -meta = col_meta) -comb <- gpm(comb, meta, scale = FALSE) -dir.create(paste0(path_comb_gpm), showWarnings = FALSE) -path_comb_gpm -path_comb_gpm_sr = paste0(path_data, "/100_comb_gpm_sr/") -path_model_gpm_sr = paste0(path_data, "/200_model_gpm_sr/") -dir.create(paste0(path_comb_gpm_sr), showWarnings = FALSE) -saveRDS(comb, file = paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) -comb -comb -m1 = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled_modell.rds")) -m1 = readRDS(paste0(path_model_gpm_sr, "ki_hyperspec_biodiv_non_scaled_modell.rds")) -m2 = readRDS(paste0(path_model_gpm_sr, "ki_hyperspec_biodiv_non_scaled_modell_rf.rds")) -m1@model$pls_ffs[[1]][[1]]$model -m2@model$pls_ffs[[1]][[1]]$model -m2@model[[1]][[1]][[1]]$model -m2@model[[1]][[1]][[1]]$model$pred -m2@model[[1]][[1]][[1]]$model$finalModel$importance -m1@model[[1]][[1]][[1]]$model$finalModel$importance -m1@model[[1]][[1]][[1]]$model$finalModel$coefficients -m1@model[[1]][[1]][[1]]$model$finalModel$loadings -m1@model[[1]][[1]][[1]]$model -m1@model[[1]][[1]][[1]]$model$finalModel$loadings -m2@model[[1]][[1]][[1]]$model$finalModel$importance -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -if(length(showConnections()) == 0){ -cores = 3 -cl = parallel::makeCluster(cores) -doParallel::registerDoParallel(cl) -} -dir.create(paste0(path_model_gpm_sr), showWarnings = FALSE) -comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) -comb@meta$input$RESPONSE_FINAL = "SRsnails" -comb@data$input = comb@data$input[complete.cases(comb@data$input[, c(comb@meta$input$RESPONSE_FINAL, comb@meta$input$PREDICTOR_FINAL)]), ] -comb = createIndexFolds(x = comb, nested_cv = FALSE) -comb@meta$input$PREDICTOR_FINAL -comb@meta$input$PREDICTOR_FINAL[, -seq(7)] -comb@meta$input$PREDICTOR_FINAL[, -c(1:7)] -comb@meta$input$PREDICTOR_FINAL[-c(1:7)] -comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR_FINAL[-c(1:7)] -comb = trainModel(x = comb, -metric = "RMSE", -n_var = NULL, -mthd = "rf", -mode = "ffs", -seed_nbr = 11, -cv_nbr = NULL, -var_selection = "indv", -filepath_tmp = NULL) -saveRDS(comb, file = paste0(path_model_gpm_sr, "ki_hyperspec_biodiv_non_scaled_modell_rf_rs_only.rds")) -comb@model[[1]][[1]][[1]]$model -comb@model[[1]][[1]][[2]]$model -comb@model[[1]][[2]][[1]]$model -comb@model[[1]][[1]][[1]]$model -comb@model[[1]][[1]][[1]]$model$results -comb@meta$input$TRAIN_TEST -comb@model[[1]][[1]][[1]]$model$finalModel -comb@model[[1]][[1]][[1]]$model -comb@model[[1]][[1]][[1]]$model$metric -comb@model[[1]][[1]][[1]]$model$resample -comb@model[[1]][[1]][[1]]$model -comb@model[[1]][[1]][[1]]$model$resample -comb@model[[1]][[1]][[1]]$model$resample[comb@model[[1]][[1]][[1]]$model$resample$mtry == 3,] -summary(comb@model[[1]][[1]][[1]]$model$resample[comb@model[[1]][[1]][[1]]$model$resample$mtry == 3,]) -comb@model[[1]][[1]][[1]]$model -comb@model[[1]][[1]][[1]]$model$perfNames -comb@model[[1]][[1]][[1]]$model$selectedvars -comb@model[[1]][[1]][[1]]$model$selectedvars_perf_SE -comb@model[[1]][[1]][[1]]$model$selectedvars_perf -comb@model[[1]][[1]][[1]]$model$levels -comb@model[[1]][[1]][[1]]$model$finalModel -comb@model[[1]][[1]][[1]]$model$finalModel$importance -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -if(length(showConnections()) == 0){ -cores = 3 -cl = parallel::makeCluster(cores) -doParallel::registerDoParallel(cl) -} -comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) -comb@meta$input$RESPONSE_FINAL -r = comb@meta$input$RESPONSE_FINAL[[1 -]] -r -comb@meta$input$RESPONSE -comb@meta$input$RESPONSE_FINAL = r -comb@data$input = comb@data$input[complete.cases(comb@data$input[, c(comb@meta$input$RESPONSE_FINAL, comb@meta$input$PREDICTOR_FINAL)]), ] -comb@meta$input$RESPONSE_FINAL -nrow(comb@data$input) -comb@meta$input$PREDICTOR -comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[-c(1:7)] -comb@meta$input$PREDICTOR_FINAL -comb -r -paste0(path_model_gpm_sr, -"ki_hyperspec_biodiv_non_scaled_modell_rf_rs_only_", -r, -".rds") -path_model_gpm_sr -hd_files = c(list.files(path_hyp_vegidcs, recursive = FALSE, full.names = TRUE), -list.files(path_hyp_kmdc, recursive = FALSE, full.names = TRUE), -list.files(path_hyp_glcm, recursive = FALSE, full.names = TRUE), -list.files(path_hyp_raoq, recursive = FALSE, full.names = TRUE)) -hd_files -grp = list(grep("vegidcs.rds", hd_files), -grep("vegidcs_raoq_3.rds", hd_files), -grep("vegidcs_kmdc.rds", hd_files), -grep("vegidcs_kmdc_glcm.rds", hd_files), -grep("vegidcs_kmdc_raoq_3.rds", hd_files), -grep("pcai_raoq_3.rds", hd_files), -grep("pcai_kmdc.rds", hd_files), -grep("pcai_kmdc_glcm.rds", hd_files), -grep("pcai_kmdc_raoq_3.rds", hd_files)) -grp -hd_files[grep("cof1", hd_files)] -comb@meta$input$PREDICTOR_FINAL -filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" -path_model_gpm_sr -path_model_gpm_sr -filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" -path_model_gpm_sr diff --git a/src/000_set_environment_linux.R b/src/000_set_environment_linux.R index e0c974d..f428570 100644 --- a/src/000_set_environment_linux.R +++ b/src/000_set_environment_linux.R @@ -19,6 +19,7 @@ path_hyp_glcm = paste0(path_data, "/070_hypspec_glcm/") path_hyp_pred = paste0(path_data, "/090_hypspec_pred/") path_comb_gpm_sr = paste0(path_data, "/100_comb_gpm_sr/") path_model_gpm_sr = paste0(path_data, "/200_model_gpm_sr/") +path_analysis_sr = paste0(path_data, "/300_analysis_sr/") path_plots = paste0(path_data, "/plots/") path_rdata = paste0(path_data, "/rdata/") diff --git a/src/200_predict_biodiv_sr.R b/src/200_predict_biodiv_sr.R index 815f646..86c2039 100644 --- a/src/200_predict_biodiv_sr.R +++ b/src/200_predict_biodiv_sr.R @@ -7,7 +7,7 @@ if(Sys.info()["sysname"] == "Windows"){ source(filepath_base) if(length(showConnections()) == 0){ - cores = 3 + cores = 20 cl = parallel::makeCluster(cores) doParallel::registerDoParallel(cl) } @@ -15,13 +15,70 @@ if(length(showConnections()) == 0){ dir.create(paste0(path_model_gpm_sr), showWarnings = FALSE) comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) + + +# Predict with elevation and lui only +comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[c(1,7)] + +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "rf", "CAST")) %dopar% { + + model = comb + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "rf", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr, + "ki_sr_elui_non_scaled_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + + +# Predict with all elevation and lui information only +comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[c(1:7)] + + +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "rf", "CAST")) %dopar% { + + model = comb + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "rf", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr, + "ki_sr_eall_non_scaled_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + +# Predict with hyperspectral data only comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[-c(1:7)] -lapply(comb@meta$input$RESPONSE, function(r){ - comb@meta$input$RESPONSE_FINAL = r - comb@data$input = comb@data$input[complete.cases(comb@data$input[, c(comb@meta$input$RESPONSE_FINAL, comb@meta$input$PREDICTOR_FINAL)]), ] - comb = createIndexFolds(x = comb, nested_cv = FALSE) - comb = trainModel(x = comb, +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "rf", "CAST")) %dopar% { + + model = comb + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, metric = "RMSE", n_var = NULL, mthd = "rf", @@ -30,17 +87,11 @@ lapply(comb@meta$input$RESPONSE, function(r){ cv_nbr = NULL, var_selection = "indv", filepath_tmp = NULL) - saveRDS(comb, file = paste0(path_model_gpm_sr, - "ki_hs_bd_sr_non_scaled_rf_rso_", - r, + + saveRDS(model, file = paste0(path_model_gpm_sr, + "ki_sr_spec_non_scaled_rf_", + model@meta$input$RESPONSE_FINAL, ".rds")) -}) - - - - - - -# saveRDS(comb, file = paste0(path_model_gpm_sr, "ki_hyperspec_biodiv_non_scaled_modell.rds")) +} stopCluster(cl) \ No newline at end of file diff --git a/src/300_analyse_biodiv_sr.R b/src/300_analyse_biodiv_sr.R new file mode 100644 index 0000000..b27c377 --- /dev/null +++ b/src/300_analyse_biodiv_sr.R @@ -0,0 +1,53 @@ +# Combine hyperspectral predictores and biodiversity variables in gpm class. +if(Sys.info()["sysname"] == "Windows"){ + filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" +} else { + filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" +} +source(filepath_base) + +if(length(showConnections()) == 0){ + cores = 3 + cl = parallel::makeCluster(cores) + doParallel::registerDoParallel(cl) +} + +dir.create(path_analysis_sr, showWarnings = FALSE) + + +# Combine all models into one gpm object +model_files = list.files(path_model_gpm_sr, full.names = TRUE) + +all_models = readRDS(model_files[[1]]) +all_models@log = NULL + +for(i in (seq(2, length(model_files)))){ + all_models@model[[1]][[i]] = readRDS(model_files[[i]])@model[[1]][[1]] +} + + + +varImp(all_models@model[[1]][[1]][[1]]$model) + +caret::varImp(all_models@model[[1]][[1]][[1]]$model) + +tune = m@meta$input$RESPONSE_FINAL +perf_mean = m@model[[1]][[1]][[1]]$model$results[m@model[[1]][[1]][[1]]$model$results$mtry == m@model[[1]][[1]][[1]]$model$bestTune[, 1],] +perf_resmpls = m@model[[1]][[1]][[1]]$model$resample +return(data.frame(SR = n, Results = t)) + + +model_files + +ms = do.call("rbind", ms) +ms[, c(1, 4)] + + +varImp(m@model$rf_ffs[[1]][[1]]$model$finalModel$importance) + +var_imp <- compVarImp(m@model, scale = FALSE) +var_imp_scale <- compVarImp(models, scale = TRUE) +plotVarImp(var_imp) +plotVarImpHeatmap(var_imp_scale, xlab = "Species", ylab = "Band") +tstat <- compContTests(models, mean = TRUE) +summary(tstat[[2]]) \ No newline at end of file From 384ce710913904bdabcd78401efe9edf84b9edc8 Mon Sep 17 00:00:00 2001 From: tnauss Date: Thu, 25 Oct 2018 18:45:01 +0200 Subject: [PATCH 29/65] Update src/200_predict_biodiv_sr.R --- src/200_predict_biodiv_sr.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/200_predict_biodiv_sr.R b/src/200_predict_biodiv_sr.R index 86c2039..fb9c002 100644 --- a/src/200_predict_biodiv_sr.R +++ b/src/200_predict_biodiv_sr.R @@ -20,7 +20,7 @@ comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) # Predict with elevation and lui only comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[c(1,7)] -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "rf", "CAST")) %dopar% { +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { model = comb model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] @@ -47,7 +47,7 @@ foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret" comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[c(1:7)] -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "rf", "CAST")) %dopar% { +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { model = comb model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] @@ -72,7 +72,7 @@ foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret" # Predict with hyperspectral data only comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[-c(1:7)] -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "rf", "CAST")) %dopar% { +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { model = comb model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] From 556e04f23213851e786ab1e2e06bdf2448612ea4 Mon Sep 17 00:00:00 2001 From: tnauss Date: Tue, 30 Oct 2018 18:00:16 +0100 Subject: [PATCH 30/65] Update --- ...redictores_biodiv_sr_elevation_residuals.R | 15 +++ src/200_predict_biodiv_sr.R | 55 +++++------ src/300_analyse_biodiv_sr.R | 92 ++++++++++++------- 3 files changed, 102 insertions(+), 60 deletions(-) create mode 100644 src/105_combine_predictores_biodiv_sr_elevation_residuals.R diff --git a/src/105_combine_predictores_biodiv_sr_elevation_residuals.R b/src/105_combine_predictores_biodiv_sr_elevation_residuals.R new file mode 100644 index 0000000..3f69dff --- /dev/null +++ b/src/105_combine_predictores_biodiv_sr_elevation_residuals.R @@ -0,0 +1,15 @@ +# Combine hyperspectral predictores and biodiversity variables in gpm class. + +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") + +comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) + + + + + + + +dir.create(paste0(path_comb_gpm_sr), showWarnings = FALSE) + +saveRDS(comb, file = paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) diff --git a/src/200_predict_biodiv_sr.R b/src/200_predict_biodiv_sr.R index fb9c002..4f59c8d 100644 --- a/src/200_predict_biodiv_sr.R +++ b/src/200_predict_biodiv_sr.R @@ -17,32 +17,6 @@ dir.create(paste0(path_model_gpm_sr), showWarnings = FALSE) comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) -# Predict with elevation and lui only -comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[c(1,7)] - -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { - - model = comb - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "rf", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_elui_non_scaled_rf_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - - # Predict with all elevation and lui information only comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[c(1:7)] @@ -64,7 +38,7 @@ foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret" filepath_tmp = NULL) saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_eall_non_scaled_rf_", + "ki_sr_elui_non_scaled_rf_", model@meta$input$RESPONSE_FINAL, ".rds")) } @@ -94,4 +68,31 @@ foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret" ".rds")) } + +# Predict with all data +comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR + +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { + + model = comb + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "rf", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr, + "ki_sr_elsp_non_scaled_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + + stopCluster(cl) \ No newline at end of file diff --git a/src/300_analyse_biodiv_sr.R b/src/300_analyse_biodiv_sr.R index b27c377..7e17fd2 100644 --- a/src/300_analyse_biodiv_sr.R +++ b/src/300_analyse_biodiv_sr.R @@ -16,38 +16,64 @@ dir.create(path_analysis_sr, showWarnings = FALSE) # Combine all models into one gpm object -model_files = list.files(path_model_gpm_sr, full.names = TRUE) -all_models = readRDS(model_files[[1]]) -all_models@log = NULL -for(i in (seq(2, length(model_files)))){ - all_models@model[[1]][[i]] = readRDS(model_files[[i]])@model[[1]][[1]] -} - - - -varImp(all_models@model[[1]][[1]][[1]]$model) - -caret::varImp(all_models@model[[1]][[1]][[1]]$model) - -tune = m@meta$input$RESPONSE_FINAL -perf_mean = m@model[[1]][[1]][[1]]$model$results[m@model[[1]][[1]][[1]]$model$results$mtry == m@model[[1]][[1]][[1]]$model$bestTune[, 1],] -perf_resmpls = m@model[[1]][[1]][[1]]$model$resample -return(data.frame(SR = n, Results = t)) - - -model_files - -ms = do.call("rbind", ms) -ms[, c(1, 4)] - - -varImp(m@model$rf_ffs[[1]][[1]]$model$finalModel$importance) - -var_imp <- compVarImp(m@model, scale = FALSE) -var_imp_scale <- compVarImp(models, scale = TRUE) -plotVarImp(var_imp) -plotVarImpHeatmap(var_imp_scale, xlab = "Species", ylab = "Band") -tstat <- compContTests(models, mean = TRUE) -summary(tstat[[2]]) \ No newline at end of file +mtypes = c("*elui*", "*eall*", "*spec*") + +mtypes = c("*eall*", "*spec*") + +model_results = lapply(mtypes, function(mt){ + model_files = list.files(path_model_gpm_sr, full.names = TRUE, + pattern = glob2rx(mt)) + + all_models = readRDS(model_files[[1]]) + + for(i in (seq(2, length(model_files)))){ + all_models@model[[1]][[i]] = readRDS(model_files[[i]])@model[[1]][[1]] + } + + smr = lapply(all_models@model[[1]], function(m){ + data.frame(mtype = mt, + resp = m[[1]]$response, + m[[1]]$model$results[m[[1]]$model$results$mtry == + m[[1]]$model$bestTune$mtry,] + ) + }) + smr = do.call("rbind", smr) + return(smr) +}) + +model_results = do.call("rbind", model_results) + +model_results[order(model_results$resp),] + + + + + + + +# varImp(all_models@model[[1]][[1]][[1]]$model) +# +# caret::varImp(all_models@model[[1]][[1]][[1]]$model) +# +# tune = m@meta$input$RESPONSE_FINAL +# perf_mean = m@model[[1]][[1]][[1]]$model$results[m@model[[1]][[1]][[1]]$model$results$mtry == m@model[[1]][[1]][[1]]$model$bestTune[, 1],] +# perf_resmpls = m@model[[1]][[1]][[1]]$model$resample +# return(data.frame(SR = n, Results = t)) +# +# +# model_files +# +# ms = do.call("rbind", ms) +# ms[, c(1, 4)] +# +# +# varImp(m@model$rf_ffs[[1]][[1]]$model$finalModel$importance) +# +# var_imp <- compVarImp(m@model, scale = FALSE) +# var_imp_scale <- compVarImp(models, scale = TRUE) +# plotVarImp(var_imp) +# plotVarImpHeatmap(var_imp_scale, xlab = "Species", ylab = "Band") +# tstat <- compContTests(models, mean = TRUE) +# summary(tstat[[2]]) \ No newline at end of file From 21a78b49acd764f827f0dba0c4669d9ef2c35033 Mon Sep 17 00:00:00 2001 From: tnauss Date: Tue, 30 Oct 2018 20:00:03 +0100 Subject: [PATCH 31/65] Update src/300_analyse_biodiv_sr.R --- src/300_analyse_biodiv_sr.R | 42 ++++++++++++++++++++----------------- 1 file changed, 23 insertions(+), 19 deletions(-) diff --git a/src/300_analyse_biodiv_sr.R b/src/300_analyse_biodiv_sr.R index 7e17fd2..2cb1169 100644 --- a/src/300_analyse_biodiv_sr.R +++ b/src/300_analyse_biodiv_sr.R @@ -16,13 +16,10 @@ dir.create(path_analysis_sr, showWarnings = FALSE) # Combine all models into one gpm object +mtypes = c("*elui*", "*spec*", "*elsp*") -mtypes = c("*elui*", "*eall*", "*spec*") - -mtypes = c("*eall*", "*spec*") - -model_results = lapply(mtypes, function(mt){ +all_models = lapply(mtypes, function(mt){ model_files = list.files(path_model_gpm_sr, full.names = TRUE, pattern = glob2rx(mt)) @@ -32,27 +29,34 @@ model_results = lapply(mtypes, function(mt){ all_models@model[[1]][[i]] = readRDS(model_files[[i]])@model[[1]][[1]] } - smr = lapply(all_models@model[[1]], function(m){ - data.frame(mtype = mt, - resp = m[[1]]$response, - m[[1]]$model$results[m[[1]]$model$results$mtry == - m[[1]]$model$bestTune$mtry,] - ) - }) - smr = do.call("rbind", smr) - return(smr) + return(all_models) + }) +names(all_models) = mtypes + +var_imp <- compVarImp(all_models$`*elui*`@model$rf_ffs, scale = FALSE) +var_imp_scale <- compVarImp(all_models$`*elui*`@model$rf_ffs, scale = TRUE) +plotVarImp(var_imp) +plotVarImpHeatmap(var_imp, xlab = "Species", ylab = "Band") +tstat <- compContTests(models, mean = TRUE) +summary(tstat[[2]]) + +# smr = lapply(all_models@model[[1]], function(m){ +# data.frame(mtype = mt, +# resp = m[[1]]$response, +# m[[1]]$model$results[m[[1]]$model$results$mtry == +# m[[1]]$model$bestTune$mtry,] +# ) +# }) +# smr = do.call("rbind", smr) +# return(smr) + model_results = do.call("rbind", model_results) model_results[order(model_results$resp),] - - - - - # varImp(all_models@model[[1]][[1]][[1]]$model) # # caret::varImp(all_models@model[[1]][[1]][[1]]$model) From c8c72799f14b107b212ea0ac25b9273fb7d6509e Mon Sep 17 00:00:00 2001 From: tnauss Date: Fri, 2 Nov 2018 08:52:40 +0100 Subject: [PATCH 32/65] Add elevation residuals --- src/000_set_environment.R | 2 + src/000_set_environment_linux.R | 2 + ...redictores_biodiv_sr_elevation_residuals.R | 15 --- ...redictores_biodiv_sr_elevation_residuals.R | 47 +++++++++ src/210_predict_biodiv_sr_elev_res.R | 98 +++++++++++++++++++ 5 files changed, 149 insertions(+), 15 deletions(-) delete mode 100644 src/105_combine_predictores_biodiv_sr_elevation_residuals.R create mode 100644 src/110_combine_predictores_biodiv_sr_elevation_residuals.R create mode 100644 src/210_predict_biodiv_sr_elev_res.R diff --git a/src/000_set_environment.R b/src/000_set_environment.R index 86a9fff..21d5db9 100644 --- a/src/000_set_environment.R +++ b/src/000_set_environment.R @@ -18,7 +18,9 @@ path_hyp_raoq = paste0(path_data, "/060_hypspec_raoq/") path_hyp_glcm = paste0(path_data, "/070_hypspec_glcm/") path_hyp_pred = paste0(path_data, "/090_hypspec_pred/") path_comb_gpm_sr = paste0(path_data, "/100_comb_gpm_sr/") +path_comb_gpm_sr_elev_res = paste0(path_data, "/110_comb_gpm_sr_elev_res/") path_model_gpm_sr = paste0(path_data, "/200_model_gpm_sr/") +path_model_gpm_sr_elev_res = paste0(path_data, "/210_model_gpm_sr_elev_res/") path_plots = paste0(path_data, "/plots/") path_rdata = paste0(path_data, "/rdata/") diff --git a/src/000_set_environment_linux.R b/src/000_set_environment_linux.R index f428570..82321d6 100644 --- a/src/000_set_environment_linux.R +++ b/src/000_set_environment_linux.R @@ -18,7 +18,9 @@ path_hyp_raoq = paste0(path_data, "/060_hypspec_raoq/") path_hyp_glcm = paste0(path_data, "/070_hypspec_glcm/") path_hyp_pred = paste0(path_data, "/090_hypspec_pred/") path_comb_gpm_sr = paste0(path_data, "/100_comb_gpm_sr/") +path_comb_gpm_sr_elev_res = paste0(path_data, "/110_comb_gpm_sr_elev_res/") path_model_gpm_sr = paste0(path_data, "/200_model_gpm_sr/") +path_model_gpm_sr_elev_res = paste0(path_data, "/210_model_gpm_sr_elev_res/") path_analysis_sr = paste0(path_data, "/300_analysis_sr/") path_plots = paste0(path_data, "/plots/") diff --git a/src/105_combine_predictores_biodiv_sr_elevation_residuals.R b/src/105_combine_predictores_biodiv_sr_elevation_residuals.R deleted file mode 100644 index 3f69dff..0000000 --- a/src/105_combine_predictores_biodiv_sr_elevation_residuals.R +++ /dev/null @@ -1,15 +0,0 @@ -# Combine hyperspectral predictores and biodiversity variables in gpm class. - -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") - -comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) - - - - - - - -dir.create(paste0(path_comb_gpm_sr), showWarnings = FALSE) - -saveRDS(comb, file = paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) diff --git a/src/110_combine_predictores_biodiv_sr_elevation_residuals.R b/src/110_combine_predictores_biodiv_sr_elevation_residuals.R new file mode 100644 index 0000000..022abf8 --- /dev/null +++ b/src/110_combine_predictores_biodiv_sr_elevation_residuals.R @@ -0,0 +1,47 @@ +# Combine hyperspectral predictores and biodiversity variables in gpm class. + +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") + +if(length(showConnections()) == 0){ + cores = 20 + cl = parallel::makeCluster(cores) + doParallel::registerDoParallel(cl) +} + +comb_elev_res = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) + +comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR[c(1)] + +for (i in seq(length(comb@meta$input$RESPONSE))){ + print(i) + comb_elev_res@meta$input$RESPONSE_FINAL = comb_elev_res@meta$input$RESPONSE[i] + comb_elev_res@data$input = comb_elev_res@data$input[complete.cases(comb_elev_res@data$input[, c(comb_elev_res@meta$input$RESPONSE_FINAL, comb_elev_res@meta$input$PREDICTOR_FINAL)]), ] + comb_elev_res = createIndexFolds(x = comb_elev_res, nested_cv = FALSE) + + + comb_elev_res = trainModel(x = comb_elev_res, + metric = "RMSE", + n_var = NULL, + mthd = "gam", + mode = "none", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + comb_elev_res@model$gam_none[[1]][[1]]$model + + comb_elev_res@data$input[, paste0(comb_elev_res@meta$input$RESPONSE_FINAL, "_elev_res")] = + as.vector(comb_elev_res@data$input[, comb_elev_res@meta$input$RESPONSE_FINAL] - + predict(comb_elev_res@model$gam_none[[1]][[1]]$model, comb_elev_res@data$input)) + +} + +# Remove original biodiversity information and update meta information +comb_elev_res@data$input[, comb_elev_res@meta$input$RESPONSE] = NULL +comb_elev_res@meta$input$RESPONSE = paste0(comb_elev_res@meta$input$RESPONSE, "_elev_res") + +dir.create(paste0(path_comb_gpm_sr_elev_res), showWarnings = FALSE) + +saveRDS(comb_elev_res, file = paste0(path_comb_gpm_sr_elev_res, "ki_hyperspec_biodiv_non_scaled_elev_res.rds")) + diff --git a/src/210_predict_biodiv_sr_elev_res.R b/src/210_predict_biodiv_sr_elev_res.R new file mode 100644 index 0000000..60b156c --- /dev/null +++ b/src/210_predict_biodiv_sr_elev_res.R @@ -0,0 +1,98 @@ +# comb_elev_resine hyperspectral predictores and biodiversity variables in gpm class. +if(Sys.info()["sysname"] == "Windows"){ + filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" +} else { + filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" +} +source(filepath_base) + +if(length(showConnections()) == 0){ + cores = 20 + cl = parallel::makeCluster(cores) + doParallel::registerDoParallel(cl) +} + +dir.create(paste0(path_model_gpm_sr_elev_res), showWarnings = FALSE) + +comb_elev_res = readRDS(paste0(path_comb_gpm_sr_elev_res, "ki_hyperspec_biodiv_non_scaled_elev_res.rds")) + + +# Predict with all elevation and lui information only +comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR[c(1:7)] + + +foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { + + model = comb_elev_res + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "rf", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, + "ki_sr_elui_non_scaled_elev_res_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + +# Predict with hyperspectral data only +comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR[-c(1:7)] + +foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { + + model = comb_elev_res + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "rf", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, + "ki_sr_spec_non_scaled_elev_res_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + + +# Predict with all data +comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR + +foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { + + model = comb_elev_res + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "rf", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, + "ki_sr_elsp_non_scaled_elev_res_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + + +stopCluster(cl) \ No newline at end of file From dfc6044594780d03f931883d37f0f1962039af25 Mon Sep 17 00:00:00 2001 From: tnauss Date: Sun, 18 Nov 2018 19:08:06 +0100 Subject: [PATCH 33/65] Update 010_biodiv_preprocessing.R --- src/010_biodiv_preprocessing.R | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/010_biodiv_preprocessing.R b/src/010_biodiv_preprocessing.R index 9406418..3b98a3c 100644 --- a/src/010_biodiv_preprocessing.R +++ b/src/010_biodiv_preprocessing.R @@ -2,7 +2,7 @@ source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -# Read dataset +# Read species richness dataset bd = read.table(paste0(path_biodiv, "Biodiversity_Data_Marcel.csv"), header = TRUE, sep = ";", dec = ",") @@ -10,5 +10,3 @@ saveRDS(as.character(bd$plotID), file = paste0(path_biodiv, "biodiv_plots.rds")) saveRDS(bd, file = paste0(path_biodiv, "biodiv.rds")) - - From 5a7a9fa55098df8788c8aabd488244519939cdd1 Mon Sep 17 00:00:00 2001 From: "Nauss, Thomas" Date: Mon, 31 Dec 2018 10:08:04 +0100 Subject: [PATCH 34/65] Add gam and pls --- src/000_setup.R | 24 ++++ ...biodiv_sr.R => 200_predict_biodiv_sr_rf.R} | 28 ++++ src/201_predict_biodiv_sr_rf_kmra.R | 50 +++++++ src/202_predict_biodiv_sr_pls.R | 126 +++++++++++++++++ src/204_predict_biodiv_sr_gam.R | 126 +++++++++++++++++ ....R => 210_predict_biodiv_sr_elev_res_rf.R} | 29 ++++ src/211_predict_biodiv_sr_elev_res_rf_kmra.R | 50 +++++++ src/212_predict_biodiv_sr_elev_res_pls.R | 127 ++++++++++++++++++ src/214_predict_biodiv_sr_elev_res_gam.R | 127 ++++++++++++++++++ 9 files changed, 687 insertions(+) create mode 100644 src/000_setup.R rename src/{200_predict_biodiv_sr.R => 200_predict_biodiv_sr_rf.R} (76%) create mode 100644 src/201_predict_biodiv_sr_rf_kmra.R create mode 100644 src/202_predict_biodiv_sr_pls.R create mode 100644 src/204_predict_biodiv_sr_gam.R rename src/{210_predict_biodiv_sr_elev_res.R => 210_predict_biodiv_sr_elev_res_rf.R} (77%) create mode 100644 src/211_predict_biodiv_sr_elev_res_rf_kmra.R create mode 100644 src/212_predict_biodiv_sr_elev_res_pls.R create mode 100644 src/214_predict_biodiv_sr_elev_res_gam.R diff --git a/src/000_setup.R b/src/000_setup.R new file mode 100644 index 0000000..7d5b325 --- /dev/null +++ b/src/000_setup.R @@ -0,0 +1,24 @@ +# Set environment for environmental information systems analysis + +root_folder = path.expand("~/analysis/global_forest_cover/") + +project_folders = c("data/", + "data/biomass_1950_2010/", + "data/biomass_2010_gsv/", + "data/maped_datasets/", + "data/gee_landcover_rainfall/", + "data/tree_water_content/", + "data/tmp/", + "EI-GlobalForestAnalysis/src/") + +libs = c("gdalUtils", "mapview", "raster", "rgdal", "sp") + +envrmt = createEnvi(root_folder = root_folder, folders = project_folders, + path_prefix = "path_", libs = libs, + alt_env_id = "COMPUTERNAME", alt_env_value = "PCRZP", + alt_env_root_folder = "F:\\BEN\\edu") + +# More settings +rasterOptions(tmpdir = envrmt$path_tmp) +mapviewOptions(basemaps = mapviewGetOption("basemaps")[c(3, 1:2, 4:5)]) + diff --git a/src/200_predict_biodiv_sr.R b/src/200_predict_biodiv_sr_rf.R similarity index 76% rename from src/200_predict_biodiv_sr.R rename to src/200_predict_biodiv_sr_rf.R index 4f59c8d..ef73620 100644 --- a/src/200_predict_biodiv_sr.R +++ b/src/200_predict_biodiv_sr_rf.R @@ -95,4 +95,32 @@ foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret" } + +# Predict with kmdc and raoq only +comb@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ + c(grep("kmdc", comb@meta$input$PREDICTOR), + grep("raoq", comb@meta$input$PREDICTOR))]) + + +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { + + model = comb + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "rf", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr, + "ki_sr_kmra_non_scaled_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} stopCluster(cl) \ No newline at end of file diff --git a/src/201_predict_biodiv_sr_rf_kmra.R b/src/201_predict_biodiv_sr_rf_kmra.R new file mode 100644 index 0000000..2ddf81d --- /dev/null +++ b/src/201_predict_biodiv_sr_rf_kmra.R @@ -0,0 +1,50 @@ +# Combine hyperspectral predictores and biodiversity variables in gpm class. +if(Sys.info()["sysname"] == "Windows"){ + filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" +} else { + filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" +} +source(filepath_base) + +if(length(showConnections()) == 0){ + cores = 20 + cl = parallel::makeCluster(cores) + doParallel::registerDoParallel(cl) +} + +dir.create(paste0(path_model_gpm_sr), showWarnings = FALSE) + +comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) + + + + + +# Predict with kmdc and raoq only +comb@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ + c(grep("kmdc", comb@meta$input$PREDICTOR), + grep("raoq", comb@meta$input$PREDICTOR))]) + + +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { + + model = comb + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "rf", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr, + "ki_sr_kmra_non_scaled_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} +stopCluster(cl) \ No newline at end of file diff --git a/src/202_predict_biodiv_sr_pls.R b/src/202_predict_biodiv_sr_pls.R new file mode 100644 index 0000000..4959bc5 --- /dev/null +++ b/src/202_predict_biodiv_sr_pls.R @@ -0,0 +1,126 @@ +# Combine hyperspectral predictores and biodiversity variables in gpm class. +if(Sys.info()["sysname"] == "Windows"){ + filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" +} else { + filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" +} +source(filepath_base) + +if(length(showConnections()) == 0){ + cores = 20 + cl = parallel::makeCluster(cores) + doParallel::registerDoParallel(cl) +} + +dir.create(paste0(path_model_gpm_sr), showWarnings = FALSE) + +comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) + + +# Predict with all elevation and lui information only +comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[c(1:7)] + + +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { + + model = comb + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "pls", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr, + "ki_sr_elui_non_scaled_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + +# Predict with hyperspectral data only +comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[-c(1:7)] + +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { + + model = comb + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "pls", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr, + "ki_sr_spec_non_scaled_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + + +# Predict with all data +comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR + +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { + + model = comb + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "pls", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr, + "ki_sr_elsp_non_scaled_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + + + +# Predict with kmdc and raoq only +comb@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ + c(grep("kmdc", comb@meta$input$PREDICTOR), + grep("raoq", comb@meta$input$PREDICTOR))]) + + +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { + + model = comb + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "pls", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr, + "ki_sr_kmra_non_scaled_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} +stopCluster(cl) \ No newline at end of file diff --git a/src/204_predict_biodiv_sr_gam.R b/src/204_predict_biodiv_sr_gam.R new file mode 100644 index 0000000..f871da2 --- /dev/null +++ b/src/204_predict_biodiv_sr_gam.R @@ -0,0 +1,126 @@ +# Combine hyperspectral predictores and biodiversity variables in gpm class. +if(Sys.info()["sysname"] == "Windows"){ + filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" +} else { + filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" +} +source(filepath_base) + +if(length(showConnections()) == 0){ + cores = 20 + cl = parallel::makeCluster(cores) + doParallel::registerDoParallel(cl) +} + +dir.create(paste0(path_model_gpm_sr), showWarnings = FALSE) + +comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) + + +# Predict with all elevation and lui information only +comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[c(1:7)] + + +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { + + model = comb + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "gam", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr, + "ki_sr_elui_non_scaled_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + +# Predict with hyperspectral data only +comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[-c(1:7)] + +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { + + model = comb + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "gam", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr, + "ki_sr_spec_non_scaled_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + + +# Predict with all data +comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR + +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { + + model = comb + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "gam", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr, + "ki_sr_elsp_non_scaled_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + + + +# Predict with kmdc and raoq only +comb@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ + c(grep("kmdc", comb@meta$input$PREDICTOR), + grep("raoq", comb@meta$input$PREDICTOR))]) + + +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { + + model = comb + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "gam", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr, + "ki_sr_kmra_non_scaled_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} +stopCluster(cl) \ No newline at end of file diff --git a/src/210_predict_biodiv_sr_elev_res.R b/src/210_predict_biodiv_sr_elev_res_rf.R similarity index 77% rename from src/210_predict_biodiv_sr_elev_res.R rename to src/210_predict_biodiv_sr_elev_res_rf.R index 60b156c..8be880d 100644 --- a/src/210_predict_biodiv_sr_elev_res.R +++ b/src/210_predict_biodiv_sr_elev_res_rf.R @@ -95,4 +95,33 @@ foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm" } + +# Predict with kmdc and raoq only +comb_elev_res@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ + c(grep("kmdc", comb@meta$input$PREDICTOR), + grep("raoq", comb@meta$input$PREDICTOR))]) + +foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { + + model = comb_elev_res + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "rf", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, + "ki_sr_kmra_non_scaled_elev_res_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + + stopCluster(cl) \ No newline at end of file diff --git a/src/211_predict_biodiv_sr_elev_res_rf_kmra.R b/src/211_predict_biodiv_sr_elev_res_rf_kmra.R new file mode 100644 index 0000000..af07d57 --- /dev/null +++ b/src/211_predict_biodiv_sr_elev_res_rf_kmra.R @@ -0,0 +1,50 @@ +# comb_elev_resine hyperspectral predictores and biodiversity variables in gpm class. +if(Sys.info()["sysname"] == "Windows"){ + filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" +} else { + filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" +} +source(filepath_base) + +if(length(showConnections()) == 0){ + cores = 20 + cl = parallel::makeCluster(cores) + doParallel::registerDoParallel(cl) +} + +dir.create(paste0(path_model_gpm_sr_elev_res), showWarnings = FALSE) + +comb_elev_res = readRDS(paste0(path_comb_gpm_sr_elev_res, "ki_hyperspec_biodiv_non_scaled_elev_res.rds")) + + + + +# Predict with kmdc and raoq only +comb_elev_res@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ + c(grep("kmdc", comb@meta$input$PREDICTOR), + grep("raoq", comb@meta$input$PREDICTOR))]) + +foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { + + model = comb_elev_res + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "rf", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, + "ki_sr_kmra_non_scaled_elev_res_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + + +stopCluster(cl) \ No newline at end of file diff --git a/src/212_predict_biodiv_sr_elev_res_pls.R b/src/212_predict_biodiv_sr_elev_res_pls.R new file mode 100644 index 0000000..d04f0c4 --- /dev/null +++ b/src/212_predict_biodiv_sr_elev_res_pls.R @@ -0,0 +1,127 @@ +# comb_elev_resine hyperspectral predictores and biodiversity variables in gpm class. +if(Sys.info()["sysname"] == "Windows"){ + filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" +} else { + filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" +} +source(filepath_base) + +if(length(showConnections()) == 0){ + cores = 20 + cl = parallel::makeCluster(cores) + doParallel::registerDoParallel(cl) +} + +dir.create(paste0(path_model_gpm_sr_elev_res), showWarnings = FALSE) + +comb_elev_res = readRDS(paste0(path_comb_gpm_sr_elev_res, "ki_hyperspec_biodiv_non_scaled_elev_res.rds")) + + +# Predict with all elevation and lui information only +comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR[c(1:7)] + + +foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { + + model = comb_elev_res + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "pls", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, + "ki_sr_elui_non_scaled_elev_res_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + +# Predict with hyperspectral data only +comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR[-c(1:7)] + +foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { + + model = comb_elev_res + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "pls", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, + "ki_sr_spec_non_scaled_elev_res_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + + +# Predict with all data +comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR + +foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { + + model = comb_elev_res + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "pls", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, + "ki_sr_elsp_non_scaled_elev_res_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + + + +# Predict with kmdc and raoq only +comb_elev_res@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ + c(grep("kmdc", comb@meta$input$PREDICTOR), + grep("raoq", comb@meta$input$PREDICTOR))]) + +foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { + + model = comb_elev_res + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "pls", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, + "ki_sr_kmra_non_scaled_elev_res_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + + +stopCluster(cl) \ No newline at end of file diff --git a/src/214_predict_biodiv_sr_elev_res_gam.R b/src/214_predict_biodiv_sr_elev_res_gam.R new file mode 100644 index 0000000..6ac686f --- /dev/null +++ b/src/214_predict_biodiv_sr_elev_res_gam.R @@ -0,0 +1,127 @@ +# comb_elev_resine hyperspectral predictores and biodiversity variables in gpm class. +if(Sys.info()["sysname"] == "Windows"){ + filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" +} else { + filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" +} +source(filepath_base) + +if(length(showConnections()) == 0){ + cores = 20 + cl = parallel::makeCluster(cores) + doParallel::registerDoParallel(cl) +} + +dir.create(paste0(path_model_gpm_sr_elev_res), showWarnings = FALSE) + +comb_elev_res = readRDS(paste0(path_comb_gpm_sr_elev_res, "ki_hyperspec_biodiv_non_scaled_elev_res.rds")) + + +# Predict with all elevation and lui information only +comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR[c(1:7)] + + +foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { + + model = comb_elev_res + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "gam", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, + "ki_sr_elui_non_scaled_elev_res_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + +# Predict with hyperspectral data only +comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR[-c(1:7)] + +foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { + + model = comb_elev_res + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "gam", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, + "ki_sr_spec_non_scaled_elev_res_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + + +# Predict with all data +comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR + +foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { + + model = comb_elev_res + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "gam", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, + "ki_sr_elsp_non_scaled_elev_res_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + + + +# Predict with kmdc and raoq only +comb_elev_res@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ + c(grep("kmdc", comb@meta$input$PREDICTOR), + grep("raoq", comb@meta$input$PREDICTOR))]) + +foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { + + model = comb_elev_res + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "gam", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, + "ki_sr_kmra_non_scaled_elev_res_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + + +stopCluster(cl) \ No newline at end of file From beedf8694b333ae9225aa537de592b52d85ae6de Mon Sep 17 00:00:00 2001 From: "Nauss, Thomas" Date: Mon, 31 Dec 2018 10:15:28 +0100 Subject: [PATCH 35/65] Adjust output filenames --- src/202_predict_biodiv_sr_pls.R | 8 +- src/204_predict_biodiv_sr_gam.R | 8 +- src/206_predict_biodiv_sr_combined.R | 265 ++++++++++++++++++ src/212_predict_biodiv_sr_elev_res_pls.R | 8 +- src/214_predict_biodiv_sr_elev_res_gam.R | 8 +- ...6_predict_biodiv_sr_elev_res_rf_combined.R | 263 +++++++++++++++++ 6 files changed, 544 insertions(+), 16 deletions(-) create mode 100644 src/206_predict_biodiv_sr_combined.R create mode 100644 src/216_predict_biodiv_sr_elev_res_rf_combined.R diff --git a/src/202_predict_biodiv_sr_pls.R b/src/202_predict_biodiv_sr_pls.R index 4959bc5..98d5769 100644 --- a/src/202_predict_biodiv_sr_pls.R +++ b/src/202_predict_biodiv_sr_pls.R @@ -38,7 +38,7 @@ foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret" filepath_tmp = NULL) saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_elui_non_scaled_rf_", + "ki_sr_elui_non_scaled_pls_", model@meta$input$RESPONSE_FINAL, ".rds")) } @@ -63,7 +63,7 @@ foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret" filepath_tmp = NULL) saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_spec_non_scaled_rf_", + "ki_sr_spec_non_scaled_pls_", model@meta$input$RESPONSE_FINAL, ".rds")) } @@ -89,7 +89,7 @@ foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret" filepath_tmp = NULL) saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_elsp_non_scaled_rf_", + "ki_sr_elsp_non_scaled_pls_", model@meta$input$RESPONSE_FINAL, ".rds")) } @@ -119,7 +119,7 @@ foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret" filepath_tmp = NULL) saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_kmra_non_scaled_rf_", + "ki_sr_kmra_non_scaled_pls_", model@meta$input$RESPONSE_FINAL, ".rds")) } diff --git a/src/204_predict_biodiv_sr_gam.R b/src/204_predict_biodiv_sr_gam.R index f871da2..b6798f9 100644 --- a/src/204_predict_biodiv_sr_gam.R +++ b/src/204_predict_biodiv_sr_gam.R @@ -38,7 +38,7 @@ foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret" filepath_tmp = NULL) saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_elui_non_scaled_rf_", + "ki_sr_elui_non_scaled_gam_", model@meta$input$RESPONSE_FINAL, ".rds")) } @@ -63,7 +63,7 @@ foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret" filepath_tmp = NULL) saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_spec_non_scaled_rf_", + "ki_sr_spec_non_scaled_gam_", model@meta$input$RESPONSE_FINAL, ".rds")) } @@ -89,7 +89,7 @@ foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret" filepath_tmp = NULL) saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_elsp_non_scaled_rf_", + "ki_sr_elsp_non_scaled_gam_", model@meta$input$RESPONSE_FINAL, ".rds")) } @@ -119,7 +119,7 @@ foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret" filepath_tmp = NULL) saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_kmra_non_scaled_rf_", + "ki_sr_kmra_non_scaled_gam_", model@meta$input$RESPONSE_FINAL, ".rds")) } diff --git a/src/206_predict_biodiv_sr_combined.R b/src/206_predict_biodiv_sr_combined.R new file mode 100644 index 0000000..5547331 --- /dev/null +++ b/src/206_predict_biodiv_sr_combined.R @@ -0,0 +1,265 @@ +# Combine hyperspectral predictores and biodiversity variables in gpm class. +if(Sys.info()["sysname"] == "Windows"){ + filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" +} else { + filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" +} +source(filepath_base) + +if(length(showConnections()) == 0){ + cores = 20 + cl = parallel::makeCluster(cores) + doParallel::registerDoParallel(cl) +} + +dir.create(paste0(path_model_gpm_sr), showWarnings = FALSE) + +comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) + + + + + +# Predict with kmdc and raoq only +comb@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ + c(grep("kmdc", comb@meta$input$PREDICTOR), + grep("raoq", comb@meta$input$PREDICTOR))]) + + +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { + + model = comb + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "rf", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr, + "ki_sr_kmra_non_scaled_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + +# Predict with all elevation and lui information only +comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[c(1:7)] + + +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { + + model = comb + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "pls", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr, + "ki_sr_elui_non_scaled_pls_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + +# Predict with hyperspectral data only +comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[-c(1:7)] + +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { + + model = comb + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "pls", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr, + "ki_sr_spec_non_scaled_pls_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + + +# Predict with all data +comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR + +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { + + model = comb + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "pls", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr, + "ki_sr_elsp_non_scaled_pls_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + + + +# Predict with kmdc and raoq only +comb@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ + c(grep("kmdc", comb@meta$input$PREDICTOR), + grep("raoq", comb@meta$input$PREDICTOR))]) + + +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { + + model = comb + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "pls", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr, + "ki_sr_kmra_non_scaled_pls_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + +# Predict with all elevation and lui information only +comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[c(1:7)] + + +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { + + model = comb + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "gam", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr, + "ki_sr_elui_non_scaled_gam_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + +# Predict with hyperspectral data only +comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[-c(1:7)] + +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { + + model = comb + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "gam", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr, + "ki_sr_spec_non_scaled_gam_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + + +# Predict with all data +comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR + +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { + + model = comb + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "gam", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr, + "ki_sr_elsp_non_scaled_gam_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + + + +# Predict with kmdc and raoq only +comb@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ + c(grep("kmdc", comb@meta$input$PREDICTOR), + grep("raoq", comb@meta$input$PREDICTOR))]) + + +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { + + model = comb + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "gam", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr, + "ki_sr_kmra_non_scaled_gam_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + +stopCluster(cl) \ No newline at end of file diff --git a/src/212_predict_biodiv_sr_elev_res_pls.R b/src/212_predict_biodiv_sr_elev_res_pls.R index d04f0c4..e6b5a4a 100644 --- a/src/212_predict_biodiv_sr_elev_res_pls.R +++ b/src/212_predict_biodiv_sr_elev_res_pls.R @@ -38,7 +38,7 @@ foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm" filepath_tmp = NULL) saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_elui_non_scaled_elev_res_rf_", + "ki_sr_elui_non_scaled_elev_res_pls_", model@meta$input$RESPONSE_FINAL, ".rds")) } @@ -63,7 +63,7 @@ foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm" filepath_tmp = NULL) saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_spec_non_scaled_elev_res_rf_", + "ki_sr_spec_non_scaled_elev_res_pls_", model@meta$input$RESPONSE_FINAL, ".rds")) } @@ -89,7 +89,7 @@ foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm" filepath_tmp = NULL) saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_elsp_non_scaled_elev_res_rf_", + "ki_sr_elsp_non_scaled_elev_res_pls_", model@meta$input$RESPONSE_FINAL, ".rds")) } @@ -118,7 +118,7 @@ foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm" filepath_tmp = NULL) saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_kmra_non_scaled_elev_res_rf_", + "ki_sr_kmra_non_scaled_elev_res_pls_", model@meta$input$RESPONSE_FINAL, ".rds")) } diff --git a/src/214_predict_biodiv_sr_elev_res_gam.R b/src/214_predict_biodiv_sr_elev_res_gam.R index 6ac686f..c3a3e76 100644 --- a/src/214_predict_biodiv_sr_elev_res_gam.R +++ b/src/214_predict_biodiv_sr_elev_res_gam.R @@ -38,7 +38,7 @@ foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm" filepath_tmp = NULL) saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_elui_non_scaled_elev_res_rf_", + "ki_sr_elui_non_scaled_elev_res_gam_", model@meta$input$RESPONSE_FINAL, ".rds")) } @@ -63,7 +63,7 @@ foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm" filepath_tmp = NULL) saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_spec_non_scaled_elev_res_rf_", + "ki_sr_spec_non_scaled_elev_res_gam_", model@meta$input$RESPONSE_FINAL, ".rds")) } @@ -89,7 +89,7 @@ foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm" filepath_tmp = NULL) saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_elsp_non_scaled_elev_res_rf_", + "ki_sr_elsp_non_scaled_elev_res_gam_", model@meta$input$RESPONSE_FINAL, ".rds")) } @@ -118,7 +118,7 @@ foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm" filepath_tmp = NULL) saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_kmra_non_scaled_elev_res_rf_", + "ki_sr_kmra_non_scaled_elev_res_gam_", model@meta$input$RESPONSE_FINAL, ".rds")) } diff --git a/src/216_predict_biodiv_sr_elev_res_rf_combined.R b/src/216_predict_biodiv_sr_elev_res_rf_combined.R new file mode 100644 index 0000000..b682dbc --- /dev/null +++ b/src/216_predict_biodiv_sr_elev_res_rf_combined.R @@ -0,0 +1,263 @@ +# comb_elev_resine hyperspectral predictores and biodiversity variables in gpm class. +if(Sys.info()["sysname"] == "Windows"){ + filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" +} else { + filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" +} +source(filepath_base) + +if(length(showConnections()) == 0){ + cores = 20 + cl = parallel::makeCluster(cores) + doParallel::registerDoParallel(cl) +} + +dir.create(paste0(path_model_gpm_sr_elev_res), showWarnings = FALSE) + +comb_elev_res = readRDS(paste0(path_comb_gpm_sr_elev_res, "ki_hyperspec_biodiv_non_scaled_elev_res.rds")) + + + + +# Predict with kmdc and raoq only +comb_elev_res@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ + c(grep("kmdc", comb@meta$input$PREDICTOR), + grep("raoq", comb@meta$input$PREDICTOR))]) + +foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { + + model = comb_elev_res + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "rf", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, + "ki_sr_kmra_non_scaled_elev_res_rf_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + + +# Predict with all elevation and lui information only +comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR[c(1:7)] + + +foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { + + model = comb_elev_res + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "pls", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, + "ki_sr_elui_non_scaled_elev_res_pls_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + +# Predict with hyperspectral data only +comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR[-c(1:7)] + +foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { + + model = comb_elev_res + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "pls", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, + "ki_sr_spec_non_scaled_elev_res_pls_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + + +# Predict with all data +comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR + +foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { + + model = comb_elev_res + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "pls", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, + "ki_sr_elsp_non_scaled_elev_res_pls_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + + + +# Predict with kmdc and raoq only +comb_elev_res@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ + c(grep("kmdc", comb@meta$input$PREDICTOR), + grep("raoq", comb@meta$input$PREDICTOR))]) + +foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { + + model = comb_elev_res + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "pls", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, + "ki_sr_kmra_non_scaled_elev_res_pls_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + +# Predict with all elevation and lui information only +comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR[c(1:7)] + + +foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { + + model = comb_elev_res + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "gam", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, + "ki_sr_elui_non_scaled_elev_res_gam_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + +# Predict with hyperspectral data only +comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR[-c(1:7)] + +foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { + + model = comb_elev_res + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "gam", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, + "ki_sr_spec_non_scaled_elev_res_gam_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + + +# Predict with all data +comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR + +foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { + + model = comb_elev_res + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "gam", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, + "ki_sr_elsp_non_scaled_elev_res_gam_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + + + +# Predict with kmdc and raoq only +comb_elev_res@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ + c(grep("kmdc", comb@meta$input$PREDICTOR), + grep("raoq", comb@meta$input$PREDICTOR))]) + +foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { + + model = comb_elev_res + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "gam", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, + "ki_sr_kmra_non_scaled_elev_res_gam_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} + + +stopCluster(cl) \ No newline at end of file From de12bde6171fbc9c9d1dd17211e1bee573bc5f0a Mon Sep 17 00:00:00 2001 From: "Nauss, Thomas" Date: Fri, 11 Jan 2019 11:11:22 +0100 Subject: [PATCH 36/65] Add analysis and re-define residual based modelling --- src/000_set_environment.R | 8 +- src/001_functions.R | 119 +++++++++++++++- ...redictores_biodiv_sr_elevation_residuals.R | 47 ------- src/201_predict_biodiv_sr_rf_kmra.R | 50 ------- src/204_predict_biodiv_sr_gam.R | 24 ++++ src/210_predict_biodiv_sr_elev_res_rf.R | 127 ------------------ src/211_predict_biodiv_sr_elev_res_rf_kmra.R | 50 ------- src/300_analyse_biodiv_sr.R | 83 ------------ ..._combine_predictores_biodiv_sr_residuals.R | 51 +++++++ src/310_predict_biodiv_sr_res_rf.R | 33 +++++ ..._pls.R => 312_predict_biodiv_sr_res_pls.R} | 0 ..._gam.R => 314_predict_biodiv_sr_res_gam.R} | 0 ...> 316_predict_biodiv_sr_res_rf_combined.R} | 0 src/400_compile_analyse_biodiv_sr.R | 35 +++++ src/410_compile_analyse_biodiv_sr_elev_res.R | 51 +++++++ src/500_analyse_biodiv_sr.R | 65 +++++++++ src/510_analyse_biodiv_sr_elev_res.R | 71 ++++++++++ 17 files changed, 450 insertions(+), 364 deletions(-) delete mode 100644 src/110_combine_predictores_biodiv_sr_elevation_residuals.R delete mode 100644 src/201_predict_biodiv_sr_rf_kmra.R delete mode 100644 src/210_predict_biodiv_sr_elev_res_rf.R delete mode 100644 src/211_predict_biodiv_sr_elev_res_rf_kmra.R delete mode 100644 src/300_analyse_biodiv_sr.R create mode 100644 src/300_combine_predictores_biodiv_sr_residuals.R create mode 100644 src/310_predict_biodiv_sr_res_rf.R rename src/{212_predict_biodiv_sr_elev_res_pls.R => 312_predict_biodiv_sr_res_pls.R} (100%) rename src/{214_predict_biodiv_sr_elev_res_gam.R => 314_predict_biodiv_sr_res_gam.R} (100%) rename src/{216_predict_biodiv_sr_elev_res_rf_combined.R => 316_predict_biodiv_sr_res_rf_combined.R} (100%) create mode 100644 src/400_compile_analyse_biodiv_sr.R create mode 100644 src/410_compile_analyse_biodiv_sr_elev_res.R create mode 100644 src/500_analyse_biodiv_sr.R create mode 100644 src/510_analyse_biodiv_sr_elev_res.R diff --git a/src/000_set_environment.R b/src/000_set_environment.R index 21d5db9..8b24348 100644 --- a/src/000_set_environment.R +++ b/src/000_set_environment.R @@ -18,9 +18,13 @@ path_hyp_raoq = paste0(path_data, "/060_hypspec_raoq/") path_hyp_glcm = paste0(path_data, "/070_hypspec_glcm/") path_hyp_pred = paste0(path_data, "/090_hypspec_pred/") path_comb_gpm_sr = paste0(path_data, "/100_comb_gpm_sr/") -path_comb_gpm_sr_elev_res = paste0(path_data, "/110_comb_gpm_sr_elev_res/") path_model_gpm_sr = paste0(path_data, "/200_model_gpm_sr/") -path_model_gpm_sr_elev_res = paste0(path_data, "/210_model_gpm_sr_elev_res/") +path_comb_gpm_sr_res = paste0(path_data, "/300_comb_gpm_sr_res/") +path_model_gpm_sr_res = paste0(path_data, "/310_model_gpm_sr_res/") +path_compile_analysis_sr = paste0(path_data, "/400_compile_analysis_sr/") +path_compile_analysis_sr_elev_res = paste0(path_data, "/410_compile_analysis_sr_elev_res/") +path_analysis_sr = paste0(path_data, "/500_analysis_sr/") +path_analysis_sr_elev_res = paste0(path_data, "/510_analysis_sr_elev_res/") path_plots = paste0(path_data, "/plots/") path_rdata = paste0(path_data, "/rdata/") diff --git a/src/001_functions.R b/src/001_functions.R index a9ab692..28961a4 100644 --- a/src/001_functions.R +++ b/src/001_functions.R @@ -1,4 +1,4 @@ -# Visually check data +# Visually check data ---------------------------------------------------------- visCheck = function(datapath, polygonfile, band = 109){ ds = list.files(datapath, full.names = TRUE) pb = shapefile(polygonfile) @@ -16,7 +16,116 @@ visCheck = function(datapath, polygonfile, band = 109){ } -# Spectral rao +# Compile residual datasets ---------------------------------------------------- +compResData = function(comb_sr, pt, mt){ + comb_sr_elev_res = comb_sr + model_files = list.files(path_model_gpm_sr, full.names = TRUE, + pattern = glob2rx(paste0(pt, mt))) + + for(m in model_files){ + act_model = readRDS(m)@model[[1]][[1]][[1]] + + if(inherits(act_model$model, "try-error")){ + act_predictions = NA + } else { + non_na_pos = which( + complete.cases( + comb_sr_elev_res@data$input[, act_model$model$selectedvars])) + + act_predictions = NA + act_predictions[non_na_pos] = predict(act_model$model, comb_sr@data$input[non_na_pos,]) + } + comb_sr_elev_res@data$input[, act_model$response] = + comb_sr_elev_res@data$input[, act_model$response] - + act_predictions + + colname_pos = grep(act_model$response, colnames(comb_sr_elev_res@data$input)) + colnames(comb_sr_elev_res@data$input)[colname_pos] = + paste0(colnames(comb_sr_elev_res@data$input)[colname_pos], + gsub("[*]", "", paste0("_", mt, "_", pt, "_res"))) + } + + comb_sr_elev_res@meta$input$RESPONSE = + paste0(comb_sr_elev_res@meta$input$RESPONSE, + gsub("[*]", "", paste0("_", mt, "_", pt, "_res"))) + + comb_sr_elev_res@meta$input$RESPONSE_FINAL = comb_sr_elev_res@meta$input$RESPONSE + return(comb_sr_elev_res) +} + + + +# Train and tune models -------------------------------------------------------- +compModels = function(model, pt, mt){ + foreach (i = seq(length(model@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { + + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "rf", + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + outfile_name = gsub("[*]", "", paste0(path_model_gpm_sr_res, + "ki_sr_", pt, "_non_scaled_", mt, "_", + model@meta$input$RESPONSE_FINAL, + ".rds")) + saveRDS(model, file = outfile_name) + } +} + + + +# Collect model performance ---------------------------------------------------- +modelPerformance = function(model){ + smr_all = lapply(names(model), function(pt){ + smr_pt = lapply(model[[pt]]@model[[1]], function(mi){ + if(inherits(mi[[1]]$model, "try-error")){ + df = NULL + } else { + if(ncol(mi[[1]]$model$resample) == 6){ + temp = rbind(mi[[1]]$model$resample[ + mi[[1]]$model$resample$method == mi[[1]]$model$bestTune$method & + mi[[1]]$model$resample$select == mi[[1]]$model$bestTune$select, c(1:3, 6)], + data.frame( + t(colMeans(mi[[1]]$model$resample[ + mi[[1]]$model$resample$method == mi[[1]]$model$bestTune$method & + mi[[1]]$model$resample$select == mi[[1]]$model$bestTune$select, 1:3], na.rm = TRUE)), + Resample = "Mean")) + } else { + temp = rbind(mi[[1]]$model$resample, + data.frame(t(colMeans(mi[[1]]$model$resample[, 1:3], na.rm = TRUE)), + Resample = "Mean")) + + } + temp$RMSE_normSD = temp$RMSE/sd(mi[[1]]$model$trainingData$.outcome) + df = data.frame(mtype = mi[[1]]$model$method, + ptype = pt, + resp = mi[[1]]$response, + mi[[1]]$model$bestTune, + nvars = length(mi[[1]]$model$selectedvars), + temp) + # for(i in seq(df$nvars)){ + # df[paste0("V",i)] = mi[[1]]$model$selectedvars[i] + # } + } + }) + smr_pt = do.call("rbind", smr_pt) + return(smr_pt) + }) + smr_all = do.call("rbind", smr_all) + return(smr_all) +} + + + +# Spectral rao ----------------------------------------------------------------- ######### SPECTRALRAO ############################# ## Developed by Matteo Marcantonio ## Latest update: 04th October 2018 @@ -32,8 +141,8 @@ visCheck = function(datapath, polygonfile, band = 109){ ## where S is the number of pixel classes). ## ------------------------------------------------- ## Find more info and application here: -## 1) https://doi.org/10.1016/j.ecolind.2016.07.039 Titel anhand dieser DOI in Citavi-Projekt übernehmen -## 2) https://besjournals.onlinelibrary.wiley.com/doi/10.1111/2041-210X.12941 %CITAVIPICKER£10.1111/2041-210X.12941£Titel anhand dieser DOI in Citavi-Projekt übernehmen£% +## 1) https://doi.org/10.1016/j.ecolind.2016.07.039 Titel anhand dieser DOI in Citavi-Projekt ?bernehmen +## 2) https://besjournals.onlinelibrary.wiley.com/doi/10.1111/2041-210X.12941 %CITAVIPICKER?10.1111/2041-210X.12941?Titel anhand dieser DOI in Citavi-Projekt ?bernehmen?% ##################################################### # Function spectralrao <- function(input, distance_m="euclidean", p=NULL, window=9, mode="classic", lambda=0, shannon=FALSE, rescale=FALSE, na.tolerance=0.0, simplify=3, nc.cores=1, cluster.type="MPI", debugging=FALSE, ...) @@ -451,7 +560,7 @@ spectralrao <- function(input, distance_m="euclidean", p=NULL, window=9, mode="c # raoqe[rw-w,cl-w] <- sum(rep(vout,2) * (1/(window)^4),na.rm=TRUE) return(data.frame(row=rw-w, col=cl-w, value=sum(rep(vout,2) * (1/(window)^4),na.rm=TRUE))) } - + } diff --git a/src/110_combine_predictores_biodiv_sr_elevation_residuals.R b/src/110_combine_predictores_biodiv_sr_elevation_residuals.R deleted file mode 100644 index 022abf8..0000000 --- a/src/110_combine_predictores_biodiv_sr_elevation_residuals.R +++ /dev/null @@ -1,47 +0,0 @@ -# Combine hyperspectral predictores and biodiversity variables in gpm class. - -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") - -if(length(showConnections()) == 0){ - cores = 20 - cl = parallel::makeCluster(cores) - doParallel::registerDoParallel(cl) -} - -comb_elev_res = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) - -comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR[c(1)] - -for (i in seq(length(comb@meta$input$RESPONSE))){ - print(i) - comb_elev_res@meta$input$RESPONSE_FINAL = comb_elev_res@meta$input$RESPONSE[i] - comb_elev_res@data$input = comb_elev_res@data$input[complete.cases(comb_elev_res@data$input[, c(comb_elev_res@meta$input$RESPONSE_FINAL, comb_elev_res@meta$input$PREDICTOR_FINAL)]), ] - comb_elev_res = createIndexFolds(x = comb_elev_res, nested_cv = FALSE) - - - comb_elev_res = trainModel(x = comb_elev_res, - metric = "RMSE", - n_var = NULL, - mthd = "gam", - mode = "none", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - comb_elev_res@model$gam_none[[1]][[1]]$model - - comb_elev_res@data$input[, paste0(comb_elev_res@meta$input$RESPONSE_FINAL, "_elev_res")] = - as.vector(comb_elev_res@data$input[, comb_elev_res@meta$input$RESPONSE_FINAL] - - predict(comb_elev_res@model$gam_none[[1]][[1]]$model, comb_elev_res@data$input)) - -} - -# Remove original biodiversity information and update meta information -comb_elev_res@data$input[, comb_elev_res@meta$input$RESPONSE] = NULL -comb_elev_res@meta$input$RESPONSE = paste0(comb_elev_res@meta$input$RESPONSE, "_elev_res") - -dir.create(paste0(path_comb_gpm_sr_elev_res), showWarnings = FALSE) - -saveRDS(comb_elev_res, file = paste0(path_comb_gpm_sr_elev_res, "ki_hyperspec_biodiv_non_scaled_elev_res.rds")) - diff --git a/src/201_predict_biodiv_sr_rf_kmra.R b/src/201_predict_biodiv_sr_rf_kmra.R deleted file mode 100644 index 2ddf81d..0000000 --- a/src/201_predict_biodiv_sr_rf_kmra.R +++ /dev/null @@ -1,50 +0,0 @@ -# Combine hyperspectral predictores and biodiversity variables in gpm class. -if(Sys.info()["sysname"] == "Windows"){ - filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" -} else { - filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" -} -source(filepath_base) - -if(length(showConnections()) == 0){ - cores = 20 - cl = parallel::makeCluster(cores) - doParallel::registerDoParallel(cl) -} - -dir.create(paste0(path_model_gpm_sr), showWarnings = FALSE) - -comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) - - - - - -# Predict with kmdc and raoq only -comb@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ - c(grep("kmdc", comb@meta$input$PREDICTOR), - grep("raoq", comb@meta$input$PREDICTOR))]) - - -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { - - model = comb - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "rf", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_kmra_non_scaled_rf_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} -stopCluster(cl) \ No newline at end of file diff --git a/src/204_predict_biodiv_sr_gam.R b/src/204_predict_biodiv_sr_gam.R index b6798f9..338ab7c 100644 --- a/src/204_predict_biodiv_sr_gam.R +++ b/src/204_predict_biodiv_sr_gam.R @@ -16,6 +16,30 @@ dir.create(paste0(path_model_gpm_sr), showWarnings = FALSE) comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) +# Predict with elevation information only +comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[1] + +foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { + + model = comb + model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] + model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = "gam", + mode = "none", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + + saveRDS(model, file = paste0(path_model_gpm_sr, + "ki_sr_elev_non_scaled_gam_", + model@meta$input$RESPONSE_FINAL, + ".rds")) +} # Predict with all elevation and lui information only comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[c(1:7)] diff --git a/src/210_predict_biodiv_sr_elev_res_rf.R b/src/210_predict_biodiv_sr_elev_res_rf.R deleted file mode 100644 index 8be880d..0000000 --- a/src/210_predict_biodiv_sr_elev_res_rf.R +++ /dev/null @@ -1,127 +0,0 @@ -# comb_elev_resine hyperspectral predictores and biodiversity variables in gpm class. -if(Sys.info()["sysname"] == "Windows"){ - filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" -} else { - filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" -} -source(filepath_base) - -if(length(showConnections()) == 0){ - cores = 20 - cl = parallel::makeCluster(cores) - doParallel::registerDoParallel(cl) -} - -dir.create(paste0(path_model_gpm_sr_elev_res), showWarnings = FALSE) - -comb_elev_res = readRDS(paste0(path_comb_gpm_sr_elev_res, "ki_hyperspec_biodiv_non_scaled_elev_res.rds")) - - -# Predict with all elevation and lui information only -comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR[c(1:7)] - - -foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { - - model = comb_elev_res - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "rf", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_elui_non_scaled_elev_res_rf_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - -# Predict with hyperspectral data only -comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR[-c(1:7)] - -foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { - - model = comb_elev_res - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "rf", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_spec_non_scaled_elev_res_rf_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - - -# Predict with all data -comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR - -foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { - - model = comb_elev_res - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "rf", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_elsp_non_scaled_elev_res_rf_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - - - -# Predict with kmdc and raoq only -comb_elev_res@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ - c(grep("kmdc", comb@meta$input$PREDICTOR), - grep("raoq", comb@meta$input$PREDICTOR))]) - -foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { - - model = comb_elev_res - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "rf", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_kmra_non_scaled_elev_res_rf_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - - -stopCluster(cl) \ No newline at end of file diff --git a/src/211_predict_biodiv_sr_elev_res_rf_kmra.R b/src/211_predict_biodiv_sr_elev_res_rf_kmra.R deleted file mode 100644 index af07d57..0000000 --- a/src/211_predict_biodiv_sr_elev_res_rf_kmra.R +++ /dev/null @@ -1,50 +0,0 @@ -# comb_elev_resine hyperspectral predictores and biodiversity variables in gpm class. -if(Sys.info()["sysname"] == "Windows"){ - filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" -} else { - filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" -} -source(filepath_base) - -if(length(showConnections()) == 0){ - cores = 20 - cl = parallel::makeCluster(cores) - doParallel::registerDoParallel(cl) -} - -dir.create(paste0(path_model_gpm_sr_elev_res), showWarnings = FALSE) - -comb_elev_res = readRDS(paste0(path_comb_gpm_sr_elev_res, "ki_hyperspec_biodiv_non_scaled_elev_res.rds")) - - - - -# Predict with kmdc and raoq only -comb_elev_res@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ - c(grep("kmdc", comb@meta$input$PREDICTOR), - grep("raoq", comb@meta$input$PREDICTOR))]) - -foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { - - model = comb_elev_res - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "rf", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_kmra_non_scaled_elev_res_rf_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - - -stopCluster(cl) \ No newline at end of file diff --git a/src/300_analyse_biodiv_sr.R b/src/300_analyse_biodiv_sr.R deleted file mode 100644 index 2cb1169..0000000 --- a/src/300_analyse_biodiv_sr.R +++ /dev/null @@ -1,83 +0,0 @@ -# Combine hyperspectral predictores and biodiversity variables in gpm class. -if(Sys.info()["sysname"] == "Windows"){ - filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" -} else { - filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" -} -source(filepath_base) - -if(length(showConnections()) == 0){ - cores = 3 - cl = parallel::makeCluster(cores) - doParallel::registerDoParallel(cl) -} - -dir.create(path_analysis_sr, showWarnings = FALSE) - - -# Combine all models into one gpm object -mtypes = c("*elui*", "*spec*", "*elsp*") - - -all_models = lapply(mtypes, function(mt){ - model_files = list.files(path_model_gpm_sr, full.names = TRUE, - pattern = glob2rx(mt)) - - all_models = readRDS(model_files[[1]]) - - for(i in (seq(2, length(model_files)))){ - all_models@model[[1]][[i]] = readRDS(model_files[[i]])@model[[1]][[1]] - } - - return(all_models) - -}) - -names(all_models) = mtypes - -var_imp <- compVarImp(all_models$`*elui*`@model$rf_ffs, scale = FALSE) -var_imp_scale <- compVarImp(all_models$`*elui*`@model$rf_ffs, scale = TRUE) -plotVarImp(var_imp) -plotVarImpHeatmap(var_imp, xlab = "Species", ylab = "Band") -tstat <- compContTests(models, mean = TRUE) -summary(tstat[[2]]) - -# smr = lapply(all_models@model[[1]], function(m){ -# data.frame(mtype = mt, -# resp = m[[1]]$response, -# m[[1]]$model$results[m[[1]]$model$results$mtry == -# m[[1]]$model$bestTune$mtry,] -# ) -# }) -# smr = do.call("rbind", smr) -# return(smr) - -model_results = do.call("rbind", model_results) - -model_results[order(model_results$resp),] - - -# varImp(all_models@model[[1]][[1]][[1]]$model) -# -# caret::varImp(all_models@model[[1]][[1]][[1]]$model) -# -# tune = m@meta$input$RESPONSE_FINAL -# perf_mean = m@model[[1]][[1]][[1]]$model$results[m@model[[1]][[1]][[1]]$model$results$mtry == m@model[[1]][[1]][[1]]$model$bestTune[, 1],] -# perf_resmpls = m@model[[1]][[1]][[1]]$model$resample -# return(data.frame(SR = n, Results = t)) -# -# -# model_files -# -# ms = do.call("rbind", ms) -# ms[, c(1, 4)] -# -# -# varImp(m@model$rf_ffs[[1]][[1]]$model$finalModel$importance) -# -# var_imp <- compVarImp(m@model, scale = FALSE) -# var_imp_scale <- compVarImp(models, scale = TRUE) -# plotVarImp(var_imp) -# plotVarImpHeatmap(var_imp_scale, xlab = "Species", ylab = "Band") -# tstat <- compContTests(models, mean = TRUE) -# summary(tstat[[2]]) \ No newline at end of file diff --git a/src/300_combine_predictores_biodiv_sr_residuals.R b/src/300_combine_predictores_biodiv_sr_residuals.R new file mode 100644 index 0000000..7e270eb --- /dev/null +++ b/src/300_combine_predictores_biodiv_sr_residuals.R @@ -0,0 +1,51 @@ +# Combine hyperspectral predictores and biodiversity variables in gpm class. +if(Sys.info()["sysname"] == "Windows"){ + filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" +} else { + filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" +} + +source(filepath_base) +dir.create(paste0(path_comb_gpm_sr_res), showWarnings = FALSE) + + +# Compile elevation residuals for gam model using eleveation as only predictor +pt = "*elev*" +mt = "*gam*" + +comb_sr = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) +comb_sr_elev_res = compResData(comb_sr, pt, mt) + +saveRDS(comb_sr_elev_res, + file = file.path(path_comb_gpm_sr_res, + paste0("ki_hyperspec_biodiv_non_scaled", + gsub("[*]", "", paste0("_", mt, "_", pt, "_res.rds"))))) + + + +# Compile elevation residuals for pls model using elevation and LUI as only predictor +pt = "*elui*" +mt = "*pls*" + +comb_sr = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) +comb_sr_elev_res = compResData(comb_sr, pt, mt) + +saveRDS(comb_sr_elev_res, + file = file.path(path_comb_gpm_sr_res, + paste0("ki_hyperspec_biodiv_non_scaled", + gsub("[*]", "", paste0("_", mt, "_", pt, "_res.rds"))))) + + + +# Compile elevation residuals for rf model using elevation and LUI as only predictor +pt = "*elui*" +mt = "*rf*" + +comb_sr = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) +comb_sr_elev_res = compResData(comb_sr, pt, mt) + +saveRDS(comb_sr_elev_res, + file = file.path(path_comb_gpm_sr_res, + paste0("ki_hyperspec_biodiv_non_scaled", + gsub("[*]", "", paste0("_", mt, "_", pt, "_res.rds"))))) + diff --git a/src/310_predict_biodiv_sr_res_rf.R b/src/310_predict_biodiv_sr_res_rf.R new file mode 100644 index 0000000..def8ce7 --- /dev/null +++ b/src/310_predict_biodiv_sr_res_rf.R @@ -0,0 +1,33 @@ +# comb_elev_resine hyperspectral predictores and biodiversity variables in gpm class. +if(Sys.info()["sysname"] == "Windows"){ + filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" +} else { + filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" +} +source(filepath_base) + +if(length(showConnections()) == 0){ + cores = 20 + cl = parallel::makeCluster(cores) + doParallel::registerDoParallel(cl) +} + +dir.create(paste0(path_model_gpm_sr_res), showWarnings = FALSE) + +# Predict gam, pls and rf elevation and elevation/lui based residuals using +# pls and rf models with hyperspectral data only +res_suffixes = c("_gam_elev_res", "pls_elui_res", "rf_elui_res") +mtypes = c("*pls*", "*rf*") +pt = "*spec*" + + +for(res_suffix in res_suffixes){ + comb_elev_res = readRDS(paste0(path_comb_gpm_sr_res, "ki_hyperspec_biodiv_non_scaled", + res_suffix, ".rds")) + comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR[-c(1:7)] + for(mt in mtypes){ + compModels(model = comb_elev_res, pt, mt) + } +} + +stopCluster(cl) \ No newline at end of file diff --git a/src/212_predict_biodiv_sr_elev_res_pls.R b/src/312_predict_biodiv_sr_res_pls.R similarity index 100% rename from src/212_predict_biodiv_sr_elev_res_pls.R rename to src/312_predict_biodiv_sr_res_pls.R diff --git a/src/214_predict_biodiv_sr_elev_res_gam.R b/src/314_predict_biodiv_sr_res_gam.R similarity index 100% rename from src/214_predict_biodiv_sr_elev_res_gam.R rename to src/314_predict_biodiv_sr_res_gam.R diff --git a/src/216_predict_biodiv_sr_elev_res_rf_combined.R b/src/316_predict_biodiv_sr_res_rf_combined.R similarity index 100% rename from src/216_predict_biodiv_sr_elev_res_rf_combined.R rename to src/316_predict_biodiv_sr_res_rf_combined.R diff --git a/src/400_compile_analyse_biodiv_sr.R b/src/400_compile_analyse_biodiv_sr.R new file mode 100644 index 0000000..f9df8a5 --- /dev/null +++ b/src/400_compile_analyse_biodiv_sr.R @@ -0,0 +1,35 @@ +# Combine hyperspectral predictores and biodiversity variables in gpm class. +if(Sys.info()["sysname"] == "Windows"){ + filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" +} else { + filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" +} +source(filepath_base) + +dir.create(path_compile_analysis_sr, showWarnings = FALSE) + + +# Combine all models into one gpm object +ptypes = c("*elui*", "*kmra*", "*spec*", "*elsp*") +mtypes = c("*gam*", "*pls*", "*rd*") + +all_models = lapply(mtypes, function(mt){ + all_pmodels = lapply(ptypes, function(pt){ + model_files = list.files(path_model_gpm_sr, full.names = TRUE, + pattern = glob2rx(paste0(pt, mt))) + + all_models = readRDS(model_files[[1]]) + + for(i in (seq(2, length(model_files)))){ + all_models@model[[1]][[i]] = readRDS(model_files[[i]])@model[[1]][[1]] + } + + return(all_models) + }) + names(all_pmodels) = gsub("[*]", "", ptypes) + return(all_pmodels) +}) +names(all_models) = gsub("[*]", "", gsub("_", "", mtypes)) + +saveRDS(all_models, file = file.path(path_compile_analysis_sr, + "models_sr.rds")) diff --git a/src/410_compile_analyse_biodiv_sr_elev_res.R b/src/410_compile_analyse_biodiv_sr_elev_res.R new file mode 100644 index 0000000..612fd01 --- /dev/null +++ b/src/410_compile_analyse_biodiv_sr_elev_res.R @@ -0,0 +1,51 @@ +# Combine hyperspectral predictores and biodiversity variables in gpm class. +if(Sys.info()["sysname"] == "Windows"){ + filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" +} else { + filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" +} +source(filepath_base) + +dir.create(path_compile_analysis_sr_elev_res, showWarnings = FALSE) + + +# Combine all models into one gpm object +ptypes = c("*elui*", "*kmra*", "*spec*", "*elsp*") +mtypes = c("gam_none", "*_gam_*", "*_pls_*", "*_rf_*") + +all_models = lapply(mtypes, function(mt){ + all_pmodels = lapply(ptypes, function(pt){ + use_model_nbr = 2 + if(mt == "gam_none"){ + use_model_nbr = 1 + model_files = list.files(path_model_gpm_sr_elev_res, full.names = TRUE, + pattern = glob2rx(paste0(pt, "*_gam_*"))) + } else { + + model_files = list.files(path_model_gpm_sr_elev_res, full.names = TRUE, + pattern = glob2rx(paste0(pt, mt))) + } + + + all_models = readRDS(model_files[[1]]) + if(mt == "gam_none"){ + all_models@model$gam_ffs = NULL + } else { + all_models@model$gam_none = NULL + } + + for(i in (seq(2, length(model_files)))){ + all_models@model[[1]][[i]] = readRDS(model_files[[i]])@model[[use_model_nbr]][[1]] + } + + return(all_models) + }) + names(all_pmodels) = gsub("[*]", "", ptypes) + return(all_pmodels) +}) +names(all_models) = gsub("[*]", "", gsub("_", "", mtypes)) + +saveRDS(all_models, file = file.path(path_compile_analysis_sr_elev_res, + "models_sr_elev_res.rds")) + + diff --git a/src/500_analyse_biodiv_sr.R b/src/500_analyse_biodiv_sr.R new file mode 100644 index 0000000..8087534 --- /dev/null +++ b/src/500_analyse_biodiv_sr.R @@ -0,0 +1,65 @@ +# Combine hyperspectral predictores and biodiversity variables in gpm class. +if(Sys.info()["sysname"] == "Windows"){ + filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" +} else { + filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" +} +source(filepath_base) + +if(length(showConnections()) == 0){ + cores = 3 + cl = parallel::makeCluster(cores) + doParallel::registerDoParallel(cl) +} + +dir.create(path_analysis_sr, showWarnings = FALSE) + +all_models = readRDS(file.path(path_compile_analysis_sr, "models_sr.rds")) + + +# Collect model performance +gam_sr = modelPerformance(all_models[["gam"]]) +pls_sr = modelPerformance(all_models[["pls"]]) +rf_sr = modelPerformance(all_models[["rf"]]) + +summary(gam_sr) +summary(pls_sr) +summary(rf_sr) + +models_sr = rbind(pls_sr[, -4], rf_sr[, -4]) +models_sr$mptype = paste0(models_sr$mtype, "_", models_sr$ptype) +models_sr$mptype = factor(models_sr$mptype, levels = c("pls_elsp", "rf_elsp", + "pls_elui", "rf_elui", + "pls_kmra", "rf_kmra", + "pls_spec", "rf_spec")) + +# Plot model performance +ggplot(data = pls_sr[pls_sr$ptype == "elui" | pls_sr$ptype == "spec",], aes(x = resp, y = RMSE_normSD, fill = ptype)) + + geom_boxplot()+ + labs(list(title = "PLS", fill = "Predictor Set")) + + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + + +ggplot(data = rf_sr[rf_sr$ptype == "elui" | rf_sr$ptype == "spec",], aes(x = resp, y = RMSE_normSD, fill = ptype)) + + geom_boxplot() + + labs(list(title = "RF", fill = "Predictor Set")) + + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + + +ggplot(data = models_sr[models_sr$ptype == "elui" | models_sr$ptype == "spec",], aes(x = resp, y = RMSE_normSD, fill = mptype)) + + geom_boxplot() + + labs(list(title = "PLS and RF", fill = "Predictor Set")) + + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + + + +# Collect variable importance +var_imp <- compVarImp(all_models[["pls"]][["spec"]]@model[[1]], scale = FALSE) +plotVarImp(var_imp) +plotVarImpHeatmap(var_imp, xlab = "Species", ylab = "Band") + +var_imp <- compVarImp(all_models[["rf"]][["spec"]]@model[[1]], scale = FALSE) +plotVarImp(var_imp) +plotVarImpHeatmap(var_imp, xlab = "Species", ylab = "Band") + + diff --git a/src/510_analyse_biodiv_sr_elev_res.R b/src/510_analyse_biodiv_sr_elev_res.R new file mode 100644 index 0000000..80bc96a --- /dev/null +++ b/src/510_analyse_biodiv_sr_elev_res.R @@ -0,0 +1,71 @@ +# Combine hyperspectral predictores and biodiversity variables in gpm class. +if(Sys.info()["sysname"] == "Windows"){ + filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" +} else { + filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" +} +source(filepath_base) + +dir.create(path_analysis_sr_elev_res, showWarnings = FALSE) + +all_models = readRDS(file.path(path_compile_analysis_sr_elev_res, + "models_sr_elev_res.rds")) + + +# Collect model performance +gamnone_sr = modelPerformance(all_models[["gamnone"]]) +gamnone_sr$mtype = "gamnone" +gam_sr = modelPerformance(all_models[["gam"]]) +pls_sr = modelPerformance(all_models[["pls"]]) +rf_sr = modelPerformance(all_models[["rf"]]) + +summary(gamnone_sr) +summary(gam_sr) +summary(pls_sr) +summary(rf_sr) + +models_sr = rbind(gamnone_sr[, -c(4,5)], pls_sr[, -4], rf_sr[, -4]) +models_sr$mptype = paste0(models_sr$mtype, "_", models_sr$ptype) +models_sr$mptype = factor(models_sr$mptype, levels = c("gamnone_elsp", "pls_elsp", "rf_elsp", + "gamnone_elui", "pls_elui", "rf_elui", + "gamnone_kmra", "pls_kmra", "rf_kmra", + "gamnone_spec", "pls_spec", "rf_spec")) + + + +# Plot model performance +ggplot(data = gamnone_sr[pls_sr$ptype == "elui" | pls_sr$ptype == "spec",], aes(x = resp, y = RMSE_normSD, fill = ptype)) + + geom_boxplot()+ + labs(list(title = "PLS", fill = "Predictor Set")) + + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + + +ggplot(data = pls_sr[pls_sr$ptype == "elui" | pls_sr$ptype == "spec",], aes(x = resp, y = RMSE_normSD, fill = ptype)) + + geom_boxplot()+ + labs(list(title = "PLS", fill = "Predictor Set")) + + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + + +ggplot(data = rf_sr[rf_sr$ptype == "elui" | rf_sr$ptype == "spec",], aes(x = resp, y = RMSE_normSD, fill = ptype)) + + geom_boxplot() + + labs(list(title = "RF", fill = "Predictor Set")) + + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + + +ggplot(data = models_sr[models_sr$ptype == "elui" | models_sr$ptype == "spec",], aes(x = resp, y = RMSE_normSD, fill = mptype)) + + geom_boxplot() + + labs(list(title = "PLS and RF", fill = "Predictor Set")) + + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + + + +# Collect variable importance +var_imp <- compVarImp(all_models[["pls"]][["spec"]]@model[[1]], scale = FALSE) +plotVarImp(var_imp) +plotVarImpHeatmap(var_imp, xlab = "Species", ylab = "Band") + +var_imp <- compVarImp(all_models[["rf"]][["spec"]]@model[[1]], scale = FALSE) +plotVarImp(var_imp) +plotVarImpHeatmap(var_imp, xlab = "Species", ylab = "Band") + + From dac93f45426e3e1bbda2bf0c840f01e9714de276 Mon Sep 17 00:00:00 2001 From: "Nauss, Thomas" Date: Fri, 11 Jan 2019 11:12:01 +0100 Subject: [PATCH 37/65] Change linux settings --- src/000_set_environment_linux.R | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/000_set_environment_linux.R b/src/000_set_environment_linux.R index 82321d6..6166656 100644 --- a/src/000_set_environment_linux.R +++ b/src/000_set_environment_linux.R @@ -18,10 +18,13 @@ path_hyp_raoq = paste0(path_data, "/060_hypspec_raoq/") path_hyp_glcm = paste0(path_data, "/070_hypspec_glcm/") path_hyp_pred = paste0(path_data, "/090_hypspec_pred/") path_comb_gpm_sr = paste0(path_data, "/100_comb_gpm_sr/") -path_comb_gpm_sr_elev_res = paste0(path_data, "/110_comb_gpm_sr_elev_res/") path_model_gpm_sr = paste0(path_data, "/200_model_gpm_sr/") -path_model_gpm_sr_elev_res = paste0(path_data, "/210_model_gpm_sr_elev_res/") -path_analysis_sr = paste0(path_data, "/300_analysis_sr/") +path_comb_gpm_sr_res = paste0(path_data, "/300_comb_gpm_sr_res/") +path_model_gpm_sr_res = paste0(path_data, "/310_model_gpm_sr_res/") +path_compile_analysis_sr = paste0(path_data, "/400_compile_analysis_sr/") +path_compile_analysis_sr_elev_res = paste0(path_data, "/410_compile_analysis_sr_elev_res/") +path_analysis_sr = paste0(path_data, "/500_analysis_sr/") +path_analysis_sr_elev_res = paste0(path_data, "/510_analysis_sr_elev_res/") path_plots = paste0(path_data, "/plots/") path_rdata = paste0(path_data, "/rdata/") From b3066c294f2bba5bc0835596b4fd0fed87d8d441 Mon Sep 17 00:00:00 2001 From: "Nauss, Thomas" Date: Fri, 11 Jan 2019 11:42:48 +0100 Subject: [PATCH 38/65] Update modellilng functions --- src/001_functions.R | 11 +-- src/200_predict_biodiv_sr_rf.R | 130 ++++++----------------------- src/310_predict_biodiv_sr_res_rf.R | 2 +- 3 files changed, 33 insertions(+), 110 deletions(-) diff --git a/src/001_functions.R b/src/001_functions.R index 28961a4..c9fa8a1 100644 --- a/src/001_functions.R +++ b/src/001_functions.R @@ -56,7 +56,7 @@ compResData = function(comb_sr, pt, mt){ # Train and tune models -------------------------------------------------------- -compModels = function(model, pt, mt){ +compModels = function(model, pt, mt, outpath){ foreach (i = seq(length(model@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] @@ -64,18 +64,19 @@ compModels = function(model, pt, mt){ model = createIndexFolds(x = model, nested_cv = FALSE) model = trainModel(x = model, metric = "RMSE", - n_var = NULL, + n_var = NULL, mthd = "rf", mode = "ffs", - seed_nbr = 11, + seed_nbr = 11, cv_nbr = NULL, var_selection = "indv", filepath_tmp = NULL) - - outfile_name = gsub("[*]", "", paste0(path_model_gpm_sr_res, + + outfile_name = gsub("[*]", "", paste0(outpath, "ki_sr_", pt, "_non_scaled_", mt, "_", model@meta$input$RESPONSE_FINAL, ".rds")) + print(outfile_name) saveRDS(model, file = outfile_name) } } diff --git a/src/200_predict_biodiv_sr_rf.R b/src/200_predict_biodiv_sr_rf.R index ef73620..9dec116 100644 --- a/src/200_predict_biodiv_sr_rf.R +++ b/src/200_predict_biodiv_sr_rf.R @@ -17,110 +17,32 @@ dir.create(paste0(path_model_gpm_sr), showWarnings = FALSE) comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) -# Predict with all elevation and lui information only -comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[c(1:7)] - - -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { - - model = comb - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "rf", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_elui_non_scaled_rf_", - model@meta$input$RESPONSE_FINAL, - ".rds")) +# Predict with all elevation and lui information, hyperspectral data only, +# all data, and kmdc and raoq only using gam, pls and rf models. +mtypes = c("*gam*", "*pls*", "*rf*") +ptypes = c("*elui*", "*spec*", "*elsp*", "*kmra*") + +mt = mtypes[3] +pt = ptypes[4] + +for(mt in mtypes){ + for(pt in ptypes){ + + if(pt == "*elui*"){ + comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[c(1:7)] + } else if(pt == "*spec*"){ + comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[-c(1:7)] + } else if(pt == "*elsp*"){ + comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR + } else if(pt == "*kmra*"){ + comb@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ + c(grep("kmdc", comb@meta$input$PREDICTOR), + grep("raoq", comb@meta$input$PREDICTOR))]) + } + + compModels(model = comb, pt = pt, mt = mt, outpath = path_model_gpm_sr) + } } -# Predict with hyperspectral data only -comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[-c(1:7)] - -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { - - model = comb - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "rf", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_spec_non_scaled_rf_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - -# Predict with all data -comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR - -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { - - model = comb - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "rf", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_elsp_non_scaled_rf_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - - - -# Predict with kmdc and raoq only -comb@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ - c(grep("kmdc", comb@meta$input$PREDICTOR), - grep("raoq", comb@meta$input$PREDICTOR))]) - - -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { - - model = comb - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "rf", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_kmra_non_scaled_rf_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} -stopCluster(cl) \ No newline at end of file +stopCluster(cl) diff --git a/src/310_predict_biodiv_sr_res_rf.R b/src/310_predict_biodiv_sr_res_rf.R index def8ce7..dfc1030 100644 --- a/src/310_predict_biodiv_sr_res_rf.R +++ b/src/310_predict_biodiv_sr_res_rf.R @@ -26,7 +26,7 @@ for(res_suffix in res_suffixes){ res_suffix, ".rds")) comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR[-c(1:7)] for(mt in mtypes){ - compModels(model = comb_elev_res, pt, mt) + compModels(model = comb_elev_res, pt = pt, mt = mt, outpath = path_model_gpm_sr_res) } } From 9a9cf2f08561b05049b1fe50620a3349bcb544c8 Mon Sep 17 00:00:00 2001 From: "Nauss, Thomas" Date: Sun, 13 Jan 2019 15:09:05 +0100 Subject: [PATCH 39/65] Update --- src/000_setup.R | 24 -- src/050_comp_kmdc.R | 2 + src/120_combine_predictores_biodiv_tlevel.R | 9 +- src/200_predict_biodiv_sr_rf.R | 3 +- ..._combine_predictores_biodiv_sr_residuals.R | 4 +- src/400_compile_analyse_biodiv_sr.R | 12 +- src/410_compile_analyse_biodiv_sr_elev_res.R | 9 +- src/500_analyse_biodiv_sr.R | 64 +-- src/500_analyse_biodiv_sr.Rmd | 123 ++++++ src/500_analyse_biodiv_sr.nb.html | 372 ++++++++++++++++++ src/findings.txt | 20 + 11 files changed, 571 insertions(+), 71 deletions(-) delete mode 100644 src/000_setup.R create mode 100644 src/500_analyse_biodiv_sr.Rmd create mode 100644 src/500_analyse_biodiv_sr.nb.html create mode 100644 src/findings.txt diff --git a/src/000_setup.R b/src/000_setup.R deleted file mode 100644 index 7d5b325..0000000 --- a/src/000_setup.R +++ /dev/null @@ -1,24 +0,0 @@ -# Set environment for environmental information systems analysis - -root_folder = path.expand("~/analysis/global_forest_cover/") - -project_folders = c("data/", - "data/biomass_1950_2010/", - "data/biomass_2010_gsv/", - "data/maped_datasets/", - "data/gee_landcover_rainfall/", - "data/tree_water_content/", - "data/tmp/", - "EI-GlobalForestAnalysis/src/") - -libs = c("gdalUtils", "mapview", "raster", "rgdal", "sp") - -envrmt = createEnvi(root_folder = root_folder, folders = project_folders, - path_prefix = "path_", libs = libs, - alt_env_id = "COMPUTERNAME", alt_env_value = "PCRZP", - alt_env_root_folder = "F:\\BEN\\edu") - -# More settings -rasterOptions(tmpdir = envrmt$path_tmp) -mapviewOptions(basemaps = mapviewGetOption("basemaps")[c(3, 1:2, 4:5)]) - diff --git a/src/050_comp_kmdc.R b/src/050_comp_kmdc.R index 05c59bd..6551cab 100644 --- a/src/050_comp_kmdc.R +++ b/src/050_comp_kmdc.R @@ -2,12 +2,14 @@ # scaled vegetation inidces stack source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") + if(length(showConnections()) == 0){ cores = 3 cl = parallel::makeCluster(cores) doParallel::registerDoParallel(cl) } + dir.create(paste0(path_hyp_kmdc), showWarnings = FALSE) diff --git a/src/120_combine_predictores_biodiv_tlevel.R b/src/120_combine_predictores_biodiv_tlevel.R index 3b31c5b..d213cad 100644 --- a/src/120_combine_predictores_biodiv_tlevel.R +++ b/src/120_combine_predictores_biodiv_tlevel.R @@ -10,16 +10,13 @@ bd = readRDS(paste0(path_biodiv, "biodiv.rds")) comb = merge(bd, preds, by = c("plotID"), all.x = TRUE, all.y = TRUE) trophic_levels = rbind(data.frame(tlevel = "Plants", - groups = c("SRallplants", "SRasterids", "SRconifers", "SReudicots", - "SRferns", "SRlycopodiopsida", "SRmagnoliids", - "SRmonocots", "SRrosids")), + groups = c("SRallplants", "SRasterids", "SRconifers", "SReudicots", "SRferns", "SRlycopodiopsida", "SRmagnoliids", "SRmonocots", "SRrosids")), data.frame(tlevel = "Herbivore", groups = c("SRbees", "SRmoths", "SRorthoptera")), - data.frame(tlevel = "Decomposer", + data.frame(tlevel = "", groups = c("SRdungbeetles", "SRmillipedes", "SRcollembola")), data.frame(tlevel = "Predators", - groups = c("SRspiders", "SRheteroptera", "SRotheraculeata", - "SRparasitoids", "SRothercoleoptera")), + groups = c("SRspiders", "SRheteroptera", "SRotheraculeata", "SRparasitoids", "SRothercoleoptera")), data.frame(tlevel = "Flying predatores", groups = c("SRbats", "SRbirds")), data.frame(tlevel = "Generalist", diff --git a/src/200_predict_biodiv_sr_rf.R b/src/200_predict_biodiv_sr_rf.R index 9dec116..ff085c8 100644 --- a/src/200_predict_biodiv_sr_rf.R +++ b/src/200_predict_biodiv_sr_rf.R @@ -1,4 +1,4 @@ -# Combine hyperspectral predictores and biodiversity variables in gpm class. +# Predict species richness using different models and predictor sets if(Sys.info()["sysname"] == "Windows"){ filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" } else { @@ -12,6 +12,7 @@ if(length(showConnections()) == 0){ doParallel::registerDoParallel(cl) } + dir.create(paste0(path_model_gpm_sr), showWarnings = FALSE) comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) diff --git a/src/300_combine_predictores_biodiv_sr_residuals.R b/src/300_combine_predictores_biodiv_sr_residuals.R index 7e270eb..454da9a 100644 --- a/src/300_combine_predictores_biodiv_sr_residuals.R +++ b/src/300_combine_predictores_biodiv_sr_residuals.R @@ -1,4 +1,4 @@ -# Combine hyperspectral predictores and biodiversity variables in gpm class. +# Compile species richness dataset containing residuals from some previous modelling if(Sys.info()["sysname"] == "Windows"){ filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" } else { @@ -6,6 +6,8 @@ if(Sys.info()["sysname"] == "Windows"){ } source(filepath_base) + + dir.create(paste0(path_comb_gpm_sr_res), showWarnings = FALSE) diff --git a/src/400_compile_analyse_biodiv_sr.R b/src/400_compile_analyse_biodiv_sr.R index f9df8a5..dcc36ea 100644 --- a/src/400_compile_analyse_biodiv_sr.R +++ b/src/400_compile_analyse_biodiv_sr.R @@ -1,17 +1,13 @@ -# Combine hyperspectral predictores and biodiversity variables in gpm class. -if(Sys.info()["sysname"] == "Windows"){ - filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" -} else { - filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" -} -source(filepath_base) +# Combine species richness model results in one variable. +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") + dir.create(path_compile_analysis_sr, showWarnings = FALSE) # Combine all models into one gpm object ptypes = c("*elui*", "*kmra*", "*spec*", "*elsp*") -mtypes = c("*gam*", "*pls*", "*rd*") +mtypes = c("*gam*", "*pls*", "*rf*") all_models = lapply(mtypes, function(mt){ all_pmodels = lapply(ptypes, function(pt){ diff --git a/src/410_compile_analyse_biodiv_sr_elev_res.R b/src/410_compile_analyse_biodiv_sr_elev_res.R index 612fd01..cbfc3b3 100644 --- a/src/410_compile_analyse_biodiv_sr_elev_res.R +++ b/src/410_compile_analyse_biodiv_sr_elev_res.R @@ -1,10 +1,7 @@ # Combine hyperspectral predictores and biodiversity variables in gpm class. -if(Sys.info()["sysname"] == "Windows"){ - filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" -} else { - filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" -} -source(filepath_base) + +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") + dir.create(path_compile_analysis_sr_elev_res, showWarnings = FALSE) diff --git a/src/500_analyse_biodiv_sr.R b/src/500_analyse_biodiv_sr.R index 8087534..f8ac849 100644 --- a/src/500_analyse_biodiv_sr.R +++ b/src/500_analyse_biodiv_sr.R @@ -1,16 +1,6 @@ -# Combine hyperspectral predictores and biodiversity variables in gpm class. -if(Sys.info()["sysname"] == "Windows"){ - filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" -} else { - filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" -} -source(filepath_base) - -if(length(showConnections()) == 0){ - cores = 3 - cl = parallel::makeCluster(cores) - doParallel::registerDoParallel(cl) -} +# Analyse species richness prediction models + +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") dir.create(path_analysis_sr, showWarnings = FALSE) @@ -26,6 +16,8 @@ summary(gam_sr) summary(pls_sr) summary(rf_sr) + +# Compare pls and rf models_sr = rbind(pls_sr[, -4], rf_sr[, -4]) models_sr$mptype = paste0(models_sr$mtype, "_", models_sr$ptype) models_sr$mptype = factor(models_sr$mptype, levels = c("pls_elsp", "rf_elsp", @@ -33,23 +25,45 @@ models_sr$mptype = factor(models_sr$mptype, levels = c("pls_elsp", "rf_elsp", "pls_kmra", "rf_kmra", "pls_spec", "rf_spec")) -# Plot model performance -ggplot(data = pls_sr[pls_sr$ptype == "elui" | pls_sr$ptype == "spec",], aes(x = resp, y = RMSE_normSD, fill = ptype)) + - geom_boxplot()+ - labs(list(title = "PLS", fill = "Predictor Set")) + +ggplot(data = models_sr[models_sr$ptype == "elui" | models_sr$ptype == "spec",], aes(x = resp, y = RMSE_normSD, fill = mptype)) + + geom_boxplot() + + labs(list(title = "PLS and RF", fill = "Predictor Set")) + theme(axis.text.x = element_text(angle = 45, hjust = 1)) -ggplot(data = rf_sr[rf_sr$ptype == "elui" | rf_sr$ptype == "spec",], aes(x = resp, y = RMSE_normSD, fill = ptype)) + - geom_boxplot() + - labs(list(title = "RF", fill = "Predictor Set")) + - theme(axis.text.x = element_text(angle = 45, hjust = 1)) +pls_rf_sr = merge(pls_sr, rf_sr, by = c("ptype", "resp", "Resample"), all.y = TRUE) +colnames(pls_rf_sr)[grep("\\.x", colnames(pls_rf_sr))] = + gsub("\\.x", "_pls", colnames(pls_rf_sr)[grep("\\.x", colnames(pls_rf_sr))]) +colnames(pls_rf_sr)[grep("\\.y", colnames(pls_rf_sr))] = + gsub("\\.y", "_rf", colnames(pls_rf_sr)[grep("\\.y", colnames(pls_rf_sr))]) +# nrow(pls_rf_sr) +ptypes = c("elui", "kmra", "spec", "elsp") +perf_check = lapply(ptypes, function(pt){ + subdf = pls_rf_sr[!is.na(pls_rf_sr$RMSE_pls) & + pls_rf_sr$ptype == pt & + pls_rf_sr$Resample == "Mean", ] + rownames(subdf[subdf$RMSE_pls < subdf$RMSE_rf, ]) +}) +names(perf_check) = ptypes -ggplot(data = models_sr[models_sr$ptype == "elui" | models_sr$ptype == "spec",], aes(x = resp, y = RMSE_normSD, fill = mptype)) + - geom_boxplot() + - labs(list(title = "PLS and RF", fill = "Predictor Set")) + - theme(axis.text.x = element_text(angle = 45, hjust = 1)) +# Check performance of PLS and RF for ELUI +pls_rf_sr[as.numeric(perf_check[[1]]),] + +# Check performance of PLS and RF for KMRA +pls_rf_sr[as.numeric(perf_check[[2]]),] +sort(round(1-pls_rf_sr[as.numeric(perf_check[[2]]), "RMSE_pls"] / pls_rf_sr[as.numeric(perf_check[[2]]), "RMSE_rf"],2)) +sort(round(pls_rf_sr[as.numeric(perf_check[[2]]), "nvars_rf"] / pls_rf_sr[as.numeric(perf_check[[2]]), "nvars_pls"],2)) + +# Check performance of PLS and RF for SPEC +pls_rf_sr[as.numeric(perf_check[[3]]),] +sort(round(1-pls_rf_sr[as.numeric(perf_check[[3]]), "RMSE_pls"] / pls_rf_sr[as.numeric(perf_check[[3]]), "RMSE_rf"],2)) +sort(round(pls_rf_sr[as.numeric(perf_check[[3]]), "nvars_rf"] / pls_rf_sr[as.numeric(perf_check[[3]]), "nvars_pls"],2)) + + + +# models_sr_wide = spread(models_sr[models_sr$Resample == "Mean",], "ptype", "RMSE_normSD") +# head(models_sr_wide) diff --git a/src/500_analyse_biodiv_sr.Rmd b/src/500_analyse_biodiv_sr.Rmd new file mode 100644 index 0000000..62a36f6 --- /dev/null +++ b/src/500_analyse_biodiv_sr.Rmd @@ -0,0 +1,123 @@ +--- +title: "500 Analyse Biodiv-RS" +output: html_notebook +--- + +```{r, include = FALSE} +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") + +dir.create(path_analysis_sr, showWarnings = FALSE) + +all_models = readRDS(file.path(path_compile_analysis_sr, "models_sr.rds")) + + +# Collect model performance +gam_sr = modelPerformance(all_models[["gam"]]) +pls_sr = modelPerformance(all_models[["pls"]]) +rf_sr = modelPerformance(all_models[["rf"]]) + +summary(gam_sr) +summary(pls_sr) +summary(rf_sr) + +# Get trophic levels +tl = read.table(file.path(path_meta, "trophic_levels.csv"), header = TRUE, sep = ";") +gam_sr = merge(gam_sr, tl, by.x = "resp", by.y = "Species") +pls_sr = merge(pls_sr, tl, by.x = "resp", by.y = "Species") +rf_sr = merge(rf_sr, tl, by.x = "resp", by.y = "Species") +``` + +# Compare PLS and RF +```{r, echo=FALSE} +models_sr = rbind(pls_sr[, -4], rf_sr[, -4]) +models_sr$mptype = paste0(models_sr$mtype, "_", models_sr$ptype) +models_sr$mptype = factor(models_sr$mptype, levels = c("pls_elsp", "rf_elsp", + "pls_elui", "rf_elui", + "pls_kmra", "rf_kmra", + "pls_spec", "rf_spec")) + + +ggplot(data = models_sr[models_sr$ptype == "elui" | models_sr$ptype == "spec",], aes(x = resp, y = RMSE_normSD, fill = mptype)) + + geom_boxplot() + + theme_bw() + + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + + labs(list(x = "Species groups", y = "RMSEn", fill = "Model set")) +``` + +```{r, echo=FALSE} +pls_rf_sr = merge(pls_sr, rf_sr, by = c("ptype", "resp", "Resample"), all.y = TRUE) +colnames(pls_rf_sr)[grep("\\.x", colnames(pls_rf_sr))] = + gsub("\\.x", "_pls", colnames(pls_rf_sr)[grep("\\.x", colnames(pls_rf_sr))]) +colnames(pls_rf_sr)[grep("\\.y", colnames(pls_rf_sr))] = + gsub("\\.y", "_rf", colnames(pls_rf_sr)[grep("\\.y", colnames(pls_rf_sr))]) +# nrow(pls_rf_sr) + +ptypes = c("elui", "kmra", "spec", "elsp") +perf_check = lapply(ptypes, function(pt){ + subdf = pls_rf_sr[!is.na(pls_rf_sr$RMSE_pls) & + pls_rf_sr$ptype == pt & + pls_rf_sr$Resample == "Mean", ] + rownames(subdf[subdf$RMSE_pls < subdf$RMSE_rf, ]) +}) +names(perf_check) = ptypes +``` + +# Check performance of PLS and RF +```{r, echo = FALSE} +for(i in seq(length(perf_check))){ +rmse_perf = sort(round(1-pls_rf_sr[as.numeric(perf_check[[i]]), "RMSE_pls"] / + pls_rf_sr[as.numeric(perf_check[[i]]), "RMSE_rf"],2)) +var_rf_prct = sort(round(pls_rf_sr[as.numeric(perf_check[[i]]), "nvars_rf"] / + pls_rf_sr[as.numeric(perf_check[[i]]), "nvars_pls"],2)) +level_pls = sort(table(pls_rf_sr[as.numeric(perf_check[[i]]), "Level_pls"])) +print(names(perf_check[i])) +print(pls_rf_sr[as.numeric(perf_check[[i]]),]) +cat("RMSE (1 - PLS/RF):", rmse_perf, "\n") +cat("Var number (RF/PLS):", var_rf_prct, "\n") +cat("Levels with PLS is better:", level_pls, "\n") +cat("\n\n") +} +``` + +# Collect variable importance +## Number of variables +```{r} +pls_rf_sr_long = melt(pls_rf_sr[pls_rf_sr$Resample == "Mean", c(1, 2, 6, 13)], id.vars = c("ptype", "resp")) +ggplot(data = pls_rf_sr_long, aes(x = variable, y = value, fill = ptype)) + + geom_boxplot() + + labs(list(x = "Models", y = "Number of variables" , + fill = "Predictor Set")) + + theme_bw() +``` + + +# Variable importance for PLS +```{r, echo=FALSE} +var_imp <- compVarImp(all_models[["pls"]][["spec"]]@model[[1]], scale = FALSE) +# plotVarImp(var_imp) +plotVarImpHeatmap(var_imp, xlab = "Species", ylab = "Band") +``` + +# Variable importance for RF +```{r, echo=FALSE} +var_imp <- compVarImp(all_models[["rf"]][["spec"]]@model[[1]], scale = FALSE) +# plotVarImp(var_imp) +plotVarImpHeatmap(var_imp, xlab = "Species", ylab = "Band") +``` + + +# Trophic levels +```{r} +var_imp_levels = var_imp +for(i in seq(length(var_imp_levels))){ + var_imp_levels[[i]]$RESPONSE = tl$Level[grep(var_imp_levels[[i]]$RESPONSE[1], tl$Species)] +} +plotVarImpHeatmap(var_imp_levels, xlab = "Species", ylab = "Band") +``` + + + + +When you save the notebook, an HTML file containing the code and output will be saved alongside it (click the *Preview* button or press *Ctrl+Shift+K* to preview the HTML file). + +The preview shows you a rendered HTML copy of the contents of the editor. Consequently, unlike *Knit*, *Preview* does not run any R code chunks. Instead, the output of the chunk when it was last run in the editor is displayed. diff --git a/src/500_analyse_biodiv_sr.nb.html b/src/500_analyse_biodiv_sr.nb.html new file mode 100644 index 0000000..5ed2f08 --- /dev/null +++ b/src/500_analyse_biodiv_sr.nb.html @@ -0,0 +1,372 @@ + + + + + + + + + + + + + +500 Analyse Biodiv-RS + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + + + + + + + + + + + + + + + + + + +
+

Compare PLS and RF

+ + + +

+ + + + + + + +
+
+

Check performance of PLS and RF

+ + + +
[1] "elui"
+ [1] ptype           resp            Resample        mtype_pls       ncomp           nvars_pls       RMSE_pls       
+ [8] Rsquared_pls    MAE_pls         RMSE_normSD_pls Level_pls       mtype_rf        mtry            nvars_rf       
+[15] RMSE_rf         Rsquared_rf     MAE_rf          RMSE_normSD_rf  Level_rf       
+<0 Zeilen> (oder row.names mit Länge 0)
+RMSE (1 - PLS/RF):  
+Var number (RF/PLS):  
+Levels with PLS is better: 0 0 0 0 0 0 
+
+
+[1] "kmra"
+    ptype       resp Resample mtype_pls ncomp nvars_pls RMSE_pls Rsquared_pls  MAE_pls RMSE_normSD_pls  Level_pls mtype_rf mtry
+241  kmra SRasterids     Mean       pls     8        14 4.379693    0.5013369 3.558558       0.7824208     Plants       rf    6
+305  kmra    SRferns     Mean       pls    11        12 4.701912    0.7137181 3.686251       0.5388445     Plants       rf    2
+329  kmra  SRmammals     Mean       pls     5         7 1.676879    0.2334310 1.422120       0.9741508 Generalist       rf    2
+345  kmra SRmonocots     Mean       pls    13        14 4.060297    0.7540859 2.972480       0.5711398     Plants       rf    8
+    nvars_rf  RMSE_rf Rsquared_rf   MAE_rf RMSE_normSD_rf   Level_rf
+241        8 4.876534   0.2983567 3.992938      0.8711802     Plants
+305        4 4.973091   0.6784929 4.025896      0.5699220     Plants
+329        3 1.686781   0.3031130 1.388244      0.9799032 Generalist
+345        3 4.378556   0.7194768 3.490220      0.6159075     Plants
+RMSE (1 - PLS/RF): 0.01 0.05 0.07 0.1 
+Var number (RF/PLS): 0.21 0.33 0.43 0.57 
+Levels with PLS is better: 0 0 0 0 1 3 
+
+
+[1] "spec"
+    ptype              resp Resample mtype_pls ncomp nvars_pls   RMSE_pls Rsquared_pls   MAE_pls RMSE_normSD_pls
+433  spec       SRallplants     Mean       pls    10        20 12.1677951    0.6404985 9.8793737       0.6038114
+449  spec            SRants     Mean       pls    16        23  1.1402304    0.8933173 0.9233010       0.3360080
+465  spec            SRbats     Mean       pls    12        22  1.2893364    0.8664830 1.0101511       0.3942589
+473  spec            SRbees     Mean       pls     6        19  2.4459734    0.8413755 2.0174785       0.4138771
+481  spec           SRbirds     Mean       pls     6        14  4.2239376    0.7781512 3.1281718       0.4910325
+489  spec      SRcollembola     Mean       pls     8        24  1.0518208    0.7729542 0.7911845       0.4280729
+513  spec        SReudicots     Mean       pls    11        17  1.4665003    0.5199711 1.1955748       0.6671803
+537  spec      SRmagnoliids     Mean       pls    13        21  0.6450509    0.7977228 0.5350513       0.4503717
+545  spec         SRmammals     Mean       pls    12        19  1.3371388    0.4846824 1.0720648       0.7767851
+593  spec SRothercoleoptera     Mean       pls    10        17  3.1074301    0.6235629 2.4441677       0.6358466
+609  spec          SRrosids     Mean       pls    10        21  5.1116419    0.7113718 3.9698183       0.5027286
+617  spec          SRsnails     Mean       pls    16        30  2.7158186    0.7472981 1.8932602       0.4878470
+           Level_pls mtype_rf mtry nvars_rf    RMSE_rf Rsquared_rf     MAE_rf RMSE_normSD_rf         Level_rf
+433           Plants       rf    7        9 13.0671744   0.6428939 10.7297639      0.6484419           Plants
+449       Generalist       rf    8        8  1.7206668   0.7564282  1.1918567      0.5070535       Generalist
+465 Flyingpredatores       rf    2        7  1.7621145   0.7801090  1.3642665      0.5388270 Flyingpredatores
+473        Herbivore       rf    8        6  2.4714365   0.8242960  1.8320004      0.4181857        Herbivore
+481 Flyingpredatores       rf    8        7  4.4892308   0.7962765  3.3893444      0.5218728 Flyingpredatores
+489       Decomposer       rf    7        8  1.0924602   0.8015405  0.8882414      0.4446124       Decomposer
+513           Plants       rf    4        4  1.5758132   0.4602090  1.2865897      0.7169120           Plants
+537           Plants       rf    6        8  0.6691076   0.8298201  0.4836353      0.4671680           Plants
+545       Generalist       rf    8        3  1.3750537   0.5186430  1.1302886      0.7988110       Generalist
+593        Predators       rf    7        8  3.3653395   0.6095221  2.7642226      0.6886204        Predators
+609           Plants       rf    2        5  5.6763627   0.7203280  4.3897044      0.5582687           Plants
+617       Generalist       rf    3        3  2.8439540   0.7518932  2.1876421      0.5108641       Generalist
+RMSE (1 - PLS/RF): 0.01 0.03 0.04 0.04 0.05 0.06 0.07 0.07 0.08 0.1 0.27 0.34 
+Var number (RF/PLS): 0.1 0.16 0.24 0.24 0.32 0.32 0.33 0.35 0.38 0.45 0.47 0.5 
+Levels with PLS is better: 1 1 1 2 3 4 
+
+
+[1] "elsp"
+    ptype              resp Resample mtype_pls ncomp nvars_pls RMSE_pls Rsquared_pls  MAE_pls RMSE_normSD_pls  Level_pls
+649  elsp       SRallplants     Mean       pls    12        21 9.762681    0.7556949 7.467871       0.4804236     Plants
+673  elsp        SRasterids     Mean       pls    15        25 3.880332    0.5859014 3.304183       0.6880815     Plants
+809  elsp SRothercoleoptera     Mean       pls     8        14 3.298003    0.5622939 2.618039       0.6748419  Predators
+849  elsp        SRsyrphids     Mean       pls     7        24 1.939375    0.6371102 1.518929       0.5864162 Generalist
+    mtype_rf mtry nvars_rf   RMSE_rf Rsquared_rf    MAE_rf RMSE_normSD_rf   Level_rf
+649       rf    7        6 13.646908   0.5863973 11.277148      0.6715672     Plants
+673       rf    7        4  4.196627   0.5075030  3.459266      0.7441684     Plants
+809       rf    4        6  3.386110   0.5924158  2.858294      0.6928704  Predators
+849       rf    7        5  2.099933   0.5995575  1.712869      0.6349646 Generalist
+RMSE (1 - PLS/RF): 0.03 0.08 0.08 0.28 
+Var number (RF/PLS): 0.16 0.21 0.29 0.43 
+Levels with PLS is better: 0 0 0 1 1 2 
+ + + +
+
+

Collect variable importance

+
+

Number of variables

+ + + +
pls_rf_sr_long = melt(pls_rf_sr[pls_rf_sr$Resample == "Mean", c(1, 2, 6, 13)], id.vars = c("ptype", "resp"))
+ggplot(data = pls_rf_sr_long, aes(x = variable, y = value, fill = ptype)) +
+  geom_boxplot() + 
+  labs(list(x = "Models", y = "Number of variables" ,
+            fill = "Predictor Set")) +
+  theme_bw()
+ + +

+ + + +
+
+
+

Variable importance for PLS

+ + + +

+ + + +
+
+

Variable importance for RF

+ + + +

+ + + +
+
+

Trophic levels

+ + + +

+ + + +

When you save the notebook, an HTML file containing the code and output will be saved alongside it (click the Preview button or press Ctrl+Shift+K to preview the HTML file).

+

The preview shows you a rendered HTML copy of the contents of the editor. Consequently, unlike Knit, Preview does not run any R code chunks. Instead, the output of the chunk when it was last run in the editor is displayed.

+ +
+ +
LS0tDQp0aXRsZTogIjUwMCBBbmFseXNlIEJpb2Rpdi1SUyINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCmBgYHtyLCBpbmNsdWRlID0gRkFMU0V9DQpzb3VyY2UoIkM6L1VzZXJzL3RuYXVzcy9wZXJtYW5lbnQvcGx5Z3JuZC9LSS1IeXBlcnNwZWMvSHlTcGVjX0tpTGkvc3JjLzAwMF9zZXRfZW52aXJvbm1lbnQuUiIpDQoNCmRpci5jcmVhdGUocGF0aF9hbmFseXNpc19zciwgc2hvd1dhcm5pbmdzID0gRkFMU0UpDQoNCmFsbF9tb2RlbHMgPSByZWFkUkRTKGZpbGUucGF0aChwYXRoX2NvbXBpbGVfYW5hbHlzaXNfc3IsICJtb2RlbHNfc3IucmRzIikpDQoNCg0KIyBDb2xsZWN0IG1vZGVsIHBlcmZvcm1hbmNlDQpnYW1fc3IgPSBtb2RlbFBlcmZvcm1hbmNlKGFsbF9tb2RlbHNbWyJnYW0iXV0pDQpwbHNfc3IgPSBtb2RlbFBlcmZvcm1hbmNlKGFsbF9tb2RlbHNbWyJwbHMiXV0pDQpyZl9zciA9IG1vZGVsUGVyZm9ybWFuY2UoYWxsX21vZGVsc1tbInJmIl1dKQ0KDQpzdW1tYXJ5KGdhbV9zcikNCnN1bW1hcnkocGxzX3NyKQ0Kc3VtbWFyeShyZl9zcikNCg0KIyBHZXQgdHJvcGhpYyBsZXZlbHMNCnRsID0gcmVhZC50YWJsZShmaWxlLnBhdGgocGF0aF9tZXRhLCAidHJvcGhpY19sZXZlbHMuY3N2IiksIGhlYWRlciA9IFRSVUUsIHNlcCA9ICI7IikNCmdhbV9zciA9IG1lcmdlKGdhbV9zciwgdGwsIGJ5LnggPSAicmVzcCIsIGJ5LnkgPSAiU3BlY2llcyIpDQpwbHNfc3IgPSBtZXJnZShwbHNfc3IsIHRsLCBieS54ID0gInJlc3AiLCBieS55ID0gIlNwZWNpZXMiKQ0KcmZfc3IgPSBtZXJnZShyZl9zciwgdGwsIGJ5LnggPSAicmVzcCIsIGJ5LnkgPSAiU3BlY2llcyIpDQpgYGANCg0KIyBDb21wYXJlIFBMUyBhbmQgUkYNCmBgYHtyLCBlY2hvPUZBTFNFfQ0KbW9kZWxzX3NyID0gcmJpbmQocGxzX3NyWywgLTRdLCByZl9zclssIC00XSkNCm1vZGVsc19zciRtcHR5cGUgPSBwYXN0ZTAobW9kZWxzX3NyJG10eXBlLCAiXyIsIG1vZGVsc19zciRwdHlwZSkNCm1vZGVsc19zciRtcHR5cGUgPSBmYWN0b3IobW9kZWxzX3NyJG1wdHlwZSwgbGV2ZWxzID0gYygicGxzX2Vsc3AiLCAicmZfZWxzcCIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgInBsc19lbHVpIiwgInJmX2VsdWkiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICJwbHNfa21yYSIsICJyZl9rbXJhIiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAicGxzX3NwZWMiLCAicmZfc3BlYyIpKQ0KDQoNCmdncGxvdChkYXRhID0gbW9kZWxzX3NyW21vZGVsc19zciRwdHlwZSA9PSAiZWx1aSIgfCBtb2RlbHNfc3IkcHR5cGUgPT0gInNwZWMiLF0sIGFlcyh4ID0gcmVzcCwgeSA9IFJNU0Vfbm9ybVNELCBmaWxsID0gbXB0eXBlKSkgKyANCiAgZ2VvbV9ib3hwbG90KCkgKw0KICB0aGVtZV9idygpICsgDQogIHRoZW1lKGF4aXMudGV4dC54ID0gZWxlbWVudF90ZXh0KGFuZ2xlID0gNDUsIGhqdXN0ID0gMSkpICsgDQogIGxhYnMobGlzdCh4ID0gIlNwZWNpZXMgZ3JvdXBzIiwgeSA9ICJSTVNFbiIsIGZpbGwgPSAiTW9kZWwgc2V0IikpDQpgYGANCg0KYGBge3IsIGVjaG89RkFMU0V9DQpwbHNfcmZfc3IgPSBtZXJnZShwbHNfc3IsIHJmX3NyLCBieSA9IGMoInB0eXBlIiwgInJlc3AiLCAiUmVzYW1wbGUiKSwgYWxsLnkgPSBUUlVFKQ0KY29sbmFtZXMocGxzX3JmX3NyKVtncmVwKCJcXC54IiwgY29sbmFtZXMocGxzX3JmX3NyKSldID0gDQogIGdzdWIoIlxcLngiLCAiX3BscyIsIGNvbG5hbWVzKHBsc19yZl9zcilbZ3JlcCgiXFwueCIsIGNvbG5hbWVzKHBsc19yZl9zcikpXSkNCmNvbG5hbWVzKHBsc19yZl9zcilbZ3JlcCgiXFwueSIsIGNvbG5hbWVzKHBsc19yZl9zcikpXSA9IA0KICBnc3ViKCJcXC55IiwgIl9yZiIsIGNvbG5hbWVzKHBsc19yZl9zcilbZ3JlcCgiXFwueSIsIGNvbG5hbWVzKHBsc19yZl9zcikpXSkNCiMgbnJvdyhwbHNfcmZfc3IpDQoNCnB0eXBlcyA9IGMoImVsdWkiLCAia21yYSIsICJzcGVjIiwgImVsc3AiKQ0KcGVyZl9jaGVjayA9IGxhcHBseShwdHlwZXMsIGZ1bmN0aW9uKHB0KXsNCiAgc3ViZGYgPSBwbHNfcmZfc3JbIWlzLm5hKHBsc19yZl9zciRSTVNFX3BscykgJiANCiAgICAgICAgICAgICAgICAgICAgICBwbHNfcmZfc3IkcHR5cGUgPT0gcHQgJg0KICAgICAgICAgICAgICAgICAgICAgIHBsc19yZl9zciRSZXNhbXBsZSA9PSAiTWVhbiIsIF0NCiAgcm93bmFtZXMoc3ViZGZbc3ViZGYkUk1TRV9wbHMgPCBzdWJkZiRSTVNFX3JmLCBdKQ0KfSkNCm5hbWVzKHBlcmZfY2hlY2spID0gcHR5cGVzDQpgYGANCg0KIyBDaGVjayBwZXJmb3JtYW5jZSBvZiBQTFMgYW5kIFJGDQpgYGB7ciwgZWNobyA9IEZBTFNFfQ0KZm9yKGkgaW4gc2VxKGxlbmd0aChwZXJmX2NoZWNrKSkpew0Kcm1zZV9wZXJmID0gc29ydChyb3VuZCgxLXBsc19yZl9zclthcy5udW1lcmljKHBlcmZfY2hlY2tbW2ldXSksICJSTVNFX3BscyJdIC8gDQogICAgICAgICAgICAgICAgICAgICAgICAgcGxzX3JmX3NyW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIlJNU0VfcmYiXSwyKSkNCnZhcl9yZl9wcmN0ID0gc29ydChyb3VuZChwbHNfcmZfc3JbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLCAibnZhcnNfcmYiXSAvIA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgcGxzX3JmX3NyW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIm52YXJzX3BscyJdLDIpKQ0KbGV2ZWxfcGxzID0gc29ydCh0YWJsZShwbHNfcmZfc3JbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLCAiTGV2ZWxfcGxzIl0pKQ0KcHJpbnQobmFtZXMocGVyZl9jaGVja1tpXSkpDQpwcmludChwbHNfcmZfc3JbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLF0pDQpjYXQoIlJNU0UgKDEgLSBQTFMvUkYpOiIsIHJtc2VfcGVyZiwgIlxuIikNCmNhdCgiVmFyIG51bWJlciAoUkYvUExTKToiLCB2YXJfcmZfcHJjdCwgIlxuIikNCmNhdCgiTGV2ZWxzIHdpdGggUExTIGlzIGJldHRlcjoiLCBsZXZlbF9wbHMsICJcbiIpDQpjYXQoIlxuXG4iKQ0KfQ0KYGBgDQoNCiMgQ29sbGVjdCB2YXJpYWJsZSBpbXBvcnRhbmNlDQojIyBOdW1iZXIgb2YgdmFyaWFibGVzDQpgYGB7cn0NCnBsc19yZl9zcl9sb25nID0gbWVsdChwbHNfcmZfc3JbcGxzX3JmX3NyJFJlc2FtcGxlID09ICJNZWFuIiwgYygxLCAyLCA2LCAxMyldLCBpZC52YXJzID0gYygicHR5cGUiLCAicmVzcCIpKQ0KZ2dwbG90KGRhdGEgPSBwbHNfcmZfc3JfbG9uZywgYWVzKHggPSB2YXJpYWJsZSwgeSA9IHZhbHVlLCBmaWxsID0gcHR5cGUpKSArDQogIGdlb21fYm94cGxvdCgpICsgDQogIGxhYnMobGlzdCh4ID0gIk1vZGVscyIsIHkgPSAiTnVtYmVyIG9mIHZhcmlhYmxlcyIgLA0KICAgICAgICAgICAgZmlsbCA9ICJQcmVkaWN0b3IgU2V0IikpICsNCiAgdGhlbWVfYncoKQ0KYGBgDQoNCg0KIyBWYXJpYWJsZSBpbXBvcnRhbmNlIGZvciBQTFMNCmBgYHtyLCBlY2hvPUZBTFNFfQ0KdmFyX2ltcCA8LSBjb21wVmFySW1wKGFsbF9tb2RlbHNbWyJwbHMiXV1bWyJzcGVjIl1dQG1vZGVsW1sxXV0sIHNjYWxlID0gRkFMU0UpDQojIHBsb3RWYXJJbXAodmFyX2ltcCkNCnBsb3RWYXJJbXBIZWF0bWFwKHZhcl9pbXAsIHhsYWIgPSAiU3BlY2llcyIsIHlsYWIgPSAiQmFuZCIpDQpgYGANCg0KIyBWYXJpYWJsZSBpbXBvcnRhbmNlIGZvciBSRg0KYGBge3IsIGVjaG89RkFMU0V9DQp2YXJfaW1wIDwtIGNvbXBWYXJJbXAoYWxsX21vZGVsc1tbInJmIl1dW1sic3BlYyJdXUBtb2RlbFtbMV1dLCBzY2FsZSA9IEZBTFNFKQ0KIyBwbG90VmFySW1wKHZhcl9pbXApDQpwbG90VmFySW1wSGVhdG1hcCh2YXJfaW1wLCB4bGFiID0gIlNwZWNpZXMiLCB5bGFiID0gIkJhbmQiKQ0KYGBgDQoNCg0KIyBUcm9waGljIGxldmVscw0KYGBge3J9DQp2YXJfaW1wX2xldmVscyA9IHZhcl9pbXANCmZvcihpIGluIHNlcShsZW5ndGgodmFyX2ltcF9sZXZlbHMpKSl7DQogIHZhcl9pbXBfbGV2ZWxzW1tpXV0kUkVTUE9OU0UgPSB0bCRMZXZlbFtncmVwKHZhcl9pbXBfbGV2ZWxzW1tpXV0kUkVTUE9OU0VbMV0sIHRsJFNwZWNpZXMpXQ0KfQ0KcGxvdFZhckltcEhlYXRtYXAodmFyX2ltcF9sZXZlbHMsIHhsYWIgPSAiU3BlY2llcyIsIHlsYWIgPSAiQmFuZCIpDQpgYGANCg0KDQoNCg0KV2hlbiB5b3Ugc2F2ZSB0aGUgbm90ZWJvb2ssIGFuIEhUTUwgZmlsZSBjb250YWluaW5nIHRoZSBjb2RlIGFuZCBvdXRwdXQgd2lsbCBiZSBzYXZlZCBhbG9uZ3NpZGUgaXQgKGNsaWNrIHRoZSAqUHJldmlldyogYnV0dG9uIG9yIHByZXNzICpDdHJsK1NoaWZ0K0sqIHRvIHByZXZpZXcgdGhlIEhUTUwgZmlsZSkuDQoNClRoZSBwcmV2aWV3IHNob3dzIHlvdSBhIHJlbmRlcmVkIEhUTUwgY29weSBvZiB0aGUgY29udGVudHMgb2YgdGhlIGVkaXRvci4gQ29uc2VxdWVudGx5LCB1bmxpa2UgKktuaXQqLCAqUHJldmlldyogZG9lcyBub3QgcnVuIGFueSBSIGNvZGUgY2h1bmtzLiBJbnN0ZWFkLCB0aGUgb3V0cHV0IG9mIHRoZSBjaHVuayB3aGVuIGl0IHdhcyBsYXN0IHJ1biBpbiB0aGUgZWRpdG9yIGlzIGRpc3BsYXllZC4NCg==
+ + + +
+ + + + + + + + diff --git a/src/findings.txt b/src/findings.txt new file mode 100644 index 0000000..bf1bd47 --- /dev/null +++ b/src/findings.txt @@ -0,0 +1,20 @@ +ELUI +RF always performs better than PLS for elui. + +KMRA +PLS better for: SRasterids, SRferns, SRmammals, SRmonocots +RMSE percentage difference: 0.01 0.05 0.07 0.10 +Variables used by RF/PLS: 0.21 0.33 0.43 0.57 +RF performs worse than PLS for kmra for 4 groups. Differences in RMSE range between 1% and 10%. RF requires only between 21% and 57% of the variables. + +SPEC +PLS better for: SRallplants, SRants, SRbats, SRbees, SRbirds, SRcollembola, SReudicots, SRmagnoliids, SRmammals, SRothercoleoptera, SRrosids, SRsnails +RMSE percentage difference: 0.01 0.03 0.04 0.04 0.05 0.06 0.07 0.07 0.08 0.10 0.27 0.34 +Variables used by RF/PLS: 0.10 0.16 0.24 0.24 0.32 0.32 0.33 0.35 0.38 0.45 0.47 0.50 +RF performs worse than PLS for spec for 12 groups. Differences in RMSE range between 1% and 34%. RF requires only between 10% and 50% of the variables. + +ELSP +PLS better for: SRallplants, SRasterids, SRothercoleoptera, SRsyrphids +RMSE percentage difference: 0.03 0.08 0.08 0.28 +Variables used by RF/PLS: 0.16 0.21 0.29 0.43 +RF performs worse than PLS for elsp for 4 groups. Differences in RMSE range between 3% and 28%. RF requires only between 16% and 43% of the variables. \ No newline at end of file From fa6263997e249d903c2eb9073c38b785df17a7f5 Mon Sep 17 00:00:00 2001 From: "Nauss, Thomas" Date: Sat, 26 Jan 2019 15:35:21 +0100 Subject: [PATCH 40/65] Fix bug in 310 sr prediction --- src/202_predict_biodiv_sr_pls.R | 126 --------- src/204_predict_biodiv_sr_gam.R | 150 ----------- src/206_predict_biodiv_sr_combined.R | 265 ------------------- src/310_predict_biodiv_sr_res_rf.R | 3 +- src/312_predict_biodiv_sr_res_pls.R | 127 --------- src/314_predict_biodiv_sr_res_gam.R | 127 --------- src/316_predict_biodiv_sr_res_rf_combined.R | 263 ------------------ src/410_compile_analyse_biodiv_sr_elev_res.R | 31 +-- 8 files changed, 9 insertions(+), 1083 deletions(-) delete mode 100644 src/202_predict_biodiv_sr_pls.R delete mode 100644 src/204_predict_biodiv_sr_gam.R delete mode 100644 src/206_predict_biodiv_sr_combined.R delete mode 100644 src/312_predict_biodiv_sr_res_pls.R delete mode 100644 src/314_predict_biodiv_sr_res_gam.R delete mode 100644 src/316_predict_biodiv_sr_res_rf_combined.R diff --git a/src/202_predict_biodiv_sr_pls.R b/src/202_predict_biodiv_sr_pls.R deleted file mode 100644 index 98d5769..0000000 --- a/src/202_predict_biodiv_sr_pls.R +++ /dev/null @@ -1,126 +0,0 @@ -# Combine hyperspectral predictores and biodiversity variables in gpm class. -if(Sys.info()["sysname"] == "Windows"){ - filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" -} else { - filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" -} -source(filepath_base) - -if(length(showConnections()) == 0){ - cores = 20 - cl = parallel::makeCluster(cores) - doParallel::registerDoParallel(cl) -} - -dir.create(paste0(path_model_gpm_sr), showWarnings = FALSE) - -comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) - - -# Predict with all elevation and lui information only -comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[c(1:7)] - - -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { - - model = comb - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "pls", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_elui_non_scaled_pls_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - -# Predict with hyperspectral data only -comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[-c(1:7)] - -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { - - model = comb - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "pls", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_spec_non_scaled_pls_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - - -# Predict with all data -comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR - -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { - - model = comb - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "pls", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_elsp_non_scaled_pls_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - - - -# Predict with kmdc and raoq only -comb@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ - c(grep("kmdc", comb@meta$input$PREDICTOR), - grep("raoq", comb@meta$input$PREDICTOR))]) - - -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { - - model = comb - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "pls", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_kmra_non_scaled_pls_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} -stopCluster(cl) \ No newline at end of file diff --git a/src/204_predict_biodiv_sr_gam.R b/src/204_predict_biodiv_sr_gam.R deleted file mode 100644 index 338ab7c..0000000 --- a/src/204_predict_biodiv_sr_gam.R +++ /dev/null @@ -1,150 +0,0 @@ -# Combine hyperspectral predictores and biodiversity variables in gpm class. -if(Sys.info()["sysname"] == "Windows"){ - filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" -} else { - filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" -} -source(filepath_base) - -if(length(showConnections()) == 0){ - cores = 20 - cl = parallel::makeCluster(cores) - doParallel::registerDoParallel(cl) -} - -dir.create(paste0(path_model_gpm_sr), showWarnings = FALSE) - -comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) - -# Predict with elevation information only -comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[1] - -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { - - model = comb - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "gam", - mode = "none", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_elev_non_scaled_gam_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - -# Predict with all elevation and lui information only -comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[c(1:7)] - - -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { - - model = comb - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "gam", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_elui_non_scaled_gam_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - -# Predict with hyperspectral data only -comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[-c(1:7)] - -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { - - model = comb - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "gam", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_spec_non_scaled_gam_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - - -# Predict with all data -comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR - -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { - - model = comb - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "gam", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_elsp_non_scaled_gam_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - - - -# Predict with kmdc and raoq only -comb@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ - c(grep("kmdc", comb@meta$input$PREDICTOR), - grep("raoq", comb@meta$input$PREDICTOR))]) - - -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { - - model = comb - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "gam", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_kmra_non_scaled_gam_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} -stopCluster(cl) \ No newline at end of file diff --git a/src/206_predict_biodiv_sr_combined.R b/src/206_predict_biodiv_sr_combined.R deleted file mode 100644 index 5547331..0000000 --- a/src/206_predict_biodiv_sr_combined.R +++ /dev/null @@ -1,265 +0,0 @@ -# Combine hyperspectral predictores and biodiversity variables in gpm class. -if(Sys.info()["sysname"] == "Windows"){ - filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" -} else { - filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" -} -source(filepath_base) - -if(length(showConnections()) == 0){ - cores = 20 - cl = parallel::makeCluster(cores) - doParallel::registerDoParallel(cl) -} - -dir.create(paste0(path_model_gpm_sr), showWarnings = FALSE) - -comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) - - - - - -# Predict with kmdc and raoq only -comb@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ - c(grep("kmdc", comb@meta$input$PREDICTOR), - grep("raoq", comb@meta$input$PREDICTOR))]) - - -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { - - model = comb - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "rf", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_kmra_non_scaled_rf_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - -# Predict with all elevation and lui information only -comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[c(1:7)] - - -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { - - model = comb - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "pls", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_elui_non_scaled_pls_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - -# Predict with hyperspectral data only -comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[-c(1:7)] - -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { - - model = comb - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "pls", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_spec_non_scaled_pls_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - - -# Predict with all data -comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR - -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { - - model = comb - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "pls", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_elsp_non_scaled_pls_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - - - -# Predict with kmdc and raoq only -comb@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ - c(grep("kmdc", comb@meta$input$PREDICTOR), - grep("raoq", comb@meta$input$PREDICTOR))]) - - -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { - - model = comb - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "pls", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_kmra_non_scaled_pls_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - -# Predict with all elevation and lui information only -comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[c(1:7)] - - -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { - - model = comb - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "gam", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_elui_non_scaled_gam_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - -# Predict with hyperspectral data only -comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[-c(1:7)] - -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { - - model = comb - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "gam", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_spec_non_scaled_gam_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - - -# Predict with all data -comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR - -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { - - model = comb - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "gam", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_elsp_non_scaled_gam_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - - - -# Predict with kmdc and raoq only -comb@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ - c(grep("kmdc", comb@meta$input$PREDICTOR), - grep("raoq", comb@meta$input$PREDICTOR))]) - - -foreach (i = seq(length(comb@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { - - model = comb - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "gam", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr, - "ki_sr_kmra_non_scaled_gam_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - -stopCluster(cl) \ No newline at end of file diff --git a/src/310_predict_biodiv_sr_res_rf.R b/src/310_predict_biodiv_sr_res_rf.R index dfc1030..745291d 100644 --- a/src/310_predict_biodiv_sr_res_rf.R +++ b/src/310_predict_biodiv_sr_res_rf.R @@ -16,7 +16,8 @@ dir.create(paste0(path_model_gpm_sr_res), showWarnings = FALSE) # Predict gam, pls and rf elevation and elevation/lui based residuals using # pls and rf models with hyperspectral data only -res_suffixes = c("_gam_elev_res", "pls_elui_res", "rf_elui_res") +res_suffixes = c("_gam_elev_res", "_pls_elui_res", "_rf_elui_res") +res_suffixes = c("_pls_elui_res", "_rf_elui_res") mtypes = c("*pls*", "*rf*") pt = "*spec*" diff --git a/src/312_predict_biodiv_sr_res_pls.R b/src/312_predict_biodiv_sr_res_pls.R deleted file mode 100644 index e6b5a4a..0000000 --- a/src/312_predict_biodiv_sr_res_pls.R +++ /dev/null @@ -1,127 +0,0 @@ -# comb_elev_resine hyperspectral predictores and biodiversity variables in gpm class. -if(Sys.info()["sysname"] == "Windows"){ - filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" -} else { - filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" -} -source(filepath_base) - -if(length(showConnections()) == 0){ - cores = 20 - cl = parallel::makeCluster(cores) - doParallel::registerDoParallel(cl) -} - -dir.create(paste0(path_model_gpm_sr_elev_res), showWarnings = FALSE) - -comb_elev_res = readRDS(paste0(path_comb_gpm_sr_elev_res, "ki_hyperspec_biodiv_non_scaled_elev_res.rds")) - - -# Predict with all elevation and lui information only -comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR[c(1:7)] - - -foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { - - model = comb_elev_res - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "pls", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_elui_non_scaled_elev_res_pls_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - -# Predict with hyperspectral data only -comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR[-c(1:7)] - -foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { - - model = comb_elev_res - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "pls", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_spec_non_scaled_elev_res_pls_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - - -# Predict with all data -comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR - -foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { - - model = comb_elev_res - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "pls", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_elsp_non_scaled_elev_res_pls_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - - - -# Predict with kmdc and raoq only -comb_elev_res@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ - c(grep("kmdc", comb@meta$input$PREDICTOR), - grep("raoq", comb@meta$input$PREDICTOR))]) - -foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { - - model = comb_elev_res - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "pls", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_kmra_non_scaled_elev_res_pls_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - - -stopCluster(cl) \ No newline at end of file diff --git a/src/314_predict_biodiv_sr_res_gam.R b/src/314_predict_biodiv_sr_res_gam.R deleted file mode 100644 index c3a3e76..0000000 --- a/src/314_predict_biodiv_sr_res_gam.R +++ /dev/null @@ -1,127 +0,0 @@ -# comb_elev_resine hyperspectral predictores and biodiversity variables in gpm class. -if(Sys.info()["sysname"] == "Windows"){ - filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" -} else { - filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" -} -source(filepath_base) - -if(length(showConnections()) == 0){ - cores = 20 - cl = parallel::makeCluster(cores) - doParallel::registerDoParallel(cl) -} - -dir.create(paste0(path_model_gpm_sr_elev_res), showWarnings = FALSE) - -comb_elev_res = readRDS(paste0(path_comb_gpm_sr_elev_res, "ki_hyperspec_biodiv_non_scaled_elev_res.rds")) - - -# Predict with all elevation and lui information only -comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR[c(1:7)] - - -foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { - - model = comb_elev_res - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "gam", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_elui_non_scaled_elev_res_gam_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - -# Predict with hyperspectral data only -comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR[-c(1:7)] - -foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { - - model = comb_elev_res - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "gam", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_spec_non_scaled_elev_res_gam_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - - -# Predict with all data -comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR - -foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { - - model = comb_elev_res - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "gam", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_elsp_non_scaled_elev_res_gam_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - - - -# Predict with kmdc and raoq only -comb_elev_res@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ - c(grep("kmdc", comb@meta$input$PREDICTOR), - grep("raoq", comb@meta$input$PREDICTOR))]) - -foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { - - model = comb_elev_res - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "gam", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_kmra_non_scaled_elev_res_gam_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - - -stopCluster(cl) \ No newline at end of file diff --git a/src/316_predict_biodiv_sr_res_rf_combined.R b/src/316_predict_biodiv_sr_res_rf_combined.R deleted file mode 100644 index b682dbc..0000000 --- a/src/316_predict_biodiv_sr_res_rf_combined.R +++ /dev/null @@ -1,263 +0,0 @@ -# comb_elev_resine hyperspectral predictores and biodiversity variables in gpm class. -if(Sys.info()["sysname"] == "Windows"){ - filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" -} else { - filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" -} -source(filepath_base) - -if(length(showConnections()) == 0){ - cores = 20 - cl = parallel::makeCluster(cores) - doParallel::registerDoParallel(cl) -} - -dir.create(paste0(path_model_gpm_sr_elev_res), showWarnings = FALSE) - -comb_elev_res = readRDS(paste0(path_comb_gpm_sr_elev_res, "ki_hyperspec_biodiv_non_scaled_elev_res.rds")) - - - - -# Predict with kmdc and raoq only -comb_elev_res@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ - c(grep("kmdc", comb@meta$input$PREDICTOR), - grep("raoq", comb@meta$input$PREDICTOR))]) - -foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { - - model = comb_elev_res - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "rf", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_kmra_non_scaled_elev_res_rf_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - - -# Predict with all elevation and lui information only -comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR[c(1:7)] - - -foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { - - model = comb_elev_res - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "pls", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_elui_non_scaled_elev_res_pls_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - -# Predict with hyperspectral data only -comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR[-c(1:7)] - -foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { - - model = comb_elev_res - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "pls", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_spec_non_scaled_elev_res_pls_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - - -# Predict with all data -comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR - -foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { - - model = comb_elev_res - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "pls", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_elsp_non_scaled_elev_res_pls_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - - - -# Predict with kmdc and raoq only -comb_elev_res@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ - c(grep("kmdc", comb@meta$input$PREDICTOR), - grep("raoq", comb@meta$input$PREDICTOR))]) - -foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "pls", "CAST")) %dopar% { - - model = comb_elev_res - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "pls", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_kmra_non_scaled_elev_res_pls_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - -# Predict with all elevation and lui information only -comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR[c(1:7)] - - -foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { - - model = comb_elev_res - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "gam", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_elui_non_scaled_elev_res_gam_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - -# Predict with hyperspectral data only -comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR[-c(1:7)] - -foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { - - model = comb_elev_res - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "gam", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_spec_non_scaled_elev_res_gam_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - - -# Predict with all data -comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR - -foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { - - model = comb_elev_res - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "gam", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_elsp_non_scaled_elev_res_gam_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - - - -# Predict with kmdc and raoq only -comb_elev_res@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ - c(grep("kmdc", comb@meta$input$PREDICTOR), - grep("raoq", comb@meta$input$PREDICTOR))]) - -foreach (i = seq(length(comb_elev_res@meta$input$RESPONSE)), .packages = c("gpm", "caret", "mgcv", "CAST")) %dopar% { - - model = comb_elev_res - model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] - model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = "gam", - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) - - saveRDS(model, file = paste0(path_model_gpm_sr_elev_res, - "ki_sr_kmra_non_scaled_elev_res_gam_", - model@meta$input$RESPONSE_FINAL, - ".rds")) -} - - -stopCluster(cl) \ No newline at end of file diff --git a/src/410_compile_analyse_biodiv_sr_elev_res.R b/src/410_compile_analyse_biodiv_sr_elev_res.R index cbfc3b3..2ddac3c 100644 --- a/src/410_compile_analyse_biodiv_sr_elev_res.R +++ b/src/410_compile_analyse_biodiv_sr_elev_res.R @@ -1,5 +1,4 @@ -# Combine hyperspectral predictores and biodiversity variables in gpm class. - +# Combine species richness residual model results in one variable. source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") @@ -8,31 +7,17 @@ dir.create(path_compile_analysis_sr_elev_res, showWarnings = FALSE) # Combine all models into one gpm object ptypes = c("*elui*", "*kmra*", "*spec*", "*elsp*") -mtypes = c("gam_none", "*_gam_*", "*_pls_*", "*_rf_*") +mtypes = c("*gam*", "*pls*", "*rf*") all_models = lapply(mtypes, function(mt){ all_pmodels = lapply(ptypes, function(pt){ - use_model_nbr = 2 - if(mt == "gam_none"){ - use_model_nbr = 1 - model_files = list.files(path_model_gpm_sr_elev_res, full.names = TRUE, - pattern = glob2rx(paste0(pt, "*_gam_*"))) - } else { - - model_files = list.files(path_model_gpm_sr_elev_res, full.names = TRUE, - pattern = glob2rx(paste0(pt, mt))) - } - + model_files = list.files(path_model_gpm_sr, full.names = TRUE, + pattern = glob2rx(paste0(pt, mt))) all_models = readRDS(model_files[[1]]) - if(mt == "gam_none"){ - all_models@model$gam_ffs = NULL - } else { - all_models@model$gam_none = NULL - } for(i in (seq(2, length(model_files)))){ - all_models@model[[1]][[i]] = readRDS(model_files[[i]])@model[[use_model_nbr]][[1]] + all_models@model[[1]][[i]] = readRDS(model_files[[i]])@model[[1]][[1]] } return(all_models) @@ -42,7 +27,5 @@ all_models = lapply(mtypes, function(mt){ }) names(all_models) = gsub("[*]", "", gsub("_", "", mtypes)) -saveRDS(all_models, file = file.path(path_compile_analysis_sr_elev_res, - "models_sr_elev_res.rds")) - - +saveRDS(all_models, file = file.path(path_compile_analysis_sr, + "models_sr.rds")) From fc16d162d8256110a204ac7e985e60682a12ad08 Mon Sep 17 00:00:00 2001 From: "Nauss, Thomas" Date: Sat, 26 Jan 2019 16:04:03 +0100 Subject: [PATCH 41/65] Another bugfix in function compModels --- src/001_functions.R | 2 +- src/310_predict_biodiv_sr_res_rf.R | 2 +- src/410_compile_analyse_biodiv_sr_elev_res.R | 15 +- src/500_analyse_biodiv_sr.R | 79 ---- src/510_analyse_biodiv_sr_elev_res.R | 71 --- src/510_analyse_biodiv_sr_elev_res.Rmd | 126 +++++ src/510_analyse_biodiv_sr_elev_res.nb.html | 460 +++++++++++++++++++ 7 files changed, 596 insertions(+), 159 deletions(-) delete mode 100644 src/500_analyse_biodiv_sr.R delete mode 100644 src/510_analyse_biodiv_sr_elev_res.R create mode 100644 src/510_analyse_biodiv_sr_elev_res.Rmd create mode 100644 src/510_analyse_biodiv_sr_elev_res.nb.html diff --git a/src/001_functions.R b/src/001_functions.R index c9fa8a1..7897b1f 100644 --- a/src/001_functions.R +++ b/src/001_functions.R @@ -65,7 +65,7 @@ compModels = function(model, pt, mt, outpath){ model = trainModel(x = model, metric = "RMSE", n_var = NULL, - mthd = "rf", + mthd = mt, mode = "ffs", seed_nbr = 11, cv_nbr = NULL, diff --git a/src/310_predict_biodiv_sr_res_rf.R b/src/310_predict_biodiv_sr_res_rf.R index 745291d..791e928 100644 --- a/src/310_predict_biodiv_sr_res_rf.R +++ b/src/310_predict_biodiv_sr_res_rf.R @@ -18,7 +18,7 @@ dir.create(paste0(path_model_gpm_sr_res), showWarnings = FALSE) # pls and rf models with hyperspectral data only res_suffixes = c("_gam_elev_res", "_pls_elui_res", "_rf_elui_res") res_suffixes = c("_pls_elui_res", "_rf_elui_res") -mtypes = c("*pls*", "*rf*") +mtypes = c("pls", "rf") pt = "*spec*" diff --git a/src/410_compile_analyse_biodiv_sr_elev_res.R b/src/410_compile_analyse_biodiv_sr_elev_res.R index 2ddac3c..4a89930 100644 --- a/src/410_compile_analyse_biodiv_sr_elev_res.R +++ b/src/410_compile_analyse_biodiv_sr_elev_res.R @@ -6,12 +6,13 @@ dir.create(path_compile_analysis_sr_elev_res, showWarnings = FALSE) # Combine all models into one gpm object -ptypes = c("*elui*", "*kmra*", "*spec*", "*elsp*") -mtypes = c("*gam*", "*pls*", "*rf*") +pt = "*spec*" +mtypes = c("*pls*", "*rf*") +rtypes = c("*gam_elev_res*", "*pls_elui_res*", "*rf_elui_res*") all_models = lapply(mtypes, function(mt){ - all_pmodels = lapply(ptypes, function(pt){ - model_files = list.files(path_model_gpm_sr, full.names = TRUE, + all_pmodels = lapply(rtypes, function(rt){ + model_files = list.files(path_model_gpm_sr_res, full.names = TRUE, pattern = glob2rx(paste0(pt, mt))) all_models = readRDS(model_files[[1]]) @@ -22,10 +23,10 @@ all_models = lapply(mtypes, function(mt){ return(all_models) }) - names(all_pmodels) = gsub("[*]", "", ptypes) + names(all_pmodels) = gsub("[*]", "", rtypes) return(all_pmodels) }) names(all_models) = gsub("[*]", "", gsub("_", "", mtypes)) -saveRDS(all_models, file = file.path(path_compile_analysis_sr, - "models_sr.rds")) +saveRDS(all_models, file = file.path(path_compile_analysis_sr_elev_res, + "models_sr_elev_res.rds")) diff --git a/src/500_analyse_biodiv_sr.R b/src/500_analyse_biodiv_sr.R deleted file mode 100644 index f8ac849..0000000 --- a/src/500_analyse_biodiv_sr.R +++ /dev/null @@ -1,79 +0,0 @@ -# Analyse species richness prediction models - -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") - -dir.create(path_analysis_sr, showWarnings = FALSE) - -all_models = readRDS(file.path(path_compile_analysis_sr, "models_sr.rds")) - - -# Collect model performance -gam_sr = modelPerformance(all_models[["gam"]]) -pls_sr = modelPerformance(all_models[["pls"]]) -rf_sr = modelPerformance(all_models[["rf"]]) - -summary(gam_sr) -summary(pls_sr) -summary(rf_sr) - - -# Compare pls and rf -models_sr = rbind(pls_sr[, -4], rf_sr[, -4]) -models_sr$mptype = paste0(models_sr$mtype, "_", models_sr$ptype) -models_sr$mptype = factor(models_sr$mptype, levels = c("pls_elsp", "rf_elsp", - "pls_elui", "rf_elui", - "pls_kmra", "rf_kmra", - "pls_spec", "rf_spec")) - -ggplot(data = models_sr[models_sr$ptype == "elui" | models_sr$ptype == "spec",], aes(x = resp, y = RMSE_normSD, fill = mptype)) + - geom_boxplot() + - labs(list(title = "PLS and RF", fill = "Predictor Set")) + - theme(axis.text.x = element_text(angle = 45, hjust = 1)) - - -pls_rf_sr = merge(pls_sr, rf_sr, by = c("ptype", "resp", "Resample"), all.y = TRUE) -colnames(pls_rf_sr)[grep("\\.x", colnames(pls_rf_sr))] = - gsub("\\.x", "_pls", colnames(pls_rf_sr)[grep("\\.x", colnames(pls_rf_sr))]) -colnames(pls_rf_sr)[grep("\\.y", colnames(pls_rf_sr))] = - gsub("\\.y", "_rf", colnames(pls_rf_sr)[grep("\\.y", colnames(pls_rf_sr))]) -# nrow(pls_rf_sr) - -ptypes = c("elui", "kmra", "spec", "elsp") -perf_check = lapply(ptypes, function(pt){ - subdf = pls_rf_sr[!is.na(pls_rf_sr$RMSE_pls) & - pls_rf_sr$ptype == pt & - pls_rf_sr$Resample == "Mean", ] - rownames(subdf[subdf$RMSE_pls < subdf$RMSE_rf, ]) -}) -names(perf_check) = ptypes - -# Check performance of PLS and RF for ELUI -pls_rf_sr[as.numeric(perf_check[[1]]),] - -# Check performance of PLS and RF for KMRA -pls_rf_sr[as.numeric(perf_check[[2]]),] -sort(round(1-pls_rf_sr[as.numeric(perf_check[[2]]), "RMSE_pls"] / pls_rf_sr[as.numeric(perf_check[[2]]), "RMSE_rf"],2)) -sort(round(pls_rf_sr[as.numeric(perf_check[[2]]), "nvars_rf"] / pls_rf_sr[as.numeric(perf_check[[2]]), "nvars_pls"],2)) - -# Check performance of PLS and RF for SPEC -pls_rf_sr[as.numeric(perf_check[[3]]),] -sort(round(1-pls_rf_sr[as.numeric(perf_check[[3]]), "RMSE_pls"] / pls_rf_sr[as.numeric(perf_check[[3]]), "RMSE_rf"],2)) -sort(round(pls_rf_sr[as.numeric(perf_check[[3]]), "nvars_rf"] / pls_rf_sr[as.numeric(perf_check[[3]]), "nvars_pls"],2)) - - - -# models_sr_wide = spread(models_sr[models_sr$Resample == "Mean",], "ptype", "RMSE_normSD") -# head(models_sr_wide) - - - -# Collect variable importance -var_imp <- compVarImp(all_models[["pls"]][["spec"]]@model[[1]], scale = FALSE) -plotVarImp(var_imp) -plotVarImpHeatmap(var_imp, xlab = "Species", ylab = "Band") - -var_imp <- compVarImp(all_models[["rf"]][["spec"]]@model[[1]], scale = FALSE) -plotVarImp(var_imp) -plotVarImpHeatmap(var_imp, xlab = "Species", ylab = "Band") - - diff --git a/src/510_analyse_biodiv_sr_elev_res.R b/src/510_analyse_biodiv_sr_elev_res.R deleted file mode 100644 index 80bc96a..0000000 --- a/src/510_analyse_biodiv_sr_elev_res.R +++ /dev/null @@ -1,71 +0,0 @@ -# Combine hyperspectral predictores and biodiversity variables in gpm class. -if(Sys.info()["sysname"] == "Windows"){ - filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" -} else { - filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" -} -source(filepath_base) - -dir.create(path_analysis_sr_elev_res, showWarnings = FALSE) - -all_models = readRDS(file.path(path_compile_analysis_sr_elev_res, - "models_sr_elev_res.rds")) - - -# Collect model performance -gamnone_sr = modelPerformance(all_models[["gamnone"]]) -gamnone_sr$mtype = "gamnone" -gam_sr = modelPerformance(all_models[["gam"]]) -pls_sr = modelPerformance(all_models[["pls"]]) -rf_sr = modelPerformance(all_models[["rf"]]) - -summary(gamnone_sr) -summary(gam_sr) -summary(pls_sr) -summary(rf_sr) - -models_sr = rbind(gamnone_sr[, -c(4,5)], pls_sr[, -4], rf_sr[, -4]) -models_sr$mptype = paste0(models_sr$mtype, "_", models_sr$ptype) -models_sr$mptype = factor(models_sr$mptype, levels = c("gamnone_elsp", "pls_elsp", "rf_elsp", - "gamnone_elui", "pls_elui", "rf_elui", - "gamnone_kmra", "pls_kmra", "rf_kmra", - "gamnone_spec", "pls_spec", "rf_spec")) - - - -# Plot model performance -ggplot(data = gamnone_sr[pls_sr$ptype == "elui" | pls_sr$ptype == "spec",], aes(x = resp, y = RMSE_normSD, fill = ptype)) + - geom_boxplot()+ - labs(list(title = "PLS", fill = "Predictor Set")) + - theme(axis.text.x = element_text(angle = 45, hjust = 1)) - - -ggplot(data = pls_sr[pls_sr$ptype == "elui" | pls_sr$ptype == "spec",], aes(x = resp, y = RMSE_normSD, fill = ptype)) + - geom_boxplot()+ - labs(list(title = "PLS", fill = "Predictor Set")) + - theme(axis.text.x = element_text(angle = 45, hjust = 1)) - - -ggplot(data = rf_sr[rf_sr$ptype == "elui" | rf_sr$ptype == "spec",], aes(x = resp, y = RMSE_normSD, fill = ptype)) + - geom_boxplot() + - labs(list(title = "RF", fill = "Predictor Set")) + - theme(axis.text.x = element_text(angle = 45, hjust = 1)) - - -ggplot(data = models_sr[models_sr$ptype == "elui" | models_sr$ptype == "spec",], aes(x = resp, y = RMSE_normSD, fill = mptype)) + - geom_boxplot() + - labs(list(title = "PLS and RF", fill = "Predictor Set")) + - theme(axis.text.x = element_text(angle = 45, hjust = 1)) - - - -# Collect variable importance -var_imp <- compVarImp(all_models[["pls"]][["spec"]]@model[[1]], scale = FALSE) -plotVarImp(var_imp) -plotVarImpHeatmap(var_imp, xlab = "Species", ylab = "Band") - -var_imp <- compVarImp(all_models[["rf"]][["spec"]]@model[[1]], scale = FALSE) -plotVarImp(var_imp) -plotVarImpHeatmap(var_imp, xlab = "Species", ylab = "Band") - - diff --git a/src/510_analyse_biodiv_sr_elev_res.Rmd b/src/510_analyse_biodiv_sr_elev_res.Rmd new file mode 100644 index 0000000..5b5dbe0 --- /dev/null +++ b/src/510_analyse_biodiv_sr_elev_res.Rmd @@ -0,0 +1,126 @@ +--- +title: "500 Analyse Biodiv-RS" +output: html_notebook +--- + +```{r, include = FALSE} +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") + +dir.create(path_analysis_sr, showWarnings = FALSE) + +all_models = readRDS(file.path(path_compile_analysis_sr_elev_res, "models_res_elev_res.rds")) + + +# Collect model performance +pls_res = modelPerformance(all_models[["pls"]]) +rf_res = modelPerformance(all_models[["rf"]]) + +pls_res$resmodel = pls_res$resp +pls_res$resp = gsub("_gam_elev_res", "", pls_res$resp) + +rf_res$resmodel = rf_res$resp +rf_res$resp = gsub("_gam_elev_res", "", rf_res$resp) + +summary(pls_res) +summary(rf_res) + +# Get trophic levels +tl = read.table(file.path(path_meta, "trophic_levels.csv"), header = TRUE, sep = ";") +pls_res = merge(pls_res, tl, by.x = "resp", by.y = "Species") +rf_res = merge(rf_res, tl, by.x = "resp", by.y = "Species") +``` + +# Compare PLS and RF +```{r, echo=FALSE} +models_res = rbind(pls_res[, -4], rf_res[, -4]) +models_res$mptype = paste0(models_res$mtype, "_", models_res$ptype) +models_res$mptype = factor(models_res$mptype, levels = c("pls_elsp", "rf_elsp", + "pls_elui", "rf_elui", + "pls_kmra", "rf_kmra", + "pls_spec", "rf_spec")) + + +ggplot(data = models_res[models_res$ptype == "elui" | models_res$ptype == "spec",], aes(x = resp, y = RMSE_normSD, fill = mptype)) + + geom_boxplot() + + theme_bw() + + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + + labs(list(x = "Species groups", y = "RMSEn", fill = "Model set")) +``` + +```{r, echo=FALSE} +pls_rf_res = merge(pls_res, rf_res, by = c("ptype", "resp", "Resample"), all.y = TRUE) +colnames(pls_rf_res)[grep("\\.x", colnames(pls_rf_res))] = + gsub("\\.x", "_pls", colnames(pls_rf_res)[grep("\\.x", colnames(pls_rf_res))]) +colnames(pls_rf_res)[grep("\\.y", colnames(pls_rf_res))] = + gsub("\\.y", "_rf", colnames(pls_rf_res)[grep("\\.y", colnames(pls_rf_res))]) +# nrow(pls_rf_res) + +ptypes = c("elui", "kmra", "spec", "elsp") +perf_check = lapply(ptypes, function(pt){ + subdf = pls_rf_res[!is.na(pls_rf_res$RMSE_pls) & + pls_rf_res$ptype == pt & + pls_rf_res$Resample == "Mean", ] + rownames(subdf[subdf$RMSE_pls < subdf$RMSE_rf, ]) +}) +names(perf_check) = ptypes +``` + +# Check performance of PLS and RF +```{r, echo = FALSE} +for(i in seq(length(perf_check))){ +rmse_perf = sort(round(1-pls_rf_res[as.numeric(perf_check[[i]]), "RMSE_pls"] / + pls_rf_res[as.numeric(perf_check[[i]]), "RMSE_rf"],2)) +var_rf_prct = sort(round(pls_rf_res[as.numeric(perf_check[[i]]), "nvars_rf"] / + pls_rf_res[as.numeric(perf_check[[i]]), "nvars_pls"],2)) +level_pls = sort(table(pls_rf_res[as.numeric(perf_check[[i]]), "Level_pls"])) +print(names(perf_check[i])) +print(pls_rf_res[as.numeric(perf_check[[i]]),]) +cat("RMSE (1 - PLS/RF):", rmse_perf, "\n") +cat("Var number (RF/PLS):", var_rf_prct, "\n") +cat("Levels with PLS is better:", level_pls, "\n") +cat("\n\n") +} +``` + +# Collect variable importance +## Number of variables +```{r} +pls_rf_res_long = melt(pls_rf_res[pls_rf_res$Resample == "Mean", c(1, 2, 6, 13)], id.vars = c("ptype", "resp")) +ggplot(data = pls_rf_res_long, aes(x = variable, y = value, fill = ptype)) + + geom_boxplot() + + labs(list(x = "Models", y = "Number of variables" , + fill = "Predictor Set")) + + theme_bw() +``` + + +# Variable importance for PLS +```{r, echo=FALSE} +var_imp <- compVarImp(all_models[["pls"]][["spec"]]@model[[1]], scale = FALSE) +# plotVarImp(var_imp) +plotVarImpHeatmap(var_imp, xlab = "Species", ylab = "Band") +``` + +# Variable importance for RF +```{r, echo=FALSE} +var_imp <- compVarImp(all_models[["rf"]][["spec"]]@model[[1]], scale = FALSE) +# plotVarImp(var_imp) +plotVarImpHeatmap(var_imp, xlab = "Species", ylab = "Band") +``` + + +# Trophic levels +```{r} +var_imp_levels = var_imp +for(i in seq(length(var_imp_levels))){ + var_imp_levels[[i]]$RESPONSE = tl$Level[grep(var_imp_levels[[i]]$RESPONSE[1], tl$Species)] +} +plotVarImpHeatmap(var_imp_levels, xlab = "Species", ylab = "Band") +``` + + + + +When you save the notebook, an HTML file containing the code and output will be saved alongside it (click the *Preview* button or press *Ctrl+Shift+K* to preview the HTML file). + +The preview shows you a rendered HTML copy of the contents of the editor. Consequently, unlike *Knit*, *Preview* does not run any R code chunks. Instead, the output of the chunk when it was last run in the editor is displayed. diff --git a/src/510_analyse_biodiv_sr_elev_res.nb.html b/src/510_analyse_biodiv_sr_elev_res.nb.html new file mode 100644 index 0000000..e909da8 --- /dev/null +++ b/src/510_analyse_biodiv_sr_elev_res.nb.html @@ -0,0 +1,460 @@ + + + + + + + + + + + + + +500 Analyse Biodiv-RS + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + + + + + + + + + + + + + + + + + + +
+

Compare PLS and RF

+ + + +
   [1] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+   [7] "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_pls_elui_res"
+  [13] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res" 
+  [19] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
+  [25] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res"
+  [31] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res"
+  [37] "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
+  [43] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res"
+  [49] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
+  [55] "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+  [61] "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res"
+  [67] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
+  [73] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+  [79] "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
+  [85] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
+  [91] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+  [97] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [103] "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [109] "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res"
+ [115] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res" 
+ [121] "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [127] "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [133] "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res" 
+ [139] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [145] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [151] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [157] "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [163] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res"
+ [169] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [175] "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res"
+ [181] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [187] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [193] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [199] "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [205] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [211] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [217] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [223] "rf_pls_elui_res" "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [229] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res"
+ [235] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [241] "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [247] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [253] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [259] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [265] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res"
+ [271] "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res"
+ [277] "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [283] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_gam_elev_res"
+ [289] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [295] "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res"
+ [301] "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res"
+ [307] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [313] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [319] "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [325] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [331] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [337] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [343] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [349] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res"
+ [355] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [361] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [367] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [373] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res" 
+ [379] "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [385] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [391] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [397] "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [403] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res"
+ [409] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [415] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [421] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res"
+ [427] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [433] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [439] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [445] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res" 
+ [451] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res"
+ [457] "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [463] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [469] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [475] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [481] "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [487] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [493] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [499] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [505] "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [511] "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res" 
+ [517] "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [523] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res"
+ [529] "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [535] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res" 
+ [541] "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res"
+ [547] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [553] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [559] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [565] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res" 
+ [571] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res"
+ [577] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [583] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res" 
+ [589] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res" 
+ [595] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [601] "rf_pls_elui_res" "rf_rf_elui_res"  "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [607] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res"
+ [613] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [619] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [625] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [631] "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [637] "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [643] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [649] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [655] "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [661] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [667] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res"
+ [673] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res" 
+ [679] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res"
+ [685] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res" 
+ [691] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [697] "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [703] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [709] "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [715] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [721] "rf_gam_elev_res" "rf_rf_elui_res"  "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res"
+ [727] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [733] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [739] "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res" 
+ [745] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res"
+ [751] "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [757] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res"
+ [763] "rf_gam_elev_res" "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [769] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [775] "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [781] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [787] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res"
+ [793] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res" 
+ [799] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res"
+ [805] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res" 
+ [811] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [817] "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [823] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [829] "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_rf_elui_res" 
+ [835] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res" 
+ [841] "rf_gam_elev_res" "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [847] "rf_pls_elui_res" "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res"
+ [853] "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res"
+ [859] "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res" 
+ [865] "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res"  "rf_pls_elui_res"
+ [871] "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res" 
+ [877] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res"
+ [883] "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_rf_elui_res" 
+ [889] "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [895] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [901] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [907] "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res"
+ [913] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [919] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_pls_elui_res"
+ [925] "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [931] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [937] "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res"
+ [943] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res"
+ [949] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [955] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res" 
+ [961] "rf_gam_elev_res" "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
+ [967] "rf_pls_elui_res" "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res"
+ [973] "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res"
+ [979] "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res" 
+ [985] "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res"  "rf_pls_elui_res"
+ [991] "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res" 
+ [997] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
+ [ reached getOption("max.print") -- omitted 200 entries ]
+ + + + + + + +
+
+

Check performance of PLS and RF

+ + + + +
+
+

Collect variable importance

+
+

Number of variables

+ + + +
pls_rf_res_long = melt(pls_rf_res[pls_rf_res$Resample == "Mean", c(1, 2, 6, 13)], id.vars = c("ptype", "resp"))
+ggplot(data = pls_rf_res_long, aes(x = variable, y = value, fill = ptype)) +
+  geom_boxplot() + 
+  labs(list(x = "Models", y = "Number of variables" ,
+            fill = "Predictor Set")) +
+  theme_bw()
+ + + +
+
+
+

Variable importance for PLS

+ + + + +
+
+

Variable importance for RF

+ + + + +
+
+

Trophic levels

+ + + +
var_imp_levels = var_imp
+for(i in seq(length(var_imp_levels))){
+  var_imp_levels[[i]]$RESPONSE = tl$Level[grep(var_imp_levels[[i]]$RESPONSE[1], tl$Species)]
+}
+plotVarImpHeatmap(var_imp_levels, xlab = "Species", ylab = "Band")
+ + + +

When you save the notebook, an HTML file containing the code and output will be saved alongside it (click the Preview button or press Ctrl+Shift+K to preview the HTML file).

+

The preview shows you a rendered HTML copy of the contents of the editor. Consequently, unlike Knit, Preview does not run any R code chunks. Instead, the output of the chunk when it was last run in the editor is displayed.

+ +
+ +
LS0tDQp0aXRsZTogIjUwMCBBbmFseXNlIEJpb2Rpdi1SUyINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCmBgYHtyLCBpbmNsdWRlID0gRkFMU0V9DQpzb3VyY2UoIkM6L1VzZXJzL3RuYXVzcy9wZXJtYW5lbnQvcGx5Z3JuZC9LSS1IeXBlcnNwZWMvSHlTcGVjX0tpTGkvc3JjLzAwMF9zZXRfZW52aXJvbm1lbnQuUiIpDQoNCmRpci5jcmVhdGUocGF0aF9hbmFseXNpc19zciwgc2hvd1dhcm5pbmdzID0gRkFMU0UpDQoNCmFsbF9tb2RlbHMgPSByZWFkUkRTKGZpbGUucGF0aChwYXRoX2NvbXBpbGVfYW5hbHlzaXNfc3JfZWxldl9yZXMsICJtb2RlbHNfcmVzX2VsZXZfcmVzLnJkcyIpKQ0KDQoNCiMgQ29sbGVjdCBtb2RlbCBwZXJmb3JtYW5jZQ0KcGxzX3JlcyA9IG1vZGVsUGVyZm9ybWFuY2UoYWxsX21vZGVsc1tbInBscyJdXSkNCnJmX3JlcyA9IG1vZGVsUGVyZm9ybWFuY2UoYWxsX21vZGVsc1tbInJmIl1dKQ0KDQpwbHNfcmVzJHJlc21vZGVsID0gcGxzX3JlcyRyZXNwDQpwbHNfcmVzJHJlc3AgPSBnc3ViKCJfZ2FtX2VsZXZfcmVzIiwgIiIsIHBsc19yZXMkcmVzcCkNCg0KcmZfcmVzJHJlc21vZGVsID0gcmZfcmVzJHJlc3ANCnJmX3JlcyRyZXNwID0gZ3N1YigiX2dhbV9lbGV2X3JlcyIsICIiLCByZl9yZXMkcmVzcCkNCg0Kc3VtbWFyeShwbHNfcmVzKQ0Kc3VtbWFyeShyZl9yZXMpDQoNCiMgR2V0IHRyb3BoaWMgbGV2ZWxzDQp0bCA9IHJlYWQudGFibGUoZmlsZS5wYXRoKHBhdGhfbWV0YSwgInRyb3BoaWNfbGV2ZWxzLmNzdiIpLCBoZWFkZXIgPSBUUlVFLCBzZXAgPSAiOyIpDQpwbHNfcmVzID0gbWVyZ2UocGxzX3JlcywgdGwsIGJ5LnggPSAicmVzcCIsIGJ5LnkgPSAiU3BlY2llcyIpDQpyZl9yZXMgPSBtZXJnZShyZl9yZXMsIHRsLCBieS54ID0gInJlc3AiLCBieS55ID0gIlNwZWNpZXMiKQ0KYGBgDQoNCiMgQ29tcGFyZSBQTFMgYW5kIFJGDQpgYGB7ciwgZWNobz1GQUxTRX0NCm1vZGVsc19yZXMgPSByYmluZChwbHNfcmVzWywgLTRdLCByZl9yZXNbLCAtNF0pDQptb2RlbHNfcmVzJG1wdHlwZSA9IHBhc3RlMChtb2RlbHNfcmVzJG10eXBlLCAiXyIsIG1vZGVsc19yZXMkcHR5cGUpDQptb2RlbHNfcmVzJG1wdHlwZSA9IGZhY3Rvcihtb2RlbHNfcmVzJG1wdHlwZSwgbGV2ZWxzID0gYygicGxzX2Vsc3AiLCAicmZfZWxzcCIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgInBsc19lbHVpIiwgInJmX2VsdWkiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICJwbHNfa21yYSIsICJyZl9rbXJhIiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAicGxzX3NwZWMiLCAicmZfc3BlYyIpKQ0KDQoNCmdncGxvdChkYXRhID0gbW9kZWxzX3Jlc1ttb2RlbHNfcmVzJHB0eXBlID09ICJlbHVpIiB8IG1vZGVsc19yZXMkcHR5cGUgPT0gInNwZWMiLF0sIGFlcyh4ID0gcmVzcCwgeSA9IFJNU0Vfbm9ybVNELCBmaWxsID0gbXB0eXBlKSkgKyANCiAgZ2VvbV9ib3hwbG90KCkgKw0KICB0aGVtZV9idygpICsgDQogIHRoZW1lKGF4aXMudGV4dC54ID0gZWxlbWVudF90ZXh0KGFuZ2xlID0gNDUsIGhqdXN0ID0gMSkpICsgDQogIGxhYnMobGlzdCh4ID0gIlNwZWNpZXMgZ3JvdXBzIiwgeSA9ICJSTVNFbiIsIGZpbGwgPSAiTW9kZWwgc2V0IikpDQpgYGANCg0KYGBge3IsIGVjaG89RkFMU0V9DQpwbHNfcmZfcmVzID0gbWVyZ2UocGxzX3JlcywgcmZfcmVzLCBieSA9IGMoInB0eXBlIiwgInJlc3AiLCAiUmVzYW1wbGUiKSwgYWxsLnkgPSBUUlVFKQ0KY29sbmFtZXMocGxzX3JmX3JlcylbZ3JlcCgiXFwueCIsIGNvbG5hbWVzKHBsc19yZl9yZXMpKV0gPSANCiAgZ3N1YigiXFwueCIsICJfcGxzIiwgY29sbmFtZXMocGxzX3JmX3JlcylbZ3JlcCgiXFwueCIsIGNvbG5hbWVzKHBsc19yZl9yZXMpKV0pDQpjb2xuYW1lcyhwbHNfcmZfcmVzKVtncmVwKCJcXC55IiwgY29sbmFtZXMocGxzX3JmX3JlcykpXSA9IA0KICBnc3ViKCJcXC55IiwgIl9yZiIsIGNvbG5hbWVzKHBsc19yZl9yZXMpW2dyZXAoIlxcLnkiLCBjb2xuYW1lcyhwbHNfcmZfcmVzKSldKQ0KIyBucm93KHBsc19yZl9yZXMpDQoNCnB0eXBlcyA9IGMoImVsdWkiLCAia21yYSIsICJzcGVjIiwgImVsc3AiKQ0KcGVyZl9jaGVjayA9IGxhcHBseShwdHlwZXMsIGZ1bmN0aW9uKHB0KXsNCiAgc3ViZGYgPSBwbHNfcmZfcmVzWyFpcy5uYShwbHNfcmZfcmVzJFJNU0VfcGxzKSAmIA0KICAgICAgICAgICAgICAgICAgICAgIHBsc19yZl9yZXMkcHR5cGUgPT0gcHQgJg0KICAgICAgICAgICAgICAgICAgICAgIHBsc19yZl9yZXMkUmVzYW1wbGUgPT0gIk1lYW4iLCBdDQogIHJvd25hbWVzKHN1YmRmW3N1YmRmJFJNU0VfcGxzIDwgc3ViZGYkUk1TRV9yZiwgXSkNCn0pDQpuYW1lcyhwZXJmX2NoZWNrKSA9IHB0eXBlcw0KYGBgDQoNCiMgQ2hlY2sgcGVyZm9ybWFuY2Ugb2YgUExTIGFuZCBSRg0KYGBge3IsIGVjaG8gPSBGQUxTRX0NCmZvcihpIGluIHNlcShsZW5ndGgocGVyZl9jaGVjaykpKXsNCnJtc2VfcGVyZiA9IHNvcnQocm91bmQoMS1wbHNfcmZfcmVzW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIlJNU0VfcGxzIl0gLyANCiAgICAgICAgICAgICAgICAgICAgICAgICBwbHNfcmZfcmVzW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIlJNU0VfcmYiXSwyKSkNCnZhcl9yZl9wcmN0ID0gc29ydChyb3VuZChwbHNfcmZfcmVzW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIm52YXJzX3JmIl0gLyANCiAgICAgICAgICAgICAgICAgICAgICAgICAgIHBsc19yZl9yZXNbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLCAibnZhcnNfcGxzIl0sMikpDQpsZXZlbF9wbHMgPSBzb3J0KHRhYmxlKHBsc19yZl9yZXNbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLCAiTGV2ZWxfcGxzIl0pKQ0KcHJpbnQobmFtZXMocGVyZl9jaGVja1tpXSkpDQpwcmludChwbHNfcmZfcmVzW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSxdKQ0KY2F0KCJSTVNFICgxIC0gUExTL1JGKToiLCBybXNlX3BlcmYsICJcbiIpDQpjYXQoIlZhciBudW1iZXIgKFJGL1BMUyk6IiwgdmFyX3JmX3ByY3QsICJcbiIpDQpjYXQoIkxldmVscyB3aXRoIFBMUyBpcyBiZXR0ZXI6IiwgbGV2ZWxfcGxzLCAiXG4iKQ0KY2F0KCJcblxuIikNCn0NCmBgYA0KDQojIENvbGxlY3QgdmFyaWFibGUgaW1wb3J0YW5jZQ0KIyMgTnVtYmVyIG9mIHZhcmlhYmxlcw0KYGBge3J9DQpwbHNfcmZfcmVzX2xvbmcgPSBtZWx0KHBsc19yZl9yZXNbcGxzX3JmX3JlcyRSZXNhbXBsZSA9PSAiTWVhbiIsIGMoMSwgMiwgNiwgMTMpXSwgaWQudmFycyA9IGMoInB0eXBlIiwgInJlc3AiKSkNCmdncGxvdChkYXRhID0gcGxzX3JmX3Jlc19sb25nLCBhZXMoeCA9IHZhcmlhYmxlLCB5ID0gdmFsdWUsIGZpbGwgPSBwdHlwZSkpICsNCiAgZ2VvbV9ib3hwbG90KCkgKyANCiAgbGFicyhsaXN0KHggPSAiTW9kZWxzIiwgeSA9ICJOdW1iZXIgb2YgdmFyaWFibGVzIiAsDQogICAgICAgICAgICBmaWxsID0gIlByZWRpY3RvciBTZXQiKSkgKw0KICB0aGVtZV9idygpDQpgYGANCg0KDQojIFZhcmlhYmxlIGltcG9ydGFuY2UgZm9yIFBMUw0KYGBge3IsIGVjaG89RkFMU0V9DQp2YXJfaW1wIDwtIGNvbXBWYXJJbXAoYWxsX21vZGVsc1tbInBscyJdXVtbInNwZWMiXV1AbW9kZWxbWzFdXSwgc2NhbGUgPSBGQUxTRSkNCiMgcGxvdFZhckltcCh2YXJfaW1wKQ0KcGxvdFZhckltcEhlYXRtYXAodmFyX2ltcCwgeGxhYiA9ICJTcGVjaWVzIiwgeWxhYiA9ICJCYW5kIikNCmBgYA0KDQojIFZhcmlhYmxlIGltcG9ydGFuY2UgZm9yIFJGDQpgYGB7ciwgZWNobz1GQUxTRX0NCnZhcl9pbXAgPC0gY29tcFZhckltcChhbGxfbW9kZWxzW1sicmYiXV1bWyJzcGVjIl1dQG1vZGVsW1sxXV0sIHNjYWxlID0gRkFMU0UpDQojIHBsb3RWYXJJbXAodmFyX2ltcCkNCnBsb3RWYXJJbXBIZWF0bWFwKHZhcl9pbXAsIHhsYWIgPSAiU3BlY2llcyIsIHlsYWIgPSAiQmFuZCIpDQpgYGANCg0KDQojIFRyb3BoaWMgbGV2ZWxzDQpgYGB7cn0NCnZhcl9pbXBfbGV2ZWxzID0gdmFyX2ltcA0KZm9yKGkgaW4gc2VxKGxlbmd0aCh2YXJfaW1wX2xldmVscykpKXsNCiAgdmFyX2ltcF9sZXZlbHNbW2ldXSRSRVNQT05TRSA9IHRsJExldmVsW2dyZXAodmFyX2ltcF9sZXZlbHNbW2ldXSRSRVNQT05TRVsxXSwgdGwkU3BlY2llcyldDQp9DQpwbG90VmFySW1wSGVhdG1hcCh2YXJfaW1wX2xldmVscywgeGxhYiA9ICJTcGVjaWVzIiwgeWxhYiA9ICJCYW5kIikNCmBgYA0KDQoNCg0KDQpXaGVuIHlvdSBzYXZlIHRoZSBub3RlYm9vaywgYW4gSFRNTCBmaWxlIGNvbnRhaW5pbmcgdGhlIGNvZGUgYW5kIG91dHB1dCB3aWxsIGJlIHNhdmVkIGFsb25nc2lkZSBpdCAoY2xpY2sgdGhlICpQcmV2aWV3KiBidXR0b24gb3IgcHJlc3MgKkN0cmwrU2hpZnQrSyogdG8gcHJldmlldyB0aGUgSFRNTCBmaWxlKS4NCg0KVGhlIHByZXZpZXcgc2hvd3MgeW91IGEgcmVuZGVyZWQgSFRNTCBjb3B5IG9mIHRoZSBjb250ZW50cyBvZiB0aGUgZWRpdG9yLiBDb25zZXF1ZW50bHksIHVubGlrZSAqS25pdCosICpQcmV2aWV3KiBkb2VzIG5vdCBydW4gYW55IFIgY29kZSBjaHVua3MuIEluc3RlYWQsIHRoZSBvdXRwdXQgb2YgdGhlIGNodW5rIHdoZW4gaXQgd2FzIGxhc3QgcnVuIGluIHRoZSBlZGl0b3IgaXMgZGlzcGxheWVkLg0K
+ + + +
+ + + + + + + + From 01e9656d1e48835d937cf63415ff73ef6b167d65 Mon Sep 17 00:00:00 2001 From: "Nauss, Thomas" Date: Sat, 26 Jan 2019 18:22:11 +0100 Subject: [PATCH 42/65] Add combined 2step analysis --- src/001_functions.R | 57 +++- src/400_compile_analyse_biodiv_sr.R | 6 +- src/410_compile_analyse_biodiv_sr_elev_res.R | 2 +- src/500_analyse_biodiv_sr.nb.html | 10 +- src/510_analyse_biodiv_sr_elev_res.Rmd | 22 +- src/510_analyse_biodiv_sr_elev_res.nb.html | 176 +---------- src/520_analyse_biodiv_sr_two_step.Rmd | 136 +++++++++ src/520_analyse_biodiv_sr_two_step.nb.html | 290 +++++++++++++++++++ 8 files changed, 503 insertions(+), 196 deletions(-) create mode 100644 src/520_analyse_biodiv_sr_two_step.Rmd create mode 100644 src/520_analyse_biodiv_sr_two_step.nb.html diff --git a/src/001_functions.R b/src/001_functions.R index 7897b1f..c13d21e 100644 --- a/src/001_functions.R +++ b/src/001_functions.R @@ -16,6 +16,24 @@ visCheck = function(datapath, polygonfile, band = 109){ } + +# Compute predictions ---------------------------------------------------------- +compPredictions = function(model, input){ + if(inherits(model, "try-error")){ + predictions = NA + } else { + non_na_pos = which( + complete.cases( + input[, model$selectedvars])) + + predictions = NA + predictions[non_na_pos] = predict(model, input[non_na_pos,]) + } + return(predictions) +} + + + # Compile residual datasets ---------------------------------------------------- compResData = function(comb_sr, pt, mt){ comb_sr_elev_res = comb_sr @@ -35,9 +53,9 @@ compResData = function(comb_sr, pt, mt){ act_predictions = NA act_predictions[non_na_pos] = predict(act_model$model, comb_sr@data$input[non_na_pos,]) } - comb_sr_elev_res@data$input[, act_model$response] = - comb_sr_elev_res@data$input[, act_model$response] - - act_predictions + comb_sr_elev_res@data$input[, act_model$response] = + comb_sr_elev_res@data$input[, act_model$response] - + act_predictions colname_pos = grep(act_model$response, colnames(comb_sr_elev_res@data$input)) colnames(comb_sr_elev_res@data$input)[colname_pos] = @@ -71,7 +89,7 @@ compModels = function(model, pt, mt, outpath){ cv_nbr = NULL, var_selection = "indv", filepath_tmp = NULL) - + outfile_name = gsub("[*]", "", paste0(outpath, "ki_sr_", pt, "_non_scaled_", mt, "_", model@meta$input$RESPONSE_FINAL, @@ -126,6 +144,37 @@ modelPerformance = function(model){ +# Compile two step prediction datasets ----------------------------------------- +comp2StepPred = function(comb_sr_two_step, model, model_res){ + + smr = lapply(seq(length(model)), function(i){ + mi = model[[i]][[1]] + mi_res = model_res[[i]][[1]] + + mi_pred = compPredictions(mi$model, comb_sr_two_step@data$input) + mi_res_pred = compPredictions(mi_res$model, comb_sr_two_step@data$input) + + rmse_1step = sqrt(mean((comb_sr_two_step@data$input[, mi$response]-(mi_pred))**2, na.rm = TRUE)) + rmse_2step = sqrt(mean((comb_sr_two_step@data$input[, mi$response]-(mi_pred + mi_res_pred))**2, na.rm = TRUE)) + pmean = mean(comb_sr_two_step@data$input[, mi$response], na.rm = TRUE) + psd = sd(comb_sr_two_step@data$input[, mi$response], na.rm = TRUE) + rmse_1step_nd = rmse_1step/psd + rmse_2step_nd = rmse_2step/psd + + data.frame(mtype1 = mi$model$method, + mtype2 = mi_res$model$method, + resp = mi$response, + RMSE1 = rmse_1step, + RMSE2 = rmse_2step, + RMSE_normSD1 = rmse_1step_nd, + RMSE_normSD2 = rmse_2step_nd) + + }) + smr = do.call("rbind", smr) + return(smr) +} + + # Spectral rao ----------------------------------------------------------------- ######### SPECTRALRAO ############################# ## Developed by Matteo Marcantonio diff --git a/src/400_compile_analyse_biodiv_sr.R b/src/400_compile_analyse_biodiv_sr.R index dcc36ea..d47b0eb 100644 --- a/src/400_compile_analyse_biodiv_sr.R +++ b/src/400_compile_analyse_biodiv_sr.R @@ -6,10 +6,14 @@ dir.create(path_compile_analysis_sr, showWarnings = FALSE) # Combine all models into one gpm object -ptypes = c("*elui*", "*kmra*", "*spec*", "*elsp*") mtypes = c("*gam*", "*pls*", "*rf*") all_models = lapply(mtypes, function(mt){ + if(mt == "*gam*"){ + ptypes = c("*elev*", "*elui*", "*kmra*", "*spec*", "*elsp*") + } else { + ptypes = c("*elui*", "*kmra*", "*spec*", "*elsp*") + } all_pmodels = lapply(ptypes, function(pt){ model_files = list.files(path_model_gpm_sr, full.names = TRUE, pattern = glob2rx(paste0(pt, mt))) diff --git a/src/410_compile_analyse_biodiv_sr_elev_res.R b/src/410_compile_analyse_biodiv_sr_elev_res.R index 4a89930..53d3aaf 100644 --- a/src/410_compile_analyse_biodiv_sr_elev_res.R +++ b/src/410_compile_analyse_biodiv_sr_elev_res.R @@ -13,7 +13,7 @@ rtypes = c("*gam_elev_res*", "*pls_elui_res*", "*rf_elui_res*") all_models = lapply(mtypes, function(mt){ all_pmodels = lapply(rtypes, function(rt){ model_files = list.files(path_model_gpm_sr_res, full.names = TRUE, - pattern = glob2rx(paste0(pt, mt))) + pattern = glob2rx(paste0(mt, rt))) all_models = readRDS(model_files[[1]]) diff --git a/src/500_analyse_biodiv_sr.nb.html b/src/500_analyse_biodiv_sr.nb.html index 5ed2f08..80307d4 100644 --- a/src/500_analyse_biodiv_sr.nb.html +++ b/src/500_analyse_biodiv_sr.nb.html @@ -183,7 +183,7 @@

Compare PLS and RF

-

+

@@ -288,7 +288,7 @@

Number of variables

theme_bw() -

+

@@ -299,7 +299,7 @@

Variable importance for PLS

-

+

@@ -309,7 +309,7 @@

Variable importance for RF

-

+

@@ -319,7 +319,7 @@

Trophic levels

-

+

diff --git a/src/510_analyse_biodiv_sr_elev_res.Rmd b/src/510_analyse_biodiv_sr_elev_res.Rmd index 5b5dbe0..062df46 100644 --- a/src/510_analyse_biodiv_sr_elev_res.Rmd +++ b/src/510_analyse_biodiv_sr_elev_res.Rmd @@ -1,19 +1,20 @@ --- -title: "500 Analyse Biodiv-RS" +title: "510 Analyse Biodiv-RS" output: html_notebook --- ```{r, include = FALSE} source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -dir.create(path_analysis_sr, showWarnings = FALSE) +dir.create(path_analysis_sr_elev_res, showWarnings = FALSE) -all_models = readRDS(file.path(path_compile_analysis_sr_elev_res, "models_res_elev_res.rds")) +all_models_res = readRDS(file.path(path_compile_analysis_sr_elev_res, + "models_sr_elev_res.rds")) # Collect model performance -pls_res = modelPerformance(all_models[["pls"]]) -rf_res = modelPerformance(all_models[["rf"]]) +pls_res = modelPerformance(all_models_res[["pls"]]) +rf_res = modelPerformance(all_models_res[["rf"]]) pls_res$resmodel = pls_res$resp pls_res$resp = gsub("_gam_elev_res", "", pls_res$resp) @@ -34,13 +35,10 @@ rf_res = merge(rf_res, tl, by.x = "resp", by.y = "Species") ```{r, echo=FALSE} models_res = rbind(pls_res[, -4], rf_res[, -4]) models_res$mptype = paste0(models_res$mtype, "_", models_res$ptype) -models_res$mptype = factor(models_res$mptype, levels = c("pls_elsp", "rf_elsp", - "pls_elui", "rf_elui", - "pls_kmra", "rf_kmra", - "pls_spec", "rf_spec")) +models_res$mptype = factor(models_res$mptype, levels = c("rf_gam_elev_res")) -ggplot(data = models_res[models_res$ptype == "elui" | models_res$ptype == "spec",], aes(x = resp, y = RMSE_normSD, fill = mptype)) + +ggplot(data = models_res[models_res$ptype == "gam_elev_res" | models_res$ptype == "spec",], aes(x = resp, y = RMSE_normSD, fill = mptype)) + geom_boxplot() + theme_bw() + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + @@ -96,14 +94,14 @@ ggplot(data = pls_rf_res_long, aes(x = variable, y = value, fill = ptype)) + # Variable importance for PLS ```{r, echo=FALSE} -var_imp <- compVarImp(all_models[["pls"]][["spec"]]@model[[1]], scale = FALSE) +var_imp <- compVarImp(all_models_res[["pls"]][["spec"]]@model[[1]], scale = FALSE) # plotVarImp(var_imp) plotVarImpHeatmap(var_imp, xlab = "Species", ylab = "Band") ``` # Variable importance for RF ```{r, echo=FALSE} -var_imp <- compVarImp(all_models[["rf"]][["spec"]]@model[[1]], scale = FALSE) +var_imp <- compVarImp(all_models_res[["rf"]][["spec"]]@model[[1]], scale = FALSE) # plotVarImp(var_imp) plotVarImpHeatmap(var_imp, xlab = "Species", ylab = "Band") ``` diff --git a/src/510_analyse_biodiv_sr_elev_res.nb.html b/src/510_analyse_biodiv_sr_elev_res.nb.html index e909da8..dcbdb2a 100644 --- a/src/510_analyse_biodiv_sr_elev_res.nb.html +++ b/src/510_analyse_biodiv_sr_elev_res.nb.html @@ -11,7 +11,7 @@ -500 Analyse Biodiv-RS +510 Analyse Biodiv-RS @@ -170,7 +170,7 @@ -

500 Analyse Biodiv-RS

+

510 Analyse Biodiv-RS

@@ -182,176 +182,6 @@

500 Analyse Biodiv-RS

Compare PLS and RF

- -
   [1] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
-   [7] "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_pls_elui_res"
-  [13] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res" 
-  [19] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
-  [25] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res"
-  [31] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res"
-  [37] "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
-  [43] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res"
-  [49] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
-  [55] "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
-  [61] "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res"
-  [67] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
-  [73] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
-  [79] "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
-  [85] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
-  [91] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
-  [97] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [103] "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
- [109] "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res"
- [115] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res" 
- [121] "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [127] "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
- [133] "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res" 
- [139] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
- [145] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [151] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [157] "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
- [163] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res"
- [169] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
- [175] "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res"
- [181] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [187] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [193] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [199] "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [205] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
- [211] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [217] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [223] "rf_pls_elui_res" "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
- [229] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res"
- [235] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [241] "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [247] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
- [253] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [259] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
- [265] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res"
- [271] "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res"
- [277] "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
- [283] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_gam_elev_res"
- [289] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
- [295] "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res"
- [301] "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res"
- [307] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [313] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [319] "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [325] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
- [331] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [337] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [343] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
- [349] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res"
- [355] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [361] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [367] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [373] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res" 
- [379] "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
- [385] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [391] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [397] "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
- [403] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res"
- [409] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
- [415] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [421] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res"
- [427] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [433] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [439] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [445] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res" 
- [451] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res"
- [457] "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [463] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
- [469] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
- [475] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [481] "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [487] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [493] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [499] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
- [505] "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [511] "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res" 
- [517] "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
- [523] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res"
- [529] "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
- [535] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res" 
- [541] "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res"
- [547] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [553] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [559] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [565] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res" 
- [571] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res"
- [577] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [583] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res" 
- [589] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res" 
- [595] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [601] "rf_pls_elui_res" "rf_rf_elui_res"  "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [607] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res"
- [613] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [619] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
- [625] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [631] "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [637] "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
- [643] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
- [649] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [655] "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
- [661] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [667] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res"
- [673] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res" 
- [679] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res"
- [685] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res" 
- [691] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [697] "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [703] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [709] "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
- [715] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
- [721] "rf_gam_elev_res" "rf_rf_elui_res"  "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res"
- [727] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [733] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [739] "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res" 
- [745] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res"
- [751] "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
- [757] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res"
- [763] "rf_gam_elev_res" "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
- [769] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [775] "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
- [781] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [787] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res"
- [793] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res" 
- [799] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res"
- [805] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res" 
- [811] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [817] "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [823] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [829] "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_rf_elui_res" 
- [835] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res" 
- [841] "rf_gam_elev_res" "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
- [847] "rf_pls_elui_res" "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res"
- [853] "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res"
- [859] "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res" 
- [865] "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res"  "rf_pls_elui_res"
- [871] "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res" 
- [877] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res"
- [883] "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_gam_elev_res" "rf_rf_elui_res" 
- [889] "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [895] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
- [901] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [907] "rf_pls_elui_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res"
- [913] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [919] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_rf_elui_res"  "rf_pls_elui_res"
- [925] "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [931] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [937] "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_pls_elui_res"
- [943] "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res"
- [949] "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res" 
- [955] "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res" 
- [961] "rf_gam_elev_res" "rf_rf_elui_res"  "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res" 
- [967] "rf_pls_elui_res" "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res"
- [973] "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res"
- [979] "rf_pls_elui_res" "rf_gam_elev_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res" 
- [985] "rf_gam_elev_res" "rf_rf_elui_res"  "rf_rf_elui_res"  "rf_pls_elui_res" "rf_rf_elui_res"  "rf_pls_elui_res"
- [991] "rf_pls_elui_res" "rf_pls_elui_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_gam_elev_res" "rf_rf_elui_res" 
- [997] "rf_rf_elui_res"  "rf_pls_elui_res" "rf_pls_elui_res" "rf_pls_elui_res"
- [ reached getOption("max.print") -- omitted 200 entries ]
- @@ -416,7 +246,7 @@

Trophic levels

-
LS0tDQp0aXRsZTogIjUwMCBBbmFseXNlIEJpb2Rpdi1SUyINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCmBgYHtyLCBpbmNsdWRlID0gRkFMU0V9DQpzb3VyY2UoIkM6L1VzZXJzL3RuYXVzcy9wZXJtYW5lbnQvcGx5Z3JuZC9LSS1IeXBlcnNwZWMvSHlTcGVjX0tpTGkvc3JjLzAwMF9zZXRfZW52aXJvbm1lbnQuUiIpDQoNCmRpci5jcmVhdGUocGF0aF9hbmFseXNpc19zciwgc2hvd1dhcm5pbmdzID0gRkFMU0UpDQoNCmFsbF9tb2RlbHMgPSByZWFkUkRTKGZpbGUucGF0aChwYXRoX2NvbXBpbGVfYW5hbHlzaXNfc3JfZWxldl9yZXMsICJtb2RlbHNfcmVzX2VsZXZfcmVzLnJkcyIpKQ0KDQoNCiMgQ29sbGVjdCBtb2RlbCBwZXJmb3JtYW5jZQ0KcGxzX3JlcyA9IG1vZGVsUGVyZm9ybWFuY2UoYWxsX21vZGVsc1tbInBscyJdXSkNCnJmX3JlcyA9IG1vZGVsUGVyZm9ybWFuY2UoYWxsX21vZGVsc1tbInJmIl1dKQ0KDQpwbHNfcmVzJHJlc21vZGVsID0gcGxzX3JlcyRyZXNwDQpwbHNfcmVzJHJlc3AgPSBnc3ViKCJfZ2FtX2VsZXZfcmVzIiwgIiIsIHBsc19yZXMkcmVzcCkNCg0KcmZfcmVzJHJlc21vZGVsID0gcmZfcmVzJHJlc3ANCnJmX3JlcyRyZXNwID0gZ3N1YigiX2dhbV9lbGV2X3JlcyIsICIiLCByZl9yZXMkcmVzcCkNCg0Kc3VtbWFyeShwbHNfcmVzKQ0Kc3VtbWFyeShyZl9yZXMpDQoNCiMgR2V0IHRyb3BoaWMgbGV2ZWxzDQp0bCA9IHJlYWQudGFibGUoZmlsZS5wYXRoKHBhdGhfbWV0YSwgInRyb3BoaWNfbGV2ZWxzLmNzdiIpLCBoZWFkZXIgPSBUUlVFLCBzZXAgPSAiOyIpDQpwbHNfcmVzID0gbWVyZ2UocGxzX3JlcywgdGwsIGJ5LnggPSAicmVzcCIsIGJ5LnkgPSAiU3BlY2llcyIpDQpyZl9yZXMgPSBtZXJnZShyZl9yZXMsIHRsLCBieS54ID0gInJlc3AiLCBieS55ID0gIlNwZWNpZXMiKQ0KYGBgDQoNCiMgQ29tcGFyZSBQTFMgYW5kIFJGDQpgYGB7ciwgZWNobz1GQUxTRX0NCm1vZGVsc19yZXMgPSByYmluZChwbHNfcmVzWywgLTRdLCByZl9yZXNbLCAtNF0pDQptb2RlbHNfcmVzJG1wdHlwZSA9IHBhc3RlMChtb2RlbHNfcmVzJG10eXBlLCAiXyIsIG1vZGVsc19yZXMkcHR5cGUpDQptb2RlbHNfcmVzJG1wdHlwZSA9IGZhY3Rvcihtb2RlbHNfcmVzJG1wdHlwZSwgbGV2ZWxzID0gYygicGxzX2Vsc3AiLCAicmZfZWxzcCIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgInBsc19lbHVpIiwgInJmX2VsdWkiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICJwbHNfa21yYSIsICJyZl9rbXJhIiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAicGxzX3NwZWMiLCAicmZfc3BlYyIpKQ0KDQoNCmdncGxvdChkYXRhID0gbW9kZWxzX3Jlc1ttb2RlbHNfcmVzJHB0eXBlID09ICJlbHVpIiB8IG1vZGVsc19yZXMkcHR5cGUgPT0gInNwZWMiLF0sIGFlcyh4ID0gcmVzcCwgeSA9IFJNU0Vfbm9ybVNELCBmaWxsID0gbXB0eXBlKSkgKyANCiAgZ2VvbV9ib3hwbG90KCkgKw0KICB0aGVtZV9idygpICsgDQogIHRoZW1lKGF4aXMudGV4dC54ID0gZWxlbWVudF90ZXh0KGFuZ2xlID0gNDUsIGhqdXN0ID0gMSkpICsgDQogIGxhYnMobGlzdCh4ID0gIlNwZWNpZXMgZ3JvdXBzIiwgeSA9ICJSTVNFbiIsIGZpbGwgPSAiTW9kZWwgc2V0IikpDQpgYGANCg0KYGBge3IsIGVjaG89RkFMU0V9DQpwbHNfcmZfcmVzID0gbWVyZ2UocGxzX3JlcywgcmZfcmVzLCBieSA9IGMoInB0eXBlIiwgInJlc3AiLCAiUmVzYW1wbGUiKSwgYWxsLnkgPSBUUlVFKQ0KY29sbmFtZXMocGxzX3JmX3JlcylbZ3JlcCgiXFwueCIsIGNvbG5hbWVzKHBsc19yZl9yZXMpKV0gPSANCiAgZ3N1YigiXFwueCIsICJfcGxzIiwgY29sbmFtZXMocGxzX3JmX3JlcylbZ3JlcCgiXFwueCIsIGNvbG5hbWVzKHBsc19yZl9yZXMpKV0pDQpjb2xuYW1lcyhwbHNfcmZfcmVzKVtncmVwKCJcXC55IiwgY29sbmFtZXMocGxzX3JmX3JlcykpXSA9IA0KICBnc3ViKCJcXC55IiwgIl9yZiIsIGNvbG5hbWVzKHBsc19yZl9yZXMpW2dyZXAoIlxcLnkiLCBjb2xuYW1lcyhwbHNfcmZfcmVzKSldKQ0KIyBucm93KHBsc19yZl9yZXMpDQoNCnB0eXBlcyA9IGMoImVsdWkiLCAia21yYSIsICJzcGVjIiwgImVsc3AiKQ0KcGVyZl9jaGVjayA9IGxhcHBseShwdHlwZXMsIGZ1bmN0aW9uKHB0KXsNCiAgc3ViZGYgPSBwbHNfcmZfcmVzWyFpcy5uYShwbHNfcmZfcmVzJFJNU0VfcGxzKSAmIA0KICAgICAgICAgICAgICAgICAgICAgIHBsc19yZl9yZXMkcHR5cGUgPT0gcHQgJg0KICAgICAgICAgICAgICAgICAgICAgIHBsc19yZl9yZXMkUmVzYW1wbGUgPT0gIk1lYW4iLCBdDQogIHJvd25hbWVzKHN1YmRmW3N1YmRmJFJNU0VfcGxzIDwgc3ViZGYkUk1TRV9yZiwgXSkNCn0pDQpuYW1lcyhwZXJmX2NoZWNrKSA9IHB0eXBlcw0KYGBgDQoNCiMgQ2hlY2sgcGVyZm9ybWFuY2Ugb2YgUExTIGFuZCBSRg0KYGBge3IsIGVjaG8gPSBGQUxTRX0NCmZvcihpIGluIHNlcShsZW5ndGgocGVyZl9jaGVjaykpKXsNCnJtc2VfcGVyZiA9IHNvcnQocm91bmQoMS1wbHNfcmZfcmVzW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIlJNU0VfcGxzIl0gLyANCiAgICAgICAgICAgICAgICAgICAgICAgICBwbHNfcmZfcmVzW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIlJNU0VfcmYiXSwyKSkNCnZhcl9yZl9wcmN0ID0gc29ydChyb3VuZChwbHNfcmZfcmVzW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIm52YXJzX3JmIl0gLyANCiAgICAgICAgICAgICAgICAgICAgICAgICAgIHBsc19yZl9yZXNbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLCAibnZhcnNfcGxzIl0sMikpDQpsZXZlbF9wbHMgPSBzb3J0KHRhYmxlKHBsc19yZl9yZXNbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLCAiTGV2ZWxfcGxzIl0pKQ0KcHJpbnQobmFtZXMocGVyZl9jaGVja1tpXSkpDQpwcmludChwbHNfcmZfcmVzW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSxdKQ0KY2F0KCJSTVNFICgxIC0gUExTL1JGKToiLCBybXNlX3BlcmYsICJcbiIpDQpjYXQoIlZhciBudW1iZXIgKFJGL1BMUyk6IiwgdmFyX3JmX3ByY3QsICJcbiIpDQpjYXQoIkxldmVscyB3aXRoIFBMUyBpcyBiZXR0ZXI6IiwgbGV2ZWxfcGxzLCAiXG4iKQ0KY2F0KCJcblxuIikNCn0NCmBgYA0KDQojIENvbGxlY3QgdmFyaWFibGUgaW1wb3J0YW5jZQ0KIyMgTnVtYmVyIG9mIHZhcmlhYmxlcw0KYGBge3J9DQpwbHNfcmZfcmVzX2xvbmcgPSBtZWx0KHBsc19yZl9yZXNbcGxzX3JmX3JlcyRSZXNhbXBsZSA9PSAiTWVhbiIsIGMoMSwgMiwgNiwgMTMpXSwgaWQudmFycyA9IGMoInB0eXBlIiwgInJlc3AiKSkNCmdncGxvdChkYXRhID0gcGxzX3JmX3Jlc19sb25nLCBhZXMoeCA9IHZhcmlhYmxlLCB5ID0gdmFsdWUsIGZpbGwgPSBwdHlwZSkpICsNCiAgZ2VvbV9ib3hwbG90KCkgKyANCiAgbGFicyhsaXN0KHggPSAiTW9kZWxzIiwgeSA9ICJOdW1iZXIgb2YgdmFyaWFibGVzIiAsDQogICAgICAgICAgICBmaWxsID0gIlByZWRpY3RvciBTZXQiKSkgKw0KICB0aGVtZV9idygpDQpgYGANCg0KDQojIFZhcmlhYmxlIGltcG9ydGFuY2UgZm9yIFBMUw0KYGBge3IsIGVjaG89RkFMU0V9DQp2YXJfaW1wIDwtIGNvbXBWYXJJbXAoYWxsX21vZGVsc1tbInBscyJdXVtbInNwZWMiXV1AbW9kZWxbWzFdXSwgc2NhbGUgPSBGQUxTRSkNCiMgcGxvdFZhckltcCh2YXJfaW1wKQ0KcGxvdFZhckltcEhlYXRtYXAodmFyX2ltcCwgeGxhYiA9ICJTcGVjaWVzIiwgeWxhYiA9ICJCYW5kIikNCmBgYA0KDQojIFZhcmlhYmxlIGltcG9ydGFuY2UgZm9yIFJGDQpgYGB7ciwgZWNobz1GQUxTRX0NCnZhcl9pbXAgPC0gY29tcFZhckltcChhbGxfbW9kZWxzW1sicmYiXV1bWyJzcGVjIl1dQG1vZGVsW1sxXV0sIHNjYWxlID0gRkFMU0UpDQojIHBsb3RWYXJJbXAodmFyX2ltcCkNCnBsb3RWYXJJbXBIZWF0bWFwKHZhcl9pbXAsIHhsYWIgPSAiU3BlY2llcyIsIHlsYWIgPSAiQmFuZCIpDQpgYGANCg0KDQojIFRyb3BoaWMgbGV2ZWxzDQpgYGB7cn0NCnZhcl9pbXBfbGV2ZWxzID0gdmFyX2ltcA0KZm9yKGkgaW4gc2VxKGxlbmd0aCh2YXJfaW1wX2xldmVscykpKXsNCiAgdmFyX2ltcF9sZXZlbHNbW2ldXSRSRVNQT05TRSA9IHRsJExldmVsW2dyZXAodmFyX2ltcF9sZXZlbHNbW2ldXSRSRVNQT05TRVsxXSwgdGwkU3BlY2llcyldDQp9DQpwbG90VmFySW1wSGVhdG1hcCh2YXJfaW1wX2xldmVscywgeGxhYiA9ICJTcGVjaWVzIiwgeWxhYiA9ICJCYW5kIikNCmBgYA0KDQoNCg0KDQpXaGVuIHlvdSBzYXZlIHRoZSBub3RlYm9vaywgYW4gSFRNTCBmaWxlIGNvbnRhaW5pbmcgdGhlIGNvZGUgYW5kIG91dHB1dCB3aWxsIGJlIHNhdmVkIGFsb25nc2lkZSBpdCAoY2xpY2sgdGhlICpQcmV2aWV3KiBidXR0b24gb3IgcHJlc3MgKkN0cmwrU2hpZnQrSyogdG8gcHJldmlldyB0aGUgSFRNTCBmaWxlKS4NCg0KVGhlIHByZXZpZXcgc2hvd3MgeW91IGEgcmVuZGVyZWQgSFRNTCBjb3B5IG9mIHRoZSBjb250ZW50cyBvZiB0aGUgZWRpdG9yLiBDb25zZXF1ZW50bHksIHVubGlrZSAqS25pdCosICpQcmV2aWV3KiBkb2VzIG5vdCBydW4gYW55IFIgY29kZSBjaHVua3MuIEluc3RlYWQsIHRoZSBvdXRwdXQgb2YgdGhlIGNodW5rIHdoZW4gaXQgd2FzIGxhc3QgcnVuIGluIHRoZSBlZGl0b3IgaXMgZGlzcGxheWVkLg0K
+
LS0tDQp0aXRsZTogIjUxMCBBbmFseXNlIEJpb2Rpdi1SUyINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCmBgYHtyLCBpbmNsdWRlID0gRkFMU0V9DQpzb3VyY2UoIkM6L1VzZXJzL3RuYXVzcy9wZXJtYW5lbnQvcGx5Z3JuZC9LSS1IeXBlcnNwZWMvSHlTcGVjX0tpTGkvc3JjLzAwMF9zZXRfZW52aXJvbm1lbnQuUiIpDQoNCmRpci5jcmVhdGUocGF0aF9hbmFseXNpc19zcl9lbGV2X3Jlcywgc2hvd1dhcm5pbmdzID0gRkFMU0UpDQoNCmFsbF9tb2RlbHNfcmVzID0gcmVhZFJEUyhmaWxlLnBhdGgocGF0aF9jb21waWxlX2FuYWx5c2lzX3NyX2VsZXZfcmVzLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAibW9kZWxzX3NyX2VsZXZfcmVzLnJkcyIpKQ0KDQoNCiMgQ29sbGVjdCBtb2RlbCBwZXJmb3JtYW5jZQ0KcGxzX3JlcyA9IG1vZGVsUGVyZm9ybWFuY2UoYWxsX21vZGVsc19yZXNbWyJwbHMiXV0pDQpyZl9yZXMgPSBtb2RlbFBlcmZvcm1hbmNlKGFsbF9tb2RlbHNfcmVzW1sicmYiXV0pDQoNCnBsc19yZXMkcmVzbW9kZWwgPSBwbHNfcmVzJHJlc3ANCnBsc19yZXMkcmVzcCA9IGdzdWIoIl9nYW1fZWxldl9yZXMiLCAiIiwgcGxzX3JlcyRyZXNwKQ0KDQpyZl9yZXMkcmVzbW9kZWwgPSByZl9yZXMkcmVzcA0KcmZfcmVzJHJlc3AgPSBnc3ViKCJfZ2FtX2VsZXZfcmVzIiwgIiIsIHJmX3JlcyRyZXNwKQ0KDQpzdW1tYXJ5KHBsc19yZXMpDQpzdW1tYXJ5KHJmX3JlcykNCg0KIyBHZXQgdHJvcGhpYyBsZXZlbHMNCnRsID0gcmVhZC50YWJsZShmaWxlLnBhdGgocGF0aF9tZXRhLCAidHJvcGhpY19sZXZlbHMuY3N2IiksIGhlYWRlciA9IFRSVUUsIHNlcCA9ICI7IikNCnBsc19yZXMgPSBtZXJnZShwbHNfcmVzLCB0bCwgYnkueCA9ICJyZXNwIiwgYnkueSA9ICJTcGVjaWVzIikNCnJmX3JlcyA9IG1lcmdlKHJmX3JlcywgdGwsIGJ5LnggPSAicmVzcCIsIGJ5LnkgPSAiU3BlY2llcyIpDQpgYGANCg0KIyBDb21wYXJlIFBMUyBhbmQgUkYNCmBgYHtyLCBlY2hvPUZBTFNFfQ0KbW9kZWxzX3JlcyA9IHJiaW5kKHBsc19yZXNbLCAtNF0sIHJmX3Jlc1ssIC00XSkNCm1vZGVsc19yZXMkbXB0eXBlID0gcGFzdGUwKG1vZGVsc19yZXMkbXR5cGUsICJfIiwgbW9kZWxzX3JlcyRwdHlwZSkNCm1vZGVsc19yZXMkbXB0eXBlID0gZmFjdG9yKG1vZGVsc19yZXMkbXB0eXBlLCBsZXZlbHMgPSBjKCJyZl9nYW1fZWxldl9yZXMiKSkNCg0KDQpnZ3Bsb3QoZGF0YSA9IG1vZGVsc19yZXNbbW9kZWxzX3JlcyRwdHlwZSA9PSAiZ2FtX2VsZXZfcmVzIiB8IG1vZGVsc19yZXMkcHR5cGUgPT0gInNwZWMiLF0sIGFlcyh4ID0gcmVzcCwgeSA9IFJNU0Vfbm9ybVNELCBmaWxsID0gbXB0eXBlKSkgKyANCiAgZ2VvbV9ib3hwbG90KCkgKw0KICB0aGVtZV9idygpICsgDQogIHRoZW1lKGF4aXMudGV4dC54ID0gZWxlbWVudF90ZXh0KGFuZ2xlID0gNDUsIGhqdXN0ID0gMSkpICsgDQogIGxhYnMobGlzdCh4ID0gIlNwZWNpZXMgZ3JvdXBzIiwgeSA9ICJSTVNFbiIsIGZpbGwgPSAiTW9kZWwgc2V0IikpDQpgYGANCg0KYGBge3IsIGVjaG89RkFMU0V9DQpwbHNfcmZfcmVzID0gbWVyZ2UocGxzX3JlcywgcmZfcmVzLCBieSA9IGMoInB0eXBlIiwgInJlc3AiLCAiUmVzYW1wbGUiKSwgYWxsLnkgPSBUUlVFKQ0KY29sbmFtZXMocGxzX3JmX3JlcylbZ3JlcCgiXFwueCIsIGNvbG5hbWVzKHBsc19yZl9yZXMpKV0gPSANCiAgZ3N1YigiXFwueCIsICJfcGxzIiwgY29sbmFtZXMocGxzX3JmX3JlcylbZ3JlcCgiXFwueCIsIGNvbG5hbWVzKHBsc19yZl9yZXMpKV0pDQpjb2xuYW1lcyhwbHNfcmZfcmVzKVtncmVwKCJcXC55IiwgY29sbmFtZXMocGxzX3JmX3JlcykpXSA9IA0KICBnc3ViKCJcXC55IiwgIl9yZiIsIGNvbG5hbWVzKHBsc19yZl9yZXMpW2dyZXAoIlxcLnkiLCBjb2xuYW1lcyhwbHNfcmZfcmVzKSldKQ0KIyBucm93KHBsc19yZl9yZXMpDQoNCnB0eXBlcyA9IGMoImVsdWkiLCAia21yYSIsICJzcGVjIiwgImVsc3AiKQ0KcGVyZl9jaGVjayA9IGxhcHBseShwdHlwZXMsIGZ1bmN0aW9uKHB0KXsNCiAgc3ViZGYgPSBwbHNfcmZfcmVzWyFpcy5uYShwbHNfcmZfcmVzJFJNU0VfcGxzKSAmIA0KICAgICAgICAgICAgICAgICAgICAgIHBsc19yZl9yZXMkcHR5cGUgPT0gcHQgJg0KICAgICAgICAgICAgICAgICAgICAgIHBsc19yZl9yZXMkUmVzYW1wbGUgPT0gIk1lYW4iLCBdDQogIHJvd25hbWVzKHN1YmRmW3N1YmRmJFJNU0VfcGxzIDwgc3ViZGYkUk1TRV9yZiwgXSkNCn0pDQpuYW1lcyhwZXJmX2NoZWNrKSA9IHB0eXBlcw0KYGBgDQoNCiMgQ2hlY2sgcGVyZm9ybWFuY2Ugb2YgUExTIGFuZCBSRg0KYGBge3IsIGVjaG8gPSBGQUxTRX0NCmZvcihpIGluIHNlcShsZW5ndGgocGVyZl9jaGVjaykpKXsNCnJtc2VfcGVyZiA9IHNvcnQocm91bmQoMS1wbHNfcmZfcmVzW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIlJNU0VfcGxzIl0gLyANCiAgICAgICAgICAgICAgICAgICAgICAgICBwbHNfcmZfcmVzW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIlJNU0VfcmYiXSwyKSkNCnZhcl9yZl9wcmN0ID0gc29ydChyb3VuZChwbHNfcmZfcmVzW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIm52YXJzX3JmIl0gLyANCiAgICAgICAgICAgICAgICAgICAgICAgICAgIHBsc19yZl9yZXNbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLCAibnZhcnNfcGxzIl0sMikpDQpsZXZlbF9wbHMgPSBzb3J0KHRhYmxlKHBsc19yZl9yZXNbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLCAiTGV2ZWxfcGxzIl0pKQ0KcHJpbnQobmFtZXMocGVyZl9jaGVja1tpXSkpDQpwcmludChwbHNfcmZfcmVzW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSxdKQ0KY2F0KCJSTVNFICgxIC0gUExTL1JGKToiLCBybXNlX3BlcmYsICJcbiIpDQpjYXQoIlZhciBudW1iZXIgKFJGL1BMUyk6IiwgdmFyX3JmX3ByY3QsICJcbiIpDQpjYXQoIkxldmVscyB3aXRoIFBMUyBpcyBiZXR0ZXI6IiwgbGV2ZWxfcGxzLCAiXG4iKQ0KY2F0KCJcblxuIikNCn0NCmBgYA0KDQojIENvbGxlY3QgdmFyaWFibGUgaW1wb3J0YW5jZQ0KIyMgTnVtYmVyIG9mIHZhcmlhYmxlcw0KYGBge3J9DQpwbHNfcmZfcmVzX2xvbmcgPSBtZWx0KHBsc19yZl9yZXNbcGxzX3JmX3JlcyRSZXNhbXBsZSA9PSAiTWVhbiIsIGMoMSwgMiwgNiwgMTMpXSwgaWQudmFycyA9IGMoInB0eXBlIiwgInJlc3AiKSkNCmdncGxvdChkYXRhID0gcGxzX3JmX3Jlc19sb25nLCBhZXMoeCA9IHZhcmlhYmxlLCB5ID0gdmFsdWUsIGZpbGwgPSBwdHlwZSkpICsNCiAgZ2VvbV9ib3hwbG90KCkgKyANCiAgbGFicyhsaXN0KHggPSAiTW9kZWxzIiwgeSA9ICJOdW1iZXIgb2YgdmFyaWFibGVzIiAsDQogICAgICAgICAgICBmaWxsID0gIlByZWRpY3RvciBTZXQiKSkgKw0KICB0aGVtZV9idygpDQpgYGANCg0KDQojIFZhcmlhYmxlIGltcG9ydGFuY2UgZm9yIFBMUw0KYGBge3IsIGVjaG89RkFMU0V9DQp2YXJfaW1wIDwtIGNvbXBWYXJJbXAoYWxsX21vZGVsc19yZXNbWyJwbHMiXV1bWyJzcGVjIl1dQG1vZGVsW1sxXV0sIHNjYWxlID0gRkFMU0UpDQojIHBsb3RWYXJJbXAodmFyX2ltcCkNCnBsb3RWYXJJbXBIZWF0bWFwKHZhcl9pbXAsIHhsYWIgPSAiU3BlY2llcyIsIHlsYWIgPSAiQmFuZCIpDQpgYGANCg0KIyBWYXJpYWJsZSBpbXBvcnRhbmNlIGZvciBSRg0KYGBge3IsIGVjaG89RkFMU0V9DQp2YXJfaW1wIDwtIGNvbXBWYXJJbXAoYWxsX21vZGVsc19yZXNbWyJyZiJdXVtbInNwZWMiXV1AbW9kZWxbWzFdXSwgc2NhbGUgPSBGQUxTRSkNCiMgcGxvdFZhckltcCh2YXJfaW1wKQ0KcGxvdFZhckltcEhlYXRtYXAodmFyX2ltcCwgeGxhYiA9ICJTcGVjaWVzIiwgeWxhYiA9ICJCYW5kIikNCmBgYA0KDQoNCiMgVHJvcGhpYyBsZXZlbHMNCmBgYHtyfQ0KdmFyX2ltcF9sZXZlbHMgPSB2YXJfaW1wDQpmb3IoaSBpbiBzZXEobGVuZ3RoKHZhcl9pbXBfbGV2ZWxzKSkpew0KICB2YXJfaW1wX2xldmVsc1tbaV1dJFJFU1BPTlNFID0gdGwkTGV2ZWxbZ3JlcCh2YXJfaW1wX2xldmVsc1tbaV1dJFJFU1BPTlNFWzFdLCB0bCRTcGVjaWVzKV0NCn0NCnBsb3RWYXJJbXBIZWF0bWFwKHZhcl9pbXBfbGV2ZWxzLCB4bGFiID0gIlNwZWNpZXMiLCB5bGFiID0gIkJhbmQiKQ0KYGBgDQoNCg0KDQoNCldoZW4geW91IHNhdmUgdGhlIG5vdGVib29rLCBhbiBIVE1MIGZpbGUgY29udGFpbmluZyB0aGUgY29kZSBhbmQgb3V0cHV0IHdpbGwgYmUgc2F2ZWQgYWxvbmdzaWRlIGl0IChjbGljayB0aGUgKlByZXZpZXcqIGJ1dHRvbiBvciBwcmVzcyAqQ3RybCtTaGlmdCtLKiB0byBwcmV2aWV3IHRoZSBIVE1MIGZpbGUpLg0KDQpUaGUgcHJldmlldyBzaG93cyB5b3UgYSByZW5kZXJlZCBIVE1MIGNvcHkgb2YgdGhlIGNvbnRlbnRzIG9mIHRoZSBlZGl0b3IuIENvbnNlcXVlbnRseSwgdW5saWtlICpLbml0KiwgKlByZXZpZXcqIGRvZXMgbm90IHJ1biBhbnkgUiBjb2RlIGNodW5rcy4gSW5zdGVhZCwgdGhlIG91dHB1dCBvZiB0aGUgY2h1bmsgd2hlbiBpdCB3YXMgbGFzdCBydW4gaW4gdGhlIGVkaXRvciBpcyBkaXNwbGF5ZWQuDQo=
diff --git a/src/520_analyse_biodiv_sr_two_step.Rmd b/src/520_analyse_biodiv_sr_two_step.Rmd new file mode 100644 index 0000000..e3b3f83 --- /dev/null +++ b/src/520_analyse_biodiv_sr_two_step.Rmd @@ -0,0 +1,136 @@ +--- +title: "520 Analyse Biodiv-RS Two Step" +output: html_notebook +--- + +```{r, include = FALSE} +source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") + +dir.create(path_analysis_sr_elev_res, showWarnings = FALSE) + +comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) +all_models = readRDS(file.path(path_compile_analysis_sr, "models_sr.rds")) +all_models_res = readRDS(file.path(path_compile_analysis_sr_elev_res, + "models_sr_elev_res.rds")) + + + +comb_sr_two_step = comb +model = all_models$gam$elev@model$gam_none +model_res = all_models_res$pls$gam_elev_res@model$rf_ffs + +comp2StepPred(comb_sr_two_step, model, model_res) + + + + +# Collect model performance +pls_res = modelPerformance(all_models_res[["pls"]]) +rf_res = modelPerformance(all_models_res[["rf"]]) + +pls_res$resmodel = pls_res$resp +pls_res$resp = gsub("_gam_elev_res", "", pls_res$resp) + +rf_res$resmodel = rf_res$resp +rf_res$resp = gsub("_gam_elev_res", "", rf_res$resp) + +summary(pls_res) +summary(rf_res) + +# Get trophic levels +tl = read.table(file.path(path_meta, "trophic_levels.csv"), header = TRUE, sep = ";") +pls_res = merge(pls_res, tl, by.x = "resp", by.y = "Species") +rf_res = merge(rf_res, tl, by.x = "resp", by.y = "Species") +``` + +# Compare PLS and RF +```{r, echo=FALSE} +models_res = rbind(pls_res[, -4], rf_res[, -4]) +models_res$mptype = paste0(models_res$mtype, "_", models_res$ptype) +models_res$mptype = factor(models_res$mptype, levels = c("rf_gam_elev_res")) + + +ggplot(data = models_res[models_res$ptype == "gam_elev_res" | models_res$ptype == "spec",], aes(x = resp, y = RMSE_normSD, fill = mptype)) + + geom_boxplot() + + theme_bw() + + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + + labs(list(x = "Species groups", y = "RMSEn", fill = "Model set")) +``` + +```{r, echo=FALSE} +pls_rf_res = merge(pls_res, rf_res, by = c("ptype", "resp", "Resample"), all.y = TRUE) +colnames(pls_rf_res)[grep("\\.x", colnames(pls_rf_res))] = + gsub("\\.x", "_pls", colnames(pls_rf_res)[grep("\\.x", colnames(pls_rf_res))]) +colnames(pls_rf_res)[grep("\\.y", colnames(pls_rf_res))] = + gsub("\\.y", "_rf", colnames(pls_rf_res)[grep("\\.y", colnames(pls_rf_res))]) +# nrow(pls_rf_res) + +ptypes = c("elui", "kmra", "spec", "elsp") +perf_check = lapply(ptypes, function(pt){ + subdf = pls_rf_res[!is.na(pls_rf_res$RMSE_pls) & + pls_rf_res$ptype == pt & + pls_rf_res$Resample == "Mean", ] + rownames(subdf[subdf$RMSE_pls < subdf$RMSE_rf, ]) +}) +names(perf_check) = ptypes +``` + +# Check performance of PLS and RF +```{r, echo = FALSE} +for(i in seq(length(perf_check))){ +rmse_perf = sort(round(1-pls_rf_res[as.numeric(perf_check[[i]]), "RMSE_pls"] / + pls_rf_res[as.numeric(perf_check[[i]]), "RMSE_rf"],2)) +var_rf_prct = sort(round(pls_rf_res[as.numeric(perf_check[[i]]), "nvars_rf"] / + pls_rf_res[as.numeric(perf_check[[i]]), "nvars_pls"],2)) +level_pls = sort(table(pls_rf_res[as.numeric(perf_check[[i]]), "Level_pls"])) +print(names(perf_check[i])) +print(pls_rf_res[as.numeric(perf_check[[i]]),]) +cat("RMSE (1 - PLS/RF):", rmse_perf, "\n") +cat("Var number (RF/PLS):", var_rf_prct, "\n") +cat("Levels with PLS is better:", level_pls, "\n") +cat("\n\n") +} +``` + +# Collect variable importance +## Number of variables +```{r} +pls_rf_res_long = melt(pls_rf_res[pls_rf_res$Resample == "Mean", c(1, 2, 6, 13)], id.vars = c("ptype", "resp")) +ggplot(data = pls_rf_res_long, aes(x = variable, y = value, fill = ptype)) + + geom_boxplot() + + labs(list(x = "Models", y = "Number of variables" , + fill = "Predictor Set")) + + theme_bw() +``` + + +# Variable importance for PLS +```{r, echo=FALSE} +var_imp <- compVarImp(all_models_res[["pls"]][["spec"]]@model[[1]], scale = FALSE) +# plotVarImp(var_imp) +plotVarImpHeatmap(var_imp, xlab = "Species", ylab = "Band") +``` + +# Variable importance for RF +```{r, echo=FALSE} +var_imp <- compVarImp(all_models_res[["rf"]][["spec"]]@model[[1]], scale = FALSE) +# plotVarImp(var_imp) +plotVarImpHeatmap(var_imp, xlab = "Species", ylab = "Band") +``` + + +# Trophic levels +```{r} +var_imp_levels = var_imp +for(i in seq(length(var_imp_levels))){ + var_imp_levels[[i]]$RESPONSE = tl$Level[grep(var_imp_levels[[i]]$RESPONSE[1], tl$Species)] +} +plotVarImpHeatmap(var_imp_levels, xlab = "Species", ylab = "Band") +``` + + + + +When you save the notebook, an HTML file containing the code and output will be saved alongside it (click the *Preview* button or press *Ctrl+Shift+K* to preview the HTML file). + +The preview shows you a rendered HTML copy of the contents of the editor. Consequently, unlike *Knit*, *Preview* does not run any R code chunks. Instead, the output of the chunk when it was last run in the editor is displayed. diff --git a/src/520_analyse_biodiv_sr_two_step.nb.html b/src/520_analyse_biodiv_sr_two_step.nb.html new file mode 100644 index 0000000..2fb220b --- /dev/null +++ b/src/520_analyse_biodiv_sr_two_step.nb.html @@ -0,0 +1,290 @@ + + + + + + + + + + + + + +520 Analyse Biodiv-RS Two Step + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + + + + + + + + + + + + + + + + + + +
+

Compare PLS and RF

+ + + + + + + + +
+
+

Check performance of PLS and RF

+ + + + +
+
+

Collect variable importance

+
+

Number of variables

+ + + +
pls_rf_res_long = melt(pls_rf_res[pls_rf_res$Resample == "Mean", c(1, 2, 6, 13)], id.vars = c("ptype", "resp"))
+ggplot(data = pls_rf_res_long, aes(x = variable, y = value, fill = ptype)) +
+  geom_boxplot() + 
+  labs(list(x = "Models", y = "Number of variables" ,
+            fill = "Predictor Set")) +
+  theme_bw()
+ + + +
+
+
+

Variable importance for PLS

+ + + + +
+
+

Variable importance for RF

+ + + + +
+
+

Trophic levels

+ + + +
var_imp_levels = var_imp
+for(i in seq(length(var_imp_levels))){
+  var_imp_levels[[i]]$RESPONSE = tl$Level[grep(var_imp_levels[[i]]$RESPONSE[1], tl$Species)]
+}
+plotVarImpHeatmap(var_imp_levels, xlab = "Species", ylab = "Band")
+ + + +

When you save the notebook, an HTML file containing the code and output will be saved alongside it (click the Preview button or press Ctrl+Shift+K to preview the HTML file).

+

The preview shows you a rendered HTML copy of the contents of the editor. Consequently, unlike Knit, Preview does not run any R code chunks. Instead, the output of the chunk when it was last run in the editor is displayed.

+ +
+ +
LS0tDQp0aXRsZTogIjUyMCBBbmFseXNlIEJpb2Rpdi1SUyBUd28gU3RlcCINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCmBgYHtyLCBpbmNsdWRlID0gRkFMU0V9DQpzb3VyY2UoIkM6L1VzZXJzL3RuYXVzcy9wZXJtYW5lbnQvcGx5Z3JuZC9LSS1IeXBlcnNwZWMvSHlTcGVjX0tpTGkvc3JjLzAwMF9zZXRfZW52aXJvbm1lbnQuUiIpDQoNCmRpci5jcmVhdGUocGF0aF9hbmFseXNpc19zcl9lbGV2X3Jlcywgc2hvd1dhcm5pbmdzID0gRkFMU0UpDQoNCmNvbWIgPSByZWFkUkRTKHBhc3RlMChwYXRoX2NvbWJfZ3BtX3NyLCAia2lfaHlwZXJzcGVjX2Jpb2Rpdl9ub25fc2NhbGVkLnJkcyIpKQ0KYWxsX21vZGVscyA9IHJlYWRSRFMoZmlsZS5wYXRoKHBhdGhfY29tcGlsZV9hbmFseXNpc19zciwgIm1vZGVsc19zci5yZHMiKSkNCmFsbF9tb2RlbHNfcmVzID0gcmVhZFJEUyhmaWxlLnBhdGgocGF0aF9jb21waWxlX2FuYWx5c2lzX3NyX2VsZXZfcmVzLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAibW9kZWxzX3NyX2VsZXZfcmVzLnJkcyIpKQ0KDQoNCg0KY29tYl9zcl90d29fc3RlcCA9IGNvbWINCm1vZGVsID0gYWxsX21vZGVscyRnYW0kZWxldkBtb2RlbCRnYW1fbm9uZQ0KbW9kZWxfcmVzID0gYWxsX21vZGVsc19yZXMkcGxzJGdhbV9lbGV2X3Jlc0Btb2RlbCRyZl9mZnMNCg0KY29tcDJTdGVwUHJlZChjb21iX3NyX3R3b19zdGVwLCBtb2RlbCwgbW9kZWxfcmVzKQ0KDQoNCg0KDQojIENvbGxlY3QgbW9kZWwgcGVyZm9ybWFuY2UNCnBsc19yZXMgPSBtb2RlbFBlcmZvcm1hbmNlKGFsbF9tb2RlbHNfcmVzW1sicGxzIl1dKQ0KcmZfcmVzID0gbW9kZWxQZXJmb3JtYW5jZShhbGxfbW9kZWxzX3Jlc1tbInJmIl1dKQ0KDQpwbHNfcmVzJHJlc21vZGVsID0gcGxzX3JlcyRyZXNwDQpwbHNfcmVzJHJlc3AgPSBnc3ViKCJfZ2FtX2VsZXZfcmVzIiwgIiIsIHBsc19yZXMkcmVzcCkNCg0KcmZfcmVzJHJlc21vZGVsID0gcmZfcmVzJHJlc3ANCnJmX3JlcyRyZXNwID0gZ3N1YigiX2dhbV9lbGV2X3JlcyIsICIiLCByZl9yZXMkcmVzcCkNCg0Kc3VtbWFyeShwbHNfcmVzKQ0Kc3VtbWFyeShyZl9yZXMpDQoNCiMgR2V0IHRyb3BoaWMgbGV2ZWxzDQp0bCA9IHJlYWQudGFibGUoZmlsZS5wYXRoKHBhdGhfbWV0YSwgInRyb3BoaWNfbGV2ZWxzLmNzdiIpLCBoZWFkZXIgPSBUUlVFLCBzZXAgPSAiOyIpDQpwbHNfcmVzID0gbWVyZ2UocGxzX3JlcywgdGwsIGJ5LnggPSAicmVzcCIsIGJ5LnkgPSAiU3BlY2llcyIpDQpyZl9yZXMgPSBtZXJnZShyZl9yZXMsIHRsLCBieS54ID0gInJlc3AiLCBieS55ID0gIlNwZWNpZXMiKQ0KYGBgDQoNCiMgQ29tcGFyZSBQTFMgYW5kIFJGDQpgYGB7ciwgZWNobz1GQUxTRX0NCm1vZGVsc19yZXMgPSByYmluZChwbHNfcmVzWywgLTRdLCByZl9yZXNbLCAtNF0pDQptb2RlbHNfcmVzJG1wdHlwZSA9IHBhc3RlMChtb2RlbHNfcmVzJG10eXBlLCAiXyIsIG1vZGVsc19yZXMkcHR5cGUpDQptb2RlbHNfcmVzJG1wdHlwZSA9IGZhY3Rvcihtb2RlbHNfcmVzJG1wdHlwZSwgbGV2ZWxzID0gYygicmZfZ2FtX2VsZXZfcmVzIikpDQoNCg0KZ2dwbG90KGRhdGEgPSBtb2RlbHNfcmVzW21vZGVsc19yZXMkcHR5cGUgPT0gImdhbV9lbGV2X3JlcyIgfCBtb2RlbHNfcmVzJHB0eXBlID09ICJzcGVjIixdLCBhZXMoeCA9IHJlc3AsIHkgPSBSTVNFX25vcm1TRCwgZmlsbCA9IG1wdHlwZSkpICsgDQogIGdlb21fYm94cGxvdCgpICsNCiAgdGhlbWVfYncoKSArIA0KICB0aGVtZShheGlzLnRleHQueCA9IGVsZW1lbnRfdGV4dChhbmdsZSA9IDQ1LCBoanVzdCA9IDEpKSArIA0KICBsYWJzKGxpc3QoeCA9ICJTcGVjaWVzIGdyb3VwcyIsIHkgPSAiUk1TRW4iLCBmaWxsID0gIk1vZGVsIHNldCIpKQ0KYGBgDQoNCmBgYHtyLCBlY2hvPUZBTFNFfQ0KcGxzX3JmX3JlcyA9IG1lcmdlKHBsc19yZXMsIHJmX3JlcywgYnkgPSBjKCJwdHlwZSIsICJyZXNwIiwgIlJlc2FtcGxlIiksIGFsbC55ID0gVFJVRSkNCmNvbG5hbWVzKHBsc19yZl9yZXMpW2dyZXAoIlxcLngiLCBjb2xuYW1lcyhwbHNfcmZfcmVzKSldID0gDQogIGdzdWIoIlxcLngiLCAiX3BscyIsIGNvbG5hbWVzKHBsc19yZl9yZXMpW2dyZXAoIlxcLngiLCBjb2xuYW1lcyhwbHNfcmZfcmVzKSldKQ0KY29sbmFtZXMocGxzX3JmX3JlcylbZ3JlcCgiXFwueSIsIGNvbG5hbWVzKHBsc19yZl9yZXMpKV0gPSANCiAgZ3N1YigiXFwueSIsICJfcmYiLCBjb2xuYW1lcyhwbHNfcmZfcmVzKVtncmVwKCJcXC55IiwgY29sbmFtZXMocGxzX3JmX3JlcykpXSkNCiMgbnJvdyhwbHNfcmZfcmVzKQ0KDQpwdHlwZXMgPSBjKCJlbHVpIiwgImttcmEiLCAic3BlYyIsICJlbHNwIikNCnBlcmZfY2hlY2sgPSBsYXBwbHkocHR5cGVzLCBmdW5jdGlvbihwdCl7DQogIHN1YmRmID0gcGxzX3JmX3Jlc1shaXMubmEocGxzX3JmX3JlcyRSTVNFX3BscykgJiANCiAgICAgICAgICAgICAgICAgICAgICBwbHNfcmZfcmVzJHB0eXBlID09IHB0ICYNCiAgICAgICAgICAgICAgICAgICAgICBwbHNfcmZfcmVzJFJlc2FtcGxlID09ICJNZWFuIiwgXQ0KICByb3duYW1lcyhzdWJkZltzdWJkZiRSTVNFX3BscyA8IHN1YmRmJFJNU0VfcmYsIF0pDQp9KQ0KbmFtZXMocGVyZl9jaGVjaykgPSBwdHlwZXMNCmBgYA0KDQojIENoZWNrIHBlcmZvcm1hbmNlIG9mIFBMUyBhbmQgUkYNCmBgYHtyLCBlY2hvID0gRkFMU0V9DQpmb3IoaSBpbiBzZXEobGVuZ3RoKHBlcmZfY2hlY2spKSl7DQpybXNlX3BlcmYgPSBzb3J0KHJvdW5kKDEtcGxzX3JmX3Jlc1thcy5udW1lcmljKHBlcmZfY2hlY2tbW2ldXSksICJSTVNFX3BscyJdIC8gDQogICAgICAgICAgICAgICAgICAgICAgICAgcGxzX3JmX3Jlc1thcy5udW1lcmljKHBlcmZfY2hlY2tbW2ldXSksICJSTVNFX3JmIl0sMikpDQp2YXJfcmZfcHJjdCA9IHNvcnQocm91bmQocGxzX3JmX3Jlc1thcy5udW1lcmljKHBlcmZfY2hlY2tbW2ldXSksICJudmFyc19yZiJdIC8gDQogICAgICAgICAgICAgICAgICAgICAgICAgICBwbHNfcmZfcmVzW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIm52YXJzX3BscyJdLDIpKQ0KbGV2ZWxfcGxzID0gc29ydCh0YWJsZShwbHNfcmZfcmVzW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIkxldmVsX3BscyJdKSkNCnByaW50KG5hbWVzKHBlcmZfY2hlY2tbaV0pKQ0KcHJpbnQocGxzX3JmX3Jlc1thcy5udW1lcmljKHBlcmZfY2hlY2tbW2ldXSksXSkNCmNhdCgiUk1TRSAoMSAtIFBMUy9SRik6Iiwgcm1zZV9wZXJmLCAiXG4iKQ0KY2F0KCJWYXIgbnVtYmVyIChSRi9QTFMpOiIsIHZhcl9yZl9wcmN0LCAiXG4iKQ0KY2F0KCJMZXZlbHMgd2l0aCBQTFMgaXMgYmV0dGVyOiIsIGxldmVsX3BscywgIlxuIikNCmNhdCgiXG5cbiIpDQp9DQpgYGANCg0KIyBDb2xsZWN0IHZhcmlhYmxlIGltcG9ydGFuY2UNCiMjIE51bWJlciBvZiB2YXJpYWJsZXMNCmBgYHtyfQ0KcGxzX3JmX3Jlc19sb25nID0gbWVsdChwbHNfcmZfcmVzW3Bsc19yZl9yZXMkUmVzYW1wbGUgPT0gIk1lYW4iLCBjKDEsIDIsIDYsIDEzKV0sIGlkLnZhcnMgPSBjKCJwdHlwZSIsICJyZXNwIikpDQpnZ3Bsb3QoZGF0YSA9IHBsc19yZl9yZXNfbG9uZywgYWVzKHggPSB2YXJpYWJsZSwgeSA9IHZhbHVlLCBmaWxsID0gcHR5cGUpKSArDQogIGdlb21fYm94cGxvdCgpICsgDQogIGxhYnMobGlzdCh4ID0gIk1vZGVscyIsIHkgPSAiTnVtYmVyIG9mIHZhcmlhYmxlcyIgLA0KICAgICAgICAgICAgZmlsbCA9ICJQcmVkaWN0b3IgU2V0IikpICsNCiAgdGhlbWVfYncoKQ0KYGBgDQoNCg0KIyBWYXJpYWJsZSBpbXBvcnRhbmNlIGZvciBQTFMNCmBgYHtyLCBlY2hvPUZBTFNFfQ0KdmFyX2ltcCA8LSBjb21wVmFySW1wKGFsbF9tb2RlbHNfcmVzW1sicGxzIl1dW1sic3BlYyJdXUBtb2RlbFtbMV1dLCBzY2FsZSA9IEZBTFNFKQ0KIyBwbG90VmFySW1wKHZhcl9pbXApDQpwbG90VmFySW1wSGVhdG1hcCh2YXJfaW1wLCB4bGFiID0gIlNwZWNpZXMiLCB5bGFiID0gIkJhbmQiKQ0KYGBgDQoNCiMgVmFyaWFibGUgaW1wb3J0YW5jZSBmb3IgUkYNCmBgYHtyLCBlY2hvPUZBTFNFfQ0KdmFyX2ltcCA8LSBjb21wVmFySW1wKGFsbF9tb2RlbHNfcmVzW1sicmYiXV1bWyJzcGVjIl1dQG1vZGVsW1sxXV0sIHNjYWxlID0gRkFMU0UpDQojIHBsb3RWYXJJbXAodmFyX2ltcCkNCnBsb3RWYXJJbXBIZWF0bWFwKHZhcl9pbXAsIHhsYWIgPSAiU3BlY2llcyIsIHlsYWIgPSAiQmFuZCIpDQpgYGANCg0KDQojIFRyb3BoaWMgbGV2ZWxzDQpgYGB7cn0NCnZhcl9pbXBfbGV2ZWxzID0gdmFyX2ltcA0KZm9yKGkgaW4gc2VxKGxlbmd0aCh2YXJfaW1wX2xldmVscykpKXsNCiAgdmFyX2ltcF9sZXZlbHNbW2ldXSRSRVNQT05TRSA9IHRsJExldmVsW2dyZXAodmFyX2ltcF9sZXZlbHNbW2ldXSRSRVNQT05TRVsxXSwgdGwkU3BlY2llcyldDQp9DQpwbG90VmFySW1wSGVhdG1hcCh2YXJfaW1wX2xldmVscywgeGxhYiA9ICJTcGVjaWVzIiwgeWxhYiA9ICJCYW5kIikNCmBgYA0KDQoNCg0KDQpXaGVuIHlvdSBzYXZlIHRoZSBub3RlYm9vaywgYW4gSFRNTCBmaWxlIGNvbnRhaW5pbmcgdGhlIGNvZGUgYW5kIG91dHB1dCB3aWxsIGJlIHNhdmVkIGFsb25nc2lkZSBpdCAoY2xpY2sgdGhlICpQcmV2aWV3KiBidXR0b24gb3IgcHJlc3MgKkN0cmwrU2hpZnQrSyogdG8gcHJldmlldyB0aGUgSFRNTCBmaWxlKS4NCg0KVGhlIHByZXZpZXcgc2hvd3MgeW91IGEgcmVuZGVyZWQgSFRNTCBjb3B5IG9mIHRoZSBjb250ZW50cyBvZiB0aGUgZWRpdG9yLiBDb25zZXF1ZW50bHksIHVubGlrZSAqS25pdCosICpQcmV2aWV3KiBkb2VzIG5vdCBydW4gYW55IFIgY29kZSBjaHVua3MuIEluc3RlYWQsIHRoZSBvdXRwdXQgb2YgdGhlIGNodW5rIHdoZW4gaXQgd2FzIGxhc3QgcnVuIGluIHRoZSBlZGl0b3IgaXMgZGlzcGxheWVkLg0K
+ + + +
+ + + + + + + + From 8cb737d5a4a148768d5e611bde66b08279fc5029 Mon Sep 17 00:00:00 2001 From: "Nauss, Thomas" Date: Sun, 3 Feb 2019 15:52:19 +0100 Subject: [PATCH 43/65] Add check for missing model --- src/001_functions.R | 22 +++++++++++--------- src/310_predict_biodiv_sr_res_rf.R | 1 + src/410_compile_analyse_biodiv_sr_elev_res.R | 7 ++++++- 3 files changed, 19 insertions(+), 11 deletions(-) diff --git a/src/001_functions.R b/src/001_functions.R index c13d21e..3563398 100644 --- a/src/001_functions.R +++ b/src/001_functions.R @@ -79,16 +79,18 @@ compModels = function(model, pt, mt, outpath){ model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - model = createIndexFolds(x = model, nested_cv = FALSE) - model = trainModel(x = model, - metric = "RMSE", - n_var = NULL, - mthd = mt, - mode = "ffs", - seed_nbr = 11, - cv_nbr = NULL, - var_selection = "indv", - filepath_tmp = NULL) + if(nrow(model@data$input) > 0){ + model = createIndexFolds(x = model, nested_cv = FALSE) + model = trainModel(x = model, + metric = "RMSE", + n_var = NULL, + mthd = mt, + mode = "ffs", + seed_nbr = 11, + cv_nbr = NULL, + var_selection = "indv", + filepath_tmp = NULL) + } outfile_name = gsub("[*]", "", paste0(outpath, "ki_sr_", pt, "_non_scaled_", mt, "_", diff --git a/src/310_predict_biodiv_sr_res_rf.R b/src/310_predict_biodiv_sr_res_rf.R index 791e928..0d89baf 100644 --- a/src/310_predict_biodiv_sr_res_rf.R +++ b/src/310_predict_biodiv_sr_res_rf.R @@ -19,6 +19,7 @@ dir.create(paste0(path_model_gpm_sr_res), showWarnings = FALSE) res_suffixes = c("_gam_elev_res", "_pls_elui_res", "_rf_elui_res") res_suffixes = c("_pls_elui_res", "_rf_elui_res") mtypes = c("pls", "rf") +mtypes = c("rf") pt = "*spec*" diff --git a/src/410_compile_analyse_biodiv_sr_elev_res.R b/src/410_compile_analyse_biodiv_sr_elev_res.R index 53d3aaf..4af2ca1 100644 --- a/src/410_compile_analyse_biodiv_sr_elev_res.R +++ b/src/410_compile_analyse_biodiv_sr_elev_res.R @@ -18,7 +18,12 @@ all_models = lapply(mtypes, function(mt){ all_models = readRDS(model_files[[1]]) for(i in (seq(2, length(model_files)))){ - all_models@model[[1]][[i]] = readRDS(model_files[[i]])@model[[1]][[1]] + act_model = readRDS(model_files[[i]]) + if(length(act_model@model) > 0){ + all_models@model[[1]][[i]] = act_model@model[[1]][[1]] + } else { + all_models@model[[1]][[i]] = NA + } } return(all_models) From 1c6b4cabf47fd1ca60ddec1b4c858d1930586282 Mon Sep 17 00:00:00 2001 From: Thomas Nauss Date: Tue, 5 Mar 2019 12:48:12 +0100 Subject: [PATCH 44/65] Update --- src/000_set_environment.R | 3 +- src/410_compile_analyse_biodiv_sr_elev_res.R | 2 +- src/500_analyse_biodiv_sr.Rmd | 63 ++++++++++++++++---- src/500_analyse_biodiv_sr.nb.html | 25 ++++---- src/520_analyse_biodiv_sr_two_step.Rmd | 21 ++++--- src/520_analyse_biodiv_sr_two_step.nb.html | 5 +- 6 files changed, 81 insertions(+), 38 deletions(-) diff --git a/src/000_set_environment.R b/src/000_set_environment.R index 8b24348..b75411d 100644 --- a/src/000_set_environment.R +++ b/src/000_set_environment.R @@ -1,6 +1,6 @@ # Set path --------------------------------------------------------------------- if(Sys.info()["sysname"] == "Windows"){ - filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/" + filepath_base = "C:/Users/Thomas Nauss/permanent/plygrnd/KI-Hyperspec/" } else { filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/" } @@ -61,6 +61,7 @@ library(spacetime) # library(vegan) # library(yaml) + # Other settings --------------------------------------------------------------- source(filepath_source) diff --git a/src/410_compile_analyse_biodiv_sr_elev_res.R b/src/410_compile_analyse_biodiv_sr_elev_res.R index 4af2ca1..016099c 100644 --- a/src/410_compile_analyse_biodiv_sr_elev_res.R +++ b/src/410_compile_analyse_biodiv_sr_elev_res.R @@ -1,5 +1,5 @@ # Combine species richness residual model results in one variable. -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +source("C:/Users/Thomas Nauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") dir.create(path_compile_analysis_sr_elev_res, showWarnings = FALSE) diff --git a/src/500_analyse_biodiv_sr.Rmd b/src/500_analyse_biodiv_sr.Rmd index 62a36f6..616ea8a 100644 --- a/src/500_analyse_biodiv_sr.Rmd +++ b/src/500_analyse_biodiv_sr.Rmd @@ -25,6 +25,20 @@ tl = read.table(file.path(path_meta, "trophic_levels.csv"), header = TRUE, sep = gam_sr = merge(gam_sr, tl, by.x = "resp", by.y = "Species") pls_sr = merge(pls_sr, tl, by.x = "resp", by.y = "Species") rf_sr = merge(rf_sr, tl, by.x = "resp", by.y = "Species") + +# Arrange levels and species names +pls_sr$Level = factor(pls_sr$Level, levels(pls_sr$Level)[c(1, 5, 4, 3, 6, 2)] ) +pls_sr$resp = as.character(pls_sr$resp) +pls_sr$resp = substr(pls_sr$resp, 3, nchar(pls_sr$resp)) +pls_sr$resp = gsub("(^[[:alpha:]])", "\\U\\1", pls_sr$resp, perl=TRUE) +pls_sr$resp = factor(pls_sr$resp, unique(pls_sr$resp[order(pls_sr$Level, pls_sr$resp)])) + + +rf_sr$Level = factor(rf_sr$Level, levels(rf_sr$Level)[c(1, 5, 4, 3, 6, 2)] ) +rf_sr$resp = as.character(rf_sr$resp) +rf_sr$resp = substr(rf_sr$resp, 3, nchar(rf_sr$resp)) +rf_sr$resp = gsub("(^[[:alpha:]])", "\\U\\1", rf_sr$resp, perl=TRUE) +rf_sr$resp = factor(rf_sr$resp, unique(rf_sr$resp[order(rf_sr$Level, rf_sr$resp)])) ``` # Compare PLS and RF @@ -36,12 +50,37 @@ models_sr$mptype = factor(models_sr$mptype, levels = c("pls_elsp", "rf_elsp", "pls_kmra", "rf_kmra", "pls_spec", "rf_spec")) +ggplot(data = models_sr[models_sr$mtype == "pls" & + (models_sr$ptype == "elui" | models_sr$ptype == "spec"),], + aes(x = resp, y = RMSE_normSD, fill = mptype)) + + geom_boxplot() + + geom_hline(yintercept=c(0.5,1), linetype="dashed", color = "black") + + scale_fill_brewer(palette="Dark2") + + theme_bw() + + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + + labs(list(x = "Species groups", y = "RMSEn", fill = "Model set")) + + -ggplot(data = models_sr[models_sr$ptype == "elui" | models_sr$ptype == "spec",], aes(x = resp, y = RMSE_normSD, fill = mptype)) + +ggplot(data = models_sr[models_sr$mtype == "rf" & + (models_sr$ptype == "elui" | models_sr$ptype == "spec"),], + aes(x = resp, y = RMSE_normSD, fill = mptype)) + geom_boxplot() + + geom_hline(yintercept=c(0.5,1), linetype="dashed", color = "black") + + scale_fill_brewer(palette="Dark2") + theme_bw() + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + labs(list(x = "Species groups", y = "RMSEn", fill = "Model set")) + + +ggplot(data = models_sr[models_sr$mtype == "rf" & models_sr$ptype == "spec",], + aes(x = resp, y = RMSE_normSD, fill = Level)) + + geom_boxplot() + + geom_hline(yintercept=c(0.5,1), linetype="dashed", color = "black") + + scale_fill_brewer(palette="Dark2") + + theme_bw() + + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + + labs(list(x = "Species richness", y = "RMSEn", fill = "Trophic level")) ``` ```{r, echo=FALSE} @@ -65,17 +104,17 @@ names(perf_check) = ptypes # Check performance of PLS and RF ```{r, echo = FALSE} for(i in seq(length(perf_check))){ -rmse_perf = sort(round(1-pls_rf_sr[as.numeric(perf_check[[i]]), "RMSE_pls"] / - pls_rf_sr[as.numeric(perf_check[[i]]), "RMSE_rf"],2)) -var_rf_prct = sort(round(pls_rf_sr[as.numeric(perf_check[[i]]), "nvars_rf"] / - pls_rf_sr[as.numeric(perf_check[[i]]), "nvars_pls"],2)) -level_pls = sort(table(pls_rf_sr[as.numeric(perf_check[[i]]), "Level_pls"])) -print(names(perf_check[i])) -print(pls_rf_sr[as.numeric(perf_check[[i]]),]) -cat("RMSE (1 - PLS/RF):", rmse_perf, "\n") -cat("Var number (RF/PLS):", var_rf_prct, "\n") -cat("Levels with PLS is better:", level_pls, "\n") -cat("\n\n") + rmse_perf = sort(round(1-pls_rf_sr[as.numeric(perf_check[[i]]), "RMSE_pls"] / + pls_rf_sr[as.numeric(perf_check[[i]]), "RMSE_rf"],2)) + var_rf_prct = sort(round(pls_rf_sr[as.numeric(perf_check[[i]]), "nvars_rf"] / + pls_rf_sr[as.numeric(perf_check[[i]]), "nvars_pls"],2)) + level_pls = sort(table(pls_rf_sr[as.numeric(perf_check[[i]]), "Level_pls"])) + print(names(perf_check[i])) + print(pls_rf_sr[as.numeric(perf_check[[i]]),]) + cat("RMSE (1 - PLS/RF):", rmse_perf, "\n") + cat("Var number (RF/PLS):", var_rf_prct, "\n") + cat("Levels with PLS is better:", level_pls, "\n") + cat("\n\n") } ``` diff --git a/src/500_analyse_biodiv_sr.nb.html b/src/500_analyse_biodiv_sr.nb.html index 80307d4..3cb1b54 100644 --- a/src/500_analyse_biodiv_sr.nb.html +++ b/src/500_analyse_biodiv_sr.nb.html @@ -183,7 +183,7 @@

Compare PLS and RF

-

+

@@ -279,17 +279,14 @@

Collect variable importance

Number of variables

- +
pls_rf_sr_long = melt(pls_rf_sr[pls_rf_sr$Resample == "Mean", c(1, 2, 6, 13)], id.vars = c("ptype", "resp"))
-ggplot(data = pls_rf_sr_long, aes(x = variable, y = value, fill = ptype)) +
-  geom_boxplot() + 
-  labs(list(x = "Models", y = "Number of variables" ,
-            fill = "Predictor Set")) +
-  theme_bw()
+ - -

- + +
Error in melt(pls_rf_sr[pls_rf_sr$Resample == "Mean", c(1, 2, 6, 13)],  : 
+  object 'pls_rf_sr' not found
+ @@ -299,7 +296,7 @@

Variable importance for PLS

-

+

@@ -309,7 +306,7 @@

Variable importance for RF

-

+

@@ -319,7 +316,7 @@

Trophic levels

-

+

@@ -328,7 +325,7 @@

Trophic levels

-
LS0tDQp0aXRsZTogIjUwMCBBbmFseXNlIEJpb2Rpdi1SUyINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCmBgYHtyLCBpbmNsdWRlID0gRkFMU0V9DQpzb3VyY2UoIkM6L1VzZXJzL3RuYXVzcy9wZXJtYW5lbnQvcGx5Z3JuZC9LSS1IeXBlcnNwZWMvSHlTcGVjX0tpTGkvc3JjLzAwMF9zZXRfZW52aXJvbm1lbnQuUiIpDQoNCmRpci5jcmVhdGUocGF0aF9hbmFseXNpc19zciwgc2hvd1dhcm5pbmdzID0gRkFMU0UpDQoNCmFsbF9tb2RlbHMgPSByZWFkUkRTKGZpbGUucGF0aChwYXRoX2NvbXBpbGVfYW5hbHlzaXNfc3IsICJtb2RlbHNfc3IucmRzIikpDQoNCg0KIyBDb2xsZWN0IG1vZGVsIHBlcmZvcm1hbmNlDQpnYW1fc3IgPSBtb2RlbFBlcmZvcm1hbmNlKGFsbF9tb2RlbHNbWyJnYW0iXV0pDQpwbHNfc3IgPSBtb2RlbFBlcmZvcm1hbmNlKGFsbF9tb2RlbHNbWyJwbHMiXV0pDQpyZl9zciA9IG1vZGVsUGVyZm9ybWFuY2UoYWxsX21vZGVsc1tbInJmIl1dKQ0KDQpzdW1tYXJ5KGdhbV9zcikNCnN1bW1hcnkocGxzX3NyKQ0Kc3VtbWFyeShyZl9zcikNCg0KIyBHZXQgdHJvcGhpYyBsZXZlbHMNCnRsID0gcmVhZC50YWJsZShmaWxlLnBhdGgocGF0aF9tZXRhLCAidHJvcGhpY19sZXZlbHMuY3N2IiksIGhlYWRlciA9IFRSVUUsIHNlcCA9ICI7IikNCmdhbV9zciA9IG1lcmdlKGdhbV9zciwgdGwsIGJ5LnggPSAicmVzcCIsIGJ5LnkgPSAiU3BlY2llcyIpDQpwbHNfc3IgPSBtZXJnZShwbHNfc3IsIHRsLCBieS54ID0gInJlc3AiLCBieS55ID0gIlNwZWNpZXMiKQ0KcmZfc3IgPSBtZXJnZShyZl9zciwgdGwsIGJ5LnggPSAicmVzcCIsIGJ5LnkgPSAiU3BlY2llcyIpDQpgYGANCg0KIyBDb21wYXJlIFBMUyBhbmQgUkYNCmBgYHtyLCBlY2hvPUZBTFNFfQ0KbW9kZWxzX3NyID0gcmJpbmQocGxzX3NyWywgLTRdLCByZl9zclssIC00XSkNCm1vZGVsc19zciRtcHR5cGUgPSBwYXN0ZTAobW9kZWxzX3NyJG10eXBlLCAiXyIsIG1vZGVsc19zciRwdHlwZSkNCm1vZGVsc19zciRtcHR5cGUgPSBmYWN0b3IobW9kZWxzX3NyJG1wdHlwZSwgbGV2ZWxzID0gYygicGxzX2Vsc3AiLCAicmZfZWxzcCIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgInBsc19lbHVpIiwgInJmX2VsdWkiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICJwbHNfa21yYSIsICJyZl9rbXJhIiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAicGxzX3NwZWMiLCAicmZfc3BlYyIpKQ0KDQoNCmdncGxvdChkYXRhID0gbW9kZWxzX3NyW21vZGVsc19zciRwdHlwZSA9PSAiZWx1aSIgfCBtb2RlbHNfc3IkcHR5cGUgPT0gInNwZWMiLF0sIGFlcyh4ID0gcmVzcCwgeSA9IFJNU0Vfbm9ybVNELCBmaWxsID0gbXB0eXBlKSkgKyANCiAgZ2VvbV9ib3hwbG90KCkgKw0KICB0aGVtZV9idygpICsgDQogIHRoZW1lKGF4aXMudGV4dC54ID0gZWxlbWVudF90ZXh0KGFuZ2xlID0gNDUsIGhqdXN0ID0gMSkpICsgDQogIGxhYnMobGlzdCh4ID0gIlNwZWNpZXMgZ3JvdXBzIiwgeSA9ICJSTVNFbiIsIGZpbGwgPSAiTW9kZWwgc2V0IikpDQpgYGANCg0KYGBge3IsIGVjaG89RkFMU0V9DQpwbHNfcmZfc3IgPSBtZXJnZShwbHNfc3IsIHJmX3NyLCBieSA9IGMoInB0eXBlIiwgInJlc3AiLCAiUmVzYW1wbGUiKSwgYWxsLnkgPSBUUlVFKQ0KY29sbmFtZXMocGxzX3JmX3NyKVtncmVwKCJcXC54IiwgY29sbmFtZXMocGxzX3JmX3NyKSldID0gDQogIGdzdWIoIlxcLngiLCAiX3BscyIsIGNvbG5hbWVzKHBsc19yZl9zcilbZ3JlcCgiXFwueCIsIGNvbG5hbWVzKHBsc19yZl9zcikpXSkNCmNvbG5hbWVzKHBsc19yZl9zcilbZ3JlcCgiXFwueSIsIGNvbG5hbWVzKHBsc19yZl9zcikpXSA9IA0KICBnc3ViKCJcXC55IiwgIl9yZiIsIGNvbG5hbWVzKHBsc19yZl9zcilbZ3JlcCgiXFwueSIsIGNvbG5hbWVzKHBsc19yZl9zcikpXSkNCiMgbnJvdyhwbHNfcmZfc3IpDQoNCnB0eXBlcyA9IGMoImVsdWkiLCAia21yYSIsICJzcGVjIiwgImVsc3AiKQ0KcGVyZl9jaGVjayA9IGxhcHBseShwdHlwZXMsIGZ1bmN0aW9uKHB0KXsNCiAgc3ViZGYgPSBwbHNfcmZfc3JbIWlzLm5hKHBsc19yZl9zciRSTVNFX3BscykgJiANCiAgICAgICAgICAgICAgICAgICAgICBwbHNfcmZfc3IkcHR5cGUgPT0gcHQgJg0KICAgICAgICAgICAgICAgICAgICAgIHBsc19yZl9zciRSZXNhbXBsZSA9PSAiTWVhbiIsIF0NCiAgcm93bmFtZXMoc3ViZGZbc3ViZGYkUk1TRV9wbHMgPCBzdWJkZiRSTVNFX3JmLCBdKQ0KfSkNCm5hbWVzKHBlcmZfY2hlY2spID0gcHR5cGVzDQpgYGANCg0KIyBDaGVjayBwZXJmb3JtYW5jZSBvZiBQTFMgYW5kIFJGDQpgYGB7ciwgZWNobyA9IEZBTFNFfQ0KZm9yKGkgaW4gc2VxKGxlbmd0aChwZXJmX2NoZWNrKSkpew0Kcm1zZV9wZXJmID0gc29ydChyb3VuZCgxLXBsc19yZl9zclthcy5udW1lcmljKHBlcmZfY2hlY2tbW2ldXSksICJSTVNFX3BscyJdIC8gDQogICAgICAgICAgICAgICAgICAgICAgICAgcGxzX3JmX3NyW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIlJNU0VfcmYiXSwyKSkNCnZhcl9yZl9wcmN0ID0gc29ydChyb3VuZChwbHNfcmZfc3JbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLCAibnZhcnNfcmYiXSAvIA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgcGxzX3JmX3NyW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIm52YXJzX3BscyJdLDIpKQ0KbGV2ZWxfcGxzID0gc29ydCh0YWJsZShwbHNfcmZfc3JbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLCAiTGV2ZWxfcGxzIl0pKQ0KcHJpbnQobmFtZXMocGVyZl9jaGVja1tpXSkpDQpwcmludChwbHNfcmZfc3JbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLF0pDQpjYXQoIlJNU0UgKDEgLSBQTFMvUkYpOiIsIHJtc2VfcGVyZiwgIlxuIikNCmNhdCgiVmFyIG51bWJlciAoUkYvUExTKToiLCB2YXJfcmZfcHJjdCwgIlxuIikNCmNhdCgiTGV2ZWxzIHdpdGggUExTIGlzIGJldHRlcjoiLCBsZXZlbF9wbHMsICJcbiIpDQpjYXQoIlxuXG4iKQ0KfQ0KYGBgDQoNCiMgQ29sbGVjdCB2YXJpYWJsZSBpbXBvcnRhbmNlDQojIyBOdW1iZXIgb2YgdmFyaWFibGVzDQpgYGB7cn0NCnBsc19yZl9zcl9sb25nID0gbWVsdChwbHNfcmZfc3JbcGxzX3JmX3NyJFJlc2FtcGxlID09ICJNZWFuIiwgYygxLCAyLCA2LCAxMyldLCBpZC52YXJzID0gYygicHR5cGUiLCAicmVzcCIpKQ0KZ2dwbG90KGRhdGEgPSBwbHNfcmZfc3JfbG9uZywgYWVzKHggPSB2YXJpYWJsZSwgeSA9IHZhbHVlLCBmaWxsID0gcHR5cGUpKSArDQogIGdlb21fYm94cGxvdCgpICsgDQogIGxhYnMobGlzdCh4ID0gIk1vZGVscyIsIHkgPSAiTnVtYmVyIG9mIHZhcmlhYmxlcyIgLA0KICAgICAgICAgICAgZmlsbCA9ICJQcmVkaWN0b3IgU2V0IikpICsNCiAgdGhlbWVfYncoKQ0KYGBgDQoNCg0KIyBWYXJpYWJsZSBpbXBvcnRhbmNlIGZvciBQTFMNCmBgYHtyLCBlY2hvPUZBTFNFfQ0KdmFyX2ltcCA8LSBjb21wVmFySW1wKGFsbF9tb2RlbHNbWyJwbHMiXV1bWyJzcGVjIl1dQG1vZGVsW1sxXV0sIHNjYWxlID0gRkFMU0UpDQojIHBsb3RWYXJJbXAodmFyX2ltcCkNCnBsb3RWYXJJbXBIZWF0bWFwKHZhcl9pbXAsIHhsYWIgPSAiU3BlY2llcyIsIHlsYWIgPSAiQmFuZCIpDQpgYGANCg0KIyBWYXJpYWJsZSBpbXBvcnRhbmNlIGZvciBSRg0KYGBge3IsIGVjaG89RkFMU0V9DQp2YXJfaW1wIDwtIGNvbXBWYXJJbXAoYWxsX21vZGVsc1tbInJmIl1dW1sic3BlYyJdXUBtb2RlbFtbMV1dLCBzY2FsZSA9IEZBTFNFKQ0KIyBwbG90VmFySW1wKHZhcl9pbXApDQpwbG90VmFySW1wSGVhdG1hcCh2YXJfaW1wLCB4bGFiID0gIlNwZWNpZXMiLCB5bGFiID0gIkJhbmQiKQ0KYGBgDQoNCg0KIyBUcm9waGljIGxldmVscw0KYGBge3J9DQp2YXJfaW1wX2xldmVscyA9IHZhcl9pbXANCmZvcihpIGluIHNlcShsZW5ndGgodmFyX2ltcF9sZXZlbHMpKSl7DQogIHZhcl9pbXBfbGV2ZWxzW1tpXV0kUkVTUE9OU0UgPSB0bCRMZXZlbFtncmVwKHZhcl9pbXBfbGV2ZWxzW1tpXV0kUkVTUE9OU0VbMV0sIHRsJFNwZWNpZXMpXQ0KfQ0KcGxvdFZhckltcEhlYXRtYXAodmFyX2ltcF9sZXZlbHMsIHhsYWIgPSAiU3BlY2llcyIsIHlsYWIgPSAiQmFuZCIpDQpgYGANCg0KDQoNCg0KV2hlbiB5b3Ugc2F2ZSB0aGUgbm90ZWJvb2ssIGFuIEhUTUwgZmlsZSBjb250YWluaW5nIHRoZSBjb2RlIGFuZCBvdXRwdXQgd2lsbCBiZSBzYXZlZCBhbG9uZ3NpZGUgaXQgKGNsaWNrIHRoZSAqUHJldmlldyogYnV0dG9uIG9yIHByZXNzICpDdHJsK1NoaWZ0K0sqIHRvIHByZXZpZXcgdGhlIEhUTUwgZmlsZSkuDQoNClRoZSBwcmV2aWV3IHNob3dzIHlvdSBhIHJlbmRlcmVkIEhUTUwgY29weSBvZiB0aGUgY29udGVudHMgb2YgdGhlIGVkaXRvci4gQ29uc2VxdWVudGx5LCB1bmxpa2UgKktuaXQqLCAqUHJldmlldyogZG9lcyBub3QgcnVuIGFueSBSIGNvZGUgY2h1bmtzLiBJbnN0ZWFkLCB0aGUgb3V0cHV0IG9mIHRoZSBjaHVuayB3aGVuIGl0IHdhcyBsYXN0IHJ1biBpbiB0aGUgZWRpdG9yIGlzIGRpc3BsYXllZC4NCg==
+
LS0tDQp0aXRsZTogIjUwMCBBbmFseXNlIEJpb2Rpdi1SUyINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCmBgYHtyLCBpbmNsdWRlID0gRkFMU0V9DQpzb3VyY2UoIkM6L1VzZXJzL3RuYXVzcy9wZXJtYW5lbnQvcGx5Z3JuZC9LSS1IeXBlcnNwZWMvSHlTcGVjX0tpTGkvc3JjLzAwMF9zZXRfZW52aXJvbm1lbnQuUiIpDQoNCmRpci5jcmVhdGUocGF0aF9hbmFseXNpc19zciwgc2hvd1dhcm5pbmdzID0gRkFMU0UpDQoNCmFsbF9tb2RlbHMgPSByZWFkUkRTKGZpbGUucGF0aChwYXRoX2NvbXBpbGVfYW5hbHlzaXNfc3IsICJtb2RlbHNfc3IucmRzIikpDQoNCg0KIyBDb2xsZWN0IG1vZGVsIHBlcmZvcm1hbmNlDQpnYW1fc3IgPSBtb2RlbFBlcmZvcm1hbmNlKGFsbF9tb2RlbHNbWyJnYW0iXV0pDQpwbHNfc3IgPSBtb2RlbFBlcmZvcm1hbmNlKGFsbF9tb2RlbHNbWyJwbHMiXV0pDQpyZl9zciA9IG1vZGVsUGVyZm9ybWFuY2UoYWxsX21vZGVsc1tbInJmIl1dKQ0KDQpzdW1tYXJ5KGdhbV9zcikNCnN1bW1hcnkocGxzX3NyKQ0Kc3VtbWFyeShyZl9zcikNCg0KIyBHZXQgdHJvcGhpYyBsZXZlbHMNCnRsID0gcmVhZC50YWJsZShmaWxlLnBhdGgocGF0aF9tZXRhLCAidHJvcGhpY19sZXZlbHMuY3N2IiksIGhlYWRlciA9IFRSVUUsIHNlcCA9ICI7IikNCmdhbV9zciA9IG1lcmdlKGdhbV9zciwgdGwsIGJ5LnggPSAicmVzcCIsIGJ5LnkgPSAiU3BlY2llcyIpDQpwbHNfc3IgPSBtZXJnZShwbHNfc3IsIHRsLCBieS54ID0gInJlc3AiLCBieS55ID0gIlNwZWNpZXMiKQ0KcmZfc3IgPSBtZXJnZShyZl9zciwgdGwsIGJ5LnggPSAicmVzcCIsIGJ5LnkgPSAiU3BlY2llcyIpDQoNCiMgQXJyYW5nZSBsZXZlbHMgYW5kIHNwZWNpZXMgbmFtZXMNCnBsc19zciRMZXZlbCA9IGZhY3RvcihwbHNfc3IkTGV2ZWwsIGxldmVscyhwbHNfc3IkTGV2ZWwpW2MoMSwgNSwgNCwgMywgNiwgMildICkNCnBsc19zciRyZXNwID0gYXMuY2hhcmFjdGVyKHBsc19zciRyZXNwKQ0KcGxzX3NyJHJlc3AgPSBzdWJzdHIocGxzX3NyJHJlc3AsIDMsIG5jaGFyKHBsc19zciRyZXNwKSkNCnBsc19zciRyZXNwID0gZ3N1YigiKF5bWzphbHBoYTpdXSkiLCAiXFxVXFwxIiwgcGxzX3NyJHJlc3AsIHBlcmw9VFJVRSkNCnBsc19zciRyZXNwID0gZmFjdG9yKHBsc19zciRyZXNwLCB1bmlxdWUocGxzX3NyJHJlc3Bbb3JkZXIocGxzX3NyJExldmVsLCBwbHNfc3IkcmVzcCldKSkNCg0KDQpyZl9zciRMZXZlbCA9IGZhY3RvcihyZl9zciRMZXZlbCwgbGV2ZWxzKHJmX3NyJExldmVsKVtjKDEsIDUsIDQsIDMsIDYsIDIpXSApDQpyZl9zciRyZXNwID0gYXMuY2hhcmFjdGVyKHJmX3NyJHJlc3ApDQpyZl9zciRyZXNwID0gc3Vic3RyKHJmX3NyJHJlc3AsIDMsIG5jaGFyKHJmX3NyJHJlc3ApKQ0KcmZfc3IkcmVzcCA9IGdzdWIoIiheW1s6YWxwaGE6XV0pIiwgIlxcVVxcMSIsIHJmX3NyJHJlc3AsIHBlcmw9VFJVRSkNCnJmX3NyJHJlc3AgPSBmYWN0b3IocmZfc3IkcmVzcCwgdW5pcXVlKHJmX3NyJHJlc3Bbb3JkZXIocmZfc3IkTGV2ZWwsIHJmX3NyJHJlc3ApXSkpDQpgYGANCg0KIyBDb21wYXJlIFBMUyBhbmQgUkYNCmBgYHtyLCBlY2hvPUZBTFNFfQ0KbW9kZWxzX3NyID0gcmJpbmQocGxzX3NyWywgLTRdLCByZl9zclssIC00XSkNCm1vZGVsc19zciRtcHR5cGUgPSBwYXN0ZTAobW9kZWxzX3NyJG10eXBlLCAiXyIsIG1vZGVsc19zciRwdHlwZSkNCm1vZGVsc19zciRtcHR5cGUgPSBmYWN0b3IobW9kZWxzX3NyJG1wdHlwZSwgbGV2ZWxzID0gYygicGxzX2Vsc3AiLCAicmZfZWxzcCIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgInBsc19lbHVpIiwgInJmX2VsdWkiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICJwbHNfa21yYSIsICJyZl9rbXJhIiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAicGxzX3NwZWMiLCAicmZfc3BlYyIpKQ0KDQpnZ3Bsb3QoZGF0YSA9IG1vZGVsc19zclttb2RlbHNfc3IkbXR5cGUgPT0gInBscyIgJiANCiAgICAgICAgICAgICAgICAgICAgICAgICAgKG1vZGVsc19zciRwdHlwZSA9PSAiZWx1aSIgfCBtb2RlbHNfc3IkcHR5cGUgPT0gInNwZWMiKSxdLCANCiAgICAgICBhZXMoeCA9IHJlc3AsIHkgPSBSTVNFX25vcm1TRCwgZmlsbCA9IG1wdHlwZSkpICsgDQogIGdlb21fYm94cGxvdCgpICsNCiAgZ2VvbV9obGluZSh5aW50ZXJjZXB0PWMoMC41LDEpLCBsaW5ldHlwZT0iZGFzaGVkIiwgY29sb3IgPSAiYmxhY2siKSArIA0KICBzY2FsZV9maWxsX2JyZXdlcihwYWxldHRlPSJEYXJrMiIpICsgDQogIHRoZW1lX2J3KCkgKyANCiAgdGhlbWUoYXhpcy50ZXh0LnggPSBlbGVtZW50X3RleHQoYW5nbGUgPSA0NSwgaGp1c3QgPSAxKSkgKyANCiAgbGFicyhsaXN0KHggPSAiU3BlY2llcyBncm91cHMiLCB5ID0gIlJNU0VuIiwgZmlsbCA9ICJNb2RlbCBzZXQiKSkNCg0KDQoNCmdncGxvdChkYXRhID0gbW9kZWxzX3NyW21vZGVsc19zciRtdHlwZSA9PSAicmYiICYgDQogICAgICAgICAgICAgICAgICAgICAgICAgIChtb2RlbHNfc3IkcHR5cGUgPT0gImVsdWkiIHwgbW9kZWxzX3NyJHB0eXBlID09ICJzcGVjIiksXSwgDQogICAgICAgYWVzKHggPSByZXNwLCB5ID0gUk1TRV9ub3JtU0QsIGZpbGwgPSBtcHR5cGUpKSArIA0KICBnZW9tX2JveHBsb3QoKSArDQogIGdlb21faGxpbmUoeWludGVyY2VwdD1jKDAuNSwxKSwgbGluZXR5cGU9ImRhc2hlZCIsIGNvbG9yID0gImJsYWNrIikgKyANCiAgc2NhbGVfZmlsbF9icmV3ZXIocGFsZXR0ZT0iRGFyazIiKSArIA0KICB0aGVtZV9idygpICsgDQogIHRoZW1lKGF4aXMudGV4dC54ID0gZWxlbWVudF90ZXh0KGFuZ2xlID0gNDUsIGhqdXN0ID0gMSkpICsgDQogIGxhYnMobGlzdCh4ID0gIlNwZWNpZXMgZ3JvdXBzIiwgeSA9ICJSTVNFbiIsIGZpbGwgPSAiTW9kZWwgc2V0IikpDQoNCg0KZ2dwbG90KGRhdGEgPSBtb2RlbHNfc3JbbW9kZWxzX3NyJG10eXBlID09ICJyZiIgJiBtb2RlbHNfc3IkcHR5cGUgPT0gInNwZWMiLF0sIA0KICAgICAgIGFlcyh4ID0gcmVzcCwgeSA9IFJNU0Vfbm9ybVNELCBmaWxsID0gTGV2ZWwpKSArIA0KICBnZW9tX2JveHBsb3QoKSArDQogIGdlb21faGxpbmUoeWludGVyY2VwdD1jKDAuNSwxKSwgbGluZXR5cGU9ImRhc2hlZCIsIGNvbG9yID0gImJsYWNrIikgKyANCiAgc2NhbGVfZmlsbF9icmV3ZXIocGFsZXR0ZT0iRGFyazIiKSArIA0KICB0aGVtZV9idygpICsgDQogIHRoZW1lKGF4aXMudGV4dC54ID0gZWxlbWVudF90ZXh0KGFuZ2xlID0gNDUsIGhqdXN0ID0gMSkpICsgDQogIGxhYnMobGlzdCh4ID0gIlNwZWNpZXMgcmljaG5lc3MiLCB5ID0gIlJNU0VuIiwgZmlsbCA9ICJUcm9waGljIGxldmVsIikpDQpgYGANCg0KYGBge3IsIGVjaG89RkFMU0V9DQpwbHNfcmZfc3IgPSBtZXJnZShwbHNfc3IsIHJmX3NyLCBieSA9IGMoInB0eXBlIiwgInJlc3AiLCAiUmVzYW1wbGUiKSwgYWxsLnkgPSBUUlVFKQ0KY29sbmFtZXMocGxzX3JmX3NyKVtncmVwKCJcXC54IiwgY29sbmFtZXMocGxzX3JmX3NyKSldID0gDQogIGdzdWIoIlxcLngiLCAiX3BscyIsIGNvbG5hbWVzKHBsc19yZl9zcilbZ3JlcCgiXFwueCIsIGNvbG5hbWVzKHBsc19yZl9zcikpXSkNCmNvbG5hbWVzKHBsc19yZl9zcilbZ3JlcCgiXFwueSIsIGNvbG5hbWVzKHBsc19yZl9zcikpXSA9IA0KICBnc3ViKCJcXC55IiwgIl9yZiIsIGNvbG5hbWVzKHBsc19yZl9zcilbZ3JlcCgiXFwueSIsIGNvbG5hbWVzKHBsc19yZl9zcikpXSkNCiMgbnJvdyhwbHNfcmZfc3IpDQoNCnB0eXBlcyA9IGMoImVsdWkiLCAia21yYSIsICJzcGVjIiwgImVsc3AiKQ0KcGVyZl9jaGVjayA9IGxhcHBseShwdHlwZXMsIGZ1bmN0aW9uKHB0KXsNCiAgc3ViZGYgPSBwbHNfcmZfc3JbIWlzLm5hKHBsc19yZl9zciRSTVNFX3BscykgJiANCiAgICAgICAgICAgICAgICAgICAgICBwbHNfcmZfc3IkcHR5cGUgPT0gcHQgJg0KICAgICAgICAgICAgICAgICAgICAgIHBsc19yZl9zciRSZXNhbXBsZSA9PSAiTWVhbiIsIF0NCiAgcm93bmFtZXMoc3ViZGZbc3ViZGYkUk1TRV9wbHMgPCBzdWJkZiRSTVNFX3JmLCBdKQ0KfSkNCm5hbWVzKHBlcmZfY2hlY2spID0gcHR5cGVzDQpgYGANCg0KIyBDaGVjayBwZXJmb3JtYW5jZSBvZiBQTFMgYW5kIFJGDQpgYGB7ciwgZWNobyA9IEZBTFNFfQ0KZm9yKGkgaW4gc2VxKGxlbmd0aChwZXJmX2NoZWNrKSkpew0KICBybXNlX3BlcmYgPSBzb3J0KHJvdW5kKDEtcGxzX3JmX3NyW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIlJNU0VfcGxzIl0gLyANCiAgICAgICAgICAgICAgICAgICAgICAgICAgIHBsc19yZl9zclthcy5udW1lcmljKHBlcmZfY2hlY2tbW2ldXSksICJSTVNFX3JmIl0sMikpDQogIHZhcl9yZl9wcmN0ID0gc29ydChyb3VuZChwbHNfcmZfc3JbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLCAibnZhcnNfcmYiXSAvIA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICBwbHNfcmZfc3JbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLCAibnZhcnNfcGxzIl0sMikpDQogIGxldmVsX3BscyA9IHNvcnQodGFibGUocGxzX3JmX3NyW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIkxldmVsX3BscyJdKSkNCiAgcHJpbnQobmFtZXMocGVyZl9jaGVja1tpXSkpDQogIHByaW50KHBsc19yZl9zclthcy5udW1lcmljKHBlcmZfY2hlY2tbW2ldXSksXSkNCiAgY2F0KCJSTVNFICgxIC0gUExTL1JGKToiLCBybXNlX3BlcmYsICJcbiIpDQogIGNhdCgiVmFyIG51bWJlciAoUkYvUExTKToiLCB2YXJfcmZfcHJjdCwgIlxuIikNCiAgY2F0KCJMZXZlbHMgd2l0aCBQTFMgaXMgYmV0dGVyOiIsIGxldmVsX3BscywgIlxuIikNCiAgY2F0KCJcblxuIikNCn0NCmBgYA0KDQojIENvbGxlY3QgdmFyaWFibGUgaW1wb3J0YW5jZQ0KIyMgTnVtYmVyIG9mIHZhcmlhYmxlcw0KYGBge3J9DQpwbHNfcmZfc3JfbG9uZyA9IG1lbHQocGxzX3JmX3NyW3Bsc19yZl9zciRSZXNhbXBsZSA9PSAiTWVhbiIsIGMoMSwgMiwgNiwgMTMpXSwgaWQudmFycyA9IGMoInB0eXBlIiwgInJlc3AiKSkNCmdncGxvdChkYXRhID0gcGxzX3JmX3NyX2xvbmcsIGFlcyh4ID0gdmFyaWFibGUsIHkgPSB2YWx1ZSwgZmlsbCA9IHB0eXBlKSkgKw0KICBnZW9tX2JveHBsb3QoKSArIA0KICBsYWJzKGxpc3QoeCA9ICJNb2RlbHMiLCB5ID0gIk51bWJlciBvZiB2YXJpYWJsZXMiICwNCiAgICAgICAgICAgIGZpbGwgPSAiUHJlZGljdG9yIFNldCIpKSArDQogIHRoZW1lX2J3KCkNCmBgYA0KDQoNCiMgVmFyaWFibGUgaW1wb3J0YW5jZSBmb3IgUExTDQpgYGB7ciwgZWNobz1GQUxTRX0NCnZhcl9pbXAgPC0gY29tcFZhckltcChhbGxfbW9kZWxzW1sicGxzIl1dW1sic3BlYyJdXUBtb2RlbFtbMV1dLCBzY2FsZSA9IEZBTFNFKQ0KIyBwbG90VmFySW1wKHZhcl9pbXApDQpwbG90VmFySW1wSGVhdG1hcCh2YXJfaW1wLCB4bGFiID0gIlNwZWNpZXMiLCB5bGFiID0gIkJhbmQiKQ0KYGBgDQoNCiMgVmFyaWFibGUgaW1wb3J0YW5jZSBmb3IgUkYNCmBgYHtyLCBlY2hvPUZBTFNFfQ0KdmFyX2ltcCA8LSBjb21wVmFySW1wKGFsbF9tb2RlbHNbWyJyZiJdXVtbInNwZWMiXV1AbW9kZWxbWzFdXSwgc2NhbGUgPSBGQUxTRSkNCiMgcGxvdFZhckltcCh2YXJfaW1wKQ0KcGxvdFZhckltcEhlYXRtYXAodmFyX2ltcCwgeGxhYiA9ICJTcGVjaWVzIiwgeWxhYiA9ICJCYW5kIikNCmBgYA0KDQoNCiMgVHJvcGhpYyBsZXZlbHMNCmBgYHtyfQ0KdmFyX2ltcF9sZXZlbHMgPSB2YXJfaW1wDQpmb3IoaSBpbiBzZXEobGVuZ3RoKHZhcl9pbXBfbGV2ZWxzKSkpew0KICB2YXJfaW1wX2xldmVsc1tbaV1dJFJFU1BPTlNFID0gdGwkTGV2ZWxbZ3JlcCh2YXJfaW1wX2xldmVsc1tbaV1dJFJFU1BPTlNFWzFdLCB0bCRTcGVjaWVzKV0NCn0NCnBsb3RWYXJJbXBIZWF0bWFwKHZhcl9pbXBfbGV2ZWxzLCB4bGFiID0gIlNwZWNpZXMiLCB5bGFiID0gIkJhbmQiKQ0KYGBgDQoNCg0KDQoNCldoZW4geW91IHNhdmUgdGhlIG5vdGVib29rLCBhbiBIVE1MIGZpbGUgY29udGFpbmluZyB0aGUgY29kZSBhbmQgb3V0cHV0IHdpbGwgYmUgc2F2ZWQgYWxvbmdzaWRlIGl0IChjbGljayB0aGUgKlByZXZpZXcqIGJ1dHRvbiBvciBwcmVzcyAqQ3RybCtTaGlmdCtLKiB0byBwcmV2aWV3IHRoZSBIVE1MIGZpbGUpLg0KDQpUaGUgcHJldmlldyBzaG93cyB5b3UgYSByZW5kZXJlZCBIVE1MIGNvcHkgb2YgdGhlIGNvbnRlbnRzIG9mIHRoZSBlZGl0b3IuIENvbnNlcXVlbnRseSwgdW5saWtlICpLbml0KiwgKlByZXZpZXcqIGRvZXMgbm90IHJ1biBhbnkgUiBjb2RlIGNodW5rcy4gSW5zdGVhZCwgdGhlIG91dHB1dCBvZiB0aGUgY2h1bmsgd2hlbiBpdCB3YXMgbGFzdCBydW4gaW4gdGhlIGVkaXRvciBpcyBkaXNwbGF5ZWQuDQo=
diff --git a/src/520_analyse_biodiv_sr_two_step.Rmd b/src/520_analyse_biodiv_sr_two_step.Rmd index e3b3f83..8c38f70 100644 --- a/src/520_analyse_biodiv_sr_two_step.Rmd +++ b/src/520_analyse_biodiv_sr_two_step.Rmd @@ -19,8 +19,8 @@ comb_sr_two_step = comb model = all_models$gam$elev@model$gam_none model_res = all_models_res$pls$gam_elev_res@model$rf_ffs -comp2StepPred(comb_sr_two_step, model, model_res) - +gam2rf = comp2StepPred(comb_sr_two_step, model, model_res) +gam2rf[gam2rf$RMSE_normSD1 > gam2rf$RMSE_normSD2,] @@ -41,20 +41,23 @@ summary(rf_res) tl = read.table(file.path(path_meta, "trophic_levels.csv"), header = TRUE, sep = ";") pls_res = merge(pls_res, tl, by.x = "resp", by.y = "Species") rf_res = merge(rf_res, tl, by.x = "resp", by.y = "Species") + +# Arrange levels and species names +rf_res$Level = factor(rf_res$Level, levels(rf_res$Level)[c(1, 5, 4, 3, 6, 2)] ) +rf_res$resp = substr(rf_res$resp, 3, nchar(rf_res$resp)) +rf_res$resp = gsub("(^[[:alpha:]])", "\\U\\1", rf_res$resp, perl=TRUE) +rf_res$resp = factor(rf_res$resp, unique(rf_res$resp[order(rf_res$Level, rf_res$resp)])) ``` # Compare PLS and RF ```{r, echo=FALSE} -models_res = rbind(pls_res[, -4], rf_res[, -4]) -models_res$mptype = paste0(models_res$mtype, "_", models_res$ptype) -models_res$mptype = factor(models_res$mptype, levels = c("rf_gam_elev_res")) - - -ggplot(data = models_res[models_res$ptype == "gam_elev_res" | models_res$ptype == "spec",], aes(x = resp, y = RMSE_normSD, fill = mptype)) + +ggplot(data = rf_res, aes(x = resp, y = RMSE_normSD, fill = Level)) + geom_boxplot() + + geom_hline(yintercept=1, linetype="dashed", color = "black") + + scale_fill_brewer(palette="Dark2") + theme_bw() + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + - labs(list(x = "Species groups", y = "RMSEn", fill = "Model set")) + labs(list(x = "Species richness", y = "RMSEn", fill = "Trophic level")) ``` ```{r, echo=FALSE} diff --git a/src/520_analyse_biodiv_sr_two_step.nb.html b/src/520_analyse_biodiv_sr_two_step.nb.html index 2fb220b..fb44f45 100644 --- a/src/520_analyse_biodiv_sr_two_step.nb.html +++ b/src/520_analyse_biodiv_sr_two_step.nb.html @@ -182,6 +182,9 @@

520 Analyse Biodiv-RS Two Step

Compare PLS and RF

+ +

+ @@ -246,7 +249,7 @@

Trophic levels

-
LS0tDQp0aXRsZTogIjUyMCBBbmFseXNlIEJpb2Rpdi1SUyBUd28gU3RlcCINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCmBgYHtyLCBpbmNsdWRlID0gRkFMU0V9DQpzb3VyY2UoIkM6L1VzZXJzL3RuYXVzcy9wZXJtYW5lbnQvcGx5Z3JuZC9LSS1IeXBlcnNwZWMvSHlTcGVjX0tpTGkvc3JjLzAwMF9zZXRfZW52aXJvbm1lbnQuUiIpDQoNCmRpci5jcmVhdGUocGF0aF9hbmFseXNpc19zcl9lbGV2X3Jlcywgc2hvd1dhcm5pbmdzID0gRkFMU0UpDQoNCmNvbWIgPSByZWFkUkRTKHBhc3RlMChwYXRoX2NvbWJfZ3BtX3NyLCAia2lfaHlwZXJzcGVjX2Jpb2Rpdl9ub25fc2NhbGVkLnJkcyIpKQ0KYWxsX21vZGVscyA9IHJlYWRSRFMoZmlsZS5wYXRoKHBhdGhfY29tcGlsZV9hbmFseXNpc19zciwgIm1vZGVsc19zci5yZHMiKSkNCmFsbF9tb2RlbHNfcmVzID0gcmVhZFJEUyhmaWxlLnBhdGgocGF0aF9jb21waWxlX2FuYWx5c2lzX3NyX2VsZXZfcmVzLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAibW9kZWxzX3NyX2VsZXZfcmVzLnJkcyIpKQ0KDQoNCg0KY29tYl9zcl90d29fc3RlcCA9IGNvbWINCm1vZGVsID0gYWxsX21vZGVscyRnYW0kZWxldkBtb2RlbCRnYW1fbm9uZQ0KbW9kZWxfcmVzID0gYWxsX21vZGVsc19yZXMkcGxzJGdhbV9lbGV2X3Jlc0Btb2RlbCRyZl9mZnMNCg0KY29tcDJTdGVwUHJlZChjb21iX3NyX3R3b19zdGVwLCBtb2RlbCwgbW9kZWxfcmVzKQ0KDQoNCg0KDQojIENvbGxlY3QgbW9kZWwgcGVyZm9ybWFuY2UNCnBsc19yZXMgPSBtb2RlbFBlcmZvcm1hbmNlKGFsbF9tb2RlbHNfcmVzW1sicGxzIl1dKQ0KcmZfcmVzID0gbW9kZWxQZXJmb3JtYW5jZShhbGxfbW9kZWxzX3Jlc1tbInJmIl1dKQ0KDQpwbHNfcmVzJHJlc21vZGVsID0gcGxzX3JlcyRyZXNwDQpwbHNfcmVzJHJlc3AgPSBnc3ViKCJfZ2FtX2VsZXZfcmVzIiwgIiIsIHBsc19yZXMkcmVzcCkNCg0KcmZfcmVzJHJlc21vZGVsID0gcmZfcmVzJHJlc3ANCnJmX3JlcyRyZXNwID0gZ3N1YigiX2dhbV9lbGV2X3JlcyIsICIiLCByZl9yZXMkcmVzcCkNCg0Kc3VtbWFyeShwbHNfcmVzKQ0Kc3VtbWFyeShyZl9yZXMpDQoNCiMgR2V0IHRyb3BoaWMgbGV2ZWxzDQp0bCA9IHJlYWQudGFibGUoZmlsZS5wYXRoKHBhdGhfbWV0YSwgInRyb3BoaWNfbGV2ZWxzLmNzdiIpLCBoZWFkZXIgPSBUUlVFLCBzZXAgPSAiOyIpDQpwbHNfcmVzID0gbWVyZ2UocGxzX3JlcywgdGwsIGJ5LnggPSAicmVzcCIsIGJ5LnkgPSAiU3BlY2llcyIpDQpyZl9yZXMgPSBtZXJnZShyZl9yZXMsIHRsLCBieS54ID0gInJlc3AiLCBieS55ID0gIlNwZWNpZXMiKQ0KYGBgDQoNCiMgQ29tcGFyZSBQTFMgYW5kIFJGDQpgYGB7ciwgZWNobz1GQUxTRX0NCm1vZGVsc19yZXMgPSByYmluZChwbHNfcmVzWywgLTRdLCByZl9yZXNbLCAtNF0pDQptb2RlbHNfcmVzJG1wdHlwZSA9IHBhc3RlMChtb2RlbHNfcmVzJG10eXBlLCAiXyIsIG1vZGVsc19yZXMkcHR5cGUpDQptb2RlbHNfcmVzJG1wdHlwZSA9IGZhY3Rvcihtb2RlbHNfcmVzJG1wdHlwZSwgbGV2ZWxzID0gYygicmZfZ2FtX2VsZXZfcmVzIikpDQoNCg0KZ2dwbG90KGRhdGEgPSBtb2RlbHNfcmVzW21vZGVsc19yZXMkcHR5cGUgPT0gImdhbV9lbGV2X3JlcyIgfCBtb2RlbHNfcmVzJHB0eXBlID09ICJzcGVjIixdLCBhZXMoeCA9IHJlc3AsIHkgPSBSTVNFX25vcm1TRCwgZmlsbCA9IG1wdHlwZSkpICsgDQogIGdlb21fYm94cGxvdCgpICsNCiAgdGhlbWVfYncoKSArIA0KICB0aGVtZShheGlzLnRleHQueCA9IGVsZW1lbnRfdGV4dChhbmdsZSA9IDQ1LCBoanVzdCA9IDEpKSArIA0KICBsYWJzKGxpc3QoeCA9ICJTcGVjaWVzIGdyb3VwcyIsIHkgPSAiUk1TRW4iLCBmaWxsID0gIk1vZGVsIHNldCIpKQ0KYGBgDQoNCmBgYHtyLCBlY2hvPUZBTFNFfQ0KcGxzX3JmX3JlcyA9IG1lcmdlKHBsc19yZXMsIHJmX3JlcywgYnkgPSBjKCJwdHlwZSIsICJyZXNwIiwgIlJlc2FtcGxlIiksIGFsbC55ID0gVFJVRSkNCmNvbG5hbWVzKHBsc19yZl9yZXMpW2dyZXAoIlxcLngiLCBjb2xuYW1lcyhwbHNfcmZfcmVzKSldID0gDQogIGdzdWIoIlxcLngiLCAiX3BscyIsIGNvbG5hbWVzKHBsc19yZl9yZXMpW2dyZXAoIlxcLngiLCBjb2xuYW1lcyhwbHNfcmZfcmVzKSldKQ0KY29sbmFtZXMocGxzX3JmX3JlcylbZ3JlcCgiXFwueSIsIGNvbG5hbWVzKHBsc19yZl9yZXMpKV0gPSANCiAgZ3N1YigiXFwueSIsICJfcmYiLCBjb2xuYW1lcyhwbHNfcmZfcmVzKVtncmVwKCJcXC55IiwgY29sbmFtZXMocGxzX3JmX3JlcykpXSkNCiMgbnJvdyhwbHNfcmZfcmVzKQ0KDQpwdHlwZXMgPSBjKCJlbHVpIiwgImttcmEiLCAic3BlYyIsICJlbHNwIikNCnBlcmZfY2hlY2sgPSBsYXBwbHkocHR5cGVzLCBmdW5jdGlvbihwdCl7DQogIHN1YmRmID0gcGxzX3JmX3Jlc1shaXMubmEocGxzX3JmX3JlcyRSTVNFX3BscykgJiANCiAgICAgICAgICAgICAgICAgICAgICBwbHNfcmZfcmVzJHB0eXBlID09IHB0ICYNCiAgICAgICAgICAgICAgICAgICAgICBwbHNfcmZfcmVzJFJlc2FtcGxlID09ICJNZWFuIiwgXQ0KICByb3duYW1lcyhzdWJkZltzdWJkZiRSTVNFX3BscyA8IHN1YmRmJFJNU0VfcmYsIF0pDQp9KQ0KbmFtZXMocGVyZl9jaGVjaykgPSBwdHlwZXMNCmBgYA0KDQojIENoZWNrIHBlcmZvcm1hbmNlIG9mIFBMUyBhbmQgUkYNCmBgYHtyLCBlY2hvID0gRkFMU0V9DQpmb3IoaSBpbiBzZXEobGVuZ3RoKHBlcmZfY2hlY2spKSl7DQpybXNlX3BlcmYgPSBzb3J0KHJvdW5kKDEtcGxzX3JmX3Jlc1thcy5udW1lcmljKHBlcmZfY2hlY2tbW2ldXSksICJSTVNFX3BscyJdIC8gDQogICAgICAgICAgICAgICAgICAgICAgICAgcGxzX3JmX3Jlc1thcy5udW1lcmljKHBlcmZfY2hlY2tbW2ldXSksICJSTVNFX3JmIl0sMikpDQp2YXJfcmZfcHJjdCA9IHNvcnQocm91bmQocGxzX3JmX3Jlc1thcy5udW1lcmljKHBlcmZfY2hlY2tbW2ldXSksICJudmFyc19yZiJdIC8gDQogICAgICAgICAgICAgICAgICAgICAgICAgICBwbHNfcmZfcmVzW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIm52YXJzX3BscyJdLDIpKQ0KbGV2ZWxfcGxzID0gc29ydCh0YWJsZShwbHNfcmZfcmVzW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIkxldmVsX3BscyJdKSkNCnByaW50KG5hbWVzKHBlcmZfY2hlY2tbaV0pKQ0KcHJpbnQocGxzX3JmX3Jlc1thcy5udW1lcmljKHBlcmZfY2hlY2tbW2ldXSksXSkNCmNhdCgiUk1TRSAoMSAtIFBMUy9SRik6Iiwgcm1zZV9wZXJmLCAiXG4iKQ0KY2F0KCJWYXIgbnVtYmVyIChSRi9QTFMpOiIsIHZhcl9yZl9wcmN0LCAiXG4iKQ0KY2F0KCJMZXZlbHMgd2l0aCBQTFMgaXMgYmV0dGVyOiIsIGxldmVsX3BscywgIlxuIikNCmNhdCgiXG5cbiIpDQp9DQpgYGANCg0KIyBDb2xsZWN0IHZhcmlhYmxlIGltcG9ydGFuY2UNCiMjIE51bWJlciBvZiB2YXJpYWJsZXMNCmBgYHtyfQ0KcGxzX3JmX3Jlc19sb25nID0gbWVsdChwbHNfcmZfcmVzW3Bsc19yZl9yZXMkUmVzYW1wbGUgPT0gIk1lYW4iLCBjKDEsIDIsIDYsIDEzKV0sIGlkLnZhcnMgPSBjKCJwdHlwZSIsICJyZXNwIikpDQpnZ3Bsb3QoZGF0YSA9IHBsc19yZl9yZXNfbG9uZywgYWVzKHggPSB2YXJpYWJsZSwgeSA9IHZhbHVlLCBmaWxsID0gcHR5cGUpKSArDQogIGdlb21fYm94cGxvdCgpICsgDQogIGxhYnMobGlzdCh4ID0gIk1vZGVscyIsIHkgPSAiTnVtYmVyIG9mIHZhcmlhYmxlcyIgLA0KICAgICAgICAgICAgZmlsbCA9ICJQcmVkaWN0b3IgU2V0IikpICsNCiAgdGhlbWVfYncoKQ0KYGBgDQoNCg0KIyBWYXJpYWJsZSBpbXBvcnRhbmNlIGZvciBQTFMNCmBgYHtyLCBlY2hvPUZBTFNFfQ0KdmFyX2ltcCA8LSBjb21wVmFySW1wKGFsbF9tb2RlbHNfcmVzW1sicGxzIl1dW1sic3BlYyJdXUBtb2RlbFtbMV1dLCBzY2FsZSA9IEZBTFNFKQ0KIyBwbG90VmFySW1wKHZhcl9pbXApDQpwbG90VmFySW1wSGVhdG1hcCh2YXJfaW1wLCB4bGFiID0gIlNwZWNpZXMiLCB5bGFiID0gIkJhbmQiKQ0KYGBgDQoNCiMgVmFyaWFibGUgaW1wb3J0YW5jZSBmb3IgUkYNCmBgYHtyLCBlY2hvPUZBTFNFfQ0KdmFyX2ltcCA8LSBjb21wVmFySW1wKGFsbF9tb2RlbHNfcmVzW1sicmYiXV1bWyJzcGVjIl1dQG1vZGVsW1sxXV0sIHNjYWxlID0gRkFMU0UpDQojIHBsb3RWYXJJbXAodmFyX2ltcCkNCnBsb3RWYXJJbXBIZWF0bWFwKHZhcl9pbXAsIHhsYWIgPSAiU3BlY2llcyIsIHlsYWIgPSAiQmFuZCIpDQpgYGANCg0KDQojIFRyb3BoaWMgbGV2ZWxzDQpgYGB7cn0NCnZhcl9pbXBfbGV2ZWxzID0gdmFyX2ltcA0KZm9yKGkgaW4gc2VxKGxlbmd0aCh2YXJfaW1wX2xldmVscykpKXsNCiAgdmFyX2ltcF9sZXZlbHNbW2ldXSRSRVNQT05TRSA9IHRsJExldmVsW2dyZXAodmFyX2ltcF9sZXZlbHNbW2ldXSRSRVNQT05TRVsxXSwgdGwkU3BlY2llcyldDQp9DQpwbG90VmFySW1wSGVhdG1hcCh2YXJfaW1wX2xldmVscywgeGxhYiA9ICJTcGVjaWVzIiwgeWxhYiA9ICJCYW5kIikNCmBgYA0KDQoNCg0KDQpXaGVuIHlvdSBzYXZlIHRoZSBub3RlYm9vaywgYW4gSFRNTCBmaWxlIGNvbnRhaW5pbmcgdGhlIGNvZGUgYW5kIG91dHB1dCB3aWxsIGJlIHNhdmVkIGFsb25nc2lkZSBpdCAoY2xpY2sgdGhlICpQcmV2aWV3KiBidXR0b24gb3IgcHJlc3MgKkN0cmwrU2hpZnQrSyogdG8gcHJldmlldyB0aGUgSFRNTCBmaWxlKS4NCg0KVGhlIHByZXZpZXcgc2hvd3MgeW91IGEgcmVuZGVyZWQgSFRNTCBjb3B5IG9mIHRoZSBjb250ZW50cyBvZiB0aGUgZWRpdG9yLiBDb25zZXF1ZW50bHksIHVubGlrZSAqS25pdCosICpQcmV2aWV3KiBkb2VzIG5vdCBydW4gYW55IFIgY29kZSBjaHVua3MuIEluc3RlYWQsIHRoZSBvdXRwdXQgb2YgdGhlIGNodW5rIHdoZW4gaXQgd2FzIGxhc3QgcnVuIGluIHRoZSBlZGl0b3IgaXMgZGlzcGxheWVkLg0K
+
LS0tDQp0aXRsZTogIjUyMCBBbmFseXNlIEJpb2Rpdi1SUyBUd28gU3RlcCINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCmBgYHtyLCBpbmNsdWRlID0gRkFMU0V9DQpzb3VyY2UoIkM6L1VzZXJzL3RuYXVzcy9wZXJtYW5lbnQvcGx5Z3JuZC9LSS1IeXBlcnNwZWMvSHlTcGVjX0tpTGkvc3JjLzAwMF9zZXRfZW52aXJvbm1lbnQuUiIpDQoNCmRpci5jcmVhdGUocGF0aF9hbmFseXNpc19zcl9lbGV2X3Jlcywgc2hvd1dhcm5pbmdzID0gRkFMU0UpDQoNCmNvbWIgPSByZWFkUkRTKHBhc3RlMChwYXRoX2NvbWJfZ3BtX3NyLCAia2lfaHlwZXJzcGVjX2Jpb2Rpdl9ub25fc2NhbGVkLnJkcyIpKQ0KYWxsX21vZGVscyA9IHJlYWRSRFMoZmlsZS5wYXRoKHBhdGhfY29tcGlsZV9hbmFseXNpc19zciwgIm1vZGVsc19zci5yZHMiKSkNCmFsbF9tb2RlbHNfcmVzID0gcmVhZFJEUyhmaWxlLnBhdGgocGF0aF9jb21waWxlX2FuYWx5c2lzX3NyX2VsZXZfcmVzLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAibW9kZWxzX3NyX2VsZXZfcmVzLnJkcyIpKQ0KDQoNCg0KY29tYl9zcl90d29fc3RlcCA9IGNvbWINCm1vZGVsID0gYWxsX21vZGVscyRnYW0kZWxldkBtb2RlbCRnYW1fbm9uZQ0KbW9kZWxfcmVzID0gYWxsX21vZGVsc19yZXMkcGxzJGdhbV9lbGV2X3Jlc0Btb2RlbCRyZl9mZnMNCg0KZ2FtMnJmID0gY29tcDJTdGVwUHJlZChjb21iX3NyX3R3b19zdGVwLCBtb2RlbCwgbW9kZWxfcmVzKQ0KZ2FtMnJmW2dhbTJyZiRSTVNFX25vcm1TRDEgPiBnYW0ycmYkUk1TRV9ub3JtU0QyLF0NCg0KDQoNCiMgQ29sbGVjdCBtb2RlbCBwZXJmb3JtYW5jZQ0KcGxzX3JlcyA9IG1vZGVsUGVyZm9ybWFuY2UoYWxsX21vZGVsc19yZXNbWyJwbHMiXV0pDQpyZl9yZXMgPSBtb2RlbFBlcmZvcm1hbmNlKGFsbF9tb2RlbHNfcmVzW1sicmYiXV0pDQoNCnBsc19yZXMkcmVzbW9kZWwgPSBwbHNfcmVzJHJlc3ANCnBsc19yZXMkcmVzcCA9IGdzdWIoIl9nYW1fZWxldl9yZXMiLCAiIiwgcGxzX3JlcyRyZXNwKQ0KDQpyZl9yZXMkcmVzbW9kZWwgPSByZl9yZXMkcmVzcA0KcmZfcmVzJHJlc3AgPSBnc3ViKCJfZ2FtX2VsZXZfcmVzIiwgIiIsIHJmX3JlcyRyZXNwKQ0KDQpzdW1tYXJ5KHBsc19yZXMpDQpzdW1tYXJ5KHJmX3JlcykNCg0KIyBHZXQgdHJvcGhpYyBsZXZlbHMNCnRsID0gcmVhZC50YWJsZShmaWxlLnBhdGgocGF0aF9tZXRhLCAidHJvcGhpY19sZXZlbHMuY3N2IiksIGhlYWRlciA9IFRSVUUsIHNlcCA9ICI7IikNCnBsc19yZXMgPSBtZXJnZShwbHNfcmVzLCB0bCwgYnkueCA9ICJyZXNwIiwgYnkueSA9ICJTcGVjaWVzIikNCnJmX3JlcyA9IG1lcmdlKHJmX3JlcywgdGwsIGJ5LnggPSAicmVzcCIsIGJ5LnkgPSAiU3BlY2llcyIpDQoNCiMgQXJyYW5nZSBsZXZlbHMgYW5kIHNwZWNpZXMgbmFtZXMNCnJmX3JlcyRMZXZlbCA9IGZhY3RvcihyZl9yZXMkTGV2ZWwsIGxldmVscyhyZl9yZXMkTGV2ZWwpW2MoMSwgNSwgNCwgMywgNiwgMildICkNCnJmX3JlcyRyZXNwID0gc3Vic3RyKHJmX3JlcyRyZXNwLCAzLCBuY2hhcihyZl9yZXMkcmVzcCkpDQpyZl9yZXMkcmVzcCA9IGdzdWIoIiheW1s6YWxwaGE6XV0pIiwgIlxcVVxcMSIsIHJmX3JlcyRyZXNwLCBwZXJsPVRSVUUpDQpyZl9yZXMkcmVzcCA9IGZhY3RvcihyZl9yZXMkcmVzcCwgdW5pcXVlKHJmX3JlcyRyZXNwW29yZGVyKHJmX3JlcyRMZXZlbCwgcmZfcmVzJHJlc3ApXSkpDQpgYGANCg0KIyBDb21wYXJlIFBMUyBhbmQgUkYNCmBgYHtyLCBlY2hvPUZBTFNFfQ0KZ2dwbG90KGRhdGEgPSByZl9yZXMsIGFlcyh4ID0gcmVzcCwgeSA9IFJNU0Vfbm9ybVNELCBmaWxsID0gTGV2ZWwpKSArIA0KICBnZW9tX2JveHBsb3QoKSArDQogIGdlb21faGxpbmUoeWludGVyY2VwdD0xLCBsaW5ldHlwZT0iZGFzaGVkIiwgY29sb3IgPSAiYmxhY2siKSArIA0KICBzY2FsZV9maWxsX2JyZXdlcihwYWxldHRlPSJEYXJrMiIpICsgDQogIHRoZW1lX2J3KCkgKyANCiAgdGhlbWUoYXhpcy50ZXh0LnggPSBlbGVtZW50X3RleHQoYW5nbGUgPSA0NSwgaGp1c3QgPSAxKSkgKyANCiAgbGFicyhsaXN0KHggPSAiU3BlY2llcyByaWNobmVzcyIsIHkgPSAiUk1TRW4iLCBmaWxsID0gIlRyb3BoaWMgbGV2ZWwiKSkNCmBgYA0KDQpgYGB7ciwgZWNobz1GQUxTRX0NCnBsc19yZl9yZXMgPSBtZXJnZShwbHNfcmVzLCByZl9yZXMsIGJ5ID0gYygicHR5cGUiLCAicmVzcCIsICJSZXNhbXBsZSIpLCBhbGwueSA9IFRSVUUpDQpjb2xuYW1lcyhwbHNfcmZfcmVzKVtncmVwKCJcXC54IiwgY29sbmFtZXMocGxzX3JmX3JlcykpXSA9IA0KICBnc3ViKCJcXC54IiwgIl9wbHMiLCBjb2xuYW1lcyhwbHNfcmZfcmVzKVtncmVwKCJcXC54IiwgY29sbmFtZXMocGxzX3JmX3JlcykpXSkNCmNvbG5hbWVzKHBsc19yZl9yZXMpW2dyZXAoIlxcLnkiLCBjb2xuYW1lcyhwbHNfcmZfcmVzKSldID0gDQogIGdzdWIoIlxcLnkiLCAiX3JmIiwgY29sbmFtZXMocGxzX3JmX3JlcylbZ3JlcCgiXFwueSIsIGNvbG5hbWVzKHBsc19yZl9yZXMpKV0pDQojIG5yb3cocGxzX3JmX3JlcykNCg0KcHR5cGVzID0gYygiZWx1aSIsICJrbXJhIiwgInNwZWMiLCAiZWxzcCIpDQpwZXJmX2NoZWNrID0gbGFwcGx5KHB0eXBlcywgZnVuY3Rpb24ocHQpew0KICBzdWJkZiA9IHBsc19yZl9yZXNbIWlzLm5hKHBsc19yZl9yZXMkUk1TRV9wbHMpICYgDQogICAgICAgICAgICAgICAgICAgICAgcGxzX3JmX3JlcyRwdHlwZSA9PSBwdCAmDQogICAgICAgICAgICAgICAgICAgICAgcGxzX3JmX3JlcyRSZXNhbXBsZSA9PSAiTWVhbiIsIF0NCiAgcm93bmFtZXMoc3ViZGZbc3ViZGYkUk1TRV9wbHMgPCBzdWJkZiRSTVNFX3JmLCBdKQ0KfSkNCm5hbWVzKHBlcmZfY2hlY2spID0gcHR5cGVzDQpgYGANCg0KIyBDaGVjayBwZXJmb3JtYW5jZSBvZiBQTFMgYW5kIFJGDQpgYGB7ciwgZWNobyA9IEZBTFNFfQ0KZm9yKGkgaW4gc2VxKGxlbmd0aChwZXJmX2NoZWNrKSkpew0Kcm1zZV9wZXJmID0gc29ydChyb3VuZCgxLXBsc19yZl9yZXNbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLCAiUk1TRV9wbHMiXSAvIA0KICAgICAgICAgICAgICAgICAgICAgICAgIHBsc19yZl9yZXNbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLCAiUk1TRV9yZiJdLDIpKQ0KdmFyX3JmX3ByY3QgPSBzb3J0KHJvdW5kKHBsc19yZl9yZXNbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLCAibnZhcnNfcmYiXSAvIA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgcGxzX3JmX3Jlc1thcy5udW1lcmljKHBlcmZfY2hlY2tbW2ldXSksICJudmFyc19wbHMiXSwyKSkNCmxldmVsX3BscyA9IHNvcnQodGFibGUocGxzX3JmX3Jlc1thcy5udW1lcmljKHBlcmZfY2hlY2tbW2ldXSksICJMZXZlbF9wbHMiXSkpDQpwcmludChuYW1lcyhwZXJmX2NoZWNrW2ldKSkNCnByaW50KHBsc19yZl9yZXNbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLF0pDQpjYXQoIlJNU0UgKDEgLSBQTFMvUkYpOiIsIHJtc2VfcGVyZiwgIlxuIikNCmNhdCgiVmFyIG51bWJlciAoUkYvUExTKToiLCB2YXJfcmZfcHJjdCwgIlxuIikNCmNhdCgiTGV2ZWxzIHdpdGggUExTIGlzIGJldHRlcjoiLCBsZXZlbF9wbHMsICJcbiIpDQpjYXQoIlxuXG4iKQ0KfQ0KYGBgDQoNCiMgQ29sbGVjdCB2YXJpYWJsZSBpbXBvcnRhbmNlDQojIyBOdW1iZXIgb2YgdmFyaWFibGVzDQpgYGB7cn0NCnBsc19yZl9yZXNfbG9uZyA9IG1lbHQocGxzX3JmX3Jlc1twbHNfcmZfcmVzJFJlc2FtcGxlID09ICJNZWFuIiwgYygxLCAyLCA2LCAxMyldLCBpZC52YXJzID0gYygicHR5cGUiLCAicmVzcCIpKQ0KZ2dwbG90KGRhdGEgPSBwbHNfcmZfcmVzX2xvbmcsIGFlcyh4ID0gdmFyaWFibGUsIHkgPSB2YWx1ZSwgZmlsbCA9IHB0eXBlKSkgKw0KICBnZW9tX2JveHBsb3QoKSArIA0KICBsYWJzKGxpc3QoeCA9ICJNb2RlbHMiLCB5ID0gIk51bWJlciBvZiB2YXJpYWJsZXMiICwNCiAgICAgICAgICAgIGZpbGwgPSAiUHJlZGljdG9yIFNldCIpKSArDQogIHRoZW1lX2J3KCkNCmBgYA0KDQoNCiMgVmFyaWFibGUgaW1wb3J0YW5jZSBmb3IgUExTDQpgYGB7ciwgZWNobz1GQUxTRX0NCnZhcl9pbXAgPC0gY29tcFZhckltcChhbGxfbW9kZWxzX3Jlc1tbInBscyJdXVtbInNwZWMiXV1AbW9kZWxbWzFdXSwgc2NhbGUgPSBGQUxTRSkNCiMgcGxvdFZhckltcCh2YXJfaW1wKQ0KcGxvdFZhckltcEhlYXRtYXAodmFyX2ltcCwgeGxhYiA9ICJTcGVjaWVzIiwgeWxhYiA9ICJCYW5kIikNCmBgYA0KDQojIFZhcmlhYmxlIGltcG9ydGFuY2UgZm9yIFJGDQpgYGB7ciwgZWNobz1GQUxTRX0NCnZhcl9pbXAgPC0gY29tcFZhckltcChhbGxfbW9kZWxzX3Jlc1tbInJmIl1dW1sic3BlYyJdXUBtb2RlbFtbMV1dLCBzY2FsZSA9IEZBTFNFKQ0KIyBwbG90VmFySW1wKHZhcl9pbXApDQpwbG90VmFySW1wSGVhdG1hcCh2YXJfaW1wLCB4bGFiID0gIlNwZWNpZXMiLCB5bGFiID0gIkJhbmQiKQ0KYGBgDQoNCg0KIyBUcm9waGljIGxldmVscw0KYGBge3J9DQp2YXJfaW1wX2xldmVscyA9IHZhcl9pbXANCmZvcihpIGluIHNlcShsZW5ndGgodmFyX2ltcF9sZXZlbHMpKSl7DQogIHZhcl9pbXBfbGV2ZWxzW1tpXV0kUkVTUE9OU0UgPSB0bCRMZXZlbFtncmVwKHZhcl9pbXBfbGV2ZWxzW1tpXV0kUkVTUE9OU0VbMV0sIHRsJFNwZWNpZXMpXQ0KfQ0KcGxvdFZhckltcEhlYXRtYXAodmFyX2ltcF9sZXZlbHMsIHhsYWIgPSAiU3BlY2llcyIsIHlsYWIgPSAiQmFuZCIpDQpgYGANCg0KDQoNCg0KV2hlbiB5b3Ugc2F2ZSB0aGUgbm90ZWJvb2ssIGFuIEhUTUwgZmlsZSBjb250YWluaW5nIHRoZSBjb2RlIGFuZCBvdXRwdXQgd2lsbCBiZSBzYXZlZCBhbG9uZ3NpZGUgaXQgKGNsaWNrIHRoZSAqUHJldmlldyogYnV0dG9uIG9yIHByZXNzICpDdHJsK1NoaWZ0K0sqIHRvIHByZXZpZXcgdGhlIEhUTUwgZmlsZSkuDQoNClRoZSBwcmV2aWV3IHNob3dzIHlvdSBhIHJlbmRlcmVkIEhUTUwgY29weSBvZiB0aGUgY29udGVudHMgb2YgdGhlIGVkaXRvci4gQ29uc2VxdWVudGx5LCB1bmxpa2UgKktuaXQqLCAqUHJldmlldyogZG9lcyBub3QgcnVuIGFueSBSIGNvZGUgY2h1bmtzLiBJbnN0ZWFkLCB0aGUgb3V0cHV0IG9mIHRoZSBjaHVuayB3aGVuIGl0IHdhcyBsYXN0IHJ1biBpbiB0aGUgZWRpdG9yIGlzIGRpc3BsYXllZC4NCg==
From 1c8aea6e12367a828942aaa19264881605ed4880 Mon Sep 17 00:00:00 2001 From: Thomas Nauss Date: Tue, 5 Mar 2019 14:21:32 +0100 Subject: [PATCH 45/65] Update --- src/000_set_environment.R | 4 +- src/001_functions.R | 4 +- src/410_compile_analyse_biodiv_sr_elev_res.R | 12 ++- src/510_analyse_biodiv_sr_elev_res.Rmd | 96 +++++++------------- src/510_analyse_biodiv_sr_elev_res.nb.html | 54 ++++------- 5 files changed, 69 insertions(+), 101 deletions(-) diff --git a/src/000_set_environment.R b/src/000_set_environment.R index b75411d..642c4ca 100644 --- a/src/000_set_environment.R +++ b/src/000_set_environment.R @@ -42,6 +42,8 @@ library(doParallel) library(grid) library(gridExtra) library(gpm) # devtools::install_github("environmentalinformatics-marburg/gpm") +library(ggplot2) +library(ggbiplot) library(hsdar) # library(lavaan) # library(rPointDB) @@ -58,7 +60,7 @@ library(satelliteTools) # devtools::install_github("environmentalinformatics-ma # library(semPlot) library(sp) library(spacetime) -# library(vegan) +library(vegan) # library(yaml) diff --git a/src/001_functions.R b/src/001_functions.R index 3563398..92e0238 100644 --- a/src/001_functions.R +++ b/src/001_functions.R @@ -107,7 +107,9 @@ compModels = function(model, pt, mt, outpath){ modelPerformance = function(model){ smr_all = lapply(names(model), function(pt){ smr_pt = lapply(model[[pt]]@model[[1]], function(mi){ - if(inherits(mi[[1]]$model, "try-error")){ + if(is.na(mi[[1]])){ + df = NULL + } else if(inherits(mi[[1]]$model, "try-error")){ df = NULL } else { if(ncol(mi[[1]]$model$resample) == 6){ diff --git a/src/410_compile_analyse_biodiv_sr_elev_res.R b/src/410_compile_analyse_biodiv_sr_elev_res.R index 016099c..e2161b5 100644 --- a/src/410_compile_analyse_biodiv_sr_elev_res.R +++ b/src/410_compile_analyse_biodiv_sr_elev_res.R @@ -7,15 +7,23 @@ dir.create(path_compile_analysis_sr_elev_res, showWarnings = FALSE) # Combine all models into one gpm object pt = "*spec*" -mtypes = c("*pls*", "*rf*") +mtypes = c("*rf*") rtypes = c("*gam_elev_res*", "*pls_elui_res*", "*rf_elui_res*") +rtypes = c("*pls_elui_res*", "*rf_elui_res*") all_models = lapply(mtypes, function(mt){ all_pmodels = lapply(rtypes, function(rt){ model_files = list.files(path_model_gpm_sr_res, full.names = TRUE, pattern = glob2rx(paste0(mt, rt))) - all_models = readRDS(model_files[[1]]) + l = 0 + i = 0 + while(l == 0){ + i = i + 1 + all_models = readRDS(model_files[[i]]) + l = length(all_models@model) + } + for(i in (seq(2, length(model_files)))){ act_model = readRDS(model_files[[i]]) diff --git a/src/510_analyse_biodiv_sr_elev_res.Rmd b/src/510_analyse_biodiv_sr_elev_res.Rmd index 062df46..3ba029d 100644 --- a/src/510_analyse_biodiv_sr_elev_res.Rmd +++ b/src/510_analyse_biodiv_sr_elev_res.Rmd @@ -4,7 +4,7 @@ output: html_notebook --- ```{r, include = FALSE} -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +source("C:/Users/Thomas Nauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") dir.create(path_analysis_sr_elev_res, showWarnings = FALSE) @@ -13,78 +13,42 @@ all_models_res = readRDS(file.path(path_compile_analysis_sr_elev_res, # Collect model performance -pls_res = modelPerformance(all_models_res[["pls"]]) -rf_res = modelPerformance(all_models_res[["rf"]]) +models_res = modelPerformance(all_models_res[["rf"]]) -pls_res$resmodel = pls_res$resp -pls_res$resp = gsub("_gam_elev_res", "", pls_res$resp) +models_res$resmodel = models_res$resp +models_res$resp = gsub("_pls_elui_res", "", models_res$resp) +models_res$resp = gsub("_rf_elui_res", "", models_res$resp) -rf_res$resmodel = rf_res$resp -rf_res$resp = gsub("_gam_elev_res", "", rf_res$resp) +rf_pls_res = models_res[models_res$ptype == "pls_elui_res",] +rf_rf_res = models_res[models_res$ptype == "rf_elui_res",] -summary(pls_res) -summary(rf_res) +summary(rf_pls_res) +summary(rf_rf_res) # Get trophic levels tl = read.table(file.path(path_meta, "trophic_levels.csv"), header = TRUE, sep = ";") -pls_res = merge(pls_res, tl, by.x = "resp", by.y = "Species") -rf_res = merge(rf_res, tl, by.x = "resp", by.y = "Species") +rf_pls_res = merge(rf_pls_res, tl, by.x = "resp", by.y = "Species") +rf_rf_res = merge(rf_rf_res, tl, by.x = "resp", by.y = "Species") ``` # Compare PLS and RF ```{r, echo=FALSE} -models_res = rbind(pls_res[, -4], rf_res[, -4]) models_res$mptype = paste0(models_res$mtype, "_", models_res$ptype) -models_res$mptype = factor(models_res$mptype, levels = c("rf_gam_elev_res")) +models_res$mptype = factor(models_res$mptype) -ggplot(data = models_res[models_res$ptype == "gam_elev_res" | models_res$ptype == "spec",], aes(x = resp, y = RMSE_normSD, fill = mptype)) + +ggplot(data = models_res, aes(x = resp, y = RMSE_normSD, fill = mptype)) + geom_boxplot() + theme_bw() + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + labs(list(x = "Species groups", y = "RMSEn", fill = "Model set")) ``` -```{r, echo=FALSE} -pls_rf_res = merge(pls_res, rf_res, by = c("ptype", "resp", "Resample"), all.y = TRUE) -colnames(pls_rf_res)[grep("\\.x", colnames(pls_rf_res))] = - gsub("\\.x", "_pls", colnames(pls_rf_res)[grep("\\.x", colnames(pls_rf_res))]) -colnames(pls_rf_res)[grep("\\.y", colnames(pls_rf_res))] = - gsub("\\.y", "_rf", colnames(pls_rf_res)[grep("\\.y", colnames(pls_rf_res))]) -# nrow(pls_rf_res) - -ptypes = c("elui", "kmra", "spec", "elsp") -perf_check = lapply(ptypes, function(pt){ - subdf = pls_rf_res[!is.na(pls_rf_res$RMSE_pls) & - pls_rf_res$ptype == pt & - pls_rf_res$Resample == "Mean", ] - rownames(subdf[subdf$RMSE_pls < subdf$RMSE_rf, ]) -}) -names(perf_check) = ptypes -``` - -# Check performance of PLS and RF -```{r, echo = FALSE} -for(i in seq(length(perf_check))){ -rmse_perf = sort(round(1-pls_rf_res[as.numeric(perf_check[[i]]), "RMSE_pls"] / - pls_rf_res[as.numeric(perf_check[[i]]), "RMSE_rf"],2)) -var_rf_prct = sort(round(pls_rf_res[as.numeric(perf_check[[i]]), "nvars_rf"] / - pls_rf_res[as.numeric(perf_check[[i]]), "nvars_pls"],2)) -level_pls = sort(table(pls_rf_res[as.numeric(perf_check[[i]]), "Level_pls"])) -print(names(perf_check[i])) -print(pls_rf_res[as.numeric(perf_check[[i]]),]) -cat("RMSE (1 - PLS/RF):", rmse_perf, "\n") -cat("Var number (RF/PLS):", var_rf_prct, "\n") -cat("Levels with PLS is better:", level_pls, "\n") -cat("\n\n") -} -``` - # Collect variable importance ## Number of variables ```{r} -pls_rf_res_long = melt(pls_rf_res[pls_rf_res$Resample == "Mean", c(1, 2, 6, 13)], id.vars = c("ptype", "resp")) -ggplot(data = pls_rf_res_long, aes(x = variable, y = value, fill = ptype)) + +rf_pls_res_long = melt(models_res[models_res$Resample == "Mean", c(2,3,5)], id.vars = c("ptype", "resp")) +ggplot(data = rf_pls_res_long, aes(x = variable, y = value, fill = ptype)) + geom_boxplot() + labs(list(x = "Models", y = "Number of variables" , fill = "Predictor Set")) + @@ -92,16 +56,9 @@ ggplot(data = pls_rf_res_long, aes(x = variable, y = value, fill = ptype)) + ``` -# Variable importance for PLS -```{r, echo=FALSE} -var_imp <- compVarImp(all_models_res[["pls"]][["spec"]]@model[[1]], scale = FALSE) -# plotVarImp(var_imp) -plotVarImpHeatmap(var_imp, xlab = "Species", ylab = "Band") -``` - # Variable importance for RF -```{r, echo=FALSE} -var_imp <- compVarImp(all_models_res[["rf"]][["spec"]]@model[[1]], scale = FALSE) +```{r} +var_imp <- compVarImp(all_models_res$rf$rf_elui_res@model[[1]], scale = FALSE) # plotVarImp(var_imp) plotVarImpHeatmap(var_imp, xlab = "Species", ylab = "Band") ``` @@ -111,13 +68,26 @@ plotVarImpHeatmap(var_imp, xlab = "Species", ylab = "Band") ```{r} var_imp_levels = var_imp for(i in seq(length(var_imp_levels))){ - var_imp_levels[[i]]$RESPONSE = tl$Level[grep(var_imp_levels[[i]]$RESPONSE[1], tl$Species)] + act_species = gsub("_rf_elui_res", "", var_imp_levels[[i]]$RESPONSE[1]) + var_imp_levels[[i]]$RESPONSE = tl$Level[grep(act_species, tl$Species)] } plotVarImpHeatmap(var_imp_levels, xlab = "Species", ylab = "Band") ``` - - +```{r} +t = do.call("rbind", var_imp) +t = t[t$mean>=0.6,] +t$RESPONSE = gsub("_rf_elui_res", "", t$RESPONSE) +tt = table(t$VARIABLE, t$RESPONSE) +pca_tt <- prcomp(tt, scale = TRUE, center = TRUE) +pca_var <- as.data.frame(pca_tt$rotation) +pca_obs <- as.data.frame(pca_tt$x) +ggplot(pca_var, aes(PC1, PC2))+ + geom_point()+ +geom_point(data = pca_obs, aes(PC1, PC2), color = "red") +ggbiplot(pca_tt, labels = rownames(pca_tt$x), choices = 1:2) +biplot(pca_tt) +``` When you save the notebook, an HTML file containing the code and output will be saved alongside it (click the *Preview* button or press *Ctrl+Shift+K* to preview the HTML file). diff --git a/src/510_analyse_biodiv_sr_elev_res.nb.html b/src/510_analyse_biodiv_sr_elev_res.nb.html index dcbdb2a..dd8db24 100644 --- a/src/510_analyse_biodiv_sr_elev_res.nb.html +++ b/src/510_analyse_biodiv_sr_elev_res.nb.html @@ -182,17 +182,9 @@

510 Analyse Biodiv-RS

Compare PLS and RF

- - - - - - - -
-

Check performance of PLS and RF

- - + +

+
@@ -202,29 +194,20 @@

Collect variable importance

Number of variables

- -
pls_rf_res_long = melt(pls_rf_res[pls_rf_res$Resample == "Mean", c(1, 2, 6, 13)], id.vars = c("ptype", "resp"))
-ggplot(data = pls_rf_res_long, aes(x = variable, y = value, fill = ptype)) +
-  geom_boxplot() + 
-  labs(list(x = "Models", y = "Number of variables" ,
-            fill = "Predictor Set")) +
-  theme_bw()
- + +

+ -
-

Variable importance for PLS

- - - - -

Variable importance for RF

+ +

+
@@ -232,13 +215,16 @@

Variable importance for RF

Trophic levels

- -
var_imp_levels = var_imp
-for(i in seq(length(var_imp_levels))){
-  var_imp_levels[[i]]$RESPONSE = tl$Level[grep(var_imp_levels[[i]]$RESPONSE[1], tl$Species)]
-}
-plotVarImpHeatmap(var_imp_levels, xlab = "Species", ylab = "Band")
- + +

+ + + + + + +

+

When you save the notebook, an HTML file containing the code and output will be saved alongside it (click the Preview button or press Ctrl+Shift+K to preview the HTML file).

@@ -246,7 +232,7 @@

Trophic levels

-
LS0tDQp0aXRsZTogIjUxMCBBbmFseXNlIEJpb2Rpdi1SUyINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCmBgYHtyLCBpbmNsdWRlID0gRkFMU0V9DQpzb3VyY2UoIkM6L1VzZXJzL3RuYXVzcy9wZXJtYW5lbnQvcGx5Z3JuZC9LSS1IeXBlcnNwZWMvSHlTcGVjX0tpTGkvc3JjLzAwMF9zZXRfZW52aXJvbm1lbnQuUiIpDQoNCmRpci5jcmVhdGUocGF0aF9hbmFseXNpc19zcl9lbGV2X3Jlcywgc2hvd1dhcm5pbmdzID0gRkFMU0UpDQoNCmFsbF9tb2RlbHNfcmVzID0gcmVhZFJEUyhmaWxlLnBhdGgocGF0aF9jb21waWxlX2FuYWx5c2lzX3NyX2VsZXZfcmVzLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAibW9kZWxzX3NyX2VsZXZfcmVzLnJkcyIpKQ0KDQoNCiMgQ29sbGVjdCBtb2RlbCBwZXJmb3JtYW5jZQ0KcGxzX3JlcyA9IG1vZGVsUGVyZm9ybWFuY2UoYWxsX21vZGVsc19yZXNbWyJwbHMiXV0pDQpyZl9yZXMgPSBtb2RlbFBlcmZvcm1hbmNlKGFsbF9tb2RlbHNfcmVzW1sicmYiXV0pDQoNCnBsc19yZXMkcmVzbW9kZWwgPSBwbHNfcmVzJHJlc3ANCnBsc19yZXMkcmVzcCA9IGdzdWIoIl9nYW1fZWxldl9yZXMiLCAiIiwgcGxzX3JlcyRyZXNwKQ0KDQpyZl9yZXMkcmVzbW9kZWwgPSByZl9yZXMkcmVzcA0KcmZfcmVzJHJlc3AgPSBnc3ViKCJfZ2FtX2VsZXZfcmVzIiwgIiIsIHJmX3JlcyRyZXNwKQ0KDQpzdW1tYXJ5KHBsc19yZXMpDQpzdW1tYXJ5KHJmX3JlcykNCg0KIyBHZXQgdHJvcGhpYyBsZXZlbHMNCnRsID0gcmVhZC50YWJsZShmaWxlLnBhdGgocGF0aF9tZXRhLCAidHJvcGhpY19sZXZlbHMuY3N2IiksIGhlYWRlciA9IFRSVUUsIHNlcCA9ICI7IikNCnBsc19yZXMgPSBtZXJnZShwbHNfcmVzLCB0bCwgYnkueCA9ICJyZXNwIiwgYnkueSA9ICJTcGVjaWVzIikNCnJmX3JlcyA9IG1lcmdlKHJmX3JlcywgdGwsIGJ5LnggPSAicmVzcCIsIGJ5LnkgPSAiU3BlY2llcyIpDQpgYGANCg0KIyBDb21wYXJlIFBMUyBhbmQgUkYNCmBgYHtyLCBlY2hvPUZBTFNFfQ0KbW9kZWxzX3JlcyA9IHJiaW5kKHBsc19yZXNbLCAtNF0sIHJmX3Jlc1ssIC00XSkNCm1vZGVsc19yZXMkbXB0eXBlID0gcGFzdGUwKG1vZGVsc19yZXMkbXR5cGUsICJfIiwgbW9kZWxzX3JlcyRwdHlwZSkNCm1vZGVsc19yZXMkbXB0eXBlID0gZmFjdG9yKG1vZGVsc19yZXMkbXB0eXBlLCBsZXZlbHMgPSBjKCJyZl9nYW1fZWxldl9yZXMiKSkNCg0KDQpnZ3Bsb3QoZGF0YSA9IG1vZGVsc19yZXNbbW9kZWxzX3JlcyRwdHlwZSA9PSAiZ2FtX2VsZXZfcmVzIiB8IG1vZGVsc19yZXMkcHR5cGUgPT0gInNwZWMiLF0sIGFlcyh4ID0gcmVzcCwgeSA9IFJNU0Vfbm9ybVNELCBmaWxsID0gbXB0eXBlKSkgKyANCiAgZ2VvbV9ib3hwbG90KCkgKw0KICB0aGVtZV9idygpICsgDQogIHRoZW1lKGF4aXMudGV4dC54ID0gZWxlbWVudF90ZXh0KGFuZ2xlID0gNDUsIGhqdXN0ID0gMSkpICsgDQogIGxhYnMobGlzdCh4ID0gIlNwZWNpZXMgZ3JvdXBzIiwgeSA9ICJSTVNFbiIsIGZpbGwgPSAiTW9kZWwgc2V0IikpDQpgYGANCg0KYGBge3IsIGVjaG89RkFMU0V9DQpwbHNfcmZfcmVzID0gbWVyZ2UocGxzX3JlcywgcmZfcmVzLCBieSA9IGMoInB0eXBlIiwgInJlc3AiLCAiUmVzYW1wbGUiKSwgYWxsLnkgPSBUUlVFKQ0KY29sbmFtZXMocGxzX3JmX3JlcylbZ3JlcCgiXFwueCIsIGNvbG5hbWVzKHBsc19yZl9yZXMpKV0gPSANCiAgZ3N1YigiXFwueCIsICJfcGxzIiwgY29sbmFtZXMocGxzX3JmX3JlcylbZ3JlcCgiXFwueCIsIGNvbG5hbWVzKHBsc19yZl9yZXMpKV0pDQpjb2xuYW1lcyhwbHNfcmZfcmVzKVtncmVwKCJcXC55IiwgY29sbmFtZXMocGxzX3JmX3JlcykpXSA9IA0KICBnc3ViKCJcXC55IiwgIl9yZiIsIGNvbG5hbWVzKHBsc19yZl9yZXMpW2dyZXAoIlxcLnkiLCBjb2xuYW1lcyhwbHNfcmZfcmVzKSldKQ0KIyBucm93KHBsc19yZl9yZXMpDQoNCnB0eXBlcyA9IGMoImVsdWkiLCAia21yYSIsICJzcGVjIiwgImVsc3AiKQ0KcGVyZl9jaGVjayA9IGxhcHBseShwdHlwZXMsIGZ1bmN0aW9uKHB0KXsNCiAgc3ViZGYgPSBwbHNfcmZfcmVzWyFpcy5uYShwbHNfcmZfcmVzJFJNU0VfcGxzKSAmIA0KICAgICAgICAgICAgICAgICAgICAgIHBsc19yZl9yZXMkcHR5cGUgPT0gcHQgJg0KICAgICAgICAgICAgICAgICAgICAgIHBsc19yZl9yZXMkUmVzYW1wbGUgPT0gIk1lYW4iLCBdDQogIHJvd25hbWVzKHN1YmRmW3N1YmRmJFJNU0VfcGxzIDwgc3ViZGYkUk1TRV9yZiwgXSkNCn0pDQpuYW1lcyhwZXJmX2NoZWNrKSA9IHB0eXBlcw0KYGBgDQoNCiMgQ2hlY2sgcGVyZm9ybWFuY2Ugb2YgUExTIGFuZCBSRg0KYGBge3IsIGVjaG8gPSBGQUxTRX0NCmZvcihpIGluIHNlcShsZW5ndGgocGVyZl9jaGVjaykpKXsNCnJtc2VfcGVyZiA9IHNvcnQocm91bmQoMS1wbHNfcmZfcmVzW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIlJNU0VfcGxzIl0gLyANCiAgICAgICAgICAgICAgICAgICAgICAgICBwbHNfcmZfcmVzW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIlJNU0VfcmYiXSwyKSkNCnZhcl9yZl9wcmN0ID0gc29ydChyb3VuZChwbHNfcmZfcmVzW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIm52YXJzX3JmIl0gLyANCiAgICAgICAgICAgICAgICAgICAgICAgICAgIHBsc19yZl9yZXNbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLCAibnZhcnNfcGxzIl0sMikpDQpsZXZlbF9wbHMgPSBzb3J0KHRhYmxlKHBsc19yZl9yZXNbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLCAiTGV2ZWxfcGxzIl0pKQ0KcHJpbnQobmFtZXMocGVyZl9jaGVja1tpXSkpDQpwcmludChwbHNfcmZfcmVzW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSxdKQ0KY2F0KCJSTVNFICgxIC0gUExTL1JGKToiLCBybXNlX3BlcmYsICJcbiIpDQpjYXQoIlZhciBudW1iZXIgKFJGL1BMUyk6IiwgdmFyX3JmX3ByY3QsICJcbiIpDQpjYXQoIkxldmVscyB3aXRoIFBMUyBpcyBiZXR0ZXI6IiwgbGV2ZWxfcGxzLCAiXG4iKQ0KY2F0KCJcblxuIikNCn0NCmBgYA0KDQojIENvbGxlY3QgdmFyaWFibGUgaW1wb3J0YW5jZQ0KIyMgTnVtYmVyIG9mIHZhcmlhYmxlcw0KYGBge3J9DQpwbHNfcmZfcmVzX2xvbmcgPSBtZWx0KHBsc19yZl9yZXNbcGxzX3JmX3JlcyRSZXNhbXBsZSA9PSAiTWVhbiIsIGMoMSwgMiwgNiwgMTMpXSwgaWQudmFycyA9IGMoInB0eXBlIiwgInJlc3AiKSkNCmdncGxvdChkYXRhID0gcGxzX3JmX3Jlc19sb25nLCBhZXMoeCA9IHZhcmlhYmxlLCB5ID0gdmFsdWUsIGZpbGwgPSBwdHlwZSkpICsNCiAgZ2VvbV9ib3hwbG90KCkgKyANCiAgbGFicyhsaXN0KHggPSAiTW9kZWxzIiwgeSA9ICJOdW1iZXIgb2YgdmFyaWFibGVzIiAsDQogICAgICAgICAgICBmaWxsID0gIlByZWRpY3RvciBTZXQiKSkgKw0KICB0aGVtZV9idygpDQpgYGANCg0KDQojIFZhcmlhYmxlIGltcG9ydGFuY2UgZm9yIFBMUw0KYGBge3IsIGVjaG89RkFMU0V9DQp2YXJfaW1wIDwtIGNvbXBWYXJJbXAoYWxsX21vZGVsc19yZXNbWyJwbHMiXV1bWyJzcGVjIl1dQG1vZGVsW1sxXV0sIHNjYWxlID0gRkFMU0UpDQojIHBsb3RWYXJJbXAodmFyX2ltcCkNCnBsb3RWYXJJbXBIZWF0bWFwKHZhcl9pbXAsIHhsYWIgPSAiU3BlY2llcyIsIHlsYWIgPSAiQmFuZCIpDQpgYGANCg0KIyBWYXJpYWJsZSBpbXBvcnRhbmNlIGZvciBSRg0KYGBge3IsIGVjaG89RkFMU0V9DQp2YXJfaW1wIDwtIGNvbXBWYXJJbXAoYWxsX21vZGVsc19yZXNbWyJyZiJdXVtbInNwZWMiXV1AbW9kZWxbWzFdXSwgc2NhbGUgPSBGQUxTRSkNCiMgcGxvdFZhckltcCh2YXJfaW1wKQ0KcGxvdFZhckltcEhlYXRtYXAodmFyX2ltcCwgeGxhYiA9ICJTcGVjaWVzIiwgeWxhYiA9ICJCYW5kIikNCmBgYA0KDQoNCiMgVHJvcGhpYyBsZXZlbHMNCmBgYHtyfQ0KdmFyX2ltcF9sZXZlbHMgPSB2YXJfaW1wDQpmb3IoaSBpbiBzZXEobGVuZ3RoKHZhcl9pbXBfbGV2ZWxzKSkpew0KICB2YXJfaW1wX2xldmVsc1tbaV1dJFJFU1BPTlNFID0gdGwkTGV2ZWxbZ3JlcCh2YXJfaW1wX2xldmVsc1tbaV1dJFJFU1BPTlNFWzFdLCB0bCRTcGVjaWVzKV0NCn0NCnBsb3RWYXJJbXBIZWF0bWFwKHZhcl9pbXBfbGV2ZWxzLCB4bGFiID0gIlNwZWNpZXMiLCB5bGFiID0gIkJhbmQiKQ0KYGBgDQoNCg0KDQoNCldoZW4geW91IHNhdmUgdGhlIG5vdGVib29rLCBhbiBIVE1MIGZpbGUgY29udGFpbmluZyB0aGUgY29kZSBhbmQgb3V0cHV0IHdpbGwgYmUgc2F2ZWQgYWxvbmdzaWRlIGl0IChjbGljayB0aGUgKlByZXZpZXcqIGJ1dHRvbiBvciBwcmVzcyAqQ3RybCtTaGlmdCtLKiB0byBwcmV2aWV3IHRoZSBIVE1MIGZpbGUpLg0KDQpUaGUgcHJldmlldyBzaG93cyB5b3UgYSByZW5kZXJlZCBIVE1MIGNvcHkgb2YgdGhlIGNvbnRlbnRzIG9mIHRoZSBlZGl0b3IuIENvbnNlcXVlbnRseSwgdW5saWtlICpLbml0KiwgKlByZXZpZXcqIGRvZXMgbm90IHJ1biBhbnkgUiBjb2RlIGNodW5rcy4gSW5zdGVhZCwgdGhlIG91dHB1dCBvZiB0aGUgY2h1bmsgd2hlbiBpdCB3YXMgbGFzdCBydW4gaW4gdGhlIGVkaXRvciBpcyBkaXNwbGF5ZWQuDQo=
+
LS0tDQp0aXRsZTogIjUxMCBBbmFseXNlIEJpb2Rpdi1SUyINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCmBgYHtyLCBpbmNsdWRlID0gRkFMU0V9DQpzb3VyY2UoIkM6L1VzZXJzL1Rob21hcyBOYXVzcy9wZXJtYW5lbnQvcGx5Z3JuZC9LSS1IeXBlcnNwZWMvSHlTcGVjX0tpTGkvc3JjLzAwMF9zZXRfZW52aXJvbm1lbnQuUiIpDQoNCmRpci5jcmVhdGUocGF0aF9hbmFseXNpc19zcl9lbGV2X3Jlcywgc2hvd1dhcm5pbmdzID0gRkFMU0UpDQoNCmFsbF9tb2RlbHNfcmVzID0gcmVhZFJEUyhmaWxlLnBhdGgocGF0aF9jb21waWxlX2FuYWx5c2lzX3NyX2VsZXZfcmVzLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAibW9kZWxzX3NyX2VsZXZfcmVzLnJkcyIpKQ0KDQoNCiMgQ29sbGVjdCBtb2RlbCBwZXJmb3JtYW5jZQ0KbW9kZWxzX3JlcyA9IG1vZGVsUGVyZm9ybWFuY2UoYWxsX21vZGVsc19yZXNbWyJyZiJdXSkNCg0KbW9kZWxzX3JlcyRyZXNtb2RlbCA9IG1vZGVsc19yZXMkcmVzcA0KbW9kZWxzX3JlcyRyZXNwID0gZ3N1YigiX3Bsc19lbHVpX3JlcyIsICIiLCBtb2RlbHNfcmVzJHJlc3ApDQptb2RlbHNfcmVzJHJlc3AgPSBnc3ViKCJfcmZfZWx1aV9yZXMiLCAiIiwgbW9kZWxzX3JlcyRyZXNwKQ0KDQpyZl9wbHNfcmVzID0gbW9kZWxzX3Jlc1ttb2RlbHNfcmVzJHB0eXBlID09ICJwbHNfZWx1aV9yZXMiLF0NCnJmX3JmX3JlcyA9IG1vZGVsc19yZXNbbW9kZWxzX3JlcyRwdHlwZSA9PSAicmZfZWx1aV9yZXMiLF0NCg0Kc3VtbWFyeShyZl9wbHNfcmVzKQ0Kc3VtbWFyeShyZl9yZl9yZXMpDQoNCiMgR2V0IHRyb3BoaWMgbGV2ZWxzDQp0bCA9IHJlYWQudGFibGUoZmlsZS5wYXRoKHBhdGhfbWV0YSwgInRyb3BoaWNfbGV2ZWxzLmNzdiIpLCBoZWFkZXIgPSBUUlVFLCBzZXAgPSAiOyIpDQpyZl9wbHNfcmVzID0gbWVyZ2UocmZfcGxzX3JlcywgdGwsIGJ5LnggPSAicmVzcCIsIGJ5LnkgPSAiU3BlY2llcyIpDQpyZl9yZl9yZXMgPSBtZXJnZShyZl9yZl9yZXMsIHRsLCBieS54ID0gInJlc3AiLCBieS55ID0gIlNwZWNpZXMiKQ0KYGBgDQoNCiMgQ29tcGFyZSBQTFMgYW5kIFJGDQpgYGB7ciwgZWNobz1GQUxTRX0NCm1vZGVsc19yZXMkbXB0eXBlID0gcGFzdGUwKG1vZGVsc19yZXMkbXR5cGUsICJfIiwgbW9kZWxzX3JlcyRwdHlwZSkNCm1vZGVsc19yZXMkbXB0eXBlID0gZmFjdG9yKG1vZGVsc19yZXMkbXB0eXBlKQ0KDQoNCmdncGxvdChkYXRhID0gbW9kZWxzX3JlcywgYWVzKHggPSByZXNwLCB5ID0gUk1TRV9ub3JtU0QsIGZpbGwgPSBtcHR5cGUpKSArIA0KICBnZW9tX2JveHBsb3QoKSArDQogIHRoZW1lX2J3KCkgKyANCiAgdGhlbWUoYXhpcy50ZXh0LnggPSBlbGVtZW50X3RleHQoYW5nbGUgPSA0NSwgaGp1c3QgPSAxKSkgKyANCiAgbGFicyhsaXN0KHggPSAiU3BlY2llcyBncm91cHMiLCB5ID0gIlJNU0VuIiwgZmlsbCA9ICJNb2RlbCBzZXQiKSkNCmBgYA0KDQojIENvbGxlY3QgdmFyaWFibGUgaW1wb3J0YW5jZQ0KIyMgTnVtYmVyIG9mIHZhcmlhYmxlcw0KYGBge3J9DQpyZl9wbHNfcmVzX2xvbmcgPSBtZWx0KG1vZGVsc19yZXNbbW9kZWxzX3JlcyRSZXNhbXBsZSA9PSAiTWVhbiIsIGMoMiwzLDUpXSwgaWQudmFycyA9IGMoInB0eXBlIiwgInJlc3AiKSkNCmdncGxvdChkYXRhID0gcmZfcGxzX3Jlc19sb25nLCBhZXMoeCA9IHZhcmlhYmxlLCB5ID0gdmFsdWUsIGZpbGwgPSBwdHlwZSkpICsNCiAgZ2VvbV9ib3hwbG90KCkgKyANCiAgbGFicyhsaXN0KHggPSAiTW9kZWxzIiwgeSA9ICJOdW1iZXIgb2YgdmFyaWFibGVzIiAsDQogICAgICAgICAgICBmaWxsID0gIlByZWRpY3RvciBTZXQiKSkgKw0KICB0aGVtZV9idygpDQpgYGANCg0KDQojIFZhcmlhYmxlIGltcG9ydGFuY2UgZm9yIFJGDQpgYGB7cn0NCnZhcl9pbXAgPC0gY29tcFZhckltcChhbGxfbW9kZWxzX3JlcyRyZiRyZl9lbHVpX3Jlc0Btb2RlbFtbMV1dLCBzY2FsZSA9IEZBTFNFKQ0KIyBwbG90VmFySW1wKHZhcl9pbXApDQpwbG90VmFySW1wSGVhdG1hcCh2YXJfaW1wLCB4bGFiID0gIlNwZWNpZXMiLCB5bGFiID0gIkJhbmQiKQ0KYGBgDQoNCg0KIyBUcm9waGljIGxldmVscw0KYGBge3J9DQp2YXJfaW1wX2xldmVscyA9IHZhcl9pbXANCmZvcihpIGluIHNlcShsZW5ndGgodmFyX2ltcF9sZXZlbHMpKSl7DQogIGFjdF9zcGVjaWVzID0gZ3N1YigiX3JmX2VsdWlfcmVzIiwgIiIsIHZhcl9pbXBfbGV2ZWxzW1tpXV0kUkVTUE9OU0VbMV0pDQogIHZhcl9pbXBfbGV2ZWxzW1tpXV0kUkVTUE9OU0UgPSB0bCRMZXZlbFtncmVwKGFjdF9zcGVjaWVzLCB0bCRTcGVjaWVzKV0NCn0NCnBsb3RWYXJJbXBIZWF0bWFwKHZhcl9pbXBfbGV2ZWxzLCB4bGFiID0gIlNwZWNpZXMiLCB5bGFiID0gIkJhbmQiKQ0KYGBgDQoNCmBgYHtyfQ0KdCA9IGRvLmNhbGwoInJiaW5kIiwgdmFyX2ltcCkNCnQgPSB0W3QkbWVhbj49MC42LF0NCnQkUkVTUE9OU0UgPSBnc3ViKCJfcmZfZWx1aV9yZXMiLCAiIiwgdCRSRVNQT05TRSkNCnR0ID0gdGFibGUodCRWQVJJQUJMRSwgdCRSRVNQT05TRSkNCnBjYV90dCA8LSBwcmNvbXAodHQsIHNjYWxlID0gVFJVRSwgY2VudGVyID0gVFJVRSkNCnBjYV92YXIgPC0gYXMuZGF0YS5mcmFtZShwY2FfdHQkcm90YXRpb24pDQpwY2Ffb2JzIDwtIGFzLmRhdGEuZnJhbWUocGNhX3R0JHgpDQpnZ3Bsb3QocGNhX3ZhciwgYWVzKFBDMSwgUEMyKSkrDQogIGdlb21fcG9pbnQoKSsNCmdlb21fcG9pbnQoZGF0YSA9IHBjYV9vYnMsIGFlcyhQQzEsIFBDMiksIGNvbG9yID0gInJlZCIpDQpnZ2JpcGxvdChwY2FfdHQsIGxhYmVscyA9IHJvd25hbWVzKHBjYV90dCR4KSwgY2hvaWNlcyA9IDE6MikNCmJpcGxvdChwY2FfdHQpDQpgYGANCg0KV2hlbiB5b3Ugc2F2ZSB0aGUgbm90ZWJvb2ssIGFuIEhUTUwgZmlsZSBjb250YWluaW5nIHRoZSBjb2RlIGFuZCBvdXRwdXQgd2lsbCBiZSBzYXZlZCBhbG9uZ3NpZGUgaXQgKGNsaWNrIHRoZSAqUHJldmlldyogYnV0dG9uIG9yIHByZXNzICpDdHJsK1NoaWZ0K0sqIHRvIHByZXZpZXcgdGhlIEhUTUwgZmlsZSkuDQoNClRoZSBwcmV2aWV3IHNob3dzIHlvdSBhIHJlbmRlcmVkIEhUTUwgY29weSBvZiB0aGUgY29udGVudHMgb2YgdGhlIGVkaXRvci4gQ29uc2VxdWVudGx5LCB1bmxpa2UgKktuaXQqLCAqUHJldmlldyogZG9lcyBub3QgcnVuIGFueSBSIGNvZGUgY2h1bmtzLiBJbnN0ZWFkLCB0aGUgb3V0cHV0IG9mIHRoZSBjaHVuayB3aGVuIGl0IHdhcyBsYXN0IHJ1biBpbiB0aGUgZWRpdG9yIGlzIGRpc3BsYXllZC4NCg==
From 09070cf54e8eca967b994cacddf212b314f98656 Mon Sep 17 00:00:00 2001 From: Thomas Nauss Date: Fri, 8 Mar 2019 23:04:26 +0100 Subject: [PATCH 46/65] Update biodiv variables --- src/010_biodiv_preprocessing.R | 153 ++++++++++++++++++++- src/510_analyse_biodiv_sr_elev_res.nb.html | 23 +++- 2 files changed, 173 insertions(+), 3 deletions(-) diff --git a/src/010_biodiv_preprocessing.R b/src/010_biodiv_preprocessing.R index 3b98a3c..7155f91 100644 --- a/src/010_biodiv_preprocessing.R +++ b/src/010_biodiv_preprocessing.R @@ -1,12 +1,161 @@ # Preprocess biodiversity observations. -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +source("C:/Users/Thomas Nauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") -# Read species richness dataset + +# Read species richness dataset (Peters et al. 2016) bd = read.table(paste0(path_biodiv, "Biodiversity_Data_Marcel.csv"), header = TRUE, sep = ";", dec = ",") saveRDS(as.character(bd$plotID), file = paste0(path_biodiv, "biodiv_plots.rds")) saveRDS(bd, file = paste0(path_biodiv, "biodiv.rds")) +# Read animal species dataset +ad = read.table(paste0(path_biodiv, "animals_plotIDcomplete_Syn1.csv"), + header = TRUE, sep = ";", dec = ",") + +ad_diet = lapply(unique(ad$taxon), function(t){ + data.frame(taxon = t, + ad$diet) +}) + + + +# Set species number to 0/1 and reduce to complete cases +ad[, 14:73][!is.na(ad[, 14:73]) & ad[, 14:73]>1] = 1 +adc = ad[complete.cases(ad[, 14:73]),] + +# Split into taxon groups +adc_taxl = lapply(unique(adc$taxon), function(t){ + act_level = adc[adc$taxon == t, ] + act_grp = act_level[, 14:73] + rownames(act_grp) = act_level$species + return(t(act_grp)) +}) + +adc_taxl_all = adc[, 14:73] +rownames(adc_all) = adc$species + +adc_taxl = c(list(t(adc_taxl_all)), adc_taxl) +names(adc_taxl) = c("Animals", as.character(unique(adc$taxon))) + +saveRDS(adc_taxl, file = paste0(path_biodiv, "adc_taxl.rds")) + + + +# Split into trophic levels +adc_tlevels = lapply(unique(adc$diet), function(d){ + act_level = adc[adc$diet == d, ] + act_grp = act_level[, 14:73] + rownames(act_grp) = act_level$species + return(t(act_grp)) +}) + +adc_all =adc[, 14:73] +rownames(adc_all) = adc$species + +adc_tlevels = c(list(t(adc_all)), adc_tlevels) +names(adc_tlevels) = c("Animals", as.character(unique(adc$diet))) + +saveRDS(adc_tlevels, file = paste0(path_biodiv, "adc_tlevels.rds")) + + + +# Compute species richness from taxon groups and tropich levels +adc_taxl_sr = data.frame(plotID = rownames(adc_taxl[[1]])) +for(i in seq(length(adc_taxl))){ + adc_taxl_sr[, i+1] = rowSums(adc_taxl[[i]]) + names(adc_taxl_sr)[i+1] = paste0("SR", tolower(names(adc_taxl[i]))) +} + +adc_tlevels_sr = data.frame(plotID = rownames(adc_tlevels[[1]])) +for(i in seq(length(adc_tlevels))){ + adc_tlevels_sr[, i+1] = rowSums(adc_tlevels[[i]]) + names(adc_tlevels_sr)[i+1] = paste0("SR", tolower(names(adc_tlevels[i]))) +} + +adc_sr = merge(adc_tlevels_sr, + adc_taxl_sr[, -grep("SRanimals", colnames(adc_taxl_sr))], + by = "plotID") + +saveRDS(adc_sr, file = paste0(path_biodiv, "adc_sr.rds")) + + + +# Merge species richness data +s_adc_sr = colnames(adc_sr[-grep("plotID", colnames(adc_sr))]) + +colnames(bd)[which("SRsyrphids" == colnames(bd))] = "SRsyrphid_flies" +colnames(bd)[which("SRbats" == colnames(bd))] = "SRinsectivorous_bats" +colnames(bd)[which("SRmammals" == colnames(bd))] = "SRlarge_mammals" +colnames(bd)[which("SRparasitoids" == colnames(bd))] = "SRparasitoid_wasps" +colnames(bd)[which("SRotheraculeata" == colnames(bd))] = "SRaculeate_wasps" +colnames(bd)[which("SRmillipedes" == colnames(bd))] = "SRmilipeds" +colnames(bd)[which("SRsnails" == colnames(bd))] = "SRgastropods" + +s_bd = colnames(bd[, grep("SR", colnames(bd))]) +# which(tolower(s_adc_taxl_sr) %in% tolower(s_bd)) + +species_richness = merge(bd, adc_sr, by = "plotID") +species_richness = species_richness[, -grep("\\.x", colnames(species_richness))] +colnames(species_richness)[grep("\\.y", colnames(species_richness))] = + substr(colnames(species_richness)[grep("\\.y", colnames(species_richness))], 1, + (nchar(colnames(species_richness)[grep("\\.y", colnames(species_richness))])-2)) + +saveRDS(species_richness, file = paste0(path_biodiv, "species_richness.rds")) + + + +# Compute community composition using detrended correspondence analysis +species_composition_dcor.rds = lapply(adc_tlevels, function(l){ + l = l[rowSums(l) > 0, ] + decorana(l) +}) +names(species_composition_dcor.rds) = names(adc_tlevels) +# for(i in seq(5)) plot(species_composition_dcor.rds[[i]], display = "sites") + +saveRDS(species_composition_dcor.rds, file = paste0(path_biodiv, "species_composition_dcor.rds")) + + + +# Compute relative network using PCA +tlevels = colnames(species_richness)[ + seq(grep("SRanimals", colnames(species_richness)), + grep("SRanimals", colnames(species_richness))+4)] + +adn_matrix = matrix(ncol = 5, nrow = 60) +for(i in seq(5)){ + adn_matrix[, i] = species_richness[, tlevels[i]] +} +rownames(adn_matrix) <- species_richness$plotID +colnames(adn_matrix ) <- tlevels + +species_network_pca <- princomp(adn_matrix[,-1], cor=T) + +# biplot(species_network_pca, choices = 2:3) +# summary(species_network_pca) + +saveRDS(species_network_pca, file = paste0(path_biodiv, "species_network_pca.rds")) + + +# Cross check +# sort(colnames(adc_taxl_sr)) +# sort(colnames(bd[, c(1, grep("SR", colnames(bd)))])) +# +# test = merge(adc_taxl_sr, bd, by = "plotID", all = TRUE) +# +# test_df = lapply(grep("\\.x", colnames(test)), function(t){ +# x = colnames(test)[t] +# y = paste0(substr(x, 1, (nchar(x)-1)), "y") +# act_df = data.frame(plotID = test$plotID, test[, x], test[, y]) +# colnames(act_df) = c("plotId", x, y) +# return(act_df) +# }) +# test_df + + + + + + diff --git a/src/510_analyse_biodiv_sr_elev_res.nb.html b/src/510_analyse_biodiv_sr_elev_res.nb.html index dd8db24..a5db346 100644 --- a/src/510_analyse_biodiv_sr_elev_res.nb.html +++ b/src/510_analyse_biodiv_sr_elev_res.nb.html @@ -223,7 +223,28 @@

Trophic levels

-

+

+ + +

+ + +
t = do.call("rbind", var_imp)
+t = t[t$mean>=0.6,]
+t$RESPONSE = gsub("_rf_elui_res", "", t$RESPONSE)
+tt = table(t$VARIABLE, t$RESPONSE)
+pca_tt <- prcomp(tt, scale = TRUE, center = TRUE)
+pca_var <- as.data.frame(pca_tt$rotation)
+pca_obs <- as.data.frame(pca_tt$x)
+ggplot(pca_var, aes(PC1, PC2))+
+  geom_point()+
+geom_point(data = pca_obs, aes(PC1, PC2), color = "red")
+ggbiplot(pca_tt, labels = rownames(pca_tt$x), choices = 1:2)
+
+biplot(pca_tt)
+ + +

From 9a5fc937c3d0289728bbf3f28296642a21a488b3 Mon Sep 17 00:00:00 2001 From: Thomas Nauss Date: Sat, 9 Mar 2019 06:45:15 +0100 Subject: [PATCH 47/65] Update combined dataset --- src/010_biodiv_preprocessing.R | 8 ++++---- src/100_combine_predictores_biodiv_sr.R | 26 ++++++++++++++++++++----- 2 files changed, 25 insertions(+), 9 deletions(-) diff --git a/src/010_biodiv_preprocessing.R b/src/010_biodiv_preprocessing.R index 7155f91..093d4ad 100644 --- a/src/010_biodiv_preprocessing.R +++ b/src/010_biodiv_preprocessing.R @@ -107,14 +107,14 @@ saveRDS(species_richness, file = paste0(path_biodiv, "species_richness.rds")) # Compute community composition using detrended correspondence analysis -species_composition_dcor.rds = lapply(adc_tlevels, function(l){ +species_composition_dcor = lapply(adc_tlevels, function(l){ l = l[rowSums(l) > 0, ] decorana(l) }) -names(species_composition_dcor.rds) = names(adc_tlevels) -# for(i in seq(5)) plot(species_composition_dcor.rds[[i]], display = "sites") +names(species_composition_dcor) = names(adc_tlevels) +# for(i in seq(5)) plot(species_composition_dcor[[i]], display = "sites") -saveRDS(species_composition_dcor.rds, file = paste0(path_biodiv, "species_composition_dcor.rds")) +saveRDS(species_composition_dcor, file = paste0(path_biodiv, "species_composition_dcor.rds")) diff --git a/src/100_combine_predictores_biodiv_sr.R b/src/100_combine_predictores_biodiv_sr.R index bc85f57..a60ce8d 100644 --- a/src/100_combine_predictores_biodiv_sr.R +++ b/src/100_combine_predictores_biodiv_sr.R @@ -1,20 +1,36 @@ # Combine hyperspectral predictores and biodiversity variables in gpm class. -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +source("C:/Users/Thomas Nauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") preds = readRDS(paste0(path_hyp_pred, "hyperspec_preds.rds")) -bd = readRDS(paste0(path_biodiv, "biodiv.rds")) +# bd = readRDS(paste0(path_biodiv, "biodiv.rds")) +species_richness = readRDS(paste0(path_biodiv, "species_richness.rds")) +species_composition_dcor = readRDS(paste0(path_biodiv, "species_composition_dcor.rds")) +species_network_pca = readRDS(paste0(path_biodiv, "species_network_pca.rds")) -comb = merge(bd, preds, by = c("plotID"), all.x = TRUE, all.y = TRUE) +comb = data.frame(species_network_pca$scores) +colnames(comb) = paste0("sn_pca", seq(4)) +comb$plotID = rownames(species_network_pca$scores) + +comb = merge(species_richness, comb, by = c("plotID"), all.x = TRUE, all.y = TRUE) + +for(i in seq(length(species_composition_dcor))){ + act = data.frame(species_composition_dcor[[i]]$rproj) + colnames(act) = paste0("sn_dca", seq(4), "_", names(species_composition_dcor[i])) + act$plotID = rownames(act) + comb = merge(comb, act, by = c("plotID"), all.x = TRUE, all.y = TRUE) +} + +comb = merge(comb, preds, by = c("plotID")) comb$SelCat = substr(as.character(comb$plotID), 1, 3) comb$SelNbr = substr(as.character(comb$plotID), 4, 4) col_selector = which(names(comb) %in% c("SelCat", "SelNbr")) -col_diversity = seq(which("SRmammals" == colnames(comb)), - which("SRallplants" == colnames(comb))) +col_diversity = seq(which("SRspiders" == colnames(comb)), + which("sn_dca4_Decomposer" == colnames(comb))) col_precitors = c(which("elevation" == colnames(comb)), seq(which("lui_biomass_removal" == colnames(comb)), From 613938c6cba4b90dda718e79b06cfe9cc2e6489e Mon Sep 17 00:00:00 2001 From: Thomas Nauss Date: Sat, 9 Mar 2019 14:38:05 +0100 Subject: [PATCH 48/65] Update model --- src/100_combine_predictores_biodiv_sr.R | 3 +-- src/120_combine_predictores_biodiv_tlevel.R | 2 +- src/200_predict_biodiv_sr_rf.R | 9 +++++---- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/100_combine_predictores_biodiv_sr.R b/src/100_combine_predictores_biodiv_sr.R index a60ce8d..f6337c9 100644 --- a/src/100_combine_predictores_biodiv_sr.R +++ b/src/100_combine_predictores_biodiv_sr.R @@ -33,8 +33,7 @@ col_diversity = seq(which("SRspiders" == colnames(comb)), which("sn_dca4_Decomposer" == colnames(comb))) col_precitors = c(which("elevation" == colnames(comb)), - seq(which("lui_biomass_removal" == colnames(comb)), - which("lui" == colnames(comb))), + which("lui" == colnames(comb)), seq(which("CARI_mean" == colnames(comb)), which("pcai_kmdc_raoq_sd" == colnames(comb)))) diff --git a/src/120_combine_predictores_biodiv_tlevel.R b/src/120_combine_predictores_biodiv_tlevel.R index d213cad..ee7f0fb 100644 --- a/src/120_combine_predictores_biodiv_tlevel.R +++ b/src/120_combine_predictores_biodiv_tlevel.R @@ -1,7 +1,7 @@ # Combine hyperspectral predictores and biodiversity variables in gpm class # aggregated by trophic level. -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +source("C:/Users/Thomas Nauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") preds = readRDS(paste0(path_hyp_pred, "hyperspec_preds.rds")) diff --git a/src/200_predict_biodiv_sr_rf.R b/src/200_predict_biodiv_sr_rf.R index ff085c8..e2f5a41 100644 --- a/src/200_predict_biodiv_sr_rf.R +++ b/src/200_predict_biodiv_sr_rf.R @@ -1,6 +1,6 @@ # Predict species richness using different models and predictor sets if(Sys.info()["sysname"] == "Windows"){ - filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" + filepath_base = "C:/Users/Thomas Nauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" } else { filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" } @@ -21,6 +21,7 @@ comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) # Predict with all elevation and lui information, hyperspectral data only, # all data, and kmdc and raoq only using gam, pls and rf models. mtypes = c("*gam*", "*pls*", "*rf*") +mtypes = c("*rf*") ptypes = c("*elui*", "*spec*", "*elsp*", "*kmra*") mt = mtypes[3] @@ -30,11 +31,11 @@ for(mt in mtypes){ for(pt in ptypes){ if(pt == "*elui*"){ - comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[c(1:7)] + comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[c(1,2)] } else if(pt == "*spec*"){ - comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[-c(1:7)] + comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[-c(1,2)] } else if(pt == "*elsp*"){ - comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR + comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR } else if(pt == "*kmra*"){ comb@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ c(grep("kmdc", comb@meta$input$PREDICTOR), From 24bcf8bca4ad72b12ab92d86f7e9152499fbcf37 Mon Sep 17 00:00:00 2001 From: Thomas Nauss Date: Sat, 9 Mar 2019 15:05:58 +0100 Subject: [PATCH 49/65] Update CV --- src/001_functions.R | 7 ++++++- src/100_combine_predictores_biodiv_sr.R | 8 +++++++- src/200_predict_biodiv_sr_rf.R | 10 +++++----- 3 files changed, 18 insertions(+), 7 deletions(-) diff --git a/src/001_functions.R b/src/001_functions.R index 92e0238..73e6378 100644 --- a/src/001_functions.R +++ b/src/001_functions.R @@ -79,13 +79,18 @@ compModels = function(model, pt, mt, outpath){ model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] + if(length(model@meta$input$PREDICTOR_FINAL) < 3){ + mode = "none" + } else { + mode = "ffs" + } if(nrow(model@data$input) > 0){ model = createIndexFolds(x = model, nested_cv = FALSE) model = trainModel(x = model, metric = "RMSE", n_var = NULL, mthd = mt, - mode = "ffs", + mode = mode, seed_nbr = 11, cv_nbr = NULL, var_selection = "indv", diff --git a/src/100_combine_predictores_biodiv_sr.R b/src/100_combine_predictores_biodiv_sr.R index f6337c9..4e154a8 100644 --- a/src/100_combine_predictores_biodiv_sr.R +++ b/src/100_combine_predictores_biodiv_sr.R @@ -23,9 +23,15 @@ for(i in seq(length(species_composition_dcor))){ } comb = merge(comb, preds, by = c("plotID")) +comb = droplevels(comb) comb$SelCat = substr(as.character(comb$plotID), 1, 3) -comb$SelNbr = substr(as.character(comb$plotID), 4, 4) + +selnbr = lapply(table(comb$SelCat), function(c){ + seq(c) +}) +comb$SelNbr = unlist(selnbr) + col_selector = which(names(comb) %in% c("SelCat", "SelNbr")) diff --git a/src/200_predict_biodiv_sr_rf.R b/src/200_predict_biodiv_sr_rf.R index e2f5a41..8a51eb9 100644 --- a/src/200_predict_biodiv_sr_rf.R +++ b/src/200_predict_biodiv_sr_rf.R @@ -20,17 +20,17 @@ comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) # Predict with all elevation and lui information, hyperspectral data only, # all data, and kmdc and raoq only using gam, pls and rf models. -mtypes = c("*gam*", "*pls*", "*rf*") -mtypes = c("*rf*") +mtypes = c("gam", "pls", "rf") +mtypes = c("rf") ptypes = c("*elui*", "*spec*", "*elsp*", "*kmra*") -mt = mtypes[3] -pt = ptypes[4] +mt = mtypes[1] +pt = ptypes[1] for(mt in mtypes){ for(pt in ptypes){ - if(pt == "*elui*"){ + if(pt == "*elui*"){ comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[c(1,2)] } else if(pt == "*spec*"){ comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[-c(1,2)] From 823287be12647d27c5c59a907146ab34c0bdfd81 Mon Sep 17 00:00:00 2001 From: Thomas Nauss Date: Sat, 16 Mar 2019 08:23:02 +0100 Subject: [PATCH 50/65] Update elev res modelling --- src/010_biodiv_preprocessing.R | 18 ++++++++ ..._combine_predictores_biodiv_sr_residuals.R | 44 ++++++++++--------- src/310_predict_biodiv_sr_res_rf.R | 26 +++++++---- src/400_compile_analyse_biodiv_sr.R | 5 ++- 4 files changed, 63 insertions(+), 30 deletions(-) diff --git a/src/010_biodiv_preprocessing.R b/src/010_biodiv_preprocessing.R index 093d4ad..6199d78 100644 --- a/src/010_biodiv_preprocessing.R +++ b/src/010_biodiv_preprocessing.R @@ -138,6 +138,24 @@ species_network_pca <- princomp(adn_matrix[,-1], cor=T) saveRDS(species_network_pca, file = paste0(path_biodiv, "species_network_pca.rds")) +# comb_grigusovaine diversity for Grigusova et al. 2019 +comb_grigusova = data.frame(species_network_pca$scores) +colnames(comb_grigusova) = paste0("sn_pca", seq(4)) +comb_grigusova$plotID = rownames(species_network_pca$scores) + +comb_grigusova = merge(adc_sr, comb_grigusova, by = c("plotID"), all.x = TRUE, all.y = TRUE) + +for(i in seq(length(species_composition_dcor))){ + act = data.frame(species_composition_dcor[[i]]$rproj) + colnames(act) = paste0("sn_dca", seq(4), "_", names(species_composition_dcor[i])) + act$plotID = rownames(act) + comb_grigusova = merge(comb_grigusova, act, by = c("plotID"), all.x = TRUE, all.y = TRUE) +} + +comb_grigusova = droplevels(comb_grigusova) + +saveRDS(comb_grigusova, file = paste0(path_biodiv, "comb_grigusova.rds")) + # Cross check # sort(colnames(adc_taxl_sr)) # sort(colnames(bd[, c(1, grep("SR", colnames(bd)))])) diff --git a/src/300_combine_predictores_biodiv_sr_residuals.R b/src/300_combine_predictores_biodiv_sr_residuals.R index 454da9a..b4d0b66 100644 --- a/src/300_combine_predictores_biodiv_sr_residuals.R +++ b/src/300_combine_predictores_biodiv_sr_residuals.R @@ -1,6 +1,6 @@ # Compile species richness dataset containing residuals from some previous modelling if(Sys.info()["sysname"] == "Windows"){ - filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" + filepath_base = "C:/Users/Thomas Nauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" } else { filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" } @@ -11,31 +11,33 @@ source(filepath_base) dir.create(paste0(path_comb_gpm_sr_res), showWarnings = FALSE) +# 1st version - not used anymore # Compile elevation residuals for gam model using eleveation as only predictor -pt = "*elev*" -mt = "*gam*" - -comb_sr = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) -comb_sr_elev_res = compResData(comb_sr, pt, mt) - -saveRDS(comb_sr_elev_res, - file = file.path(path_comb_gpm_sr_res, - paste0("ki_hyperspec_biodiv_non_scaled", - gsub("[*]", "", paste0("_", mt, "_", pt, "_res.rds"))))) +# pt = "*elev*" +# mt = "*gam*" +# +# comb_sr = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) +# comb_sr_elev_res = compResData(comb_sr, pt, mt) +# +# saveRDS(comb_sr_elev_res, +# file = file.path(path_comb_gpm_sr_res, +# paste0("ki_hyperspec_biodiv_non_scaled", +# gsub("[*]", "", paste0("_", mt, "_", pt, "_res.rds"))))) +# 1st version - not used anymore # Compile elevation residuals for pls model using elevation and LUI as only predictor -pt = "*elui*" -mt = "*pls*" - -comb_sr = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) -comb_sr_elev_res = compResData(comb_sr, pt, mt) - -saveRDS(comb_sr_elev_res, - file = file.path(path_comb_gpm_sr_res, - paste0("ki_hyperspec_biodiv_non_scaled", - gsub("[*]", "", paste0("_", mt, "_", pt, "_res.rds"))))) +# pt = "*elui*" +# mt = "*pls*" +# +# comb_sr = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) +# comb_sr_elev_res = compResData(comb_sr, pt, mt) +# +# saveRDS(comb_sr_elev_res, +# file = file.path(path_comb_gpm_sr_res, +# paste0("ki_hyperspec_biodiv_non_scaled", +# gsub("[*]", "", paste0("_", mt, "_", pt, "_res.rds"))))) diff --git a/src/310_predict_biodiv_sr_res_rf.R b/src/310_predict_biodiv_sr_res_rf.R index 0d89baf..4446afd 100644 --- a/src/310_predict_biodiv_sr_res_rf.R +++ b/src/310_predict_biodiv_sr_res_rf.R @@ -1,13 +1,13 @@ # comb_elev_resine hyperspectral predictores and biodiversity variables in gpm class. if(Sys.info()["sysname"] == "Windows"){ - filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" + filepath_base = "C:/Users/Thomas Nauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" } else { filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" } source(filepath_base) if(length(showConnections()) == 0){ - cores = 20 + cores = 30 cl = parallel::makeCluster(cores) doParallel::registerDoParallel(cl) } @@ -16,19 +16,29 @@ dir.create(paste0(path_model_gpm_sr_res), showWarnings = FALSE) # Predict gam, pls and rf elevation and elevation/lui based residuals using # pls and rf models with hyperspectral data only -res_suffixes = c("_gam_elev_res", "_pls_elui_res", "_rf_elui_res") -res_suffixes = c("_pls_elui_res", "_rf_elui_res") -mtypes = c("pls", "rf") +# res_suffixes = c("_gam_elev_res", "_pls_elui_res", "_rf_elui_res") +res_suffixes = c("_rf_elui_res") +# mtypes = c("pls", "rf") mtypes = c("rf") -pt = "*spec*" +ptypes = c("*spec*", "*kmra*") for(res_suffix in res_suffixes){ comb_elev_res = readRDS(paste0(path_comb_gpm_sr_res, "ki_hyperspec_biodiv_non_scaled", res_suffix, ".rds")) - comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR[-c(1:7)] for(mt in mtypes){ - compModels(model = comb_elev_res, pt = pt, mt = mt, outpath = path_model_gpm_sr_res) + for(pt in ptypes){ + + if(pt == "*spec*"){ + comb_elev_res@meta$input$PREDICTOR_FINAL = comb_elev_res@meta$input$PREDICTOR[-c(1,2)] + } else if(pt == "*kmra*"){ + comb_elev_res@meta$input$PREDICTOR_FINAL = unique(comb_elev_res@meta$input$PREDICTOR[ + c(grep("kmdc", comb_elev_res@meta$input$PREDICTOR), + grep("raoq", comb_elev_res@meta$input$PREDICTOR))]) + } + + compModels(model = comb_elev_res, pt = pt, mt = mt, outpath = path_model_gpm_sr_res) + } } } diff --git a/src/400_compile_analyse_biodiv_sr.R b/src/400_compile_analyse_biodiv_sr.R index d47b0eb..387b045 100644 --- a/src/400_compile_analyse_biodiv_sr.R +++ b/src/400_compile_analyse_biodiv_sr.R @@ -1,5 +1,5 @@ # Combine species richness model results in one variable. -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +source("C:/Users/Thomas Nauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") dir.create(path_compile_analysis_sr, showWarnings = FALSE) @@ -7,6 +7,7 @@ dir.create(path_compile_analysis_sr, showWarnings = FALSE) # Combine all models into one gpm object mtypes = c("*gam*", "*pls*", "*rf*") +mtypes = c("*rf*") all_models = lapply(mtypes, function(mt){ if(mt == "*gam*"){ @@ -33,3 +34,5 @@ names(all_models) = gsub("[*]", "", gsub("_", "", mtypes)) saveRDS(all_models, file = file.path(path_compile_analysis_sr, "models_sr.rds")) + + From 69e83ff3560f752668f1700f66b5d79ceb70ba17 Mon Sep 17 00:00:00 2001 From: Thomas Nauss Date: Sun, 14 Apr 2019 15:09:58 +0200 Subject: [PATCH 51/65] Rearrange numbering and add independent validation --- src/000_set_environment.R | 11 +++--- src/000_set_environment_linux.R | 11 +++--- src/001_functions.R | 24 ++++++++---- ...div_sr_rf.R => 110_predict_biodiv_sr_rf.R} | 0 ...v_sr.R => 120_compile_analyse_biodiv_sr.R} | 2 +- ...combine_predictores_biodiv_sr_residuals.R} | 0 ...es_rf.R => 210_predict_biodiv_sr_res_rf.R} | 0 ... 220_compile_analyse_biodiv_sr_elev_res.R} | 0 src/300_prepare_indp_prediction_biodiv_sr.R | 38 +++++++++++++++++++ ...d_120_combine_predictores_biodiv_tlevel.R} | 0 10 files changed, 67 insertions(+), 19 deletions(-) rename src/{200_predict_biodiv_sr_rf.R => 110_predict_biodiv_sr_rf.R} (100%) rename src/{400_compile_analyse_biodiv_sr.R => 120_compile_analyse_biodiv_sr.R} (96%) rename src/{300_combine_predictores_biodiv_sr_residuals.R => 200_combine_predictores_biodiv_sr_residuals.R} (100%) rename src/{310_predict_biodiv_sr_res_rf.R => 210_predict_biodiv_sr_res_rf.R} (100%) rename src/{410_compile_analyse_biodiv_sr_elev_res.R => 220_compile_analyse_biodiv_sr_elev_res.R} (100%) create mode 100644 src/300_prepare_indp_prediction_biodiv_sr.R rename src/{120_combine_predictores_biodiv_tlevel.R => old_120_combine_predictores_biodiv_tlevel.R} (100%) diff --git a/src/000_set_environment.R b/src/000_set_environment.R index 642c4ca..2818a9c 100644 --- a/src/000_set_environment.R +++ b/src/000_set_environment.R @@ -18,11 +18,12 @@ path_hyp_raoq = paste0(path_data, "/060_hypspec_raoq/") path_hyp_glcm = paste0(path_data, "/070_hypspec_glcm/") path_hyp_pred = paste0(path_data, "/090_hypspec_pred/") path_comb_gpm_sr = paste0(path_data, "/100_comb_gpm_sr/") -path_model_gpm_sr = paste0(path_data, "/200_model_gpm_sr/") -path_comb_gpm_sr_res = paste0(path_data, "/300_comb_gpm_sr_res/") -path_model_gpm_sr_res = paste0(path_data, "/310_model_gpm_sr_res/") -path_compile_analysis_sr = paste0(path_data, "/400_compile_analysis_sr/") -path_compile_analysis_sr_elev_res = paste0(path_data, "/410_compile_analysis_sr_elev_res/") +path_model_gpm_sr = paste0(path_data, "/110_model_gpm_sr/") +path_compile_analysis_sr = paste0(path_data, "/120_compile_analysis_sr/") +path_comb_gpm_sr_res = paste0(path_data, "/200_comb_gpm_sr_res/") +path_model_gpm_sr_res = paste0(path_data, "/210_model_gpm_sr_res/") +path_compile_analysis_sr_elev_res = paste0(path_data, "/220_compile_analysis_sr_elev_res/") +path_comb_gpm_sr_indp = paste0(path_data, "/300_comb_gpm_sr_indp/") path_analysis_sr = paste0(path_data, "/500_analysis_sr/") path_analysis_sr_elev_res = paste0(path_data, "/510_analysis_sr_elev_res/") diff --git a/src/000_set_environment_linux.R b/src/000_set_environment_linux.R index 6166656..4b825bf 100644 --- a/src/000_set_environment_linux.R +++ b/src/000_set_environment_linux.R @@ -18,11 +18,12 @@ path_hyp_raoq = paste0(path_data, "/060_hypspec_raoq/") path_hyp_glcm = paste0(path_data, "/070_hypspec_glcm/") path_hyp_pred = paste0(path_data, "/090_hypspec_pred/") path_comb_gpm_sr = paste0(path_data, "/100_comb_gpm_sr/") -path_model_gpm_sr = paste0(path_data, "/200_model_gpm_sr/") -path_comb_gpm_sr_res = paste0(path_data, "/300_comb_gpm_sr_res/") -path_model_gpm_sr_res = paste0(path_data, "/310_model_gpm_sr_res/") -path_compile_analysis_sr = paste0(path_data, "/400_compile_analysis_sr/") -path_compile_analysis_sr_elev_res = paste0(path_data, "/410_compile_analysis_sr_elev_res/") +path_model_gpm_sr = paste0(path_data, "/110_model_gpm_sr/") +path_compile_analysis_sr = paste0(path_data, "/120_compile_analysis_sr/") +path_comb_gpm_sr_res = paste0(path_data, "/200_comb_gpm_sr_res/") +path_model_gpm_sr_res = paste0(path_data, "/210_model_gpm_sr_res/") +path_compile_analysis_sr_elev_res = paste0(path_data, "/220_compile_analysis_sr_elev_res/") +path_comb_gpm_sr_indp = paste0(path_data, "/300_comb_gpm_sr_indp/") path_analysis_sr = paste0(path_data, "/500_analysis_sr/") path_analysis_sr_elev_res = paste0(path_data, "/510_analysis_sr_elev_res/") diff --git a/src/001_functions.R b/src/001_functions.R index 73e6378..cad4e57 100644 --- a/src/001_functions.R +++ b/src/001_functions.R @@ -74,33 +74,41 @@ compResData = function(comb_sr, pt, mt){ # Train and tune models -------------------------------------------------------- -compModels = function(model, pt, mt, outpath){ +compModels = function(model, pt, mt, rs = NULL, outpath, nested_cv = FALSE){ foreach (i = seq(length(model@meta$input$RESPONSE)), .packages = c("gpm", "caret", "randomForest", "CAST")) %dopar% { model@meta$input$RESPONSE_FINAL = model@meta$input$RESPONSE[i] model@data$input = model@data$input[complete.cases(model@data$input[, c(model@meta$input$RESPONSE_FINAL, model@meta$input$PREDICTOR_FINAL)]), ] - if(length(model@meta$input$PREDICTOR_FINAL) < 3){ - mode = "none" + if(length(model@meta$input$PREDICTOR_FINAL) < 3 | !is.null(rs)){ + var_mode = "none" } else { - mode = "ffs" + var_mode = "ffs" } if(nrow(model@data$input) > 0){ - model = createIndexFolds(x = model, nested_cv = FALSE) + model = createIndexFolds(x = model, nested_cv = nested_cv) model = trainModel(x = model, metric = "RMSE", n_var = NULL, mthd = mt, - mode = mode, + mode = var_mode, seed_nbr = 11, cv_nbr = NULL, var_selection = "indv", filepath_tmp = NULL) } - outfile_name = gsub("[*]", "", paste0(outpath, + if(is.null(rs)){ + outfile_name = gsub("[*]", "", paste0(outpath, "ki_sr_", pt, "_non_scaled_", mt, "_", model@meta$input$RESPONSE_FINAL, ".rds")) + } else { + outfile_name = gsub("[*]", "", paste0(outpath, + "ki_sr_", pt, "_non_scaled_", mt, "_", + model@meta$input$RESPONSE_FINAL, + "_iv.rds")) + } + print(outfile_name) saveRDS(model, file = outfile_name) } @@ -155,7 +163,7 @@ modelPerformance = function(model){ # Compile two step prediction datasets ----------------------------------------- comp2StepPred = function(comb_sr_two_step, model, model_res){ - + smr = lapply(seq(length(model)), function(i){ mi = model[[i]][[1]] mi_res = model_res[[i]][[1]] diff --git a/src/200_predict_biodiv_sr_rf.R b/src/110_predict_biodiv_sr_rf.R similarity index 100% rename from src/200_predict_biodiv_sr_rf.R rename to src/110_predict_biodiv_sr_rf.R diff --git a/src/400_compile_analyse_biodiv_sr.R b/src/120_compile_analyse_biodiv_sr.R similarity index 96% rename from src/400_compile_analyse_biodiv_sr.R rename to src/120_compile_analyse_biodiv_sr.R index 387b045..53ecd31 100644 --- a/src/400_compile_analyse_biodiv_sr.R +++ b/src/120_compile_analyse_biodiv_sr.R @@ -6,7 +6,7 @@ dir.create(path_compile_analysis_sr, showWarnings = FALSE) # Combine all models into one gpm object -mtypes = c("*gam*", "*pls*", "*rf*") +# mtypes = c("*gam*", "*pls*", "*rf*") mtypes = c("*rf*") all_models = lapply(mtypes, function(mt){ diff --git a/src/300_combine_predictores_biodiv_sr_residuals.R b/src/200_combine_predictores_biodiv_sr_residuals.R similarity index 100% rename from src/300_combine_predictores_biodiv_sr_residuals.R rename to src/200_combine_predictores_biodiv_sr_residuals.R diff --git a/src/310_predict_biodiv_sr_res_rf.R b/src/210_predict_biodiv_sr_res_rf.R similarity index 100% rename from src/310_predict_biodiv_sr_res_rf.R rename to src/210_predict_biodiv_sr_res_rf.R diff --git a/src/410_compile_analyse_biodiv_sr_elev_res.R b/src/220_compile_analyse_biodiv_sr_elev_res.R similarity index 100% rename from src/410_compile_analyse_biodiv_sr_elev_res.R rename to src/220_compile_analyse_biodiv_sr_elev_res.R diff --git a/src/300_prepare_indp_prediction_biodiv_sr.R b/src/300_prepare_indp_prediction_biodiv_sr.R new file mode 100644 index 0000000..60d6294 --- /dev/null +++ b/src/300_prepare_indp_prediction_biodiv_sr.R @@ -0,0 +1,38 @@ +# Recompute models using best variable subset and completely independent validation + +# Predict species richness using different models and predictor sets +if(Sys.info()["sysname"] == "Windows"){ + filepath_base = "C:/Users/Thomas Nauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" +} else { + filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" +} +source(filepath_base) + +if(length(showConnections()) == 0){ + cores = 3 + cl = parallel::makeCluster(cores) + doParallel::registerDoParallel(cl) +} + +dir.create(path_comb_gpm_sr_indp, showWarnings = FALSE) + +all_models = readRDS(file.path(path_compile_analysis_sr, "models_sr.rds"))[["rf"]] + +mt = "rf" + +# Predict variables again using best predictors and independent validation. +for(pt in names(all_models[[mt]])){ + comb = all_models[[pt]] + var_imp <- compVarImp(comb@model[[1]], scale = FALSE) + + for(rs in seq(length(var_imp))){ + comb@meta$input$RESPONSE = as.character(var_imp[[rs]]$RESPONSE[1]) + comb@meta$input$PREDICTOR_FINAL = var_imp[[rs]]$VARIABLE + + compModels(model = comb, pt = pt, mt = mt, rs = rs, outpath = path_comb_gpm_sr_indp, nested_cv = TRUE) + } +} + + +stopCluster(cl) + diff --git a/src/120_combine_predictores_biodiv_tlevel.R b/src/old_120_combine_predictores_biodiv_tlevel.R similarity index 100% rename from src/120_combine_predictores_biodiv_tlevel.R rename to src/old_120_combine_predictores_biodiv_tlevel.R From 3aa1174847fc48ac0f634622b8a0f9a2a0d5e0e0 Mon Sep 17 00:00:00 2001 From: Thomas Nauss Date: Sun, 14 Apr 2019 15:12:25 +0200 Subject: [PATCH 52/65] Bugfix --- src/300_prepare_indp_prediction_biodiv_sr.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/300_prepare_indp_prediction_biodiv_sr.R b/src/300_prepare_indp_prediction_biodiv_sr.R index 60d6294..05b458f 100644 --- a/src/300_prepare_indp_prediction_biodiv_sr.R +++ b/src/300_prepare_indp_prediction_biodiv_sr.R @@ -16,7 +16,7 @@ if(length(showConnections()) == 0){ dir.create(path_comb_gpm_sr_indp, showWarnings = FALSE) -all_models = readRDS(file.path(path_compile_analysis_sr, "models_sr.rds"))[["rf"]] +all_models = readRDS(file.path(path_compile_analysis_sr, "models_sr.rds")) mt = "rf" From e2ac8630cf77fe9749860ecefd007bf48f268a5c Mon Sep 17 00:00:00 2001 From: Thomas Nauss Date: Sun, 14 Apr 2019 15:14:04 +0200 Subject: [PATCH 53/65] Another bugfix --- src/300_prepare_indp_prediction_biodiv_sr.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/300_prepare_indp_prediction_biodiv_sr.R b/src/300_prepare_indp_prediction_biodiv_sr.R index 05b458f..df2fc4f 100644 --- a/src/300_prepare_indp_prediction_biodiv_sr.R +++ b/src/300_prepare_indp_prediction_biodiv_sr.R @@ -22,7 +22,7 @@ mt = "rf" # Predict variables again using best predictors and independent validation. for(pt in names(all_models[[mt]])){ - comb = all_models[[pt]] + comb = all_models[[mt]][[pt]] var_imp <- compVarImp(comb@model[[1]], scale = FALSE) for(rs in seq(length(var_imp))){ From 047caf9781fd59c8bf19695b8b83315599b414fa Mon Sep 17 00:00:00 2001 From: Thomas Nauss Date: Sun, 14 Apr 2019 15:16:53 +0200 Subject: [PATCH 54/65] Another bugfix --- src/300_prepare_indp_prediction_biodiv_sr.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/300_prepare_indp_prediction_biodiv_sr.R b/src/300_prepare_indp_prediction_biodiv_sr.R index df2fc4f..cfad1e4 100644 --- a/src/300_prepare_indp_prediction_biodiv_sr.R +++ b/src/300_prepare_indp_prediction_biodiv_sr.R @@ -27,7 +27,7 @@ for(pt in names(all_models[[mt]])){ for(rs in seq(length(var_imp))){ comb@meta$input$RESPONSE = as.character(var_imp[[rs]]$RESPONSE[1]) - comb@meta$input$PREDICTOR_FINAL = var_imp[[rs]]$VARIABLE + comb@meta$input$PREDICTOR_FINAL = as.character(var_imp[[rs]]$VARIABLE) compModels(model = comb, pt = pt, mt = mt, rs = rs, outpath = path_comb_gpm_sr_indp, nested_cv = TRUE) } From 3732575659225bed227253685c05af52485dbafd Mon Sep 17 00:00:00 2001 From: Thomas Nauss Date: Sun, 14 Apr 2019 18:12:59 +0200 Subject: [PATCH 55/65] Add residual predictions with independent test --- src/000_set_environment.R | 4 +- src/000_set_environment_linux.R | 4 +- src/001_functions.R | 8 ++-- ...v_sr.R => 300_predict_biodiv_sr_rf_indp.R} | 4 +- ...ine_predictores_biodiv_sr_residuals_indp.R | 25 +++++++++++ src/320_predict_biodiv_sr_rf_indp.R | 41 +++++++++++++++++++ 6 files changed, 78 insertions(+), 8 deletions(-) rename src/{300_prepare_indp_prediction_biodiv_sr.R => 300_predict_biodiv_sr_rf_indp.R} (91%) create mode 100644 src/310_combine_predictores_biodiv_sr_residuals_indp.R create mode 100644 src/320_predict_biodiv_sr_rf_indp.R diff --git a/src/000_set_environment.R b/src/000_set_environment.R index 2818a9c..6db065b 100644 --- a/src/000_set_environment.R +++ b/src/000_set_environment.R @@ -23,7 +23,9 @@ path_compile_analysis_sr = paste0(path_data, "/120_compile_analysis_sr/") path_comb_gpm_sr_res = paste0(path_data, "/200_comb_gpm_sr_res/") path_model_gpm_sr_res = paste0(path_data, "/210_model_gpm_sr_res/") path_compile_analysis_sr_elev_res = paste0(path_data, "/220_compile_analysis_sr_elev_res/") -path_comb_gpm_sr_indp = paste0(path_data, "/300_comb_gpm_sr_indp/") +path_model_gpm_sr_indp = paste0(path_data, "/300_model_gpm_sr_indp/") +path_comb_gpm_sr_elev_res_indp = paste0(path_data, "/310_comb_gpm_sr_elev_res_indp/") +path_model_gpm_sr_elev_res_indp = paste0(path_data, "/320_model_gpm_sr_elev_res_indp/") path_analysis_sr = paste0(path_data, "/500_analysis_sr/") path_analysis_sr_elev_res = paste0(path_data, "/510_analysis_sr_elev_res/") diff --git a/src/000_set_environment_linux.R b/src/000_set_environment_linux.R index 4b825bf..2df7b57 100644 --- a/src/000_set_environment_linux.R +++ b/src/000_set_environment_linux.R @@ -23,7 +23,9 @@ path_compile_analysis_sr = paste0(path_data, "/120_compile_analysis_sr/") path_comb_gpm_sr_res = paste0(path_data, "/200_comb_gpm_sr_res/") path_model_gpm_sr_res = paste0(path_data, "/210_model_gpm_sr_res/") path_compile_analysis_sr_elev_res = paste0(path_data, "/220_compile_analysis_sr_elev_res/") -path_comb_gpm_sr_indp = paste0(path_data, "/300_comb_gpm_sr_indp/") +path_model_gpm_sr_indp = paste0(path_data, "/300_model_gpm_sr_indp/") +path_comb_gpm_sr_elev_res_indp = paste0(path_data, "/310_comb_gpm_sr_elev_res_indp/") +path_model_gpm_sr_elev_res_indp = paste0(path_data, "/320_model_gpm_sr_elev_res_indp/") path_analysis_sr = paste0(path_data, "/500_analysis_sr/") path_analysis_sr_elev_res = paste0(path_data, "/510_analysis_sr_elev_res/") diff --git a/src/001_functions.R b/src/001_functions.R index cad4e57..f9f30ef 100644 --- a/src/001_functions.R +++ b/src/001_functions.R @@ -35,9 +35,9 @@ compPredictions = function(model, input){ # Compile residual datasets ---------------------------------------------------- -compResData = function(comb_sr, pt, mt){ +compResData = function(comb_sr, pt, mt, model_path = path_model_gpm_sr, suf = "_res"){ comb_sr_elev_res = comb_sr - model_files = list.files(path_model_gpm_sr, full.names = TRUE, + model_files = list.files(model_path, full.names = TRUE, pattern = glob2rx(paste0(pt, mt))) for(m in model_files){ @@ -60,12 +60,12 @@ compResData = function(comb_sr, pt, mt){ colname_pos = grep(act_model$response, colnames(comb_sr_elev_res@data$input)) colnames(comb_sr_elev_res@data$input)[colname_pos] = paste0(colnames(comb_sr_elev_res@data$input)[colname_pos], - gsub("[*]", "", paste0("_", mt, "_", pt, "_res"))) + gsub("[*]", "", paste0("_", mt, "_", pt, suf))) } comb_sr_elev_res@meta$input$RESPONSE = paste0(comb_sr_elev_res@meta$input$RESPONSE, - gsub("[*]", "", paste0("_", mt, "_", pt, "_res"))) + gsub("[*]", "", paste0("_", mt, "_", pt, suf))) comb_sr_elev_res@meta$input$RESPONSE_FINAL = comb_sr_elev_res@meta$input$RESPONSE return(comb_sr_elev_res) diff --git a/src/300_prepare_indp_prediction_biodiv_sr.R b/src/300_predict_biodiv_sr_rf_indp.R similarity index 91% rename from src/300_prepare_indp_prediction_biodiv_sr.R rename to src/300_predict_biodiv_sr_rf_indp.R index cfad1e4..0a0b7ef 100644 --- a/src/300_prepare_indp_prediction_biodiv_sr.R +++ b/src/300_predict_biodiv_sr_rf_indp.R @@ -14,7 +14,7 @@ if(length(showConnections()) == 0){ doParallel::registerDoParallel(cl) } -dir.create(path_comb_gpm_sr_indp, showWarnings = FALSE) +dir.create(path_model_gpm_sr_indp, showWarnings = FALSE) all_models = readRDS(file.path(path_compile_analysis_sr, "models_sr.rds")) @@ -29,7 +29,7 @@ for(pt in names(all_models[[mt]])){ comb@meta$input$RESPONSE = as.character(var_imp[[rs]]$RESPONSE[1]) comb@meta$input$PREDICTOR_FINAL = as.character(var_imp[[rs]]$VARIABLE) - compModels(model = comb, pt = pt, mt = mt, rs = rs, outpath = path_comb_gpm_sr_indp, nested_cv = TRUE) + compModels(model = comb, pt = pt, mt = mt, rs = rs, outpath = path_model_gpm_sr_indp, nested_cv = TRUE) } } diff --git a/src/310_combine_predictores_biodiv_sr_residuals_indp.R b/src/310_combine_predictores_biodiv_sr_residuals_indp.R new file mode 100644 index 0000000..b99290f --- /dev/null +++ b/src/310_combine_predictores_biodiv_sr_residuals_indp.R @@ -0,0 +1,25 @@ +# Compile species richness dataset containing residuals from some previous modelling +if(Sys.info()["sysname"] == "Windows"){ + filepath_base = "C:/Users/Thomas Nauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" +} else { + filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" +} + +source(filepath_base) + + +dir.create(paste0(path_comb_gpm_sr_res), showWarnings = FALSE) + +# Compile elevation residuals for rf model using elevation and LUI as only predictor +pt = "*elui*" +mt = "*rf*" +suf = "_res_indp" + +comb_sr = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) +comb_sr_elev_res = compResData(comb_sr, pt, mt, model_path = path_model_gpm_sr_indp, suf = suf) + +saveRDS(comb_sr_elev_res, + file = file.path(path_comb_gpm_sr_elev_res_indp, + paste0("ki_hyperspec_biodiv_non_scaled", + gsub("[*]", "", paste0("_", mt, "_", pt, suf, ".rds"))))) + diff --git a/src/320_predict_biodiv_sr_rf_indp.R b/src/320_predict_biodiv_sr_rf_indp.R new file mode 100644 index 0000000..75c5141 --- /dev/null +++ b/src/320_predict_biodiv_sr_rf_indp.R @@ -0,0 +1,41 @@ +# Recompute elevation residual models using best variable subset and completely independent validation + +# Predict species richness using different models and predictor sets +if(Sys.info()["sysname"] == "Windows"){ + filepath_base = "C:/Users/Thomas Nauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" +} else { + filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" +} +source(filepath_base) + +if(length(showConnections()) == 0){ + cores = 3 + cl = parallel::makeCluster(cores) + doParallel::registerDoParallel(cl) +} + +dir.create(path_model_gpm_sr_elev_res_indp, showWarnings = FALSE) + +elev_res_indp = readRDS(file.path(path_comb_gpm_sr_elev_res_indp, "ki_hyperspec_biodiv_non_scaled_rf_elui_res_indp.rds")) +all_models_res = readRDS(file.path(path_compile_analysis_sr_elev_res, + "models_sr_elev_res.rds")) + +mt = "rf" + +# Predict variables again using best predictors and independent validation. +for(pt in names(all_models_res[[mt]])){ + comb_res = all_models_res[[mt]][[pt]] + var_imp <- compVarImp(comb_res@model[[1]], scale = FALSE) + com_res_indp = elev_res_indp + + for(rs in seq(length(var_imp))){ + com_res_indp@meta$input$RESPONSE = paste0(as.character(var_imp[[rs]]$RESPONSE[1]), "_indp") + com_res_indp@meta$input$PREDICTOR_FINAL = as.character(var_imp[[rs]]$VARIABLE) + + compModels(model = com_res_indp, pt = pt, mt = mt, rs = rs, outpath = path_model_gpm_sr_elev_res_indp, nested_cv = TRUE) + } +} + + +stopCluster(cl) + From 640959ef94fb630a55839048999cbce629d69e21 Mon Sep 17 00:00:00 2001 From: "Nauss, Thomas" Date: Mon, 9 Dec 2019 08:09:22 +0100 Subject: [PATCH 56/65] Update --- src/000_set_environment_linux.R | 1 + src/000_setup_windows.R | 28 ++++++++++++++++++++++++++ src/500_analyse_biodiv_sr.nb.html | 30 ++++++++++++++-------------- src/{src.Rproj => specVisKili.Rproj} | 0 4 files changed, 44 insertions(+), 15 deletions(-) create mode 100644 src/000_setup_windows.R rename src/{src.Rproj => specVisKili.Rproj} (100%) diff --git a/src/000_set_environment_linux.R b/src/000_set_environment_linux.R index 2df7b57..7f27482 100644 --- a/src/000_set_environment_linux.R +++ b/src/000_set_environment_linux.R @@ -29,6 +29,7 @@ path_model_gpm_sr_elev_res_indp = paste0(path_data, "/320_model_gpm_sr_elev_res_ path_analysis_sr = paste0(path_data, "/500_analysis_sr/") path_analysis_sr_elev_res = paste0(path_data, "/510_analysis_sr_elev_res/") + path_plots = paste0(path_data, "/plots/") path_rdata = paste0(path_data, "/rdata/") path_meta = paste0(path_data, "/meta/") diff --git a/src/000_setup_windows.R b/src/000_setup_windows.R new file mode 100644 index 0000000..4f626ae --- /dev/null +++ b/src/000_setup_windows.R @@ -0,0 +1,28 @@ +# Set environment for environmental information systems analysis + +root_folder = path.expand("~/analysis/globalTreeWater/") +fcts_folder = file.path(root_folder, "EI-GlobalTreeWater/src/functions/") + +project_folders = c("data/", + "data/biomass_2010_gsv/", + "data/ecoregions/", + "data/gee_landcover_rainfall/", + "data/graphics/", + "data/maped_datasets/", + "data/rds_data/", + "data/tree_water_content/", + "data/tmp/") + +libs = c("colorspace", "gdalUtils", "ggplot2", "maptools", "mapview", "raster", "RColorBrewer", "rgdal", "sp", "sf", "tmap") + +envrmt = createEnvi(root_folder = root_folder, + fcts_folder = fcts_folder, + folders = project_folders, + path_prefix = "path_", libs = libs, + alt_env_id = "COMPUTERNAME", alt_env_value = "PCRZP", + alt_env_root_folder = "F:\\BEN\\edu") + +# More settings +rasterOptions(tmpdir = envrmt$path_tmp) +mapviewOptions(basemaps = mapviewGetOption("basemaps")[c(3, 1:2, 4:5)]) + diff --git a/src/500_analyse_biodiv_sr.nb.html b/src/500_analyse_biodiv_sr.nb.html index 3cb1b54..80b35d2 100644 --- a/src/500_analyse_biodiv_sr.nb.html +++ b/src/500_analyse_biodiv_sr.nb.html @@ -182,7 +182,7 @@

500 Analyse Biodiv-RS

Compare PLS and RF

- +

@@ -196,18 +196,18 @@

Compare PLS and RF

Check performance of PLS and RF

- -
[1] "elui"
+
+
[1] \elui\
  [1] ptype           resp            Resample        mtype_pls       ncomp           nvars_pls       RMSE_pls       
  [8] Rsquared_pls    MAE_pls         RMSE_normSD_pls Level_pls       mtype_rf        mtry            nvars_rf       
 [15] RMSE_rf         Rsquared_rf     MAE_rf          RMSE_normSD_rf  Level_rf       
-<0 Zeilen> (oder row.names mit Länge 0)
+<0 Zeilen> (oder row.names mit Länge 0)
 RMSE (1 - PLS/RF):  
 Var number (RF/PLS):  
 Levels with PLS is better: 0 0 0 0 0 0 
 
 
-[1] "kmra"
+[1] \kmra\
     ptype       resp Resample mtype_pls ncomp nvars_pls RMSE_pls Rsquared_pls  MAE_pls RMSE_normSD_pls  Level_pls mtype_rf mtry
 241  kmra SRasterids     Mean       pls     8        14 4.379693    0.5013369 3.558558       0.7824208     Plants       rf    6
 305  kmra    SRferns     Mean       pls    11        12 4.701912    0.7137181 3.686251       0.5388445     Plants       rf    2
@@ -223,7 +223,7 @@ 

Check performance of PLS and RF

Levels with PLS is better: 0 0 0 0 1 3 -[1] "spec" +[1] \spec\ ptype resp Resample mtype_pls ncomp nvars_pls RMSE_pls Rsquared_pls MAE_pls RMSE_normSD_pls 433 spec SRallplants Mean pls 10 20 12.1677951 0.6404985 9.8793737 0.6038114 449 spec SRants Mean pls 16 23 1.1402304 0.8933173 0.9233010 0.3360080 @@ -255,7 +255,7 @@

Check performance of PLS and RF

Levels with PLS is better: 1 1 1 2 3 4 -[1] "elsp" +[1] \elsp\ ptype resp Resample mtype_pls ncomp nvars_pls RMSE_pls Rsquared_pls MAE_pls RMSE_normSD_pls Level_pls 649 elsp SRallplants Mean pls 12 21 9.762681 0.7556949 7.467871 0.4804236 Plants 673 elsp SRasterids Mean pls 15 25 3.880332 0.5859014 3.304183 0.6880815 Plants @@ -279,12 +279,12 @@

Collect variable importance

Number of variables

- -
pls_rf_sr_long = melt(pls_rf_sr[pls_rf_sr$Resample == "Mean", c(1, 2, 6, 13)], id.vars = c("ptype", "resp"))
-
+ +

rr pls_rf_sr_long = melt(pls_rf_sr[pls_rf_sr$Resample == , c(1, 2, 6, 13)], id.vars = c(, ))

+
- -
Error in melt(pls_rf_sr[pls_rf_sr$Resample == "Mean", c(1, 2, 6, 13)],  : 
+
+
Error in melt(pls_rf_sr[pls_rf_sr$Resample == \Mean\, c(1, 2, 6, 13)],  : 
   object 'pls_rf_sr' not found
@@ -295,7 +295,7 @@

Number of variables

Variable importance for PLS

- +

@@ -305,7 +305,7 @@

Variable importance for PLS

Variable importance for RF

- +

@@ -315,7 +315,7 @@

Variable importance for RF

Trophic levels

- +

diff --git a/src/src.Rproj b/src/specVisKili.Rproj similarity index 100% rename from src/src.Rproj rename to src/specVisKili.Rproj From 4c8c0867601bd80e84c588f0746fc3ec1fee1aef Mon Sep 17 00:00:00 2001 From: Thomas Nauss Date: Tue, 16 Jun 2020 15:35:04 +0200 Subject: [PATCH 57/65] Update --- src/000_set_environment.R | 2 +- src/000_setup_windows.R | 50 ++++++++++++++----- src/120_compile_analyse_biodiv_sr.R | 3 +- src/500_analyse_biodiv_sr.Rmd | 10 ++-- src/500_analyse_biodiv_sr.nb.html | 11 ++-- src/510_analyse_biodiv_sr_elev_res.Rmd | 7 ++- src/510_analyse_biodiv_sr_elev_res.nb.html | 34 +++++-------- src/{ => functions}/001_functions.R | 0 ...{specVisKili.Rproj => hySpecVisKili.Rproj} | 0 9 files changed, 67 insertions(+), 50 deletions(-) rename src/{ => functions}/001_functions.R (100%) rename src/{specVisKili.Rproj => hySpecVisKili.Rproj} (100%) diff --git a/src/000_set_environment.R b/src/000_set_environment.R index 6db065b..4ae145d 100644 --- a/src/000_set_environment.R +++ b/src/000_set_environment.R @@ -74,6 +74,6 @@ rasterOptions(tmpdir = path_temp) saga_cmd = "C:/OSGeo4W64/apps/saga-ltr/saga_cmd.exe" # initOTB("C:/OSGeo4W64/bin/") -initOTB("C:/OSGeo4W64/OTB-6.2.0-Win64/bin/") +# initOTB("C:/OSGeo4W64/OTB-6.2.0-Win64/bin/") diff --git a/src/000_setup_windows.R b/src/000_setup_windows.R index 4f626ae..2a3e6bd 100644 --- a/src/000_setup_windows.R +++ b/src/000_setup_windows.R @@ -1,19 +1,41 @@ # Set environment for environmental information systems analysis +require(envimaR) -root_folder = path.expand("~/analysis/globalTreeWater/") -fcts_folder = file.path(root_folder, "EI-GlobalTreeWater/src/functions/") +root_folder = path.expand("~/plygrnd/hySpecVisKili/") +fcts_folder = file.path(root_folder, "hySpecVisKili/src/functions/") project_folders = c("data/", - "data/biomass_2010_gsv/", - "data/ecoregions/", - "data/gee_landcover_rainfall/", - "data/graphics/", - "data/maped_datasets/", - "data/rds_data/", - "data/tree_water_content/", - "data/tmp/") + "data/biodiv", + "data/020_hypspec_org/", + "data/025_hypspec_aio/", + "data/030_hypspec_nrm/", + "data/040_hypspec_vegidcs/", + "data/050_hypspec_kmdc/", + "data/060_hypspec_raoq/", + "data/070_hypspec_glcm/", + "data/090_hypspec_pred/", + "data/100_comb_gpm_sr/", + "data/110_model_gpm_sr/", + "data/120_compile_analysis_sr/", + "data/200_comb_gpm_sr_res/", + "data/210_model_gpm_sr_res/", + "data/220_compile_analysis_sr_elev_res/", + "data/300_model_gpm_sr_indp/", + "data/310_comb_gpm_sr_elev_res_indp/", + "data/320_model_gpm_sr_elev_res_indp/", + "data/500_analysis_sr/", + "data/510_analysis_sr_elev_res/", + "data/plots/", + "data/rdata/", + "data/meta/", + "data/output/", + "data/vis/", + "data/temp/") -libs = c("colorspace", "gdalUtils", "ggplot2", "maptools", "mapview", "raster", "RColorBrewer", "rgdal", "sp", "sf", "tmap") +libs = c("biodivTools", "CAST", "corrplot", "doParallel", "grid", "gridExtra", + "gpm", "ggplot2", "ggbiplot", "hsdar", "rgeos", "ggplot2", "mapview", + "raster", "RStoolbox", "reshape2", "rgdal", "satelliteTools", "sp", + "spacetime", "vegan") envrmt = createEnvi(root_folder = root_folder, fcts_folder = fcts_folder, @@ -23,6 +45,10 @@ envrmt = createEnvi(root_folder = root_folder, alt_env_root_folder = "F:\\BEN\\edu") # More settings -rasterOptions(tmpdir = envrmt$path_tmp) +rasterOptions(tmpdir = envrmt$path_temp) mapviewOptions(basemaps = mapviewGetOption("basemaps")[c(3, 1:2, 4:5)]) +saga_cmd = "C:/OSGeo4W64/apps/saga-ltr/saga_cmd.exe" +# initOTB("C:/OSGeo4W64/bin/") +initOTB("C:/OSGeo4W64/OTB-6.2.0-Win64/bin/") + diff --git a/src/120_compile_analyse_biodiv_sr.R b/src/120_compile_analyse_biodiv_sr.R index 53ecd31..8f8e36f 100644 --- a/src/120_compile_analyse_biodiv_sr.R +++ b/src/120_compile_analyse_biodiv_sr.R @@ -1,7 +1,8 @@ # Combine species richness model results in one variable. -source("C:/Users/Thomas Nauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +root_folder = path.expand("~/plygrnd/hySpecVisKili/") +source(file.path(root_folder, "hySpecVisKili/src/000_setup_windows.R")) dir.create(path_compile_analysis_sr, showWarnings = FALSE) diff --git a/src/500_analyse_biodiv_sr.Rmd b/src/500_analyse_biodiv_sr.Rmd index 616ea8a..808aee1 100644 --- a/src/500_analyse_biodiv_sr.Rmd +++ b/src/500_analyse_biodiv_sr.Rmd @@ -4,12 +4,12 @@ output: html_notebook --- ```{r, include = FALSE} -source("C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") - -dir.create(path_analysis_sr, showWarnings = FALSE) - -all_models = readRDS(file.path(path_compile_analysis_sr, "models_sr.rds")) +# Set up working environment and defaults -------------------------------------- +root_folder = path.expand("~/plygrnd/hySpecVisKili/") +source(file.path(root_folder, "hySpecVisKili/src/000_setup_windows.R")) +all_models = readRDS(file.path(envrmt$path_120_compile_analysis_sr, + "models_sr.rds")) # Collect model performance gam_sr = modelPerformance(all_models[["gam"]]) diff --git a/src/500_analyse_biodiv_sr.nb.html b/src/500_analyse_biodiv_sr.nb.html index 80b35d2..9b0d2a5 100644 --- a/src/500_analyse_biodiv_sr.nb.html +++ b/src/500_analyse_biodiv_sr.nb.html @@ -196,12 +196,12 @@

Compare PLS and RF

Check performance of PLS and RF

- +
[1] \elui\
  [1] ptype           resp            Resample        mtype_pls       ncomp           nvars_pls       RMSE_pls       
  [8] Rsquared_pls    MAE_pls         RMSE_normSD_pls Level_pls       mtype_rf        mtry            nvars_rf       
 [15] RMSE_rf         Rsquared_rf     MAE_rf          RMSE_normSD_rf  Level_rf       
-<0 Zeilen> (oder row.names mit Länge 0)
+<0 Zeilen> (oder row.names mit Länge 0)
 RMSE (1 - PLS/RF):  
 Var number (RF/PLS):  
 Levels with PLS is better: 0 0 0 0 0 0 
@@ -279,8 +279,9 @@ 

Collect variable importance

Number of variables

- -

rr pls_rf_sr_long = melt(pls_rf_sr[pls_rf_sr$Resample == , c(1, 2, 6, 13)], id.vars = c(, ))

+ +

rr rr pls_rf_sr_long = melt(pls_rf_sr[pls_rf_sr$Resample == , c(1, 2, 6, 13)], id.vars = c(, ))

+
@@ -325,7 +326,7 @@

Trophic levels

-
LS0tDQp0aXRsZTogIjUwMCBBbmFseXNlIEJpb2Rpdi1SUyINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCmBgYHtyLCBpbmNsdWRlID0gRkFMU0V9DQpzb3VyY2UoIkM6L1VzZXJzL3RuYXVzcy9wZXJtYW5lbnQvcGx5Z3JuZC9LSS1IeXBlcnNwZWMvSHlTcGVjX0tpTGkvc3JjLzAwMF9zZXRfZW52aXJvbm1lbnQuUiIpDQoNCmRpci5jcmVhdGUocGF0aF9hbmFseXNpc19zciwgc2hvd1dhcm5pbmdzID0gRkFMU0UpDQoNCmFsbF9tb2RlbHMgPSByZWFkUkRTKGZpbGUucGF0aChwYXRoX2NvbXBpbGVfYW5hbHlzaXNfc3IsICJtb2RlbHNfc3IucmRzIikpDQoNCg0KIyBDb2xsZWN0IG1vZGVsIHBlcmZvcm1hbmNlDQpnYW1fc3IgPSBtb2RlbFBlcmZvcm1hbmNlKGFsbF9tb2RlbHNbWyJnYW0iXV0pDQpwbHNfc3IgPSBtb2RlbFBlcmZvcm1hbmNlKGFsbF9tb2RlbHNbWyJwbHMiXV0pDQpyZl9zciA9IG1vZGVsUGVyZm9ybWFuY2UoYWxsX21vZGVsc1tbInJmIl1dKQ0KDQpzdW1tYXJ5KGdhbV9zcikNCnN1bW1hcnkocGxzX3NyKQ0Kc3VtbWFyeShyZl9zcikNCg0KIyBHZXQgdHJvcGhpYyBsZXZlbHMNCnRsID0gcmVhZC50YWJsZShmaWxlLnBhdGgocGF0aF9tZXRhLCAidHJvcGhpY19sZXZlbHMuY3N2IiksIGhlYWRlciA9IFRSVUUsIHNlcCA9ICI7IikNCmdhbV9zciA9IG1lcmdlKGdhbV9zciwgdGwsIGJ5LnggPSAicmVzcCIsIGJ5LnkgPSAiU3BlY2llcyIpDQpwbHNfc3IgPSBtZXJnZShwbHNfc3IsIHRsLCBieS54ID0gInJlc3AiLCBieS55ID0gIlNwZWNpZXMiKQ0KcmZfc3IgPSBtZXJnZShyZl9zciwgdGwsIGJ5LnggPSAicmVzcCIsIGJ5LnkgPSAiU3BlY2llcyIpDQoNCiMgQXJyYW5nZSBsZXZlbHMgYW5kIHNwZWNpZXMgbmFtZXMNCnBsc19zciRMZXZlbCA9IGZhY3RvcihwbHNfc3IkTGV2ZWwsIGxldmVscyhwbHNfc3IkTGV2ZWwpW2MoMSwgNSwgNCwgMywgNiwgMildICkNCnBsc19zciRyZXNwID0gYXMuY2hhcmFjdGVyKHBsc19zciRyZXNwKQ0KcGxzX3NyJHJlc3AgPSBzdWJzdHIocGxzX3NyJHJlc3AsIDMsIG5jaGFyKHBsc19zciRyZXNwKSkNCnBsc19zciRyZXNwID0gZ3N1YigiKF5bWzphbHBoYTpdXSkiLCAiXFxVXFwxIiwgcGxzX3NyJHJlc3AsIHBlcmw9VFJVRSkNCnBsc19zciRyZXNwID0gZmFjdG9yKHBsc19zciRyZXNwLCB1bmlxdWUocGxzX3NyJHJlc3Bbb3JkZXIocGxzX3NyJExldmVsLCBwbHNfc3IkcmVzcCldKSkNCg0KDQpyZl9zciRMZXZlbCA9IGZhY3RvcihyZl9zciRMZXZlbCwgbGV2ZWxzKHJmX3NyJExldmVsKVtjKDEsIDUsIDQsIDMsIDYsIDIpXSApDQpyZl9zciRyZXNwID0gYXMuY2hhcmFjdGVyKHJmX3NyJHJlc3ApDQpyZl9zciRyZXNwID0gc3Vic3RyKHJmX3NyJHJlc3AsIDMsIG5jaGFyKHJmX3NyJHJlc3ApKQ0KcmZfc3IkcmVzcCA9IGdzdWIoIiheW1s6YWxwaGE6XV0pIiwgIlxcVVxcMSIsIHJmX3NyJHJlc3AsIHBlcmw9VFJVRSkNCnJmX3NyJHJlc3AgPSBmYWN0b3IocmZfc3IkcmVzcCwgdW5pcXVlKHJmX3NyJHJlc3Bbb3JkZXIocmZfc3IkTGV2ZWwsIHJmX3NyJHJlc3ApXSkpDQpgYGANCg0KIyBDb21wYXJlIFBMUyBhbmQgUkYNCmBgYHtyLCBlY2hvPUZBTFNFfQ0KbW9kZWxzX3NyID0gcmJpbmQocGxzX3NyWywgLTRdLCByZl9zclssIC00XSkNCm1vZGVsc19zciRtcHR5cGUgPSBwYXN0ZTAobW9kZWxzX3NyJG10eXBlLCAiXyIsIG1vZGVsc19zciRwdHlwZSkNCm1vZGVsc19zciRtcHR5cGUgPSBmYWN0b3IobW9kZWxzX3NyJG1wdHlwZSwgbGV2ZWxzID0gYygicGxzX2Vsc3AiLCAicmZfZWxzcCIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgInBsc19lbHVpIiwgInJmX2VsdWkiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICJwbHNfa21yYSIsICJyZl9rbXJhIiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAicGxzX3NwZWMiLCAicmZfc3BlYyIpKQ0KDQpnZ3Bsb3QoZGF0YSA9IG1vZGVsc19zclttb2RlbHNfc3IkbXR5cGUgPT0gInBscyIgJiANCiAgICAgICAgICAgICAgICAgICAgICAgICAgKG1vZGVsc19zciRwdHlwZSA9PSAiZWx1aSIgfCBtb2RlbHNfc3IkcHR5cGUgPT0gInNwZWMiKSxdLCANCiAgICAgICBhZXMoeCA9IHJlc3AsIHkgPSBSTVNFX25vcm1TRCwgZmlsbCA9IG1wdHlwZSkpICsgDQogIGdlb21fYm94cGxvdCgpICsNCiAgZ2VvbV9obGluZSh5aW50ZXJjZXB0PWMoMC41LDEpLCBsaW5ldHlwZT0iZGFzaGVkIiwgY29sb3IgPSAiYmxhY2siKSArIA0KICBzY2FsZV9maWxsX2JyZXdlcihwYWxldHRlPSJEYXJrMiIpICsgDQogIHRoZW1lX2J3KCkgKyANCiAgdGhlbWUoYXhpcy50ZXh0LnggPSBlbGVtZW50X3RleHQoYW5nbGUgPSA0NSwgaGp1c3QgPSAxKSkgKyANCiAgbGFicyhsaXN0KHggPSAiU3BlY2llcyBncm91cHMiLCB5ID0gIlJNU0VuIiwgZmlsbCA9ICJNb2RlbCBzZXQiKSkNCg0KDQoNCmdncGxvdChkYXRhID0gbW9kZWxzX3NyW21vZGVsc19zciRtdHlwZSA9PSAicmYiICYgDQogICAgICAgICAgICAgICAgICAgICAgICAgIChtb2RlbHNfc3IkcHR5cGUgPT0gImVsdWkiIHwgbW9kZWxzX3NyJHB0eXBlID09ICJzcGVjIiksXSwgDQogICAgICAgYWVzKHggPSByZXNwLCB5ID0gUk1TRV9ub3JtU0QsIGZpbGwgPSBtcHR5cGUpKSArIA0KICBnZW9tX2JveHBsb3QoKSArDQogIGdlb21faGxpbmUoeWludGVyY2VwdD1jKDAuNSwxKSwgbGluZXR5cGU9ImRhc2hlZCIsIGNvbG9yID0gImJsYWNrIikgKyANCiAgc2NhbGVfZmlsbF9icmV3ZXIocGFsZXR0ZT0iRGFyazIiKSArIA0KICB0aGVtZV9idygpICsgDQogIHRoZW1lKGF4aXMudGV4dC54ID0gZWxlbWVudF90ZXh0KGFuZ2xlID0gNDUsIGhqdXN0ID0gMSkpICsgDQogIGxhYnMobGlzdCh4ID0gIlNwZWNpZXMgZ3JvdXBzIiwgeSA9ICJSTVNFbiIsIGZpbGwgPSAiTW9kZWwgc2V0IikpDQoNCg0KZ2dwbG90KGRhdGEgPSBtb2RlbHNfc3JbbW9kZWxzX3NyJG10eXBlID09ICJyZiIgJiBtb2RlbHNfc3IkcHR5cGUgPT0gInNwZWMiLF0sIA0KICAgICAgIGFlcyh4ID0gcmVzcCwgeSA9IFJNU0Vfbm9ybVNELCBmaWxsID0gTGV2ZWwpKSArIA0KICBnZW9tX2JveHBsb3QoKSArDQogIGdlb21faGxpbmUoeWludGVyY2VwdD1jKDAuNSwxKSwgbGluZXR5cGU9ImRhc2hlZCIsIGNvbG9yID0gImJsYWNrIikgKyANCiAgc2NhbGVfZmlsbF9icmV3ZXIocGFsZXR0ZT0iRGFyazIiKSArIA0KICB0aGVtZV9idygpICsgDQogIHRoZW1lKGF4aXMudGV4dC54ID0gZWxlbWVudF90ZXh0KGFuZ2xlID0gNDUsIGhqdXN0ID0gMSkpICsgDQogIGxhYnMobGlzdCh4ID0gIlNwZWNpZXMgcmljaG5lc3MiLCB5ID0gIlJNU0VuIiwgZmlsbCA9ICJUcm9waGljIGxldmVsIikpDQpgYGANCg0KYGBge3IsIGVjaG89RkFMU0V9DQpwbHNfcmZfc3IgPSBtZXJnZShwbHNfc3IsIHJmX3NyLCBieSA9IGMoInB0eXBlIiwgInJlc3AiLCAiUmVzYW1wbGUiKSwgYWxsLnkgPSBUUlVFKQ0KY29sbmFtZXMocGxzX3JmX3NyKVtncmVwKCJcXC54IiwgY29sbmFtZXMocGxzX3JmX3NyKSldID0gDQogIGdzdWIoIlxcLngiLCAiX3BscyIsIGNvbG5hbWVzKHBsc19yZl9zcilbZ3JlcCgiXFwueCIsIGNvbG5hbWVzKHBsc19yZl9zcikpXSkNCmNvbG5hbWVzKHBsc19yZl9zcilbZ3JlcCgiXFwueSIsIGNvbG5hbWVzKHBsc19yZl9zcikpXSA9IA0KICBnc3ViKCJcXC55IiwgIl9yZiIsIGNvbG5hbWVzKHBsc19yZl9zcilbZ3JlcCgiXFwueSIsIGNvbG5hbWVzKHBsc19yZl9zcikpXSkNCiMgbnJvdyhwbHNfcmZfc3IpDQoNCnB0eXBlcyA9IGMoImVsdWkiLCAia21yYSIsICJzcGVjIiwgImVsc3AiKQ0KcGVyZl9jaGVjayA9IGxhcHBseShwdHlwZXMsIGZ1bmN0aW9uKHB0KXsNCiAgc3ViZGYgPSBwbHNfcmZfc3JbIWlzLm5hKHBsc19yZl9zciRSTVNFX3BscykgJiANCiAgICAgICAgICAgICAgICAgICAgICBwbHNfcmZfc3IkcHR5cGUgPT0gcHQgJg0KICAgICAgICAgICAgICAgICAgICAgIHBsc19yZl9zciRSZXNhbXBsZSA9PSAiTWVhbiIsIF0NCiAgcm93bmFtZXMoc3ViZGZbc3ViZGYkUk1TRV9wbHMgPCBzdWJkZiRSTVNFX3JmLCBdKQ0KfSkNCm5hbWVzKHBlcmZfY2hlY2spID0gcHR5cGVzDQpgYGANCg0KIyBDaGVjayBwZXJmb3JtYW5jZSBvZiBQTFMgYW5kIFJGDQpgYGB7ciwgZWNobyA9IEZBTFNFfQ0KZm9yKGkgaW4gc2VxKGxlbmd0aChwZXJmX2NoZWNrKSkpew0KICBybXNlX3BlcmYgPSBzb3J0KHJvdW5kKDEtcGxzX3JmX3NyW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIlJNU0VfcGxzIl0gLyANCiAgICAgICAgICAgICAgICAgICAgICAgICAgIHBsc19yZl9zclthcy5udW1lcmljKHBlcmZfY2hlY2tbW2ldXSksICJSTVNFX3JmIl0sMikpDQogIHZhcl9yZl9wcmN0ID0gc29ydChyb3VuZChwbHNfcmZfc3JbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLCAibnZhcnNfcmYiXSAvIA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICBwbHNfcmZfc3JbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLCAibnZhcnNfcGxzIl0sMikpDQogIGxldmVsX3BscyA9IHNvcnQodGFibGUocGxzX3JmX3NyW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIkxldmVsX3BscyJdKSkNCiAgcHJpbnQobmFtZXMocGVyZl9jaGVja1tpXSkpDQogIHByaW50KHBsc19yZl9zclthcy5udW1lcmljKHBlcmZfY2hlY2tbW2ldXSksXSkNCiAgY2F0KCJSTVNFICgxIC0gUExTL1JGKToiLCBybXNlX3BlcmYsICJcbiIpDQogIGNhdCgiVmFyIG51bWJlciAoUkYvUExTKToiLCB2YXJfcmZfcHJjdCwgIlxuIikNCiAgY2F0KCJMZXZlbHMgd2l0aCBQTFMgaXMgYmV0dGVyOiIsIGxldmVsX3BscywgIlxuIikNCiAgY2F0KCJcblxuIikNCn0NCmBgYA0KDQojIENvbGxlY3QgdmFyaWFibGUgaW1wb3J0YW5jZQ0KIyMgTnVtYmVyIG9mIHZhcmlhYmxlcw0KYGBge3J9DQpwbHNfcmZfc3JfbG9uZyA9IG1lbHQocGxzX3JmX3NyW3Bsc19yZl9zciRSZXNhbXBsZSA9PSAiTWVhbiIsIGMoMSwgMiwgNiwgMTMpXSwgaWQudmFycyA9IGMoInB0eXBlIiwgInJlc3AiKSkNCmdncGxvdChkYXRhID0gcGxzX3JmX3NyX2xvbmcsIGFlcyh4ID0gdmFyaWFibGUsIHkgPSB2YWx1ZSwgZmlsbCA9IHB0eXBlKSkgKw0KICBnZW9tX2JveHBsb3QoKSArIA0KICBsYWJzKGxpc3QoeCA9ICJNb2RlbHMiLCB5ID0gIk51bWJlciBvZiB2YXJpYWJsZXMiICwNCiAgICAgICAgICAgIGZpbGwgPSAiUHJlZGljdG9yIFNldCIpKSArDQogIHRoZW1lX2J3KCkNCmBgYA0KDQoNCiMgVmFyaWFibGUgaW1wb3J0YW5jZSBmb3IgUExTDQpgYGB7ciwgZWNobz1GQUxTRX0NCnZhcl9pbXAgPC0gY29tcFZhckltcChhbGxfbW9kZWxzW1sicGxzIl1dW1sic3BlYyJdXUBtb2RlbFtbMV1dLCBzY2FsZSA9IEZBTFNFKQ0KIyBwbG90VmFySW1wKHZhcl9pbXApDQpwbG90VmFySW1wSGVhdG1hcCh2YXJfaW1wLCB4bGFiID0gIlNwZWNpZXMiLCB5bGFiID0gIkJhbmQiKQ0KYGBgDQoNCiMgVmFyaWFibGUgaW1wb3J0YW5jZSBmb3IgUkYNCmBgYHtyLCBlY2hvPUZBTFNFfQ0KdmFyX2ltcCA8LSBjb21wVmFySW1wKGFsbF9tb2RlbHNbWyJyZiJdXVtbInNwZWMiXV1AbW9kZWxbWzFdXSwgc2NhbGUgPSBGQUxTRSkNCiMgcGxvdFZhckltcCh2YXJfaW1wKQ0KcGxvdFZhckltcEhlYXRtYXAodmFyX2ltcCwgeGxhYiA9ICJTcGVjaWVzIiwgeWxhYiA9ICJCYW5kIikNCmBgYA0KDQoNCiMgVHJvcGhpYyBsZXZlbHMNCmBgYHtyfQ0KdmFyX2ltcF9sZXZlbHMgPSB2YXJfaW1wDQpmb3IoaSBpbiBzZXEobGVuZ3RoKHZhcl9pbXBfbGV2ZWxzKSkpew0KICB2YXJfaW1wX2xldmVsc1tbaV1dJFJFU1BPTlNFID0gdGwkTGV2ZWxbZ3JlcCh2YXJfaW1wX2xldmVsc1tbaV1dJFJFU1BPTlNFWzFdLCB0bCRTcGVjaWVzKV0NCn0NCnBsb3RWYXJJbXBIZWF0bWFwKHZhcl9pbXBfbGV2ZWxzLCB4bGFiID0gIlNwZWNpZXMiLCB5bGFiID0gIkJhbmQiKQ0KYGBgDQoNCg0KDQoNCldoZW4geW91IHNhdmUgdGhlIG5vdGVib29rLCBhbiBIVE1MIGZpbGUgY29udGFpbmluZyB0aGUgY29kZSBhbmQgb3V0cHV0IHdpbGwgYmUgc2F2ZWQgYWxvbmdzaWRlIGl0IChjbGljayB0aGUgKlByZXZpZXcqIGJ1dHRvbiBvciBwcmVzcyAqQ3RybCtTaGlmdCtLKiB0byBwcmV2aWV3IHRoZSBIVE1MIGZpbGUpLg0KDQpUaGUgcHJldmlldyBzaG93cyB5b3UgYSByZW5kZXJlZCBIVE1MIGNvcHkgb2YgdGhlIGNvbnRlbnRzIG9mIHRoZSBlZGl0b3IuIENvbnNlcXVlbnRseSwgdW5saWtlICpLbml0KiwgKlByZXZpZXcqIGRvZXMgbm90IHJ1biBhbnkgUiBjb2RlIGNodW5rcy4gSW5zdGVhZCwgdGhlIG91dHB1dCBvZiB0aGUgY2h1bmsgd2hlbiBpdCB3YXMgbGFzdCBydW4gaW4gdGhlIGVkaXRvciBpcyBkaXNwbGF5ZWQuDQo=
+
LS0tDQp0aXRsZTogIjUwMCBBbmFseXNlIEJpb2Rpdi1SUyINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCmBgYHtyLCBpbmNsdWRlID0gRkFMU0V9DQojIFNldCB1cCB3b3JraW5nIGVudmlyb25tZW50IGFuZCBkZWZhdWx0cyAtLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLQ0Kcm9vdF9mb2xkZXIgPSBwYXRoLmV4cGFuZCgifi9wbHlncm5kL2h5U3BlY1Zpc0tpbGkvIikNCnNvdXJjZShmaWxlLnBhdGgocm9vdF9mb2xkZXIsICJoeVNwZWNWaXNLaWxpL3NyYy8wMDBfc2V0dXBfd2luZG93cy5SIikpDQoNCmFsbF9tb2RlbHMgPSByZWFkUkRTKGZpbGUucGF0aChlbnZybXQkcGF0aF8xMjBfY29tcGlsZV9hbmFseXNpc19zciwgDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIm1vZGVsc19zci5yZHMiKSkNCg0KIyBDb2xsZWN0IG1vZGVsIHBlcmZvcm1hbmNlDQpnYW1fc3IgPSBtb2RlbFBlcmZvcm1hbmNlKGFsbF9tb2RlbHNbWyJnYW0iXV0pDQpwbHNfc3IgPSBtb2RlbFBlcmZvcm1hbmNlKGFsbF9tb2RlbHNbWyJwbHMiXV0pDQpyZl9zciA9IG1vZGVsUGVyZm9ybWFuY2UoYWxsX21vZGVsc1tbInJmIl1dKQ0KDQpzdW1tYXJ5KGdhbV9zcikNCnN1bW1hcnkocGxzX3NyKQ0Kc3VtbWFyeShyZl9zcikNCg0KIyBHZXQgdHJvcGhpYyBsZXZlbHMNCnRsID0gcmVhZC50YWJsZShmaWxlLnBhdGgocGF0aF9tZXRhLCAidHJvcGhpY19sZXZlbHMuY3N2IiksIGhlYWRlciA9IFRSVUUsIHNlcCA9ICI7IikNCmdhbV9zciA9IG1lcmdlKGdhbV9zciwgdGwsIGJ5LnggPSAicmVzcCIsIGJ5LnkgPSAiU3BlY2llcyIpDQpwbHNfc3IgPSBtZXJnZShwbHNfc3IsIHRsLCBieS54ID0gInJlc3AiLCBieS55ID0gIlNwZWNpZXMiKQ0KcmZfc3IgPSBtZXJnZShyZl9zciwgdGwsIGJ5LnggPSAicmVzcCIsIGJ5LnkgPSAiU3BlY2llcyIpDQoNCiMgQXJyYW5nZSBsZXZlbHMgYW5kIHNwZWNpZXMgbmFtZXMNCnBsc19zciRMZXZlbCA9IGZhY3RvcihwbHNfc3IkTGV2ZWwsIGxldmVscyhwbHNfc3IkTGV2ZWwpW2MoMSwgNSwgNCwgMywgNiwgMildICkNCnBsc19zciRyZXNwID0gYXMuY2hhcmFjdGVyKHBsc19zciRyZXNwKQ0KcGxzX3NyJHJlc3AgPSBzdWJzdHIocGxzX3NyJHJlc3AsIDMsIG5jaGFyKHBsc19zciRyZXNwKSkNCnBsc19zciRyZXNwID0gZ3N1YigiKF5bWzphbHBoYTpdXSkiLCAiXFxVXFwxIiwgcGxzX3NyJHJlc3AsIHBlcmw9VFJVRSkNCnBsc19zciRyZXNwID0gZmFjdG9yKHBsc19zciRyZXNwLCB1bmlxdWUocGxzX3NyJHJlc3Bbb3JkZXIocGxzX3NyJExldmVsLCBwbHNfc3IkcmVzcCldKSkNCg0KDQpyZl9zciRMZXZlbCA9IGZhY3RvcihyZl9zciRMZXZlbCwgbGV2ZWxzKHJmX3NyJExldmVsKVtjKDEsIDUsIDQsIDMsIDYsIDIpXSApDQpyZl9zciRyZXNwID0gYXMuY2hhcmFjdGVyKHJmX3NyJHJlc3ApDQpyZl9zciRyZXNwID0gc3Vic3RyKHJmX3NyJHJlc3AsIDMsIG5jaGFyKHJmX3NyJHJlc3ApKQ0KcmZfc3IkcmVzcCA9IGdzdWIoIiheW1s6YWxwaGE6XV0pIiwgIlxcVVxcMSIsIHJmX3NyJHJlc3AsIHBlcmw9VFJVRSkNCnJmX3NyJHJlc3AgPSBmYWN0b3IocmZfc3IkcmVzcCwgdW5pcXVlKHJmX3NyJHJlc3Bbb3JkZXIocmZfc3IkTGV2ZWwsIHJmX3NyJHJlc3ApXSkpDQpgYGANCg0KIyBDb21wYXJlIFBMUyBhbmQgUkYNCmBgYHtyLCBlY2hvPUZBTFNFfQ0KbW9kZWxzX3NyID0gcmJpbmQocGxzX3NyWywgLTRdLCByZl9zclssIC00XSkNCm1vZGVsc19zciRtcHR5cGUgPSBwYXN0ZTAobW9kZWxzX3NyJG10eXBlLCAiXyIsIG1vZGVsc19zciRwdHlwZSkNCm1vZGVsc19zciRtcHR5cGUgPSBmYWN0b3IobW9kZWxzX3NyJG1wdHlwZSwgbGV2ZWxzID0gYygicGxzX2Vsc3AiLCAicmZfZWxzcCIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgInBsc19lbHVpIiwgInJmX2VsdWkiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICJwbHNfa21yYSIsICJyZl9rbXJhIiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAicGxzX3NwZWMiLCAicmZfc3BlYyIpKQ0KDQpnZ3Bsb3QoZGF0YSA9IG1vZGVsc19zclttb2RlbHNfc3IkbXR5cGUgPT0gInBscyIgJiANCiAgICAgICAgICAgICAgICAgICAgICAgICAgKG1vZGVsc19zciRwdHlwZSA9PSAiZWx1aSIgfCBtb2RlbHNfc3IkcHR5cGUgPT0gInNwZWMiKSxdLCANCiAgICAgICBhZXMoeCA9IHJlc3AsIHkgPSBSTVNFX25vcm1TRCwgZmlsbCA9IG1wdHlwZSkpICsgDQogIGdlb21fYm94cGxvdCgpICsNCiAgZ2VvbV9obGluZSh5aW50ZXJjZXB0PWMoMC41LDEpLCBsaW5ldHlwZT0iZGFzaGVkIiwgY29sb3IgPSAiYmxhY2siKSArIA0KICBzY2FsZV9maWxsX2JyZXdlcihwYWxldHRlPSJEYXJrMiIpICsgDQogIHRoZW1lX2J3KCkgKyANCiAgdGhlbWUoYXhpcy50ZXh0LnggPSBlbGVtZW50X3RleHQoYW5nbGUgPSA0NSwgaGp1c3QgPSAxKSkgKyANCiAgbGFicyhsaXN0KHggPSAiU3BlY2llcyBncm91cHMiLCB5ID0gIlJNU0VuIiwgZmlsbCA9ICJNb2RlbCBzZXQiKSkNCg0KDQoNCmdncGxvdChkYXRhID0gbW9kZWxzX3NyW21vZGVsc19zciRtdHlwZSA9PSAicmYiICYgDQogICAgICAgICAgICAgICAgICAgICAgICAgIChtb2RlbHNfc3IkcHR5cGUgPT0gImVsdWkiIHwgbW9kZWxzX3NyJHB0eXBlID09ICJzcGVjIiksXSwgDQogICAgICAgYWVzKHggPSByZXNwLCB5ID0gUk1TRV9ub3JtU0QsIGZpbGwgPSBtcHR5cGUpKSArIA0KICBnZW9tX2JveHBsb3QoKSArDQogIGdlb21faGxpbmUoeWludGVyY2VwdD1jKDAuNSwxKSwgbGluZXR5cGU9ImRhc2hlZCIsIGNvbG9yID0gImJsYWNrIikgKyANCiAgc2NhbGVfZmlsbF9icmV3ZXIocGFsZXR0ZT0iRGFyazIiKSArIA0KICB0aGVtZV9idygpICsgDQogIHRoZW1lKGF4aXMudGV4dC54ID0gZWxlbWVudF90ZXh0KGFuZ2xlID0gNDUsIGhqdXN0ID0gMSkpICsgDQogIGxhYnMobGlzdCh4ID0gIlNwZWNpZXMgZ3JvdXBzIiwgeSA9ICJSTVNFbiIsIGZpbGwgPSAiTW9kZWwgc2V0IikpDQoNCg0KZ2dwbG90KGRhdGEgPSBtb2RlbHNfc3JbbW9kZWxzX3NyJG10eXBlID09ICJyZiIgJiBtb2RlbHNfc3IkcHR5cGUgPT0gInNwZWMiLF0sIA0KICAgICAgIGFlcyh4ID0gcmVzcCwgeSA9IFJNU0Vfbm9ybVNELCBmaWxsID0gTGV2ZWwpKSArIA0KICBnZW9tX2JveHBsb3QoKSArDQogIGdlb21faGxpbmUoeWludGVyY2VwdD1jKDAuNSwxKSwgbGluZXR5cGU9ImRhc2hlZCIsIGNvbG9yID0gImJsYWNrIikgKyANCiAgc2NhbGVfZmlsbF9icmV3ZXIocGFsZXR0ZT0iRGFyazIiKSArIA0KICB0aGVtZV9idygpICsgDQogIHRoZW1lKGF4aXMudGV4dC54ID0gZWxlbWVudF90ZXh0KGFuZ2xlID0gNDUsIGhqdXN0ID0gMSkpICsgDQogIGxhYnMobGlzdCh4ID0gIlNwZWNpZXMgcmljaG5lc3MiLCB5ID0gIlJNU0VuIiwgZmlsbCA9ICJUcm9waGljIGxldmVsIikpDQpgYGANCg0KYGBge3IsIGVjaG89RkFMU0V9DQpwbHNfcmZfc3IgPSBtZXJnZShwbHNfc3IsIHJmX3NyLCBieSA9IGMoInB0eXBlIiwgInJlc3AiLCAiUmVzYW1wbGUiKSwgYWxsLnkgPSBUUlVFKQ0KY29sbmFtZXMocGxzX3JmX3NyKVtncmVwKCJcXC54IiwgY29sbmFtZXMocGxzX3JmX3NyKSldID0gDQogIGdzdWIoIlxcLngiLCAiX3BscyIsIGNvbG5hbWVzKHBsc19yZl9zcilbZ3JlcCgiXFwueCIsIGNvbG5hbWVzKHBsc19yZl9zcikpXSkNCmNvbG5hbWVzKHBsc19yZl9zcilbZ3JlcCgiXFwueSIsIGNvbG5hbWVzKHBsc19yZl9zcikpXSA9IA0KICBnc3ViKCJcXC55IiwgIl9yZiIsIGNvbG5hbWVzKHBsc19yZl9zcilbZ3JlcCgiXFwueSIsIGNvbG5hbWVzKHBsc19yZl9zcikpXSkNCiMgbnJvdyhwbHNfcmZfc3IpDQoNCnB0eXBlcyA9IGMoImVsdWkiLCAia21yYSIsICJzcGVjIiwgImVsc3AiKQ0KcGVyZl9jaGVjayA9IGxhcHBseShwdHlwZXMsIGZ1bmN0aW9uKHB0KXsNCiAgc3ViZGYgPSBwbHNfcmZfc3JbIWlzLm5hKHBsc19yZl9zciRSTVNFX3BscykgJiANCiAgICAgICAgICAgICAgICAgICAgICBwbHNfcmZfc3IkcHR5cGUgPT0gcHQgJg0KICAgICAgICAgICAgICAgICAgICAgIHBsc19yZl9zciRSZXNhbXBsZSA9PSAiTWVhbiIsIF0NCiAgcm93bmFtZXMoc3ViZGZbc3ViZGYkUk1TRV9wbHMgPCBzdWJkZiRSTVNFX3JmLCBdKQ0KfSkNCm5hbWVzKHBlcmZfY2hlY2spID0gcHR5cGVzDQpgYGANCg0KIyBDaGVjayBwZXJmb3JtYW5jZSBvZiBQTFMgYW5kIFJGDQpgYGB7ciwgZWNobyA9IEZBTFNFfQ0KZm9yKGkgaW4gc2VxKGxlbmd0aChwZXJmX2NoZWNrKSkpew0KICBybXNlX3BlcmYgPSBzb3J0KHJvdW5kKDEtcGxzX3JmX3NyW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIlJNU0VfcGxzIl0gLyANCiAgICAgICAgICAgICAgICAgICAgICAgICAgIHBsc19yZl9zclthcy5udW1lcmljKHBlcmZfY2hlY2tbW2ldXSksICJSTVNFX3JmIl0sMikpDQogIHZhcl9yZl9wcmN0ID0gc29ydChyb3VuZChwbHNfcmZfc3JbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLCAibnZhcnNfcmYiXSAvIA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICBwbHNfcmZfc3JbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLCAibnZhcnNfcGxzIl0sMikpDQogIGxldmVsX3BscyA9IHNvcnQodGFibGUocGxzX3JmX3NyW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIkxldmVsX3BscyJdKSkNCiAgcHJpbnQobmFtZXMocGVyZl9jaGVja1tpXSkpDQogIHByaW50KHBsc19yZl9zclthcy5udW1lcmljKHBlcmZfY2hlY2tbW2ldXSksXSkNCiAgY2F0KCJSTVNFICgxIC0gUExTL1JGKToiLCBybXNlX3BlcmYsICJcbiIpDQogIGNhdCgiVmFyIG51bWJlciAoUkYvUExTKToiLCB2YXJfcmZfcHJjdCwgIlxuIikNCiAgY2F0KCJMZXZlbHMgd2l0aCBQTFMgaXMgYmV0dGVyOiIsIGxldmVsX3BscywgIlxuIikNCiAgY2F0KCJcblxuIikNCn0NCmBgYA0KDQojIENvbGxlY3QgdmFyaWFibGUgaW1wb3J0YW5jZQ0KIyMgTnVtYmVyIG9mIHZhcmlhYmxlcw0KYGBge3J9DQpwbHNfcmZfc3JfbG9uZyA9IG1lbHQocGxzX3JmX3NyW3Bsc19yZl9zciRSZXNhbXBsZSA9PSAiTWVhbiIsIGMoMSwgMiwgNiwgMTMpXSwgaWQudmFycyA9IGMoInB0eXBlIiwgInJlc3AiKSkNCmdncGxvdChkYXRhID0gcGxzX3JmX3NyX2xvbmcsIGFlcyh4ID0gdmFyaWFibGUsIHkgPSB2YWx1ZSwgZmlsbCA9IHB0eXBlKSkgKw0KICBnZW9tX2JveHBsb3QoKSArIA0KICBsYWJzKGxpc3QoeCA9ICJNb2RlbHMiLCB5ID0gIk51bWJlciBvZiB2YXJpYWJsZXMiICwNCiAgICAgICAgICAgIGZpbGwgPSAiUHJlZGljdG9yIFNldCIpKSArDQogIHRoZW1lX2J3KCkNCmBgYA0KDQoNCiMgVmFyaWFibGUgaW1wb3J0YW5jZSBmb3IgUExTDQpgYGB7ciwgZWNobz1GQUxTRX0NCnZhcl9pbXAgPC0gY29tcFZhckltcChhbGxfbW9kZWxzW1sicGxzIl1dW1sic3BlYyJdXUBtb2RlbFtbMV1dLCBzY2FsZSA9IEZBTFNFKQ0KIyBwbG90VmFySW1wKHZhcl9pbXApDQpwbG90VmFySW1wSGVhdG1hcCh2YXJfaW1wLCB4bGFiID0gIlNwZWNpZXMiLCB5bGFiID0gIkJhbmQiKQ0KYGBgDQoNCiMgVmFyaWFibGUgaW1wb3J0YW5jZSBmb3IgUkYNCmBgYHtyLCBlY2hvPUZBTFNFfQ0KdmFyX2ltcCA8LSBjb21wVmFySW1wKGFsbF9tb2RlbHNbWyJyZiJdXVtbInNwZWMiXV1AbW9kZWxbWzFdXSwgc2NhbGUgPSBGQUxTRSkNCiMgcGxvdFZhckltcCh2YXJfaW1wKQ0KcGxvdFZhckltcEhlYXRtYXAodmFyX2ltcCwgeGxhYiA9ICJTcGVjaWVzIiwgeWxhYiA9ICJCYW5kIikNCmBgYA0KDQoNCiMgVHJvcGhpYyBsZXZlbHMNCmBgYHtyfQ0KdmFyX2ltcF9sZXZlbHMgPSB2YXJfaW1wDQpmb3IoaSBpbiBzZXEobGVuZ3RoKHZhcl9pbXBfbGV2ZWxzKSkpew0KICB2YXJfaW1wX2xldmVsc1tbaV1dJFJFU1BPTlNFID0gdGwkTGV2ZWxbZ3JlcCh2YXJfaW1wX2xldmVsc1tbaV1dJFJFU1BPTlNFWzFdLCB0bCRTcGVjaWVzKV0NCn0NCnBsb3RWYXJJbXBIZWF0bWFwKHZhcl9pbXBfbGV2ZWxzLCB4bGFiID0gIlNwZWNpZXMiLCB5bGFiID0gIkJhbmQiKQ0KYGBgDQoNCg0KDQoNCldoZW4geW91IHNhdmUgdGhlIG5vdGVib29rLCBhbiBIVE1MIGZpbGUgY29udGFpbmluZyB0aGUgY29kZSBhbmQgb3V0cHV0IHdpbGwgYmUgc2F2ZWQgYWxvbmdzaWRlIGl0IChjbGljayB0aGUgKlByZXZpZXcqIGJ1dHRvbiBvciBwcmVzcyAqQ3RybCtTaGlmdCtLKiB0byBwcmV2aWV3IHRoZSBIVE1MIGZpbGUpLg0KDQpUaGUgcHJldmlldyBzaG93cyB5b3UgYSByZW5kZXJlZCBIVE1MIGNvcHkgb2YgdGhlIGNvbnRlbnRzIG9mIHRoZSBlZGl0b3IuIENvbnNlcXVlbnRseSwgdW5saWtlICpLbml0KiwgKlByZXZpZXcqIGRvZXMgbm90IHJ1biBhbnkgUiBjb2RlIGNodW5rcy4gSW5zdGVhZCwgdGhlIG91dHB1dCBvZiB0aGUgY2h1bmsgd2hlbiBpdCB3YXMgbGFzdCBydW4gaW4gdGhlIGVkaXRvciBpcyBkaXNwbGF5ZWQuDQo=
diff --git a/src/510_analyse_biodiv_sr_elev_res.Rmd b/src/510_analyse_biodiv_sr_elev_res.Rmd index 3ba029d..bc9ebf7 100644 --- a/src/510_analyse_biodiv_sr_elev_res.Rmd +++ b/src/510_analyse_biodiv_sr_elev_res.Rmd @@ -4,11 +4,10 @@ output: html_notebook --- ```{r, include = FALSE} -source("C:/Users/Thomas Nauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +root_folder = path.expand("~/plygrnd/hySpecVisKili/") +source(file.path(root_folder, "hySpecVisKili/src/000_setup_windows.R")) -dir.create(path_analysis_sr_elev_res, showWarnings = FALSE) - -all_models_res = readRDS(file.path(path_compile_analysis_sr_elev_res, +all_models_res = readRDS(file.path(envrmt$path_220_compile_analysis_sr_elev_res, "models_sr_elev_res.rds")) diff --git a/src/510_analyse_biodiv_sr_elev_res.nb.html b/src/510_analyse_biodiv_sr_elev_res.nb.html index a5db346..ca9c7f4 100644 --- a/src/510_analyse_biodiv_sr_elev_res.nb.html +++ b/src/510_analyse_biodiv_sr_elev_res.nb.html @@ -182,7 +182,7 @@

510 Analyse Biodiv-RS

Compare PLS and RF

- +

@@ -194,7 +194,7 @@

Collect variable importance

Number of variables

- +

@@ -205,7 +205,7 @@

Number of variables

Variable importance for RF

- +

@@ -215,35 +215,25 @@

Variable importance for RF

Trophic levels

- +

- +

- +

- -
t = do.call("rbind", var_imp)
-t = t[t$mean>=0.6,]
-t$RESPONSE = gsub("_rf_elui_res", "", t$RESPONSE)
-tt = table(t$VARIABLE, t$RESPONSE)
-pca_tt <- prcomp(tt, scale = TRUE, center = TRUE)
-pca_var <- as.data.frame(pca_tt$rotation)
-pca_obs <- as.data.frame(pca_tt$x)
-ggplot(pca_var, aes(PC1, PC2))+
-  geom_point()+
-geom_point(data = pca_obs, aes(PC1, PC2), color = "red")
-ggbiplot(pca_tt, labels = rownames(pca_tt$x), choices = 1:2)
-
-biplot(pca_tt)
+ +

rr t = do.call(, var_imp) t = t[t$mean>=0.6,] t\(RESPONSE = gsub(\_rf_elui_res\, \\, t\)RESPONSE) tt = table(t\(VARIABLE, t\)RESPONSE) pca_tt <- prcomp(tt, scale = TRUE, center = TRUE) pca_var <- as.data.frame(pca_tt\(rotation) pca_obs <- as.data.frame(pca_tt\)x) ggplot(pca_var, aes(PC1, PC2))+ geom_point()+ geom_point(data = pca_obs, aes(PC1, PC2), color = ) ggbiplot(pca_tt, labels = rownames(pca_tt$x), choices = 1:2)

+

biplot(pca_tt)

+
- +

@@ -253,7 +243,7 @@

Trophic levels

-
LS0tDQp0aXRsZTogIjUxMCBBbmFseXNlIEJpb2Rpdi1SUyINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCmBgYHtyLCBpbmNsdWRlID0gRkFMU0V9DQpzb3VyY2UoIkM6L1VzZXJzL1Rob21hcyBOYXVzcy9wZXJtYW5lbnQvcGx5Z3JuZC9LSS1IeXBlcnNwZWMvSHlTcGVjX0tpTGkvc3JjLzAwMF9zZXRfZW52aXJvbm1lbnQuUiIpDQoNCmRpci5jcmVhdGUocGF0aF9hbmFseXNpc19zcl9lbGV2X3Jlcywgc2hvd1dhcm5pbmdzID0gRkFMU0UpDQoNCmFsbF9tb2RlbHNfcmVzID0gcmVhZFJEUyhmaWxlLnBhdGgocGF0aF9jb21waWxlX2FuYWx5c2lzX3NyX2VsZXZfcmVzLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAibW9kZWxzX3NyX2VsZXZfcmVzLnJkcyIpKQ0KDQoNCiMgQ29sbGVjdCBtb2RlbCBwZXJmb3JtYW5jZQ0KbW9kZWxzX3JlcyA9IG1vZGVsUGVyZm9ybWFuY2UoYWxsX21vZGVsc19yZXNbWyJyZiJdXSkNCg0KbW9kZWxzX3JlcyRyZXNtb2RlbCA9IG1vZGVsc19yZXMkcmVzcA0KbW9kZWxzX3JlcyRyZXNwID0gZ3N1YigiX3Bsc19lbHVpX3JlcyIsICIiLCBtb2RlbHNfcmVzJHJlc3ApDQptb2RlbHNfcmVzJHJlc3AgPSBnc3ViKCJfcmZfZWx1aV9yZXMiLCAiIiwgbW9kZWxzX3JlcyRyZXNwKQ0KDQpyZl9wbHNfcmVzID0gbW9kZWxzX3Jlc1ttb2RlbHNfcmVzJHB0eXBlID09ICJwbHNfZWx1aV9yZXMiLF0NCnJmX3JmX3JlcyA9IG1vZGVsc19yZXNbbW9kZWxzX3JlcyRwdHlwZSA9PSAicmZfZWx1aV9yZXMiLF0NCg0Kc3VtbWFyeShyZl9wbHNfcmVzKQ0Kc3VtbWFyeShyZl9yZl9yZXMpDQoNCiMgR2V0IHRyb3BoaWMgbGV2ZWxzDQp0bCA9IHJlYWQudGFibGUoZmlsZS5wYXRoKHBhdGhfbWV0YSwgInRyb3BoaWNfbGV2ZWxzLmNzdiIpLCBoZWFkZXIgPSBUUlVFLCBzZXAgPSAiOyIpDQpyZl9wbHNfcmVzID0gbWVyZ2UocmZfcGxzX3JlcywgdGwsIGJ5LnggPSAicmVzcCIsIGJ5LnkgPSAiU3BlY2llcyIpDQpyZl9yZl9yZXMgPSBtZXJnZShyZl9yZl9yZXMsIHRsLCBieS54ID0gInJlc3AiLCBieS55ID0gIlNwZWNpZXMiKQ0KYGBgDQoNCiMgQ29tcGFyZSBQTFMgYW5kIFJGDQpgYGB7ciwgZWNobz1GQUxTRX0NCm1vZGVsc19yZXMkbXB0eXBlID0gcGFzdGUwKG1vZGVsc19yZXMkbXR5cGUsICJfIiwgbW9kZWxzX3JlcyRwdHlwZSkNCm1vZGVsc19yZXMkbXB0eXBlID0gZmFjdG9yKG1vZGVsc19yZXMkbXB0eXBlKQ0KDQoNCmdncGxvdChkYXRhID0gbW9kZWxzX3JlcywgYWVzKHggPSByZXNwLCB5ID0gUk1TRV9ub3JtU0QsIGZpbGwgPSBtcHR5cGUpKSArIA0KICBnZW9tX2JveHBsb3QoKSArDQogIHRoZW1lX2J3KCkgKyANCiAgdGhlbWUoYXhpcy50ZXh0LnggPSBlbGVtZW50X3RleHQoYW5nbGUgPSA0NSwgaGp1c3QgPSAxKSkgKyANCiAgbGFicyhsaXN0KHggPSAiU3BlY2llcyBncm91cHMiLCB5ID0gIlJNU0VuIiwgZmlsbCA9ICJNb2RlbCBzZXQiKSkNCmBgYA0KDQojIENvbGxlY3QgdmFyaWFibGUgaW1wb3J0YW5jZQ0KIyMgTnVtYmVyIG9mIHZhcmlhYmxlcw0KYGBge3J9DQpyZl9wbHNfcmVzX2xvbmcgPSBtZWx0KG1vZGVsc19yZXNbbW9kZWxzX3JlcyRSZXNhbXBsZSA9PSAiTWVhbiIsIGMoMiwzLDUpXSwgaWQudmFycyA9IGMoInB0eXBlIiwgInJlc3AiKSkNCmdncGxvdChkYXRhID0gcmZfcGxzX3Jlc19sb25nLCBhZXMoeCA9IHZhcmlhYmxlLCB5ID0gdmFsdWUsIGZpbGwgPSBwdHlwZSkpICsNCiAgZ2VvbV9ib3hwbG90KCkgKyANCiAgbGFicyhsaXN0KHggPSAiTW9kZWxzIiwgeSA9ICJOdW1iZXIgb2YgdmFyaWFibGVzIiAsDQogICAgICAgICAgICBmaWxsID0gIlByZWRpY3RvciBTZXQiKSkgKw0KICB0aGVtZV9idygpDQpgYGANCg0KDQojIFZhcmlhYmxlIGltcG9ydGFuY2UgZm9yIFJGDQpgYGB7cn0NCnZhcl9pbXAgPC0gY29tcFZhckltcChhbGxfbW9kZWxzX3JlcyRyZiRyZl9lbHVpX3Jlc0Btb2RlbFtbMV1dLCBzY2FsZSA9IEZBTFNFKQ0KIyBwbG90VmFySW1wKHZhcl9pbXApDQpwbG90VmFySW1wSGVhdG1hcCh2YXJfaW1wLCB4bGFiID0gIlNwZWNpZXMiLCB5bGFiID0gIkJhbmQiKQ0KYGBgDQoNCg0KIyBUcm9waGljIGxldmVscw0KYGBge3J9DQp2YXJfaW1wX2xldmVscyA9IHZhcl9pbXANCmZvcihpIGluIHNlcShsZW5ndGgodmFyX2ltcF9sZXZlbHMpKSl7DQogIGFjdF9zcGVjaWVzID0gZ3N1YigiX3JmX2VsdWlfcmVzIiwgIiIsIHZhcl9pbXBfbGV2ZWxzW1tpXV0kUkVTUE9OU0VbMV0pDQogIHZhcl9pbXBfbGV2ZWxzW1tpXV0kUkVTUE9OU0UgPSB0bCRMZXZlbFtncmVwKGFjdF9zcGVjaWVzLCB0bCRTcGVjaWVzKV0NCn0NCnBsb3RWYXJJbXBIZWF0bWFwKHZhcl9pbXBfbGV2ZWxzLCB4bGFiID0gIlNwZWNpZXMiLCB5bGFiID0gIkJhbmQiKQ0KYGBgDQoNCmBgYHtyfQ0KdCA9IGRvLmNhbGwoInJiaW5kIiwgdmFyX2ltcCkNCnQgPSB0W3QkbWVhbj49MC42LF0NCnQkUkVTUE9OU0UgPSBnc3ViKCJfcmZfZWx1aV9yZXMiLCAiIiwgdCRSRVNQT05TRSkNCnR0ID0gdGFibGUodCRWQVJJQUJMRSwgdCRSRVNQT05TRSkNCnBjYV90dCA8LSBwcmNvbXAodHQsIHNjYWxlID0gVFJVRSwgY2VudGVyID0gVFJVRSkNCnBjYV92YXIgPC0gYXMuZGF0YS5mcmFtZShwY2FfdHQkcm90YXRpb24pDQpwY2Ffb2JzIDwtIGFzLmRhdGEuZnJhbWUocGNhX3R0JHgpDQpnZ3Bsb3QocGNhX3ZhciwgYWVzKFBDMSwgUEMyKSkrDQogIGdlb21fcG9pbnQoKSsNCmdlb21fcG9pbnQoZGF0YSA9IHBjYV9vYnMsIGFlcyhQQzEsIFBDMiksIGNvbG9yID0gInJlZCIpDQpnZ2JpcGxvdChwY2FfdHQsIGxhYmVscyA9IHJvd25hbWVzKHBjYV90dCR4KSwgY2hvaWNlcyA9IDE6MikNCmJpcGxvdChwY2FfdHQpDQpgYGANCg0KV2hlbiB5b3Ugc2F2ZSB0aGUgbm90ZWJvb2ssIGFuIEhUTUwgZmlsZSBjb250YWluaW5nIHRoZSBjb2RlIGFuZCBvdXRwdXQgd2lsbCBiZSBzYXZlZCBhbG9uZ3NpZGUgaXQgKGNsaWNrIHRoZSAqUHJldmlldyogYnV0dG9uIG9yIHByZXNzICpDdHJsK1NoaWZ0K0sqIHRvIHByZXZpZXcgdGhlIEhUTUwgZmlsZSkuDQoNClRoZSBwcmV2aWV3IHNob3dzIHlvdSBhIHJlbmRlcmVkIEhUTUwgY29weSBvZiB0aGUgY29udGVudHMgb2YgdGhlIGVkaXRvci4gQ29uc2VxdWVudGx5LCB1bmxpa2UgKktuaXQqLCAqUHJldmlldyogZG9lcyBub3QgcnVuIGFueSBSIGNvZGUgY2h1bmtzLiBJbnN0ZWFkLCB0aGUgb3V0cHV0IG9mIHRoZSBjaHVuayB3aGVuIGl0IHdhcyBsYXN0IHJ1biBpbiB0aGUgZWRpdG9yIGlzIGRpc3BsYXllZC4NCg==
+
LS0tDQp0aXRsZTogIjUxMCBBbmFseXNlIEJpb2Rpdi1SUyINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCmBgYHtyLCBpbmNsdWRlID0gRkFMU0V9DQpyb290X2ZvbGRlciA9IHBhdGguZXhwYW5kKCJ+L3BseWdybmQvaHlTcGVjVmlzS2lsaS8iKQ0Kc291cmNlKGZpbGUucGF0aChyb290X2ZvbGRlciwgImh5U3BlY1Zpc0tpbGkvc3JjLzAwMF9zZXR1cF93aW5kb3dzLlIiKSkNCg0KYWxsX21vZGVsc19yZXMgPSByZWFkUkRTKGZpbGUucGF0aChlbnZybXQkcGF0aF8yMjBfY29tcGlsZV9hbmFseXNpc19zcl9lbGV2X3JlcywgDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIm1vZGVsc19zcl9lbGV2X3Jlcy5yZHMiKSkNCg0KDQojIENvbGxlY3QgbW9kZWwgcGVyZm9ybWFuY2UNCm1vZGVsc19yZXMgPSBtb2RlbFBlcmZvcm1hbmNlKGFsbF9tb2RlbHNfcmVzW1sicmYiXV0pDQoNCm1vZGVsc19yZXMkcmVzbW9kZWwgPSBtb2RlbHNfcmVzJHJlc3ANCm1vZGVsc19yZXMkcmVzcCA9IGdzdWIoIl9wbHNfZWx1aV9yZXMiLCAiIiwgbW9kZWxzX3JlcyRyZXNwKQ0KbW9kZWxzX3JlcyRyZXNwID0gZ3N1YigiX3JmX2VsdWlfcmVzIiwgIiIsIG1vZGVsc19yZXMkcmVzcCkNCg0KcmZfcGxzX3JlcyA9IG1vZGVsc19yZXNbbW9kZWxzX3JlcyRwdHlwZSA9PSAicGxzX2VsdWlfcmVzIixdDQpyZl9yZl9yZXMgPSBtb2RlbHNfcmVzW21vZGVsc19yZXMkcHR5cGUgPT0gInJmX2VsdWlfcmVzIixdDQoNCnN1bW1hcnkocmZfcGxzX3JlcykNCnN1bW1hcnkocmZfcmZfcmVzKQ0KDQojIEdldCB0cm9waGljIGxldmVscw0KdGwgPSByZWFkLnRhYmxlKGZpbGUucGF0aChwYXRoX21ldGEsICJ0cm9waGljX2xldmVscy5jc3YiKSwgaGVhZGVyID0gVFJVRSwgc2VwID0gIjsiKQ0KcmZfcGxzX3JlcyA9IG1lcmdlKHJmX3Bsc19yZXMsIHRsLCBieS54ID0gInJlc3AiLCBieS55ID0gIlNwZWNpZXMiKQ0KcmZfcmZfcmVzID0gbWVyZ2UocmZfcmZfcmVzLCB0bCwgYnkueCA9ICJyZXNwIiwgYnkueSA9ICJTcGVjaWVzIikNCmBgYA0KDQojIENvbXBhcmUgUExTIGFuZCBSRg0KYGBge3IsIGVjaG89RkFMU0V9DQptb2RlbHNfcmVzJG1wdHlwZSA9IHBhc3RlMChtb2RlbHNfcmVzJG10eXBlLCAiXyIsIG1vZGVsc19yZXMkcHR5cGUpDQptb2RlbHNfcmVzJG1wdHlwZSA9IGZhY3Rvcihtb2RlbHNfcmVzJG1wdHlwZSkNCg0KDQpnZ3Bsb3QoZGF0YSA9IG1vZGVsc19yZXMsIGFlcyh4ID0gcmVzcCwgeSA9IFJNU0Vfbm9ybVNELCBmaWxsID0gbXB0eXBlKSkgKyANCiAgZ2VvbV9ib3hwbG90KCkgKw0KICB0aGVtZV9idygpICsgDQogIHRoZW1lKGF4aXMudGV4dC54ID0gZWxlbWVudF90ZXh0KGFuZ2xlID0gNDUsIGhqdXN0ID0gMSkpICsgDQogIGxhYnMobGlzdCh4ID0gIlNwZWNpZXMgZ3JvdXBzIiwgeSA9ICJSTVNFbiIsIGZpbGwgPSAiTW9kZWwgc2V0IikpDQpgYGANCg0KIyBDb2xsZWN0IHZhcmlhYmxlIGltcG9ydGFuY2UNCiMjIE51bWJlciBvZiB2YXJpYWJsZXMNCmBgYHtyfQ0KcmZfcGxzX3Jlc19sb25nID0gbWVsdChtb2RlbHNfcmVzW21vZGVsc19yZXMkUmVzYW1wbGUgPT0gIk1lYW4iLCBjKDIsMyw1KV0sIGlkLnZhcnMgPSBjKCJwdHlwZSIsICJyZXNwIikpDQpnZ3Bsb3QoZGF0YSA9IHJmX3Bsc19yZXNfbG9uZywgYWVzKHggPSB2YXJpYWJsZSwgeSA9IHZhbHVlLCBmaWxsID0gcHR5cGUpKSArDQogIGdlb21fYm94cGxvdCgpICsgDQogIGxhYnMobGlzdCh4ID0gIk1vZGVscyIsIHkgPSAiTnVtYmVyIG9mIHZhcmlhYmxlcyIgLA0KICAgICAgICAgICAgZmlsbCA9ICJQcmVkaWN0b3IgU2V0IikpICsNCiAgdGhlbWVfYncoKQ0KYGBgDQoNCg0KIyBWYXJpYWJsZSBpbXBvcnRhbmNlIGZvciBSRg0KYGBge3J9DQp2YXJfaW1wIDwtIGNvbXBWYXJJbXAoYWxsX21vZGVsc19yZXMkcmYkcmZfZWx1aV9yZXNAbW9kZWxbWzFdXSwgc2NhbGUgPSBGQUxTRSkNCiMgcGxvdFZhckltcCh2YXJfaW1wKQ0KcGxvdFZhckltcEhlYXRtYXAodmFyX2ltcCwgeGxhYiA9ICJTcGVjaWVzIiwgeWxhYiA9ICJCYW5kIikNCmBgYA0KDQoNCiMgVHJvcGhpYyBsZXZlbHMNCmBgYHtyfQ0KdmFyX2ltcF9sZXZlbHMgPSB2YXJfaW1wDQpmb3IoaSBpbiBzZXEobGVuZ3RoKHZhcl9pbXBfbGV2ZWxzKSkpew0KICBhY3Rfc3BlY2llcyA9IGdzdWIoIl9yZl9lbHVpX3JlcyIsICIiLCB2YXJfaW1wX2xldmVsc1tbaV1dJFJFU1BPTlNFWzFdKQ0KICB2YXJfaW1wX2xldmVsc1tbaV1dJFJFU1BPTlNFID0gdGwkTGV2ZWxbZ3JlcChhY3Rfc3BlY2llcywgdGwkU3BlY2llcyldDQp9DQpwbG90VmFySW1wSGVhdG1hcCh2YXJfaW1wX2xldmVscywgeGxhYiA9ICJTcGVjaWVzIiwgeWxhYiA9ICJCYW5kIikNCmBgYA0KDQpgYGB7cn0NCnQgPSBkby5jYWxsKCJyYmluZCIsIHZhcl9pbXApDQp0ID0gdFt0JG1lYW4+PTAuNixdDQp0JFJFU1BPTlNFID0gZ3N1YigiX3JmX2VsdWlfcmVzIiwgIiIsIHQkUkVTUE9OU0UpDQp0dCA9IHRhYmxlKHQkVkFSSUFCTEUsIHQkUkVTUE9OU0UpDQpwY2FfdHQgPC0gcHJjb21wKHR0LCBzY2FsZSA9IFRSVUUsIGNlbnRlciA9IFRSVUUpDQpwY2FfdmFyIDwtIGFzLmRhdGEuZnJhbWUocGNhX3R0JHJvdGF0aW9uKQ0KcGNhX29icyA8LSBhcy5kYXRhLmZyYW1lKHBjYV90dCR4KQ0KZ2dwbG90KHBjYV92YXIsIGFlcyhQQzEsIFBDMikpKw0KICBnZW9tX3BvaW50KCkrDQpnZW9tX3BvaW50KGRhdGEgPSBwY2Ffb2JzLCBhZXMoUEMxLCBQQzIpLCBjb2xvciA9ICJyZWQiKQ0KZ2diaXBsb3QocGNhX3R0LCBsYWJlbHMgPSByb3duYW1lcyhwY2FfdHQkeCksIGNob2ljZXMgPSAxOjIpDQpiaXBsb3QocGNhX3R0KQ0KYGBgDQoNCldoZW4geW91IHNhdmUgdGhlIG5vdGVib29rLCBhbiBIVE1MIGZpbGUgY29udGFpbmluZyB0aGUgY29kZSBhbmQgb3V0cHV0IHdpbGwgYmUgc2F2ZWQgYWxvbmdzaWRlIGl0IChjbGljayB0aGUgKlByZXZpZXcqIGJ1dHRvbiBvciBwcmVzcyAqQ3RybCtTaGlmdCtLKiB0byBwcmV2aWV3IHRoZSBIVE1MIGZpbGUpLg0KDQpUaGUgcHJldmlldyBzaG93cyB5b3UgYSByZW5kZXJlZCBIVE1MIGNvcHkgb2YgdGhlIGNvbnRlbnRzIG9mIHRoZSBlZGl0b3IuIENvbnNlcXVlbnRseSwgdW5saWtlICpLbml0KiwgKlByZXZpZXcqIGRvZXMgbm90IHJ1biBhbnkgUiBjb2RlIGNodW5rcy4gSW5zdGVhZCwgdGhlIG91dHB1dCBvZiB0aGUgY2h1bmsgd2hlbiBpdCB3YXMgbGFzdCBydW4gaW4gdGhlIGVkaXRvciBpcyBkaXNwbGF5ZWQuDQo=
diff --git a/src/001_functions.R b/src/functions/001_functions.R similarity index 100% rename from src/001_functions.R rename to src/functions/001_functions.R diff --git a/src/specVisKili.Rproj b/src/hySpecVisKili.Rproj similarity index 100% rename from src/specVisKili.Rproj rename to src/hySpecVisKili.Rproj From 04b31ff2737c03aac16d168b16c0b6a5484e2307 Mon Sep 17 00:00:00 2001 From: Thomas Nauss Date: Tue, 16 Jun 2020 22:33:32 +0200 Subject: [PATCH 58/65] Add LiDAR to predictor variables. --- src/000_set_environment.R | 7 +-- src/000_set_environment_linux.R | 4 +- src/010_biodiv_preprocessing.R | 2 +- src/100_combine_predictores_biodiv_sr.R | 15 +++++-- src/110_predict_biodiv_sr_rf.R | 45 ++++++++++++++++--- ..._combine_predictores_biodiv_sr_residuals.R | 2 +- src/210_predict_biodiv_sr_res_rf.R | 2 +- src/220_compile_analyse_biodiv_sr_elev_res.R | 2 +- src/300_predict_biodiv_sr_rf_indp.R | 2 +- ...ine_predictores_biodiv_sr_residuals_indp.R | 2 +- src/320_predict_biodiv_sr_rf_indp.R | 2 +- ...ld_120_combine_predictores_biodiv_tlevel.R | 2 +- 12 files changed, 64 insertions(+), 23 deletions(-) diff --git a/src/000_set_environment.R b/src/000_set_environment.R index 4ae145d..015ddd4 100644 --- a/src/000_set_environment.R +++ b/src/000_set_environment.R @@ -1,11 +1,11 @@ # Set path --------------------------------------------------------------------- if(Sys.info()["sysname"] == "Windows"){ - filepath_base = "C:/Users/Thomas Nauss/permanent/plygrnd/KI-Hyperspec/" + filepath_base = "D:/plygrnd/hySpecVisKili/" } else { filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/" } -filepath_source = paste0(filepath_base, "HySpec_KiLi/src/001_functions.R") +filepath_source = paste0(filepath_base, "hySpecVisKili/src/functions/001_functions.R") path_data = paste0(filepath_base, "/data/") path_biodiv = paste0(path_data, "/biodiv/") @@ -17,6 +17,7 @@ path_hyp_kmdc = paste0(path_data, "/050_hypspec_kmdc/") path_hyp_raoq = paste0(path_data, "/060_hypspec_raoq/") path_hyp_glcm = paste0(path_data, "/070_hypspec_glcm/") path_hyp_pred = paste0(path_data, "/090_hypspec_pred/") +path_ldr_pred = paste0(path_data, "/095_lidar_pred/") path_comb_gpm_sr = paste0(path_data, "/100_comb_gpm_sr/") path_model_gpm_sr = paste0(path_data, "/110_model_gpm_sr/") path_compile_analysis_sr = paste0(path_data, "/120_compile_analysis_sr/") @@ -46,7 +47,7 @@ library(grid) library(gridExtra) library(gpm) # devtools::install_github("environmentalinformatics-marburg/gpm") library(ggplot2) -library(ggbiplot) +# library(ggbiplot) library(hsdar) # library(lavaan) # library(rPointDB) diff --git a/src/000_set_environment_linux.R b/src/000_set_environment_linux.R index 7f27482..e3df02e 100644 --- a/src/000_set_environment_linux.R +++ b/src/000_set_environment_linux.R @@ -1,11 +1,11 @@ # Set path --------------------------------------------------------------------- if(Sys.info()["sysname"] == "Windows"){ - filepath_base = "C:/Users/tnauss/permanent/plygrnd/KI-Hyperspec/" + filepath_base = "D:/plygrnd/hySpecVisKili/" } else { filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/" } -filepath_source = paste0(filepath_base, "HySpec_KiLi/src/001_functions.R") +filepath_source = paste0(filepath_base, "hySpecVisKili/src/functions/001_functions.R") path_data = paste0(filepath_base, "/data/") path_biodiv = paste0(path_data, "/biodiv/") diff --git a/src/010_biodiv_preprocessing.R b/src/010_biodiv_preprocessing.R index 6199d78..38c8dd9 100644 --- a/src/010_biodiv_preprocessing.R +++ b/src/010_biodiv_preprocessing.R @@ -1,6 +1,6 @@ # Preprocess biodiversity observations. -source("C:/Users/Thomas Nauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +source("D:/plygrnd/hySpecVisKili/hySpecVisKili/src/000_set_environment.R") # Read species richness dataset (Peters et al. 2016) diff --git a/src/100_combine_predictores_biodiv_sr.R b/src/100_combine_predictores_biodiv_sr.R index 4e154a8..fc8d369 100644 --- a/src/100_combine_predictores_biodiv_sr.R +++ b/src/100_combine_predictores_biodiv_sr.R @@ -1,9 +1,14 @@ # Combine hyperspectral predictores and biodiversity variables in gpm class. -source("C:/Users/Thomas Nauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +source("D:/plygrnd/hySpecVisKili/hySpecVisKili/src/000_set_environment.R") -preds = readRDS(paste0(path_hyp_pred, "hyperspec_preds.rds")) +preds_hyspec = readRDS(paste0(path_hyp_pred, "hyperspec_preds.rds")) +preds_lidar = readRDS(file.path(path_ldr_pred, "lidar_preds.rds")) +preds_lidar = preds_lidar[, c(which(colnames(preds_lidar) == "plotID"), + seq(which(colnames(preds_lidar) == "AGB"), + ncol(preds_lidar)))] + # bd = readRDS(paste0(path_biodiv, "biodiv.rds")) species_richness = readRDS(paste0(path_biodiv, "species_richness.rds")) species_composition_dcor = readRDS(paste0(path_biodiv, "species_composition_dcor.rds")) @@ -22,7 +27,9 @@ for(i in seq(length(species_composition_dcor))){ comb = merge(comb, act, by = c("plotID"), all.x = TRUE, all.y = TRUE) } -comb = merge(comb, preds, by = c("plotID")) +comb = merge(comb, preds_hyspec, by = c("plotID")) +comb = merge(comb, preds_lidar, by = c("plotID")) + comb = droplevels(comb) comb$SelCat = substr(as.character(comb$plotID), 1, 3) @@ -41,7 +48,7 @@ col_diversity = seq(which("SRspiders" == colnames(comb)), col_precitors = c(which("elevation" == colnames(comb)), which("lui" == colnames(comb)), seq(which("CARI_mean" == colnames(comb)), - which("pcai_kmdc_raoq_sd" == colnames(comb)))) + which("scl_elevsq" == colnames(comb)))) col_meta = which(!seq(ncol(comb)) %in% c(col_selector, col_diversity, col_precitors)) diff --git a/src/110_predict_biodiv_sr_rf.R b/src/110_predict_biodiv_sr_rf.R index 8a51eb9..313316f 100644 --- a/src/110_predict_biodiv_sr_rf.R +++ b/src/110_predict_biodiv_sr_rf.R @@ -1,6 +1,6 @@ # Predict species richness using different models and predictor sets if(Sys.info()["sysname"] == "Windows"){ - filepath_base = "C:/Users/Thomas Nauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" + filepath_base = "D:/plygrnd/hySpecVisKili/hySpecVisKili/src/000_set_environment.R" } else { filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" } @@ -22,20 +22,53 @@ comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) # all data, and kmdc and raoq only using gam, pls and rf models. mtypes = c("gam", "pls", "rf") mtypes = c("rf") -ptypes = c("*elui*", "*spec*", "*elsp*", "*kmra*") +ptypes = c("*elui*", + "*spec*", "*elsp*", + "*lidr*", "*eldr*", + "*splr*", "*esld*", + "*kmra*") mt = mtypes[1] pt = ptypes[1] + +elui_cols = seq(which(comb@meta$input$PREDICTOR == "elevation"), + which(comb@meta$input$PREDICTOR == "lui")) + +spec_cols = seq(which(comb@meta$input$PREDICTOR == "CARI_mean"), + which(comb@meta$input$PREDICTOR == "pcai_kmdc_raoq_sd")) + +ldr_cols = seq(which(comb@meta$input$PREDICTOR == "AGB"), + which(comb@meta$input$PREDICTOR == "scl_elevsq")) + for(mt in mtypes){ for(pt in ptypes){ if(pt == "*elui*"){ - comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[c(1,2)] + comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[elui_cols] + } else if(pt == "*spec*"){ - comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[-c(1,2)] - } else if(pt == "*elsp*"){ - comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR + comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[spec_cols] + + } else if(pt == "*elsp*"){ + comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[c(elui_cols, + spec_cols)] + + } else if(pt == "*lidr*"){ + comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[ldr_cols] + + } else if(pt == "*eldr*"){ + comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[c(elui_cols, + ldr_cols)] + + } else if(pt == "*splr*"){ + comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[c(spec_cols, + ldr_cols)] + + } else if(pt == "*esld*"){ + comb@meta$input$PREDICTOR_FINAL = comb@meta$input$PREDICTOR[c(elui_cols, + spec_cols, + ldr_cols)] } else if(pt == "*kmra*"){ comb@meta$input$PREDICTOR_FINAL = unique(comb@meta$input$PREDICTOR[ c(grep("kmdc", comb@meta$input$PREDICTOR), diff --git a/src/200_combine_predictores_biodiv_sr_residuals.R b/src/200_combine_predictores_biodiv_sr_residuals.R index b4d0b66..6a0cf1c 100644 --- a/src/200_combine_predictores_biodiv_sr_residuals.R +++ b/src/200_combine_predictores_biodiv_sr_residuals.R @@ -1,6 +1,6 @@ # Compile species richness dataset containing residuals from some previous modelling if(Sys.info()["sysname"] == "Windows"){ - filepath_base = "C:/Users/Thomas Nauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" + filepath_base = "D:/plygrnd/hySpecVisKili/hySpecVisKili/src/000_set_environment.R" } else { filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" } diff --git a/src/210_predict_biodiv_sr_res_rf.R b/src/210_predict_biodiv_sr_res_rf.R index 4446afd..ac3a905 100644 --- a/src/210_predict_biodiv_sr_res_rf.R +++ b/src/210_predict_biodiv_sr_res_rf.R @@ -1,6 +1,6 @@ # comb_elev_resine hyperspectral predictores and biodiversity variables in gpm class. if(Sys.info()["sysname"] == "Windows"){ - filepath_base = "C:/Users/Thomas Nauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" + filepath_base = "D:/plygrnd/hySpecVisKili/hySpecVisKili/src/000_set_environment.R" } else { filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" } diff --git a/src/220_compile_analyse_biodiv_sr_elev_res.R b/src/220_compile_analyse_biodiv_sr_elev_res.R index e2161b5..17bed1d 100644 --- a/src/220_compile_analyse_biodiv_sr_elev_res.R +++ b/src/220_compile_analyse_biodiv_sr_elev_res.R @@ -1,5 +1,5 @@ # Combine species richness residual model results in one variable. -source("C:/Users/Thomas Nauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +source("D:/plygrnd/hySpecVisKili/hySpecVisKili/src/000_set_environment.R") dir.create(path_compile_analysis_sr_elev_res, showWarnings = FALSE) diff --git a/src/300_predict_biodiv_sr_rf_indp.R b/src/300_predict_biodiv_sr_rf_indp.R index 0a0b7ef..42abafa 100644 --- a/src/300_predict_biodiv_sr_rf_indp.R +++ b/src/300_predict_biodiv_sr_rf_indp.R @@ -2,7 +2,7 @@ # Predict species richness using different models and predictor sets if(Sys.info()["sysname"] == "Windows"){ - filepath_base = "C:/Users/Thomas Nauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" + filepath_base = "D:/plygrnd/hySpecVisKili/hySpecVisKili/src/000_set_environment.R" } else { filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" } diff --git a/src/310_combine_predictores_biodiv_sr_residuals_indp.R b/src/310_combine_predictores_biodiv_sr_residuals_indp.R index b99290f..253e66a 100644 --- a/src/310_combine_predictores_biodiv_sr_residuals_indp.R +++ b/src/310_combine_predictores_biodiv_sr_residuals_indp.R @@ -1,6 +1,6 @@ # Compile species richness dataset containing residuals from some previous modelling if(Sys.info()["sysname"] == "Windows"){ - filepath_base = "C:/Users/Thomas Nauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" + filepath_base = "D:/plygrnd/hySpecVisKili/hySpecVisKili/src/000_set_environment.R" } else { filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" } diff --git a/src/320_predict_biodiv_sr_rf_indp.R b/src/320_predict_biodiv_sr_rf_indp.R index 75c5141..db24516 100644 --- a/src/320_predict_biodiv_sr_rf_indp.R +++ b/src/320_predict_biodiv_sr_rf_indp.R @@ -2,7 +2,7 @@ # Predict species richness using different models and predictor sets if(Sys.info()["sysname"] == "Windows"){ - filepath_base = "C:/Users/Thomas Nauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R" + filepath_base = "D:/plygrnd/hySpecVisKili/hySpecVisKili/src/000_set_environment.R" } else { filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" } diff --git a/src/old_120_combine_predictores_biodiv_tlevel.R b/src/old_120_combine_predictores_biodiv_tlevel.R index ee7f0fb..74fddbe 100644 --- a/src/old_120_combine_predictores_biodiv_tlevel.R +++ b/src/old_120_combine_predictores_biodiv_tlevel.R @@ -1,7 +1,7 @@ # Combine hyperspectral predictores and biodiversity variables in gpm class # aggregated by trophic level. -source("C:/Users/Thomas Nauss/permanent/plygrnd/KI-Hyperspec/HySpec_KiLi/src/000_set_environment.R") +source("D:/plygrnd/hySpecVisKili/hySpecVisKili/src/000_set_environment.R") preds = readRDS(paste0(path_hyp_pred, "hyperspec_preds.rds")) From f07d34c2bebae3330c9e95be7caaf1a5574c252a Mon Sep 17 00:00:00 2001 From: Thomas Nauss Date: Tue, 16 Jun 2020 23:45:47 +0200 Subject: [PATCH 59/65] Update Lidar predictors. --- src/100_combine_predictores_biodiv_sr.R | 4 ++-- src/110_predict_biodiv_sr_rf.R | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/100_combine_predictores_biodiv_sr.R b/src/100_combine_predictores_biodiv_sr.R index fc8d369..63d9e7e 100644 --- a/src/100_combine_predictores_biodiv_sr.R +++ b/src/100_combine_predictores_biodiv_sr.R @@ -7,7 +7,7 @@ preds_hyspec = readRDS(paste0(path_hyp_pred, "hyperspec_preds.rds")) preds_lidar = readRDS(file.path(path_ldr_pred, "lidar_preds.rds")) preds_lidar = preds_lidar[, c(which(colnames(preds_lidar) == "plotID"), seq(which(colnames(preds_lidar) == "AGB"), - ncol(preds_lidar)))] + which(colnames(preds_lidar) == "qntl_rng")))] # bd = readRDS(paste0(path_biodiv, "biodiv.rds")) species_richness = readRDS(paste0(path_biodiv, "species_richness.rds")) @@ -63,4 +63,4 @@ comb <- gpm(comb, meta, scale = FALSE) dir.create(paste0(path_comb_gpm_sr), showWarnings = FALSE) -saveRDS(comb, file = paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) +saveRDS(comb, file = paste0(path_comb_gpm_sr, "ki_hyperspec_lidar_biodiv_non_scaled.rds")) diff --git a/src/110_predict_biodiv_sr_rf.R b/src/110_predict_biodiv_sr_rf.R index 313316f..9332f65 100644 --- a/src/110_predict_biodiv_sr_rf.R +++ b/src/110_predict_biodiv_sr_rf.R @@ -15,7 +15,7 @@ if(length(showConnections()) == 0){ dir.create(paste0(path_model_gpm_sr), showWarnings = FALSE) -comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_biodiv_non_scaled.rds")) +comb = readRDS(paste0(path_comb_gpm_sr, "ki_hyperspec_lidar_biodiv_non_scaled.rds")) # Predict with all elevation and lui information, hyperspectral data only, From bf9fb17e06d334a21fe97d54b37a4d902f77d968 Mon Sep 17 00:00:00 2001 From: Thomas Nauss Date: Tue, 16 Jun 2020 23:54:46 +0200 Subject: [PATCH 60/65] Adjust server path. --- src/000_set_environment_linux.R | 2 +- src/110_predict_biodiv_sr_rf.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/000_set_environment_linux.R b/src/000_set_environment_linux.R index e3df02e..34774e8 100644 --- a/src/000_set_environment_linux.R +++ b/src/000_set_environment_linux.R @@ -17,6 +17,7 @@ path_hyp_kmdc = paste0(path_data, "/050_hypspec_kmdc/") path_hyp_raoq = paste0(path_data, "/060_hypspec_raoq/") path_hyp_glcm = paste0(path_data, "/070_hypspec_glcm/") path_hyp_pred = paste0(path_data, "/090_hypspec_pred/") +path_ldr_pred = paste0(path_data, "/095_lidar_pred/") path_comb_gpm_sr = paste0(path_data, "/100_comb_gpm_sr/") path_model_gpm_sr = paste0(path_data, "/110_model_gpm_sr/") path_compile_analysis_sr = paste0(path_data, "/120_compile_analysis_sr/") @@ -29,7 +30,6 @@ path_model_gpm_sr_elev_res_indp = paste0(path_data, "/320_model_gpm_sr_elev_res_ path_analysis_sr = paste0(path_data, "/500_analysis_sr/") path_analysis_sr_elev_res = paste0(path_data, "/510_analysis_sr_elev_res/") - path_plots = paste0(path_data, "/plots/") path_rdata = paste0(path_data, "/rdata/") path_meta = paste0(path_data, "/meta/") diff --git a/src/110_predict_biodiv_sr_rf.R b/src/110_predict_biodiv_sr_rf.R index 9332f65..3b6038f 100644 --- a/src/110_predict_biodiv_sr_rf.R +++ b/src/110_predict_biodiv_sr_rf.R @@ -2,7 +2,7 @@ if(Sys.info()["sysname"] == "Windows"){ filepath_base = "D:/plygrnd/hySpecVisKili/hySpecVisKili/src/000_set_environment.R" } else { - filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/HySpec_KiLi/src/000_set_environment_linux.R" + filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/hySpecVisKili/src/000_set_environment_linux.R" } source(filepath_base) From fa1a8217e7dfeaf93e55da747b1de5cdf8922396 Mon Sep 17 00:00:00 2001 From: Thomas Nauss Date: Wed, 17 Jun 2020 00:15:37 +0200 Subject: [PATCH 61/65] Adjust for LiDAR processing. --- src/000_set_environment_linux.R | 2 +- src/100_combine_predictores_biodiv_sr.R | 2 +- src/110_predict_biodiv_sr_rf.R | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/000_set_environment_linux.R b/src/000_set_environment_linux.R index 34774e8..3c06631 100644 --- a/src/000_set_environment_linux.R +++ b/src/000_set_environment_linux.R @@ -39,7 +39,7 @@ path_vis = paste0(path_data, "/vis/") # Set libraries ---------------------------------------------------------------- -library(biodivTools) # devtools::install_github("environmentalinformatics-marburg/biodivTools") +#library(biodivTools) # devtools::install_github("environmentalinformatics-marburg/biodivTools") library(CAST) # library(corrplot) library(doParallel) diff --git a/src/100_combine_predictores_biodiv_sr.R b/src/100_combine_predictores_biodiv_sr.R index 63d9e7e..832c0c6 100644 --- a/src/100_combine_predictores_biodiv_sr.R +++ b/src/100_combine_predictores_biodiv_sr.R @@ -48,7 +48,7 @@ col_diversity = seq(which("SRspiders" == colnames(comb)), col_precitors = c(which("elevation" == colnames(comb)), which("lui" == colnames(comb)), seq(which("CARI_mean" == colnames(comb)), - which("scl_elevsq" == colnames(comb)))) + which("qntl_rng" == colnames(comb)))) col_meta = which(!seq(ncol(comb)) %in% c(col_selector, col_diversity, col_precitors)) diff --git a/src/110_predict_biodiv_sr_rf.R b/src/110_predict_biodiv_sr_rf.R index 3b6038f..d03e13c 100644 --- a/src/110_predict_biodiv_sr_rf.R +++ b/src/110_predict_biodiv_sr_rf.R @@ -39,7 +39,7 @@ spec_cols = seq(which(comb@meta$input$PREDICTOR == "CARI_mean"), which(comb@meta$input$PREDICTOR == "pcai_kmdc_raoq_sd")) ldr_cols = seq(which(comb@meta$input$PREDICTOR == "AGB"), - which(comb@meta$input$PREDICTOR == "scl_elevsq")) + which(comb@meta$input$PREDICTOR == "qntl_rng")) for(mt in mtypes){ for(pt in ptypes){ From d1cda3ae7baee4b02507b79929487ae8f52b5453 Mon Sep 17 00:00:00 2001 From: Thomas Nauss Date: Fri, 19 Jun 2020 21:29:49 +0200 Subject: [PATCH 62/65] Adjust some scripts. --- src/000_setup_windows.R | 2 +- src/110_predict_biodiv_sr_rf.R | 2 +- src/120_compile_analyse_biodiv_sr.R | 21 +- src/500_analyse_biodiv_sr.Rmd | 23 +- src/500_analyse_biodiv_sr.nb.html | 1673 ++++++++++++++++++++++++++- src/functions/001_functions.R | 9 +- 6 files changed, 1679 insertions(+), 51 deletions(-) diff --git a/src/000_setup_windows.R b/src/000_setup_windows.R index 2a3e6bd..f89a830 100644 --- a/src/000_setup_windows.R +++ b/src/000_setup_windows.R @@ -33,7 +33,7 @@ project_folders = c("data/", "data/temp/") libs = c("biodivTools", "CAST", "corrplot", "doParallel", "grid", "gridExtra", - "gpm", "ggplot2", "ggbiplot", "hsdar", "rgeos", "ggplot2", "mapview", + "gpm", "ggplot2", "hsdar", "rgeos", "ggplot2", "mapview", "raster", "RStoolbox", "reshape2", "rgdal", "satelliteTools", "sp", "spacetime", "vegan") diff --git a/src/110_predict_biodiv_sr_rf.R b/src/110_predict_biodiv_sr_rf.R index d03e13c..6181d2f 100644 --- a/src/110_predict_biodiv_sr_rf.R +++ b/src/110_predict_biodiv_sr_rf.R @@ -29,7 +29,7 @@ ptypes = c("*elui*", "*kmra*") mt = mtypes[1] -pt = ptypes[1] +pt = ptypes[2] elui_cols = seq(which(comb@meta$input$PREDICTOR == "elevation"), diff --git a/src/120_compile_analyse_biodiv_sr.R b/src/120_compile_analyse_biodiv_sr.R index 8f8e36f..32ebe06 100644 --- a/src/120_compile_analyse_biodiv_sr.R +++ b/src/120_compile_analyse_biodiv_sr.R @@ -1,24 +1,27 @@ # Combine species richness model results in one variable. - +require(envimaR) root_folder = path.expand("~/plygrnd/hySpecVisKili/") source(file.path(root_folder, "hySpecVisKili/src/000_setup_windows.R")) -dir.create(path_compile_analysis_sr, showWarnings = FALSE) +dir.create(envrmt$path_120_compile_analysis_sr, showWarnings = FALSE) # Combine all models into one gpm object -# mtypes = c("*gam*", "*pls*", "*rf*") -mtypes = c("*rf*") +# mtypes = c("gam", "pls", "rf") +mtypes = c("rf") + + all_models = lapply(mtypes, function(mt){ - if(mt == "*gam*"){ + if(mt == "gam"){ ptypes = c("*elev*", "*elui*", "*kmra*", "*spec*", "*elsp*") } else { - ptypes = c("*elui*", "*kmra*", "*spec*", "*elsp*") + ptypes = c("*elui*", "*spec*", "*elsp*", "*lidr*", "*eldr*", + "*splr*", "*esld*", "*kmra*") } all_pmodels = lapply(ptypes, function(pt){ - model_files = list.files(path_model_gpm_sr, full.names = TRUE, - pattern = glob2rx(paste0(pt, mt))) + model_files = list.files(envrmt$path_110_model_gpm_sr, full.names = TRUE, + pattern = glob2rx(paste0(pt, mt, "*"))) all_models = readRDS(model_files[[1]]) @@ -33,7 +36,7 @@ all_models = lapply(mtypes, function(mt){ }) names(all_models) = gsub("[*]", "", gsub("_", "", mtypes)) -saveRDS(all_models, file = file.path(path_compile_analysis_sr, +saveRDS(all_models, file = file.path(envrmt$path_120_compile_analysis_sr, "models_sr.rds")) diff --git a/src/500_analyse_biodiv_sr.Rmd b/src/500_analyse_biodiv_sr.Rmd index 808aee1..7a1ba45 100644 --- a/src/500_analyse_biodiv_sr.Rmd +++ b/src/500_analyse_biodiv_sr.Rmd @@ -1,14 +1,20 @@ --- title: "500 Analyse Biodiv-RS" output: html_notebook +editor_options: + chunk_output_type: console --- ```{r, include = FALSE} # Set up working environment and defaults -------------------------------------- -root_folder = path.expand("~/plygrnd/hySpecVisKili/") -source(file.path(root_folder, "hySpecVisKili/src/000_setup_windows.R")) +if(Sys.info()["sysname"] == "Windows"){ + filepath_base = "D:/plygrnd/hySpecVisKili/hySpecVisKili/src/000_set_environment.R" +} else { + filepath_base = "/mnt/sd19006/data/users/tnauss/KI-Hyperspec/hySpecVisKili/src/000_set_environment_linux.R" +} +source(filepath_base) -all_models = readRDS(file.path(envrmt$path_120_compile_analysis_sr, +all_models = readRDS(file.path(path_compile_analysis_sr, "models_sr.rds")) # Collect model performance @@ -39,6 +45,17 @@ rf_sr$resp = as.character(rf_sr$resp) rf_sr$resp = substr(rf_sr$resp, 3, nchar(rf_sr$resp)) rf_sr$resp = gsub("(^[[:alpha:]])", "\\U\\1", rf_sr$resp, perl=TRUE) rf_sr$resp = factor(rf_sr$resp, unique(rf_sr$resp[order(rf_sr$Level, rf_sr$resp)])) + + +rf_sr$mptype = paste0(rf_sr$mtype, "_", rf_sr$ptype) +ggplot(data = rf_sr[rf_sr$mtype == "rf",], + aes(x = resp, y = RMSE_normSD, fill = mptype)) + + geom_boxplot() + + geom_hline(yintercept=c(0.5,1), linetype="dashed", color = "black") + + scale_fill_brewer(palette="Dark2") + + theme_bw() + + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + + labs(list(x = "Species groups", y = "RMSEn", fill = "Model set")) ``` # Compare PLS and RF diff --git a/src/500_analyse_biodiv_sr.nb.html b/src/500_analyse_biodiv_sr.nb.html index 9b0d2a5..1be7136 100644 --- a/src/500_analyse_biodiv_sr.nb.html +++ b/src/500_analyse_biodiv_sr.nb.html @@ -1,31 +1,1554 @@ - + - + 500 Analyse Biodiv-RS - + - - - - - - - - - - - + + + + + + + + + + + - - -
- - + + - + + + + + +
+ + -
LS0tDQp0aXRsZTogIjUwMCBBbmFseXNlIEJpb2Rpdi1SUyINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCmBgYHtyLCBpbmNsdWRlID0gRkFMU0V9DQojIFNldCB1cCB3b3JraW5nIGVudmlyb25tZW50IGFuZCBkZWZhdWx0cyAtLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLQ0Kcm9vdF9mb2xkZXIgPSBwYXRoLmV4cGFuZCgifi9wbHlncm5kL2h5U3BlY1Zpc0tpbGkvIikNCnNvdXJjZShmaWxlLnBhdGgocm9vdF9mb2xkZXIsICJoeVNwZWNWaXNLaWxpL3NyYy8wMDBfc2V0dXBfd2luZG93cy5SIikpDQoNCmFsbF9tb2RlbHMgPSByZWFkUkRTKGZpbGUucGF0aChlbnZybXQkcGF0aF8xMjBfY29tcGlsZV9hbmFseXNpc19zciwgDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIm1vZGVsc19zci5yZHMiKSkNCg0KIyBDb2xsZWN0IG1vZGVsIHBlcmZvcm1hbmNlDQpnYW1fc3IgPSBtb2RlbFBlcmZvcm1hbmNlKGFsbF9tb2RlbHNbWyJnYW0iXV0pDQpwbHNfc3IgPSBtb2RlbFBlcmZvcm1hbmNlKGFsbF9tb2RlbHNbWyJwbHMiXV0pDQpyZl9zciA9IG1vZGVsUGVyZm9ybWFuY2UoYWxsX21vZGVsc1tbInJmIl1dKQ0KDQpzdW1tYXJ5KGdhbV9zcikNCnN1bW1hcnkocGxzX3NyKQ0Kc3VtbWFyeShyZl9zcikNCg0KIyBHZXQgdHJvcGhpYyBsZXZlbHMNCnRsID0gcmVhZC50YWJsZShmaWxlLnBhdGgocGF0aF9tZXRhLCAidHJvcGhpY19sZXZlbHMuY3N2IiksIGhlYWRlciA9IFRSVUUsIHNlcCA9ICI7IikNCmdhbV9zciA9IG1lcmdlKGdhbV9zciwgdGwsIGJ5LnggPSAicmVzcCIsIGJ5LnkgPSAiU3BlY2llcyIpDQpwbHNfc3IgPSBtZXJnZShwbHNfc3IsIHRsLCBieS54ID0gInJlc3AiLCBieS55ID0gIlNwZWNpZXMiKQ0KcmZfc3IgPSBtZXJnZShyZl9zciwgdGwsIGJ5LnggPSAicmVzcCIsIGJ5LnkgPSAiU3BlY2llcyIpDQoNCiMgQXJyYW5nZSBsZXZlbHMgYW5kIHNwZWNpZXMgbmFtZXMNCnBsc19zciRMZXZlbCA9IGZhY3RvcihwbHNfc3IkTGV2ZWwsIGxldmVscyhwbHNfc3IkTGV2ZWwpW2MoMSwgNSwgNCwgMywgNiwgMildICkNCnBsc19zciRyZXNwID0gYXMuY2hhcmFjdGVyKHBsc19zciRyZXNwKQ0KcGxzX3NyJHJlc3AgPSBzdWJzdHIocGxzX3NyJHJlc3AsIDMsIG5jaGFyKHBsc19zciRyZXNwKSkNCnBsc19zciRyZXNwID0gZ3N1YigiKF5bWzphbHBoYTpdXSkiLCAiXFxVXFwxIiwgcGxzX3NyJHJlc3AsIHBlcmw9VFJVRSkNCnBsc19zciRyZXNwID0gZmFjdG9yKHBsc19zciRyZXNwLCB1bmlxdWUocGxzX3NyJHJlc3Bbb3JkZXIocGxzX3NyJExldmVsLCBwbHNfc3IkcmVzcCldKSkNCg0KDQpyZl9zciRMZXZlbCA9IGZhY3RvcihyZl9zciRMZXZlbCwgbGV2ZWxzKHJmX3NyJExldmVsKVtjKDEsIDUsIDQsIDMsIDYsIDIpXSApDQpyZl9zciRyZXNwID0gYXMuY2hhcmFjdGVyKHJmX3NyJHJlc3ApDQpyZl9zciRyZXNwID0gc3Vic3RyKHJmX3NyJHJlc3AsIDMsIG5jaGFyKHJmX3NyJHJlc3ApKQ0KcmZfc3IkcmVzcCA9IGdzdWIoIiheW1s6YWxwaGE6XV0pIiwgIlxcVVxcMSIsIHJmX3NyJHJlc3AsIHBlcmw9VFJVRSkNCnJmX3NyJHJlc3AgPSBmYWN0b3IocmZfc3IkcmVzcCwgdW5pcXVlKHJmX3NyJHJlc3Bbb3JkZXIocmZfc3IkTGV2ZWwsIHJmX3NyJHJlc3ApXSkpDQpgYGANCg0KIyBDb21wYXJlIFBMUyBhbmQgUkYNCmBgYHtyLCBlY2hvPUZBTFNFfQ0KbW9kZWxzX3NyID0gcmJpbmQocGxzX3NyWywgLTRdLCByZl9zclssIC00XSkNCm1vZGVsc19zciRtcHR5cGUgPSBwYXN0ZTAobW9kZWxzX3NyJG10eXBlLCAiXyIsIG1vZGVsc19zciRwdHlwZSkNCm1vZGVsc19zciRtcHR5cGUgPSBmYWN0b3IobW9kZWxzX3NyJG1wdHlwZSwgbGV2ZWxzID0gYygicGxzX2Vsc3AiLCAicmZfZWxzcCIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgInBsc19lbHVpIiwgInJmX2VsdWkiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICJwbHNfa21yYSIsICJyZl9rbXJhIiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAicGxzX3NwZWMiLCAicmZfc3BlYyIpKQ0KDQpnZ3Bsb3QoZGF0YSA9IG1vZGVsc19zclttb2RlbHNfc3IkbXR5cGUgPT0gInBscyIgJiANCiAgICAgICAgICAgICAgICAgICAgICAgICAgKG1vZGVsc19zciRwdHlwZSA9PSAiZWx1aSIgfCBtb2RlbHNfc3IkcHR5cGUgPT0gInNwZWMiKSxdLCANCiAgICAgICBhZXMoeCA9IHJlc3AsIHkgPSBSTVNFX25vcm1TRCwgZmlsbCA9IG1wdHlwZSkpICsgDQogIGdlb21fYm94cGxvdCgpICsNCiAgZ2VvbV9obGluZSh5aW50ZXJjZXB0PWMoMC41LDEpLCBsaW5ldHlwZT0iZGFzaGVkIiwgY29sb3IgPSAiYmxhY2siKSArIA0KICBzY2FsZV9maWxsX2JyZXdlcihwYWxldHRlPSJEYXJrMiIpICsgDQogIHRoZW1lX2J3KCkgKyANCiAgdGhlbWUoYXhpcy50ZXh0LnggPSBlbGVtZW50X3RleHQoYW5nbGUgPSA0NSwgaGp1c3QgPSAxKSkgKyANCiAgbGFicyhsaXN0KHggPSAiU3BlY2llcyBncm91cHMiLCB5ID0gIlJNU0VuIiwgZmlsbCA9ICJNb2RlbCBzZXQiKSkNCg0KDQoNCmdncGxvdChkYXRhID0gbW9kZWxzX3NyW21vZGVsc19zciRtdHlwZSA9PSAicmYiICYgDQogICAgICAgICAgICAgICAgICAgICAgICAgIChtb2RlbHNfc3IkcHR5cGUgPT0gImVsdWkiIHwgbW9kZWxzX3NyJHB0eXBlID09ICJzcGVjIiksXSwgDQogICAgICAgYWVzKHggPSByZXNwLCB5ID0gUk1TRV9ub3JtU0QsIGZpbGwgPSBtcHR5cGUpKSArIA0KICBnZW9tX2JveHBsb3QoKSArDQogIGdlb21faGxpbmUoeWludGVyY2VwdD1jKDAuNSwxKSwgbGluZXR5cGU9ImRhc2hlZCIsIGNvbG9yID0gImJsYWNrIikgKyANCiAgc2NhbGVfZmlsbF9icmV3ZXIocGFsZXR0ZT0iRGFyazIiKSArIA0KICB0aGVtZV9idygpICsgDQogIHRoZW1lKGF4aXMudGV4dC54ID0gZWxlbWVudF90ZXh0KGFuZ2xlID0gNDUsIGhqdXN0ID0gMSkpICsgDQogIGxhYnMobGlzdCh4ID0gIlNwZWNpZXMgZ3JvdXBzIiwgeSA9ICJSTVNFbiIsIGZpbGwgPSAiTW9kZWwgc2V0IikpDQoNCg0KZ2dwbG90KGRhdGEgPSBtb2RlbHNfc3JbbW9kZWxzX3NyJG10eXBlID09ICJyZiIgJiBtb2RlbHNfc3IkcHR5cGUgPT0gInNwZWMiLF0sIA0KICAgICAgIGFlcyh4ID0gcmVzcCwgeSA9IFJNU0Vfbm9ybVNELCBmaWxsID0gTGV2ZWwpKSArIA0KICBnZW9tX2JveHBsb3QoKSArDQogIGdlb21faGxpbmUoeWludGVyY2VwdD1jKDAuNSwxKSwgbGluZXR5cGU9ImRhc2hlZCIsIGNvbG9yID0gImJsYWNrIikgKyANCiAgc2NhbGVfZmlsbF9icmV3ZXIocGFsZXR0ZT0iRGFyazIiKSArIA0KICB0aGVtZV9idygpICsgDQogIHRoZW1lKGF4aXMudGV4dC54ID0gZWxlbWVudF90ZXh0KGFuZ2xlID0gNDUsIGhqdXN0ID0gMSkpICsgDQogIGxhYnMobGlzdCh4ID0gIlNwZWNpZXMgcmljaG5lc3MiLCB5ID0gIlJNU0VuIiwgZmlsbCA9ICJUcm9waGljIGxldmVsIikpDQpgYGANCg0KYGBge3IsIGVjaG89RkFMU0V9DQpwbHNfcmZfc3IgPSBtZXJnZShwbHNfc3IsIHJmX3NyLCBieSA9IGMoInB0eXBlIiwgInJlc3AiLCAiUmVzYW1wbGUiKSwgYWxsLnkgPSBUUlVFKQ0KY29sbmFtZXMocGxzX3JmX3NyKVtncmVwKCJcXC54IiwgY29sbmFtZXMocGxzX3JmX3NyKSldID0gDQogIGdzdWIoIlxcLngiLCAiX3BscyIsIGNvbG5hbWVzKHBsc19yZl9zcilbZ3JlcCgiXFwueCIsIGNvbG5hbWVzKHBsc19yZl9zcikpXSkNCmNvbG5hbWVzKHBsc19yZl9zcilbZ3JlcCgiXFwueSIsIGNvbG5hbWVzKHBsc19yZl9zcikpXSA9IA0KICBnc3ViKCJcXC55IiwgIl9yZiIsIGNvbG5hbWVzKHBsc19yZl9zcilbZ3JlcCgiXFwueSIsIGNvbG5hbWVzKHBsc19yZl9zcikpXSkNCiMgbnJvdyhwbHNfcmZfc3IpDQoNCnB0eXBlcyA9IGMoImVsdWkiLCAia21yYSIsICJzcGVjIiwgImVsc3AiKQ0KcGVyZl9jaGVjayA9IGxhcHBseShwdHlwZXMsIGZ1bmN0aW9uKHB0KXsNCiAgc3ViZGYgPSBwbHNfcmZfc3JbIWlzLm5hKHBsc19yZl9zciRSTVNFX3BscykgJiANCiAgICAgICAgICAgICAgICAgICAgICBwbHNfcmZfc3IkcHR5cGUgPT0gcHQgJg0KICAgICAgICAgICAgICAgICAgICAgIHBsc19yZl9zciRSZXNhbXBsZSA9PSAiTWVhbiIsIF0NCiAgcm93bmFtZXMoc3ViZGZbc3ViZGYkUk1TRV9wbHMgPCBzdWJkZiRSTVNFX3JmLCBdKQ0KfSkNCm5hbWVzKHBlcmZfY2hlY2spID0gcHR5cGVzDQpgYGANCg0KIyBDaGVjayBwZXJmb3JtYW5jZSBvZiBQTFMgYW5kIFJGDQpgYGB7ciwgZWNobyA9IEZBTFNFfQ0KZm9yKGkgaW4gc2VxKGxlbmd0aChwZXJmX2NoZWNrKSkpew0KICBybXNlX3BlcmYgPSBzb3J0KHJvdW5kKDEtcGxzX3JmX3NyW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIlJNU0VfcGxzIl0gLyANCiAgICAgICAgICAgICAgICAgICAgICAgICAgIHBsc19yZl9zclthcy5udW1lcmljKHBlcmZfY2hlY2tbW2ldXSksICJSTVNFX3JmIl0sMikpDQogIHZhcl9yZl9wcmN0ID0gc29ydChyb3VuZChwbHNfcmZfc3JbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLCAibnZhcnNfcmYiXSAvIA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICBwbHNfcmZfc3JbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLCAibnZhcnNfcGxzIl0sMikpDQogIGxldmVsX3BscyA9IHNvcnQodGFibGUocGxzX3JmX3NyW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIkxldmVsX3BscyJdKSkNCiAgcHJpbnQobmFtZXMocGVyZl9jaGVja1tpXSkpDQogIHByaW50KHBsc19yZl9zclthcy5udW1lcmljKHBlcmZfY2hlY2tbW2ldXSksXSkNCiAgY2F0KCJSTVNFICgxIC0gUExTL1JGKToiLCBybXNlX3BlcmYsICJcbiIpDQogIGNhdCgiVmFyIG51bWJlciAoUkYvUExTKToiLCB2YXJfcmZfcHJjdCwgIlxuIikNCiAgY2F0KCJMZXZlbHMgd2l0aCBQTFMgaXMgYmV0dGVyOiIsIGxldmVsX3BscywgIlxuIikNCiAgY2F0KCJcblxuIikNCn0NCmBgYA0KDQojIENvbGxlY3QgdmFyaWFibGUgaW1wb3J0YW5jZQ0KIyMgTnVtYmVyIG9mIHZhcmlhYmxlcw0KYGBge3J9DQpwbHNfcmZfc3JfbG9uZyA9IG1lbHQocGxzX3JmX3NyW3Bsc19yZl9zciRSZXNhbXBsZSA9PSAiTWVhbiIsIGMoMSwgMiwgNiwgMTMpXSwgaWQudmFycyA9IGMoInB0eXBlIiwgInJlc3AiKSkNCmdncGxvdChkYXRhID0gcGxzX3JmX3NyX2xvbmcsIGFlcyh4ID0gdmFyaWFibGUsIHkgPSB2YWx1ZSwgZmlsbCA9IHB0eXBlKSkgKw0KICBnZW9tX2JveHBsb3QoKSArIA0KICBsYWJzKGxpc3QoeCA9ICJNb2RlbHMiLCB5ID0gIk51bWJlciBvZiB2YXJpYWJsZXMiICwNCiAgICAgICAgICAgIGZpbGwgPSAiUHJlZGljdG9yIFNldCIpKSArDQogIHRoZW1lX2J3KCkNCmBgYA0KDQoNCiMgVmFyaWFibGUgaW1wb3J0YW5jZSBmb3IgUExTDQpgYGB7ciwgZWNobz1GQUxTRX0NCnZhcl9pbXAgPC0gY29tcFZhckltcChhbGxfbW9kZWxzW1sicGxzIl1dW1sic3BlYyJdXUBtb2RlbFtbMV1dLCBzY2FsZSA9IEZBTFNFKQ0KIyBwbG90VmFySW1wKHZhcl9pbXApDQpwbG90VmFySW1wSGVhdG1hcCh2YXJfaW1wLCB4bGFiID0gIlNwZWNpZXMiLCB5bGFiID0gIkJhbmQiKQ0KYGBgDQoNCiMgVmFyaWFibGUgaW1wb3J0YW5jZSBmb3IgUkYNCmBgYHtyLCBlY2hvPUZBTFNFfQ0KdmFyX2ltcCA8LSBjb21wVmFySW1wKGFsbF9tb2RlbHNbWyJyZiJdXVtbInNwZWMiXV1AbW9kZWxbWzFdXSwgc2NhbGUgPSBGQUxTRSkNCiMgcGxvdFZhckltcCh2YXJfaW1wKQ0KcGxvdFZhckltcEhlYXRtYXAodmFyX2ltcCwgeGxhYiA9ICJTcGVjaWVzIiwgeWxhYiA9ICJCYW5kIikNCmBgYA0KDQoNCiMgVHJvcGhpYyBsZXZlbHMNCmBgYHtyfQ0KdmFyX2ltcF9sZXZlbHMgPSB2YXJfaW1wDQpmb3IoaSBpbiBzZXEobGVuZ3RoKHZhcl9pbXBfbGV2ZWxzKSkpew0KICB2YXJfaW1wX2xldmVsc1tbaV1dJFJFU1BPTlNFID0gdGwkTGV2ZWxbZ3JlcCh2YXJfaW1wX2xldmVsc1tbaV1dJFJFU1BPTlNFWzFdLCB0bCRTcGVjaWVzKV0NCn0NCnBsb3RWYXJJbXBIZWF0bWFwKHZhcl9pbXBfbGV2ZWxzLCB4bGFiID0gIlNwZWNpZXMiLCB5bGFiID0gIkJhbmQiKQ0KYGBgDQoNCg0KDQoNCldoZW4geW91IHNhdmUgdGhlIG5vdGVib29rLCBhbiBIVE1MIGZpbGUgY29udGFpbmluZyB0aGUgY29kZSBhbmQgb3V0cHV0IHdpbGwgYmUgc2F2ZWQgYWxvbmdzaWRlIGl0IChjbGljayB0aGUgKlByZXZpZXcqIGJ1dHRvbiBvciBwcmVzcyAqQ3RybCtTaGlmdCtLKiB0byBwcmV2aWV3IHRoZSBIVE1MIGZpbGUpLg0KDQpUaGUgcHJldmlldyBzaG93cyB5b3UgYSByZW5kZXJlZCBIVE1MIGNvcHkgb2YgdGhlIGNvbnRlbnRzIG9mIHRoZSBlZGl0b3IuIENvbnNlcXVlbnRseSwgdW5saWtlICpLbml0KiwgKlByZXZpZXcqIGRvZXMgbm90IHJ1biBhbnkgUiBjb2RlIGNodW5rcy4gSW5zdGVhZCwgdGhlIG91dHB1dCBvZiB0aGUgY2h1bmsgd2hlbiBpdCB3YXMgbGFzdCBydW4gaW4gdGhlIGVkaXRvciBpcyBkaXNwbGF5ZWQuDQo=
+
LS0tDQp0aXRsZTogIjUwMCBBbmFseXNlIEJpb2Rpdi1SUyINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCmBgYHtyLCBpbmNsdWRlID0gRkFMU0V9DQojIFNldCB1cCB3b3JraW5nIGVudmlyb25tZW50IGFuZCBkZWZhdWx0cyAtLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLQ0KcmVxdWlyZShlbnZpbWFSKQ0Kcm9vdF9mb2xkZXIgPSBwYXRoLmV4cGFuZCgifi9wbHlncm5kL2h5U3BlY1Zpc0tpbGkvIikNCnNvdXJjZShmaWxlLnBhdGgocm9vdF9mb2xkZXIsICJoeVNwZWNWaXNLaWxpL3NyYy8wMDBfc2V0dXBfd2luZG93cy5SIikpDQoNCmFsbF9tb2RlbHMgPSByZWFkUkRTKGZpbGUucGF0aChlbnZybXQkcGF0aF8xMjBfY29tcGlsZV9hbmFseXNpc19zciwgDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIm1vZGVsc19zci5yZHMiKSkNCg0KIyBDb2xsZWN0IG1vZGVsIHBlcmZvcm1hbmNlDQpnYW1fc3IgPSBtb2RlbFBlcmZvcm1hbmNlKGFsbF9tb2RlbHNbWyJnYW0iXV0pDQpwbHNfc3IgPSBtb2RlbFBlcmZvcm1hbmNlKGFsbF9tb2RlbHNbWyJwbHMiXV0pDQpyZl9zciA9IG1vZGVsUGVyZm9ybWFuY2UoYWxsX21vZGVsc1tbInJmIl1dKQ0KDQpzdW1tYXJ5KGdhbV9zcikNCnN1bW1hcnkocGxzX3NyKQ0Kc3VtbWFyeShyZl9zcikNCg0KIyBHZXQgdHJvcGhpYyBsZXZlbHMNCnRsID0gcmVhZC50YWJsZShmaWxlLnBhdGgocGF0aF9tZXRhLCAidHJvcGhpY19sZXZlbHMuY3N2IiksIGhlYWRlciA9IFRSVUUsIHNlcCA9ICI7IikNCmdhbV9zciA9IG1lcmdlKGdhbV9zciwgdGwsIGJ5LnggPSAicmVzcCIsIGJ5LnkgPSAiU3BlY2llcyIpDQpwbHNfc3IgPSBtZXJnZShwbHNfc3IsIHRsLCBieS54ID0gInJlc3AiLCBieS55ID0gIlNwZWNpZXMiKQ0KcmZfc3IgPSBtZXJnZShyZl9zciwgdGwsIGJ5LnggPSAicmVzcCIsIGJ5LnkgPSAiU3BlY2llcyIpDQoNCiMgQXJyYW5nZSBsZXZlbHMgYW5kIHNwZWNpZXMgbmFtZXMNCnBsc19zciRMZXZlbCA9IGZhY3RvcihwbHNfc3IkTGV2ZWwsIGxldmVscyhwbHNfc3IkTGV2ZWwpW2MoMSwgNSwgNCwgMywgNiwgMildICkNCnBsc19zciRyZXNwID0gYXMuY2hhcmFjdGVyKHBsc19zciRyZXNwKQ0KcGxzX3NyJHJlc3AgPSBzdWJzdHIocGxzX3NyJHJlc3AsIDMsIG5jaGFyKHBsc19zciRyZXNwKSkNCnBsc19zciRyZXNwID0gZ3N1YigiKF5bWzphbHBoYTpdXSkiLCAiXFxVXFwxIiwgcGxzX3NyJHJlc3AsIHBlcmw9VFJVRSkNCnBsc19zciRyZXNwID0gZmFjdG9yKHBsc19zciRyZXNwLCB1bmlxdWUocGxzX3NyJHJlc3Bbb3JkZXIocGxzX3NyJExldmVsLCBwbHNfc3IkcmVzcCldKSkNCg0KDQpyZl9zciRMZXZlbCA9IGZhY3RvcihyZl9zciRMZXZlbCwgbGV2ZWxzKHJmX3NyJExldmVsKVtjKDEsIDUsIDQsIDMsIDYsIDIpXSApDQpyZl9zciRyZXNwID0gYXMuY2hhcmFjdGVyKHJmX3NyJHJlc3ApDQpyZl9zciRyZXNwID0gc3Vic3RyKHJmX3NyJHJlc3AsIDMsIG5jaGFyKHJmX3NyJHJlc3ApKQ0KcmZfc3IkcmVzcCA9IGdzdWIoIiheW1s6YWxwaGE6XV0pIiwgIlxcVVxcMSIsIHJmX3NyJHJlc3AsIHBlcmw9VFJVRSkNCnJmX3NyJHJlc3AgPSBmYWN0b3IocmZfc3IkcmVzcCwgdW5pcXVlKHJmX3NyJHJlc3Bbb3JkZXIocmZfc3IkTGV2ZWwsIHJmX3NyJHJlc3ApXSkpDQpgYGANCg0KIyBDb21wYXJlIFBMUyBhbmQgUkYNCmBgYHtyLCBlY2hvPUZBTFNFfQ0KbW9kZWxzX3NyID0gcmJpbmQocGxzX3NyWywgLTRdLCByZl9zclssIC00XSkNCm1vZGVsc19zciRtcHR5cGUgPSBwYXN0ZTAobW9kZWxzX3NyJG10eXBlLCAiXyIsIG1vZGVsc19zciRwdHlwZSkNCm1vZGVsc19zciRtcHR5cGUgPSBmYWN0b3IobW9kZWxzX3NyJG1wdHlwZSwgbGV2ZWxzID0gYygicGxzX2Vsc3AiLCAicmZfZWxzcCIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgInBsc19lbHVpIiwgInJmX2VsdWkiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICJwbHNfa21yYSIsICJyZl9rbXJhIiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAicGxzX3NwZWMiLCAicmZfc3BlYyIpKQ0KDQpnZ3Bsb3QoZGF0YSA9IG1vZGVsc19zclttb2RlbHNfc3IkbXR5cGUgPT0gInBscyIgJiANCiAgICAgICAgICAgICAgICAgICAgICAgICAgKG1vZGVsc19zciRwdHlwZSA9PSAiZWx1aSIgfCBtb2RlbHNfc3IkcHR5cGUgPT0gInNwZWMiKSxdLCANCiAgICAgICBhZXMoeCA9IHJlc3AsIHkgPSBSTVNFX25vcm1TRCwgZmlsbCA9IG1wdHlwZSkpICsgDQogIGdlb21fYm94cGxvdCgpICsNCiAgZ2VvbV9obGluZSh5aW50ZXJjZXB0PWMoMC41LDEpLCBsaW5ldHlwZT0iZGFzaGVkIiwgY29sb3IgPSAiYmxhY2siKSArIA0KICBzY2FsZV9maWxsX2JyZXdlcihwYWxldHRlPSJEYXJrMiIpICsgDQogIHRoZW1lX2J3KCkgKyANCiAgdGhlbWUoYXhpcy50ZXh0LnggPSBlbGVtZW50X3RleHQoYW5nbGUgPSA0NSwgaGp1c3QgPSAxKSkgKyANCiAgbGFicyhsaXN0KHggPSAiU3BlY2llcyBncm91cHMiLCB5ID0gIlJNU0VuIiwgZmlsbCA9ICJNb2RlbCBzZXQiKSkNCg0KDQoNCmdncGxvdChkYXRhID0gbW9kZWxzX3NyW21vZGVsc19zciRtdHlwZSA9PSAicmYiICYgDQogICAgICAgICAgICAgICAgICAgICAgICAgIChtb2RlbHNfc3IkcHR5cGUgPT0gImVsdWkiIHwgbW9kZWxzX3NyJHB0eXBlID09ICJzcGVjIiksXSwgDQogICAgICAgYWVzKHggPSByZXNwLCB5ID0gUk1TRV9ub3JtU0QsIGZpbGwgPSBtcHR5cGUpKSArIA0KICBnZW9tX2JveHBsb3QoKSArDQogIGdlb21faGxpbmUoeWludGVyY2VwdD1jKDAuNSwxKSwgbGluZXR5cGU9ImRhc2hlZCIsIGNvbG9yID0gImJsYWNrIikgKyANCiAgc2NhbGVfZmlsbF9icmV3ZXIocGFsZXR0ZT0iRGFyazIiKSArIA0KICB0aGVtZV9idygpICsgDQogIHRoZW1lKGF4aXMudGV4dC54ID0gZWxlbWVudF90ZXh0KGFuZ2xlID0gNDUsIGhqdXN0ID0gMSkpICsgDQogIGxhYnMobGlzdCh4ID0gIlNwZWNpZXMgZ3JvdXBzIiwgeSA9ICJSTVNFbiIsIGZpbGwgPSAiTW9kZWwgc2V0IikpDQoNCg0KZ2dwbG90KGRhdGEgPSBtb2RlbHNfc3JbbW9kZWxzX3NyJG10eXBlID09ICJyZiIgJiBtb2RlbHNfc3IkcHR5cGUgPT0gInNwZWMiLF0sIA0KICAgICAgIGFlcyh4ID0gcmVzcCwgeSA9IFJNU0Vfbm9ybVNELCBmaWxsID0gTGV2ZWwpKSArIA0KICBnZW9tX2JveHBsb3QoKSArDQogIGdlb21faGxpbmUoeWludGVyY2VwdD1jKDAuNSwxKSwgbGluZXR5cGU9ImRhc2hlZCIsIGNvbG9yID0gImJsYWNrIikgKyANCiAgc2NhbGVfZmlsbF9icmV3ZXIocGFsZXR0ZT0iRGFyazIiKSArIA0KICB0aGVtZV9idygpICsgDQogIHRoZW1lKGF4aXMudGV4dC54ID0gZWxlbWVudF90ZXh0KGFuZ2xlID0gNDUsIGhqdXN0ID0gMSkpICsgDQogIGxhYnMobGlzdCh4ID0gIlNwZWNpZXMgcmljaG5lc3MiLCB5ID0gIlJNU0VuIiwgZmlsbCA9ICJUcm9waGljIGxldmVsIikpDQpgYGANCg0KYGBge3IsIGVjaG89RkFMU0V9DQpwbHNfcmZfc3IgPSBtZXJnZShwbHNfc3IsIHJmX3NyLCBieSA9IGMoInB0eXBlIiwgInJlc3AiLCAiUmVzYW1wbGUiKSwgYWxsLnkgPSBUUlVFKQ0KY29sbmFtZXMocGxzX3JmX3NyKVtncmVwKCJcXC54IiwgY29sbmFtZXMocGxzX3JmX3NyKSldID0gDQogIGdzdWIoIlxcLngiLCAiX3BscyIsIGNvbG5hbWVzKHBsc19yZl9zcilbZ3JlcCgiXFwueCIsIGNvbG5hbWVzKHBsc19yZl9zcikpXSkNCmNvbG5hbWVzKHBsc19yZl9zcilbZ3JlcCgiXFwueSIsIGNvbG5hbWVzKHBsc19yZl9zcikpXSA9IA0KICBnc3ViKCJcXC55IiwgIl9yZiIsIGNvbG5hbWVzKHBsc19yZl9zcilbZ3JlcCgiXFwueSIsIGNvbG5hbWVzKHBsc19yZl9zcikpXSkNCiMgbnJvdyhwbHNfcmZfc3IpDQoNCnB0eXBlcyA9IGMoImVsdWkiLCAia21yYSIsICJzcGVjIiwgImVsc3AiKQ0KcGVyZl9jaGVjayA9IGxhcHBseShwdHlwZXMsIGZ1bmN0aW9uKHB0KXsNCiAgc3ViZGYgPSBwbHNfcmZfc3JbIWlzLm5hKHBsc19yZl9zciRSTVNFX3BscykgJiANCiAgICAgICAgICAgICAgICAgICAgICBwbHNfcmZfc3IkcHR5cGUgPT0gcHQgJg0KICAgICAgICAgICAgICAgICAgICAgIHBsc19yZl9zciRSZXNhbXBsZSA9PSAiTWVhbiIsIF0NCiAgcm93bmFtZXMoc3ViZGZbc3ViZGYkUk1TRV9wbHMgPCBzdWJkZiRSTVNFX3JmLCBdKQ0KfSkNCm5hbWVzKHBlcmZfY2hlY2spID0gcHR5cGVzDQpgYGANCg0KIyBDaGVjayBwZXJmb3JtYW5jZSBvZiBQTFMgYW5kIFJGDQpgYGB7ciwgZWNobyA9IEZBTFNFfQ0KZm9yKGkgaW4gc2VxKGxlbmd0aChwZXJmX2NoZWNrKSkpew0KICBybXNlX3BlcmYgPSBzb3J0KHJvdW5kKDEtcGxzX3JmX3NyW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIlJNU0VfcGxzIl0gLyANCiAgICAgICAgICAgICAgICAgICAgICAgICAgIHBsc19yZl9zclthcy5udW1lcmljKHBlcmZfY2hlY2tbW2ldXSksICJSTVNFX3JmIl0sMikpDQogIHZhcl9yZl9wcmN0ID0gc29ydChyb3VuZChwbHNfcmZfc3JbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLCAibnZhcnNfcmYiXSAvIA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICBwbHNfcmZfc3JbYXMubnVtZXJpYyhwZXJmX2NoZWNrW1tpXV0pLCAibnZhcnNfcGxzIl0sMikpDQogIGxldmVsX3BscyA9IHNvcnQodGFibGUocGxzX3JmX3NyW2FzLm51bWVyaWMocGVyZl9jaGVja1tbaV1dKSwgIkxldmVsX3BscyJdKSkNCiAgcHJpbnQobmFtZXMocGVyZl9jaGVja1tpXSkpDQogIHByaW50KHBsc19yZl9zclthcy5udW1lcmljKHBlcmZfY2hlY2tbW2ldXSksXSkNCiAgY2F0KCJSTVNFICgxIC0gUExTL1JGKToiLCBybXNlX3BlcmYsICJcbiIpDQogIGNhdCgiVmFyIG51bWJlciAoUkYvUExTKToiLCB2YXJfcmZfcHJjdCwgIlxuIikNCiAgY2F0KCJMZXZlbHMgd2l0aCBQTFMgaXMgYmV0dGVyOiIsIGxldmVsX3BscywgIlxuIikNCiAgY2F0KCJcblxuIikNCn0NCmBgYA0KDQojIENvbGxlY3QgdmFyaWFibGUgaW1wb3J0YW5jZQ0KIyMgTnVtYmVyIG9mIHZhcmlhYmxlcw0KYGBge3J9DQpwbHNfcmZfc3JfbG9uZyA9IG1lbHQocGxzX3JmX3NyW3Bsc19yZl9zciRSZXNhbXBsZSA9PSAiTWVhbiIsIGMoMSwgMiwgNiwgMTMpXSwgaWQudmFycyA9IGMoInB0eXBlIiwgInJlc3AiKSkNCmdncGxvdChkYXRhID0gcGxzX3JmX3NyX2xvbmcsIGFlcyh4ID0gdmFyaWFibGUsIHkgPSB2YWx1ZSwgZmlsbCA9IHB0eXBlKSkgKw0KICBnZW9tX2JveHBsb3QoKSArIA0KICBsYWJzKGxpc3QoeCA9ICJNb2RlbHMiLCB5ID0gIk51bWJlciBvZiB2YXJpYWJsZXMiICwNCiAgICAgICAgICAgIGZpbGwgPSAiUHJlZGljdG9yIFNldCIpKSArDQogIHRoZW1lX2J3KCkNCmBgYA0KDQoNCiMgVmFyaWFibGUgaW1wb3J0YW5jZSBmb3IgUExTDQpgYGB7ciwgZWNobz1GQUxTRX0NCnZhcl9pbXAgPC0gY29tcFZhckltcChhbGxfbW9kZWxzW1sicGxzIl1dW1sic3BlYyJdXUBtb2RlbFtbMV1dLCBzY2FsZSA9IEZBTFNFKQ0KIyBwbG90VmFySW1wKHZhcl9pbXApDQpwbG90VmFySW1wSGVhdG1hcCh2YXJfaW1wLCB4bGFiID0gIlNwZWNpZXMiLCB5bGFiID0gIkJhbmQiKQ0KYGBgDQoNCiMgVmFyaWFibGUgaW1wb3J0YW5jZSBmb3IgUkYNCmBgYHtyLCBlY2hvPUZBTFNFfQ0KdmFyX2ltcCA8LSBjb21wVmFySW1wKGFsbF9tb2RlbHNbWyJyZiJdXVtbInNwZWMiXV1AbW9kZWxbWzFdXSwgc2NhbGUgPSBGQUxTRSkNCiMgcGxvdFZhckltcCh2YXJfaW1wKQ0KcGxvdFZhckltcEhlYXRtYXAodmFyX2ltcCwgeGxhYiA9ICJTcGVjaWVzIiwgeWxhYiA9ICJCYW5kIikNCmBgYA0KDQoNCiMgVHJvcGhpYyBsZXZlbHMNCmBgYHtyfQ0KdmFyX2ltcF9sZXZlbHMgPSB2YXJfaW1wDQpmb3IoaSBpbiBzZXEobGVuZ3RoKHZhcl9pbXBfbGV2ZWxzKSkpew0KICB2YXJfaW1wX2xldmVsc1tbaV1dJFJFU1BPTlNFID0gdGwkTGV2ZWxbZ3JlcCh2YXJfaW1wX2xldmVsc1tbaV1dJFJFU1BPTlNFWzFdLCB0bCRTcGVjaWVzKV0NCn0NCnBsb3RWYXJJbXBIZWF0bWFwKHZhcl9pbXBfbGV2ZWxzLCB4bGFiID0gIlNwZWNpZXMiLCB5bGFiID0gIkJhbmQiKQ0KYGBgDQoNCg0KDQoNCldoZW4geW91IHNhdmUgdGhlIG5vdGVib29rLCBhbiBIVE1MIGZpbGUgY29udGFpbmluZyB0aGUgY29kZSBhbmQgb3V0cHV0IHdpbGwgYmUgc2F2ZWQgYWxvbmdzaWRlIGl0IChjbGljayB0aGUgKlByZXZpZXcqIGJ1dHRvbiBvciBwcmVzcyAqQ3RybCtTaGlmdCtLKiB0byBwcmV2aWV3IHRoZSBIVE1MIGZpbGUpLg0KDQpUaGUgcHJldmlldyBzaG93cyB5b3UgYSByZW5kZXJlZCBIVE1MIGNvcHkgb2YgdGhlIGNvbnRlbnRzIG9mIHRoZSBlZGl0b3IuIENvbnNlcXVlbnRseSwgdW5saWtlICpLbml0KiwgKlByZXZpZXcqIGRvZXMgbm90IHJ1biBhbnkgUiBjb2RlIGNodW5rcy4gSW5zdGVhZCwgdGhlIG91dHB1dCBvZiB0aGUgY2h1bmsgd2hlbiBpdCB3YXMgbGFzdCBydW4gaW4gdGhlIGVkaXRvciBpcyBkaXNwbGF5ZWQuDQo=
@@ -356,6 +1934,29 @@

Trophic levels

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + + + + + + + + + + + +
+ + + + + + + + + + + + + + + diff --git a/src/pls_zwischenstand.png b/src/pls_zwischenstand.png deleted file mode 100644 index 31c8d3e67bc4f9213289dfa42b64b1d08a7ab352..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 14812 zcmdVB2UHYI*C&pE&?ABkh=_nrlSV*62_hh=0U0EU1j&lzC?Fs?H8KQY5Xngqk&I-J zWFQP#f*@IO1j!E|D0y4o_uKuxvwP0&IeX4OG)+%W_pMu1H&osF-I@q(O%?iMXO2-& zP|&O5m2@a5s2~aoN-uy4eNss*$)cb*;;gN%tBii7ppc@Vu%?hgPa=hNHG8I)sHiCV zNQy#Aio#k-3O$KZMD!fj_;WaGXvAnZJ8L+j*Fue$7>yY8O0xbp3u|k%jJ1?Ck!W3g zh?1go&Kfb!e-89o=o}N{Tv+H_NOCSDd)%*x`O6Ds5%ZVm53?AQ1U*PGg)uROg)t;j z42c{=IwVR_5Ycx0X^1tknn)Z!EOgc={L8TrWr>oaT>pHK(7!^`VIi4RNG2DO538*y zs)FUO4IB z!{G4n&{VoG5tTRQKHkusf`Z}0pZ_E6E_s#|6j%yXB?aAw>B|{WS(9xZ(*^}OYWc-N zc7ZleSE}GE`L?f$Cz2ftHB9vUd3XvF*y~y9tVfK54t6bQsP3GdJ8pgH z;c=Sg>Gol!xn7y86thv@eKPr2V8)}|lLCBNB@a+cm2^W9s4(8dU;iY3h*h0ds8dHPK*tN{GRS_t9d_pS190zp|*!dpfSnR40Dl(0);+DAhc8STF9`T9R*U_B*&n6N{G$(Z@2q{|IbT+7WYe&qnAH?3EPrv za|Bhz^NvpwJDiryM;k6|Uy#RVvmr%ajv}>`5OZ63_QnO68VcU>TWoS~FVEb#1}jPP zbZ7Q+_jS<0VlgOn-8EsL|0*REF}vP?Rr&@XJgHq9A>d3(P-N zY2zQF10Y8=2WqJA`F88X_jKojqB8AX2}OeI)AquuYr@@hXRJswl#n;7zYuL)lMZlQ=4BjM%25Fj>Qn`SgD?TCVi$x!CR>{SRjI8IKtY-sQUBU- z2cGQ-@Sa zN<1$LV3+~J^NDy-RFr5JkHgvBSRQpO&q7YGA|)g$MGFn4D&U{8AqWOh$~cMKE(-z; zuq}bTp~7=P#M5(FOC$GFNTu9Y0Oq^T0OyMT2h#{CexS?(6{eU<}Jcjyfz zg2G3v|0P8>L@7l9pDd3bQdJ6qJi#GLN{?oA^i*378XEt zi|Njk5HyGYu=S zCjg{qp)#NY$~2F`Cc(s;W?VhxH@xm^(!!@$fr#~T9>{4tJj&|xk__&TP$E!!D~b;R z4Z=WJ_bw%>-o+ejiyj-IJu3W`ZVVbm8!ZTm2%w_dDgSGjtBJ(WH_3Y#OcN><26ww< z;(d6kpz0|6d4vgIOYzf$+fXC>2J4;+CPJv-#s96DR%W+5XE@Rz>SdzBpU3e?gYt{l zoG@2LDABG5RYf|gk!|Lg#BMC|I+U35R0dL7WI#|K7KxX~|FOvvWt0%sGAHR@T12k& zjWIxP&MDww0t>)jC>(X>Jtc&J^s&@Pbo77Hex7>>@zQb{5%DA(j(nCUo$OU0RnA^U zT72e(0=}@yDE#}$K2v!Li!RoZbR35NZDAYPNYOOIe44hyQ29dv1ytJKc?YiH3B&Xf z7a?`o5$)z_i>wgo$t*)3NpG~>bvql6QqQ%<)84Q z3$TE#9m0daTd0b?orpJSCP8sqc^hY+ zthNV7b8ot^v-)RjGr6sqsS&_VP;24nZaGc7Xm9wELjt5UH$l?{Lg0*RQ<%|kkiR%= zGWS=hosi|7P;HROqqmsZZU3JY0e{1<^$jr*ym4Tl^&~yC!aT+a%^Y6-1`RSYmEHQC ze4DZ{Ijr>!a-qCJ9JnmLoxJ0N)aK)$7E-|CaJf9`m_Rtl<(-IVvxXU+n&&`{Cx07* z*dc^`79pZ4%$c>qu;J<9>|PA~o6MZb>J)xFhX%SiM-BO{V|s$i{t+xv6~4t>?kJ5g zgk8&LeC0p^y&Jm*9Z0M!AxOID9Tp+>YcL>(g?cWs-9^yC&IPg5?TQ?yw+%Kr1w60xhOd{tH%$Y3w{tPio$1i>E~#KI z1B|-Tg zxmcV@G&o^)Sah(_v+LqFzu$HRGhaax!eEXuBH9ZW?_AQu%`c{_5?53S`aKko2?2}f zsE`V2oi-Ozn!zIww?)1@z&@i7Y|ri|5?RZuTkVq&F-j;A9T&%Vp!{Vb-?t#J>o|O# zGrHLrvV1^52Oac%Dr>R(NhFAPeYzoVzL3wA;C7Kfm`csi&+to#Pf~@Z#Lgy6J_PK{`BpW zgW)1Lvr(=J7n#+)i@(k|aGn-cihr>myJvh4dnoIBYp+yX#(`#+X6LyHTg5c5voOuD zHj6yIffaodZ=P1=bQtvZscewtCAG^{j3X zigZ5d3A*kryp!{tt0)j}Jl**@x}4)OHRQh~8WkJ{+-0RBYvBhkxQwy)X-=Kgcv}6^ zjFpS~(h*3}?9GnnF~}**h8k*9W#v+uKJ93X5K2r(lbyd1A3v~SYHZ~0WDEuSAE$rl zZcPX7iu5MmUa*zN6TJ5b&n0zkj}#Bkp74NEONyXiVp&-bF%09qRdO#fNfUqDW=#mA zY8pldC%ZqHwFBZ5BW@)@s4+RF64@*(6=|*yvVYekY*%V`aRFZ&gFuyAHADNN1@d^? z3s@c%_|euA2Wt5G!wv$``85?no!^is1zhf%2M5NgVS>k+ngi8EkGVF-U{JugjR}5m zB8b>(RjoM1HmY-?CjrYNmdJ(~HM%Is4Uf?W&loQ#GwXP;g(ve%;~-nqqeST7!S1dz z8bG5x2624JX`v-2lule*CYB+uOGRZoWRVLdT^1PE6;e9#y8edl2IIhN)C9mbopcmV zcex#2$28z;&3Abhlaim9APC)EoKV0Ml9m|D5&#GL$4gy;td`mf;ZoBOje# zpKGp|*p}7-n86$bNmgN=IX6Ac1LbU_18iP{HaLX6{m1eWzI_N$7h6=4K*vBhW1{XO z4}3cXxkmR{SefOg2~~{W?Tl;}4!zO|*NagPGMORAi(P5Lv)tsg)q}d*K7#m%cPq~= z@G1NAT=9SSYFDw-F<&ChIc#aXYpOOMvmKYFC=d8oPcqHe93tW3cI-K_VC0gdM zU)a9d*;6?K+-z)A@D&OHo0DW1v#mP!I*C$R%{wDm0DK^C?r=WF-nx?qS?;ESh9p_B zIa-KwMk;L+Y-weVuu zWYWtekFtMan~j+u!D>aWh9DvlH0EWRS?t;g9Xj{oOnv+Zq1|$>26YwS=KWyMNQp8H zOlaly#BtWo%}_uStwF@M?(4`uq|eC5!QWfT_&0660l%2u_m!dxu{pAXAuZR*E4!Q~ zXxu&cnMF4MuH8GCVtitkH-{3^3qV?y>S`$<4OME`jV~wgx+EwP)mC!CFod{rcljwO zy=zxy2@`xKHo$@5Poi9ZqVJY2YUJvuR#dCI`{USbjBB1r9O&`fkSV*3tjd{5C(gQN zlE166(KkDmiMxU0nRS?yiv|Z_J2Adv7ZZQjk{c^a1Aok({Y-W7q}7N}7jKJ(=I;vl z+Uq2?`}4!`4#JfZC#+_-$Dxb{MC@=k{D=^dwKi>a4-DkJdpsU;lh&`|9#@n(q zeiYJOj|TE9CsJ9U#H1&{<;>>|R`Jo{mP1K;!9+25jH3((@2Js0A3E9@Evz`c+w;L^ zWR_{yt4JR(ceR0sr@moat*v^h*|ke`VNbIzx2yp(pg)7X!!qf2T)h1Mx&NG#+jmn9|kN8Jyof9T0rEgodSslxOsStPf2qrfw{uM z%Z&ok923DjH+qLMSx$P{NpzW#+olbCxcgmhPf@lnl=v1DCALnWq}x~Pqx zR<65N{BVo?X8gFY%fm=UkmMjQna}&`pe`le$0MXvHS}r_(1bUO?2S9C{RG4`c z;Xwz(p8*;v=?i=h$iIf+n-Uhp3o^ldk%Nu@+%xU=pbiJ%fpJKy&aaFEvfH%^ zv%3pN>l{HGBf*QKMo5ktH`$OrG0&lO#j%HZ=6X6knJ z<|@faM4~5tl{cOE*`kC8e$#i1+wznL(%|z?N#4uJvwM1*;+Qq5BarhmERUhSOR4QU z^^tKp7!AevLqS8oAaI>-Nz!}H7eX?WM{$DBIJt5=B+{DYu3wDWq4d?9k_6_Tu*eh6 z%UOz|0ZO292M0n-s=f=S_fM8%I$kDbJw$v~QXG>|CMOj=Sxi8pZbW{En%CCJqU0ly|Gl42dLwD3u!?ech*T0~C@DjrAe z!MMFzk{!iv#qHeg{>+l~DKNdnlFi93a~%$16XIAp?j1I!AQjd*9^|&H(>F7qql|L^H*po}c9vhj`(N-n>hn#lpTYHf|8DvF#F|hv zhIA|uF4U?$0{fxHDuMOLk#&|XYw$N5j0sm)A>5KX9|dX=e6dO{;U8JvQNRLPA;FVD zlvn6dtxDq~fUjrxu{j*Dm~a%@6dJK7#6uRHM|q1Wal{o}1x3E*sMgabznr}7M@@nEd29kO^0Njmq1PAsPN70~aUy}xxbwLxK9RD~bJen7YJRd>q z{rU)#qCD#?FFf@-7I&bxAPT}wCsI}`G;^^nX~rAe$c-jdI8Vjky9!}qF~_<6_);yN z5oY}j(e1ITOc~HUud_GA<{Y|YebmB#3Eg6bYl=j8EkPmxKQh1g_{9ZazJwAVFXceF?~yf4LTCraK=rR8JfDi&W8m1awF7q$d54=Xo*7-%yy80D^rA`(fLi4 z5NFkhT$1!tsVcftjK?2J-9sm=6m&WBb8DOdqi=}(w0p(V!p75^K>TPl{MLvQ%r4Z0 zqZvPl!Kq|yi%1Ztk!BZ8M6@q<8Ukx({WIvQa4yek^cB|Lk7biEp=KtJ%@Mb)DylV6 z6(EA<`L&|(qaG|GqvuA${9b?(hzIn{l9a zQU)61=JM+m1_!1B8fzq?P)z0s)Op3&#pRruw%aNTYO0DOi{n^y)_i0QX1y4sx?lgA5#@0qi0?tnVM;Ck01dh{ij?cb4UU5SH>Vn$dnDG!DtPzWd!wBehQ zLO@ANP1s1re@D0L#3JL&qr5<6Icliv7!FBJIHQ8UUBV$@QF{R@_Cl?tV7TEl)af)_ zRrIHJ#lcE6va-ue0?QSBZotWGmmaJ?W_~a6%LM)%l^#U2XM*35u}W%3VT+f{1FUJ- zmh}^`$@l?kyq2N}br@cf7V4k=xGD#Hbt5buMLB9bM@W;`a-o)SKDYQ#;zO7)r3%j2 z-+(J`R_ek9A5}`i%uYc=QwoDjOb3J+0D5$^00vZ-yQFN#D4~_m?r?D3Fo8N%*ZsBYKVXX-k&AI8-s|@8e;MQZUIxUoBKgP$$ z&s8nR;bzXXOz)f_yE@^(WXwJ0O~&)$@WH0FV~_Zp`|e{F~Dd|#*gwRaR+m+kmA0n|M#MKP<`vv%J} zV^+XMTYmM;M;y@tCfd@-gR`E!cZGwkfZe^>3yMo-@e{y&7nomivD_2&J;y|%Y!|Bn zewrbU3$ym?@s?`6NgN)Zru4*89;yql^P`T%ZUoG}U$jz+4U`;+>+2uQKCH%)5;IhgE|l zgF)OjgM;DJt0xN5JTCCqYAD!w6tI&^uRz!DK}4~?c+pvwnddXZ3+TvUqRhnfhA-64 z#{kPC0sjb41_x3L@i3gVtb}~L)%nOe_2wMUQCJ@Tf(1y)N&G}j3sZJud33g!;8rFz z05$ZMAsWnG2SYR}R4-j-WQrG*Py)n%o1caH6!0!3SJd&g&0|jykPRmX!x=$DO=TuH zgA!@EdIZYY(!i^y0f;WP< z_9s-MgnxnxcvpwbBx zm0`zOJ}e3IJ~l=N+?I08lBuc!foqfPGcQhdx-HackuAfSyBfDR*CgnI54 z{sjXb9%r*e--}bX(Vn;_NIUUTAwpgw*nn))KFU2h9iruE_W#41CVaLu9>NWLhwBq z%~0j+VW7El-(euBCJC1#*db4@RA;* zG!EGi5rl?JX`x{a^C)6xiSbejn3W_s4)HRISfP&fvoi~n^591vq9Z~E(~Oy2_cARc zZ5OWV%gbYdp#m_mFB_VQ>}!zM-sAlx05rvc3jK9Qc=vb4C&@K)+&ohpbz|p{N>zD4 zk#y3@5yjq5aibFziz2{Ihq_i18Kqx(4Eml4mfMa2BI=@|Ig#!hUQGUy+Swbjk)VJi zfcYu%m<_Rwtk1$CvhSuam@c7u$a0oZQNa5+v}Sk&(MBPV>nNX(e?Gr|D$gzt31lhp zZR%lymwMj4qJdITTMkqRV}_sZHVt8OSka0fT)4$JkaY$@eBwqg6o|)DK^bVWCbf8& z<1a9qCx62+eCa7MWT$*fkwjpKelRD^%OhhD0tyh(W!>kAr43mA=-*06K3u}`pavQdc@*KnAUUllDqEI=rt`j`;Y{9bdHfT3yb+q% zVO1+&1x0%QO=w3ChoCbSKbkpGrG)IzY?Jwge6zo8;t@FY2a?|FS@(Ja-#f6E;aAiO#RmDPynhuOi8G<&vJmQkT+GhoPC5o4& zDUdkE=pps?rAz7Y z%Q5n#2WXzj4xM|^4<{PP9YE9>yTty}GohzMO)L)z6FUYIC8^);6e+zT7wpJNH+wEC|?luX8Vrj$boIk!*l@J zWPCas^6?Lu2p6(lcBdBubi6||Z{n;_$M~*e4d)ZZt*(Aa;BvP+5GijL!b>^MzJ2i6}(=xA0N;)c?pX{~x8G|F4Ne0tqea3uBiyVZ`+w!UgTR01yeZ-6f91Te6>0?EukFg9xd zQy1{CAvYV+7CRr|?Pb<(HC-TB$NMvmAPTEVcZ3Kyc|6IN!T z%kD!$`Id0+>ama0yFMTH>Q(&gJB0>lrGN1@2Rv+kgUz%+HfqV4q!0JLIvY6QGA^O1 zps0q7i1hkrb{1b@6PEX{PD=2Iu^p z~?f^98Yy7(2 z8@~DcUWpJ{)T`UXEhY0({9I1F#OTs`XtVFb<^YzAg?zL+AEu>r`nZU&sJ)$AT#2M{ zz41T=Q_xFiV5t$?sd>FOm3vifsN%K>KSB`5s}*g|@72`U4R7Y{?h*CsQD5Jwj`~^R z?yb{Km(d_;wVz#ou+7Z9*>~_8!zQ_$&QMkyLVI1vosv;)V);q0DQ-e_wEjot#!S;( zB#AUim%VY6)ncOJwh=$FSCz+0<6G)iny(wT{s=&iLWC2`lnbKrQ+jjH)^oP!@EOf5DQioG>C4`vtdMuy$ z{W2xlsF&iI;5MbJFFV=c$3mvN;lNbGsqiP}KoV=V|7>pa-oeNwe;?#6ch@(tj{n)-W!w{Uxsx^P>r^*? zW{yhyM0HWT+GzSuW*=TWu!TVbhG&BYSRB+vvzxdHLv0Hd+){X z_ckII+;vQ^E^ug`?@?`T-#qHi;Z{!?cXOQ%tp7c3kyYWG=BNDqp_JQ7NV4BM1b>b0 zQ-+3I6pL6QXc(FLvXST$tSzix&=;yIWZvg7b8gCg+_`GB!~)+tL0&di3rxe%=>*Tw?N#ck7Ru6Tai{U)nP7bmv{o?TdK6PsC{mUi2z{Qx7F~XiHc9lTV$LUxb?HzTlte3d}Yk{Kj(80e)XVh zAu;29Gy8=Po^FsKesT5rV)(T8Z>oa5Q^MM73xgRIW(Cy@&MMPG=2N?4fHH&ZKM6Fi zgb59%0>%EuKi3pjJdaK!u5|Npsgs*fs|`DUI~`Q+8Qyf;emA%2ZYxB1c&f`m4C=Yv z+brg+JlMd~dGD_1?lq+&7mXfJbG0mP-)Qh5cm+Bo@s^JdIV{x7`r@BTyl2)6=wi(q zk1U#;@PV6q&R6U0xB85CzN1~tF(qi4gWmN5;>sOT`6SEru&(Ca;wK^XSi|4`PU7b} zNQMMo5%TRQA5XtiooEgom}V7MBYd2Pjumx@{QikkEHvb}HGIne5s z@GJ_u{qycx{;BN2I_0U7YIl{`=xpvHe6%t;+6m z*(b|7S7)7^o8)=5G*X_$&L8A%-lO_-66?3S$69wX=11aZXi$6+3%Ql zypN4Y7iZpvU)JDaNe3q4vKGFKtCz~P9`ZiMDzUKa+>WvFX&?1(EY%v^&VLwcHd${) zKPY9&)5G21el5UOe89MV{CW0z^uCCT6ivxeqJzP`5%XuwzPf2vA4g93N<20%r{r$$ zXi{uoa-g~_+k%j$h1?>aocX7W@vg;9=S?~ts!83i?Ml67V4U!qFUzCyZng;fImVZG zAzspXn3NroIt58{xyamgKw6e`!Ct?_F=1%Y*Z&qmo_LU@Zfc zzxOv_@9zJY{uB&`onw~tRd^5{F!;8N?iAxyQREim>T7WpH9S4Vq{6)B>JKR{Hl^NW z1IZC(H}AP{5v?r4Rlc?)%OU8#g(um!8NVy#xJPre1&^S{Z>+% zvhriN^QVTaXwyI2je|7APUn}M1udl=O`N%JRPrwFE>+5Q7InrA@3M=md%HTyWHEbi zmSo>Z%kaA?{Y(5lx#DBHN@}%ZKqQw^;@q4w?aP9r+A>qJNwA(f^YTUZ*J$>lL`dZ9LgCqLlp`9y8=?Tt|VNyc^kgE??HQPF>&HV>yMn; z-|iI_s5K?$`?6Tx-Rw4^B zjBRGPUQJUgHPsRa5oN_tr!Tiyh z_E#v$1@mdKc}5iVej#yZ7Y@%_(LaXVW zWjPCbw1>~thEM5f%7w^YTQ~4N!Ze=b5m0HaeUWS5$pObp^Zq&Cw&rWwtkmOfLV^ZL ze=1b$%X1S-jD{SiLX*V~L#>l1Gk++Bx=*@1yVEF;QLe?XFqooqDtu)*fr_1M`b*{* zXI#{-V|>`+&s(oN*TeF(Qxa$CJv<-a?ks%Z4s_7syKUUx*cdonI%(&e5QUfKzYN4V zKXDnz_IGA<8dp{%i&_k~xAvS!6VO+V-PGw1{B680@+sPnJ-w~2R+|$n&{Cvd7;GK% zFCQ#q`;0v`&Jocj&g+!_M)X>?)c%A5|I6kY+5@50&nGsPO8kT)9wm>*em@>d&R#3L zzq`G-o^LBW>8xY%(S4q8oA1Kd+^K%g9e}1ef-1nAd{7{KtR?sW_^;hhgB!M9Lp!{@Q;pAfVP_+V}$y;v;K9Q-n)}8v9zFaqV6rS1t;;DU$?rT`>4!iX8jV<6i=5_2&}x2FA6*!s{+}0hYr}-gH?=O$ zJ*Cd~aPI!fJSaT+$=~hlBg4RZNfU1FAHvurv(`(hqOzr5zv~_Q{=h%htU$BLzu@vc zKbsc6>RQ>pRu&k)tI1={eVHxNsV^>aCPF`)uxvDze&f+CEk^sfr-Cyhf9Unn7KQo%I;lkezW>jt7nJ3o?Ojl zFIv5CXYfVLDY5jR(W6SKhnQK_mCtsY$4jb0f-}uNI@a#B)ypF=Ir?XH!t4ZaFgza5 zw0~nlB6{?yrn1|d?N1K7{e7?HudH?Q634->v%W(>%#TT~HU(KLzB(U+^J(J;9Gf2L z(>rsT8-1rg|I<76@{=>$y&ik)70$xkGvB_wYM6cT+$b?UZmNMfBkX90VZ9!Q*2+kS z4JmJV)oYPIp>`~giH1Lg^m5D!sw!t`e*WRh?6 zD&`8~s|E5ha`;_QQ_GOxWbN)s&#-?Y)%I%3qvwu`S=J-t1(89^D``auK5~z|Mr?0A z6`J(9k=zo*S`o%m#jDgx|Jqmod^~H85eqriqt?QD`H5;8EU&vYp%=TiV$`h3@r{|C zmPT0ESj!AfmGWJP{<%FgtjYDpA>jH+j+;^jugYtPPw9_&HoNt`u9rNKGKO){EeuJi zQp;x-&$iJit9J;~u=<*Fg`wMG?q-%BQrXp=Zwi!a%UPZs?v8= zn=QJIm^ckMZZS%UDp#34R%aV8&_2e#RpbMwTeFqb>q~!OzNXnXzw@>E3Aciz#K22G zaI(dm6hY^SR>s10jU5>tV=<~YU@3o)QyJEB) zq}6g&=Ec}@D<8PV`2O&^Dc{VaZnoBL2OAzy#>)lz5k-pnqc5gvmU8JCiz6BB+x3=B z6P))Ws_GL@pMOdv`}Nz;q6MZx1)e^74yiIktT2w!=hVnaQOlJd>oKR*38^E!SD9S2 zB$G>oxnvSv)e7EVtWWzjcPO*s-{tg}X{zA#3sDOby-MZ_GghUPGGCZqEo$vb`K`j-U$uK3-pw!my|&xp^2V4< zQ_-=GPcoZ@K{maL&0uqlVv(d1tyv|1AeD^L2A4&Iao@y>-?cYhw=U|j9{%3aS{IfV zhyC%v-)q3HxGWi(i(7JDWFpRBPH9(%!V>4=U)+yPSK$@WJs? z`6Hu8870*pt3E|nzFbHcj7`rcc>*23LTTar^UaHV^y;L%}{3QySvp-!N{o> zD57wpUo6`J?2g@Q!5bHtS;18>EM)JF}CM4ab(pkvlP)cCC%ELHRbxbf!M^u zf|}Se^WpvE{38`nMGE)j)|nyye4lRWU>0SNOG|$1 z+-E<^5IUP^Bk{~W^kc<-OSF{MSzarmBg}W&t5+v#D?z{eih?~SOBu&}$>u$SMZy$)-ZrTM%ct3*vsq-t zEb^{alxHryw(5;1XF|oELGNk@_8YPOh`7b6mL+*UXr@0PQ);EbH^1PGOv!NR3z5Xb zYSBw>KTbdQqOw2M+&%ZBhcA>k+s_v(y=uCg2Owz>Rb90Jzi6?*FR>; zLlt`D)WG(X4>gM zmr1tMV>%u?Ud6xCa6HiDl@+$f3(mUs*9T8z6t@x*OZurAo#`K$7L+V^H{Hq?$(d}E zi8`BbF)E8$WB+rll9J}Ukv9!Zy>6rFT&20v8JO>P7-e3Z_=|iON9~KID_%3KtTnna zhmFUqlkD?xhwzaczVI{_z2Y*3>IZex5#}Z>Iv(4L)w`Uub}xaHFRaHrOIJpiq9YgH zK1h0L^Wn8yVuAUDA5TCl_?7a+DqT~}9_ECSzwa<9UTZBv zEgB4cxn+zmtXB&5MyF&9$^@KRUK4od3stuw+?u^IH12W3Zu25$X$jX!3*)seM)rC~ zMJ2DLwOvQhxJ_#Dwr4&v{XWd7s=4l;!8No%)`BO7B3~X~u5?d-w*@}x@CKdU0&hl ze}^0Y*FQx2FNoxSB_Vomu4l-}dGA*koX}i299EIg)YNn~5S~7WijS9QGLgP=9!*)A zH8!kS>oxjlAI^=ko1=SnneW!^uRjW!?WwvK3RAoNexdfH9XWP)Q%WS zEV9ZMV0~Ki=NY;iN}H8SoUdF)$M~bp^dCC=v2WQm22Z(#HOc0q<8<=X5Lh1a@o^Qp tnU#eazQTiklP5j;pMQz>Uj%R??B{PQbKRb@@368KKYe*-ff{R#j8 From 181997fe451bff55751dae1623c755e06ca80a14 Mon Sep 17 00:00:00 2001 From: Thomas Nauss Date: Tue, 14 Jul 2020 17:00:11 +0200 Subject: [PATCH 65/65] Minors --- src/600_analyse_biodiv_sr.html | 78 ++++++++++++++++++++++++++++++++-- 1 file changed, 75 insertions(+), 3 deletions(-) diff --git a/src/600_analyse_biodiv_sr.html b/src/600_analyse_biodiv_sr.html index 1447cf8..d229841 100644 --- a/src/600_analyse_biodiv_sr.html +++ b/src/600_analyse_biodiv_sr.html @@ -11,7 +11,7 @@ -500 Analyse Biodiv-RS +600 Analyse Biodiv-RS