Цикл внутри функции в R - PullRequest
0 голосов
/ 12 июня 2018

Я хочу создать функцию, которая содержит оператор ifelse следующим образом:

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)

Тогда у меня будет это:

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

Вот пример данных:

  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

Таким образом, код будет проверять данные за последние 4 недели, начиная с самых последних (то есть 2018 неделя 23, неделя 22, неделя 21 и неделя 20)

Начальная неделя можетизменить, и я хочу сделать эту работу, чтобы я ввел первую неделю, и он выполняет функцию в течение последних 4 недель. Я хочу ввести только первую неделю, поэтому только один ввод. Так что, если я введу col_201820, я получу ответ за недели col_201820, col_201819, col_201818 и col_201817.

Я хочучтобы выполнить это за 52 недели данных (то есть за год) в какой-то момент, поэтому я пытаюсь облегчить изменение, если начальная неделя изменится. Также необходимо перейти к 201752, 201751, 201750, если начальная неделя - 201801.

Я не уверен, с чего начать, поэтому не могу ничего показатьмы уже пробовали.

** Код для воспроизводимого примера

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))

Ответы [ 2 ]

0 голосов
/ 12 июня 2018

Полагаю, вы хотите выяснить, как создать вектор недель из начальной недели.Например,

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))
}

, поэтому

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

Используйте это в верхней части функции ArrearsL1M().Я бы реализовал это как

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
}

Для более сложного анализа измените weeks_from_start() на

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)

Возможно, это приближается к «хаку», например, все ли годы имеют 52 недели?Для года, начинающегося, скажем, во вторник, неделя 1 Вт - воскресенье, неделя 52 предыдущего года - только понедельник?Время переосмыслить, как эти данные представлены ...

0 голосов
/ 12 июня 2018
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)

}

С 1 импульсом:

ArrearsL1M <- function(cols){

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

  return(output)

}
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...