TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Lee Mac on May 10, 2012, 07:25:35 PM

Title: -={ Challenge }=- Doomsday Algorithm
Post by: Lee Mac 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"
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: 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

Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: 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.

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. )

Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: Lee Mac on May 11, 2012, 06:03:49 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  :-)
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: Lee Mac on May 11, 2012, 06:05:37 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.
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: pBe 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  (http://"http://en.wikipedia.org/wiki/Determination_of_the_day_of_the_week")

EDIT: to follow new format  :-D ADJUSTED Leap Year
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: Lee Mac on May 11, 2012, 07:01:27 AM
Implementing Zeller's congruence (http://en.wikipedia.org/wiki/Zeller%27s_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. )
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: 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. )
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: David Bethel 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 (http://www.andor.net/ftp/ftp1/Program_masters/ACAD/BONUS/CADTOOLS/julian.lsp)
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: Lee Mac on May 11, 2012, 07:42:13 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 :-)
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: 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"
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: ElpanovEvgeniy on May 11, 2012, 09:25:13 AM
Calendar for year 1812 (http://www.timeanddate.com/calendar/?year=1812&country=9)

Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: Lee Mac on May 11, 2012, 09:29:54 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 (http://www.wolframalpha.com/input/?i=20.02.1812)
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: Lee Mac 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"
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: pBe on May 11, 2012, 09:37:09 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 (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>>>  :-)
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: ElpanovEvgeniy on May 11, 2012, 09:49:11 AM
Code - Auto/Visual Lisp: [Select]
  1. (defun ee_getday (y m d / a)
  2.   (setq y (- y (setq a (/ (- 14 m) 12))))
  3.   (nth (rem (+ d y (/ y 4) (/ y -100) (/ y 400) (/ (* 31 (+ m (* 12 a) -2)) 12)) 7)
  4.        '("Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday")
  5.   )
  6. )
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: Lee Mac on May 11, 2012, 09:54:59 AM
 8-)

Code: [Select]
_$ (keith_doomsday 1812 2 20)
"Thursday"
_$ (pBe_getday 1812 2 20)
"Thursday"
_$ (lm:getday 1812 2 20)
"Thursday"
_$ (ee_getday 1812 2 20)
"Thursday"

Code - Auto/Visual Lisp: [Select]
  1. Benchmarking ..................Elapsed milliseconds / relative speed for 32768 iteration(s):
  2.  
  3.     (EE_GETDAY 1812 2 20)..........1155 / 2.88 <fastest>
  4.     (LM:GETDAY 1812 2 20)..........1170 / 2.84
  5.     (KEITH_DOOMSDAY 1812 2 20).....1248 / 2.66
  6.     (PBE_GETDAY 1812 2 20).........3323 / 1 <slowest>

It wouldn't be right if Evgeniy wasn't at the top :lol:
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: ElpanovEvgeniy on May 11, 2012, 10:08:10 AM
Code - Auto/Visual Lisp: [Select]
  1. _$
  2. Benchmarking ...................Elapsed milliseconds / relative speed for 65536 iteration(s):
  3.  
  4.     (LEE_GETDAY 2012 5 11).....1513 / 1 <fastest>
  5.     (EE_GETDAY 2012 5 11)......1513 / 1 <slowest>
  6.  
  7.  
  8. _$
:-)
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: ElpanovEvgeniy on May 11, 2012, 10:17:00 AM
It wouldn't be right if Evgeniy wasn't at the top :lol:

Why?   8-)
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: Lee Mac on May 11, 2012, 10:24:42 AM
It wouldn't be right if Evgeniy wasn't at the top :lol:

Why?   8-)

