Adventsgewinnspiel 2007 - Lösungen Frage 1

BenBE · Verfasst: Mo 03.12.07 00:57

Also hier die Lösungsvorschläge für das erste Gewinnspiel...

Werden sicherlich von einigen schon sehnsüchtig erwartet, damit man sich anschauen kann, warum der eigene Code nicht funktionierte oder so langsam war.

Hier erstmal ein Schätzchen, zu dem der Kommentar eines Users in diesem Forum sinngemäß lautete: "Ich will auch endlich Assembler mit PHP entwickeln können" (naja ... oder so ähnlich halt :mrgreen:

). Viel Spaß mit dem ersten Schnipsel:

markieren

DF2007_Easy1.php

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:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:

<?php

$zahl = 0;

$start = microtime(true);

set_time_limit(0);

$last = array();
$ltmp = 0;
$lcur = 0;
while($ltmp < 1000){
    while(
        (((($lcur % 10) * (int)(($lcur % 100) / 10)) * (int)(($lcur % 1000) / 100)) == 0) ||
        ((($lcur % 10) + (int)(($lcur % 1000) / 100)) !== 7) )
        $lcur++;

    while($ltmp < $lcur)
        $last[$ltmp++] = $lcur;
    $lcur++;
}

$zdim = 1;

do {
    $zahl++;
    $zoff = $zahl % 1000;
    $zahl += $last[$zoff] - $zoff;

    $right = true;

    while($zahl / $zdim >= 100) $zdim *= 10;
    //$ztmp = (int)($zahl / $zdim);
    $right &= (int)($zahl / $zdim) % 9 == 0;
    if(!$right) {
        $zahl += $zdim - ($zahl % $zdim);
        continue;
    }

//    $right &= (($zahl % 10) + (int)(($zahl % 1000) / 100)) == 7;
//    if(!$right) continue;

    $ztmp = $zahl;
    $zq = 0;
    $zp = 1;
    while($ztmp) {
        $z = $ztmp % 10; //~10 Sekunden
        $zq = $zq + $z; //~10 Sekunden
        $zp = $zp * $z; //~10 Sekunden
        $ztmp = (int)($ztmp / 10);
    }
    $right &= $zq % 19 == 0;
    $right &= $zp % 10 == 2;
    if(!$zp) {
        $add = 1;
        while($zahl > $add)
            $add *= 10;
        $zahl++;
        $add /= 10;
        do {
            $add /= 10;
            while((int)(($zahl % ($add * 10)) / $add) == 0)
                $zahl += $add - ($zahl % $add);
        } while($add > 1);
        $zahl--;
        continue;
    }
    if(!$right) continue;

    $zhex = sprintf("%x", $zahl);
    $right &= 0 == preg_match("/[a-f]/i", $zhex);
    if(!$right) {
        $add = 1;
        $zahl++;
        do {
            while((int)(($zahl % ($add * 16)) / $add) >= 10)
                $zahl += $add - ($zahl % $add);
            $add *= 16;
        } while($add < $zahl);
        $zhex = sprintf("%x", $zahl);
        $zahl--;
        continue;
    }

    $right &= preg_match("/7[89]/i", $zhex);
    if(!$right) {
        do {
            $right = preg_match("/7[89]/i", sprintf("%x", ++$zahl));
        } while(!$right);
        $zahl--;
        $right = false;
        continue;
    }


    $zbin = str_replace(array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9"),
        array("0000", "0001", "0010", "0011", "0100", "0101", "0110", "0111", "1000", "1001"), $zhex);
    $right &= preg_match("/1{4,}/i", $zbin);
    if(!$right) continue;
    $right &= preg_match("/\A0*(10*){0,8}\Z/i", $zbin);
    if(!$right) continue;

    $za = array(0,0,0,0,0,0,0,0,0,0);
    $ztmp = $zahl;
    while($ztmp) {
        if(++$za[($ztmp % 10)] > 2) {
            $right = false;
            break;
        }
        $ztmp = (int)($ztmp / 10);
    }

} while(!$right);


echo $zahl . "\n";

$stop = microtime(true);

echo "Zeit: " . ($stop - $start) . "\n";

?>

Das bemerkenswerte an diesem Source ist: Die Hauptzeit (nämlich laut meinem Profiler ~26 von 28,4 Sekunden ;-)

) verbrät dieser Source in den Zeilen 47-49 ... Naja, da kann man nix machen. Also kurzerhand nach Delphi portiert:

markieren

DF2007_Easy1_U.pas

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:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:

Unit DF2007_Easy1_U;

Interface

Uses
    Windows,
    Messages,
    SysUtils,
    Variants,
    Classes,
    Graphics,
    Controls,
    Forms,
    Dialogs,
    StdCtrls;

Type
    TForm1 = Class(TForm)
        Edit1: TEdit;
        Button1: TButton;
        Procedure Button1Click(Sender: TObject);
    Private
        { Private-Deklarationen }
    Public
        { Public-Deklarationen }
    End;

Var
    Form1: TForm1;

Implementation

{$R *.dfm}

Procedure TForm1.Button1Click(Sender: TObject);
Var
    Start, Stop: Int64;

    Zahl: Integer;
    ztmp, zbin, zdim, zp, zq, add: Integer;

    right: Boolean;

    nextnum: Array[0..1116] Of Integer;
    nncur, nntmp: integer;

    za: Array[0..15] Of Integer;

Begin
    zahl := 0;

    QueryPerformanceCounter(Start);

    //Berechnen der Lookup-Table ;-)
    nntmp := 0;
    nncur := 0;
    While nntmp < 1000 Do
    Begin
        While
            (
            (nncur Mod 10) *
            ((nncur Mod 100) Div 10) *
            ((nncur Mod 1000) Div 100) = 0
            )
            Or
            (
            (nncur Mod 10) +
            ((nncur Mod 1000) Div 100) <> 7
            ) Do
            Inc(nncur);

        While nntmp < nncur Do
        Begin
            nextnum[nntmp] := nncur;
            Inc(nntmp);
        End;

        inc(nncur);
    End;

    zdim := 1;

    right := false;
    Repeat
        Inc(zahl);
        ztmp := zahl Mod 1000;
        zahl := zahl + nextnum[ztmp] - ztmp;

        While zahl Div zdim >= 100 Do
            zdim := zdim * 10;

        If (zahl Div zdim) Mod 9 <> 0 Then
        Begin
            zahl := zahl + zdim - (zahl Mod zdim);
            continue;
        End;

        ztmp := zahl;
        zq := 0;
        zp := 1;
        While ztmp <> 0 Do
        Begin
            zbin := ztmp Mod 10;
            zq := zq + zbin;
            zp := zp * zbin;
            ztmp := ztmp Div 10;
        End;

        If zp = 0 Then
        Begin
            add := zdim;
            Inc(zahl);

            Repeat
                While (zahl Mod (add * 10)) Div add = 0 Do
                    zahl := zahl + add - (zahl Mod add);
                add := add Div 10;
            Until add < 100;

            dec(Zahl);
            continue;
        End;

        If (zq Mod 19 <> 0) Or (zp Mod 10 <> 2) Then
            continue;

        ztmp := Zahl;
        Right := False;
        While (ztmp <> 0) And Not right Do
        Begin
            If ztmp And $F > 9 Then
                Break;
            Right := Right Or (ztmp And $FC = $78);
            ztmp := ztmp Shr 4;
        End;

        If Not right Then
        Begin
            add := 0;
            Inc(zahl);
            Repeat
                While (zahl Shr add) And $F > 9 Do
                    zahl := ((zahl Shr add) + 1) Shl add;
                Inc(add, 4);
            Until (1 Shl add > zahl) Or (add >= 32);
            Dec(zahl);
            continue;
        End;

        zbin := 0;
        ztmp := Zahl;
        While ztmp <> 0 Do
        Begin
            zbin := zbin + (ztmp And 1);
            ztmp := ztmp Shr 1;
        End;
        If zbin > 8 Then
        Begin
            Right := False;
            continue;
        End;

        For add := 1 To 9 Do
            za[add] := 0;
        ztmp := zahl;
        While ztmp <> 0 Do
        Begin
            add := ztmp Mod 10;
            Inc(za[add]);
            If za[add] > 2 Then
            Begin
                right := false;
                break;
            End;
            ztmp := ztmp Div 10;
        End;

    Until right;

    QueryPerformanceCounter(Stop);
    Stop := Stop - Start;
    QueryPerformanceFrequency(Start);
    Caption := Format('%.6fs', [stop / start]);
    Edit1.Text := IntToStr(Zahl);
