Den letzten Donnerstag eines Monats

[ConstantGardener]

Delphi-Quellcode:

function TForm2.LetzterDonnerstag(AYear, AMonth: Word): TDate;
var ADate : TDate;
    ADay  : Word;
begin
 ADate:=IncMonth(EncodeDate(AYear,AMonth,1))-1;                  // letzer Tag des Monats
 ADay :=DayOfTheWeek(ADate);                                     // ist was für ein Tag ?
 if ADay<4 then                                                 
  result:=ADate+(4-ADay)-7                                       // Montag-Mittwoch ?
 else
  result:=ADate+(4-ADay)
end;

evtl. so?

[Solutor]

Dieser Funktion übergibt man das Jahr, den Monat und den Wochentag von dem man wissen möchte wann der letzte davon im Monat ist.
Als Ergebnis bekommt man das Datum (TDatetime) dieses letzen Tages.
Die Wochendatge sind nach der alten Weise vergeben. 1-7 wovon 1 der Sonntag ist.

Für das geforderte Problem würde man die 5 für Donnerstag als letzten Parameter übergeben.

Da hier keine Schleifen, sondern nur eine verkettete If Abfrage sowie eine Addition, bzw. Subtraktion verwendet wird,
dürfte diese Funktion auch recht schnell sein.

Delphi-Quellcode:

Function GetLastWeekDayOfMonth(yyyy,mm,d:Integer):TDatetime;
Var Adate:TDatetime;
    y,m,z:Integer;
begin
   z:=DayOfWeek(DateUtils.EndOfAMonth(yyyy,mm));
   if z=d then
   begin
      Result:=DateUtils.EndOfAMonth(yyyy,mm);
   end
   else
   if z>d then
   begin
      z:=z-d;
      Result:=DateUtils.EndOfAMonth(yyyy,mm)-z;
   end
   else
   begin
      z:=z-d;
      Result:=DateUtils.EndOfAMonth(yyyy,mm)-z-7;
   end;
end;

[LTE5]

Deine Funktion ist etwa 60% schneller als die im Beitrag dadrüber.

[Amateurprofi]

Zitat von LTE5:

Deine Funktion ist etwa 60% schneller als die im Beitrag dadrüber.

Naja, wenn es um Schnelligkeit geht dann so:

Delphi-Quellcode:

// WeekDay 0=Mo, 6=So
FUNCTION LastWeekDayOfMonth(Year,Month,WeekDay:Integer):TDateTime;
const DIM:Array[1..12] of byte=(31,28,31,30,31,30,31,31,30,31,30,31);
var Day,DN,DoW,Y:Integer;
begin
   Y:=Year;
   Day:=DIM[Month]+Ord((Month=2) and ((Year mod 4=0) and (Year mod 100<>0) or (Year mod 400=0)));
   DN:=Year*365+Day+31*(Month-1);
   If Month>2 then Dec(DN,(23+4*Month) div 10)
      else if Year<>0 then Dec(Year)
         else Dec(DN);
   Inc(DN,Year div 4 - Year div 100 + Year div 400);
   DoW:=(5+DN) mod 7;
   if WeekDay>DOW then Dec(Day,7-WeekDay+DoW) else Dec(Day,Dow-WeekDay);
   Result:=EncodeDate(Y,Month,Day);
end;

Kurz zur Funktion, falls es jemanden interessiert:
In der Funktion wird u.A. DN berechnet. DN ist die Anzahl der Tage, die seit dem fiktiven Datum 01.01.0000 vergangen sind, wobei angenommen wird, dass der Gregorianische Kalender schon immer gegolten hätte.
Der 01.01.0000 hätte also die Nummer 0.

Auf meinem Rechner (i7 2600K 3.4 GHz) arbeitet diese Funktion deutlich schneller.
Bei unten stehendem Test brauchte diese Funktion 187 ms, die aus #7 2262 ms.
Das mag auf anderen Rechnern anders sein.

Hinzu kommt, dass die Funktion aus #7 in bestimmten Fällen falsche Resultate liefert.
Für Dezember 1899 und Montag liefert #7 den 26.12.1899, richtig wäre der 25.12.1899 (Geburtstag von Humphrey Bogart).
Auch für Dienstag bis Freitag im Dezember 1899 tritt diese Verschiebung um einen Tag auf.
Ansonsten arbeitet sie im Zeitraum 1583 bis 2500 korrekt.
Was mir ebenfalls nicht an #7 gefällt, ist, dass sie nicht ein Datum sondern einen Zeitpunkt liefert (nämlich 23:59:59 am jeweiligen Tag) was vermutlich auch die Quelle des Fehlers ist.

