Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: Petr on December 28, 2019, 06:35:48 am

Title: Name of the day of the week
Post by: Petr on December 28, 2019, 06:35:48 am
Name of the day of the week solve this function:

Code: QB64: [Select]
  1. 'function parameters: YEAR, MONTH, DAY
  2.  
  3. Today$ = GETDAYNAME(2019, 12, 28)
  4. PRINT "Today is "; Today$
  5.  
  6.  
  7.  
  8.  
  9.  
  10.  
  11. FUNCTION ISLEAPYEAR (year)
  12.     IF year MOD 4 = 0 AND year MOD 100 THEN ISLEAPYEAR = 1
  13.     IF year MOD 100 = 0 AND year MOD 400 = 0 THEN ISLEAPYEAR = 1
  15.  
  16. FUNCTION GETDAYNAME$ (year, month, day)
  17.     IF year < 1900 THEN GETDAYNAME$ = "Invalid Year ( <1900 ).": EXIT FUNCTION
  18.     'spocitat pocet mesicu od ledna 1900:
  19.     Days = day
  20.     FOR yyr = 1900 TO year
  21.         IF yyr = year THEN monthend = month ELSE monthend = 12
  22.         FOR mont = 1 TO monthend
  23.             IF ISLEAPYEAR(yyr) = 0 THEN
  24.                 SELECT CASE mont
  25.                     CASE 1: m = 31
  26.                     CASE 2: m = 28
  27.                     CASE 3: m = 31
  28.                     CASE 4: m = 30
  29.                     CASE 5: m = 31
  30.                     CASE 6: m = 30
  31.                     CASE 7: m = 31
  32.                     CASE 8: m = 31
  33.                     CASE 9: m = 30
  34.                     CASE 10: m = 31
  35.                     CASE 11: m = 30
  36.                     CASE 12: m = 31
  37.                 END SELECT
  38.             ELSE
  39.                 SELECT CASE mont
  40.                     CASE 1: m = 31
  41.                     CASE 2: m = 29
  42.                     CASE 3: m = 31
  43.                     CASE 4: m = 30
  44.                     CASE 5: m = 31
  45.                     CASE 6: m = 30
  46.                     CASE 7: m = 31
  47.                     CASE 8: m = 31
  48.                     CASE 9: m = 30
  49.                     CASE 10: m = 31
  50.                     CASE 11: m = 30
  51.                     CASE 12: m = 31
  52.                 END SELECT
  53.             END IF
  54.             Om = m
  55.             Days = Days + m
  56.         NEXT
  57.     NEXT
  58.     Days = Days - m - 1
  59.     '  PRINT "Dnu:"; Days
  60.     a = (Days MOD 7) '0 = pondeli
  61.     RESTORE nms
  62.     FOR r = 0 TO a
  63.         READ GETDAYNAME$
  64.     NEXT
  65.     nms:
  66.     DATA Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday
  68.  

You may need to find out which week of the year it is, or determine by which week is according to date. For this I wrote this feature:

