friday the 13 calculator

gistfile1.rkt

#lang racket

; stream stuff
(define (make-stream proc init)
  (cons proc init))

(define (eval-stream s)
  (cdr s))

(define (next-stream s)
  (let ([proc (car s)]
        [init (cdr s)])
    (make-stream proc (proc init))))

(define (takeWhile pred s)
  (let ([val (eval-stream s)])
    (if (pred val)
        (cons val (takeWhile pred (next-stream s)))
        `())))

; date stuff
(define (dow-list lst)
  (dow (car lst) (cadr lst) (caddr lst)))
(define (dow year m d)
  (let* ([t `(0, 3, 2, 5, 0, 3, 5, 1, 4, 6, 2, 5)]
         [days `(`Sunday, `Monday, `Tuesday, `Wednesday, `Thursday, `Friday, `Saturday)]
         [y (if (< m 3)
               (sub1 year)
               year)]
         [day-number (modulo (- (+ y
                                   (truncate (/ y 4))
                                   (truncate (/ y 400))
                                   (list-ref t (sub1 m))
                                   d)
                                (truncate (/ y 100)))
                             7)])
    (list-ref days day-number)))

(define (isleapyear? year)
  (if (eq? (modulo year 4) 0)
      (if (eq? (modulo year 100) 0)
          (eq? (modulo year 400) 0)
          #t)
      #f))

(define (febdays year)
  (if (isleapyear? year)
      29
      28))

(define (nextday day)
  (let* ([d (third day)]
            [m (second day)]
            [y (first day)]
            [days (list 31 (febdays y) 31 30 31 30 31 31 30 31 30 31)]
            [daysinmonth (list-ref days (sub1 m))])
       (if (eq? d daysinmonth)
           (if (eq? m 12)
               (list (add1 y) 1 1)
               (list y (add1 m) 1))
           (list y m (add1 d)))))

(define (dateStreamMaker start-date)
  (make-stream nextday start-date))

(define (lessThanDate day1 day2)
  (let ([y1 (first day1)] [m1 (second day1)] [d1 (third day1)]
        [y2 (first day2)] [m2 (second day2)] [d2 (third day2)])
    (if (< y1 y2)
        #t
        (if (> y1 y2)
            #f
            (if (< m1 m2)
                #t
                (if (> m1 m2)
                    #f
                    (< d1 d2)))))))

(define (friday-13s start-date end-date)
  (let* ([datestream (dateStreamMaker start-date)]
         [final-date (nextday end-date)]
         [datepred (lambda (day) (lessThanDate day final-date))]
         [fri13pred (lambda (day) (and (eq? (third day) 13) (eq? (dow-list day) `Friday)))])
    (filter fri13pred (takeWhile datepred datestream))))