# Qbasicnews.com

Full Version: another date challenge
You're currently viewing a stripped down version of our content. View the full version with proper formatting.
Pages: 1 2
Ok....maybe not a very difficult one....

The challenge is to convert year and day of year to day of the week and day of the month in Basic.
Untested, hope I got it right.

Weeks are assumed to start on Sunday; day of year is zero-based.

Compiles with FreeBASIC 0.17b (current CVS version)... no guarantees it'll work anywhere else.

Code:
```declare function isleapyear(byval i as integer) as integer declare function monthlen(byval m as integer, byval leap as integer) as integer declare function monthname(byval m as integer) as string declare sub yeardaytomonth(byval i as integer, byval leap as integer, byref m as integer, byref d as integer) declare sub yeardaytoweek(byval i as integer, byref w as integer, byref d as integer) declare function weekdayname(byval d as integer) as string dim y as integer, i as integer, leap as integer, m as integer, w as integer, d as integer do     input "Year (-1 to quit): ", y     if y < 0 then end retry:     input "Day of year (-1 to quit): ", i     if i < 0 then end     if i > 364 then goto retry          leap = isleapyear(y)     yeardaytomonth(i, leap, m, d)     print d + 1 & " " & monthname(m)     yeardaytoweek(i, w, d)     print weekdayname(d) & " of week " & w loop function isleapyear(byval i as integer) as integer     isleapyear = 0     if i mod 4 = 0 then         if i mod 100 = 0 then             if i mod 400 = 0 then                 isleapyear = 1             end if         else             isleapyear = 1         end if     end if end function function monthlen(byval m as integer, byval leap as integer) as integer     static monthlentb(0 to 11) as integer = {31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31}     if (leap <> 0) and (m = 1) then         return 29     else         return monthlentb(m)     end if end function function monthname(byval m as integer) as string     static monthnametb(0 to 11) as zstring ptr = {@"Jan", @"Feb", @"Mar", @"Apr", @"May", @"Jun", _         @"Jul", @"Aug", @"Sep", @"Oct", @"Nov", @"Dec"}     return *monthnametb(m) end function sub yeardaytomonth(byval i as integer, byval leap as integer, byref m as integer, byref d as integer)     static monthstarttb(0 to 12) as integer = {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365}     dim n as integer, add as integer = 0     for n = 0 to 11         if (i >= (monthstarttb(n) + add)) and (i < (monthstarttb(n + 1) + add)) then exit for         if n = 1 then add = 1     next n          m = n     d = i - monthstarttb(n) end sub sub yeardaytoweek(byval i as integer, byref w as integer, byref d as integer)     w = i \ 7     d = i mod 7 end sub function weekdayname(byval d as integer) as string     static daynametb(0 to 6) as zstring ptr = {@"Sun", @"Mon", @"Tue", @"Wed", @"Thu", @"Fri", @"Sat"}     return *daynametb(d) end function```
It won't work in anything but Freebasic...

I tried day:0, with years 2004, 2005, and 2006, and I got the same day of the week every time... Your input to the function "yeardaytoweek" is only the day of the year... I think I know how to fix it, but I will leave that to you....
Ah, good point, the day of week thing is broken. I wrote it on the assumption that a week would start on the first day of the year... but I'm too lazy to go fix it, so there.
Quote:Ok....maybe not a very difficult one....

The challenge is to convert year and day of year to day of the week and day of the month in Basic.

Ok Aga, I took my old date utility and made some mods. Here it is. I did some testing.

