Как найти первую строку (дату) серии из 5 или более строк (дата) со значением ниже 0 - PullRequest
Новая
       5

Как найти первую строку (дату) серии из 5 или более строк (дата) со значением ниже 0

2 голосов
/ 08 марта 2020

У меня есть данные средней температуры с датой ниже. Я хотел найти дату, которая является последовательной последовательностью ниже или выше 0 по Цельсию в сериях не менее 5 дней. 

  date_short mean.temp
1 2018-05-18  17.54
2 2018-05-19  19.45
3 2018-05-20  22.31
4 2018-05-21  13.26
5 2018-05-22  10.29
6 2018-05-23  15.06

Я использовал следующие сценарии и выяснил, сколько дней меньше 0 и какие строки соответствуют критериям температуры ниже 0. Это показывает, что всего 147 дней с температурой ниже 0 градусов и в какой строке наблюдается температура ниже 0 градусов. Из этого я могу видеть, что 161-я дата - это первый день с температурой ниже 0, но это не то, что я хотел, потому что это не первая дата серии, по крайней мере, 5 дней с 0 или выше 0 градусов. Вместо этого я хочу, чтобы R возвратил 170-й день, так как это начало серии, по крайней мере, 5 дней с 0 или выше 0 градусов. 

length(which(d.mean$mean.temp <= 0))
[1] 147
which(d.mean$mean.temp <= 0)
  [1] 161 162 166 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195
 [30] 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224
 [59] 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253
 [88] 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282
[117] 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 307 308 309 310 313 314 315 316 317
[146] 318 324

Как я могу сделать это в R. Я могу сделать это вручную , но я должен найти такую ​​дату для многих столбцов. В Excel эта функция будет выглядеть примерно так: 

IF(B2<0, IF(B3<0, IF(B4<0, IF(B5<0, IF(B6<0,A2,""),""),""),""),"")

Заранее спасибо

Ответы [ 4 ]

4 голосов
/ 08 марта 2020

Для этого достаточно функции rle (кодирование длины серии) базы R, например, 

# sample data
set.seed(47)
df <- data.frame(
    date = seq(as.Date("1970-01-01"), length = 500, by = "days"),
    temp = rnorm(500)
)

runs <- rle(df$temp < 0)

df[(cumsum(runs$lengths) - runs$lengths + 1)[runs$values & runs$lengths >= 5], ]
#>           date       temp
#> 25  1970-01-25 -0.3264668
#> 270 1970-09-27 -0.5443173
#> 350 1970-12-16 -0.8436569
#> 356 1970-12-22 -1.2768785
#> 370 1971-01-05 -1.4122783
#> 431 1971-03-07 -0.4711361
#> 454 1971-03-30 -0.9901146

Чтобы немного разбить это, посмотрите на составные части: 

runs
#> Run Length Encoding
#>   lengths: int [1:235] 3 1 1 2 1 3 2 1 2 1 ...
#>   values : logi [1:235] FALSE TRUE FALSE TRUE FALSE TRUE ...

# start index of each run
head((cumsum(runs$lengths) - runs$lengths + 1), 20)
#>  [1]  1  4  5  6  8  9 12 14 15 17 18 19 22 23 24 25 30 33 34 37

# runs where temp < 0 and length >= 5
head(runs$values & runs$lengths >= 5, 20)
#>  [1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#> [13] FALSE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE

# together, indices of first rows which satisfy the conditions
(cumsum(runs$lengths) - runs$lengths + 1)[runs$values & runs$lengths >= 5]
#> [1]  25 270 350 356 370 431 454
2 голосов
/ 08 марта 2020

Одно решение с tidyversere и zoo будет следующим. Вы можете использовать rollapply, чтобы найти 5 температур ниже нуля, установив их как TRUE. Как скользящее окно, оно будет отмечать те даты, за которыми следуют четыре дополнительные (последовательные) даты с температурой ниже нуля. Чтобы отфильтровать даты, когда происходят эти серии, посмотрите на переход от FALSE к TRUE.