Hier die Prozedur mit der ich getestet habe.

Delphi-Quellcode:

PROCEDURE TMain.Test;
var Err,I,Year,Month,DoW1,DoW2:Integer; DT1,DT2:TDateTime; DS1,DS2:String;
    T0,T1,T2:Cardinal;
begin
   // Prüfung ob beide Funktionen identische Ergebnisse bringen
   Err:=0;
   for Year:=1583 to 2500 do
      for Month:=1 to 12 do
         for DoW1:=0 to 6 do begin
            DT1:=LastWeekDayOfMonth(Year,Month,DoW1);
            DS1:=FormatDateTime('dd.mm.yyyy',DT1);
            if DoW1<6 then DoW2:=DoW1+2 else DoW2:=1;
            DT2:=GetLastWeekDayOfMonth(Year,Month,DoW2);
            DS2:=FormatDateTime('dd.mm.yyyy',DT2);
            if DS1<>DS2 then begin
               Inc(Err);
               ShowMessage(IntToStr(Year)+' '+IntToStr(Month)+#13+
                           IntToStr(DoW1)+' '+DS1+#13+
                           IntToStr(DoW2)+' '+DS2);
            end;
         end;
   ShowMessage(IntToStr(Err));
   // Performance Vergleich
   T0:=GetTickCount;
   for I:=1 to 50 do
      for Year:=1583 to 2500 do
         for Month:=1 to 12 do
            for DoW1:=0 to 6 do
               DT1:=LastWeekDayOfMonth(Year,Month,DoW1);
   T1:=GetTickCount;
   for I:=1 to 50 do
      for Year:=1583 to 2500 do
         for Month:=1 to 12 do
            for DoW2:=1 to 7 do
               DT2:=GetLastWeekDayOfMonth(Year,Month,DoW2);
   T2:=GetTickCount;
   ShowMessage(IntToStr(T1-T0)+#13+IntToStr(T2-T1));
end;

[blawen]

Zitat von Amateurprofi:

Naja, wenn es um Schnelligkeit geht dann so:

Delphi-Quellcode:

// WeekDay 0=Mo, 6=So
FUNCTION LastWeekDayOfMonth(Year,Month,WeekDay:Integer):TDateTime;
const DIM:Array[1..12] of byte=(31,28,31,30,31,30,31,31,30,31,30,31);

Wie sieht es mit Schaltjahren aus? Diese werden nicht berücksichtigt - oder übersehe ich etwas?

[Amateurprofi]

Zitat von blawen:

Zitat von Amateurprofi:

Naja, wenn es um Schnelligkeit geht dann so:

Delphi-Quellcode:

// WeekDay 0=Mo, 6=So
FUNCTION LastWeekDayOfMonth(Year,Month,WeekDay:Integer):TDateTime;
const DIM:Array[1..12] of byte=(31,28,31,30,31,30,31,31,30,31,30,31);

Wie sieht es mit Schaltjahren aus? Diese werden nicht berücksichtigt - oder übersehe ich etwas?

Ja, da übersiehst du etwas.
1) Hier
Day:=DIM[Month]+Ord((Month=2) and ((Year mod 4=0) and (Year mod 100<>0) or (Year mod 400=0)));
2) Und hier
Inc(DN,Year div 4 - Year div 100 + Year div 400);

[Amateurprofi]

Ich hab mir das noch einmal angeschaut und die Funktion aus #9 optimiert.
Die neue Version ist noch einmal fast doppelt so schnell und ist auch verständlicher aufgebaut.

Delphi-Quellcode:

FUNCTION LastWeekDayOfMonth(Year,Month,WeekDay:Word):TDateTime;
const Days:Array[1..12] of Integer=(31,59,90,120,151,181,212,243,273,304,334,365);
var DN,DoW:Integer;
begin
   DN:=Days[Month];
   if (Month>=2) and ((Year Mod 4=0) and (Year mod 100<>0) or (Year mod 400=0)) then Inc(DN);
   Dec(Year);
   Inc(DN,Year*365 + Year div 4 - Year div 100 + Year div 400);
   DoW:=(6+DN) mod 7;
   if WeekDay>DOW then Dec(DN,7-WeekDay+DoW) else Dec(DN,Dow-WeekDay);
   Result:=DN-System.SysUtils.DateDelta;