End;

End.

Ui, siehe da: Gegenüber PHP nahezu nix geändert (nagut: Die Regexps anderweitig umgesetzt) und schon runter auf 1,38 Sekunden. Gratulation: Wer brauch da noch Assembler *zu user profile icon

keinem Besonderen schiel* ;-)

Naja ... und da noch die Chance auf schnellere Sources bestand: halt kurz mit Hilfe der Idee von nem Kumpel (der das Rätsel mit etwas Unterstützung in ner dreiviertel Stunde auf Papier gelöst hat - Gruß in die vereinigten Staaten - ), mal eben noch ein neues Edit und nen weiteren Button ergänzt:

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:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:

Procedure TForm1.Button2Click(Sender: TObject);
Var
    Start, Stop: Int64;

    Zahl: Integer;

    right: Boolean;

    a, b, c, d, e: Integer;
    ma, mb, mc, md, me: Integer;

    za: Array[0..15] Of Integer;

    vsuf: Array[0..999] Of Boolean;
    tmp, digit: Integer;

    zdim: Integer;
    zq, zp: Integer;

Begin
    zahl := 0;

    QueryPerformanceCounter(Start);

    For tmp := 0 To 999 Do
    Begin
        vsuf[tmp] :=
            (
            (tmp Mod 10) *
            ((tmp Mod 100) Div 10) *
            ((tmp Mod 1000) Div 100) <> 0
            )
            And
            (
            (tmp Mod 10) +
            ((tmp Mod 1000) Div 100) = 7
            );
    End;

    right := false;

    a := 8;
    While (a < 31) And Not right Do
    Begin
        ma := 1 Shl a;
        Try
            b := 0;
            While (b < a) And Not right Do
            Begin
                mb := ma + (1 Shl b);
                Try
                    c := 0;
                    While (c < b) And Not right Do
                    Begin
                        mc := mb + (1 Shl c);
                        Try
                            If (mc Shr c) And $F > 9 Then
                                continue;

                            d := 0;
                            While (d + 8 <= c) And (d + 12 <= a) And Not right Do
                            Begin
                                md := mc + ($78 Shl d);
                                Try
                                    e := 0;
                                    While (e < c) And (e + 2 < a) And Not right Do
                                    Begin
                                        me := md + (1 Shl e);

                                        If d + 1 = e Then
                                        Begin
                                            Inc(e, 7);
                                            continue;
                                        End;

                                        zahl := me;
                                        Try
                                            //Zahl testen ...

                                            //The last 3 digits:
                                            // Look them up in the lookup table we pre-calculated
                                            If Not vsuf[zahl Mod 1000] Then
                                                Continue;

                                            zdim := 1;
                                            While zahl Div zdim >= 100 Do
                                                zdim := zdim * 10;
                                            If (zahl Div zdim) Mod 9 <> 0 Then
                                                Continue;

                                            zp := 1;
                                            zq := 0;
                                            tmp := zahl;
                                            While (tmp > 0) And (zp <> 0) Do
                                            Begin
                                                digit := tmp Mod 10;
                                                zp := zp * digit;
                                                zq := zq + digit;
                                                tmp := tmp Div 10;
                                            End;

                                            If zp Mod 10 <> 2 Then
                                                Continue;
                                            If zq Mod 19 <> 0 Then
                                                Continue;

                                            Right := True;
                                        Finally
                                            Inc(e);
                                        End;
                                    End;
                                Finally
                                    Inc(d, 4);
                                End;
                            End;
                        Finally
                            inc(c);
                        End;
                    End;
                Finally
                    Inc(b);
                End;
            End;
        Finally
            Inc(a);
        End;
    End;

    QueryPerformanceCounter(Stop);
    Stop := Stop - Start;
    QueryPerformanceFrequency(Start);
    Caption := Format('%.6fs', [stop / start]);
    Edit2.Text := IntToStr(Zahl);
End;

Siehe da: Gleich beim ersten (bugfreien) Durchlauf: 3,015 ms ... Gut, er testet nicht ganz alle Zahlen, Da man aber zeigen kann, dass er das richtige Ergebnis liefert ...

Gut, was hab ich an Optimierungs-Techniken verwendet:
- Keine VCL
- Keine RTL
- Lookup-Tables
- Range-Skips
- Schnelle Bit-Operationen

Zumindest was Exemplar 1 und 2 angeht.

Das Exemplar 3 nutzt darüber hinaus noch die Methode anhand von Bit-Konstellationen alle 8-Bit-Kombinationen zu erzeugen. Hier kam mir zu gute, dass es zwei Einschränkungen für die gesuchte Zahl gab:

Keine Buchstaben in Hex
4 aufeinanderfolgende gesetzte Bits.

Diese Eigenschaft bieten in Hex nur 2 von 256 Zahlen: 78 und 79. Daher findet sich auch in jeder Variante von mir indirekt eine Prüfung auf dieses Muster. Im ersten Beispiel mit Hilfe von $right &= preg_match("/7[89]/i", $zhex);, im zweiten Beispiel mit Right := Right Or (ztmp And $FC = $78); und im dritten Beispiel explizit durch md := mc + ($78 Shl d);.

Andere Tricks, die sich häufiger finden, sind die Kombination mehrerer Berechnungen. So berechne ich jedes Mal Quersumme und Querprodukt gleichzeitig. Da in PHP die Abbruchbedingung unter einbeziehung der Abfrage ($ztmp && $zp langsamer ist, als die Schleife zu Ende laufen zu lassen, fehlt diese in PHP; in Delphi ist die Kombination beider schneller.

Ach ja: Anhand der Algos sollte auch klar werden, was meine Laufzeiten aussagen ... Ferner möcht ich anmerken, dass der dritte Algo nicht alle Prüfbedingungen implementiert, aber zum finden der Lösung ausreicht.

Ich bin dann also mal auf eure Lösungen gespannt!

MfG,
BenBE.

P.S.: Viel Spaß und Erfolg noch bei den anderen Rätseln ;-)

//Edit: Kleinen Tippfehler im Post. Thx dph.

Moderiert von Tino: "Lösungen" im Titel ergänzt.

_________________

Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.

Martok · Verfasst: Mo 03.12.07 01:14

Nicht übel.

Ohne Lookup-Tables hab ich das ganze gelöst. Im Endeffekt ein einfaches Sieb.

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:
103:
104:
105:
106:
107:
108:
109:
110:
111:

type stringhex = string[8];
     Number = Cardinal;

//Konvertierungen
function num(c:char):byte;
begin
  result:= byte(c)-$30;
end;

function IntToBin(dez:Number):string;
var i:integer;
begin
  SetLength(Result,32);
  for i:= 0 to 31 do
    Result[32-i]:= chr($30 + ((dez and (1 shl i)) shr i));
end;

//Die Idee das gleichzeitig zu machen kommt von BenBE. Ohne ASM wars aber quasi gleich schnell.
function quersummeprod(dec:Number; var prod:integer):integer;
var z,p,q:integer;
begin
  p:= 1;
  q:= 0;
  while (dec>0) do begin
    asm  //die einzige asm-Stelle. Hat 3 Sekunden gebracht ;)
      // z:= dec mod 10; dec:= dec div 10
      mov eax, dec
      mov ecx, 10
      xor edx, edx
      div ecx
      mov z, edx
      mov dec, eax
    end;
    inc(q,z);
    p:= p*z;
  end;
  prod:= p;
  Result:= q;
end;

function bitscount(bin:string; var cons:integer):integer;
var i,c:integer;
begin
  Result:= 0;
  cons:= 0;
  c:= 0;
  for i:= 1 to 32 do begin
    if bin[i]='1' then begin
      inc(Result); inc(c);
    end else begin
      if c>cons then cons:= c;
      c:= 0;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var hex:stringhex;
    int,bin:string;
    i,j,k,l,m,n,o,p:byte;
    dez:Number;
    cons,prod:integer;

    time:Int64;
