12-14-2006, 06:36 AM
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