« previous next »
Pages: [1] 2 3  All |   Go Down

Author Topic: -={ Challenge }=- Doomsday Algorithm  (Read 12915 times)

0 Members and 1 Guest are viewing this topic.

Lee Mac

  • Seagull
  • Posts: 12913
  • London, England
-={ Challenge }=- Doomsday Algorithm
« on: May 10, 2012, 07:25:35 PM »
The Challenge:

Write a function:

Code - Auto/Visual Lisp: [Select]
  1. (_getday YYYY MM DD)

Where:

YYYY = four digit year
  MM = month
  DD = day

To return the day of the week for the given date.

Example:

Code - Auto/Visual Lisp: [Select]
  1. (_getday 2012 5 11)
  2. "Friday"
« Last Edit: May 11, 2012, 06:13:46 AM by Lee Mac »
Logged

pBe

  • Bull Frog
  • Posts: 402
Re: -={ Challenge }=- Doomsday Algorithm
« Reply #1 on: May 11, 2012, 02:42:24 AM »
Does it have to be a unique algorithm and not like the known ones listed elsewhere?  :-D

Logged

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Re: -={ Challenge }=- Doomsday Algorithm
« Reply #2 on: May 11, 2012, 03:27:06 AM »
Ok, this isn't the prettiest, but it is functional and I have included two variations to get the longday.

Code - Auto/Visual Lisp: [Select]
  1. (defun doomsday (yyyy mm dd)
  2.   ;;Calculate years for Julian Date
  3.   (setq y (+ yyyy
  4.              (if (< mm 3)
  5.                4799
  6.                4800
  7.              )
  8.           )
  9.  
  10.   )
  11.   ;;Calculate days for Julian Date
  12.   (setq jdn (- (+ dd
  13.                   (fix (/ (+ (* 153
  14.                                 (if (< 2 mm)
  15.                                   (- mm 3)
  16.                                   (+ mm 9)
  17.                                 )
  18.                              )
  19.                              2
  20.                           )
  21.                           5
  22.                        )
  23.                   )
  24.                   (* 365 y)
  25.                   (fix (/ y 4))
  26.                   (fix (/ y 400))
  27.                )
  28.                (fix (/ y 100))
  29.                32045
  30.             )
  31.   )
  32.   ;;Day of the week is modulus(Julian 7)
  33.   ;;Monday = 0
  34.   (setq DDDD (rem jdn 7))
  35.   (cond
  36.     ((= DDDD 0)"Monday")
  37.     ((= DDDD 1)"Tuesday")
  38.     ((= DDDD 2)"Wednesday")
  39.     ((= DDDD 3)"Thursday")
  40.     ((= DDDD 4)"Friday")
  41.     ((= DDDD 5)"Saturday")
  42.     ((= DDDD 6)"Sunday")
  43.   )
  44.   ;;Another method to obtain the day of week using DIESEL
  45. ;;;(setq DDDD (menucmd (strcat "M=$(edtime," (rtos jdn 2 0) ",DDDD - M/DD/YYYY)")))
  46. ;;;DDDD
  47. )

Logged
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

Lee Mac

  • Seagull
  • Posts: 12913
  • London, England
Re: -={ Challenge }=- Doomsday Algorithm
« Reply #3 on: May 11, 2012, 06:03:49 AM »
Quote from: pBe on May 11, 2012, 02:42:24 AM
Does it have to be a unique algorithm and not like the known ones listed elsewhere?  :-D

If you can concoct a unique and original algorithm for the problem then post away!  8-)

Just a bit of fun, you can tackle the problem as you wish  :-)
Logged

Lee Mac

  • Seagull
  • Posts: 12913
  • London, England
Re: -={ Challenge }=- Doomsday Algorithm
« Reply #4 on: May 11, 2012, 06:05:37 AM »
Quote from: Keith™ on May 11, 2012, 03:27:06 AM
Ok, this isn't the prettiest, but it is functional and I have included two variations to get the longday.

Nice one Keith - I thought it likely someone may opt for the conversion to Julian over coding Conway's Doomsday Algorithm  :-)

BTW, good call on the separate arguments over a list - not sure what I was thinking there - I may alter the first post to reflect this.
« Last Edit: May 11, 2012, 06:12:22 AM by Lee Mac »
Logged

pBe

  • Bull Frog
  • Posts: 402
