[Lazarus] DateDif function needed
Frederic Da Vitoria
davitofrg at gmail.com
Mon Nov 18 13:11:10 CET 2013
2013/11/18 Michael Schnell <mschnell at lumino.de>
> On 11/16/2013 06:40 PM, Michael Van Canneyt wrote:
>
>>
>> I think it's fairly simple, really. ...
>>
>> This does make some sense, even for me :-)
>
I ask in advance all those who thought that this thread was finally dead to
excuse me.
I have been working on this since the beginning. Date calculations is a
subject I like, I love the quirks we have to use to make them right.
First of all, I decided to use a different name. DateDiff comes from Excel,
this is Lazarus, we should try to use names consistent with our functions.
I chose DatesToAge, but I am not convinced this name is any better to any
other name which has been used in this thread. I'll keep it here as this
allows to distinguish my routine from others.
Since the beginning, I felt that there was something missing in how we were
tackling the problem: there were dark spaces in what the result should be.
Unless I missed something, nobody defined a good way to tell if a result
was correct or not. I felt we needed a way to check the calculations in a
loop. I decided to use the IncXXX functions to do this. This has 2
advantages IMO: this would rely on preexisting functions (no need to add a
new function for performing the check), and it allows to define what the
datediff routine does in a simple way: DateDiff is the reverse function of
IncYear+IncMonth+IncDay. It also should allow some mathematical tricks like
DatesToAge (date1, date3) = DatesToAge (date1, date2) + DatesToAge (date2,
date3) (kind of associativity). This has a consequence: the result is
exclusive, but if you need the inclusive result, just send date2+1 instead
of date2.
I wanted to avoid brute force, so I started with the Jedi code. I first
tried to incrementally correct the code, bad idea, of course, all I ended
up with was useless messy code. Then I used a spreadsheet to try to find
out what the desirable steps were. I did find some of them, but I kept
stumbling on other problems further on in my test loop. After one week of
this (I only spent my free hours, around 2 hours a day, but still...) I
decided it was time to quit. Michael's post convinced me that brute force
had something. So I fell back to another algorithm: calculate an estimation
of the result, then use a loop to correct it. Still more efficient than
brute force. I finally reached the code which follows.
This implementation has been tested with date1 from 2001-01-01 to
2005-12-31 and date2 varying from date1 - 5 years to date1 + 5 years.
Overkill, given the algorithm, but that was the test loop I had for my
previous test and I kept it. I first define an IncDate function. This
combines IncYear, IncMonth and IncDay, ensuring that the combination is
done in the "corrrect" order: first add years, then add months, then add
days, because the result could be different if you add days first, for
example. It should be relatively easy to remove the swapping step from the
previous implementations. DatesToAge would then work both ways and if
someone needed a unsigned version, one could easily swap the parameters
before calling DatesToAge. For this, I'd remove the swapping step and
correct the existing code to handle negative values. But I won't try this
if nobody is interested in my version :-)
uDateDiff.pas :
unit uDateDiff;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, StdCtrls, DateUtils;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end {TForm1} ;
var
Form1: TForm1 ;
implementation
{$R *.lfm}
// This function ensures that adding parts to a date is done in the
"correct" order: years first, days last
function IncDate (const aDate : TDate ; const Years, Months, Days:
integer) : TDate ;
begin { IncDate }
result := IncDay (IncMonth (IncYear (aDate, years), months), days)
end { IncDate } ;
procedure DatesToAge (Date1, Date2: TDate ; out Years, Months, Days:
integer);
var
d1, d2: word;
month2_after_carry : integer ;
y1, y2, m1, m2: word;
yw, mw, dw : word ; // work date for intermediate calculations
temp_date: TDate;
begin {DatesToAge}
if Date1 > Date2
then begin {SwapDates}
temp_date := Date1;
Date1 := Date2;
Date2 := temp_date;
end {SwapDates};
Days := 0;
Months := 0 ;
Years := 0 ;
DecodeDate (date1, y1, m1, d1) ;
DecodeDate (date2, y2, m2, d2) ;
if d2 >= d1
then month2_after_carry := m2
else month2_after_carry := m2 - 1 ;
if month2_after_carry >= m1
then begin
Years := y2 - y1 ;
Months := month2_after_carry - m1
end {then}
else begin
Years := y2 - y1 - 1 ;
Months := month2_after_carry - m1 + 12
end {else} ;
if d2 >= d1
then Days := d2 - d1
else begin
DecodeDate (IncMonth (date2, -1), yw, mw, dw) ;
Days := d2 - d1 + DaysInAMonth (yw, mw)
end {else} ;
while IncDate (date1, Years, Months, Days) < Date2 do Inc (Days) ;
while IncDate (date1, Years, Months, Days) > Date2 do Dec (Days) ;
if IncDate (date1, Years, Months, 0) = DaysInAMonth (y1+Years, m1+Months)
then begin
Days := d1 - DaysInAMonth (y1+Years, m1+Months) ;
if Months = 12
then begin
Inc (Years) ;
Months := 1
end {then}
else Inc (Months)
end {then}
end {DatesToAge} ;
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var
years, months, days: integer;
day_count_1, day_count_2: integer ;
date1, date2, date3 : TDate ;
test_ok : boolean ;
begin {TForm1.Button1Click}
Memo1.Clear ;
test_ok := TRUE ;
for day_count_1 := 0 to DaysBetween (EncodeDate (2000, 01, 01),
EncodeDate (2005, 12, 31)) do begin
date1 := EncodeDate (2000, 01, 01) + day_count_1 ;
for day_count_2 := 0 to (365*5) do begin
date2 := IncDay (date1, day_count_2) ;
DatesToAge(date1, date2, years, months, days) ;
date3 := IncDate (date1, years, months, days) ;
if (date3 <> date2)
then begin
test_ok := FALSE ;
Memo1.Append ('------'+DateToStr (date1)+' '+DateToStr (date2)+'
Y='+IntToStr (years)+' M='+IntToStr (months)+' D='+IntToStr (days)+'
'+DateToStr (date3));
Memo1.Append ('incYear='+DateToStr (IncYear (date1, Years))+',
IncMonth+IncYear='+DateToStr (IncMonth (IncYear (date1, years), months)));
exit
end {then}
end {for}
end {for} ;
if test_ok
then Memo1.Append ('Finished OK')
else Memo1.Append ('Finished KO')
end {TForm1.Button1Click} ;
end {uDateDiff}.
uDateDiff.lfm :
object Form1: TForm1
Left = 1397
Height = 106
Top = 35
Width = 501
Caption = 'Form1'
ClientHeight = 106
ClientWidth = 501
LCLVersion = '1.2.0.1'
object Button1: TButton
Left = 8
Height = 25
Top = 8
Width = 75
Caption = 'Button1'
OnClick = Button1Click
TabOrder = 0
end
object Memo1: TMemo
Left = 88
Height = 88
Top = 8
Width = 406
Anchors = [akTop, akLeft, akRight, akBottom]
ScrollBars = ssAutoBoth
TabOrder = 1
end
end
--
Frederic Da Vitoria
(davitof)
Membre de l'April - « promouvoir et défendre le logiciel libre » -
http://www.april.org
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.lazarus-ide.org/pipermail/lazarus/attachments/20131118/db5167eb/attachment-0003.html>
More information about the Lazarus
mailing list