"Floating point overflow" error in Delphi code - delphi

I have this source code in Delphi, why I get this error "Floating point overflow." when I run the code? and how to correct it?
The error message:
The code:
procedure TForm1.Button1Click(Sender: TObject);
var n, d, i, j, maxiter , iter: Integer;
Lower,Upper : Double;
X, V : TArray<TArray<Double>>;
begin
Lower := 0;
Upper := 0.2;
n := 100;
d := 55;
SetLength(V, n, d);
SetLength(X, n, d);
maxiter := 2000;
iter := 1;
for i:= 0 n-1 do
for j:=0 to d-1 do
begin
X[i][j]:= Lower + (Upper - Lower) * Random;
V[i][j] := 0.1 * X[i][j];
end;
while (iter <= maxiter) do
begin
for i:= 0 to n-1 do
for j:= 0 to D-1 do
V[i][j]:= 5 * V[i][j] + 2.0 * Random;
iter := iter +1;
end;
end;

Look here: V[i][j]:= 5 * V[i][j] + 2.0 * Random;
You make 2000 iterations, so your results might be as large as 7^2000 ~ 10^1690, but max value for Double type is about 10^308. So “Floating point overflow” error is exact diagnosis.
You could see V[] values about 10^307 in debug watch or immediate watch (mouse over V[]) when error occurred.
You can use 10-byte Extended type(probably not available for 64-bit compilers) to avoid overflow for these given variable values, but this is not good solution in general case.
Aside note: You did not set i index value for this code piece:
for j:=0 to d-1 do
begin
X[i][j]:= Lower + (Upper - Lower) * Random;
V[i][j] := 0.1 * X[i][j];
end;

Related

Operator not applicable to this operand type Delphi

Someone help me to fix this error please.
[Error] Unit1.pas(39): Operator not applicable to this operand type
code is:
procedure TForm1.Button1Click(Sender: TObject);
var
k: Integer;
broj: Real;
begin
k := StrToInt(Edit1.Text);
if k <= 9 then
broj := k
else
broj := (k + 10) / 2;
if k mod 2 = 0 then
broj := broj / 10
else
broj := broj mod 10; // error line
ShowMessage(FloatToStr(broj));
end;
You can't use mod or div with floating point types, e.g. Real.
Alternatively to previous answer you can use this.
broj := Frac(broj / 10) * 10;
or simply FMod from System.Math
broj := FMod(broj, 10);
The mod operator needs 2 integers. broj is real (float).
Use this instead
broj := broj - Trunc(broj / 10) * 10;

B-Spline Curves coefficients - division by zero (code in DELPHI)

