Are points on max. two lines? - delphi

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.

Related

Scan Line Out of Range Error for Bitmap. TJanDrawImage Component for a Paint-like Program

I am using the free JansDraw Components and when the executable runs, it throws AV error. I could locate the error to specifically the loop block of the code (not the initial block of assignment statements).
procedure TjanDrawImage.colorcircle(var bm:TBitmap;center:tpoint;radius,mode:integer);
var p,p0,p1:pbytearray;
dx,x,y,w,h,i,j,sum,c:integer;
cm,tm:tbitmap;
Rs,Rd:trect;
begin
x:=center.x;
y:=center.y;
w:=bm.width;
h:=bm.height;
cm:=tbitmap.create;
cm.width:=2*radius;
cm.height:=2*radius;
cm.PixelFormat :=FPixelFormat;
tm:=tbitmap.create;
tm.width:=2*radius;
tm.height:=2*radius;
tm.PixelFormat :=FPixelFormat;
tm.canvas.brush.color:=clblack;
tm.canvas.Ellipse (0,0,tm.width-1,tm.height-1);
tm.transparent:=true;
tm.TransparentColor :=clblack;
Rd:=rect(0,0,cm.width,cm.height);
Rs:=rect(x-radius,y-radius,x+radius,y+radius);
cm.canvas.CopyRect (Rd,bm.canvas,RS);
for j:=0 to cm.height-1 do begin
p:=cm.scanline[j];
if j>0 then p0:=cm.scanline[j-1];
if j<(h-1) then p1:=cm.scanline[j+1];
for i:=0 to cm.width-1 do begin
case mode of
0: //blue
begin
p[i*3+1]:=0;
p[i*3+2]:=0;
end;
1: //green
begin
p[i*3]:=0;
p[i*3+2]:=0;
end;
2: //red
begin
p[i*3]:=0;
p[i*3+1]:=0;
end;
3: //not blue
begin
p[i*3]:=0;
end;
4: //not green
begin
p[i*3+1]:=0;
end;
5: //not red
begin
p[i*3+2]:=0;
end;
6: //half blue
begin
p[i*3]:=p[i*3]*9 div 10;
end;
7: //half green
begin
p[i*3+1]:=p[i*3+1]*9 div 10;
end;
8: //half red
begin
p[i*3+2]:=p[i*3+2]*9 div 10;
end;
9:// darker
begin
p[i*3]:=round(p[i*3]*10 /11);
p[i*3+1]:=round(p[i*3+1]*10 / 11);
p[i*3+2]:=round(p[i*3+2]*10 /11);
end;
10:// lighter
begin
p[i*3]:=round(p[i*3]*11 / 10);
p[i*3+1]:=round(p[i*3+1]*11 / 10);
p[i*3+2]:=round(p[i*3+2]*11 / 10);
end;
11:// gray
begin
sum:=round((p[i*3]+p[i*3+1]+p[i*3+2])/ 3);
p[i*3]:=sum;
p[i*3+1]:=sum;
p[i*3+2]:=sum;
end;
12:// mix
begin
c:=p[i*3];
p[i*3]:=p[i*3+1];
p[i*3+1]:=p[i*3+2];
p[i*3+2]:=c;
end;
13://smooth
begin
if ((j>0) and (j<(h-1))and (i>0)and (i<(w-1))) then begin
p[i*3]:=round((p[(i-1)*3]+p[(i+1)*3]+p0[i*3]+p1[i*3]) /4);
p[i*3+1]:=round((p[(i-1)*3+1]+p[(i+1)*3+1]+p0[i*3+1]+p1[i*3+1]) /4);
p[i*3+2]:=round((p[(i-1)*3+2]+p[(i+1)*3+2]+p0[i*3+2]+p1[i*3+2]) / 4);
end;
end;
end;
end;
end;
cm.canvas.Draw (0,0,tm);
cm.transparent:=true;
cm.transparentcolor:=clwhite;
bm.Canvas.draw(x-radius,y-radius,cm);
cm.free;
tm.free;
end;
A linked question which is helpful is this - implementing scan line of bitmap corectly. It suggests to cast the pointers to NativeInt. The OP changed his code after answers, making it difficult to correlate old code with new code. I understand that my problem is due to some hard coded sequential access of pointers but I am really beginner to make sense of scan line or pointers. If you help me port this, these components will continue to be useful to everyone.
update after comment from #Renate Schaaf:
all the brush modes of the janDrawImage are working now, except for the below one. I was expecting a bigger problem but that didn't turn out to be the case. So modified the title of the question. #Renate Schaaf Can you please help fix the below one too. I tried but failed.
procedure TjanDrawImage.rimple(src,dst:tbitmap;amount:extended);
var ca,sa,a,dx,dy,r,rx,ry,sr,fr:extended;
w,h,x,y,cx,cy,i,j,c,ci:NativeInt;
p1,p2:pbytearray;
begin
w:=src.width;
h:=src.height;
cx:=w div 2;
cy:=h div 2;
if amount<1 then amount:=1;
fr:=cx/amount;
for y:=0 to h-1 do begin
p1:=src.ScanLine[y];
for x:=0 to w-1 do begin
dx:=x-cx;dy:=-(y-cx);
r:=sqrt(sqr(dx)+sqr(dy));
sr:=fr*sin(r/cx*amount*2*pi);
if (r+sr<cx) and (r+sr>0) then begin
a:=arctan2(dy,dx);
sincos(a,sa,ca);
i:=cx+round((r+sr)*ca);
j:=cy+round((r+sr)*sa);
p2:=dst.scanline[j];
c:=x*3;ci:=i*3;
p2[ci]:=p1[c];
p2[ci+1]:=p1[c+1];
p2[ci+2]:=p1[c+2];
end;
end;
end;
end;
When you do scanline operations, you always need to make sure that your pixel location is within the boundaries of your bitmap, particularly if you make geometric transformations.
So, in the last example you must clamp j to [0,h-1] and i to [0,w-1] using max(min(..)).
Also, you should set the size and pixelformat of src and dst to the same at the beginning.
I didn't really bother to find out what this ripple is supposed to do, but when I run an example it doesn't look like it's doing whatever it does right. For geometric transformations you need to work backwards, running through the pixels of the destination and figure out which pixel of the source needs to go there. Otherwise you end up with a destination that has holes, like here.
Edit:
Since I'm stuck with my project: I think this is the routine you really want to use. Note that I just switched the roles of src and dst and corrected some errors. It now adds a water ripple effect to the bitmap.
procedure rimple(src, dst: TBitmap; amount: extended);
var
ca, sa, a, dx, dy, r, sr, fr: extended;
w, h, x, y, cx, cy, i, j, c, ci: NativeInt;
p1, p2: pbytearray;
bits: integer;
begin
Assert(src.PixelFormat in [pf24bit, pf32bit],
'Device independent bitmap needed');
dst.PixelFormat := src.PixelFormat;
bits := 3;
if src.PixelFormat = pf32bit then
bits := 4;
w := src.width;
h := src.height;
dst.SetSize(w, h);
cx := w div 2;
cy := h div 2;
// in case somebody enters a negative amount
if abs(amount) < 1 then
amount := 1;
fr := cx / amount;
for y := 0 to h - 1 do
begin
// switched src and dst
p1 := dst.scanline[y]; // src.scanline[y];
for x := 0 to w - 1 do
begin
dx := x - cx;
// Corrected from dy:=-(y-cx)
dy := (y - cy);
r := sqrt(sqr(dx) + sqr(dy));
sr := fr * sin(r / cx * amount * 2 * pi);
// Omitted the following check
// if (r + sr < cx) and (r + sr > 0) then
begin
a := arctan2(dy, dx);
sincos(a, sa, ca);
i := max(min(cx + round((r + sr) * ca), w - 1), 0);
j := max(min(cy + round((r + sr) * sa), h - 1), 0);
// switched src and dst
p2 := src.scanline[j];
c := x * bits;
ci := i * bits;
p1[c] := p2[ci];
p1[c + 1] := p2[ci + 1];
p1[c + 2] := p2[ci + 2];
end;
end;
end;
end;

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.

