Compute a person's age today based on his date of birth.

[Deleter]

Deleter,

I compiled your solution and ran a few tests using valid data, and it ran ok.

I have the following comments which I hope you take in a constructive manner:

1) Minor point: You did not input the date of birth, you inserted one into a variable.

2) You did not perform any validation on the input date of birth. No wonder the problem became elementary.

3) In obtaining the current date using DATE$, you invoked the DATE$ function three separate times. This could rarely happen, but if you were running the program just at midnight, then you could get two different dates, before midnight and after midnight, which would affect your final year, month, day.

If you'd like, you can fix up your program and submit it again.
*****

cool. I am not ignorant enough to take critism as an insult, seeing as most of the time, its the opposite. Thanks for pointing these things out, I'm glad you did. I am not aware of one tenth of all the nuances there are, the date$ thing being one of them. Since I was rewriting it, I decided to make it able to tell you how many days until your next birthday as well. This will probably contain more bugs/things to fix, so, tell me all of them, I would prefer it.

Code:

declare function maxday(month as integer, year as integer)
declare function daystillbday(cmonth as integer, bmonth as integer, cday as integer, bday as integer, cyear as integer)
print "Type 'X' to exit"
do
    input$ "Birthdate (YYYYMMDD)", birth$
    if ucase$(left$(birth$, 1)) = "X" then exit do
    cdate$ = date$
    cyear = val(mid$(cdate$, 7, 4))
    cmonth = val(mid$(cdate$,1,2))
    cday = val(mid$(cdate$, 4, 2))
    byear = val(mid$(birth$, 1, 4))
    bmonth = val(mid$(birth$, 5,2))
    if bmonth < 1 or bmonth > 12 then byear = cyear+1
    bday = val(mid$(birth$,7,2))
    if bday < 1 or bday > maxday(bmonth, byear) then byear = cyear+1
    age = (cyear - byear) - 1
    if bmonth <= cmonth then
        if bday <= cday or bmonth < cmonth then
            age = age + 1
        end if
    end if
    if age < 0 then
        print "Invalid birthdate"
    elseif age < 1 then
        print cmonth-bmonth; " months old for "; daystillbday(cmonth,bmonth,cday,bday,cyear); " more days"
    elseif age = 1 then
        print age; " year old for "; daystillbday(cmonth,bmonth,cday,bday,cyear); " more days"
    elseif age > 1 then
        print age; " years old for "; daystillbday(cmonth,bmonth,cday,bday,cyear); " more days"
    end if    
loop
end

function maxday(month as integer, year as integer)
    '1-31, 2-28, 3-31, 4-30, 5-31, 6-30, 7-31, 8-31, 9-30, 10-31, 11-30, 12-31
    maxday = 30
    if month/2 <> int(month/2) and month < 8 then maxday=31
    if month=2 and (year mod 4) <> 0 then maxday=28
    if month=2 and (year mod 4) = 0 then maxday = 29
    if month>7 and month/2 = int(month/2) then maxday = 31
end function

function daystillbday(cmonth as integer, bmonth as integer, cday as integer, bday as integer, cyear as integer)
    if cmonth < bmonth or (cmonth = bmonth and cday < bday) then
        for x = cmonth to bmonth-1
            tdaystillbday = tdaystillbday + maxday(x, cyear)
        next x
        tdaystillbday = tdaystillbday+bday-cday
    elseif (cmonth > bmonth) or (cmonth=bmonth and cday >= bday) then
        for x = cmonth to 12
            tdaystillbday = tdaystillbday +maxday(x, cyear)
        next x
        tdaystillbday=tdaystillbday-cday
        for x = 1 to bmonth-1
            tdaystillbday = tdaystillbday+maxday(x, cyear+1)
        next x
        tdaystillbday=tdaystillbday+bday
    end if
    daystillbday=tdaystillbday
end function

[Neo]

It looks good, I only have one remark though:

The Gregorian calendar adds an extra day to February, making it 29 days long, in years where the quotient has no remainder when divided by 4, excluding years where the quotient has no remainder when divided by 100, but including years where the quotient has no remainder when divided by 400.

