String in Datum umwandeln z.B. '01-Jan-2005' in Tdate

retnyg · Verfasst: So 14.08.05 16:56

bei deiner prozedur kriege ich immer 00 als monat, egal welchen monatsnamen ich teste.

//edit aha, habe vergessen die setup-funktion aufzurufen :shock:

hier meine rückumwandel-prozedur, ist im günstigsten fall 8%, und im schlechtesten fall 2 % schneller als deine user defined image

ausserdem ist sie 10 mal schneller, als die konvertierung in die andere richtung.

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:

Function QuickConvertDateBack (Const aDate : String) : String;
// (C) retnyg
Const
  szMonths : array [1..12] of string[3] = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug' , 'Sep', 'Oct', 'Nov', 'Dec');
var m,i: integer;
    p,p2:pchar;
    m1,m2:char;
Begin
  p := @szMonths[1][1];
  for m := 1 to 12 do begin
     if p^ = adate[4] then begin
        inc(p);
        if p^ = adate[5] then begin
           inc(p);
           if p^ = adate[6] then break;
           dec(p);
        end;
        dec(p);
     end;
     inc(p,4);
  end;
  if m > 9 then begin
     m1 := '1';
     dec(m,10);
     m2 := chr(m+48);
  end
  else begin
     m1 := '0';
     m2 := chr(m+48);
  end;

  setlength(result,8);
  p:=@result[1];
  i:=1;
  repeat
    case i of
    1: p^:= aDate[1];
    2: p^:= aDate[2];
    3: p^:= '.';
    4: p^:= m1;
    5: p^:= m2;
    6: p^:= '.';
    7: p^:= aDate[8];
    8: p^:= aDate[9];
    end;
    inc(p);
    inc(i);
  until i = 9;
End

_________________
es gibt leute, die sind genetisch nicht zum programmieren geschaffen.
in der regel haben diese leute die regel...

alzaimar · Verfasst: So 14.08.05 17:19

Du musst schon DateClass initialisieren ...

markieren

Delphi-Quelltext

1:	SetupDateClassConst;

Übrigens ist das hier wieder schneller :beer:

(Du bist also wieder am Zug)

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:

Function ConvertDateFastest (Const aDate : String) : String;
Var
  m,i : Integer;
  p : PChar;

Begin

// ---- Monats-Hash à la Alzaimar --------------------------------------------
  m := DateClass[aDate[4]];
// Wenn < 0, dann Fallunterscheidung vornehmen
  case m Of
    -1 : If aDate[5]='a' Then m := 1 else if aDate[6]= 'n' Then m := 6 else m:=7;
    -2 : If aDate[6]='y' Then m:=5 Else m:=3;
    -3 : If aDate[6]='r' Then m:=4 Else m:=8;
    End;
//----------------------------------------------------------------------------
  SetLength (Result, 8);
  p := @Result[1];
  p^ := aDate[1]; inc (p);
  p^ := aDate[2]; inc (p);
  p^ := '.'; inc (p);
  if m<10 then begin
    p^ := '0'; inc (p);
    p^ := Chr (m + 48); inc(P);
    End
  Else Begin
    p^ := '1'; inc (p);
    p^ := Chr (m + 38); inc (p);
    End;
  p^ := '.'; inc (p);
  p^ := aDate [8]; inc (p);
  p^ := aDate [9];
End;

retnyg · Verfasst: So 14.08.05 18:14

ich glaube nicht dass man noch mehr rausholen kann
deine vergleichstechnik ist ziemlich effektiv, in verbindung mit dem pointerzugriff optimal. user defined image

allein die setuproutine bietet noch optmierungsbedarf...

_________________
es gibt leute, die sind genetisch nicht zum programmieren geschaffen.
in der regel haben diese leute die regel...

retnyg · Verfasst: So 14.08.05 18:49

doch noch was rausgekommen ^^

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:

Function QuickConvertDateBack (const aDate : String) : String;
// (C) retnyg
var p,p3:pchar;
    mn:dword;