Редактировать : Если у вас есть несколько столбцов температур, и вы хотите применить этот подход к каждому столбцу температур, вы можете сначала использовать pivot_longer и group_by. Пример теперь включает 3 столбца температур. 

set.seed(126)

library(tidyverse)
library(zoo)

df %>%
  pivot_longer(cols = -date, names_to = "temp", values_to = "value") %>%
  group_by(temp) %>%
  mutate(start = rollapply(value < 0, width = 5, all, align = "left", fill = FALSE)) %>%
  dplyr::filter(start & !lag(start, default = FALSE)) %>%
  dplyr::select(date, temp) %>%
  arrange(temp, date)

Выход 

# A tibble: 7 x 2
# Groups:   temp [3]
  date       temp  
  <date>     <chr> 
1 2020-01-10 temp_A
2 2020-01-16 temp_A
3 2020-01-22 temp_A
4 2020-01-05 temp_B
5 2020-01-22 temp_B
6 2020-01-01 temp_C
7 2020-01-23 temp_C

Данные 

df <- data.frame(
  date = seq(as.Date("2020/01/01"), as.Date("2020/02/01"), "days"),
  temp_A = sample(c(-10:2), 32, replace = TRUE),
  temp_B = sample(c(-10:2), 32, replace = TRUE),
  temp_C = sample(c(-10:2), 32, replace = TRUE)
)

         date temp_A temp_B temp_C
1  2020-01-01     -9     -8     -6
2  2020-01-02     -1      1     -9
3  2020-01-03     -6     -7     -4
4  2020-01-04      0      1     -9
5  2020-01-05      2     -8     -3
6  2020-01-06     -4     -3      0
7  2020-01-07     -1     -3      1
8  2020-01-08      2     -3      0
9  2020-01-09      1     -6      1
10 2020-01-10     -1     -7     -1
11 2020-01-11     -2     -4     -6
12 2020-01-12     -8     -2      1
13 2020-01-13     -7      1     -5
14 2020-01-14     -3     -2     -7
15 2020-01-15      0      0     -8
16 2020-01-16     -1     -4    -10
17 2020-01-17     -4     -1      2
18 2020-01-18     -6      1     -9
19 2020-01-19     -5     -7     -5
20 2020-01-20     -4     -6      0
21 2020-01-21      2      0     -6
22 2020-01-22     -1     -3      0
23 2020-01-23     -4     -7     -3
24 2020-01-24     -2     -7     -5
25 2020-01-25    -10     -1    -10
26 2020-01-26     -5     -6     -6
27 2020-01-27     -3    -10     -1
28 2020-01-28     -8     -5      1
29 2020-01-29      0      1     -2
30 2020-01-30      2     -9     -6
31 2020-01-31    -10     -4     -1
32 2020-02-01      2    -10     -4
1 голос
/ 08 марта 2020

Вы можете использовать rle. 

LEN <- 5
rrl <- rle(+(dat$temp < 0))
(bel.0 <- 
  which(c(NA, diff(rep(suppressWarnings(rrl$lengths*(1:0)), rrl$lengths) >= LEN)) == 1))
# [1]   4  21 306 384 417 427

Мы подавляем предупреждения, вызванные тем, что период 1-0 может быть неполным.

Проверка: 

dat$minus <- 0
dat$minus[bel.0] <- 1

