[REBOL] Re: How to...? Convert Date of Birth to Age
From: lmecir:mbox:vol:cz at: 24-Oct-2002 11:08
Hi,
I think, that it may be useful to summarize the results.
The first candidate:
fwd-top: func [
lo [date!] hi [date!]
/local y m d i j k
][
if hi < lo [k: lo lo: hi hi: k]
y: lo/year
m: lo/month
d: lo/day
i: j: k: 0
while [hi > to-date reduce [y m d]] [y: y + 1 i: i + 1]
while [hi < to-date reduce [y m d]] [y: y - 1 i: i - 1]
while [hi > to-date reduce [y m d]] [m: m + 1 j: j + 1]
while [hi < to-date reduce [y m d]] [m: m - 1 j: j - 1]
while [hi > to-date reduce [y m d]] [d: d + 1 k: k + 1]
while [hi < to-date reduce [y m d]] [d: d - 1 k: k - 1]
reduce [i j k]
]
Advantages:
1) Rebol compatibility
> FWD-TOP returns triplets that are consistent with the
> way REBOL converts blocks to dates.
2) Forward counting
The difference is computed counting forward in time.
3) Half-monotonicity
For two dates A and B, where A < B, we would expect the difference between A
and B
(in whatever representation) to increase as B increases.
Disadvantages:
1) "Unusual" results
>> fwd-top 31/1/2002 5/3/2002
== [0 1 2]
>> fwd-top 29/2/2004 1/3/2005
== [1 0 0]
2) Uni-directional counting
>> fwd-top 3/1/2002 2/1/2002
== [0 0 1]
>> fwd-top 3/1/2002 4/1/2002
== [0 0 1]
The second candidate:
new-age: function [birth [date!] date [date!]] [
years months days new
] [
days: date/day - birth/day
either date < birth [
if positive? days [
new: to date! reduce [birth/day date/month + 1 date/year]
if new/day <> birth/day [
new: to date! reduce [0 date/month + 2 date/year]
]
days: date - new
date: new
]
months: date/month - birth/month
years: date/year - birth/year
if positive? months [
months: months - 12
years: years + 1
]
] [
if negative? days [
new: to date! reduce [birth/day date/month - 1 date/year]
if new/day <> birth/day [
new: to date! reduce [0 date/month date/year]
]
days: date - new
date: new
]
months: date/month - birth/month
years: date/year - birth/year
if negative? months [
months: months + 12
years: years - 1
]
]
reduce [years months days]
]
Advantages:
1) "Usual" results
>> new-age 31/1/2002 5/3/2002
== [0 1 5]
>> new-age 29/2/2004 1/3/2005
== [1 0 1]
2) Birth-related counting direction
The counting starts from the BIRTH and goes towards the DATE
>> new-age 3/1/2002 2/1/2002
== [0 0 -1]
>> new-age 3/1/2002 4/1/2002
== [0 0 1]
3) Weak monotonicity
For dates A, B, C, D, for which C <= A and D >= B holds, that (new-age a b)
<= (new-age c d)
Disadvantages:
1) Non-strict monotonicity
We can obtain equal results for (new-age a b) and (new-age c b) even if (a
<> c). This means, that given a date and a new-age we aren't able to
uniquely determine the birth date.
>> new-age 30/1/2004 5/3/2004
== [0 1 5]
>> new-age 31/1/2004 5/3/2004
== [0 1 5]
The third candidate:
strict-age: function [birth [date!] date [date!]] [
years months days new direction
] [
days: date/day - birth/day
direction: either date < birth [-1] [1]
if negative? days * direction [
new: to date! reduce [birth/day date/month - direction date/year]
if new/day <> birth/day [
new: to date! reduce [birth/day date/month - direction -
direction date/year]
]
if not positive? date - new * direction [return reduce [0 0 date -
birth]]
days: date - new
date: new
]
months: date/month - birth/month
years: date/year - birth/year
if negative? months * direction [
months: months + (12 * direction)
years: years - direction
]
reduce [years months days]
]
Advantages:
1) Birth-related counting direction
The counting starts from the BIRTH and goes towards the DATE
>> strict-age 3/1/2002 2/1/2002
== [0 0 -1]
>> strict-age 3/1/2002 4/1/2002
== [0 0 1]
2) Monotonicity / uniqueness
For dates A, B, C holds, that if C < A, then (STRICT-AGE A B) < (STRICT-AGE
C B). If C > B, then (STRICT-AGE A B) < (STRICT-AGE A C). For a given
STRICT-AGE and a given DATE we can find the corresponding BIRTH date.
Disadvantages:
1) "Unusual" results
>> strict-age 31/1/2002 5/3/2002
== [0 0 33]
>> strict-age 29/2/2004 1/3/2005
== [0 11 31]
Cheers
-L