begin
  time:= TimeMeasure;
  hex:= '00000000';
  for i:= 0 to 8 do
    for j:= 0 to 9 do
      for k:= 0 to 9 do begin
        for l:= 0 to 9 do
          for m:= 0 to 9 do
            for n:= 0 to 9 do
              for o:= 0 to 9 do
                for p:= 0 to 9 do begin
                  dez:= p+
                        o shl 4+
                        n shl 8+
                        m shl 12+
                        l shl 16+
                        k shl 20+
                        j shl 24+
                        i shl 28;
                  if dez<100 then continue;     // 3 stellen wegen 1. und vorvorletzter stelle
                  if (dez mod 10) + (dez mod 1000 div 100)<>7 then continue;

                  if quersummeprod(dez,prod) mod 19<>0 then continue;
                  if prod mod 10<>2 then continue;

                  int:= IntToStr(dez);
                  if num(int[1])+num(int[2])<>9 then continue;

                  bin:= IntToBin(dez);
                  if (bitscount(bin,cons)>8) then continue;
                  if (cons<4) then continue;
                  //Ausgabe
                  hex[1]:= char(i+$30);
                  hex[2]:= char(j+$30);
                  hex[3]:= char(k+$30);
                  hex[4]:= char(l+$30);
                  hex[5]:= char(m+$30);
                  hex[6]:= char(n+$30);
                  hex[7]:= char(o+$30);
                  hex[8]:= char(p+$30);
                  Memo1.Lines.Add(format('hex:%s int:%s',[hex,int]));
                end;
        Label1.Caption:= format('hex:%s int:%s',[hex,int]);
        Application.ProcessMessages;
      end;
  Memo1.Lines.Add(format('Zeit: %.3f s',[TimeStop(time) / 1000]));
end;

Man sieht also, aus der Bedingung, dass in Hex nur Ziffern vorkommen, hab ich gleich eine Hex-Zählung gemacht. Dabei laufen 8 Schleifen, für jedes Nybble eine.
Dann werden nacheinander die Bedingungen geprüft und bei nicht passenden Zahlen die Schleife weitergezählt.
Die Reihenfolge der Siebe ist so gewählt, dass die jeweils am schnellsten durchführbare Prüfung oben steht.

Ein interessanter Fakt: die Binär-Checks mache ich über AnsiStrings. Ich hab grade nochmal probiert, ob es was bringt, direkt mit Zahlen zu rechnen. Siehe da, das wäre sogar langsamer. Warum auch immer.

Achso, eins noch: hier fehlt das allerletzte Sieb, die 'Jede Ziffer nur 2mal'-Regel. Nachdem nur noch 3 Zahlen übrig bleiben, von denen 2 die 0 dreimal enthalten, hab ich das dann auch nicht mehr implementiert. Ein bisschen mitdenken muss man ja auch

Eine Lösung fast ohne komplizierte Optimierungen oder fiese Mathematik also

_________________
"The phoenix's price isn't inevitable. It's not part of some deep balance built into the universe. It's just the parts of the game where you haven't figured out yet how to cheat."

Ehemaliges Mitglied Erhaltene Danke: 1

Ich hänge mich jetzt hier hinten dran, denn ich glaube, dass jetzt jeder gern seinen Code präsentieren will ... (Auf jeden Fall!)

Also die 2-3 Milisekunden schaffe ich bei weitem nicht. Respekt an die, welche es geschafft haben *NEID*.

Mir fehlte leider auch die Zeit diesen Code zu überarbeiten.

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:
103:
104:
105:
106:
107:
108:
109:
110:
111:

procedure TForm1.Button1Click
          ( Sender : TObject );
type
  TCountState = Array[ 0..9 ] of Integer;

  // Quersumme bzw. Querprodukt
  function HorizCalc
           ( const pValue : Integer; const pStyle : Boolean )
           : Integer;
  var
    Value      : ShortString;
    I          : Integer;
  begin
    Value  := IntToStr( pValue );
    Result := StrToInt( Value[ 1 ] );
    for I := 2 to Length( Value ) do
      if pStyle = True then
        Inc( Result, StrToInt( Value[ I ] ) )
      else
        Result := Result * StrToInt( Value[ I ] );
  end;

  // Überprüfen der Anzahl des Vorkommens einzelner Ziffern.
  function CheckCount
           ( const pValue : Integer; CountState : TCountState )
           : Boolean;
  var
    StrValue   : ShortString;
    I          : Integer;
  begin
    Result   := True;
    StrValue := IntToStr( pValue );
    for I := 1 to Length( StrValue ) do
    begin
      Inc( CountState[ StrToInt( StrValue[ I ] ) ] );
      if CountState[ StrToInt( StrValue[ I ] ) ] = 3 then
      begin
        Result := False;
        Break;
      end;
    end;
  end;

  // In Binär-String konvertieren
  // Quelle:   http://www.delphi-forum.de/viewtopic.php?p=367899#367899    (vielen Dank)
  function DezToBin
           ( const pValue : Integer )
           : String;
  begin
    if ( pValue > 1 ) then
      Result := DezToBin( pValue div 2 ) + Char( ( pValue mod 2 ) + 48 )
    else
      Result := Char( ( pValue mod 2 ) + 48 );
  end;

  // auf max. 8 gesetzte Bits prüfen
  function CheckBin8Set
           ( const pValue : Integer )
           : Boolean;
  var
    StrBin    : String[ 32 ];
    StrCount,
    I         : Integer;
  begin
    StrBin   := DezToBin( pValue );
    StrCount := 0;
    for I := 1 to Length ( StrBin ) do
      if StrBin[ I ] = '1' then
        Inc( StrCount );
    Result := ( StrCount <= 8 );
  end;

var
  CountState      : TCountState;
  Number          : Integer;
  StrNumber,
  StrHorizProduct : ShortString;
begin
  for Number := 0 to 9 do
    CountState[ Number ] := 0;
  for Number := 0 to 2147483647 do      // mit 2147483647 downto 0 geht's schneller ;)
  begin
    // Hex-Wert darf keine alphanumerischen Zeichen enthalten
    if ( StrToIntDef( IntToHex( Number, 0 ), -1 ) > -1 ) then
      // Quersumme von "Number" muss Vielfaches von 19 sein
      if ( HorizCalc( Number, True ) mod 19 = 0 ) then
      begin
        StrHorizProduct := IntToStr( HorizCalc( Number, False ) );
        // Querprodukt von "Number" muss auf 2 enden
        if ( StrHorizProduct[ Length( StrHorizProduct ) ] = '2' ) then
        begin
          StrNumber := IntToStr( Number );
          // Summe der Ziffern ( Nr. 1 ) + ( Nr. 2 ) = 9
          if ( StrToInt( StrNumber[ 1 ] ) + StrToInt( StrNumber[ 2 ] ) = 9 ) then
            // Summe der Ziffern ( AnzahlZiffern - 2 ) + ( AnzahlZiffern ) = 7
            if ( StrToInt( StrNumber[ Length( StrNumber ) - 2 ] ) + StrToInt( StrNumber[ Length( StrNumber ) ] ) = 7 ) then
              // Keine Ziffer darf mehr als 2 mal in der Zahl vorhanden sein
              if ( CheckCount( Number, CountState ) = True ) then
                // Mindestens 4 gesetzte Bits müssen direkt nebeneinander stehen
                if ( Pos( '1111', DezToBin( Number ) ) > 0 ) then
                  // Es dürfen maximal 8 Bits gestzt sein
                  if ( CheckBin8Set( Number ) = True ) then
                  begin
                    ShowMessage( IntToStr( Number ) );
                    Self.ListBox1.Repaint(  );
                  end;
        end;
      end;
  end;
  ShowMessage( 'Finished!' );
end;

Aber den Style-Preis gewinne ich mit diesem Code nicht. Zuviel String-Konvertierungen und überhaupt. Aber es funktioniert jedenfalls. 10-15 Minuten mit Vorwärtsprüfung.

War eine wriklich schöne Aufgabe. Grüße an alle, die teilgenommen haben.

Christian

//Edit: Wenn man die Regeln liest, und auch BruteForce anwendet, dann kann man bei frühestens 100 anfangen mit Zählen und schon bei 1.899.598.489 wieder aufhören.

ACHSO: Ganz wichtig! Ich habe die Zahl 1.879.179.384 heraus.

