(defun number-class (n)
  (let ((divisor-sum (sum-divisors n)))
    (cond ((< divisor-sum n) :deficient)
          ((= divisor-sum n) :perfect)
          ((> divisor-sum n) :abundant))))

(defun sum-divisors (n)
  (loop :for i :from 1 :to (/ n 2)
        :when (zerop (mod n i))
        :sum i))

(defun classification ()
  (loop :for n :from 1 :to 20000
        :for class := (number-class n)
        :count (eq class :deficient) :into deficient
        :count (eq class :perfect) :into perfect
        :count (eq class :abundant) :into abundant
        :finally (return (values deficient perfect abundant))))


include "cowgol.coh";

const MAXIMUM := 20000;

var p: uint16[MAXIMUM+1];
var i: uint16;
var j: uint16;

MemZero(&p as [uint8], @bytesof p);
i := 1;
while i <= MAXIMUM/2 loop
    j := i+i;
    while j <= MAXIMUM loop
        p[j] := p[j]+i;
        j := j+i;
    end loop;
    i := i+1;
end loop;

var def: uint16 := 0;
var per: uint16 := 0;
var ab: uint16 := 0;
i := 1;
while i <= MAXIMUM loop
    if p[i]<i then
        def := def + 1;
    elseif p[i]==i then
        per := per + 1;
    else
        ab := ab + 1;
    end if;
    i := i + 1;
end loop;

print_i16(def); print(" deficient numbers.\n");
print_i16(per); print(" perfect numbers.\n");
print_i16(ab); print(" abundant numbers.\n");


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

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

    enum Class { deficient, perfect, abundant }

    static Class classify(in uint n) pure nothrow @safe /*@nogc*/ {
        immutable p = properDivs(n).sum;
        with (Class)
            return (p < n) ? deficient : ((p == n) ? perfect : abundant);
    }

    enum rangeMax = 20_000;
    //iota(1, 1 + rangeMax).map!classify.hashGroup.writeln;
    iota(1, 1 + rangeMax).map!classify.array.sort().group.writeln;
}


/* Fill a given array such that for each N,
 * P[n] is the sum of proper divisors of N */
proc nonrec propdivs([*] word p) void:
    word i, j, max;
    max := dim(p,1)-1;
    for i from 0 upto max do p[i] := 0 od;
    for i from 1 upto max/2 do
        for j from i*2 by i upto max do
            p[j] := p[j] + i
        od
    od
corp

proc nonrec main() void:
    word MAX = 20000;
    word def, per, ab, i;

    /* Find all required proper divisor sums */
    [MAX+1] word p;
    propdivs(p);

    def := 0;
    per := 0;
    ab := 0;

    /* Check each number */
    for i from 1 upto MAX do
        if   p[i]<i then def := def + 1
        elif p[i]=i then per := per + 1
        elif p[i]>i then ab := ab + 1
        fi
    od;

    writeln("Deficient: ", def:5);
    writeln("Perfect:   ", per:5);
    writeln("Abundant:  ", ab:5)
corp


func sieve(bound) {
    var (a, d, p) = (0, 0, 0)
    var sum = Array.Empty(bound + 1, 0)

    for divisor in 1..(bound / 2) {
        var i = divisor + divisor
        while i <= bound {
            sum[i] += divisor
            i += divisor
        }
    }
    for i in 1..bound {
        if sum[i] < i {
            d += 1
        } else if sum[i] > i {
            a += 1
        } else {
            p += 1
        }
    }

    (abundant: a, deficient: d, perfect: p)
}

func Iterator.Where(fn) {
    for x in this {
        if fn(x) {
            yield x
        }
    }
}

func Iterator.Sum() {
    var sum = 0
    for x in this {
        sum += x
    }
    sum
}

func division(bound) {
    var (a, d, p) = (0, 0, 0)
    for i in 1..20000 {
        var sum = ( 1 .. ((i + 1) / 2) )
            .Where(div => div != i && i % div == 0)
            .Sum()
        if sum < i {
            d += 1
        } else if sum > i {
            a += 1
        } else {
            p += 1
        }
    }

    (abundant: a, deficient: d, perfect: p)
}

func out(res) {
    print("Abundant: \(res.abundant), Deficient: \(res.deficient), Perfect: \(res.perfect)");
}

out( sieve(20000) )
out( division(20000) )


