Script Library: 1213 scripts
 

date-time.r

REBOL [ file: %date-time.r title: "Date and time functions" date: 24-Feb-2011 version: 1.1 home: http://rebol.x10.mx author: "Francois Vanzeveren" email: %brainois--rebol--x10--mx purpose: { This script contains the Rebol implementation of some date and time functions provided in the glibc library and the gnumeric (and therefore Microsoft Excel) software. While the use and handling of date and time data are in most cases straightforward with Rebol, some of the advanced date and times functionalities found in glibc and gnumeric are still missing in Rebol. This script is therefore an attempt to fill the gap. } language: "English" history: [ 1.1 24-Feb-2011 "Francois Vanzeveren" { BUG: the function 'week-of-year was not correctly implemented, sometimes returning 0 as week number for the first week of the year. CLEANSING: iso-week-num removed (redundant with week-of-year/iso) } 1.0 05-Jan-2003 "Francois Vanzeveren" "First public release" ] library: [ level: 'intermediate platform: 'all type: [function tool] domain: [extension financial] tested-under: [linux windows] support: none license: 'lgpl see-also: none ] ] ; M T W T F S S ;_base-monday: copy [1 2 3 4 5 6 7] _base-sunday: copy [2 3 4 5 6 7 1] end-of-month: function [ { Returns the last day of the month which is @months from the @start-date. } start-date [date!] months [integer!] ] [ last-day [integer!] new-month [integer!] new-year [integer!] ] [ either greater-or-equal? months 0 [ new-year: add start-date/year to-integer divide add start-date/month months 12 new-month: remainder add start-date/month months 12 ] [ either greater? start-date/month absolute months [ new-year: start-date/year new-month: add start-date/month months ] [ new-year: add start-date/year subtract to-integer divide add start-date/month months 12 1 new-month: add 12 remainder add start-date/month months 12 ] ] last-day: multiply 31 to-integer found? find [0 1 3 5 7 8 10 12] new-month if all [not to-logic last-day found? find [4 6 9 11] new-month ] [ last-day: 30 ] if not to-logic last-day [ last-day: add 28 to-integer leap-year? make date! reduce [1 1 new-year] ] make date! reduce [last-day new-month new-year] ] end-of-month?: function [ { Returns true if @a-date is the last day of its month. } a-date [date!] ] [] [ equal? a-date end-of-month a-date 0 ] leap-year?: function [ { Returns true for a leap year. } date [date!] "The date to check." ] [year [integer!]] [ year: date/year any [ all [ equal? 0 remainder year 4 not-equal? 0 remainder year 100 ] equal? 0 remainder year 400 ] ] date-dif: function [ { Returns the difference between two dates. } date1 [date!] date2 [date!] /y {Returns the number of complete years between @date1 and @date2.} /m {Returns the number of complete months between @date1 and @date2.} /d {Returns the number of complete days between @date1 and @date2.} /ym {Returns the number of full months between @date1 and @date2, not including the difference in years.} /md {Returns the number of full days between @date1 and @date2, not including the difference in months.} /yd {Returns the number of full days between @date1 and @date2, not including the difference in years.} ] [] [ if y [ return subtract subtract date2/year date1/year to-integer any [ lesser? date2/month date1/month all [ equal? date2/month date1/month lesser? date2/day date1/day ] ] ] if m [ return subtract subtract add multiply subtract date2/year date1/year 12 date2/month date1/month to-integer lesser? date2/day date1/day ] if ym [ return either any [lesser? date1/month date2/month all [ equal? date1/month date2/month lesser-or-equal? date1/day date2/day ] ] [ subtract subtract date2/month date1/month to-integer greater? date1/day date2/day ] [ subtract add subtract 12 date1/month date2/month to-integer greater? date1/day date2/day ] ] if md [ return subtract add date2/day multiply get-refinement end-of-month date2 -1 'day to-integer greater? date1/day date2/day date1/day ] if yd [ if all [equal? date1/day date2/day equal? date1/month date2/month ] [ return 0 ] return either any [ greater? date2/month date1/month all [ equal? date2/month date1/month greater? date2/day date1/day ] ] [ use [ start-date [date!]] [ start-date: make date! reduce [date1/day date1/month date2/year] subtract date2 start-date ] ] [ use [ start-date [date!]] [ start-date: make date! reduce [date1/day date1/month subtract date2/year 1 ] subtract date2 start-date ] ] ] return subtract date2 date1 ] days360: function [ { Returns the number of days from @date1 to @date2 following a 360-day calendar in which all months are assumed to have 30 days. By default, the US method is used. } date1 [date!] "Starting date" date2 [date!] "Ending date" /euro {The European method will be used. In this case, if the day of the month is 31 it will be considered as 30.} /us {U.S. (NASD) method. If the starting date is the 31st of a month, it becomes equal to the 30th of the same month. If the ending date is the 31st of a month and the starting date is earlier than the 30th of a month, the ending date becomes equal to the 1st of the next month, otherwise the ending date becomes equal to the 30th of the same month. This is the default behaviour.} ] [] [ either euro [ ;euro date1: subtract date1 to-integer equal? date1/day 31 date2: subtract date2 to-integer equal? date2/day 31 ] [ ;US or default either all [ end-of-month? date1 end-of-month? date2 ] [ date1/day: min date1/day date2/day date2/day: min date1/day date2/day ] [ date1: subtract date1 to-integer all [ equal? date1/day 31 any [ not-equal? date1/month date2/month not-equal? date1/year date2/year equal? date2/day 30 ] ] if all [ equal? date1/month 2 ; February equal? date1/day 29 ; End of february for leap year... greater-or-equal? date2 subtract end-of-month date1 0 1 any [ not-equal? date1/month date2/month not-equal? date1/year date2/year ] ] [ date2: subtract date2 1 ] if equal? date2/day 31 [ either lesser? date1/day 30 [ date2: add date2 1 ][ date2: subtract date2 1 ] ] ] ] return add add multiply date-dif/m date1 date2 30 multiply 30 to-integer lesser? date2/day date1/day subtract date2/day date1/day ] edate: function [ { Returns the date that is the specified number of months before or after a given date. } initial-date [date!] "The initial date." months [integer!] {The number of months before (negative number) or after (positive number) the initial date.} ] [ new-day [integer!] new-month [integer!] new-year [integer!] new-date [integer!] ] [ new-day: initial-date/day new-month: remainder add initial-date/month months 12 new-year: add initial-date/year to-integer divide add initial-date/month months 12 new-date: end-of-month make date! reduce [1 new-month new-year] 0 if lesser? new-day new-date/day [ new-date/day: new-day ] return new-date ] day-of-year: function [ { Returns the day number within @the-date/year. The first day of the year has value 1. } the-date [date!] ] [] [ add 1 subtract the-date make date! reduce [the-date/year 1 1] ] week-of-year: function [ { Return the week of the year. The first week of the year has value 1. } the-date [date!] /monday "Weeks are understood to start on Monday" /sunday "Weeks are understood to start on Sunday." /iso {Returns the ISO 8601 week number of @the-date. An ISO 8601 week starts on Monday. Weeks are numbered from 1. Week 01 of a year is per definition the first week that has the Thursday in this year, which is equivalent to the week that contains the fourth day of January. In other words, the first week of a new year is the week that has the majority of its days in the new year. Week 01 might also contain days from the previous year and the week before week 01 of a year is the last week (52 or 53) of the previous year even if it contains days from the new year. See http://www.techno-science.net/?onglet=glossaire&definition=3075 } ] [ week [integer!] wd [integer!] day [integer!] jan1date [date!] mon [date!] thur [date!] ] [ either iso [ thur: add the-date subtract 4 the-date/weekday mon: make date! reduce [thur/year 1 4] mon: add mon subtract 1 mon/weekday week: round/ceiling divide subtract thur mon 7 ] [ jan1date: make date! reduce [the-date/year 1 1] wd: jan1date/weekday ; Weeks are understood to start on Monday if sunday [ ; Weeks are understood to start on Sunday wd: pick _base-sunday wd ] wd: subtract wd 1 day: subtract day-of-year the-date 1 week: add 1 to-integer divide add day wd 7 ] week ; return value ] net-work-days: function [ { Returns the number of whole working days, beginning with @start_date and ending with @end_date, excluding days in @dates and weekends. } start-date [date!] end-date [date!] /holidays dates [block!] ] [ nb-of-holidays [integer!] diff-in-weeks [integer!] first-week-nwd [integer!] ; first week non weekend days last-week-nwd [integer!] ; last week non weekend days non-weekend-days [integer!] first-monday [date!] ; the first monday of the period, first week not included. last-friday [date!] ; the last friday of the period, last week not included. ] [ if greater? start-date end-date [ use [tmp-date [date!]] [ tmp-date: end-date end-date: start-date start-date: tmp-date ] ] nb-of-holidays: 0 if holidays [ ; Computes the number of holidays within the period foreach item dates [ if all [ date? item lesser-or-equal? item/weekday 5 ; saturday and sunday are not holidays, but weekend days greater-or-equal? item start-date lesser-or-equal? item end-date ][ nb-of-holidays: add nb-of-holidays 1 ] ] ] ; number of non weekend days during the first week of the period first-week-nwd: multiply to-integer lesser-or-equal? start-date/weekday 5 add 1 subtract 5 start-date/weekday ; number of non weekend days during the last week of the period last-week-nwd: either lesser-or-equal? end-date/weekday 5 [ end-date/weekday ] [5] ; the first monday of the period, first week not included. first-monday: add start-date add 1 subtract 7 start-date/weekday ; the last friday of the period, last week not included. last-friday: subtract end-date add 2 end-date/weekday non-weekend-days: either greater? last-friday first-monday [ diff-in-weeks: to-integer divide add 1 subtract last-friday first-monday 7 add first-week-nwd add last-week-nwd add 5 multiply 5 diff-in-weeks ] [ subtract add first-week-nwd last-week-nwd multiply 5 to-integer equal? subtract end-date/weekday start-date/weekday subtract end-date start-date ; start-date and end-date are in the same week! ] ; return value subtract non-weekend-days nb-of-holidays ] work-day: function [ { Returns the day which is @days working days from the @start-date. Weekends and holidays optionally supplied in @dates are respected. } start-date [date!] days [integer!] /holidays dates [block!] ] [ weekend-days [integer!] end-date [date!] days-gap [integer!] ] [ if not holidays [ dates: make block! [] ] weekend-days: multiply 2 subtract to-integer divide days 5 to-integer equal? remainder days 5 0 end-date: add start-date add days weekend-days days-gap: add 1 subtract absolute days net-work-days/holidays start-date end-date dates while [ not-equal? days-gap 0 ] [ end-date: either positive? days [add end-date days-gap] [subtract end-date days-gap] days-gap: add 1 subtract absolute days net-work-days/holidays start-date end-date dates ] if negative? days [ while [found? find dates end-date] [ end-date: add end-date 1 ] ] ; return value end-date ]
halt ;; to terminate script if DO'ne from webpage
Notes