head(dat, 30)
#          date   temp minus
# 1  2017-12-01 -14.03     0
# 2  2017-12-02  17.33     0
# 3  2017-12-03  20.02     0
# 4  2017-12-04 -21.28     1
# 5  2017-12-05 -23.49     0
# 6  2017-12-06 -13.04     0
# 7  2017-12-07 -19.27     0
# 8  2017-12-08 -18.76     0
# 9  2017-12-09  26.44     0
# 10 2017-12-10  10.14     0
# 11 2017-12-11  -6.05     0
# 12 2017-12-12 -19.10     0
# 13 2017-12-13  -4.88     0
# 14 2017-12-14 -19.19     0
# 15 2017-12-15   6.95     0
# 16 2017-12-16 -19.07     0
# 17 2017-12-17  -2.02     0
# 18 2017-12-18   4.96     0
# 19 2017-12-19 -15.18     0
# 20 2017-12-20   5.80     0
# 21 2017-12-21 -24.17     1
# 22 2017-12-22 -23.51     0
# 23 2017-12-23 -10.26     0
# 24 2017-12-24  -7.91     0
# 25 2017-12-25  -7.65     0
# 26 2017-12-26   8.66     0
# 27 2017-12-27  -9.71     0
# 28 2017-12-28 -15.09     0
# 29 2017-12-29 -28.49     0
# 30 2017-12-30 -22.01     0

Данные 

set.seed(666)
temp <- sample(-(3e3):3e3, 5e2, replace=TRUE) / 1e2
dat <- data.frame(date=as.Date(seq(temp) + 1.75e4), temp)
1 голос
/ 08 марта 2020

В качестве альтернативы (возможно, менее элегантного) вы можете использовать функцию rleid из data.table в сочетании с пакетом dplyr.

Вкратце, вы конвертируете свою температуру в 0 и 1 в зависимости от того, ниже или выше 0. Затем rleid вычислит длину каждой последовательной последовательности 1 или 0 и присвоит число каждой последовательности. Вы можете группировать по этому номеру и видеть длину каждой последовательности, находить минимальную дату для каждой последовательности и фильтровать для последовательности, превышающей 4, и вы получаете список температур ниже или выше 0 и когда они начались. 

library(lubridate)
library(data.table)
library(dplyr)
Result_DF <- df %>% 
  mutate(Above0 = ifelse(temp > 0,1,0)) %>% # Compute temperature above 0
  mutate(Seq_ID = rleid(Above0)) %>% 
  group_by(Seq_ID) %>%
  mutate(Length_seq = n()) %>%
  filter(Length_seq > 4) %>%
  mutate(Date_Min = min(date)) %>%
  distinct(Date_Min, Above0, Length_seq, Seq_ID)

# A tibble: 18 x 4
# Groups:   Seq_ID [18]
   Date_Min   Above0 Length_seq Seq_ID
   <date>      <dbl>      <int>  <int>
 1 2018-02-04      1          6     23
 2 2018-02-14      1          6     25
 3 2018-02-28      1          6     31
 4 2018-03-09      1          9     33
 5 2018-04-06      1          5     47
 6 2018-04-30      1          5     59
 7 2018-06-19      1          5     83
 8 2018-06-30      1          6     87
 9 2018-07-14      1          6     93
10 2018-07-25      1          9     97
11 2018-08-21      1          5    107
12 2018-09-08      1          6    117
13 2018-09-25      1         10    125
14 2018-10-15      1          7    131
15 2018-10-23      1          7    133
16 2018-11-23      0          5    148
17 2018-12-05      1          6    155
18 2018-12-24      1          5    163

Вероятно, есть более быстрый и более элегантный способ сделать это (ответ @ Ben довольно прост), но это просто еще один вариант.

РЕДАКТИРОВАТЬ: Улучшено код (спасибо комментарию @ allistaire)

Благодаря комментарию @ allistaire вы можете go намного быстрее, выполнив: 

df %>% 
  group_by(run = data.table::rleid(temp > 0)) %>% 
  filter(n() >= 5) %>% 
  slice(1)

Воспроизводимый пример 

set.seed(123)
df <- data.frame(date = seq(ymd("2018-01-01"), ymd("2018-12-31"), by = "day"),
                 temp = sample(-15:25, 365, replace = TRUE))
...