Mein erster Code brauchte geschlagene 5 Stunden und kam auf kein Ergebnis. Hat allerdings meine CPU-Auslastung so hoch getrieben, dass nix mehr außer der Code lief und ich vorzeitig ins Bett gegangen bin. lol

jaenicke · Verfasst: Mo 03.12.07 01:21

Also ich habe zwei Lösungen, die eine komplett Brute Force, es werden ALLE Zahlen im Zahlenbereich durchprobiert, was bei mir 63 Sekunden dauert (mit Fortschrittsanzeige), die andere setzt gezielt Bits, wobei ich auf 12,3 ms Laufzeit komme:
Bruteforce:

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:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:

procedure TForm11.Button1Click(Sender: TObject);
var
  NumberCount: array[0..9] of Byte;
  Ziffer1, Ziffer2: Integer;

  function BitCount(uNumber: Integer): Integer;
  begin
    Result := (uNumber and $AAAAAAAA) shr 1 + (uNumber and $55555555);
    Result := (Result and $CCCCCCCC) shr 2 + (Result and $33333333);
    Result := (Result and $F0F0F0F0) shr 4 + (Result and $0F0F0F0F);
    Result := (Result and $FF00FF00) shr 8 + (Result and $00FF00FF);
    Result := (Result and $FFFF0000) shr 16 + (Result and $0000FFFF);
  end;

  function QuerSumme(uNumber: Integer; var Querprodukt: Integer): Integer;
  var
    Current: Integer;
  begin
    Ziffer2 := 0;
    Result := 0;
    Querprodukt := 1;
    while uNumber <> 0 do
    begin
      Current := uNumber mod 10;
      Result := Result + Current;
      Querprodukt := Querprodukt * Current;
      Inc(NumberCount[Current]);
      Ziffer1 := Ziffer2;
      Ziffer2 := Current;
      uNumber := uNumber div 10;
    end;
  end;

  function Bin(IntNumber: Integer): String;
  var
    i : Integer;
  begin
    Result := '';
    for i := 31 downto 0 do
      Result := Result + IntToStr((IntNumber shr i) and 1);
  end;

  function TestNumber(uNumber: Integer): Boolean;
  var
    i, QuerProdukt: Integer;
    DezNumber, HexNumber, BinNumber: String;
  begin
    Result := False;

    // Die Binärdarstellung der Zahl enthält aber höchstens 8 gesetzte Bits insgesamt
    if BitCount(uNumber) > 8 then
      Exit;

    // Die Summe der letzen und der vorvorletzen Ziffer ist 7 (Zahl in Dezimaldarstellung, die letzte Ziffer ist rechts)
    if (uNumber mod 10) + (uNumber div 10 div 10 mod 10) <> 7 then
      Exit;

    for i := 0 to 9 do
      NumberCount[i] := 0;

    // Die Quersumme ist ein Vielfaches von 19 (Zahl in Dezimaldarstellung)
    if QuerSumme(uNumber, QuerProdukt) mod 19 <> 0 then
      Exit;

    // Das Querprodukt endet auf 2 (Zahl in Dezimaldarstellung)
    if QuerProdukt mod 10 <> 2 then
      Exit;

    // Jede Ziffer darf höchstens zwei mal auftreten (Zahl in Dezimaldarstellung, Beispiele: 1223 -> OK, 123334 -> nicht OK)
    for i := 0 to 9 do
      if NumberCount[i] > 2 then
        Exit;

    // Die Summe der ersten beiden Ziffern ist 9 (Zahl in Dezimaldarstellung, die erste Ziffer ist links)
    if Ziffer1 + Ziffer2 <> 9 then
      Exit;

    BinNumber := Bin(uNumber);
    // Die Binärdarstellung der Zahl enthält mindestens 4 aufeinanderfolgende 1-Bits (irgendwo in der Zahl)
    if Pos('1111', BinNumber) = 0 then
      Exit;

    HexNumber := IntToHex(uNumber, 8);
    // Die Hexadezimaldarstellung der Zahl enthält keinen Buchstaben
    for i := 1 to Length(HexNumber) do
      if HexNumber[i] in ['A'..'F'] then
        Exit;

    DezNumber := IntToStr(uNumber);
    Memo1.Lines.Add(DezNumber + '    ' + HexNumber + '    ' + BinNumber);
    Result := True;
  end;

var
  i: Integer;
  StartTime: TDateTime;
begin
  StartTime := now;
  Memo1.Lines.Clear;
  for i := 10 to 2147483647 do
  begin
    TestNumber(i);
    if i mod 10000000 = 0 then
    begin
      ProgressBar1.Position := i div 10000000;
      lblCurrentNumber.Caption := IntToStr(i);
      lblCurrentTime.Caption := TimeToStr(now - StartTime);
      lblTimeLeft.Caption := TimeToStr((now - StartTime) / (i / 2147483647) - (now - StartTime));
      Application.ProcessMessages;
    end;
  end;
  if Memo1.Lines.Count = 0 then
    ShowMessage('Leider keine Zahl gefunden!')
  else
    ShowMessage(IntToStr(Memo1.Lines.Count) + ' Zahlen gefunden!');
end;

Optimiert:

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:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:

procedure TForm11.Button1Click(Sender: TObject);
var
  NumberCount: array[0..9] of Byte;
  Ziffer1, Ziffer2: Integer;

  function Bin(IntNumber: Integer): String;
  var
    i : Integer;
  begin
    Result := '';
    for i := 31 downto 0 do
      Result := Result + IntToStr((IntNumber shr i) and 1);
  end;

  function BitCount(uNumber: Integer): Integer;
  begin
    Result := (uNumber and $AAAAAAAA) shr 1 + (uNumber and $55555555);
    Result := (Result and $CCCCCCCC) shr 2 + (Result and $33333333);
    Result := (Result and $F0F0F0F0) shr 4 + (Result and $0F0F0F0F);
    Result := (Result and $FF00FF00) shr 8 + (Result and $00FF00FF);
    Result := (Result and $FFFF0000) shr 16 + (Result and $0000FFFF);
  end;

  function QuerSumme(uNumber: Integer; var Querprodukt: Integer): Integer;
  var
    Current: Integer;
  begin
    Ziffer2 := 0;
    Result := 0;
    Querprodukt := 1;
    while uNumber <> 0 do
    begin
      Current := uNumber mod 10;
      Result := Result + Current;
      Querprodukt := Querprodukt * Current;
      Inc(NumberCount[Current]);
      Ziffer1 := Ziffer2;
      Ziffer2 := Current;
      uNumber := uNumber div 10;
    end;
  end;

  function SetBit(uNumber, uBit: Integer): Integer;
  begin
    Result := (1 shl uBit) or uNumber;
  end;

  function TestNumber(uNumber: Integer): Boolean;
  var
    i, QuerProdukt: Integer;
    DezNumber, HexNumber, BinNumber: String;
  begin
    Result := False;

    // Die Binärdarstellung der Zahl enthält aber höchstens 8 gesetzte Bits insgesamt
//    if BitCount(uNumber) > 8 then
//      Exit;

    // Die Summe der letzen und der vorvorletzen Ziffer ist 7 (Zahl in Dezimaldarstellung, die letzte Ziffer ist rechts)
    if (uNumber mod 10) + (uNumber div 10 div 10 mod 10) <> 7 then
      Exit;

    for i := 0 to 9 do
      NumberCount[i] := 0;

    // Die Quersumme ist ein Vielfaches von 19 (Zahl in Dezimaldarstellung)
    if QuerSumme(uNumber, QuerProdukt) mod 19 <> 0 then
      Exit;

    // Das Querprodukt endet auf 2 (Zahl in Dezimaldarstellung)
    if QuerProdukt mod 10 <> 2 then
      Exit;

    // Jede Ziffer darf höchstens zwei mal auftreten (Zahl in Dezimaldarstellung, Beispiele: 1223 -> OK, 123334 -> nicht OK)
    for i := 0 to 9 do
      if NumberCount[i] > 2 then
        Exit;

    // Die Summe der ersten beiden Ziffern ist 9 (Zahl in Dezimaldarstellung, die erste Ziffer ist links)
    if Ziffer1 + Ziffer2 <> 9 then
      Exit;

    HexNumber := IntToHex(uNumber, 8);
    // Die Hexadezimaldarstellung der Zahl enthält keinen Buchstaben
    for i := 1 to Length(HexNumber) do
      if HexNumber[i] in ['A'..'F'] then
        Exit;

    DezNumber := IntToStr(uNumber);
    BinNumber := Bin(uNumber);
    Memo1.Lines.Add(DezNumber + '    ' + HexNumber + '    ' + BinNumber);
    DezNumber := IntToStr(uNumber);
    Result := True;
  end;

