I want to retrieve the third Wedndesday of specific months in R.
This is not exactly a duplicate question of How to figure third Friday of a month in R because I want to use either Base R or XTS.
The data is in x:
library(xts)
x = xts(1:100, Sys.Date()+1:100)
and I can retrieve wednesdays by using:
wed=x[.indexwday(x) %in% 3]
> wed
[,1]
2015-09-30 6
2015-10-07 13
2015-10-14 20
2015-10-21 27
2015-10-28 34
2015-11-04 41
2015-11-11 48
2015-11-18 55
2015-11-25 62
2015-12-02 69
2015-12-09 76
2015-12-16 83
2015-12-23 90
2015-12-30 97
>
I haven't figured out how to get the third observation in each month of this wed vector using xts but there must be a way.
third=wed[head(endpoints(wed, "months") + 3, -3)]
returns a wrong result.
I have read the xts documentation and couln't find the right function there.
Any help would be appreciated.
Why not just
library(xts)
x = xts(1:3650, Sys.Date()+1:3650)
x[.indexwday(x) == 3 &
.indexmday(x) >= 15 &
.indexmday(x) <= 21
]
If first Wednesday is on 1st then third is on 15th.
If first Wednesday is on 7th then third is on 21st.
So anywhere between 15th and 21st.
Take your wed object, split it by month, then select the 3rd row. Then use do.call and rbind to put it back together.
R> # 3rd or last available Wednesday
R> wedList <- split(wed, "months")
R> do.call(rbind, lapply(wedList, function(x) x[min(nrow(x),3),]))
# [,1]
# 2015-09-30 6
# 2015-10-21 27
# 2015-11-18 55
# 2015-12-16 83
R> # no observation if 3rd Wednesday isn't available
R> do.call(rbind, lapply(wedList, function(x) if(nrow(x) < 3) NULL else x[3,]))
# [,1]
# 2015-10-21 27
# 2015-11-18 55
# 2015-12-16 83
Related
I have some sampled data from a sensor with no particular time differences between samples looking like this:
> Y_cl[[1]]
index Date time Glucose POS
10 11 2017-06-10 03:01:00 136 2017-06-10 00:01:00
14 15 2017-06-10 03:06:00 132 2017-06-10 00:06:00
18 19 2017-06-10 03:11:00 133 2017-06-10 00:11:00
22 23 2017-06-10 03:16:00 130 2017-06-10 00:16:00
26 27 2017-06-10 03:20:59 119 2017-06-10 00:20:59
30 31 2017-06-10 03:26:00 115 2017-06-10 00:26:00
34 35 2017-06-10 03:30:59 117 2017-06-10 00:30:59
38 39 2017-06-10 03:36:00 114 2017-06-10 00:36:00
42 43 2017-06-10 03:40:59 113 2017-06-10 00:40:59
The data is saved in the format of Dataframes stored in list Y_cl, each list element is for one day. I am trying to select ALL samples between every quarter hour of the clock and get the mean, resulting in 4 points for each hour of each day, mathematically defined (NOT CODE) as:
mean(Glucose(H:00 <Y_cl[[1]]$time< H:15))==> Glucose_av(H:00),
mean(Glucose(H:15 <Y_cl[[1]]$time< H:30))==> Glucose_av(H:15),
mean(Glucose(H:30 <Y_cl[[1]]$time< H:45))==> Glucose_av(H:30),
mean(Glucose(H:45 <Y_cl[[1]]$time< (H+1):00))==>Glucose_av(H:45)
I have tried searching but have found links on how to select or cut every 15 minutes differences, while I need to group every hours data based on which quarter of the hour they are in, average, and assign the result to corresponding quarter. Y_cl[[1]]['POS'] is in standard POSIXct format. Any help would be appreciated.
Here is a solution using lubridate and plyr packages :
data$POS <- NULL
data$POS = as.POSIXct(paste(data$Date, data$time)) # POS correction
library(lubridate)
library(plyr)
data$day <- day(data$POS) # extract day
data$hour <- hour(data$POS) # extract hour
data$minute <- minute(data$POS) # extract minute
Create a new factor according to the quarter :
data$quarter <- NA
data$quarter[data$minute >= 0 & data$minute < 15] <- "q1" # 1st quarter
data$quarter[data$minute >= 15 & data$minute < 30] <- "q2" # 2ndquarter
data$quarter[data$minute >= 30 & data$minute < 45] <- "q3" # 3rd quarter
data$quarter[data$minute >= 45 & data$minute < 60] <- "q4" # 4th quarter
Summarize data for each quarter (compute mean of Glucose for each combination of day, hour and quarter) :
output <- ddply(data, c("day", "hour", "quarter"), summarise, result = mean(Glucose))
Result :
> output
day hour quarter result
1 10 3 q1 133.6667
2 10 3 q2 121.3333
3 10 3 q3 114.6667
I did it by flooring the result of the minutes of each time stamp divided by 15, where YPOS is the list within the time stamps for each day i with the list Y_cl exist:
SeI<- function(i){
*###seperate the hours from the minutes for use later and store in K1*
strftime(YPOS[[i]], format="%H")
K1<- (floor((as.numeric(strftime(YPOS[[i]], format="%M")))/15))*15
*###get the minutes and divide by 15, keeping the floor,multiplying by 15,store in K2*
K2<- strftime(YPOS[[i]], format="%Y-%m-%d %H", tz="GMT")
*###paste K1 and K2 together an save in POSTIXCT format as T_av*
TT<- paste0(K2, ':', K1)
T_av<- as.POSIXct(TT,format="%Y-%m-%d %H:%M", tz="GMT" )}
and then applying it over all days in the list:
lapply(1:length(Y_cl), function(i) SeI(i) )
My solution included taking the time stamps from the list Y_cl and saving it in YPOS.
Date Sales
3/11/2017 1
3/12/2017 0
3/13/2017 40
3/14/2017 47
3/15/2017 83
3/16/2017 62
3/17/2017 13
3/18/2017 58
3/19/2017 27
3/20/2017 17
3/21/2017 71
3/22/2017 76
3/23/2017 8
3/24/2017 13
3/25/2017 97
3/26/2017 58
3/27/2017 80
3/28/2017 77
3/29/2017 31
3/30/2017 78
3/31/2017 0
4/1/2017 40
4/2/2017 58
4/3/2017 32
4/4/2017 31
4/5/2017 90
4/6/2017 35
4/7/2017 88
4/8/2017 16
4/9/2017 72
4/10/2017 39
4/11/2017 8
4/12/2017 88
4/13/2017 93
4/14/2017 57
4/15/2017 23
4/16/2017 15
4/17/2017 6
4/18/2017 91
4/19/2017 87
4/20/2017 44
Here current date is 20/04/2017, My question is grouping data from 19/04/2017 to 11/03/2017 with 4 equal parts with summation sales in r programming?
Eg :
library("xts")
ep <- endpoints(data, on = 'days', k = 4)
period.apply(data,ep,sum)
it's not working. However, its taking start date to current date but I need to geatherd data from yestderday (19/4/2017) to start date and split into 4 equal parts.
kindly anyone guide me soon.
Thank you
Base R has a function cut.Date() which is built for the purpose.
However, the question is not fully clear on what the OP intends. My understanding of the requirements supplied in Q and additional comment is:
Take the sales data per day in Book1 but leave out the current day, i.e., use only completed days.
Group the data in four equal parts, i.e., four periods containing an equal number of days. (Note that the title of the Q and the attempt to use xts::endpoint() with k = 4 indicates that the OP might have a different intention to group the data in periods of four days length each.)
Summarize the sales figures by period
For the sake of brevity, data.table is used here for data manipulation and aggregation, lubridate for date manipulation
library(data.table)
library(lubridate)
# coerce to data.table, convert Date column from character to class Date,
# exclude the actual date
temp <- setDT(Book1)[, Date := mdy(Book1$Date)][Date != today()]
# cut the date range in four parts
temp[, start_date_of_period := cut.Date(Date, 4)]
temp
# Date Sales start_date_of_period
# 1: 2017-03-11 1 2017-03-11
# 2: 2017-03-12 0 2017-03-11
# 3: 2017-03-13 40 2017-03-11
# ...
#38: 2017-04-17 6 2017-04-10
#39: 2017-04-18 91 2017-04-10
#40: 2017-04-19 87 2017-04-10
# Date Sales start_date_of_period
# aggregate sales by period
temp[, .(n_days = .N, total_sales = sum(Sales)), by = start_date_of_period]
# start_date_of_period n_days total_sales
#1: 2017-03-11 10 348
#2: 2017-03-21 10 589
#3: 2017-03-31 10 462
#4: 2017-04-10 10 507
Thanks to chaining, this can be put together in one statement without using a temporary variable:
setDT(Book1)[, Date := mdy(Book1$Date)][Date != today()][
, start_date_of_period := cut.Date(Date, 4)][
, .(n_days = .N, total_sales = sum(Sales)), by = start_date_of_period]
Note If you want to reproduce the result in the future, you will have to replace the call to today() which excludes the current day by mdy("4/20/2017") which is the last day in the sample data set supplied by the OP.
this is my first post so I do apologize if I am not specific enough.
I have a sequence of months and a data frame with approximately 100 rows, each with a unique identifier. Each identifier is associated with a start up date. I am trying to calculate the number of months since start up for each of these unique identifiers at each month in the sequence. I have tried unsuccessfully to write a for loop to accomplish this.
Example Below:
# Build Example Data Frame #
x_example <- c("A","B","C","D","E")
y_example <- c("2013-10","2013-10","2014-04","2015-06","2014-01")
x_name <- "ID"
y_name <- "StartUp"
df_example <- data.frame(x_example,y_example)
names(df_example) <- c(x_name,y_name)
# Create Sequence of Months, Format to match Data Frame, Reverse for the For Loop #
base.date <- as.Date(c("2015-11-1"))
Months <- seq.Date(from = base.date , to = Sys.Date(), by = "month")
Months.1 <- format(Months, "%Y-%m")
Months.2 <- rev(Months.1)
# Create For Loop #
require(zoo)
for(i in seq_along(Months.2))
{
for(j in 1:length(summary(as.factor(df_example$ID), maxsum = 100000)))
{
Active.Months <- 12 * as.numeric((as.yearmon(Months.2 - i) - as.yearmon(df_example$StartUp)))
}
}
The idea behind the for loop was that for every record in the Months.2 sequence, there would be a calculation of the number of months to that record (month date) from the Start Up month for each of the unique identifiers. However, this has been kicking back the error:
Error in Months.2 - i : non-numeric argument to binary operator
I am not sure what the solution is, or if I am using the for loop properly for this.
Thanks in advance for any help with solving this problem!
Edit: This is what I am hoping my expected outcome would be (this is just a sample as there are more months in the sequence):
ID Start Up Month 2015-11 2015-12 2015-12 2016-02 2016-03
1 A 2013-10 25 26 27 28 29
2 B 2013-10 25 26 27 28 29
3 C 2014-04 19 20 21 22 23
4 D 2015-06 5 6 7 8 9
5 E 2014-01 22 23 24 25 26
One way to do it is to first use as.yearmon from zoo package to convert the dates. Then simply we iterate over months and subtract from the ones in the df_example,
library(zoo)
df_example$StartUp <- as.Date(as.yearmon(df_example$StartUp))
Months.2 <- as.Date(as.yearmon(Months.2))
df <- as.data.frame(sapply(Months.2, function(i)
round(abs(difftime(df_example$StartUp, i, units = 'days')/30))))
names(df) <- Months.2
cbind(df_example, df)
# ID StartUp 2016-07 2016-06 2016-05 2016-04 2016-03 2016-02 2016-01 2015-12 2015-11
#1 A 2013-10 33 32 31 30 29 28 27 26 25
#2 B 2013-10 33 32 31 30 29 28 27 26 25
#3 C 2014-04 27 26 25 24 23 22 21 20 19
#4 D 2015-06 13 12 11 10 9 8 7 6 5
#5 E 2014-01 30 29 28 27 26 25 24 23 22
x_example <- c("A","B","C","D","E")
y_example <- c("2013-10","2013-10","2014-04","2015-06","2014-01")
y_example <- paste(y_example,"-01",sep = "")
# past on the "-01" because I want the later function to work.
x_name <- "ID"
y_name <- "StartUp"
df_example <- data.frame(x_example,y_example)
names(df_example) <- c(x_name,y_name)
base.date <- as.Date(c("2015-11-01"))
Months <- seq.Date(from = base.date , to = Sys.Date(), by = "month")
Months.1 <- format(Months, "%Y-%m-%d")
Months.2 <- rev(Months.1)
monnb <- function(d) { lt <- as.POSIXlt(as.Date(d, origin="1900-01-01")); lt$year*12 + lt$mon }
mondf <- function(d1, d2) {monnb(d2) - monnb(d1)}
NumofMonths <- abs(mondf(df_example[,2],Sys.Date()))
n = max(NumofMonths)
# sequence along the number of months and get the month count.
monthcount <- (t(sapply(NumofMonths, function(x) pmax(seq((x-n+1),x, +1), 0) )))
monthcount <- data.frame(monthcount[,-(1:24)])
names(monthcount) <- Months.1
finalDataFrame <- cbind.data.frame(df_example,monthcount)
Here is your final data frame which is the desired output you indicated:
ID StartUp 2015-11-01 2015-12-01 2016-01-01 2016-02-01 2016-03-01 2016-04-01 2016-05-01 2016-06-01 2016-07-01
1 A 2013-10-01 25 26 27 28 29 30 31 32 33
2 B 2013-10-01 25 26 27 28 29 30 31 32 33
3 C 2014-04-01 19 20 21 22 23 24 25 26 27
4 D 2015-06-01 5 6 7 8 9 10 11 12 13
5 E 2014-01-01 22 23 24 25 26 27 28 29 30
The overall idea is that we calculate the number of months and use the sequence function to create a counter of the number of months until we get the current month.
I use an xts object. The index of the object is as below. There is one for every hour of the day for a year.
"2011-01-02 18:59:00 EST"
"2011-01-02 19:58:00 EST"
"2011-01-02 20:59:00 EST"
In columns are values associated with each index entry. What I want to do is calculate the standard deviation of the value for all Mondays at 18:59 for the complete year. There should be 52 values for the year.
I'm able to search for the day of the week using the weekdays() function, but my problem is searching for the time, such as 18:59:00 or any other time.
You can do this by using interaction to create a factor from the combination of weekdays and .indexhour, then use split to select the relevant observations from your xts object.
set.seed(21)
x <- .xts(rnorm(1e4), seq(1, by=60*60, length.out=1e4))
groups <- interaction(weekdays(index(x)), .indexhour(x))
output <- lapply(split(x, groups), function(x) c(count=length(x), sd=sd(x)))
output <- do.call(rbind, output)
head(output)
# count sd
# Friday.0 60 1.0301030
# Monday.0 59 0.9204670
# Saturday.0 60 0.9842125
# Sunday.0 60 0.9500347
# Thursday.0 60 0.9506620
# Tuesday.0 59 0.8972697
You can use the .index* family of functions (don't forget the '.' in front of 'index'!):
fxts[.indexmon(fxts)==0] # its zero-based (!) and gives you all the January values
fxts[.indexmday(fxts)==1] # beginning of month
fxts[.indexwday(SPY)==1] # Mondays
require(quantmod)
> fxts
value
2011-01-02 19:58:00 1
2011-01-02 20:59:00 2
2011-01-03 18:59:00 3
2011-01-09 19:58:00 4
2011-01-09 20:59:00 5
2011-01-10 18:59:00 6
2011-01-16 18:59:00 7
2011-01-16 19:58:00 8
2011-01-16 20:59:00 9`
fxts[.indexwday(fxts)==1] #this gives you all the Mondays
for subsetting the time you use
fxts["T19:30/T20:00"] # this will give you the time period you are looking for
and here you combine weekday and time period
fxts["T18:30/T20:00"] & fxts[.indexwday(fxts)==1] # to get a logical vector or
fxts["T18:30/T21:00"][.indexwday(fxts["T18:30/T21:00"])==1] # to get the values
> value
2011-01-03 18:58:00 3
2011-01-10 18:59:00 6
Let's say I have several years worth of data which look like the following
# load date package and set random seed
library(lubridate)
set.seed(42)
# create data.frame of dates and income
date <- seq(dmy("26-12-2010"), dmy("15-01-2011"), by = "days")
df <- data.frame(date = date,
wday = wday(date),
wday.name = wday(date, label = TRUE, abbr = TRUE),
income = round(runif(21, 0, 100)),
week = format(date, format="%Y-%U"),
stringsAsFactors = FALSE)
# date wday wday.name income week
# 1 2010-12-26 1 Sun 91 2010-52
# 2 2010-12-27 2 Mon 94 2010-52
# 3 2010-12-28 3 Tues 29 2010-52
# 4 2010-12-29 4 Wed 83 2010-52
# 5 2010-12-30 5 Thurs 64 2010-52
# 6 2010-12-31 6 Fri 52 2010-52
# 7 2011-01-01 7 Sat 74 2011-00
# 8 2011-01-02 1 Sun 13 2011-01
# 9 2011-01-03 2 Mon 66 2011-01
# 10 2011-01-04 3 Tues 71 2011-01
# 11 2011-01-05 4 Wed 46 2011-01
# 12 2011-01-06 5 Thurs 72 2011-01
# 13 2011-01-07 6 Fri 93 2011-01
# 14 2011-01-08 7 Sat 26 2011-01
# 15 2011-01-09 1 Sun 46 2011-02
# 16 2011-01-10 2 Mon 94 2011-02
# 17 2011-01-11 3 Tues 98 2011-02
# 18 2011-01-12 4 Wed 12 2011-02
# 19 2011-01-13 5 Thurs 47 2011-02
# 20 2011-01-14 6 Fri 56 2011-02
# 21 2011-01-15 7 Sat 90 2011-02
I would like to sum 'income' for each week (Sunday thru Saturday). Currently I do the following:
Weekending 2011-01-01 = sum(df$income[1:7]) = 487
Weekending 2011-01-08 = sum(df$income[8:14]) = 387
Weekending 2011-01-15 = sum(df$income[15:21]) = 443
However I would like a more robust approach which will automatically sum by week. I can't work out how to automatically subset the data into weeks. Any help would be much appreciated.
First use format to convert your dates to week numbers, then plyr::ddply() to calculate the summaries:
library(plyr)
df$week <- format(df$date, format="%Y-%U")
ddply(df, .(week), summarize, income=sum(income))
week income
1 2011-52 413
2 2012-01 435
3 2012-02 379
For more information on format.date, see ?strptime, particular the bit that defines %U as the week number.
EDIT:
Given the modified data and requirement, one way is to divide the date by 7 to get a numeric number indicating the week. (Or more precisely, divide by the number of seconds in a week to get the number of weeks since the epoch, which is 1970-01-01 by default.
In code:
df$week <- as.Date("1970-01-01")+7*trunc(as.numeric(df$date)/(3600*24*7))
library(plyr)
ddply(df, .(week), summarize, income=sum(income))
week income
1 2010-12-23 298
2 2010-12-30 392
3 2011-01-06 294
4 2011-01-13 152
I have not checked that the week boundaries are on Sunday. You will have to check this, and insert an appropriate offset into the formula.
This is now simple using dplyr. Also I would suggest using cut(breaks = "week") rather than format() to cut the dates into weeks.
library(dplyr)
df %>% group_by(week = cut(date, "week")) %>% mutate(weekly_income = sum(income))
I Googled "group week days into weeks R" and came across this SO question. You mention you have multiple years, so I think we need to keep up with both the week number and also the year, so I modified the answers there as so format(date, format = "%U%y")
In use it looks like this:
library(plyr) #for aggregating
df <- transform(df, weeknum = format(date, format = "%y%U"))
ddply(df, "weeknum", summarize, suminc = sum(income))
#----
weeknum suminc
1 1152 413
2 1201 435
3 1202 379
See ?strptime for all the format abbreviations.
Try rollapply from the zoo package:
rollapply(df$income, width=7, FUN = sum, by = 7)
# [1] 487 387 443
Or, use period.sum from the xts package:
period.sum(xts(df$income, order.by=df$date), which(df$wday %in% 7))
# [,1]
# 2011-01-01 487
# 2011-01-08 387
# 2011-01-15 443
Or, to get the output in the format you want:
data.frame(income = period.sum(xts(df$income, order.by=df$date),
which(df$wday %in% 7)),
week = df$week[which(df$wday %in% 7)])
# income week
# 2011-01-01 487 2011-00
# 2011-01-08 387 2011-01
# 2011-01-15 443 2011-02
Note that the first week shows as 2011-00 because that's how it is entered in your data. You could also use week = df$week[which(df$wday %in% 1)] which would match your output.
This solution is influenced by #Andrie and #Chase.
# load plyr
library(plyr)
# format weeks as per requirement (replace "00" with "52" and adjust corresponding year)
tmp <- list()
tmp$y <- format(df$date, format="%Y")
tmp$w <- format(df$date, format="%U")
tmp$y[tmp$w=="00"] <- as.character(as.numeric(tmp$y[tmp$w=="00"]) - 1)
tmp$w[tmp$w=="00"] <- "52"
df$week <- paste(tmp$y, tmp$w, sep = "-")
# get summary
df2 <- ddply(df, .(week), summarize, income=sum(income))
# include week ending date
tmp$week.ending <- lapply(df2$week, function(x) rev(df[df$week==x, "date"])[[1]])
df2$week.ending <- sapply(tmp$week.ending, as.character)
# week income week.ending
# 1 2010-52 487 2011-01-01
# 2 2011-01 387 2011-01-08
# 3 2011-02 443 2011-01-15
df.index = df['week'] #the the dt variable as index
df.resample('W').sum() #sum using resample
With dplyr:
df %>%
arrange(date) %>%
mutate(week = as.numeric(date - date[1])%/%7) %>%
group_by(week) %>%
summarise(weekincome= sum(income))
Instead of date[1] you can have any date from when you want to start your weekly study.