Преобразование суточной метеорологической недели в стандартную в R - PullRequest
Новая
       133

Преобразование суточной метеорологической недели в стандартную в R

1 голос
/ 04 мая 2020

Я видел много вопросов в SO о преобразовании ежедневных данных в еженедельные с использованием пакетов xts, zoo или lubridate. Ни один из ответов не был найден подходящим для моей проблемы. Я попробовал следующий код 

library(zoo)
library(lubridate)
library(xts)
library(tidyverse)

#Calculation for multistation
set.seed(123)
df <- data.frame("date"= seq(from = as.Date("1970-1-1"), to = as.Date("2000-12-31"), by = "day"),
                 "Station1" = runif(length(seq.Date(as.Date("1970-1-1"), as.Date("2000-12-31"), "days")), 10, 30),
                 "Station2" = runif(length(seq.Date(as.Date("1970-1-1"), as.Date("2000-12-31"), "days")), 11, 29),
                 "Station3" = runif(length(seq.Date(as.Date("1970-1-1"), as.Date("2000-12-31"), "days")), 9, 28))

head(df)

# Aggregate over week
df %>% 
  mutate(Week = week(ymd(date)),
         Year = year(ymd(date))) %>% 
  pivot_longer(-c(Week, date, Year), values_to = "value", names_to = "Station") %>% 
  group_by(Year, Week, Station) %>% 
  summarise(Weekly = mean(value)) %>% 
  arrange(Station) %>% 
  print(n = 55)

Из результатов вы можете видеть, что 1970 охватывает 53 недели, которые я не хочу. Я хочу начать неделю с первого числа каждого года, и 52-я неделя должна иметь 8 дней в не високосном году, а в случае високосных годов 9-я и 52-я недели должны иметь 8 дней, чтобы каждый год содержал только 52 недели. Как это сделать в R?

Ответы [ 2 ]

2 голосов
/ 04 мая 2020

Почему бы просто не написать функцию, которая дает метеорологическую неделю из определения, которое вы дали? Пакет lubridate даст вам день года с yday, который может выступать в качестве индекса для вектора правильных меток недели. Их легко построить с помощью простой модульной математики и конкатенации.

Вам нужно только выяснить, находитесь ли вы в високосном году, что снова возможно при использовании lubridate::leap_year. Объедините их в ifelse, и вы получите простую в использовании функцию: 

met_week <- function(dates)
{
  normal_year <- c((0:363 %/% 7 + 1), 52)
  leap_year   <- c(normal_year[1:59], 9, normal_year[60:365])
  year_day    <- lubridate::yday(dates)

  return(ifelse(lubridate::leap_year(dates), leap_year[year_day], normal_year[year_day]))
}

, и вы можете сделать 

df %>% mutate(week = met_week(date))
2 голосов
/ 04 мая 2020

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

df %>% 
  mutate(Week = pmin(52, ceiling(yday(date) / 7)),
         Year = year(ymd(date)))
...