var
  i, j, k, l, Value1, Value2, Value3, Value4, Currenti, Currentj, Currentk, Currentl: Integer;
  freq, StartTime, EndTime: Int64;
begin
  Memo1.Lines.BeginUpdate;
  Memo1.Lines.Clear;

  QueryPerformanceFrequency(freq);
  QueryPerformanceCounter(StartTime);

  // Die Binärdarstellung der Zahl enthält mindestens 4 aufeinanderfolgende 1-Bits (irgendwo in der Zahl)
  Value1 := 15 shl 3;
  Value2 := 15 shl 11;
  Value3 := 15 shl 19;
  Value4 := 15 shl 27;
  for i := 1 to 30 do
  begin
    Currenti := 1 shl i;
    for j := i to 30 do
    begin
      Currentj := Currenti or (1 shl j);
      for k := j to 30 do
      begin
        Currentk := Currentj or (1 shl k);
        for l := k to 30 do
        begin
          Currentl := Currentk or (1 shl l);
          TestNumber(Value1 or Currentl);
          TestNumber(Value2 or Currentl);
          TestNumber(Value3 or Currentl);
          TestNumber(Value4 or Currentl);
        end;
      end;
    end;
  end;
  QueryPerformanceCounter(EndTime);
  Memo1.Lines.EndUpdate;

  ShowMessage(IntToStr(Memo1.Lines.Count) + ' - ' + IntToStr((EndTime - StartTime) * 1000000 div freq));
end;

Im Anhang befinden sich beide Projekte.

Es gäbe da auch noch weitere Optimierungen, aber 12,3 Millisekunden ist ja schonmal ganz ok denke ich. ;-)

Einloggen, um Attachments anzusehen!

Dragonclaw · Beiträge: 196 Windows Vista Delphi 7 Prof.

Okay, hier ist mein Code. Er liefert die richtige Lösung, braucht dafür aber (mit nem Core Duo 2.0 GHz) geschlagene ~40 min. Hatte ziemliche Torschlusspanik und deswegen nicht wirklich Zeit mir ne clevere Lösung einfallen zulassen:

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:

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Cardinal;
  temp, temp2: String;
  J: Integer;
  add: Boolean;
  a, b, c: TLargeInteger;
begin
QueryPerformanceFrequency(a);
QueryPerformanceCounter(b);
I := 100;
while I < 1899598489  do
  begin
    if (Quersumme(I) mod 19 = 0) and (Pos('1111',BaseToBase(I)) <> 0) then
    begin
    temp := InTToHex(I,8);
    add := True;
    temp2 := IntToStr(I);
    for J := 1 to Length(temp) + 1 do
    begin
    if temp2[J] = '0' then add := False;
    end;
    if not TryStrToInt(IntToHex(I,8),J) then add := False;
    if (StrToInt(temp2[length(temp2)]) + StrToInt(temp2[length(temp2)-2])) <> 7 then add := False;
    if not Querprodukt_2(I) then add := False;
    if not bits_gesetzt(BaseToBase(I)) then add := False;
    if StrToInt(temp2[1]) + StrToInt(temp2[2]) <> 9 then add := False;
    if not ziffern_zaehlen(IntToStr(I)) then add := False;
    if add then begin
    ListBox1.Items.Add(temp2);
    end;
    end;
    Inc(I,1);
  end;
QueryPerformanceCounter(c);
ListBox1.Items.Add(IntToStr((c - b) * 1000 div a));
ShowMessage('Done');
end;

function TForm1.BaseToBase(Value: LongInt): string;
begin
result := '';
while value > 0 do begin
  result := intToStr(ord(odd(Value))) + result;
  value := value shr 1;
end;
  if result = '' then result := '0';
end;

function TForm1.bits_gesetzt(Value: String): Boolean;
var
I,count: Integer;
begin
Result := False;
Count := 0;
for I := 1 to Length(Value) do
 if Value[I] = '1' then
   Inc(Count);
if Count <= 8 then Result := True;
end;

function TForm1.Querprodukt_2(Value: Integer): Boolean;
var
I : Integer;
Value2,nummer2: String;
nummer: Integer;
begin
nummer := 1;
Result := False;
Value2 := IntToStr(Value);
for I := 1 to length(Value2) do
nummer := nummer * StrToInt(Value2[I]);
nummer2 := IntToStr(nummer);
  if nummer2[length(IntToStr(nummer))] = '2' then result := True;
end;

function TForm1.Quersumme(Value: Integer): Integer;
var
I : Integer;
nummer: String;
begin
result := 0;
nummer := IntToStr(Value);
for I := 1 to Length(nummer) do
  Result := Result + StrToInt(nummer[I]);
end;

function TForm1.ziffern_zaehlen(Value: String): Boolean;
var
countarray: Array[1..9] of Byte;
I: Integer;
begin
Result := True;
for I := 1 to 9 do
  CountArray[I] := 0;
for I := 1 to Length(Value) do
  Inc(Countarray[StrToInt(Value[I])]);
for I := 1 to 9 do
  if Countarray[I] > 2 then Result := False;
end;

delfiphan · Beiträge: 2684 Erhaltene Danke: 32

@BenBE: Sehr schön. Man muss aber auch sagen, dass du vor dem Schreiben des Codes Analysen durchgeführt hast und anhand der gewonnenen Informationen einen Code geschrieben hast, der gar nicht mehr alle Zahlen prüft. Der Code ist alles andere als allgemein sondern extrem spezialisiert auf genau diesen einen Fall. Z.B. dieser Satz hier: "Diese Eigenschaft bieten in Hex nur 2 von 256 Zahlen: 78 und 79". Dann prüfst du nur noch diese. Das wäre, als ob ich separat vom Lösungsprogramm mal die ersten 1000 Zahlen analysiere und im Lösungscode dann nur noch ab der 1001. Zahl prüfe - die anderen konnte ich ja vorab ausschliessen. Oder wenn man das Spielchen weitertreibt: Ich könnte auch sagen "Ich prüfe nur noch die eine Lösungszahl, denn die anderen Zahlen haben die gewünschten Eigenschaften nicht".

Abgesehen davon, Hut ab, wenn der Code auch wirklich fehlerfrei ist

Kommentiert ist er leider nicht gross.

// Edit: Obwohl, wenn ich es mir recht überlege kann man ja auf einer Zeile (auf Papier) zeigen, dass es nur diese beiden Zahlen sein können. Von dem her ist die Optimierung eigentlich ganz okay ;D

Allesquarks · Beiträge: 510 Win XP Prof Delphi 7 E

Dieser Algorithmus braucht 2,6 Millisekunden:
a
Hm ich hab das jetzt mal schön erklärt ist natürlich Ansichtssache obs gut zu verstehen ist. Anzumerken ist, dass ich nach 8 Bits gesucht habe und fündig geworden bin. dies ist aber der rechenaufwendigste Durchlauf nach 7 und 6 gesetzten Bits zu suchen sollte die Laufzeit auf jeden Fall weniger als verdoppeln. hierzu einfach die function calczahl clonen und jeweils soviele innere Schleifen rausmachen wie jetzt weniger Bits sind.

