cary@hpcllak.cup.hp.com (Cary Coutant) (11/01/90)
> Perhaps I didn't look close enough at the IPL, but I am interested in time > and date manipulation routines. Well, it doesn't quite meet your specs, but I have here a set of Icon procedures that convert dates to and from Julian day numbers. Given the Julian day numbers, you can do all of the arithmetic you like and the convert back. These routines are as correct as I can establish from a several sources, the most helpful ones being the _Astronomical_Calendar_ (annual) and _Astronomical_Companion_, both by Guy Ottewell (great books, both!). I got the trick for converting month number to days-in-year-so-far from some well-known published calculator algorithms floating around the net. -Cary Coutant, Hewlett-Packard Computer Language Laboratory # This is a shell archive. Remove anything before this line, # then unpack it by saving it in a file and typing "sh file". # # Wrapped by Cary Coutant <cary@hpcllak> on Wed Oct 31 15:04:41 1990 # # This archive contains: # jdate.icn # LANG=""; export LANG PATH=/bin:/usr/bin:$PATH; export PATH echo x - jdate.icn cat >jdate.icn <<'@EOF' # Note: "Julian day" is named after the father of the astronomer who # invented the Julian day numbering system. It is unrelated to the # "Julian calendar", which was the one established by Julius Caesar, # and introduced the concept of a leap year every fourth year. The # Gregorian calendar, established by Pope Gregory the somethingorother, # corrected the Julian calendar by eliminating three leap years out of # every four hundred years, bringing the average year to a length of # 365 + 1/4 - 3/100 = 365.22 days. # By the way, to astronomers (and to this program), the year 1 B.C. # is year 0, 2 B.C. is -1, etc. global cutover # julian day number of cutover from Julian to # Gregorian calendar (should be the first day # skipped). procedure main(args) cutover := julian(9, 3, 1752) # England and the Colonies if !args == "-c" then cutover := julian(10, 5, 1582) # Catholic countries convert() return end procedure convert() local g while read() ? { month := integer(tab(many('0123456789'))) tab(many(' /')) day := integer(tab(many('0123456789'))) tab(many(' /')) year := integer(tab(many('-0123456789'))) g := gregorian(month, day, year) write(datestring(g), " = ", g) } return end ## gregorian(m,d,y) - Return the Julian day number for 12:00 noon # on the given m/d/y, using the Gregorian calendar. procedure gregorian(month, day, year) local g g := julian(month, day, year) if g >= cutover then { if month < 3 then year -:= 1 g +:= 2 - floor(year/100.0) + floor(year/400.0) } return g end ## julian(m,d,y) - Return the Julian day number for 12:00 noon # on the given m/d/y, using the Julian calendar. procedure julian(month, day, year) month -:= 3 if month < 0 then { month +:= 12 year -:= 1 } return 1721117 + floor(year*365.25) + (month*153+2)/5 + day end ## datestring() - produces a formatted date string for a julian day number. procedure datestring(g) local dow, mdy, m, d, y dow := dayofweek(g) mdy := tomdy(g) m := mdy[1] d := mdy[2] y := mdy[3] return left(dow, 10) || right(m, 2, "0") || "/" || right(d, 2, "0") || "/" || (right(0<y, 4, "0") | (right(1-y, 4, "0") || "BC")) end ## dayofweek() - returns day of the week for a julian day number. procedure dayofweek(g) local dow dow := g % 7 if dow < 0 then dow +:= 7 return (dow+1)("Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday") end ## tomdy() - converts julian day number to a list [m,d,y]. procedure tomdy(g) local month, day, year, qc, c day := g - 1721117 - 1 # 3/1/0000 = 0 # eliminate gregorian calendar correction if g >= cutover then { qc := floor(day/146097.0) c := floor((day-qc*146097)/36525.0) day +:= c + qc*3 - 2 } year := floor((day*4+3)/1461.0) day -:= floor(year*1461/4.0) month := (day*5+2)/153 day := day - (month*153+2)/5 + 1 month +:= 3 if month > 12 then { month -:= 12 year +:= 1 } return [month, day, year] end ## floor() - rounds to an integer towards negative infinity. procedure floor(f) local i i := integer(f) if i > f then i -:= 1 return i end ## test() - Tests the date conversion routines by brute force, # by stepping through day by day through the years 1601 to 2000. # # procedure test() # local g, year, month, day, mdy # # g := julian(1, 1, 1601) # every year := 1601 to 2000 do { # every month := 1 to 12 do { # every day := 1 to ndays(year, month) do { # if year = 1752 & month = 9 & 2 < day < 14 then next # g1 := gregorian(month, day, year) # if g ~= g1 then # write("gregorian(", month, "/", day, "/", year, ") is ", # g1, ", should be ", g) # mdy := tomdy(g) # if mdy[1] ~= month | mdy[2] ~= day | mdy[3] ~= year then # write("tomdy(", g, ") is ", # mdy[1], "/", mdy[2], "/", mdy[3], # ", should be ", # month, "/", day, "/", year) # g +:= 1 # } # } # if year % 25 = 0 then write(year) # } # return # end # # procedure ndays(year, month) # local mdays # static stdyear, leapyear # # initial { # stdyear := [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31] # leapyear := [31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31] # } # # mdays := stdyear # if year % 4 = 0 then mdays := leapyear # if (1752 < year) % 400 = (100|200|300) then mdays := stdyear # return .mdays[month] # end @EOF chmod 664 jdate.icn exit 0