/* ARM assembly Raspberry PI  */
/*  program proFactor.s   */

/* REMARK 1 : this program use routines in a include file
   see task Include a file language arm assembly
   for the routine affichageMess conversion10
   see at end of this program the instruction include */
/*******************************************/
/* Constantes                              */
/*******************************************/
.equ STDOUT, 1                           @ Linux output console
.equ EXIT,   1                           @ Linux syscall
.equ WRITE,  4                           @ Linux syscall

/*******************************************/
/* Initialized data                        */
/*******************************************/
.data
szMessStartPgm:          .asciz "Program start \n"
szMessEndPgm:            .asciz "Program normal end.\n"
szMessError:             .asciz "\033[31mError Allocation !!!\n"
szCarriageReturn:        .asciz "\n"

/* datas message display */
szMessEntete:            .ascii "Number :"
sNumber:                 .space 12,' '
                         .asciz " Divisors :"
szMessResult:            .ascii " "
sValue:                  .space 12,' '
                         .asciz ""
szMessDivNumber:         .ascii "\nnumber divisors :"
sCounter:                .space 12,' '
                         .asciz "\n"
szMessNumberMax:         .ascii "Number :"
sNumberMax:              .space 12,' '
                         .ascii " has "
sDivMax:                 .space 12, ' '
                         .asciz " divisors\n"
/*******************************************/
/* UnInitialized data                      */
/*******************************************/
.bss
/*******************************************/
/*  code section                           */
/*******************************************/
.text
.global main
main:                               @ program start
    ldr r0,iAdrszMessStartPgm       @ display start message
    bl affichageMess
    mov r2,#1
1:
    mov r0,r2                       @  number
    ldr r1,iAdrsNumber              @ and convert ascii string
    bl conversion10
    ldr r0,iAdrszMessEntete         @ display result message
    bl affichageMess
    mov r0,r2                       @  number
    mov r1,#1                       @ display flag
    bl divisors                     @ display divisors
    ldr r1,iAdrsCounter              @ and convert ascii string
    bl conversion10
    ldr r0,iAdrszMessDivNumber      @ display result message
    bl affichageMess
    add r2,r2,#1
    cmp r2,#10
    ble 1b

    mov r2,#2
    mov r3,#0
    mov r4,#0
    ldr r5,iMaxi
2:
    mov r0,r2
    mov r1,#0                       @ display flag
    bl divisors                     @ display divisors
    cmp r0,r3
    movgt r3,r0
    movgt r4,r2
    add r2,r2,#1
    cmp r2,r5
    ble 2b
    mov r0,r4
    ldr r1,iAdrsNumberMax           @ and convert ascii string
    bl conversion10
    mov r0,r3
    ldr r1,iAdrsDivMax              @ and convert ascii string
    bl conversion10
    ldr r0,iAdrszMessNumberMax
    bl affichageMess

    ldr r0,iAdrszMessEndPgm         @ display end message
    bl affichageMess
    b 100f
99:                                 @ display error message
    ldr r0,iAdrszMessError
    bl affichageMess
100:                                @ standard end of the program
    mov r0, #0                      @ return code
    mov r7, #EXIT                   @ request to exit program
    svc 0                           @ perform system call
iAdrszMessStartPgm:        .int szMessStartPgm
iAdrszMessEndPgm:          .int szMessEndPgm
iAdrszMessError:           .int szMessError
iAdrszCarriageReturn:      .int szCarriageReturn
iAdrszMessResult:          .int szMessResult
iAdrsValue:                .int sValue
iAdrszMessDivNumber:       .int szMessDivNumber
iAdrsCounter:              .int sCounter
iAdrszMessEntete:          .int szMessEntete
iAdrsNumber:               .int sNumber
iAdrszMessNumberMax:       .int szMessNumberMax
iAdrsDivMax:               .int sDivMax
iAdrsNumberMax:            .int sNumberMax
iMaxi:                     .int 20000
/******************************************************************/
/*     divisors function                         */
/******************************************************************/
/* r0 contains the number  */
/* r1 contains display flag (<>0: display, 0: no display )
/* r0 return divisors number */
divisors:
    push {r1-r8,lr}             @ save  registers
    cmp r0,#1                   @ = 1 ?
    movle r0,#0
    ble 100f
    mov r7,r0
    mov r8,r1
    cmp r8,#0
    beq 1f
    mov r0,#1                   @ first divisor = 1
    ldr r1,iAdrsValue           @ and convert ascii string
    bl conversion10
    ldr r0,iAdrszMessResult     @ display result message
    bl affichageMess
1:                              @ begin loop
    lsr r4,r7,#1                @ Maxi
    mov r6,r4                   @ first divisor
    mov r5,#1                   @ Counter divisors
2:
    mov r0,r7                   @ dividende = number
    mov r1,r6                   @ divisor
    bl division
    cmp r3,#0                   @ remainder = 0 ?
    bne 3f
    add r5,r5,#1                @ increment counter
    cmp r8,#0                   @ display divisor ?
    beq 3f
    mov r0,r2                   @ divisor
    ldr r1,iAdrsValue           @ and convert ascii string
    bl conversion10
    ldr r0,iAdrszMessResult     @ display result message
    bl affichageMess
3:
    sub r6,r6,#1                @ decrement divisor
    cmp r6,#2                   @ End ?
    bge 2b                      @ no loop
    mov r0,r5                   @ return divisors number

100:
    pop {r1-r8,lr}              @ restaur registers
    bx lr                       @ return

/***************************************************/
/*      ROUTINES INCLUDE                 */
/***************************************************/
.include "../affichage.inc"


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


properDivisors: function [x] ->
    (factors x) -- x

loop 1..10 'x ->
    print ["proper divisors of" x "=>" properDivisors x]

maxN: 0
maxProperDivisors: 0

loop 1..20000 'x [
    pd: size properDivisors x
    if maxProperDivisors < pd [
        maxN: x
        maxProperDivisors: pd
    ]
]

print ["The number with the most proper divisors (" maxProperDivisors ") is" maxN]


proper_divisors(n) {
	Array := []
	if n = 1
		return Array
	Array[1] := true
	x := Floor(Sqrt(n))
	loop, % x+1
		if !Mod(n, i:=A_Index+1) && (floor(n/i) < n)
			Array[floor(n/i)] := true
	Loop % n/x
		if !Mod(n, i:=A_Index+1) && (i < n)
			Array[i] := true
	return Array
}


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


# syntax: GAWK -f PROPER_DIVISORS.AWK
BEGIN {
    show = 0 # show divisors: 0=no, 1=yes
    print("    N  cnt  DIVISORS")
    for (i=1; i<=20000; i++) {
      divisors(i)
      if (i <= 10 || i == 100) { # including 100 as it was an example in task description
        printf("%5d  %3d  %s\n",i,Dcnt,Dstr)
      }
      if (Dcnt < max_cnt) {
        continue
      }
      if (Dcnt > max_cnt) {
        rec = ""
        max_cnt = Dcnt
      }
      rec = sprintf("%s%5d  %3d  %s\n",rec,i,Dcnt,show?Dstr:"divisors not shown")
    }
    printf("%s",rec)
    exit(0)
}
function divisors(n,  i) {
    if (n == 1) {
      Dcnt = 0
      Dstr = ""
      return
    }
    Dcnt = Dstr = 1
    for (i=2; i<n; i++) {
      if (n % i == 0) {
        Dcnt++
        Dstr = sprintf("%s %s",Dstr,i)
      }
    }
    return
}


FUNCTION CountProperDivisors (number)
    IF number < 2 THEN CountProperDivisors = 0
    count = 0
    FOR i = 1 TO number \ 2
        IF number MOD i = 0 THEN count = count + 1
    NEXT i
    CountProperDivisors = count
END FUNCTION

SUB ListProperDivisors (limit)
    IF limit < 1 THEN EXIT SUB
    FOR i = 1 TO limit
        PRINT USING "## ->"; i;
        IF i = 1 THEN PRINT " (None)";
        FOR j = 1 TO i \ 2
            IF i MOD j = 0 THEN PRINT " "; j;
        NEXT j
        PRINT
    NEXT i
END SUB

most = 1
maxCount = 0

PRINT "The proper divisors of the following numbers are: "; CHR$(10)
ListProperDivisors (10)

FOR n = 2 TO 20000
'' It is extremely slow in this loop
    count = CountProperDivisors(n)
    IF count > maxCount THEN
        maxCount = count
        most = n
    END IF
NEXT n

PRINT
PRINT most; " has the most proper divisors, namely "; maxCount
END


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'=. ([: +/@:*:@, -/[email protected]) f. amoeba goal centers
 if. err > 10 * goal do. '' return. end.    NB. no solution found
 avg=. +/ % #
 (, [email protected]) soln
)


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));
 }
}


FUNCTION ProperDivisor(nr, show)

    LOCAL probe, total

    FOR probe = 1 TO nr-1
        IF MOD(nr, probe) = 0 THEN
            IF show THEN PRINT " ", probe;
            INCR total
        END IF
    NEXT

    RETURN total

END FUNCTION

FOR x = 1 TO 10
    PRINT x, ":";
    IF ProperDivisor(x, 1) = 0 THEN PRINT " 0";
    PRINT
NEXT

FOR x = 1 TO 20000
    DivisorCount = ProperDivisor(x, 0)
    IF DivisorCount > MaxDivisors THEN
        MaxDivisors = DivisorCount
        MagicNumber = x
    END IF
NEXT

PRINT "Most proper divisors for number in the range 1-20000: ", MagicNumber, " with ", MaxDivisors, " divisors."


using Printf

module ApolloniusProblems

using Polynomials
export Circle

struct Point{T<:Real}
    x::T
    y::T
end

xcoord(p::Point) = p.x
ycoord(p::Point) = p.y

struct Circle{T<:Real}
    c::Point{T}
    r::T
end
Circle(x::T, y::T, r::T) where T<:Real = Circle(Point(x, y), r)

radius(c::Circle) = c.r
center(c::Circle) = c.c
xcenter(c::Circle) = xcoord(center(c))
ycenter(c::Circle) = ycoord(center(c))

Base.show(io::IO, c::Circle) =
    @printf(io, "centered at (%0.4f, %0.4f) with radius %0.4f",
        xcenter(c), ycenter(c), radius(c))

function solve(ap::Vector{Circle{T}}, enc=()) where T<:Real
    length(ap) == 3 || error("This Apollonius problem needs 3 circles.")
    x = @. xcenter(ap)
    y = @. ycenter(ap)
    r = map(u -> ifelse(u ∈ enc, -1, 1), 1:3) .* radius.(ap)
    @views begin
        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) .- (x[2:3] .^ 2 .+ y[2:3] .^ 2 .- r[2:3] .^ 2)
    end
    u = Poly([-det([b d]), det([b c])] ./ det([a b]))
    v = Poly([det([a d]), -det([a c])] ./ det([a b]))
    w = Poly([r[1], 1.0]) ^ 2
    s = (u - x[1]) ^ 2 + (v - y[1]) ^ 2 - w
    r = filter(x -> iszero(imag(x)) && x > zero(x), roots(s))
    length(r) <  2 || error("The solution is not unique.")
    length(r) == 1 || error("There is no solution.")
    r = r[1]
    return Circle(polyval(u, r), polyval(v, r), r)