end;

[Solutor]

Korrekt! Meine Funktion hat nur einen eingeschränkten Gültigkeitsbereich. Doch ein umfangreicherer Gültigkeitsbereich wäre nur für
astronomische Anwendungen interessant. Für die Anwendungen im täglichen Leben, spielt es keine Rolle.
Der Ansatz sämtliche Formularien selbst zu kreieren ist natürlich sinnvoll, wenn man auf Geschwindigkeit optimiert,
der nächste Schritt wäre dann Teile in Assembler abzuarbeiten.
Bei meinem Ansatz ging es darum, mit der in Delphi vorhandenen Funktionalität,
ohne tiefere Kenntnisse der mathematischen Hintergründe, das Problem anzupacken, ohne dabei Schleifenkonstrukte verwenden zu müssen.
Damit ist diese Funktion immer noch mindestens um den Faktor 100 schneller, als die gleiche Lösung in Excel.

[Amateurprofi]

@Solutor:

Zitat:

Korrekt! Meine Funktion hat nur einen eingeschränkten Gültigkeitsbereich.

Nein! Deine Funktion arbeitet für den gesamten Zahlenbereich, der von TDateTime unterstützt wird korrekt, außer eben für Montag bis Freitag im Dezember 1899.

Zitat:

Doch ein umfangreicherer Gültigkeitsbereich wäre nur für
astronomische Anwendungen interessant. Für die Anwendungen im täglichen Leben, spielt es keine Rolle.

Naja! Was sind Anwendungen im täglichen Leben?
Stell dir vor du sitzt bei Günter Jauch und kriegst als 1 Mio € Frage "Wann wurde Humphrey Bogart geboren" und gefragt ist das genaue Datum. Mit deinem vorletzten Joker kriegst du aus dem Publikum die Information dass der am letzten Montag in 1899 geboren wurde, was dir aber so auch nicht hilft. Mit dem letzten Joker rufst du jemanden an der Deine Funktion auf dem Rechner hat, und der sagt dir "26.12.1899".
Und futsch ist die Million, und warum sie futsch ist, erkläre ich etwas weiter unten.

Zitat:

Der Ansatz sämtliche Formularien selbst zu kreieren ist natürlich sinnvoll, wenn man auf Geschwindigkeit optimiert

Ja, uneingeschränkt ja.
Und deshalb habe ich weiter unten eine weitere Version, die noch einmal fast doppelt so schnell ist, wie die aus #12.

Zitat:

der nächste Schritt wäre dann Teile in Assembler abzuarbeiten.

Richtig, und am Ende dieses Beitrags findest du das Ganze in Assembler sowohl für 32 Bit wie auch 64 Bit.
Und die ist noch einmal fas doppelt so schnell.

Zitat:

Bei meinem Ansatz ging es darum, mit der in Delphi vorhandenen Funktionalität, ohne tiefere Kenntnisse der mathematischen Hintergründe, das Problem anzupacken, ohne dabei Schleifenkonstrukte verwenden zu müssen.

Aber was nützt das, wenn dir Resultate (zumindest teilweise) nicht stimmen?

Zitat:

Damit ist diese Funktion immer noch mindestens um den Faktor 100 schneller, als die gleiche Lösung in Excel.

Und sie braucht 60 Mal so viel Zeit wie die Asm-Version am Ende des Beitrags.


Da mich dieses Thema und die damit verbundenen Probleme interessierten, habe ich mir alle Funktionen aus diesem Thread genauer angeschaut:

LastThursday aus #5
Funktioniert überhaupt nicht.
Die Funktion liefert immer den 28. des Monats als letzten Donnerstag.
Richtige Ergebnisse kommen bestenfalls zufallsbedingt, wie zum Beispiel im Dezember 2017.
Warum ist das so:
Mit DaysInAMonth(Year, Month) wird die Anzahl der Tage im Monat geholt und in die Variable Day gestellt.
Anschließend wird Day so lange um 1 gesenkt, bis (Day+5) mod 7 = 5 ist.
Das ist sehr zuverlässig immer dann der Fall, wenn Day = 28 ist.
Das Ergebnis wird dann mit EncodeDate(Year,Month,Day) errechnet.
Vermutlich hat der Autor erwartet, dass (Day+5) mod 7 den Wochentag ergibt, was aber nicht stimmt.