I was trying to implement the following recursive formula to my code
but to my surprise it turns out that after implementing this to DELPHI, I get an error due to division by zero. I am 98% sure that my knot vector is correctly calculated, which in a way means there shouldn't be any divisions by zero. I am 70% sure that the recursive formula is correctly implemented, for that reason I am posting my code here:
program project1;
uses
SysUtils;
Type
TRealPoint = record
x: single;
y: single;
end;
type
TSample = Class(TObject)
public
KnotVector: array of single;
FitPoints: array of TRealPoint;
Degree: integer;
constructor Create; overload;
function Coefficient(i, p: integer; Knot: single): single;
procedure GetKnots;
destructor Destroy; overload;
end;
constructor TSample.Create;
begin
inherited;
end;
function TSample.Coefficient(i, p: integer; Knot: single): single;
var
s1, s2: single;
begin
If (p = 0) then
begin
If (KnotVector[i] <= Knot) And (Knot < KnotVector[i+1]) then Result := 1.0
else Result := 0.0;
end
else
begin
s1 := (Knot - KnotVector[i])*Coefficient(i, p-1, Knot)/(KnotVector[i+p] - KnotVector[i]); //THIS LINE ERRORS due to division by zero ???
s2 := (KnotVector[i+p+1]-Knot)*Coefficient(i+1,p-1,Knot)/(KnotVector[i+p+1]-KnotVector[i+1]);
Result := s1 + s2;
end;
end;
procedure TSample.GetKnots();
var
KnotValue: single;
i, MaxKnot: integer;
begin
// KNOTS
KnotValue:= 0.0;
SetLength(KnotVector, Length(FitPoints) + 1 + Degree);
MaxKnot:= Length(KnotVector) - (2*Degree + 1);
for i := Low(KnotVector) to High(KnotVector) do
begin
if i <= (Degree) then KnotVector[i] := KnotValue / MaxKnot
else if i > Length(FitPoints) then KnotVector[i] := KnotValue / MaxKnot
else
begin
KnotValue := KnotValue + 1.0;
KnotVector[i] := KnotValue / MaxKnot;
end;
end;
end;
destructor TSample.Destroy;
begin
inherited;
end;
var
i, j: integer;
Test: TSample;
N: array of array of single;
begin
Test := TSample.Create;
//define degree
Test.Degree := 3;
//random fit points
j := 15;
SetLength(Test.FitPoints, j + 1 + Test.Degree);
For i := Low(Test.FitPoints) to High(Test.FitPoints) do
begin
Test.FitPoints[i].x := Random()*2000;
Test.FitPoints[i].y := Random()*2000;
end;
//get knot vector
Test.GetKnots;
//get coefficients
SetLength(N, j+1, j+1);
For j := Low(N) to High(N) do
begin
For i := Low(N[j]) to High(N[j]) do
begin
N[j, i] := Test.Coefficient(i,3,Test.KnotVector[j]);
write(floattostrf(N[j,i], ffFixed, 2, 2) + ', ');
end;
writeln();
end;
readln();
Test.Free;
end.
Basically I'm not sure how to continue. I would need the values of matrix N (see this link) of basis coefficients but somehow using the formula from this link leads me to division by zero.
So... Is there a totally different way how to calculate those coefficients or what is the problem here?
UPDATE
Instead of using my own idea i tried to implement the algorithm from here as suggested by Dsm in the comments. As a result, there is no more divison by zero, but the result is totally unexpected anyways.
For n + 1 = 10 random fit points with spline degree 3 the basis matrix N (see link) is singular - as seen from the attached image.
Instead of that I would expect the matrix to be band matrix. Anyway, here is my updated code:
program project1;
uses
SysUtils;
Type
TRealPoint = record
x: single;
y: single;
end;
type
TMatrix = array of array of double;
type
TSample = Class(TObject)
public
KnotVector: array of double;
FitPoints: array of TRealPoint;
SplineDegree: integer;
Temp: array of double;
A: TMatrix;
procedure GetKnots;
function GetBasis(Parameter: double): boolean;
procedure FormBasisMatrix;
end;
procedure TSample.GetKnots();
var
i, j: integer;
begin
// KNOTS
//https://pages.mtu.edu/~shene/COURSES/cs3621/NOTES/INT-APP/PARA-knot-generation.html
SetLength(KnotVector, Length(FitPoints) + SplineDegree + 1);
for i := Low(KnotVector) to High(KnotVector) do
begin
if i <= SplineDegree then KnotVector[i] := 0
else if i <= (High(KnotVector) - SplineDegree - 1) then KnotVector[i] := (i - SplineDegree) / (Length(FitPoints) - SplineDegree)
else KnotVector[i] := 1;
end;
end;
function TSample.GetBasis(Parameter: double): boolean;
var
m, d, k: integer;
FirstTerm, SecondTerm: double;
begin
//http://pages.mtu.edu/~shene/COURSES/cs3621/NOTES/spline/B-spline/bspline-curve-coef.html
Result := False;
//initialize to 0
SetLength(Temp, Length(FitPoints));
For m := Low(Temp) to High(Temp) do Temp[m] := 0.0;
//special cases
If Abs(Parameter - KnotVector[0]) < 1e-8 then
begin
Temp[0] := 1;
end
else if Abs(Parameter - KnotVector[High(KnotVector)]) < 1e-8 then
begin
Temp[High(Temp)] := 1;
end
else
begin
//find knot span [u_k, u_{k+1})
for k := Low(KnotVector) to High(KnotVector) do if Abs(KnotVector[k] - Parameter) < 1e-8 then break;
Temp[k] := 1.0;
for d := 1 to SplineDegree do
begin
Temp[k - d] := (KnotVector[k + 1] - Parameter) * Temp[k - d + 1] / (KnotVector[k + 1] - KnotVector[k - d + 1]);
for m := k - d + 1 to k - 1 do
begin
FirstTerm := (Parameter - KnotVector[m]) / (KnotVector[m + d] - KnotVector[m]);
SecondTerm := (KnotVector[m + d + 1] - Parameter) / (KnotVector[m + d + 1] - KnotVector[m + 1]);
Temp[m] := FirstTerm * Temp[m] + SecondTerm * Temp[m + 1];
end;
Temp[k] := (Parameter - KnotVector[k]) * Temp[k] / (KnotVector[k + d] - KnotVector[k]);
end;
end;
Result := True;
end;
procedure TSample.FormBasisMatrix;
var
i, j: integer;
begin
SetLength(A, Length(FitPoints), Length(FitPoints));
for j := Low(A) to High(A) do
begin
for i := low(A[j]) to High(A[j]) do //j - row, i - column
begin
If GetBasis(KnotVector[j + SplineDegree]) then A[j, i] := Temp[i];
end;
end;
end;
var
i, j, iFitPoints: integer;
Test: TSample;
N: array of array of single;
begin
Test := TSample.Create;
//define degree
Test.SplineDegree := 3;
//random fit points
iFitPoints := 10;
SetLength(Test.FitPoints, iFitPoints);
For i := Low(Test.FitPoints) to High(Test.FitPoints) do
begin
Test.FitPoints[i].x := Random()*200;
Test.FitPoints[i].y := Random()*200;
end;
//get knot vector
Test.GetKnots;
//get B-Spline basis matrix
Test.FormBasisMatrix;
// print matrix
for j := Low(Test.A) to High(Test.A) do
begin
for i := Low(Test.A) to High(Test.A) do write(FloatToStrF(Test.A[j, i], ffFixed, 2, 2) + ', ');
writeln();
end;
readln();
Test.Free;
end.
This does not appear to be the complete answer, but it may help you on your way, and the result is closer to what you expect, but as I say, not completely there.
First of all the knots do not look right to me. The knots appear to form a 'ramp' function (clamped line), and though I can't work out if 'm' has any specific value, I would expect the function to be continuous, which yours is not. Making it continuous gives better results, e.g.
procedure TSample.GetKnots();
var
i, j: integer;
iL : integer;
begin
// KNOTS
//https://pages.mtu.edu/~shene/COURSES/cs3621/NOTES/INT-APP/PARA-knot-generation.html
iL := Length( FitPoints );
SetLength(KnotVector, iL + SplineDegree + 1);
// set outer knot values and sum used to geterate first internal value
for i := 0 to SplineDegree - 1 do
begin
KnotVector[ i ] := 0;
KnotVector[ High(KnotVector)-i] := 1;
end;
// and internal ones
for i := 0 to High(KnotVector) - 2* SplineDegree + 1 do
begin
KnotVector[ SplineDegree + i - 1] := i / (iL - 1);
end;
end;
I introduced iL = Length( Fitpoints ) for convenience - it is not important.
The second issue I spotted is more of a programming one. In the GetBasis routine, you evaluate k by breaking a for loop. The problem with that is that k is not guaranteed to persist outside the loop, so your use of it later is not guaranteed to succeed (although it may)
Finally, in the same place, your range determination is completely wrong in my opinion. You should be looking for parameter to lie in a half open line segment, but instead you are looking for it to lie close to an endpoint of that line.
Putting these two together
for k := Low(KnotVector) to High(KnotVector) do if Abs(KnotVector[k] - Parameter) < 1e-8 then break;
should be replaced by
k1 := 0;
for k1 := High(KnotVector) downto Low(KnotVector) do
begin
if Parameter >= KnotVector[k1] then
begin
k := k1;
break;
end;
end;
where k1 is an integer.
I can't help feeling that there is a plus 1 error somewhere, but I can't spot it.
Anyway, I hope that this helps you get a bit further.
To build recursive pyramid for coefficient calculation at intervals, you have to start top level of recursion (inner loop of calculations) from the first real (not duplicate) knot index:
For i := Test.Degree...
Also check the last loop index.
P.S. You can remove constructor and destructor from class description and implementation if they have nothing but inherited.

