0
\$\begingroup\$

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)))
\$\endgroup\$
2
\$\begingroup\$

I don’t have many or deep comments, but since there aren’t any answers yet, here are mine, for what they’re worth.

You have a lot of chains of calls to car and cdr. I would tend to use the c*r shortcuts instead. And when possible, I’d use first, second, third, etc. instead. e.g. Instead of...

(define (year-part dt)
  (car (cdr (cdr dt))))

...I would have written...

(define year-part caddr)

...or...

(define year-part third)

Also, when you just need an alias for an existing function, you can use define to create one rather than wrapping it in another function. (I didn’t test that with Racket, but I use it in other Schemes, and I’m pretty sure I’ve done it in Racket too.)

Likewise, you use chains of cons where I would’ve used the list function or quasiquotation. e.g. Instead of…

(cons 1 (cons 1 (cons (+ 1 year) '())))

…I would’ve written…

(list 1 1 (+ 1 year))

...or...

`(1 1 ,(+ 1 year))
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.