How to...? Convert Date of Birth to Age
[1/26] from: al::bri::xtra::co::nz at: 3-Jul-2002 11:07
Using Rebol (of course!), how would I convert a date of birth to an age in
years, months and days?
Andrew Martin
ICQ: 26227169 http://valley.150m.com/
[2/26] from: ammon:rcslv at: 2-Jul-2002 5:25
Hi,
I was going to say,
>>now/date - 1-Jan-1980
== 8218
What? Come again? How does [now/date - 1-Jan-1980] come up with 8218?
Any Ideas?
Ammon
A short time ago, Andrew Martin, sent an email stating:
[3/26] from: greggirwin:mindspring at: 2-Jul-2002 17:40
Hi Andrew,
<< Using Rebol (of course!), how would I convert a date of birth to an age
in
years, months and days? >>
Well, it's not exactly what you asked for, but it's a start. Maybe I'll mod
it later tonight.
(watch for wrap)
days-between: func [date-1[date!] date-2[date!]][
return date-1 - date-2
]
persons-age: func [
"Return a persons age, in years."
b-day [date!]
/precise "Include decimal portion of age."
/days "Return result as how many *days* old the person is."
/yrs-days "Return result as number of years and days (2 item block)."
/on "Use alternate date instead of current date, to figure age."
date
/local result
][
date: any [date now]
if days [return days-between date b-day]
if precise [return (days-between date b-day) / 365.25]
if yrs-days [return compose [(to-integer date - b-day / 365.25)(date -
b-day // 365.25)]]
; otherwise, take away 1 year if their birthday hasn't come yet this
year.
return date/year - b-day/year - either any [
(date/month > b-day/month) all [
(date/month = b-day/month)(date/day >= b-day/day)]] [0][1]
]
persons-age 23-dec-1964
persons-age/days 23-dec-1964
persons-age/yrs-days 23-dec-1964
persons-age/precise 23-dec-1964
persons-age/on-date 23-dec-1964 23-dec-2001
--Gregg
[4/26] from: nitsch-lists:netcologne at: 3-Jul-2002 1:49
Am Mittwoch, 3. Juli 2002 01:07 schrieb Andrew Martin:
> Using Rebol (of course!), how would I convert a date of birth to an age in
> years, months and days?
>
rough estimation:
birth: 1-Jan-1987 ;1-jan-2000 ;..
days: now - birth
s2k: 1-jan-2000 + days ;since-2k
print [
"since" birth ":" days "days ="
s2k/year - 2000 "years," s2k/month "month," s2k/day "days"
]
> Andrew Martin
> ICQ: 26227169 http://valley.150m.com/
> -><-
HTH!
-Volker
[5/26] from: otherchaz:mindspring at: 2-Jul-2002 16:55
>> now/date - 1-jul-2002
== 1
>> now/date - 1-jun-2002
== 31
totalDaysElapsed: now/date - 1-Jan-1980 ; days since 1-Jan-1980
== 8218
years: a / 365
== 22.5150684931507
yearRemainder: (b - 22) * 365;
== 188
months: c / 30
== 6.26666666666668
monthRemainder: d - 6
== 0.266666666666679
days: (d - 6) * 30
== 8.00000000000037
22 years, 6 months, 8 days, and some change.
[6/26] from: al:bri:xtra at: 3-Jul-2002 12:22
> I was going to say,
>
> >>now/date - 1-Jan-1980
> == 8218
>
> What? Come again? How does [now/date - 1-Jan-1980] come up with 8218?
8218 is the number of days.
Andrew Martin
ICQ: 26227169 http://valley.150m.com/
[7/26] from: al:bri:xtra at: 3-Jul-2002 12:26
After some thought (thanks Gregg!), I came up with this:
Age: function [Date1 [date!] Date2 [date!]] [Years Months Days] [
Years: Date1/year
Months: Date1/month
Days: subtract Date1/day Date2/day
if negative? Days [
Days: Days + pick system/locale/days-per-month Date1/month
all [
February? Date1
leap-year? Date1
Days: Days + 1
]
Months: Months - 1
]
Months: Months - Date2/month
if negative? Months [
Months: Months + 12
Years: Years - 1
]
Years: Years - Date2/year
reduce [Years Months Days]
]
Which also needs this:
; This is done during Rebol's start up process.
system/locale: make system/locale [
Days-Per-Month: [
31 ; January
28 ; February
31 ; March
30 ; April
31 ; May
30 ; June
31 ; July
31 ; August
30 ; September
31 ; October
30 ; November
31 ; December
]
]
...and this:
Leap-Year?: function [Date [date!]] [Year] [
Year: Date/year
any [
all [
0 = remainder Year 4
0 <> remainder Year 100
]
0 = remainder Year 400
]
]
But this solution, though I think it works, seems a bit too complicated.
Is there a more simpler way?
Andrew Martin
ICQ: 26227169 http://valley.150m.com/
[8/26] from: lmecir:mbox:vol:cz at: 3-Jul-2002 11:41
Hi Andrew,
There is a possibility to write the function as follows:
age: function [birth [date!] date [date!]] [years months days new] [
if date < birth [
return head insert age date birth '-
]
days: date/day - birth/day
if negative? days [
months: birth/month + 1
years: birth/year
if months > 12 [
months: 1
years: years + 1
]
new: to date! reduce [1 months years]
days: new - birth + date/day - 1
birth: new
]
months: date/month - birth/month
years: date/year - birth/year
if negative? months [
months: months + 12
years: years - 1
]
reduce [years months days]
]
-L
[9/26] from: g:santilli:tiscalinet:it at: 3-Jul-2002 12:31
Hi Ammon,
On Tuesday, July 02, 2002, 2:25:17 PM, you wrote:
AJ> What? Come again? How does [now/date - 1-Jan-1980] come up with 8218?
That's the number of days.
You could divide that by 365 to get your answer; well, you could
also do something like:
>> to-date reduce [1900 1 now/date - 1-jan-1980]
== 3-Jul-1922
that shows 22 years, 7 months and 3 days, but it would be
approximate anyway.
Regards,
Gabriele.
--
Gabriele Santilli <[g--santilli--tiscalinet--it]> -- REBOL Programmer
Amigan -- AGI L'Aquila -- REB: http://web.tiscali.it/rebol/index.r
[10/26] from: joel:neely:fedex at: 3-Jul-2002 8:21
Hi, Andrew,
Andrew Martin wrote:
> Using Rebol (of course!), how would I convert a date of birth to
> an age in years, months and days?
>
First a couple of observations:
- Date arithmetic is non-trivial; tricks with 365.25 (or 365.2425,
to be more precise ;-) days are fragile in the presence of leap
years.
- Keeping up with lots of boilerplate (e.g. days per month) offers
many opportunities for typos with subtle bugs.
- As with sorting, one can do things simply (trading away speed)
or highly tuned (trading away simplicity and clarity).
All of that said, here's a "bubble-sort-style" solution. It's not
a speed winner (and isn't suitable for large problems), but should
be obvious and clear enough that you can type it from memory any
time you need such a calculation. First, a version with comments
explaining the strategy:
8<----------------------------------------------------------------
datedelta: func [
bdate [date!] edate [date!]
/local result temp adjust
][
;
; ensure proper order
;
if bdate > edate [temp: bdate bdate: edate edate: temp]
;
; result = difference between bdate and temp (initially zero)
;
temp: reduce [bdate/year bdate/month bdate/day]
result: copy [0 0 0]
;
; function to modify a date component [y=1 m=2 d=3]
; in both result and temp by the same adjustment amount
;
adjust: func [pos [integer!] delta [integer!]] [
poke result pos result/:pos + delta
poke temp pos temp/:pos + delta
]
;
; tally difference in years, then months, then days
;
foreach datepart [1 2 3] [
;
; adjust up until overshoot
;
while [edate > to-date temp] [ adjust datepart 1 ]
;
; correct any overshoot
;
while [edate < to-date temp] [ adjust datepart -1 ]
]
;
; result = difference between bdate and temp
; temp = edate
; ergo result is final answer
;
result
]
8<----------------------------------------------------------------
... then a version without comments to help remember just the code:
8<----------------------------------------------------------------
datedelta: func [
bdate [date!] edate [date!]
/local result temp adjust
][
if bdate > edate [temp: bdate bdate: edate edate: temp]
temp: reduce [bdate/year bdate/month bdate/day]
result: copy [0 0 0]
adjust: func [pos [integer!] delta [integer!]] [
poke result pos result/:pos + delta
poke temp pos temp/:pos + delta
]
foreach datepart [1 2 3] [
while [edate > to-date temp] [adjust datepart 1]
while [edate < to-date temp] [adjust datepart -1]
]
result
]
8<----------------------------------------------------------------
HTH!
-jn-
--
; Joel Neely joeldotneelyatfedexdotcom
REBOL [] do [ do func [s] [ foreach [a b] s [prin b] ] sort/skip
do function [s] [t] [ t: "" foreach [a b] s [repend t [b a]] t ] {
| e s m!zauafBpcvekexEohthjJakwLrngohOqrlryRnsctdtiub} 2 ]
[11/26] from: pwoodward:cncdsl at: 3-Jul-2002 10:13
Hey -
why not use the follow approximation:
birthdate: day-month-year
today: now/date
daysold: today - birthdate
yearsold: to-integer daysold / 365.2425
Since to-integer always rounds down, you end up with an a relatively
accurate age. REBOL seems to be pretty good about date arithmetic
(accounting for leap years). I haven't tested the above that extensively,
but it's come up roses for friends and family.
- Porter
[12/26] from: lmecir:mbox:vol:cz at: 3-Jul-2002 16:42
Hi,
>> age 29/2/2004 28/2/2005
== [0 11 28]
>> datedelta 29/2/2004 28/2/2005
== [0 11 30]
>> age 29/2/2004 1/3/2005
== [1 0 1]
>> datedelta 29/2/2004 1/3/2005
== [1 0 0]
Which results are correct?
-L
[13/26] from: joel:neely:fedex at: 3-Jul-2002 14:04
Hi, Ladislav,
Ladislav Mecir wrote:
> >> age 29/2/2004 28/2/2005
> == [0 11 28]
<<quoted lines omitted: 4>>
> >> datedelta 29/2/2004 1/3/2005
> == [1 0 0]
Good questions, to which I'll add another:
If you were born on 29 Feb 2000, when did your next
birthday occur?
Given the irregularities in the current calendar scheme, I guess
I'd have to wonder about the purpose of the calculation before
forming opinions re date arithmetic including/surrounding leap
days.
-jn-
--
; Joel Neely joeldotneelyatfedexdotcom
REBOL [] do [ do func [s] [ foreach [a b] s [prin b] ] sort/skip
do function [s] [t] [ t: "" foreach [a b] s [repend t [b a]] t ] {
| e s m!zauafBpcvekexEohthjJakwLrngohOqrlryRnsctdtiub} 2 ]
[14/26] from: al:bri:xtra at: 4-Jul-2002 16:58
Joel Neely wrote:
> Good questions, to which I'll add another:
>
> If you were born on 29 Feb 2000, when did your next
> birthday occur?
>
> Given the irregularities in the current calendar scheme, I guess I'd have
to wonder about the purpose of the calculation before forming opinions re
date arithmetic including/surrounding leap days.
Birthday parties usually occur on the same day and month each year as one's
birthdate. If one is born on a leap-year day, like:
>> leap-year? 29/Feb/2000
== true
then one has less birthdays than most other people. But, one can still
calculate one's age as that's just the number of years, months and days that
have elapsed since one's birth date.
>> now
== 4-Jul-2002/16:56:42+12:00
>> probe age now 29/Feb/2000
make object! [
Years: 2
Months: 4
Days: 5
]
Age: function [
"Calulates Age in Years, Months & Days."
Date1 [date!]
Date2 [date!]
] [Difference Years Months Days] [
if Date1 < Date2 [
Years: Date1
Date1: Date2
Date2: Years
]
Difference: Date1 - Date2
Years: Date1/year
Months: Date1/month
Days: subtract Date1/day Date2/day
if negative? Days [
Months: Months - 1
Days: Days + pick system/locale/days-per-month either 1 <= Months [
Months
] [
length? system/locale/days-per-month
]
if all [
2 = Months ; Previous month = February?
leap-year? Date1
] [
Days: Days + 1
]
]
Months: Months - Date2/month
if negative? Months [
Years: Years - 1
Months: Months + 12
]
Years: Years - Date2/year
make object! compose [Years: (Years) Months: (Months) Days: (Days)]
]
Andrew Martin
ICQ: 26227169 http://valley.150m.com/
[15/26] from: lmecir:mbox:vol:cz at: 4-Jul-2002 11:43
Hi Andrew,
you probably missed my suggested change. AFAICT your function can yield
negative days sometimes.
Cheers
-L
[16/26] from: al:bri:xtra at: 5-Jul-2002 9:38
Ladislav wrote:
> you probably missed my suggested change.
I did too! Sorry.
> AFAICT your function can yield negative days sometimes.
You're right! I tried out comparing date with date from 1/1/1900 to 1/1/2000
and discovered that:
Age 30/01/1900 01/03/1900 ; My 'Age NOT Ladislav's age.
gives a negative day.
So I decided to replace my age value with your age value.
Thank you, Ladislav!
My 'Age function now looks like:
Age: function [
"Calulates Age in Years, Months & Days."
Birth [date!]
Date [date!]
] [Years Months Days New] [
if Date < Birth [
return Age Date Birth
]
Days: Date/day - Birth/day
if negative? Days [
Months: Birth/month + 1
Years: Birth/year
if Months > 12 [
Months: 1
Years: Years + 1
]
New: to date! reduce [1 Months Years]
Days: New - Birth + Date/day - 1
Birth: New
]
Months: Date/month - Birth/month
Years: Date/year - Birth/year
if negative? Months [
Months: Months + 12
Years: Years - 1
]
make object! compose [Years: (Years) Months: (Months) Days: (Days)]
]
And if people are interested in some tests:
26/10/2002 25/10/1960 [Years: 42 Months: 0 Days: 1]
25/10/2002 25/10/1960 [Years: 42 Months: 0 Days: 0]
24/10/2002 25/10/1960 [Years: 41 Months: 11 Days: 30]
01/03/2005 29/02/2004 [Years: 1 Months: 0 Days: 1]
28/02/2005 29/02/2004 [Years: 0 Months: 11 Days: 28]
02/03/2004 29/02/2004 [Years: 0 Months: 0 Days: 2]
01/03/2004 29/02/2004 [Years: 0 Months: 0 Days: 1]
29/02/2004 29/02/2004 [Years: 0 Months: 0 Days: 0]
01/03/2004 29/02/2000 [Years: 4 Months: 0 Days: 1]
29/02/2004 29/02/2000 [Years: 4 Months: 0 Days: 0]
30/01/1900 01/03/1900 [Years: 0 Months: 1 Days: 2]
Thanks again, Ladislav!
Andrew Martin
ICQ: 26227169 http://valley.150m.com/
[17/26] from: joel::neely::fedex::com at: 22-Oct-2002 18:46
Hi, Ladislav,
I'm long overdue to reply to this, but have had occasion to revisit
the "difference of dates" problem. For various obscure reasons,
substitue FWD-TOP for DATEDELTA in the snippet below.
Ladislav Mecir wrote:
> Hi,
> >> age 29/2/2004 28/2/2005
<<quoted lines omitted: 6>>
> == [1 0 0]
> Which results are correct?
The issue (which I didn't think through with sufficient precision
in the earlier discussion) is that we tend to expect all of these
statements to be equivalent:
last - first = difference
last - difference = first
first + difference = last
when, in fact, they are not equivalent for date "arithmetic". To
illustrate, consider the number of months/days between the dates
27-Jan-2004 and 03-Mar-2004. Working forward, we observe that:
27-Jan-2002 -> 27-Feb-2002 = 1 months 0 days
27-Feb-2002 -> 03-Mar-2002 = 0 months 4 days
--------------------------------------------
27-Jan-2002 -> 03-Mar-2002 = 1 months 4 days
but working backward, we find that:
03-Mar-2002 <- 03-Feb-2002 = 1 months 0 days
03-Feb-2002 <- 27-Jan-2002 = 0 months 7 days
--------------------------------------------
03-Mar-2002 <- 27-Jan-2002 = 1 months 7 days
and this difference resembles the difference between:
>> fwd-top 27-jan-2002 03-mar-2002 == [0 1 4]
>> age 27-jan-2002 03-mar-2002 == [0 1 7]
So, as you asked, which is "correct"?
I've concluded that there are two reasons for favoring the
behavior of FWD-TOP over AGE as follows:
Minor reason: We think of time as moving forward, rather than
backward, so if we must choose, let's use the
direction that matches our experience.
Major reason: 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. This
behavior is exhibited by FWD-TOP, but not by AGE, as shown in the
following example:
>> for target 29-mar-2004 03-apr-2004 1 [
[ print [target tab mold fwd-top 08-feb-2004 target]
[ ]
29-Mar-2004 [0 1 21]
30-Mar-2004 [0 1 22]
31-Mar-2004 [0 1 23]
1-Apr-2004 [0 1 24]
2-Apr-2004 [0 1 25]
3-Apr-2004 [0 1 26]
>> for target 29-mar-2004 03-apr-2004 1 [
[ print [target tab mold age 08-feb-2004 target]
[ ]
29-Mar-2004 [0 1 21]
30-Mar-2004 [0 1 22]
31-Mar-2004 [0 1 23]
1-Apr-2004 [0 1 22]
2-Apr-2004 [0 1 23]
3-Apr-2004 [0 1 24]
I have trouble with the idea that a baby born on 08-feb-2004 will
be the same age (in months/days) on 1-apr-2004 as (s)he was two
days earlier.
This is (to me, at least) an interesting demonstration of the
fact that the "real world" of everyday activity, and the "ideal
world" of computing, do not always correspond as nicely as we
programmers would like to think they do! ;-)
-jn-
PS: To save anyone the trouble of digging through dusty email
archives, the relevant function definitions appear below:
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]
]
age: function [birth [date!] date [date!]] [years months days new] [
if date < birth [
return head insert age date birth '-
]
days: date/day - birth/day
if negative? days [
months: birth/month + 1
years: birth/year
if months > 12 [
months: 1
years: years + 1
]
new: to date! reduce [1 months years]
days: new - birth + date/day - 1
birth: new
]
months: date/month - birth/month
years: date/year - birth/year
if negative? months [
months: months + 12
years: years - 1
]
reduce [years months days]
]
--
----------------------------------------------------------------------
Joel Neely joelDOTneelyATfedexDOTcom 901-263-4446
[18/26] from: lmecir:mbox:vol:cz at: 24-Oct-2002 20:41
Hi Joel,
----- Original Message -----
From: "Joel Neely"
> substitue FWD-TOP for DATEDELTA in the snippet below.
> > >> age 29/2/2004 28/2/2005
<<quoted lines omitted: 16>>
> first + difference = last
> when, in fact, they are not equivalent for date "arithmetic".
Exactly! That is why we must answer the question (Which results are
correct?) for our intented application.
> To
> illustrate, consider the number of months/days between the dates
<<quoted lines omitted: 16>>
> backward, so if we must choose, let's use the
> direction that matches our experience.
Good point! But what if we have got the origin? (E.g. the date of the
birth). Then we should use the counting direction pointing towards the other
date regardless of the fact whether we are counting forward. (see the
monotonicity discussion below)
> Major reason: 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. This
> behavior is exhibited by FWD-TOP,
it isn't ;-)
a: 8/2/2004
b: 1/2/2004
fwd-top a b ; == [0 0 7]
; while
b: 9/2/2004
fwd-top a b ; == [0 0 1]
Here is another candidate function:
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]
]
foreach [birth date] [
29/2/2004 28/2/2005
29/2/2004 1/3/2005
8/2/2004 1/2/2004
8/2/2004 29-Mar-2004
8/2/2004 30-Mar-2004
8/2/2004 31-Mar-2004
8/2/2004 1-Apr-2004
8/2/2004 2-Apr-2004
8/2/2004 3-Apr-2004
29/2/2004 29/2/2008
] [
foreach fnc [fwd-top age new-age] [print [fnc birth date mold do get fnc
birth date]]
]
[19/26] from: joel:neely:fedex at: 23-Oct-2002 15:56
Hi, Ladislav,
Read it again, please! ;-)
Ladislav Mecir wrote:
> > Major reason: Monotonicity. For two dates A and B, where A < B,
> > we would expect the difference between A and B
<<quoted lines omitted: 7>>
> b: 9/2/2004
> fwd-top a b ; == [0 0 1]
For two dates A and B, where A < B ...
===========
In the example you proposed, A is 8-Feb-2004 and B is 1-Feb-2004,
therefore you violated the precondition A < B. I'm afraid the
example you offered simply shows that one can find another date
that is *closer* to 8-Feb-2004 than is 1-Feb-2004.
The reason I stated the condition that way is that the function I
supplied computes the *absolute* difference between two dates; it
tells how far apart two dates are, leaving it up to the caller to
deal with before-versus-after comparisons on the dates themselves.
However, I'm quite happy to state the monotonicity condition in
another way:
Let C be the difference between two dates A and B. If the
larger of A and B is increased, or the smaller of A and B
is decreased, the new difference D should be larger than C.
All that amounts to is a more formal statement of the intent that
if the dates "get further apart" in the ordinary sense of that
phrase, then the computed difference should increase and not
zig-zag back and forth.
> Here is another candidate function:
>
> new-age: function [birth [date!] date [date!]] [
> years months days new
> ] [
...
> ]
>
Which raises the interesting question: what is the date exactly one
year and one month after 29-Jan-2000? ;-)
>> nyy: 2000
== 2000
>> nym: 1
== 1
>> nyd: 29
== 29
>> to-date reduce [nyy nym nyd]
== 29-Jan-2000
>> to-date reduce [nyy + 1 nym + 1 nyd]
== 1-Mar-2001
I believe that FWD-TOP returns triplets that are consistent with the
way REBOL converts blocks to dates.
>> base: 29-jan-2000
== 29-Jan-2000
>> base-blk: reduce [base/year base/month base/day]
== [2000 1 29]
>> target: 01-mar-2001
== 1-Mar-2001
>> incr-blk: fwd-top base target
== [1 1 0]
>> target = to-date for i 1 3 1 [append [] base-blk/:i +
incr-blk/:i]
== true
> Exactly! That is why we must answer the question (Which results
> are correct?) for our intented application.
>
We're *totally* in agreement on that point. The question, "How far
apart are two given dates, with the result represented in years,
months, and days?" is underspecified. However, I'm playing with the
related question, "Given an underspecified problem, are there some
properties that would make some solutions preferable to others?"
As an aside, there's a psychological component: if someone asked,
How many years, months, and days until 31-dec-2004?
we might
imagine that there's something significant about the number 31,
and respond that 30-nov-2002 is 2 years and 1 month exactly prior
to the target date, because the jump from one last-day-of-month
to another last-day-of-month would seem naturally to be some
number of whole months... However, the more such things enter into
our designs (at least unsolicited!) the more we are creating very
brittle objects that will undoubtedly surprise us at some point, or
exhibit some other inconsistency with a different use.
Just more evidence that programming is simple until we have to deal
with the "real world"! ;-)
-jn-
--
----------------------------------------------------------------------
Joel Neely joelDOTneelyATfedexDOTcom 901-263-4446
[20/26] 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
[21/26] from: joel:neely:fedex at: 25-Oct-2002 15:17
Hi, Ladislav,
Nice summary!
Let me add a few remarks and another alternative.
Ladislav Mecir wrote:
> I think, that it may be useful to summarize the results.
>
> The first candidate:
>
> fwd-top: func [
...
> ]
>
> Advantages:
>
> 1) Rebol compatibility
>
> > FWD-TOP returns triplets that are consistent with the
> > way REBOL converts blocks to dates.
>
In retrospect, I could have specified this option by saying:
For two dates A, B such that A <= B, return the "smallest"
triplet of (non-negative) values Y, M, D such that
b = to-date reduce [a/year + y a/month + m a/day + d]
> 2) Forward counting
> 3) Half-monotonicity
>
> Disadvantages:
>
> 1) "Unusual" results
>
This is unavoidable, if the REBOL compatibility criterion is
to be satisfied. For all solutions, "Usuality" and compatibility
with REBOL date arithmetic are mutually exclusive. Pick one.
> 2) Uni-directional counting
>
I was addressing the expanded problem of "difference between
two arbitrary dates" to avoid the semantic complications of
birthdays (see below).
To be fair, we could add:
3) Slow.
(However, I have another version that is equivalent but much
faster; benchmarks to follow later.)
> The second candidate:
>
> new-age: function [birth [date!] date [date!]] [
...
> ]
>
> Advantages:
>
> 1) "Usual" results
> 2) Birth-related counting direction
>
For a person born on 24-Aug-1977, what was that person's age
on 12-Aug-1974? Some would say that the question is meaningless,
in the same sense that
find [1 3 5 7 9 11] 2
evaluates to NONE.
> 3) Weak monotonicity
>
> Disadvantages:
>
> 1) Non-strict monotonicity
>
> The third candidate:
>
> strict-age: function [birth [date!] date [date!]] [
...
> Advantages:
>
> 1) Birth-related counting direction
> 2) Monotonicity / uniqueness
>
> Disadvantages:
>
> 1) "Unusual" results
>
By way of philosophy, let me offer another Grand Universal Principle
of software development:
When there are multiple arguably correct solutions to a
problem, push the decision up the food chain.
We can do this at requirements time by insisting on more rigorous
specification in advance, or we can do this at run time by making
the selection among alternatives available to the caller/user.
Therefore...
A fourth candidate:
ymd-sub: func [
left [date!] right [date!]
/local y m d not-yet? too-far? one i j k
][
either left <= right [
not-yet?: :greater?
too-far?: :lesser?
one: +1
][
not-yet?: :lesser?
too-far?: :greater?
one: -1
]
y: left/year
m: left/month
d: left/day
i: j: k: 0
while [not-yet? right to-date reduce [y m d]] [y: y + one i: i +
one]
while [too-far? right to-date reduce [y m d]] [y: y - one i: i -
one]
while [not-yet? right to-date reduce [y m d]] [m: m + one j: j +
one]
while [too-far? right to-date reduce [y m d]] [m: m - one j: j -
one]
while [not-yet? right to-date reduce [y m d]] [d: d + one k: k +
one]
while [too-far? right to-date reduce [y m d]] [d: d - one k: k -
one]
reduce [i j k]
]
which behaves as follows:
>> ymd-sub 28-jan-2000 3-mar-2000 == [0 1 4]
>> ymd-sub 3-mar-2000 28-jan-2000 == [0 -1 -6]
i.e., if the arguments are increasing, calculate the difference with
time running forward, but if the arguments are decreasing, calculate
the result with time moving backward. The results will be unambiguous
in the sense that forward differences are all non-negative (>= 0),
while backward differences are all non-positive (<= 0).
-jn-
--
----------------------------------------------------------------------
Joel Neely joelDOTneelyATfedexDOTcom 901-263-4446
[22/26] from: jan:skibinski:sympatico:ca at: 25-Oct-2002 21:01
Since there are already several proposals re dates difference
I am teasing with one more. Postconditions say it all.
Jan
=========================================
USAGE:
TRIPLET date2 date1
DESCRIPTION:
A triplet of average values [years months days]
representing a difference beteen two dates.
To be used for information, not for arithmetics.
TRIPLET is a function value.
ARGUMENTS:
date2 -- (Type: date)
date1 -- (Type: date)
POSTCONDITIONS:
[(total-days? result) == abs (date2 - date1)]
[result/1 >= 0]
[(result/2 >= 0) and (result/2 <= 366)]
[(result/3 >= 0) and (result/3 <= 31)]
=============================================
Pick up any random date y1....
No matter what your choice is the results will be always
identical with those below. I just used 'to-integer for truncating
but the algorithm could be improved upon by using a combination
of careful rounding and truncating.
>> triplet y1 (y1 - 0)
== [0 0 0]
>> triplet y1 (y1 - 1)
== [0 0 1]
>> triplet y1 (y1 + 1)
== [0 0 1]
>> triplet y1 (y1 + 30)
== [0 0 30]
>> triplet y1 (y1 + 31)
== [0 1 1]
>> triplet y1 (y1 + 60)
== [0 1 30]
>> triplet y1 (y1 + 61)
== [0 2 1]
>> triplet y1 (y1 + 365)
== [0 11 31]
>> triplet y1 (y1 + 366)
== [1 0 1]
[23/26] from: jan:skibinski:sympatico:ca at: 25-Oct-2002 21:31
OOPS, change from 366 to 12 in postcondition 3:
POSTCONDITIONS:
[24/26] from: lmecir:mbox:vol:cz at: 26-Oct-2002 9:49
Hi,
----- Original Message -----
From: "Joel Neely"
> In retrospect, I could have specified this option by saying:
>
> For two dates A, B such that A <= B, return the "smallest"
> triplet of (non-negative) values Y, M, D such that
>
> b = to-date reduce [a/year + y a/month + m a/day + d]
I would say the "largest" ? (but that doesn't matter, of course, because
everybody can see, what you mean)
-L
[25/26] from: joel:neely:fedex at: 27-Oct-2002 17:48
Hi, Ladislav,
Ladislav Mecir wrote:
> I would say the "largest" ? (but that doesn't matter, of course,
> because everybody can see, what you mean)
>
Hmmm... I need to think out loud more loudly! ;-)
The term "smallest" was stuck in my head because I also realized
that the algorithm could be considered a reasonably near cousin
of the standard solution of the "change-maker's problem":
For some currency X assume that you have an adequate supply of
bills and/or coins in denominations of
X50.00 X20.00 X10.00 X5.00 X1.00 X0.50 X0.25 X0.10 X0.05 X0.01
(e.g. in a cash drawer) and you are asked to provide some
amount of money less than X100.00 (e.g. change to a customer
for a purchase) using as the minimum number of bills/coins.
The "smallest" solution (smallest number of pieces of money) can be
had by iterating across the denominations from largest to smallest
and counting out the maximum number of each denomination that does
not exceed the remaining balance, deducting each bill/coin from the
remaining balance as dispensed. Ergo, "smallest" in the sense of
minimizing the total of the (three, in this case) elements in the
result block.
The quotation marks were intended as an (obviously inadequate) hint
that normal LESSER? comparison was not the metric in mind.
Sorry for not being more clear!
-jn-
--
; Joel Neely joeldotneelyatfedexdotcom
REBOL [] do [ do func [s] [ foreach [a b] s [prin b] ] sort/skip
do function [s] [t] [ t: "" foreach [a b] s [repend t [b a]] t ] {
| e s m!zauafBpcvekexEohthjJakwLrngohOqrlryRnsctdtiub} 2 ]
[26/26] from: ingo:2b1 at: 11-Nov-2002 1:06
Hi,
I was searching for a function like this for a faq entry, but all your
examples seem much too advnced for the intended audience, so I made up
this silly little function:
my-age: func [
a b
/local t y m d
][
if a > b [t: a a: b b: t]
y: b/year - a/year
m: b/month - a/month
d: b/day - a/day
if d < 0 [
d: a/day + d
m: m - 1
]
if m < 0 [
m: 12 + m
y: y - 1
]
reduce [y m d]
]
mind you, it's 1:00 am now and _looong_ past my bed-time.
Kind regards,
Ingo
Notes
- Quoted lines have been omitted from some messages.
View the message alone to see the lines that have been omitted
Librarian comment
Recent versions of REBOL allow difference to work on dates, giving a result in hours: