A revised function for getting ISO week

classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

A revised function for getting ISO week

Gustaf Rydevik
Hi All,

Two years back, I posted a small function for getting the ISO 8601
defined week number of a date (such as the week number used in all
Swedish calendars),
in a os-independent manner.
I've since discovered an inaccuracy in that code, and so I thought I'd
repost the corrected version.
Hopefully this will come in handy for someone searching the mailing
list archives in the future.

Best Regards,
Gustaf

#############



## Inputs a date object, posix object, or 3 numbers and gives back the iso week.
## By Gustaf Rydevik, revised 2010


getweek<-function(Y,M=NULL,D=NULL){

  if(!class(Y)[1]%in%c("Date","POSIXt")) {
  date.posix<-strptime(paste(Y,M,D,sep="-"),"%Y-%m-%d")
  }
  if(class(Y)[1]%in%c("POSIXt","Date")){
date.posix<-as.POSIXlt(Y)
Y<-as.numeric(format(date.posix,"%Y"))
M<-as.numeric(format(date.posix,"%m"))
D<-as.numeric(format(date.posix,"%d"))
  }


  LY<- (Y%%4==0 & !(Y%%100==0))|(Y%%400==0)
  LY.prev<- ((Y-1)%%4==0 & !((Y-1)%%100==0))|((Y-1)%%400==0)
  date.yday<-date.posix$yday+1
  jan1.wday<-strptime(paste(Y,"01-01",sep="-"),"%Y-%m-%d")$wday
  jan1.wday<-ifelse(jan1.wday==0,7,jan1.wday)
  date.wday<-date.posix$wday
  date.wday<-ifelse(date.wday==0,7,date.wday)


  ####If the date is in the beginning, or end of the year,
  ### does it fall into a week of the previous or next year?
  Yn<-ifelse(date.yday<=(8-jan1.wday)&jan1.wday>4,Y-1,
        ifelse(((365+LY-date.yday)<(4-date.wday)),Y+1,Y))

  ##Set the week differently if the date is in the beginning,middle or
end of the year

  Wn<-ifelse(
      Yn==Y-1,
      ifelse((jan1.wday==5|(jan1.wday==6 &LY.prev)),53,52),
      ifelse(Yn==Y+1,1,(date.yday+(7-date.wday)+(jan1.wday-1))/7-(jan1.wday>4))
      )

    return(list(Year=Yn,ISOWeek=Wn))
}





--
Gustaf Rydevik, M.Sci.
tel: +46(0)703 051 451
address:Essingetorget 40,112 66 Stockholm, SE
skype:gustaf_rydevik

______________________________________________
[hidden email] mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.