# ====================================================================
#
# Copyright 2025, PBL Netherlands Environmental Assessment Agency
# See the copyright notice at the end of this file.
#
# ====================================================================


### Functions for the dispersal model
# 1. F_DispersalAssumption:         function which applies the no or unlimited dispesal assumption to the future range maps.
# 2. F_CreateTimeMaps_PBL:          function which creates time maps for each species indicating range contraction and/or expansion
# 3. F_process_raster_files_to_csv: function which transforms binary maps to csv files needed by the dispersalRate function to simulate starting point of analysis
# 4. F_dispersalRate:               function which simulates dispersal and creates ensemble and binary maps for each species

#1. function which applies the no or unlimited dispesal assumption to the future range maps.

F_DispersalAssumption <- function(DispersalAssumption, Scenario, RespName, Species_RangeMap) {
  if (DispersalAssumption == "unlimited dispersal" | Scenario == "current"){
    return(Species_RangeMap)
  }
  if (DispersalAssumption == "no dispersal" & Scenario != "current") {
    # Load current range map
    Current_RangeMap <- rast(file.path(user_dir, base_dir, species_out_dir, "RangeMaps", "current", paste0(RespName, ".tif"))) 
    # Set areas outside the current range to 0
    Species_RangeMap[Current_RangeMap == 0] <- 0
    rm(Current_RangeMap)
    gc()  # Garbage collection to free up memory
    
    return(Species_RangeMap)
  }
  
  if (DispersalAssumption == "realistic dispersal" & Scenario != "current") {
    # settings necessary to run F_CreateTimeMaps_PBL, F_process_raster_files_to_csv and F_dispersalRate
    dispersal <- FALSE
    setwd(file.path(user_dir, base_dir, IntermediateResults))
    contiguous <- TRUE
    occ_output <- "occurrences"  
    point_data <- occ_output
    ncores <- 1
    # Create time maps with the dispersal assumptions
    F_CreateTimeMaps_PBL(
      result_dir = result_dir,
      spp.list = RespName,
      time_periods = time_periods,
      scenarios = Scenario,
      dispersal = FALSE,
      ncores = ncores)
    # Process raster files into CSVs
    F_process_raster_files_to_csv(
      user_dir = user_dir,
      base_dir = base_dir,
      IntermediateResults = IntermediateResults)
    
    dispersal <- TRUE
    # Point data using occurrence data for dispersal
    
    # Run the dispersal rate function
    Species_RangeMap <- F_dispersalRate(result_dir = result_dir,
                                        #dispersaldata = dispersaldata,
                                        dispersaldata = file.path(user_dir,base_dir,IntermediateResults,"dispersaldata.csv"),
                                        spp.list = RespName,
                                        time_periods = time_periods,
                                        scenarios = Scenario,
                                        point_data = occ_output, #MH added
                                        ncores = ncores,
                                        SetValuesUnderThresholdToZero = SetValuesUnderThresholdToZero, 
                                        SetValuesAboveThresholdToOne = SetValuesAboveThresholdToOne)
  
   
    return(Species_RangeMap)
    
  }
}

#2. creates time maps that show contraction and expansion of species in a certain time period