Code: QB64: [Select]
  1. 'function parameters: YEAR, MONTH, DAY
  2.  
  3. PRINT "Today is"; GETWEEK(2019, 12, 28); "week in this year."
  4.  
  5.  
  6.  
  7.  
  8.  
  9.  
  10.  
  11. FUNCTION GETWEEK (year, month, day)
  12.     Days = day
  13.     FOR mont = 1 TO month
  14.         IF ISLEAPYEAR(year) = 0 THEN
  15.             SELECT CASE mont
  16.                 CASE 1: m = 31
  17.                 CASE 2: m = 28
  18.                 CASE 3: m = 31
  19.                 CASE 4: m = 30
  20.                 CASE 5: m = 31
  21.                 CASE 6: m = 30
  22.                 CASE 7: m = 31
  23.                 CASE 8: m = 31
  24.                 CASE 9: m = 30
  25.                 CASE 10: m = 31
  26.                 CASE 11: m = 30
  27.                 CASE 12: m = 31
  28.             END SELECT
  29.         ELSE
  30.             SELECT CASE mont
  31.                 CASE 1: m = 31
  32.                 CASE 2: m = 29
  33.                 CASE 3: m = 31
  34.                 CASE 4: m = 30
  35.                 CASE 5: m = 31
  36.                 CASE 6: m = 30
  37.                 CASE 7: m = 31
  38.                 CASE 8: m = 31
  39.                 CASE 9: m = 30
  40.                 CASE 10: m = 31
  41.                 CASE 11: m = 30
  42.                 CASE 12: m = 31
  43.             END SELECT
  44.         END IF
  45.         Om = m
  46.         Days = Days + m
  47.     NEXT
  48.     Days = Days - m
  49.     GETWEEK = _CEIL(Days / 7)
  51.  
  52. FUNCTION ISLEAPYEAR (year)
  53.     IF year MOD 4 = 0 AND year MOD 100 THEN ISLEAPYEAR = 1
  54.     IF year MOD 100 = 0 AND year MOD 400 = 0 THEN ISLEAPYEAR = 1
  56.  
Title: Re: Name of the day of the week
Post by: SMcNeill on December 28, 2019, 06:40:01 am
You can also use my little GetDay$ Function:

Code: QB64: [Select]
  1. FUNCTION GetDay$ (mm, dd, yyyy) 'use 4 digit year
  2.     'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
  3.     IF mm < 3 THEN mm = mm + 12: yyyy = yyyy - 1
  4.     century = yyyy MOD 100
  5.     zerocentury = yyyy \ 100
  6.     result = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
  7.     SELECT CASE result
  8.         CASE 0: GetDay$ = "Saturday"
  9.         CASE 1: GetDay$ = "Sunday"
  10.         CASE 2: GetDay$ = "Monday"
  11.         CASE 3: GetDay$ = "Tuesday"
  12.         CASE 4: GetDay$ = "Wednesday"
  13.         CASE 5: GetDay$ = "Thursday"
  14.         CASE 6: GetDay$ = "Friday"
  15.     END SELECT

An example, to compare, here:

Code: QB64: [Select]
  1. 'function parameters: YEAR, MONTH, DAY
  2.  
  3. Today$ = GETDAYNAME(2019, 12, 28)
  4. PRINT "Today is "; Today$
  5. PRINT "Today is also "; GetDay(12, 28, 2019)
  6.  
  7.  
  8.  
  9.  
  10.  
  11. FUNCTION ISLEAPYEAR (year)
  12.     IF year MOD 4 = 0 AND year MOD 100 THEN ISLEAPYEAR = 1
  13.     IF year MOD 100 = 0 AND year MOD 400 = 0 THEN ISLEAPYEAR = 1
  15.  
  16. FUNCTION GETDAYNAME$ (year, month, day) 'otestovano brutalne, fuguje skutecne spravne!
  17.     IF year < 1900 THEN GETDAYNAME$ = "Invalid Year ( <1900 ).": EXIT FUNCTION
  18.     'spocitat pocet mesicu od ledna 1900:
  19.     Days = day
  20.     FOR yyr = 1900 TO year
  21.         IF yyr = year THEN monthend = month ELSE monthend = 12
  22.         FOR mont = 1 TO monthend
  23.             IF ISLEAPYEAR(yyr) = 0 THEN
  24.                 SELECT CASE mont
  25.                     CASE 1: m = 31
  26.                     CASE 2: m = 28
  27.                     CASE 3: m = 31
  28.                     CASE 4: m = 30
  29.                     CASE 5: m = 31
  30.                     CASE 6: m = 30
  31.                     CASE 7: m = 31
  32.                     CASE 8: m = 31
  33.                     CASE 9: m = 30
  34.                     CASE 10: m = 31
  35.                     CASE 11: m = 30
  36.                     CASE 12: m = 31
  37.                 END SELECT
  38.             ELSE
  39.                 SELECT CASE mont
  40.                     CASE 1: m = 31
  41.                     CASE 2: m = 29
  42.                     CASE 3: m = 31
  43.                     CASE 4: m = 30
  44.                     CASE 5: m = 31
  45.                     CASE 6: m = 30
  46.                     CASE 7: m = 31
  47.                     CASE 8: m = 31
  48.                     CASE 9: m = 30
  49.                     CASE 10: m = 31
  50.                     CASE 11: m = 30
  51.                     CASE 12: m = 31
  52.                 END SELECT
  53.             END IF
  54.             Om = m
  55.             Days = Days + m
  56.         NEXT
  57.     NEXT
  58.     Days = Days - m - 1
  59.     '  PRINT "Dnu:"; Days
  60.     a = (Days MOD 7) '0 = pondeli
  61.     RESTORE nms
  62.     FOR r = 0 TO a
  63.         READ GETDAYNAME$
  64.     NEXT
  65.     nms:
  66.     DATA Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday
  68.  
  69.  
  70. FUNCTION GetDay$ (mm, dd, yyyy) 'use 4 digit year
  71.     'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
  72.     IF mm < 3 THEN mm = mm + 12: yyyy = yyyy - 1
  73.     century = yyyy MOD 100
  74.     zerocentury = yyyy \ 100
  75.     result = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
  76.     SELECT CASE result
  77.         CASE 0: GetDay$ = "Saturday"
  78.         CASE 1: GetDay$ = "Sunday"
  79.         CASE 2: GetDay$ = "Monday"
  80.         CASE 3: GetDay$ = "Tuesday"
  81.         CASE 4: GetDay$ = "Wednesday"
  82.         CASE 5: GetDay$ = "Thursday"
  83.         CASE 6: GetDay$ = "Friday"
  84.     END SELECT
  86.  