Because we measure the awesomeness of our codes on a scale from 0 to Evgeniy  8-)
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: ElpanovEvgeniy on May 11, 2012, 10:45:26 AM
Now, my code was very similar to yours!  :-D
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: LE3 on May 11, 2012, 12:24:29 PM
after to much lurking... here is something extracted from one of my old classes arxKey - just to put a little pepper on the lisp salad.-
Code - C++: [Select]
  1. // returns same left value as:
  2. // acedGetVar(_T("DATE"), &rb)
  3. // acdbRToS(r, 2, 12, fmtval);
  4. long JulianDayNumber (int y, int m, int d)
  5. {
  6.         if (m < 3) { y--; m += 12; }
  7.         y += 8000;
  8.         return (y * 365) + (y / 4) - (y / 100) + (y / 400) + (m * 153 + 3) / 5 - 92 + d - 1 - 1200820;
  9. }
  10. [code]
  11. [code=cpp]
  12. static void LESQ_TST(void)
  13. {
  14.         //long val = JulianDayNumber(2012, 5, 11);
  15.         long val = JulianDayNumber(1812, 2, 20);
  16.         int dayOfWeek = val % 7 + 1;
  17.         AcString day;
  18.         switch (dayOfWeek)
  19.         {
  20.         case 1: day = _T("Monday"); break;
  21.         case 2: day = _T("Tuesday"); break;
  22.         case 3: day = _T("Wendsday"); break;
  23.         case 4: day = _T("Thursday"); break;
  24.         case 5: day = _T("Friday"); break;
  25.         case 6: day = _T("Saturday"); break;
  26.         case 7: day = _T("Sunday"); break;
  27.         }
  28.         acutPrintf (_T("\nDay of the week[%s] \n"), day.kACharPtr());
  29. }
  30.  
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: Keith™ on May 11, 2012, 12:34:51 PM
You know this is so much easier in C++ or C#
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: Lee Mac on May 11, 2012, 05:19:29 PM
You know this is so much easier in C++ or C#

Indeed, a single line. (http://en.wikipedia.org/wiki/Determination_of_the_day_of_the_week#Implementation-dependent_methods_of_Sakamoto.2C_Lachman.2C_Keith_and_Craver)  :-o
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: LE3 on May 11, 2012, 05:29:15 PM
^ indeed for many things - but not for everything (at least in c++) - per all the stuff i have done so far..
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: Keith™ on May 12, 2012, 12:55:02 AM
I was thinking more on the lines of creating a time struct, passing the date values then outputting the day.
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: Kerry on May 12, 2012, 03:53:47 AM
Almost a one-liner :)
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: Lee Mac on May 12, 2012, 08:21:49 AM
Very nice Kerry - out of interest, can that method handle dates occurring before 1900 (as per Evgeniy's example), as I know that is a limitation for some systems.

Also, I like your VS colour scheme, though not sure about the 'blue screen of death' style console  :lol:

Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: Kerry on May 12, 2012, 08:20:53 PM

Quote
The DateTime value type represents dates and times with values ranging from 12:00:00 midnight, January 1, 0001 Anno Domini (Common Era) through 11:59:59 P.M., December 31, 9999 A.D. (C.E.).



Yes, I like that colour Scheme. http://www.theswamp.org/index.php?topic=41700.msg468090#msg468090

The 'Blue Screen' is just me being rebellious :)

Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: Lee Mac on May 13, 2012, 05:53:12 AM
Excellent  8-)
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: AIberto on July 08, 2015, 08:49:49 AM
Excellent  8-)


Dear Lee
I know the current Date  20150708 ,  3 days later is 20150711
I want know the Date at 200 days later... , How write this ?
Thanks.
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: Lee Mac on July 08, 2015, 01:17:17 PM
I know the current Date  20150708 ,  3 days later is 20150711
I want know the Date at 200 days later... , How write this ?

This is probably the easiest way:
Code - Auto/Visual Lisp: [Select]
  1. (menucmd "m=$(edtime,$(+,$(getvar,date),200),YYYYMODD)")
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: AIberto on July 09, 2015, 02:49:13 AM
I know the current Date  20150708 ,  3 days later is 20150711
I want know the Date at 200 days later... , How write this ?

This is probably the easiest way:
Code - Auto/Visual Lisp: [Select]
  1. (menucmd "m=$(edtime,$(+,$(getvar,date),200),YYYYMODD)")

Lee, Inconceivable! 

