Julian days (QBASIC)

From LiteratePrograms

Calculations with dates and times are often required. Many modern languages have built-in datetime types to make this easy. Unfortunately BASIC doesn't. This group of functions remedies that by making use of a form of day-based date known as a Julian day. This allows for the representation of dates and times by DOUBLE precision floating point numbers. Once in this format it is easy to carry out calculations on dates and times. The only difficulty lies in converting from a specific calendar such as the Gregorian calendar to the Julian Day Number (and vice-versa).

These functions provide the ability to convert between the ISO STRING representation of a Gregorian date and its Julian DOUBLE representation. Note that time is not currently handled, therefore the functions always assume midnight as the beginning of the day. Since the Julian date system starts at noon, this means that all Julian day numbers produced or used by these functions will be 0.5 less than might otherwise be expected.

Description

The first function takes a Gregorian date formatted in the ISO manner, ie YYYYMMDD, and calculates the Julian Day Number from it using the widely known function which can be found in the Wikipedia article.

<<julian conversion function>>=
FUNCTION JulianDay# (aISOdate AS STRING)
   DIM dDay AS LONG
   DIM dMonth AS LONG
   DIM dYear AS LONG
   LET dYear = VAL(MID$(aISOdate, 1, 4))
   LET dMonth = VAL(MID$(aISOdate, 5, 2))
   LET dDay = VAL(MID$(aISOdate, 7, 2))
   IF dMonth < 3 THEN
      LET dMonth = dMonth + 12
      LET dYear = dYear - 1
   END IF
   LET JulianDay# = 1721118.5# + dDay + (153 * dMonth - 457) \ 5 + INT(365.25# * dYear) - INT(.01# * dYear) + INT(.0025# * dYear)
END FUNCTION

The second function takes a Julian Day Number and calculates the Gregorian date formatted in the ISO manner from it using another widely known method which, once again, can be found in the Wikipedia article.

<<gregorian conversion function>>=
FUNCTION ISOday$ (aJulianDay AS DOUBLE)
   DIM dBaseDay AS LONG
   DIM G AS DOUBLE
   DIM dCentury AS LONG
   DIM B AS LONG
   DIM C AS LONG
   DIM dYear AS LONG
   DIM dMonth AS INTEGER
   DIM dDay AS INTEGER
   LET dBaseDay = INT(aJulianDay - 1721118.5#)
   LET G = dBaseDay - .25#
   LET dCentury = INT(G / 36524.25)
   LET B = dCentury - INT(dCentury / 4)
   LET dYear = INT((B + G) / 365.25)
   LET C = B + dBaseDay - INT(365.25 * dYear)
   LET dMonth = (5 * C + 456) \ 153
   LET dDay = C - (153 * dMonth - 457) \ 5
   IF dMonth > 12 THEN
      dYear = dYear + 1
      dMonth = dMonth - 12
   END IF
   LET ISOday$ = RIGHT$(STR$(10000 + dYear), 4) + RIGHT$(STR$(100 + dMonth), 2) + RIGHT$(STR$(100 + dDay), 2)
END FUNCTION

The third function is a utility function which takes a date, formatted as MM-DD-YYYY, and changes it to YYYYMMDD.

<<US2ISO conversion function>>=
FUNCTION US2ISOdate$ (aUSdate AS STRING)
   LET US2ISOdate$ = MID$(aUSdate, 7) + MID$(aUSdate, 1, 2) + MID$(aUSdate, 4, 2)
END FUNCTION

The fourth function is a utility function which takes a date, formatted as YYYYMMDD, and changes it to MM-DD-YYYY.

<<ISO2US conversion function>>=
FUNCTION ISO2USdate$ (aISOdate AS STRING)
   LET ISO2USdate$ = MID$(aISOdate, 5, 2) + "-" + MID$(aISOdate, 7, 2) + "-" + MID$(aISOdate, 1, 4)
END FUNCTION

The fifth function can be used to check that a date really has been formatted as YYYYMMDD

<<check ISO format function>>=
FUNCTION AnISOdate% (aISOdate AS STRING)
   DIM dTruth AS INTEGER
   DIM dYear AS STRING
   DIM dMonth AS STRING
   DIM dDay AS STRING
   LET dYear = MID$(aISOdate, 1, 4)
   LET dMonth = MID$(aISOdate, 5, 2)
   LET dDay = MID$(aISOdate, 7, 2)
   LET dTruth = (LEN(aISOdate) = 8)
   LET dTruth = dTruth AND (LTRIM$(STR$(ABS(VAL(dYear)))) = dYear)
   LET dTruth = dTruth AND (VAL(dMonth) >= 1 AND VAL(dMonth) <= 12)
   LET dTruth = dTruth AND (VAL(dDay) >= 1 AND VAL(dDay) <= 31)
   LET AnISOdate% = dTruth
END FUNCTION

Lastly we have a little test harness to check that this works for various dates...

<<test harness>>=
DECLARE FUNCTION JulianDay# (aISOdate AS STRING)
DECLARE FUNCTION ISOday$ (aJulianDay AS DOUBLE)
DECLARE FUNCTION AnISOdate% (aISOdate AS STRING)
DECLARE FUNCTION US2ISOdate$ (aUSdate AS STRING)
DECLARE FUNCTION ISO2USdate$ (aISOdate AS STRING)
CLS
LET TestDate$ = "02-28-1900": GOSUB PrintResult
LET TestDate$ = "02-29-1900": GOSUB PrintResult
LET TestDate$ = "03-01-1900": GOSUB PrintResult
LET TestDate$ = "01-01-2000": GOSUB PrintResult
LET TestDate$ = "02-28-2000": GOSUB PrintResult
LET TestDate$ = "02-29-2000": GOSUB PrintResult
LET TestDate$ = "03-01-2000": GOSUB PrintResult
LET TestDate$ = "02-28-2004": GOSUB PrintResult
LET TestDate$ = "02-29-2004": GOSUB PrintResult
LET TestDate$ = "03-01-2004": GOSUB PrintResult
LET TestDate$ = "12-31-2004": GOSUB PrintResult
LET TestDate$ = "01-01-2005": GOSUB PrintResult
LET TestDate$ = "12-31-2005": GOSUB PrintResult
LET TestDate$ = "01-01-2006": GOSUB PrintResult
LET TestDate$ = "01-31-2006": GOSUB PrintResult
LET TestDate$ = "02-01-2006": GOSUB PrintResult
LET TestDate$ = "02-28-2006": GOSUB PrintResult
LET TestDate$ = "03-01-2006": GOSUB PrintResult
LET TestDate$ = "03-31-2006": GOSUB PrintResult
LET TestDate$ = "04-01-2006": GOSUB PrintResult
LET TestDate$ = "04-30-2006": GOSUB PrintResult
PRINT
LET TestDate$ = DATE$: GOSUB PrintResult
SYSTEM
PrintResult:
   PRINT TestDate$,
   PRINT ISOdate$(TestDate$),
   PRINT JulianDay(ISOdate$(TestDate$)),
   PRINT ISOday(JulianDay(ISOdate$(TestDate$)))
   RETURN

And that's it.

<<julian.bas>>=
test harness
check ISO format function
US2ISO conversion function
ISO2US conversion function
gregorian conversion function
julian conversion function

Download code