I'm sure Moneo would have said something about this, so I post it here too

[Moneo]

Neo,

I'll test you new function/formula as soon as possible.

I'm going to have to write a test program which loops to generate the age for say the last 100 years, day by day, using a known accurate algorithm. Given this, I can plug in submittted solutions like yours and verify their performance. Give me some time.

By the way, your date of birth validation checks for a valid date. However, in the case of the given problem, it should also check that the date of birth is not in the future. Do you agree?
*****

[Moneo]

Deleter,

Like I just told Neo, I'll test your new solution as soon as possible.

I see you're in a good mood, so do me a favor. Please don't add any additional goodies to the specifications. What this does is make my testing more complicated.

Neo's comment regarding your leapyear calculation is true. The logic is incomplete. See the function called IsLeapYear in Neo's code. We both share this function and it has been actively running for years. You are welcome to use it.

Since you have to make a change, take this opportunity to remove any extra goodies that you added. Thanks.

I also told Neo the following:
I'm going to have to write a test program which loops to generate the age for say the last 100 years, day by day, using a known accurate algorithm. Given this, I can plug in submittted solutions like yours and verify their performance. Give me some time.
*****

[Neo]

Moneo,

I hoped you could test both functions, as I did myself. The first one should return correct answers (if you disregard leaplings), and I tested the second one, which returned an invalid age (always +1) after 20 thousand random dates (with checks).

By the way, your date of birth validation checks for a valid date. However, in the case of the given problem, it should also check that the date of birth is not in the future. Do you agree?

Yes actually I should have implemented it.


I'll update you soon with something new.

[Neo]

Sorry moneo, final update.

Code:

Private Function getPersonAge (Year As Integer, Month As Integer, Day As Integer, _
                               NowYear As Integer, NowMonth As Integer, NowDay As Integer) As Integer    
    If (NowMonth > Month) Or (NowMonth = Month And NowDay >= Day) Then getPersonAge = NowYear - Year Else getPersonAge = NowYear - Year - 1    
End Function

this is the simplest (at least) functional code I could think of.

I now did it in all 3 possible ways...
- Using a loop: will return the correct results, except from leaplings
- Using average calculation: will mostly return correct results and sometimes return ages that are +1 or -1
- Using conditional checks: will probably (only tested 80000 times yet) return correct results, including leaplings.

Now I'll be quiet so you can have the time to check these 3 (I'm pretty sure the latest 3-liner update can't be shortened anymore).

