Skip to content

Commit

Permalink
Update many features
Browse files Browse the repository at this point in the history
- Support the 6-parameter double-logistic function
- Support threshold-based phenometrics extraction method, which gives us 7 phenometrics including Greenup, MidGreenup, Maturity, Peak, Senescence, MidGreendown, and Dormancy.
- Fix bugs.
- Need to update the vignette.
  • Loading branch information
MrJGao committed Apr 16, 2024
1 parent 677d473 commit e3b5ccd
Show file tree
Hide file tree
Showing 17 changed files with 979 additions and 426 deletions.
1 change: 1 addition & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -4,3 +4,4 @@
inst/doc
/doc/
/Meta/
zzz*
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,7 @@ License: MIT + file LICENSE
Encoding: UTF-8
LazyData: true
Roxygen: list(markdown = TRUE)
RoxygenNote: 7.2.3
RoxygenNote: 7.3.1
Imports:
coda,
data.table,
Expand Down
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
# Generated by roxygen2: do not edit by hand

export("%>%")
export(BLSPFitted)
export(FitAvgModel)
export(FitBLSP)
export(FitBLSP_spring)
Expand Down
79 changes: 0 additions & 79 deletions R/base.R
Original file line number Diff line number Diff line change
Expand Up @@ -7,83 +7,4 @@

usethis::use_pipe(export = TRUE)

# The double-logistic function equation
model_str <- "m1 + (m2 - m7 * t) * ((1 / (1 + exp((m3 - t) / m4))) -
(1 / (1 + exp((m5 - t) / m6))))"


#' Make a standard color transparent.
#' This function is borrowed from 'yarrr' package, but I changed the trans.val
#' to use alpha value directly.
#' @param orig.col: the original color, can be a color name, a hexadecimal code,
#' or a rgb vector.
#' @param alpha: define the transparent level.
#' @param maxColorValue: used to convert the color to rgb format before making
#' it transparent.
#' @return color code.
#'
#' @noRd
Transparent <- function(orig.col, alpha = 1, maxColorValue = 255) {
n.cols <- length(orig.col)
orig.col <- grDevices::col2rgb(orig.col)
final.col <- rep(NA, n.cols)
for (i in 1:n.cols) {
final.col[i] <- grDevices::rgb(
orig.col[1, i], orig.col[2, i], orig.col[3, i],
alpha = alpha[i] * 255,
maxColorValue = maxColorValue
)
}
return(final.col)
}


#' Format input date and VI vectors to the structure needed for fitting averaged
#' phenology models such as Fisher et al 2006, Elmore et al 2012.
#'
#' @param date_vec the date vector, be sure to convert the vector to "Date"
#' format or use "yyyy-mm-dd" format string.
#' @param vi_vec The vegetation index vector.
#' @return A list that contains formated data.
#' @import data.table
#'
#' @noRd
FormatAvgData <- function(date_vec, vi_vec) {
# Check if date_vec is in Date format
if (sum(!is.na(lubridate::parse_date_time(date_vec, orders = "ymd"))) !=
length(date_vec)) {
stop("There're invalid Date values in the `date_vec`!
Be sure to use `yyyy-mm-dd` format.")
}

# Make it a data table
vi_dt <- data.table::data.table(
date = as.Date(date_vec),
evi2 = vi_vec,
avg_date = ""
)
vi_dt[, avg_date := as.Date(paste0("1970", substr(vi_dt$date, 5, 10)))]
vi_dt <- stats::na.omit(vi_dt)
data.table::setorder(vi_dt, date)

# Find unique dates in the averaged year
unique_dates <- unique(vi_dt$avg_date)

# Deal with multiple observations on the same date in the averaged year.
# When that happens, we choose the one whose EVI2 value is the highest.
merge_dt <- sapply(unique_dates, function(x) {
# find how many records this day has
evi2 <- NA
find_idx <- which(x == vi_dt$avg_date)
if (length(find_idx) == 1) {
evi2 <- vi_dt[find_idx]$evi2
} else if (length(find_idx) > 1) { # we have multiple values for this date
# compute the max
evi2 <- max(vi_dt[avg_date == x]$evi2, na.rm = TRUE)
}
return(list(date = x, evi2 = evi2))
})
merge_dt <- data.table::as.data.table(t(merge_dt))

return(merge_dt)
}
7 changes: 1 addition & 6 deletions R/dat_dl_point_ts.R
Original file line number Diff line number Diff line change
Expand Up @@ -131,12 +131,7 @@ GetEvi2PointTs <- function(pt_coords, focalDates = "1984-01-01/2022-12-31",
ncores
)
cl <- parallel::makeCluster(ncores)
calls <- parallel::clusterCall(cl, function() {
suppressWarnings({
require(terra)
require(magrittr)
})
})
calls <- parallel::clusterCall(cl, function() {})
parallel::clusterExport(cl,
c("CalEVI2", "pt_coords"),
envir = environment()
Expand Down
Loading

0 comments on commit e3b5ccd

Please sign in to comment.