Search code examples
rtestingpermutation

How to run all permutations of a test set, break at first "fail" and keep results of last "pass" per permutation


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

Solution

  • what about:

    library(combinat) ## provides permutation function "permn"
    
    • define your test list:
    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)
    )
    
    • get the list of permutations:
    perms <- combinat::permn(c('C', 'R', 'L', 'Y'))
    
    ## > perms
    ## [[1]]
    ## [1] "C" "R" "L" "Y"
    ## 
    ## [[2]]
    ## [1] "C" "R" "Y" "L"
    ## truncated
    
    • iterate over the permutations, shuffling your test list according to each permutation, do.calling 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
    
    • to tabulate scores, store above output to object and table it, or simply append |> (\(.) table(.$score))() to the previous pipe:
    ## +   setNames(nm = c('perm', 'score')) |>
    ## +   (\(.) table(.$score))()
     0  3  4 
    12  6  6