Re: -={ Challenge }=- Doomsday Algorithm
« Reply #5 on: May 11, 2012, 06:07:44 AM »
Not pretty at all.
Code - Auto/Visual Lisp: [Select]
  1. (defun _getday  (yrl mn dy / x m yrl)
  2.       (setq x  (vl-some
  3.                       '(lambda (x)
  4.                              (if (<= (caadr x) yrl (cadadr x))
  5.                                    x))
  6.                       (list '(4 (1700 1799))
  7.                             '(2 (1800 1899))
  8.                             '(0 (1900 1999))
  9.                             '(6 (2000 2099))
  10.                             '(4 (2100 2199))
  11.                             '(2 (2200 2299))
  12.                             '(0 (2300 2399))
  13.                             '(6 (2400 2499))
  14.                             '(4 (2500 2599))
  15.                             '(2 (2600 2699)))))
  16.       (setq m (append (if (zerop (+ (rem yrl 4)
  17.                                     (rem yrl 100)))
  18.                             (if (zerop (rem yrl 400))
  19.                                   '((1 6) (2 2))
  20.                                   '((1 0) (2 3)))
  21.                             '((1 6) (2 2)))
  22.                       '((3 3)
  23.                         (4 6)
  24.                         (5 1)
  25.                         (6 4)
  26.                         (7 6)
  27.                         (8 2)
  28.                         (9 5)
  29.                         (10 0)
  30.                         (11 3)
  31.                         (12 5))))
  32.  
  33.       (nth (rem (+ (car x)
  34.                    (setq lt (- yrl (caadr x)))
  35.                    (/ lt 4)
  36.                    (cadr (assoc mn m))
  37.                    dy)
  38.                 7)
  39.            '("Sunday"
  40.              "Monday"
  41.              "Tuesday"
  42.              "Wednesday"
  43.              "Thursday"
  44.              "Friday"
  45.              "Saturday")))
Taken from
A tabular method to calculate the day of the week

EDIT: to follow new format  :-D ADJUSTED Leap Year
« Last Edit: May 11, 2012, 12:33:28 PM by pBe »
Logged

Lee Mac

  • Seagull
  • Posts: 12913
  • London, England
Re: -={ Challenge }=- Doomsday Algorithm
« Reply #6 on: May 11, 2012, 07:01:27 AM »
Implementing Zeller's congruence:

-- Incorrect code --  remains for thread continuity --
Code - Auto/Visual Lisp: [Select]
  1. (defun _getday ( y m d )
  2.     (if (< m 3) (setq y (1- y)))
  3.     (nth
  4.         (rem (+ d (/ (* 26 (1+ m)) 10) y (/ y 4) (* 6 (/ y 100)) (/ y 400)) 7)
  5.        '("Saturday" "Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday")
  6.     )
  7. )
« Last Edit: May 11, 2012, 09:52:39 AM by Lee Mac »
Logged

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: -={ Challenge }=- Doomsday Algorithm
« Reply #7 on: May 11, 2012, 07:35:44 AM »
Code - Auto/Visual Lisp: [Select]
  1. (defun getday (y m d / a)
  2.   (setq y (- y (setq a (/ (- 14 m) 12))))
  3.   (nth (rem (+ 7001 d y (/ y 4) (/ y -100) (/ y 400) (/ (* 31 (+ m (* 12 a) -2)) 12)) 7)
  4.        '("Saturday" "Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday")
  5.   )
  6. )
Logged

David Bethel

  • Swamp Rat
  • Posts: 656
Re: -={ Challenge }=- Doomsday Algorithm
« Reply #8 on: May 11, 2012, 07:41:26 AM »
AutoCAD included julian.lsp ( 1988-1993 ) in it support folder that has CTOJ ( calender to Julian ) and JTOW ( julian to week ).  But it has all the DONT publish or distribute BS in it.  It is an interesting read though.  -David


PS  Mine has the limits :  This one doesn't seem to have the same :

http://www.andor.net/ftp/ftp1/Program_masters/ACAD/BONUS/CADTOOLS/julian.lsp
Logged
R12 Dos - A2K

Lee Mac

  • Seagull
  • Posts: 12913
  • London, England
Re: -={ Challenge }=- Doomsday Algorithm
« Reply #9 on: May 11, 2012, 07:42:13 AM »
Quote from: ElpanovEvgeniy on May 11, 2012, 07:35:44 AM
Code - Auto/Visual Lisp: [Select]
  1. (defun getday (y m d / a)
  2.   (setq y (- y (setq a (/ (- 14 m) 12))))
  3.   (nth (rem (+ 7001 d y (/ y 4) (/ y -100) (/ y 400) (/ (* 31 (+ m (* 12 a) -2)) 12)) 7)
  4.        '("Saturday" "Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday")
  5.   )
  6. )

Another Julian conversion, nice one Evgeniy :-)
« Last Edit: May 11, 2012, 07:51:10 AM by Lee Mac »
Logged

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: -={ Challenge }=- Doomsday Algorithm
« Reply #10 on: May 11, 2012, 09:07:21 AM »
 :?

Code: [Select]
(setq y 1812 m 2 d 20)
(lee_getday y m d) = "Sunday"
(ee_getday y m d)  = "Tuesday"
(pBe_getday y m d)  = "Friday"
(keith_doomsday y m d)  = "Thursday"
« Last Edit: May 11, 2012, 09:15:23 AM by ElpanovEvgeniy »
Logged

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: -={ Challenge }=- Doomsday Algorithm
« Reply #11 on: May 11, 2012, 09:25:13 AM »
Logged

Lee Mac

  • Seagull
  • Posts: 12913
  • London, England
Re: -={ Challenge }=- Doomsday Algorithm
« Reply #12 on: May 11, 2012, 09:29:54 AM »
Quote from: ElpanovEvgeniy on May 11, 2012, 09:07:21 AM
:?

Code: [Select]
(setq y 1812 m 2 d 20)
(lee_getday y m d) = "Sunday"
(ee_getday y m d)  = "Tuesday"
(pBe_getday y m d)  = "Friday"
(keith_doomsday y m d)  = "Thursday"

Oops!

http://www.wolframalpha.com/input/?i=20.02.1812
Logged

Lee Mac

  • Seagull
  • Posts: 12913
  • London, England
Re: -={ Challenge }=- Doomsday Algorithm
« Reply #13 on: May 11, 2012, 09:36:06 AM »
I forgot that the months are shifted back by two in the Zeller's congruence algorithm:

Code - Auto/Visual Lisp: [Select]
  1. (defun lm:getday ( y m d )
  2.    (if (< m 3) (setq y (1- y) m (+ m 12)))
  3.    (nth (rem (+ d (/ (* 26 (1+ m)) 10) y (/ y 4) (* 6 (/ y 100)) (/ y 400)) 7)
  4.        '("Saturday" "Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday")
  5.    )
  6. )

Code - Auto/Visual Lisp: [Select]
  1. _$ (lm:getday 1812 2 20)
  2. "Thursday"
« Last Edit: May 11, 2012, 09:53:30 AM by Lee Mac »
Logged

pBe

  • Bull Frog
  • Posts: 402
Re: -={ Challenge }=- Doomsday Algorithm
« Reply #14 on: May 11, 2012, 09:37:09 AM »
Quote from: Lee Mac on May 11, 2012, 09:29:54 AM
Quote from: ElpanovEvgeniy on May 11, 2012, 09:07:21 AM
:?

Code: [Select]
(setq y 1812 m 2 d 20)
(lee_getday y m d) = "Sunday"
(ee_getday y m d)  = "Tuesday"
(pBe_getday y m d)  = "Friday"
(keith_doomsday y m d)  = "Thursday"

Oops!

http://www.wolframalpha.com/input/?i=20.02.1812

pBe is sooo BUSTED!  :-D

Code - Auto/Visual Lisp: [Select]
  1. (if (or (zerop (+ (rem yrl 4)
  2.                                         (rem yrl 100)))
  3.                               (zerop (rem yrl 400)))
  4.                             '((1 0) (2 3))'((1 6) (2 2)))

EDIT: oh bummer..
(pBe_getday 2000 1 1) "Sunday" <---
(LM_getday  2000 1 1) "Saturday" <----
(pBe_getday 2000 1 1) "Saturday <--- corrected

<<<pBe Needs an aspirin>>>  :-)
« Last Edit: May 11, 2012, 12:36:23 PM by pBe »
Logged
Pages: [1] 2 3  All |   Go Up
« previous next »