Zum Programm in Button1click ist die Zeitmessung mit dem Aufruf
in calczahl wird die Zahl berechnet (Erklärung siehe nächster Absatz. Die restlichen Functionen sollten sich selber per Name erklären.

Zum Algorithmus: mind 4 aneinander gesetzte Bits => mit keine Buchstaben in hex => es sind genau vier, denn mehr würde inen Buchstaben fabrizieren und diese vier sitzen genau so: 0111 | 100x, wobei der | für eine Trennung zwischen jeweils 4-er Bits Gruppen steht und das x gesetzt oder nicht gesetzt sein kann. Diese acht Bit Gruppe kann nun in einem 32 Bit Raum (die angegebene Zahl ist genau die Maximalzahl in Integer) genau an 7 Stellen stehen. Diese Möglichkeiten geht die erste Schleife mit e durch. Dann gibt es noch 4 Stellen für die anderen Bits nämlich a,b,c,d. Und anfangend mit kleinen Werten werden jetzt alle Kombinationen aus diesen durchprobiert, indem man zu jedem a alle b WErte bis a ausprobiert und zu jedem dieser b alle c Werte. Ohne Beschränkung der Allgemeinheit ist a>b>c>d daraus ergeben sich die Bedingungen der While-Schleifen. Falls jetzt a,b,c oder d in den Bereich der 8Bit-Gruppe von oben laufen müssen sie diese überspringen. dies steht jeweils in einer if-Bedingung in jeder while-Schleife. if ((a and $00000003)=0) and ((a-b)<3) then bedeutet nur falls a durch 4 teilbar ist muss das nächste Bit mindestens 3 weiter hinten sein, denn durch 4 teilbar (ich fange bei 1 an zu zählen) heißt, xxxx|1xxx|, dass ein Bit in so einer 4er Gruppe ganz vorne gesetzt ist. Da keine Buchstaben in hex vorkommen dürfen an den stellen y und z keine Bits stehen (xxx|1 y z x), sondern erst wieder bei x. Die restlichen ifs ganz innen prüfen die restlichen Bedingungen in der Reihenfolge des Rechenaufwandes. Um diesen hab ich TDezzahl gebaut, in welchen die Ziffern nicht mit dem Ascii Offset stehen. Der REst sollte sich selbst erklären

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:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:

  type TDezzahl = packed record
    laenge:integer;
    zahl:array [1..10] of byte;
  end;

var
  Form1: TForm1;

  zweierpots:array [1..32] of TDezzahl;

implementation

{$R *.dfm}

//die zweite Zahl muss immer die längere sein => falsches Ergebnis
function add(zahl1,zahl2:TDezzahl):TDezzahl;
var i,remainder,addtemp,base:integer;
begin
  base:=10;
  remainder:=0;
  for i:=1 to zahl1.laenge do
  begin
    addtemp:=zahl1.zahl[i]+zahl2.zahl[i]+remainder;
    if addtemp>=base then
    begin
      result.zahl[i]:=byte(addtemp-base);
      remainder:=1;
    end else begin
      result.zahl[i]:=byte(addtemp);
      remainder:=0;
    end;
  end;

  for i:=zahl1.laenge+1 to zahl2.laenge do
  begin
    addtemp:=zahl2.zahl[i]+remainder;
    if addtemp>=base then
    begin
      result.zahl[i]:=byte(addtemp-base);
      remainder:=1;
    end else begin
      result.zahl[i]:=byte(addtemp);
      remainder:=0;
    end;
  end;

  if remainder=1 then
  begin
    result.zahl[zahl2.laenge+1]:=1;
    result.laenge:=zahl2.laenge+1;
  end else begin
    result.laenge:=zahl2.laenge;
  end;
end;

procedure builtzweipots;
var i:integer;
begin
  zweierpots[1].laenge:=1;
  zweierpots[1].zahl[1]:=1;
  for i:=2 to 31 do
  begin
    zweierpots[i]:=add(zweierpots[i-1],zweierpots[i-1]);
  end;
end;

function quersumme(zahl:TDezzahl):integer;
var i:integer;
begin
  result:=0;
  for i:=1 to zahl.laenge do
  begin
    result:=result+zahl.zahl[i];
  end;
end;

function querprodukt(zahl:TDezzahl):integer;
var i:integer;
begin
  result:=1;
  for i:=1 to zahl.laenge do
  begin
    result:=result*zahl.zahl[i];
  end;
end;

function querproduktend2(zahl:TDezzahl):boolean;
var i:integer;resultbyte:byte;
begin
  resultbyte:=1;
  for i:=1 to zahl.laenge do
  begin
    resultbyte:=(zahl.zahl[i]*resultbyte) mod 10;
  end;
  result:=resultbyte=2;
end;

function charin2mal(zahl:TDezzahl):boolean;
var i,a,inmal:integer;stelle:byte;
begin
  result:=true;
  for i:=1 to zahl.laenge-2 do
  begin
    stelle:=zahl.zahl[i];
    inmal:=1;
    for a:=i+1 to zahl.laenge do
    begin
      if zahl.zahl[a]=stelle then
      begin
        inc(inmal);
        if inmal>2 then
        begin
          result:=false;
          exit;
        end;
      end;
    end;
  end;
end;

function zahltostring(zahl:TDezzahl):string;
var i:integer;
begin
  setlength(result,zahl.laenge);
  for i:=1 to zahl.laenge do
  begin
    result[zahl.laenge-i+1]:=chr(zahl.zahl[i]+48);
  end;
end;


{$B-}

function calc8bitzahl:string;
var ehex,e4hex,e,a,b,c,d,test:integer;bit4zahl,zahl:TDezzahl;
quer:string;
begin
  for ehex:=1 to 7 do
  begin
    e4hex:=ehex shl 2;
    //von der 8Bit Gruppe die Teilzahl schonmal zusammenaddieren
    bit4zahl:=add(zweierpots[e4hex],zweierpots[e4hex+1]);
    bit4zahl:=add(bit4zahl,zweierpots[e4hex+2]);
    bit4zahl:=add(bit4zahl,zweierpots[e4hex+3]);

    a:=0;
    e:=e4hex-2;//dieser e-wert ist verboten
    while a<31 do
    begin
      inc(a);
      b:=0;
      if a=e then //a liegt in der 8 Bit Gruppe also a davor setzen
      begin
        a:=a+6;
        continue;
      end;

      while (b+1)<a do
      begin
        inc(b);
        c:=0;
        if b=e then //b liegt in der 8 Bit Gruppe also b davor setzen
        begin
          b:=b+6;
          continue;
        end;

        if ((a and $00000003)=0) and ((a-b)<3)then
        begin
          continue;
        end;

        while (c+1)<b do
        begin
          inc(c);
          d:=0;
          if c=e then
          begin
            c:=c+6;
            continue;
          end;

          if ((b and $00000003)=0) and ((b-c)<3) then
          begin
            continue;
          end;

          while (d+1)<c do
          begin
            inc(d);
            if d=e then
            begin
              d:=d+6;
              continue;
            end;

            if ((c and $00000003)=0) and ((c-d)<3) then
            begin
              continue;
            end;

            //komplette Zahl bauen
            zahl:=add(zweierpots[b],zweierpots[a]);
            zahl:=add(zweierpots[c],zahl);
            zahl:=add(zweierpots[d],zahl);

            
            if bit4zahl.laenge<zahl.laenge then
            begin
              zahl:=add(bit4zahl,zahl);
            end else begin
              zahl:=add(zahl,bit4zahl);
            end;
            //Zahl ist fertig Tests durchführen

            //die Zahl ist wegen der 4Bit Gruzppe immer mindestens 3 Ziffern lang
            //da immer eine Zahl größer 2^7=128 darin vorkommt also nicht überprüfen ob min 3 lang
            if zahl.zahl[1]+zahl.zahl[3]<>7 then
            begin
              continue;
            end;

            if zahl.zahl[zahl.laenge]+zahl.zahl[zahl.laenge-1]<>9 then
            begin
              continue;
            end;

            if (quersumme(zahl) mod 19)<>0 then
            begin
              continue;
            end;

            //Diese Function prüft direkt auf die Endziffer
            if not(querproduktend2(zahl)) then
            begin
              continue;
            end;

            if not(charin2mal(zahl)) then
            begin
              continue;
            end;

            //hier kommt man nur hin wenn alles ok ist

            result:=zahltostring(zahl);
            exit;
          end;
        end;
      end;
    end;
  end;
end;



{$B+}

function calczahl:string;
begin
  //result:=calc7bitzahl;
  result:=calc8bitzahl;
end;

//hier der Aufruf mit Zeitmessung
procedure TForm1.Button1Click(Sender: TObject);
var test:string;i,zeit1,zeit2:integer;
begin
  builtzweipots;
  zeit1:=gettickcount;
  for i:=1 to 100 do
  begin
    test:=calczahl;
  end;
  zeit2:=gettickcount;

  self.Caption:=test;
  button2.Caption:=(inttostr(zeit2-zeit1));
end;

Shorty · Verfasst: Mo 03.12.07 01:51

Dann poste ich auch mal meinen Code hier:

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:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:

procedure TForm1.Button1Click(Sender: TObject);
var i, j, l, zahl, num, obereGrenze: integer;
    start, stop: int64;
    str: string;

// Die ersten beiden bzw. die letzten 3 möglichen Kombinationen
const anfang: array[0..7] of string =
        ('18', '27', '36', '45', '54', '63', '72', '81');
      ende: array[0..53] of string =
        ('116', '126', '136', '146', '156', '166', '176', '186', '196',
         '215', '225', '235', '245', '255', '265', '275', '285', '295',
         '314', '324', '334', '344', '354', '364', '374', '384', '394',
         '413', '423', '433', '443', '453', '463', '473', '483', '493',
         '512', '522', '532', '542', '552', '562', '572', '582', '592',
         '611', '621', '631', '641', '651', '661', '671', '681', '691');

    function Quersumme(const number: string): integer; inline;
    var i: integer;
    begin
      result:= 0;
      for i:= 1 to length(number) do
        result:= result+strtoint(number[i]);
    end;

    function Querprodukt(const number: string): string; inline;
    var i, produkt: integer;
    begin
      produkt:= 1;
      for i:= 1 to length(number) do
        begin
          produkt:= produkt*strtoint(number[i]);
          if produkt = 0 then
            break;
        end;
      result:= inttostr(produkt);
    end;

    function CharInHex(const hex: string): boolean;
    var i: integer;
    begin
      result:= false;
      for i:= 1 to length(hex) do
        if hex[i] in ['A'..'F'] then
          begin
            result:= true;
            exit;
          end;
    end;

    function IntToBin(i: int64): string;
    begin
      result := '';
      while i > 0 do
        begin
          result := inttostr(ord(odd(i))) + result;
          i := i shr 1;
        end;
    end;

    function OhneRestTeilbar(divisor: integer; const divident: integer): boolean; inline;
    begin
      repeat
        dec(divisor, divident);
      until divisor <= divident;
      result:= divisor = divident;
    end;
    
    function DigitMoreThanTwoTimes(const number: string): boolean; inline;
    var digits: array[0..9] of integer;
        i, index: integer;
    begin
      FillChar(digits,Sizeof(digits),0);
      for i := 1 to length(number) do
        begin
          index:= strtoint(number[i]);
          inc(digits[index]);
          if digits[index] > 2 then
            begin
              result:= true;
              exit;
            end;
        end;
      result:= false;
    end;

    function Valid(const number: integer; const numberstr: string): boolean; inline;
    var produkt, bin: string;
        count, k: integer;
    begin
      result:= true;   

      // letztes Zeichen des Querprodukts eine 2
      produkt:= Querprodukt(numberstr);
      result:= result and (produkt[length(produkt)] = '2');
      // Wenn die Zahl nicht gültig ist, aussteigen
      if not result then
        exit; 

      // überprüft, ob die Quersumme durch 19 teilbar ist, entspricht Quersumme mod 19 = 0
      result:= result and OhneRestTeilbar(Quersumme(numberstr), 19);
      // Wenn die Zahl nicht gültig ist, aussteigen
      if not result then
        exit; 


      // stellt fest, ob ein Buchstabe in der Hexadezimaldarstellung vorhabenden ist
      result:= result and (not CharInHex(inttohex(number, 0)));
      // Wenn die Zahl nicht gültig ist, aussteigen
      if not result then
        exit; 


      // überprüft, ob kein Zeichen zweimal vorkommt
      result:= result and (not DigitMoreThanTwoTimes(numberstr));
      // Wenn die Zahl nicht gültig ist, aussteigen
      if not result then
        exit; 


      // zählt die einsen
      bin:= IntToBin(number);
      count:= 0;
      k:= 1;
      while (k <= length(bin)) and (count <= 8) do
        begin
          if bin[k] = '1' then
            inc(count);
          inc(k);
        end;

      result:= result and (count <= 8);
      // Wenn die Zahl nicht gültig ist, aussteigen
      if not result then
        exit; 

      // stellt fest, ob mindestens 4 einsen vorkommen
      result:= result and (Pos('1111', bin) <> 0);
    end;

begin
  QueryPerformanceCounter(start);
  for i:= 0 to 7 do            // 2147483647
    for j := 0 to 53 do
      begin
      // i ist der Eintrag im Anfangsarray, muss bei 0 höher sein, da
      // anfang[i]= '18' ist und damit kleiner als die 21 am Anfang in 2147483647
      if i = 0 then
        zahl:= 99999
      else
        zahl:= 9999;
      while zahl > 0 do
        begin
          // Zahl zusammen setzen
          str:= anfang[i]+inttostr(zahl)+ende[j];
          if Valid(strtoint(str), str) then
            begin
              QueryPerformanceCounter(Stop);
              Stop := Stop - Start;
              QueryPerformanceFrequency(Start);
              ShowMessage('Ergebnis ist '+str+' in '+floattostr(stop / start)+' s');
              exit;
            end;
          dec(zahl);
        end;
      end;
end;

Ich habe bei mir den Suchraum eingegrenzt, indem ich alle möglichen Zahlenkombinationen für den Anfang oder das Ende der Zahl in ein Array geschrieben habe und dann nur noch zwischen den beiden die möglichen Zahlen gesetzt habe, so brauche ich nur ca. 2,5 Mio Vergleiche, um auf die Zahl zu kommen.

Wenn ich das Programm alleine auf dem Rechner laufen lasse, also ohne Browser, IDE o.Ä. dann komme ich auf immerhin 3 Sekunden runter, obwohl sich bestimmt noch einen einigen Stellen optimieren lässt, benutze zum Beispiel relativ oft noch inttostr bzw. strtoint und berechne Quadratsumme und Quadratprodukt noch einzeln, auch könnte man das Zählen der gesetzen Bits und das Suchern nach einer 1111-Folge in eine Schleife tun, was vielleicht auch nochmal ein paar Millisekunden rausholt.

delfiphan · Beiträge: 2684 Erhaltene Danke: 32

Was man bei Delphi sicherlich beachten muss: Wenn man mit Strings arbeitet, sollte man wenn möglich auf die normalen Strings verzichten, da so sonst ständig Speicher auf dem Heap alloziert werden muss. Alleine dadurch, dass man keine Strings verwendet, kann man alle Zahlen von 0 bis MaxInt in wenigen Sekunden durchprobieren, ohne durch geschicktes Überlegen Zahlen ausgeschlossen zu haben.

Zu den anderen Posts hier (wenn wir schon Off-Topic sind): Man sieht hier einmal mehr, dass man durch gute Algorithmen meist viel mehr rausholen kann, als durch einen guten Compiler :zustimm:

.

F34r0fTh3D4rk · Verfasst: Mo 03.12.07 07:58

Diese Version ist reichlich unoptimiert. Sie stellt prinzipiell die "Standard"-Lösung dar, bei der eine große Einschränkung des Lösungsbereiches noch nicht vorgenommen wurde.

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:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:

procedure TForm1.Button1Click(Sender: TObject);
  function NZiffer(const Zahl, Ziffer: integer): integer;
  var
    i, num: integer;
  begin
    num := zahl;
    i := 0;
    repeat
      result := num mod 10;
      num := num div 10;
      inc(i);
    until i = Ziffer;
  end;
const
  maxzahl = 2147483647;
var
  startwert,
  i, j, num, stellenzahl, altezahl,
  c, cc: integer;
  buchstabe, nullg,
  vier, maxzwei: boolean;
  ziffern: array [1..10] of integer;
  ziff: array [0..9] of integer;
  astr: string;
begin
  // Controls
  memo1.Clear;
  progressbar1.Min := 1;
  progressbar1.Max := maxzahl;
  startwert := strtointdef(edit1.text, 1);
  if (startwert > maxzahl) or (startwert < 1) then
  begin
    showmessage('Startwert muss zwischen 1 und ' + inttostr(maxzahl) + ' liegen!');
    exit;
  end;
  // Initialisierung
  // Um ohne Schleifen oder Stringfunktionen die Stellenzahl zu bestimmen
  altezahl := startwert;
  // Hier schränkt das die Performance nun wirklich nicht ein ;)
  stellenzahl := length(inttostr(startwert));
  // Hier gehts los
  for i := startwert to maxzahl do
  begin
    if (i = (altezahl * 10)) then
    begin
      altezahl := i;
      inc(stellenzahl);
    end;
    // Statusanzeige
    if ((i mod 100000) = 0) or (i = 0) then
    begin
      caption := inttostr(i) + ' / '+ inttostr(stellenzahl);  
      label1.caption := inttostr(i) + ' / 2147483647';
      progressbar1.Position := i;
      application.processmessages;
    end;
    // Array mit Ziffern füllen
    nullg := false;
    num := i;
    j := 1;
    repeat
      c := num mod 10;
      if c = 0 then
      begin
        nullg := true;
        break;
      end;
      ziffern[stellenzahl - j + 1] := num mod 10;
      num := num div 10;
      inc(j);
    until num = 0;
    if nullg then
      continue;
    // numme der ersten beiden Ziffern ist 9
    if not ((ziffern[1] + ziffern[2]) = 9) then
      continue;
    // numme der letzten und vorvorletzten ist 7
    if not ((ziffern[stellenzahl] + ziffern[stellenzahl - 2]) = 7) then
      continue;
    // Quernumme ist Vielfaches von 19
    num := 0;
    for j := 1 to stellenzahl do
      num := num + ziffern[j];
    if not ((num mod 19) = 0) then
      continue;
    // Querprodukt endet auf 2
    num := 1;
    for j := 1 to stellenzahl do
      num := num * ziffern[j];
    if not (NZiffer(num, 1) = 2) then
      continue;
    // Hexadezimal-Darstellung enthält keine Buchstaben
    num := i;
    buchstabe := false;
    repeat
      if (num mod 16) >= 10 then
      begin
        buchstabe := true;
        break;
      end;
      num := num div 16;
    until num < 10;
    if buchstabe then
      continue;
    // Binär-Darstellung enthält höchsten 8 gesetzte Bits und mindestens 4 in Folge
    num := i;
    c := 0;
    cc := 0;
    vier := false;
    repeat
      if ((num mod 2) = 1) then
      begin
        inc(c);
        inc(cc);
        if (cc >= 4) then
          vier := true;
      end else
        cc := 0;
      num := num div 2;
    until  num = 0;
    // Höchsten 8 1-er Bits
    if (c > 8) then
      continue;
    // Mindestens 4 in Folge
    if not vier then
      continue;
    // Jede Ziffer höchsten zwei mal
    maxzwei := true;
    for j := 0 to 9 do
      ziff[j] := 0;
    for j := 1 to stellenzahl do
    begin
      num := ziffern[j] - 1;
      inc(ziff[num]);
      if ziff[num] > 2 then
      begin
        maxzwei := false;
        break;
      end;
    end;
    if not maxzwei then
      continue;
    memo1.lines.add(inttostr(i));
    exit;
  end;
end;

mfg

Moderiert von Tino: Beitrag hier hin verschoben.

jaenicke · Verfasst: Mo 03.12.07 08:23

F34r0fTh3D4rk hat folgendes geschrieben:

So, dann will ich mal mit meiner Lösung den Anfang machen:

Wie das?^^

BenBE hat folgendes geschrieben:

So, hier die ersten Lösungen ...

www.delphi-forum.de/....php?p=475129#475129

F34r0fTh3D4rk · Verfasst: Mo 03.12.07 10:26

Der Beitrag wurde von Tino hierher verschoben, ich hatte nicht gesehen, dass es schon ein topic gibt

außerdem war benbe ein wenig zu früh dran

mfg

Wolle92 · Verfasst: Mo 03.12.07 12:18

Ich reg mich grad so auf!
Ich hätte mir auch nen Programm gebastelt, das alle Zahlen von unten nach oben durchgeht, hätt vielleicht etwas gedauert, aber hätt ich samstag morgen starten lassen und Sonntag Abend nochmal draufgeschaut, wär vielleicht was rausgekommen (also ohne explorer.exe, dwm.exe, sidebar.exe, ICQ.exe, XFire.exe, skype.exe)... Aber ich war nicht zu Hause!!!
OK, dann mal ans zweite...

_________________
1405006117752879898543142606244511569936384000000000.

jaenicke · Verfasst: Mo 03.12.07 12:55

Wolle92 hat folgendes geschrieben:

Ich hätte mir auch nen Programm gebastelt, das alle Zahlen von unten nach oben durchgeht, hätt vielleicht etwas gedauert, aber hätt ich samstag morgen starten lassen und Sonntag Abend nochmal draufgeschaut, wär vielleicht was rausgekommen

Genau das macht ja meine erste unoptimierte Lösung. Für die Untersuchung aller 2,1... Milliarden Zahlen braucht das Programm 63 Sekunden, also 0,03 Mikrosekunden pro Zahl ;-)

