Не могу найти способ перенести последнее хорошее значение - PullRequest
2 голосов
/ 25 июня 2019

Это немного сложно описать, но я попробую. Предположим, у меня есть следующий объект зоопарка:

a <- read.zoo(data.frame(date=as.Date('2011-1-1') + 0:59, closest.idx=c(rep(1,20), rep(2, 20), rep(3, 20)), is.good=c(rep(1,20), rep(1,20), rep(0, 20)), val=c(rep(.2, 6), rep(.3, 14), rep(.4, 6), rep(.5, 14), rep(.6, 6), rep(.7, 14))), FUN = as.Date)
           closest.idx is.good val
2011-01-01          1       1 0.2
2011-01-02          1       1 0.2
2011-01-03          1       1 0.2
2011-01-04          1       1 0.2
2011-01-05          1       1 0.2
2011-01-06          1       1 0.2
2011-01-07          1       1 0.3
2011-01-08          1       1 0.3
2011-01-09          1       1 0.3
2011-01-10          1       1 0.3
...

Я бы хотел унести последний добрый "вал". Вот правила:

  1. Первые 6 строк каждой группы не должны быть изменены, независимо от значения. Хорошее имеет
  2. Следующие строки изменяются, если is.good = 0. Если is.good = 0, значение val меняется на last.good.val)
  3. Последний хороший вал - это тот, где is.good = 1, который появляется в 7-м ряду или выше этой группы

ПРИМЕЧАНИЕ # 1: Не думайте, что в группе будет всего 20 строк - это может быть любое число

ПРИМЕЧАНИЕ # 2: Вы можете предположить, что первые 6 строк каждой группы не должны быть затронуты

Так что в этом примере,

2011-01-01 - 2011-01-06 will have a val of 0.2 (is.good = 1, < 6 rows into group so not last.good.val)
2011-01-07 - 2011-01-20 will have a val of 0.3 (is.good = 1, last.good.val = 0.3)
2011-01-21 - 2011-01-26 will have a val of 0.4 (is.good = 1, last.good.val = 0.3, < 6 rows into group so not last.good.val)
2011-01-27 - 2011-02-09 will have a val of 0.5 (is.good = 1, last.good.val = 0.5)
2011-02-10 - 2011-02-15 will have a val of 0.6 (b/c they are < 6 rows into the group so aren't affected)
2011-02-16 - 2011-03-01 will have a val of 0.5 (b/c 0.5 was the last good value and is.good = 0 in this group)

Так что я ожидаю, что мой вывод будет выглядеть так:

           closestIdx is.good val
2011-01-01          1       1 0.2
2011-01-02          1       1 0.2
2011-01-03          1       1 0.2
2011-01-04          1       1 0.2
2011-01-05          1       1 0.2
2011-01-06          1       1 0.2
2011-01-07          1       1 0.3
2011-01-08          1       1 0.3
2011-01-09          1       1 0.3
...
2011-01-21          2       1 0.4
2011-01-22          2       1 0.4
2011-01-23          2       1 0.4
2011-01-24          2       1 0.4
2011-01-25          2       1 0.4
2011-01-26          2       1 0.4
2011-01-27          2       1 0.5
2011-01-28          2       1 0.5
2011-01-29          2       1 0.5
2011-01-30          2       1 0.5
2011-01-31          2       1 0.5
...
2011-02-10          3       0 0.6
2011-02-11          3       0 0.6
2011-02-12          3       0 0.6
2011-02-13          3       0 0.6
2011-02-14          3       0 0.6
2011-02-15          3       0 0.6
2011-02-16          3       0 0.5    <- notice these changed to last good value
2011-02-17          3       0 0.5
2011-02-18          3       0 0.5
...

ПРИМЕЧАНИЕ. Я бы предпочел решение base-R, но другие пакеты интересно посмотреть

1 Ответ

1 голос
/ 26 июня 2019

Вот несколько подходов, каждый из которых, по сути, делает то же самое:

  • Добавить столбец val_tofill, заменив все негодные значения на NA s
  • Используйте один измного доступных методов для перенаправления заполнения val_tofill, см., например, Замена NA на последнее не-значение NA
  • Перезаписать столбец val на val_tofill всякий раз, когда номер строки не является одним изпервые шесть группы (сгруппированные по closest.idx)

Исходные данные

a <- data.frame(
    date=as.Date('2011-1-1') + 0:59, 
    closest.idx=c(rep(1,20), rep(2, 20), rep(3, 20)), 
    is.good=c(rep(1,20), rep(1,20), rep(0, 20)), 
    val=c(rep(.2, 6), rep(.3, 14), rep(.4, 6), rep(.5, 14), rep(.6, 6), rep(.7, 14))
)

base + zoo :: na.locf

a$val_tofill <- zoo::na.locf(ifelse(a$is.good > 0, a$val, NA))
a$val <- unlist(
    by(a, INDICES = a$closest.idx,
        FUN = function(x) ifelse(seq_len(nrow(x)) < 7, x$val, x$val_tofill)
    )
)
a$val_tofill <- NULL

dplyr + tidyr :: fill

library(tidyverse)

mutate(a, val_tofill = ifelse(is.good > 0, val, NA)) %>%
    fill(val_tofill, .direction = "down") %>%
    group_by(closest.idx) %>%
    mutate(val = ifelse(row_number() < 7, val, val_tofill)) %>%
    ungroup() %>%
    select(-val_tofill)

data.table + zoo :: na.locf

library(data.table)

a <- setDT(a)
a[, val_tofill := zoo::na.locf(ifelse(is.good > 0, val, NA))][,
    val := ifelse(seq_len(.N) < 7, val, val_tofill),
    by = closest.idx
]
a$val_tofill <- NULL
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...