F_CreateTimeMaps_PBL <- function(result_dir, spp.list, time_periods, scenarios,
                               dispersal, dispersaldata, ncores) {
  

  if (length(spp.list) == 0) {
    stop(paste0("No projected models found in 'result_dir': Ensure that 'result_dir' provides a path to the proper location"))
  }
  #Generates the species list for parallelization
  if (dispersal == "TRUE") {
    
    #Reads in dispersal data
    if (class(dispersaldata) == "character") {
      dispersaldata <- utils::read.csv(dispersaldata, stringsAsFactors = FALSE)
      dispersaldata[, 1] <- gsub("_", " ", dispersaldata[, 1])
    } else {
      dispersaldata[, 1] <- gsub("_", " ", dispersaldata[, 1])
    }
    
    ListSpp <- c()
    for (i in 1:length(spp.list)) {
      curspecies <- spp.list[i]
      if (file.exists(paste0(result_dir, "/", curspecies, "/Results_Dispersal.csv"))) {
        ListSpp <- c(ListSpp, spp.list[i])
      }
    }
    for (w in 1:length(spp.list)) {
      FocSpec <- gsub("_", " ",spp.list[w])
      DispSpec <- grep(paste0("^", FocSpec, "$"), dispersaldata[, 1])
      if (length(DispSpec) == 0) {
        message(paste0("No dispersal rate values found for ", FocSpec, ": skipping dispersal rate analysis"))
      }
    }
  } else {
    ListSpp <- spp.list
    dispersaldata <- NA
  }
  if (length(ListSpp) < ncores) {
    ncores <- length(ListSpp)
  }
  ListSpp <- matrix(ListSpp, ncol = ncores)
  
  #Lists Scenarios and time_periods
  numScenario <- length(scenarios)
  numYear <- length(time_periods)
  #Creates a vector of years
  largestNum <- "1"
  for (year in 1:numYear) {
    largestNum <- paste0(largestNum, "0")
  }
  
  #Checking to see if the time periods pass through the year the model is projected on
  largestNum <- as.numeric(largestNum)
  if (is.numeric(time_periods)) {
    if (time_periods[length(time_periods)] > time_periods[1]) {
      if (!identical(sort(time_periods), time_periods)) {
        timeSort <- sort(time_periods)
      } else {
        timeSort <- time_periods
      }
    } else if (time_periods[length(time_periods)] < time_periods[1]) {
      if (!identical(sort(time_periods, decreasing = TRUE), time_periods)) {
        timeSort <- sort(time_periods)
      } else {
        timeSort <- time_periods
      }
    }
  } else {
    timeSort <- time_periods
  }
  
  #Functions---------------------
  
  #Overlaps two rasters
  overlap <- function(t1, t2) {
    return(terra::mask(t1, t2, inverse = TRUE, maskvalue = 1, updatevalue = 0))
  }
  
  #Determines if there is a consistent trend (expanding or contracting) among the time periods
  #If there is more than one change from 0 to 1 or vice versa, "FALSE"
  consecutiveCheck <- function(val) {
    change <- 0
    valString<- unlist(strsplit(as.character(val), ""))
    firstVal <- as.numeric(valString[1])
    #Counts the number of times a "0" switches to a "1" or vice-versa
    for (i in 2:length(valString)) {
      if (as.numeric(valString[i]) != firstVal) {
        firstVal <- as.numeric(valString[i])
        change <- change + 1
      }
    }
    if (change > 1) {
      return(FALSE)
    } else {
      return(TRUE)
    }
  }
  
  #Sets the values of the binary (0, 1) raster to the values of the given state (e.g.: 101)
  setbinary <- function(r, val) {
    return (terra::app(r, fun = function(x) {x * val}))
  }
  
  #Converts binary numbers to decimal numbers
  BinToDec <- function(x) {
    sum(2 ^ (which(rev((unlist(strsplit(as.character(x), "")) == 1))) - 1))
  }
  
  # CurSpp <- ListSpp
  run <- function(CurSpp) {
    #Creates new directories for the Time Maps
    if (!dir.exists(file.path(user_dir, base_dir, result_dir, CurSpp, "TimeMapRasters"))) {
      dir.create(file.path(user_dir, base_dir, result_dir, CurSpp, "TimeMapRasters"))
    }
    
    if (!dir.exists(file.path(user_dir, base_dir, result_dir, CurSpp, "TimeMaps"))) {
      dir.create(file.path(user_dir, base_dir, result_dir, CurSpp, "TimeMaps"))
    }
    
    #Lists current binary raster files
    modernData <- list.files(path = file.path(user_dir, base_dir, result_dir, CurSpp), pattern = paste0("binary.grd$"), full.names = TRUE)
    rasterCRS <- terra::crs(terra::rast(modernData[1]))
    directories <- list.dirs(path = file.path(user_dir, base_dir, result_dir, CurSpp))
    correctDirectories <- c()
    
    #Gets only the forecasted/hindcasted file folders
    for (w in 1:length(scenarios)) {
      #cordir <- grep(paste0("^", result_dir, "/", CurSpp, "/", scenarios[w], "$"), directories, perl = TRUE)
      cordir <- grep(paste0(user_dir, "/", base_dir, "/", result_dir, "/", CurSpp, "/", scenarios[w], "$"), directories, perl = TRUE)
      if(length(cordir) == 1) {
        correctDirectories <- c(correctDirectories, directories[cordir])
      } else {
        stop("Directory with name ", scenarios[w], " not found! Revise binary map file management to Species/Scenario/Time")
      }
    }
    
    if (dispersal == TRUE) {
      filepattern <- "binary_dispersalRate.grd$"
    } else {
      filepattern <- "binary.grd$"
    }
    
    #Creates a matrix with the correct file paths to the current and future rasters
    collength <- length(list.files(path = file.path(correctDirectories[1]),
                                   pattern = paste0(filepattern),
                                   full.names = TRUE))
    
    results <- matrix(data = NA,
                      nrow = collength + 1,
                      ncol = length(correctDirectories),
                      byrow = FALSE,
                      dimnames = NULL)
    
    sortmodern <- which(timeSort == time_periods[1])
    
    for (i in 1:ncol(results)) {
      results[sortmodern, i] <- modernData
    }
    
    for(i in 1:length(correctDirectories)) {
      files <- list.files(path = file.path(correctDirectories[i]),
                          pattern = paste0(filepattern),
                          full.names = TRUE)
      
      for (j in 2:nrow(results)) {
        sortfut <- which(timeSort == time_periods[j])
        futfile <- files[grep(time_periods[j], files)]
        results[sortfut, i] <- futfile
      }
    }
    
    #Stacks the list of projected raster files and gives the stack the name %Scenarios[i]%
    for(i in 1:ncol(results)) {
      if (terra::ext(terra::rast(results[1, 1])) == terra::ext(terra::rast(results[2, 1]))) {
        assign(scenarios[i], terra::rast(results[, i]))
      } else {
        #if the extents don't match, crop the rasters to ensure that they do
        assign(scenarios[i], NULL)
        for(j in 1:nrow(results)) {
          minX <- max(terra::ext(terra::rast(results[1, 1]))[1], terra::ext(terra::rast(results[2, 1]))[1])
          maxX <- min(terra::ext(terra::rast(results[1, 1]))[2], terra::ext(terra::rast(results[2, 1]))[2])
          minY <- max(terra::ext(terra::rast(results[1, 1]))[3], terra::ext(terra::rast(results[2, 1]))[3])
          maxY <- min(terra::ext(terra::rast(results[1, 1]))[4], terra::ext(terra::rast(results[2, 1]))[4])
          Extent2 <- rbind(c(minX, maxX), c(minY, maxY))
          if (j == 1) {
            assign(scenarios[i], terra::crop(terra::rast(results[j, i]), Extent2))
          } else {
            assign(scenarios[i], terra::rast(get(scenarios[i]), terra::crop(terra::rast(results[j, i]), Extent2)))
          }
        }
      }
    }
    
    #Makes a list of possible states of presence/absence through the multiple years
    l <- rep(list(0:1), numYear)
    possible <- expand.grid(l)
    possible <- possible[-1, ]
    
    ScenariosCalc <- c()
    allRasterNames <- list()
    for (i in 1:numScenario) {
      ScenariosCalc[[i]] <- list()
    }
    
    for(i in 1:numScenario) {
      #Defines variables
      rasterNames <- c()
      consRasterNames <- c()
      allRasters <- get(scenarios[i])
      breakpoints <- c(0)
      allRasterNames <- c()
      FinalPrintRast <- c()
      #For each possible state
      for(j in 1:nrow(possible)) {
        name <- ""
        binary <- possible[j, ]
        #Overlaps each binary raster (with a state of "1") for the given scenario and state
        for (col in 1:ncol(binary)) {
          name <- paste0(name, binary[col])
          if (binary[col] == 1) {
            if (!exists("computedRaster")) {
              computedRaster <- allRasters[[col]]
            } else {
              computedRaster <- overlap(computedRaster, allRasters[[col]])
              allRasterNames <- c(allRasterNames, names(computedRaster))
            }
          }
        }
        
        #creates a mask of the overlapped raster (removes areas that are state "0" for other times)
        for (k in 1:ncol(binary)) {
          if (binary[k] == 0) {
            computedRaster <- terra::mask(computedRaster, allRasters[[k]], inverse = FALSE, maskvalue = 1, updatevalue = 0)
            allRasterNames <- c(allRasterNames, names(computedRaster))
          }
        }
        
        #Creates a composite raster with the binary values of computedRaster
        PrintedRaster <- computedRaster
        PrintedRaster[PrintedRaster == 1] <- as.numeric(name)
        if (j == 1) {
          FinalPrintRast <- PrintedRaster
        } else {
          PrintStack <- c(PrintedRaster, FinalPrintRast)
          FinalPrintRast <- terra::app(PrintStack, fun = max)
        }
        
        terra::crs(FinalPrintRast) <- rasterCRS
        
        #Seperates the rasters showing a consistent trend (consecutiveCheck) and those that don't
        if (consecutiveCheck(name)) {
          breakpoints <- c(breakpoints, as.numeric(name) - 0.1)
          consRasterNames <- c(consRasterNames, paste0("raster_", name))
          assign(paste0("raster_", name), setbinary(computedRaster, as.numeric(name)))
          rm(computedRaster)
          gc()
        } else {
          #If the first and last time periods are a "0", the species distribution expanded and then contracted ("expand-contract")
          if ((binary[, 1] == 0) && (binary[, ncol(binary)] == 0)) {
            rasterNames <- c(rasterNames, paste0("raster_", as.character(as.numeric(name) + (largestNum * 2)), "_", BinToDec(as.numeric(name))))
            assign(paste0("raster_", as.character(as.numeric(name) + (largestNum * 2)), "_", BinToDec(as.numeric(name))), setbinary(computedRaster, (largestNum * 2)))
            breakpoints <- c(breakpoints, largestNum * 2 - 0.1)
            rm(computedRaster)
            gc()
            #If the first and last time periods are a "1", the species distribution contracted and then expanded ("contract-expand")
          } else if ((binary[, 1] == 1) && (binary[, ncol(binary)] == 1)) {
            rasterNames <- c(rasterNames, paste0("raster_", as.character(as.numeric(name) + (largestNum * 4)), "_", BinToDec(as.numeric(name))))
            assign(paste0("raster_", as.character(as.numeric(name) + (largestNum * 4)), "_", BinToDec(as.numeric(name))), setbinary(computedRaster, (largestNum * 4)))
            breakpoints <- c(breakpoints, largestNum * 4 - 0.1)
            rm(computedRaster)
            gc()
            #If the first and last time periods are different and there is no consistent trend ("mixed")
          } else {
            rasterNames <- c(rasterNames, paste0("raster_", as.character(as.numeric(name) + (largestNum * 3)), "_", BinToDec(as.numeric(name))))
            assign(paste0("raster_", as.character(as.numeric(name) + (largestNum * 3)), "_", BinToDec(as.numeric(name))), setbinary(computedRaster, (largestNum * 3)))
            breakpoints <- c(breakpoints, largestNum * 3 - 0.1)
            rm(computedRaster)
            gc()
          }
        }
      }
      
      #write the output raster
      if (dispersal == TRUE) {
        terra::writeRaster(FinalPrintRast,
                           filename = file.path(user_dir, base_dir ,result_dir, CurSpp, "TimeMapRasters", paste0("binary", scenarios[i], "_dispersal.grd")),
                           overwrite = TRUE)
      } else {
        terra::writeRaster(FinalPrintRast,
                           filename = file.path(user_dir, base_dir , result_dir, CurSpp, "TimeMapRasters", paste0("binary", scenarios[i], ".grd")),
                           overwrite = TRUE)
      }
      
      #Creates breakpoints (used to delineate colors in the PDFs)
      breakpoints <- c(breakpoints, max(breakpoints) + 1)
      breakpoints <- unique(breakpoints)
      #Makes names for the legend
      consRasterNames <- sort(consRasterNames)
      rasterNames <- gtools::mixedsort(rasterNames)
      stackedRaster <- get(consRasterNames[1])
      for (index in 2:length(consRasterNames)) {
        stackedRaster <- c(stackedRaster, get(consRasterNames[index]))
      }
      if (length(rasterNames) > 0) {
        for (index in 1:length(rasterNames)) {
          stackedRaster <- c(stackedRaster, get(rasterNames[index]))
        }
      }
      
      #Gets colors for the graph
      color <- c()
      color <- c(color, "lightgrey")
      dbtolb <- grDevices::colorRampPalette(c("darkblue", "dodgerblue"))(floor(length(consRasterNames) / 2))
      redtoyellow <- grDevices::colorRampPalette(c("red", "yellow"))(ceiling(length(consRasterNames) / 2))
      
      #The amount of "mixed" depends on the number of time steps
      if (length(time_periods) == 3) {
        pinktopurple <- grDevices::colorRampPalette(c("magenta3", "pink"))(2)
      } else {
        pinktopurple <- grDevices::colorRampPalette(c("magenta3", "pink"))(3)
      }
      if (length(time_periods) == 2) {
        color <- c(color, dbtolb)
        color <- c(color, redtoyellow)
      } else {
        color <- c(color, dbtolb)
        color <- c(color, redtoyellow)
        color <- c(color, pinktopurple)
      }
      
      #Combines all of the rasters into a single one
      ScenariosCalc <- c(ScenariosCalc, terra::app(stackedRaster, fun = max))
      r <- ScenariosCalc[[length(ScenariosCalc)]]
      
      #Gets the full legend captions
      bin <- c()
      for (index in 1:length(consRasterNames)) {
        bin <- c(bin, unlist(strsplit(consRasterNames[index], "_"))[2])
      }
      if (length(rasterNames) > 0) {
        for (index in 1:length(rasterNames)) {
          bin <- c(bin, unlist(strsplit(rasterNames[index], "_"))[2])
        }
      }
      
      BinaryPoss <- rep(c(), nrow(possible))
      for(p in 1:nrow(possible)) {
        q <- 1
        BinaryPoss[p] <- possible[p, q]
        for (q in 2:ncol(possible)) {
          BinaryPoss[p] <- paste0(BinaryPoss[p], (possible[p, q]))
        }
      }
      
      #Makes "expand-contract", "contract-expand", and "mixed" as legend captions
      for(binIndex in 1:length(bin)) {
        if (as.numeric(bin[binIndex]) > largestNum) {
          for (p in 1:length(BinaryPoss)) {
            if (grepl(BinaryPoss[p], bin[binIndex]) == TRUE) {
              if ((possible[p, 1] == 0) && (possible[p, ncol(possible)] == 0)) {
                bin[binIndex] <- paste0("expand-contract")
              } else if ((possible[p, 1] == 1) && (possible[p, ncol(possible)] == 1)) {
                bin[binIndex] <- paste0("contract-expand")
              } else {
                bin[binIndex] <- paste0("mixed")
              }
            }
          }
        }
      }
      
      bin <- unique(bin)
      rm(stackedRaster)
      rm(list = consRasterNames)
      rm(list = rasterNames)
      gc()
      
      if (dispersal == TRUE) {
        #creates pdf of the Time Maps
        grDevices::pdf(file = file.path(user_dir, base_dir ,result_dir, CurSpp, "TimeMaps", paste0(scenarios[i], "_dispersalRate_TimeMap.pdf")))
        terra::plot(legend = FALSE,
                    breaks = breakpoints,
                    r,
                    col = color,
                    xlab = "",
                    ylab = "",
                    main = paste0(CurSpp, " ", scenarios[i], " dispersalRate"))
        graphics::legend("bottomright", legend = rev(bin), fill = rev(color), cex = 0.6)
        grDevices::dev.off()
      } else {
        #creates pdf of the Time Maps
        grDevices::pdf(file = file.path(user_dir, base_dir ,result_dir, CurSpp, "TimeMaps", paste0(scenarios[i], "_TimeMap.pdf")))
        terra::plot(legend = FALSE,
                    breaks = breakpoints,
                    r,
                    col = color,
                    xlab = "",
                    ylab = "",
                    main = paste0(CurSpp, " ", scenarios[i]))
        graphics::legend("bottomright", legend = rev(bin), fill = rev(color), cex = 0.6)
        grDevices::dev.off()
      }
      
      rm(r)
      gc()
    }
    rm(ScenariosCalc)
    gc()
  }
  if (ncores == 1) {
    ListSpp <- as.vector(ListSpp)
    out <- sapply(ListSpp, function(x) run(x))
  } else {
    clus <- parallel::makeCluster(ncores, setup_timeout = 0.5)
    
    parallel::clusterExport(clus, varlist = c("run", "overlap",
                                              "consecutiveCheck", "setbinary", "BinToDec",
                                              "numScenario", "timeSort", "numYear", "largestNum",
                                              "result_dir", "time_periods", "scenarios",
                                              "dispersal", "dispersaldata", "ncores",
                                              "ListSpp"), envir = environment())
    
    parallel::clusterEvalQ(clus, library(gtools))
    parallel::clusterEvalQ(clus, library(terra))
    
    for (i in 1:nrow(ListSpp)) {
      out <- parallel::parLapply(clus, ListSpp[i, ], function(x) run(x))
      gc()
    }
    parallel::stopCluster(clus)
  }
}

