Какова альтернатива этому медленному циклу for для заполнения отдельных дней между датами?

Вот подход, основанный на создании всех индексов наблюдений, которые должны быть установлены на 1, а затем на заполнении значений.

# The data
df1 <- data.frame(Person = c(1,1,1,1,1),
                  StartDate = c("01-01","02-01","03-01","04-01","05-01"),
                  DAYS = c(3,NA,NA,NA,1))

# Initialize the vector we want with zeros
df1$Absent <- 0

# we get the indices of all the non-zero day entries
inds <- which(!is.na(df1$DAYS))

# Now we are going to build a list of all the indices that should be
# set to one. These are the intervals from when absence starts to
# the number of days absent - 1
inds_to_change <- mapply(function(i,d){i:(i+d-1)}, inds, na.omit(df1$DAYS))

df1$Absent[unlist(inds_to_change)] <- 1
df1
#>   Person StartDate DAYS Absent
#> 1      1     01-01    3      1
#> 2      1     02-01   NA      1
#> 3      1     03-01   NA      1
#> 4      1     04-01   NA      0
#> 5      1     05-01    1      1

^{Создана 20 февраля 2019 г. в пакете reprex (v0.2.1)}

Более быстрое решение можно найти, используя встроенные функции R.

Общая идея:

1. Для каждого человека найдите позицию для отсутствующих дней больше 1. Пусть количество отсутствующих дней будет a, а позиция будет p.
2. В каждую позицию, определенную последовательностью p:(p + a - 1), вставьте значение 1.
3. Верните переопределенный вектор вместо старого вектора.

Все это можно реализовать в виде функции, а затем применить ко всем подгруппам. Чтобы это было быстрее

функция

В конкретном случае использование mapply (как следует из предыдущего ответа) работает, но использование data.table в целом будет быстрее для больших наборов данных. Это используется ниже.

RelocateAbsentees <- function(x){
  #Find the position in x for which the value is greater than 1
  pos <- which(x > 1)
  #Fill in the vector with the absent days
  for(i in pos){
    val <- x[i]
    x[i:(i + val - 1)] <- 1
  }
  #return the vector
  pos
} 
df1 <- data.frame(Person = c(1,1,1,1,1),
                  StartDate = c("01-01","02-01","03-01","04-01","05-01"),
                  DAYS = c(3,NA,NA,NA,1))
library(data.table)
setDT(df1)
df2 <- copy(df1)[,Person := 2]
df3 <- rbind(df1,df2)
#Using data.table package (faster)
df1[, newDays := RelocateAbsentees(DAYS), by = Person]
df3[, newDays := RelocateAbsentees(DAYS), by = Person]

Я нашел довольно аккуратное решение, используя tidyverse:

library(tidyverse)

df1 %>%
  group_by(Person) %>%
  mutate(Abs = map_dbl(DAYS, ~ {
    if (!is.na(.x)) {
      d <<- .x
      +(d > 0)
    } else {
      d <<- d - 1
      +(d > 0)
    }
  }))

Во-первых, ваш оригинальный подход был не так уж и плох. Некоторые незначительные улучшения могут сделать его быстрее, чем gfgm (на момент моего тестирования я не знаю вашей точной структуры данных):

improvedOP <- function(d) {
  days <- d$DAYS # so we do not repeatedly change data.frames column
  ii <- !is.na(days) # this can be calculated outside the loop
  for (i in 1:nrow(d)) {
    if (ii[i]) var <- days[i]
    if (var > 0) {
      var <- var - 1
      days[i] <- 1
    }
  }
  return(days)
}

Я придумал такой подход:

minem <- function(d) {
  require(zoo)
  rn <- 1:nrow(d) # row numbers
  ii <- rn + d$DAYS - 1L # get row numbers which set to 1
  ii <- na.locf(ii, na.rm = F) # fill NA forward
  ii <- rn <= ii # if row number less or equal than interested row is 1
  ii[ii == 0] <- NA # set 0 to NA to match original results
  as.integer(ii)
}

all.equal(minem(d), improvedOP(d))
# TRUE

Идея состоит в том, что мы вычисляем номера строк, которые должны быть равны 1 (текущая строка + ДНИ - 1). Затем заполните NA этим значением, и если строка соответствует нашему условию, установите значение 1. Это должно быть быстрее, чем любой другой подход, который включает создание последовательностей.

Сравните с более крупными (7,3 млн строк) смоделированными данными:

gfgm <- function(d) {
  days <- rep(0, nrow(d))
  inds <- which(!is.na(d$DAYS))
  inds_to_change <- mapply(function(i, d) {i:(i + d - 1)}, inds, na.omit(d$DAYS))
  days[unlist(inds_to_change)] <- 1
  days
}
nrow(d)/1e6 # 7.3 mil
require(bench)
require(data.table)
bm <- bench::mark(minem(d), improvedOP(d), gfgm(d), iterations = 2, check = F)
as.data.table(bm[, 1:7])
#       expression      min     mean   median      max   itr/sec mem_alloc
# 1:      minem(d) 281.34ms 302.85ms 302.85ms 324.35ms 3.3019990     408MB
# 2: improvedOP(d) 747.45ms 754.55ms 754.55ms 761.65ms 1.3252907     139MB
# 3:       gfgm(d)    3.23s    3.27s    3.27s    3.31s 0.3056558     410MB

P.S. но реальные результаты, вероятно, зависят от распределения значений DAYS.