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:

numToList x = numToList' [] x
numToList' y x =
    if x < 10
    then x : y
    else (x `mod` 10) : (numToList' y (x `div` 10))
revList x = reverse x
addList x y =
    if null x
    then (
        if null y
        then []
        else y
    )
    else (
        if null y
        then x
        else (head x + head y) : addList (tail x) (tail y)
    )
daaList x =
    if null x
    then []
    else (daaElemDigit (head x)) : (
        if null (tail x)
        then (
            if 0 == daaHeadCarry x
            then []
            else [daaHeadCarry x]
        )
        else (
            daaList (((daaHeadCarry x) + (head (tail x))) : (tail (tail x)))
        )
    )
daaElemDigit x = x `mod` 10
daaElemCarry x = x `div` 10
daaHeadDigit x = if null x then 0 else daaElemDigit (head x)
daaHeadCarry x = if null x then 0 else daaElemCarry (head x)
isPalim x = x == reverse x
getLyrchInt x = getLyrch (numToList x) 100000
getLyrch x y =
    if y == 0
    then x
    else (
        if isPalim x
        then x
        else (getLyrch (daaList (addList x (reverse x))) (y - 1))
    )					

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

[Denkansatz]

Was ihr braucht:

[*] das Programm, um die (Teil-) Summen auszurechnen
[*] ein weiteres Programm, um diese (Teil-) Summen auf ein Palindrom zu prüfen


Von verteiltem Rechnen habt ihr doch schon gehört !?
Also fehlt noch das 3. (bzw. das nach dem 1. kommende) Programm, 
wechles eine gewisse Anzahl von errechneten (Teil-) Summen dem 2. Programm zur Verfügung stellt...
[/Denkansatz]					

1:
2:
3:
4:
5:
6:
7:

type 
  record 
      ZiffernfolgeOhneCarry : Dword;
      ZiffernfolgeMitCarry  : Dword;
      CarryOhneCarray       : word;// lieber DWword ?
      CarryMitCarray        : word;// Dword 
  end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:

2497 -> (((2*16 +4)*16+9)*16+7 ==> Feldnummer 9367
Feld[9367].ZiffernfolgeOhneCarry = $00040309 ( 0* 4096 +4*256+3*16+9 )
Feld[9367].ZiffernfolgeMitCarry =  $00040400
Feld[9367].CarryOhneCarray = 1
Feld[9367].CarryMitCarray = 1

4455 -> (((4*16 +4)*16+5)*16+5 ==> Feldnummer 17493
Feld[17493].ZiffernfolgeOhneCarry = $09090909
Feld[17493].ZiffernfolgeMitCarry =  $00000000
Feld[17493].CarryOhneCarray = 0
Feld[17493].CarryMitCarray = 1					

1:
2:
3:
4:
5:

Eingabe:  196
Es gab einen Fehler:
    Der Wert liegt außerhalb des erwarteten Bereichs.

Gesammte Zeit: 0 ms					

1:
2:
3:
4:
5:

Summe "2442" -> (((2*10 +4)*10+4)*10+2 ==> Feldnummer 2442
Feld[9367].ZiffernfolgeOhneCarry = $02040402 
Feld[9367].ZiffernfolgeMitCarry =  $02040403
Feld[9367].CarryOhneCarray = 0
Feld[9367].CarryMitCarray = 0					

1:
2:
3:
4:
5:

...952584506637311513
    241389 it    100000 dig

Einzelbyte Additionen  12080757065
Einzelbyte Uebertraege  6040358167					

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:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:

program p196;
{$IFDEF FPC}
  {$MODE DELPHI}
  {$ASMMODE INTEL}
  {$Optimization ON}
  {$Optimization RegVar}
  {$Optimization PEEPHOLE}
  {$Optimization CSE}
  {$Optimization ASMCSE}
{$Else}
  {$APPTYPE console}
{$Endif}

uses
  SysUtils;

{$IFNDEF FPC}
type
  nativeUint = LongWord;//Uint64
  PtrUint  = LongWord;
{$Endif}

const
  NUMBER_BASE = 10;
  cMaxDigit = 100000; //quadratische Laufzeit n,t->k*n,k^2*t
  cDelta = 24139;//Ausgabe alle cDelta Berechnungen

  CpuF = 3.5e9;  // CPU-Frequenz

type
  TDigit  = byte;
  tDigit2 = word;
  tpDigit =^TDigit;
  tpDigit2 =^TDigit2;
  // Rueckwaerts, niederwertigste Stelle ist [0]
  TNumber = array of TDigit;
  tSumCarry = record
                we: Word; 
//              ca:word; carry und neuer Wert separat
              end;
//ein nicht gelungener Versuch, Platz zu sparen 
//aber die Indexbestimmung wird zu langsam
//tSumCarFeld = array[0..18*32+21] of tSumCarry;
  tSumCarFeld = array[0..18*256+21] of tSumCarry;
  
var
  MaxIndex : integer;
  Cycle: Cardinal;
  AddCnt : Int64;
  cSumCarFeld : tSumCarFeld;

procedure NumberFromString(var Number: TNumber; Str: string);
var
  i: integer;
begin
  SetLength(Number, Length(Str));
  for i:= 0 to Length(Str) - 1 do
    Number[i]:= Ord(Str[Length(Str) - i]) - Ord('0');
end;

function NumberToString(var Number: TNumber): string;
var
  i,l: integer;
begin
  i := High(Number);
  If i <= 50 then
  begin
    l := i+1;
    SetLength(Result, l);
    for i:= 0 to High(Number) do
    begin
      Result[l]:= Chr(Ord('0') + Number[i]);
      dec(l);
    end;
  end
  else
  begin
    SetLength(Result, 50);
    fillchar(Result[1],50,'.');
    For l := 1 to 24 do
    Begin
      Result[l] := Chr(Ord('0') + Number[i-l+1]);
      Result[l+26] := Chr(Ord('0') + Number[24-l]);
    end;
  end;
end;

function NumAddAs(pDigit1,pDigit2 : tpDigit):NativeUInt;
//Mal sehen, ob moeglichst viele Register helfen
//Aber es dauert so nur etwa 0.25..0.32 Takte/Digit
begin
  asm
//   PUSH     ECX; PUSH     ESI;PUSH   EDI;
// Bei dermaßen vielen Stellen geht das unter.
     PUSHAD

     MOV     ESI,pDigit2
     MOV     EDI,pDigit1

     MOV     ECX,ESI
     SUB     ECX,EDI
     INC     ECX
     SAR     ECX,3
     TEST    ECX,ECX
     MOV     @result,ECX;
     JLE     @UndTschuesz
//EDI von Byte auf LongWord zeigen lassen
     SUB     ESI,3

     CMP     ECX,4
     JLE     @Reste
//     JMP     @Reste
@WeiteSchritte:
     SUB     ECX,4

     MOV     EAX,[ESI]
     BSWAP   EAX
     MOV     EBX,[ESI-4]
     BSWAP   EBX
     ADD     EAX,[EDI]
     MOV     EBP,[ESI-8]
     BSWAP   EBP
     ADD     EBX,[EDI+4]
     MOV     EDX,[ESI-12]
     BSWAP   EDX
     ADD     EBP,[EDI+8]
     ADD     EDX,[EDI+12]

     MOV     [EDI],EAX
     BSWAP   EAX
     MOV     [EDI+4],EBX
     BSWAP   EBX
     MOV     [EDI+8],EBP
     BSWAP   EBP
     MOV     [EDI+12],EDX
     BSWAP   EDX

     ADD     EDI,16

     MOV     [ESI],EAX
     MOV     [ESI-4],EBX
     MOV     [ESI-8],EBP
     MOV     [ESI-12],EDX

     SUB     ESI,16
     CMP     ECX,4

     JG      @WeiteSchritte;

@Reste:
     MOV     EAX,[EDI]
     BSWAP   EAX
     MOV     EDX,[ESI]
     ADD     EAX,EDX
     MOV     EDX,EAX
     BSWAP   EDX
     MOV     [ESI],EAX
     SUB      ESI,4
     MOV     [EDI],EDX
     ADD      EDI,4
     DEC     ECX
     JNE     @Reste;

@UndTschuesz:
     POPAD
//     POP     EDI; POP     ESI;POP     ECX
  end;
end;

function CarryCorrect(pDigit: tpDigit;cnt: integer):nativeUint;
//Das braucht ~13 Takte pro Digit :-(
//freepascal 2.6.2 div wird durch mul und shr ersetzt
var
 Carry: nativeUint;
begin
  Carry := 0;
  for  cnt := cnt Downto 0 do
  begin
    Carry := Carry+pDigit^;
    result := Carry DIV 10;
    pDigit^ := Carry-10*result;
    inc(pDigit);
    Carry := result;
  end;
end;

function CarryCorrect2(pDigit: tpDigit2;cnt: integer):nativeUint;
//Zwei Zahlen auf einmal korrigieren
var
 idx: NativeUint;
begin
  result := 0;
  //0..cnt hat cnt+1 Elemente
  dec(cnt);
  IF cnt > 0 then
    repeat
      with cSumCarFeld[pDigit^+result] do
      begin
        idx := we;
        pDigit^ := idx shr 2;
        result  := idx AND 3;
      end;
      inc(pDigit);
      dec(cnt,2);
    until cnt<0;

  IF cnt >-2 then
  begin
    // Da fehlt ein Byte
    // Zugriff via word ist nicht sauber.
    // Aber oberes Byte bleibt unangetastet
    idx := (pDigit^ AND 255 )+result;
    result := idx DIV Number_Base;
    idx := idx -result*Number_Base;// ( idx MOD Number_Base)
    pDigit^ := pDigit^ AND (255*256)+idx;
  end;
end;

procedure NumberAdd(var Number : TNumber);
// erst alles addieren und anschliessend carry
// uebertragen bringt einiges
var
  pDigit1,pDigit2 : tpDigit;
  p,
  Carry: nativeUint;
begin
  p := high(Number);
  inc(AddCnt,  (p+1) DIV 2);
  pDigit1 := @Number[0];
  pDigit2 := pDigit1;
  inc(pDigit2,p);// @Number[p];
//{ Mit Assembler
  //Wieviele Stellen mit Assemblerroutine bearbeitet
  Carry:=SizeOf(PtrUint)*NumAddAs(pDigit1,pDigit2);
  //Die Zeiger entsprechend anpassen
  inc(pDigit1,Carry);
  dec(pDigit2,Carry);
//}

  //die letzten einzelnen Stellen addieren
  Carry:= 0;
  IF PtrUint(pDigit2)>= PtrUint(pDigit1) then
    repeat
    Carry := pDigit1^+pDigit2^;
    pDigit1^ := Carry;
    pDigit2^ := Carry;
    inc(pDigit1);
    dec(pDigit2);
    until PtrUint(pDigit2) < PtrUint(pDigit1);

  IF CarryCorrect2(@Number[0],p) = 1 then
    begin
    p := Length(Number)+1;
    SetLength(Number, p);
    Number[p-1] :=1;
    end;
end;

function NumberCompare(const A: TNumber): boolean;
var
  i,j: integer;
begin
  i := Low(A);
  j := High(A);
  Repeat
    Result:= A[i]=A[j];
    inc(i);
    dec(j);
  until Not(Result) OR (J<I);

  IF  MaxIndex <i then
  begin
    MaxIndex := i;
    writeln('Erster Unterschied bei Stelle ',i:2,' und Iteration ',cycle)
  end;
end;

procedure SumCarFeldErstellen;
// Für zwei Stellen auf einmal
var
  i,j,s,c,d1,d2,idx: integer;
begin
  Fillchar(cSumCarFeld,SizeOf(cSumCarFeld),#0);
  For i := 0 to 18 do
    For j := 0 to 21 do
    begin
      idx := i*256+j;
      s := (i*Number_Base+j);
      c := s DIV sqr(Number_Base);
      s := s - c* sqr(Number_Base);
      d1 := s DIV Number_Base;
      d2 := s-d1*Number_Base;
      with cSumCarFeld[idx] do
      begin
        we := (d1*256+d2)*4+c;
      end
    end;
end;

var
  Work : TNumber;
  delta: cardinal;
  Time1, Time2 : TDateTime;
  s: string;
begin
  SumCarFeldErstellen;

  Repeat
    Write('Startzahl: ( Beenden mit 0 ) ');
    ReadLn(s);
    if s='0' then
      break;
    If s= '' then
      s := '196';
    writeln(s);
    NumberFromString(Work, s);
    Cycle:= 0; // das erste ist kein cycle...
    AddCnt := 0;
    delta := cDelta;
    Time1 := time;
    Repeat
      inc(Cycle);
      NumberAdd(Work);
      //Keine Ausgabe !
      if Length(Work) >= cMaxDigit then
        break;
      dec(delta);
      if Delta=0  then
        begin
        delta := cDelta;
        Time2 := time;
        WriteLn(Cycle:10,' it',Length(Work):10,' dig',(Time2-Time1)*86400.0:10:3,' s');
        //WriteLn(NumberToString(Work));readln;
        end;
    until NumberCompare(Work);
    Time2 := time;
    WriteLn(NumberToString(Work));
    WriteLn(Cycle:10,' Iterationen mit ',AddCnt,' Byte-Additionen ' );
    time1 := (Time2-Time1)*86400;
    IF time1 > 0 then
    begin
      WriteLn('Takte/ Addition ',(Time1*CpuF)/AddCnt:6:3);
      WriteLn(Length(Work):10,' Digits ',Time1:10:7,' s');
    end;
  until true;
end.
{# ./p196_6
Startzahl: ( Beenden mit 0 )
196
Erster Unterschied bei Stelle  1 und Iteration 1
Erster Unterschied bei Stelle  2 und Iteration 6
Erster Unterschied bei Stelle  3 und Iteration 13
Erster Unterschied bei Stelle  4 und Iteration 16
Erster Unterschied bei Stelle  5 und Iteration 25
Erster Unterschied bei Stelle  8 und Iteration 70
Erster Unterschied bei Stelle 12 und Iteration 105
Erster Unterschied bei Stelle 13 und Iteration 1237
Erster Unterschied bei Stelle 14 und Iteration 1430
Erster Unterschied bei Stelle 16 und Iteration 3461
Erster Unterschied bei Stelle 17 und Iteration 3940
Erster Unterschied bei Stelle 29 und Iteration 9777
     24139 it     10019 dig     0.152 s
     48278 it     20054 dig     0.605 s
     72417 it     30072 dig     1.360 s
     96556 it     40075 dig     2.418 s
    120695 it     50116 dig     3.780 s
    144834 it     60047 dig     5.443 s
    168973 it     70007 dig     7.407 s
    193112 it     80054 dig     9.675 s
    217251 it     90053 dig    12.239 s
131611373561547534929710..990802952584506637311513
    241389 Iterationen mit 6040318143 Byte-Additionen
Takte/ Addition  8.752
    100000 Digits 15.1040000 s
}