# 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.
<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
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.  :-)
--

## 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.
--

## 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.
<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 &
> 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

##### 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.
--

## 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]