In MS excel, a date is also represented as a numeric value, with 1-Jan-1900 as the first day. Also in VBA there are dateAdd and dateDiff functions. dateAdd adds a given unit (day, month quarter or a year) to a date. dateDiff returs the difference between the numeric values of two dates. I have written a scheme code in DrRacket to implement these operations. In my code, all dates are represented in the form of a list where the format is (list month day year). date-hash function returs the numeric value of a date. dateAdd and dateDiff do the addition and subtraction. Note: - It is assumed that the user will supply valid dates(i.e I have not checked what happens when user gives values like '(2 31 1999) for a date).
#lang racket
;;List of dates in a normal year and a leap year
(define normal-year-days '((1 31) (2 28) (3 31) (4 30) (5 31) (6 30) (7 31) (8 31) (9 30) (10 31) (11 30) (12 31)))
(define leap-year-days '((1 31) (2 29) (3 31) (4 30) (5 31) (6 30) (7 31) (8 31) (9 30) (10 31) (11 30) (12 31)))
;;all dates are in the form of a list--(list month day year)
;;Contract: month-part:date:number
;;Purpose: To find the month part of a date
;;Example: (month-part '(12 31 2000)) should produce 12
;;Definition:
(define (month-part dt)
(car dt))
;;Contract: day-part:date:number
;;Purpose: To find the day part of a date
;;Example: (day-part '(12 31 2000)) should produce 31
;;Definition:
(define (day-part dt)
(car (cdr dt)))
;;Contract: year-part:date:number
;;Purpose: To find the year part of a date
;;Example: (year-part '(12 31 2000)) should produce 2000
;;Definition:
(define (year-part dt)
(car (cdr (cdr dt))))
;;Contract: is-leap?:number:boolean
;;Purpose: To find whether a year is leap
;;Example: (is-leap? 2000) should produce #t,
;; : (is-leap? 1900) should produce #f
;;Definition:
(define is-leap?
(lambda (yyyy)
(cond ((not (= (remainder yyyy 4) 0)) #f)
(else
(if (= (remainder yyyy 400) 0)
#t
(not (= (remainder yyyy 100) 0)))))))
;;Contract: find-days-from-list:number list:number
;;Purpose: To fetch the no of days in a month from the two lists defined above
;;Example: (find-days-from-list 2 normal-year-days) should produce 28
;;Definition:
(define (find-days-from-list m days-list)
(if (= m (car (car days-list)))
(car (cdr (car days-list)))
(find-days-from-list m (cdr days-list))))
;;Contract: days-in-mon:number number:number
;;Purpose: To fetch the no of days in the given month of the given year
;;Example: (days-in-mon 2 2000) should produce 29
;;Definition:
(define (days-in-mon m y)
(if (is-leap? y)
(find-days-from-list m leap-year-days)
(find-days-from-list m normal-year-days)))
;;Contract: days-in-year:number:number
;;Purpose: To fetch the no of days in the given year
;;Example: (days-in-year 2000) should produce 366
;;Definition:
(define (days-in-year y)
(if (is-leap? y)
366
365))
;;Contract: date-hash:date :number
;;Purpose: To convert a date to a number (i.e number of days since 1-Jan-1900)
;;Example: (date-hash '(1 1 1900)) should produce 1,
;; : (date-hash '(12 31 2000)) should produce 36890
;;Definition:
(define (date-hash dt)
(let ((dd (day-part dt))
(mm (month-part dt))
(yyyy (year-part dt)))
(letrec ((iter (lambda (m d y hash)
(if (= y yyyy)
(if (= m mm)
(if (= d dd)
hash
(iter m (+ 1 d) y (+ 1 hash)))
(iter (+ 1 m) d y (+ (days-in-mon m y) hash)))
(iter m d (+ y 1) (+ (days-in-year y) hash))))))
(iter 1 1 1900 1))))
;;Contract: increment-date:date :date
;;Purpose: To find the next date
;;Example: (increment-date '(1 1 1903)) should produce '(1 2 1903),
;; : (increment-date '(12 31 2000)) should produce '(1 1 2001)
;;Definition:
(define (increment-date dt)
(let ((day (day-part dt))
(month (month-part dt))
(year (year-part dt)))
(cond ((and (= month 12) (= day 31)) (cons 1 (cons 1 (cons (+ 1 year) '()))))
((last-date-of-month? month day year) (cons (+ 1 month) (cons 1 (cons year '()))))
(else (cons month (cons (+ 1 day) (cons year '())))))))
;;Contract: last-date-of-month?:number number number :boolean
;;Purpose: To determine whether a given date is the last day of the month
;;Example: (last-date-of-month? 2 29 2000) should produce #t,
;; : (last-date-of-month? 2 28 2000) should produce #f
;;Definition:
(define (last-date-of-month? m d y)
(if (is-leap? y)
(= d (find-days-from-list m leap-year-days))
(= d (find-days-from-list m normal-year-days))))
;;Contract: dateAdd:symbol(either 'd, 'm, or 'y) number date:date
;;Purpose: To add given number of days, months or years(unit * multiplier) to a date
;;Example: (dateAdd 'd 3 '(2 29 2000)) should produce '(3 3 2000),
;; : (dateAdd 'm 7 '(7 31 1999)) should produce '(2 29 2000)
;; : (dateAdd 'm 7 '(7 28 1999)) should produce '(2 28 2000)
;; : (dateAdd 'y 2 '(2 29 2000)) should produce '(2 28 2002)
;;Definition:
(define (dateAdd unit multiplier prev-date)
(cond ((equal? unit 'd) (add-days multiplier prev-date))
((equal? unit 'm) (add-month-or-year multiplier prev-date 'm))
((equal? unit 'y) (add-month-or-year multiplier prev-date 'y))
(else (error "symbol not identified"))))
;;Contract: add-days:number date:date
;;Purpose: To add given number of days (multiplier) to a date
;;Example: (add-days 3 '(2 29 2000)) should produce '(3 3 2000))
;;Definition:
(define (add-days mult dt)
(if (= mult 0)
dt
(add-days (- mult 1) (increment-date dt))))
;;Contract: add-month-or-year:number date symbol(either 'm or 'y):date
;;Purpose: To add given number of months or year (multiplier) to a date
;;Example: (add-month-or-year 3 '(11 31 1999) 'm) should produce '(2 29 2000))
;; : (add-month-or-year 3 '(3 31 1999) 'm) should produce '(6 30 1999))
;; : (add-month-or-year 3 '(2 28 1997) '9) should produce '(2 28 2000))
;;Definition:
(define (add-month-or-year mult dt unit)
(let* ((month-sum (+ mult (month-part dt)))
(next-year
(if (equal? unit 'm)
(+ (quotient month-sum 12) (year-part dt))
(+ mult (year-part dt))))
(next-month
(if (equal? unit 'm)
(remainder month-sum 12)
(month-part dt)))
(next-day (day-part dt))
(last-day-of-next-month (days-in-mon next-month next-year)))
(if (> next-day last-day-of-next-month)
(cons next-month (cons last-day-of-next-month (cons next-year '())))
(cons next-month (cons next-day (cons next-year '()))))))
;;Contract: dateDiff :date date: number
;;Purpose: To find the number of days between two days(date1 - date 2, the least expected date is '(1 1 1900))
;;Example: (dateDiff '(2 29 2000) '(6 15 1965)) 12677
(define (dateDiff dt1 dt2)
(- (date-hash dt1) (date-hash dt2)))