Regards..... Moneo
Code:
```rem Date Challenge by Agamemnus, 11-Dec-2006. rem INPUT : YEAR and Day of Year rem OUTPUT: Day of Week and Day of Month. DEFINT A-Z DECLARE FUNCTION   NumStrict    (Z\$) DECLARE FUNCTION IsLeapYear% (Z)   DECLARE FUNCTION FillString\$ (V#,ZL)           DIM DAYS.OFFSET  AS LONG     'Plus or minus offset days from given date DIM YEAR.MIN     AS INTEGER  'Minimum valid year for dates (default=0) DIM DATE.FACTOR  AS SINGLE   'Number of days given date is from day zero. DIM WEEK.DAY     AS INTEGER  'Day of week value: 1=Sunday....7=Saturday. DIM WEEK.NUM     AS INTEGER  'Week number within year (1 to 54). DIM JULIAN.DAY   AS INTEGER  'Day  number within year (1 to 366). DIM DATE.OK      AS INTEGER  'Valid date indicator: -1=True, 0=False. Z\$               =  ""       'Date string as YYYYMMDD. DIM ZYY          AS INTEGER  'Value of the 4 digit year. DIM ZMM          AS INTEGER  'Value of the 2 digit month. DIM ZDD          AS INTEGER  'Value of the 2 digit day. DIM ZMAX         AS INTEGER  'Routine internal value of max days in month. DIM ZDWORK       AS LONG     'Variable    internal to date routines. DIM ZFSAVE       AS SINGLE   'Variable    internal to date routines. DIM ZFSAVE2      AS SINGLE   'Variable    internal to date routines. ZTEMP\$           =  ""       'Work string internal to date routines. ZTEMP2\$          =  ""       'Work string internal to date routines. DIM ZMO(1 TO 12) AS INTEGER DATA 31,28,31,30,31,30,31,31,30,31,30,31 FOR ZMM=1 TO 12:READ ZMO(ZMM):NEXT CONST ZMO3\$="JANENEFEBFEBMARMARAPRABRMAYMAYJUNJUNJULJULAUGAGOSEPSEPOCTOCTNOVNOVDECDIC" rem Miscellaneous variables: twide = 14                  'width of text before equalsign is 14 in English em4\$="ERROR: Non-numeric Day of Year" em5\$="ERROR: Invalid Day of Year" em6\$="*** Internal date error #" wdate1\$="date#1" wdate2\$="date#2" wdate3\$="result date" textoffset\$="days_offset" REM ************************************************************************* REM        |-------------------------------------|                   REM        |  P R O G R A M   M A I N   L I N E  | REM        |-------------------------------------|                   REM ************************************************************************* cls print "Input YEAR "; input PARAM1\$ PARAM1\$=PARAM1\$+"0101" z\$=Param1\$ gosub date.factor if not(date.ok) then print "Invalid Year":system print "Input DAY OF YEAR "; input PARAM2\$ if param2\$="" then print "Day of Year missing":system if not NumStrict(param2\$) then print em4\$:system if val(param2\$)<1 then print em5\$:system days.offset=val(param2\$)-1 z\$=param1\$ gosub date.offset if not(date.ok) then print em5\$:system w\$=wdate3\$:gosub display SYSTEM REM *************************************************************************** REM *****   S U B R O U T I N E S   REM *************************************************************************** display: gosub date.format print left\$(w\$+space\$(twide),twide);"= ";z\$ print "week day      = ";:print using "###";week.day;                          print "  ";mid\$("SunMonTueWedThuFriSat",3*week.day-2,3) REM ...print "week number   = ";:print using "###";week.num print "Julian day    = ";:print using "###";julian.day return     '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> REM *************************************************************************** REM *****   D A T E   S U B R O U T I N E S   ********************************* REM *************************************************************************** REM ************************  DATE.FACTOR  ************************************ REM * REM *** PRINCIPAL DATE SUBROUTINE: REM *   ========================= REM *   - Validate input date string. REM *   - Compute number of days (date.factor) from year 0, month 0, day 0. REM *   - Compute day of week. REM *   - Compute week number. REM *   - Compute "julian" day of year. REM * REM *  INPUT: REM *  ===== REM *  Z\$         = Date string formatted as YYYYMMDD. REM *  YEAR.MIN   = Minimum year user wishes to allow (default 0) REM * REM * OUTPUT: REM * ====== REM * DATE.OK       = -1 if input date VALID.   (true) REM *               =  0 if Input date INVALID. (false)                     REM * NOTE: IF VALID,   THE FOLLOWING VARIABLES AR BASED ON INPUT DATE. REM *       IF INVALID, THE VALUES MAY HAVE CHANGED AND ARE MEANINGLESS. REM * DATE.FACTOR   = Number of cumulative days from year/month/day 0. REM * WEEK.DAY      = 1 to   7 is Sunday to Saturday respectively.   REM * WEEK.NUM      = 1 TO  54 is week number within year.             REM * JULIAN.DAY    = 1 TO 366 is day  number within year.             REM * ZYY           = Value of of 4 digit year.         REM * ZMM           = Value of month.                     REM * ZDD           = Value of day.                                 REM * Z\$            = (unchanged). REM * YEAR.MIN      = (unchanged). REM * REM * REM * Date factor logic adopted from a Texas Instruments calculator manual. REM * DATE.FACTOR:   gosub Date.Check                     'check input date   if not(date.ok) then RETURN          'exit if invalid   zmm=1:zdd=1                          'set to January 1st   gosub Compute.Factor                 'compute factor of Jan 1st   zfsave=date.factor                   'save factor   of Jan 1st   gosub Compute.Weekday                'week.day now has day of week of Jan 1st   zdd=val(right\$(z\$,2))                'Restore input date's day + month     zmm=val(mid\$(z\$,5,2))     gosub Compute.Factor                 'compute factor of input date   '* Julian day is input date minus Jan 1st of same year +1   julian.day=date.factor-zfsave+1     '* Compute the week number: (week.day-1 is week day of Jan 1st relative to 0)   week.num=int((julian.day+(week.day-1)-1)/7)+1   '* Compute the day of the week of input date:   gosub Compute.Weekday RETURN COMPUTE.FACTOR:   DATE.FACTOR=365!*ZYY+ZDD+31*(ZMM-1)  'NOTE: WON'T WORK WITHOUT ! AFTER 365.   IF ZMM<3 THEN      DATE.FACTOR=DATE.FACTOR+INT((ZYY-1)/4)-INT(3/4*(INT((ZYY-1)/100)+1))   ELSE      DATE.FACTOR=DATE.FACTOR-INT(.4*ZMM+2.3)+INT(ZYY/4)-INT(3/4*(INT(ZYY/100)+1))   END IF RETURN COMPUTE.WEEKDAY:   '* Compute the day of the week:   WEEK.DAY=DATE.FACTOR-INT(DATE.FACTOR/7)*7    'Modulo 7.   IF WEEK.DAY=0 THEN WEEK.DAY=7                'WEEK.DAY=1=Sunday. RETURN REM *************************************************************************** REM ******************  DATE.OFFSET  ****************************************** REM * REM *** COMPUTE THE DATE WHICH IS NUMBER OF DAYS FROM GIVEN DATE. REM * REM *  INPUT: REM *  ===== REM *  Z\$           = Given date as YYYYMMDD. REM *  DAYS.OFFSET  = Number of calendar days plus or minus from given date. REM *  YEAR.MIN     = Minimum year user wishes to allow (default 0) REM * REM * OUTPUT: REM * ====== REM * DATE.OK       = -1 if input/offset/result date is VALID.   (true) REM *               =  0 if input/offset/result date is INVALID. (false) REM * NOTE: IF VALID, THE FOLLOWING VARIABLES AR BASED ON COMPUTED/RESULT DATE. REM *       IF INVALID, THE VALUES MAY HAVE CHANGED AND ARE MEANINGLESS. REM * Z\$            = Computed/Result date (Given+DAYS.OFFSET) (as YYYYMMDD). REM * DAYS.OFFSET   = (unchanged). REM * DATE.FACTOR   = Number of cumulative days from year/month/day 0. REM * WEEK.DAY      = 1 to   7 is Sunday to Saturday respectively.   REM * WEEK.NUM      = 1 TO  54 is week number within year.             REM * JULIAN.DAY    = 1 TO 366 is day  number within year.             REM * ZYY           = Value of of 4 digit year.         REM * ZMM           = Value of month.                     REM * ZDD           = Value of day.                                 REM * EASTERSUNDAY\$ = Date of Easter for computed/result year.       REM * YEAR.MIN      = (unchanged). REM * DATE.OFFSET:   gosub date.factor   if not (date.ok) then RETURN           if date.factor+days.offset < 0 or_      date.factor+days.offset > 3652424 then Date.ok=0 : RETURN                               '3652424 is date.factor for max date of 99991231.   '* Note: Date was split into zyy/zmm/zdd by date.factor routine.   zdwork=zdd+days.offset                    'Set to Given day + increment.   if zdwork < 1 then      do        zmm=zmm-1:if zmm=0 then zmm=12:zyy=zyy-1        gosub GetZMax                           'go get max days cur month (zmm)        zdwork=zdwork+zmax      loop while zdwork<1   else      gosub GetZMax                             'go get max days cur month (zmm)      do while zdwork>zmax        zmm=zmm+1:IF zmm>12 then zmm=1:zyy=zyy+1        zdwork=zdwork-zmax        gosub GetZMax      loop   end if   zdd=zdwork   '* Pack the date as YYYYMMDD   Z\$=FILLSTRING\$((ZYY),4)+FILLSTRING\$((ZMM),2)+FILLSTRING\$((ZDD),2)   gosub date.factor         'get all pertinent variables for final date   '* Note: date.factor routine also sets date.ok indicator. RETURN GetZMax:   IF ZMM=2 AND ISLEAPYEAR(ZYY) THEN ZMAX=ZMO(ZMM)+1 ELSE ZMAX=ZMO(ZMM) RETURN REM *************************************************************************** REM *************************************************************************** REM *********************  DATE.CHECK  **************************************** REM * REM *** VALIDATE A DATE IN YYYYMMDD FORMAT. REM * REM *  INPUT: Z\$       = Given date in format YYYYMMDD. REM *         YEAR.MIN = Minimum valid year allowed. (default=0) REM * REM * OUTPUT: DATE.OK = -1 if input date is VALID.   (true) REM *                    0 if input date is INVALID. (false)                     REM *         (if VALID): REM *         ZYY      = Value of 4 digit year.         REM *         ZMM      = Value of month.                               REM *         ZDD      = Value of day.                                 REM * REM * DATE.CHECK:   DATE.OK = 0      'preset to false   ZTEMP\$="1"+Z\$+"1"   IF LEN(Z\$)<>8 OR MID\$(STR\$(VAL(ZTEMP\$)),2)<>ZTEMP\$ THEN RETURN   ZDD=VAL(RIGHT\$(Z\$,2))                'Set day                   ZMM=VAL(MID\$(Z\$,5,2))                'Set month.   ZYY=VAL(LEFT\$(Z\$,4))                 'Set year.   IF ZMM<1 OR ZMM>12 OR ZDD<1 OR ZDD>31 OR ZYY<YEAR.MIN THEN RETURN   IF ZMO(ZMM)+1*(-(ZMM=2 AND ISLEAPYEAR(ZYY))) < ZDD THEN RETURN   '   If expression (month=2 and is leapyear) is TRUE which is -1, then   '   taking the negative of this issues a plus 1. Conversely, the FALSE       '   always gives a zero. Multiplying the +1 by this result of 1 or 0   '   will either add 1 or not to the number of days in the month.   '   The routine wants to add 1 only when it is February and leap year.   DATE.OK = -1        '-1=valid (true) RETURN       REM *************************************************************************** REM ******************  DATE.FORMAT  ****************************************** REM * REM *** FORMAT A DATE FOR PRINTING. REM * REM *  INPUT: Z\$ in format YYYYMMDD. (assumed to be already validated) REM * REM * OUTPUT: Z\$ formatted as DD-MMM-YYYY. REM * DATE.FORMAT:   Z\$=RIGHT\$(Z\$,2)+"-"+MID\$(ZMO3\$,6*VAL(MID\$(Z\$,5,2))-2-(3),3)+"-"+LEFT\$(Z\$,4) RETURN REM *************************************************************************** END REM *************************************************************************** REM *************************************************************************** REM *****   D A T E   F U N C T I O N S   ************************************* REM *************************************************************************** ' ====================== ISLEAPYEAR ========================== '         Determines if a year is a leap year or not. ' ============================================================ ' FUNCTION IsLeapYear (Z) STATIC    ' If the year is evenly divisible by 4 and not divisible    ' by 100, or if the year is evenly divisible by 400, then    ' it's a leap year:    IsLeapYear = (Z MOD 4 = 0 AND Z MOD 100 <> 0) OR (Z MOD 400 = 0) END FUNCTION ' ========================= FILLSTRING ============================= ' Converts a value to string of specified length with leading zeros. ' ================================================================== FUNCTION FillString\$ (V#,ZL) STATIC   FILLSTRING\$=right\$(STRING\$(ZL,"0")+MID\$(STR\$(V#),2),ZL) END FUNCTION ' =================================================================== FUNCTION NumStrict (Z\$) REM * REM *** (NUMSTRICT) - CHECK FOR STRICTLY NUMERIC ONLY (NO NULL NO DECIMAL) REM *   NumStrict=0         'Init to False   IF Z\$="" THEN EXIT FUNCTION   FOR X = 1 TO LEN(Z\$)       A=ASC(MID\$(Z\$,X,1))       IF A<48 OR A>57 THEN EXIT FUNCTION   NEXT X   NumStrict = -1          'True END FUNCTION```
Hm... I guess you wrote this for QB, but there are loads of problems running this with FB... among them, date.ok doesn't seem to work right... :-| I'll try to fix later....
Small is beautiful
Code:
```'Conversion of day of year and year to day of month and day of week 'by Antoni gual 2006/12/15 for Agamemnus contest at QBN 'Tested in QB 1.1 ' DEFINT A-Z DECLARE FUNCTION DayofWeek (y, m, D) DECLARE FUNCTION ISLEAPYEAR (y) DECLARE FUNCTION daysinmonth (y, m) DO INPUT "year (0 to exit)"; y IF y < 1 THEN EXIT DO INPUT "day of year"; dy IF dy < 1 OR dy > 365 - ISLEAPYEAR(y) THEN PRINT "bad day of year": END nt = 0 m = 0 DO n = nt m = m + 1 nt = nt + daysinmonth(y, m) LOOP UNTIL dy <= nt dm = dy - n 'PRINT "month (1=January...12=December)"; m PRINT "day of month = "; dm PRINT "day of week (1=monday...7=sunday) "; DayofWeek(y, m, dm) + 1 LOOP END ' '------------------------------------------------------------------------- FUNCTION DayofWeek (y, m, D)   '0=monday   DIM P, Q   IF m > 2 THEN     P = m - 3     Q = y   ELSE     P = m + 9     Q = y - 1   END IF DayofWeek = (D + 1 + Q + Q \ 4 - Q \ 100 + Q \ 400 + CINT(2.6 * P)) MOD 7 END FUNCTION ' '------------------------------------------------------------------------- FUNCTION daysinmonth (y, m) 'get nr of days in a month  of a year(check for leap year if february) SELECT CASE m CASE 2: daysinmonth = 28 - ISLEAPYEAR(y) CASE 1, 3, 5, 7, 8, 10, 12: daysinmonth = 31 CASE ELSE: daysinmonth = 30 END SELECT END FUNCTION ' '------------------------------------------------------------------------- FUNCTION ISLEAPYEAR (y) 'Returns -1 if Gregorian year y is a leap year ISLEAPYEAR = (y MOD 4 = 0) - (y MOD 100 = 0) + (y MOD 400 = 0) END FUNCTION ' '--------------------------------------------------------------------------```
Quote:Small is beautiful
Code:
```'Conversion of day of year and year to day of month and day of week 'by Antoni gual 2006/12/15 for Agamemnus contest at QBN 'Tested in QB 1.1```