end

end  # module ApolloniusProblem


// version 1.1.3

data class Circle(val x: Double, val y: Double, val r: Double)

val Double.sq get() = this * this

fun solveApollonius(c1: Circle, c2: Circle, c3: Circle,
                    s1: Int, s2: Int, s3: Int): Circle {
    val (x1, y1, r1) = c1
    val (x2, y2, r2) = c2
    val (x3, y3, r3) = c3

    val v11 = 2 * x2 - 2 * x1
    val v12 = 2 * y2 - 2 * y1
    val v13 = x1.sq - x2.sq + y1.sq - y2.sq - r1.sq + r2.sq
    val v14 = 2 * s2 * r2 - 2 * s1 * r1

    val v21 = 2 * x3 - 2 * x2
    val v22 = 2 * y3 - 2 * y2
    val v23 = x2.sq - x3.sq + y2.sq - y3.sq - r2.sq + r3.sq
    val v24 = 2 * s3 * r3 - 2 * s2 * r2

    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.sq +  q.sq - 1
    val b = 2 * m * n - 2 * n * x1 + 2 * p * q - 2 * q * y1 + 2 * s1 * r1
    val c = x1.sq + m.sq - 2 * m * x1 + p.sq + y1.sq - 2 * p * y1 - r1.sq

    val d = b.sq - 4 * a * c
    val rs = (-b - Math.sqrt(d)) / (2 * a)
    val xs = m + n * rs
    val ys = p + q * rs
    return Circle(xs, ys, rs)
}

fun main(args: Array<String>) {
    val c1 = Circle(0.0, 0.0, 1.0)
    val c2 = Circle(4.0, 0.0, 1.0)
    val c3 = Circle(2.0, 4.0, 2.0)
    println(solveApollonius(c1, c2, c3, 1, 1, 1))
    println(solveApollonius(c1, c2, c3,-1,-1,-1))
}


#include <stdio.h>
#include <stdbool.h>

int proper_divisors(const int n, bool print_flag)
{
    int count = 0;

    for (int i = 1; i < n; ++i) {
        if (n % i == 0) {
            count++;
            if (print_flag)
                printf("%d ", i);
        }
    }

    if (print_flag)
        printf("\n");

    return count;
}

int main(void)
{
    for (int i = 1; i <= 10; ++i) {
        printf("%d: ", i);
        proper_divisors(i, true);
    }

    int max = 0;
    int max_i = 1;

    for (int i = 1; i <= 20000; ++i) {
        int v = proper_divisors(i, false);
        if (v >= max) {
            max = v;
            max_i = i;
        }
    }

    printf("%d with %d divisors\n", max_i, max);
    return 0;
}


namespace RosettaCode.ProperDivisors
{
    using System;
    using System.Collections.Generic;
    using System.Linq;

    internal static class Program
    {
        private static IEnumerable<int> ProperDivisors(int number)
        {
            return
                Enumerable.Range(1, number / 2)
                    .Where(divisor => number % divisor == 0);
        }

        private static void Main()
        {
            foreach (var number in Enumerable.Range(1, 10))
            {
                Console.WriteLine("{0}: {{{1}}}", number,
                    string.Join(", ", ProperDivisors(number)));
            }

            var record = Enumerable.Range(1, 20000).Select(number => new
            {
                Number = number,
                Count = ProperDivisors(number).Count()
            }).OrderByDescending(currentRecord => currentRecord.Count).First();
            Console.WriteLine("{0}: {1}", record.Number, record.Count);
        }
    }
}


with Ada.Numerics.Float_Random;  use Ada.Numerics.Float_Random;
with Ada.Text_IO;                use Ada.Text_IO;

procedure Random_Distribution is
   Trials : constant := 1_000_000;
   type Outcome is (Aleph, Beth, Gimel, Daleth, He, Waw, Zayin, Heth);
   Pr : constant array (Outcome) of Uniformly_Distributed :=
        (1.0/5.0, 1.0/6.0, 1.0/7.0, 1.0/8.0, 1.0/9.0, 1.0/10.0, 1.0/11.0, 1.0);
   Samples : array (Outcome) of Natural := (others => 0);
   Value   : Uniformly_Distributed;
   Dice    : Generator;