.
(Wobei die Fortschrittsanzeige auch noch ein bisschen Zeit klaut.)

Wolle92 · Verfasst: Mo 03.12.07 12:58

wieso braucht dein Programm nur 63 Sekunden für alle Zahlen?
Mein Programm brauchte, ohne irgendeine Untersuchung, schon unendlich lange, um nur auf die erste Millionen zu kommen...

_________________
1405006117752879898543142606244511569936384000000000.

jaenicke · Verfasst: Mo 03.12.07 13:05

Ich habe mein Programm oben ja gepostet und angehängt ;-)

, du kannst es dir gerne ansehen.
// EDIT:
Ich habe es gerade auf einem alten Athlon 64 3700er getestet, da brauchts 3 Minuten bzw. die zweite Lösung 32 statt 12,3 Millisekunden, auf einem 2400er 4 Minuten bzw. 47 Millisekunden.

Wolle92 · Verfasst: Mo 03.12.07 13:16

Dein Programm versteh ich, ja, nur die Geschwindigkeit davon nicht!

_________________
1405006117752879898543142606244511569936384000000000.

jaenicke · Verfasst: Mo 03.12.07 13:31

Dann poste doch mal, welcher Quelltext bei dir so langsam ist ;-)

. Kann es sein, dass du zum Beispiel bei jedem Durchlauf die aktuelle Zahl ausgibst auf ein Label oder so oder jedesmal eine Fortschrittsanzeige aktualisierst? Dann braucht mein Quelltext 5 Stunden oder so...
Außerdem benutze ich kaum Stringoperationen, sondern Divisionen und Modulo zum Beispiel um die Dezimalziffern einzeln zu erhalten.

