/*REXX program computes some  primorial numbers  for low numbers,  and for various 10^n.*/
parse arg N H .                                  /*get optional arguments:  N,  L,  H   */
if N=='' | N==','  then N=     10                /*Not specified?  Then use the default.*/
if H=='' | H==','  then H= 100000                /* "      "         "   "   "     "    */
numeric digits 600000                            /*be able to handle gihugic numbers.   */
w= length( commas( digits() ) )                  /*W:  width of the largest commatized #*/
@.=.; @.0= 1;  @.1= 2;  @.2= 3;  @.3=  5; @.4=  7; @.5=  11; @.6=  13 /*some low primes.*/
               s.1= 4;  s.2= 9;  s.3= 25; s.4= 49; s.5= 121; s.6= 169 /*squared primes. */
#= 6                                                                  /*number of primes*/
     do j=0  for N                               /*calculate the first  N  primorial #s.*/
     say right(j, length(N))th(j)   " primorial is: "    right(commas(primorial(j) ), N+2)
     end   /*j*/
say
iw= length( commas(H) ) + 2                      /*IW: width of largest commatized index*/
p= 1                                             /*initialize the first multiplier for P*/
     do k=1  for H                               /*process a large range of numbers.    */
     p= p * prime(k)                             /*calculate the next primorial number. */
     parse var  k   L  2  ''  -1  R              /*get the left and rightmost dec digits*/
     if R\==0              then iterate          /*if right─most decimal digit\==0, skip*/
     if L\==1              then iterate          /* "  left─most    "      "  \==1,   " */
     if strip(k, , 0)\==1  then iterate          /*Not a power of 10?  Then skip this K.*/
     say right( commas(k), iw)th(k)     ' primorial number length in decimal digits is:' ,
                                                           right( commas( length(p) ), w)
     end   /*k*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
commas:  parse arg _;  do ?=length(_)-3  to 1  by -3; _=insert(',', _, ?); end;   return _
th:      parse arg th; return word('th st nd rd', 1+ (th//10)*(th//100%10\==1)*(th//10<4))
/*──────────────────────────────────────────────────────────────────────────────────────*/
primorial: procedure expose @. s. #;  parse arg y;    != 1         /*obtain the arg  Y. */
               do p=0  to y;   != ! * prime(p)                     /*calculate product. */
               end   /*p*/;                           return !     /*return with the #. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
prime: procedure expose @. s. #; parse arg n;  if @.n\==.  then return @.n
       numeric digits 9                                             /*limit digs to min.*/
         do [email protected].#+2  by 2                                           /*start looking at #*/
         if j//2==0  then iterate;     if j//3==0    then iterate   /*divisible by 2│3 ?*/
         parse var  j   ''  -1  _;     if _==5       then iterate   /*right─most dig≡5? */
         if j//7==0  then iterate;     if j//11==0   then iterate   /*divisible by 7│11?*/
             do k=6  while s.k<=j;     if j//@.k==0  then iterate j /*divide by primes. */
             end   /*k*/
         #= # + 1;         @.#= j;     s.#= j * j;        return j  /*next prime; return*/
         end     /*j*/


# Project: Primorial numbers
load "bignumber.ring"
decimals(0)
num = 0
prim = 0
limit = 10000000
see "working..." + nl
see "wait for done..." + nl
while num < 100001
    prim = prim + 1
    prime = []
    primorial(prim)
end
see "done..." + nl

func primorial(pr)
     n = 1
     n2 = 0
     flag = 1
     while flag = 1 and n < limit
           nr = isPrime(n)
           if n=1
              nr=1
           ok
           if nr=1
              n2 = n2 + 1
              add(prime,n)
           ok
           if n2=pr
              flag=0
              num = num + 1
           ok
           n = n + 1
     end
     pro = 1
     str = ""
     for n=1 to len(prime)
         pro = FuncMultiply("" + pro,"" + prime[n])
         str = str + prime[n] + "*"
     next
     str = left(str,len(str)-1)
     if pr < 11
        see "primorial(" + string(pr-1) + ") : " + pro + nl
     ok
     if pr = 11
        see "primorial(" + string(pr-1) + ") " + "has " + len(pro) + " digits"+ nl
     but pr = 101
        see "primorial(" + string(pr-1) + ") " + "has " + len(pro) + " digits"+ nl
     but pr = 1001
         see "primorial(" + string(pr-1) + ") " + "has " + len(pro) + " digits"+ nl
     but pr = 10001
         see "primorial(" + string(pr-1) + ") " + "has " + len(pro) + " digits"+ nl
     but pr = 100001
         see "primorial(" + string(pr-1) + ") " + "has " + len(pro) + " digits"+ nl
     ok


require 'prime'

def primorial_number(n)
  pgen = Prime.each
  (1..n).inject(1){|p,_| p*pgen.next}
end

puts "First ten primorials: #{(0..9).map{|n| primorial_number(n)}}"

(1..5).each do |n|
  puts "primorial(10**#{n}) has #{primorial_number(10**n).to_s.size} digits"
end


extern crate primal;
extern crate rayon;
extern crate rug;

use rayon::prelude::*;
use rug::Integer;

fn partial(p1 : usize, p2 : usize) -> String {
    let mut aux = Integer::from(1);
    let (_, hi) = primal::estimate_nth_prime(p2 as u64);
    let sieve = primal::Sieve::new(hi as usize);
    let prime1 = sieve.nth_prime(p1);
    let prime2 = sieve.nth_prime(p2);

    for i in sieve.primes_from(prime1).take_while(|i| *i <= prime2) {
        aux = Integer::from(aux * i as u32);
    }
    aux.to_string_radix(10)
}

fn main() {
    let mut j1 = Integer::new();
    for k in [2,3,5,7,11,13,17,19,23,29].iter() {
        j1.assign_primorial(*k);
        println!("Primorial : {}", j1);
    }
    println!("Digits of primorial 10 : {}", partial(1, 10).chars().fold(0, |n, _| n + 1));
    println!("Digits of primorial 100 : {}", partial(1, 100).chars().fold(0, |n, _| n + 1));
    println!("Digits of primorial 1_000 : {}", partial(1, 1_000).chars().fold(0, |n, _| n + 1));
    println!("Digits of primorial 10_000 : {}", partial(1, 10_000).chars().fold(0, |n, _| n + 1));
    println!("Digits of primorial 100_000 : {}", partial(1, 100_000).chars().fold(0, |n, _| n + 1));

    let mut auxi = Integer::from(1);
    let ranges = vec![[1, 300_000], [300_001, 550_000], [550_001, 800_000], [800_001, 1_000_000]];
    let v = ranges.par_iter().map(|value| partial(value[0], value[1])).collect::<Vec<_>>();
    for i in v.iter() {
        auxi =Integer::from(&auxi * i.parse::<Integer>().unwrap());
    }
    let result = auxi.to_string_radix(10).chars().fold(0, |n, _| n+1);
    println!("Digits of primorial 1_000_000 : {}",result);
}


import spire.math.SafeLong
import spire.implicits._

import scala.collection.parallel.immutable.ParVector

object Primorial {
  def main(args: Array[String]): Unit = {
    println(
      s"""|First 10 Primorials:
          |${LazyList.range(0, 10).map(n => f"$n: ${primorial(n).toBigInt}%,d").mkString("\n")}
          |
          |Lengths of Primorials:
          |${LazyList.range(1, 7).map(math.pow(10, _).toInt).map(i => f"$i%,d: ${primorial(i).toString.length}%,d").mkString("\n")}
          |""".stripMargin)
  }

  def primorial(num: Int): SafeLong = if(num == 0) 1 else primesSL.take(num).to(ParVector).reduce(_*_)
  lazy val primesSL: Vector[SafeLong] = 2 +: ParVector.range(3, 20000000, 2).filter(n => !Iterator.range(3, math.sqrt(n).toInt + 1, 2).exists(n%_ == 0)).toVector.sorted.map(SafeLong(_))
}


say (
    'First ten primorials: ',
    {|i| pn_primorial(i) }.map(^10).join(', ')
)

{ |i|
    say ("primorial(10^#{i}) has " + pn_primorial(10**i).len + ' digits')
} << 1..6


import "/big" for BigInt
import "/math" for Int
import "/fmt" for Fmt

var vecprod = Fn.new { |primes|
    var le = primes.count
    if (le == 0) return BigInt.one
    var s = List.filled(le, null)
    for (i in 0...le) s[i] = BigInt.new(primes[i])
    while (le > 1) {
        var c = (le/2).floor
        for(i in 0...c) s[i] = s[i] * s[le-i-1]
        if (le & 1 ==  1) c = c + 1
        le  = c
    }
    return s[0]
}

var primes = Int.primeSieve(1.3e6) // enough to generate first 100,000 primes
var prod = 1
System.print("The first ten primorial numbers are:")
for (i in 0..9) {
    System.print("%(i):  %(prod)")
    prod = prod * primes[i]
}

System.print("\nThe following primorials have the lengths shown:")
// first multiply the first 100,000 primes together in pairs to reduce BigInt conversions needed
var primes2 = List.filled(50000, 0)
for (i in 0...50000) primes2[i] = primes[2*i] * primes[2*i+1]
for (i in [10, 100, 1000, 10000, 100000]) {
    Fmt.print("$6d:  $d", i, vecprod.call(primes2[0...i/2]).toString.count)
}


