<div dir="ltr"><div class="gmail_extra"><div class="gmail_quote">2013/11/18 Michael Schnell <span dir="ltr"><<a href="mailto:mschnell@lumino.de" target="_blank">mschnell@lumino.de</a>></span><br><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex">
On 11/16/2013 06:40 PM, Michael Van Canneyt wrote:<br>
<blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex">
<br>
I think it's fairly simple, really. ...<br>
<br>
</blockquote>
This does make some sense, even for me :-)<span></span><br></blockquote></div><br>I ask in advance all those who thought that this thread was finally dead to excuse me.<br><br>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. <br>
<br>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.<br>
<br>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. <br>
<br>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. <br>
<br>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 :-)<br>
<br>uDateDiff.pas :<br>unit uDateDiff;<br><br>{$mode objfpc}{$H+}<br><br>interface<br><br>uses<br> Classes, SysUtils, Forms, Controls, StdCtrls, DateUtils;<br><br>type<br><br> { TForm1 }<br><br> TForm1 = class(TForm)<br>
Button1: TButton;<br> Memo1: TMemo;<br> procedure Button1Click(Sender: TObject);<br> private<br> { private declarations }<br> public<br> { public declarations }<br> end {TForm1} ;<br><br>var<br> Form1: TForm1 ;<br>
<br>implementation<br><br>{$R *.lfm}<br><br>// This function ensures that adding parts to a date is done in the "correct" order: years first, days last<br>function IncDate (const aDate : TDate ; const Years, Months, Days: integer) : TDate ;<br>
begin { IncDate }<br> result := IncDay (IncMonth (IncYear (aDate, years), months), days)<br>end { IncDate } ;<br><br>procedure DatesToAge (Date1, Date2: TDate ; out Years, Months, Days: integer);<br>var<br> d1, d2: word;<br>
month2_after_carry : integer ;<br> y1, y2, m1, m2: word;<br> yw, mw, dw : word ; // work date for intermediate calculations<br> temp_date: TDate;<br>begin {DatesToAge}<br> if Date1 > Date2<br> then begin {SwapDates}<br>
temp_date := Date1;<br> Date1 := Date2;<br> Date2 := temp_date;<br> end {SwapDates};<br> Days := 0;<br> Months := 0 ;<br> Years := 0 ;<br> DecodeDate (date1, y1, m1, d1) ;<br> DecodeDate (date2, y2, m2, d2) ;<br>
if d2 >= d1<br> then month2_after_carry := m2<br> else month2_after_carry := m2 - 1 ;<br> if month2_after_carry >= m1<br> then begin<br> Years := y2 - y1 ;<br> Months := month2_after_carry - m1<br>
end {then}<br> else begin<br> Years := y2 - y1 - 1 ;<br> Months := month2_after_carry - m1 + 12<br> end {else} ;<br> if d2 >= d1<br> then Days := d2 - d1<br> else begin<br> DecodeDate (IncMonth (date2, -1), yw, mw, dw) ;<br>
Days := d2 - d1 + DaysInAMonth (yw, mw)<br> end {else} ;<br> while IncDate (date1, Years, Months, Days) < Date2 do Inc (Days) ;<br> while IncDate (date1, Years, Months, Days) > Date2 do Dec (Days) ;<br> if IncDate (date1, Years, Months, 0) = DaysInAMonth (y1+Years, m1+Months)<br>
then begin<br> Days := d1 - DaysInAMonth (y1+Years, m1+Months) ;<br> if Months = 12<br> then begin<br> Inc (Years) ;<br> Months := 1<br> end {then}<br> else Inc (Months)<br>
end {then}<br>end {DatesToAge} ;<br><br>{ TForm1 }<br><br>procedure TForm1.Button1Click(Sender: TObject);<br>var<br> years, months, days: integer;<br> day_count_1, day_count_2: integer ;<br> date1, date2, date3 : TDate ;<br>
test_ok : boolean ;<br>begin {TForm1.Button1Click}<br> Memo1.Clear ;<br> test_ok := TRUE ;<br> for day_count_1 := 0 to DaysBetween (EncodeDate (2000, 01, 01), EncodeDate (2005, 12, 31)) do begin<br> date1 := EncodeDate (2000, 01, 01) + day_count_1 ;<br>
for day_count_2 := 0 to (365*5) do begin<br> date2 := IncDay (date1, day_count_2) ;<br> DatesToAge(date1, date2, years, months, days) ;<br> date3 := IncDate (date1, years, months, days) ;<br> if (date3 <> date2)<br>
then begin<br> test_ok := FALSE ;<br> Memo1.Append ('------'+DateToStr (date1)+' '+DateToStr (date2)+' Y='+IntToStr (years)+' M='+IntToStr (months)+' D='+IntToStr (days)+' '+DateToStr (date3));<br>
Memo1.Append ('incYear='+DateToStr (IncYear (date1, Years))+', IncMonth+IncYear='+DateToStr (IncMonth (IncYear (date1, years), months)));<br> exit<br> end {then} <br> end {for}<br>
end {for} ;<br> if test_ok<br> then Memo1.Append ('Finished OK')<br> else Memo1.Append ('Finished KO')<br>end {TForm1.Button1Click} ;<br><br>end {uDateDiff}.<br><br>uDateDiff.lfm :<br><br>object Form1: TForm1<br>
Left = 1397<br> Height = 106<br> Top = 35<br> Width = 501<br> Caption = 'Form1'<br> ClientHeight = 106<br> ClientWidth = 501<br> LCLVersion = '1.2.0.1'<br> object Button1: TButton<br> Left = 8<br>
Height = 25<br> Top = 8<br> Width = 75<br> Caption = 'Button1'<br> OnClick = Button1Click<br> TabOrder = 0<br> end<br> object Memo1: TMemo<br> Left = 88<br> Height = 88<br> Top = 8<br>
Width = 406<br> Anchors = [akTop, akLeft, akRight, akBottom]<br> ScrollBars = ssAutoBoth<br> TabOrder = 1<br> end<br>end<br clear="all"><br></div>-- <br><div class="gmail_extra">Frederic Da Vitoria<br>(davitof)<br>
<br>Membre de l'April - « promouvoir et défendre le logiciel libre » - <a href="http://www.april.org" target="_blank">http://www.april.org</a><br>
</div></div>