begin
   for Try in 1..Trials loop
      Value := Random (Dice);
      for I in Pr'Range loop
         if Value <= Pr (I) then
            Samples (I) := Samples (I) + 1;
            exit;
         else
            Value := Value - Pr (I);
         end if;
      end loop;
   end loop;
      -- Printing the results
   for I in Pr'Range loop
      Put (Outcome'Image (I) & Character'Val (9));
      Put (Float'Image (Float (Samples (I)) / Float (Trials)) & Character'Val (9));
      if I = Heth then
         Put_Line (" rest");
      else
         Put_Line (Uniformly_Distributed'Image (Pr (I)));
      end if;
   end loop;
end Random_Distribution;


#include <vector>
#include <iostream>
#include <algorithm>

std::vector<int> properDivisors ( int number ) {
   std::vector<int> divisors ;
   for ( int i = 1 ; i < number / 2 + 1 ; i++ )
      if ( number % i == 0 )
	 divisors.push_back( i ) ;
   return divisors ;
}

int main( ) {
   std::vector<int> divisors ;
   unsigned int maxdivisors = 0 ;
   int corresponding_number = 0 ;
   for ( int i = 1 ; i < 11 ; i++ ) {
      divisors =  properDivisors ( i ) ;
      std::cout << "Proper divisors of " << i << ":\n" ;
      for ( int number : divisors ) {
	 std::cout << number << " " ;
      }
      std::cout << std::endl ;
      divisors.clear( ) ;
   }
   for ( int i = 11 ; i < 20001 ; i++ ) {
      divisors =  properDivisors ( i ) ;
      if ( divisors.size( ) > maxdivisors ) {
	 maxdivisors = divisors.size( ) ;
	 corresponding_number = i ;
      }
      divisors.clear( ) ;
   }

   std::cout << "Most divisors has " << corresponding_number <<
      " , it has " << maxdivisors << " divisors!\n" ;
   return 0 ;
}


INT trials = 1 000 000;

MODE LREAL = LONG REAL;

MODE ITEM = STRUCT(
  STRING name,
  INT prob count,
  LREAL expect,
        mapping
);
INT col width = 9;
FORMAT real repr = $g(-col width+1, 6)$,
       item repr = $"Name: "g", Prob count: "g(0)", Expect: "f(real repr)", Mapping: ", f(real repr)l$;

[8]ITEM items := (
  ( "aleph",  0, ~, ~ ),
  ( "beth",   0, ~, ~ ),
  ( "gimel",  0, ~, ~ ),
  ( "daleth", 0, ~, ~ ),
  ( "he",     0, ~, ~ ),
  ( "waw",    0, ~, ~ ),
  ( "zayin",  0, ~, ~ ),
  ( "heth",   0, ~, ~ )
);

main:
(
  LREAL offset = 5; # const #

# initialise items #
  LREAL total sum := 0;
  FOR i FROM LWB items TO UPB items - 1 DO
    expect OF items[i] := 1/(i-1+offset);
    total sum +:= expect OF items[i]
  OD;
  expect OF items[UPB items] := 1 - total sum;

  mapping OF items[LWB items] := expect OF items[LWB items];
  FOR i FROM LWB items + 1 TO UPB items DO
    mapping OF items[i] := mapping OF items[i-1] + expect OF items[i]
  OD;

  # printf((item repr, items)) #

# perform the sampling #
  PROC sample = (REF[]LREAL mapping)INT:(
    INT out;
    LREAL rand real = random;
    FOR j FROM LWB items TO UPB items DO
      IF rand real < mapping[j] THEN
        out := j;
	done
      FI
    OD;
    done: out
  );

  FOR i TO trials DO
      prob count OF items[sample(mapping OF items)] +:= 1
  OD;

  FORMAT indent = $17k$;

# print the results #
  printf(($"Trials: "g(0)l$, trials));
  printf(($"Items:"$,indent));
  FOR i FROM LWB items TO UPB items DO printf(($gn(col width)k" "$, name OF items[i])) OD;
  printf(($l"Target prob.:"$, indent, $f(real repr)" "$, expect OF items));
  printf(($l"Attained prob.:"$, indent));
  FOR i FROM LWB items TO UPB items DO printf(($f(real repr)" "$, prob count OF items[i]/trials)) OD;
  printf($l$)
)


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


shared void run() {

	function divisors(Integer int) =>
			if(int <= 1)
			then {}
			else (1..int / 2).filter((Integer element) => element.divides(int));

	for(i in 1..10) {
		print("``i`` => ``divisors(i)``");
	}

	value start = 1;
	value end = 20k;

	value mostDivisors =
			map {for(i in start..end) i->divisors(i).size}
			.inverse()
			.max(byKey(byIncreasing(Integer.magnitude)));

	print("the number(s) with the most divisors between ``start`` and ``end`` is/are:
	       ``mostDivisors?.item else "nothing"`` with ``mostDivisors?.key else "no"`` divisors");
}


(ns properdivisors
  (:gen-class))

(defn proper-divisors [n]
  " Proper divisors of n"
  (if (= n 1)
    []
  (filter #(= 0 (rem n %)) (range 1 n))))

;; Property divisors of numbers 1 to 20,000 inclusive
(def data (for [n (range 1 (inc 20000))]
            [n (proper-divisors n)]))

;; Find Max
(defn maximal-key [k x & xs]
  " Normal max-key only finds one key that produces maximum, while this function finds them all "
  (reduce (fn [ys x]
            (let [c (compare (k x) (k (peek ys)))]
              (cond
                (pos? c) [x]
                (neg? c) ys
                :else    (conj ys x))))
          [x]
          xs))

(println "n\tcnt\tPROPER DIVISORS")
(doseq [n (range 1 11)]
  (let [factors (proper-divisors n)]
    (println n "\t" (count factors) "\t" factors)))

(def max-data (apply maximal-key (fn [[i pd]] (count pd)) data))

(doseq [[n factors] max-data]
  (println n " has " (count factors) " divisors"))


use AppleScript version "2.5" -- Mac OS X 10.11 (El Capitan) or later.
use framework "Foundation"
use framework "GameplayKit"

on probabilisticChoices(mapping, picks)
    script o
        property mapping : {}
    end script

    -- Make versions of the mapping records with additional 'actual' properties …
    set mapping to current application's class "NSMutableArray"'s arrayWithArray:(mapping)
    tell mapping to makeObjectsPerformSelector:("addEntriesFromDictionary:") withObject:({actual:0})
    -- … ensuring that they're sorted (for accuracy) in descending order (for efficiency) of probability.
    set descriptor to current application's class "NSSortDescriptor"'s sortDescriptorWithKey:("probability") ascending:(false)
    tell mapping to sortUsingDescriptors:({descriptor})
    set o's mapping to mapping as list

    set rndGenerator to current application's class "GKRandomDistribution"'s distributionForDieWithSideCount:(picks)
    set onePickth to 1 / picks
    repeat picks times
        -- Get a random number between 0.0 and 1.0.
        set r to rndGenerator's nextUniform()
        -- Interpret the probability of the number occurring in the range it does
        -- as picking the item with the same probability of being picked.
        repeat with thisRecord in o's mapping
            set r to r - (thisRecord's probability)
            if (r ≤ 0) then
                set thisRecord's actual to (thisRecord's actual) + onePickth
                exit repeat
            end if
        end repeat
    end repeat

    return o's mapping
end probabilisticChoices

on task()
    set mapping to {{|item|:"aleph", probability:1 / 5}, {|item|:"beth", probability:1 / 6}, ¬
        {|item|:"gimel", probability:1 / 7}, {|item|:"daleth", probability:1 / 8}, ¬
        {|item|:"he", probability:1 / 9}, {|item|:"waw", probability:1 / 10}, ¬
        {|item|:"zayin", probability:1 / 11}, {|item|:"heth", probability:1759 / 27720}}
    set picks to 1000000
    set theResults to probabilisticChoices(mapping, picks)
    set output to {}
    set template to {"|item|:", missing value, ", probability:", missing value, ", actual:", missing value}
    set astid to AppleScript's text item delimiters
    set AppleScript's text item delimiters to ""
    repeat with thisRecord in theResults
        set {|item|:item 2 of template, probability:item 4 of template, actual:item 6 of template} to thisRecord
        set {|item|:template's second item, probability:template's fourth item, actual:template's sixth item} to thisRecord
        set end of output to template as text
    end repeat
    set AppleScript's text item delimiters to "}, ¬
    {"
    set output to "{ ¬
    {" & output & "} ¬
}"
    set AppleScript's text item delimiters to astid
    return output
end task

task()


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;
;;


(defun proper-divisors-recursive (product &optional (results '(1)))
   "(int,list)->list::Function to find all proper divisors of a +ve integer."

   (defun smallest-divisor (x)
      "int->int::Find the smallest divisor of an integer > 1."
      (if (evenp x) 2
          (do ((lim (truncate (sqrt x)))
               (sd 3 (+ sd 2)))
              ((or (integerp (/ x sd)) (> sd lim)) (if (> sd lim) x sd)))))

   (defun pd-rec (fac)
      "(int,int)->nil::Recursive function to find proper divisors of a +ve integer"
      (when (not (member fac results))
         (push fac results)
         (let ((hifac (/ fac (smallest-divisor fac))))
            (pd-rec hifac)
            (pd-rec (/ product hifac)))))

   (pd-rec product)
   (butlast (sort (copy-list results) #'<)))

(defun task (method &optional (n 1) (most-pds '(0)))
   (dotimes (i 19999)
      (let ((npds (length (funcall method (incf n))))
            (hiest (car most-pds)))
         (when (>= npds hiest)
            (if (> npds hiest)
                (setf most-pds (list npds (list n)))
                (setf most-pds (list npds (cons n (second most-pds))))))))
   most-pds)

(defun main ()
   (format t "Task 1:Proper Divisors of [1,10]:~%")
   (dotimes (i 10) (format t "~A:~A~%" (1+ i) (proper-divisors-recursive (1+ i))))
   (format t "Task 2:Count & list of numbers <=20,000 with the most Proper Divisors:~%~A~%"
           (task #'proper-divisors-recursive)))


nofTrials: 10000
probabilities: #[
    aleph: to :rational [1 5]
    beth: to :rational [1 6]
    gimel: to :rational [1 7]
    daleth: to :rational [1 8]
    he: to :rational [1 9]
    waw: to :rational [1 10]
    zayin: to :rational [1 11]
    heth: to :rational [1759 27720]
]

samples: #[]

loop 1..nofTrials 'x [
    z: random 0.0 1.0
    loop probabilities [item,prob][
        if? z < prob [
            unless key? samples item -> samples\[item]: 0
            samples\[item]: samples\[item] + 1
            break
        ]
        else [
            z: z - prob
        ]
    ]
]

[s1, s2]: 0.0

print [pad.right "Item" 10 pad "Target" 10 pad "Tesults" 10 pad "Differences" 15]
print repeat "-" 50
loop probabilities [item,prob][
    r: samples\[item] // nofTrials
    s1: s1 + r*100
    s2: s2 + prob*100

    print [
        pad.right item 10
        pad to :string prob 10
        pad to :string round.to:4 r 10
        pad to :string round.to:4 to :floating 100*1-r//prob 13 "%"
    ]
]
print repeat "-" 50
print [
    pad.right "Total:" 10
    pad to :string to :floating s2 10
    pad to :string s1 10
]


MODULE RosettaProperDivisor;
IMPORT StdLog;

PROCEDURE Pd*(n: LONGINT;OUT r: ARRAY OF LONGINT):LONGINT;
VAR
	i,j: LONGINT;
BEGIN
	i := 1;j := 0;
	IF n >  1 THEN
		WHILE (i < n) DO
			IF (n MOD i) = 0 THEN
				IF (j < LEN(r)) THEN r[j] := i END; INC(j)
			END;
			INC(i)
		END;
	END;
	RETURN j
END Pd;

PROCEDURE Do*;
VAR
	r: ARRAY 128 OF LONGINT;
	i,j,found,max,idxMx: LONGINT;
	mx: ARRAY 128 OF LONGINT;
BEGIN
	FOR i := 1 TO 10 DO
		found := Pd(i,r);
		IF found > LEN(r) THEN (* Error. more pd than r can admit *) HALT(1) END;
		StdLog.Int(i);StdLog.String("[");StdLog.Int(found);StdLog.String("]:> ");
		FOR j := 0 TO found - 1 DO
			StdLog.Int(r[j]);StdLog.Char(' ');
		END;
		StdLog.Ln
	END;

	max := 0;idxMx := 0;
  FOR i := 1 TO 20000 DO
  	found := Pd(i,r);
  	IF found > max THEN
    	idxMx:= 0;mx[idxMx] := i;max := found
	  ELSIF found = max THEN
    	INC(idxMx);mx[idxMx] := i
  	END;
  END;
	StdLog.String("Found: ");StdLog.Int(idxMx + 1);
  StdLog.String(" Numbers with the longest proper divisors [");
	StdLog.Int(max);StdLog.String("]: ");StdLog.Ln;
	FOR i := 0 TO idxMx DO
  	StdLog.Int(mx[i]);StdLog.Ln
	END
END Do;

END RosettaProperDivisor.

^Q RosettaProperDivisor.Do~


#!/usr/bin/awk -f

BEGIN {
    ITERATIONS = 1000000
    delete symbMap
    delete probMap
    delete counts
    initData();

    for (i = 0; i < ITERATIONS; i++) {
        distribute(rand())
    }
    showDistributions()

    exit
}

function distribute(rnd,    cnt, symNum, sym, symPrb) {
    cnt = length(symbMap)
    for (symNum = 1; symNum <= cnt; symNum++) {
        sym = symbMap[symNum];
        symPrb = probMap[sym];
        rnd -= symPrb;
        if (rnd <= 0) {
            counts[sym]++
            return;
        }
    }
}

function showDistributions(    s, sym, prb, actSum, expSum, totItr) {
    actSum = 0.0
    expSum = 0.0
    totItr = 0
    printf "%-7s  %-7s  %-5s  %-5s\n", "symb", "num.", "act.", "expt."
    print  "-------  -------  -----  -----"
    for (s = 1; s <= length(symbMap); s++) {
        sym = symbMap[s]
        prb = counts[sym]/ITERATIONS
        actSum += prb
        expSum += probMap[sym]
        totItr += counts[sym]
        printf "%-7s  %7d  %1.3f  %1.3f\n", sym, counts[sym], prb, probMap[sym]
    }
    print  "-------  -------  -----  -----"
    printf "Totals:  %7d  %1.3f  %1.3f\n", totItr, actSum, expSum
}

function initData(    sym) {
    srand()

    probMap["aleph"]  = 1.0 / 5.0
    probMap["beth"]   = 1.0 / 6.0
    probMap["gimel"]  = 1.0 / 7.0
    probMap["daleth"] = 1.0 / 8.0
    probMap["he"]     = 1.0 / 9.0
    probMap["waw"]    = 1.0 / 10.0
    probMap["zyin"]   = 1.0 / 11.0
    probMap["heth"]   = 1759.0 / 27720.0

    symbMap[1] = "aleph"
    symbMap[2] = "beth"
    symbMap[3] = "gimel"
    symbMap[4] = "daleth"
    symbMap[5] = "he"
    symbMap[6] = "waw"
    symbMap[7] = "zyin"
    symbMap[8] = "heth"

    for (sym in probMap)
        counts[sym] = 0;
}


void main() /*@safe*/ {
    import std.stdio, std.algorithm, std.range, std.typecons;

    immutable properDivs = (in uint n) pure nothrow @safe /*@nogc*/ =>
        iota(1, (n + 1) / 2 + 1).filter!(x => n % x == 0 && n != x);

    iota(1, 11).map!properDivs.writeln;
    iota(1, 20_001).map!(n => tuple(properDivs(n).count, n)).reduce!max.writeln;
}


program ProperDivisors;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  System.Generics.Collections;

type
  TProperDivisors = TArray<Integer>;

function GetProperDivisors(const value: Integer): TProperDivisors;
var
  i, count: Integer;
begin
  count := 0;

  for i := 1 to value div 2 do
  begin
    if value mod i = 0 then
    begin
      inc(count);
      SetLength(result, count);
      Result[count - 1] := i;
    end;
  end;
end;

procedure Println(values: TProperDivisors);
var
  i: Integer;
begin
  Write('[');
  if Length(values) > 0 then
    for i := 0 to High(values) do
      Write(Format('%2d', [values[i]]));
  Writeln(']');
end;

var
  number, max_count, count, max_number: Integer;

begin
  for number := 1 to 10 do
  begin
    write(number, ': ');
    Println(GetProperDivisors(number));
  end;

  max_count := 0;
  for number := 1 to 20000 do
  begin
    count := length(GetProperDivisors(number));
    if count > max_count then
    begin
      max_count := count;
      max_number := number;
    end;
  end;

  Write(max_number, ': ', max_count);

  readln;
end.


dim letters$ = {"aleph", "beth", "gimel", "daleth", "he", "waw", "zayin", "heth"}
dim actual(8) fill 0 ## all zero by default
dim probs = {1/5.0, 1/6.0, 1/7.0, 1/8.0, 1/9.0, 1/10.0, 1/11.0, 0}
dim cumProbs(8)

cumProbs[0] = probs[0]
for i = 1 to 6
	cumProbs[i] = cumProbs[i - 1] + probs[i]
next i
cumProbs[7] = 1.0
probs[7] = 1.0 - cumProbs[6]

n = 1000000
sum = 0.0

for i = 1 to n
    rnd = rand  ## random number where 0 <= rand < 1
    begin case
        case rnd <= cumProbs[0]
            actual[0] += 1
        case rnd <= cumProbs[1]
            actual[1] += 1
        case rnd <= cumProbs[2]
            actual[2] += 1
        case rnd <= cumProbs[3]
            actual[3] += 1
        case rnd <= cumProbs[4]
            actual[4] += 1
        case rnd <= cumProbs[5]
            actual[5] += 1
        case rnd <= cumProbs[6]
            actual[6] += 1
        else
            actual[7] += 1
    end case
next i

sumActual = 0

print "Letter", " Actual", "Expected"
print "------", "--------", "--------"
for i = 0 to 7
    print ljust(letters$[i],14," ");
    print ljust(actual[i]/n,8,"0"); "      ";
    sumActual += actual[i]/n
    print ljust(probs[i],8,"0")
next i

print "      ", "--------", "--------"
print "      ", ljust(sumActual,8,"0"), "1.000000"
end


      DIM item$(7), prob(7), cnt%(7)
      item$() = "aleph","beth","gimel","daleth","he","waw","zayin","heth"
      prob()  = 1/5.0, 1/6.0, 1/7.0, 1/8.0, 1/9.0, 1/10.0, 1/11.0, 1759/27720
      IF ABS(SUM(prob())-1) > 1E-6 ERROR 100, "Probabilities don't sum to 1"

      FOR trial% = 1 TO 1E6
        r = RND(1)
        p = 0
        FOR i% = 0 TO DIM(prob(),1)
          p += prob(i%)
          IF r < p cnt%(i%) += 1 : EXIT FOR
        NEXT
      NEXT

      @% = &2060A
      PRINT "Item        actual    theoretical"
      FOR i% = 0 TO DIM(item$(),1)
        PRINT item$(i%), cnt%(i%)/1E6, prob(i%)
      NEXT


#include <stdio.h>
#include <stdlib.h>

/* pick a random index from 0 to n-1, according to probablities listed
   in p[] which is assumed to have a sum of 1. The values in the probablity
   list matters up to the point where the sum goes over 1 */
int rand_idx(double *p, int n)
{
	double s = rand() / (RAND_MAX + 1.0);
	int i;
	for (i = 0; i < n - 1 && (s -= p[i]) >= 0; i++);
	return i;
}

#define LEN 8
#define N 1000000
int main()
{
	const char *names[LEN] = { "aleph", "beth", "gimel", "daleth",
			  "he", "waw", "zayin", "heth" };
	double s, p[LEN] = { 1./5, 1./6, 1./7, 1./8, 1./9, 1./10, 1./11, 1e300 };
	int i, count[LEN] = {0};

	for (i = 0; i < N; i++) count[rand_idx(p, LEN)] ++;

	printf("  Name  Count    Ratio Expected\n");
	for (i = 0, s = 1; i < LEN; s -= p[i++])
		printf("%6s%7d %7.4f%% %7.4f%%\n",
			names[i], count[i],
			(double)count[i] / N * 100,
			((i < LEN - 1) ? p[i] : s) * 100);

	return 0;
}


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;


func properDivs(n) {
    if n == 1 {
        yield break
    }
    for x in 1..<n {
        if n % x == 0 {
            yield x
        }
    }
}

for i in 1..10 {
    print("\(i): \(properDivs(i).ToArray())")
}

var (num, max) = (0,0)

for i in 1..20000 {
    let count = properDivs(i).Length()
    if count > max {
        set (num, max) = (i, count)
    }
}

print("\(num): \(max)")


(lib 'list) ;; list-delete

;; let n = product p_i^a_i , p_i prime
;; number of divisors = product (a_i + 1) - 1
(define (numdivs n)
    (1- (apply * (map (lambda(g) (1+ (length g))) (group (prime-factors n))))))

(remember 'numdivs)

;; prime powers
;; input : a list g of grouped prime factors ( 3 3 3 ..)
;; returns (1 3 9 27 ...)
(define (ppows g (mult 1))
	(for/fold (ppows '(1)) ((a g))
	(set! mult (* mult a))
	(cons mult ppows)))

;; proper divisors
;; decomp n into ((2 2 ..) ( 3 3 ..)  ) prime factors groups
;; combines (1 2 4 8 ..) (1 3 9 ..) lists
;; remove n from the list

(define (divs n)
   (if (<= n 1) null
    (list-delete
        (for/fold (divs'(1)) ((g (map  ppows (group (prime-factors n)))))
		    (for*/list ((a divs) (b g)) (* a b)))
    n )))

;; find number(s) with max # of proper divisors
;; returns list of (n . maxdivs)  for n in range 2..N

(define (most-proper N)
    (define maxdivs 1)
    (define ndivs 0)
    (for/fold (most-proper null) ((n (in-range 2 N)))
       (set! ndivs (numdivs n))
        #:continue (< ndivs maxdivs)
        (when (> ndivs maxdivs)
        (set!-values (most-proper maxdivs) (values null ndivs)))
        (cons (cons n maxdivs) most-proper)))


using System;

class Program
{
    static long TRIALS = 1000000L;
    private class Expv
    {
        public string name;
        public int probcount;
        public double expect;
        public double mapping;

        public Expv(string name, int probcount, double expect, double mapping)
        {
            this.name = name;
            this.probcount = probcount;
            this.expect = expect;
            this.mapping = mapping;
        }
    }

    static Expv[] items = {
        new Expv("aleph", 0, 0.0, 0.0), new Expv("beth", 0, 0.0, 0.0),
        new Expv("gimel", 0, 0.0, 0.0), new Expv("daleth", 0, 0.0, 0.0),
	new Expv("he", 0, 0.0, 0.0),    new Expv("waw", 0, 0.0, 0.0),
	new Expv("zayin", 0, 0.0, 0.0), new Expv("heth", 0, 0.0, 0.0)
    };

    static void Main(string[] args)
    {
        double rnum, tsum = 0.0;
        Random random = new Random();

        for (int i = 0, rnum = 5.0; i < 7; i++, rnum += 1.0)
        {
            items[i].expect = 1.0 / rnum;
            tsum += items[i].expect;
        }
        items[7].expect = 1.0 - tsum;

        items[0].mapping = 1.0 / 5.0;
        for (int i = 1; i < 7; i++)
            items[i].mapping = items[i - 1].mapping + 1.0 / ((double)i + 5.0);
        items[7].mapping = 1.0;

        for (int i = 0; i < TRIALS; i++)
        {
            rnum = random.NextDouble();
            for (int j = 0; j < 8; j++)
                if (rnum < items[j].mapping)
                {
                    items[j].probcount++;
                    break;
                }
        }

        Console.WriteLine("Trials: {0}", TRIALS);
        Console.Write("Items:          ");
        for (int i = 0; i < 8; i++)
            Console.Write(items[i].name.PadRight(9));
        Console.WriteLine();
        Console.Write("Target prob.:   ");
        for (int i = 0; i < 8; i++)
            Console.Write("{0:0.000000} ", items[i].expect);
        Console.WriteLine();
        Console.Write("Attained prob.: ");
        for (int i = 0; i < 8; i++)
            Console.Write("{0:0.000000} ", (double)items[i].probcount / (double)TRIALS);
        Console.WriteLine();
    }
}


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


class
	APPLICATION

create
	make

feature

	make
			-- Test the feature proper_divisors.
		local
			list: LINKED_LIST [INTEGER]
			count, number: INTEGER
		do
			across
				1 |..| 10 as c
			loop
				list := proper_divisors (c.item)
				io.put_string (c.item.out + ": ")
				across
					list as l
				loop
					io.put_string (l.item.out + " ")
				end
				io.new_line
			end
			across
				1 |..| 20000 as c
			loop
				list := proper_divisors (c.item)
				if list.count > count then
					count := list.count
					number := c.item
				end
			end
			io.put_string (number.out + " has with " + count.out + " divisors the highest number of proper divisors.")
		end

	proper_divisors (n: INTEGER): LINKED_LIST [INTEGER]
			-- Proper divisors of 'n'.
		do
			create Result.make
			across
				1 |..| (n - 1) as c
			loop
				if n \\ c.item = 0 then
					Result.extend (c.item)
				end
			end
		end

end


#include <cstdlib>
#include <iostream>
#include <vector>
#include <utility>
#include <algorithm>
#include <ctime>
#include <iomanip>

int main( ) {
   typedef std::vector<std::pair<std::string, double> >::const_iterator SPI ;
   typedef std::vector<std::pair<std::string , double> > ProbType ;
   ProbType probabilities ;
   probabilities.push_back( std::make_pair( "aleph" , 1/5.0 ) ) ;
   probabilities.push_back( std::make_pair( "beth" , 1/6.0 ) ) ;
   probabilities.push_back( std::make_pair( "gimel" , 1/7.0 ) ) ;
   probabilities.push_back( std::make_pair( "daleth" , 1/8.0 ) ) ;
   probabilities.push_back( std::make_pair( "he" , 1/9.0 ) ) ;
   probabilities.push_back( std::make_pair( "waw" , 1/10.0 ) ) ;
   probabilities.push_back( std::make_pair( "zayin" , 1/11.0 ) ) ;
   probabilities.push_back( std::make_pair( "heth" , 1759/27720.0 ) ) ;
   std::vector<std::string> generated ; //for the strings that are generatod
   std::vector<int> decider ; //holds the numbers that determine the choice of letters
   for ( int i = 0 ; i < probabilities.size( ) ; i++ ) {
      if ( i == 0 ) {
	 decider.push_back( 27720 * (probabilities[ i ].second) ) ;
      }
      else {
	 int number = 0 ;
	 for ( int j = 0 ; j < i ; j++ ) {
	    number +=  27720 * ( probabilities[ j ].second ) ;
	 }
	 number += 27720 * probabilities[ i ].second ;
	 decider.push_back( number ) ;
      }
   }
   srand( time( 0 ) ) ;
   for ( int i = 0 ; i < 1000000 ; i++ ) {
      int randnumber = rand( ) % 27721 ;
      int j = 0 ;
      while ( randnumber > decider[ j ] )
	 j++ ;
      generated.push_back( ( probabilities[ j ]).first ) ;
   }
   std::cout << "letter  frequency attained   frequency expected\n" ;
   for ( SPI i = probabilities.begin( ) ; i != probabilities.end( ) ; i++ ) {
      std::cout << std::left << std::setw( 8 ) << i->first ;
      int found = std::count ( generated.begin( ) , generated.end( ) , i->first ) ;
      std::cout << std::left << std::setw( 21 ) << found / 1000000.0 ;
      std::cout << std::left << std::setw( 17 ) << i->second << '\n' ;
   }
   return 0 ;
}


defmodule Proper do
  def divisors(1), do: []
  def divisors(n), do: [1 | divisors(2,n,:math.sqrt(n))] |> Enum.sort

  defp divisors(k,_n,q) when k>q, do: []
  defp divisors(k,n,q) when rem(n,k)>0, do: divisors(k+1,n,q)
  defp divisors(k,n,q) when k * k == n, do: [k | divisors(k+1,n,q)]
  defp divisors(k,n,q)                , do: [k,div(n,k) | divisors(k+1,n,q)]

  def most_divisors(limit) do
    {length,nums} = Enum.group_by(1..limit, fn n -> length(divisors(n)) end)
                    |> Enum.max_by(fn {length,_nums} -> length end)
    IO.puts "With #{length}, Number #{inspect nums} has the most divisors"
  end
end

Enum.each(1..10, fn n ->
  IO.puts "#{n}: #{inspect Proper.divisors(n)}"
end)
Proper.most_divisors(20000)


-module(properdivs).
-export([divs/1,sumdivs/1,longest/1]).

divs(0) -> [];
divs(1) -> [];
divs(N) -> lists:sort([1] ++ divisors(2,N,math:sqrt(N))).

divisors(K,_N,Q) when K > Q -> [];
divisors(K,N,Q) when N rem K =/= 0 ->
    divisors(K+1,N,Q);
divisors(K,N,Q) when K * K  == N ->
    [K] ++ divisors(K+1,N,Q);
divisors(K,N,Q) ->
    [K, N div K] ++ divisors(K+1,N,Q).

sumdivs(N) -> lists:sum(divs(N)).

longest(Limit) -> longest(Limit,0,0,1).

longest(L,Current,CurLeng,Acc) when Acc >= L ->
    io:format("With ~w, Number ~w has the most divisors~n", [CurLeng,Current]);
longest(L,Current,CurLeng,Acc) ->
    A = length(divs(Acc)),
    if A > CurLeng ->
        longest(L,Acc,A,Acc+1);
        true -> longest(L,Current,CurLeng,Acc+1)
    end.


(defn to-cdf [pdf]
  (reduce
    (fn [acc n] (conj acc (+ (or (last acc) 0) n)))
    []
    pdf))

(defn choose [cdf]
  (let [r (rand)]
    (count
      (filter (partial > r) cdf))))

(def *names* '[aleph beth gimel daleth he waw zayin heth])
(def *pdf* (map double [1/5 1/6 1/7 1/8 1/9 1/10 1/11 1759/27720]))

(let [num-trials 1000000
      cdf (to-cdf *pdf*)
      indexes (range (count *names*)) ;; use integer key internally, not name
      expected (into (sorted-map) (zipmap indexes *pdf*))
      actual (frequencies (repeatedly num-trials #(choose cdf)))]
  (doseq [[idx exp] expected]
    (println "Expected number of" (*names* idx) "was"
             (* num-trials exp) "and actually got" (actual idx))))


(defvar *probabilities* '((aleph  1/5)
                          (beth   1/6)
                          (gimel  1/7)
                          (daleth 1/8)
                          (he     1/9)
                          (waw    1/10)
                          (zayin  1/11)
                          (heth   1759/27720)))
(defun calculate-probabilities (choices &key (repetitions 1000000))
  (assert (= 1 (reduce #'+ choices :key #'second)))
  (labels ((make-ranges ()
             (loop for (datum probability) in choices
                   sum (coerce probability 'double-float) into total
                   collect (list datum total)))
           (pick (ranges)
             (declare (optimize (speed 3) (safety 0) (debug 0)))
             (loop with random = (random 1.0d0)
                   for (datum below) of-type (t double-float) in ranges
                   when (< random below)
                     do (return datum)))
           (populate-hash (ranges)
             (declare (optimize (speed 3) (safety 0) (debug 0)))
             (loop repeat (the fixnum repetitions)
                   with hash = (make-hash-table)
                   do (incf (the fixnum (gethash (pick ranges) hash 0)))
                   finally (return hash)))
           (make-table-data (hash)
             (loop for (datum probability) in choices
                   collect (list datum
                                 (float (/ (gethash datum hash)
                                           repetitions))
                                 (float probability)))))
    (format t "Datum~10,2TOccured~20,2TExpected~%")
    (format t "~{~{~A~10,2T~F~20,2T~F~}~%~}"
                 (make-table-data (populate-hash (make-ranges))))))

CL-USER> (calculate-probabilities *probabilities*)
Datum     Occured   Expected
ALEPH     0.200156  0.2
BETH      0.166521  0.16666667
GIMEL     0.142936  0.14285715
DALETH    0.124779  0.125
HE        0.111601  0.11111111
WAW       0.100068  0.1
ZAYIN     0.090458  0.09090909
HETH      0.063481  0.06345599


#lang slideshow

(struct circle (x y r) #:prefab)

(define (apollonius c1 c2 c3 s1 s2 s3)
  (define x1 (circle-x c1))
  (define y1 (circle-y c1))
  (define r1 (circle-r c1))
  (define x2 (circle-x c2))
  (define y2 (circle-y c2))
  (define r2 (circle-r c2))
  (define x3 (circle-x c3))
  (define y3 (circle-y c3))
  (define r3 (circle-r c3))

  (define v11 (- (* 2 x2) (* 2 x1)))
  (define v12 (- (* 2 y2) (* 2 y1)))
  (define v13 (+ (- (* x1 x1) (* x2 x2))
                 (- (* y1 y1) (* y2 y2))
                 (- (* r2 r2) (* r1 r1))))
  (define v14 (- (* 2 s2 r2) (* 2 s1 r1)))

  (define v21 (- (* 2 x3) (* 2 x2)))
  (define v22 (- (* 2 y3) (* 2 y2)))
  (define v23 (+ (- (* x2 x2) (* x3 x3))
                 (- (* y2 y2) (* y3 y3))
                 (- (* r3 r3) (* r2 r2))))
  (define v24 (- (* 2 s3 r3) (* 2 s2 r2)))

  (define w12 (/ v12 v11))
  (define w13 (/ v13 v11))
  (define w14 (/ v14 v11))

  (define w22 (- (/ v22 v21) w12))
  (define w23 (- (/ v23 v21) w13))
  (define w24 (- (/ v24 v21) w14))

  (define P (- (/ w23 w22)))
  (define Q (/ w24 w22))
  (define M (- (+ (* w12 P) w13)))
  (define N (- w14 (* w12 Q)))

  (define a (+ (* N N) (* Q Q) -1))
  (define b (+ (- (* 2 M N) (* 2 N x1))
               (- (* 2 P Q) (* 2 Q y1))
               (* 2 s1 r1)))
  (define c (- (+ (* x1 x1) (* M M) (* P P) (* y1 y1))
               (+ (* 2 M x1) (* 2 P y1) (* r1 r1))))

  (define D (- (* b b) (* 4 a c)))
  (define rs (/ (- (+ b (sqrt D))) (* 2 a)))
  (define xs (+ M (* N rs)))
  (define ys (+ P (* Q rs)))
  (circle xs ys rs))

(define c1 (circle 0.0 0.0 1.0))
(define c2 (circle 4.0 0.0 1.0))
(define c3 (circle 2.0 4.0 2.0))

;; print solutions
(apollonius c1 c2 c3 1.0 1.0 1.0)
(apollonius c1 c2 c3 -1.0 -1.0 -1.0)

;; visualize solutions
(require racket/gui/base)
(define (show-circles . circles+colors)
  (define f (new frame% [label "Apollonius"] [width 300] [height 300]))
  (define c
    (new canvas% [parent f]
      [paint-callback
       (lambda (canvas dc)
         (send* dc (set-origin 100 100)
                   (set-scale 20 20)
                   (set-pen "black" 1/10 'solid)
                   (set-brush "white" 'transparent))
         (for ([x circles+colors])
           (if (string? x)
             (send dc set-pen x 1/5 'solid)
             (let ([x (circle-x x)] [y (circle-y x)] [r (circle-r x)])
               (send dc draw-ellipse (- x r) (- y r) (* 2 r) (* 2 r))))))]))
  (send f show #t))
(show-circles "black" c1 c2 c3
              "green" (apollonius c1 c2 c3 1.0 1.0 1.0)
              "red"   (apollonius c1 c2 c3 -1.0 -1.0 -1.0))


// the simple function with the answer
let propDivs n = [1..n/2] |> List.filter (fun x->n % x = 0)

// to cache the result length; helpful for a long search
let propDivDat n = propDivs n |> fun xs -> n, xs.Length, xs

// UI: always the longest and messiest
let show (n,count,divs) =
  let showCount = count |> function | 0-> "no proper divisors" | 1->"1 proper divisor" | _-> sprintf "%d proper divisors" count
  let showDiv = divs |> function | []->"" | x::[]->sprintf ": %d" x | _->divs |> Seq.map string |> String.concat "," |> sprintf ": %s"
  printfn "%d has %s%s" n showCount showDiv

// generate output
[1..10] |> List.iter (propDivDat >> show)

// use a sequence: we don't really need to hold this data, just iterate over it
Seq.init 20000 ( ((+) 1) >> propDivDat)
|> Seq.fold (fun a b ->match a,b with | (_,c1,_),(_,c2,_) when c2 > c1 -> b | _-> a) (0,0,[])
|> fun (n,count,_) -> (n,count,[]) |> show


void main() {
  import std.stdio, std.random, std.string, std.range;

  enum int nTrials = 1_000_000;
  const items = "aleph beth gimel daleth he waw zayin heth".split;
  const pr = [1/5., 1/6., 1/7., 1/8., 1/9., 1/10., 1/11., 1759/27720.];

  double[pr.length] counts = 0.0;
  foreach (immutable _; 0 .. nTrials)
    counts[pr.dice]++;

  writeln("Item    Target prob  Attained prob");
  foreach (name, p, co; zip(items, pr, counts[]))
    writefln("%-7s %.8f   %.8f", name, p, co / nTrials);
}


/*REXX program solves the problem of Apollonius, named after the Greek Apollonius of    */
/*────────────────────────────────────── Perga [Pergæus]   (circa 262 BCE ──► 190 BCE). */
numeric digits 15;                x1= 0;        y1= 0;         r1= 1
                                  x2= 4;        y2= 0;         r2= 1
                                  x3= 2;        y3= 4;         r3= 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 internal or external tangent*/
      numeric digits digits() * 3                /*reduce rounding with thrice digits.  */
      va= x2*2     - x1*2;                        vb= y2*2 - y1*2
      vc= x1**2    - x2**2 + y1**2 - y2**2 - r1**2 + r2**2
      vd= s2*r2*2  - s1*r1*2;                     ve= x3*2 - x2*2;   vf= y3*2    - y2*2
      vg= x2**2    - x3**2 + y2**2 - y3**2 - r2**2 + r3**2;          vh= s3*r3*2 - s2*r2*2
      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**2 + q**2   - 1
      b =  (m*n    - n*x1    + p*q    - q*y1   + s1*r1)  * 2
      c =  x1**2   + y1**2   + m**2   - r1**2  + p**2    - (m*x1 + p*y1)  * 2
                                         $r= (-b - sqrt(b**2 - a*c*4) ) / (a+a)
      return  (m + n*$r)   (p + q*$r)   ($r)                       /*return 3 arguments.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
sqrt: procedure; parse arg x;  if x=0  then return 0;  d=digits();  h=d+6;  numeric digits
      m.=9; numeric form; 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*/;  return g
/*──────────────────────────────────────────────────────────────────────────────────────*/
tell: parse arg _,a b c; w=digits()+4; say _ left(a/1,w%2) left(b/1,w) left(c/1,w); return


USING: formatting io kernel math math.functions
math.primes.factors math.ranges prettyprint sequences ;

: #divisors ( m -- n )
    dup sqrt >integer 1 + [1,b] [ divisor? ] with count dup +
    1 - ;

10 [1,b] [ dup pprint bl divisors but-last . ] each
20000 [1,b] [ #divisors ] supremum-by dup #divisors
"%d with %d divisors.\n" printf


Func Divisors(n) =
    [d]:=[(1)];                                            {start divisor list with just 1, which is a divisor of everything}
    for i = 2 to n\2 do                                    {loop through possible divisors of n}
        if Divides(i, n) then [d]:=[d]_[(i)] fi
    od;
    .;

for n = 1 to 10 do
    Divisors(n);
    !!(n,'    ',[d);
od;

record:=0;
champ:=1;
for n=2 to 20000 do
    Divisors(n);
    m:=Cols[d];                                            {this gets the length of the array}
    if m > record then
        champ:=n;
        record:=m;
    fi;
od;

!!('The number up to 20,000 with the most divisors was ',champ,' with ',record,' divisors.');


: .proper-divisors
  dup 1 ?do
    dup i mod 0= if i . then
  loop cr drop
;

: proper-divisors-count
  0 swap
  dup 1 ?do
    dup i mod 0= if swap 1 + swap then
  loop drop
;

: rosetta-proper-divisors
  cr
  11 1 do
    i . ." : " i .proper-divisors
  loop

  1 0
  20000 2 do
    i proper-divisors-count
    2dup < if nip nip i swap else drop then
  loop
  swap cr . ." has " . ." divisors" cr
;

rosetta-proper-divisors


defmodule Probabilistic do
  @tries 1000000
  @probs [aleph:  1/5,
          beth:   1/6,
          gimel:  1/7,
          daleth: 1/8,
          he:     1/9,
          waw:    1/10,
          zayin:  1/11,
          heth:   1759/27720]

  def test do
    trials = for _ <- [email protected], do: get_choice(@probs, :rand.uniform)
    IO.puts "Item      Expected   Actual"
    fmt = " ~-8s ~.6f  ~.6f~n"
    Enum.each(@probs, fn {glyph,expected} ->
      actual = length(for ^glyph <- trials, do: glyph) / @tries
      :io.format fmt, [glyph, expected, actual]
    end)
  end

  defp get_choice([{glyph,_}], _), do: glyph
  defp get_choice([{glyph,prob}|_], ran) when ran < prob, do: glyph
  defp get_choice([{_,prob}|t], ran), do: get_choice(t, ran - prob)
end

Probabilistic.test


-module(probabilistic_choice).

-export([test/0]).

-define(TRIES, 1000000).

test() ->
	Probs =
		[{aleph,1/5},
		{beth,1/6},
		{gimel,1/7},
		{daleth,1/8},
		{he,1/9},
		{waw,1/10},
		{zayin,1/11},
		{heth,1759/27720}],
    random:seed(now()),
    Trials =
    	[get_choice(Probs,random:uniform()) || _ <- lists:seq(1,?TRIES)],
    [{Glyph,Expected,(length([Glyph || Glyph_ <- Trials, Glyph_ == Glyph])/?TRIES)}
    	 || {Glyph,Expected} <- Probs].

get_choice([{Glyph,_}],_) ->
	Glyph;
get_choice([{Glyph,Prob}|T],Ran) ->
	case (Ran < Prob) of
		true ->
			Glyph;
		false ->
			get_choice(T,Ran - Prob)
	end.


BEGIN # find solutions to the "Prime Triangle" - a triangle of numbers that sum to primes #
    INT max number = 18; # largest number we will consider #
    # construct a primesieve and from that a table of pairs of numbers whose sum is prime #
    [ 0 : 2 * max number ]BOOL prime;
    prime[ 0 ] := prime[ 1 ] := FALSE;
    prime[ 2 ] := TRUE;
    FOR i FROM 3 BY 2 TO UPB prime DO prime[ i ] := TRUE  OD;
    FOR i FROM 4 BY 2 TO UPB prime DO prime[ i ] := FALSE OD;
    FOR i FROM 3 BY 2 TO ENTIER sqrt( UPB prime ) DO
        IF prime[ i ] THEN
            FOR s FROM i * i BY i + i TO UPB prime DO prime[ s ] := FALSE OD
        FI
    OD;
    # returns the number of possible arrangements of the integers for a row in the prime triangle #
    PROC count arrangements = ( INT n )INT:
         IF   n < 2 THEN # no solutions for n < 2 # 0
         ELIF n < 4 THEN
             # for 2 and 3. there is only 1 solution: 1, 2 and 1, 2, 3 #
             FOR i TO n DO print( ( whole( i, -3 ) ) ) OD; print( ( newline ) );
             1
         ELSE
             # 4 or more - must find the solutions #
             BOOL print solution := TRUE;
             [ 0 : n ]BOOL used;
             [ 0 : n ]INT  number;
             # the triangle row must have 1 in the leftmost and n in the rightmost elements #
             # the numbers must alternate between even and odd in order for the sum to be prime #
             FOR i FROM 0 TO n DO
                 used[   i ] := FALSE;
                 number[ i ] := i MOD 2
             OD;
             used[   1 ] := TRUE;
             number[ n ] := n;
             used[   n ] := TRUE;
             # find the intervening numbers and count the solutions #
             INT count := 0;
             INT p     := 2;
             WHILE p > 0 DO
                 INT p1      = number[ p - 1 ];
                 INT current = number[ p     ];
                 INT next   := current + 2;
                 WHILE IF next >= n THEN FALSE ELSE NOT prime[ p1 + next ] OR used[ next ] FI DO
                     next +:= 2
                 OD;
                 IF next >= n THEN next := 0 FI;
                 IF p = n - 1 THEN
                     # we are at the final number before n #
                     # it must be the final even/odd number preceded by the final odd/even number #
                     IF next /= 0 THEN
                         # possible solution #
                         IF prime[ next + n ] THEN
                             # found a solution #
                             count +:= 1;
                             IF print solution THEN
                                 FOR i TO n - 2 DO
                                     print( ( whole( number[ i ], -3 ) ) )
                                 OD;
                                 print( ( whole( next, -3 ), whole( n, - 3 ), newline ) );
                                 print solution := FALSE
                             FI
                         FI;
                         next := 0
                     FI;
                     # backtrack for more solutions #
                     p -:= 1
                     # here will be a further backtrack as next is 0 ( there could only be one possible number at p - 1 ) #
                 FI;
                 IF next /= 0 THEN
                     # have a/another number that can appear at p #
                     used[ current ] := FALSE;
                     used[    next ] := TRUE;
                     number[     p ] := next;
                     p +:= 1
                 ELIF p <= 2 THEN
                     # no more solutions #
                     p := 0
                 ELSE
                     # can't find a number for this position, backtrack #
                     used[ number[ p ] ] := FALSE;
                     number[       p   ] := p MOD 2;
                     p -:= 1
                 FI
             OD;
             count
         FI # count arrangements # ;
    [ 2 : max number ]INT arrangements;
    FOR n FROM LWB arrangements TO UPB arrangements DO
        arrangements[ n ] := count arrangements( n )
    OD;
    FOR n FROM LWB arrangements TO UPB arrangements DO
        print( ( " ", whole( arrangements[ n ], 0 ) ) )
    OD;
    print( ( newline ) )
END


      function icntprop(num  )
      icnt=0
      do i=1 , num-1
          if (mod(num , i)  .eq. 0)  then
          icnt = icnt + 1
          if (num .lt. 11) print *,'    ',i
          end if
          end do
      icntprop =  icnt
      end function

      limit = 20000
      maxcnt = 0
      print *,'N   divisors'
      do j=1,limit,1
      if (j .lt. 11) print *,j
      icnt = icntprop(j)

      if (icnt .gt. maxcnt) then
      maxcnt = icnt
      maxj = j
      end if

      end do

      print *,' '
      print *,' from 1 to ',limit
      print *,maxj,' has max proper divisors: ',maxcnt
      end


' FreeBASIC v1.05.0 win64

Sub ListProperDivisors(limit As Integer)
  If limit < 1 Then Return
  For i As Integer = 1 To limit
     Print Using "##"; i;
     Print " ->";
     If i = 1 Then
       Print " (None)"
       Continue For
     End if
     For j As Integer = 1 To i \ 2
       If i Mod j = 0 Then Print " "; j;
     Next j
     Print
  Next i
End Sub

Function CountProperDivisors(number As Integer) As Integer
  If number < 2 Then Return 0
  Dim count As Integer = 0
  For i As Integer = 1 To number \ 2
    If number Mod i = 0 Then count += 1
  Next
  Return count
End Function

Dim As Integer n, count, most = 1, maxCount = 0

Print "The proper divisors of the following numbers are :"
Print
ListProperDivisors(10)

For n As Integer = 2 To 20000
  count = CountProperDivisors(n)
  If count > maxCount Then
    maxCount = count
    most = n
  EndIf
Next

Print
Print Str(most); " has the most proper divisors, namely"; maxCount
Print
Print "Press any key to exit the program"
Sleep
End


PROGRAM PROB_CHOICE

   DIM ITEM$[7],PROB[7],CNT[7]

BEGIN
   ITEM$[]=("aleph","beth","gimel","daleth","he","waw","zayin","heth")

   PROB[0]=1/5.0  PROB[1]=1/6.0  PROB[2]=1/7.0   PROB[3]=1/8.0
   PROB[4]=1/9.0  PROB[5]=1/10.0 PROB[6]=1/11.0  PROB[7]=1759/27720
   SUM=0
   FOR I%=0 TO UBOUND(PROB,1) DO
      SUM=SUM+PROB[I%]
   END FOR

   IF ABS(SUM-1)>1E-6 THEN
        PRINT("Probabilities don't sum to 1")
      ELSE
        FOR TRIAL=1 TO 1E6 DO
           R=RND(1)
           P=0
           FOR I%=0 TO UBOUND(PROB,1) DO
              P+=PROB[I%]
              IF R<P THEN
                 CNT[I%]+=1
                 EXIT
              END IF
           END FOR
        END FOR
        PRINT("Item        actual    theoretical")
        PRINT("---------------------------------")
        FOR I%=0 TO UBOUND(ITEM$,1) DO
           WRITE("\      \    #.######  #.######";ITEM$[I%],CNT[I%]/1E6,PROB[I%])
        END FOR
   END IF
END PROGRAM


constant MAX = #3FFFFFFF
constant times = 1e6
atom d,e
sequence Mapps
Mapps = {
    { "aleph",  1/5,        0},
    { "beth",   1/6,        0},
    { "gimel",  1/7,        0},
    { "daleth", 1/8,        0},
    { "he",     1/9,        0},
    { "waw",    1/10,       0},
    { "zayin",  1/11,       0},
    { "heth",   1759/27720, 0}
}

for i = 1 to times do
    d = (rand(MAX)-1)/MAX
    e = 0
    for j = 1 to length(Mapps) do
        e += Mapps[j][2]
        if d <= e then
            Mapps[j][3] += 1
            exit
        end if
    end for
end for

printf(1,"Sample times: %d\n",times)
for j = 1 to length(Mapps) do
    d = Mapps[j][3]/times
    printf(1,"%-7s should be %f is %f | Deviatation %6.3f%%\n",
                {Mapps[j][1],Mapps[j][2],d,(1-Mapps[j][2]/d)*100})
end for


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))
        }
      }
}


#include <assert.h>
#include <stdbool.h>
#include <stdio.h>
#include <time.h>

bool is_prime(unsigned int n) {
    assert(n < 64);
    static bool isprime[] = {0, 0, 1, 1, 0, 1, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0,
                             0, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 1,
                             0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 1,
                             0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0};
    return isprime[n];
}

void swap(unsigned int* a, size_t i, size_t j) {
    unsigned int tmp = a[i];
    a[i] = a[j];
    a[j] = tmp;
}

bool prime_triangle_row(unsigned int* a, size_t length) {
    if (length == 2)
        return is_prime(a[0] + a[1]);
    for (size_t i = 1; i + 1 < length; i += 2) {
        if (is_prime(a[0] + a[i])) {
            swap(a, i, 1);
            if (prime_triangle_row(a + 1, length - 1))
                return true;
            swap(a, i, 1);
        }
    }
    return false;
}

int prime_triangle_count(unsigned int* a, size_t length) {
    int count = 0;
    if (length == 2) {
        if (is_prime(a[0] + a[1]))
            ++count;
    } else {
        for (size_t i = 1; i + 1 < length; i += 2) {
            if (is_prime(a[0] + a[i])) {
                swap(a, i, 1);
                count += prime_triangle_count(a + 1, length - 1);
                swap(a, i, 1);
            }
        }
    }
    return count;
}

void print(unsigned int* a, size_t length) {
    if (length == 0)
        return;
    printf("%2u", a[0]);
    for (size_t i = 1; i < length; ++i)
        printf(" %2u", a[i]);
    printf("\n");
}

int main() {
    clock_t start = clock();
    for (unsigned int n = 2; n < 21; ++n) {
        unsigned int a[n];
        for (unsigned int i = 0; i < n; ++i)
            a[i] = i + 1;
        if (prime_triangle_row(a, n))
            print(a, n);
    }
    printf("\n");
    for (unsigned int n = 2; n < 21; ++n) {
        unsigned int a[n];
        for (unsigned int i = 0; i < n; ++i)
            a[i] = i + 1;
        if (n > 2)
            printf(" ");
        printf("%d", prime_triangle_count(a, n));
    }
    printf("\n");
    clock_t end = clock();
    double duration = (end - start + 0.0) / CLOCKS_PER_SEC;
    printf("\nElapsed time: %f seconds\n", duration);
    return 0;
}


Program ProperDivisors;

Uses fgl;

Type
  TIntegerList = Specialize TfpgList<longint>;

Var list : TintegerList;

Function GetProperDivisors(x : longint): longint;
{this function will return the number of proper divisors
 and put them in the list}

Var i : longint;
Begin
  list.clear;
  If x = 1 Then {by default 1 has no proper divisors}
    GetProperDivisors := 0
  Else
    Begin
      list.add(1); //add 1 as a proper divisor;
      i := 2;
      While i * i < x Do
        Begin
          If (x Mod i) = 0 Then //found a proper divisor
            Begin
              list.add(i); // add divisor
              list.add(x Div i); // add result
            End;
          inc(i);
        End;
      If i*i=x Then list.add(i); //make sure to capture the sqrt only once
      GetProperDivisors := list.count;
    End;
End;

Var i,j,count,most : longint;
Begin

  list := TIntegerList.Create;
  For i := 1 To 10 Do
    Begin
      write(i:4,' has ', GetProperDivisors(i),' proper divisors:');
      For j := 0 To pred(list.count) Do
        write(list[j]:3);
      writeln();
    End;
  count := 0; //store highest number of proper divisors
  most := 0;  //store number with highest number of proper divisors
  For i := 1 To 20000 Do
    If GetProperDivisors(i) > count Then
      Begin
        count := list.count;
        most := i;
      End;
  writeln(most,' has ',count,' proper divisors');
  list.free;
End.


USING: arrays assocs combinators.random io kernel macros math
math.statistics prettyprint quotations sequences sorting formatting ;
IN: rosettacode.proba

CONSTANT: data
{
    { "aleph"   1/5.0 }
    { "beth"    1/6.0 }
    { "gimel"   1/7.0 }
    { "daleth"  1/8.0 }
    { "he"      1/9.0 }
    { "waw"     1/10.0 }
    { "zayin"   1/11.0 }
    { "heth"    f }
}

MACRO: case-probas ( data -- case-probas )
    [ first2 [ swap 1quotation 2array ] [ 1quotation ] if* ] map 1quotation ;

: expected ( name data -- float )
    2dup at [ 2nip ] [ nip values sift sum 1 swap - ] if* ;
: generate ( # case-probas -- seq )
    H{ } clone
    [ [ [ casep ] [ inc-at ] bi* ] 2curry times ] keep ; inline
: normalize ( seq # -- seq )
    [ clone ] dip [ /f ] curry assoc-map ;
: summarize1 ( name value data -- )
    [ over ] dip expected
    "%6s: %10f %10f\n" printf ;
: summarize ( generated data -- )
    "Key" "Value" "expected" "%6s  %10s %10s\n" printf
    [ summarize1 ] curry assoc-each ;
: generate-normalized ( # proba -- seq )
    [ generate ] [ drop normalize ] 2bi ; inline
: example ( # data -- )
    [ case-probas generate-normalized ]
    [ summarize ] bi ; inline


trials:=1000000;

Array probs[8];                         {store the probabilities}
[probs]:=[<i=1,8> 1/(i+4)];
probs[8]:=1-Sigma<i=1,7>[probs[i,1]];

Func Round( a, b ) = (2*a+b)\(2*b).;    {rounds a fraction with numerator a and denominator b}
                                   ;    {to the nearest integer (positive fractions only)}

Func Sel =                              {select a number from 1 to 8 according to the}
    r:=Rand|27720;                      {specified probabilities}
    if r < probs[1]*27720 then Return(1) fi;
    if r < Sigma<i=1,2>[probs[i]]*27720 then Return(2) fi;
    if r < Sigma<i=1,3>[probs[i]]*27720 then Return(3) fi;
    if r < Sigma<i=1,4>[probs[i]]*27720 then Return(4) fi;
    if r < Sigma<i=1,5>[probs[i]]*27720 then Return(5) fi;
    if r < Sigma<i=1,6>[probs[i]]*27720 then Return(6) fi;
    if r < Sigma<i=1,7>[probs[i]]*27720 then Return(7) fi;
    Return(8);
.;

Array label[10];                        {strings are not Fermat's strong suit}
Func Letter(n) =                        {assign a Hebrew letter to the numbers 1-8}
                  [label]:='heth     ';
    if n = 1 then [label]:='aleph    '  fi;
    if n = 2 then [label]:='beth     '  fi;
    if n = 3 then [label]:='gimel    '  fi;
    if n = 4 then [label]:='daleth   '  fi;
    if n = 5 then [label]:='he       '  fi;
    if n = 6 then [label]:='waw      '  fi;
    if n = 7 then [label]:='zayin    '  fi;
.;

Array count[8];                         {pick a bunch of random numbers}
for i = 1 to trials do
    s:=Sel;
    count[s]:=count[s]+1;
od;

for i = 1 to 8 do                       {now display some diagnostics}
    Letter(i);
    ctp:=count[i]/trials-probs[i];
    !([label:char, count[i]/trials,' differs from ',probs[i]);
    !(' by ',ctp, ' or about one part in ', Round(Denom(ctp),|Numer(ctp)|));
    !!;
od;

!!('The various probabilities add up to ',Sigma<i=1,8>[count[i]/trials]);   {check if our trials add to 1}


include random.fs

\ common factors of desired probabilities (1/5 .. 1/11)
2 2 * 2 * 3 * 3 * 5 * 7 * 11 * constant denom   \ 27720

\ represent each probability as the numerator with 27720 as the denominator
: ,numerators ( max min -- )
  do denom i / , loop ;

\  final item is 27720 - sum(probs)
: ,remainder ( denom addr len -- )
  cells bounds do  i @ -  1 cells +loop , ;

create probs 12 5 ,numerators  denom probs 7 ,remainder
create bins 8 cells allot

: choose ( -- 0..7 )
  denom random
  8 0 do
    probs i cells + @ -
    dup 0< if drop i unloop exit then
  loop
  abort" can't get here" ;

: trials ( n -- )
  0 do  1  bins choose cells +  +!  loop ;

: str-table
  create ( c-str ... n -- ) 0 do , loop
  does> ( n -- str len ) swap cells + @ count ;

here ," heth"   here ," zayin" here ," waw"  here ," he"
here ," daleth" here ," gimel" here ," beth" here ," aleph"
8 str-table names

: .header
  cr ." Name" #tab emit ." Prob" #tab emit ." Actual" #tab emit ." Error" ;
: .result ( n -- )
  cr dup names type #tab emit
  dup cells probs + @ s>f denom s>f f/ fdup f. #tab emit
  dup cells bins  + @ s>f 1e6       f/ fdup f. #tab emit
  f- fabs fs. ;

: .results   .header 8 0 do i .result loop ;


#include <cassert>
#include <chrono>
#include <iomanip>
#include <iostream>
#include <numeric>
#include <vector>

bool is_prime(unsigned int n) {
    assert(n > 0 && n < 64);
    return (1ULL << n) & 0x28208a20a08a28ac;
}

template <typename Iterator>
bool prime_triangle_row(Iterator begin, Iterator end) {
    if (std::distance(begin, end) == 2)
        return is_prime(*begin + *(begin + 1));
    for (auto i = begin + 1; i + 1 != end; ++i) {
        if (is_prime(*begin + *i)) {
            std::iter_swap(i, begin + 1);
            if (prime_triangle_row(begin + 1, end))
                return true;
            std::iter_swap(i, begin + 1);
        }
    }
    return false;
}

template <typename Iterator>
void prime_triangle_count(Iterator begin, Iterator end, int& count) {
    if (std::distance(begin, end) == 2) {
        if (is_prime(*begin + *(begin + 1)))
            ++count;
        return;
    }
    for (auto i = begin + 1; i + 1 != end; ++i) {
        if (is_prime(*begin + *i)) {
            std::iter_swap(i, begin + 1);
            prime_triangle_count(begin + 1, end, count);
            std::iter_swap(i, begin + 1);
        }
    }
}

template <typename Iterator>
void print(Iterator begin, Iterator end) {
    if (begin == end)
        return;
    auto i = begin;
    std::cout << std::setw(2) << *i++;
    for (; i != end; ++i)
        std::cout << ' ' << std::setw(2) << *i;
    std::cout << '\n';
}

int main() {
    auto start = std::chrono::high_resolution_clock::now();
    for (unsigned int n = 2; n < 21; ++n) {
        std::vector<unsigned int> v(n);
        std::iota(v.begin(), v.end(), 1);
        if (prime_triangle_row(v.begin(), v.end()))
            print(v.begin(), v.end());
    }
    std::cout << '\n';
    for (unsigned int n = 2; n < 21; ++n) {
        std::vector<unsigned int> v(n);
        std::iota(v.begin(), v.end(), 1);
        int count = 0;
        prime_triangle_count(v.begin(), v.end(), count);
        if (n > 2)
            std::cout << ' ';
        std::cout << count;
    }
    std::cout << '\n';
    auto end = std::chrono::high_resolution_clock::now();
    std::chrono::duration<double> duration(end - start);
    std::cout << "\nElapsed time: " << duration.count() << " seconds\n";
}


for n = 1 to 10
   println["$n\t" + join[" ", properDivisors[n]]]

println[]

d = new dict
for n = 1 to 20000
{
   c = length[properDivisors[n]]
   d.addToList[c, n]
}

most = max[keys[d]]
println[[email protected] + " have $most factors"]

properDivisors[n] := allFactors[n, true, false, true]


OPENW 1
CLEARW 1
'
' Array f% is used to hold the divisors
DIM f%(SQR(20000)) ! cannot redim arrays, so set size to largest needed
'
' 1. Show proper divisors of 1 to 10, inclusive
'
FOR i%=1 TO 10
  num%[email protected]_divisors(i%)
  PRINT "Divisors for ";i%;":";
  FOR j%=1 TO num%
    PRINT " ";f%(j%);
  NEXT j%
  PRINT
NEXT i%
'
' 2. Find (smallest) number <= 20000 with largest number of proper divisors
'
result%=1 ! largest so far
number%=0 ! its number of divisors
FOR i%=1 TO 20000
  num%[email protected]_divisors(i%)
  IF num%>number%
    result%=i%
    number%=num%
  ENDIF
NEXT i%
PRINT "Largest number of divisors is ";number%;" for ";result%
'
~INP(2)
CLOSEW 1
'
' find the proper divisors of n%, placing results in f%
' and return the number found
'
FUNCTION proper_divisors(n%)
  LOCAL i%,root%,count%
  '
  ARRAYFILL f%(),0
  count%=1 ! index of next slot in f% to fill
  '
  IF n%>1
    f%(count%)=1
    count%=count%+1
    root%=SQR(n%)
    FOR i%=2 TO root%
      IF n% MOD i%=0
        f%(count%)=i%
        count%=count%+1
        IF i%*i%<>n% ! root% is an integer, so check if i% is actual squa- lists:seq(1,10)].
X: 1, N: []
X: 2, N: [1]
X: 3, N: [1]
X: 4, N: [1,2]
X: 5, N: [1]
X: 6, N: [1,2,3]
X: 7, N: [1]
X: 8, N: [1,2,4]
X: 9, N: [1,3]
X: 10, N: [1,2,5]
[ok,ok,ok,ok,ok,ok,ok,ok,ok,ok]

2> properdivs:longest(20000).
With 79, Number 15120 has the most divisors
re root of n%
          f%(count%)=n%/i%
          count%=count%+1
        ENDIF
      ENDIF
    NEXT i%
  ENDIF
  '
  RETURN count%-1
ENDFUNC


PROGRAM PROBS

  IMPLICIT NONE

  INTEGER, PARAMETER :: trials = 1000000
  INTEGER :: i, j, probcount(8) = 0
  REAL :: expected(8), mapping(8), rnum
  CHARACTER(6) :: items(8) = (/ "aleph ", "beth  ", "gimel ", "daleth", "he    ", "waw   ", "zayin ", "heth  " /)

  expected(1:7) = (/ (1.0/i, i=5,11) /)
  expected(8) = 1.0 - SUM(expected(1:7))
  mapping(1) = 1.0 / 5.0
  DO i = 2, 7
     mapping(i) = mapping(i-1) + 1.0/(i+4.0)
  END DO
  mapping(8) = 1.0

  DO i = 1, trials
     CALL RANDOM_NUMBER(rnum)
     DO j = 1, 8
        IF (rnum < mapping(j)) THEN
           probcount(j) = probcount(j) + 1
           EXIT
        END IF
     END DO
  END DO

  WRITE(*, "(A,I10)") "Trials:             ", trials
  WRITE(*, "(A,8A10)") "Items:             ", items
  WRITE(*, "(A,8F10.6)") "Target Probability:  ", expected
  WRITE(*, "(A,8F10.6)") "Attained Probability:", REAL(probcount) / REAL(trials)

ENDPROGRAM PROBS


import Foundation

struct Circle {
    let center:[Double]!
    let radius:Double!

    init(center:[Double], radius:Double) {
        self.center = center
        self.radius = radius
    }

    func toString() -> String {
        return "Circle[x=\(center[0]),y=\(center[1]),r=\(radius)]"
    }
}

func solveApollonius(c1:Circle, c2:Circle, c3:Circle,
    s1:Double, s2:Double, s3:Double) -> Circle {

        let x1 = c1.center[0]
        let y1 = c1.center[1]
        let r1 = c1.radius
        let x2 = c2.center[0]
        let y2 = c2.center[1]
        let r2 = c2.radius
        let x3 = c3.center[0]
        let y3 = c3.center[1]
        let r3 = c3.radius

        let v11 = 2*x2 - 2*x1
        let v12 = 2*y2 - 2*y1
        let v13 = x1*x1 - x2*x2 + y1*y1 - y2*y2 - r1*r1 + r2*r2
        let v14 = 2*s2*r2 - 2*s1*r1

        let v21 = 2*x3 - 2*x2
        let v22 = 2*y3 - 2*y2
        let v23 = x2*x2 - x3*x3 + y2*y2 - y3*y3 - r2*r2 + r3*r3
        let v24 = 2*s3*r3 - 2*s2*r2

        let w12 = v12/v11
        let w13 = v13/v11
        let w14 = v14/v11

        let w22 = v22/v21-w12
        let w23 = v23/v21-w13
        let w24 = v24/v21-w14

        let P = -w23/w22
        let Q = w24/w22
        let M = -w12*P-w13
        let N = w14 - w12*Q

        let a = N*N + Q*Q - 1
        let b = 2*M*N - 2*N*x1 + 2*P*Q - 2*Q*y1 + 2*s1*r1
        let c = x1*x1 + M*M - 2*M*x1 + P*P + y1*y1 - 2*P*y1 - r1*r1

        let D = b*b-4*a*c

        let rs = (-b - sqrt(D)) / (2*a)
        let xs = M + N * rs
        let ys = P + Q * rs

        return  Circle(center: [xs,ys], radius: rs)

}

let c1 = Circle(center: [0,0], radius: 1)
let c2 = Circle(center: [4,0], radius: 1)
let c3 = Circle(center: [2,4], radius: 2)

println(solveApollonius(c1,c2,c3,1,1,1).toString())
println(solveApollonius(c1,c2,c3,-1,-1,-1).toString())


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]
}


// Prime triangle. Nigel Galloway: April 12th., 2022
let     fN i (g,(e,l))=e|>Seq.map(fun n->let n=i n in (n::g,List.partition(i>>(=)n) l))
let rec fG n g=function 0->n|>Seq.map fst |x->fG(n|>Seq.collect(fN(if g then fst else snd)))(not g)(x-1)
let primeT row=fG [([1],([for g in {2..2..row-1} do if isPrime(g+1) then yield (1,g)],[for n in {3..2..row-1} do for g in {2..2..row-1} do if isPrime(n+g) then yield (n,g)]))] false (row-2)
                 |>Seq.filter(List.head>>(+)row>>isPrime)|>Seq.map(fun n->row::n|>List.rev)

{2..20}|>Seq.iter(fun n->(primeT>>Seq.head>>List.iter(printf "%3d"))n;printfn "");;
{2..20}|>Seq.iter(primeT>>Seq.length>>printf "%d "); printfn ""


package main

import "fmt"

var canFollow [][]bool
var arrang []int
var bFirst = true

var pmap = make(map[int]bool)

func init() {
    for _, i := range []int{2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37} {
        pmap[i] = true
    }
}

func ptrs(res, n, done int) int {
    ad := arrang[done-1]
    if n-done <= 1 {
        if canFollow[ad-1][n-1] {
            if bFirst {
                for _, e := range arrang {
                    fmt.Printf("%2d ", e)
                }
                fmt.Println()
                bFirst = false
            }
            res++
        }
    } else {
        done++
        for i := done - 1; i <= n-2; i += 2 {
            ai := arrang[i]
            if canFollow[ad-1][ai-1] {
                arrang[i], arrang[done-1] = arrang[done-1], arrang[i]
                res = ptrs(res, n, done)
                arrang[i], arrang[done-1] = arrang[done-1], arrang[i]
            }
        }
    }
    return res
}

func primeTriangle(n int) int {
    canFollow = make([][]bool, n)
    for i := 0; i < n; i++ {
        canFollow[i] = make([]bool, n)
        for j := 0; j < n; j++ {
            _, ok := pmap[i+j+2]
            canFollow[i][j] = ok
        }
    }
    bFirst = true
    arrang = make([]int, n)
    for i := 0; i < n; i++ {
        arrang[i] = i + 1
    }
    return ptrs(0, n, 1)
}

func main() {
    counts := make([]int, 19)
    for i := 2; i <= 20; i++ {
        counts[i-2] = primeTriangle(i)
    }
    fmt.Println()
    for i := 0; i < 19; i++ {
        fmt.Printf("%d ", counts[i])
    }
    fmt.Println()
}


package main

import (
    "fmt"
    "strconv"
)

func listProperDivisors(limit int) {
    if limit < 1 {
        return
    }
    width := len(strconv.Itoa(limit))
    for i := 1; i <= limit; i++ {
        fmt.Printf("%*d -> ", width, i)
        if i == 1 {
            fmt.Println("(None)")
            continue
        }
        for j := 1; j <= i/2; j++ {
            if i%j == 0 {
                fmt.Printf(" %d", j)
            }
        }
        fmt.Println()
    }
}

func countProperDivisors(n int) int {
    if n < 2 {
        return 0
    }
    count := 0
    for i := 1; i <= n/2; i++ {
        if n%i == 0 {
            count++
        }
    }
    return count
}

func main() {
    fmt.Println("The proper divisors of the following numbers are :\n")
    listProperDivisors(10)
    fmt.Println()
    maxCount := 0
    most := []int{1}
    for n := 2; n <= 20000; n++ {
        count := countProperDivisors(n)
        if count == maxCount {
            most = append(most, n)
        } else if count > maxCount {
            maxCount = count
            most = most[0:1]
            most[0] = n
        }
    }
    fmt.Print("The following number(s) <= 20000 have the most proper divisors, ")
    fmt.Println("namely", maxCount, "\b\n")
    for _, n := range most {
        fmt.Println(n)
    }
}


' FB 1.05.0 Win64

Dim letters  (0 To 7) As String = {"aleph", "beth", "gimel", "daleth", "he", "waw", "zayin", "heth"}
Dim actual   (0 To 7) As Integer '' all zero by default
Dim probs (0 To 7)    As Double = {1/5.0, 1/6.0, 1/7.0, 1/8.0, 1/9.0, 1/10.0, 1/11.0}
Dim cumProbs (0 To 7) As Double

cumProbs(0) = probs(0)
For i As Integer = 1 To 6
  cumProbs(i) = cumProbs(i - 1) + probs(i)
Next
cumProbs(7) = 1.0
probs(7) = 1.0 - cumProbs(6)

Randomize
Dim rand As Double
Dim n As Double = 1000000
Dim sum As Double = 0.0

For i As Integer = 1 To n
  rand = Rnd  '' random number where 0 <= rand < 1
  Select case rand
    Case Is <= cumProbs(0)
      actual(0) += 1
    Case Is <= cumProbs(1)
      actual(1) += 1
    Case Is <= cumProbs(2)
      actual(2) += 1
    Case Is <= cumProbs(3)
      actual(3) += 1
    Case Is <= cumProbs(4)
      actual(4) += 1
    Case Is <= cumProbs(5)
      actual(5) += 1
    Case Is <= cumProbs(6)
      actual(6) += 1
    Case Else
      actual(7) += 1
  End Select
Next

Dim sumActual As Double = 0

Print "Letter", " Actual", "Expected"
Print "------", "--------", "--------"
For i As Integer = 0 To 7
  Print letters(i),
  Print Using "#.######"; actual(i)/n;
  sumActual += actual(i)/n
  Print , Using "#.######"; probs(i)
Next

Print , "--------", "--------"
Print , Using "#.######"; sumActual;
Print , Using "#.######"; 1.000000

Print
Print "Press any key to quit"
Sleep