Title: Re: Name of the day of the week
Post by: Petr on December 28, 2019, 06:58:34 am
Thank you Steve. I haven't known a Zeller yet. I know read more in my longer solution, than in the Zeller formula, that's... other level...

Better is my own algorithm. You know how i count cows in a meadow? Count the legs and then divide by four ...  :)
Title: Re: Name of the day of the week
Post by: SMcNeill on December 28, 2019, 07:45:55 am
Quote from: Petr on December 28, 2019, 06:58:34 am
Thank you Steve. I haven't known a Zeller yet. I know read more in my longer solution, than in the Zeller formula, that's... other level...

Better is my own algorithm. You know how i count cows in a meadow? Count the legs and then divide by four ...  :)

I just hope you never run across a field with 4 three-legged cows in it.  ;)
Title: Re: Name of the day of the week
Post by: FellippeHeitor on December 28, 2019, 07:51:55 am
Code: QB64: [Select]
  1. numberOfCows = _CEIL(numberOfLegs / 4)

😁
Title: Re: Name of the day of the week
Post by: TempodiBasic on December 28, 2019, 10:36:25 am
IMHO for leap years

Quote
DO WHILE Bull =< 0
numberOfCows = _CEIL(numberOfLegs / 4)
LOOP

^_^
Title: Re: Name of the day of the week
Post by: Petr on December 28, 2019, 10:56:01 am
:-)
Title: Re: Name of the day of the week
Post by: bplus on December 28, 2019, 01:04:02 pm
Quote from: SMcNeill on December 28, 2019, 06:40:01 am
You can also use my little GetDay$ Function:

Code: QB64: [Select]
  1. FUNCTION GetDay$ (mm, dd, yyyy) 'use 4 digit year
  2.     'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
  3.     IF mm < 3 THEN mm = mm + 12: yyyy = yyyy - 1
  4.     century = yyyy MOD 100
  5.     zerocentury = yyyy \ 100
  6.     result = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
  7.     SELECT CASE result
  8.         CASE 0: GetDay$ = "Saturday"
  9.         CASE 1: GetDay$ = "Sunday"
  10.         CASE 2: GetDay$ = "Monday"
  11.         CASE 3: GetDay$ = "Tuesday"
  12.         CASE 4: GetDay$ = "Wednesday"
  13.         CASE 5: GetDay$ = "Thursday"
  14.         CASE 6: GetDay$ = "Friday"
  15.     END SELECT

