Newsgroups: comp.lang.dylan
Path: cantaloupe.srv.cs.cmu.edu!rochester!udel!news.mathworks.com!news.alpha.net!uwm.edu!lll-winken.llnl.gov!ames!cnn.nas.nasa.gov!cnn!raible
From: raible@nas.nasa.gov (Eric Raible)
Subject: Re: day of week algorithm
In-Reply-To: Ted Lowery's message of 27 Feb 1995 15:08:35 GMT
Message-ID: <RAIBLE.95Feb27170320@win57.nas.nasa.gov>
Sender: news@cnn.nas.nasa.gov (News Administrator)
Nntp-Posting-Host: win57.nas.nasa.gov
Reply-To: raible@nas.nasa.gov
Organization: Applied Research Office, NASA Ames Research Center
References: <3isptj$8hg@brtph500.bnr.ca>
Date: Tue, 28 Feb 1995 01:03:20 GMT
Lines: 51


In article <3isptj$8hg@brtph500.bnr.ca> Ted Lowery <ted.lowery@nt.com> writes:

   Hi all-

   Anybody out there know the algorithm to calculate the day of the
   week from a date.  I remember from college days there is a formula, 
   but I cannot seem to find it.

You get extra points if you figure out how this works.
I got the algorithm from John Conway (the mathematician)
who can do the calculation for any arbitrary data in about
a second or so.

- Eric

(define (day-of-week-for-last-day-in-feb year)
  (if (< year 1900)
    (error "Too early"))
  (let* ((from-1900       (- year 1900))
	 (12-year-spans   (quotient from-1900 12))
	 (extra           (modulo from-1900 12))
	 (leap-year-count (quotient extra 4)))
    (modulo (+ 12-year-spans
	       extra
	       leap-year-count
	       3) ; Feb 28, 1900 was a wednesday
	    7)))

(define (leap-year? year)
  (if (zero? (modulo year 4))
    (if (zero? (modulo year 100))
      (zero? (modulo year 400))
      #t)))

(define (same-day-as-last-day-in-feb month year)
  (list-ref
   (if (leap-year? year)
     ; 1  2  3  4  5  6  7  8  9  10 11 12
     '(4 29  7  4  9  6 11  8  5  10  7 12)
     '(3 28  7  4  9  6 11  8  5  10  7 12))
   (- month 1)))

(define (day-of-week month day-of-month year)
  (let ((num1 (day-of-week-for-last-day-in-feb year))
	(num2 (same-day-as-last-day-in-feb month year)))
    (list-ref '(sun mon tue wed thu fri sat)
	      (modulo (+ 28
			 (- day-of-month num2)
			 num1)
		      7))))
