Board index » delphi » Comparison of Month-Length Algorithms

Comparison of Month-Length Algorithms

I have split my aforementioned
        http://www.merlyn.demon.co.uk/programs/mjd_date.pas
so that the useful routines are in dateprox.pas and mjd_date.pas is now a
test harness.

Although I have learnt much Pascal from Timo's postings, the algorithms
in these routines are developed from my understanding of first
principles, quite independently of the algorithms in the FAQ.

I have compared the last-day-of-month routine in dateprox with that in
TSFAQP#129/#3, for every month in every year from AD22222 down to AD1580,
using Gregorian dates only (first use of Gregorian was in 1582; but AIUI
astronomers use it retrospectively).  There is substantial agreement.

However, LASTDDFN reports implausible results for half the Decembers
before AD1600 - half of these are given 30 days, half some other number
which appears to depend in value on some unknown influence.  I never
understood LASTDDFN, but especially before 1600.

My routine appears to be the faster, by a factor in excess of ten, even
though the test loop variables are integer and need converting, using a
crude profiling technique.

The program below has been processed by CLEAN-TP.PAS, so the indentation
of the TS code is not as in the FAQ.

program tsfqp129 ;

uses DateProx ;

function WeekDay ( Day, Month, Year : Integer ) : Integer {TSFAQP #3} ;
function FirstThursday (Year: Integer) : Integer;
begin
  FirstThursday := 7 - (1 + (Year-1600) + (Year-1597) div 4
    - (Year-1501) div 100 + (Year-1201) div 400) mod 7;
  end; (* FirstThursday *)
function DayNumber (Day, Month, Year : Integer) : Integer;
const DaysBeforeMonth : array [1..12] of Integer =
  (0,31,59,90,120,151,181,212,243,273,304,334);
begin
  DayNumber := DaysBeforeMonth[Month] + Day + Ord( (Month > 2) and
    (Year mod 4 = 0) and ((Year mod 100 <> 0) or
    (Year mod 400 = 0)) );
  end; (* DayNumber *)
begin
  WeekDay:=(7+DayNumber(Day,Month,Year)-FirstThursday(Year)+3) mod 7;
  end; (* WeekDay *)

function WeekDayString (Day, Month, Year : Integer) : String;
const DayStr = 'MonTueWedThuFriSatSun';
begin
  WeekDayString := Copy (DayStr, 3*WeekDay(Day,Month,Year)+1, 3);
  end;

function LASTDDFN (month, year : integer) : integer {TSFAQP #129} ;
var i, nextMonth, yy : integer;
begin
  nextMonth := month + 1;
  yy := year;
  if nextMonth > 12 then begin
    yy := yy + 1;
    nextMonth := nextMonth - 12;
    end;
  for i := 28 to 31 do begin
    if Weekday (i, month, year) =
      ((WeekDay (1, nextMonth, yy) + 6) mod 7)
      then lastddfn := i;
    end;
  end;  (* lastddfn *)

const Opts : options = (Cal : Gregorian ; Astr : false) ;
var TS, JRS, Y, M : integer ;
Tkr : byte absolute $40:$6C ;
T1 : byte ;
const Tcount : word = 0 ; Jcount : word = 0 ;

BEGIN ;
Writeln('TSFQP129') ;
for Y := 12222 downto 1580 do begin {Write(Y:6, #13) ;}
  if Y=1600 then Writeln(#10, Tcount:52, Jcount:6) ; ;
  for M := 12 downto 1 do begin
    T1 := Tkr ; TS := LastDDFN(M, Y) ; if T1<>Tkr then Inc(Tcount) ;
    T1 := Tkr ; JRS := UltiMo(Opts, Y, M) ; if T1<>Tkr then Inc(Jcount) ;
    if TS<>JRS then Writeln(Y:12, M:3, TS:9, JRS:7) ;
    end ;
  end ;
Writeln(#10, Tcount:52, Jcount:6) ; Readln ;
END.

The code in dateprox may be copied for test or for use; but please do not
put it on a server as it is liable to get changed if I understand better
what the Romans did.  Some of it will never work for Sweden 1700-1712.

--
John Stockton, Surrey, UK.    j...@merlyn.demon.co.uk    Turnpike v1.12    MIME.
  Web <URL: http://www.merlyn.demon.co.uk/> - TP/BP/&c. FAQqish topics & links.
  Timo's TurboPascal <A HREF="ftp://garbo.uwasa.fi/pc/link/tsfaqp.zip">FAQ</A>.
  <A HREF="http://www.merlyn.demon.co.uk/clpb-faq.txt">Mini-FAQ</A> of c.l.p.b.

 

Re:Comparison of Month-Length Algorithms


Dr John Stockton heeft geschreven in bericht ...

Quote
>I have split my aforementioned
>        http://www.merlyn.demon.co.uk/programs/mjd_date.pas
>so that the useful routines are in dateprox.pas and mjd_date.pas is now a
>test harness.

>Although I have learnt much Pascal from Timo's postings, the algorithms
>in these routines are developed from my understanding of first
>principles, quite independently of the algorithms in the FAQ.

>I have compared the last-day-of-month routine in dateprox with that in
>TSFAQP#129/#3, for every month in every year from AD22222 down to AD1580,
>using Gregorian dates only (first use of Gregorian was in 1582; but AIUI
>astronomers use it retrospectively).  There is substantial agreement.

I don't know what changed in 1582. Could you explain, please?

I use this functions. I made them myself, however they're not tested after
3000.

This is the Pascal function which I don't use and didn't check.
FUNCTION XBIsLeapYear(Year:Word):Byte;
BEGIN
    XBIsLeapYear:=False;
    IF Year AND 3<>0 THEN
    Exit;
    IF (Year MOD 400=0) OR (Year MOD 100=0) THEN
    XBIsLeapYear:=True;
END;

FUNCTION XBIsLeapYear(Year:Word):Byte;
ASSEMBLER;
ASM
 MOV  AX,Year
 XOR  DH,DH
 TEST AL,3
 JNZ  @LE
 MOV  BL,100
 DIV  BL
 OR   AH,AH
 JNZ  @L1
 TEST AL,3
 JNZ  @LE
@L1:INC  DH
@LE:MOV  AL,DH
END;

FUNCTION XBPackDate(Day,Month:Byte;Year:Word):LongInt;
CONST
 DPM:Array[0..11] OF Word=(0,31,59,90,120,151,181,212,243,273,304,334);
VAR
 DayNum:LongInt;
BEGIN
 DayNum:=XBMul(365,Year);
 Inc(Year,3);
 Inc(DayNum,Year DIV 4);
 Dec(DayNum,Year DIV 100);
 Inc(DayNum,Year DIV 400);
 Dec(Year,3);
 IF Month>2 THEN
 Inc(DayNum,XBIsLeapYear(Year));
 Dec(Month);
 Inc(DayNum,DPM[Month]);
 Inc(DayNum,Day);
 Dec(DayNum);
 XBPackDate:=DayNum;
END;

FUNCTION XBGetDayOfWeek(Day,Month:Byte;Year:Word):Byte;
ASSEMBLER;
ASM
 PUSH WORD PTR Day
 PUSH WORD PTR Month
 PUSH Year
 CALL XBPackDate
 DB   $66
SHL  DX,16                ;shl edx,16
 MOV  DX,AX
 DB   $66
 MOV  AX,DX                ;mov eax,edx
 DB   $66
 ADD  AX,5                    ;add eax,5
 DW   0
 DB   $66
 MOV  BX,7                    ;mov ebx,7
 DW   0
 DB   $66
 XOR  DX,DX                ;xor edx,edx
 DB   $66
 DIV  BX                        ;div ebx
 MOV  AL,DL
END;

Re:Comparison of Month-Length Algorithms


In article <6j9s5s$...@news.euro.net>, Olaf van der Spek
<S...@EuroNet.NL> writes

Quote

>This is the Pascal function which I don't use and didn't check.

If you are intending offering an alternative code to that posted, should
you not check the code you post?

--
Pedt Scragg                    <newsmas...@pedt.demon.co.uk>

Never curse the Crocodile's mother before crossing the river

Re:Comparison of Month-Length Algorithms


JRS:  In article <6j9s5s$...@news.euro.net> of Tue, 12 May 1998 16:08:28
in comp.lang.pascal.borland, Olaf van der Spek <S...@EuroNet.NL> wrote:

Quote
>Dr John Stockton heeft geschreven in bericht ...
>>I have compared the last-day-of-month routine in dateprox with that in
>>TSFAQP#129/#3, for every month in every year from AD22222 down to AD1580,
>>using Gregorian dates only (first use of Gregorian was in 1582; but AIUI
>>astronomers use it retrospectively).  There is substantial agreement.

>I don't know what changed in 1582. Could you explain, please?

See any encyclopaedia on Calendar/Gregorian/Julian, or my WWW pages
referenced below, or The Calendar FAQ.  The Pope changed the Calendar.

Quote
>I use this functions. I made them myself, however they're not tested after
>3000.

Mine are tested in http://www.merlyn.demon.co.uk/programs/mjd_date.pas

This is the Pascal function which I don't use and didn't check.
FUNCTION XBIsLeapYear(Year:Word):Byte;       <--- boolean ??
BEGIN
    XBIsLeapYear:=False;
    IF Year AND 3<>0 THEN
    Exit;
    IF (Year MOD 400=0) OR (Year MOD 100=0) THEN
                                         <>     --- ???

Quote
>    XBIsLeapYear:=True;
>END;

Numerous Pascal Gregorian LeapYear functions are presented, tested, and
timed in http://www.merlyn.demon.co.uk/programs/leapyear.pas - but AFAIR
not that one, yet --- Inserted as Z17, fails, = changed to <>, works;
like all that are efficient in the non-quadrennial case, it is fastish.

FUNCTION XBIsLeapYear(Year:Word):Byte;       <--- boolean ??

Quote
>ASSEMBLER;
>ASM
> MOV  AX,Year
> XOR  DH,DH
> TEST AL,3
> JNZ  @LE
> MOV  BL,100
> DIV  BL
> OR   AH,AH
> JNZ  @L1
> TEST AL,3
> JNZ  @LE
>@L1:INC  DH
>@LE:MOV  AL,DH
>END;

 ---   I don't see a 400 there ???

Quote
> ...

DateProx now includes FirstThurs(Opts, Year) and SecondsToday(H, M, S) -
or will at next upload.  Also procedure/function identifiers have been
improved.

--
John Stockton, Surrey, UK.    j...@merlyn.demon.co.uk    Turnpike v1.12    MIME.
 Web <URL: http://www.merlyn.demon.co.uk/> --- includes FAQqish topics & links:
 Year 2000 - date2000.htm  Dates - misctime.htm  Critical Dates - critdate.htm
 Don't Mail News.  Y2k for beginners http://www.merlyn.demon.co.uk/year2000.txt

Re:Comparison of Month-Length Algorithms


Dr John Stockton <j...@merlyn.demon.co.uk> writes:

Quote
> I never understood LASTDDFN, but especially before 1600.

I would guess that looking at FirstThursday would be most instructive:

Quote
> function FirstThursday (Year: Integer) : Integer;
> begin
>   FirstThursday := 7 - (1 + (Year-1600) + (Year-1597) div 4
>     - (Year-1501) div 100 + (Year-1201) div 400) mod 7;

as that code does not look particularly 1600-compliant.  :-)
--
Russell_Sch...@locutus.ofB.ORG  Shad 86c

Re:Comparison of Month-Length Algorithms


"Olaf van der Spek" <S...@EuroNet.NL> writes:

Quote
>     IF (Year MOD 400=0) OR (Year MOD 100=0) THEN
>     XBIsLeapYear:=True;

that's incorrect.  1900 was not a leap year.

Quote
> ASM
>  MOV  AX,Year
>  XOR  DH,DH
>  TEST AL,3
>  JNZ  @LE
>  MOV  BL,100
>  DIV  BL
>  OR   AH,AH
>  JNZ  @L1
>  TEST AL,3
>  JNZ  @LE
> @L1:INC  DH
> @LE:MOV  AL,DH
> END;

I am willing to create a new group for substantially-ASM posts just to
keep them out of here.
--
Russell_Sch...@locutus.ofB.ORG  Shad 86c

Re:Comparison of Month-Length Algorithms


Pedt Scragg heeft geschreven in bericht ...

Quote
>In article <6j9s5s$...@news.euro.net>, Olaf van der Spek
><S...@EuroNet.NL> writes

>>This is the Pascal function which I don't use and didn't check.

>If you are intending offering an alternative code to that posted, should
>you not check the code you post?

I did check the ASM version, the Pascal version of the same procedure was
only an explanation.
Quote

>--
>Pedt Scragg                    <newsmas...@pedt.demon.co.uk>

>Never curse the Crocodile's mother before crossing the river

Re:Comparison of Month-Length Algorithms


JRS:  In article <19980513.114734.9R8.rnr.w1...@locutus.ofB.ORG> of Wed,
13 May 1998 11:47:34 in comp.lang.pascal.borland, Russell Schulz

Quote
<Russell_Sch...@locutus.ofB.ORG> wrote:
>Dr John Stockton <j...@merlyn.demon.co.uk> writes:
>> I never understood LASTDDFN, but especially before 1600.
>I would guess that looking at FirstThursday would be most instructive:

>> function FirstThursday (Year: Integer) : Integer;
>> begin
>>   FirstThursday := 7 - (1 + (Year-1600) + (Year-1597) div 4
>>     - (Year-1501) div 100 + (Year-1201) div 400) mod 7;

>as that code does not look particularly 1600-compliant.  :-)

I have the following in http://www.merlyn.demon.co.uk/programs/dateprox.
pas (the "3" would be changed for another day of the week); it seems
right, and should work 32000BC-32000AD, Gregorian/Julian/Civil(UK/RC) :

function FirstThurs(const Opts : Options ; const Yr : integer) : byte ;
begin
  FirstThurs := 7 - Ord(DayOfWeek(YMD_to_MJD(Opts, Yr, 1, 3))) ;
  end {FirstThurs} ;
(* TSFAQP #92 may be quicker; this is independent *)

YMD_to_MJD is moderately well-tested now, in mjd_date.pas.

--
John Stockton, Surrey, UK.    j...@merlyn.demon.co.uk    Turnpike v1.12    MIME.
  Web <URL: http://www.merlyn.demon.co.uk/> - TP/BP/&c. FAQqish topics & links.
  Timo's TurboPascal <A HREF="ftp://garbo.uwasa.fi/pc/link/tsfaqp.zip">FAQ</A>.
  <A HREF="http://www.merlyn.demon.co.uk/clpb-faq.txt">Mini-FAQ</A> of c.l.p.b.

Re:Comparison of Month-Length Algorithms


In article <6je0ff$...@news.euro.net>, Olaf van der Spek
<S...@EuroNet.NL> writes

Quote

>Pedt Scragg heeft geschreven in bericht ...
>>In article <6j9s5s$...@news.euro.net>, Olaf van der Spek
>><S...@EuroNet.NL> writes

>>>This is the Pascal function which I don't use and didn't check.

>>If you are intending offering an alternative code to that posted, should
>>you not check the code you post?

>I did check the ASM version, the Pascal version of the same procedure was
>only an explanation.

Did you try 2000 in asm - there's no 400 check there so according to
your asm routine 2000 is not a leap year.

The Pascal version *may* have been an attempt at an explanation but it
won't even compile and doesn't match the asm routine.

At least John described his tests.

See <URL:http://www.merlyn.demon.co.uk/programs/leapyear.pas>

--
Pedt Scragg                    <newsmas...@pedt.demon.co.uk>

Never curse the Crocodile's mother before crossing the river

Re:Comparison of Month-Length Algorithms


Russell Schulz <Russell_Sch...@locutus.ofB.ORG> wrote in article
<19980513.114354.9P8.rnr.w1...@locutus.ofB.ORG>...

Quote
> I am willing to create a new group for substantially-ASM posts just to
> keep them out of here.

That is "BASM", Built-In Assembler, which has been a part of Borland/Turbo
Pascal for a couple of versions now, so it seems to me that it's
appropriate
for this group. You can distinguish BASM from ASM by these clues:

   asm             { asm...end; block delimiters }
      jnz @l1      { use of at-sign to denote a local undeclared label }
   @l1:            { acceptance of BP/TP curly-brace comments }
      mov ax, $34  { acceptance of BP/TP hex constants  }
   end;

Cheers, Todd

Re:Comparison of Month-Length Algorithms


Quote
>This is the Pascal function which I don't use and didn't check.
>FUNCTION XBIsLeapYear(Year:Word):Byte;       <--- boolean ??

Byte, because I then can use Inc(DayNum,XBIsLeapYear(Year));
Maybe I should change this to Boolean.

Quote
>BEGIN
>    XBIsLeapYear:=False;
>    IF Year AND 3<>0 THEN
>    Exit;
>    IF (Year MOD 400=0) OR (Year MOD 100=0) THEN
>                                         <>     --- ???

Yes, it has to be
IF (Year MOD 400=0) OR (Year MOD 100<>0) THEN
Quote
>>    XBIsLeapYear:=True;
>>END;

>FUNCTION XBIsLeapYear(Year:Word):Byte;       <--- boolean ??
Same as above.
>>ASSEMBLER;
>>ASM
>> MOV  AX,Year
>> XOR  DH,DH
>> TEST AL,3                                ;if year mod 4<>0, no leapyear
>> JNZ  @LE
>> MOV  BL,100                            ;year mod 4=0
>> DIV  BL
>> OR   AH,AH                                ;if year mod 100<>0, leapyear
>> JNZ  @L1
>> TEST AL,3                                  ;if year mod 400<>0. no
leapyear
>> JNZ  @LE
>>@L1:INC  DH                                ;it's a leapyear
>>@LE:MOV  AL,DH
>>END;
> ---   I don't see a 400 there ???

>> ...

>DateProx now includes FirstThurs(Opts, Year) and SecondsToday(H, M, S) -
>or will at next upload.  Also procedure/function identifiers have been
>improved.

>--
>John Stockton, Surrey, UK.    j...@merlyn.demon.co.uk    Turnpike v1.12
MIME.
> Web <URL: http://www.merlyn.demon.co.uk/> --- includes FAQqish topics &
links:
> Year 2000 - date2000.htm  Dates - misctime.htm  Critical Dates -
critdate.htm
> Don't Mail News.  Y2k for beginners

http://www.merlyn.demon.co.uk/year2000.txt

Re:Comparison of Month-Length Algorithms


Re:Comparison of Month-Length Algorithms


Quote
"Todd Fiske" <tfi...@delphi.com> writes:
>> I am willing to create a new group for substantially-ASM posts just to
>> keep them out of here.

> That is "BASM", Built-In Assembler, which has been a part of
> Borland/Turbo Pascal for a couple of versions now,

yes.  I know that.

Quote
> so it seems to me that it's appropriate for this group.

but do these groups have a lot in common:

  1. people who use Pascal instead of C
  2. people who like to include little asm speed hacks

I would guess `no'.  the people who _are_ in #2 would probably be
happier reading comp.lang.asm.x86 anyway, and just change the syntax.
--
Russell_Sch...@locutus.ofB.ORG  Shad 86c

Re:Comparison of Month-Length Algorithms


Re:Comparison of Month-Length Algorithms


Pedt Scragg heeft geschreven in bericht ...

Quote
>In article <6je0ff$...@news.euro.net>, Olaf van der Spek
><S...@EuroNet.NL> writes

>>Pedt Scragg heeft geschreven in bericht ...
>>>In article <6j9s5s$...@news.euro.net>, Olaf van der Spek
>>><S...@EuroNet.NL> writes

>>>>This is the Pascal function which I don't use and didn't check.

>>>If you are intending offering an alternative code to that posted, should
>>>you not check the code you post?

>>I did check the ASM version, the Pascal version of the same procedure was
>>only an explanation.

>Did you try 2000 in asm - there's no 400 check there so according to
>your asm routine 2000 is not a leap year.

Did you try it? Are you sure. The asm routine says 2000 is a leap year.

Quote
>The Pascal version *may* have been an attempt at an explanation but it
>won't even compile and doesn't match the asm routine.

Ok, one fault in it. It should have been:
FUNCTION XBIsLeapYear(Year:Word):Byte;       <--- boolean ??
Byte, because I then can use Inc(DayNum,XBIsLeapYear(Year));
Maybe I should change this to Boolean.
Quote
>BEGIN
>    XBIsLeapYear:=0;
>    IF Year AND 3<>0 THEN
>    Exit;

IF (Year MOD 400=0) OR (Year MOD 100<>0) THEN

- Show quoted text -

Quote
>>    XBIsLeapYear:=1;
>>END;

Go to page: [1] [2]

Other Threads