#!/usr/local/bin/apl --script
⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝
⍝
⍝ date 2016-11-29 12:51:06 (GMT-5)
⍝
⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝
⍝ date workspace implements lillian dates
⍝ Copyright (C) 2016 Bill Daly
⍝ This program is free software: you can redistribute it and/or modify
⍝ it under the terms of the GNU General Public License as published by
⍝ the Free Software Foundation, either version 3 of the License, or
⍝ (at your option) any later version.
⍝ This program is distributed in the hope that it will be useful,
⍝ but WITHOUT ANY WARRANTY; without even the implied warranty of
⍝ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
⍝ GNU General Public License for more details.
⍝ You should have received a copy of the GNU General Public License
⍝ along with this program. If not, see .
)copy 1 util
∇date←date∆lillian ts;b1;b2;b3;yrs;days
⍝ Function to convert time stamp dates to lillian dates
ts[1]←ts[1]-date∆dates lex∆lookup 'Year 0'
⍝yrs←¯1+⍳ts[1]
yrs←⍳ts[1]
b1←0=400|yrs
b2←0=100|(~b1)/yrs
b3←0=4|(~b2)/(~b1)/yrs
days←(b3×366)+(~b3)×365
days←(b2×365)+(~b2)\days
days←(b1×366)+(~b1)\days
ix←1+365=days[ts[1]]
date←+/¯1↓days
date←date++/(ts[2]-1)↑date∆cal[ix;]
date←date+ts[3]
date←date-date∆dates lex∆lookup 'Pre lillian'
⎕es (date ≤ 0)/'PRE LILLIAN DATE'
∇
∇days←date∆marshalYears ts;yrs;b1;b2;b3
⍝ Function to assemble vector of days in each year starting with rarg
yrs←⍳''⍴ts-date∆dates lex∆lookup 'Year 0'
b1←0=400|yrs
b2←0=100|(~b1)/yrs
b3←0=4|(~b2)/(~b1)/yrs
days←(b3×366)+(~b3)×365
days←(b2×365)+(~b2)\days
days←(b1×366)+(~b1)\days
∇
∇ts←date∆unlillian date;yrs;b1;b2;b3;ix
⍝ Function to covert a lillian date to a ts formatted date.
date←date + date∆dates lex∆lookup 'Pre lillian'
yrs←⍳2+⌈date÷365.25
b1←0=400|yrs
b2←0=100|(~b1)/yrs
b3←0=4|(~b2)/(~b1)/yrs
days←(b3×366)+(~b3)×365
days←(b2×365)+(~b2)\days
days←(b1×366)+(~b1)\days
ts←3⍴0
ts[1]←1++/date>+\days
date←date-+/days[⍳ts[1]-1]
ix←1+365=days[ts[1]]
ts[2]←+/date>+\date∆cal[ix;]
ts[3]←date-+/date∆cal[ix;⍳ts[2]]
ts[1]←ts[1] + date∆dates lex∆lookup 'Year 0'
ts[2]←ts[2]+1
∇
∇ts←locale date∆parse str;num;epoch
⍝ Function to parse a string and return a integer vector of year, month, day.
⍝ One ISO 8601 format
⍎(util∆numberp str)/'ts←''NOT TEXT''◊→0'
str← date∆delim util∆split str
→(∧/~num←util∆numberis ¨ str)/err
str[num/⍳⍴num]←⍎,' ',⊃num/str
→(3=⍴ts←locale date∆parse∆ISO str)/tests
→(3=⍴ts←locale date∆parse∆long str)/tests
→(3=⍴ts←locale date∆parse∆short str)/tests
tests:
epoch←locale lex∆lookup 'epoch'
→(ts[1]=0)/er2 ⍝ Year tests failed
→((ts[1]=epoch[1])^ts[2]12)/err
max_days←(locale lex∆lookup 'days')[ts[2]]
mex_days←max_days+date∆US date∆parse∆leap_day ts
→((ts[3]<1)∨ts[3]>max_days)/err
→0
err:
ts←'NOT A DATE'
→0
er2:
ts←'DATE BEFORE EPOCH STARTING ','0006-06-06'⍕epoch
→0
∇
∇dt←locale date∆parse∆ISO txt
⍝ Function attempts to convert text in an ISO 8601 format to a date
⍝ made up of year month day.
dt←3⍴0
→(3=⍴txt)/extended
→(1≠⍴txt)/err
basic_iso:
dt[1]←⌊txt÷10000
txt←10000 | txt
dt[2]←⌊txt÷100
dt[3]←100 | txt
→0
extended:
→(3≠+/util∆numberp ¨ txt)/err
→(0=⍴dt[1]←locale date∆test∆year txt)/err
→(dt[1]=txt[1])/iso_date
dt[2 3]←txt[(locale lex∆lookup 'month_pos'),locale lex∆lookup 'day_pos']
→0
iso_date:
dt←txt
→0
err:
dt←''
→0
∇
∇dt←locale date∆parse∆leap_day ts;leap_month
⍝ Function returns 1 if the leap-month number of days should be incremented.
leap_month←locale lex∆lookup 'leap-month'
→(~dt←ts[2]=leap_month)/0
→(dt←0=400|ts[1])/0
→(~dt←0≠100|ts[1])/0
dt←0=4|ts[1]
∇
∇dt←locale date∆parse∆long txt
⍝ Function attempts to convert test in a long, spelled out form to a
⍝ date made up of year month day.
dt←3⍴0
'→err' ⎕ea 'dt[2]←(locale lex∆lookup ''months'') util∆stringSearch util∆lower ⊃txt[1]'
→(∨/0≠≡¨txt[2 3])/err
dt[1]←txt[3]
dt[3]←txt[2]
→0
err:
dt←''
→0
∇
∇dt←locale date∆parse∆short txt;m
⍝ Function attempts to convert text in a short abbreviate form to a
⍝ date made up of year month day.
dt←3⍴0
m←locale lex∆lookup 'MTH'
'→mil' ⎕ea 'dt[2]←m util∆stringSearch util∆upper ⊃txt[1]'
dt[1]←txt[3]
dt[3]←txt[2]
→0
mil: ⍝ Try military format
'→err' ⎕ea 'dt[2]←m util∆stringSearch util∆upper ⊃txt[2]'
dt[1]←txt[3]
dt[3]←txt[1]
→0
err:
dt←''
→0
∇
∇yr←locale date∆test∆year dt;e;t
⍝ Function called when all three elements of a date are numeric to
⍝ determine what the year is.
yr←dt[1] ⍝ We try ISO dates first
→(yr≥e←1↑locale lex∆lookup 'epoch')/0
yr←dt[locale lex∆lookup 'year_pos']
→(yr≥e)/0
→((dt[1]>1000)∨yr≥100)/err
t←locale lex∆lookup 'two-digit-cutoff'
yr←yr+(1900 2000)[1+(yr>0)∧yr