LetzterDonnerstag aus #6
Arbeitet korrekt für den Zeitraum 01.0001 bis 11.9999
Bei 12.9999 erfolgt eine Exception, weil mit IncMonth(AYear,AMonth,1) versucht wird einen TDateTime für den ersten Tag des Folgemonats zu holen.
Das scheitert, weil TDateTime nur bis 31.12.9999 23:59:59.999 unterstützt wird.
Performance: 2777 ms für 11997600 Durchläufe = 231.5 µs je Durchlauf

GetLastWeekDayOfMonth aus #7
Arbeitet korrekt für den Zeitraum 01.0001 bis 12.9999, ausgenommen für Montag bis Freitag im Dezember 1899.
Ursache für die Fehler ist, dass die Funktion für den letzten Tag des Monats nicht einen Datumswert sondern einen Zeitpunkt verwendet, nämlich 23:59:59 am letzten Tag des Monats.
Beispiel für Freitag im Dezember 1899:
Der letzte Tag des Monats ist ein Sonntag und es wird richtig erkannt, dass das Datum vom letzten Tag des Monats um 2 gesenkt werden muss.
Hierfür wird mit System.DateUtils.EndOfAMonth(yyyy,mm) das Ende des Monats geholt und dieser Wert um 2 gesenkt.
Das Ende des Monats (31.12.1899 23:59:59) ist 1.999999988425930
Hiervon 2 subtrahiert ergibt -0.000000011574074, was dem 30.12.1899 00:00:00 entspricht. Richtig wäre der 29.12.1899.
Der Hintergrund ist, dass der Integerteil eines TDateTime, der den Tag angibt, als vorzeichenbehafteter Wert betrachtet wird. Negative Werte sind Tage vor dem 30.12.1899.
Abweichend hiervon wird der Nachkommateil, der die Uhrzeit angibt, als vorzeichenloser Wert betrachtet.
Bei Berechnungen von TDateTime-Werten, bei denen der Nachkommateil nicht leer ist, führt das dann zu Problemen wenn ein Wechsel des Vorzeichens auftritt.
Wie man oben schön sieht, wird, wenn 2 subtrahiert wird, nicht der Integeranteil um 2 gesenkt.
Performance: 4945 ms für 8399160 Durchläufe = 588.7 µs je Durchlauf

LastWeekDayOfMonth aus #9
Arbeitet korrekt für den Zeitraum 01.0001 bis 12.9999
Performance: 421 ms für 8399160 Durchläufe = 50.1 µs je Durchlauf

LastWeekDayOfMonth aus #12
Arbeitet korrekt für den Zeitraum 01.0001 bis 12.9999
Performance: 249 ms für 8399160 Durchläufe = 29.6 µs je Durchlauf

LastWeekDayOfMonth aus diesem Beitrag weiter unten
Arbeitet korrekt für den Zeitraum 01.0001 bis 12.9999
Performance: 140 ms für 8399160 Durchläufe = 16.7 µs je Durchlauf

LastWeekDayOfMonthAsm aus diesem Beitrag weiter unten
Performance: 78 ms für 8399160 Durchläufe = 9.3 µs je Durchlauf

Delphi-Quellcode:

FUNCTION LastWeekDayOfMonth(Year,Month,WeekDay:Integer):TDateTime;
const DOffs:Array[1..12] of Integer=(31,59,90,120,151,181,212,243,273,304,334,365);
var DN,DoW:Integer;
begin
   DN:=Year*365+DOffs[Month];
   if Month=1 then Dec(Year);
   Year:=Year shr 2;  // Year Div 4
   Inc(DN,Year);
   Year:=Year div 25; // Year Div 100
   Inc(DN,Year shr 2 - Year);
   DoW:=(5+DN) mod 7;
   if WeekDay>DoW then Dec(DN,7-WeekDay+DoW) else Dec(DN,Dow-WeekDay);
   Result:=DN-System.SysUtils.DateDelta-365;
end;

Delphi-Quellcode:

