I have 3 days long time series (data) sampled every minute (60*24*3 values):
require(zoo)
t<-seq(as.POSIXlt("2015/02/02 00:01:00"),as.POSIXlt("2015/02/04 24:00:00"), length.out=60*24*3)
d<-seq(1,2, length.out=60*24*3)
data<-zoo(d,t)
I would like to calculate:
Mean values (over three days span) for every minute of the hour assuming that all hours are equal. In this case I should have 60 values in the output with time stamps:
01:00, 02:00, ..., 60:00. Each mean must be calculated over 24x3=72 values, since we have 72 hours in three days long time series.
Same as above but additionally tracking hours:
00:01:00, 00:02:00, ..., 23:60:00. Each mean will be calculated over three values, since we have three days long time series.
These two both create zoo series use aggregate.zoo. The index of the resulting zoo series will be of chron "times" class.
library(chron) # "times" class
aggregate(data, times(format(time(data), "00:%M:00")), mean)
aggregate(data, times(format(time(data), "%H:%M:00")), mean)
If its OK that the index is of class "character" then times can be omitted in which case chron is not needed.
You can do this using data.table and lubridate:
library(data.table)
library(lubridate)
##
Dt <- data.table(
Data=as.numeric(data),
Index=index(data))
##
min_dt <- Dt[
,list(Mean=mean(Data)),
by=list(Minute=minute(Index))]
##
hmin_dt <- Dt[
,list(Mean=mean(Data)),
by=list(Hour=hour(Index),
Minute=minute(Index))]
##
R> head(min_dt)
Minute Mean
1: 1 1.493170
2: 2 1.493401
3: 3 1.493633
4: 4 1.493864
5: 5 1.494096
6: 6 1.494327
##
R> head(hmin_dt)
Hour Minute Mean
1: 0 1 1.333411
2: 0 2 1.333642
3: 0 3 1.333874
4: 0 4 1.334105
5: 0 5 1.334337
6: 0 6 1.334568
Data:
library(zoo)
t <- seq(
as.POSIXlt("2015/02/02 00:01:00"),
as.POSIXlt("2015/02/04 24:00:00"),
length.out=60*24*3)
d <- seq(1,2,length.out=60*24*3)
data <- zoo(d,t)
Related
I have the below dataset which is a dataframe. But I would like to convert it into time series so that I can do ARIMA forecasting.
Have searched various topics in SO but could not find anything similar which is at YEARMONTH grain. Everyone talked about date field. But here I don't have date.
I am using the below code but this gives error
dataset <- data.frame(year =c(2017), YearMonth = c(201701,201702,201703,201704), sales = c(100,200,300,400))
library(zoo)
newdataset <- as.ts(read.zoo(dataset, FUN = as.yearmon))
# Error:
#
# In zoo(coredata(x), tt) :
# some methods for “zoo” objects do not work if the index entries in ‘order.by’ are not unique
I know it gives error because I have year column as 1st column which does not have unique values but not really sure how to fix it.
Any help would be really appreciated.
Regards,
Akash
One option is to convert YearMonth to 1st date of a month and generate ts.
library(zoo)
dataset$YearMonth = as.Date(as.yearmon(as.character(dataset$YearMonth),"%Y%m"), frac = 0)
dataset
# year YearMonth sales
# 1 2017 2017-01-01 100
# 2 2017 2017-02-01 200
# 3 2017 2017-03-01 300
# 4 2017 2017-04-01 400
Just for ts another option is as:
dataset$YearMonth = as.yearmon(as.character(dataset$YearMonth),"%Y%m")
as.ts(dataset[-1])
# Time Series:
# Start = 1
# End = 4
# Frequency = 1
# YearMonth sales
# 1 2017.000 100
# 2 2017.083 200
# 3 2017.167 300
# 4 2017.250 400
I am working on a data frame that contains 2 columns as follows:
time frequency
2014-01-06 13
2014-01-07 30
2014-01-09 56
My issue is that I am interested in counting the days of which frequency is 0. The data is pulled using RPostgreSQL/RSQLite so there is no datetime given unless there is a value (i.e. unless frequency is at least 1). If I was interested in counting these dates that don't actually exist in the data frame, is there an easy way to go about doing it? I.E. If we consider the date range 2014-01-01 to 20-14-01-10, I would want it to count 7
My only thought was to brute force create a separate dataframe with every date (note that this is 4+ years of dates which would be an immense undertaking) and then merging the two dataframes and counting the number of NA values. I'm sure there is a more elegant solution than what I've thought of.
Thanks!
Sort by date and then look for gaps.
start <- as.Date("2014-01-01")
time <- as.Date(c("2014-01-06", "2014-01-07","2014-01-09"))
end <- as.Date("2014-01-10")
time <- sort(unique(time))
# Include start and end dates, so the missing dates are 1/1-1/5, 1/8, 1/10
d <- c(time[1]- start,
diff(time) - 1,
end - time[length(time)] )
d # [1] 5 0 1 1
sum(d) # 7 missing days
And now for which days are missing...
(gaps <- data.frame(gap_starts = c(start,time+1)[d>0],
gap_length = d[d>0]))
# gap_starts gap_length
# 1 2014-01-01 5
# 2 2014-01-08 1
# 3 2014-01-10 1
for (g in 1:nrow(gaps)){
start=gaps$gap_starts[g]
length=gaps$gap_length[g]
for(i in start:(start+length-1)){
print(as.Date(i, origin="1970-01-01"))
}
}
# [1] "2014-01-01"
# [1] "2014-01-02"
# [1] "2014-01-03"
# [1] "2014-01-04"
# [1] "2014-01-05"
# [1] "2014-01-08"
# [1] "2014-01-10"
I am new in R.
I want the week number of the month, which the date belongs to.
By using the following code:
>CurrentDate<-Sys.Date()
>Week Number <- format(CurrentDate, format="%U")
>Week Number
"31"
%U will return the Week number of the year .
But i want the week number of the month.
If the date is 2014-08-01 then i want to get 1.( The Date belongs to the 1st week of the month).
Eg:
2014-09-04 -> 1 (The Date belongs to the 1st week of the month).
2014-09-10 -> 2 (The Date belongs to the 2nd week of the month).
and so on...
How can i get this?
Reference:
http://astrostatistics.psu.edu/su07/R/html/base/html/strptime.html
By analogy of the weekdays function:
monthweeks <- function(x) {
UseMethod("monthweeks")
}
monthweeks.Date <- function(x) {
ceiling(as.numeric(format(x, "%d")) / 7)
}
monthweeks.POSIXlt <- function(x) {
ceiling(as.numeric(format(x, "%d")) / 7)
}
monthweeks.character <- function(x) {
ceiling(as.numeric(format(as.Date(x), "%d")) / 7)
}
dates <- sample(seq(as.Date("2000-01-01"), as.Date("2015-01-01"), "days"), 7)
dates
#> [1] "2004-09-24" "2002-11-21" "2011-08-13" "2008-09-23" "2000-08-10" "2007-09-10" "2013-04-16"
monthweeks(dates)
#> [1] 4 3 2 4 2 2 3
Another solution to use stri_datetime_fields() from the stringi package:
stringi::stri_datetime_fields(dates)$WeekOfMonth
#> [1] 4 4 2 4 2 3 3
You can use day from the lubridate package. I'm not sure if there's a week-of-month type function in the package, but we can do the math.
library(lubridate)
curr <- Sys.Date()
# [1] "2014-08-08"
day(curr) ## 8th day of the current month
# [1] 8
day(curr) / 7 ## Technically, it's the 1.14th week
# [1] 1.142857
ceiling(day(curr) / 7) ## but ceiling() will take it up to the 2nd week.
# [1] 2
Issue Overview
It was difficult to tell which answers worked, so I built my own function nth_week and tested it against the others.
The issue that's leading to most of the answers being incorrect is this:
The first week of a month is often a short-week
Same with the last week of the month
For example, October 1st 2019 is a Tuesday, so 6 days into October (which is a Sunday) is already the second week. Also, contiguous months often share the same week in their respective counts, meaning that the last week of the prior month is commonly also the first week of the current month. So, we should expect a week count higher than 52 per year and some months that contain a span of 6 weeks.
Results Comparison
Here's a table showing examples where some of the above suggested algorithms go awry:
DATE Tori user206 Scri Klev Stringi Grot Frei Vale epi iso coni
Fri-2016-01-01 1 1 1 1 5 1 1 1 1 1 1
Sat-2016-01-02 1 1 1 1 1 1 1 1 1 1 1
Sun-2016-01-03 2 1 1 1 1 2 2 1 -50 1 2
Mon-2016-01-04 2 1 1 1 2 2 2 1 -50 -51 2
----
Sat-2018-12-29 5 5 5 5 5 5 5 4 5 5 5
Sun-2018-12-30 6 5 5 5 5 6 6 4 -46 5 6
Mon-2018-12-31 6 5 5 5 6 6 6 4 -46 -46 6
Tue-2019-01-01 1 1 1 1 6 1 1 1 1 1 1
You can see that only Grothendieck, conighion, Freitas, and Tori are correct due to their treatment of partial week periods. I compared all days from year 100 to year 3000; there are no differences among those 4. (Stringi is probably correct for noting weekends as separate, incremented periods, but I didn't check to be sure; epiweek() and isoweek(), because of their intended uses, show some odd behavior near year-ends when using them for week incrementation.)
Speed Comparison
Below are the tests for efficiency between the implementations of: Tori, Grothendieck, Conighion, and Freitas
# prep
library(lubridate)
library(tictoc)
kepler<- ymd(15711227) # Kepler's birthday since it's a nice day and gives a long vector of dates
some_dates<- seq(kepler, today(), by='day')
# test speed of Tori algorithm
tic(msg = 'Tori')
Tori<- (5 + day(some_dates) + wday(floor_date(some_dates, 'month'))) %/% 7
toc()
Tori: 0.19 sec elapsed
# test speed of Grothendieck algorithm
wk <- function(x) as.numeric(format(x, "%U"))
tic(msg = 'Grothendieck')
Grothendieck<- (wk(some_dates) - wk(as.Date(cut(some_dates, "month"))) + 1)
toc()
Grothendieck: 1.99 sec elapsed
# test speed of conighion algorithm
tic(msg = 'conighion')
weeknum <- as.integer( format(some_dates, format="%U") )
mindatemonth <- as.Date( paste0(format(some_dates, "%Y-%m"), "-01") )
weeknummin <- as.integer( format(mindatemonth, format="%U") ) # the number of the week of the first week within the month
conighion <- weeknum - (weeknummin - 1) # this is as an integer
toc()
conighion: 2.42 sec elapsed
# test speed of Freitas algorithm
first_day_of_month_wday <- function(dx) {
day(dx) <- 1
wday(dx)
}
tic(msg = 'Freitas')
Freitas<- ceiling((day(some_dates) + first_day_of_month_wday(some_dates) - 1) / 7)
toc()
Freitas: 0.97 sec elapsed
Fastest correct algorithm by about at least 5X
require(lubridate)
(5 + day(some_dates) + wday(floor_date(some_dates, 'month'))) %/% 7
# some_dates above is any vector of dates, like:
some_dates<- seq(ymd(20190101), today(), 'day')
Function Implementation
I also wrote a generalized function for it that performs either month or year week counts, begins on a day you choose (i.e. say you want to start your week on Monday), labels output for easy checking, and is still extremely fast thanks to lubridate.
nth_week<- function(dates = NULL,
count_weeks_in = c("month","year"),
begin_week_on = "Sunday"){
require(lubridate)
count_weeks_in<- tolower(count_weeks_in[1])
# day_names and day_index are for beginning the week on a day other than Sunday
# (this vector ordering matters, so careful about changing it)
day_names<- c("Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday")
# index integer of first match
day_index<- pmatch(tolower(begin_week_on),
tolower(day_names))[1]
### Calculate week index of each day
if (!is.na(pmatch(count_weeks_in, "year"))) {
# For year:
# sum the day of year, index for day of week at start of year, and constant 5
# then integer divide quantity by 7
# (explicit on package so lubridate and data.table don't fight)
n_week<- (5 +
lubridate::yday(dates) +
lubridate::wday(floor_date(dates, 'year'),
week_start = day_index)
) %/% 7
} else {
# For month:
# same algorithm as above, but for month rather than year
n_week<- (5 +
lubridate::day(dates) +
lubridate::wday(floor_date(dates, 'month'),
week_start = day_index)
) %/% 7
}
# naming very helpful for review
names(n_week)<- paste0(lubridate::wday(dates,T), '-', dates)
n_week
}
Function Output
# Example raw vector output:
some_dates<- seq(ymd(20190930), today(), by='day')
nth_week(some_dates)
Mon-2019-09-30 Tue-2019-10-01 Wed-2019-10-02
5 1 1
Thu-2019-10-03 Fri-2019-10-04 Sat-2019-10-05
1 1 1
Sun-2019-10-06 Mon-2019-10-07 Tue-2019-10-08
2 2 2
Wed-2019-10-09 Thu-2019-10-10 Fri-2019-10-11
2 2 2
Sat-2019-10-12 Sun-2019-10-13
2 3
# Example tabled output:
library(tidyverse)
nth_week(some_dates) %>%
enframe('DATE','nth_week_default') %>%
cbind(some_year_day_options = as.vector(nth_week(some_dates, count_weeks_in = 'year', begin_week_on = 'Mon')))
DATE nth_week_default some_year_day_options
1 Mon-2019-09-30 5 40
2 Tue-2019-10-01 1 40
3 Wed-2019-10-02 1 40
4 Thu-2019-10-03 1 40
5 Fri-2019-10-04 1 40
6 Sat-2019-10-05 1 40
7 Sun-2019-10-06 2 40
8 Mon-2019-10-07 2 41
9 Tue-2019-10-08 2 41
10 Wed-2019-10-09 2 41
11 Thu-2019-10-10 2 41
12 Fri-2019-10-11 2 41
13 Sat-2019-10-12 2 41
14 Sun-2019-10-13 3 41
Hope this work saves people the time of having to weed through all the responses to figure out which are correct.
I don't know R but if you take the week of the first day in the month you could use it to get the week in the month
2014-09-18
First day of month = 2014-09-01
Week of first day on month = 36
Week of 2014-09-18 = 38
Week in the month = 1 + (38 - 36) = 3
Using lubridate you can do
ceiling((day(date) + first_day_of_month_wday(date) - 1) / 7)
Where the function first_day_of_month_wday returns the weekday of the first day of month.
first_day_of_month_wday <- function(dx) {
day(dx) <- 1
wday(dx)
}
This adjustment must be done in order to get the correct week number otherwise if you have the 7th day of month on a Monday you will get 1 instead of 2, for example.
This is only a shift in the day of month.
The minus 1 is necessary because when the first day of month is sunday the adjustment is not needed, and the others weekdays follow this rule.
I came across the same issue and I solved it with mday from data.table package. Also, I realized that when using the ceiling() function, one also needs to account for the '5th week' situation. For example ceiling of the 30th day of a month ceiling(30/7) will give 5 ! Therefore, the ifelse statement below.
# Create a sample data table with days from year 0 until present
DT <- data.table(days = seq(as.Date("0-01-01"), Sys.Date(), "days"))
# compute the week of the month and account for the '5th week' case
DT[, week := ifelse( ceiling(mday(days)/7)==5, 4, ceiling(mday(days)/7) )]
> DT
days week
1: 0000-01-01 1
2: 0000-01-02 1
3: 0000-01-03 1
4: 0000-01-04 1
5: 0000-01-05 1
---
736617: 2016-10-14 2
736618: 2016-10-15 3
736619: 2016-10-16 3
736620: 2016-10-17 3
736621: 2016-10-18 3
To have an idea about the speed, then run:
system.time( DT[, week := ifelse( ceiling(mday(days)/7)==5, 4, ceiling(mday(days)/7) )] )
# user system elapsed
# 3.23 0.05 3.27
It took approx. 3 seconds to compute the weeks for more than 700 000 days.
However, the ceiling way above will always create the last week longer than all the other weeks (the four weeks have 7,7,7, and 9 or 10 days). Another way would be to use something like
ceiling(1:31/31*4)
[1] 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 4 4 4 4 4 4 4 4
where you get 7, 8 , 8 and 8 days per respective week in a 31 days month.
DT[, week2 := ceiling(mday(days)/31*4)]
There is a simple way to do it with lubridate package:
isoweek() returns the week as it would appear in the ISO 8601 system, which uses a reoccurring leap week.
epiweek() is the US CDC version of epidemiological week. It follows same rules as
isoweek() but starts on Sunday. In other parts of the world the convention is to start epidemiological weeks on Monday, which is the same as isoweek().
Reference here
I am late to the party and maybe noone is gonna read this answer...
Anyway, why not stay simple and do it like this:
library(lubridate)
x <- ymd(20200311, 20200308)
week(x) - week(floor_date(x, unit = "months")) + 1
[1] 3 2
I don't know any build in functions but a work around would be
CurrentDate <- Sys.Date()
# The number of the week relative to the year
weeknum <- as.integer( format(CurrentDate, format="%U") )
# Find the minimum week of the month relative to the year
mindatemonth <- as.Date( paste0(format(CurrentDate, "%Y-%m"), "-01") )
weeknummin <- as.integer( format(mindatemonth, format="%U") ) # the number of the week of the first week within the month
# Calculate the number of the week relative to the month
weeknum <- weeknum - (weeknummin - 1) # this is as an integer
# With the following you can convert the integer to the same format of
# format(CurrentDate, format="%U")
formatC(weeknum, width = 2, flag = "0")
Simply do this:
library(lubridate)
ds1$Week <- week(ds1$Sale_Date)
This is high performance! It instantly works on my 12 milion rows dataset.
On example above, ds1 is the dataset, Sale_Date is a date column (like "2015-11-23")
The other approach, using "as.integer( format..." might work on small datasets, but on 12 million rows it would keep running forever...
I have following data set:
>d
x date
1 1 1-3-2013
2 2 2-4-2010
3 3 2-5-2011
4 4 1-6-2012
I want:
> d
x date
1 1 31-12-2013
2 2 31-12-2010
3 3 31-12-2011
4 4 31-12-2012
i.e. Last day, last month and the year of the date object.
Please Help!
You can also just use the ceiling_date function in LUBRIDATE package.
You can do something like -
library(lubridate)
last_date <- ceiling_date(date,"year") - days(1)
ceiling_date(date,"year") gives you the first date of the next year and to get the last date of the current year, you subtract this by 1 or days(1).
Hope this helps.
Another option using lubridate package:
## using d from Roland answer
transform(d,last =dmy(paste0('3112',year(dmy(date)))))
x date last
1 1 1-3-2013 2013-12-31
2 2 2-4-2010 2010-12-31
3 3 2-5-2011 2011-12-31
4 4 1-6-2012 2012-12-31
d <- read.table(text="x date
1 1 1-3-2013
2 2 2-4-2010
3 3 2-5-2011
4 4 1-6-2012", header=TRUE)
d$date <- as.Date(d$date, "%d-%m-%Y")
d$date <- as.POSIXlt(d$date)
d$date$mon <- 11
d$date$mday <- 31
d$date <- as.Date(d$date)
# x date
#1 1 2013-12-31
#2 2 2010-12-31
#3 3 2011-12-31
#4 4 2012-12-31
1) cut.Date Define cut_year to give the first day of the year. Adding 366 gets us to the next year and then applying cut_year again gets us to the first day of the next year. Finally subtract 1 to get the last day of the year. The code uses base functionality only.
cut_year <- function(x) as.Date(cut(as.Date(x), "year"))
transform(d, date = cut_year(cut_year(date) + 366) - 1)
2) format
transform(d, date = as.Date(format(as.Date(date), "%Y-12-31")))
3) zoo A "yearmon" class variable stores the date as a year plus 0 for Jan, 1/12 for Feb, ..., 11/12 for Dec. Thus taking its floor and adding 11/12 gets one to Dec and as.Date.yearmon(..., frac = 1) uses the last of the month instead of the first.
library(zoo)
transform(d, date = as.Date(floor(as.yearmon(as.Date(date))) + 11 / 12, frac = 1))
Note: The inner as.Date in cut_year and in the other two solutions can be omitted if it is known that date is already of "Date" class.
ADDED additional solutions.
I have a dataframe called daily which looks like this:
daily[1:10,]
Climate_Division Date Precipitation
1 1 1948-07-01 0.2100000
2 1 1948-07-02 0.7000000
3 1 1948-07-03 0.1900000
4 1 1948-07-04 0.1033333
5 1 1948-07-05 0.1982895
6 1 1948-07-06 0.1433333
7 1 1948-07-07 NA
8 1 1948-07-08 NA
9 1 1948-07-09 NA
10 1 1948-07-10 NA
The objective that I would like to accomplish is average all the day values throughout the years (1948-1995) to replace the NA value that occurs on that particular day. For example, since row 7 has an NA for July 7, 1948, I would average all the July 7 from 1948-1995 and replace that particular day with the average.
What I have tried so far is this:
index <- which(is.na(daily$Precipitation)) # find where the NA's occur
daily_avg <- daily # copy dataframe
daily_avg$Date <- strftime(daily_avg$Date, format="2000-%m-%d") # Change the Date format to represent only the day and month and disregard year
daily_avg <- aggregate(Precipitation~Date, FUN = mean, data = daily_avg, na.rm = TRUE) # find the mean precip per day
daily[index,3] <- daily_avg[daily_avg$Date %in% strftime(daily[index,2], format="2000-%m-%d"), 2]
The last line in the code is not working properly, I'm not sure why yet. That is how my thought process of this problem is going. However, I was wondering if there is a better way of doing it using a built in function that I am not aware of. Any help is greatly appreciated. Thank you
I think the data in your example, don't explain the problem. You should give data for a certain day over many years with some NA values. For example, here I change the problem for 2 days over 3 years.
Climate_Division Date Precipitation
1 1 1948-07-01 0.2100000
2 1 1948-07-02 NA
3 1 1949-07-01 0.1900000
4 1 1949-07-02 0.1033333
5 1 1950-07-01 NA
6 1 1950-07-02 0.1433333
The idea if I understand , is to replace NA values by the mean of the values over all years. You can use ave and transform to create the new column containing the mean, then replace the NA value with it.
daily$daymonth <- strftime(daily$Date, format="%m-%d")
daily <- transform(daily, mp =ave(Precipitation,daymonth,
FUN=function(x) mean(x,na.rm=TRUE) ))
transform(daily, Precipitation =ifelse(is.na(Precipitation),mp,Precipitation))
Climate_Division Date Precipitation daymonth mp
1 1 1948-07-01 0.2100000 07-01 0.2000000
2 1 1948-07-02 0.1233333 07-02 0.1233333
3 1 1949-07-01 0.1900000 07-01 0.2000000
4 1 1949-07-02 0.1033333 07-02 0.1233333
5 1 1950-07-01 0.2000000 07-01 0.2000000
6 1 1950-07-02 0.1433333 07-02 0.1233333
Using data.table
Some dummy data
set.seed(1)
library(data.table)
daily <- seq(as.Date('1948-01-01'),as.Date('1995-12-31')
dd <- data.table(date = daily, precip = runif(length(daily)))
# add na values
nas <- sample(length(daily),300, FALSE)
dd[, precip := {is.na(precip) <- nas; precip}]
## calculate the daily averages
# add day and month
dd[, c('month','day') := list(month(date), mday(date))]
monthdate <- dd[, list(mprecip = mean(precip, na.rm = TRUE)),
keyby = list(month, date)]
# set key for joining
setkey(dd, month, date)
# replace NA with day-month averages
dd[monthdate, precip := ifelse(is.na(precip), mprecip, precip)]
# set key to reorder to daily
setkey(dd, date)
A slightly neater version of mnel's answer, which I would prefer to the accepted one:
set.seed(1)
library(data.table)
# step 1: form data
daily <- seq(as.Date('1948-01-01'),as.Date('1995-12-31'),by="day")
dd <- data.table(date = daily, precip = runif(length(daily)))
# step 2: add NA values
nas <- sample(length(daily),300, FALSE)
dd[, precip := {is.na(precip) <- nas; precip}]
# step 3: replace NAs with day-of-month across years averages
dd[, c('month','day') := list(month(date), mday(date))]
dd[,precip:= ifelse(is.na(precip), mean(precip, na.rm=TRUE), precip), by=list(month,day)]