Agamemnus


« on: December 11, 2006, 03:04:18 PM » 

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.



Logged

Peace cannot be obtained without war. Why? If there is already peace, it is unnecessary for war. If there is no peace, there is already war." Visit www.neobasic.net to see rubbish in all its finest.



DrV


« Reply #1 on: December 11, 2006, 07:44:37 PM » 

Untested, hope I got it right. Weeks are assumed to start on Sunday; day of year is zerobased. Compiles with FreeBASIC 0.17b (current CVS version)... no guarantees it'll work anywhere else. 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



Logged




Agamemnus


« Reply #2 on: December 12, 2006, 05:02:34 PM » 

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



Logged

Peace cannot be obtained without war. Why? If there is already peace, it is unnecessary for war. If there is no peace, there is already war." Visit www.neobasic.net to see rubbish in all its finest.



DrV


« Reply #3 on: December 13, 2006, 04:41:31 PM » 

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.



Logged




Moneo


« Reply #4 on: December 13, 2006, 10:36:44 PM » 

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 rem Date Challenge by Agamemnus, 11Dec2006. rem INPUT : YEAR and Day of Year rem OUTPUT: Day of Week and Day of Month.
DEFINT AZ
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: Nonnumeric 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.day2,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.factorzfsave+1
'* Compute the week number: (week.day1 is week day of Jan 1st relative to 0) week.num=int((julian.day+(week.day1)1)/7)+1
'* Compute the day of the week of input date: gosub Compute.Weekday RETURN
COMPUTE.FACTOR: DATE.FACTOR=365!*ZYY+ZDD+31*(ZMM1) 'NOTE: WON'T WORK WITHOUT ! AFTER 365. IF ZMM<3 THEN DATE.FACTOR=DATE.FACTOR+INT((ZYY1)/4)INT(3/4*(INT((ZYY1)/100)+1)) ELSE DATE.FACTOR=DATE.FACTORINT(.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.FACTORINT(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=zmm1:if zmm=0 then zmm=12:zyy=zyy1 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=zdworkzmax 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 DDMMMYYYY. 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



Logged




Agamemnus


« Reply #5 on: December 15, 2006, 05:23:36 PM » 

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



Logged

Peace cannot be obtained without war. Why? If there is already peace, it is unnecessary for war. If there is no peace, there is already war." Visit www.neobasic.net to see rubbish in all its finest.



Antoni Gual


« Reply #6 on: December 15, 2006, 05:47:21 PM » 

Small is beautiful '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 AZ 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 ' '



Logged

Antoni



Moneo


« Reply #7 on: December 18, 2006, 12:48:11 AM » 

Small is beautiful '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 40 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



Logged




Antoni Gual


« Reply #8 on: December 18, 2006, 02:26:20 PM » 

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.



Logged

Antoni



Agamemnus


« Reply #9 on: December 18, 2006, 04:07:48 PM » 

Small is beautiful '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 40 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.



Logged

Peace cannot be obtained without war. Why? If there is already peace, it is unnecessary for war. If there is no peace, there is already war." Visit www.neobasic.net to see rubbish in all its finest.



Antoni Gual


« Reply #10 on: December 18, 2006, 06:07:03 PM » 

Aga: I guess what you consider interesting is a description of the DayofWeek routine so here it goes. I don't know who invented it but it gave me a good headache to figure how does it work. 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
It uses modular arithmetics to add offsets modulo 7 from a theoretical (gregorian) march 1th of the year zero. If that day existed it was a wednedsday. And it uses a shifted year (Q variable) starting at march 1. The monhts are also shifted, month 0 is march and month 11 is february. If you divide 365 by 7 you get a remainder of 1, so if you don't count leap years, every year advances a date by 1 position in the week. So we have a +Q in the formula. the +Q\4Q\100+\400 part provide for the leap year's additional offsets. Then it comes the serious part, the reason why we use a shifted year. CINT(2.6*P) provides for the month of year offset. The effect of the fp operation plus rounding makes this factor add 3 days (3128) for april (month 1), 5 days for may, 8 days for june... and so on, including the irregularity of august and september that require 3 days for each. February has been noved to the end of the year so its different behavior in leap years must not be considered in this step. Then the formula adds the Day of month (+D) and a 1 to center the things and make the result of 0 a monday . Hope it helps... Moneo: In my last post I was obviously not speaking about the same soccer game as you. In fact i found about the Barça America in the net after rereading yout post . I'm not very interested in soccer, you see... And for the explanation of the DayofWeek routine, my memory failed, we spoke about it at Pete's site, not at Foronet.



Logged

Antoni



Agamemnus


« Reply #11 on: December 24, 2006, 10:13:50 PM » 

Yes, I guess that how I would go about it is figure out how many years since now were not leap years and then do MOD 7.
Thanks for the explanation.
I actually figured out that this can be done with FB's functions without resorting to formulas, but I was interested in a use for this in Javascript, actually:
A function for a project of mine needs to get the next trading day (e.g.: Monday through Friday) X days from day N, year M: It would adjust the day if it was Sunday, Saturday, or another nontrading day. I can adjust the days easily enough, but getting the day of the week would have been difficult.



Logged

Peace cannot be obtained without war. Why? If there is already peace, it is unnecessary for war. If there is no peace, there is already war." Visit www.neobasic.net to see rubbish in all its finest.



Antoni Gual


« Reply #12 on: December 25, 2006, 07:30:08 AM » 

If your project requires to count n days from a day, just convert to julian dates. With JD you can get the day of the week simply by doing JD MOD 7.



Logged

Antoni



Moneo


« Reply #13 on: December 25, 2006, 05:00:54 PM » 

...... A function for a project of mine needs to get the next trading day (e.g.: Monday through Friday)..... I think you're going to have to identify holidays, falling on Monday to Friday, which are not trading days for the location where the program is to be run. This a pain because you need to create a table or file of these holidays, and update the table every year. You could also try to program these holidays. Examples in the USA: Martin Luther King's birthday is celebrated on the third Monday in January. Thanksgiving is the fourth Thursday in November. If Good Friday is a holiday at your location, you will also need to compute the date of Easter. Banking laws in some countries inhibit banks from being closed for more than 4 days. So, if a Friday is a holiday, then Thursday and Monday cannot both be holidays. Trading days generally adhere to bank holidays. Computing all these holidays can get tedious. The holiday table or file is less elegant and perhaps prone to user error, but much simpler. EDIT: I think that The best solution would be to get the holiday table/file from the applicable stock exchange directly. Regards..... Moneo



Logged