An example, to compare, here:

Code: QB64: [Select]
  1. 'function parameters: YEAR, MONTH, DAY
  2.  
  3. Today$ = GETDAYNAME(2019, 12, 28)
  4. PRINT "Today is "; Today$
  5. PRINT "Today is also "; GetDay(12, 28, 2019)
  6.  
  7.  
  8.  
  9.  
  10.  
  11. FUNCTION ISLEAPYEAR (year)
  12.     IF year MOD 4 = 0 AND year MOD 100 THEN ISLEAPYEAR = 1
  13.     IF year MOD 100 = 0 AND year MOD 400 = 0 THEN ISLEAPYEAR = 1
  15.  
  16. FUNCTION GETDAYNAME$ (year, month, day) 'otestovano brutalne, fuguje skutecne spravne!
  17.     IF year < 1900 THEN GETDAYNAME$ = "Invalid Year ( <1900 ).": EXIT FUNCTION
  18.     'spocitat pocet mesicu od ledna 1900:
  19.     Days = day
  20.     FOR yyr = 1900 TO year
  21.         IF yyr = year THEN monthend = month ELSE monthend = 12
  22.         FOR mont = 1 TO monthend
  23.             IF ISLEAPYEAR(yyr) = 0 THEN
  24.                 SELECT CASE mont
  25.                     CASE 1: m = 31
  26.                     CASE 2: m = 28
  27.                     CASE 3: m = 31
  28.                     CASE 4: m = 30
  29.                     CASE 5: m = 31
  30.                     CASE 6: m = 30
  31.                     CASE 7: m = 31
  32.                     CASE 8: m = 31
  33.                     CASE 9: m = 30
  34.                     CASE 10: m = 31
  35.                     CASE 11: m = 30
  36.                     CASE 12: m = 31
  37.                 END SELECT
  38.             ELSE
  39.                 SELECT CASE mont
  40.                     CASE 1: m = 31
  41.                     CASE 2: m = 29
  42.                     CASE 3: m = 31
  43.                     CASE 4: m = 30
  44.                     CASE 5: m = 31
  45.                     CASE 6: m = 30
  46.                     CASE 7: m = 31
  47.                     CASE 8: m = 31
  48.                     CASE 9: m = 30
  49.                     CASE 10: m = 31
  50.                     CASE 11: m = 30
  51.                     CASE 12: m = 31
  52.                 END SELECT
  53.             END IF
  54.             Om = m
  55.             Days = Days + m
  56.         NEXT
  57.     NEXT
  58.     Days = Days - m - 1
  59.     '  PRINT "Dnu:"; Days
  60.     a = (Days MOD 7) '0 = pondeli
  61.     RESTORE nms
  62.     FOR r = 0 TO a
  63.         READ GETDAYNAME$
  64.     NEXT
  65.     nms:
  66.     DATA Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday
  68.  
  69.  
  70. FUNCTION GetDay$ (mm, dd, yyyy) 'use 4 digit year
  71.     'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
  72.     IF mm < 3 THEN mm = mm + 12: yyyy = yyyy - 1
  73.     century = yyyy MOD 100
  74.     zerocentury = yyyy \ 100
  75.     result = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
  76.     SELECT CASE result
  77.         CASE 0: GetDay$ = "Saturday"
  78.         CASE 1: GetDay$ = "Sunday"
  79.         CASE 2: GetDay$ = "Monday"
  80.         CASE 3: GetDay$ = "Tuesday"
  81.         CASE 4: GetDay$ = "Wednesday"
  82.         CASE 5: GetDay$ = "Thursday"
  83.         CASE 6: GetDay$ = "Friday"
  84.     END SELECT
  86.  

Once again I remind folks to get copies of mm and yyyy because the getDay$ function changes them in first line.
Text Only | Text with Attachments