декодировать все значения в ноль, если последовательность <= 3, сохраняя определенную информацию

Question

Я задавал похожий вопрос раньше, но мне нужно еще кое-что узнать, и я решил опубликовать новый вопрос.

У меня есть объект data.table, подобный этому:

library(data.table)
cells <- c(100, 1,1980,1,0,1,1,0,1,0,
       150, 1,1980,1,1,1,0,0,0,1,
       99 , 1,1980,1,1,1,1,0,0,0,
       899, 1,1980,0,1,0,1,1,1,1,
       789, 1,1982,1,1,1,0,1,1,1 )
colname <- c("number","sex", "birthy", "2004","2005", "2006", "2007", "2008", "2009","2010")
rowname <- c("1","2","3","4","5")
y <- matrix(cells, nrow=5, ncol=10, byrow=TRUE, dimnames =   list(rowname,colname))
y <- data.table(y, keep.rownames = TRUE)

значение 1 в столбце 2004 означает, что это лицо непрерывно застраховано в течение 2004 года. Лицо, застрахованное в течение 3 предыдущих лет, может участвовать в исследовании.Мне нужно подмножество этого data.table, содержащего все наблюдения, где выполняется следующее условие: 2004 + 2005 + 2006 = 3 или 2005 + 2006 + 2007 = или 2006 + 2007 + ...

#using melt and rle function to restrucure the data
tmp <- melt(y, id = "rn", measure.vars = patterns("^20"),
        variable.factor = FALSE, variable.name = "year")[, rle(value), by = rn]

#subset data based on condition, keeping only the first relevant sequence
tmp2 <- tmp[(values == 1 & lengths >= 3), .(rn,lengths)][, .SD[1,], by=rn]
##selecting only rows with value=1 and min 3 in a row
##keeping only the variable rn
tmp3 <- tmp[values == 1, which(max(lengths) >= 3), by = rn]$rn

##using the row-number to select obersvations from data.table
##merging length of sequence
dt <- merge(y[as.integer(tmp3)],tmp2, by="rn")

Есть ли способ превратить все 1 в 0, если они не являются частью последовательности?Например, переменная rn == 4 «2005» должна быть равна нулю.

Мне также нужна новая переменная «begy», содержащая год начала последовательности.Например rn==5 и begy==2004.Любое предложение будет оценено ...

Answer 1

Опция с использованием скользящего окна:

#convert into long format and convert data types
DT <- melt(y, id="rn", measure.vars=patterns("^20"),
    variable.factor=FALSE, variable.name="YEAR", 
    value.factor=FALSE, value.name="VALUE")
cols <- c("YEAR", "VALUE")
DT[, (cols) := lapply(.SD, as.integer), .SDcols=cols]
setorder(DT, rn, YEAR)

#for each row, sum the value that is between current year and 2 years from now
winsize <- 3L
DT[, roll3y := vapply(YEAR,
        function(k) sum(VALUE[between(YEAR, k, k + winsize - 1L)]),
        integer(1L)), 
    by=.(rn)]

#> Is there a way to turn all 1 to 0 if they are not part of a sequence?
#reset all values to 0 and set only those in sequence to 1
DT[, VALUE := 0L][
    c(outer(DT[roll3y==winsize, which=TRUE], 0L:2L, `+`)), VALUE := 1L]

#> I also need a new variable "begy" containing the year of the beginning of the sequence.
#identify the year that a sequence of 3 ones appears
longDT <- rbindlist(list(DT,
        DT[roll3y==winsize, .(YEAR="begy", VALUE=min(YEAR)), by=.(rn,number,sex,birthy)]),
    use.names=TRUE, fill=TRUE)

#get desired output
dcast(longDT, rn + number + sex + birthy ~ YEAR, value.var="VALUE")

Вывод:

   rn number sex birthy 2004 2005 2006 2007 2008 2009 2010 begy