The current Date is Local time ?  Can I use your  Internet time function ? (LM:InternetTime "YYYYMODD")

Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: Lee Mac on July 09, 2015, 06:45:24 AM
I know the current Date  20150708 ,  3 days later is 20150711
I want know the Date at 200 days later... , How write this ?

This is probably the easiest way:
Code - Auto/Visual Lisp: [Select]
  1. (menucmd "m=$(edtime,$(+,$(getvar,date),200),YYYYMODD)")

Lee, Inconceivable! 

The current Date is Local time ?  Can I use your  Internet time function ? (LM:InternetTime "YYYYMODD")

Yes  :-)
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: AIberto on July 09, 2015, 07:07:38 AM
Lee ,Thanks,
But
like this ?
(menucmd "m=$(edtime,$(+,$(getvar,date),200),YYYYMODD)")
==>
(menucmd "m=$(edtime,$(+,(LM:InternetTime "YYYYMODD"),200),YYYYMODD)")

? ERROR
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: Lee Mac on July 09, 2015, 08:43:40 AM
No, you will need to either retrieve the Julian Date from the internet time server, add 200, and pass it to the edtime DIESEL function; or convert the date returned by my LM:InternetTime function to a Julian Date, before adding 200 and passing the resulting value to the edtime DIESEL function.

Lee
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: AIberto on July 09, 2015, 09:45:11 AM
No, you will need to either retrieve the Julian Date from the internet time server, add 200, and pass it to the edtime DIESEL function; or convert the date returned by my LM:InternetTime function to a Julian Date, before adding 200 and passing the resulting value to the edtime DIESEL function.

Lee

Sorry , Lee , I can't understand.
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: AIberto on July 09, 2015, 08:29:46 PM
Lee , I think I understand that "Julian Date " 
Thank you.

1.Manual Conversion
http://www.iasfbo.inaf.it/~mauro/JD/
DD/MM/YYYY 10/7/2015
==> Julian Day
2457214

_1$ (menucmd "m=$(edtime,$(+,2457214,200),YYYYMODD)")
"20160126"

2.  Conversion by function
_$ (setq tm (LM:InternetTime "YYYYMODD"))
"20150710"

_$ (setvar "userr1" (DTOJ (atof tm)));;  convert the date returned by LM:InternetTime function to a Julian Date
2.45721e+006

_$ (menucmd "m=$(edtime,$(+,$(getvar,userr1),200),YYYYMODD)")
"20160126"
_$

Lee, any suggest ? Thank you.
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: roy_043 on July 10, 2015, 04:01:14 AM
Tip: Use strcat to build the string for menucmd...
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: AIberto on July 10, 2015, 11:39:47 AM
Tip: Use strcat to build the string for menucmd...

?? example ?
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: Kerry on July 10, 2015, 10:20:52 PM
STRCAT
http://www.theswamp.org/~john/avlisp/#strcat
http://help.autodesk.com/view/ACD/2016/ENU/?guid=GUID-4430B1BF-DBB5-49D1-98F9-711B480976A1

What do you want the result to look like ?
What component pieces do you want to assemble ?
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: roy_043 on July 11, 2015, 04:06:34 AM
Tip: Use strcat to build the string for menucmd...

?? example ?
Code - Auto/Visual Lisp: [Select]
  1. (setq tm (LM:InternetTime "YYYYMODD"))
  2. (setq tm (DTOJ (atof tm)))
  3.   (strcat
  4.     "m=$(edtime,$(+,"
  5.     (rtos tm 2 0)
  6.     ",200),YYYYMODD)"
  7.   )
  8. )
Title: Re: -={ Challenge }=- Doomsday Algorithm
Post by: AIberto on July 11, 2015, 04:58:46 AM
Tip: Use strcat to build the string for menucmd...

?? example ?
Code - Auto/Visual Lisp: [Select]
  1. (setq tm (LM:InternetTime "YYYYMODD"))
  2. (setq tm (DTOJ (atof tm)))
  3.   (strcat
  4.     "m=$(edtime,$(+,"
  5.     (rtos tm 2 0)
  6.     ",200),YYYYMODD)"
  7.   )
  8. )


Very thanks ,roy , This is a good idea.  :laugh: