R Under development (unstable) (2024-10-26 r87273 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2024 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64
R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.
R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.
Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.
> library(tsDyn)
> suppressMessages(library(dplyr))
> library(purrr)
> library(tidyr)
>
> ############################
> ### Load data
> ############################
> path_mod_uni <- system.file("inst/testdata/models_univariate.rds", package = "tsDyn")
> if(path_mod_uni=="") path_mod_uni <- system.file("testdata/models_univariate.rds", package = "tsDyn")
>
> models_univariate <- readRDS(path_mod_uni)
>
> ############################
> ### Compute
> ############################
>
> ## ar_mean
> models_ar_mean <- models_univariate %>%
+ filter(model!="aar") %>%
+ mutate(ar_mean = map(object, ~suppressWarnings(ar_mean(.))))
>
> ############################
> ### Show result
> ############################
>
> ## should be only for both and trend
> check_1 <- models_ar_mean %>%
+ filter(map_lgl(ar_mean, is.null)) %>%
+ count(include)
>
> stopifnot(all(check_1$include == c("both", "trend")))
>
> ## should be only for const and none
> check_2 <- models_ar_mean %>%
+ filter(!map_lgl(ar_mean, is.null)) %>%
+ count(include)
>
> stopifnot(all(check_2$include == c("const", "none")))
>
> ## show results
> models_ar_mean %>%
+ filter(!map_lgl(ar_mean, is.null)) %>%
+ mutate(ar_mean = map(ar_mean, ~as_tibble(t(.)))) %>%
+ unnest(ar_mean) %>%
+ select(-object) %>%
+ as.data.frame() %>%
+ print(digits=3)
lag include model nthresh thDelay ar_mean ar_mean_H ar_mean_L ar_mean_M
1 1 const linear NA NA 2.42 NA NA NA
2 1 none linear NA NA 0.00 NA NA NA
3 2 const linear NA NA 2.40 NA NA NA
4 2 none linear NA NA 0.00 NA NA NA
5 1 const setar 1 0 NA 0.559 8.475 NA
6 1 const setar 2 0 NA 14.776 2.123 2.26
7 1 none setar 1 0 0.00 NA NA NA
8 1 none setar 2 0 0.00 NA NA NA
9 2 const setar 1 0 NA 1.444 4.648 NA
10 2 const setar 1 1 NA 2.421 1.703 NA
11 2 const setar 2 0 NA -0.567 0.316 2.50
12 2 const setar 2 1 NA 2.453 2.572 1.97
13 2 none setar 1 0 0.00 NA NA NA
14 2 none setar 1 1 0.00 NA NA NA
15 2 none setar 2 0 0.00 NA NA NA
16 2 none setar 2 1 0.00 NA NA NA
17 1 const lstar NA 0 NA -0.416 8.402 NA
18 1 none lstar NA 0 0.00 NA NA NA
19 2 const lstar NA 0 NA -0.441 4.657 NA
20 2 const lstar NA 1 NA 1.670 1.555 NA
21 2 none lstar NA 0 0.00 NA NA NA
22 2 none lstar NA 1 0.00 NA NA NA
>
>
> proc.time()
user system elapsed
2.06 0.32 2.37