#3. Process raster files to csv files
F_process_raster_files_to_csv <- function(user_dir, base_dir, IntermediateResults, pattern = "\\.tif$") {
  # Define paths for the binary maps and occurrences directories
  binary_maps_dir <- file.path(user_dir, base_dir, IntermediateResults, "Binary_maps")
  occurrences_dir <- file.path(user_dir, base_dir, IntermediateResults, "occurrences")
  # Ensure Occurrences directory exists, create it if it doesn't
  if (!dir.exists(occurrences_dir)) {
    dir.create(occurrences_dir, recursive = TRUE)
  }
  
  # Process raster files: convert to CSV to generate occurrence datasets
  invisible(lapply(list.files(binary_maps_dir, pattern = pattern, full.names = TRUE), function(file_path) {
    # Load binary map raster and convert non-NA cells to a data frame
    occurrence_df <- as.data.frame(rasterToPoints(raster::raster(file_path)))
    
    # Extract file name without extension and remove ".tif" from the name
    file_name <- sub(pattern, "", basename(file_path))
    
    # Save the data frame as a CSV file in the Occurrences directory
    write.csv(occurrence_df, file.path(occurrences_dir, paste0(file_name, ".csv")), row.names = FALSE)
  }))
}


#4. Simulates dispersal using the dispersal distances provided and creates ensemble and binary maps of all species
F_dispersalRate <- function(result_dir, spp.list, dispersaldata, time_periods,
                          scenarios, contiguous = TRUE,
                          point_data = occ_output, ncores = ncores,
                          SetValuesUnderThresholdToZero = SetValuesUnderThresholdToZero, 
                          SetValuesAboveThresholdToOne = SetValuesAboveThresholdToOne) { 
                          
  
  if (length(spp.list) == 0) {
    stop(paste0("No projected models found in 'result_dir': Ensure that 'result_dir' provides a path to the proper location"))
  }
  #Calculates number of scenarios, future time periods
  numScenario <- length(scenarios)
  numYear <- length(time_periods)
  
  #Reads in dispersal data
  if (class(dispersaldata) == "character") {
    dispersal <- utils::read.csv(dispersaldata, stringsAsFactors = FALSE)
    dispersal[, 1] <- gsub("_", " ", dispersal[, 1])
  } else {
    dispersal <- dispersaldata
    dispersal[, 1] <- gsub("_", " ", dispersal[, 1])
  }
  
  ListSpp <- c()
  #If no dispersal rate data found for a given species, prints a message
  for (w in 1:length(spp.list)) {
    FocSpec <- gsub("_", " ", spp.list[w])
    DispSpec <- grep(paste0("^", FocSpec, "$"), dispersal[, 1])
    if (length(DispSpec) == 0) {
      message(paste0("No dispersal rate values found for ", FocSpec, ": skipping dispersal rate analysis"))
    } else {
      ListSpp <- c(ListSpp, spp.list[w])
    }
  }
  if (length(ListSpp) < ncores) {
    ncores <- length(ListSpp)
  }
  ListSpp <- matrix(ListSpp, ncol = ncores)
  
  #Functions-------------------
  
  getSize <- function(raster) {
    Freq <- data.frame(terra::freq(raster, digits = 0, value = 1))
    return(Freq$count)
  }
  
  getCentroid <- function(raster) {
    #convert raster to points and only take the presence points
    points <- terra::as.points(raster, values = TRUE)
    points <- points[which(terra::values(points) == 1),]
    
    #Get the coordinates of the points
    points <- data.frame(terra::geom(points))[, c("x", "y")]
    
    #average latitude (y)
    Clat <- mean(points[, 2], na.rm = TRUE)
    
    #average longitude (x)
    Clong <- mean(points[, 1], na.rm = TRUE)
    
    #returns the longitude & latitude of the Centroid
    return(c(Clong, Clat))
  }
  
  
  #Creates distance rasters from original projection (studyarea environmental rasters)
  DistanceRaster <- function(spp, Time, Scen, CurrentBinary, TimeMap) {
    #Loads and reclassifies the binary maps
    CurrentPresence <- CurrentBinary
    CurrentPresence[which(terra::values(CurrentPresence) == 0)] <- NA
    #Trims the time map as an extent template for faster calculations
    TimeMap2 <- TimeMap
    TimeMap2[which(terra::values(TimeMap2) == 0)] <- NA
    TimeMap2 <- terra::trim(TimeMap2)
    TimeMap2[which(is.na(terra::values(TimeMap2)))] <- 0
    #Trims "CurrentPresence" to the extent of the time maps
    CurrentPresence <- terra::crop(CurrentPresence, terra::ext(TimeMap2))
    
    #Calculates the distances from each pixel to the nearest presence
    CurrDist <- terra::distance(CurrentPresence)
    #Extends the raster back out to full study area extent
    CurrDist <- terra::extend(CurrDist, terra::ext(CurrentBinary))
    CurrDist[which(is.na(terra::values(CurrDist)))] <- max(terra::values(CurrDist), na.rm = TRUE) + 1
    DistFinal <- terra::mask(CurrDist, CurrentBinary)
    
    #if the data have units that are not degrees or meters, convert distance values to meters.
    if(terra::linearUnits(DistFinal) != 0) {
      unitmult <- terra::linearUnits(DistFinal)
      DistFinal <- DistFinal * unitmult
    }
    
    #Converts distance (now in meters) to kilometers (for dispersal rate)
    DistFinal <- (DistFinal / 1000)
    
    #writes distance raster
     terra::writeRaster(DistFinal,
                 filename = paste0(user_dir, base_dir, result_dir, "/", spp, "/", "distance_", Time, "_", Scen, ".grd"),
                 overwrite = TRUE)
    rm(CurrentPresence, CurrDist)
    gc()
    return(DistFinal)
  }
  
  #Creates dispersal probability raster from distance raster
  DispersalProbRaster <- function(rate, DistRaster, Elapsed) {
    #Calculates lambda of exponential distribution
    Lambda <- 1 / rate
    
    #When exponential distributions are added, they convolute to a gamma distribution
    GammaProbFun <- function(x) {
      1 - stats::pgamma(x, shape = Elapsed, rate = Lambda)
    }
    
    #Relates distance raster to dispersal probability
    DistProb <- terra::app(DistRaster, fun = function(x){GammaProbFun(x)})
    return(DistProb)
  }
  
  #Gets presence pixels in raster 1 but not raster 2
  t1nott2 <- function(t1, t2) {
    return(terra::mask(t1, t2, inverse = FALSE, maskvalue = 1, updatevalue = 0))
  }
  
  #Calculates overlap between raster 1 and raster 2 presences
  overlap <- function(t1, t2) {
    return(terra::mask(t1, t2, inverse = TRUE, maskvalue = 1, updatevalue = 0))
  }
  
  #Conducts the actual dispersal rate analyses
  FinalDispersal <- function(CurSpp) {
    #Gets species name and relevant dispersal rate
    speciesName = gsub("_", " ", CurSpp)
    if (length(grep(paste0(speciesName), dispersal[, 1])) > 0) {
      #Finds species-specific dispersal rate
      dispRateColumn <- which(unlist(lapply(dispersal, is.numeric)))
      dispersal_rate <- dispersal[grep(paste0(speciesName, "\\s*$"), dispersal[, 1]), dispRateColumn]
      if (length(dispersal_rate) > 1) {
        stop(paste0("More than one dispersal rate found for ", speciesName))
      }
      if (!is.na(dispersal_rate)) {
        CurrentTime <- time_periods[1]
        
        #If desired, removes patches of the binary map at the first time step that do not border
        #the occurrence points used for the model. This is to avoid extrapolation errors.
        if (contiguous == TRUE) {
          
          #Read in the binary and ensembled rasters for the species at the time period the model was trained on
          CurrentBinary <- terra::rast(file.path(user_dir, base_dir, result_dir, CurSpp, paste0(CurrentTime, "_binary.grd")))
          CurrentEnsemble <- terra::rast(file.path(user_dir, base_dir, result_dir, CurSpp, paste0(CurrentTime, "_ensembled.grd")))
          

          CurrentPatch <- terra::patches(CurrentBinary, zeroAsNA = TRUE)
          
          #Get a list of occurrences and convert to SpatVector
          occurrence <- read.csv(file.path(point_data, paste0(CurSpp, ".csv")))
          occurrence <- terra::vect(occurrence, geom = c("x", "y"))
          terra::crs(occurrence) <- terra::crs(CurrentPatch)
          
          #Extract patch ID numbers that have points in them
          occ_extract <- terra::extract(CurrentPatch, occurrence, ID = FALSE)
          truepatches <- unique(occ_extract$patches)
          truepatches <- truepatches[which(!is.na(truepatches))]
          
          #Convert unoccupied patches to 0, occupied patches to 1
          CurrentPatch <- terra::match(CurrentPatch, truepatches)
          CurrentPatch[!is.na(CurrentPatch)] <- 1
          CurrentPatch[is.na(CurrentPatch)] <- 0
          CurrentPatch <- terra::mask(CurrentPatch, CurrentBinary)
          
          #Clip ensembled raster to boundary of occupied patches
          Ensemble2 <- terra::mask(CurrentEnsemble, CurrentPatch, maskvalue = 0)
          Ensemble2[is.na(Ensemble2)] <- 0
          Ensemble2 <- terra::mask(Ensemble2, CurrentBinary)
          
          #Write out rasters
          terra::writeRaster(CurrentBinary, file.path(user_dir, base_dir, result_dir, CurSpp,
                                                      paste0(CurrentTime, "_binary_original.grd")),
                             overwrite = TRUE)
          terra::writeRaster(CurrentEnsemble, file.path(user_dir, base_dir, result_dir, CurSpp,
                                                        paste0(CurrentTime, "_ensembled_original.grd")),
                             overwrite = TRUE)
          
          terra::writeRaster(CurrentPatch, file.path(user_dir, base_dir, result_dir, CurSpp,
                                                     paste0(CurrentTime, "_binary.grd")), overwrite = TRUE)
          terra::writeRaster(Ensemble2, file.path(user_dir, base_dir, result_dir, CurSpp,
                                                  paste0(CurrentTime, "_ensembled.grd")), overwrite = TRUE)
        }
        
        CurrentBinary <- terra::rast(paste0(user_dir, base_dir, result_dir, "/", CurSpp, "/", CurrentTime, "_binary.grd"))
        
        if(is.na(terra::linearUnits(CurrentBinary))) {
          stop("The spatial units of the data cannot be found!
           Choose a different coordinate system for all data or add units into the existing one.")
        }
        
        #Creates variables for stats
        Projection <- c("Current")
        NumberCells <- getSize(CurrentBinary)
        CellChange <- c(0)
        T1notT2 <- c(0)
        T2notT1 <- c(0)
        Overlap <- c(0)
        CentroidX <- c(getCentroid(CurrentBinary)[1])
        CentroidY <- c(getCentroid(CurrentBinary)[2])
        
        #Creates dispersal rasters and PDFs for each Scenario + time
        for (s in 1:length(scenarios)) {
          CurScen <- scenarios[s]
          curdir <- file.path(user_dir, base_dir, result_dir, CurSpp, CurScen)
          DispersalNames <- c()
          TimeMap <- terra::rast(file.path(user_dir, base_dir, result_dir, CurSpp, "TimeMapRasters", paste0("binary", CurScen, ".grd")))
          for (y in 2:length(time_periods)) {
            CurYear <- time_periods[y]
            
            #Calculates distance from current distribution
            if (y == 2) {
              DistanceRastersExist <- list.files(path = file.path(user_dir, base_dir, result_dir, CurSpp),
                                                 pattern = paste0("distance_", time_periods[1], "_Current.grd$"))
              if (length(DistanceRastersExist) == 0) {
                SppDistance <- DistanceRaster(CurSpp, CurrentTime, "Current", CurrentBinary, TimeMap)
                OriginalDistance <- SppDistance
              } else {
                OriginalDistance <- terra::rast(file.path(user_dir, base_dir, result_dir, CurSpp, DistanceRastersExist))
                SppDistance <- OriginalDistance
              }
            } else {
              FocusTime <- time_periods[y - 1]
              
              #Reads in the current distribution (from the previous time step)
              CurrentDistribution <- Binary_Dispersal
              
              #Sizes down the raster for faster distance measuring
              TimeMap2 <- TimeMap
              TimeMap2[which(terra::values(TimeMap2) == 0)] <- NA
              TimeMap2 <- terra::trim(TimeMap2)
              TimeMap2[which(is.na(terra::values(TimeMap2)))] <- 0
              
              #Highlights the places where species lived in the previous time step
              CurrentDistribution <- terra::crop(CurrentDistribution, terra::ext(TimeMap2))
              CurrentDistribution[which(terra::values(CurrentDistribution) == 0)] <- NA
              
              #Creates new distance raster
              CurrentDistance <- terra::distance(CurrentDistribution) / 1000
              SppDistance <- terra::extend(CurrentDistance, terra::ext(Binary_Dispersal))
              SppDistance[which(is.na(terra::values(SppDistance)))] <- max(terra::values(SppDistance), na.rm = TRUE) + 1
              
              if ((terra::ext(SppDistance) != terra::ext(CurrentBinary)) | (terra::ncell(SppDistance) != terra::ncell(CurrentBinary))) {
                message("Raster extents are not consistent: only the intersection of the rasters will be analysed")
                SppDistance <- terra::intersect(SppDistance, CurrentBinary)
                SppDistance <- terra::resample(SppDistance, CurrentBinary, method = "bilinear")
              }
              SppDistance <- terra::mask(SppDistance, CurrentBinary)
            }
            
            #Calculates the dispersal probability for the given time step
            TimeDiff <- abs(CurYear - time_periods[y - 1])
            SppDispProb <- DispersalProbRaster(dispersal_rate, SppDistance, TimeDiff)
            RasterList <- list.files(path = curdir, pattern = paste0(".grd$"))
            
            #Creates an ensembled raster that incorporates dispersal rate
            #Calculates the ensembled dispersal probability * habitat suitability to make "invadable suitability"
            
            EnsembleNum <- grep(paste0(CurYear, "_", CurScen, "_ensembled.grd"), RasterList)
            EnsembleSD <- terra::rast(file.path(curdir, RasterList[EnsembleNum]))
            if ((terra::ext(SppDispProb) != terra::ext(EnsembleSD)) | (terra::ncell(SppDispProb) != terra::ncell(EnsembleSD))) {
              message("Raster extents are not consistent: only the intersection of the rasters will be analysed")
              SppDispProb <- terra::intersect(SppDispProb, EnsembleSD)
              SppDispProb <- terra::resample(SppDispProb, EnsembleSD, method = "bilinear")
            }
            
            Ensemble_Dispersal <- SppDispProb * EnsembleSD
            if (!is.na(terra::crs(EnsembleSD))) {
              terra::crs(Ensemble_Dispersal) <- terra::crs(EnsembleSD)
            }

            #Writes the ensembled dispersal rate raster
            if(SetValuesUnderThresholdToZero == FALSE & SetValuesAboveThresholdToOne == FALSE){
              Species_RangeMap <- Ensemble_Dispersal
              return(Species_RangeMap)
            }

            # Read the CSV file
            dt_AllMetrics <- read.csv(file.path(user_dir,base_dir,AllMetrics_file)) 
            # Extract the cutoff value
            cutoff_value <- dt_AllMetrics[dt_AllMetrics$species == CurSpp, "cutoff.ens"]
            
            # Proceed if a cutoff value was found
            if (length(cutoff_value) > 0) {
              # Apply the cutoff value to create the binary raster
              Binary_Dispersal <- Ensemble_Dispersal
              Binary_Dispersal[Binary_Dispersal >= 0 & Binary_Dispersal < cutoff_value] <- 0
              Binary_Dispersal[Binary_Dispersal >= cutoff_value] <- 1
              
              # Save the raster to species_out_dir
              if(SetValuesUnderThresholdToZero == TRUE & SetValuesAboveThresholdToOne == TRUE){
                Species_RangeMap <- Binary_Dispersal
                return(Species_RangeMap)
              }

              # Add to DispersalNames
              DispersalNames <- c(DispersalNames, paste0(CurYear, "_", CurScen, "_ensembled_dispersalRate"))
            } else {
              warning(paste("No cutoff value found for species:", CurSpp))
            }
            #Fills out the stats table
            Projection <- c(Projection, paste0(CurScen, "_", CurYear))
            FocusNCells <- getSize(Binary_Dispersal)
            NumberCells <- c(NumberCells, FocusNCells)
            CellChange <- c(CellChange, NumberCells[length(NumberCells)] - NumberCells[1])
            T1notT2_rast <- t1nott2(CurrentBinary, Binary_Dispersal)
            T2notT1_rast <- t1nott2(Binary_Dispersal, CurrentBinary)
            T1notT2 <- c(T1notT2, getSize(T1notT2_rast))
            T2notT1 <- c(T2notT1, getSize(T2notT1_rast))
            Overlap_rast <- overlap(Binary_Dispersal, CurrentBinary)
            Overlap <- c(Overlap, getSize(Overlap_rast))
            CentroidX <- c(CentroidX, getCentroid(Binary_Dispersal)[1])
            CentroidY <- c(CentroidY, getCentroid(Binary_Dispersal)[2])
          }
          
        }
        
        #Fills out stats table
        stats <- data.frame(Projection = Projection,
                            NumberCells = NumberCells,
                            CellChange = CellChange,
                            T1notT2 = T1notT2,
                            T2notT1 = T2notT1,
                            Overlap = Overlap,
                            CentroidX = CentroidX,
                            CentroidY = CentroidY)
        
        utils::write.csv(stats, file = file.path(user_dir, base_dir, result_dir, CurSpp, "Results_Dispersal.csv"))
        rm(CurrentBinary)
        gc()
      } else {
        message(paste0("No dispersal rate values found for ", speciesName, ": skipping dispersal rate analysis"))
      }
    } else {
      message(paste0("No dispersal rate data found for ", speciesName, ": skipping dispersal rate analysis"))
    }
  }
  
  if (ncores == 1) {
    ListSpp <- as.vector(ListSpp)
    out <- FinalDispersal(ListSpp)
    return(out)
  } 
  }




# ====================================================================
#
# Copyright 2025, PBL Netherlands Environmental Assessment Agency
# 
# This source code of the BioScore model is owned by PBL Netherlands Environmental Assessment Agency. 
# It is not permitted to copy, redistribute, remix, transform, and build upon the material without written approval of PBL. 
# Permission for commercial purposes will not be granted. 
# This code is published to improve the transparency of the models used by PBL, 
# but without any warranty for fitness for any other purpose. 
# After approval of PBL to use the code, PBL will not provide any support.
#
# 
# ====================================================================