sieve:=Import("sieve.zkl",False,False,False).postponed_sieve;
primes:=Utils.Generator(sieve).walk(0d10);  // first 10 primes
foreach n in (10)
   { primes[0,n].reduce('*,1):println("primorial(%d)=%d".fmt(n,_)); }

var [const] BN=Import("zklBigNum");
primes:=Utils.Generator(sieve).walk(0d1_000_000);
foreach n in ([1..6]){ n=(10).pow(n);
   primes[0,n].pump(BN(1).mul)
   :println("primorial(%,d)=%,d digits".fmt(n,_.numDigits));
}


V maxsum = 99

F get_primes(max)
   V lprimes = [2]
   L(x) (3..max).step(2)
      L(p) lprimes
         I x % p == 0
            L.break
      L.was_no_break
         lprimes.append(x)
   R lprimes

V descendants = [[Int64]()] * (maxsum + 1)
V ancestors   = [[Int64]()] * (maxsum + 1)

V primes = get_primes(maxsum)

L(p) primes
   descendants[p].append(p)
   L(s) 1 .< descendants.len - p
      descendants[s + p] [+]= descendants[s].map(pr -> @p * pr)

L(p) primes [+] [4]
   descendants[p].pop()

V total = 0
L(s) 1..maxsum
   descendants[s].sort()
   L(d) descendants[s]
      I d > maxsum
         L.break
      ancestors[Int(d)] = ancestors[s] [+] [Int64(s)]
   print([s]‘ Level: ’ancestors[s].len)
   print(‘Ancestors: ’(I !ancestors[s].empty {String(ancestors[s])} E ‘None’))
   print(‘Descendants: ’(I !descendants[s].empty {String(descendants[s].len)} E ‘None’))
   I !descendants[s].empty
      print(descendants[s])
   print()
   total += descendants[s].len

print(‘Total descendants ’total)


#Warn
#SingleInstance force
#NoEnv            ; Recommended for performance and compatibility with future AutoHotkey releases.
SendMode Input    ; Recommended for new scripts due to its superior speed and reliability.
SetBatchLines, -1
SetFormat, IntegerFast, D

MaxPrime    = 99		; upper bound for the prime factors
MaxAncestor = 99		; greatest parent number

Descendants := []

Primes := GetPrimes(MaxPrime)
Exclusions := Primes.Clone()
Exclusions.Insert(4)

if A_Is64bitOS
{
	Loop, % MaxAncestor
		Descendants.Insert({})

	for i, Prime in Primes
	{
		Descendants[Prime, Prime] := 0

		for Parent, Children in Descendants
		{
			if ((Sum := Parent+Prime) > MaxAncestor)
				break

			for pr in Children
				Descendants[Sum, pr*Prime] := 0
		}
	}

	for i, v in Exclusions
		Descendants[v].Remove(v, "")
}
else
{
	Loop, % MaxAncestor
		Descendants.Insert([])

	for i, Prime in Primes
	{
		Descendants[Prime].Insert(Prime)

		for Parent, Children in Descendants
		{
			if ((Sum := Parent+Prime) > MaxAncestor)
				break

			for j, pr in Children
				Descendants[Sum].Insert(pr*Prime)
		}
	}

	for i, v in Exclusions
		Descendants[v].Remove()
}

if (MaxAncestor > MaxPrime)
	Primes := GetPrimes(MaxAncestor)

IfExist, %A_ScriptName%.txt
	FileDelete, %A_ScriptName%.txt

;-------------------------------------------------------
; Arrays :
; Integer keys are stored using the native integer type
; 32bit key max = 2.147.483.647
; 64bit key max = 9.223.372.036.854.775.807
;-------------------------------------------------------
Tot_desc = 0
for Parent, Children in Descendants
{
	ls_desc =
	if A_Is64bitOS
	{
		nb_desc = 0
		for pr in Children
			ls_desc .= ", " pr, nb_desc++
		ls_desc := LTrim(ls_desc, ", ")
	}
	else
	{
		nb_desc := Children.MaxIndex()
		for i, pr in Children
			ls_desc .= "," pr
		ls_desc := LTrim(ls_desc, ",")

		Sort, ls_desc, N D`,
		StringReplace, ls_desc, ls_desc, `,,`,%A_Space%, All
	}

	ls_anc =
	nb_anc := GetAncestors(ls_anc, Parent)
	ls_anc := LTrim(ls_anc, ", ")

	FileAppend, % "[" Parent "] Level: " nb_anc "`r`nAncestors: " (nb_anc ? ls_anc : "None") "`r`n"
				 , %A_ScriptName%.txt

	if nb_desc
	{
		Tot_desc += nb_desc
		FileAppend, % "Descendants: " nb_desc "`r`n" ls_desc "`r`n`r`n", %A_ScriptName%.txt
	}
	else
		FileAppend, % "Descendants: None`r`n`r`n", %A_ScriptName%.txt
}

FileAppend, % "Total descendants " Tot_desc, %A_ScriptName%.txt
return

GetAncestors(ByRef _lsAnc, _child)
{
	global Primes

	lChild := _child
	lIndex := lParent := 0

	while lChild > 1
	{
		lPrime := Primes[++lIndex]
		while !mod(lChild, lPrime)
			lChild //= lPrime, lParent += lPrime
	}

	if (lParent = _child or _child = 1)
		return 0

	_lsAnc := ", " lParent _lsAnc
	li := GetAncestors(_lsAnc, lParent)
	return ++li
}

GetPrimes(_maxPrime=0, _nbrPrime=0)
{
	lPrimes := []

	if (_maxPrime >= 2 or _nbrPrime >= 1)
	{
		lPrimes.Insert(2)
		lValue = 1

		while (lValue += 2) <= _maxPrime or lPrimes.MaxIndex() < _nbrPrime
		{
			lMaxPrime := Floor(Sqrt(lValue))

			for lKey, lPrime in lPrimes
			{
				if (lPrime > lMaxPrime)		; if prime divisor is greater than Floor(Sqrt(lValue))
				{
					lPrimes.Insert(lValue)
					break
				}

				if !Mod(lValue, lPrime)
					break
			}
		}
	}

	return lPrimes
}


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

#define MAXPRIME 99						// upper bound for the prime factors
#define MAXPARENT 99					// greatest parent number
#define NBRPRIMES 30					// max number of prime factors
#define NBRANCESTORS 10					// max number of parent's ancestors

FILE *FileOut;
char format[] = ", %lld";

int Primes[NBRPRIMES];					// table of the prime factors
int iPrimes;							// max index of the prime factor table

short Ancestors[NBRANCESTORS];			// table of the parent's ancestors

struct Children {
	long long Child;
	struct Children *pNext;
};
struct Children *Parents[MAXPARENT+1][2];	// table pointing to the root and to the last descendants (per parent)
int CptDescendants[MAXPARENT+1];			// counter table of the descendants (per parent)
long long MaxDescendant = (long long) pow(3.0, 33.0);	// greatest descendant number

short GetParent(long long child);
struct Children *AppendChild(struct Children *node, long long child);
short GetAncestors(short child);
void PrintDescendants(struct Children *node);
int GetPrimes(int primes[], int maxPrime);

int main()
{
	long long Child;
	short i, Parent, Level;
	int TotDesc = 0;

	if ((iPrimes = GetPrimes(Primes, MAXPRIME)) < 0)
		return 1;

	for (Child = 1; Child <= MaxDescendant; Child++)
	{
		if (Parent = GetParent(Child))
		{
			Parents[Parent][1] = AppendChild(Parents[Parent][1], Child);
			if (Parents[Parent][0] == NULL)
				Parents[Parent][0] = Parents[Parent][1];
			CptDescendants[Parent]++;
		}
	}

	if (MAXPARENT > MAXPRIME)
		if (GetPrimes(Primes, MAXPARENT) < 0)
			return 1;

	if (fopen_s(&FileOut, "Ancestors.txt", "w"))
		return 1;

	for (Parent = 1; Parent <= MAXPARENT; Parent++)
	{
		Level = GetAncestors(Parent);

		fprintf(FileOut, "[%d] Level: %d\n", Parent, Level);

		if (Level)
		{
			fprintf(FileOut, "Ancestors: %d", Ancestors[0]);

			for (i = 1; i < Level; i++)
				fprintf(FileOut, ", %d", Ancestors[i]);
		}
		else
			fprintf(FileOut, "Ancestors: None");

		if (CptDescendants[Parent])
		{
			fprintf(FileOut, "\nDescendants: %d\n", CptDescendants[Parent]);
			strcpy_s(format, "%lld");
			PrintDescendants(Parents[Parent][0]);
			fprintf(FileOut, "\n");
		}
		else
			fprintf(FileOut, "\nDescendants: None\n");

		fprintf(FileOut, "\n");
		TotDesc += CptDescendants[Parent];
	}

	fprintf(FileOut, "Total descendants %d\n\n", TotDesc);
	if (fclose(FileOut))
		return 1;

	return 0;
}

short GetParent(long long child)
{
	long long Child = child;
	short Parent = 0;
	short Index = 0;

	while (Child > 1 && Parent <= MAXPARENT)
	{
		if (Index > iPrimes)
			return 0;

		while (Child % Primes[Index] == 0)
		{
			Child /= Primes[Index];
			Parent += Primes[Index];
		}

		Index++;
	}

	if (Parent == child || Parent > MAXPARENT || child == 1)
		return 0;

	return Parent;
}

struct Children *AppendChild(struct Children *node, long long child)
{
	static struct Children *NodeNew;

	if (NodeNew = (struct Children *) malloc(sizeof(struct Children)))
	{
		NodeNew->Child = child;
		NodeNew->pNext = NULL;
		if (node != NULL)
			node->pNext = NodeNew;
	}

	return NodeNew;
}

short GetAncestors(short child)
{
	short Child = child;
	short Parent = 0;
	short Index = 0;

	while (Child > 1)
	{
		while (Child % Primes[Index] == 0)
		{
			Child /= Primes[Index];
			Parent += Primes[Index];
		}

		Index++;
	}

	if (Parent == child || child == 1)
		return 0;

	Index = GetAncestors(Parent);

	Ancestors[Index] = Parent;
	return ++Index;
}

void PrintDescendants(struct Children *node)
{
	static struct Children *NodeCurr;
	static struct Children *NodePrev;

	NodeCurr = node;
	NodePrev = NULL;
	while (NodeCurr)
	{
		fprintf(FileOut, format, NodeCurr->Child);
		strcpy_s(format, ", %lld");
		NodePrev = NodeCurr;
		NodeCurr = NodeCurr->pNext;
		free(NodePrev);
	}

	return;
}

int GetPrimes(int primes[], int maxPrime)
{
	if (maxPrime < 2)
		return -1;

	int Index = 0, Value = 1;
	int Max, i;

	primes[0] = 2;

	while ((Value += 2) <= maxPrime)
	{
		Max = (int) floor(sqrt((double) Value));

		for (i = 0; i <= Index; i++)
		{
			if (primes[i] > Max)
			{
				if (++Index >= NBRPRIMES)
					return -1;

				primes[Index] = Value;
				break;
			}

			if (Value % primes[i] == 0)
				break;
		}
	}

	return Index;
}


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

typedef unsigned long long integer;

// returns all ancestors of n. n is not its own ancestor.
std::vector<integer> get_ancestors(const std::vector<integer>& ancestor, integer n) {
    std::vector<integer> result;
    for (integer a = ancestor[n]; a != 0 && a != n; ) {
        n = a;
        a = ancestor[n];
        result.push_back(n);
    }
    return result;
}

void print_vector(const std::vector<integer>& vec) {
    if (vec.empty()) {
        std::cout << "none\n";
        return;
    }
    auto i = vec.begin();
    std::cout << *i++;
    for (; i != vec.end(); ++i)
        std::cout << ", " << *i;
    std::cout << '\n';
}

bool is_prime(integer n) {
    if (n < 2)
        return false;
    if (n % 2 == 0)
        return n == 2;
    for (integer p = 3; p * p <= n; p += 2) {
        if (n % p == 0)
            return false;
    }
    return true;
}

int main(int argc, char** argv) {
    const size_t limit = 100;

    std::vector<integer> ancestor(limit, 0);
    std::vector<std::vector<integer>> descendants(limit);

    for (size_t prime = 0; prime < limit; ++prime) {
        if (!is_prime(prime))
            continue;
        descendants[prime].push_back(prime);
        for (size_t i = 0; i + prime < limit; ++i) {
            integer s = i + prime;
            for (integer n : descendants[i]) {
                integer prod = n * prime;
                descendants[s].push_back(prod);
                if (prod < limit)
                    ancestor[prod] = s;
            }
        }
    }

    // print the results
    size_t total_descendants = 0;
    for (integer i = 1; i < limit; ++i) {
        std::vector<integer> ancestors(get_ancestors(ancestor, i));
        std::cout << "[" << i << "] Level: " << ancestors.size() << '\n';
        std::cout << "Ancestors: ";
        std::sort(ancestors.begin(), ancestors.end());
        print_vector(ancestors);

        std::cout << "Descendants: ";
        std::vector<integer>& desc = descendants[i];
        if (!desc.empty()) {
            std::sort(desc.begin(), desc.end());
            if (desc[0] == i)
                desc.erase(desc.begin());
        }
        std::cout << desc.size() << '\n';
        total_descendants += desc.size();
        if (!desc.empty())
            print_vector(desc);
        std::cout << '\n';
    }
    std::cout << "Total descendants: " << total_descendants << '\n';
    return 0;
}


package main

import (
    "fmt"
    "sort"
)

func getPrimes(max int) []int {
    if max < 2 {
        return []int{}
    }
    lprimes := []int{2}
outer:
    for x := 3; x <= max; x += 2 {
        for _, p := range lprimes {
            if x%p == 0 {
                continue outer
            }
        }
        lprimes = append(lprimes, x)
    }
    return lprimes
}

func main() {
    const maxSum = 99
    descendants := make([][]int64, maxSum+1)
    ancestors := make([][]int, maxSum+1)
    for i := 0; i <= maxSum; i++ {
        descendants[i] = []int64{}
        ancestors[i] = []int{}
    }
    primes := getPrimes(maxSum)

    for _, p := range primes {
        descendants[p] = append(descendants[p], int64(p))
        for s := 1; s < len(descendants)-p; s++ {
            temp := make([]int64, len(descendants[s]))
            for i := 0; i < len(descendants[s]); i++ {
                temp[i] = int64(p) * descendants[s][i]
            }
            descendants[s+p] = append(descendants[s+p], temp...)
        }
    }

    for _, p := range append(primes, 4) {
        le := len(descendants[p])
        if le == 0 {
            continue
        }
        descendants[p][le-1] = 0
        descendants[p] = descendants[p][:le-1]
    }
    total := 0

    for s := 1; s <= maxSum; s++ {
        x := descendants[s]
        sort.Slice(x, func(i, j int) bool {
            return x[i] < x[j]
        })
        total += len(descendants[s])
        index := 0
        for ; index < len(descendants[s]); index++ {
            if descendants[s][index] > int64(maxSum) {
                break
            }
        }
        for _, d := range descendants[s][:index] {
            ancestors[d] = append(ancestors[s], s)
        }
        if (s >= 21 && s <= 45) || (s >= 47 && s <= 73) || (s >= 75 && s < maxSum) {
            continue
        }
        temp := fmt.Sprintf("%v", ancestors[s])
        fmt.Printf("%2d: %d Ancestor(s): %-14s", s, len(ancestors[s]), temp)
        le := len(descendants[s])
        if le <= 10 {
            fmt.Printf("%5d Descendant(s): %v\n", le, descendants[s])
        } else {
            fmt.Printf("%5d Descendant(s): %v\b ...]\n", le, descendants[s][:10])
        }
    }
    fmt.Println("\nTotal descendants", total)
}


{-# LANGUAGE DeriveFunctor #-}
import Data.Numbers.Primes (isPrime)
import Data.List

------------------------------------------------------------
-- memoization utilities

type Memo2 a = Memo (Memo a)

data Memo a = Node a (Memo a) (Memo a)
  deriving Functor

memo :: Integral a => Memo p -> a -> p
memo (Node a l r) n
  | n == 0 = a
  | odd n = memo l (n `div` 2)
  | otherwise = memo r (n `div` 2 - 1)

nats :: Integral a => Memo a
nats = Node 0 ((+1).(*2) <$> nats) ((*2).(+1) <$> nats)

memoize :: Integral a => (a -> b) -> (a -> b)
memoize f = memo (f <$> nats)

memoize2 :: (Integral a, Integral b) => (a -> b -> c) -> (a -> b -> c)
memoize2 f = memoize (memoize . f)

------------------------------------------------------------

partProd = memoize2 partProdM
  where
    partProdM x p
      | p == 0 = []
      | x == 0 = [1]
      | x < 0 = []
      | isPrime p = ((p *) <$> partProdM (x - p) p) ++
                    partProd x (p - 1)
      | otherwise = partProd x (p - 1)

descendants = memoize descendantsM
  where
    descendantsM x =
      if x == 4 then [] else sort (partProd x (x - 1))

ancestors = memoize ancestorsM
  where
    ancestorsM z = concat [ ancestors x ++ [x]
                          | x <- [z-1,z-2..1]
                          , z `elem` descendants x ]

main = do
  mapM_ (putStrLn . task1) [1..15]
  putStrLn (task2 46)
  putStrLn (task2 99)
  putStrLn task3
  where
    task1 n = show n ++
              "  ancestors:" ++ show (ancestors n) ++
              "  descendants:" ++ show (descendants n)
    task2 n = show n ++ " has " ++
              show (length (ancestors n)) ++ " ancestors, " ++
              show (length (descendants n)) ++ " descendants."
    task3 = "Total ancestors up to 99: " ++
            show (sum $ length . ancestors <$> [1..99]) ++
            "\nTotal descendants up to 99: " ++
            show (sum $ length . descendants <$> [1..99])


require'strings files'

family=:3 :0 M.
  if. 2>y do.
    i.0   NB. no primes less than 2
  else.
    p=. i.&.(p:inv) y
    (y#~1 p:y),~.;p (* family)&.>y-p
  end.
)

familytree=: +/@q:^:a: ::(''"_)

descendants=: family -. ]
ancestors=: 1 }. familytree
level=: #@ancestors"0

taskfmt=:'None'"_^:(0=#)@rplc&(' ';', ')@":

task1=:3 :0
  text=. '[',(":y),'] Level: ',(":level y),LF
  text=. text,'Ancestors: ',(taskfmt /:~ancestors y),LF
  if. #descendants y do.
    text=. text,'Descendants: ',(":#descendants y),LF
    text=. text,(taskfmt /:~descendants y),LF
  else.
    text=. text,'Descendants: None',LF
  end.
  text=. text,LF
)

task=:3 :0
  tot=. 'Total descendants ',(":#@; descendants&.> 1+i.y),LF
  ((;task1&.>1+i.y),tot) fwrite jpath '~user/temp/Ancestors.txt'
)

task 99


import java.io.*;
import java.util.*;

public class PrimeDescendants {
    public static void main(String[] args) {
        try (Writer writer = new BufferedWriter(new OutputStreamWriter(System.out))) {
            printPrimeDesc(writer, 100);
        } catch (IOException ex) {
            ex.printStackTrace();
        }
    }

    private static void printPrimeDesc(Writer writer, int limit) throws IOException {
        List<Long> primes = findPrimes(limit);

        List<Long> ancestor = new ArrayList<>(limit);
        List<List<Long>> descendants = new ArrayList<>(limit);
        for (int i = 0; i < limit; ++i) {
            ancestor.add(Long.valueOf(0));
            descendants.add(new ArrayList<Long>());
        }

        for (Long prime : primes) {
            int p = prime.intValue();
            descendants.get(p).add(prime);
            for (int i = 0; i + p < limit; ++i) {
                int s = i + p;
                for (Long n : descendants.get(i)) {
                    Long prod = n * p;
                    descendants.get(s).add(prod);
                    if (prod < limit)
                        ancestor.set(prod.intValue(), Long.valueOf(s));
                }
            }
        }

        // print the results
        int totalDescendants = 0;
        for (int i = 1; i < limit; ++i) {
            List<Long> ancestors = getAncestors(ancestor, i);
            writer.write("[" + i + "] Level: " + ancestors.size() + "\n");
            writer.write("Ancestors: ");
            Collections.sort(ancestors);
            print(writer, ancestors);

            writer.write("Descendants: ");
            List<Long> desc = descendants.get(i);
            if (!desc.isEmpty()) {
                Collections.sort(desc);
                if (desc.get(0) == i)
                    desc.remove(0);
            }
            writer.write(desc.size() + "\n");
            totalDescendants += desc.size();
            if (!desc.isEmpty())
                print(writer, desc);
            writer.write("\n");
        }
        writer.write("Total descendants: " + totalDescendants + "\n");
    }

    // find the prime numbers up to limit
    private static List<Long> findPrimes(int limit) {
        boolean[] isprime = new boolean[limit];
        Arrays.fill(isprime, true);
        isprime[0] = isprime[1] = false;
        for (int p = 2; p * p < limit; ++p) {
            if (isprime[p]) {
                for (int i = p * p; i < limit; i += p)
                    isprime[i] = false;
            }
        }
        List<Long> primes = new ArrayList<>();
        for (int p = 2; p < limit; ++p) {
            if (isprime[p])
                primes.add(Long.valueOf(p));
        }
        return primes;
    }

    // returns all ancestors of n. n is not its own ancestor.
    private static List<Long> getAncestors(List<Long> ancestor, int n) {
        List<Long> result = new ArrayList<>();
        for (Long a = ancestor.get(n); a != 0 && a != n; ) {
            n = a.intValue();
            a = ancestor.get(n);
            result.add(Long.valueOf(n));
        }
        return result;
    }

    private static void print(Writer writer, List<Long> list) throws IOException {
        if (list.isEmpty()) {
            writer.write("none\n");
            return;
        }
        int i = 0;
        writer.write(String.valueOf(list.get(i++)));
        for (; i != list.size(); ++i)
            writer.write(", " + list.get(i));
        writer.write("\n");
    }
}


using Primes

function ancestraldecendants(maxsum)
    aprimes = primes(maxsum)
    descendants = [Vector{Int}() for _ in 1:maxsum + 1]
    ancestors = [Vector{Int}() for _ in 1:maxsum + 1]
    for p in aprimes
        push!(descendants[p + 1], p)
        foreach(s -> append!(descendants[s + p], [p * pr for pr in descendants[s]]),
            2:length(descendants) - p)
    end
    foreach(p -> pop!(descendants[p + 1]), vcat(aprimes, [4]))
    total = 0
    for s in 1:maxsum
        sort!(descendants[s + 1])
        dstlen = length(descendants[s + 1])
        total += dstlen
        idx = findfirst(x -> x > maxsum, descendants[s + 1])
        idx  = (idx == nothing) ? dstlen : idx - 1
        foreach(d -> ancestors[d] = vcat(ancestors[s + 1], [s]), descendants[s + 1][1:idx])
        if s in vcat(collect(0:20), 46, 74, 99)
            print(lpad(s, 3), ":", lpad("$(length(ancestors[s + 1]))", 2))
            print(" Ancestor(s):", rpad("$(ancestors[s + 1])", 18))
            print(lpad("$(length(descendants[s + 1]))", 5), " Descendant(s): ")
            println(rpad(dstlen <= 10 ? "$(descendants[s + 1])" : "$(descendants[s + 1][1:10])\b, ...]", 40))
        end
    end
    print("Total descendants: ", total)
end

ancestraldecendants(99)


// version 1.1.2

const val MAXSUM = 99

fun getPrimes(max: Int): List<Int> {
    if (max < 2) return emptyList<Int>()
    val lprimes = mutableListOf(2)
    outer@ for (x in 3..max step 2) {
        for (p in lprimes) if (x % p == 0) continue@outer
        lprimes.add(x)
    }
    return lprimes
}

fun main(args: Array<String>) {
    val descendants = Array(MAXSUM + 1) { mutableListOf<Long>() }
    val ancestors   = Array(MAXSUM + 1) { mutableListOf<Int>() }
    val primes = getPrimes(MAXSUM)

    for (p in primes) {
        descendants[p].add(p.toLong())
        for (s in 1 until descendants.size - p) {
            val temp = descendants[s + p] + descendants[s].map { p * it }
            descendants[s + p] = temp.toMutableList()
        }
    }

    for (p in primes + 4) descendants[p].removeAt(descendants[p].lastIndex)
    var total = 0

    for (s in 1..MAXSUM) {
        descendants[s].sort()
        total += descendants[s].size
        for (d in descendants[s].takeWhile { it <= MAXSUM.toLong() }) {
            ancestors[d.toInt()] = (ancestors[s] + s).toMutableList()
        }
        if (s in 21..45 || s in 47..73 || s in 75 until MAXSUM) continue
        print("${"%2d".format(s)}: ${ancestors[s].size} Ancestor(s): ")
        print(ancestors[s].toString().padEnd(18))
        print("${"%5d".format(descendants[s].size)} Descendant(s): ")
        println("${descendants[s].joinToString(", ", "[", "]", 10)}")
    }

    println("\nTotal descendants $total")
}


import algorithm, strformat, strutils, sugar

const MaxSum = 99

func getPrimes(max: Positive): seq[int] =
  if max < 2: return
  result.add 2
  for n in countup(3, max, 2):
    block check:
      for p in result:
        if n mod p == 0:
          break check
      result.add n

let primes = getPrimes(MaxSum)

var descendants, ancestors = newSeq[seq[int]](MaxSum + 1)

for p in primes:
  descendants[p].add p
  for s in 1..(descendants.high - p):
    descendants[s + p].add collect(newSeq, for pr in descendants[s]: p * pr)

for p in primes & 4:
  discard descendants[p].pop()

var total = 0
for s in 1..MaxSum:
  descendants[s].sort()
  for d in descendants[s]:
    if d > MaxSum: break
    ancestors[d] = ancestors[s] & s
  let dlength = descendants[s].len
  echo &"[{s}] Level: {ancestors[s].len}"
  echo "Ancestors: ", if ancestors[s].len != 0: ancestors[s].join(" ") else: "None"
  echo "Descendants: ", if dlength != 0: $dlength else: "None"
  if dlength != 0: echo descendants[s].join(", ")
  echo ""
  inc total, dlength

echo "Total descendants: ", total


use List::Util qw(sum uniq);
use ntheory qw(nth_prime);

my $max = 99;
my %tree;

sub allocate {
    my($n, $i, $sum,, $prod) = @_;
    $i //= 0; $sum //= 0; $prod //= 1;

    for my $k (0..$max) {
        next if $k < $i;
        my $p = nth_prime($k+1);
        if (($sum + $p) <= $max) {
            allocate($n, $k, $sum + $p, $prod * $p);
        } else {
            last if $sum == $prod;
            $tree{$sum}{descendants}{$prod} = 1;
            $tree{$prod}{ancestor} = [uniq $sum, @{$tree{$sum}{ancestor}}] unless $prod > $max || $sum == 0;
            last;
        }
    }
}

sub abbrev { # abbreviate long lists to first and last 5 elements
    my(@d) = @_;
    return @d if @d < 11;
    @d[0 .. 4], '...', @d[-5 .. -1];
}

allocate($_) for 1 .. $max;

for (1 .. 15, 46, $max) {
    printf "%2d, %2d Ancestors: %-15s", $_, (scalar uniq @{$tree{$_}{ancestor}}),
        '[' . join(' ',uniq @{$tree{$_}{ancestor}}) . ']';
    my $dn = 0; my $dl = '';
    if ($tree{$_}{descendants}) {
        $dn = keys %{$tree{$_}{descendants}};
        $dl = join ' ', abbrev(sort { $a <=> $b } keys %{$tree{$_}{descendants}});
    }
    printf "%5d Descendants: %s", $dn, "[$dl]\n";
}

map { for my $k (keys %{$tree{$_}{descendants}}) { $total += $tree{$_}{descendants}{$k} } } 1..$max;
print "\nTotal descendants: $total\n";


with javascript_semantics
constant maxSum = 99

function stringify(sequence s)
    s = deep_copy(s)
    for i=1 to length(s) do
        s[i] = sprintf("%d",s[i])
    end for
    return s
end function

procedure main()
    atom t0 = time()
    integer p
    sequence descendants = repeat({},maxSum+1),
             ancestors = repeat({},maxSum+1),
             primes = get_primes_le(maxSum)

    for i=1 to length(primes) do
        p = primes[i]
        descendants[p] = append(descendants[p], p)
        for s=1 to length(descendants)-p do
            descendants[s+p] = deep_copy(descendants[s+p])
                                & sq_mul(descendants[s],p)
        end for
    end for

    p = 4
    for i=0 to length(primes) do
        if i>0 then p = primes[i] end if
        if length(descendants[p])!=0 then
            descendants[p] = descendants[p][1..$-1]
        end if
    end for

    integer total = 0

    for s=1 to maxSum do
        sequence x = sort(deep_copy(descendants[s]))
        total += length(x)
        for i=1 to length(x) do
            atom d = x[i]
            if d>maxSum then exit end if
            ancestors[d] = deep_copy(ancestors[d])
                   &append(deep_copy(ancestors[s]),s)
        end for
        if s<26 or find(s,{46,74,99}) then
            sequence d = ancestors[s]
            integer l = length(d)
            string sp = iff(l=1?" ":"s")
            d = stringify(d)
            printf(1,"%2d: %d Ancestor%s: [%-14s", {s, l, sp, join(d)&"]"})
            d = sort(deep_copy(descendants[s]))
            l = length(d)
            sp = iff(l=1?" ":"s")
            if l<10 then
                d = stringify(d)
            else
                d[4..-4] = {0}
                d = stringify(d)
                d[4] = "..."
            end if
            printf(1,"%5d Descendant%s: [%s]\n", {l, sp, join(d)})
        end if
    end for
    printf(1,"\nTotal descendants %d\n", total)
    ?elapsed(time()-t0)         -- about 1s
    ?elapsed(power(3,33)/4e9)   -- over 16 days
end procedure
main()


from __future__ import print_function
from itertools import takewhile

maxsum = 99

def get_primes(max):
    if max < 2:
        return []
    lprimes = [2]
    for x in range(3, max + 1, 2):
        for p in lprimes:
            if x % p == 0:
                break
        else:
            lprimes.append(x)
    return lprimes

descendants = [[] for _ in range(maxsum + 1)]
ancestors = [[] for _ in range(maxsum + 1)]

primes = get_primes(maxsum)

for p in primes:
    descendants[p].append(p)
    for s in range(1, len(descendants) - p):
        descendants[s + p] += [p * pr for pr in descendants[s]]

for p in primes + [4]:
    descendants[p].pop()

total = 0
for s in range(1, maxsum + 1):
    descendants[s].sort()
    for d in takewhile(lambda x: x <= maxsum, descendants[s]):
        ancestors[d] = ancestors[s] + [s]
    print([s], "Level:", len(ancestors[s]))
    print("Ancestors:", ancestors[s] if len(ancestors[s]) else "None")
    print("Descendants:", len(descendants[s]) if len(descendants[s]) else "None")
    if len(descendants[s]):
        print(descendants[s])
    print()
    total += len(descendants[s])

print("Total descendants", total)


#lang racket

(define-syntax-rule (define/mem (name args ...) body ...)
  (begin
    (define cache (make-hash))
    (define (name args ...)
      (hash-ref! cache (list args ...) (lambda () body ...)))))

(define (take-last x n)
  (drop x (- (length x) n)))

(define (borders x)
  (if (> (length x) 5)
    (append (take x 2) '(...) (take-last x 2))
    x))

(define (add-tail list x)
  (reverse (cons x (reverse list))))


my $max = 99;
my @primes = (2 .. $max).grep: *.is-prime;
my %tree;
(1..$max).map: {
    %tree{$_}<ancestor> = ();
    %tree{$_}<descendants> = {};
};

sub allocate ($n, $i = 0, $sum = 0, $prod = 1) {
    return if $n < 4;
    for @primes.kv -> $k, $p {
        next if $k < $i;
        if ($sum + $p) <= $n {
            allocate($n, $k, $sum + $p, $prod * $p);
        } else {
            last if $sum == $prod;
            %tree{$sum}<descendants>{$prod} = True;
            last if $prod > $max;
            %tree{$prod}<ancestor> = %tree{$sum}<ancestor> (|) $sum;
            last;
        }
    }
}

# abbreviate long lists to first and last 5 elements
sub abbrev (@d) { @d < 11 ?? @d !! ( @d.head(5), '...', @d.tail(5) ) }

my @print = flat 1 .. 15, 46, 74, $max;

(1 .. $max).map: -> $term {
    allocate($term);

    if $term == any( @print )  # print some representative lines
    {
        my $dn = +%tree{$term}<descendants> // 0;
        my $dl = abbrev(%tree{$term}<descendants>.keys.sort( +*) // ());
        printf "%2d, %2d Ancestors: %-14s %5d Descendants: %s\n",
          $term, %tree{$term}<ancestor>,
          "[{ %tree{$term}<ancestor>.keys.sort: +* }],", $dn, "[$dl]";
    }
}

say "\nTotal descendants: ",
  sum (1..$max).map({ +%tree{$_}<descendants> });


var maxsum = 99
var primes = maxsum.primes

var descendants = (maxsum+1).of { [] }
var ancestors   = (maxsum+1).of { [] }

for p in (primes) {
    descendants[p] << p
    for s in (1 .. descendants.end-p) {
        descendants[s + p] << descendants[s].map {|q| p*q }...
    }
}

for p in (primes + [4]) {
    descendants[p].pop
}

var total = 0

for s in (1 .. maxsum) {

    descendants[s].sort!

    total += (var dsclen = descendants[s].len)
    var idx = descendants[s].first_index {|x| x > maxsum }

    for d in (descendants[s].slice(0, idx)) {
        ancestors[d] = (ancestors[s] + [s])
    }

    if ((s <= 20) || (s ~~ [46, 74, 99])) {
        printf("%2d: %d Ancestor(s): %-15s %5s Descendant(s): %s\n", s,
            ancestors[s].len, "[#{ancestors[s].join(' ')}]", descendants[s].len,
            dsclen <= 10 ? descendants[s] : "[#{descendants[s].first(10).join(' ')} ...]")
    }
}

say "\nTotal descendants: #{total}"


COMMENT cim --memory-pool-size=512 allocate-descendants-to-their-ancestors.sim ;
BEGIN

    COMMENT ABSTRACT FRAMEWORK CLASSES ;

    CLASS ITEM;
    BEGIN
    END ITEM;

    CLASS ITEMLIST;
    BEGIN

        CLASS ITEMARRAY(N); INTEGER N;
        BEGIN REF(ITEM) ARRAY DATA(0:N-1);
        END ITEMARRAY;

        PROCEDURE EXPAND(N); INTEGER N;
        BEGIN
            INTEGER I;
            REF(ITEMARRAY) TEMP;
            TEMP :- NEW ITEMARRAY(N);
            FOR I := 0 STEP 1 UNTIL SIZE-1 DO
                TEMP.DATA(I) :- ITEMS.DATA(I);
            ITEMS :- TEMP;
        END EXPAND;

        PROCEDURE APPEND(RI); REF(ITEM) RI;
        BEGIN
            IF SIZE + 1 > CAPACITY THEN
            BEGIN
                CAPACITY := 2 * CAPACITY;
                EXPAND(CAPACITY);
            END;
            ITEMS.DATA(SIZE) :- RI;
            SIZE := SIZE + 1;
        END APPEND;

        PROCEDURE APPENDALL(IL); REF(ITEMLIST) IL;
        BEGIN
            INTEGER I;
            FOR I := 0 STEP 1 UNTIL IL.SIZE-1 DO
                APPEND(IL.ELEMENT(I));
        END APPENDALL;

        REF(ITEM) PROCEDURE ELEMENT(I); INTEGER I;
        BEGIN
            IF I < 0 OR I > SIZE-1 THEN ERROR("ELEMENT: INDEX OUT OF BOUNDS");
            ELEMENT :- ITEMS.DATA(I);
        END ELEMENT;

        REF(ITEM) PROCEDURE SETELEMENT(I, IT); INTEGER I; REF(ITEM) IT;
        BEGIN
            IF I < 0 OR I > SIZE-1 THEN ERROR("SETELEMENT: INDEX OUT OF BOUNDS");
            ITEMS.DATA(I) :- IT;
        END SETELEMENT;

        REF(ITEM) PROCEDURE POP;
        BEGIN
            REF(ITEM) RESULT;
            IF SIZE=0 THEN ERROR("POP: EMPTY ITEMLIST");
            RESULT :- ITEMS.DATA(SIZE-1);
            ITEMS.DATA(SIZE-1) :- NONE;
            SIZE := SIZE-1;
            POP :- RESULT;
        END POP;

        PROCEDURE SORT(COMPARE_PROC);
            PROCEDURE COMPARE_PROC IS
                INTEGER PROCEDURE COMPARE_PROC(IT1,IT2); REF(ITEM) IT1,IT2;;
        BEGIN
            PROCEDURE SWAP(I,J); INTEGER I,J;
            BEGIN
               REF(ITEM) T;
               T :- ITEMS.DATA(I);
               ITEMS.DATA(I) :- ITEMS.DATA(J);
               ITEMS.DATA(J) :- T;
            END SWAP;
            PROCEDURE QUICKSORT(L,R); INTEGER L,R;
            BEGIN
               REF(ITEM) PIVOT;
               INTEGER I, J;
               PIVOT :- ITEMS.DATA((L+R)//2); I := L; J := R;
               WHILE I <= J DO
               BEGIN
                  WHILE COMPARE_PROC(ITEMS.DATA(I), PIVOT) < 0 DO I := I+1;
                  WHILE COMPARE_PROC(PIVOT, ITEMS.DATA(J)) < 0 DO J := J-1;
                  IF I <= J THEN
                  BEGIN SWAP(I,J); I := I+1; J := J-1;
                  END;
               END;
               IF L < J THEN QUICKSORT(L, J);
               IF I < R THEN QUICKSORT(I, R);
            END QUICKSORT;
            IF SIZE >= 2 THEN
               QUICKSORT(0,SIZE-1);
        END SORT;

        INTEGER CAPACITY;
        INTEGER SIZE;
        REF(ITEMARRAY) ITEMS;

        CAPACITY := 20;
        SIZE := 0;
        EXPAND(CAPACITY);
    END ITEMLIST;

    COMMENT PROBLEM SPECIFIC PART ;

    ITEM CLASS REALITEM(X); LONG REAL X;
    BEGIN
    END REALITEM;

    ITEMLIST CLASS LIST_OF_REAL;
    BEGIN
        LONG REAL PROCEDURE ELEMENT(I); INTEGER I;
            ELEMENT := ITEMS.DATA(I) QUA REALITEM.X;

        PROCEDURE APPEND(X); LONG REAL X;
            THIS ITEMLIST.APPEND(NEW REALITEM(X));

        PROCEDURE SORT;
        BEGIN
            INTEGER PROCEDURE CMP(IT1,IT2); REF(ITEM) IT1,IT2;
                CMP := IF IT1 QUA REALITEM.X < IT2 QUA REALITEM.X THEN -1 ELSE
                       IF IT1 QUA REALITEM.X > IT2 QUA REALITEM.X THEN +1 ELSE 0;
            THIS ITEMLIST.SORT(CMP);
        END SORT;

        PROCEDURE OUTLIST;
        BEGIN
            INTEGER I;
            TEXT FMT;
            OUTTEXT("[");
            FMT :- BLANKS(20);
            FOR I := 0 STEP 1 UNTIL SIZE-1 DO
            BEGIN
                IF I < 3 OR I > SIZE-1-3 THEN BEGIN
                    IF I > 0 THEN OUTTEXT(", ");
                    FMT.PUTFIX(ELEMENT(I), 0);
                    FMT.SETPOS(1);
                    WHILE FMT.MORE DO
                    BEGIN
                        CHARACTER C;
                        C := FMT.GETCHAR;
                        IF C <> ' ' THEN OUTCHAR(C);
                    END
                END ELSE BEGIN OUTTEXT(", ..."); I := SIZE-1-3; END;
            END;
            OUTTEXT("]");
        END OUTLIST;
    END LIST_OF_REAL;

    ITEM CLASS REALLISTITEM(LRL); REF(LIST_OF_REAL) LRL;
    BEGIN
    END REALLISTITEM;

    ITEMLIST CLASS LIST_OF_REALLIST;
    BEGIN
        REF(LIST_OF_REAL) PROCEDURE ELEMENT(I); INTEGER I;
            ELEMENT :- ITEMS.DATA(I) QUA REALLISTITEM.LRL;

        PROCEDURE APPEND(LRL); REF(LIST_OF_REAL) LRL;
            THIS ITEMLIST.APPEND(NEW REALLISTITEM(LRL));

        PROCEDURE OUTLIST;
        BEGIN
            INTEGER I;
            OUTTEXT("[");
            FOR I := 0 STEP 1 UNTIL SIZE-1 DO
            BEGIN
                IF I > 0 THEN OUTTEXT(", ");
                ELEMENT(I).OUTLIST;
            END;
            OUTTEXT("]");
        END OUTLIST;
    END LIST_OF_REALLIST;

    REF(LIST_OF_REAL) PROCEDURE GET_PRIMES(MAX);
        INTEGER MAX;
    BEGIN
        REF(LIST_OF_REAL) LPRIMES;
        LPRIMES :- NEW LIST_OF_REAL;
        IF MAX < 2 THEN
            GOTO RETURN
        ELSE
        BEGIN
            INTEGER X;
            LPRIMES.APPEND(2);
            FOR X := 3 STEP 2 UNTIL MAX DO BEGIN
                INTEGER I;
                LONG REAL P;
                FOR I := 0 STEP 1 UNTIL LPRIMES.SIZE-1 DO BEGIN
                    P := LPRIMES.ELEMENT(I);
                    IF (X / P) = ENTIER(X / P) THEN GOTO BREAK;
                END;
                LPRIMES.APPEND(X);
            BREAK:
            END;
        END;
    RETURN:
        GET_PRIMES :- LPRIMES;
    END GET_PRIMES;

    INTEGER MAXSUM, I, S, PRI, TOTAL, DI;
    REF(LIST_OF_REALLIST) DESCENDANTS, ANCESTORS;
    REF(LIST_OF_REAL) PRIMES, LR, LRS;
    LONG REAL P, D, PR;
    BOOLEAN TAKEWHILE;
    MAXSUM := 99;

    DESCENDANTS :- NEW LIST_OF_REALLIST;
    ANCESTORS   :- NEW LIST_OF_REALLIST;
    FOR I := 0 STEP 1 UNTIL MAXSUM DO BEGIN
        DESCENDANTS.APPEND(NEW LIST_OF_REAL);
        ANCESTORS  .APPEND(NEW LIST_OF_REAL);
    END;

    PRIMES :- GET_PRIMES(MAXSUM);

    FOR I := 0 STEP 1 UNTIL PRIMES.SIZE-1 DO
    BEGIN
        P := PRIMES.ELEMENT(I);
        DESCENDANTS.ELEMENT(P).APPEND(P);
        FOR S := 1 STEP 1 UNTIL DESCENDANTS.SIZE-P-1 DO
        BEGIN
            LRS :- DESCENDANTS.ELEMENT(S);
            FOR PRI := 0 STEP 1 UNTIL LRS.SIZE-1 DO
            BEGIN
                PR := LRS.ELEMENT(PRI);
                DESCENDANTS.ELEMENT(S + P).APPEND(P * PR);
            END;
        END;
    END;

    FOR I := 0 STEP 1 UNTIL PRIMES.SIZE-1 DO
    BEGIN
        P := PRIMES.ELEMENT(I);
        DESCENDANTS.ELEMENT(P).POP;
    END;
    DESCENDANTS.ELEMENT(4).POP;

    TOTAL := 0;
    FOR S := 1 STEP 1 UNTIL MAXSUM DO
    BEGIN
        LRS :- DESCENDANTS.ELEMENT(S);
        LRS.SORT;
        FOR DI := 0 STEP 1 UNTIL LRS.SIZE-1 DO
        BEGIN
            D := LRS.ELEMENT(DI);
            IF D <= MAXSUM THEN
            BEGIN
                REF(LIST_OF_REAL) ANCD;
                ANCD :- NEW LIST_OF_REAL;
                ANCD.APPENDALL(ANCESTORS.ELEMENT(S));
                ANCD.APPEND(S);
                ANCESTORS.SETELEMENT(D, NEW REALLISTITEM(ANCD));
            END
            ELSE GOTO BREAK;
        END;
        BREAK:

        OUTTEXT("[");
        OUTINT(S, 0);
        OUTTEXT("] LEVEL: ");
        OUTINT(ANCESTORS.ELEMENT(S).SIZE, 0);
        OUTIMAGE;

        OUTTEXT("ANCESTORS: ");
        ANCESTORS.ELEMENT(S).OUTLIST;
        OUTIMAGE;

        OUTTEXT("DESCENDANTS: ");
        OUTINT(LRS.SIZE,0);
        OUTIMAGE;

        LRS.OUTLIST;
        OUTIMAGE;

        OUTIMAGE;
        TOTAL := TOTAL + LRS.SIZE;
    END;

    OUTTEXT("TOTAL DESCENDANTS ");
    OUTINT(TOTAL, 0);
    OUTIMAGE;
END.


Imports System.Math

Module Module1
    Const MAXPRIME = 99                             ' upper bound for the prime factors
    Const MAXPARENT = 99                            ' greatest parent number

    Const NBRCHILDREN = 547100                      ' max number of children (total descendants)

    Public Primes As New Collection()               ' table of the prime factors
    Public PrimesR As New Collection()              ' table of the prime factors in reversed order
    Public Ancestors As New Collection()            ' table of the parent's ancestors

    Public Parents(MAXPARENT + 1) As Integer        ' index table of the root descendant (per parent)
    Public CptDescendants(MAXPARENT + 1) As Integer ' counter table of the descendants (per parent)
    Public Children(NBRCHILDREN) As ChildStruct     ' table of the whole descendants
    Public iChildren As Integer                     ' max index of the Children table

    Public Delimiter As String = ", "
    Public Structure ChildStruct
        Public Child As Long
        Public pLower As Integer
        Public pHigher As Integer
    End Structure
    Sub Main()
        Dim Parent As Short
        Dim Sum As Short
        Dim i As Short
        Dim TotDesc As Integer = 0
        Dim MidPrime As Integer

        If GetPrimes(Primes, MAXPRIME) = vbFalse Then
            Return
        End If

        For i = Primes.Count To 1 Step -1
            PrimesR.Add(Primes.Item(i))
        Next

        MidPrime = PrimesR.Item(1) / 2

        For Each Prime In PrimesR
            Parents(Prime) = InsertChild(Parents(Prime), Prime)
            CptDescendants(Prime) += 1

            If Prime > MidPrime Then
                Continue For
            End If

            For Parent = 1 To MAXPARENT
                Sum = Parent + Prime

                If Sum > MAXPARENT Then
                    Exit For
                End If

                If Parents(Parent) Then
                    InsertPreorder(Parents(Parent), Sum, Prime)
                    CptDescendants(Sum) += CptDescendants(Parent)
                End If
            Next
        Next

        RemoveFalseChildren()

        If MAXPARENT > MAXPRIME Then
            If GetPrimes(Primes, MAXPARENT) = vbFalse Then
                Return
            End If
        End If

        FileOpen(1, "Ancestors.txt", OpenMode.Output)

        For Parent = 1 To MAXPARENT
            GetAncestors(Parent)
            PrintLine(1, "[" & Parent.ToString & "] Level: " & Ancestors.Count.ToString)

            If Ancestors.Count Then
                Print(1, "Ancestors: " & Ancestors.Item(1).ToString)
                For i = 2 To Ancestors.Count
                    Print(1, ", " & Ancestors.Item(i).ToString)
                Next
                PrintLine(1)
                Ancestors.Clear()
            Else
                PrintLine(1, "Ancestors: None")
            End If

            If CptDescendants(Parent) Then
                PrintLine(1, "Descendants: " & CptDescendants(Parent).ToString)
                Delimiter = ""
                PrintDescendants(Parents(Parent))
                PrintLine(1)
                TotDesc += CptDescendants(Parent)
            Else
                PrintLine(1, "Descendants: None")
            End If

            PrintLine(1)
        Next
        Primes.Clear()
        PrimesR.Clear()
        PrintLine(1, "Total descendants " & TotDesc.ToString)
        PrintLine(1)
        FileClose(1)
    End Sub
    Function InsertPreorder(_index As Integer, _sum As Short, _prime As Short)
        Parents(_sum) = InsertChild(Parents(_sum), Children(_index).Child * _prime)

        If Children(_index).pLower Then
            InsertPreorder(Children(_index).pLower, _sum, _prime)
        End If

        If Children(_index).pHigher Then
            InsertPreorder(Children(_index).pHigher, _sum, _prime)
        End If

        Return Nothing
    End Function
    Function InsertChild(_index As Integer, _child As Long) As Integer
        If _index Then
            If _child <= Children(_index).Child Then
                Children(_index).pLower = InsertChild(Children(_index).pLower, _child)
            Else
                Children(_index).pHigher = InsertChild(Children(_index).pHigher, _child)
            End If
        Else
            iChildren += 1
            _index = iChildren
            Children(_index).Child = _child
            Children(_index).pLower = 0
            Children(_index).pHigher = 0
        End If

        Return _index
    End Function
    Function RemoveFalseChildren()
        Dim Exclusions As New Collection

        Exclusions.Add(4)
        For Each Prime In Primes
            Exclusions.Add(Prime)
        Next

        For Each ex In Exclusions
            Parents(ex) = Children(Parents(ex)).pHigher
            CptDescendants(ex) -= 1
        Next

        Exclusions.Clear()
        Return Nothing
    End Function
    Function GetAncestors(_child As Short)
        Dim Child As Short = _child
        Dim Parent As Short = 0

        For Each Prime In Primes
            If Child = 1 Then
                Exit For
            End If
            While Child Mod Prime = 0
                Child /= Prime
                Parent += Prime
            End While
        Next

        If Parent = _child Or _child = 1 Then
            Return Nothing
        End If

        GetAncestors(Parent)
        Ancestors.Add(Parent)
        Return Nothing
    End Function
    Function PrintDescendants(_index As Integer)
        If Children(_index).pLower Then
            PrintDescendants(Children(_index).pLower)
        End If

        Print(1, Delimiter.ToString & Children(_index).Child.ToString)
        Delimiter = ", "

        If Children(_index).pHigher Then
            PrintDescendants(Children(_index).pHigher)
        End If

        Return Nothing
    End Function
    Function GetPrimes(ByRef _primes As Object, Optional _maxPrime As Integer = 2) As Boolean
        Dim Value As Integer = 3
        Dim Max As Integer
        Dim Prime As Integer

        If _maxPrime < 2 Then
            Return vbFalse
        End If

        _primes.Add(2)

        While Value <= _maxPrime
            Max = Floor(Sqrt(Value))

            For Each Prime In _primes
                If Prime > Max Then
                    _primes.Add(Value)
                    Exit For
                End If

                If Value Mod Prime = 0 Then
                    Exit For
                End If
            Next

            Value += 2
        End While

        Return vbTrue
    End Function
End Module


import "/math" for Int
import "/sort" for Sort
import "/fmt" for Fmt

var maxSum = 99

var descendants = List.filled(maxSum + 1, null)
var ancestors   = List.filled(maxSum + 1, null)
for (i in 0..maxSum) {
    descendants[i] = []
    ancestors[i]   = []
}
var primes = Int.primeSieve(maxSum)
for (p in primes) {
    descendants[p].add(p)
    for (s in 1...descendants.count - p) {
        descendants[s + p].addAll(descendants[s].map { |d| p * d })
    }
}
for (p in primes + [4]) descendants[p].removeAt(-1)
var total = 0
for (s in 1..maxSum) {
    Sort.quick(descendants[s])
    total = total + descendants[s].count
    for (d in descendants[s]) {
        if (d > maxSum) break
         ancestors[d] = ancestors[s] + [s]
    }
    if (s < 21 || s == 46 || s == 74 || s == maxSum) {
        Fmt.write("$2d: $d Ancestors[s]: $-18n", s, ancestors[s].count, ancestors[s])
        var count = descendants[s].count
        var desc10 = (count <= 10) ? descendants[s] : descendants[s].take(10).toList + ["..."]
        Fmt.print("$5d Descendants[s]: $n", count, desc10)
    }
}
System.print("\nTotal descendants %(total)")


const maxsum=99;

primes:=Utils.Generator(Import("sieve.zkl").postponed_sieve)
        .pump(List,'wrap(p){ (p<=maxsum) and p or Void.Stop });

descendants,ancestors:=List()*(maxsum + 1), List()*(maxsum + 1);

foreach p in (primes){
   descendants[p].insert(0,p);
   foreach s in ([1..descendants.len() - p - 1]){
      descendants[s + p].merge(descendants[s].apply('*(p)));
   }
}

    // descendants[prime] is a list that starts with prime, remove prime. 4: ???
foreach p in (primes + 4) { descendants[p].pop(0) }

ta,td:=0,0;
foreach s in ([1..maxsum]){
   foreach d in (descendants[s].filter('<=(maxsum))){
      ancestors[d]=ancestors[s].copy() + s;
   }

   println("%2d Ancestors: ".fmt(s),ancestors[s].len() and ancestors[s] or "None");
   println("   Descendants: ", if(z:=descendants[s])
				String(z.len()," : ",z) else "None");
   ta+=ancestors[s].len(); td+=descendants[s].len();
}
println("Total ancestors: %,d".fmt(ta));
println("Total descendants: %,d".fmt(td));


package Apollonius is
   type Point is record
      X, Y : Long_Float := 0.0;
   end record;

   type Circle is record
      Center : Point;
      Radius : Long_Float := 0.0;
   end record;

   type Tangentiality is (External, Internal);

   function Solve_CCC
     (Circle_1, Circle_2, Circle_3 : Circle;
      T1, T2, T3                   : Tangentiality := External)
      return                         Circle;
end Apollonius;


#NoEnv
#SingleInstance, Force
SetBatchLines, -1

; Uncomment if Gdip.ahk is not in your standard library
;#Include, Gdip.ahk

; Start gdi+
If !pToken := Gdip_Startup()
{
	MsgBox, 48, gdiplus error!, Gdiplus failed to start. Please ensure you have gdiplus on your system
	ExitApp
}
OnExit, Exit
; I've added a simple new function here, just to ensure if anyone is having any problems then to make sure they are using the correct library version
If (Gdip_LibraryVersion() < 1.30)
{
	MsgBox, 48, version error!, Please download the latest version of the gdi+ library
	ExitApp
}
x1:=300,y1:=500,r1:=50,x2:=200,y2:=200,r2:=150,x3:=600,y3:=400,r3:=100,s1:=-1,s2:=-1,s3:=-1,xs:=0,ys:=0,rs:=0
, Apollonius(x1,y1,r1,x2,y2,r2,x3,y3,r3,s1,s2,s3,xs,ys,rs)
, Width:=max(x1+r1 "," x2+r2 "," x3+r3 "," xs+rs)*1.1
, Height:=max(y1+r1 "," y2+r2 "," y3+r3 "," ys+rs)*1.1

Gui, -Caption +E0x80000 +LastFound +AlwaysOnTop +ToolWindow +OwnDialogs
Gui, Show
hwnd1 := WinExist()
, hbm := CreateDIBSection(Width, Height)
, hdc := CreateCompatibleDC()
, obm := SelectObject(hdc, hbm)
, G := Gdip_GraphicsFromHDC(hdc)
, Gdip_SetSmoothingMode(G, 4)
, bWhite := Gdip_BrushCreateSolid(0xffffffff)
, Gdip_FillRectangle(G, bWhite, 0, 0, Width, Height)
, pRed := Gdip_CreatePen(0x88ff0000, 3)
, pGreen := Gdip_CreatePen(0x8800ff00, 3)
, pBlue := Gdip_CreatePen(0x880000ff, 3)
, pBlack := Gdip_CreatePen(0x88000000, 3)
, Gdip_DrawCircle(G, pRed, x1, y1, r1)
, Gdip_DrawCircle(G, pGreen, x2, y2, r2)
, Gdip_DrawCircle(G, pBlue, x3, y3, r3)
, Gdip_DrawCircle(G, pBlack, xs, ys, rs)
, Gdip_DeletePen(pRed)
, Gdip_DeletePen(pGreen)
, Gdip_DeletePen(pBlue)
, Gdip_DeletePen(pBlack)
, UpdateLayeredWindow(hwnd1, hdc, 0, 0, Width, Height)
Return

GuiEscape:
GuiClose:
Exit:
	SelectObject(hdc, obm)
	, DeleteObject(hbm)
	, DeleteDC(hdc)
	, Gdip_DeleteGraphics(G)
	, Gdip_Shutdown(pToken)
	ExitApp

Apollonius(x1=300,y1=500,r1=50,x2=200,y2=200,r2=150,x3=600,y3=400,r3=100,s1=1,s2=1,s3=1,ByRef xs=0, ByRef ys=0, ByRef rs=0) {
v11 := 2*x2 - 2*x1
v12 := 2*y2 - 2*y1
v13 := x1**2 - x2**2 + y1**2 - y2**2 - r1**2 + r2**2
v14 := 2*s2*r2 - 2*s1*r1

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

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

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

p := -w23/w22
q := w24/w22
m := -w12*p - w13
n := w14 - w12*q

a := n**2 + q**2 - 1
b := 2*m*n - 2*n*x1 + 2*p*q - 2*q*y1 + 2*s1*r1
c := x1**2 + m**2 - 2*m*x1 + p**2 + y1**2 - 2*p*y1 - r1**2

d := b**2 - 4*a*c
rs := (-b - d**0.5)/(2*a)
xs := m + n*rs
ys := p + q*rs
}

; from http://rosettacode.org/wiki/Greatest_element_of_a_list#AutoHotkey
max(list) {
	Loop Parse, list, `,
	x := x < A_LoopField ? A_LoopField : x
	Return x
}

; Gdip helper function
Gdip_DrawCircle(G, pPen, x, y, r) {
	Return Gdip_DrawEllipse(G, pPen, x-r, y-r, r*2, r*2)
}


#include <stdio.h>
#include <tgmath.h>

#define VERBOSE 0
#define for3 for(int i = 0; i < 3; i++)

typedef complex double vec;
typedef struct { vec c; double r; } circ;

#define re(x) creal(x)
#define im(x) cimag(x)
#define cp(x) re(x), im(x)
#define CPLX "(%6.3f,%6.3f)"
#define CPLX3 CPLX" "CPLX" "CPLX

double cross(vec a, vec b) { return re(a) * im(b) - im(a) * re(b); }
double abs2(vec a) { return a * conj(a); }

int apollonius_in(circ aa[], int ss[], int flip, int divert)
{
	vec n[3], x[3], t[3], a, b, center;
	int s[3], iter = 0, res = 0;
	double diff = 1, diff_old = -1, axb, d, r;

	for3 {
		s[i] = ss[i] ? 1 : -1;
		x[i] = aa[i].c;
	}

	while (diff > 1e-20) {
		a = x[0] - x[2], b = x[1] - x[2];
		diff = 0;
		axb = -cross(a, b);
		d = sqrt(abs2(a) * abs2(b) * abs2(a - b));

		if (VERBOSE) {
			const char *z = 1 + "-0+";
			printf("%c%c%c|%c%c|",
				z[s[0]], z[s[1]], z[s[2]], z[flip], z[divert]);
			printf(CPLX3, cp(x[0]), cp(x[1]), cp(x[2]));
		}

		/* r and center represent an arc through points x[i].  Each step,
		   we'll deform this arc by pushing or pulling some point on it
		   towards the edge of each given circle. */
		r = fabs(d / (2 * axb));
		center = (abs2(a)*b - abs2(b)*a) / (2 * axb) * I + x[2];

 		/* maybe the "arc" is actually straight line; then we have two
		   choices in defining "push" and "pull", so try both */
		if (!axb && flip != -1 && !divert) {
			if (!d) { /* generally means circle centers overlap */
				printf("Given conditions confused me.\n");
				return 0;
			}

			if (VERBOSE) puts("\n[divert]");
			divert = 1;
			res = apollonius_in(aa, ss, -1, 1);
		}

 		/* if straight line, push dir is its norm; else it's away from center */
		for3 n[i] = axb ? aa[i].c - center : a * I * flip;
		for3 t[i] = aa[i].c + n[i] / cabs(n[i]) * aa[i].r * s[i];

		/* diff: how much tangent points have moved since last iteration */
		for3 diff += abs2(t[i] - x[i]), x[i] = t[i];

		if (VERBOSE) printf(" %g\n", diff);

 		/* keep an eye on the total diff: failing to converge means no solution */
		if (diff >= diff_old && diff_old >= 0)
			if (iter++ > 20) return res;

		diff_old = diff;
	}

	printf("found: ");
	if (axb) printf("circle "CPLX", r = %f\n", cp(center), r);
	else	 printf("line "CPLX3"\n", cp(x[0]), cp(x[1]), cp(x[2]));

	return res + 1;
}

int apollonius(circ aa[])
{
	int s[3], i, sum = 0;
	for (i = 0; i < 8; i++) {
		s[0] = i & 1, s[1] = i & 2, s[2] = i & 4;

		/* internal or external results of a zero-radius circle are the same */
		if (s[0] && !aa[0].r) continue;
		if (s[1] && !aa[1].r) continue;
		if (s[2] && !aa[2].r) continue;
		sum += apollonius_in(aa, s, 1, 0);
	}
	return sum;
}

int main()
{
	circ a[3] = {{0, 1}, {4, 1}, {2 + 4 * I, 1}};
	circ b[3] = {{-3, 2}, {0, 1}, {3, 2}};
	circ c[3] = {{-2, 1}, {0, 1}, {2 * I, 1}};
	//circ c[3] = {{0, 1}, {0, 2}, {0, 3}}; <-- a fun one

	puts("set 1"); apollonius(a);
	puts("set 2"); apollonius(b);
	puts("set 3"); apollonius(c);
}


using System;

namespace ApolloniusProblemCalc
{
    class Program
    {
        static float rs = 0;
        static float xs = 0;
        static float ys = 0;

        public static void Main(string[] args)
        {
            float gx1;
            float gy1;
            float gr1;
            float gx2;
            float gy2;
            float gr2;
            float gx3;
            float gy3;
            float gr3;

            //----------Enter values for the given circles here----------
            gx1 = 0;
            gy1 = 0;
            gr1 = 1;
            gx2 = 4;
            gy2 = 0;
            gr2 = 1;
            gx3 = 2;
            gy3 = 4;
            gr3 = 2;
            //-----------------------------------------------------------

            for (int i = 1; i <= 8; i++)
            {
                SolveTheApollonius(i, gx1, gy1, gr1, gx2, gy2, gr2, gx3, gy3, gr3);

                if (i == 1)
                {
                    Console.WriteLine("X of point of the " + i + "st solution: " + xs.ToString());
                    Console.WriteLine("Y of point of the " + i + "st solution: " + ys.ToString());
                    Console.WriteLine(i + "st Solution circle's radius: " + rs.ToString());
                }
                else if (i == 2)
                {
                    Console.WriteLine("X of point of the " + i + "ed solution: " + xs.ToString());
                    Console.WriteLine("Y of point of the " + i + "ed solution: " + ys.ToString());
                    Console.WriteLine(i + "ed Solution circle's radius: " + rs.ToString());
                }
                else if(i == 3)
                {
                    Console.WriteLine("X of point of the " + i + "rd solution: " + xs.ToString());
                    Console.WriteLine("Y of point of the " + i + "rd solution: " + ys.ToString());
                    Console.WriteLine(i + "rd Solution circle's radius: " + rs.ToString());
                }
                else
                {
                    Console.WriteLine("X of point of the " + i + "th solution: " + xs.ToString());
                    Console.WriteLine("Y of point of the " + i + "th solution: " + ys.ToString());
                    Console.WriteLine(i + "th Solution circle's radius: " + rs.ToString());
                }

                Console.WriteLine();
            }

            Console.ReadKey(true);
        }

        private static void SolveTheApollonius(int calcCounter, float x1, float y1, float r1, float x2, float y2, float r2, float x3, float y3, float r3)
        {
            float s1 = 1;
            float s2 = 1;
            float s3 = 1;

            if (calcCounter == 2)
            {
                s1 = -1;
                s2 = -1;
                s3 = -1;
            }
            else if (calcCounter == 3)
            {
                s1 = 1;
                s2 = -1;
                s3 = -1;
            }
            else if (calcCounter == 4)
            {
                s1 = -1;
                s2 = 1;
                s3 = -1;
            }
            else if (calcCounter == 5)
            {
                s1 = -1;
                s2 = -1;
                s3 = 1;
            }
            else if (calcCounter == 6)
            {
                s1 = 1;
                s2 = 1;
                s3 = -1;
            }
            else if (calcCounter == 7)
            {
                s1 = -1;
                s2 = 1;
                s3 = 1;
            }
            else if (calcCounter == 8)
            {
                s1 = 1;
                s2 = -1;
                s3 = 1;
            }

            //This calculation to solve for the solution circles is cited from the Java version
            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;

            float D = b * b - 4 * a * c;

            rs = (-b - float.Parse(Math.Sqrt(D).ToString())) / (2 * float.Parse(a.ToString()));
            xs = M + N * rs;
            ys = P + Q * rs;
        }
    }
}


import std.stdio, std.math;

immutable struct Circle { double x, y, r; }
enum Tangent { externally, internally }

/**
Solves the Problem of Apollonius (finding a circle tangent to three
other circles in the plane).

Params:
  c1 = First circle of the problem.
  c2 = Second circle of the problem.
  c3 = Third circle of the problem.
  t1 = How is the solution tangent (externally or internally) to c1.
  t2 = How is the solution tangent (externally or internally) to c2.
  t3 = How is the solution tangent (externally or internally) to c3.

Returns: The Circle that is tangent to c1, c2 and c3.
*/
Circle solveApollonius(in Circle c1, in Circle c2, in Circle c3,
                       in Tangent t1, in Tangent t2, in Tangent t3)
pure nothrow @safe @nogc {
    alias Imd = immutable(double);
    Imd s1 = (t1 == Tangent.externally) ? 1.0 : -1.0;
    Imd s2 = (t2 == Tangent.externally) ? 1.0 : -1.0;
    Imd s3 = (t3 == Tangent.externally) ? 1.0 : -1.0;

    Imd v11 = 2 * c2.x - 2 * c1.x;
    Imd v12 = 2 * c2.y - 2 * c1.y;
    Imd v13 = c1.x ^^ 2 - c2.x ^^ 2 +
              c1.y ^^ 2 - c2.y ^^ 2 -
              c1.r ^^ 2 + c2.r ^^ 2;
    Imd v14 = 2 * s2 * c2.r - 2 * s1 * c1.r;

    Imd v21 = 2 * c3.x - 2 * c2.x;
    Imd v22 = 2 * c3.y - 2 * c2.y;
    Imd v23 = c2.x ^^ 2 - c3.x ^^ 2 +
              c2.y ^^ 2 - c3.y ^^ 2 -
              c2.r ^^ 2 + c3.r ^^ 2;
    Imd v24 = 2 * s3 * c3.r - 2 * s2 * c2.r;

    Imd w12 = v12 / v11;
    Imd w13 = v13 / v11;
    Imd w14 = v14 / v11;

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

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

    Imd a = N * N + Q ^^ 2 - 1;
    Imd b = 2 * M * N - 2 * N * c1.x +
            2 * P * Q - 2 * Q * c1.y +
            2 * s1 * c1.r;
    Imd c = c1.x ^^ 2 + M ^^ 2 - 2 * M * c1.x +
            P ^^ 2 + c1.y ^^ 2 - 2 * P * c1.y - c1.r ^^ 2;

    // find a root of a quadratic equation.
    // This requires the circle centers not to be e.g. colinear
    Imd D = b ^^ 2 - 4 * a * c;
    Imd rs = (-b - D.sqrt) / (2 * a);

    return Circle(M + N * rs, P + Q * rs, rs);
}

void main() {
    immutable c1 = Circle(0.0, 0.0, 1.0);
    immutable c2 = Circle(4.0, 0.0, 1.0);
    immutable c3 = Circle(2.0, 4.0, 2.0);

    alias Te = Tangent.externally;
    solveApollonius(c1, c2, c3, Te, Te, Te).writeln;

    alias Ti = Tangent.internally;
    solveApollonius(c1, c2, c3, Ti, Ti, Ti).writeln;
}


F proper_divs(n)
   R Array(Set((1 .. (n + 1) I/ 2).filter(x -> @n % x == 0 & @n != x)))

print((1..10).map(n -> proper_divs(n)))

V (n, leng) = max(((1..20000).map(n -> (n, proper_divs(n).len))), key' pd -> pd[1])
print(n‘ ’leng)


type Circle(Array center, Float radius) with Lookup
func Circle.ToString() =>
    "Circle[x=\(this.center[0]),y=\(this.center[1]),r=\(this.radius)]"

func solveApollonius(Circle c1, Circle c2, Circle c3, Float s1, Float s2, Float s3) {
    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.0 * x2 - 2.0 * x1
    let v12 = 2.0 * y2 - 2.0 *y1
    let v13 = x1 * x1 - x2 * x2 + y1 * y1 - y2 * y2 - r1 * r1 + r2 * r2
    let v14 = 2.0 * s2 * r2 - 2.0 * s1 * r1

    let v21 = 2.0 * x3 - 2.0 * x2
    let v22 = 2.0 * y3 - 2.0 * y2
    let v23 = x2 * x2 - x3 * x3 + y2 * y2 - y3 * y3 - r2 * r2 + r3 * r3
    let v24 = 2.0 * 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.0
    let b = 2.0 * m * n - 2.0 * n * x1 + 2 * p * q - 2.0 * q * y1 + 2.0 * s1 * r1
    let c = x1 * x1 + m * m - 2.0 * m * x1 + p * p + y1 * y1 - 2.0 * p * y1 - r1 * r1

    let d = b * b - 4.0 * a * c
    let rs = (-b - sqrt(d)) / (2.0 * a)
    let xs = m + n * rs
    let ys = p + q * rs

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

let c1 = Circle(center: [0.0, 0.0], radius: 1.0)
let c2 = Circle(center: [4.0, 0.0], radius: 1.0)
let c3 = Circle(center: [2.0, 4.0], radius: 2.0)

print(solveApollonius(c1, c2, c3, 1.0, 1.0, 1.0))
print(solveApollonius(c1, c2, c3, -1.0, -1.0, -1.0))


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 =
   printfn "Circle(x=%.2f, y=%.2f, r=%.2f)"
     c.center.x c.center.y c.radius

let xyr c = c.center.x, c.center.y, c.radius

let solve_apollonius c1 c2 c3
                     s1 s2 s3 =

   let x1, y1, r1 = xyr c1
   let x2, y2, r2 = xyr c2
   let x3, y3, r3 = xyr c3

   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

   new_circle xs ys rs

[<EntryPoint>]
let main argv =
  let c1 = new_circle 0. 0. 1.
  let c2 = new_circle 4. 0. 1.
  let c3 = new_circle 2. 4. 2.

  let r1 = solve_apollonius c1 c2 c3 1. 1. 1.
  print_circle r1

  let r2 = solve_apollonius c1 c2 c3 (-1.) (-1.) (-1.)
  print_circle r2
  0


*        Proper divisors           14/06/2016
PROPDIV  CSECT
         USING  PROPDIV,R13        base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         STM    R14,R12,12(R13)    prolog
         ST     R13,4(R15)         "
         ST     R15,8(R13)         "
         LR     R13,R15            "
         LA     R10,1              n=1
LOOPN1   C      R10,=F'10'         do n=1 to 10
         BH     ELOOPN1
         LR     R1,R10             n
         BAL    R14,PDIV           pdiv(n)
         ST     R0,NN              nn=pdiv(n)
         MVC    PG,PGT             init buffer
         LA     R11,PG             pgi=0
         XDECO  R10,XDEC           edit n
         MVC    0(3,R11),XDEC+9    output n
         LA     R11,7(R11)         pgi=pgi+7
         L      R1,NN              nn
         XDECO  R1,XDEC            edit nn
         MVC    0(3,R11),XDEC+9    output nn
         LA     R11,20(R11)        pgi=pgi+20
         LA     R5,1               i=1
LOOPNI   C      R5,NN              do i=1 to nn
         BH     ELOOPNI
         LR     R1,R5              i
         SLA    R1,2               *4
         L      R2,TDIV-4(R1)      tdiv(i)
         XDECO  R2,XDEC            edit tdiv(i)
         MVC    0(3,R11),XDEC+9    output tdiv(i)
         LA     R11,3(R11)         pgi=pgi+3
         LA     R5,1(R5)           i=i+1
         B      LOOPNI
ELOOPNI  XPRNT  PG,80              print buffer
         LA     R10,1(R10)         n=n+1
         B      LOOPN1
ELOOPN1  SR     R0,R0              0
         ST     R0,M               m=0
         LA     R10,1              n=1
LOOPN2   C      R10,=F'20000'      do n=1 to 20000
         BH     ELOOPN2
         LR     R1,R10             n
         BAL    R14,PDIV           nn=pdiv(n)
         C      R0,M               if nn>m
         BNH    NNNHM
         ST     R10,II             ii=n
         ST     R0,M               m=nn
NNNHM    LA     R10,1(R10)         n=n+1
         B      LOOPN2
ELOOPN2  MVC    PG,PGR             init buffer
         L      R1,II              ii
         XDECO  R1,XDEC            edit ii
         MVC    PG(5),XDEC+7       output ii
         L      R1,M               m
         XDECO  R1,XDEC            edit m
         MVC    PG+9(4),XDEC+8     output m
         XPRNT  PG,80              print buffer
         L      R13,4(0,R13)       epilog
         LM     R14,R12,12(R13)    "
         XR     R15,R15            "
         BR     R14                exit
*------- pdiv   --function(x)----->number of divisors---
PDIV     ST     R1,X               x
         C      R1,=F'1'           if x=1
         BNE    NOTONE
         LA     R0,0               return(0)
         BR     R14
NOTONE   LR     R4,R1              x
         N      R4,=X'00000001'    mod(x,2)
         LA     R4,1(R4)           +1
         ST     R4,ODD             odd=mod(x,2)+1
         LA     R8,1               ia=1
         LA     R0,1               1
         ST     R0,TDIV            tdiv(1)=1
         SR     R9,R9              ib=0
         L      R7,ODD             odd
         LA     R7,1(R7)           j=odd+1
LOOPJ    LR     R5,R7              do j=odd+1 by odd
         MR     R4,R7              j*j
         C      R5,X               while j*j<x
         BNL    ELOOPJ
         L      R4,X               x
         SRDA   R4,32              .
         DR     R4,R7              /j
         LTR    R4,R4              if mod(x,j)=0
         BNZ    ITERJ
         LA     R8,1(R8)           ia=ia+1
         LR     R1,R8              ia
         SLA    R1,2               *4 (F)
         ST     R7,TDIV-4(R1)      tdiv(ia)=j
         LA     R9,1(R9)           ib=ib+1
         L      R4,X               x
         SRDA   R4,32              .
         DR     R4,R7              j
         LR     R2,R9              ib
         SLA    R2,2               *4 (F)
         ST     R5,TDIVB-4(R2)     tdivb(ib)=x/j
ITERJ    A      R7,ODD             j=j+odd
         B      LOOPJ
ELOOPJ   LR     R5,R7              j
         MR     R4,R7              j*j
         C      R5,X               if j*j=x
         BNE    JTJNEX
         LA     R8,1(R8)           ia=ia+1
         LR     R1,R8              ia
         SLA    R1,2               *4 (F)
         ST     R7,TDIV-4(R1)      tdiv(ia)=j
JTJNEX   LA     R1,TDIV(R1)        @tdiv(ia+1)
         LA     R2,TDIVB-4(R2)     @tdivb(ib)
         LTR    R6,R9              do i=ib to 1 by -1
         BZ     ELOOPI
LOOPI    MVC    0(4,R1),0(R2)      tdiv(ia)=tdivb(i)
         LA     R8,1(R8)           ia=ia+1
         LA     R1,4(R1)           r1+=4
         SH     R2,=H'4'           r2-=4
         BCT    R6,LOOPI           i=i-1
ELOOPI   LR     R0,R8              return(ia)
         BR     R14                return to caller
*        ----   ----------------------------------------
TDIV     DS     80F
TDIVB    DS     40F
M        DS     F
NN       DS     F
II       DS     F
X        DS     F
ODD      DS     F
PGT      DC     CL80'... has .. proper divisors:'
PGR      DC     CL80'..... has ... proper divisors.'
PG       DC     CL80' '
XDEC     DS     CL12
         YREGS
         END    PROPDIV


BYTE FUNC GetDivisors(INT a INT ARRAY divisors)
  INT i,max
  BYTE count

  max=a/2
  count=0
  FOR i=1 TO max
  DO
    IF a MOD i=0 THEN
      divisors(count)=i
      count==+1
    FI
  OD
RETURN (count)

PROC Main()
  DEFINE MAXNUM="20000"
  INT i,j,count,max,ind
  INT ARRAY divisors(100)
  BYTE ARRAY pdc(MAXNUM+1)

  FOR i=1 TO 10
  DO
    count=GetDivisors(i,divisors)
    PrintF("%I has %I proper divisors: [",i,count)
    FOR j=0 TO count-1
    DO
      PrintI(divisors(j))
      IF j<count-1 THEN
        Put(32)
      FI
    OD
    PrintE("]")
  OD

  PutE() PrintE("Searching for max number of divisors:")

  FOR i=1 TO MAXNUM
  DO
    pdc(i)=1
  OD
  FOR i=2 TO MAXNUM
  DO
    FOR j=i+i TO MAXNUM STEP i
    DO
      pdc(j)==+1
    OD
  OD

  max=0 ind=0
  FOR i=1 TO MAXNUM
  DO
    count=pdc(i)
    IF count>max THEN
      max=count ind=i
    FI
  OD
  PrintF("%I has %I proper divisors%E",ind,max)
RETURN


program Apollonius
  implicit none

  integer, parameter :: dp = selected_real_kind(15)

  type circle
    real(dp) :: x
    real(dp) :: y
    real(dp) :: radius
  end type

  type(circle) :: c1 , c2, c3, r

  c1 = circle(0.0, 0.0, 1.0)
  c2 = circle(4.0, 0.0, 1.0)
  c3 = circle(2.0, 4.0, 2.0)

  write(*, "(a,3f12.8))") "External tangent:", SolveApollonius(c1, c2, c3, 1, 1, 1)
  write(*, "(a,3f12.8))") "Internal tangent:", SolveApollonius(c1, c2, c3, -1, -1, -1)

contains

function SolveApollonius(c1, c2, c3, s1, s2, s3) result(res)
  type(circle) :: res
  type(circle), intent(in) :: c1, c2, c3
  integer, intent(in) :: s1, s2, s3

  real(dp) :: x1, x2, x3, y1, y2, y3, r1, r2, r3
  real(dp) :: v11, v12, v13, v14
  real(dp) :: v21, v22, v23, v24
  real(dp) :: w12, w13, w14
  real(dp) :: w22, w23, w24
  real(dp) :: p, q, m, n, a, b, c, det

  x1 = c1%x; x2 = c2%x; x3 = c3%x
  y1 = c1%y; y2 = c2%y; y3 = c3%y
  r1 = c1%radius; r2 = c2%radius; r3 = c3%radius

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

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

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

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

  p = -w23/w22
  q = w24/w22
  m = -w12*P - w13
  n = w14 - w12*q

  a = n*n + q*q - 1
  b = 2*m*n - 2*n*x1 + 2*p*q - 2*q*y1 + 2*s1*r1
  c = x1*x1 + m*m - 2*m*x1 + p*p + y1*y1 - 2*p*y1 - r1*r1

  det = b*b - 4*a*c
  res%radius = (-b-sqrt(det)) / (2*a)
  res%x = m + n*res%radius
  res%y = p + q*res%radius

end function
end program


generic
   type Result_Type (<>) is limited private;
   None: Result_Type;
   with function One(X: Positive) return Result_Type;
   with function Add(X, Y: Result_Type) return Result_Type
      is <>;
package Generic_Divisors is

  function Process
    (N: Positive; First: Positive := 1) return Result_Type is
      (if First**2 > N or First = N then None
      elsif (N mod First)=0 then
	(if First = 1 or First*First = N
	   then Add(One(First), Process(N, First+1))
	   else Add(One(First),
		    Add(One((N/First)), Process(N, First+1))))
      else Process(N, First+1));

end Generic_Divisors;


# MODE to hold an element of a list of proper divisors            #
MODE DIVISORLIST = STRUCT( INT divisor, REF DIVISORLIST next );

# end of divisor list value                                       #
REF DIVISORLIST nil divisor list = REF DIVISORLIST(NIL);

# resturns a DIVISORLIST containing the proper divisors of n      #
# if n = 1, 0 or -1, we return no divisors                        #
PROC proper divisors = ( INT n )REF DIVISORLIST:
     BEGIN
         REF DIVISORLIST result   := nil divisor list;
         REF DIVISORLIST end list := result;
         INT abs n  = ABS n;
         IF abs n > 1 THEN
             # build the list of divisors backeards, so they are  #
             # returned in ascending order                        #
             INT root n = ENTIER sqrt( abs n );
             FOR d FROM root n BY -1 TO 2 DO
                 IF abs n MOD d = 0 THEN
                     # found another divisor                      #
                     result := HEAP DIVISORLIST
                            := DIVISORLIST( d, result );
                     IF end list IS nil divisor list THEN
                         # first result                           #
                         end list := result
                     FI;
                     IF d * d /= n THEN
                         # add the other divisor to the end of    #
                         # the list                               #
                         next OF end list := HEAP DIVISORLIST
                                          := DIVISORLIST( abs n OVER d, nil divisor list );
                         end list         := next OF end list
                     FI
                 FI
             OD;
             # 1 is always a proper divisor of numbers > 1        #
             result := HEAP DIVISORLIST
                    := DIVISORLIST( 1, result )
         FI;
         result
     END # proper divisors # ;

# returns the number of divisors in a DIVISORLIST                 #
PROC count divisors = ( REF DIVISORLIST list )INT:
     BEGIN
        INT result := 0;
        REF DIVISORLIST divisors := list;
        WHILE divisors ISNT nil divisor list DO
            result +:= 1;
            divisors := next OF divisors
        OD;
        result
     END # count divisors # ;

# find the proper divisors of 1 : 10                              #
FOR n TO 10 DO
    REF DIVISORLIST divisors := proper divisors( n );
    print( ( "Proper divisors of: ", whole( n, -2 ), ": " ) );
    WHILE divisors ISNT nil divisor list DO
        print( ( " ", whole( divisor OF divisors, 0 ) ) );
        divisors := next OF divisors
    OD;
    print( ( newline ) )
OD;

# find the first/only number in 1 : 20 000 with the most divisors  #
INT max number         = 20 000;
INT max divisors      :=      0;
INT has max divisors  :=      0;
INT with max divisors :=      0;
FOR d TO max number DO
    INT divisor count = count divisors( proper divisors( d ) );
    IF divisor count > max divisors THEN
        # found a number with more divisors than the previous max  #
        max divisors       := divisor count;
        has max divisors   := d;
        with max divisors  := 1
    ELIF divisor count = max divisors THEN
        # found another number with that many divisors             #
        with max divisors +:= 1
    FI
OD;
print( ( whole( has max divisors, 0 )
       , " is the "
       , IF with max divisors < 2 THEN "only" ELSE "first" FI
       , " number upto "
       , whole( max number, 0 )
       , " with "
       , whole( max divisors, 0 )
       , " divisors"
       , newline
       ) )


Dim As String circle1 = "  0.000,  0.000,  1.000"
Dim As String circle2 = "  4.000,  0.000,  1.000"
Dim As String circle3 = "  2.000,  4.000,  2.000"

Sub ApolloniusSolver(c1 As String, c2 As String, c3 As String, s1 As Single, s2 As Single, s3 As Single)
    Dim As Single x1, x2, x3, y1, y2, y3, r1, r2, r3
    Dim As Single v11, v12, v13, v14, v21, v22, v23, v24, w12, w13, w14
    Dim As Single w22, w23, w24,P, Q, M, N, a, b, c, D
    Dim As Single Radius, XPos, YPos

    x1 = Val(Mid(c1, 3, 1)): y1 = Val(Mid(c1, 11, 1)): r1 = Val(Mid(c1, 19, 1))
    x2 = Val(Mid(c2, 3, 1)): y2 = Val(Mid(c2, 11, 1)): r2 = Val(Mid(c2, 19, 1))
    x3 = Val(Mid(c3, 3, 1)): y3 = Val(Mid(c3, 11, 1)): r3 = Val(Mid(c3, 19, 1))

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

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

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

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

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

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

    D   = b *  b - 4 * a * c

    Radius = (0 - b - Sqr(D)) / (2 * a)
    XPos   = M + N * Radius
    YPos   = P + Q * Radius

    Print Using " ##.###, ##.###, ##.###"; XPos; YPos; Radius
End Sub

Print "  x_pos   y_pos   radius"
Print circle1
Print circle2
Print circle3
Print
Print "R1: " : ApolloniusSolver(circle1, circle2, circle3,  1,  1,  1)
Print "R2: " : ApolloniusSolver(circle1, circle2, circle3, -1, -1, -1)
Sleep


BEGIN

% COMPUTE P MOD Q %
INTEGER FUNCTION MOD (P, Q);
INTEGER P, Q;
BEGIN
    MOD := P - Q * (P / Q);
END;

% COUNT, AND OPTIONALLY DISPLAY, PROPER DIVISORS OF N %
INTEGER FUNCTION DIVISORS(N, DISPLAY);
INTEGER N, DISPLAY;
BEGIN
    INTEGER I, LIMIT, COUNT, START, DELTA;
    IF MOD(N, 2) = 0 THEN
      BEGIN
        START := 2;
        DELTA := 1;
      END
    ELSE  % ONLY NEED TO CHECK ODD DIVISORS %
      BEGIN
        START := 3;
        DELTA := 2;
      END;
    % 1 IS A DIVISOR OF ANY NUMBER > 1 %
    IF N > 1 THEN COUNT := 1 ELSE COUNT := 0;
    IF (DISPLAY <> 0) AND (COUNT <> 0) THEN WRITEON(1);
    % CHECK REMAINING POTENTIAL DIVISORS %
    I := START;
    LIMIT := N / START;
    WHILE I <= LIMIT DO
      BEGIN
        IF MOD(N, I) = 0 THEN
          BEGIN
            IF DISPLAY <> 0 THEN WRITEON(I);
            COUNT := COUNT + 1;
          END;
        I := I + DELTA;
        IF COUNT = 1 THEN LIMIT := N / I;
      END;
   DIVISORS := COUNT;
END;

COMMENT MAIN PROGRAM BEGINS HERE;
INTEGER I, NDIV, TRUE, FALSE, HIGHDIV, HIGHNUM;
TRUE := -1;
FALSE := 0;

WRITE("PROPER DIVISORS OF FIRST TEN NUMBERS:");
FOR I := 1 STEP 1 UNTIL 10 DO
  BEGIN
     WRITE(I, " : ");
     NDIV := DIVISORS(I, TRUE);
  END;

WRITE("SEARCHING FOR NUMBER UP TO 10000 WITH MOST DIVISORS ...");
HIGHDIV := 1;
HIGHNUM := 1;
FOR I := 1 STEP 1 UNTIL 10000 DO
  BEGIN
     NDIV := DIVISORS(I, FALSE);
     IF NDIV > HIGHDIV THEN
       BEGIN
         HIGHDIV := NDIV;
         HIGHNUM := I;
       END;
  END;
WRITE("THE NUMBER IS:", HIGHNUM);
WRITE("IT HAS", HIGHDIV, " DIVISORS");

END


-- PROPER DIVISORS -----------------------------------------------------------

-- properDivisors :: Int -> [Int]
on properDivisors(n)
    if n = 1 then
        {1}
    else
        set realRoot to n ^ (1 / 2)
        set intRoot to realRoot as integer
        set blnPerfectSquare to intRoot = realRoot

        -- isFactor :: Int -> Bool
        script isFactor
            on |λ|(x)
                n mod x = 0
            end |λ|
        end script

        -- Factors up to square root of n,
        set lows to filter(isFactor, enumFromTo(1, intRoot))

        -- and quotients of these factors beyond the square root,

        -- integerQuotient :: Int -> Int
        script integerQuotient
            on |λ|(x)
                (n / x) as integer
            end |λ|
        end script

        -- excluding n itself (last item)
        items 1 thru -2 of (lows & map(integerQuotient, ¬
            items (1 + (blnPerfectSquare as integer)) thru -1 of reverse of lows))
    end if
end properDivisors

-- TEST ----------------------------------------------------------------------
on run
    -- numberAndDivisors :: Int -> [Int]
    script numberAndDivisors
        on |λ|(n)
            {num:n, divisors:properDivisors(n)}
        end |λ|
    end script

    -- maxDivisorCount :: Record -> Int -> Record
    script maxDivisorCount
        on |λ|(a, n)
            set intDivisors to length of properDivisors(n)

            if intDivisors ≥ divisors of a then
                {num:n, divisors:intDivisors}
            else
                a
            end if
        end |λ|
    end script

    {oneToTen:map(numberAndDivisors, ¬
        enumFromTo(1, 10)), mostDivisors:foldl(maxDivisorCount, ¬
        {num:0, divisors:0}, enumFromTo(1, 20000))} ¬

end run

-- GENERIC FUNCTIONS ---------------------------------------------------------

-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
    if m > n then
        set d to -1
    else
        set d to 1
    end if
    set lst to {}
    repeat with i from m to n by d
        set end of lst to i
    end repeat
    return lst
end enumFromTo

-- filter :: (a -> Bool) -> [a] -> [a]
on filter(f, xs)
    tell mReturn(f)
        set lst to {}
        set lng to length of xs
        repeat with i from 1 to lng
            set v to item i of xs
            if |λ|(v, i, xs) then set end of lst to v
        end repeat
        return lst
    end tell
end filter

-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from 1 to lng
            set v to |λ|(v, item i of xs, i, xs)
        end repeat
        return v
    end tell
end foldl

-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map

-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn


Problem of Apollonius

include "NSLog.incl"

begin record Circle
CGPoint     center
double      radius
CFStringRef locator
end record

local fn CircleToString( c as Circle ) as CFStringRef
end fn = fn StringWithFormat( @"%@ Circle( x = %0.3f, y = %0.3f, radius = %0.3f )", c.locator, c.center.x, c.center.y, c.radius )

local fn SolveApollonius( c1 as Circle, c2 as Circle, c3 as Circle, s1 as Double, s2 as Double, s3 as Double ) as Circle
'~'1
Circle result

double x1 = c1.center.x
double y1 = c1.center.y
double r1 = c1.radius

double x2 = c2.center.x
double y2 = c2.center.y
double r2 = c2.radius

double x3 = c3.center.x
double y3 = c3.center.y
double r3 = c3.radius

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

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

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

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

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

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

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

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

result.center.x = xs
result.center.y = ys
result.radius   = rs

if ( s1 < 1 )
result.locator = @"Internal Tangent:"
else
result.locator = @"External Tangent:"
end if
end fn = result

Circle c1, c2, c3, c

c1.center.x = 0.0 : c1.center.y = 0.0 : c1.radius = 1.0
c2.center.x = 4.0 : c2.center.y = 0.0 : c2.radius = 1.0
c3.center.x = 2.0 : c3.center.y = 4.0 : c3.radius = 2.0

// External tangent
c = fn SolveApollonius( c1, c2, c3,  1,  1,  1 )
NSLog( @"%@", fn CircleToString( c ) )

// Internal tangent
c = fn SolveApollonius( c1, c2, c3, -1, -1, -1 )
NSLog( @"%@", fn CircleToString( c ) )

HandleEvents


;; Given num, return num and the list of its divisors
(= divisor (fn (num)
   (= dlist '())
   (when (is 1 num) (= dlist '(1 0)))
   (when (is 2 num) (= dlist '(2 1)))
   (unless (or (is 1 num) (is 2 num))
   (up i 1 (+ 1 (/ num 2))
     (if (is 0 (mod num i))
         (push i dlist)))
   (= dlist (cons num dlist)))
   dlist))

;; Find out what number has the most divisors between 2 and 20,000.
;; Print a list of the largest known number's divisors as it is found.
(= div-lists (fn (cnt (o show 0))
  (= tlist '()) (= clist tlist)
  (when (> show 0) (prn tlist))
  (up i 1 cnt
    (divisor i)
    (when (is 1 show) (prn dlist))
    (when (>= (len dlist) (len tlist))
        (= tlist dlist)
        (when (is show 2) (prn tlist))
        (let c (- (len dlist) 1)
        (push (list i c) clist))))

  (= many-divisors (list ((clist 0) 1)))
  (for n 0 (is ((clist n) 1) ((clist 0) 1)) (= n (+ 1 n))
    (push ((clist n) 0) many-divisors))
  (= many-divisors (rev many-divisors))
  (prn "The number with the most divisors under " cnt
       " has " (many-divisors 0) " divisors.")
  (prn "It is the number "
  (if (> 2 (len many-divisors)) (cut (many-divisors) 1)
      (many-divisors 1)) ".")
  (prn "There are " (- (len many-divisors) 1) " numbers"
       " with this trait, and they are "
       (map [many-divisors _] (range 1 (- (len many-divisors) 1))))
  (prn (map [divisor _] (cut many-divisors 1)))
  many-divisors))

;; Do the tasks
(div-lists 10 1)
(div-lists 20000)
;; This took about 10 minutes on my machine.