So let's take the following data.table. It has dates and a column of numbers. I'd like to get the week of each date and then aggregate (sum) of each two weeks.
Date <- as.Date(c("1980-01-01", "1980-01-02", "1981-01-05", "1981-01-05", "1982-01-08", "1982-01-15", "1980-01-16", "1980-01-17",
"1981-01-18", "1981-01-22", "1982-01-24", "1982-01-26"))
Runoff <- c(2, 1, 0.1, 3, 2, 5, 1.5, 0.5, 0.3, 2, 1.5, 4)
DT <- data.table(Date, Runoff)
DT
So from the date, I can easily get the year and week.
DT[,c("Date_YrWeek") := paste(substr(Date,1,4), week(Date), sep="-")][]
What I'm struggling with is aggregating with every two week.
I thought that I'd get the first date for each week and filter using those values. Unfortunately, that would be pretty foolish.
DT[,.(min(Date)),by=.(Date_YrWeek)][order(Date)]
The final result would end up being the sum of every two weeks.
weeks sum_value
1 and 2 ...
3 and 4 ...
5 and 6 ...
Anyone have an efficient way to do this with data.table?
1) Define the two week periods as starting from the minimum Date. Then we can get the total Runoff for each such period like this.
DT[, .(sum_value = sum(Runoff)),
keyby = .(Date = 14 * (as.numeric(Date - min(Date)) %/% 14) + min(Date))]
giving the following where the Date column is the date of the first day of the two week period.
Date sum_value
1: 1980-01-01 3.0
2: 1980-01-15 2.0
3: 1980-12-30 3.1
4: 1981-01-13 2.3
5: 1981-12-29 2.0
6: 1982-01-12 6.5
7: 1982-01-26 4.0
2) If you prefer the text shown in the question for the first column then:
DT[, .(sum_value = sum(Runoff)),
keyby = .(two_week = as.numeric(Date - min(Date)) %/% 14)][
, .(weeks = paste(2*two_week + 1, "and", 2*two_week + 2), sum_value)]
giving:
weeks sum_value
1: 1 and 2 3.0
2: 3 and 4 2.0
3: 53 and 54 3.1
4: 55 and 56 2.3
5: 105 and 106 2.0
6: 107 and 108 6.5
7: 109 and 110 4.0
Update: Revised and added (2).
With tidyverse and lubridate:
library(tidyverse)
library(lubridate)
summary <- DT %>%
mutate(TwoWeeks = round_date(Date, "2 weeks")) %>%
group_by(TwoWeeks) %>%
summarise(sum_value = sum(Runoff))
summary
# A tibble: 9 × 2
TwoWeeks sum_value
<date> <dbl>
1 1979-12-30 3.0
2 1980-01-13 1.5
3 1980-01-20 0.5
4 1981-01-04 3.1
5 1981-01-18 0.3
6 1981-01-25 2.0
7 1982-01-10 2.0
8 1982-01-17 5.0
9 1982-01-24 5.5
Lubridate's round_date() will aggregate dates within ranges you can specify through size and unit, in this case, "2 weeks". round_date()'s output is the first calendar day of that period.
Related
I try to calculate the date difference between second row and last row per group id. The data looks like
data<- data.frame(pid= c(1, 1, 1,1, 2, 2, 2, 3, 3, 3,3 ,3), day = c("25/07/2018", "19/10/2018", "17/01/2019", "19/03/2019", "10/09/2018","29/11/2018", "26/03/2019", "17/06/2016", "25/04/2018", "17/07/2018","05/04/2019", "09/02/2021"), catt=c(1,1,2,1,1,1,2,2,2,1,1,2))
data
pid
day
1
1
25/07/2018
2
1
19/10/2018
3
1
17/01/2019
4
1
19/03/2019
5
2
10/09/2018
6
2
29/11/2018
7
2
26/03/2019
8
3
17/06/2016
9
3
25/04/2018
10
3
17/07/2018
11
3
05/04/2019
12
3
09/02/2021
I use the following code to obtain a difference in months.
difftime("19/10/2018","19/03/2019 ", units = "days")/ (30)
difftime("29/11/2018","26/03/2019 ", units = "days")/ (30)
difftime("25/04/2018","09/02/2021 ", units = "days")/ (30)
The desired output
id day difference
1 25/07/2018
1 19/10/2018
1 17/01/2019
1 19/03/2019 7.13
2 10/09/2018
2 29/11/2018
2 26/03/2019 44.7
3 17/06/2016
3 25/04/2018
3 17/07/2018
3 05/04/2019
3 09/02/2021 196.7667
But it is difficult to large data, so anyone can help using lubricate () + slice() functions
Convert to date object and calculate the difference between last and second date for each pid.
library(dplyr)
library(lubridate)
data %>%
mutate(day = dmy(day)) %>%
arrange(pid, day) %>%
group_by(pid) %>%
summarise(difference = (last(day) - day[2])/30)
# pid difference
# <dbl> <dbl>
#1 1 5.03
#2 2 3.9
#3 3 34.0
If you want to maintain the number of rows in the dataframe, use mutate and replace the difference only on the last row of the dataframe.
data %>%
mutate(day = dmy(day)) %>%
arrange(pid, day) %>%
group_by(pid) %>%
mutate(difference = ifelse(row_number() == n(), (last(day) - day[2])/30, NA))
Note that output from difftime in the question is incorrect.
#Wrong output
difftime("19/10/2018","19/03/2019 ", units = "days")
#Time difference of 214 days
#Correct output
difftime(dmy("19/03/2019"), dmy("19/10/2018"), units = "days")
#Time difference of 151 days
I have a data.frame df that has monthly data:
Date Value
2008-01-01 3.5
2008-02-01 9.5
2008-03-01 0.1
I want there to be data on every day in the month (and I will assume Value does not change during each month) since I will be merging this into a different table that has monthly data.
I want the output to look like this:
Date Value
2008-01-02 3.5
2008-01-03 3.5
2008-01-04 3.5
2008-01-05 3.5
2008-01-06 3.5
2008-01-07 3.5
2008-01-08 3.5
2008-01-09 3.5
2008-01-10 3.5
2008-01-11 3.5
2008-01-12 3.5
2008-01-13 3.5
2008-01-14 3.5
2008-01-15 3.5
2008-01-16 3.5
2008-01-17 3.5
2008-01-18 3.5
2008-01-19 3.5
2008-01-20 3.5
2008-01-21 3.5
2008-01-22 3.5
2008-01-23 3.5
2008-01-24 3.5
2008-01-25 3.5
2008-01-26 3.5
2008-01-27 3.5
2008-01-28 3.5
2008-01-29 3.5
2008-01-30 3.5
2008-01-31 3.5
2008-02-01 9.5
I have tried to.daily but my call:
df <- to.daily(df$Date)
returns
Error in to.period(x, "days", name = name, ...) : ‘x’ contains no data
Not sure if i understood perfectly but i think something like this may work.
First, i define the monthly data table
library(data.table)
DT_month=data.table(Date=as.Date(c("2008-01-01","2008-02-01","2008-03-01","2008-05-01","2008-07-01"))
,Value=c(3.5,9.5,0.1,5,8))
Then, you have to do the following
DT_month[,Month:=month(Date)]
DT_month[,Year:=year(Date)]
start_date=min(DT_month$Date)
end_date=max(DT_month$Date)
DT_daily=data.table(Date=seq.Date(start_date,end_date,by="day"))
DT_daily[,Month:=month(Date)]
DT_daily[,Year:=year(Date)]
DT_daily[,Value:=-100]
for( i in unique(DT_daily$Year)){
for( j in unique(DT_daily$Month)){
if(length(DT_month[Year==i & Month== j,Value])!=0){
DT_daily[Year==i & Month== j,Value:=DT_month[Year==i & Month== j,Value]]
}
}
}
Basically, the code will define the month and year of each monthly value in separate columns.
Then, it will create a vector of daily data using the minimum and maximum dates in your monthly data, and will create two separate columns for year and month for the daily data as well.
Finally, it goes through every combination of year and months of data filling the daily values with the monthly ones. In case there is no data for certain combination of month and year, it will show a -100.
Please let me know if it works.
An option using tidyr::expand expand a row between 1st day of month to last day of month. The lubridate::floor_date can provide 1st day of month and lubridate::ceiling_date() - days(1) will provide last day of month.
library(tidyverse)
library(lubridate)
df %>% mutate(Date = ymd(Date)) %>%
group_by(Date) %>%
expand(Date = seq(floor_date(Date, unit = "month"),
ceiling_date(Date, unit="month")-days(1), by="day"), Value) %>%
as.data.frame()
# Date Value
# 1 2008-01-01 3.5
# 2 2008-01-02 3.5
# 3 2008-01-03 3.5
# 4 2008-01-04 3.5
# 5 2008-01-05 3.5
#.....so on
# 32 2008-02-01 9.5
# 33 2008-02-02 9.5
# 34 2008-02-03 9.5
# 35 2008-02-04 9.5
# 36 2008-02-05 9.5
#.....so on
# 85 2008-03-25 0.1
# 86 2008-03-26 0.1
# 87 2008-03-27 0.1
# 88 2008-03-28 0.1
# 89 2008-03-29 0.1
# 90 2008-03-30 0.1
# 91 2008-03-31 0.1
Data:
df <- read.table(text =
"Date Value
2008-01-01 3.5
2008-02-01 9.5
2008-03-01 0.1",
header = TRUE, stringsAsFactors = FALSE)
to.daily can only be applied to xts/zooobjects and can only convert to a LOWER frequency. i.e. from daily to monthly, but not the other way round.
One easy way to accomplish what you want is converting df to an xts object:
df.xts <- xts(df$Value,order.by = df$Date)
And merge, like so:
na.locf(merge(df.xts, foo=zoo(NA, order.by=seq(start(df.xts), end(df.xts),
"day",drop=F)))[, 1])
df.xts
2018-01-01 3.5
2018-01-02 3.5
2018-01-03 3.5
2018-01-04 3.5
2018-01-05 3.5
2018-01-06 3.5
2018-01-07 3.5
….
2018-01-27 3.5
2018-01-28 3.5
2018-01-29 3.5
2018-01-30 3.5
2018-01-31 3.5
2018-02-01 9.5
2018-02-02 9.5
2018-02-03 9.5
2018-02-04 9.5
2018-02-05 9.5
2018-02-06 9.5
2018-02-07 9.5
2018-02-08 9.5
….
2018-02-27 9.5
2018-02-28 9.5
2018-03-01 0.1
If you want to adjust the price continuously over the course of a month use na.spline in place of na.locf.
Maybe not an efficient one but with base R we can do
do.call("rbind", lapply(1:nrow(df), function(i)
data.frame(Date = seq(df$Date[i],
(seq(df$Date[i],length=2,by="months") - 1)[2], by = "1 days"),
value = df$Value[i])))
We basically generate a sequence of dates from start_date to the last day of that month which is calculated by
seq(df$Date[i],length=2,by="months") - 1)[2]
and repeat the same value for all the dates and put them in the data frame.
We get a list of dataframe and then we can rbind them using do.call.
Another way:
library(lubridate)
d <- read.table(text = "Date Value
2008-01-01 3.5
2008-02-01 9.5
2008-03-01 0.1",
stringsAsFactors = FALSE, header = TRUE)
Dates <- seq(from = min(as.Date(d$Date)),
to = ceiling_date(max(as.Date(d$Date)), "month") - days(1),
by = "1 days")
data.frame(Date = Dates,
Value = setNames(d$Value, d$Date)[format(Dates, format = "%Y-%m-01")])
I am looking to convert the following R data frame into one that is indexed by seconds and have no idea how to do it. Maybe dcast but then in confused on how to expand out the word that's being spoken.
startTime endTime word
1 1.900s 2.300s hey
2 2.300s 2.800s I'm
3 2.800s 3s John
4 3s 3.400s right
5 3.400s 3.500s now
6 3.500s 3.800s I
7 3.800s 4.300s help
Time word
1.900s hey
2.000s hey
2.100s hey
2.200s hey
2.300s I'm
2.400s I'm
2.500s I'm
2.600s I'm
2.700s I'm
2.800s John
2.900s John
3.000s right
3.100s right
3.200s right
3.300s right
One solution can be achieved using tidyr::expand.
EDITED: Based on feedback from OP, as his data got duplicate startTime
library(tidyverse)
step = 0.1
df %>% group_by(rnum = row_number()) %>%
expand(Time = seq(startTime, max(startTime, (endTime-step)), by=step), word = word) %>%
arrange(Time) %>%
ungroup() %>%
select(-rnum)
# # A tibble: 24 x 2
# # Groups: word [7]
# Time word
# <dbl> <chr>
# 1 1.90 hey
# 2 2.00 hey
# 3 2.10 hey
# 4 2.20 hey
# 5 2.30 I'm
# 6 2.40 I'm
# 7 2.50 I'm
# 8 2.60 I'm
# 9 2.70 I'm
# 10 2.80 John
# ... with 14 more rows
Data
df <- read.table(text =
"startTime endTime word
1.900 2.300 hey
2.300 2.800 I'm
2.800 3 John
3 3.400 right
3.400 3.500 now
3.500 3.800 I
3.800 4.300 help",
header = TRUE, stringsAsFactors = FALSE)
dcast() is used for reshaping data from long to wide format (thereby aggregating) while the OP wants to reshape from wide to long format thereby filling the missing timestamps.
There is an alternative approach which uses a non-equi join.
Prepare data
However, startTime and endTime need to be turned into numeric variables after removing the trailing "s" before we can proceed.
library(data.table)
cols <- stringr::str_subset(names(DF), "Time$")
setDT(DF)[, (cols) := lapply(.SD, function(x) as.numeric(stringr::str_replace(x, "s", ""))),
.SDcols = cols]
Non-equi join
A sequence of timestamps covering the whole period is created and right joined to the dataset but only those timestamps are retained which fall within the given intervall. From the accepted answer, it seems that endTime must not be included in the result. So, the join condition has to be adjusted accordingly.
DF[DF[, CJ(time = seq(min(startTime), max(endTime), 0.1))],
on = .(startTime <= time, endTime > time), nomatch = 0L][
, endTime := NULL][] # a bit of clean-up
startTime word
1: 1.9 hey
2: 2.0 hey
3: 2.1 hey
4: 2.2 hey
5: 2.3 I'm
6: 2.4 I'm
7: 2.5 I'm
8: 2.6 I'm
9: 2.7 I'm
10: 2.8 John
11: 2.9 John
12: 3.0 right
13: 3.1 right
14: 3.2 right
15: 3.3 right
16: 3.4 now
17: 3.5 I
18: 3.6 I
19: 3.7 I
20: 3.8 help
21: 3.9 help
22: 4.0 help
23: 4.1 help
24: 4.2 help
startTime word
Note that this approach does not require to introduce row numbers.
nomatch = 0L avoids NA rows in case of gaps in the dialogue.
Data
library(data.table)
DF <- fread("
rn startTime endTime word
1 1.900s 2.300s hey
2 2.300s 2.800s I'm
3 2.800s 3s John
4 3s 3.400s right
5 3.400s 3.500s now
6 3.500s 3.800s I
7 3.800s 4.300s help
", drop = 1L)
I need to do a fast aggregation by id_client of dates: min, max, difference of dates in months and quantity of months.
Example table:
tbl<-data.frame(id_cliente=c(1,1,1,1,2,3,3,3),
fecha=c('2013-01-01', '2013-06-01','2013-05-01', '2013-04-01', '2013-01-01', '2013-01-01','2013-05-01','2013-04-01'))
Format dates:
tbl$fecha<-as.Date(as.character(tbl$fecha))
My first approach was ddply:
tbl2<-ddply(tbl, .(id_cliente), summarize, cant=length(id_cliente),
max=max(fecha), min=min(fecha),
dif=length(seq(from=min, to=max, by='month')))
I got the desired result, but with my real table takes too much time.
So I tried tapply:
tbl3<-data.frame(cbind(dif=tapply(tbl$fecha, list(tbl$id_cliente), secuencia),
hay=tapply(tbl$fecha, list(tbl$id_cliente), length),
min=tapply(tbl$fecha, list(tbl$id_cliente), min),
max=tapply(tbl$fecha, list(tbl$id_cliente), max)
))
The result was:
> tbl3
dif hay min max
6 4 15706 15857
1 1 15706 15706
5 3 15706 15826
In this case I got instead of dates, numbers. So since the following works, I tried using as.Date inside tapply:
as.Date(15706, origin='1970-01-01')
MIN<-function(x){as.Date(min(x), origin='1970-01-01')}
The function works but with tapply doesn't.
tbl3<-data.frame(cbind(min=tapply(tbl$fecha, list(tbl$id_cliente), MIN)))
And I still got the number instead of date.
How can I solve this? Thanks.
I know this is a bit late, but I figured I would put this here for the people still googling this issue.
Interestingly, tapply returns the correct results when you keep the date column in text format and then you can convert to a date after:
tbl<-data.frame(id_cliente=c(1,1,1,1,2,3,3,3),
fecha=c('2013-01-01', '2013-06-01','2013-05-01', '2013-04-01', '2013-01-01', '2013-01-01','2013-05-01','2013-04-01'))
tbl3<-data.frame(cbind(dif=tapply(tbl$fecha, list(tbl$id_cliente), seq),
hay=tapply(tbl$fecha, list(tbl$id_cliente), length),
min=tapply(tbl$fecha, list(tbl$id_cliente), min),
max=tapply(tbl$fecha, list(tbl$id_cliente), max)))
head(tbl3)
# dif hay min max
# 1, 2, 3, 4 4 2013-01-01 2013-06-01
# 1 1 2013-01-01 2013-01-01
# 1, 2, 3 3 2013-01-01 2013-05-01
With base R, the ?Date class is converted to the number of days from Jan. 1, 1970. Try using dplyr or data.table to preserve the date class:
dplyr
library(dplyr)
tbl %>% group_by(id_cliente) %>%
summarise(dif=length(seq(min(fecha), max(fecha), by='month')),
hay=length(fecha),
min=min(fecha),
max=max(fecha))
# Source: local data frame [3 x 5]
#
# id_cliente dif hay min max
# 1 1 6 4 2013-01-01 2013-06-01
# 2 2 1 1 2013-01-01 2013-01-01
# 3 3 5 3 2013-01-01 2013-05-01
data.table
library(data.table)
setDT(tbl)[,.(dif=length(seq(min(fecha), max(fecha), by='month')),
hay= .N,
min=min(fecha),
max=max(fecha)), by=id_cliente]
# id_cliente dif hay min max
# 1: 1 6 4 2013-01-01 2013-06-01
# 2: 2 1 1 2013-01-01 2013-01-01
# 3: 3 5 3 2013-01-01 2013-05-01
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...