View source: R/curvefits_LocalModel.R
curvefits_LocalModel | R Documentation |
Local model functions f_L(t)
, f_C(t)
and f_R(t)
describe the VI variation in intervals around the left minima, the central
maxima and the right minima.
Local model function are merged into global model function via merge_LocalModels()
and Per J\"onsson et al. (2004; their Eq. 12),
where cut-off function sharply drop from 1 to 0 in small intervals around
(t_L + t_C)/2
and (t_C + t_R)/2
.
F(t)= \begin{cases}
\alpha(t) f_{L}(t)+[1-\alpha(t)] f_{C}(t), t_{L}<t<t_{C} \\
\beta(t) f_{C}(t)+[1-\beta(t)] f_{R}(t), t_{C}<t<t_{R}\end{cases}
curvefits_LocalModel(INPUT, brks, options = list(), ...)
merge_LocalModels(fits)
INPUT |
A list object with the elements of 't', 'y', 'w', 'Tn' (optional)
and 'ylu', returned by |
brks |
A list object with the elements of 'fit' and 'dt', returned by
|
options |
see section: options for fitting for details. |
... |
other parameters to |
fits |
List objects returned by |
methods
(default c('AG', 'Beck', 'Elmore', 'Zhang')``): Fine curve fitting methods, can be one or more of
c('AG', 'Beck', 'Elmore', 'Zhang',
'Gu', 'Klos')‘. Note that ’Gu' and 'Klos' are very slow.
iters
(default 2): max iterations of fine fitting.
wFUN
(default wTSM
): Character or function, weights updating function
of fine fitting function.
wmin
(default 0.1): min weights in the weights updating procedure.
use.rough
(default FALSE): Whether to use rough fitting smoothed
time-series as input? If false
, smoothed VI by rough fitting will be used
for Phenological metrics extraction; If true
, original input y
will be
used (rough fitting is used to divide growing seasons and update weights.
use.y0
(default TRUE): boolean. whether to use original y0
as the input
of plot_input
, note that not for curve fitting. y0
is the original
value before the process of check_input
.
nextend
(default 2): Extend curve fitting window, until nextend
good or
marginal points are found in the previous and subsequent growing season.
maxExtendMonth
(default 1): Search good or marginal good values in
previous and subsequent maxExtendMonth
period.
minExtendMonth
(default 0.5): Extend period defined by nextend
and
maxExtendMonth
, should be no shorter than minExtendMonth
. When all
points of the input time-series are good value, then the extending period
will be too short. In that situation, we can't make sure the connection
between different growing seasons is smoothing.
minPercValid
: (default 0, not use). If the percentage of good- and
marginal- quality points is less than minPercValid
, curve fiting result is
set to NA
.
minT
: (not use). If Tn
not provided in INPUT
, minT
will
not be used. minT
use night temperature Tn to define backgroud value
(days with Tn < minT
treated as ungrowing season).
Per J\"onsson, P., Eklundh, L., 2004. TIMESAT - A program for analyzing time-series of satellite sensor data. Comput. Geosci. 30, 833-845. \Sexpr[results=rd]{tools:::Rd_expr_doi("10.1016/j.cageo.2004.05.006")}.
curvefits()
## Not run:
library(phenofit)
data("CA_NS6")
d = CA_NS6
nptperyear <- 23
INPUT <- check_input(d$t, d$y, d$w, QC_flag = d$QC_flag,
nptperyear = nptperyear, south = FALSE,
maxgap = nptperyear/4, alpha = 0.02, wmin = 0.2)
# plot_input(INPUT)
# Rough fitting and growing season dividing
wFUN <- "wTSM"
brks2 <- season_mov(INPUT,
options = list(
rFUN = "smooth_wWHIT", wFUN = wFUN,
r_min = 0.05, ypeak_min = 0.05,
lambda = 10,
verbose = FALSE
))
# plot_season(INPUT, brks2, d)
# Fine fitting
fits <- curvefits_LocalModel(
INPUT, brks2,
options = list(
methods = c("AG", "Beck", "Elmore", "Zhang", "Gu"), #,"klos", "Gu"
wFUN = wFUN,
nextend = 2, maxExtendMonth = 2, minExtendMonth = 1, minPercValid = 0.2
),
constrain = TRUE
)
# merge local model function into global model function
fits_merged = merge_LocalModels(fits)
## Visualization ---------------------------------------------------------------
l_fitting = map(fits %>% guess_names, get_fitting) #%>% melt_list("period")
d_merged = get_fitting(fits_merged[[2]]) %>% cbind(type = "Merged")
d_raw = l_fitting[2:4] %>% set_names(c("Left", "Central", "Right")) %>%
melt_list("type")
d_obs = d_raw[, .(t, y, QC_flag)] %>% unique()
d_fit = rbind(d_merged, d_raw)[meth == "Zhang"]
levs = c("Left", "Central", "Right", "Merged")
levs_new = glue("({letters[1:4]}) {levs}") %>% as.character()
d_fit$type %<>% factor(levs, levs_new)
p = ggplot(d_obs, aes(t, y)) +
geom_point() +
geom_line(data = d_fit, aes(t, ziter2, color = type)) +
facet_wrap(~type) +
labs(x = "Date", y = "EVI") +
scale_x_date(date_labels = "%b %Y", expand = c(1, 1)*0.08) +
theme_bw(base_size = 13) +
theme(legend.position = "none",
strip.text = element_text(size = 14))
p
## End(Not run)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.