(require (lib "frtime.ss" "frtime")
         (lib "list.ss")
         (lib "etc.ss"))


;// Absolute dates
;
;// "Absolute date" means the number of days elapsed since the Gregorian date
;// Sunday, December 31, 1 BC. (Since there was no year 0, the year following
;// 1 BC is 1 AD.) Thus the Gregorian date January 1, 1 AD is absolute date
;// number 1.
;
;// Absolute date of the x-day on or before absolute date d.
;// x=0 means Sunday, x=1 means Monday, and so on. 


(define (Kday-on-or-before d k)
  (- d (remainder (- d k) 7)))


;leap-year : number -> boolean
(define (leap-year? year)
  (or 
   (and (= (remainder year 4) 0) (not (= (remainder year 100)  0)))
   (= (remainder year 400) 0)) )

;(leap-year? 1988) true
;(leap-year? 1900) false
;(leap-year? 2000) true


;last-day-of-gregorian-month : number number -> number [1..31]
;determines the last day of a given month and year.
(define (last-day-of-gregorian-month month year)
  (let ((year (inexact->exact (truncate year))))
    ;// Compute the last date of the month for the Gregorian calendar.
    (case month
      ((2) (if (leap-year? year) 29 28))
      ((4 6 9 11) 30)
      (else 31))))

;(LastDayOfGregorianMonth 8 2006) 31
;(LastDayOfGregorianMonth 9 2006) 30
;(LastDayOfGregorianMonth 10 2006) 31
;(LastDayOfGregorianMonth 11 2006) 30
;(LastDayOfGregorianMonth 12 2006) 31
;(LastDayOfGregorianMonth 1 2007) 31
;(LastDayOfGregorianMonth 2 2007) 28



;gregorian->absolute : (list number number number) -> number
; Computes the absolute date from the Gregorian date
(define (gregorian->absolute gregorian) ; Computes the absolute date from the Gregorian date.
  (let* (
         (day (car gregorian))
         (year (caddr gregorian))
         (months (filter (lambda(m) (< m (cadr gregorian))) (build-list 12 (lambda(x) (+ x 1))))) 
         (N (foldr (lambda(m y) (+ (last-day-of-gregorian-month m year) y)) day months))
         )
    
    (+ 
     N                   ;// days this year
     (* 365 (- year  1))   ;// days in previous years ignoring leap days
     (quotient (- year 1) 4 )      ; // Julian leap days before this year...
     (* -1 (quotient (- year 1) 100))     ;// ...minus prior century years...
     (quotient (- year 1) 400));   // ...plus prior years divisible by 400
    )
  )
(define date1 (gregorian->absolute '(1 1 2007))) 
(define date2 (gregorian->absolute '(29 1  2007)))
(define date3 (gregorian->absolute '(28  2 2006)))
(define date4 (gregorian->absolute '(1 3 2006)))
(define date5 (gregorian->absolute '(14 3 2007)))
(define date6 (gregorian->absolute '(28 6 2006)))
(define date7 (gregorian->absolute '(5 9 2006)))
(define date8 (gregorian->absolute '(12 12 2006)))
(define date9 (gregorian->absolute '(31 12 2006)))




(define (Nth-Kday n k month year)
  ;; Absolute date of the $n$th $k$day in Gregorian $month$, $year$.
  ;; If $n$<0, the $n$th $k$day from the end of month is returned
  ;; (that is, -1 is the last $k$day, -2 is the penultimate $k$day,
  ;; and so on).  $k=0$ means Sunday, $k=1$ means Monday, and so on.
  (if (> n 0)
      ;; Then return
      (+ (Kday-on-or-before             ;; First $k$day in month.
          (gregorian->absolute (list 7 month year))
          k)
         (* 7 (sub1 n)))                  ;; Advance $n-1$ $k$days.
      ;; Else return
      (+ (Kday-on-or-before             ;; Last $k$day in month.
          (gregorian->absolute
           (list 
            (last-day-of-gregorian-month month year)
            month
            year))
          k)
         (* 7 (add1 n)))))

;(absolute->gregorian (Nth-Kday 1 1 9 2006)) '(4 9 2006)
;(absolute->gregorian (Nth-Kday 2 2 9 2006)) '(12 9 2006)
;(absolute->gregorian (Nth-Kday -1 1 5 2007)))

(define (absolute->year date year)
  (cond
    [(< date (gregorian->absolute (list 1 1 (+ year 1)))) year]
    [(>= date (gregorian->absolute (list 1 1 (+ year 1)))) (absolute->year date (add1 year))])) 

(define (absolute->month  d month year)
  (cond
    [(<= d (gregorian->absolute (list  (last-day-of-gregorian-month month year) month year))) month]
    [else
     (absolute->month d (add1 month) year)]))


(define (absolute->day d month year)
  (+ (- d (gregorian->absolute (list 1 month year))) 1))


(define (absolute->gregorian d)
  (let* (
         (approximate-year  (quotient d 366))
         (year (absolute->year d approximate-year))
         (month (absolute->month d 1 year))
         (day (absolute->day d month year))
         )
    (list day month year)))

;converts seconds to a (list day month year)
(define (now->gregorian)
  (let ((today (seconds->date seconds)))
    (list
     (date-day today)
     (date-month today)
     (date-year today))))

(now->gregorian) ;this is a list of day month year for today's date
(list 19 12 2006) ;this is a list of day month year for today's date as well
(gregorian->absolute (list 19 12 2006)) ;this returns a value...
(gregorian->absolute (now->gregorian)) ;this returns a different value...
;The problem is that given identical inputs, my program produces different outputs...