aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

tasks a-s

Browse source
This commit is contained in:
Ingy döt Net 2013-04-10 23:57:08 -07:00
parent 47bf37c096
commit b83f433714
12433 changed files with 156208 additions and 123 deletions
Download patch file Download diff file Expand all files Collapse all files

3
Task/Problem-of-Apollonius/0DESCRIPTION Normal file
View file

@ -0,0 +1,3 @@
Implement a solution to the Problem of Apollonius ([[wp:Problem_of_Apollonius|description on wikipedia]]) which is the problem of finding the circle that is tangent to three specified circles. There is an [[wp:Problem_of_Apollonius#Algebraic_solutions|algebraic solution]] which is pretty straightforward. The solutions to the example in the code are shown in the image (the red circle is "internally tangent" to all three black circles and the green circle is "externally tangent" to all three black circles).
[[File:Apollonius.png|200px|Two solutions to the problem of apollonius]]

2
Task/Problem-of-Apollonius/1META.yaml Normal file
View file

@ -0,0 +1,2 @@
---
note: arithmetic operations

17
Task/Problem-of-Apollonius/Ada/problem-of-apollonius-1.ada Normal file
View file

@ -0,0 +1,17 @@
package Apollonius is
type Point is record
X, Y : Long_Float := 0.0;
end record;
type Circle is record
Center : Point;
Radius : Long_Float := 0.0;
end record;
type Tangentiality is (External, Internal);
function Solve_CCC
(Circle_1, Circle_2, Circle_3 : Circle;
T1, T2, T3 : Tangentiality := External)
return Circle;
end Apollonius;

86
Task/Problem-of-Apollonius/Ada/problem-of-apollonius-2.ada Normal file
View file

@ -0,0 +1,86 @@
with Ada.Numerics.Generic_Elementary_Functions;
package body Apollonius is
package Math is new Ada.Numerics.Generic_Elementary_Functions
(Long_Float);
function Solve_CCC
(Circle_1, Circle_2, Circle_3 : Circle;
T1, T2, T3 : Tangentiality := External)
return Circle
is
S1 : Long_Float := 1.0;
S2 : Long_Float := 1.0;
S3 : Long_Float := 1.0;
X1 : Long_Float renames Circle_1.Center.X;
Y1 : Long_Float renames Circle_1.Center.Y;
R1 : Long_Float renames Circle_1.Radius;
X2 : Long_Float renames Circle_2.Center.X;
Y2 : Long_Float renames Circle_2.Center.Y;
R2 : Long_Float renames Circle_2.Radius;
X3 : Long_Float renames Circle_3.Center.X;
Y3 : Long_Float renames Circle_3.Center.Y;
R3 : Long_Float renames Circle_3.Radius;
begin
if T1 = Internal then
S1 := -S1;
end if;
if T2 = Internal then
S2 := -S2;
end if;
if T3 = Internal then
S3 := -S3;
end if;
declare
V11 : constant Long_Float := 2.0 * X2 - 2.0 * X1;
V12 : constant Long_Float := 2.0 * Y2 - 2.0 * Y1;
V13 : constant Long_Float :=
X1 * X1 - X2 * X2 + Y1 * Y1 - Y2 * Y2 - R1 * R1 + R2 * R2;
V14 : constant Long_Float := 2.0 * S2 * R2 - 2.0 * S1 * R1;
V21 : constant Long_Float := 2.0 * X3 - 2.0 * X2;
V22 : constant Long_Float := 2.0 * Y3 - 2.0 * Y2;
V23 : constant Long_Float :=
X2 * X2 - X3 * X3 + Y2 * Y2 - Y3 * Y3 - R2 * R2 + R3 * R3;
V24 : constant Long_Float := 2.0 * S3 * R3 - 2.0 * S2 * R2;
W12 : constant Long_Float := V12 / V11;
W13 : constant Long_Float := V13 / V11;
W14 : constant Long_Float := V14 / V11;
W22 : constant Long_Float := V22 / V21 - W12;
W23 : constant Long_Float := V23 / V21 - W13;
W24 : constant Long_Float := V24 / V21 - W14;
P : constant Long_Float := -W23 / W22;
Q : constant Long_Float := W24 / W22;
M : constant Long_Float := -W12 * P - W13;
N : constant Long_Float := W14 - W12 * Q;
A : constant Long_Float := N * N + Q * Q - 1.0;
B : constant Long_Float :=
2.0 * M * N -
2.0 * N * X1 +
2.0 * P * Q -
2.0 * Q * Y1 +
2.0 * S1 * R1;
C : constant Long_Float :=
X1 * X1 +
M * M -
2.0 * M * X1 +
P * P +
Y1 * Y1 -
2.0 * P * Y1 -
R1 * R1;
D : constant Long_Float := B * B - 4.0 * A * C;
RS : constant Long_Float := (-B - Math.Sqrt (D)) / (2.0 * A);
begin
return (Center => (X => M + N * RS, Y => P + Q * RS), Radius => RS);
end;
end Solve_CCC;
end Apollonius;

25
Task/Problem-of-Apollonius/Ada/problem-of-apollonius-3.ada Normal file
View file

@ -0,0 +1,25 @@
with Ada.Text_IO;
with Apollonius;
procedure Test_Apollonius is
use Apollonius;
package Long_Float_IO is new Ada.Text_IO.Float_IO (Long_Float);
C1 : constant Circle := (Center => (X => 0.0, Y => 0.0), Radius => 1.0);
C2 : constant Circle := (Center => (X => 4.0, Y => 0.0), Radius => 1.0);
C3 : constant Circle := (Center => (X => 2.0, Y => 4.0), Radius => 2.0);
R1 : Circle := Solve_CCC (C1, C2, C3, External, External, External);
R2 : Circle := Solve_CCC (C1, C2, C3, Internal, Internal, Internal);
begin
Ada.Text_IO.Put_Line ("R1:");
Long_Float_IO.Put (R1.Center.X, Aft => 3, Exp => 0);
Long_Float_IO.Put (R1.Center.Y, Aft => 3, Exp => 0);
Long_Float_IO.Put (R1.Radius, Aft => 3, Exp => 0);
Ada.Text_IO.New_Line;
Ada.Text_IO.Put_Line ("R2:");
Long_Float_IO.Put (R2.Center.X, Aft => 3, Exp => 0);
Long_Float_IO.Put (R2.Center.Y, Aft => 3, Exp => 0);
Long_Float_IO.Put (R2.Radius, Aft => 3, Exp => 0);
Ada.Text_IO.New_Line;
end Test_Apollonius;

37
Task/Problem-of-Apollonius/BBC-BASIC/problem-of-apollonius.bbc Normal file
View file

@ -0,0 +1,37 @@
DIM Circle{x, y, r}
DIM Circles{(2)} = Circle{}
Circles{(0)}.x = 0 : Circles{(0)}.y = 0 : Circles{(0)}.r = 1
Circles{(1)}.x = 4 : Circles{(1)}.y = 0 : Circles{(1)}.r = 1
Circles{(2)}.x = 2 : Circles{(2)}.y = 4 : Circles{(2)}.r = 2
@% = &2030A
REM Solution for internal circle:
PROCapollonius(Circle{}, Circles{()}, -1, -1, -1)
PRINT "Internal: x = ";Circle.x ", y = ";Circle.y ", r = ";Circle.r
REM Solution for external circle:
PROCapollonius(Circle{}, Circles{()}, 1, 1, 1)
PRINT "External: x = ";Circle.x ", y = ";Circle.y ", r = ";Circle.r
END
DEF PROCapollonius(c{}, c{()}, s0, s1, s2)
LOCAL x0, x1, x2, y0, y1, y2, r0, r1, r2, a, b, c
LOCAL u(), v(), w() : DIM u(2), v(2), w(2)
x0 = c{(0)}.x : y0 = c{(0)}.y : r0 = c{(0)}.r
x1 = c{(1)}.x : y1 = c{(1)}.y : r1 = c{(1)}.r
x2 = c{(2)}.x : y2 = c{(2)}.y : r2 = c{(2)}.r
u() = 2*y1-2*y0, x0*x0-x1*x1+y0*y0-y1*y1-r0*r0+r1*r1, 2*s1*r1-2*s0*r0
v() = 2*y2-2*y1, x1*x1-x2*x2+y1*y1-y2*y2-r1*r1+r2*r2, 2*s2*r2-2*s1*r1
w() = u() / (2*x1 - 2*x0)
u() = v() / (2*x2 - 2*x1) - w()
u() /= u(0)
w(1) -= w(0)*u(1)
w(2) -= w(0)*u(2)
a = w(2)*w(2) + u(2)*u(2) - 1
b = -2*w(1)*w(2) - 2*w(2)*x1 - 2*u(1)*u(2) - 2*u(2)*y1 + 2*s1*r1
c = x1*x1 + w(1)*w(1) + 2*w(1)*x1 + u(1)*u(1) + y1*y1 + 2*u(1)*y1 - r1*r1
c.r = (-b - SQR(b^2 - 4*a*c)) / (2*a)
c.x = c.r * w(2) - w(1)
c.y = c.r * u(2) - u(1)
ENDPROC

110
Task/Problem-of-Apollonius/C/problem-of-apollonius.c Normal file
View file

@ -0,0 +1,110 @@
#include <stdio.h>
#include <tgmath.h>
#define VERBOSE 0
#define for3 for(int i = 0; i < 3; i++)
typedef complex double vec;
typedef struct { vec c; double r; } circ;
#define re(x) creal(x)
#define im(x) cimag(x)
#define cp(x) re(x), im(x)
#define CPLX "(%6.3f,%6.3f)"
#define CPLX3 CPLX" "CPLX" "CPLX
double cross(vec a, vec b) { return re(a) * im(b) - im(a) * re(b); }
double abs2(vec a) { return a * conj(a); }
int apollonius_in(circ aa[], int ss[], int flip, int divert)
{
vec n[3], x[3], t[3], a, b, center;
int s[3], iter = 0, res = 0;
double diff = 1, diff_old = -1, axb, d, r;
for3 {
s[i] = ss[i] ? 1 : -1;
x[i] = aa[i].c;
}
while (diff > 1e-20) {
a = x[0] - x[2], b = x[1] - x[2];
diff = 0;
axb = -cross(a, b);
d = sqrt(abs2(a) * abs2(b) * abs2(a - b));
if (VERBOSE) {
const char *z = 1 + "-0+";
printf("%c%c%c|%c%c|",
z[s[0]], z[s[1]], z[s[2]], z[flip], z[divert]);
printf(CPLX3, cp(x[0]), cp(x[1]), cp(x[2]));
}
/* r and center represent an arc through points x[i]. Each step,
we'll deform this arc by pushing or pulling some point on it
towards the edge of each given circle. */
r = fabs(d / (2 * axb));
center = (abs2(a)*b - abs2(b)*a) / (2 * axb) * I + x[2];
/* maybe the "arc" is actually straight line; then we have two
choices in defining "push" and "pull", so try both */
if (!axb && flip != -1 && !divert) {
if (!d) { /* generally means circle centers overlap */
printf("Given conditions confused me.\n");
return 0;
}
if (VERBOSE) puts("\n[divert]");
divert = 1;
res = apollonius_in(aa, ss, -1, 1);
}
/* if straight line, push dir is its norm; else it's away from center */
for3 n[i] = axb ? aa[i].c - center : a * I * flip;
for3 t[i] = aa[i].c + n[i] / cabs(n[i]) * aa[i].r * s[i];
/* diff: how much tangent points have moved since last iteration */
for3 diff += abs2(t[i] - x[i]), x[i] = t[i];
if (VERBOSE) printf(" %g\n", diff);
/* keep an eye on the total diff: failing to converge means no solution */
if (diff >= diff_old && diff_old >= 0)
if (iter++ > 20) return res;
diff_old = diff;
}
printf("found: ");
if (axb) printf("circle "CPLX", r = %f\n", cp(center), r);
else printf("line "CPLX3"\n", cp(x[0]), cp(x[1]), cp(x[2]));
return res + 1;
}
int apollonius(circ aa[])
{
int s[3], i, sum = 0;
for (i = 0; i < 8; i++) {
s[0] = i & 1, s[1] = i & 2, s[2] = i & 4;
/* internal or external results of a zero-radius circle are the same */
if (s[0] && !aa[0].r) continue;
if (s[1] && !aa[1].r) continue;
if (s[2] && !aa[2].r) continue;
sum += apollonius_in(aa, s, 1, 0);
}
return sum;
}
int main()
{
circ a[3] = {{0, 1}, {4, 1}, {2 + 4 * I, 1}};
circ b[3] = {{-3, 2}, {0, 1}, {3, 2}};
circ c[3] = {{-2, 1}, {0, 1}, {2 * I, 1}};
//circ c[3] = {{0, 1}, {0, 2}, {0, 3}}; <-- a fun one
puts("set 1"); apollonius(a);
puts("set 2"); apollonius(b);
puts("set 3"); apollonius(c);
}

51
Task/Problem-of-Apollonius/CoffeeScript/problem-of-apollonius-1.coffeescript Normal file
View file

@ -0,0 +1,51 @@
class Circle
constructor: (@x, @y, @r) ->
apollonius = (c1, c2, c3, s1=1, s2=1, s3=1) ->
[x1, y1, r1] = [c1.x, c1.y, c1.r]
[x2, y2, r2] = [c2.x, c2.y, c2.r]
[x3, y3, r3] = [c3.x, c3.y, c3.r]
sq = (n) -> n*n
v11 = 2*x2 - 2*x1
v12 = 2*y2 - 2*y1
v13 = sq(x1) - sq(x2) + sq(y1) - sq(y2) - sq(r1) + sq(r2)
v14 = 2*s2*r2 - 2*s1*r1
v21 = 2*x3 - 2*x2
v22 = 2*y3 - 2*y2
v23 = sq(x2) - sq(x3) + sq(y2) - sq(y3) - sq(r2) + sq(r3)
v24 = 2*s3*r3 - 2*s2*r2
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 = sq(n) + sq(q) - 1
b = 2*m*n - 2*n*x1 + 2*p*q - 2*q*y1 + 2*s1*r1
c = sq(x1) + sq(m) - 2*m*x1 + sq(p) + sq(y1) - 2*p*y1 - sq(r1)
d = sq(b) - 4*a*c
rs = (-b - Math.sqrt(d)) / (2*a)
xs = m + n*rs
ys = p + q*rs
new Circle(xs, ys, rs)
console.log c1 = new Circle(0, 0, 1)
console.log c2 = new Circle(2, 4, 2)
console.log c3 = new Circle(4, 0, 1)
console.log apollonius(c1, c2, c3)
console.log apollonius(c1, c2, c3, -1, -1, -1)

6
Task/Problem-of-Apollonius/CoffeeScript/problem-of-apollonius-2.coffeescript Normal file
View file

@ -0,0 +1,6 @@
> coffee foo.coffee
{ x: 0, y: 0, r: 1 }
{ x: 2, y: 4, r: 2 }
{ x: 4, y: 0, r: 1 }
{ x: 2, y: 2.1, r: 3.9 }
{ x: 2, y: 0.8333333333333333, r: 1.1666666666666667 }

80
Task/Problem-of-Apollonius/D/problem-of-apollonius.d Normal file
View file

@ -0,0 +1,80 @@
import std.stdio, std.math;
immutable struct Circle { double x, y, r; }
enum Tangent { externally, internally }
/**
Solves the Problem of Apollonius (finding a circle tangent to three
other circles in the plane).
Params:
c1 = First circle of the problem.
c2 = Second circle of the problem.
c3 = Third circle of the problem.
t1 = How is the solution tangent (externally or internally) to c1.
t2 = How is the solution tangent (externally or internally) to c2.
t3 = How is the solution tangent (externally or internally) to c3.
Returns: The Circle that is tangent to c1, c2 and c3.
*/
pure nothrow Circle
solveApollonius(in Circle c1, in Circle c2, in Circle c3,
in Tangent t1, in Tangent t2, in Tangent t3) {
alias immutable(double) imd;
imd s1 = (t1 == Tangent.externally) ? 1.0 : -1.0;
imd s2 = (t2 == Tangent.externally) ? 1.0 : -1.0;
imd s3 = (t3 == Tangent.externally) ? 1.0 : -1.0;
imd v11 = 2 * c2.x - 2 * c1.x;
imd v12 = 2 * c2.y - 2 * c1.y;
imd v13 = c1.x ^^ 2 - c2.x ^^ 2 +
c1.y ^^ 2 - c2.y ^^ 2 -
c1.r ^^ 2 + c2.r ^^ 2;
imd v14 = 2 * s2 * c2.r - 2 * s1 * c1.r;
imd v21 = 2 * c3.x - 2 * c2.x;
imd v22 = 2 * c3.y - 2 * c2.y;
imd v23 = c2.x ^^ 2 - c3.x ^^ 2 +
c2.y ^^ 2 - c3.y ^^ 2 -
c2.r ^^ 2 + c3.r ^^ 2;
imd v24 = 2 * s3 * c3.r - 2 * s2 * c2.r;
imd w12 = v12 / v11;
imd w13 = v13 / v11;
imd w14 = v14 / v11;
imd w22 = v22 / v21 - w12;
imd w23 = v23 / v21 - w13;
imd w24 = v24 / v21 - w14;
imd P = -w23 / w22;
imd Q = w24 / w22;
imd M = -w12 * P - w13;
imd N = w14 - w12 * Q;
imd a = N * N + Q ^^ 2 - 1;
imd b = 2 * M * N - 2 * N * c1.x +
2 * P * Q - 2 * Q * c1.y +
2 * s1 * c1.r;
imd c = c1.x ^^ 2 + M ^^ 2 - 2 * M * c1.x +
P ^^ 2 + c1.y ^^ 2 - 2 * P * c1.y - c1.r ^^ 2;
// find a root of a quadratic equation.
// This requires the circle centers not to be e.g. colinear
imd D = b ^^ 2 - 4 * a * c;
imd rs = (-b - sqrt(D)) / (2 * a);
return Circle(M + N * rs, P + Q * rs, rs);
}
void main() {
immutable c1 = Circle(0.0, 0.0, 1.0);
immutable c2 = Circle(4.0, 0.0, 1.0);
immutable c3 = Circle(2.0, 4.0, 2.0);
alias Tangent.externally te;
writeln(solveApollonius(c1, c2, c3, te, te, te));
alias Tangent.internally ti;
writeln(solveApollonius(c1, c2, c3, ti, ti, ti));
}

72
Task/Problem-of-Apollonius/Fortran/problem-of-apollonius.f Normal file
View file

@ -0,0 +1,72 @@
program Apollonius
implicit none
integer, parameter :: dp = selected_real_kind(15)
type circle
real(dp) :: x
real(dp) :: y
real(dp) :: radius
end type
type(circle) :: c1 , c2, c3, r
c1 = circle(0.0, 0.0, 1.0)
c2 = circle(4.0, 0.0, 1.0)
c3 = circle(2.0, 4.0, 2.0)
write(*, "(a,3f12.8))") "External tangent:", SolveApollonius(c1, c2, c3, 1, 1, 1)
write(*, "(a,3f12.8))") "Internal tangent:", SolveApollonius(c1, c2, c3, -1, -1, -1)
contains
function SolveApollonius(c1, c2, c3, s1, s2, s3) result(res)
type(circle) :: res
type(circle), intent(in) :: c1, c2, c3
integer, intent(in) :: s1, s2, s3
real(dp) :: x1, x2, x3, y1, y2, y3, r1, r2, r3
real(dp) :: v11, v12, v13, v14
real(dp) :: v21, v22, v23, v24
real(dp) :: w12, w13, w14
real(dp) :: w22, w23, w24
real(dp) :: p, q, m, n, a, b, c, det
x1 = c1%x; x2 = c2%x; x3 = c3%x
y1 = c1%y; y2 = c2%y; y3 = c3%y
r1 = c1%radius; r2 = c2%radius; r3 = c3%radius
v11 = 2*x2 - 2*x1
v12 = 2*y2 - 2*y1
v13 = x1*x1 - x2*x2 + y1*y1 - y2*y2 - r1*r1 + r2*r2
v14 = 2*s2*r2 - 2*s1*r1
v21 = 2*x3 - 2*x2
v22 = 2*y3 - 2*y2
v23 = x2*x2 - x3*x3 + y2*y2 - y3*y3 - r2*r2 + r3*r3
v24 = 2*s3*r3 - 2*s2*r2
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*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
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
end function
end program

64
Task/Problem-of-Apollonius/Go/problem-of-apollonius.go Normal file
View file

@ -0,0 +1,64 @@
package main
import (
"fmt"
"math"
)
type circle struct {
x, y, r float64
}
func main() {
c1 := circle{0, 0, 1}
c2 := circle{4, 0, 1}
c3 := circle{2, 4, 2}
fmt.Println(ap(c1, c2, c3, true))
fmt.Println(ap(c1, c2, c3, false))
}
func ap(c1, c2, c3 circle, s bool) circle {
x1sq := c1.x * c1.x
y1sq := c1.y * c1.y
r1sq := c1.r * c1.r
x2sq := c2.x * c2.x
y2sq := c2.y * c2.y
r2sq := c2.r * c2.r
x3sq := c3.x * c3.x
y3sq := c3.y * c3.y
r3sq := c3.r * c3.r
v11 := 2 * (c2.x - c1.x)
v12 := 2 * (c2.y - c1.y)
v13 := x1sq - x2sq + y1sq - y2sq - r1sq + r2sq
v14 := 2 * (c2.r - c1.r)
v21 := 2 * (c3.x - c2.x)
v22 := 2 * (c3.y - c2.y)
v23 := x2sq - x3sq + y2sq - y3sq - r2sq + r3sq
v24 := 2 * (c3.r - c2.r)
if s {
v14 = -v14
v24 = -v24
}
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 := m*n - n*c1.x + p*q - q*c1.y
if s {
b -= c1.r
} else {
b += c1.r
}
b *= 2
c := x1sq + m*m - 2*m*c1.x + p*p + y1sq - 2*p*c1.y - r1sq
d := b*b - 4*a*c
rs := (-b - math.Sqrt(d)) / (2 * a)
return circle{m + n*rs, p + q*rs, rs}
}

75
Task/Problem-of-Apollonius/Haskell/problem-of-apollonius.hs Normal file
View file

@ -0,0 +1,75 @@
data Circle = Circle { x, y, r :: Double } deriving (Show, Eq)
data Tangent = Externally | Internally deriving Eq
{--
Solves the Problem of Apollonius (finding a circle tangent to three
other circles in the plane).
Params:
c1 = First circle of the problem.
c2 = Second circle of the problem.
c3 = Third circle of the problem.
t1 = How is the solution tangent (externally or internally) to c1.
t2 = How is the solution tangent (externally or internally) to c2.
t3 = How is the solution tangent (externally or internally) to c3.
Returns: The Circle that is tangent to c1, c2 and c3.
--}
solveApollonius :: Circle -> Circle -> Circle ->
Tangent -> Tangent -> Tangent ->
Circle
solveApollonius c1 c2 c3 t1 t2 t3 =
Circle (m + n * rs) (p + q * rs) rs
where
s1 = if t1 == Externally then 1.0 else -1.0
s2 = if t2 == Externally then 1.0 else -1.0
s3 = if t3 == Externally then 1.0 else -1.0
v11 = 2 * x c2 - 2 * x c1
v12 = 2 * y c2 - 2 * y c1
v13 = x c1 ^ 2 - x c2 ^ 2 +
y c1 ^ 2 - y c2 ^ 2 -
r c1 ^ 2 + r c2 ^ 2
v14 = 2 * s2 * r c2 - 2 * s1 * r c1
v21 = 2 * x c3 - 2 * x c2
v22 = 2 * y c3 - 2 * y c2
v23 = x c2 ^ 2 - x c3 ^ 2 +
y c2 ^ 2 - y c3 ^ 2 -
r c2 ^ 2 + r c3 ^ 2;
v24 = 2 * s3 * r c3 - 2 * s2 * r c2
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 ^ 2 - 1
b = 2 * m * n - 2 * n * x c1 +
2 * p * q - 2 * q * y c1 +
2 * s1 * r c1
c = x c1 ^ 2 + m ^ 2 - 2 * m * x c1 +
p ^ 2 + y c1 ^ 2 - 2 * p * y c1 - r c1 ^ 2
-- Find a root of a quadratic equation.
-- This requires the circle centers not to be e.g. colinear.
d = b ^ 2 - 4 * a * c
rs = (-b - sqrt d) / (2 * a)
main = do
let c1 = Circle 0.0 0.0 1.0
let c2 = Circle 4.0 0.0 1.0
let c3 = Circle 2.0 4.0 2.0
let te = Externally
print $ solveApollonius c1 c2 c3 te te te
let ti = Internally
print $ solveApollonius c1 c2 c3 ti ti ti

68
Task/Problem-of-Apollonius/Icon/problem-of-apollonius.icon Normal file
View file

@ -0,0 +1,68 @@
link graphics
record circle(x,y,r)
global scale,xoffset,yoffset,yadjust
procedure main()
WOpen("size=400,400") | stop("Unable to open Window")
scale := 28
xoffset := WAttrib("width") / 2
yoffset := ( yadjust := WAttrib("height")) / 2
WC(c1 := circle(0,0,1),"black")
WC(c2 := circle(4,0,1),"black")
WC(c3 := circle(2,4,2),"black")
WC(c4 := Apollonius(c1,c2,c3,1,1,1),"green") #/ Expects "Circle[x=2.00,y=2.10,r=3.90]" (green circle in image)
WC(c5 := Apollonius(c1,c2,c3,-1,-1,-1),"red") #/ Expects "Circle[x=2.00,y=0.83,r=1.17]" (red circle in image)
WAttrib("fg=blue")
DrawLine( 0*scale+xoffset, yadjust-(-1*scale+yoffset), 0*scale+xoffset, yadjust-(4*scale+yoffset) )
DrawLine( -1*scale+xoffset, yadjust-(0*scale+yoffset), 4*scale+xoffset, yadjust-(0*scale+yoffset) )
WDone()
end
procedure WC(c,fg) # write and plot circle
WAttrib("fg="||fg)
DrawCircle(c.x*scale+xoffset, yadjust-(c.y*scale+yoffset), c.r*scale)
return write("Circle(x,y,r) := (",c.x,", ",c.y,", ",c.r,")")
end
procedure Apollonius(c1,c2,c3,s1,s2,s3) # solve Apollonius
v11 := 2.*(c2.x - c1.x)
v12 := 2.*(c2.y - c1.y)
v13 := c1.x^2 - c2.x^2 + c1.y^2 - c2.y^2 - c1.r^2 + c2.r^2
v14 := 2.*(s2*c2.r - s1*c1.r)
v21 := 2.*(c3.x - c2.x)
v22 := 2.*(c3.y - c2.y)
v23 := c2.x^2 - c3.x^2 + c2.y^2 - c3.y^2 - c2.r^2 + c3.r^2
v24 := 2.*(s3*c3.r - s2*c2.r)
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.r
c := c1.x*c1.x + M*M - 2*M*c1.x + P*P + c1.y*c1.y - 2*P*c1.y - c1.r*c1.r
#// Find a root of a quadratic equation. This requires the circle centers not to be e.g. colinear
D := b*b-4*a*c
rs := (-b-sqrt(D))/(2*a)
xs := M + N * rs
ys := P + Q * rs
return circle(xs,ys,rs)
end

19
Task/Problem-of-Apollonius/J/problem-of-apollonius-1.j Normal file
View file

@ -0,0 +1,19 @@
require 'math/misc/amoeba'
NB.*apollonius v solves Apollonius problems
NB. y is Cx0 Cy0 R0, Cx1 Cy1 R1,: Cx2 Cy2 R2
NB. x are radius scale factors to control which circles are included
NB. in the common tangent circle. 1 to surround, _1 to exclude.
NB. returns Cxs Cys Rs
apollonius =: verb define"1 _
1 apollonius y
:
centers=. 2{."1 y
radii=. x * {:"1 y
goal=. 1e_20 NB. goal simplex volume
dist=. radii + [: +/"1&.:*: centers -"1 ] NB. distances to tangents
'soln err'=. ([: +/@:*:@, -/~@dist) f. amoeba goal centers
if. err > 10 * goal do. '' return. end. NB. no solution found
avg=. +/ % #
(, avg@dist) soln
)

7
Task/Problem-of-Apollonius/J/problem-of-apollonius-2.j Normal file
View file

@ -0,0 +1,7 @@
]rctst=: 0 0 1,4 0 1,:2 4 2 NB. Task circles
0 0 1
4 0 1
2 4 2
(_1 _1 _1 ,: 1 1 1) apollonius rctst NB. internally & externally tangent solutions
2 0.83333333 1.1666667
2 2.1 3.9

93
Task/Problem-of-Apollonius/Java/problem-of-apollonius.java Normal file
View file

@ -0,0 +1,93 @@
public class Circle
{
public double[] center;
public double radius;
public Circle(double[] center, double radius)
{
this.center = center;
this.radius = radius;
}
public String toString()
{
return String.format("Circle[x=%.2f,y=%.2f,r=%.2f]",center[0],center[1],
radius);
}
}
public class ApolloniusSolver
{
/** Solves the Problem of Apollonius (finding a circle tangent to three other
* circles in the plane). The method uses approximately 68 heavy operations
* (multiplication, division, square-roots).
* @param c1 One of the circles in the problem
* @param c2 One of the circles in the problem
* @param c3 One of the circles in the problem
* @param s1 An indication if the solution should be externally or internally
* tangent (+1/-1) to c1
* @param s2 An indication if the solution should be externally or internally
* tangent (+1/-1) to c2
* @param s3 An indication if the solution should be externally or internally
* tangent (+1/-1) to c3
* @return The circle that is tangent to c1, c2 and c3.
*/
public static Circle solveApollonius(Circle c1, Circle c2, Circle c3, int s1,
int s2, int s3)
{
float x1 = c1.center[0];
float y1 = c1.center[1];
float r1 = c1.radius;
float x2 = c2.center[0];
float y2 = c2.center[1];
float r2 = c2.radius;
float x3 = c3.center[0];
float y3 = c3.center[1];
float r3 = c3.radius;
//Currently optimized for fewest multiplications. Should be optimized for
//readability
float v11 = 2*x2 - 2*x1;
float v12 = 2*y2 - 2*y1;
float v13 = x1*x1 - x2*x2 + y1*y1 - y2*y2 - r1*r1 + r2*r2;
float v14 = 2*s2*r2 - 2*s1*r1;
float v21 = 2*x3 - 2*x2;
float v22 = 2*y3 - 2*y2;
float v23 = x2*x2 - x3*x3 + y2*y2 - y3*y3 - r2*r2 + r3*r3;
float v24 = 2*s3*r3 - 2*s2*r2;
float w12 = v12/v11;
float w13 = v13/v11;
float w14 = v14/v11;
float w22 = v22/v21-w12;
float w23 = v23/v21-w13;
float w24 = v24/v21-w14;
float P = -w23/w22;
float Q = w24/w22;
float M = -w12*P-w13;
float N = w14 - w12*Q;
float a = N*N + Q*Q - 1;
float b = 2*M*N - 2*N*x1 + 2*P*Q - 2*Q*y1 + 2*s1*r1;
float c = x1*x1 + M*M - 2*M*x1 + P*P + y1*y1 - 2*P*y1 - r1*r1;
// Find a root of a quadratic equation. This requires the circle centers not
// to be e.g. colinear
float D = b*b-4*a*c;
float rs = (-b-Math.sqrt(D))/(2*a);
float xs = M + N * rs;
float ys = P + Q * rs;
return new Circle(new double[]{xs,ys}, rs);
}
public static void main(final String[] args)
{
Circle c1 = new Circle(new double[]{0,0}, 1);
Circle c2 = new Circle(new double[]{4,0}, 1);
Circle c3 = new Circle(new double[]{2,4}, 2);
// Expects "Circle[x=2.00,y=2.10,r=3.90]" (green circle in image)
System.out.println(solveApollonius(c1,c2,c3,1,1,1));
// Expects "Circle[x=2.00,y=0.83,r=1.17]" (red circle in image)
System.out.println(solveApollonius(c1,c2,c3,-1,-1,-1));
}
}

54
Task/Problem-of-Apollonius/Liberty-BASIC/problem-of-apollonius.liberty Normal file
View file

@ -0,0 +1,54 @@
circle1$ =" 0.000, 0.000, 1.000"
circle2$ =" 4.000, 0.000, 1.000"
circle3$ =" 2.000, 4.000, 2.000"
print " x_pos y_pos radius"
print circle1$
print circle2$
print circle3$
print
print ApolloniusSolver$( circle1$, circle2$, circle3$, 1, 1, 1)
print ApolloniusSolver$( circle1$, circle2$, circle3$, -1, -1, -1)
end
function ApolloniusSolver$( c1$, c2$, c3$, s1, s2, s3)
x1 =val( word$( c1$, 1, ",")): y1 =val( word$( c1$, 2, ",")): r1 =val( word$( c1$, 3, ","))
x2 =val( word$( c2$, 1, ",")): y2 =val( word$( c2$, 2, ",")): r2 =val( word$( c2$, 3, ","))
x3 =val( word$( c3$, 1, ",")): y3 =val( word$( c3$, 2, ",")): r3 =val( word$( c3$, 3, ","))
v11 = 2 *x2 -2 *x1
v12 = 2 *y2 -2*y1
v13 = x1 *x1 - x2 *x2 + y1 *y1 - y2 *y2 -r1 *r1 +r2 *r2
v14 = 2 *s2 *r2 -2 *s1 *r1
v21 = 2 *x3 -2 *x2
v22 = 2 *y3 -2*y2
v23 = x2 *x2 -x3 *x3 + y2 *y2 -y3 *y3 -r2 *r2 +r3 *r3
v24 = 2 *s3 *r3 - 2 *s2 *r2
w12 = v12 /v11
w13 = v13 /v11
w14 = v14 /v11
w22 = v22 /v21 -w12
w23 = v23 /v21 -w13
w24 = v24 /v21 -w14
P = 0 -w23 /w22
Q = w24 /w22
M = 0 -w12 *P -w13
N = w14 -w12 *Q
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
D = b *b -4 *a *c
Radius =( 0 -b -Sqr( D)) /( 2 *a)
XPos =M +N *Radius
YPos =P +Q *Radius
ApolloniusSolver$ =using( "###.###", XPos) +"," +using( "###.###", YPos) +using( "###.###", Radius)
end function

42
Task/Problem-of-Apollonius/MUMPS/problem-of-apollonius.mumps Normal file
View file

@ -0,0 +1,42 @@
APOLLONIUS(CIR1,CIR2,CIR3,S1,S2,S3)
;Circles are passed in as strings with three parts with a "^" separator in the order x^y^r
;The three circles are CIR1, CIR2, and CIR3
;The S1, S2, and S3 parameters determine if the solution will be internally or externally
;tangent to the circle. (+1 external, -1 internal)
;CIRR is the circle returned in the same format as the input circles
;
;Xn, Yn, and Rn are the values for a circle n - following the precedents from the
;other examples because doing $Pieces would make this confusing to read
NEW X1,X2,X3,Y1,Y2,Y3,R1,R2,R3,RS,V11,V12,V13,V14,V21,V22,V23,V24,W12,W13,W14,W22,W23,W24,P,M,N,Q,A,B,C,D
NEW CIRR
SET X1=$PIECE(CIR1,"^",1),X2=$PIECE(CIR2,"^",1),X3=$PIECE(CIR3,"^",1)
SET Y1=$PIECE(CIR1,"^",2),Y2=$PIECE(CIR2,"^",2),Y3=$PIECE(CIR3,"^",2)
SET R1=$PIECE(CIR1,"^",3),R2=$PIECE(CIR2,"^",3),R3=$PIECE(CIR3,"^",3)
SET V11=(2*X2)-(2*X1)
SET V12=(2*Y2)-(2*Y1)
SET V13=(X1*X1)-(X2*X2)+(Y1*Y1)-(Y2*Y2)-(R1*R1)+(R2*R2)
SET V14=(2*S2*R2)-(2*S1*R1)
SET V21=(2*X3)-(2*X2)
SET V22=(2*Y3)-(2*Y2)
SET V23=(X2*X2)-(X3*X3)+(Y2*Y2)-(Y3*Y3)-(R2*R2)+(R3*R3)
SET V24=(2*S3*R3)-(2*S2*R2)
SET W12=V12/V11
SET W13=V13/V11
SET W14=V14/V11
SET W22=(V22/V21)-W12 ;Parentheses for insurance - MUMPS evaluates left to right
SET W23=(V23/V21)-W13
SET W24=(V24/V21)-W14
SET P=-W23/W22
SET Q=W24/W22
SET M=-(W12*P)-W13
SET N=W14-(W12*Q)
SET A=(N*N)+(Q*Q)-1
SET B=(2*M*N)-(2*N*X1)+(2*P*Q)-(2*Q*Y1)+(2*S1*R1)
SET C=(X1*X1)+(M*M)+(2*M*X1)+(P*P)+(Y1*Y1)-(2*P*Y1)-(R1*R1)
SET D=(B*B)-(4*A*C)
SET RS=(-B-(D**.5))/(2*A)
SET $PIECE(CIRR,"^",1)=M+(N*RS)
SET $PIECE(CIRR,"^",2)=P+(Q*RS)
SET $PIECE(CIRR,"^",3)=RS
KILL X1,X2,X3,Y1,Y2,Y3,R1,R2,R3,RS,V11,V12,V13,V14,V21,V22,V23,V24,W12,W13,W14,W22,W23,W24,P,M,N,Q,A,B,C,D
QUIT CIRR

27
Task/Problem-of-Apollonius/Mathematica/problem-of-apollonius.math Normal file
View file

@ -0,0 +1,27 @@
Apolonius[a1_,b1_,c1_,a2_,b2_,c2_,a3_,b3_,c3_,S1_,S2_ ,S3_ ]:=
Module[{x1=a1,y1=b1,r1=c1,x2=a2,y2=b2,r2=c2,x3=a3,y3=b3,r3=c3,s1=S1,s2=S2,s3=S3},
v11 = 2*x2 - 2*x1; v12 = 2*y2 - 2*y1;
v13 = x1^2 - x2^2 + y1^2 - y2^2 - r1^2 + r2^2;
v14 = 2*s2*r2 - 2*s1*r1;
v21 = 2*x3-2*x2 ; v22 = 2*y3 - 2*y2;
v23 = x2^2 - x3^2 + y2^2 - y3^2 - r2^2 + r3^2;
v24 = 2*s3*r3 - 2*s2*r2;
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^2 + q^2-1;
b = 2*m*n - 2*n*x1 + 2*p*q - 2*q*y1 + 2*s1*r1;
c = x1^2+m^2 - 2*m*x1 + p^2+y1^2 - 2*p*y1 - r1^2;
d= b^2 - 4*a*c;
rs = (-b -Sqrt[d])/(2*a);
xs = m + n*rs; ys = p + q*rs;
Map[N,{xs, ys, rs} ]]

76
Task/Problem-of-Apollonius/OCaml/problem-of-apollonius.ocaml Normal file
View file

@ -0,0 +1,76 @@
type point = { x:float; y:float }
type circle = {
center: point;
radius: float;
}
let new_circle ~x ~y ~r =
{ center = { x=x; y=y };
radius = r }
let print_circle ~c =
Printf.printf "Circle(x=%.2f, y=%.2f, r=%.2f)\n"
c.center.x c.center.y c.radius
let defxyr c =
(c.center.x,
c.center.y,
c.radius)
let solve_apollonius ~c1 ~c2 ~c3
~s1 ~s2 ~s3 =
let ( * ) = ( *. ) in
let ( / ) = ( /. ) in
let ( + ) = ( +. ) in
let ( - ) = ( -. ) in
let x1, y1, r1 = defxyr c1
and x2, y2, r2 = defxyr c2
and x3, y3, r3 = defxyr c3 in
let v11 = 2.0 * x2 - 2.0 * x1
and v12 = 2.0 * y2 - 2.0 * y1
and v13 = x1*x1 - x2*x2 + y1*y1 - y2*y2 - r1*r1 + r2*r2
and v14 = (2.0 * s2 * r2) - (2.0 * s1 * r1)
and v21 = 2.0 * x3 - 2.0 * x2
and v22 = 2.0 * y3 - 2.0 * y2
and v23 = x2*x2 - x3*x3 + y2*y2 - y3*y3 - r2*r2 + r3*r3
and v24 = (2.0 * s3 * r3) - (2.0 * s2 * r2) in
let w12 = v12 / v11
and w13 = v13 / v11
and w14 = v14 / v11 in
let w22 = v22 / v21 - w12
and w23 = v23 / v21 - w13
and w24 = v24 / v21 - w14 in
let p = -. w23 / w22
and q = w24 / w22 in
let m = -. w12 * p - w13
and n = w14 - w12 * q in
let a = n*n + q*q - 1.0
and b = 2.0*m*n - 2.0*n*x1 + 2.0*p*q - 2.0*q*y1 + 2.0*s1*r1
and c = x1*x1 + m*m - 2.0*m*x1 + p*p + y1*y1 - 2.0*p*y1 - r1*r1 in
let d = b * b - 4.0 * a * c in
let rs = (-. b - (sqrt d)) / (2.0 * a) in
let xs = m + n * rs
and ys = p + q * rs in
(new_circle xs ys rs)
let () =
let c1 = new_circle 0.0 0.0 1.0
and c2 = new_circle 4.0 0.0 1.0
and c3 = new_circle 2.0 4.0 2.0 in
let r1 = solve_apollonius c1 c2 c3 1.0 1.0 1.0 in
print_circle r1;
let r2 = solve_apollonius c1 c2 c3 (-1.) (-1.) (-1.) in
print_circle r2;
;;

53
Task/Problem-of-Apollonius/Perl-6/problem-of-apollonius.pl6 Normal file
View file

@ -0,0 +1,53 @@
class Circle {
has $.x;
has $.y;
has $.r;
method gist { "circle($!x, $!y, $!r)" }
}
sub circle($x,$y,$r) { Circle.new: :$x, :$y, :$r }
sub postfix:<²>($x) { $x * $x }
sub solve-Apollonius([\c1, \c2, \c3], [\s1, \s2, \s3]) {
my \𝑣11 = 2 * c2.x - 2 * c1.x;
my \𝑣12 = 2 * c2.y - 2 * c1.y;
my \𝑣13 = c1.x² - c2.x² + c1.y² - c2.y² - c1.r² + c2.r²;
my \𝑣14 = 2 * s2 * c2.r - 2 * s1 * c1.r;
my \𝑣21 = 2 * c3.x - 2 * c2.x;
my \𝑣22 = 2 * c3.y - 2 * c2.y;
my \𝑣23 = c2.x² - c3.x² + c2.y² - c3.y² - c2.r² + c3.r²;
my \𝑣24 = 2 * s3 * c3.r - 2 * s2 * c2.r;
my \𝑤12 = 𝑣12 / 𝑣11;
my \𝑤13 = 𝑣13 / 𝑣11;
my \𝑤14 = 𝑣14 / 𝑣11;
my \𝑤22 = 𝑣22 / 𝑣21 - 𝑤12;
my \𝑤23 = 𝑣23 / 𝑣21 - 𝑤13;
my \𝑤24 = 𝑣24 / 𝑣21 - 𝑤14;
my \𝑃 = -𝑤23 / 𝑤22;
my \𝑄 = 𝑤24 / 𝑤22;
my \𝑀 = -𝑤12 * 𝑃 - 𝑤13;
my \𝑁 = 𝑤14 - 𝑤12 * 𝑄;
my \𝑎 = 𝑁² + 𝑄² - 1;
my \𝑏 = 2 * 𝑀 * 𝑁 - 2 * 𝑁 * c1.x + 2 * 𝑃 * 𝑄 - 2 * 𝑄 * c1.y + 2 * s1 * c1.r;
my \𝑐 = c1.x² + 𝑀² - 2 * 𝑀 * c1.x + 𝑃² + c1.y² - 2 * 𝑃 * c1.y - c1.r²;
my \𝐷 = 𝑏² - 4 * 𝑎 * 𝑐;
my \rs = (-𝑏 - sqrt 𝐷) / (2 * 𝑎);
my \xs = 𝑀 + 𝑁 * rs;
my \ys = 𝑃 + 𝑄 * rs;
circle(xs, ys, rs);
}
sub MAIN {
my @c = circle(0, 0, 1), circle(4, 0, 1), circle(2, 4, 2);
say solve-Apollonius @c, <1 1 1>;
say solve-Apollonius @c, <-1 -1 -1>;
}

74
Task/Problem-of-Apollonius/PureBasic/problem-of-apollonius.purebasic Normal file
View file

@ -0,0 +1,74 @@
Structure Circle
XPos.f
YPos.f
Radius.f
EndStructure
Procedure ApolloniusSolver(*c1.Circle,*c2.Circle,*c3.Circle, s1, s2, s3)
Define.f ; This tells the compiler that all non-specified new variables
; should be of float type (.f).
x1=*c1\XPos: y1=*c1\YPos: r1=*c1\Radius
x2=*c2\XPos: y2=*c2\YPos: r2=*c2\Radius
x3=*c3\XPos: y3=*c3\YPos: r3=*c3\Radius
v11 = 2*x2 - 2*x1
v12 = 2*y2 - 2*y1
v13 = x1*x1 - x2*x2 + y1*y1 - y2*y2 - r1*r1 + r2*r2
v14 = 2*s2*r2 - 2*s1*r1
v21 = 2*x3 - 2*x2
v22 = 2*y3 - 2*y2
v23 = x2*x2 - x3*x3 + y2*y2 - y3*y3 - r2*r2 + r3*r3
v24 = 2*s3*r3 - 2*s2*r2
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*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
D= b*b - 4*a*c
Define *result.Circle=AllocateMemory(SizeOf(Circle))
; Allocate memory for a returned Structure of type Circle.
; This memory should be freed later but if not, PureBasic’s
; internal framework will do so when the program shuts down.
If *result
*result\Radius=(-b-Sqr(D))/(2*a)
*result\XPos =M+N * *result\Radius
*result\YPos =P+Q * *result\Radius
EndIf
ProcedureReturn *result ; Sending back a pointer
EndProcedure
If OpenConsole()
Define.Circle c1, c2, c3
Define *c.Circle ; '*c' is defined as a pointer to a circle-structure.
c1\Radius=1
c2\XPos=4: c2\Radius=1
c3\XPos=2: c3\YPos=4: c3\Radius=2
*c=ApolloniusSolver(@c1, @c2, @c3, 1, 1, 1)
If *c ; Verify that *c got allocated
PrintN("Circle [x="+StrF(*c\XPos,2)+", y="+StrF(*c\YPos,2)+", r="+StrF(*c\Radius,2)+"]")
FreeMemory(*c) ; We are done with *c for the first calculation
EndIf
*c=ApolloniusSolver(@c1, @c2, @c3,-1,-1,-1)
If *c
PrintN("Circle [x="+StrF(*c\XPos,2)+", y="+StrF(*c\YPos,2)+", r="+StrF(*c\Radius,2)+"]")
FreeMemory(*c)
EndIf
Print("Press ENTER to exit"): Input()
EndIf

56
Task/Problem-of-Apollonius/Python/problem-of-apollonius.py Normal file
View file

@ -0,0 +1,56 @@
from collections import namedtuple
import math
Circle = namedtuple('Circle', 'x, y, r')
def solveApollonius(c1, c2, c3, s1, s2, s3):
'''
>>> solveApollonius((0, 0, 1), (4, 0, 1), (2, 4, 2), 1,1,1)
Circle(x=2.0, y=2.1, r=3.9)
>>> solveApollonius((0, 0, 1), (4, 0, 1), (2, 4, 2), -1,-1,-1)
Circle(x=2.0, y=0.8333333333333333, r=1.1666666666666667)
'''
x1, y1, r1 = c1
x2, y2, r2 = c2
x3, y3, r3 = c3
v11 = 2*x2 - 2*x1
v12 = 2*y2 - 2*y1
v13 = x1*x1 - x2*x2 + y1*y1 - y2*y2 - r1*r1 + r2*r2
v14 = 2*s2*r2 - 2*s1*r1
v21 = 2*x3 - 2*x2
v22 = 2*y3 - 2*y2
v23 = x2*x2 - x3*x3 + y2*y2 - y3*y3 - r2*r2 + r3*r3
v24 = 2*s3*r3 - 2*s2*r2
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*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
# Find a root of a quadratic equation. This requires the circle centers not to be e.g. colinear
D = b*b-4*a*c
rs = (-b-math.sqrt(D))/(2*a)
xs = M+N*rs
ys = P+Q*rs
return Circle(xs, ys, rs)
if __name__ == '__main__':
c1, c2, c3 = Circle(0, 0, 1), Circle(4, 0, 1), Circle(2, 4, 2)
print(solveApollonius(c1, c2, c3, 1, 1, 1)) #Expects "Circle[x=2.00,y=2.10,r=3.90]" (green circle in image)
print(solveApollonius(c1, c2, c3, -1, -1, -1)) #Expects "Circle[x=2.00,y=0.83,r=1.17]" (red circle in image)

44
Task/Problem-of-Apollonius/REXX/problem-of-apollonius.rexx Normal file
View file

@ -0,0 +1,44 @@
/*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. */
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 ? */
numeric digits digits()*3 /*reduce rounding: use triple dig*/
x1=c1.x; x2=c2.x; x3=c3.x
y1=c1.y; y2=c2.y; y3=c3.y
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;
p=-vp/vn
q= vr/vn
m=-vj*p-vk
n=vm-vj*q
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
/*──────────────────────────────────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*/

54
Task/Problem-of-Apollonius/Ruby/problem-of-apollonius.rb Normal file
View file

@ -0,0 +1,54 @@
class Circle
def initialize(x, y, r)
@x, @y, @r = [x, y, r].map(&:to_f)
end
attr_reader :x, :y, :r
def self.apollonius(c1, c2, c3, s1=1, s2=1, s3=1)
x1, y1, r1 = [c1.x, c1.y, c1.r]
x2, y2, r2 = [c2.x, c2.y, c2.r]
x3, y3, r3 = [c3.x, c3.y, c3.r]
v11 = 2*x2 - 2*x1
v12 = 2*y2 - 2*y1
v13 = x1**2 - x2**2 + y1**2 - y2**2 - r1**2 + r2**2
v14 = 2*s2*r2 - 2*s1*r1
v21 = 2*x3 - 2*x2
v22 = 2*y3 - 2*y2
v23 = x2**2 - x3**2 + y2**2 - y3**2 - r2**2 + r3**2
v24 = 2*s3*r3 - 2*s2*r2
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**2 + q**2 - 1
b = 2*m*n - 2*n*x1 + 2*p*q - 2*q*y1 + 2*s1*r1
c = x1**2 + m**2 - 2*m*x1 + p**2 + y1**2 - 2*p*y1 - r1**2
d = b**2 - 4*a*c
rs = (-b - Math.sqrt(d)) / (2*a)
xs = m + n*rs
ys = p + q*rs
return self.new(xs, ys, rs)
end
end
p c1 = Circle.new(0, 0, 1)
p c2 = Circle.new(2, 4, 2)
p c3 = Circle.new(4, 0, 1)
p Circle.apollonius(c1, c2, c3)
p Circle.apollonius(c1, c2, c3, -1, -1, -1)

81
Task/Problem-of-Apollonius/Scala/problem-of-apollonius.scala Normal file
View file

@ -0,0 +1,81 @@
object ApolloniusSolver extends App {
case class Circle(x: Double, y: Double, r: Double)
object Tangent extends Enumeration {
type Tangent = Value
val intern = Value(-1)
val extern = Value(1)
}
import Tangent._
import scala.Math._
val solveApollonius: (Circle, Circle, Circle, Triple[Tangent, Tangent, Tangent]) => Circle = (c1, c2, c3, tangents) => {
val fv: (Circle, Circle, Int, Int) => Tuple4[Double, Double, Double, Double] = (c1, c2, s1, s2) => {
val v11 = 2 * c2.x - 2 * c1.x
val v12 = 2 * c2.y - 2 * c1.y
val v13 = pow(c1.x, 2) - pow(c2.x, 2) + pow(c1.y, 2) - pow(c2.y, 2) - pow(c1.r, 2) + pow(c2.r, 2)
val v14 = 2 * s2 * c2.r - 2 * s1 * c1.r
Tuple4(v11, v12, v13, v14)
}
val (s1, s2, s3) = (tangents._1.id, tangents._2.id, tangents._3.id)
val (v11, v12, v13, v14) = fv(c1, c2, s1, s2)
val (v21, v22, v23, v24) = fv(c2, c3, s2, s3)
val w12 = v12 / v11
val w13 = v13 / v11
val w14 = v14 / v11
val w22 = v22 / v21 - w12
val w23 = v23 / v21 - w13
val w24 = v24 / v21 - w14
val P = -w23 / w22
val Q = w24 / w22
val M = -w12 * P - w13
val N = w14 - w12 * Q
val a = N*N + Q*Q - 1
val b = 2*M*N - 2*N*c1.x +
2*P*Q - 2*Q*c1.y +
2*s1*c1.r
val c = pow(c1.x, 2) + M*M - 2*M*c1.x +
P*P + pow(c1.y, 2) - 2*P*c1.y - pow(c1.r, 2)
// Find a root of a quadratic equation. This requires the circle centers not to be e.g. colinear
val D = b*b - 4*a*c
val rs = (-b - sqrt(D)) / (2*a)
Circle(x=M + N*rs, y=P + Q*rs, r=rs)
}
val c1 = Circle(x=0.0, y=0.0, r=1.0)
val c2 = Circle(x=4.0, y=0.0, r=1.0)
val c3 = Circle(x=2.0, y=4.0, r=2.0)
println("c1: "+c1)
println("c2: "+c2)
println("c3: "+c3)
println{
val tangents = Triple(intern, intern, intern)
"red circle: tangents="+tangents+" cs=" + solveApollonius(c1, c2, c3, tangents)
}
println{
val tangents = Triple(extern, extern, extern)
"green circle: tangents="+tangents+" cs=" + solveApollonius(c1, c2, c3, tangents)
}
println("all combinations:")
for ( ti <- Tangent.values)
for ( tj <- Tangent.values)
for ( tk <- Tangent.values) {
println{
val format: Circle => String = c => {
"Circle(x=%8.5f, y=%8.5f, r=%8.5f)".format(c.x, c.y, c.r)
}
val tangents = Triple(ti, tj, tk)
"tangents: " + tangents + " -> cs=" + format(solveApollonius(c1, c2, c3, tangents))
}
}
}

56
Task/Problem-of-Apollonius/Tcl/problem-of-apollonius-1.tcl Normal file
View file

@ -0,0 +1,56 @@
package require TclOO; # Just so we can make a circle class
oo::class create circle {
variable X Y Radius
constructor {x y radius} {
namespace import ::tcl::mathfunc::double
set X [double $x]; set Y [double $y]; set Radius [double $radius]
}
method values {} {list $X $Y $Radius}
method format {} {
format "Circle\[o=(%.2f,%.2f),r=%.2f\]" $X $Y $Radius
}
}
proc solveApollonius {c1 c2 c3 {s1 1} {s2 1} {s3 1}} {
if {abs($s1)!=1||abs($s2)!=1||abs($s3)!=1} {
error "wrong sign; must be 1 or -1"
}
lassign [$c1 values] x1 y1 r1
lassign [$c2 values] x2 y2 r2
lassign [$c3 values] x3 y3 r3
set v11 [expr {2*($x2 - $x1)}]
set v12 [expr {2*($y2 - $y1)}]
set v13 [expr {$x1**2 - $x2**2 + $y1**2 - $y2**2 - $r1**2 + $r2**2}]
set v14 [expr {2*($s2*$r2 - $s1*$r1)}]
set v21 [expr {2*($x3 - $x2)}]
set v22 [expr {2*($y3 - $y2)}]
set v23 [expr {$x2**2 - $x3**2 + $y2**2 - $y3**2 - $r2**2 + $r3**2}]
set v24 [expr {2*($s3*$r3 - $s2*$r2)}]
set w12 [expr {$v12 / $v11}]
set w13 [expr {$v13 / $v11}]
set w14 [expr {$v14 / $v11}]
set w22 [expr {$v22 / $v21 - $w12}]
set w23 [expr {$v23 / $v21 - $w13}]
set w24 [expr {$v24 / $v21 - $w14}]
set P [expr {-$w23 / $w22}]
set Q [expr {$w24 / $w22}]
set M [expr {-$w12 * $P - $w13}]
set N [expr {$w14 - $w12 * $Q}]
set a [expr {$N**2 + $Q**2 - 1}]
set b [expr {2*($M*$N - $N*$x1 + $P*$Q - $Q*$y1 + $s1*$r1)}]
set c [expr {($x1-$M)**2 + ($y1-$P)**2 - $r1**2}]
set rs [expr {(-$b - sqrt($b**2 - 4*$a*$c)) / (2*$a)}]
set xs [expr {$M + $N*$rs}]
set ys [expr {$P + $Q*$rs}]
return [circle new $xs $ys $rs]
}

7
Task/Problem-of-Apollonius/Tcl/problem-of-apollonius-2.tcl Normal file
View file

@ -0,0 +1,7 @@
set c1 [circle new 0 0 1]
set c2 [circle new 4 0 1]
set c3 [circle new 2 4 2]
set sA [solveApollonius $c1 $c2 $c3]
set sB [solveApollonius $c1 $c2 $c3 -1 -1 -1]
puts [$sA format]
puts [$sB format]