Antoni, Did some testing and it works fine.

I wonder why Aga didn't ask for the month as well as the day of the month?

Â¿Que te pareciÃ³ el 4-0 del Barca contra el AmÃ©rica?
Como diriÃ¡n en inglÃ©s: When you play against Barcelona, you're playing with the big boys.

Saludos..... Moneo
Naturally it works.
It uses the day of week routine I once used in one of your challenges at Foronet. I can translate the explanation of the algorithm i posted there if someone is interested.

About the BarÃ§a, well, they were too confident. They have no rival in Spain at the moment, and they just classified for the next run of the european UEFA champions cup, so they believe they are the kings of mambo.
Quote:
Antoni Gual Wrote:Small is beautiful
Code:
```'Conversion of day of year and year to day of month and day of week 'by Antoni gual 2006/12/15 for Agamemnus contest at QBN 'Tested in QB 1.1```

Antoni, Did some testing and it works fine.

I wonder why Aga didn't ask for the month as well as the day of the month?

Â¿Que te pareciÃ³ el 4-0 del Barca contra el AmÃ©rica?
Como diriÃ¡n en inglÃ©s: When you play against Barcelona, you're playing with the big boys.

Saludos..... Moneo

Yes, I guess that would be interesting as well...

Thank you Antoni for your submission. I am going to try to do something myself (without looking at you awesome compact code) and we shall then end the contest there, if no one else has any other submissions.
Pages: 1 2