Autor Beitrag
GTA-Place
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
EE-Regisseur
Beiträge: 5248
Erhaltene Danke: 2

WIN XP, IE 7, FF 2.0
Delphi 7, Lazarus
BeitragVerfasst: Sa 26.11.05 12:07 
Diese Funktion hab ich vor längerer Zeit mal geschrieben.
Ich glaube man könnte da noch einiges optimieren:

ausblenden volle Höhe 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:
var
  BArray: Array[97..121of String;  

// ...

function GenerateWords(Last: String): String;
var
  Laenge, Zahl:    Integer;
  Schleife, Minus: Integer;
  NBuch, LBuch:    String;
begin
  Result := '';
  Laenge := Length(Last)-1;
  LBuch  := Copy(Last, Laenge+11);
  Zahl   := 0;
  Minus  := 1;

  for Schleife := 97 to 121 do
  begin
    if BArray[Schleife] = LBuch then
    begin
      Zahl := Schleife;
      Break;
    end;
  end;

  if (Zahl = 0AND (Copy(Last, 11) <> 'z'then
  begin
    LBuch := Copy(Last, Laenge, 1);

    for Schleife := 97 to 121 do
    begin
      if BArray[Schleife] = LBuch then
      begin
        Zahl := Schleife;
        Break;
      end;
    end;

    while Zahl = 0 do
    begin
      LBuch := Copy(Last, Laenge-Minus, 1);

      for Schleife := 97 to 121 do
      begin
        if BArray[Schleife] = LBuch then
        begin
          Zahl := Schleife;
          Break;
        end;
      end;

      inc(Minus);
    end;

    NBuch := Chr(Zahl+1);

    for Schleife := 1 to Minus do
      NBuch := NBuch + 'a';
         
    Result := Copy(Last, 0, Laenge-Minus) + NBuch;
  end
  else
  begin
    NBuch := Chr(Zahl+1);

    if (Copy(Last, 01) = 'z'AND (Zahl = 0then
    begin
      NBuch := 'a';

      for Schleife := 1 to Laenge+1 do
        NBuch := NBuch + 'a';

      Result := NBuch;
    end
    else
      Result := Copy(Last, 0, Laenge) + NBuch;
  end;
end;


Außerdem wäre es gut, wenn es noch eine Möglichkeit für einen Start/End-Buchstaben gibt.
Sprich: Es sollen nur Wörter generiert werden die mit V anfangen und vielleicht mit L enden.

Eine weitere Möglichkeit wäre dann nur Wörter zu generieren, die es geben kann.
Sprich: Vermeiden von Vv oder Xz.

Was würdet ihr an der Funktion anders machen? Ich denk die muss vielleicht komplett neu
aufgebaut werden, da sie so auch ziemlich unübersichtlich ist. Ich hab ne Weile gebraucht
um alle Fehler rauszubekommen, weil man ja nicht gleich weiß wo der Fehler ist.

Man könnte ja gleich ein Array mit den Buchstaben von A - Z erstellen. So muss nicht immer
Chr() aufgerufen werden, was vielleicht Zeit kostet und woran wieder die Übersichtlichkeit leidet.

_________________
"Wer Ego-Shooter Killerspiele nennt, muss konsequenterweise jeden Horrorstreifen als Killerfilm bezeichnen." (Zeit.de)
Muffin
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 99

WinXP Pro SP2
D7 Personal
BeitragVerfasst: Sa 26.11.05 12:54 
Die Funktion GetTickCount gibt die Zeit in Milisekunden an, die seit dem Start des Betriebssystems verstrichen sind. Damit kannst du recht einfach die Zeit messen, die dein Algorithmus braucht, und auch gleich die Optimierungserfolge sehen. Finde ich immer sehr motivierend :)
GTA-Place Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
EE-Regisseur
Beiträge: 5248
Erhaltene Danke: 2

WIN XP, IE 7, FF 2.0
Delphi 7, Lazarus
BeitragVerfasst: Sa 26.11.05 13:02 
Ja, verwende ich auch öfters.

In dem Fall braucht die Funktion für 26*26*26 Buchstaben: 16.062 Millisekunden.
ausblenden Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
  Start := GetTickCount;
  while LaengeW <= BLaengeW do
  begin
    if Stop = True then
    begin
      Stop := False;
      Exit;
    end;

    Antwort := RandomPassword(Memo1.Lines[Memo1.Lines.Count-1]);
    LaengeW := Length(Antwort);
    Memo1.Lines.Add(Antwort);

    Buchstaben := Buchstaben+1;
  end;
  ShowMessage(FloatToStr(GetTickCount - Start));

_________________
"Wer Ego-Shooter Killerspiele nennt, muss konsequenterweise jeden Horrorstreifen als Killerfilm bezeichnen." (Zeit.de)
GTA-Place Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
EE-Regisseur
Beiträge: 5248
Erhaltene Danke: 2

WIN XP, IE 7, FF 2.0
Delphi 7, Lazarus
BeitragVerfasst: Sa 26.11.05 19:08 
Hab mal ne viel kürzere Funktion (Procdeure) geschrieben:

ausblenden volle Höhe 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:
var
  LArray:    Array[1..26of Char;
  WordArray: Array of Integer;

// ...

procedure TForm1.FormCreate(Sender: TObject);
var
  X: Integer;
begin
  for X := 97 to 121 do
    LArray[X] := Chr(X);
end;

// ...

procedure GenerateWords2;
var
  X: Integer;
begin
  if WordArray[Length(WordArray) - 1] + 1 = 27 then
  begin
    WordArray[Length(WordArray) - 1] := 1;

    for X := Length(WordArray) - 2 downto 0 do
    begin
      WordArray[X] := 1;
      inc(WordArray[X - 1]);

      try
        if not (WordArray[X - 1] = 27then
          Break;
      except
        Break;
      end;
    end;
  end
  else
    inc(WordArray[Length(WordArray) - 1]);
end;

// ...

procedure TForm1.Button3Click(Sender: TObject);
var
  X, Y:    Integer;
  StartL:  Integer;
  LaengeW: Integer;
  EndL:    Integer;
  TempStr: String;
  Start:   Single;
begin
  Memo1.Clear;
  Stop    := False;
  StartL  := 1;
  EndL    := 1;

  LaengeW := StrToInt(VonEdit.Text);
  SetLength(WordArray, LaengeW);

  for X := 0 to LaengeW - 1 do
  begin
    WordArray[X] := 1;            // Anfangsbuchstabe, A = 1;
    LaengeW      := StartL * 26;
  end;

  for X := 1 to StrToInt(BisEdit.Text) do
    EndL := EndL * 26;

  Start := GetTickCount;
  for X := StartL to EndL do
  begin
    if Stop = True then
    begin
      Stop := False;
      Exit;
    end;

    GenerateWords2;
    LaengeW := Length(WordArray);

    TempStr := '';
    for Y := 0 to Length(WordArray) - 1 do
      TempStr := TempStr + LArray[WordArray[Y]];

    Application.ProcessMessages;
    Memo1.Lines.Add(TempStr);
  end;
  ShowMessage('Dauer: ' + FloatToStr(GetTickCount - Start));
end;


Da muss aber irgendwo ein Fehler sein, denn 1. steht nie was im Memo
und 2. Ist WordArray[Y] beim 2. Mal viel zu groß (über 100.000).

_________________
"Wer Ego-Shooter Killerspiele nennt, muss konsequenterweise jeden Horrorstreifen als Killerfilm bezeichnen." (Zeit.de)
F34r0fTh3D4rk
ontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic star
Beiträge: 5284
Erhaltene Danke: 27

Win Vista (32), Win 7 (64)
Eclipse, SciTE, Lazarus
BeitragVerfasst: Sa 26.11.05 20:36 
guck dir doch meinen namegen an, der src schwirrt hier bestimmt rum, vielleicht nicht der aktuellste aber besser als garnischt ;)
GTA-Place Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
EE-Regisseur
Beiträge: 5248
Erhaltene Danke: 2

WIN XP, IE 7, FF 2.0
Delphi 7, Lazarus
BeitragVerfasst: Sa 26.11.05 20:41 
OK, guck's mir mal an. Würde aber trotzdem gern wissen wo der Fehler ist.

_________________
"Wer Ego-Shooter Killerspiele nennt, muss konsequenterweise jeden Horrorstreifen als Killerfilm bezeichnen." (Zeit.de)