FUNCTION LastWeekDayOfMonthAsm(Year,Month,WeekDay:Integer):TDateTime;
asm
{$IFDEF CPUX86}      // EAX=Year, EDX=Month, ECX=WeekDay
            push     ebx
            imul     ebx,eax,365             // DN:=Year*365
            add      ebx,[edx*4+@Const-4]    // Inc(DN,DOffs[Month])
            cmp      edx,1                   // Month=1?
            jne      @1                      // Nein
            sub      eax,1                   // Dec(Year)
@1:         shr      eax,2                   // Year:=Year div 4
            add      ebx,eax                 // Inc(DN,Year)
            xor      edx,edx
            div      [13*4+@Const]           // Year:=Year div 25
            sub      ebx,eax                 // Dec(DN,Year)
            shr      eax,2                   // Year:=Year div 4
            add      ebx,eax                 // Inc(DN,Year)
            lea      eax,[ebx+5]
            xor      edx,edx
            div      [12*4+@Const]           // DoW=(5+DN) mod 7
            sub      edx,ecx                 // DoW-WeekDay
            jns      @2                      // WeekDay<=Dow
            add      edx,7
@2:         sub      ebx,edx
            sub      ebx,System.Sysutils.DateDelta+365
            push     ebx
            fild     DWord[esp]              // Result:=DN
            pop      ecx
            pop      ebx
            ret
//@Const:     dd       31,59,90,120,151,181,212,243,273,304,334,365,7,25
{$ELSE}              // RCX=Year, RDX=Month, R8=WeekDay
            lea      r10,@Const              // Zeiger auf Konstanten
            mov      eax,ecx                 // Year
            imul     r9d,eax,365             // DN:=Year*365
            add      r9d,DWord[r10+rdx*4-4]  // Inc(DN,Const[Month])
            cmp      edx,1                   // Month=1?
            jne      @1                      // Nein
            sub      eax,1                   // Dec(Year)
@1:         shr      eax,2                   // Year:=Year div 4
            add      r9d,eax                 // Inc(DN,Year)
            xor      edx,edx
            div      DWord[r10+13*4]         // Year:=Year div 25
            sub      r9d,eax                 // Dec(DN,Year)
            shr      eax,2                   // Year:=Year div 4
            add      r9d,eax                 // Inc(DN,Year)
            lea      rax,[r9+5]
            xor      edx,edx
            div      DWord[r10+12*4]         // DoW=(5+DN) mod 7
            sub      edx,r8d                 // DoW-WeekDay
            jns      @2                      // WeekDay<=Dow
            add      edx,7
@2:         sub      r9d,edx
            sub      r9d,System.Sysutils.DateDelta+365
            cvtsi2sd xmm0,r9d
            ret
{$ENDIF}
@Const:     dd       31,59,90,120,151,181,212,243,273,304,334,365,7,25
end;

[Michael II]

Zitat von Solutor:

Korrekt! Meine Funktion hat nur einen eingeschränkten Gültigkeitsbereich.

Du kannst deine Funktion sehr leicht anpassen, indem du von EndOfAMonth nur das Datum, nicht aber die Zeit verwendest:

Delphi-Quellcode:

Function GetLastWeekDayOfMonth( year, month, d : Integer) : TDatetime;
Var dow, eom : integer;
// d : 1= Sonntag 2=Montag 3=Dienstag ...
begin
   eom := trunc( DateUtils.EndOfAMonth(year,month) );
   dow := DayOfWeek(eom);

   if ( dow >= d ) then
      Result:=eom-dow+d
   else
      Result:=eom-dow+d-7;
end;

Irgendwann um das Jahr 4813 rum, werden wir sämtliche Funktionen anpassen müssen, weil voraussichtlich ein Schalttag ausfallen wird.

Spannend ist auch: "Auch nach der Einführung des gregorianischen Kalenders war es noch eine Zeit lang wie im julianischen Kalender üblich, in einem Schaltjahr den 24. Februar zu verdoppeln (siehe Missale Romanum, nebenstehendes Bild). Bei der Zählung der Kirchentage in der katholischen Kirche galt diese Praxis sogar noch bis 2001. Erst seitdem wird in den Ausgaben des Martyrologium Romanum die Durchnummerierung der Kalendertage zugrunde gelegt und folglich der 29. Februar verwendet.[2]" https://de.wikipedia.org/wiki/Schaltjahr

Der berechneten "Februar Werte" für die Jahre kurz nach 1582 sind also mit Vorsicht zu geniessen .