Time for an 2014 update…
This commit is contained in:
Ingy döt Net
parent
372c577f83
commit
09687c4926
2520 changed files with 34227 additions and 7318 deletions
69
Task/Problem-of-Apollonius/PL-I/problem-of-apollonius.pli
Normal file
69
Task/Problem-of-Apollonius/PL-I/problem-of-apollonius.pli
Normal file
|
|
@ -0,0 +1,69 @@
|
|||
Apollonius: procedure options (main); /* 29 October 2013 */
|
||||
|
||||
define structure
|
||||
1 circle,
|
||||
2 x float (15),
|
||||
2 y float (15),
|
||||
2 radius float (15);
|
||||
|
||||
declare (c1 , c2, c3, result) type (circle);
|
||||
|
||||
c1.x = 0; c1.y = 0; c1.radius = 1;
|
||||
c2.x = 4; c2.y = 0; c2.radius = 1;
|
||||
c3.x = 2; c3.y = 4; c3.radius = 2;
|
||||
|
||||
result = Solve_Apollonius(c1, c2, c3, 1, 1, 1);
|
||||
put skip edit ('External tangent:', result.x, result.y, result.radius) (a, 3 f(12,8));
|
||||
|
||||
result = Solve_Apollonius(c1, c2, c3, -1, -1, -1);
|
||||
put skip edit ('Internal tangent:', result.x, result.y, result.radius) (a, 3 f(12,8));
|
||||
|
||||
|
||||
|
||||
Solve_Apollonius: procedure (c1, c2, c3, s1, s2, s3) returns(type(circle));
|
||||
declare (c1, c2, c3) type(circle);
|
||||
declare res type (circle);
|
||||
declare (s1, s2, s3) fixed binary;
|
||||
|
||||
declare (
|
||||
v11, v12, v13, v14,
|
||||
v21, v22, v23, v24,
|
||||
w12, w13, w14,
|
||||
w22, w23, w24,
|
||||
p, q, m, n, a, b, c, det) float (15);
|
||||
|
||||
v11 = 2*c2.x - 2*c1.x;
|
||||
v12 = 2*c2.y - 2*c1.y;
|
||||
v13 = c1.x**2 - c2.x**2 + c1.y**2 - c2.y**2 - c1.radius**2 + c2.radius**2;
|
||||
v14 = 2*s2*c2.radius - 2*s1*c1.radius;
|
||||
|
||||
v21 = 2*c3.x - 2*c2.x;
|
||||
v22 = 2*c3.y - 2*c2.y;
|
||||
v23 = c2.x**2 - c3.x**2 + c2.y**2 - c3.y**2 - c2.radius**2 + c3.radius**2;
|
||||
v24 = 2*s3*c3.radius - 2*s2*c2.radius;
|
||||
|
||||
w12 = v12/v11;
|
||||
w13 = v13/v11;
|
||||
w14 = v14/v11;
|
||||
|
||||
w22 = v22/v21-w12;
|
||||
w23 = v23/v21-w13;
|
||||
w24 = v24/v21-w14;
|
||||
|
||||
p = -w23/w22;
|
||||
q = w24/w22;
|
||||
m = -w12*P - w13;
|
||||
n = w14 - w12*q;
|
||||
|
||||
a = n*n + q*q - 1;
|
||||
b = 2*m*n - 2*n*c1.x + 2*p*q - 2*q*c1.y + 2*s1*c1.radius;
|
||||
c = c1.x**2 + m*m - 2*m*c1.x + p*p + c1.y**2 - 2*p*c1.y - c1.radius**2;
|
||||
|
||||
det = b*b - 4*a*c;
|
||||
res.radius = (-b-sqrt(det)) / (2*a);
|
||||
res.x = m + n*res.radius;
|
||||
res.y = p + q*res.radius;
|
||||
|
||||
return (res);
|
||||
end Solve_Apollonius;
|
||||
end Apollonius;
|
||||
|
|
@ -1,14 +1,12 @@
|
|||
/*REXX program to solve the problem of Apollonius, named after the */
|
||||
/* Greek, Apollonius of Perga [Pergaeus] (circa 262 BC ──► 190 BC).*/
|
||||
|
||||
w=15; numeric digits w /*width used to display numbers. */
|
||||
w=20; numeric digits w-5 /*width used to display numbers. */
|
||||
c1.x=0; c1.y=0; c1.r=1
|
||||
c2.x=4; c2.y=0; c2.r=1
|
||||
c3.x=2; c3.y=4; c3.r=2
|
||||
call tell 'external tangent:', solveApollonius( 1, 1, 1)
|
||||
call tell 'internal tangent:', solveApollonius(-1,-1,-1)
|
||||
exit /*stick a fork in it, we're done.*/
|
||||
|
||||
/*──────────────────────────────────SOLVEAPOLLONIUS subroutine──────────*/
|
||||
/*───────────────────this code should be covered with a very think tarp.*/
|
||||
solveApollonius: arg s1,s2,s3 /*internal or external tangent ? */
|
||||
|
|
@ -19,8 +17,8 @@ r1=c1.r; r2=c2.r; r3=c3.r
|
|||
va=2*x2-2*x1; vb=2*y2-2*y1; vc=x1*x1-x2*x2+y1*y1-y2*y2-r1*r1+r2*r2
|
||||
vd=2*s2*r2-2*s1*r1; ve=2*x3-2*x2; vf=2*y3-2*y2
|
||||
vg=x2*x2-x3*x3+y2*y2-y3*y3-r2*r2+r3*r3; vh=2*s3*r3-2*s2*r2
|
||||
vj=vb/va; vk=vc/va; vm=vd/va
|
||||
vn=vf/ve-vj; vp=vg/ve-vk; vr=vh/ve-vm;
|
||||
vj=vb/va; vk=vc/va; vm=vd/va
|
||||
vn=vf/ve-vj; vp=vg/ve-vk; vr=vh/ve-vm
|
||||
p=-vp/vn
|
||||
q= vr/vn
|
||||
m=-vj*p-vk
|
||||
|
|
@ -29,16 +27,15 @@ a=n*n+q*q-1
|
|||
b=2*m*n-2*n*x1+2*p*q-2*q*y1+2*s1*r1
|
||||
c=x1*x1+m*m-2*m*x1+p*p+y1*y1-2*p*y1-r1*r1
|
||||
_=b*b-4*a*c; $.r=(-b-sqrt(_))/(a+a); $.x=m+n*$.r; $.y=p+q*$.r
|
||||
return $.x $.y $.r /*return with the money. */
|
||||
|
||||
/*──────────────────────────────────SQRT subroutine──────────────────────────*/
|
||||
sqrt: procedure; parse arg x; if x=0 then return 0;d=digits();numeric digits 11
|
||||
g=.sqGuess(); do j=0 while p>9; m.j=p; p=p%2+1; end; do k=j+5 to 0 by -1
|
||||
if m.k>11 then numeric digits m.k;g=.5*(g+x/g);end;numeric digits d;return g/1
|
||||
|
||||
.sqGuess: if x<0 then say 'negative number' x; numeric form; m.=11
|
||||
p=d+d%4+2; parse value format(x,2,1,,0) 'E0' with g 'E' _ .; return g*.5'E'_%2
|
||||
|
||||
numeric digits digits()%3 /*reset DIGITS to the original.*/
|
||||
return $.x+0 $.y+0 $.r+0 /*return with 3 args, normalized.*/
|
||||
/*──────────────────────────────────SQRT subroutine─────────────────────*/
|
||||
sqrt: procedure; parse arg x; if x=0 then return 0; m.=9; p=digits(); i=
|
||||
numeric digits 9; if x<0 then do; x=-x; i='i'; end; numeric form; m.0=p
|
||||
parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'E'_%2; m.1=p
|
||||
do j=2 while p>9; m.j=p; p=p%2+1; end /*j*/
|
||||
do k=j+5 to 0 by -1; numeric digits m.k; g=.5*(g+x/g); end /*k*/
|
||||
numeric digits m.0; return (g/1)i
|
||||
/*──────────────────────────────────TELL subroutine─────────────────────*/
|
||||
tell: parse arg _,a b c; say _ left(a/1,w) left(b/1,w) left(c/1,w); return
|
||||
/*dividing by 1 reformats #s to W*/
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue