Posts: 1,956
Threads: 65
Joined: Jun 2003
INPUT: The person's date of birth as YYYYMMDD.
LOGIC:
- Validate the input date of birth. Abort if invalid.
- Get today's date using the DATE$ function.
- Compute the person's age in years using a calculation method, or if you prefer perform some sort of loop to get to it.
OUTPUT: The person's age in years. Note: If his birthday happens to be today, he will be one year older (obviously).
*****
Posts: 1,845
Threads: 44
Joined: Aug 2002
Sorry for the wait... I was quite busy lately.
I hope this produces some answers that are correct. I tested it a few times and it returned right ages for all my family members
Code: Option Static
Option Explicit
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
Dim Year As Integer, Month As Integer, Day As Integer
'@ Ask the user for input YYYYMMDD and check if it's valid
Dim Datum As String, isOk As Byte = Not( 0 ), i As Integer
Dim NumberStr As String
NumberStr = "0123456789"
Do
isOk = Not( 0 )
Input "Enter a valid birthday in format YYYYMMDD: ", Datum
If Len(Datum) <> 8 Then
isOk = 0
Else
For i = 0 To 7
If Instr(NumberStr, Mid$(Datum, i + 1, 1)) = 0 Then isOk = 0
Next i
If isOk Then
Year = Val(Left$(Datum, 4))
Month = Val(Mid$(Datum, 5, 2))
Day = Val(Right$(Datum, 2))
isOk = isValidDate(Year, Month, Day)
End If
End If
If Not( isOk ) Then Print "Invalid entry"
Loop Until isOk
'@ Get the current Date (format MM-DD-YYYY)
Dim CurrDate As String, CurrYear As Integer, CurrMonth As Integer, CurrDay As Integer
CurrDate = Date$
CurrYear = Val(Right$(CurrDate, 4))
CurrMonth = Val(Left$(CurrDate, 2))
CurrDay = Val(Mid$(CurrDate, 4, 2))
Print getPersonAge(Year, Month, Day, CurrYear, CurrMonth, CurrDay)
Sleep
End
Private Function getPersonAge (Year As Integer, Month As Integer, Day As Integer, _
NowYear As Integer, NowMonth As Integer, NowDay As Integer) As Integer
Dim printed As integer = 0
'@ Very simple loop to calculate the age
Dim lYear As Integer, lMonth As Integer, lDay As Integer, rAge As Integer = 0
For lYear = Year To NowYear
Dim MinMonth As Integer, MaxMonth As Integer
If lYear = Year Then MinMonth = Month Else MinMonth = 1
If lYear = NowYear Then MaxMonth = NowMonth Else MaxMonth = 12
For lMonth = MinMonth To MaxMonth
Dim MaxDay As Integer, MinDay As Integer
Select Case lMonth
Case 1, 3, 5, 7, 8, 10, 12 : MaxDay = 31
Case 4, 6, 9, 11: MaxDay = 30
Case 2: MaxDay = 28 + Abs(isLeapYear(lYear))
End Select
If lYear = Year And lMonth = Month Then MinDay = Day + 1 Else MinDay = 1
If lYear = NowYear And lMonth = NowMonth Then MaxDay = NowDay
For lDay = MinDay To MaxDay
If lMonth = Month And lDay = Day Then rAge += 1
Next lDay
Next lMonth
Next lYear
getPersonAge = rAge
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
NOTE: FreeBasic code
I hope it works and suits your challenge objectives.
Posts: 104
Threads: 8
Joined: Jun 2003
woah, the code is very long...
i don`t have any time at the moment, but 'm gonna code a qb prog as soon as i get to.
cheers
'm so lazy... no really.... i am the laziest programmer ever ... ever.
Posts: 1,845
Threads: 44
Joined: Aug 2002
It's not very long... half the code is actually checking if the input birthday is a valid date (note that people who are yet to be born have age 0).
The actual "calculation"... it's more a loop, happens in the getPersonAge function, which isn't very long
Posts: 1,956
Threads: 65
Joined: Jun 2003
Neo,
I get the following FB compile error:
error 64: Too many expressions, found: 'Not'
On Line: 13
which is: Dim Datum As String, isOk As Byte = Not( 0 ), i As Integer
Reviewing your code, I too feel that it is too long. The long function "getpersonAge" can be done in about 5 instructions without any loop.
If the person is less than a year old, like a 6 month old baby, his age is zero years. If the person was not born yet, then he has no date of birth.
You did a nice job of validating the input date of birth.
Fix the compile error and I'll do some testing of this version.
*****
Posts: 1,845
Threads: 44
Joined: Aug 2002
The problem is there is no compile error
Maybe download the latest FB version? I have no compiler error at all with the latest FB IDE and FB version.
And yes, I just did the loop because it's easier, else you'd have to do all checks with date shiftings.
NOTE: My code treats a leapling as a leapling, which means, he'll only get a birthday every leapyear! (officially this is the case).
Posts: 1,956
Threads: 65
Joined: Jun 2003
Quote:The problem is there is no compile error
Maybe download the latest FB version? I have no compiler error at all with the latest FB IDE and FB version.
And yes, I just did the loop because it's easier, else you'd have to do all checks with date shiftings.
NOTE: My code treats a leapling as a leapling, which means, he'll only get a birthday every leapyear! (officially this is the case).
Sorry, Neo, I was using the previous version of FB. I have problems with the lastest version of FBIDE. It issues an error saying it can't find "\ide\spash.png". I ignored the error and continued to compile your program. It works fine.
I don't know what you mean by: "... else you'd have to do all checks with date shiftings." But let's leave this subject until after I post my solution, or someone else does it the same way. Ok?
About the leapling. I assume you mean a person born on a leap year on February 29th. You say that "officially" he has a birthday every leapyear. That may be aesthetically true, but the goverment of most any nation will consider his age as a multiple of years, just like anybody else, for reasons of having to sign up for military service, registering to vote, paying taxes, getting a drivers license, etc.
*****
Posts: 1,025
Threads: 44
Joined: May 2005
well, its just about as elementary as you can get, but hey w/e. this was coded in fb (hence the sleep at the end):
Code: birth$ = "20040101"
cyear = val(mid$(date$, 7, 4))
cmonth = val(mid$(date$,1,2))
cday = val(mid$(date$, 4, 2))
byear = val(mid$(birth$, 1, 4))
bmonth = val(mid$(birth$, 5,2))
bday = val(mid$(birth$,7,2))
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"
elseif age = 1 then
print age; " year old"
elseif age > 1 then
print age; " years old"
end if
sleep
Posts: 1,956
Threads: 65
Joined: Jun 2003
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.
*****
Posts: 1,845
Threads: 44
Joined: Aug 2002
Moneo, in an attempt to shorten the getPersonAge function I came up with the following, bizarre result.
I know it shouldn't be working fully but I haven't found a current date / birth date yet for which it doesn't work... and I tried around 400 times.
I hoped you could test the functionality of both my submitted functions
Code: Private Function getPersonAge (Year As Integer, Month As Integer, Day As Integer, _
NowYear As Integer, NowMonth As Integer, NowDay As Integer) As Integer
getPersonAge = ((NowYear * 366 + NowMonth * 31 + NowDay) - (Year * 366 + Month * 31 + Day)) \ 366
End Function
Note, to test this function you replace the old getPersonAge function by this 3-line new function.
Hmmm... 600 tests... no difference yet...
|