REBOL [
Title: "Age"
Date: 5-Jul-2002/9:20
Name: Age
Version: 2.0.0
File: %Age.r
Author: "Andrew Martin"
Needs: [%Days-Per-Month.r]
Purpose: "Calulates Age in Years, Months & Days."
Email: Al.Bri@xtra.co.nz
Web: http://valley.150m.com
Category: [math util 5]
Acknowledgements: [
"Ladislav Mecir"
]
]
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)]
]
comment [
; My faulty 'Age function. Gives a negative day for:
age 30/01/1900 01/03/1900 [Years: 0 Months: 1 Days: 2]
Age: function [
"Calulates Age in Years, Months & Days."
Date1 [date!]
Date2 [date!]
] [Difference Years Months Days] [
if Date1 < Date2 [
return Age Date2 Date1
]
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)]
]
]