I apologize for another piece of code. This is my last submission (and probably the best working one too... :roll.

[shiftLynx]

Written in FreeBASIC; should work in QBASIC.

[syntax="QBasic"]
' Current Age Calculator
' 10-Jun-2005
'
' shiftlynx
' c.g.davies@gmail.com
'

'-----------------------------------------------------------------------------
' Custom Type Declarations
'
type Date
year as integer
month as integer
day as integer
end type

'-----------------------------------------------------------------------------
' Function Declarations
'
declare sub parseDate(dateString as string, target as Date)
declare sub parseDashedDate(dateString as string, target as Date)
declare function isValidDate%(obj as Date)
declare function getDays&(obj as Date)

'-----------------------------------------------------------------------------
' Main
'
dim dateIn as Date
dim dateCurrent as Date
dim dayDifference as long
dim age as long

cls
line input "Date of Birth: ", strdate$

' parse the date strings.
parseDate(strdate$, dateIn)
parseDashedDate(date$, dateCurrent)

' validate the dates.
if isValidDate%(dateIn) = 0 then
print "Invalid date entered."
end
end if

if isValidDate%(dateCurrent) = 0 then
print "Failed to parse current date."
end
end if

' calculate the day difference.
dayDifference = getDays&(dateCurrent) - getDays&(dateIn)

' make sure the date entered wasn't in the future.
if dayDifference < 0 then
print "Invalid date of birth; it hasn't happened yet."
end
end if

' calculate the number of complete years.
age = int(dayDifference / 365.25)

' output the age.
print "Age: " + ltrim$(str$(age))

print "Press a key to exit..."
while inkey$ = "": wend



sub parseDate(dateString as string, target as Date)

' reset the structure.
target.day = 0
target.month = 0
target.year = 0

' check that we have a valid length (must be YYYYMMDD).
if len(dateString) <> 8 then exit sub

' extract the components.
target.year = val(mid$(dateString, 1, 4))
target.month = val(mid$(dateString, 5, 2))
target.day = val(mid$(dateString, 7, 2))

end sub



sub parseDashedDate(dateString as string, target as Date)

' reset the structure.
target.day = 0
target.month = 0
target.year = 0

' just make sure that the length of the date isn't too small.
' smallest date... x/x/xxxx = 8 chars.
if len(dateString) < 8 then exit sub

' store a "working-string".
tempStr$ = dateString

' extract the month.
slash% = instr(tempStr$, "-")
if slash% > 0 then
target.month = val(left$(dateString, slash% - 1))
tempStr$ = right$(tempStr$, len(tempStr$) - slash%)
else
exit sub
end if

' extract the day.
slash% = instr(tempStr$, "-")
if slash% > 0 then
target.day = val(left$(tempStr$, slash% - 1))
tempStr$ = right$(tempStr$, len(tempStr$) - slash%)
else
exit sub
end if

' extract the year.
target.year = val(tempStr$)

end sub



function isValidDate%(obj as Date)

' check for obvious errors.
if obj.day < 1 or obj.day > 31 or obj.month < 1 or obj.month > 12 or obj.year < 0 then
isValidDate% = 0
exit function
end if

' now check specific errors.
select case obj.month
case 2:
if (obj.year and 3) = 0 then
if obj.day > 29 then
isValidDate% = 0
exit function
end if
else
if obj.day > 28 then
isValidDate% = 0
exit function
end if
end if
case 4, 6, 9, 11:
if obj.day > 30 then
isValidDate% = 0
exit function
end if
end select

' looks okay.
isValidDate% = 1

end function



function getDays&(obj as Date)

dim cumulativeMonthDays(1 to 12) as long

' ensure we're dealing with a valid date.
if isValidDate%(obj) = 0 then
getDays& = -1
exit function
end if

' calculate the days from the year and the day.
days& = int(obj.year * 365.25) + obj.day

' now to process the month field...

' check if we need to account for an extra day in February.
if (obj.year and 3) = 0 then
dayCount& = 1
else
dayCount& = 0
end if

' set up the month days array.
cumulativeMonthDays(1) = 0
dayCount% = dayCount& + 31 ' jan
cumulativeMonthDays(2) = 31
dayCount& = dayCount& + 28 ' feb
cumulativeMonthDays(3) = dayCount&
dayCount& = dayCount& + 31 ' mar
cumulativeMonthDays(4) = dayCount&
dayCount& = dayCount& + 30 ' apr
cumulativeMonthDays(5) = dayCount&
dayCount& = dayCount& + 31 ' may
cumulativeMonthDays(6) = dayCount&
dayCount& = dayCount& + 30 ' jun
cumulativeMonthDays(7) = dayCount&
dayCount& = dayCount& + 31 ' jul
cumulativeMonthDays(8) = dayCount&
dayCount& = dayCount& + 31 ' aug
cumulativeMonthDays(9) = dayCount&
dayCount& = dayCount& + 30 ' sep
cumulativeMonthDays(10) = dayCount&
dayCount& = dayCount& + 31 ' oct
cumulativeMonthDays(11) = dayCount&
dayCount& = dayCount& + 30 ' nov
cumulativeMonthDays(12) = dayCount&

' now add the month days on to the day total.
days& = days& + cumulativeMonthDays(obj.month)

' set the return value.
getDays& = days&

end function
[/syntax]

[Deleter]

ok, extra chopped off, definition of leap year corrected and its ready to roll (I hope )

Code:

declare function maxday(month as integer, year as integer)

print "Type 'X' to exit"
do
    input$ "Birthdate (YYYYMMDD)", birth$
    if ucase$(left$(birth$, 1)) = "X" then exit do
    cdate$ = date$
    cyear = val(mid$(cdate$, 7, 4))
    cmonth = val(mid$(cdate$,1,2))
    cday = val(mid$(cdate$, 4, 2))
    byear = val(mid$(birth$, 1, 4))
    bmonth = val(mid$(birth$, 5,2))
    if bmonth < 1 or bmonth > 12 then byear = cyear+1
    bday = val(mid$(birth$,7,2))
    if bday < 1 or bday > maxday(bmonth, byear) then byear = cyear+1
    age = (cyear - byear) - 1
    if (bmonth <= cmonth) and (bday <= cday or bmonth < cmonth) then
            age = age + 1
    end if
    if byear < 0 then byear = cyear+1
    if age < 0 then
        print "Invalid birthdate"
    elseif age < 1 then
        print cmonth-bmonth; " months old"
    elseif age = 1 then
        print age; " year old"
    elseif age > 1 then
        print age; " years old"
    end if    
loop
end

function maxday(month as integer, year as integer)
    tmaxday = 30
    if (month/2 <> int(month/2) and month < 8) or (month>7 and month/2 = int(month/2)) then tmaxday=31
    if month=2 and ((year mod 4 <> 0) or (year mod 100 = 0)) then tmaxday=28
    if (((month=2 and year mod 4 = 0) and year mod 100 <> 0) or (year mod 400 = 0))=-1 then tmaxday = 29
    maxday=tmaxday
end function

edit: added if statment to make sure year was greater than or equal to 0

[Neo]

Okay, as everyone is posting new updates, I put my latest updates together in one file, ready for execution.

Code:

Option Static
Option Explicit

Declare Function convertDate (Dat As String, YY As Integer, MM As Integer, DD As Integer) As Byte
Declare Function isValidDate (Year As Integer, Month As Integer, Day As Integer) As Byte
Declare Function isLeapYear (Year As Integer) As Byte
Declare Function getPersonAge (Year As Integer, Month As Integer, Day As Integer, _
                               NowYear As Integer, NowMonth As Integer, NowDay As Integer) As Integer

'@ Ask the user for input YYYYMMDD and check if it's valid
Dim Datum As String, isOk As Byte
Dim Year As Integer, Month As Integer, Day As Integer
Do
    Input "Enter a valid birthday in format YYYYMMDD: ", Datum    
    isOk = convertDate(Datum, Year, Month, Day)      
    If Not( isOk ) Then Print "Invalid entry"
Loop Until isOk

'@ Get the current Date (format MM-DD-YYYY)
Dim CurrYear As Integer, CurrMonth As Integer, CurrDay As Integer
If convertDate(Date$, CurrYear, CurrMonth, CurrDay) = 0 Then Print "Current date is invalid": End

'@ Get persons age and print it
Dim rAge As Integer
rAge = getPersonAge(Year, Month, Day, CurrYear, CurrMonth, CurrDay)
If rAge > 0 Then
    Print "Persons age: "; rAge
Else
    If Year > CurrYear Or (Year = CurrYear And Month > CurrMonth) Or (Year = CurrYear And Month = CurrMonth And Day > CurrDay) Then
        Print "This person is yet to be born"
    Else
        Print "Persons age: "; rAge
    End If    
End If

Sleep
End


Private Function convertDate (Dat As String, YY As Integer, MM As Integer, DD As Integer) As Byte
    Dim NumberStr As String , i As Integer
    NumberStr = "0123456789"
    If Len(Dat) <> 8 And Len(Dat) <> 10 Then
        convertDate = 0: Exit Function
    ElseIf Len(Dat) = 8 Then
        For i = 0 To 7
            If Instr(NumberStr, Mid$(Dat, i + 1, 1)) = 0 Then convertDate = 0: Exit Function
        Next i                
        YY = Val(Left$(Dat, 4))
        MM = Val(Mid$(Dat, 5, 2))
        DD = Val(Right$(Dat, 2))            
        convertDate = isValidDate(YY, MM, DD)
    ElseIf Len(Dat) = 10 Then
        For i = 0 To 9
            If i = 2 Or i = 5 Then
                If Mid$(Dat, i + 1, 1) <> "-" Then convertDate = 0: Exit Function
            Else
                If Instr(NumberStr, Mid$(Dat, i + 1, 1)) = 0 Then convertDate = 0: Exit Function
            End If            
        Next i        
        YY = Val(Right$(Dat, 4))
        MM = Val(Left$(Dat, 2))
        DD = Val(Mid$(Dat, 4, 2))
        convertDate = isValidDate(YY, MM, DD)
    End If  
End Function


Private Function getPersonAge (Year As Integer, Month As Integer, Day As Integer, _
                               NowYear As Integer, NowMonth As Integer, NowDay As Integer) As Integer    
    If (NowMonth > Month) Or (NowMonth = Month And NowDay >= Day) Then getPersonAge = NowYear - Year Else getPersonAge = NowYear - Year - 1
End Function

Private Function isValidDate (Year As Integer, Month As Integer, Day As Integer) As Byte
    '@ Checks if a year is a valid year
    If Year < 0 Then isValidDate = 0: Exit Function
    If Month < 1 Then isValidDate = 0: Exit Function
    If Day < 1 Then isValidDate = 0: Exit Function
    
    If Month > 12 Then isValidDate = 0: Exit Function
    
    Dim MaxDay As Integer
    Select Case Month
        Case 1, 3, 5, 7, 8, 10, 12 : MaxDay = 31
        Case 4, 6, 9, 11: MaxDay = 30        
        Case 2: MaxDay = 28 + Abs(isLeapYear(Year))        
    End Select    
    
    If Day > MaxDay Then isValidDate = 0: Exit Function
    
    isValidDate = -1
End Function

Private Function isLeapYear (Year As Integer) As Byte
    isLeapYear = ((Year MOD 4 = 0) AND (Year MOD 100 <> 0)) OR (Year MOD 400 = 0)
End Function

And shiftLynx... also for you holds the same as I said to Deleter a while ago

The Gregorian calendar adds an extra day to February, making it 29 days long, in years where the quotient has no remainder when divided by 4, excluding years where the quotient has no remainder when divided by 100, but including years where the quotient has no remainder when divided by 400.

[shiftLynx]

[syntax="QBasic"]
' Current Age Calculator
' 10-Jun-2005
'
' shiftlynx
' c.g.davies@gmail.com
'
' Changes:
' [10-Jun-2005] Fixed leap-year calculation algorithm... turns out
' to be a bit more complicated then just "mod 4".
'

'-----------------------------------------------------------------------------
' Custom Type Declarations
'
type Date
year as integer
month as integer
day as integer
end type

'-----------------------------------------------------------------------------
' Function Declarations
'
declare sub parseDate(dateString as string, target as Date)
declare sub parseDashedDate(dateString as string, target as Date)
declare function isValidDate%(obj as Date)
declare function getDays&(obj as Date)
declare function isLeapYear%(year as integer)

'-----------------------------------------------------------------------------
' Main
'
dim dateIn as Date
dim dateCurrent as Date
dim dayDifference as long
dim age as long

cls
line input "Date of Birth: ", strdate$

' parse the date strings.
parseDate(strdate$, dateIn)
parseDashedDate(date$, dateCurrent)

' validate the dates.
if isValidDate%(dateIn) = 0 then
print "Invalid date entered."
end
end if

if isValidDate%(dateCurrent) = 0 then
print "Failed to parse current date."
end
end if

' calculate the day difference.
dayDifference = getDays&(dateCurrent) - getDays&(dateIn)

' make sure the date entered wasn't in the future.
if dayDifference < 0 then
print "Invalid date of birth; it hasn't happened yet."
end
end if

' calculate the number of complete years.
age = int(dayDifference / 365.25)

' output the age.
print "Age: " + ltrim$(str$(age))

print "Press a key to exit..."
while inkey$ = "": wend



sub parseDate(dateString as string, target as Date)

' reset the structure.
target.day = 0
target.month = 0
target.year = 0

' check that we have a valid length (must be YYYYMMDD).
if len(dateString) <> 8 then exit sub

' extract the components.
target.year = val(mid$(dateString, 1, 4))
target.month = val(mid$(dateString, 5, 2))
target.day = val(mid$(dateString, 7, 2))

end sub



sub parseDashedDate(dateString as string, target as Date)

' reset the structure.
target.day = 0
target.month = 0
target.year = 0

' just make sure that the length of the date isn't too small.
' smallest date... x/x/xxxx = 8 chars.
if len(dateString) < 8 then exit sub

' store a "working-string".
tempStr$ = dateString

' extract the month.
slash% = instr(tempStr$, "-")
if slash% > 0 then
target.month = val(left$(dateString, slash% - 1))
tempStr$ = right$(tempStr$, len(tempStr$) - slash%)
else
exit sub
end if

' extract the day.
slash% = instr(tempStr$, "-")
if slash% > 0 then
target.day = val(left$(tempStr$, slash% - 1))
tempStr$ = right$(tempStr$, len(tempStr$) - slash%)
else
exit sub
end if

' extract the year.
target.year = val(tempStr$)

end sub



function isValidDate%(obj as Date)

' check for obvious errors.
if obj.day < 1 or obj.day > 31 or obj.month < 1 or obj.month > 12 or obj.year < 0 then
isValidDate% = 0
exit function
end if

' now check specific errors.
select case obj.month
case 2:
if isLeapYear%(obj.year) = 1 then
if obj.day > 29 then
isValidDate% = 0
exit function
end if
else
if obj.day > 28 then
isValidDate% = 0
exit function
end if
end if
case 4, 6, 9, 11:
if obj.day > 30 then
isValidDate% = 0
exit function
end if
end select

' looks okay.
isValidDate% = 1

end function



function getDays&(obj as Date)

dim cumulativeMonthDays(1 to 12) as long

' ensure we're dealing with a valid date.
if isValidDate%(obj) = 0 then
getDays& = -1
exit function
end if

' calculate the days from the year and the day.
days& = int(obj.year * 365.25) + obj.day

' now to process the month field...

' check if we need to account for an extra day in February.
if isLeapYear%(obj.year) = 1 then
dayCount& = 1
else
dayCount& = 0
end if

' set up the month days array.
cumulativeMonthDays(1) = 0
dayCount% = dayCount& + 31 ' jan
cumulativeMonthDays(2) = 31
dayCount& = dayCount& + 28 ' feb
cumulativeMonthDays(3) = dayCount&
dayCount& = dayCount& + 31 ' mar
cumulativeMonthDays(4) = dayCount&
dayCount& = dayCount& + 30 ' apr
cumulativeMonthDays(5) = dayCount&
dayCount& = dayCount& + 31 ' may
cumulativeMonthDays(6) = dayCount&
dayCount& = dayCount& + 30 ' jun
cumulativeMonthDays(7) = dayCount&
dayCount& = dayCount& + 31 ' jul
cumulativeMonthDays(8) = dayCount&
dayCount& = dayCount& + 31 ' aug
cumulativeMonthDays(9) = dayCount&
dayCount& = dayCount& + 30 ' sep
cumulativeMonthDays(10) = dayCount&
dayCount& = dayCount& + 31 ' oct
cumulativeMonthDays(11) = dayCount&
dayCount& = dayCount& + 30 ' nov
cumulativeMonthDays(12) = dayCount&

' now add the month days on to the day total.
days& = days& + cumulativeMonthDays(obj.month)

' set the return value.
getDays& = days&

end function

function isLeapYear%(year as integer)
modFour% = year and 3
modOneHundred% = year mod 100
modFourHundred% = year mod 400

if modFour% = 0 then
if (modOneHundred% = 0) and (modFourHundred% <> 0) then
isLeapYear% = 0
exit function
end if

isLeapYear% = 1
exit function
end if

isLeapYear% = 0
exit function

end function
[/syntax]