updates: post hdd fail

Author: eliotmcintire

R/classifyCohorts.R

@@ -32,10 +32,10 @@ globalVariables(c(
 #'
 cohortsToFuelClasses <- function(cohortData, pixelGroupMap, flammableRTM, landcoverDT = NULL,
                                  sppEquiv, sppEquivCol, cutoffForYoungAge, fuelClassCol = "FuelClass") {
-  cD <- copy(cohortData)
+  # cD <- copy(cohortData)
   joinCol <- c(fuelClassCol, eval(sppEquivCol))
   sppEquivSubset <- unique(sppEquiv[, .SD, .SDcols = joinCol])
-  cD <- cD[sppEquivSubset, on = c("speciesCode" = sppEquivCol)]
+  cD <- cohortData[sppEquivSubset, on = c("speciesCode" = sppEquivCol)]
   setnames(cD, old = fuelClassCol, new = "FuelClass") # so we don't have to use eval, which trips up some dt
   # data.table needs an argument for which column names are kept during join
 
@@ -50,14 +50,37 @@ cohortsToFuelClasses <- function(cohortData, pixelGroupMap, flammableRTM, landco
 
   # Fix zero age, zero biomass
   classes <- sort(unique(cD$FuelClass))
-  classList <- lapply(classes, makeRastersFromCD,
-    flammableRTM = flammableRTM,
-    pixelGroupMap = pixelGroupMap,
-    cohortData = cD
-  )
-
-  classList <- rast(classList)
-
+  
+  # st <- profvis::profvis({
+  
+  pgmVals <- list(pixelGroup = values(pixelGroupMap, mat = FALSE), 
+                  pixelId = seq(ncell(pixelGroupMap))) |> 
+    setDT() |> na.omit()
+  aa <- pgmVals[cD, on = "pixelGroup", allow.cartesian=TRUE]
+  bb <- split(aa, by = "FuelClass")
+  flamVals <- values(flammableRTM, mat = FALSE)
+  flamValsGood <- !is.na(flamVals)
+  cc <- Map(r = bb, function(r) {
+    ras <- rastFromDF(r[, .(pixelId, BperClass)], rasTemplate = pixelGroupMap)
+    rasVals <- values(ras, mat = FALSE)
+    rasVals[flamValsGood & is.na(rasVals)] <- 0
+    ras <- setValues(x = ras, values = rasVals)
+    ras
+    })
+  dd <- rast(cc)
+  classList <- dd[[order(names(dd))]]
+  # })
+  
+  
+  # st2 <- profvis::profvis({
+  # classList <- lapply(classes, makeRastersFromCD,
+  #   flammableRTM = flammableRTM,
+  #   pixelGroupMap = pixelGroupMap,
+  #   cohortData = cD
+  # )
+  # 
+  # classList <- rast(classList)
+  # })
   if (!is.null(landcoverDT)) {
     # find rows that aren't empty i.e. have non-forest landcover
     landcoverDT[, foo := rowSums(.SD), .SD = setdiff(names(landcoverDT), "pixelID")]