Begin
  setlength(result,8);
  p:=@result[1];
  p^:= aDate[1];
  inc(p);
  p^:= aDate[2];
  inc(p);
  p^:= '.';
  inc(p);


  cardinal(p3) := cardinal(@adate[4]);
  mn:=pdword(p3)^;
  mn := mn shl 8;
  mn := mn shr 8;
  case mn of
    $006e614a:
      begin
         p^:='0';
         inc(p);
         p^:='1';
      end;
    $00626546:
      begin
         p^:='0';
         inc(p);
         p^:='2';
      end;
    $0072614d:
      begin
         p^:='0';
         inc(p);
         p^:='3';
      end;

    $00727041:
      begin
         p^:='0';
         inc(p);
         p^:='4';
      end;

    $0079614d:
      begin
         p^:='5';
         inc(p);
         p^:='1';
      end;
    $006e754a:
      begin
         p^:='0';
         inc(p);
         p^:='6';
      end;
    $006c754a:
      begin
         p^:='0';
         inc(p);
         p^:='7';
      end;
    $00677541:
      begin
         p^:='0';
         inc(p);
         p^:='8';
      end;
    $00706553:
      begin
         p^:='0';
         inc(p);
         p^:='9';
      end;
    $0074634f:
      begin
         p^:='1';
         inc(p);
         p^:='0';
      end;
    $00766f4e:
      begin
         p^:='1';
         inc(p);
         p^:='1';
      end;
    $00636544:
      begin
         p^:='1';
         inc(p);
         p^:='2';
      end;
  end;
  inc(p);
  p^:= '.';
  inc(p);
  p^:= aDate[8];
  inc(p);
  p^:= aDate[9];
End;

_________________
es gibt leute, die sind genetisch nicht zum programmieren geschaffen.
in der regel haben diese leute die regel...

alzaimar · Verfasst: So 14.08.05 20:05

retnyg hat folgendes geschrieben:

allein die setuproutine bietet noch optmierungsbedarf...

Ich hab doch im Code vermerkt, das man das als Const-Delkaration schreiben kann:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:

Const 
  DateClass : Array [Char] Of SmallInt = (
  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  0, -3,  0,  0, 12,  0,  2,  0,  0,  0, -1,  0,  0, -2, 11,  0,
  0,  0,  0, 10,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  0, -3,  0,  0,  0,  0,  2,  0,  0,  0, -1,  0,  0, -2, 11,  0,
  0,  0,  0, 10,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0
  );

Aber dann isses ja nicht mehr so übersichtlich.

molendrotter · Verfasst: So 14.08.05 21:48

Thanks @all

is ja wirklich toll eure rege beteiligung

ich hab mich jetzt für die wirklich schnellere methode von alzaimar entschlossen is wirklich schon ziemlich schnell also 50 mal schneller als die Methode die ich vorherangewendet habe SUPERKLASSE