Are points on max. two lines?

I have a time problem with my program. Given a set of points, it has to say whether all of those points are lying on two different lines.
I wrote code, which has points in array and removes one by one and try calculate it's vector.
But this solution is slow, because it must control all cases of lines. On input with 10,000 points it takes over 10 seconds.
Can someone please tell me if, is here better solution for this problem?
I made this code in Pascal:
uses
math;
type
TPoint = record
x, y: real;
end;
TList = array of TPoint;
function xround(value: real; places: integer): real;
var
muldiv: real;
begin
muldiv := power(10, places);
xround := round(value * muldiv) / muldiv;
end;
function samevec(A, B, C: TPoint): boolean;
var
bx, by: real; // vec A -> B
cx, cy: real; // vec A -> C
lb, lc: real; // len AB, len AC
begin
bx := B.x - A.x;
by := B.y - A.y;
cx := C.x - A.x;
cy := C.y - A.y;
lb := sqrt(bx * bx + by * by);
lc := sqrt(cx * cx + cy * cy);
// normalize
bx := xround(bx / lb, 3);
by := xround(by / lb, 3);
cx := xround(cx / lc, 3);
cy := xround(cy / lc, 3);
samevec := ((bx = cx) and (by = cy)) or ((bx = -cx) and (by = -cy));
end;
function remove(var list: TList; idx: integer): TPoint;
var
i: integer;
begin
remove.x := 0;
remove.y := 0;
if idx < length(list) then
begin
remove := list[idx];
for i := idx to length(list) - 2 do
list[i] := list[i + 1];
setlength(list, length(list) - 1);
end;
end;
var
i, j, lines: integer;
list, work: TList;
A, B: TPoint;
begin
while not eof(input) do
begin
setlength(list, length(list) + 1);
with list[length(list) - 1] do
readln(x, y);
end;
if length(list) < 3 then
begin
writeln('ne');
exit;
end;
lines := 0;
for i := 1 to length(list) - 1 do
begin
work := copy(list, 0, length(list));
lines := 1;
B := remove(work, i);
A := remove(work, 0);
for j := length(work) - 1 downto 0 do
if samevec(A, B, work[j]) then
remove(work, j);
if length(work) = 0 then
break;
lines := 2;
A := remove(work, 0);
B := remove(work, 0);
for j := length(work) - 1 downto 0 do
if samevec(A, B, work[j]) then
remove(work, j);
if length(work) = 0 then
break;
lines := 3; // or more
end;
if lines = 2 then
writeln('YES')
else
writeln('NO');
end.
Thanks, Ferko
APPENDED:
program line;
{$APPTYPE CONSOLE}
uses
math,
sysutils;
type point=record
x,y:longint;
end;
label x;
var
Points,otherPoints:array[0..200001] of point;
n,n2,i,j,k,i1,i2:longint;
function sameLine(A,B,C:point):boolean;
var
ABx,ACx,ABy,ACy,k:longint;
begin
ABx:=B.X-A.X;
ACx:=C.X-A.X;
ABy:=B.Y-A.Y;
ACy:=C.Y-A.Y;
k:=ABx*ACy-ABy*ACx;
if (k=0) then sameLine:=true
else sameLine:=false;
end;
begin
readln(n);
if (n<=4) then begin
writeln('YES');
halt;
end;
for i:=1 to n do readln(Points[i].x,Points[i].y);
for i:=1 to 5 do for j:=i+1 to 5 do for k:=j+1 to 5 do if not (sameLine(Points[i],Points[j],Points[k])) then begin
i1:=i;
i2:=j;
goto x;
end;
writeln('NO');
halt;
x:
n2:=0;
for i:=1 to n do begin
if ((i=i1) or (i=i2)) then continue;
if not sameLine(Points[i1],Points[i2],Points[i]) then begin
inc(n2,1);
otherPoints[n2]:=Points[i];
end;
end;
if (n2<=2) then begin
writeln('YES');
halt;
end;
for i:=3 to n2 do begin
if not sameLine(otherPoints[1],otherPoints[2],otherPoints[i]) then begin
writeln('NO');
halt;
end;
end;
writeln('YES');
end.
Three points A, B and C lie on the same straight line, if vectors AB and AC are collinear or anti-collinear. We can check for collinearity using cross product of vectors - it should be zero.
#LU RD already described this approach is comment, but author probably missed it.
Note that method doesn't suffer from division by zero - there is no division at all.
ABx := B.X - A.X;
ACx := C.X - A.X;
ABy := B.Y - A.Y;
ACy := C.Y - A.Y;
Cross := ABx * ACy - ABy * ACx;
// for integer coordinates
if Cross = 0 then
A,B,C are collinear
If coordinates are float, one must consider some tolerance level. Variants:
//better if available:
if Math.IsZero(Cross)
if Math.SameValue(Cross, 0)
//otherwise
if Abs(Cross) <= SomeEpsilonValue
If coordinate range is very large, numerical error might be significant, so it is worth to normalize tolerance by squared magnitude of coordinate differences:
if Math.IsZero(Cross / Max(ABx * ABx + ABy * ABy, ACx * ACx + ACy * ACy))
I guess the answer to the Q should be devided into two parts.
I. How to know that the given three points belong to the same line?
The answer to this part of the Q was given by #Lurd and then expanded by Mbo.
Let us name their solution function BelongToOneLine(Pnts: array [1..3] of TPoint): boolean; We can consider this part solved.
II. How to decrease time consumption of the algorithm or in other words: how to avoid calling BelongToOneLilne with every possible combination of points as parameters?
Here is the algorithm.
We select 5 distinct points from the task set. 5 is enough (check combination possibilities).
We find the answer to the question if there are at least three points from given five that belong to a single line.
if No - then we do not need to iterate the remaining poins - the answer is that we require more then two lines.
if Yes - (say poins Pt1, Pt2 and Pt3 belong to the same line and Pt4 and Pt5 - don't).
Then we store the points that do not belong to the line Pt1-Pt2-Pt3 from the group-of-five in a distinct array of "outsider" points (or store their indexes in the main array). It may have Length = 0 by the end of this step. This will not affect the rest of the algo.
We get the boolean result of the function BelongToOneLine([Pt1, Pt2, Pt[i]]).
if Yes - we skip the point - it belongs to the line Pt1-Pt2-Pt3.
if No - we store this point in the "outsiders" array.
We watch the length of the OutsidersArray.
if it is <= 2 then the answer to the whole Q is Yes, they do belong to 2 or less lines.
if >2 then we iterate the function BelongToOneLine([OutsiderPt1, OutsiderPt2, OutsiderPt[i]]) until High(OutsiderArray) or until when OutsiderPt[i] does not belong to OutsiderPt1-OutsiderPt2 line. All points of OutsiderArray must belong to the same line otherwise the answer to the whole Q will be negative.
Math note
Without optimization the inerations count will be n! / ((n - k)! * k!).
With the optimization it will be:
5! / ((5-3)! * 3!) + (n - 3) + P(q)outsiders * n that is about 15000 for n = 10000. Most negative count - about 20000.
And another optimization note
Replace declaration of TPoint with integer variables.
Search Results
Featured snippet from the web
For n=1: you need two lines to intersect, so the maximum number of intersections is 0. n=2: Two distinct lines will always intersect in at most one point irrespective of dimensions. ... Explanation: Each set of 2 lines can intersect at one point. Or one point is common intersection for 2 lines.

Byte array to Signed integer in Delphi

source array(4 bytes)
[$80,$80,$80,$80] =integer 0
[$80,$80,$80,$81] = 1
[$80,$80,$80,$FF] = 127
[$80,$80,$81,$01] = 128
need to convert this to integer.
below is my code and its working at the moment.
function convert(b: array of Byte): Integer;
var
i, st, p: Integer;
Negative: Boolean;
begin
result := 0;
st := -1;
for i := 0 to High(b) do
begin
if b[i] = $80 then Continue // skip leading 80
else
begin
st := i;
Negative := b[i] < $80;
b[i] := abs(b[i] - $80);
Break;
end;
end;
if st = -1 then exit;
for i := st to High(b) do
begin
p := round(Power(254, High(b) - i));
result := result + b[i] * p;
result := result - (p div 2);
end;
if Negative then result := -1 * result
end;
i'm looking for a better function?
Update:
file link
https://drive.google.com/file/d/0ByBA4QF-YOggZUdzcXpmOS1aam8/view?usp=sharing
in uploaded file ID field offset is from 5 to 9
NEW:
Now i got into new problem which is decoding date field
Date field hex [$80,$8F,$21,$C1] -> possible date 1995-12-15
* in uploaded file date field offset is from 199 to 203
Just an example of some improvements as outlined by David.
The array is passed by reference as a const.
The array is fixed in size.
The use of floating point calculations are converted directly into a constant array.
Const
MaxRange = 3;
Type
TMySpecial = array[0..MaxRange] of Byte;
function Convert(const b: TMySpecial): Integer;
var
i, j: Integer;
Negative: Boolean;
Const
// Pwr[i] = Round(Power(254,MaxRange-i));
Pwr: array[0..MaxRange] of Cardinal = (16387064,64516,254,1);
begin
for i := 0 to MaxRange do begin
if (b[i] <> $80) then begin
Negative := b[i] < $80;
Result := Abs(b[i] - $80)*Pwr[i] - (Pwr[i] shr 1);
for j := i+1 to MaxRange do
Result := Result + b[j]*Pwr[j] - (Pwr[j] shr 1);
if Negative then
Result := -Result;
Exit;
end;
end;
Result := 0;
end;
Note that less code lines is not always a sign of good performance.
Always measure performance before optimizing the code in order to find real bottlenecks.
Often code readability is better than optimizing over the top.
And for future references, please tell us what the algorithm is supposed to do.
Code for testing:
const
X : array[0..3] of TMySpecial =
(($80,$80,$80,$80), // =integer 0
($80,$80,$80,$81), // = 1
($80,$80,$80,$FF), // = 127
($80,$80,$81,$01)); // = 128
var
i,j: Integer;
sw: TStopWatch;
begin
sw := TStopWatch.StartNew;
for i := 1 to 100000000 do
for j := 0 to 3 do
Convert(X[j]);
WriteLn(sw.ElapsedMilliseconds);
ReadLn;
end.

Lift UInt64 limits with strings in Delphi

I'm reaching my limit with UInt64 and I was wondering if there are functions which do simple operating options such as +/- , etc. with just strings because they can store just as much RAM as you have... (theoretically)
For example I would like to calculate
24758800785707605497982484480 + 363463464326426 and get the result as a string.
I kinda know how to solve this problems with strings using the number system 0123456789 and kinda do digit by digit and overflow the next position - which would cost a lot more power, but I wouldn't mind this issue...
I would like to have this ability to do such calculations until my RAM just blows up (which would be the real limit...)
Are there such functions which already do that?
Arbitrarily large integers are not supported at the language level in Delphi, but a bit of Googling turns up http://www.delphiforfun.org/programs/Library/big_integers.htm, which can support them as alibrary.
On super computers, its called BCD math (Binary Coded Decimals) and each half-byte of RAM represents a decimal digit [0..9] - not an efficient use of RAM, but huge computations take minimal time (i.e. about 3 mSecs to multiply 2 million digit numbers. A BCD Emulator on a fast PC takes 5 or 6 minutes.
I never need to add big numbers, but I do multiply. Actually I call this routine iteratively to compute for example, 1000000 factorial (a 5,565,709 million digit answer. Str6Product refers to how it chops up a pair of string numbers. s1 and s2 have a practical length limit of about 2^31. The function is limited by what a "string can hold". Whatever that limit is, I've never gotten there.
//==============================================================================
function Str6Product(s1: string; s2: string): string; // 6-13 5:15 PM
var
so,snxt6 : string;
z1,z3, i, j, k : Cardinal; // Cardinal is 32-bit unsigned
x1,x3,xm : Cardinal;
countr : Cardinal;
a1, a2, a3 : array of Int64;
inum, icarry : uInt64; // uInt64 is 64-bit signed
begin
s1 := '00000'+s1;
s2 := '00000'+s2;
z1 := length(s1); // set size of Cardinal arrays
z3 := z1 div 6;
x1 := length(s2); // set size of Cardinal arrays
x3 := x1 div 6;
xm := max(x3,z3);
SetLength(a1,xm+1);
SetLength(a2,xm+1);
// try to keep s1 and s2 about the
// same length for best performance
for i := 1 to xm do begin // from rt 2 lft - fill arrays
// with 4-byte integers
if i <= z3 then a1[i] := StrToInt(copy (s1, z1-i*6+1, 6));
if i <= x3 then a2[i] := StrToInt(copy (s2, x1-i*6+1, 6));
if i > z3 then a1[i] := 0;
if i > x3 then a2[i] := 0;
end;
k := max(xm-x3, xm-z3); // k prevents leading zeroes
SetLength(a3,xm+xm+1);
icarry := 0; countr := 0;
icMax := 0; inMax := 0;
for i := 1 to xm do begin // begin 33 lines of "string mult" engine
inum := 0;
for j := 1 to i do
inum := inum + (a1[i-j+1] * a2[j]);
icarry := icarry + inum;
if icMax < icarry then icMax := icarry;
if inMax < inum then inMax := inum;
inum := icarry mod 1000000;
icarry := icarry div 1000000;
countr := countr + 1;
a3[countr] := inum;
end;
if xm > 1 then begin
for i := xm downto k+1 do begin // k or 2
inum := 0;
for j := 2 to i do
inum := inum + (a1[xm+j-i] * a2[xm-j+2]);
icarry := icarry + inum;
if icMax < icarry then icMax := icarry;
if inMax < inum then inMax := inum;
inum := icarry mod 1000000;
icarry := icarry div 1000000;
countr := countr + 1;
a3[countr] := inum;
end;
end;
if icarry >= 1 then begin
countr := countr + 1;
a3[countr] := icarry;
end;
so := IntToStr(a3[countr]);
for i := countr-1 downto 1 do begin
snxt6 := IntToStr(a3[i]+1000000);
so := so+ snxt6[2]+ snxt6[3]+ snxt6[4]+ snxt6[5]+ snxt6[6]+ snxt6[7];
end;
while so[1] = '0' do // leading zeroes may exist
so := copy(so,2,length(so));
result := so;
end;
//==============================================================================
Test call:
StrText := Str6Product ('742136061320987817587158718975871','623450632948509826743508972875');
I should have added that you should be able to add large numbers using the same methodology - From right to left, fragment the strings into 16 byte chunks then convert those chunks to uInt64 variables. Add the least significant digits first and if it produces a 17th byte, carry that over to the 2nd least significant chunk, add those two PLUS any carry over etc. When otherwise done, convert each 16-byte chunk back to string and concatenate accordingly.
The conversions to and from integer to string and vice-versa is a pain, but necessary for big number arithmetic.

Resources