(lib 'math) ;; sum-divisors function

(define-syntax-rule (++ a) (set! a (1+ a)))

(define (abondance (N 20000))
    (define-values (delta abondant deficient perfect) '(0 0 0 0))
    (for ((n (in-range 1 (1+ N))))
	 (set! delta (- (sum-divisors n) n))
	 (cond
	 	((< delta 0) (++ deficient))
	 	((> delta 0) (++ abondant))
	 	(else (writeln 'perfect→ n) (++ perfect))))

	(printf "In range 1.. %d" N)
	(for-each (lambda(x) (writeln x (eval x))) '(abondant deficient perfect)))

(abondance)
    perfect→     6
    perfect→     28
    perfect→     496
    perfect→     8128
    In range 1.. 20000
    abondant     4953
    deficient     15043
    perfect     4


open monad io number list

divisors n = filter ((0 ==) << (n `mod`)) [1 .. (n `div` 2)]
classOf n = compare (sum $ divisors n) n

do
  let classes = map classOf [1 .. 20000]
  let printRes w c = putStrLn $ w ++ (show << length $ filter (== c) classes)
  printRes "deficient: " LT
  printRes "perfect:   " EQ
  printRes "abundant:  " GT


import extensions;

classifyNumbers(int bound, ref int abundant, ref int deficient, ref int perfect)
{
    int a := 0;
    int d := 0;
    int p := 0;
    int[] sum := new int[](bound + 1);

    for(int divisor := 1, divisor <= bound / 2, divisor += 1)
    {
        for(int i := divisor + divisor, i <= bound, i += divisor)
        {
            sum[i] := sum[i] + divisor
        }
    };

    for(int i := 1, i <= bound, i += 1)
    {
        int t := sum[i];

        if (sum[i]<i)
        {
            d += 1
        }
        else
        {
            if (sum[i]>i)
            {
                a += 1
            }
            else
            {
                p += 1
            }
        }
    };

    abundant := a;
    deficient := d;
    perfect := p
}

public program()
{
    int abundant := 0;
    int deficient := 0;
    int perfect := 0;
    classifyNumbers(20000, ref abundant, ref deficient, ref perfect);
    console.printLine("Abundant: ",abundant,", Deficient: ",deficient,", Perfect: ",perfect)
}


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

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

{abundant, deficient, perfect} = Enum.reduce(1..20000, {0,0,0}, fn n,{a, d, p} ->
  sum = Proper.divisors(n) |> Enum.sum
  cond do
    n < sum -> {a+1, d, p}
    n > sum -> {a, d+1, p}
    true    -> {a, d, p+1}
  end
end)
IO.puts "Deficient: #{deficient}   Perfect: #{perfect}   Abundant: #{abundant}"


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

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

divisors(1,N) ->
      divisors(2,N,math:sqrt(N),[1]).

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

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

class(Limit) -> class(0,0,0,sumdivs(2),2,Limit).

class(D,P,A,_Sum,Acc,L) when Acc > L +1->
    io:format("Deficient: ~w, Perfect: ~w, Abundant: ~w~n", [D,P,A]);

class(D,P,A,Sum,Acc,L) when Acc < Sum ->
       class(D,P,A+1,sumdivs(Acc+1),Acc+1,L);
class(D,P,A,Sum,Acc,L) when Acc == Sum ->
       class(D,P+1,A,sumdivs(Acc+1),Acc+1,L);
class(D,P,A,Sum,Acc,L) when Acc > Sum  ->
       class(D+1,P,A,sumdivs(Acc+1),Acc+1,L).


let mutable a=0
let mutable b=0
let mutable c=0
let mutable d=0
let mutable e=0
let mutable f=0
for i=1 to 20000 do
    b <- 0
    f <- i/2
    for j=1 to f do
        if i%j=0 then
           b <- b+i
    if b<i then
       c <- c+1
    if b=i then
       d <- d+1
    if b>i then
       e <- e+1
printfn " deficient %i"c
printfn "perfect %i"d
printfn "abundant %i"e


USING: fry math.primes.factors math.ranges ;
: psum     ( n -- m )   divisors but-last sum ;
: pcompare ( n -- <=> ) dup psum swap <=> ;
: classify ( -- seq )   20,000 [1,b] [ pcompare ] map ;
: pcount   ( <=> -- n ) '[ _ = ] count ;
classify [ +lt+ pcount "Deficient: " write . ]
         [ +eq+ pcount "Perfect: "   write . ]
         [ +gt+ pcount "Abundant: "  write . ] tri


CREATE A 0 ,
: SLOT ( x y -- 0|1|2)  OVER OVER < -ROT > -  1+ ;
: CLASSIFY ( n -- n')  \ 0 == deficient, 1 == perfect, 2 == abundant
   DUP A !  \ we'll be accessing this often, so save somewhere convenient
   2 / >R   \ upper bound
   1        \ starting sum, 1 is always a divisor
   2        \ current check
   BEGIN DUP [email protected] < WHILE
     A @ OVER /MOD SWAP ( s c d m)
     IF DROP ELSE
       R> DROP DUP >R  ( R: d n)
       OVER TUCK OVER <> * -  ( s c c+?d)
       ROT + SWAP ( s' c)
     THEN 1+
   REPEAT  DROP R> DROP A @  ( sum n)  SLOT ;
CREATE COUNTS 0 , 0 , 0 ,
: INIT   COUNTS 3 CELLS ERASE  1 COUNTS ! ;
: CLASSIFY-NUMBERS ( n --)  INIT
   BEGIN DUP WHILE
     1 OVER CLASSIFY  CELLS COUNTS + +!  1-
   REPEAT  DROP ;
: .COUNTS
   ." Deficient : " [ COUNTS ]L           @ . CR
   ." Perfect   : " [ COUNTS 1 CELLS + ]L @ . CR
   ." Abundant  : " [ COUNTS 2 CELLS + ]L @ . CR ;
20000 CLASSIFY-NUMBERS .COUNTS BYE


Inspecting sums of proper divisors for 1 to       20000
Deficient       15043
Perfect!            4
Abundant         4953


' FreeBASIC v1.05.0 win64

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

Dim As Integer sum, deficient, perfect, abundant

For n As Integer = 1 To 20000
  sum = SumProperDivisors(n)
  If sum < n Then
    deficient += 1
  ElseIf sum = n Then
    perfect += 1
  Else
    abundant += 1
  EndIf
Next

Print "The classification of the numbers from 1 to 20,000 is as follows : "
Print
Print "Deficient = "; deficient
Print "Perfect   = "; perfect
Print "Abundant  = "; abundant
Print
Print "Press any key to exit the program"
Sleep
End


d = new	dict
for n =	1 to 20000
{
   s = sum[allFactors[n, true, false, true], 0]
   rel = s <=> n
   d.increment[rel, 1]
}

println["Deficient: " + [email protected](-1)]
println["Perfect:   " + [email protected]]
println["Abundant:  " + [email protected]]


num_deficient%=0
num_perfect%=0
num_abundant%=0
'
FOR current%=1 TO 20000
  sum_divisors%[email protected]_proper_divisors(current%)
  IF sum_divisors%<current%
    num_deficient%=num_deficient%+1
  ELSE IF sum_divisors%=current%
    num_perfect%=num_perfect%+1
  ELSE ! sum_divisors%>current%
    num_abundant%=num_abundant%+1
  ENDIF
NEXT current%
'
' Display results on a window
'
OPENW 1
CLEARW 1
PRINT "Number deficient ";num_deficient%
PRINT "Number perfect   ";num_perfect%
PRINT "Number abundant  ";num_abundant%
~INP(2)
CLOSEW 1
'
' Compute the sum of proper divisors of given number
'
FUNCTION sum_proper_divisors(n%)
  LOCAL i%,sum%,root%
  '
  IF n%>1 ! n% must be 2 or higher
    sum%=1 ! start with 1
    root%=SQR(n%) ! note that root% is an integer
    ' check possible factors, up to sqrt
    FOR i%=2 TO root%
      IF n% MOD i%=0
        sum%=sum%+i% ! i% is a factor
        IF i%*i%<>n% ! check i% is not actual square root of n%
          sum%=sum%+n%/i% ! so n%/i% will also be a factor
        ENDIF
      ENDIF
    NEXT i%
  ENDIF
  RETURN sum%
ENDFUNC


package main

import "fmt"

func pfacSum(i int) int {
    sum := 0
    for p := 1; p <= i/2; p++ {
        if i%p == 0 {
            sum += p
        }
    }
    return sum
}

func main() {
    var d, a, p = 0, 0, 0
    for i := 1; i <= 20000; i++ {
        j := pfacSum(i)
        if j < i {
            d++
        } else if j == i {
            p++
        } else {
            a++
        }
    }
    fmt.Printf("There are %d deficient numbers between 1 and 20000\n", d)
    fmt.Printf("There are %d abundant numbers  between 1 and 20000\n", a)
    fmt.Printf("There are %d perfect numbers between 1 and 20000\n", p)
}


def dpaCalc = { factors ->
    def n = factors.pop()
    def fSum = factors.sum()
    fSum < n
        ? 'deficient'
        : fSum > n
            ? 'abundant'
            : 'perfect'
}

(1..20000).inject([deficient:0, perfect:0, abundant:0]) { map, n ->
    map[dpaCalc(factorize(n))]++
    map
}
.each { e -> println e }


divisors :: (Integral a) => a -> [a]
divisors n = filter ((0 ==) . (n `mod`)) [1 .. (n `div` 2)]

classOf :: (Integral a) => a -> Ordering
classOf n = compare (sum $ divisors n) n

main :: IO ()
main = do
  let classes = map classOf [1 .. 20000 :: Int]
      printRes w c = putStrLn $ w ++ (show . length $ filter (== c) classes)
  printRes "deficient: " LT
  printRes "perfect:   " EQ
  printRes "abundant:  " GT


factors=: [: /:[email protected], */&>@{@((^ [email protected]>:)&.>/)@q:~&__
properDivisors=: factors -. ]


import java.util.stream.LongStream;

public class NumberClassifications {

    public static void main(String[] args) {
        int deficient = 0;
        int perfect = 0;
        int abundant = 0;

        for (long i = 1; i <= 20_000; i++) {
            long sum = properDivsSum(i);
            if (sum < i)
                deficient++;
            else if (sum == i)
                perfect++;
            else
                abundant++;
        }
        System.out.println("Deficient: " + deficient);
        System.out.println("Perfect: " + perfect);
        System.out.println("Abundant: " + abundant);
    }

    public static long properDivsSum(long n) {
        return LongStream.rangeClosed(1, (n + 1) / 2).filter(i -> n != i && n % i == 0).sum();
    }
}


# unordered
def proper_divisors:
  . as $n
  | if $n > 1 then 1,
      ( range(2; 1 + (sqrt|floor)) as $i
        | if ($n % $i) == 0 then $i,
            (($n / $i) | if . == $i then empty else . end)
	  else empty
	  end)
    else empty
    end;


/* Classify Deficient, Perfect and Abdundant integers */
function classifyDPA(stop:number, start:number=0, step:number=1):array {
    var dpa = [1, 0, 0];
    for (var n=start; n<=stop; n+=step) {
        for (var ds=0, d=1, e=n/2+1; d<e; d+=1) if (n%d == 0) ds += d;
        dpa[ds < n ? 0 : ds==n ? 1 : 2] += 1;
    }
    return dpa;
}

var dpa = classifyDPA(20000, 2);
printf('Deficient: %d, Perfect: %d, Abundant: %d\n', dpa[0], dpa[1], dpa[2]);


function pcontrib(p::Int64, a::Int64)
    n = one(p)
    pcon = one(p)
    for i in 1:a
        n *= p
        pcon += n
    end
    return pcon
end

function divisorsum(n::Int64)
    dsum = one(n)
    for (p, a) in factor(n)
        dsum *= pcontrib(p, a)
    end
    dsum -= n
end


/Classification of numbers into abundant, perfect and deficient
/ numclass.k

/return 0,1 or -1 if perfect or abundant or deficient respectively
numclass: {s:(+/&~x!'!1+x)-x; :[s>x;:1;:[s<x;:-1;:0]]}
/classify numbers from 1 to 20000 into respective groups
c: =numclass' 1+!20000
/print statistics
`0: ,"Deficient = ", $(#c[0])
`0: ,"Perfect   = ", $(#c[1])
`0: ,"Abundant  = ", $(#c[2])


// version 1.1

fun sumProperDivisors(n: Int) =
    if (n < 2) 0 else (1..n / 2).filter { (n % it) == 0 }.sum()

fun main(args: Array<String>) {
    var sum: Int
    var deficient = 0
    var perfect = 0
    var abundant = 0

    for (n in 1..20000) {
        sum = sumProperDivisors(n)
        when {
            sum < n -> deficient++
            sum == n -> perfect++
            sum > n -> abundant++
        }
    }

    println("The classification of the numbers from 1 to 20,000 is as follows:\n")
    println("Deficient = $deficient")
    println("Perfect   = $perfect")
    println("Abundant  = $abundant")
}


print "ROSETTA CODE - Abundant, deficient and perfect number classifications"
print
for x=1 to 20000
    x$=NumberClassification$(x)
    select case x$
        case "deficient": de=de+1
        case "perfect": pe=pe+1: print x; " is a perfect number"
        case "abundant": ab=ab+1
    end select
    select case x
        case 2000: print "Checking the number classifications of 20,000 integers..."
        case 4000: print "Please be patient."
        case 7000: print "7,000"
        case 10000: print "10,000"
        case 12000: print "12,000"
        case 14000: print "14,000"
        case 16000: print "16,000"
        case 18000: print "18,000"
        case 19000: print "Almost done..."
    end select
next x
print "Deficient numbers = "; de
print "Perfect numbers = "; pe
print "Abundant numbers = "; ab
print "TOTAL = "; pe+de+ab
[Quit]
print "Program complete."
end

function NumberClassification$(n)
    x=ProperDivisorCount(n)
    for y=1 to x
        PDtotal=PDtotal+ProperDivisor(y)
    next y
    if PDtotal=n then NumberClassification$="perfect": exit function
    if PDtotal<n then NumberClassification$="deficient": exit function
    if PDtotal>n then NumberClassification$="abundant": exit function
end function

function ProperDivisorCount(n)
    n=abs(int(n)): if n=0 or n>20000 then exit function
    dim ProperDivisor(100)
    for y=2 to n
        if (n mod y)=0 then
            ProperDivisorCount=ProperDivisorCount+1
            ProperDivisor(ProperDivisorCount)=n/y
        end if
    next y
end function


function sumDivs (n)
    if n < 2 then return 0 end
    local sum, sr = 1, math.sqrt(n)
    for d = 2, sr do
        if n % d == 0 then
            sum = sum + d
            if d ~= sr then sum = sum + n / d end
        end
    end
    return sum
end

local a, d, p, Pn = 0, 0, 0
for n = 1, 20000 do
    Pn = sumDivs(n)
    if Pn > n then a = a + 1 end
    if Pn < n then d = d + 1 end
    if Pn == n then p = p + 1 end
end
print("Abundant:", a)
print("Deficient:", d)
print("Perfect:", p)


            NORMAL MODE IS INTEGER
            DIMENSION P(20000)
            MAX = 20000
            THROUGH INIT, FOR I=1, 1, I.G.MAX
INIT        P(I) = 0
            THROUGH CALC, FOR I=1, 1, I.G.MAX/2
            THROUGH CALC, FOR J=I+I, I, J.G.MAX
CALC        P(J) = P(J)+I
            DEF = 0
            PER = 0
            AB = 0
            THROUGH CLSFY, FOR N=1, 1, N.G.MAX
            WHENEVER P(N).L.N, DEF = DEF+1
            WHENEVER P(N).E.N, PER = PER+1
CLSFY       WHENEVER P(N).G.N, AB = AB+1
            PRINT FORMAT FDEF,DEF
            PRINT FORMAT FPER,PER
            PRINT FORMAT FAB,AB
            VECTOR VALUES FDEF = $I5,S1,9HDEFICIENT*$
            VECTOR VALUES FPER = $I5,S1,7HPERFECT*$
            VECTOR VALUES FAB =  $I5,S1,8HABUNDANT*$
            END OF PROGRAM


  classify_number := proc(n::posint);
  if evalb(NumberTheory:-SumOfDivisors(n) < 2*n) then
     return "Deficient";
  elif evalb(NumberTheory:-SumOfDivisors(n) = 2*n) then
     return "Perfect";
  else
     return "Abundant";
  end if;
  end proc:

  classify_sequence := proc(k::posint)
  local num_list;
  num_list := map(classify_number, [seq(1..k)]);
  return Statistics:-Tally(num_list)
  end proc:


classify[n_Integer] := Sign[Total[[email protected]@n] - n]

StringJoin[
 Flatten[Tally[
     Table[classify[n], {n, 20000}]] /. {-1 -> "deficient: ",
     0 -> "  perfect: ", 1 -> "  abundant: "}] /.
  n_Integer :> ToString[n]]


abundant=0; deficient=0; perfect=0; p=[];
for N=2:20000
    K=1:ceil(N/2);
    D=K(~(rem(N, K)));
    sD=sum(D);
    if sD<N
        deficient=deficient+1;
    elseif sD==N
        perfect=perfect+1;
    else
        abundant=abundant+1;
    end
end
disp(table([deficient;perfect;abundant],'RowNames',{'Deficient','Perfect','Abundant'},'VariableNames',{'Quantities'}))


fun proper
		(number, count, limit, remainder, results) where (count > limit) = rev results
	|	(number, count, limit, remainder, results) =
			proper (number, count + 1, limit, number rem (count+1), if remainder = 0 then
				count :: results
			else
				results)
	|	number = (proper (number, 1, number div 2, 0, []))
;

fun is_abundant  number = number < (fold (op +, 0) ` proper number);
fun is_deficient number = number > (fold (op +, 0) ` proper number);
fun is_perfect   number = number = (fold (op +, 0) ` proper number);

val one_to_20000 = iota 20000;

print "Abundant numbers between 1 and 20000: ";
println ` fold (op +, 0) ` map ((fn n = if n then 1 else 0) o is_abundant) one_to_20000;

print "Deficient numbers between 1 and 20000: ";
println ` fold (op +, 0) ` map ((fn n = if n then 1 else 0) o is_deficient) one_to_20000;

print "Perfect numbers between 1 and 20000: ";
println ` fold (op +, 0) ` map ((fn n = if n then 1 else 0) o is_perfect) one_to_20000;


MODULE ADP;
FROM FormatString IMPORT FormatString;
FROM Terminal IMPORT WriteString,WriteLn,ReadChar;

PROCEDURE ProperDivisorSum(n : INTEGER) : INTEGER;
VAR i,sum : INTEGER;
BEGIN
    sum := 0;
    IF n<2 THEN
        RETURN 0
    END;
    FOR i:=1 TO (n DIV 2) DO
        IF n MOD i = 0 THEN
            INC(sum,i)
        END
    END;
    RETURN sum
END ProperDivisorSum;

VAR
    buf : ARRAY[0..63] OF CHAR;
    n : INTEGER;
    d,p,a : INTEGER = 0;
    sum : INTEGER;
BEGIN
    FOR n:=1 TO 20000 DO
        sum := ProperDivisorSum(n);
        IF sum<n THEN
            INC(d)
        ELSIF sum=n THEN
            INC(p)
        ELSIF sum>n THEN
            INC(a)
        END
    END;

    WriteString("The classification of the numbers from 1 to 20,000 is as follows:");
    WriteLn;

    FormatString("Deficient = %i\n", buf, d);
    WriteString(buf);
    FormatString("Perfect = %i\n", buf, p);
    WriteString(buf);
    FormatString("Abundant = %i\n", buf, a);
    WriteString(buf);
    ReadChar
END ADP.


;;;	The list (1 .. n-1) of integers is generated
;;;	then each non-divisor of n is replaced by 0
;;;	finally all these numbers are summed.
;;;	fn defines an anonymous function inline.
(define (sum-divisors n)
	(apply + (map (fn (x) (if (> (% n x) 0) 0 x)) (sequence 1 (- n 1)))))
;
;;;	Returns the symbols -, p or + for deficient, perfect or abundant numbers respectively.
(define (number-type n)
	(let (sum (sum-divisors n))
		(if
			(< sum n)	'-
			(= sum n)	'p
			true		'+)))
;
;;;	Tallies the types from 2 to n.
(define (count-types n)
	(count '(- p +) (map number-type (sequence 2 n))))
;
;;;	Running:
(println (count-types 20000))


proc sumProperDivisors(number: int) : int =
  if number < 2 : return 0
  for i in 1 .. number div 2 :
    if number mod i == 0 : result += i

var
  sum : int
  deficient = 0
  perfect = 0
  abundant = 0

for n in 1 .. 20000 :
  sum = sumProperDivisors(n)
  if sum < n :
    inc(deficient)
  elif sum == n :
    inc(perfect)
  else :
    inc(abundant)

echo "The classification of the numbers between 1 and 20,000 is as follows :\n"
echo "  Deficient = " , deficient
echo "  Perfect   = " , perfect
echo "  Abundant  = " , abundant


import: mapping

Integer method: properDivs -- []
    self 2 / seq  filter( #[ self swap mod 0 == ] ) ;

: numberClasses
| i deficient perfect s |
   0 0 ->deficient ->perfect
   0 20000 loop: i [
      0 #+ i properDivs apply ->s
      s i <  ifTrue: [ deficient 1+ ->deficient continue ]
      s i == ifTrue: [ perfect 1+ ->perfect continue ]
      1+
      ]
   "Deficients :" . deficient .cr
   "Perfects   :" . perfect   .cr
   "Abundant   :" . .cr
;


program AmicablePairs;
{find amicable pairs in a limited region 2..MAX
beware that >both< numbers must be smaller than MAX
there are 455 amicable pairs up to 524*1000*1000
correct up to
#437 460122410
}
//optimized for freepascal 2.6.4 32-Bit
{$IFDEF FPC}
   {$MODE DELPHI}
   {$OPTIMIZATION ON,peephole,cse,asmcse,regvar}
   {$CODEALIGN loop=1,proc=8}
{$ELSE}
  {$APPTYPE CONSOLE}
{$ENDIF}

uses
  sysutils;
const
  MAX = 20000;
//{$IFDEF UNIX} MAX = 524*1000*1000;{$ELSE}MAX = 499*1000*1000;{$ENDIF}
type
  tValue = LongWord;
  tpValue = ^tValue;
  tPower = array[0..31] of tValue;
  tIndex = record
             idxI,
             idxS : tValue;
           end;
  tdpa   = array[0..2] of LongWord;
var
  power        : tPower;
  PowerFac     : tPower;
  DivSumField  : array[0..MAX] of tValue;
  Indices      : array[0..511] of tIndex;
  DpaCnt       : tdpa;

procedure Init;
var
  i : LongInt;
begin
  DivSumField[0]:= 0;
  For i := 1 to MAX do
    DivSumField[i]:= 1;
end;

procedure ProperDivs(n: tValue);
//Only for output, normally a factorication would do
var
  su,so : string;
  i,q : tValue;
begin
  su:= '1';
  so:= '';
  i := 2;
  while i*i <= n do
  begin
    q := n div i;
    IF q*i -n = 0 then
    begin
      su:= su+','+IntToStr(i);
      IF q <> i then
        so:= ','+IntToStr(q)+so;
    end;
    inc(i);
  end;
  writeln('  [',su+so,']');
end;

procedure AmPairOutput(cnt:tValue);
var
  i : tValue;
  r : double;
begin
  r := 1.0;
  For i := 0 to cnt-1 do
  with Indices[i] do
  begin
    writeln(i+1:4,IdxI:12,IDxS:12,' ratio ',IdxS/IDxI:10:7);
    if r < IdxS/IDxI then
      r := IdxS/IDxI;
      IF cnt < 20 then
      begin
        ProperDivs(IdxI);
        ProperDivs(IdxS);
      end;
  end;
  writeln(' max ratio ',r:10:4);
end;

function Check:tValue;
var
  i,s,n : tValue;
begin
  fillchar(DpaCnt,SizeOf(dpaCnt),#0);
  n := 0;
  For i := 1 to MAX do
  begin
    //s = sum of proper divs (I)  == sum of divs (I) - I
    s := DivSumField[i]-i;
    IF (s <=MAX) AND (s>i) then
    begin
      IF DivSumField[s]-s = i then
      begin
        With indices[n] do
        begin
          idxI := i;
          idxS := s;
        end;
        inc(n);
      end;
    end;
    inc(DpaCnt[Ord(s>=i)-Ord(s<=i)+1]);
  end;
  result := n;
end;

Procedure CalcPotfactor(prim:tValue);
//PowerFac[k] = (prim^(k+1)-1)/(prim-1) == Sum (i=1..k) prim^i
var
  k: tValue;
  Pot,       //== prim^k
  PFac : Int64;
begin
  Pot := prim;
  PFac := 1;
  For k := 0 to High(PowerFac) do
  begin
    PFac := PFac+Pot;
    IF (POT > MAX) then
      BREAK;
    PowerFac[k] := PFac;
    Pot := Pot*prim;
  end;
end;

procedure InitPW(prim:tValue);
begin
  fillchar(power,SizeOf(power),#0);
  CalcPotfactor(prim);
end;

function NextPotCnt(p: tValue):tValue;inline;
//return the first power <> 0
//power == n to base prim
var
  i : tValue;
begin
  result := 0;
  repeat
    i := power[result];
    Inc(i);
    IF i < p then
      BREAK
    else
    begin
      i := 0;
      power[result]  := 0;
      inc(result);
    end;
  until false;
  power[result] := i;
end;

function Sieve(prim: tValue):tValue;
//simple version
var
  actNumber : tValue;
begin
  while prim <= MAX do
  begin
    InitPW(prim);
    //actNumber = actual number = n*prim
    //power == n to base prim
    actNumber := prim;
    while actNumber < MAX do
    begin
      DivSumField[actNumber] := DivSumField[actNumber] *PowerFac[NextPotCnt(prim)];
      inc(actNumber,prim);
    end;
    //next prime
    repeat
      inc(prim);
    until (DivSumField[prim] = 1);
  end;
  result := prim;
end;

var
  T2,T1,T0: TDatetime;
  APcnt: tValue;

begin
  T0:= time;
  Init;
  Sieve(2);
  T1:= time;
  APCnt := Check;
  T2:= time;

  //AmPairOutput(APCnt);
  writeln(Max:10,' upper limit');
  writeln(DpaCnt[0]:10,' deficient');
  writeln(DpaCnt[1]:10,' perfect');
  writeln(DpaCnt[2]:10,' abundant');
  writeln(DpaCnt[2]/Max:14:10,' ratio abundant/upper Limit ');
  writeln(DpaCnt[0]/Max:14:10,' ratio abundant/upper Limit ');
  writeln(DpaCnt[2]/DpaCnt[0]:14:10,' ratio abundant/deficient   ');
  writeln('Time to calc sum of divs    ',FormatDateTime('HH:NN:SS.ZZZ' ,T1-T0));
  writeln('Time to find amicable pairs ',FormatDateTime('HH:NN:SS.ZZZ' ,T2-T1));
  {$IFNDEF UNIX}
    readln;
  {$ENDIF}
end.


use ntheory qw/divisor_sum/;
my @type = <Perfect Abundant Deficient>;
say join "\n", map { sprintf "%2d %s", $_, $type[divisor_sum($_)-$_ <=> $_] } 1..12;
my %h;
$h{divisor_sum($_)-$_ <=> $_}++ for 1..20000;
say "Perfect: $h{0}    Deficient: $h{-1}    Abundant: $h{1}";


integer deficient=0, perfect=0, abundant=0, N
for i=1 to 20000 do
    N = sum(factors(i))+(i!=1)
    if N=i then
        perfect += 1
    elsif N<i then
        deficient += 1
    else
        abundant += 1
    end if
end for
printf(1,"deficient:%d, perfect:%d, abundant:%d\n",{deficient, perfect, abundant})


go =>
  Classes = new_map([deficient=0,perfect=0,abundant=0]),
  foreach(N in 1..20_000)
    C = classify(N),
    Classes.put(C,Classes.get(C)+1)
  end,
  println(Classes),
  nl.

% Classify a number N
classify(N) = Class =>
 S = sum_divisors(N),
 if S < N then
   Class1 = deficient
 elseif S = N then
   Class1 = perfect
 elseif S > N then
   Class1 = abundant
 end,
 Class = Class1.

% Alternative (slightly slower) approach.
classify2(N,S) = C, S <  N => C = deficient.
classify2(N,S) = C, S == N => C = perfect.
classify2(N,S) = C, S >  N => C = abundant.

% Sum of divisors
sum_divisors(N) = Sum =>
  sum_divisors(2,N,cond(N>1,1,0),Sum).

% Part 0: base case
sum_divisors(I,N,Sum0,Sum), I > floor(sqrt(N)) =>
  Sum = Sum0.

% Part 1: I is a divisor of N
sum_divisors(I,N,Sum0,Sum), N mod I == 0 =>
  Sum1 = Sum0 + I,
  (I != N div I ->
    Sum2 = Sum1 + N div I
    ;
    Sum2 = Sum1
  ),
  sum_divisors(I+1,N,Sum2,Sum).

% Part 2: I is not a divisor of N.
sum_divisors(I,N,Sum0,Sum) =>
  sum_divisors(I+1,N,Sum0,Sum).


(de accud (Var Key)
   (if (assoc Key (val Var))
      (con @ (inc (cdr @)))
      (push Var (cons Key 1)) )
   Key )
(de **sum (L)
   (let S 1
      (for I (cdr L)
         (inc 'S (** (car L) I)) )
      S ) )
(de factor-sum (N)
   (if (=1 N)
      0
      (let
         (R NIL
            D 2
            L (1 2 2 . (4 2 4 2 4 6 2 6 .))
            M (sqrt N)
            N1 N
            S 1 )
         (while (>= M D)
            (if (=0 (% N1 D))
               (setq M
                  (sqrt (setq N1 (/ N1 (accud 'R D)))) )
               (inc 'D (pop 'L)) ) )
         (accud 'R N1)
         (for I R
            (setq S (* S (**sum I))) )
         (- S N) ) ) )
(bench
   (let
      (A 0
         D 0
         P 0 )
      (for I 20000
         (setq @@ (factor-sum I))
         (cond
            ((< @@ I) (inc 'D))
            ((= @@ I) (inc 'P))
            ((> @@ I) (inc 'A)) ) )
      (println D P A) ) )
(bye)


*process source xref;
 apd: Proc Options(main);
 p9a=time();
 Dcl (p9a,p9b) Pic'(9)9';
 Dcl cnt(3) Bin Fixed(31) Init((3)0);
 Dcl x Bin Fixed(31);
 Dcl pd(300) Bin Fixed(31);
 Dcl sumpd   Bin Fixed(31);
 Dcl npd     Bin Fixed(31);
 Do x=1 To 20000;
   Call proper_divisors(x,pd,npd);
   sumpd=sum(pd,npd);
   Select;
     When(x<sumpd) cnt(1)+=1; /* abundant  */
     When(x=sumpd) cnt(2)+=1; /* perfect   */
     Otherwise     cnt(3)+=1; /* deficient */
     End;
   End;

 Put Edit('In the range 1 - 20000')(Skip,a);
 Put Edit(cnt(1),' numbers are abundant ')(Skip,f(5),a);
 Put Edit(cnt(2),' numbers are perfect  ')(Skip,f(5),a);
 Put Edit(cnt(3),' numbers are deficient')(Skip,f(5),a);
 p9b=time();
 Put Edit((p9b-p9a)/1000,' seconds elapsed')(Skip,f(6,3),a);
 Return;

 proper_divisors: Proc(n,pd,npd);
 Dcl (n,pd(300),npd) Bin Fixed(31);
 Dcl (d,delta)       Bin Fixed(31);
 npd=0;
 If n>1 Then Do;
   If mod(n,2)=1 Then  /* odd number  */
     delta=2;
   Else                /* even number */
     delta=1;
   Do d=1 To n/2 By delta;
     If mod(n,d)=0 Then Do;
       npd+=1;
       pd(npd)=d;
       End;
     End;
   End;
 End;

 sum: Proc(pd,npd) Returns(Bin Fixed(31));
 Dcl (pd(300),npd) Bin Fixed(31);
 Dcl sum Bin Fixed(31) Init(0);
 Dcl i   Bin Fixed(31);
 Do i=1 To npd;
   sum+=pd(i);
   End;
 Return(sum);
 End;

 End;


100H:
BDOS: PROCEDURE (FN, ARG); DECLARE FN BYTE, ARG ADDRESS; GO TO 5; END BDOS;
EXIT: PROCEDURE; CALL BDOS(0,0); END EXIT;
PRINT: PROCEDURE (S); DECLARE S ADDRESS; CALL BDOS(9,S); END PRINT;

PRINT$NUMBER: PROCEDURE (N);
    DECLARE S (6) BYTE INITIAL ('.....$');
    DECLARE (N, P) ADDRESS, C BASED P BYTE;
    P = .S(5);
DIGIT:
    P = P - 1;
    C = N MOD 10 + '0';
    N = N / 10;
    IF N > 0 THEN GO TO DIGIT;
    CALL PRINT(P);
END PRINT$NUMBER;

DECLARE LIMIT LITERALLY '20$000';
DECLARE (PBASE, P BASED PBASE) ADDRESS;
DECLARE (I, J) ADDRESS;
PBASE = .MEMORY;
DO I=0 TO LIMIT; P(I)=0; END;
DO I=1 TO LIMIT/2;
    DO J=I+I TO LIMIT BY I;
        P(J) = P(J)+I;
    END;
END;

DECLARE (DEF, PER, AB) ADDRESS INITIAL (0, 0, 0);
DO I=1 TO LIMIT;
    IF P(I)<I THEN DEF = DEF+1;
    ELSE IF P(I)=I THEN PER = PER+1;
    ELSE IF P(I)>I THEN AB = AB+1;
END;

CALL PRINT$NUMBER(DEF);
CALL PRINT(.(' DEFICIENT',13,10,'$'));
CALL PRINT$NUMBER(PER);
CALL PRINT(.(' PERFECT',13,10,'$'));
CALL PRINT$NUMBER(AB);
CALL PRINT(.(' ABUNDANT',13,10,'$'));
CALL EXIT;
EOF


function Get-ProperDivisorSum ( [int]$N )
    {
    If ( $N -lt 2 ) { return 0 }

    $Sum = 1
    If ( $N -gt 3 )
        {
        $SqrtN = [math]::Sqrt( $N )
        ForEach ( $Divisor in 2..$SqrtN )
            {
            If ( $N % $Divisor -eq 0 ) { $Sum += $Divisor + $N / $Divisor }
            }
        If ( $N % $SqrtN -eq 0 ) { $Sum -= $SqrtN }
        }
    return $Sum
    }

$Deficient = $Perfect = $Abundant = 0

ForEach ( $N in 1..20000 )
    {
    Switch ( [math]::Sign( ( Get-ProperDivisorSum $N ) - $N ) )
        {
        -1 { $Deficient++ }
         0 { $Perfect++   }
         1 { $Abundant++  }
        }
    }

"Deficient: $Deficient"
"Perfect  : $Perfect"
"Abundant : $Abundant"


void setup() {
  int deficient = 0, perfect = 0, abundant = 0;
  for (int i = 1; i <= 20000; i++) {
    int sum_divisors = propDivSum(i);
    if (sum_divisors < i) {
      deficient++;
    } else if (sum_divisors == i) {
      perfect++;
    } else {
      abundant++;
    }
  }
  println("Deficient numbers less than 20000: " + deficient);
  println("Perfect numbers less than 20000: " + perfect);
  println("Abundant numbers less than 20000: " + abundant);
}

int propDivSum(int n) {
  int sum = 0;
  for (int i = 1; i < n; i++) {
    if (n % i == 0) {
      sum += i;
    }
  }
  return sum;
}


proper_divisors(1, []) :- !.
proper_divisors(N, [1|L]) :-
	FSQRTN is floor(sqrt(N)),
	proper_divisors(2, FSQRTN, N, L).

proper_divisors(M, FSQRTN, _, []) :-
	M > FSQRTN,
	!.
proper_divisors(M, FSQRTN, N, L) :-
	N mod M =:= 0, !,
	MO is N//M, % must be integer
	L = [M,MO|L1], % both proper divisors
	M1 is M+1,
	proper_divisors(M1, FSQRTN, N, L1).
proper_divisors(M, FSQRTN, N, L) :-
	M1 is M+1,
	proper_divisors(M1, FSQRTN, N, L).

dpa(1, [1], [], []) :-
	!.
dpa(N, D, P, A) :-
	N > 1,
	proper_divisors(N, PN),
	sum_list(PN, SPN),
	compare(VGL, SPN, N),
	dpa(VGL, N, D, P, A).

dpa(<, N, [N|D], P, A) :- N1 is N-1, dpa(N1, D, P, A).
dpa(=, N, D, [N|P], A) :- N1 is N-1, dpa(N1, D, P, A).
dpa(>, N, D, P, [N|A]) :- N1 is N-1, dpa(N1, D, P, A).

dpa(N) :-
	T0 is cputime,
	dpa(N, D, P, A),
	Dur is cputime-T0,
	length(D, LD),
	length(P, LP),
	length(A, LA),
	format("deficient: ~d~n abundant: ~d~n  perfect: ~d~n",
		   [LD, LA, LP]),
	format("took ~f seconds~n", [Dur]).


EnableExplicit

Procedure.i SumProperDivisors(Number)
  If Number < 2 : ProcedureReturn 0 : EndIf
  Protected i, sum = 0
  For i = 1 To Number / 2
    If Number % i = 0
      sum + i
    EndIf
  Next
  ProcedureReturn sum
EndProcedure

Define n, sum, deficient, perfect, abundant

If OpenConsole()
  For n = 1 To 20000
    sum = SumProperDivisors(n)
    If sum < n
      deficient + 1
    ElseIf sum = n
      perfect + 1
    Else
      abundant + 1
    EndIf
  Next
  PrintN("The breakdown for the numbers 1 to 20,000 is as follows : ")
  PrintN("")
  PrintN("Deficient = " + deficient)
  PrintN("Pefect    = " + perfect)
  PrintN("Abundant  = " + abundant)
  PrintN("")
  PrintN("Press any key to close the console")
  Repeat: Delay(10) : Until Inkey() <> ""
  CloseConsole()
EndIf


>>> from proper_divisors import proper_divs
>>> from collections import Counter
>>>
>>> rangemax = 20000
>>>
>>> def pdsum(n):
...     return sum(proper_divs(n))
...
>>> def classify(n, p):
...     return 'perfect' if n == p else 'abundant' if p > n else 'deficient'
...
>>> classes = Counter(classify(n, pdsum(n)) for n in range(1, 1 + rangemax))
>>> classes.most_common()
[('deficient', 15043), ('abundant', 4953), ('perfect', 4)]
>>>


  [ 0 swap witheach + ]        is sum ( [ --> n )

  [ factors -1 pluck
    dip sum
    2dup = iff
      [ 2drop 1 ] done
    < iff 0 else 2 ]           is dpa ( n --> n )

  0 0 0
  20000 times
    [ i 1+ dpa
      [ table
        [ 1+ ]
        [ dip 1+ ]
        [ rot 1+ unrot ] ] do ]
  say "Deficient = " echo cr
  say "  Perfect = " echo cr
  say " Abundant = " echo cr


# Abundant, deficient and perfect number classifications. 12/10/16 aev
require(numbers);
propdivcls <- function(n) {
  V <- sapply(1:n, Sigma, proper = TRUE);
  c1 <- c2 <- c3 <- 0;
  for(i in 1:n){
    if(V[i]<i){c1 = c1 +1} else if(V[i]==i){c2 = c2 +1} else{c3 = c3 +1}
  }
  cat(" *** Between 1 and ", n, ":\n");
  cat("   * ", c1, "deficient numbers\n");
  cat("   * ", c2, "perfect numbers\n");
  cat("   * ", c3, "abundant numbers\n");
}
propdivcls(20000);


#lang racket
(require math)
(define (proper-divisors n) (drop-right (divisors n) 1))
(define classes '(deficient perfect abundant))
(define (classify n)
  (list-ref classes (add1 (sgn (- (apply + (proper-divisors n)) n)))))

(let ([N 20000])
  (define t (make-hasheq))
  (for ([i (in-range 1 (add1 N))])
    (define c (classify i))
    (hash-set! t c (add1 (hash-ref t c 0))))
  (printf "The range between 1 and ~a has:\n" N)
  (for ([c classes]) (printf "  ~a ~a numbers\n" (hash-ref t c 0) c)))


sub propdivsum (\x) {
    my @l = 1 if x > 1;
    (2 .. x.sqrt.floor).map: -> \d {
        unless x % d { @l.push: d; my \y = x div d; @l.push: y if y != d }
    }
    sum @l
}

say bag (1..20000).map: { propdivsum($_) <=> $_ }


/*REXX program counts the number of  abundant/deficient/perfect  numbers within a range.*/
parse arg low high .                             /*obtain optional arguments from the CL*/
high=word(high low 20000,1);  low= word(low 1,1) /*obtain the   LOW  and  HIGH   values.*/
say center('integers from '   low   " to "   high,  45,  "═")        /*display a header.*/
!.= 0                                            /*define all types of  sums  to zero.  */
      do j=low  to high;           $= sigma(j)   /*get sigma for an integer in a range. */
      if $<j  then               !.d= !.d + 1    /*Less?      It's a  deficient  number.*/
              else if $>j  then  !.a= !.a + 1    /*Greater?     "  "  abundant      "   */
                           else  !.p= !.p + 1    /*Equal?       "  "  perfect       "   */
      end  /*j*/                                 /* [↑]  IFs are coded as per likelihood*/

say '   the number of perfect   numbers: '       right(!.p, length(high) )
say '   the number of abundant  numbers: '       right(!.a, length(high) )
say '   the number of deficient numbers: '       right(!.d, length(high) )
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
sigma: procedure; parse arg x; if x<2  then return 0;  odd=x // 2    /* // ◄──remainder.*/
       s= 1                                      /* [↓]  only use  EVEN or ODD integers.*/
             do k=2+odd  by 1+odd  while k*k<x   /*divide by all integers up to  √x.    */
             if x//k==0  then  s= s + k +  x % k /*add the two divisors to (sigma) sum. */
             end   /*k*/                         /* [↑]  %  is the REXX integer division*/
       if k*k==x  then  return s + k             /*Was  X  a square?   If so, add  √ x  */
                        return s                 /*return (sigma) sum of the divisors.  */


n = 30
perfect(n)

func perfect n
for i = 1 to n
    sum = 0
    for j = 1 to i - 1
        if i % j = 0 sum = sum + j ok
    next
    see i
    if sum = i see " is a perfect number" + nl
    but sum < i see " is a deficient number" + nl
    else see " is a abundant number" + nl ok
next


res = (1 .. 20_000).map{|n| n.proper_divisors.sum <=> n }.tally
puts "Deficient: #{res[-1]}   Perfect: #{res[0]}   Abundant: #{res[1]}"


fn main() {
    // deficient starts at 1 because 1 is deficient but proper_divisors returns
    // and empty Vec
    let (mut abundant, mut deficient, mut perfect) = (0u32, 1u32, 0u32);
    for i in 1..20_001 {
        if let Some(divisors) = i.proper_divisors() {
            let sum: u64 = divisors.iter().sum();
            if sum < i {
                deficient += 1
            } else if sum > i {
                abundant += 1
            } else {
                perfect += 1
            }
        }
    }
    println!("deficient:\t{:5}\nperfect:\t{:5}\nabundant:\t{:5}",
             deficient, perfect, abundant);
}


def properDivisors(n: Int) = (1 to n/2).filter(i => n % i == 0)
def classifier(i: Int) = properDivisors(i).sum compare i
val groups = (1 to 20000).groupBy( classifier )
println("Deficient: " + groups(-1).length)
println("Abundant: " + groups(1).length)
println("Perfect: " + groups(0).length + " (" + groups(0).mkString(",") + ")")


(define (classify n)
 (define (sum_of_factors x)
  (cond ((= x 1) 1)
        ((= (remainder n x) 0) (+ x (sum_of_factors (- x 1))))
        (else (sum_of_factors (- x 1)))))
 (cond ((or (= n 1) (< (sum_of_factors (floor (/ n 2))) n)) -1)
       ((= (sum_of_factors (floor (/ n 2))) n) 0)
       (else 1)))
(define n_perfect 0)
(define n_abundant 0)
(define n_deficient 0)
(define (count n)
 (cond ((= n 1) (begin (display "perfect ")
                       (display n_perfect)
                       (newline)
                       (display "abundant")
                       (display n_abundant)
                       (newline)
                       (display "deficinet")
                       (display n_perfect)
                       (newline)))
       ((equal? (classify n) 0) (begin (set! n_perfect (+ 1 n_perfect)) (display n) (newline) (count (- n 1))))
       ((equal? (classify n) 1) (begin (set! n_abundant (+ 1 n_abundant)) (count (- n 1))))
       ((equal? (classify n) -1) (begin (set! n_deficient (+ 1 n_deficient)) (count (- n 1))))))


$ include "seed7_05.s7i";

const func integer: sumProperDivisors (in integer: number) is func
  result
    var integer: sum is 0;
  local
    var integer: num is 0;
  begin
    if number >= 2 then
      for num range 1 to number div 2 do
        if number rem num = 0 then
	  sum +:= num;
	end if;
      end for;
    end if;
  end func;

const proc: main is func
  local
    var integer: sum is 0;
    var integer: deficient is 0;
    var integer: perfect is 0;
    var integer: abundant is 0;
    var integer: number is 0;
  begin
    for number range 1 to 20000 do
      sum := sumProperDivisors(number);
      if sum < number then
        incr(deficient);
      elsif sum = number then
        incr(perfect);
      else
        incr(abundant);
      end if;
    end for;
    writeln("Deficient: " <& deficient);
    writeln("Perfect:   " <& perfect);
    writeln("Abundant:  " <& abundant);
  end func;


func propdivsum(n) { n.sigma - n }

var h = Hash()
{|i| ++(h{propdivsum(i) <=> i} := 0) } << 1..20000
say "Perfect: #{h{0}}    Deficient: #{h{-1}}    Abundant: #{h{1}}"


var deficients = 0 // sumPd < n
var perfects = 0 // sumPd = n
var abundants = 0 // sumPd > n

// 1 is deficient (no proper divisor)
deficients++

for i in 2...20000 {

    var sumPd = 1 // 1 is a proper divisor of all integer above 1

    var maxPdToTest = i/2 // the max divisor to test

    for var j = 2; j < maxPdToTest; j++ {

        if (i%j) == 0 {
            // j is a proper divisor
            sumPd += j

            // New maximum for divisibility check
            maxPdToTest = i / j

            // To add to sum of proper divisors unless already done
            if maxPdToTest != j {
                sumPd += maxPdToTest
            }
        }
    }

    // Select type according to sum of Proper divisors
    if sumPd < i {
        deficients++
    } else if sumPd > i {
        abundants++
    } else {
        perfects++
    }
}

println("There are \(deficients) deficient, \(perfects) perfect and \(abundants) abundant integers from 1 to 20000.")


proc ProperDivisors {n} {
    if {$n == 1} {return 0}
    set divs 1
    set sum 1
    for {set i 2} {$i*$i <= $n} {incr i} {
        if {! ($n % $i)} {
            lappend divs $i
            incr sum $i
            if {$i*$i<$n} {
                lappend divs [set d [expr {$n / $i}]]
                incr sum $d
            }
        }
    }
    list $sum $divs
}

proc cmp {i j} {    ;# analogous to [string compare], but for numbers
    if {$i == $j} {return 0}
    if {$i > $j} {return 1}
    return -1
}

proc classify {k} {
    lassign [ProperDivisors $k] p    ;# we only care about the first part of the result
    dict get {
        1   abundant
        0   perfect
       -1   deficient
    } [cmp $k $p]
}

puts "Classifying the integers in \[1, 20_000\]:"
set classes {}    ;# this will be a dict

for {set i 1} {$i <= 20000} {incr i} {
    set class [classify $i]
    dict incr classes $class
}

# using [lsort] to order the dictionary by value:
foreach {kind count} [lsort -stride 2 -index 1 -integer $classes] {
    puts "$kind: $count"
}


function integer_classification(){
	var sum:number=0, i:number,j:number;
	var try:number=0;
	var number_list:number[]={1,0,0};
	for(i=2;i<=20000;i++){
		try=i/2;
		sum=1;
		for(j=2;j<try;j++){
			if (i%j)
				continue;
			try=i/j;
			sum+=j;
			if (j!=try)
				sum+=try;
		}
		if (sum<i){
			number_list[d]++;
			continue;
		}
		else if (sum>i){
			number_list[a]++;
			continue;
		}
		number_list[p]++;
	}
	console.log('There are '+number_list[d]+ ' deficient , ' + 'number_list[p] + ' perfect and '+ number_list[a]+ ' abundant numbers
between 1 and 20000');
}


P = 0 : D = 0 : A = 0

For n= 1 to 20000
  s = FUNC(_SumDivisors(n))-n
  If s = n Then P = P + 1
  If s < n Then D = D + 1
  If s > n Then A = A + 1
Next

Print "Perfect: ";P;" Deficient: ";D;" Abundant: ";A
End

' Return the least power of [email protected] that does not divide [email protected]

_LeastPower Param(2)
  Local(1)

  [email protected] = [email protected]
  Do While ([email protected] % [email protected]) = 0
    [email protected] = [email protected] * [email protected]
  Loop

Return ([email protected])

' Return the sum of the proper divisors of [email protected]

_SumDivisors Param(1)
  Local(4)

  [email protected] = [email protected]
  [email protected] = 1

  ' Handle two specially

  [email protected] = FUNC(_LeastPower (2,[email protected]))
  [email protected] = [email protected] * ([email protected] - 1)
  [email protected] = [email protected] / ([email protected] / 2)

  ' Handle odd factors

  For [email protected] = 3 Step 2 While ([email protected]*[email protected]) < ([email protected]+1)
    [email protected] = FUNC(_LeastPower ([email protected],[email protected]))
    [email protected] = [email protected] * (([email protected] - 1) / ([email protected] - 1))
    [email protected] = [email protected] / ([email protected] / [email protected])
  Loop

  ' At this point, t must be one or prime

  If ([email protected] > 1) [email protected] = [email protected] * ([email protected]+1)
Return ([email protected])


enum Classification {
  DEFICIENT,
  PERFECT,
  ABUNDANT
}

void main() {
  var i = 0; var j = 0;
  var sum = 0; var try_max = 0;
  int[] count_list = {1, 0, 0};
  for (i = 2; i <= 20000; i++) {
    try_max = i / 2;
    sum = 1;
    for (j = 2; j < try_max; j++) {
      if (i % j != 0)
        continue;
      try_max = i / j;
      sum += j;
      if (j != try_max)
        sum += try_max;
    }
    if (sum < i) {
      count_list[Classification.DEFICIENT]++;
      continue;
    }
    if (sum > i) {
      count_list[Classification.ABUNDANT]++;
      continue;
    }
    count_list[Classification.PERFECT]++;
  }
  print(@"There are $(count_list[Classification.DEFICIENT]) deficient,");
  print(@" $(count_list[Classification.PERFECT]) perfect,");
  print(@" $(count_list[Classification.ABUNDANT]) abundant numbers between 1 and 20000.\n");
}


Option Explicit

Public Sub Nb_Classifications()
Dim A As New Collection, D As New Collection, P As New Collection
Dim n As Long, l As Long, s As String, t As Single

    t = Timer
    'Start
    For n = 1 To 20000
        l = SumPropers(n): s = CStr(n)
        Select Case n
            Case Is > l: D.Add s, s
            Case Is < l: A.Add s, s
            Case l: P.Add s, s
        End Select
    Next

    'End. Return :
    Debug.Print "Execution Time : " & Timer - t & " seconds."
    Debug.Print "-------------------------------------------"
    Debug.Print "Deficient := " & D.Count
    Debug.Print "Perfect := " & P.Count
    Debug.Print "Abundant := " & A.Count
End Sub

Private Function SumPropers(n As Long) As Long
'returns the sum of the proper divisors of n
Dim j As Long
    For j = 1 To n \ 2
        If n Mod j = 0 Then SumPropers = j + SumPropers
    Next
End Function


Deficient = 0
Perfect = 0
Abundant = 0
For i = 1 To 20000
	sum = 0
	For n = 1 To 20000
		If n < i Then
			If i Mod n = 0 Then
				sum = sum + n
			End If
		End If
	Next
	If sum < i Then
		Deficient = Deficient + 1
	ElseIf sum = i Then
		Perfect = Perfect + 1
	ElseIf sum > i Then
		Abundant = Abundant + 1
	End If
Next
WScript.Echo "Deficient = " & Deficient & vbCrLf &_
			 "Perfect = " & Perfect & vbCrLf &_
			 "Abundant = " & Abundant


Module Module1

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

    Sub Main()
        Dim sum, deficient, perfect, abundant As Integer

        For n As Integer = 1 To 20000
            sum = SumProperDivisors(n)
            If sum < n Then
                deficient += 1
            ElseIf sum = n Then
                perfect += 1
            Else
                abundant += 1
            End If
        Next

        Console.WriteLine("The classification of the numbers from 1 to 20,000 is as follows : ")
        Console.WriteLine()
        Console.WriteLine("Deficient = {0}", deficient)
        Console.WriteLine("Perfect   = {0}", perfect)
        Console.WriteLine("Abundant  = {0}", abundant)
    End Sub

End Module


fn p_fac_sum(i int) int {
    mut sum := 0
    for p := 1; p <= i/2; p++ {
        if i%p == 0 {
            sum += p
        }
    }
    return sum
}

fn main() {
    mut d := 0
    mut a := 0
    mut p := 0
    for i := 1; i <= 20000; i++ {
        j := p_fac_sum(i)
        if j < i {
            d++
        } else if j == i {
            p++
        } else {
            a++
        }
    }
    println("There are $d deficient numbers between 1 and 20000")
    println("There are $a abundant numbers  between 1 and 20000")
    println("There are $p perfect numbers between 1 and 20000")
}


import "/math" for Int, Nums

var d = 0
var a = 0
var p = 0
for (i in 1..20000) {
    var j = Nums.sum(Int.properDivisors(i))
    if (j < i) {
        d = d + 1
    } else if (j == i) {
        p = p + 1
    } else {
        a = a + 1
    }
}
System.print("There are %(d) deficient numbers between 1 and 20000")
System.print("There are %(a) abundant numbers  between 1 and 20000")
System.print("There are %(p) perfect numbers between 1 and 20000")


int CntD, CntP, CntA, Num, Div, Sum;
[CntD:= 0;  CntP:= 0;  CntA:= 0;
for Num:= 1 to 20000 do
    [Sum:= if Num = 1 then 0 else 1;
    for Div:= 2 to Num-1 do
    if rem(Num/Div) = 0 then
        Sum:= Sum + Div;
    case of
      Sum < Num: CntD:= CntD+1;
      Sum > Num: CntA:= CntA+1
    other CntP:= CntP+1;
    ];
Text(0, "Deficient: ");  IntOut(0, CntD);  CrLf(0);
Text(0, "Perfect:   ");  IntOut(0, CntP);  CrLf(0);
Text(0, "Abundant:  ");  IntOut(0, CntA);  CrLf(0);
]


clear screen

Deficient = 0
Perfect = 0
Abundant = 0
For j=1 to 20000
	sump = sumprop(j)
	If sump < j Then
		Deficient = Deficient + 1
	ElseIf sump = j Then
		Perfect = Perfect + 1
	ElseIf sump > j Then
		Abundant = Abundant + 1
	End If
Next j

PRINT "Number deficient: ",Deficient
PRINT "Number perfect:   ",Perfect
PRINT "Number abundant:  ",Abundant

sub sumprop(num)
	local i, sum, root

	if num>1 then
		sum=1
		root=sqrt(num)
		for i=2 to root
			if mod(num,i) = 0 then
				sum=sum+i
				if (i*i)<>num sum=sum+num/i
			end if
		next i
	end if
	return sum
end sub


fcn properDivs(n){ [1.. (n + 1)/2 + 1].filter('wrap(x){ n%x==0 and n!=x }) }

fcn classify(n){
   p:=properDivs(n).sum();
   return(if(p<n) -1 else if(p==n) 0 else 1);
}

const rangeMax=20_000;
classified:=[1..rangeMax].apply(classify);
perfect   :=classified.filter('==(0)).len();
abundant  :=classified.filter('==(1)).len();
println("Deficient=%d, perfect=%d, abundant=%d".fmt(
   classified.len()-perfect-abundant, perfect, abundant));


  10 LET nd=1: LET np=0: LET na=0
  20 FOR i=2 TO 20000
  30 LET sum=1
  40 LET max=i/2
  50 LET n=2: LET l=max-1
  60 IF n>l THEN GO TO 90
  70 IF i/n=INT (i/n) THEN LET sum=sum+n: LET max=i/n: IF max<>n THEN LET sum=sum+max: LET l=max-1
  80 LET n=n+1: GO TO 60
  90 IF sum<i THEN LET nd=nd+1: GO TO 120
 100 IF sum=i THEN LET np=np+1: GO TO 120
 110 LET na=na+1
 120 NEXT i
 130 PRINT "Number deficient: ";nd
 140 PRINT "Number perfect:   ";np
 150 PRINT "Number abundant:  ";na


*        Ackermann function        07/09/2015
&LAB     XDECO &REG,&TARGET
.*-----------------------------------------------------------------*
.*       THIS MACRO DISPLAYS THE REGISTER CONTENTS AS A TRUE       *
.*       DECIMAL VALUE. XDECO IS NOT PART OF STANDARD S360 MACROS! *
*------------------------------------------------------------------*
         AIF   (T'&REG EQ 'O').NOREG
         AIF   (T'&TARGET EQ 'O').NODEST
&LAB     B     I&SYSNDX               BRANCH AROUND WORK AREA
W&SYSNDX DS    XL8                    CONVERSION WORK AREA
I&SYSNDX CVD   &REG,W&SYSNDX          CONVERT TO DECIMAL
         MVC   &TARGET,=XL12'402120202020202020202020'
         ED    &TARGET,W&SYSNDX+2     MAKE FIELD PRINTABLE
         BC    2,*+12                 BYPASS NEGATIVE
         MVI   &TARGET+12,C'-'        INSERT NEGATIVE SIGN
         B     *+8                    BYPASS POSITIVE
         MVI   &TARGET+12,C'+'        INSERT POSITIVE SIGN
         MEXIT
.NOREG   MNOTE 8,'INPUT REGISTER OMITTED'
         MEXIT
.NODEST  MNOTE 8,'TARGET FIELD OMITTED'
         MEXIT
         MEND
ACKERMAN CSECT
         USING  ACKERMAN,R12       r12 : base register
         LR     R12,R15            establish base register
         ST     R14,SAVER14A       save r14
         LA     R4,0               m=0
LOOPM    CH     R4,=H'3'           do m=0 to 3
         BH     ELOOPM
         LA     R5,0               n=0
LOOPN    CH     R5,=H'8'           do n=0 to 8
         BH     ELOOPN
         LR     R1,R4              m
         LR     R2,R5              n
         BAL    R14,ACKER          r1=acker(m,n)
         XDECO  R1,PG+19
         XDECO  R4,XD
         MVC    PG+10(2),XD+10
         XDECO  R5,XD
         MVC    PG+13(2),XD+10
         XPRNT  PG,44              print buffer
         LA     R5,1(R5)           n=n+1
         B      LOOPN
ELOOPN   LA     R4,1(R4)           m=m+1
         B      LOOPM
ELOOPM   L      R14,SAVER14A       restore r14
         BR     R14                return to caller
SAVER14A DS     F                  static save r14
PG       DC     CL44'Ackermann(xx,xx) = xxxxxxxxxxxx'
XD       DS     CL12
ACKER    CNOP   0,4                function r1=acker(r1,r2)
         LR     R3,R1              save argument r1 in r3
         LR     R9,R10             save stackptr (r10) in r9 temp
         LA     R1,STACKLEN        amount of storage required
         GETMAIN RU,LV=(R1)        allocate storage for stack
         USING  STACK,R10          make storage addressable
         LR     R10,R1             establish stack addressability
         ST     R14,SAVER14B       save previous r14
         ST     R9,SAVER10B        save previous r10
         LR     R1,R3              restore saved argument r1
START    ST     R1,M               stack m
         ST     R2,N               stack n
IF1      C      R1,=F'0'           if m<>0
         BNE    IF2                then goto if2
         LR     R11,R2             n
         LA     R11,1(R11)         return n+1
         B      EXIT
IF2      C      R2,=F'0'           else if m<>0
         BNE    IF3                then goto if3
         BCTR   R1,0               m=m-1
         LA     R2,1               n=1
         BAL    R14,ACKER          r1=acker(m)
         LR     R11,R1             return acker(m-1,1)
         B      EXIT
IF3      BCTR   R2,0               n=n-1
         BAL    R14,ACKER          r1=acker(m,n-1)
         LR     R2,R1              acker(m,n-1)
         L      R1,M               m
         BCTR   R1,0               m=m-1
         BAL    R14,ACKER          r1=acker(m-1,acker(m,n-1))
         LR     R11,R1             return acker(m-1,1)
EXIT     L      R14,SAVER14B       restore r14
         L      R9,SAVER10B        restore r10 temp
         LA     R0,STACKLEN        amount of storage to free
         FREEMAIN A=(R10),LV=(R0)  free allocated storage
         LR     R1,R11             value returned
         LR     R10,R9             restore r10
         BR     R14                return to caller
         LTORG
         DROP   R12                base no longer needed
STACK    DSECT                     dynamic area
SAVER14B DS     F                  saved r14
SAVER10B DS     F                  saved r10
M        DS     F                  m
N        DS     F                  n
STACKLEN EQU    *-STACK
         YREGS
         END    ACKERMAN


;
; Ackermann function for Motorola 68000 under AmigaOs 2+ by Thorham
;
; Set stack space to 60000 for m = 3, n = 5.
;
; The program will print the ackermann values for the range m = 0..3, n = 0..5
;
_LVOOpenLibrary equ -552
_LVOCloseLibrary equ -414
_LVOVPrintf equ -954

m equ 3 ; Nr of iterations for the main loop.
n equ 5 ; Do NOT set them higher, or it will take hours to complete on
        ; 68k, not to mention that the stack usage will become astronomical.
        ; Perhaps n can be a little higher... If you do increase the ranges
        ; then don't forget to increase the stack size.

execBase=4

start
    move.l  execBase,a6

    lea     dosName,a1
    moveq   #36,d0
    jsr     _LVOOpenLibrary(a6)
    move.l  d0,dosBase
    beq     exit

    move.l  dosBase,a6
    lea     printfArgs,a2

    clr.l   d3 ; m
.loopn
    clr.l   d4 ; n
.loopm
    bsr     ackermann

    move.l  d3,0(a2)
    move.l  d4,4(a2)
    move.l  d5,8(a2)
    move.l  #outString,d1
    move.l  a2,d2
    jsr     _LVOVPrintf(a6)

    addq.l  #1,d4
    cmp.l   #n,d4
    ble     .loopm

    addq.l  #1,d3
    cmp.l   #m,d3
    ble     .loopn

exit
    move.l  execBase,a6
    move.l  dosBase,a1
    jsr     _LVOCloseLibrary(a6)
    rts
;
; ackermann function
;
; in:
;
; d3 = m
; d4 = n
;
; out:
;
; d5 = ans
;
ackermann
    move.l  d3,-(sp)
    move.l  d4,-(sp)

    tst.l   d3
    bne     .l1
    move.l  d4,d5
    addq.l  #1,d5
    bra     .return
.l1
    tst.l   d4
    bne     .l2
    subq.l  #1,d3
    moveq   #1,d4
    bsr     ackermann
    bra     .return
.l2
    subq.l  #1,d4
    bsr     ackermann
    move.l  d5,d4
    subq.l  #1,d3
    bsr     ackermann

.return
    move.l  (sp)+,d4
    move.l  (sp)+,d3
    rts
;
; variables
;
dosBase
    dc.l    0

printfArgs
    dcb.l   3
;
; strings
;
dosName
    dc.b    "dos.library",0

outString
    dc.b    "ackermann (%ld,%ld) is: %ld",10,0


	org	100h
	jmp	demo
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	;;;	ACK(M,N); DE=M, HL=N, return value in HL.
ack:	mov	a,d	; M=0?
	ora	e
	jnz	ackm
	inx	h	; If so, N+1.
	ret
ackm:	mov	a,h	; N=0?
	ora	l
	jnz	ackmn
	lxi	h,1	; If so, N=1,
	dcx	d	; N-=1,
	jmp	ack	; A(M,N) - tail recursion
ackmn:	push	d	; M>0 and N>0: store M on the stack
	dcx	h	; N-=1
	call	ack	; N = ACK(M,N-1)
	pop	d	; Restore previous M
	dcx	d	; M-=1
	jmp	ack	; A(M,N) - tail recursion
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	;;;	Print table of ack(m,n)
MMAX:	equ	4	; Size of table to print. Note that math is done in
NMAX:	equ	9	; 16 bits.
demo:	lhld	6	; Put stack pointer at top of available memory
	sphl
	lxi	b,0	; let B,C hold 8-bit M and N.
acknum:	xra	a	; Set high bit of M and N to zero
	mov	d,a	; DE = B (M)
	mov	e,b
	mov	h,a	; HL = C (N)
	mov	l,c
	call	ack	; HL = ack(DE,HL)
	call	prhl	; Print the number
	inr	c	; N += 1
	mvi	a,NMAX	; Time for next line?
	cmp	c
	jnz	acknum	; If not, print next number
	push	b	; Otherwise, save BC
	mvi	c,9	; Print newline
	lxi	d,nl
	call	5
	pop	b	; Restore BC
	mvi	c,0	; Set N to 0
	inr	b	; M += 1
	mvi	a,MMAX	; Time to stop?
	cmp	b
	jnz	acknum	; If not, print next number
	rst	0
	;;;	Print HL as ASCII number.
prhl:	push	h	; Save all registers
	push	d
	push	b
	lxi	b,pnum	; Store pointer to num string on stack
	push	b
	lxi	b,-10	; Divisor
prdgt:	lxi	d,-1
prdgtl:	inx	d	; Divide by 10 through trial subtraction
	dad	b
	jc	prdgtl
	mvi	a,'0'+10
	add	l	; L = remainder - 10
	pop	h	; Get pointer from stack
	dcx	h	; Store digit
	mov	m,a
	push	h	; Put pointer back on stack
	xchg		; Put quotient in HL
	mov	a,h	; Check if zero
	ora	l
	jnz	prdgt	; If not, next digit
	pop	d	; Get pointer and put in DE
	mvi	c,9	; CP/M print string
	call	5
	pop	b	; Restore registers
	pop	d
	pop	h
	ret
	db	'*****'	; Placeholder for number
pnum:	db	9,'$'
nl:	db	13,10,'$'


	cpu	8086
	bits	16
	org	100h
section	.text
	jmp	demo
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	;;;	ACK(M,N); DX=M, AX=N, return value in AX.
ack:	and	dx,dx	; N=0?
	jnz	.m
	inc	ax	; If so, return N+1
	ret
.m:	and	ax,ax	; M=0?
	jnz	.mn
	mov	ax,1	; If so, N=1,
	dec	dx	; M -= 1
	jmp	ack	; ACK(M-1,1) - tail recursion
.mn:	push	dx	; Keep M on the stack
	dec	ax	; N-=1
	call	ack	; N = ACK(M,N-1)
	pop	dx	; Restore M
	dec	dx	; M -= 1
	jmp	ack	; ACK(M-1,ACK(M,N-1)) - tail recursion
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	;;;	Print table of ack(m,n)
MMAX:	equ	4	; Size of table to print. Noe that math is done
NMAX:	equ	9	; in 16 bits.
demo:	xor	si,si	; Let SI hold M,
	xor	di,di	; and DI hold N.
acknum:	mov	dx,si	; Calculate ack(M,N)
	mov	ax,di
	call	ack
	call	prax	; Print number
	inc	di	; N += 1
	cmp	di,NMAX	; Row done?
	jb	acknum	; If not, print next number on row
	xor	di,di	; Otherwise, N=0,
	inc	si	; M += 1
	mov	dx,nl	; Print newline
	call	prstr
	cmp	si,MMAX	; Done?
	jb	acknum	; If not, start next row
	ret		; Otherwise, stop.
	;;;	Print AX as ASCII number.
prax:	mov	bx,pnum	; Pointer to number string
	mov	cx,10	; Divisor
.dgt:	xor	dx,dx	; Divide AX by ten
	div	cx
	add	dl,'0'	; DX holds remainder - add ASCII 0
	dec	bx	; Move pointer backwards
	mov	[bx],dl	; Save digit in string
	and	ax,ax	; Are we done yet?
	jnz	.dgt	; If not, next digit
	mov	dx,bx	; Tell DOS to print the string
prstr:	mov	ah,9
	int	21h
	ret
section	.data
	db	'*****'	; Placeholder for ASCII number
pnum:	db	9,'$'
nl:	db	13,10,'$'


\ Ackermann function, illustrating use of "memoization".

\ Memoization is a technique whereby intermediate computed values are stored
\ away against later need.  It is particularly valuable when calculating those
\ values is time or resource intensive, as with the Ackermann function.

\ make the stack much bigger so this can complete!
100000 stack-size

\ This is where memoized values are stored:
{} var, dict

\ Simple accessor words
: dict! \ "key" val --
  dict @ -rot m:! drop ;

: [email protected] \ "key" -- val
  dict @ swap m:@ nip ;

defer: ack1

\ We just jam the string representation of the two numbers together for a key:
: makeKey  \ m n -- m n key
	2dup >s swap >s s:+ ;

: ack2 \ m n -- A
	makeKey dup
	[email protected] null?
	if \ can't find key in dict
		\ m n key null
		drop \ m n key
		-rot \ key m n
		ack1 \ key A
		tuck \ A key A
		dict! \ A
	else \ found value
		\ m n key value
		>r drop 2drop r>
	then ;

: ack \ m n -- A
	over not
	if
		nip n:1+
	else
		dup not
		if
			drop n:1- 1 ack2
		else
			over swap n:1- ack2
			swap n:1- swap ack2
		then
	then ;

' ack is ack1

: ackOf \ m n --
        2dup
        "Ack(" . swap . ", " . . ") = " . ack . cr ;

0 0 ackOf
0 4 ackOf
1 0 ackOf
1 1 ackOf
2 1 ackOf
2 2 ackOf
3 1 ackOf
3 3 ackOf
4 0 ackOf

\ this last requires a very large data stack.  So start 8th with a parameter '-k 100000'
4 1 ackOf

bye


/* ARM assembly AARCH64 Raspberry PI 3B or android 64 bits */
/*  program ackermann64.s   */

/*******************************************/
/* Constantes file                         */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"
.equ MMAXI,   4
.equ NMAXI,   10

/*********************************/
/* Initialized data              */
/*********************************/
.data
sMessResult:        .asciz "Result for @  @  : @ \n"
szMessError:        .asciz "Overflow !!.\n"
szCarriageReturn:   .asciz "\n"

/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
sZoneConv:        .skip 24
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                           // entry of program
    mov x3,#0
    mov x4,#0
1:
    mov x0,x3
    mov x1,x4
    bl ackermann
    mov x5,x0
    mov x0,x3
    ldr x1,qAdrsZoneConv        // else display odd message
    bl conversion10             // call decimal conversion
    ldr x0,qAdrsMessResult
    ldr x1,qAdrsZoneConv        // insert value conversion in message
    bl strInsertAtCharInc
    mov x6,x0
    mov x0,x4
    ldr x1,qAdrsZoneConv        // else display odd message
    bl conversion10             // call decimal conversion
    mov x0,x6
    ldr x1,qAdrsZoneConv        // insert value conversion in message
    bl strInsertAtCharInc
    mov x6,x0
    mov x0,x5
    ldr x1,qAdrsZoneConv        // else display odd message
    bl conversion10             // call decimal conversion
    mov x0,x6
    ldr x1,qAdrsZoneConv        // insert value conversion in message
    bl strInsertAtCharInc
    bl affichageMess
    add x4,x4,#1
    cmp x4,#NMAXI
    blt 1b
    mov x4,#0
    add x3,x3,#1
    cmp x3,#MMAXI
    blt 1b
100:                            // standard end of the program
    mov x0, #0                  // return code
    mov x8, #EXIT               // request to exit program
    svc #0                      // perform the system call

qAdrszCarriageReturn:     .quad szCarriageReturn
qAdrsMessResult:          .quad sMessResult
qAdrsZoneConv:            .quad sZoneConv
/***************************************************/
/*     fonction ackermann              */
/***************************************************/
// x0 contains a number m
// x1 contains a number n
// x0 return résult
ackermann:
    stp x1,lr,[sp,-16]!         // save  registres
    stp x2,x3,[sp,-16]!         // save  registres
    cmp x0,0
    beq 5f
    mov x3,-1
    csel x0,x3,x0,lt               // error
    blt 100f
    cmp x1,#0
    csel x0,x3,x0,lt               // error
    blt 100f
    bgt 1f
    sub x0,x0,#1
    mov x1,#1
    bl ackermann
    b 100f
1:
    mov x2,x0
    sub x1,x1,#1
    bl ackermann
    mov x1,x0
    sub x0,x2,#1
    bl ackermann
    b 100f
5:
    adds x0,x1,#1
    bcc 100f
    ldr x0,qAdrszMessError
    bl affichageMess
    mov x0,-1
100:

    ldp x2,x3,[sp],16         // restaur des  2 registres
    ldp x1,lr,[sp],16         // restaur des  2 registres
    ret
qAdrszMessError:        .quad szMessError

/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


REPORT  zhuberv_ackermann.

CLASS zcl_ackermann DEFINITION.
  PUBLIC SECTION.
    CLASS-METHODS ackermann IMPORTING m TYPE i
                                      n TYPE i
                            RETURNING value(v) TYPE i.
ENDCLASS.            "zcl_ackermann DEFINITION

CLASS zcl_ackermann IMPLEMENTATION.

  METHOD: ackermann.

    DATA: lv_new_m TYPE i,
          lv_new_n TYPE i.

    IF m = 0.
      v = n + 1.
    ELSEIF m > 0 AND n = 0.
      lv_new_m = m - 1.
      lv_new_n = 1.
      v = ackermann( m = lv_new_m n = lv_new_n ).
    ELSEIF m > 0 AND n > 0.
      lv_new_m = m - 1.

      lv_new_n = n - 1.
      lv_new_n = ackermann( m = m n = lv_new_n ).

      v = ackermann( m = lv_new_m n = lv_new_n ).
    ENDIF.

  ENDMETHOD.                    "ackermann

ENDCLASS.                    "zcl_ackermann IMPLEMENTATION

PARAMETERS: pa_m TYPE i,
            pa_n TYPE i.

DATA: lv_result TYPE i.

START-OF-SELECTION.
  lv_result = zcl_ackermann=>ackermann( m = pa_m n = pa_n ).
  WRITE: / lv_result.


DEFINE MAXSIZE="1000"
CARD ARRAY stack(MAXSIZE)
CARD stacksize=[0]

BYTE FUNC IsEmpty()
  IF stacksize=0 THEN
    RETURN (1)
  FI
RETURN (0)

PROC Push(BYTE v)
  IF stacksize=maxsize THEN
    PrintE("Error: stack is full!")
    Break()
  FI
  stack(stacksize)=v
  stacksize==+1
RETURN

BYTE FUNC Pop()
  IF IsEmpty() THEN
    PrintE("Error: stack is empty!")
    Break()
  FI
  stacksize==-1
RETURN (stack(stacksize))

CARD FUNC Ackermann(CARD m,n)
  Push(m)
  WHILE IsEmpty()=0
  DO
    m=Pop()
    IF m=0 THEN
      n==+1
    ELSEIF n=0 THEN
      n=1
      Push(m-1)
    ELSE
      n==-1
      Push(m-1)
      Push(m)
    FI
  OD
RETURN (n)

PROC Main()
  CARD m,n,res

  FOR m=0 TO 3
  DO
    FOR n=0 TO 4
    DO
      res=Ackermann(m,n)
      PrintF("Ack(%U,%U)=%U%E",m,n,res)
    OD
  OD
RETURN


public function ackermann(m:uint, n:uint):uint
{
    if (m == 0)
    {
        return n + 1;
    }
    if (n == 0)
    {
        return ackermann(m - 1, 1);
    }

    return ackermann(m - 1, ackermann(m, n - 1));
}


with Ada.Text_IO;  use Ada.Text_IO;

procedure Test_Ackermann is
   function Ackermann (M, N : Natural) return Natural is
   begin
      if M = 0 then
         return N + 1;
      elsif N = 0 then
         return Ackermann (M - 1, 1);
      else
         return Ackermann (M - 1, Ackermann (M, N - 1));
      end if;
   end Ackermann;
begin
   for M in 0..3 loop
      for N in 0..6 loop
         Put (Natural'Image (Ackermann (M, N)));
      end loop;
      New_Line;
   end loop;
end Test_Ackermann;


open import Data.Nat
open import Data.Nat.Show
open import IO

module Ackermann where

ack : ℕ -> ℕ -> ℕ
ack zero n = n + 1
ack (suc m) zero = ack m 1
ack (suc m) (suc n) = ack m (ack (suc m) n)

main = run (putStrLn (show (ack 3 9)))


begin
   integer procedure ackermann(m,n);value m,n;integer m,n;
   ackermann:=if m=0 then n+1
         else if n=0 then ackermann(m-1,1)
                     else ackermann(m-1,ackermann(m,n-1));
   integer m,n;
   for m:=0 step 1 until 3 do begin
      for n:=0 step 1 until 6 do
         outinteger(1,ackermann(m,n));
      outstring(1,"\n")
   end
end


PROC test ackermann = VOID:
BEGIN
   PROC ackermann = (INT m, n)INT:
   BEGIN
      IF m = 0 THEN
         n + 1
      ELIF n = 0 THEN
         ackermann (m - 1, 1)
      ELSE
         ackermann (m - 1, ackermann (m, n - 1))
      FI
   END # ackermann #;

   FOR m FROM 0 TO 3 DO
      FOR n FROM 0 TO 6 DO
         print(ackermann (m, n))
      OD;
      new line(stand out)
   OD
END # test ackermann #;
test ackermann


begin
   integer procedure ackermann( integer value m,n ) ;
       if m=0 then n+1
       else if n=0 then ackermann(m-1,1)
                   else ackermann(m-1,ackermann(m,n-1));
   for m := 0 until 3 do begin
      write( ackermann( m, 0 ) );
      for n := 1 until 6 do writeon( ackermann( m, n ) );
   end for_m
end.


on ackermann(m, n)
    if m is equal to 0 then return n + 1
    if n is equal to 0 then return ackermann(m - 1, 1)
    return ackermann(m - 1, ackermann(m, n - 1))
end ackermann


use std

for each (val nat n) from 0 to 6
  for each (val nat m) from 0 to 3
    print "A("m","n") = "(A m n)

.:A <nat m, nat n>:. -> nat
  return (n+1)				if m == 0
  return (A (m - 1) 1)			if n == 0
  A (m - 1) (A m (n - 1))


/* ARM assembly Raspberry PI  or android 32 bits */
/*  program ackermann.s   */

/* REMARK 1 : this program use routines in a include file
   see task Include a file language arm assembly
   for the routine affichageMess conversion10
   see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes                       */
/************************************/
.include "../constantes.inc"
.equ MMAXI,   4
.equ NMAXI,   10

/*********************************/
/* Initialized data              */
/*********************************/
.data
sMessResult:        .asciz "Result for @  @  : @ \n"
szMessError:        .asciz "Overflow !!.\n"
szCarriageReturn:   .asciz "\n"

/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
sZoneConv:        .skip 24
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                           @ entry of program
    mov r3,#0
    mov r4,#0
1:
    mov r0,r3
    mov r1,r4
    bl ackermann
    mov r5,r0
    mov r0,r3
    ldr r1,iAdrsZoneConv        @ else display odd message
    bl conversion10             @ call decimal conversion
    ldr r0,iAdrsMessResult
    ldr r1,iAdrsZoneConv        @ insert value conversion in message
    bl strInsertAtCharInc
    mov r6,r0
    mov r0,r4
    ldr r1,iAdrsZoneConv        @ else display odd message
    bl conversion10             @ call decimal conversion
    mov r0,r6
    ldr r1,iAdrsZoneConv        @ insert value conversion in message
    bl strInsertAtCharInc
    mov r6,r0
    mov r0,r5
    ldr r1,iAdrsZoneConv        @ else display odd message
    bl conversion10             @ call decimal conversion
    mov r0,r6
    ldr r1,iAdrsZoneConv        @ insert value conversion in message
    bl strInsertAtCharInc
    bl affichageMess
    add r4,#1
    cmp r4,#NMAXI
    blt 1b
    mov r4,#0
    add r3,#1
    cmp r3,#MMAXI
    blt 1b
100:                            @ standard end of the program
    mov r0, #0                  @ return code
    mov r7, #EXIT               @ request to exit program
    svc #0                      @ perform the system call

iAdrszCarriageReturn:     .int szCarriageReturn
iAdrsMessResult:          .int sMessResult
iAdrsZoneConv:            .int sZoneConv
/***************************************************/
/*     fonction ackermann              */
/***************************************************/
// r0 contains a number m
// r1 contains a number n
// r0 return résult
ackermann:
    push {r1-r2,lr}             @ save  registers
    cmp r0,#0
    beq 5f
    movlt r0,#-1               @ error
    blt 100f
    cmp r1,#0
    movlt r0,#-1               @ error
    blt 100f
    bgt 1f
    sub r0,r0,#1
    mov r1,#1
    bl ackermann
    b 100f
1:
    mov r2,r0
    sub r1,r1,#1
    bl ackermann
    mov r1,r0
    sub r0,r2,#1
    bl ackermann
    b 100f
5:
    adds r0,r1,#1
    bcc 100f
    ldr r0,iAdrszMessError
    bl affichageMess
    bkpt
100:
    pop {r1-r2,lr}             @ restaur registers
    bx lr                      @ return
iAdrszMessError:        .int szMessError
/***************************************************/
/*      ROUTINES INCLUDE                           */
/***************************************************/
.include "../affichage.inc"


ackermann: function [m,n][
    (m=0)? -> n+1 [
        (n=0)? -> ackermann m-1 1
               -> ackermann m-1 ackermann m n-1
    ]
]

loop 0..3 'a [
    loop 0..4 'b [
        print ["ackermann" a b "=>" ackermann a b]
    ]
]


fun ackermann
  {m,n:nat} .<m,n>.
  (m: int m, n: int n): Nat =
  case+ (m, n) of
  | (0, _) => n+1
  | (_, 0) =>> ackermann (m-1, 1)
  | (_, _) =>> ackermann (m-1, ackermann (m, n-1))
// end of [ackermann]


A(m, n) {
  If (m > 0) && (n = 0)
    Return A(m-1,1)
  Else If (m > 0) && (n > 0)
    Return A(m-1,A(m, n-1))
  Else If (m=0)
    Return n+1
}

; Example:
MsgBox, % "A(1,2) = " A(1,2)


Func Ackermann($m, $n)
    If ($m = 0) Then
        Return $n+1
    Else
        If ($n = 0) Then
            Return Ackermann($m-1, 1)
        Else
            return Ackermann($m-1, Ackermann($m, $n-1))
        EndIf
    EndIf
EndFunc


function ackermann(m, n)
{
  if ( m == 0 ) {
    return n+1
  }
  if ( n == 0 ) {
    return ackermann(m-1, 1)
  }
  return ackermann(m-1, ackermann(m, n-1))
}

BEGIN {
  for(n=0; n < 7; n++) {
    for(m=0; m < 4; m++) {
      print "A(" m "," n ") = " ackermann(m,n)
    }
  }
}


100 DIM R%(2900),M(2900),N(2900)
110 FOR M = 0 TO 3
120     FOR N = 0 TO 4
130         GOSUB 200"ACKERMANN
140         PRINT "ACK("M","N") = "ACK
150 NEXT N, M
160 END

200 M(SP) = M
210 N(SP) = N

REM A(M - 1, A(M, N - 1))
220 IF M > 0 AND N > 0 THEN N = N - 1 : R%(SP) = 0 : SP = SP + 1 : GOTO 200

REM A(M - 1, 1)
230 IF M > 0 THEN M = M - 1 : N = 1 : R%(SP) = 1 : SP = SP + 1 : GOTO 200

REM N + 1
240 ACK = N + 1

REM RETURN
250 M = M(SP) : N = N(SP) : IF SP = 0 THEN RETURN
260 FOR SP = SP - 1 TO 0 STEP -1 : IF R%(SP) THEN M = M(SP) : N = N(SP) : NEXT SP : SP = 0 : RETURN
270 M = M - 1 : N = ACK : R%(SP) = 1 : SP = SP + 1 : GOTO 200


::Ackermann.cmd
@echo off
set depth=0
:ack
if %1==0 goto m0
if %2==0 goto n0

:else
set /a n=%2-1
set /a depth+=1
call :ack %1 %n%
set t=%errorlevel%
set /a depth-=1
set /a m=%1-1
set /a depth+=1
call :ack %m% %t%
set t=%errorlevel%
set /a depth-=1
if %depth%==0 ( exit %t% ) else ( exit /b %t% )

:m0
set/a n=%2+1
if %depth%==0 ( exit %n% ) else ( exit /b %n% )

:n0
set /a m=%1-1
set /a depth+=1
call :ack %m% 1
set t=%errorlevel%
set /a depth-=1
if %depth%==0 ( exit %t% ) else ( exit /b %t% )


GET "libhdr"

LET ack(m, n) = m=0 -> n+1,
                n=0 -> ack(m-1, 1),
                ack(m-1, ack(m, n-1))

LET start() = VALOF
{ FOR i = 0 TO 6 FOR m = 0 TO 3 DO
    writef("ack(%n, %n) = %n*n", m, n, ack(m,n))
  RESULTIS 0
}


                         >[email protected]@[email protected]            if m>0 and n>0 => replace m,n with m-1,m,n-1
                    >@[email protected]'[email protected]@[email protected]            if m>0 and n=0 => replace m,n with m-1,1
_ii>[email protected]'d?g?Pfzp                         if m=0         => replace m,n with n+1
           >I;
     b                     <            <


ackermann = { m, n |
	when { m == 0 } { n + 1 }
		{ m > 0 && n == 0 } { ackermann(m - 1, 1) }
		{ m > 0 && n > 0 } { ackermann(m - 1, ackermann(m, n - 1)) }
}

p ackermann 3, 4  #Prints 125


#include <stdio.h>

int ackermann(int m, int n)
{
        if (!m) return n + 1;
        if (!n) return ackermann(m - 1, 1);
        return ackermann(m - 1, ackermann(m, n - 1));
}

int main()
{
        int m, n;
        for (m = 0; m <= 4; m++)
                for (n = 0; n < 6 - m; n++)
                        printf("A(%d, %d) = %d\n", m, n, ackermann(m, n));

        return 0;
}


using System;
class Program
{
    public static long Ackermann(long m, long n)
    {
        if(m > 0)
        {
            if (n > 0)
                return Ackermann(m - 1, Ackermann(m, n - 1));
            else if (n == 0)
                return Ackermann(m - 1, 1);
        }
        else if(m == 0)
        {
            if(n >= 0)
                return n + 1;
        }

        throw new System.ArgumentOutOfRangeException();
    }

    static void Main()
    {
        for (long m = 0; m <= 3; ++m)
        {
            for (long n = 0; n <= 4; ++n)
            {
                Console.WriteLine("Ackermann({0}, {1}) = {2}", m, n, Ackermann(m, n));
            }
        }
    }
}


#include <iostream>

unsigned int ackermann(unsigned int m, unsigned int n) {
  if (m == 0) {
    return n + 1;
  }
  if (n == 0) {
    return ackermann(m - 1, 1);
  }
  return ackermann(m - 1, ackermann(m, n - 1));
}

int main() {
  for (unsigned int m = 0; m < 4; ++m) {
    for (unsigned int n = 0; n < 10; ++n) {
      std::cout << "A(" << m << ", " << n << ") = " << ackermann(m, n) << "\n";
    }
  }
}


proc A(m:int, n:int):int {
        if m == 0 then
                return n + 1;
        else if n == 0 then
                return A(m - 1, 1);
        else
                return A(m - 1, A(m, n - 1));
}


ackermann(m, n) {
    if(m == 0)
      return n + 1;
    if(n == 0)
      return ackermann(m - 1, 1);

    return ackermann(m - 1, ackermann(m, n - 1));
}


(deffunction ackerman
  (?m ?n)
  (if (= 0 ?m)
    then (+ ?n 1)
    else (if (= 0 ?n)
      then (ackerman (- ?m 1) 1)
      else (ackerman (- ?m 1) (ackerman ?m (- ?n 1)))
    )
  )
)


(defn ackermann [m n]
  (cond (zero? m) (inc n)
        (zero? n) (ackermann (dec m) 1)
        :else (ackermann (dec m) (ackermann m (dec n)))))


% Ackermann function
ack = proc (m, n: int) returns (int)
    if     m=0 then return(n+1)
    elseif n=0 then return(ack(m-1, 1))
    else            return(ack(m-1, ack(m, n-1)))
    end
end ack

% Print a table of ack( 0..3, 0..8 )
start_up = proc ()
    po: stream := stream$primary_output()

    for m: int in int$from_to(0, 3) do
        for n: int in int$from_to(0, 8) do
            stream$putright(po, int$unparse(ack(m,n)), 8)
        end
        stream$putl(po, "")
    end
end start_up


       IDENTIFICATION DIVISION.
       PROGRAM-ID. Ackermann.

       DATA DIVISION.
       LINKAGE SECTION.
       01  M          USAGE UNSIGNED-LONG.
       01  N          USAGE UNSIGNED-LONG.

       01  Return-Val USAGE UNSIGNED-LONG.

       PROCEDURE DIVISION USING M N Return-Val.
           EVALUATE M ALSO N
               WHEN 0 ALSO ANY
                   ADD 1 TO N GIVING Return-Val

               WHEN NOT 0 ALSO 0
                   SUBTRACT 1 FROM M
                   CALL "Ackermann" USING BY CONTENT M BY CONTENT 1
                       BY REFERENCE Return-Val

               WHEN NOT 0 ALSO NOT 0
                   SUBTRACT 1 FROM N
                   CALL "Ackermann" USING BY CONTENT M BY CONTENT N
                       BY REFERENCE Return-Val

                   SUBTRACT 1 FROM M
                   CALL "Ackermann" USING BY CONTENT M
                       BY CONTENT Return-Val BY REFERENCE Return-Val
           END-EVALUATE

           GOBACK
           .


ackermann = (m, n) ->
  if m is 0 then n + 1
  else if m > 0 and n is 0 then ackermann m - 1, 1
  else ackermann m - 1, ackermann m, n - 1


0010 //
0020 // Ackermann function
0030 //
0040 FUNC a#(m#,n#)
0050   IF m#=0 THEN RETURN n#+1
0060   IF n#=0 THEN RETURN a#(m#-1,1)
0070   RETURN a#(m#-1,a#(m#,n#-1))
0080 ENDFUNC a#
0090 //
0100 // Print table of Ackermann values
0110 //
0120 ZONE 5
0130 FOR m#:=0 TO 3 DO
0140   FOR n#:=0 TO 4 DO PRINT a#(m#,n#),
0150   PRINT
0160 ENDFOR m#
0170 END


(defun ackermann (m n)
  (cond ((zerop m) (1+ n))
        ((zerop n) (ackermann (1- m) 1))
        (t         (ackermann (1- m) (ackermann m (1- n))))))


MODULE NpctAckerman;

IMPORT  StdLog;

VAR
	m,n: INTEGER;

PROCEDURE Ackerman (x,y: INTEGER):INTEGER;

BEGIN
  IF    x = 0  THEN  RETURN  y + 1
  ELSIF y = 0  THEN  RETURN  Ackerman (x - 1 , 1)
  ELSE
    RETURN  Ackerman (x - 1 , Ackerman (x , y - 1))
  END
END Ackerman;

PROCEDURE Do*;
BEGIN
  FOR  m := 0  TO  3  DO
    FOR  n := 0  TO  6  DO
      StdLog.Int (Ackerman (m, n));StdLog.Char (' ')
    END;
    StdLog.Ln
  END;
  StdLog.Ln
END Do;

END NpctAckerman.


Require Import Arith.
Fixpoint A m := fix A_m n :=
  match m with
    | 0 => n + 1
    | S pm =>
      match n with
        | 0 => A pm 1
        | S pn => A pm (A_m pn)
      end
  end.


def ack(m, n)
  if m == 0
    n + 1
  elsif n == 0
    ack(m-1, 1)
  else
    ack(m-1, ack(m, n-1))
  end
end

#Example:
(0..3).each do |m|
  puts (0..6).map { |n| ack(m, n) }.join(' ')
end


ulong ackermann(in ulong m, in ulong n) pure nothrow @nogc {
    if (m == 0)
        return n + 1;
    if (n == 0)
        return ackermann(m - 1, 1);
    return ackermann(m - 1, ackermann(m, n - 1));
}

void main() {
    assert(ackermann(2, 4) == 11);
}


function Ackermann(m,n:Int64):Int64;
begin
    if m = 0 then
        Result := n + 1
    else if n = 0 then
        Result := Ackermann(m-1, 1)
    else
        Result := Ackermann(m-1, Ackermann(m, n - 1));
end;


/* Ackermann function */
proc ack(word m, n) word:
    if   m=0 then n+1
    elif n=0 then ack(m-1, 1)
    else          ack(m-1, ack(m, n-1))
    fi
corp;

/* Write a table of Ackermann values */
proc nonrec main() void:
    byte m, n;
    for m from 0 upto 3 do
        for n from 0 upto 8 do
            write(ack(m,n) : 5)
        od;
        writeln()
    od
corp


function Ackermann(m, n : Integer) : Integer;
begin
    if m = 0 then
        Result := n+1
    else if n = 0 then
        Result := Ackermann(m-1, 1)
    else Result := Ackermann(m-1, Ackermann(m, n-1));
end;


define method ack(m == 0, n :: <integer>)
   n + 1
end;
define method ack(m :: <integer>, n :: <integer>)
   ack(m - 1, if (n == 0) 1 else ack(m, n - 1) end)
end;


func ackerm m n . r .
  if m = 0
    r = n + 1
  elif n = 0
    call ackerm m - 1 1 r
  else
    call ackerm m n - 1 h
    call ackerm m - 1 h r
  .
.
call ackerm 3 6 r
print r


def ackermann =
    [ 0 N -> N + 1
    | M 0 -> ackermann (M - 1) 1
    | M N -> ackermann (M - 1) (ackermann M (N - 1)) ]


note
	description: "Example of Ackerman function"
	synopsis: "[
		The EIS link below (in Eiffel Studio) will launch in either an in-IDE browser or
		and external browser (your choice). The protocol informs Eiffel Studio about what
		program to use to open the `src' reference, which can be URI, PDF, or DOC. See
		second EIS for more information.
		]"
	EIS: "name=Ackermann_function", "protocol=URI", "tag=rosetta_code",
		"src=http://rosettacode.org/wiki/Ackermann_function"
	EIS: "name=eis_protocols", "protocol=URI", "tag=eiffel_docs",
		"src=https://docs.eiffel.com/book/eiffelstudio/protocols"

class
	APPLICATION

create
	make

feature {NONE} -- Initialization

	make
		do
			print ("%N A(0,0):" + ackerman (0, 0).out)
			print ("%N A(1,0):" + ackerman (1, 0).out)
			print ("%N A(0,1):" + ackerman (0, 1).out)
			print ("%N A(1,1):" + ackerman (1, 1).out)
			print ("%N A(2,0):" + ackerman (2, 0).out)
			print ("%N A(2,1):" + ackerman (2, 1).out)
			print ("%N A(2,2):" + ackerman (2, 2).out)
			print ("%N A(0,2):" + ackerman (0, 2).out)
			print ("%N A(1,2):" + ackerman (1, 2).out)
			print ("%N A(3,3):" + ackerman (3, 3).out)
			print ("%N A(3,4):" + ackerman (3, 4).out)
		end

feature -- Access

	ackerman (m, n: NATURAL): NATURAL
		do
			if m = 0 then
				Result := n + 1
			elseif n = 0 then
				Result := ackerman (m - 1, 1)
			else
				Result := ackerman (m - 1, ackerman (m, n - 1))
			end
		end
end


ack 0 n = n+1
ack m 0 = ack (m - 1) 1
ack m n = ack (m - 1) <| ack m <| n - 1


import extensions;

ackermann(m,n)
{
    if(n < 0 || m < 0)
    {
        InvalidArgumentException.raise()
    };

    m =>
       0 { ^n + 1 }
       : {
              n =>
                0 { ^ackermann(m - 1,1) }
                : { ^ackermann(m - 1,ackermann(m,n-1)) }
           }
}

public program()
{
    for(int i:=0, i <= 3, i += 1)
    {
        for(int j := 0, j <= 5, j += 1)
        {
            console.printLine("A(",i,",",j,")=",ackermann(i,j))
        }
    };

    console.readChar()
}


V grid = [[0] * 10] * 10
grid[5][5] = 64

print(‘Before:’)
L(row) grid
   print(row.map(c -> ‘#3’.format(c)).join(‘’))

F simulate(&grid)
   L
      V changed = 0B
      L(arr) grid
         V ii = L.index
         L(val) arr
            V jj = L.index
            I val > 3
               grid[ii][jj] -= 4
               I ii > 0
                  grid[ii - 1][jj]++
               I ii < grid.len - 1
                  grid[ii + 1][jj]++
               I jj > 0
                  grid[ii][jj - 1]++
               I jj < grid.len - 1
                  grid[ii][jj + 1]++
               changed = 1B
      I !changed
         L.break

simulate(&grid)

print("\nAfter:")
L(row) grid
   print(row.map(c -> ‘#3’.format(c)).join(‘’))

grid = [[0] * 65] * 65
grid[32][32] = 64 * 64

simulate(&grid)

V ppm = File(‘sand_pile.ppm’, ‘w’)
ppm.write_bytes(("P6\n#. #.\n255\n".format(grid.len, grid.len)).encode())
V colors = [[Byte(0),   0, 0],
            [Byte(255), 0, 0],
            [Byte(0), 255, 0],
            [Byte(0), 0, 255]]
L(row) grid
   L(c) row
      ppm.write_bytes(colors[c])


defmodule Ackermann do
  def ack(0, n), do: n + 1
  def ack(m, 0), do: ack(m - 1, 1)
  def ack(m, n), do: ack(m - 1, ack(m, n - 1))
end

Enum.each(0..3, fn m ->
  IO.puts Enum.map_join(0..6, " ", fn n -> Ackermann.ack(m, n) end)
end)


/* ARM assembly AARCH64 Raspberry PI 3B or android 64 bits */
/*  program abelian64.s   */

/* run : abelian 256 12 12  */

/*******************************************/
/* Constantes file                         */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"
.equ MAXI, 25

/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessValue:        .asciz "@ "
szMessErrParam:     .asciz "error : command line = abelian size posx posy  \n"
szMessFin:          .asciz "End display :\n"
szCarriageReturn:   .asciz "\n"

/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
sZoneConv:        .skip 24
iSandPile:        .skip 8 * MAXI * MAXI
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                            // entry of program
    mov fp,sp
    ldr x4,[fp]                  // load number of parameters command line
    cmp x4,#3                    // < 4 -> error
    ble 99f
    add x0,fp,#32                // load address param 4 = pos y
    ldr x0,[x0]
    bl conversionAtoD            // conversion ascii -> numeric
    mov x3,x0
    add x0,fp,#24                // load address param 3 = pos x
    ldr x0,[x0]
    bl conversionAtoD
    mov x2,x0
    add x0,fp,#16                 // load address param 2 = size begin pile
    ldr x0,[x0]
    bl conversionAtoD
    ldr x4,qAdriSandPile
    mov x5,#MAXI
    madd x5,x3,x5,x2              // compute offset = maxi * y + x
    str x0,[x4,x5,lsl #3]         // and store size in pos x,y
    //mov x0,x4                   // display start position
    //bl displaySandPile

    mov x0,x4                     // sandpile address
    mov x1,x2                     // pos x to start
    mov x2,x3                     // pos y to start
    bl addSand

    ldr x0,qAdrszMessFin
    bl affichageMess
    mov x0,x4
    bl displaySandPile
    b 100f
99:                               // line command error
   ldr x0,qAdrszMessErrParam
   bl affichageMess
100:                              // standard end of the program
    mov x0,0                      // return code
    mov x8,EXIT                   // request to exit program
    svc 0                         // perform the system call

qAdrszCarriageReturn:     .quad szCarriageReturn
qAdrsZoneConv:            .quad sZoneConv
qAdrszMessErrParam:       .quad szMessErrParam
qAdrszMessFin:            .quad szMessFin
qAdriSandPile:            .quad iSandPile
/***************************************************/
/*     display  sandpile               */
/***************************************************/
// x0 contains address to sandpile
displaySandPile:
    stp x1,lr,[sp,-16]!         // save  registres
    stp x2,x3,[sp,-16]!         // save  registres
    stp x4,x5,[sp,-16]!         // save  registres
    stp x6,x7,[sp,-16]!         // save  registres
    mov x6,x0
    mov x3,#0                   // indice y
    mov x4,#MAXI
1:
    mov x2,#0                   // indice x
2:
    madd x5,x3,x4,x2            // compute offset
    ldr x0,[x6,x5,lsl #3]       // load value at pos x,y
    ldr x1,qAdrsZoneConv
    bl conversion10             // call decimal conversion
    add x1,x1,1
    mov x7,#0
    strb w7,[x1,x0]
    ldr x0,qAdrszMessValue
    ldr x1,qAdrsZoneConv        // insert value conversion in message
    bl strInsertAtCharInc
    bl affichageMess
    add x2,x2,1
    cmp x2,MAXI
    blt 2b
    ldr x0,qAdrszCarriageReturn
    bl affichageMess
    add x3,x3,1
    cmp x3,MAXI
    blt 1b

100:
    ldp x6,x7,[sp],16         // restaur des  2 registres
    ldp x4,x5,[sp],16         // restaur des  2 registres
    ldp x2,x3,[sp],16         // restaur des  2 registres
    ldp x1,lr,[sp],16         // restaur des  2 registres
    ret
qAdrszMessValue:       .quad szMessValue
/***************************************************/
/*     display  sandpile               */
/***************************************************/
// x0 contains address to sanspile
// x1 contains position x
// x2 contains position y
addSand:
    stp x1,lr,[sp,-16]!         // save  registres
    stp x2,x3,[sp,-16]!         // save  registres
    stp x4,x5,[sp,-16]!         // save  registres
    mov x3,#MAXI
    madd x4,x3,x2,x1            // compute offset
    ldr x5,[x0,x4,lsl #3]
1:
    cmp x5,#4                   // 4 grains ?
    blt 100f
    sub x5,x5,4                 // yes sustract
    str x5,[x0,x4,lsl #3]
    cmp x1,MAXI-1               // right position ok ?
    beq 2f
    add x1,x1,1                 // yes
    bl add1Sand                 // add 1 grain
    bl addSand                  // and compute new pile
    sub x1,x1,1
2:
    cmp x1,0                    // left position ok ?
    beq 3f
    sub x1,x1,1
    bl add1Sand
    bl addSand
    add x1,x1,1
3:
    cmp x2,0                    // higt position ok ?
    beq 4f
    sub x2,x2,1
    bl add1Sand
    bl addSand
    add x2,x2,1
4:
    cmp x2,MAXI-1               // low position ok ?
    beq 5f
    add x2,x2,1
    bl add1Sand
    bl addSand
    sub x2,x2,1
5:
   ldr x5,[x0,x4,lsl #3]       // reload value
   b 1b                        // and loop
100:
    ldp x4,x5,[sp],16         // restaur des  2 registres
    ldp x2,x3,[sp],16         // restaur des  2 registres
    ldp x1,lr,[sp],16         // restaur des  2 registres
    ret
/***************************************************/
/*     add 1 grain of sand              */
/***************************************************/
// x0 contains address to sanspile
// x1 contains position x
// x2 contains position y
add1Sand:
    stp x3,lr,[sp,-16]!       // save  registres
    stp x4,x5,[sp,-16]!       // save  registres
    mov x3,#MAXI
    madd x4,x3,x2,x1          // compute offset
    ldr x5,[x0,x4,lsl #3]     // load value at pos x,y
    add x5,x5,1
    str x5,[x0,x4,lsl #3]     // and store
100:
    ldp x4,x5,[sp],16         // restaur des  2 registres
    ldp x3,lr,[sp],16         // restaur des  2 registres
    ret
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"