Wolle92 · Verfasst: Mo 03.12.07 13:37

jaenicke hat folgendes geschrieben:

Dann poste doch mal, welcher Quelltext bei dir so langsam ist ;-)

. Kann es sein, dass du zum Beispiel bei jedem Durchlauf die aktuelle Zahl ausgibst auf ein Label oder so oder jedesmal eine Fortschrittsanzeige aktualisierst? Dann braucht mein Quelltext 5 Stunden oder so...

Denn Quelltext hab ich schon inne Tonne gekloppt, aber ich hab immer nen Label aktualisiert...
Aber auch wenn ich nix mache, dauetr es länger als dein Programm...
einfach nur ne for-Schleife mit nix drin, die i bis auf 2 Mrd. erhöht, das dauert länger als deins...

_________________
1405006117752879898543142606244511569936384000000000.

jaenicke · Verfasst: Mo 03.12.07 13:43

Dann ist es kein Wunder, nimm bei mir einfach das "if i mod 10000000 = 0 then" weg, dann aktualisiert mein Programm auch bei jeder Zahl und nicht nur bei jeder zehnmillionsten ;-)

.
Jedesmal, wenn du etwas auf einem Label oder einer anderen visuellen Komponente aktualisierst, muss diese neu gezeichnet werden. Und das kostet extrem viel Zeit. Deshalb solltest du immer dafür sorgen, dass das nicht so oft vorkommt, zum Beispiel eben wie bei mir nur bei jeder zehnmillionsten Operation (bzw. eben je nachdem wieviele Operationen pro Sekunde stattfinden entsprechend weniger oder mehr).
Bei Memos oder ListViews kannst du sowas auch optimieren, indem du mit Memo1.Lines.BeginUpdate und Memo1.Lines.EndUpdate vor und nach ALLEN Operationen ein neu zeichnen während der Änderungen verhinderst.
Sehen tust du dann aber erst was, wenn alles fertig ist, und du EndUpdate aufgerufen hast.

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme