Loop within a function in R

Question

I want to create a function that holds an ifelse statement like follows:

ArrearsL1M<-function(input1, input2, input3, input4){
  output=0
  output=ifelse((df[[input1]] %in% c(1,2,3,4,5)),1,
                ifelse((df[[input2]] %in% c(1,2,3,4,5)),1,
                       ifelse((df[[input3]] %in% c(1,2,3,4,5)),1,
                              ifelse((df[[input4]] %in% c(1,2,3,4,5)), 1, 0))))
  return(output)

Then I'd have this:

df$Arrears_L1M<-ArrearsL1M("col_201823","col_201822","col_201821","col_201820")

Here is an example of the data:

  col_201823 col_201822 col_201821 col_201820 col_201819 col_201818 col_201817 col_201816 col_201815
1         99          5          4          2         99         99         99         99         99
2          3          0          3          2          3          3          3          3          3
3          2          2          2          2          2          2          2          2          2
4          0          0          0          1          0          0          0          0          0
5         99         99          5         99         99         99         99         99         99
6          2          1          4         99          2          2          2          2          2
7          1          1         99         99          1          1          1          1          1

So the code will check the previous 4 weeks of data starting with the most recent (i.e. 2018 week 23, week 22, week 21 and week 20)

The starting week can change and I want to make this work so that the I enter the first week and it runs the function for the past 4 weeks. I only want to enter the first week, so only one input. So if I enter col_201820 I will get the answer for weeks col_201820, col_201819, col_201818 and col_201817.

I'll want to run this for 52 weeks of data (i.e. a year ) at some point so I'm trying to make it easier to change if the starting week changes. It also needs to go to 201752, 201751, 201750,if the starting week is 201801.

I'm not sure where to start with this so can't show you anything I've already tried.

** Code for reproducible example

col_201823<-c(99,3,2,0,99,2,1)
col_201822<-c(5,0,2,0,99,1,1)
col_201821<-c(4,3,2,0,5,4,99)
col_201820<-c(2,2,2,1,99,99,99)
col_201819<-c(99,3,2,0,99,2,1)
col_201818<-c(99,3,2,0,99,2,1)
col_201817<-c(99,3,2,0,99,2,1)
col_201816<-c(99,3,2,0,99,2,1)
col_201815<-c(99,3,2,0,99,2,1)

test<-as.data.frame(cbind(col_201823,col_201822,col_201821,col_201820,col_201819,col_201818,col_201817,col_201816,col_201815))

Answer 1

I guess you want to figure out how to create a vector of weeks from a starting week. For instance

weeks_from_start <- function(x) {
    week <- as.integer(substring(x, nchar(x) - 1))
    rest <- substring(x, 1, nchar(x) - 2)
    paste0(rest, seq(week, by = -1, length.out=4))
}

so

> weeks_from_start("col_201823")
[1] "col_201823" "col_201822" "col_201821" "col_201820"

Use this at the top of your ArrearsL1M() function. I would implement this as

ArrearsL1M <- function(df, last_week) {
    weeks <- weeks_from_start(last_week)
    m <- as.matrix(df[, weeks])
    m[] <- m %in% 1:5               # test all elements in 1 call; format as matrix
    rowSums(m) != 0
}

For more complicated parsing, revise weeks_from_start() as

week0 <- as.integer(substring(x, nchar(x) - 1))
year0 <- as.integer(substring(x, 5, 8))

week0 <- seq(week0, by = -1, length.out = 4)
week <- (week0 - 1) %% 52 + 1
year <- year0 - cumsum(week0 == 0)
sprintf("col_%4d%.2d", year, week)

Probably this is approaching a 'hack', e.g., do all years have 52 weeks? For a year beginning on, say, Tuesday, is week 1 Tues - Sunday, week 52 of the previous year just Monday? Time to rethink how this data is represented...

Answer 2

ArrearsL1M <- function(input1, input2, input3, input4){

  cols <- c(input1, input2, input3, input4)

  output <- as.numeric(apply(apply(df[, cols], 2, function(x) x %in% 1:5), 1, any))

  return(output)

}

With 1 imput:

ArrearsL1M <- function(cols){

  output <- as.numeric(apply(apply(df[, cols], 2, function(x) x %in% 1:5), 1, any))

  return(output)

}