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:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
563:
564:
565:
566:
567:
568:
| unit U_BigInts;
{Copyright 2001, Gary Darby, Intellitech Systems Inc., www.DelphiForFun.org
This program may be used or modified for any non-commercial purpose
so long as this original notice remains in place.
All other rights are reserved
}
{ Arbitarily large integer unit -
Operations supported:
Assign, Add, Subtract, Multiply, Divide, Modulo, Compare, Factorial
(Factorial limited to max integer, run time would probably limit it
to much less)
All operations are methods of a Tinteger class and replace the value with the
result. For binary operations (all except factorial), the second operand is
passed as a parameter to the procedure.
}
interface
uses forms, dialogs;
type
TDigits=array of byte;
TInteger=class(TObject)
private
sign:integer;
fdigits:TDigits;
base:integer;
procedure trim;
public
property digits:TDigits read fdigits;
constructor create;
procedure Assign(Const I2:TInteger); overload;
procedure Assign(Const I2:Int64); overload;
procedure Assign(Const I2:string);overload;
procedure absadd( const i2:tinteger);
procedure Add(const I2:TInteger);overload;
procedure Add(const I2:Int64); overload;
procedure abssubtract(const i2:Tinteger);
procedure Subtract(const I2:TInteger);overload;
procedure Subtract(const I2:Int64); overload;
procedure mult(const I2:TInteger); overload;
procedure mult(const I2:int64); overload;
procedure divide(const I2:TInteger); overload;
procedure divide(const I2:Int64); overload;
procedure modulo(const i2:TInteger); overload;
procedure modulo(const i2:Int64); overload;
procedure dividerem(const I2:TInteger; var remainder:TInteger);
function compare(I2:TInteger):integer; overload;
function compare(I2:Int64):integer; overload;
function abscompare(I2:TInteger):integer;
procedure factorial;
function ConvertToDecimalString(commas:boolean):String;
function converttoInt64(var n:Int64):boolean;
end;
implementation
uses math;
constructor TInteger.create;
begin
inherited;
base:=10; {base in Tinteger in case we want to handle other bases later}
sign:=+1;
end;
procedure TInteger.trim;
{trim leading zeros}
var
i:integer;
begin
i:=high(fdigits);
while (i>0) and (fdigits[i]=0) do dec(i);
setlength(fdigits,i+1);
end;
procedure TInteger.Assign(Const I2:TInteger);
{Assign - TInteger}
var
i:integer;
begin
if i2.base=base then
begin
setlength(fdigits,length(i2.fdigits));
for i:=low(i2.fdigits) to high(i2.fdigits) do fdigits[i]:=i2.fdigits[i];
sign:=i2.sign;
trim;
end
else
begin
showmessage('Bases other that 10 not yet supported');
end;
end;
procedure TInteger.Assign(Const I2:Int64);
{Assign - int64}
var
i:integer;
n:int64;
begin
setlength(fdigits,20);
n:=i2;
i:=0;
while n>0 do
begin
fdigits[i]:=n mod base;
n:=n div base;
inc(i);
end;
if i2<0 then sign:=-1
else if i2=0 then sign:=0
else if i2>0 then sign:=+1;
setlength(fdigits,i);
trim;
end;
procedure TInteger.Assign(const i2:string);
{Assign - string number}
var
i,j:integer;
zeroval:boolean;
begin
setlength(fdigits,length(i2));
sign:=+1;
j:=0;
zeroval:=true;
for i:=length(i2) downto 1 do
begin
if i2[i] in ['0'..'9'] then
begin
fdigits[j]:=ord(i2[i])-ord('0');
if fdigits[j]<>0 then zeroval:=false;
inc(j);
end
else if i2[i]='-' then sign:=-1;
end;
if zeroval then sign:=0;
setlength(fdigits,j);
trim;
end;
procedure TInteger.Add(Const I2:TInteger);
{add - TInteger}
begin
if sign<>i2.sign then abssubtract(i2)
else absadd(i2);
end;
procedure tinteger.absadd( const i2:tinteger);
{add values ignoring signs}
var
i:integer;
I3:Tinteger;
n, carry:integer;
begin
I3:=TInteger.create;
I3.assign(self);
setlength(fdigits, max(length(fdigits),length(i2.fdigits))+1); {"add" could grow result by two digit}
i:=0;
carry:=0;
while i<min(length(i2.fdigits),length(i3.fdigits)) do
begin
n:=i2.fdigits[i]+i3.fdigits[i]+carry;
fdigits[i]:= n mod base;
if n >= base then carry:=1 else carry:=0;
inc(i);
end;
if length(i2.fdigits)>length(i3.fdigits) then
while i<{=}length(i2.fdigits) do
begin
{
fdigits[i]:=i2.fdigits[i]+carry;
carry:=0;
}
n:=i2.fdigits[i]+carry;
fdigits[i]:= n mod base;
if n >= base then carry:=1 else carry:=0;
inc(i);
end
else
if length(i3.fdigits)>length(i2.fdigits) then
begin
while i<{=}length(i3.fdigits) do
begin
(*
fdigits[i]:=i3.fdigits[i]+carry;
carry:=0;
*)
n:=i3.fdigits[i]+carry;
fdigits[i]:= n mod base;
if n >= base then carry:=1 else carry:=0;
inc(i)
end;
{fdigits[i]:=carry;}
end
;{else} fdigits[i]:=carry;
trim;
i3.free;
end;
procedure TInteger.add(Const I2:Int64);
{Add - Int64}
var
I3:TInteger;
begin
I3:=TInteger.create;
I3.assign(I2);
Add(I3);
I3.free;
end;
procedure TInteger.Subtract(const I2:TInteger);
{Subtract}
begin
if sign<>i2.sign then absadd(I2)
else abssubtract(i2);
end;
procedure TInteger.abssubtract(const i2:Tinteger);
{Subtract values ignoring signs}
var
c:integer;
i3:TInteger;
i,j,k:integer;
begin {request was subtract and signs are same,
or request was add and signs are different}
c:=abscompare(i2);
i3:=TInteger.create;
if c<0 then {abs(i2) larger, swap and subtract}
begin
i3.assign(self);
assign(i2);
end
else if c>=0 then {self is bigger} i3.assign(i2);
for i:= 0 to high(i3.fdigits) do
begin
if fdigits[i]>=i3.fdigits[i] then fdigits[i]:=fdigits[i]-i3.fdigits[i]
else
begin {have to "borrow"}
j:=i+1;
while(j<=high(fdigits)) and (fdigits[j]=0) do inc(j);
if j<=high(fdigits) then
begin
for k:=j downto i+1 do
begin
dec(fdigits[k]);
fdigits[k-1]:=fdigits[k-1]+base;
end;
fdigits[i]:=fdigits[i]-i3.fdigits[i];
end
else showmessage ('Subtract error');
end;
end;
i3.free;
trim;
end;
procedure TInteger.Subtract(const I2:Int64);
{subtract - TInteger}
var
I3:Tinteger;
begin
i3:=TInteger.create;
i3.assign(i2);
subtract(i3);
i3.free;
end;
procedure TInteger.mult(const I2:TInteger);
{Multiply - by Tinteger}
var
i3,i4:TInteger; {for interim result}
n:int64;
i,j:integer;
begin
i3:=TInteger.create;
i3.assign(0);
i4:=Tinteger.create;
for i:=0 to high(i2.fdigits) do
begin
n:=i2.fdigits[i];
i4.assign(self);
i4.mult(n);
setlength(i4.fdigits,length(i4.fdigits)+i);
if i>0 then
begin
for j:= high(i4.fdigits) downto i
do i4.fdigits[j]:=i4.fdigits[j-i];
for j:= i-1 downto 0
do i4.fdigits[j]:=0;
end;
i3.add(i4);
end;
assign(i3); {assign also trims any leading zeros}
if sign<>i2.sign then sign:=-1 else sign:=+1;
i3.free;
i4.free;
end;
procedure TInteger.mult(const I2:int64);
{Multiply - by int64}
var
n,d:int64;
carry:int64;
i:integer;
begin
carry:=0;
for i:=0 to high(fdigits) do
begin
n:=fdigits[i]*i2;
d:=n mod base + carry;
carry:=n div base;
while d>=base do
begin
d:=d-base;
inc(carry);
end;
fdigits[i]:=d;
end;
if carry<>0 then
begin
i:=high(fdigits)+1;
setlength(fdigits,length(fdigits)+carry div base + 1);
while carry>0 do
begin
fdigits[i]:=carry mod base;
carry:=carry div base;
inc(i);
end;
end;
trim;
end;
procedure TInteger.divide(const I2:TInteger);
{Divide - by TInteger}
var
i3:TInteger;
q:byte;
i,size:integer;
d:array of byte;
pos:integer;
begin
i3:=TInteger.create;
dividerem(I2,i3);
i3.free;
end;
procedure Tinteger.modulo(const i2:TInteger);
{Modulo (remainder after division) - by Tinteger}
var
i3:TInteger;
begin
i3:=TInteger.create;
dividerem(i2,i3);
assign(i3);
i3.free;
end;
procedure TInteger.modulo(const I2:Int64);
{Modulo - by Int64}
var
i3:Tinteger;
begin
i3:=TInteger.create;
i3.assign(i2);
modulo(i3);
i3.free;
end;
procedure TInteger.dividerem(const I2:TInteger; var remainder:TInteger);
{Divide - by TInteger and return remainder as well}
var
i3:TInteger;
q:byte;
i,size:integer;
d:array of byte;
pos:integer;
signout:integer;
done:boolean;
begin
if sign<>i2.sign then signout:=-1 else signout:=+1;
sign:=+1;
i2.sign:=+1;
if compare(i2)>=0 then
begin
i3:=TInteger.create;
setlength(i3.fdigits, length(i2.fdigits));
pos:=high(fdigits);
i3.assign(fdigits[pos]);
dec(pos);
size:=-1;
if pos=-1 then{1 digit number}
begin
while i3.compare(i2)>=0 do
begin
inc(q);
i3.subtract(i2);
end;
inc(size);
setlength(d,1);
d[size]:=q;
end
else
while pos>=0 do
begin
done:=not ((pos>=0) and (i3.compare(i2)<0));
while not done do { do}
begin
i3.mult(base);
i3.add(fdigits[pos]);
dec(pos);
if (pos>=0) and (i3.compare(i2)<0) then
begin
inc(size);
if size>length(d)-1 then setlength(d,length(d)+10);
d[size]:=0;
end
else done:=true;
end;
q:=0;
while i3.compare(i2)>=0 do
begin
inc(q);
i3.subtract(i2);
end;
inc(size);
if size>length(d)-1 then setlength(d,length(d)+10);
d[size]:=q;
end;
setlength(fdigits, size+1);
for i:= size downto 0 do
fdigits[size-i]:=d[i];
remainder.assign(i3);
sign:=signout;
remainder.sign:=signout;
trim;
i3.free;
end
else
begin
remainder.assign(self);
assign(0);
end;
end;
procedure TInteger.divide(const I2:Int64);
{Divide - by Int64}
var
i3:Tinteger;
begin
i3:=TInteger.create;
i3.assign(i2);
divide(i3);
i3.free;
end;
function TInteger.compare(i2:TInteger):integer;
{Compare - to Tinteger}
{return +1 if self>i2, 0 if self=i2 and -1 if self<i2)}
begin
if (sign<0) and (i2.sign>0) then result:=-1
else if (sign>0) and (i2.sign<0) then result:=+1
else {same sign} result:=abscompare(i2);
end;
function TInteger.compare(i2:Int64):integer;
{Compare - to int64}
{return +1 if self>i2, 0 if self=i2 and -1 if self<i2)}
var
i3:TInteger;
begin
i3:=TInteger.create;
i3.assign(i2);
if (sign<0) and (i3.sign>0) then result:=-1
else if (sign>0) and (i3.sign<0) then result:=+1
else {same sign} result:=abscompare(i3);
i3.free;
end;
function TInteger.abscompare(i2:Tinteger):integer;
{compare absolute values ingoring signs - to Tinteger}
var
i:integer;
begin
result:=0;
if length(fdigits)>length(i2.fdigits) then result:=+1
else if length(fdigits)<length(i2.fdigits) then result:=-1
else {equal length}
for i:=high(fdigits) downto 0 do
begin
if fdigits[i]>i2.fdigits[i] then
begin
result:=+1;
break;
end
else
if fdigits[i]<i2.fdigits[i] then
begin
result:=-1;
break;
end;
end;
end;
procedure TInteger.factorial;
{Compute factorial - number must be less than max integer value}
var
n:int64;
i:integer;
begin
n:=0;
if compare(high(integer))>=0 then exit;
for i:= high(fdigits) downto 0 do
begin
n:=n*base+fdigits[i];
end;
dec(n);
while n>1 do
begin
mult(n);
dec(n);
{provide a chance to cancel long running ops}
if (n mod 64) =0
then application.processmessages;
end;
end;
Function TInteger.ConvertToDecimalString(commas:boolean):string;
{Convert Tinteger to decimal string, insert commas if "commas" is true}
var
i:integer;
begin
result:='';
for i:=0 to high(fdigits) do
begin
result:=char(ord('0')+fdigits[i])+result;
if commas and((i mod 3)=2) and (i<high(fdigits)) then result:=','+result;
end;
if result='' then result:='0'
else if sign<0 then result:='-'+result;
end;
function TInteger.converttoInt64(var n:Int64):boolean;
var i:integer;
begin
result:=false;
if high(fdigits)<=20 then
begin
n:=0;
for i :=high(fdigits) downto 0 do n:=10*n+fdigits[i];
end;
end;
end. |
