Another update from ingydotnet^djgoku
This commit is contained in:
Ingy döt Net
parent
91df62d461
commit
948b86eafa
7604 changed files with 108452 additions and 22726 deletions
|
|
@ -0,0 +1,33 @@
|
|||
defmodule Circle do
|
||||
def apollonius(c1, c2, c3, s1, s2, s3) do
|
||||
{x1, y1, r1} = c1
|
||||
{w12, w13, w14} = calc(c1, c2, s1, s2)
|
||||
{u22, u23, u24} = calc(c2, c3, s2, s3)
|
||||
{w22, w23, w24} = {u22 - w12, u23 - w13, u24 - 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
|
||||
rs = (-b - :math.sqrt(d)) / (2*a)
|
||||
{m + n*rs, p + q*rs, rs}
|
||||
end
|
||||
|
||||
defp calc({x1, y1, r1}, {x2, y2, r2}, s1, s2) do
|
||||
v1 = x2 - x1
|
||||
{(y2 - y1) / v1, (x1*x1 - x2*x2 + y1*y1 - y2*y2 - r1*r1 + r2*r2) / (2*v1), (s2*r2 - s1*r1) / v1}
|
||||
end
|
||||
end
|
||||
|
||||
c1 = {0, 0, 1}
|
||||
c2 = {2, 4, 2}
|
||||
c3 = {4, 0, 1}
|
||||
|
||||
IO.inspect Circle.apollonius(c1, c2, c3, 1, 1, 1)
|
||||
IO.inspect Circle.apollonius(c1, c2, c3, -1, -1, -1)
|
||||
55
Task/Problem-of-Apollonius/Julia/problem-of-apollonius.julia
Normal file
55
Task/Problem-of-Apollonius/Julia/problem-of-apollonius.julia
Normal file
|
|
@ -0,0 +1,55 @@
|
|||
using Polynomials
|
||||
|
||||
immutable Point{T<:Real}
|
||||
x::T
|
||||
y::T
|
||||
end
|
||||
|
||||
immutable Circle{T<:Real}
|
||||
c::Point{T}
|
||||
r::T
|
||||
end
|
||||
Circle{T<:Real}(x::T, y::T, r::T) = Circle(Point(x,y), r)
|
||||
|
||||
function apollonius{T<:Real}(ap::Array{Circle{T},1},
|
||||
enc::Array{Int,1}=Int[])
|
||||
length(ap) == 3 || error("This Apollonius problem needs 3 circles.")
|
||||
x = map(u->u.c.x, ap)
|
||||
y = map(u->u.c.y, ap)
|
||||
r = map(u->u in enc ? -1 : 1, 1:3) .* map(u->u.r, ap)
|
||||
a = 2x[1] - 2x[2:3]
|
||||
b = 2y[1] - 2y[2:3]
|
||||
c = 2r[1] - 2r[2:3]
|
||||
d = (x[1]^2 + y[1]^2 - r[1]^2)
|
||||
d -= (map(u->u^2, x) + map(u->u^2, y) - map(u->u^2, r))[2:3]
|
||||
u = Poly([-det(hcat(b,d)), det(hcat(b,c))]/det(hcat(a,b)))
|
||||
v = Poly([det(hcat(a,d)), -det(hcat(a,c))]/det(hcat(a,b)))
|
||||
w = Poly([r[1], 1.0])^2
|
||||
s = (u - x[1])^2 + (v - y[1])^2 - w
|
||||
r = filter(x->imag(x)==0 && 0<x, roots(s))
|
||||
length(r) < 2 || error("The solution is not unique.")
|
||||
length(r) == 1 || error("There is no solution.")
|
||||
r = r[1]
|
||||
Circle(polyval(u,r), polyval(v,r), r)
|
||||
end
|
||||
|
||||
function detail(c::Circle)
|
||||
x = @sprintf "%.4f" c.c.x
|
||||
y = @sprintf "%.4f" c.c.y
|
||||
r = @sprintf "%.4f" c.r
|
||||
@sprintf "centered at (%s, %s) with radius %s" x y r
|
||||
end
|
||||
|
||||
|
||||
test = [Circle(0.,0.,1.),
|
||||
Circle(4.,0.,1.),
|
||||
Circle(2.,4.,2.)]
|
||||
|
||||
println("The defining circles are:")
|
||||
for c in test
|
||||
println(" ", detail(c))
|
||||
end
|
||||
println("The internal circle is:")
|
||||
println(" ", detail(apollonius(test)))
|
||||
println("The external circle is:")
|
||||
println(" ", detail(apollonius(test, [1:3])))
|
||||
|
|
@ -1,41 +1,37 @@
|
|||
/*REXX program to solve the problem of Apollonius, named after the Greek*/
|
||||
/*────────── Apollonius of Perga [Pergæus] (circa 262 BC ──► 190 BC).*/
|
||||
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 thick tarp.*/
|
||||
solveApollonius: parse 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
|
||||
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*/
|
||||
/*REXX program solves the problem of Apollonius, named after the Greek */
|
||||
/*──────────────── Apollonius of Perga [Pergæus] (circa 262 BC ──► 190 BC).*/
|
||||
w=20; numeric digits w-5 /*the width used to display the 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:', Apollonius( 1, 1, 1)
|
||||
call tell 'internal tangent:', Apollonius(-1, -1, -1)
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*────────────────────────────────────────────────────────────────────────────*/
|
||||
Apollonius: parse arg s1,s2,s3 /*could be an internal/external tangent*/
|
||||
numeric digits digits()*3 /*reduce rounding by using 3 times digs*/
|
||||
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
|
||||
numeric digits digits()%3 /*reset DIGITS to the original.*/
|
||||
return $.x $.y $.r /*return with 3 args, normalized.*/
|
||||
/*────────────────────────────────────────────────────────────────────────────*/
|
||||
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9
|
||||
numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end
|
||||
parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_%2
|
||||
do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/
|
||||
do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/
|
||||
numeric digits d; return (g/1)i /*make complex if X < 0.*/
|
||||
/*────────────────────────────────────────────────────────────────────────────*/
|
||||
tell: parse arg _,a b c; say _ left(a/1,w) left(b/1,w) left(c/1,w); return
|
||||
/*dividing by 1 normalizes the numbers.*/
|
||||
|
|
|
|||
|
|
@ -5,9 +5,9 @@ class Circle
|
|||
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]
|
||||
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
|
||||
|
|
@ -41,14 +41,17 @@ class Circle
|
|||
xs = m + n*rs
|
||||
ys = p + q*rs
|
||||
|
||||
return self.new(xs, ys, rs)
|
||||
self.new(xs, ys, rs)
|
||||
end
|
||||
|
||||
def to_s
|
||||
"Circle: x=#{@x}, y=#{@y}, r=#{@r}"
|
||||
end
|
||||
end
|
||||
|
||||
puts c1 = Circle.new(0, 0, 1)
|
||||
puts c2 = Circle.new(2, 4, 2)
|
||||
puts c3 = Circle.new(4, 0, 1)
|
||||
|
||||
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)
|
||||
puts Circle.apollonius(c1, c2, c3)
|
||||
puts Circle.apollonius(c1, c2, c3, -1, -1, -1)
|
||||
|
|
|
|||
196
Task/Problem-of-Apollonius/VBA/problem-of-apollonius.vba
Normal file
196
Task/Problem-of-Apollonius/VBA/problem-of-apollonius.vba
Normal file
|
|
@ -0,0 +1,196 @@
|
|||
Option Explicit
|
||||
Option Base 0
|
||||
|
||||
Private Const intBase As Integer = 0
|
||||
|
||||
Private Type tPoint
|
||||
X As Double
|
||||
Y As Double
|
||||
End Type
|
||||
Private Type tCircle
|
||||
Centre As tPoint
|
||||
Radius As Double
|
||||
End Type
|
||||
|
||||
Private Sub sApollonius()
|
||||
Dim Circle1 As tCircle
|
||||
Dim Circle2 As tCircle
|
||||
Dim Circle3 As tCircle
|
||||
Dim CTanTanTan(intBase + 0 to intBase + 7) As tCircle
|
||||
|
||||
With Circle1
|
||||
With .Centre
|
||||
.X = 0
|
||||
.Y = 0
|
||||
End With
|
||||
.Radius = 1
|
||||
End With
|
||||
|
||||
With Circle2
|
||||
With .Centre
|
||||
.X = 4
|
||||
.Y = 0
|
||||
End With
|
||||
.Radius = 1
|
||||
End With
|
||||
|
||||
With Circle3
|
||||
With .Centre
|
||||
.X = 2
|
||||
.Y = 4
|
||||
End With
|
||||
.Radius = 2
|
||||
End With
|
||||
|
||||
Call fApollonius(Circle1,Circle2,Circle3,CTanTanTan()))
|
||||
|
||||
End Sub
|
||||
|
||||
Public Function fApollonius(ByRef C1 As tCircle, _
|
||||
ByRef C2 As tCircle, _
|
||||
ByRef C3 As tCircle, _
|
||||
ByRef CTanTanTan() As tCircle) As Boolean
|
||||
' Solves the Problem of Apollonius (finding a circle tangent to three other circles in the plane)
|
||||
' (x_s - x_1)^2 + (y_s - y_1)^2 = (r_s - Tan_1 * r_1)^2
|
||||
' (x_s - x_2)^2 + (y_s - y_2)^2 = (r_s - Tan_2 * r_2)^2
|
||||
' (x_s - x_3)^2 + (y_s - y_3)^2 = (r_s - Tan_3 * r_3)^2
|
||||
' x_s = M + N * r_s
|
||||
' y_s = P + Q * r_s
|
||||
|
||||
' Parameters:
|
||||
' C1, C2, C3 (circles in the problem)
|
||||
' Tan1 := An indication if the solution should be externally or internally tangent (+1/-1) to Circle1 (C1)
|
||||
' Tan2 := An indication if the solution should be externally or internally tangent (+1/-1) to Circle2 (C2)
|
||||
' Tan3 := An indication if the solution should be externally or internally tangent (+1/-1) to Circle3 (C3)
|
||||
|
||||
Dim Tangent(intBase + 0 To intBase + 7, intBase + 0 To intBase + 2) As Integer
|
||||
Dim lgTangent As Long
|
||||
Dim Tan1 As Integer
|
||||
Dim Tan2 As Integer
|
||||
Dim Tan3 As Integer
|
||||
|
||||
Dim v11 As Double
|
||||
Dim v12 As Double
|
||||
Dim v13 As Double
|
||||
Dim v14 As Double
|
||||
Dim v21 As Double
|
||||
Dim v22 As Double
|
||||
Dim v23 As Double
|
||||
Dim v24 As Double
|
||||
Dim w12 As Double
|
||||
Dim w13 As Double
|
||||
Dim w14 As Double
|
||||
Dim w22 As Double
|
||||
Dim w23 As Double
|
||||
Dim w24 As Double
|
||||
|
||||
Dim p As Double
|
||||
Dim Q As Double
|
||||
Dim M As Double
|
||||
Dim N As Double
|
||||
|
||||
Dim A As Double
|
||||
Dim b As Double
|
||||
Dim c As Double
|
||||
Dim D As Double
|
||||
|
||||
'Check if circle centers are colinear
|
||||
If fColinearPoints(C1.Centre, C2.Centre, C3.Centre) Then
|
||||
fApollonius = False
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Tangent(intBase + 0, intBase + 0) = -1
|
||||
Tangent(intBase + 0, intBase + 1) = -1
|
||||
Tangent(intBase + 0, intBase + 2) = -1
|
||||
|
||||
Tangent(intBase + 1, intBase + 0) = -1
|
||||
Tangent(intBase + 1, intBase + 1) = -1
|
||||
Tangent(intBase + 1, intBase + 2) = 1
|
||||
|
||||
Tangent(intBase + 2, intBase + 0) = -1
|
||||
Tangent(intBase + 2, intBase + 1) = 1
|
||||
Tangent(intBase + 2, intBase + 2) = -1
|
||||
|
||||
Tangent(intBase + 3, intBase + 0) = -1
|
||||
Tangent(intBase + 3, intBase + 1) = 1
|
||||
Tangent(intBase + 3, intBase + 2) = 1
|
||||
|
||||
Tangent(intBase + 4, intBase + 0) = 1
|
||||
Tangent(intBase + 4, intBase + 1) = -1
|
||||
Tangent(intBase + 4, intBase + 2) = -1
|
||||
|
||||
Tangent(intBase + 5, intBase + 0) = 1
|
||||
Tangent(intBase + 5, intBase + 1) = -1
|
||||
Tangent(intBase + 5, intBase + 2) = 1
|
||||
|
||||
Tangent(intBase + 6, intBase + 0) = 1
|
||||
Tangent(intBase + 6, intBase + 1) = 1
|
||||
Tangent(intBase + 6, intBase + 2) = -1
|
||||
|
||||
Tangent(intBase + 7, intBase + 0) = 1
|
||||
Tangent(intBase + 7, intBase + 1) = 1
|
||||
Tangent(intBase + 7, intBase + 2) = 1
|
||||
|
||||
For lgTangent = LBound(Tangent) To UBound(Tangent)
|
||||
Tan1 = Tangent(lgTangent, intBase + 0)
|
||||
Tan2 = Tangent(lgTangent, intBase + 1)
|
||||
Tan3 = Tangent(lgTangent, intBase + 2)
|
||||
|
||||
v11 = 2 * (C2.Centre.X - C1.Centre.X)
|
||||
v12 = 2 * (C2.Centre.Y - C1.Centre.Y)
|
||||
v13 = (C1.Centre.X * C1.Centre.X) _
|
||||
- (C2.Centre.X * C2.Centre.X) _
|
||||
+ (C1.Centre.Y * C1.Centre.Y) _
|
||||
- (C2.Centre.Y * C2.Centre.Y) _
|
||||
- (C1.Radius * C1.Radius) _
|
||||
+ (C2.Radius * C2.Radius)
|
||||
v14 = 2 * (Tan2 * C2.Radius - Tan1 * C1.Radius)
|
||||
|
||||
v21 = 2 * (C3.Centre.X - C2.Centre.X)
|
||||
v22 = 2 * (C3.Centre.Y - C2.Centre.Y)
|
||||
v23 = (C2.Centre.X * C2.Centre.X) _
|
||||
- (C3.Centre.X * C3.Centre.X) _
|
||||
+ (C2.Centre.Y * C2.Centre.Y) _
|
||||
- (C3.Centre.Y * C3.Centre.Y) _
|
||||
- (C2.Radius * C2.Radius) _
|
||||
+ (C3.Radius * C3.Radius)
|
||||
v24 = 2 * ((Tan3 * C3.Radius) - (Tan2 * 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) - (N * C1.Centre.X) + (p * Q) - (Q * C1.Centre.Y) + (Tan1 * C1.Radius))
|
||||
c = (C1.Centre.X * C1.Centre.X) _
|
||||
+ (M * M) _
|
||||
- (2 * M * C1.Centre.X) _
|
||||
+ (p * p) _
|
||||
+ (C1.Centre.Y * C1.Centre.Y) _
|
||||
- (2 * p * C1.Centre.Y) _
|
||||
- (C1.Radius * C1.Radius)
|
||||
|
||||
'Find a root of a quadratic equation (requires the circle centers not to be e.g. colinear)
|
||||
D = (b * b) - (4 * A * c)
|
||||
|
||||
With CTanTanTan(lgTangent)
|
||||
.Radius = (-b - VBA.Sqr(D)) / (2 * A)
|
||||
.Centre.X = M + (N * .Radius)
|
||||
.Centre.Y = p + (Q * .Radius)
|
||||
End With
|
||||
|
||||
Next lgTangent
|
||||
|
||||
fApollonius = True
|
||||
|
||||
End Function
|
||||
Loading…
Add table
Add a link
Reference in a new issue