1:  1    100   1   1980    0    0    0    0    0    0    0   NA
2:  2    150   1   1980    1    1    1    0    0    0    0 2004
3:  3     99   1   1980    1    1    1    1    0    0    0 2004
4:  4    899   1   1980    0    0    0    1    1    1    1 2007
5:  5    789   1   1982    1    1    1    0    1    1    1 2004

Answer 2

ОП запросил

1. , чтобы превратить все 1 с в 0 с, если они не являются частью последовательности из 3 или более последовательных лет,
2. вдобавьте новый столбец, который содержит год, в котором начинается последовательность «.».

Обратите внимание, что 2-е требование неоднозначно, поскольку может быть более одной последовательности из 3 или более последовательных лет, например, встрока 5. Здесь мы берем год начала первой (самой старой) последовательности.

Решение ниже

• преобразуется из широкого в длинный формат,
• вычисляетдлины полос последовательных лет
• превращают 1 с в 0 с, если они не являются частью последовательности из 3 или более последовательных лет,
• получает начальный годпервая последовательность,
• удаляет строки без последовательной последовательности (не найдено begy), а
• преобразуется обратно в широкоформатный формат, наконец.

Нет прокручиваемого окнаили требуется пользовательская функция.

library(data.table)
melt(y, , patterns("^\\d"))[
  order(rn), N := .N, by = .(rleid(value), rn)][
    value == 1 & N < 3, value := 0][
      , begy := first(variable[value == 1]), by = rn][
        , dcast(.SD[!is.na(begy), -"N"], ... ~ variable)]

   rn number sex birthy begy 2004 2005 2006 2007 2008 2009 2010
1:  2    150   1   1980 2004    1    1    1    0    0    0    0
2:  3     99   1   1980 2004    1    1    1    1    0    0    0
3:  4    899   1   1980 2007    0    0    0    1    1    1    1
4:  5    789   1   1982 2004    1    1    1    0    1    1    1

Answer 3

Новое решение:

# define a custom function in order to only keep the sequences
# with 3 (or more) consecutive years
rle3 <- function(x) {
  r <- rle(x)
  r$values[r$lengths < 3 & r$values == 1] <- 0
  inverse.rle(r)
}

# replace all '1'-s that do not belong to a sequence of at least 3 to '0'
# create 'begy'-variable
melt(y, id = 1:4, measure.vars = patterns("^20"),
     variable.factor = FALSE, variable.name = "year"
     )[, value := rle3(value), by = rn
       ][, begy := year[value == 1][1], rn
         ][, dcast(.SD[!is.na(begy)], ... ~ year, value.var = "value")]

, что дает:

   rn number sex birthy begy 2004 2005 2006 2007 2008 2009 2010
1:  2    150   1   1980 2004    1    1    1    0    0    0    0
2:  3     99   1   1980 2004    1    1    1    1    0    0    0
3:  4    899   1   1980 2007    0    0    0    1    1    1    1
4:  5    789   1   1982 2004    1    1    1    0    1    1    1

---

Старое решение:

# define a custom function in order to only keep the sequences
# with 3 (or more) consecutive years
rle3 <- function(x) {
  r <- rle(x)
  r$values[r$lengths < 3 & r$values == 1] <- 0
  inverse.rle(r)
}

# create a reference 'data.table' with only the row to keep
# and the start year of the (first) sequence (row 5 has 2 sequences of 3)
x <- melt(y, id = "rn", measure.vars = patterns("^20"),
          variable.factor = FALSE, variable.name = "year"
          )[, value := rle3(value), by = rn
            ][value == 1, .SD[1], rn]

# join 'x' with 'y' to add 'begy' and filter out the row with no sequences of 3
y[x, on = "rn", begy := year][!is.na(begy)]

, что дает:

   rn number sex birthy 2004 2005 2006 2007 2008 2009 2010 begy
1:  2    150   1   1980    1    1    1    0    0    0    1 2004
2:  3     99   1   1980    1    1    1    1    0    0    0 2004
3:  4    899   1   1980    0    1    0    1    1    1    1 2007
4:  5    789   1   1982    1    1    1    0    1    1    1 2004