Related
For a time series analysis of over 1000 raster in a raster stack I need the date. The data is almost weekly in the structure of the files
"... 1981036 .... tif"
The zero separates year and week
I need something like: "1981-36"
but always get the error
Error in charToDate (x): character string is not in a standard unambiguous format
library(sp)
library(lubridate)
library(raster)
library(Zoo)
raster_path <- ".../AVHRR_All"
all_raster <- list.files(raster_path,full.names = TRUE,pattern = ".tif$")
all_raster
brings me:
all_raster
".../VHP.G04.C07.NC.P1981036.SM.SMN.Andes.tif"
".../VHP.G04.C07.NC.P1981037.SM.SMN.Andes.tif"
".../VHP.G04.C07.NC.P1981038.SM.SMN.Andes.tif"
…
To get the year and the associated week, I have used the following code:
timeline <- data.frame(
year= as.numeric(substr(basename(all_raster), start = 17, stop = 17+3)),
week= as.numeric(substr(basename(all_raster), 21, 21+2))
)
timeline
brings me:
timeline
year week
1 1981 35
2 1981 36
3 1981 37
4 1981 38
…
But I need something like = "1981-35" to be able to plot my time series later
I tried that:
timeline$week <- as.Date(paste0(timeline$year, "%Y")) + week(timeline$week -1, "%U")
and get the error:Error in charToDate(x) : character string is not in a standard unambiguous format
or I tried that
fileDates <- as.POSIXct(substr((all_raster),17,23), format="%y0%U")
and get the same error
until someone will post a better way to do this, you could try:
x <- c(".../VHP.G04.C07.NC.P1981036.SM.SMN.Andes.tif", ".../VHP.G04.C07.NC.P1981037.SM.SMN.Andes.tif",
".../VHP.G04.C07.NC.P1981038.SM.SMN.Andes.tif")
xx <- substr(x, 21, 27)
library(lubridate)
dates <- strsplit(xx,"0")
dates <- sapply(dates,function(x) {
year_week <- unlist(x)
year <- year_week[1]
week <- year_week[2]
start_date <- as.Date(paste0(year,'-01-01'))
date <- start_date+weeks(week)
#note here: OP asked for beginning of week.
#There's some ambiguity here, the above is end-of-week;
#uncommment here for beginning of week, just subtracted 6 days.
#I think this might yield inconsistent results, especially year-boundaries
#hence suggestion to use end of week. See below for possible solution
#date <- start_date+weeks(week)-days(6)
return (as.character(date))
})
newdates <- as.POSIXct(dates)
format(newdates, "%Y-%W")
Thanks to #Soren who posted this anwer here: Get the month from the week of the year
You can do it if you specify that Monday is a Weekday 1 with %u:
w <- c(35,36,37,38)
y <- c(1981,1981,1981,1981)
s <- c(1,1,1,1)
df <- data.frame(y,w,s)
df$d <- paste(as.character(df$y), as.character(df$w),as.character(df$s), sep=".")
df$date <- as.Date(df$d, "%Y.%U.%u")
# So here we have variable date as date if you need that for later.
class(df$date)
#[1] "Date"
# If you want it to look like Y-W, you can do the final formatting:
df$date <- format(df$date, "%Y-%U")
# y w s d date
# 1 1981 35 1 1981.35.1 1981-35
# 2 1981 36 1 1981.36.1 1981-36
# 3 1981 37 1 1981.37.1 1981-37
# 4 1981 38 1 1981.38.1 1981-38
# NB: though it looks correct, the resulting df$date is actually a character:
class(df$date)
#[1] "character"
Alternatively, you could do the same by setting the Sunday as 0 with %w.
Please see the sample data below.
I want to convert the quarterly sale data (with a start date and end date) into monthly sale data.
For example:
Data set A-Row 1 will be split into Data set B- Row 1, 2 and 3 for June, July and August separately and the sale will be pro rata based on number of days in that month, all other columns will be the same;
Data set A-Row 2 will pick up what was left in Row 1 (which ends in 5/9/2017) and formed a complete September.
Is there an efficient way to execute this, the actual data is a csv file with 100K x 15 data size, which will be split to approximately 300K x 15 new data set for monthly analysis.
Some key characteristic from sample question data includes:
The start day for the first quarterly sales data is the day that customer joins, so it could be any day;
All sales will be quarterly but in various days between 90, 91, or 92 days, but it is also possible to have imcomplete quarterly sale data as customer leave in the quarter.
Sample Question:
Customer.ID Country Type Sale Start..Date End.Date Days
1 1 US Commercial 91 7/06/2017 5/09/2017 91
2 1 US Commerical 92 6/09/2017 6/12/2017 92
3 2 US Casual 25 10/07/2017 3/08/2017 25
4 3 UK Commercial 64 7/06/2017 9/08/2017 64
Sample Answer:
Customer.ID Country Type Sale Start.Date End.Date Days
1 1 US Commercial 24 7/06/2017 30/06/2017 24
2 1 US Commercial 31 1/07/2017 31/07/2017 31
3 1 US Commercial 31 1/08/2017 31/08/2017 31
4 1 US Commercial 30 1/09/2017 30/09/2017 30
5 1 US Commercial 31 1/10/2017 31/10/2017 31
6 1 US Commercial 30 1/11/2017 30/11/2017 30
7 1 US Commercial 6 1/12/2017 6/12/2017 6
8 2 US Casual 22 10/07/2017 31/07/2017 22
9 2 US Casual 3 1/08/2017 3/08/2017 3
10 3 UK Commercial 24 7/06/2017 30/06/2017 24
11 3 UK Commercial 31 1/07/2017 31/07/2017 31
12 3 UK Commercial 9 1/08/2017 9/08/2017 9
I just ran CIAndrews' code. It seems to work for the most part, but it is very slow when run on a dataset with 10,000 rows. I eventually cancelled the execution after a few minutes of waiting. There's also an issue with the number of days: For example, July has 31 days, but the days variable only shows thirty. It's true that 31-1 = 30, but the first day should be counted as well.
The code below only takes about 21 seconds on my 2015 MacBook Pro (not including data generation), and takes care of the other problem, too.
library(tidyverse)
library(lubridate)
# generate data -------------------------------------------------------------
set.seed(666)
# assign variables
customer <- sample.int(n = 2000, size = 10000, replace = T)
country <- sample(c("US", "UK", "DE", "FR", "IS"), 10000, replace = T)
type <- sample(c("commercial", "casual", "other"), 10000, replace = T)
start <- sample(seq(dmy("7/06/2011"), today(), by = "day"), 10000, replace = T)
days <- sample(85:105, 10000, replace = T)
end <- start + days
sale <- sample(500:3000, 10000, replace = T)
# generate dataframe of artificial data
df_quarterly <- tibble(customer, country, type, sale, start, end, days)
# split quarters into months ----------------------------------------------
# initialize empty list with length == nrow(dataframe)
list_date_dfs <- vector(mode = "list", length = nrow(df_quarterly))
# for-loop generates new dates and adds as dataframe to list
for (i in 1:length(list_date_dfs)) {
# transfer dataframe row to variable `row`
row <- df_quarterly[i,]
# correct end date so split successful when interval doesn't cover full month
end_corr <- row$end + day(row$start) - day(row$end)
# use lubridate to compute first and last days of relevant months
m_start <- seq(row$start, end_corr, by = "month") %>%
floor_date(unit = "month")
m_end <- m_start + days_in_month(m_start) - 1
# replace first and last elements with original dates
m_start[1] <- row$start
m_end[length(m_end)] <- row$end
# compute the number of days per month as well as sales per month
# correct difference by adding 1
m_days <- as.integer(m_end - m_start) + 1
m_sale <- (row$sale / sum(m_days)) * m_days
# add tibble to list
list_date_dfs[[i]] <- tibble(customer = row$customer,
country = row$country,
type = row$type,
sale = m_sale,
start = m_start,
end = m_end,
days = m_days
)
}
# bind dataframe list elements into single dataframe
df_monthly <- bind_rows(list_date_dfs)
It's not pretty as it uses multiple functions and loops, since it consists out of multiple operations:
# Creating the dataset
library(tidyr)
customer <- c(1,1,2,3)
country <- c("US","US","US","UK")
type <- c("Commercial","Commercial","Casual","Commercial")
sale <- c(91,92,25,64)
Start <- as.Date(c("7/06/2017","6/09/2017","10/07/2017","7/06/2017"),"%d/%m/%Y")
Finish <- as.Date(c("5/09/2017","6/12/2017","3/08/2017","9/08/2017"),"%d/%m/%Y")
days <- c(91,92,25,64)
df <- data.frame(customer,country, type,sale, Start,Finish,days)
# Function to split per month
library(zoo)
addrowFun <- function(y){
temp <- do.call("rbind", by(y, 1:nrow(y), function(x) with(x, {
eom <- as.Date(as.yearmon(Start), frac = 1)
if (eom < Finish)
data.frame(customer, country, type, Start = c(Start, eom+1), Finish = c(eom, Finish))
else x
})))
return(temp)
}
loop <- df
for(i in 1:10){ #not all months are split up at once
loop <- addrowFun(loop)
}
# Calculating the days per month
loop$days <- as.numeric(difftime(loop$Finish,loop$Start, units="days"))
# Creating the function to get the monthly sales pro rata
sumFun <- function(x){
tempSum <- df[x$Start >= df$Start & x$Finish <= df$Finish & df$customer == x$customer,]
totalSale <- sum(tempSum$sale)
totalDays <- sum(tempSum$days)
return(x$days / totalDays * totalSale)
}
for(i in 1:length(loop$customer)){
loop$sale[i] <- sumFun(loop[i,])
}
loop
CiAndrews,
Thanks for the help and patience. I have managed to get the answer with small change. I have replace the "rbind" with "rbind.fill" from "plyr" package and everything runs smoothly after that.
Please see the head of sample2.csv below
customer country type sale Start Finish days
1 43108181108 US Commercial 3330 17/11/2016 24/02/2017 99
2 43108181108 US Commercial 2753 24/02/2017 23/05/2017 88
3 43108181108 US Commercial 3043 13/02/2018 18/05/2018 94
4 43108181108 US Commercial 4261 23/05/2017 18/08/2017 87
5 43103703637 UK Casual 881 4/11/2016 15/02/2017 103
6 43103703637 UK Casual 1172 26/07/2018 1/11/2018 98
Please see the codes below:
library(tidyr)
#read data and change the start and finish to data type
data <- read.csv("Sample2.csv")
data$Start <- as.Date(data$Start, "%d/%m/%Y")
data$Finish <- as.Date(data$Finish, "%d/%m/%Y")
customer <- data$customer
country <- data$country
days <- data$days
Finish <- data$Finish
Start <- data$Start
sale <- data$sale
type <- data$type
df <- data.frame(customer, country, type, sale, Start, Finish, days)
# Function to split per month
library(zoo)
library(plyr)
addrowFun <- function(y){
temp <- do.call("rbind.fill", by(y, 1:nrow(y), function(x) with(x, {
eom <- as.Date(as.yearmon(Start), frac = 1)
if (eom < Finish)
data.frame(customer, country, type, Start = c(Start, eom+1), Finish = c(eom, Finish))
else x
})))
return(temp)
}
loop <- df
for(i in 1:10){ #not all months are split up at once
loop <- addrowFun(loop)
}
# Calculating the days per month
loop$days <- as.numeric(difftime(loop$Finish,loop$Start, units="days"))
# Creating the function to get the monthly sales pro rata
sumFun <- function(x){
tempSum <- df[x$Start >= df$Start & x$Finish <= df$Finish & df$customer == x$customer,]
totalSale <- sum(tempSum$sale)
totalDays <- sum(tempSum$days)
return(x$days / totalDays * totalSale)
}
for(i in 1:length(loop$customer)){
loop$sale[i] <- sumFun(loop[i,])
}
loop
I would like to subset the following csv file based on Pentad dates (non overlapping average of dates). For example:
1.January 1 to January 5
2.January 6 to January 10
...
73.December 27 to December 31.
Here's the complete list of pentad dates:
List of Pentad dates
The Complete Data
Sample Data
SN,CY,Y,M,D,H,lat,lon,cat
198305,5,1983,8,5,0,9.1,140.7,"TD"
198305,5,1983,8,5,6,9.3,140.5,"TD"
198305,5,1983,8,5,12,9.6,139.9,"TD"
198305,5,1983,8,5,18,9.9,139.4,"TS"
198305,5,1983,8,6,0,10.2,138.8,"TS"
198305,5,1983,8,6,6,11,138.1,"TS"
198305,5,1983,8,6,12,11.8,137.3,"TS"
198305,5,1983,8,6,18,12.4,136.4,"Cat1"
198305,5,1983,8,7,0,12.8,135.8,"Cat1"
198305,5,1983,8,7,6,13.6,134.7,"Cat1"
198305,5,1983,8,7,12,14.4,133.9,"Cat2"
198305,5,1983,8,7,18,15,133.5,"Cat4"
198305,5,1983,8,8,0,15.8,132.8,"Cat4"
198305,5,1983,8,8,6,16.3,132.4,"Cat4"
198305,5,1983,8,8,12,17.1,132,"Cat5"
198305,5,1983,8,8,18,17.4,131.4,"Cat5"
198305,5,1983,8,9,0,17.8,130.8,"Cat5"
198305,5,1983,8,9,6,18.1,130.7,"Cat4"
198305,5,1983,8,9,12,18.7,130.3,"Cat4"
198305,5,1983,8,9,18,18.9,130.4,"Cat4
SN is a unique identifier, Y is years, M is months, D is days,H is hours. If the unique number falls in one pentad, it should not be included in the next subset anymore.
I have tried this for August (based from previous post):
P1 <- c(1,6,11,16,21,26)
P6 <- c(5,10,15,20,25,30)
res <- Map(function(x,y) subset(df1, M==8 & D >=x & D <= y), d1, d2)
But I'm having a problem with mapping with the starting pentads (P7) because it includes January 31 to February 4.
Can anyone suggest any methods to do this in R? Ill appreciate any help.
library(stringr)
df$Date = paste(df$Y, str_pad(df$M,2,'left','0'), str_pad(df$D,2,'left','0'), sep='-')
# Extract day of year (int 0 to 365) from POSIXlt date
df$yday = as.POSIXlt(df$Date)$yday + 1
Now it's trivial:
df$pentad = ceiling(df$yday/5)
I've been scouring the net but haven't found a solution to this quite possibly simple problem.
This is the half-hourly data using the library 'xts',
library(xts)
data.xts <- as.xts(1:nrow(data), as.POSIXct("2007-08-24 17:30:00") +
1800 * (1:nrow(data)))
data.xts <-as.data.frame(data.xts)
I changed it to data.frame because the original data is in data.frame format. Actually, in the original data frame, there is a time_stamp column and I prefer if I can just use the time_stamp column instead of using the 'xts' format.
How can I average every hourly data for a month so that I can plot a hourly time series of 24 hours for the different months?
For example,
2007-08-24 17:30:00 1
2007-08-25 17:00:00 47
2007-08-25 17:30:00 48
2007-08-26 17:00:00 95
would be averaged for the month of August 2007, etc.
Goal is to plot averaged 24-hourly time series for each month.
Thanks!
Try
library(dplyr)
res <- dat %>%
group_by(month=format(datetime, '%m'),
#year=format(datetime, '%Y'), #if you need year also
# as grouping variable
hour=format(as.POSIXct(cut(datetime, breaks='hour')), '%H')) %>%
summarise(Meanval=mean(val, na.rm=TRUE))
head(res,3)
# month hour Meanval
#1 01 00 -0.02780036
#2 01 01 -0.06589948
#3 01 02 -0.02166218
Update
If your datetime is POSIXlt you could convert it to POSIXct.
dat$datetime <- as.POSIXlt(dat$datetime)
By running the above code, I get the error
# Error: column 'datetime' has unsupported type
You could use mutate and convert the datetime to POSIXct class by as.POSIXct
res1 <- dat %>%
mutate(datetime= as.POSIXct(datetime)) %>%
group_by(month=format(datetime, '%m'),
#year=format(datetime, '%Y'), #if you need year also
# as grouping variable
hour=format(as.POSIXct(cut(datetime, breaks='hour')), '%H')) %>%
summarise(Meanval=mean(val, na.rm=TRUE))
data
set.seed(24)
dat <- data.frame(datetime=seq(Sys.time(), by='1 hour', length.out=2000),
val=rnorm(2000))
If I understand you correctly, you want to average all the values for a given hour, for all the days in a given month, and do this for all months. So average all the values between midnight and 00:59:59 for all the days in a given month, etc.
I see that you want to avoid xts but aggregate.zoo(...) was designed for this, and avoids dplyr and cut.
library(xts)
# creates sample dataset...
set.seed(1)
data <- rnorm(1000)
data.xts <- as.xts(data, as.POSIXct("2007-08-24 17:30:00") +
1800 * (1:length(data)))
# using aggregate.zoo(...)
as.hourly <- function(x) format(x,"%Y-%m %H")
result <- aggregate(data.xts,by=as.hourly,mean)
result <- data.frame(result)
head(result)
# result
# 2007-08 00 0.12236024
# 2007-08 01 0.41593567
# 2007-08 02 0.22670817
# 2007-08 03 0.23402842
# 2007-08 04 0.22175078
# 2007-08 05 0.05081899
I've been scouring the net but haven't found a solution to this quite possibly simple problem.
This is the half-hourly data using the library 'xts',
library(xts)
data.xts <- as.xts(1:nrow(data), as.POSIXct("2007-08-24 17:30:00") +
1800 * (1:nrow(data)))
data.xts <-as.data.frame(data.xts)
I changed it to data.frame because the original data is in data.frame format. Actually, in the original data frame, there is a time_stamp column and I prefer if I can just use the time_stamp column instead of using the 'xts' format.
How can I average every hourly data for a month so that I can plot a hourly time series of 24 hours for the different months?
For example,
2007-08-24 17:30:00 1
2007-08-25 17:00:00 47
2007-08-25 17:30:00 48
2007-08-26 17:00:00 95
would be averaged for the month of August 2007, etc.
Goal is to plot averaged 24-hourly time series for each month.
Thanks!
Try
library(dplyr)
res <- dat %>%
group_by(month=format(datetime, '%m'),
#year=format(datetime, '%Y'), #if you need year also
# as grouping variable
hour=format(as.POSIXct(cut(datetime, breaks='hour')), '%H')) %>%
summarise(Meanval=mean(val, na.rm=TRUE))
head(res,3)
# month hour Meanval
#1 01 00 -0.02780036
#2 01 01 -0.06589948
#3 01 02 -0.02166218
Update
If your datetime is POSIXlt you could convert it to POSIXct.
dat$datetime <- as.POSIXlt(dat$datetime)
By running the above code, I get the error
# Error: column 'datetime' has unsupported type
You could use mutate and convert the datetime to POSIXct class by as.POSIXct
res1 <- dat %>%
mutate(datetime= as.POSIXct(datetime)) %>%
group_by(month=format(datetime, '%m'),
#year=format(datetime, '%Y'), #if you need year also
# as grouping variable
hour=format(as.POSIXct(cut(datetime, breaks='hour')), '%H')) %>%
summarise(Meanval=mean(val, na.rm=TRUE))
data
set.seed(24)
dat <- data.frame(datetime=seq(Sys.time(), by='1 hour', length.out=2000),
val=rnorm(2000))
If I understand you correctly, you want to average all the values for a given hour, for all the days in a given month, and do this for all months. So average all the values between midnight and 00:59:59 for all the days in a given month, etc.
I see that you want to avoid xts but aggregate.zoo(...) was designed for this, and avoids dplyr and cut.
library(xts)
# creates sample dataset...
set.seed(1)
data <- rnorm(1000)
data.xts <- as.xts(data, as.POSIXct("2007-08-24 17:30:00") +
1800 * (1:length(data)))
# using aggregate.zoo(...)
as.hourly <- function(x) format(x,"%Y-%m %H")
result <- aggregate(data.xts,by=as.hourly,mean)
result <- data.frame(result)
head(result)
# result
# 2007-08 00 0.12236024
# 2007-08 01 0.41593567
# 2007-08 02 0.22670817
# 2007-08 03 0.23402842
# 2007-08 04 0.22175078
# 2007-08 05 0.05081899