"Floating point overflow" error in Delphi code

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;

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.

Angle between two vectors

So, I'm trying to get the angle between two TPoints in Delphi, and it turns out to be harder then what I expected. The result I'm getting I can't explain (seems to be some problem with "to degrees"-part, or ArcTan2 does not return a sum in the form I expected.
- Delpi-v7:
function Modulo(x,y:Extended): Extended;
var d: Extended;
begin
d := x / y;
Result := (d - floor(d)) * y;
end;
function Degrees(Rads: Extended): Extended;
begin
Result := Rads*(180/Pi);
end;
function GetPointAngle(P1, P2: TPoint): Extended;
begin
Result := Modulo(Degrees(ArcTan2(-(P1.Y - P2.Y), P1.X - P2.X)) - 90, 360);
end;
Yet, when I port the code to Python, or test it in another Pascal-variant, the above works. But now, it seems to return a sum that's static (not changing if I "move" the second TPoint).
In case your wondering; I created "modulo"-function simply because the divide-operator used in the "mod"-operator rounds to 0, and not down (so negative numbers don't work).
Edit: I noted that the value (angle) returned from GetPointAngle() increases when p gets further away from the other point c (and vice versa), even tho the TPoint (p) is dragged along the X-axis of the second TPoint (c).
EDIT:
You guys have outdone your self, I've looked over most of the answers, and it seems to be hard to choose best answer! And since you guys wrote everything with such detail, I will go trough everything with the same detail :-)
Also: what I did not share in my initial post, is that my function is being exported as a DLL to be reached from another pascal-interpretor (which is delphi-compatible).
Solution at last (changed):
GetPointAngle(P1, P2: TPoint) To: GetPointAngle(const P1, P2: TPoint)
^ I don't understand the need of declaring constants...
I assume you want to calculate the angle relative to the X-axis of the line which is formed between those two points.
For this situation, the following formula applies:
Tan(a) = (P2.Y - P1.Y) / (P2.X - P1.X)
Which translates to:
a = ArcTan((P2.Y - P1.Y) / (P2.X - P1.X))
When the two points have the same X coordinate, this will obviously result in a EDivByZero exception, so you have to take care of that yourself. Furthermore, ArcTan results in an angle within the range 0°..90° (i.e. 0..π/2) and thus disregards the correct quadrant, while ArcTan2 results in an angle within -180°..180°. Add 360° to the result to convert a negative angle to positive:
function AngleOfLine(const P1, P2: TPoint): Double;
begin
if P2.X = P1.X then
if P2.Y > P1.Y then
Result := 90
else
Result := 270
else
Result := RadToDeg(ArcTan2(P2.Y - P1.Y, P2.X - P1.X));
if Result < 0 then
Result := Result + 360;
end;
Which results in:
A := AngleOfLine(Point(10, 10), Point(20, 10)); // 0
A := AngleOfLine(Point(10, 10), Point(20, 20)); // 45
A := AngleOfLine(Point(10, 10), Point(10, 20)); // 90
A := AngleOfLine(Point(10, 10), Point(0, 20)); // 135
A := AngleOfLine(Point(10, 10), Point(0, 10)); // 180
A := AngleOfLine(Point(10, 10), Point(0, 0)); // 225
A := AngleOfLine(Point(10, 10), Point(10, 0)); // 270
A := AngleOfLine(Point(10, 10), Point(20, 0)); // 315
Now, this is relative to the world coordinate system which has its positive Y-axis pointed upwards by default. If you want to convert the result to the device coordinate system wherein the positive Y-axis points downwards, then subtract the result from 360°:
Result := 360 - Result;
Update:
It seems ArcTan2 dóes take care of division by zero, (even in D7 inspite of the documentation) so the routine becomes much simpler:
function AngleOfLine(const P1, P2: TPoint): Double;
begin
Result := RadToDeg(ArcTan2((P2.Y - P1.Y),(P2.X - P1.X)));
if Result < 0 then
Result := Result + 360;
end;
Edit:
I noted that the value returned from GetPointAngle() increases when p gets furter away from the other point c (and vice versa).
That depends. Looking at the diagram above, if the second point moves further along the x-axis, the angle decreases. If the second point moves further along the y-axis, the angle increases. Of course, this depends on which quadrant both points are in.
Furthermore, your code negates the first parameter of ArcTan2 and subtracts another 90° from the result. I do not know what you mean by that and whether it is intentional, but it could be the source of unexpected results.
I presume what you are looking for is the angle between two vectors. That is θ in this diagram:
The algebraic dot product can be expressed geometrically as <v1,v2> = |v1||v2|cos θ. This can be rearranged to find θ = cos-1 <v1,v2>/(|v1||v2|).
function DotProduct(const v1, v2: TPoint): Integer;
begin
Result := v1.X*v2.X + v1.Y*v2.Y;
end;
function Magnitude(const v: TPoint): Double;
begin
Result := Sqrt(Sqr(v.X)+Sqr(v.Y));
end;
function AngleBetweenVectors(const v1, v2: TPoint): Double;
var
Magv1, Magv2: Double;
begin
Magv1 := Magnitude(v1);
Magv2 := Magnitude(v2);
if abs(Magv1*Magv2)=0.0 then
Result := 0.0
else
Result := ArcCos(EnsureRange(DotProduct(v1,v2)/(Magv1*Magv2), -1.0, 1.0));
end;
That returns an angle in radians. You can convert that into degrees using RadToDeg() from the Math unit.
Now, the other way to interpret your problem is that you want to take two points and form the line between then. And then find the angle between that line and the horizontal, say. As described by this diagram:
The can still be expressed as the angle between two vectors. The first vector is p2-p1 and the other is a vector in the horizontal direction, (0, 1). Feed those two into AngleBetweenVectors and you have your answer. If you want to measure angle to vertical, then you can use the same idea.
Hopefully there's enough here for you to solve the problem, whatever it actually is.
Following code returns same results with Delphi 7 and FPC 2.7.1 and it seems correct.
So main question is: what we are expecting and what we are having?
program Project2;
{$APPTYPE CONSOLE}
uses
Math;
{.$define speed}
function CalcAngle(const lx, ly: extended): extended; {$ifdef speed} inline; {$endif}
begin
Result := RadToDeg(ArcTan2(ly, lx));
end;
function Modulo(x, y: extended): extended; {$ifdef speed} inline; {$endif}
var
d: extended;
begin
d := x / y;
Result := (d - floor(d)) * y;
end;
function Degrees(Rads: Extended): Extended;
begin
Result := Rads*(180/Pi);
end;
function Modulo2(x: extended): extended; {$ifdef speed} inline; {$endif}
begin
if x < 0 then
Result := 360 + x
else
Result := x;
end;
function GetPointAngle(const lx, ly: integer): Extended;
begin
Result := Modulo(Degrees(ArcTan2(ly, lx)) - 90, 360);
end;
procedure OutTest(const lx, ly: extended);
var
a: extended;
begin
a := CalcAngle(lx, ly);
Writeln(
a: 10: 4,
Modulo(a - 90, 360):10:4,
GetPointAngle(round(lx), round(ly)):10:4);
end;
begin
OutTest(2, 0);
OutTest(0, 2);
OutTest(-2, 2);
OutTest(-2, -2);
OutTest(2, 3);
OutTest(100, 2);
Readln;
end.

Resources