stellt sich nur noch die Frage, ob die direkte Umwandlung mit Stringtodate, wenn sie denn so funktioniert überhaupt noch schneller ist (-:

1000000000 Einträge in 8,733 min (AMD Athlon 1,2GH) echt klasse, wie der erst suf meinem Dualcore(2x3,0 pentium 4) abgeht.

hoffentlich haben wir nicht übersehen, das es auch ohne umwandlung des Strings in 'Zahlendatum' geht, also direkt, wär ja ne Verschwendung von so viel programmiererischen Könnens aller hir im Forum,

noch mals vielen Dank!!!!

ich lass die Frage nochmal en weilchen offen stehn fals einer alzaimar übertrumpfen will, oder meint seine methode sei schneller.

PS: leider kann ich den rückumwandlungscode nicht gebrauchen, aber der is auch super, danke @retnyg

retnyg · Verfasst: So 14.08.05 22:29

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:

Function QuickConvertDateBackAsm (const aDate : String) : String;
Begin
  asm push eax end;
  setlength(result,8);
  asm
  pop eax
  mov ecx, result
  mov ecx, [ecx]
  mov edi, dword ptr[eax]
  mov [ecx], edi
  mov edi, dword ptr[eax+5]
  mov [ecx+4], edi
  mov edx, dword ptr[eax+3]
  shl edx, 8
  shr edx, 8

  cmp edx, $006e614a
  jne @b2
  mov word ptr[ecx+3], $3130
  jmp @fin

  @b2:
  cmp edx, $00626546
  jne @b3
  mov word ptr[ecx+3], $3230
  jmp @fin

  @b3:
  cmp edx, $0072614d
  jne @b4
  mov word ptr[ecx+3], $3330
  jmp @fin

  @b4:
  cmp edx, $00727041
  jne @b5
  mov word ptr[ecx+3], $3430
  jmp @fin

  @b5:
  cmp edx, $0079614d
  jne @b6
  mov word ptr[ecx+3], $3530
  jmp @fin

  @b6:
  cmp edx, $006e754a
  jne @b77
  mov word ptr[ecx+3], $3630
  jmp @fin

  @b77:
  cmp edx, $006c754a
  jne @b7
  mov word ptr[ecx+3], $3730
  jmp @fin

  @b7:
  cmp edx, $00677541
  jne @b8
  mov word ptr[ecx+3], $3830
  jmp @fin

  @b8:
  cmp edx, $00706553
  jne @b9
  mov word ptr[ecx+3], $3930
  jmp @fin

  @b9:
  cmp edx, $0074634f
  jne @b10
  mov word ptr[ecx+3], $3031
  jmp @fin

  @b10:

  cmp edx, $00766f4e
  jne @b11
  mov word ptr[ecx+3], $3131
  jmp @fin

  @b11:

  cmp edx, $00636544
  db $75, $0A
  mov word ptr[ecx+3], $3231
  @fin:
  end;
End;

8,3 sekunden bei 100 mill. aufrufen VS 8,7 bei dir [url=www.planet-smilies.de/] user defined image

[/url]

_________________
es gibt leute, die sind genetisch nicht zum programmieren geschaffen.
in der regel haben diese leute die regel...

molendrotter · Verfasst: So 14.08.05 22:44

cool retnyg

ned schlecht ich glaub ich lern auch en bissel mehr assembler das ich sowas auch hinkrieg,

[highlight]
aber mir is was aufgefallen, in der realanwendung der Methode von alzaimar wird oft das Datum falsch umgewandelt, und macht ihn sie somit nutzlos

vielleicht hab ich ja was flasch kopiert aber manchmal kommen Strings raus wie: '2-.00.5' und so , das is ned so toll, schade jetzt hab ich mich so darauf gefreut das er funzt, mist verdammter :evil:

[/highlight]

@alzaimar und die anderen vielleicht merkt einer woran das liegt?

retnyg · Verfasst: So 14.08.05 22:52

verwendest du deutsche oder englische monatsnamen ?
jan feb mar... --> dann kannste auch meine neue asm prozeudr hernehmen
oder jan feb mär --> bescheid geben dann pass ich die funktion noch an

_________________
es gibt leute, die sind genetisch nicht zum programmieren geschaffen.
in der regel haben diese leute die regel...

Sprint · Beiträge: 849

Du musst nicht gleich Assembler lernen.

Meine Lösung:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:

function ConvertDate(const ADate: String): String;
var
  PResult: PByte;
  PADate: PByte;
  M: Integer;
begin
  SetLength(Result, 8);
  PResult := Pointer(Result);
  PADate := Pointer(ADate);
  PByteArray(PResult)[0] := PByteArray(PADate)[0];
  PByteArray(PResult)[1] := PByteArray(PADate)[1];
  PByteArray(PResult)[2] := Ord('.');
  case ADate[4] of
    'A': if ADate[5] = 'p' then
           M := 4
         else
           M := 8;
    'D': M := 12;
    'F': M := 2;
    'J': if ADate[5] = 'a' then
           M := 1
         else if ADate[6] = 'l' then
           M := 7
         else
           M := 6;
    'M': if ADate[6] = 'r' then
           M := 3
         else
           M := 5;
    'N': M := 11;
    'O': M := 10;
    'S': M := 9;
    else
      M := 0;
  end;
  if M < 10 then
    PByteArray(PResult)[3] := Ord('0')
  else
    PByteArray(PResult)[3] := Ord('1');
  PByteArray(PResult)[4] := Byte(Chr(48 + M));
  PByteArray(PResult)[5] := Ord('.');
  PByteArray(PResult)[6] := PByteArray(PADate)[7];
  PByteArray(PResult)[7] := PByteArray(PADate)[8];
end;

Konvertiert ein Datum von 01-Aug-05 in 01.08.05
Gültige Monatsabkürzungen: Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec

In meinem Test ist diese Funktion ein kleines bißchen schneller, als retnyg Assembler-Weg.

Ich würde aber auf diese Lösung verzichten, da Sicherheit und Stabilität bei mir vor Geschwindigkeit stehen.

_________________
Ciao, Sprint.

Ehemaliges Mitglied Erhaltene Danke: 1

Sprint hat folgendes geschrieben:

Luckie hat folgendes geschrieben:

Also das mit deiner Stringkonstanten und dem copy ist ja wohl das schlechteste, was einem einfallen kann. Unperformanter geht es kaum noch. warum nimmst du nicht ein zwölf elementiges Array?

*lol*

Vielleicht solltest du dich mal mit Delphi beschäftigen.

Stringoperationen sind, so viel ich weiß, nie sehr performant.

retnyg · Verfasst: Mo 15.08.05 00:03

Sprint hat folgendes geschrieben:

In meinem Test ist diese Funktion ein kleines bißchen schneller, als retnyg Assembler-Weg.

In meinem test ist deine funktion mit 9,7 sek deutlich langsamer.
ausserdem produziert sie 04.1<.05 bei '04-dec-05'

_________________
es gibt leute, die sind genetisch nicht zum programmieren geschaffen.
in der regel haben diese leute die regel...

Sprint · Beiträge: 849

retnyg hat folgendes geschrieben:

ausserdem produziert sie 04.1<.05 bei '04-dec-05'

Peinlich. Hatte vorher ein Array und vergessen das anzupassen.

_________________
Ciao, Sprint.

Sprint · Beiträge: 849

Nochmal überarbeitet:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:

function ConvertDate(const ADate: String): String;
var
  PResult: PByte;
  PADate: PByte;
  M: Integer;
begin
  SetLength(Result, 8);
  PResult := Pointer(Result);
  PADate := Pointer(ADate);
  PByteArray(PResult)[0] := PByteArray(PADate)[0];
  PByteArray(PResult)[1] := PByteArray(PADate)[1];
  PByteArray(PResult)[2] := Ord('.');
  case ADate[4] of
    'A': if ADate[5] = 'p' then
           M := 4
         else
           M := 8;
    'D': M := 12;
    'F': M := 2;
    'J': if ADate[5] = 'a' then
           M := 1
         else if ADate[6] = 'l' then
           M := 7
         else
           M := 6;
    'M': if ADate[6] = 'r' then
           M := 3
         else
           M := 5;
    'N': M := 11;
    'O': M := 10;
    'S': M := 9;
    else
      M := 0;
  end;
  if M < 10 then
  begin
    PByteArray(PResult)[3] := Ord('0');
    PByteArray(PResult)[4] := Byte(Chr(48 + M));
  end else
  begin
    PByteArray(PResult)[3] := Ord('1');
    PByteArray(PResult)[4] := Byte(Chr(38 + M));
  end;
  PByteArray(PResult)[5] := Ord('.');
  PByteArray(PResult)[6] := PByteArray(PADate)[7];
  PByteArray(PResult)[7] := PByteArray(PADate)[8];
end;

@retnyg: Ich bekomme bei deinem Code immer einen externen Fehler. Weiß aber nicht warum.

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:

procedure TForm1.Button1Click(Sender: TObject);
const
  Month: array[1..12] of String = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
    'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
  Year: array[1..3] of String = ('05', '06', '07');
var
  I, J, K, L: Integer;
  S: String;
  Frequency, Start, Stop: Int64;
begin

  QueryPerformanceFrequency(Frequency);
  QueryPerformanceCounter(Start);

  for I := 1 to 10000 do
    for J := Low(Year) to High(Year) do
      for K := Low(Month) to High(Month) do
        for L := 1 to 28 do
        begin
          S := FormatFloat('00', L) + '-' + Month[K] + '-' + Year[J];
          S := QuickConvertDateBackAsm(S);
        end;

  QueryPerformanceCounter(Stop);
  ShowMessage(FormatFloat('0.00', (Stop - Start) * 1000 / Frequency) + ' Millisekunden');

end;

Wenn du Lust hast, kannst du ja mal beide Beispiele testen.

_________________
Ciao, Sprint.

retnyg · Verfasst: Mo 15.08.05 01:35

dein beispiel benötigt bei deinem test 15123,24 ms, meines 15047,31 ms
bei meinem test 54,4 sek (sprintConvert) vs 52,3 sek (asmConvert)
getestet auf nem intel p4 3.0 HT

wundert mich dass der asm-code bei dir nicht läuft - an welcher stelle meckert er ?

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:

procedure TForm1.Button2Click(Sender: TObject);
var zeit: int64; i,j : integer;  s:string;
Const
  szMonths : array [1..12] of string[3] = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug' , 'Sep', 'Oct', 'Nov', 'Dec');
begin
  zeit := gettickcount ;
 // setupdateclassconst;
  for i := 1 to 10000000 do
    for j := 1 to 12 do
  //s:=convertdatefastest('04-'+szMonths[j]+'-05');
  s:=quickconvertdatebackasm('04-'+szMonths[j]+'-05');
//    s:=sprintconvertdate('04.Dec.05');
  //s:=spconvertdate('04-'+szMonths[j]+'-05');
  memo1.Lines.add(s);
  showmessage(inttostr((gettickcount - zeit) div 100));

end;

edit: sehe gerade dass meine asm-prozedur probleme bereitet, wenn man optimierung in den compileroptionen einschaltet ! werde das prüfen und dann ein update posten

_________________
es gibt leute, die sind genetisch nicht zum programmieren geschaffen.
in der regel haben diese leute die regel...

Sprint · Beiträge: 849

Also ich habe mal die Case Anweisung durch eine If Abfrage ersetzt. Ist dadurch einwenig schneller geworden.

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:

function ConvertDate(const ADate: String): String;
var
  PResult: PByte;
  PADate: PByte;
  M: Integer;
begin
  SetLength(Result, 8);
  PResult := Pointer(Result);
  PADate := Pointer(ADate);
  PByteArray(PResult)[0] := PByteArray(PADate)[0];
  PByteArray(PResult)[1] := PByteArray(PADate)[1];
  PByteArray(PResult)[2] := Ord('.');
  if ADate[4] = 'D' then
    M := 12
  else if ADate[4] = 'F' then
    M := 2
  else if ADate[4] = 'N' then
    M := 11
  else if ADate[4] = 'O' then
    M := 10
  else if ADate[4] = 'S' then
    M := 9
  else if ADate[4] = 'A' then
  begin
    if ADate[5] = 'p' then
      M := 4
    else
      M := 8;
  end
  else if ADate[4] = 'J' then
  begin
    if ADate[5] = 'a' then
      M := 1
    else if ADate[6] = 'l' then
      M := 7
    else
      M := 6;
  end
  else if ADate[4] = 'M' then
  begin
    if ADate[6] = 'r' then
      M := 3
    else
      M := 5;
  end
  else
    M := 0;
  if M < 10 then
  begin
    PByteArray(PResult)[3] := Ord('0');
    PByteArray(PResult)[4] := Byte(Chr(48 + M));
  end else
  begin
    PByteArray(PResult)[3] := Ord('1');
    PByteArray(PResult)[4] := Byte(Chr(38 + M));
  end;
  PByteArray(PResult)[5] := Ord('.');
  PByteArray(PResult)[6] := PByteArray(PADate)[7];
  PByteArray(PResult)[7] := PByteArray(PADate)[8];
end;

Da ich den Fehler nicht lokalizieren kann, habe ich jeden Monat 5.000.000 durchlaufen lassen.
Das sind meine Ergebnisse:

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:

                Sprint  retnyg
-----------------------------------
01-Jan-05       392,63  358,97
01-Feb-05       370,01  375,81
01-Mar-05       394,14  377,25
01-Apr-05       381,68  371,78
01-May-05       397,00  384,05
01-Jun-05       401,17  381,27
01-Jul-05       393,70  384,38
01-Aug-05       385,37  388,38
01-Sep-05       377,91  400,07
01-Oct-05       381,13  397,44
01-Nov-05       379,08  405,25
01-Dec-05       369,79  406,30

                385,30  385,91

Getestet auf einem AMD 2600+

Edit: \\
Fazit: Richtig angewendet, macht der Delphi Compiler aus Object Pascal sehr guten Code.

_________________
Ciao, Sprint.

molendrotter · Verfasst: Mo 15.08.05 11:24

@retnyg: Gültige Monatsabkürzungen: Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec sollen es sein.

dein code Sprint ist auch nicht von schlechten eltern, mich wundert nur das die ASM_lösung ungefähr die gleiche Performance bringt (ich hab mal gelert das ASM immer mindestens 20% mehr bringt gilt bei heutigen sachen wohl nicht mehris auch schon 7 Jahre her).

mal ne frage was für delphi versionen verwendet ihr vielleicht gibts da ja wieder Unterschiede im Compiler(bessere Compiler ab D8 ????)
werd mir heute Abend mal alle sorten selbst durchchecken und ermitteln welche die schnellste und zuverlässigste ist,

wieder mal vielen dank für die tollen codes, aber kann man da nicht noch was combiniern: en bissel ASM en bissel pascal von einem das von anderen dies, vielleicht bringts ja was, wed mich auch mal daran versuchen

retnyg · Verfasst: Mo 15.08.05 14:19

so, hab nun endlich ne version fertig die auch mit optimization tadellos funktioniert.
ist die optimierung aktiviert, ist sprints methode tatsächlich um ein quäntchen schneller
// edit: loooool, eine anweisung mit 2 byte wegoptimiert jetzt ist meines wieder schneller user defined image

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:

Function AsmConvertDate (const aDate : String) : String;
//edx: result, eax: aDate
asm
  push eax
  push edx
  xchg eax, edx
  xor edx, edx
  mov dl, 8

  call system.@LStrSetLength

  pop eax
  pop edx
  mov eax, [eax] // RESULT

  mov ECX, dword ptr[EDX]
  mov [EAX], ECX
  mov ECX, dword ptr[EDX+5]
  mov [EAX+4], ECX
  mov ECX, dword ptr[EDX+2]
  mov cl, 0

  cmp ECX, $6e614a00
  jne @b2
  mov word ptr[EAX+3], $3130
  jmp @fin

  @b2:
  cmp ECX, $62654600
  jne @b3
  mov word ptr[EAX+3], $3230
  jmp @fin

  @b3:
  cmp ECX, $72614d00
  jne @b4
  mov word ptr[EAX+3], $3330
  jmp @fin

  @b4:
  cmp ECX, $72704100
  jne @b5
  mov word ptr[EAX+3], $3430
  jmp @fin

  @b5:
  cmp ECX, $79614d00
  jne @b6
  mov word ptr[EAX+3], $3530
  jmp @fin

  @b6:
  cmp ECX, $6e754a00
  jne @b77
  mov word ptr[EAX+3], $3630
  jmp @fin

  @b77:
  cmp ECX, $6c754a00
  jne @b7
  mov word ptr[EAX+3], $3730
  jmp @fin

  @b7:
  cmp ECX, $67754100
  jne @b8
  mov word ptr[EAX+3], $3830
  jmp @fin

  @b8:
  cmp ECX, $70655300
  jne @b9
  mov word ptr[EAX+3], $3930
  jmp @fin

  @b9:
  cmp ECX, $74634f00
  jne @b10
  mov word ptr[EAX+3], $3031
  jmp @fin

  @b10:

  cmp ECX, $766f4e00
  jne @b11
  mov word ptr[EAX+3], $3131
  jmp @fin

  @b11:
  //cmp ECX, $63654400
  mov word ptr[EAX+3], $3231
  @fin:
End;

molendrotter hat folgendes geschrieben:

@retnyg: Gültige Monatsabkürzungen: Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec sollen es sein.

mit denen kommt mein code eh zugang.

molendrotter hat folgendes geschrieben:

dein code Sprint ist auch nicht von schlechten eltern, mich wundert nur das die ASM_lösung ungefähr die gleiche Performance bringt (ich hab mal gelert das ASM immer mindestens 20% mehr bringt gilt bei heutigen sachen wohl nicht mehris auch schon 7 Jahre her).

der delphi compiler erzeugt schlussendlich auch assemblercode, dazu noch hochoptimierten.
wenn natürlich der programmierer 20 pos und copy in seinem code hat, macht der compiler halt hochoptimierten pos und copy - code, der aber trotzdem extrem langsam ist.

wenn man schnellen code haben will, ist also mal der erste schritt zu überlegen wo performance verloren geht, und ob es nicht einen anderen weg gibt.

bei strings gibt es da mehrere tricks, z.b. am anfang gleich die länge festzulegen und dann direkt die einzelnen bytes zu schreiben.

markieren

Delphi-Quelltext

1:	strtoint(copy(adate, 4,2))

hier muss z.b. extra ein neuer string angelegt werden, wegen copy. das dauert einige 100 cpu-zyklen
darum:

markieren

Delphi-Quelltext

1:
2:

  if adAte[4] = '0' then m := ord(adate[5])-48
  else m := ord(adate[5])-38;

der vorteil vom manuellen asm-coden ist nur dass man direkt auf die register zugreifen kann

markieren

Delphi-Quelltext

1:
2:
3:
4:

  mov ECX, dword ptr[EDX]
  mov [EAX], ECX
  mov ECX, dword ptr[EDX+5]
  mov [EAX+4], ECX

mit diesen 4 zeilen asm habe ich bereits in result den string '04-Jn-05'
der rest ist dann eigentlich nur noch, bei Jn die passende monatsnummer einzufügen

_________________
es gibt leute, die sind genetisch nicht zum programmieren geschaffen.
in der regel haben diese leute die regel...

alzaimar · Verfasst: Mo 15.08.05 16:14

molendrotter hat folgendes geschrieben:

[highlight]
aber mir is was aufgefallen, in der realanwendung der Methode von alzaimar wird oft das Datum falsch umgewandelt, und macht ihn sie somit nutzlos

vielleicht hab ich ja was flasch kopiert aber manchmal kommen Strings raus wie: '2-.00.5' und so , das is ned so toll, schade jetzt hab ich mich so darauf gefreut das er funzt, mist verdammter :evil:

[/highlight]

@alzaimar und die anderen vielleicht merkt einer woran das liegt?

Ja, an der Setup-Prozedur. Der Monat Oktober ('O') wird gar nicht, der September falsch erkannt. Hier das entsprechende SetupDateClass sowie die geänderten Zeilen:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:

Procedure SetupDateClassConst;
Var
  i : Char;

Begin
  For i:= #0 to #255 do DateClass[i]:=0;
  DateClass ['j'] := -1; DateClass ['J'] := -1;
  DateClass ['f'] :=  2; DateClass ['F'] :=  2;
  DateClass ['m'] := -2; DateClass ['M'] := -2;
  DateClass ['a'] := -3; DateClass ['A'] := -3;
  DateClass ['s'] :=  9; DateClass ['S'] :=  9;
  DateClass ['o'] := 10; DateClass ['O'] := 10;
  DateClass ['n'] := 11; DateClass ['N'] := 11;
  DateClass ['d'] := 12; DateClass ['D'] := 12;
End;

Die Const-Deklaration (alternativ) ist dann:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:

Const
  DateClass : Array [Char] Of Smallint = (
  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  0, -3,  0,  0, 12,  0,  2,  0,  0,  0, -1,  0,  0, -2, 11, 10,
  0,  0,  0,  9,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  0, -3,  0,  0,  0,  0,  2,  0,  0,  0, -1,  0,  0, -2, 11,  0,
  0,  0,  0,  9,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0
);

Trozdem ist mein Code am Schnellsten, auch schneller als das ASM-Zeugs. Das beweist, das es in erster Linie auf das richtige Verfahren ankommt und DANN erst auf die Programmiersprache. Ich verwende einen DEA, das ist einer Jumptabelle nicht unähnlich. So etwas ist immer schneller als iterative Ansätze wie eine die x86-Umsetzung von Delphi für eine CASE-Anweisung.

Mich würde nun noch interessieren, ob eine ASM-Implementierung von meinem Zeugs noch mal was bringt...

retnyg · Verfasst: Mo 15.08.05 17:02

alzaimar hat folgendes geschrieben:

Trozdem ist mein Code am Schnellsten, auch schneller als das ASM-Zeugs.

tatsächlich ? ich habe gerade alle 3 algo's verglichen, jeweils die aktuellste version
hier die resultate

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:

retnyg       sprint       alzaimar
============ ============ ============
8190,80      8327,52      X 8395,43
X 8196,26    8326,91      8390,86
X 8177,86    X 8341,98    8387,98
8190,00      X 8316,46    8393,55
8191,19      8328,56      8389,69
8181,96      8330,2       8387,3
8196,00      8316,99      8392,68
8181,52      8323,19      8392,02
8185,92      8331,25      8388,32
8191,22      8323,45      X 8384,16
============ ============ ============
8188,58 ms   8326,01 ms   8390,3 ms
100,00       101,68       102,46  in prozent (weniger ist besser)

mein prüf-setup macht 10 messungen hintereinander, und streicht dann jeweils den höchsten, sowie den niedrigsten wert, um schwankungen auszugleichen. die restlichen 8 werte werden dann zur durchschnittsberechnung herangezogen
du kannst das gerne nachprüfen:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:

procedure TForm1.Button3Click(Sender: TObject);
const
  Month: array[1..12] of String = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
    'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
  Year: array[1..3] of String = ('05', '06', '07');
var
  I, J, K, L: Integer;
  S: String;
  Frequency, Start, Stop: Int64;
  result: array [1..12] of double;
  smallest, biggest, sum: double;
begin
  setupdateclassconst;
  for l := 1 to 10 do begin

    QueryPerformanceFrequency(Frequency);
    QueryPerformanceCounter(Start);

    for I := 1 to 1000000 do
        for K := Low(Month) to High(Month) do
          begin
            S := '04-' + Month[K] + '-05';
            //S := asmConvertDate(S);
            //s:=convertdatefastest(s);
            s:=spconvertdate3(s);
          end;

    QueryPerformanceCounter(Stop);
    result[l]:=(Stop - Start) * 1000 / Frequency;
    //memo1.Lines.add(FormatFloat('0.00', result[l] + ' Millisekunden');
    application.ProcessMessages;
  end;
  smallest := maxint;
  biggest := 0; sum := 0;
  for l := 1 to 10 do begin
    if result[l] < smallest then smallest := result[l];
    if result[l] > biggest then biggest := result[l];
  end;
  for l := 1 to 10 do begin
     if (result [l] = smallest) or (result [l] = biggest) then
     memo1.Lines.add( 'X ' + FormatFloat('0.00', result[l]) )
     else begin
       memo1.Lines.add(FormatFloat('0.00', result[l] ));
       sum := sum + result[l];
     end;
  end;
  memo1.Lines.add('============');
  memo1.Lines.add(FormatFloat('0.00', sum / 8 ));
end;

alzaimar hat folgendes geschrieben:

Mich würde nun noch interessieren, ob eine ASM-Implementierung von meinem Zeugs noch mal was bringt...

wenn du es optimal umsetzt, ist es vielleicht schneller als meines.
meine routine baut hauptsächlich darauf, dass die vergleichswerte 32 bit gross sind, was maximale performance erlaubt.

_________________
es gibt leute, die sind genetisch nicht zum programmieren geschaffen.
in der regel haben diese leute die regel...

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme