I have multiple tests to perform on my data. I have already built a function for each test separately. For example, here is a function of one test (which is not our concern, it runs well):
R <- function(series, alpha=0.05) {
library(tseries)
library(LSTS)
model <- 0
######################### Random Walk test #########################
#H0: iid residuals
RW <- Box.test(series, lag=1, type="Ljung")
p_value3 <- RW$p.value
if (p_value3 > alpha) {print("Failt to reject H_0, No autocorrolation, this is a Random Walk process !")
model <- 2
}
return(model)
}
For summary, I have four functions each performing a test. The functions are "C","R","L" and "Y" each returning a score of 1,2,3 and 4 respectively.
I want to do a permutation of tests, but i don't know how can i do it for all the 24 combinations.
Perumtation 1: CLYR Start with "C" test, if rejected go to "L" test, if rejected go to "Y" test, if rejected go to "R" test.
Note: once a test is accepted, we stop and we keep the score returned. Note: if all tests are rejected, the score is 0
At the end of the 24 permutations, we count the frequency of scores. For example,
Score | Frequency |
---|---|
0 | 1 |
1 | 5 |
2 | 12 |
3 | 2 |
4 | 4 |
what about:
library(combinat) ## provides permutation function "permn"
tests <- list(
C = list(f = \(x) {x < 10}, score = 1),
R = list(f = \(x) {x < 30}, score = 2),
L = list(f = \(x) {x < 50}, score = 3),
Y = list(f = \(x) {x < Inf}, score = 4)
)
perms <- combinat::permn(c('C', 'R', 'L', 'Y'))
## > perms
## [[1]]
## [1] "C" "R" "L" "Y"
##
## [[2]]
## [1] "C" "R" "Y" "L"
## truncated
do.call
ing the test functions in the shuffled orders, identifying the index of the latest passed (before first failed) test and retrieving the associated score:perms |>
Map(f = \(perm) {
tests_shuffled <- tests[perm]
latest_pass <- - 1 + which(tests_shuffled |>
Map(f = \(test) do.call(test$f, list(x = 42))) == FALSE
)[1]
score <- ifelse(latest_pass < 1, 0, tests_shuffled[[latest_pass]]$score)
c(paste(perm, collapse = ''), score)
}) |>
Reduce(f = rbind) |>
as.data.frame(row.names = FALSE) |>
setNames(nm = c('perm', 'score'))
output:
perm score
1 CRLY 0
2 CRYL 0
3 CYRL 0
4 YCRL 4
5 YCLR 4
6 CYLR 0
7 CLYR 0
8 CLRY 0
9 LCRY 3
## truncated
table
it, or simply append |> (\(.) table(.$score))()
to the previous pipe:## + setNames(nm = c('perm', 'score')) |>
## + (\(.) table(.$score))()
0 3 4
12 6 6