import org.apache.commons.math3.fraction.BigFraction;

public class BernoulliNumbers {

    public static void main(String[] args) {
        for (int n = 0; n <= 60; n++) {
            BigFraction b = bernouilli(n);
            if (!b.equals(BigFraction.ZERO))
                System.out.printf("B(%-2d) = %-1s%n", n , b);
        }
    }

    static BigFraction bernouilli(int n) {
        BigFraction[] A = new BigFraction[n + 1];
        for (int m = 0; m <= n; m++) {
            A[m] = new BigFraction(1, (m + 1));
            for (int j = m; j >= 1; j--)
                A[j - 1] = (A[j - 1].subtract(A[j])).multiply(new BigFraction(j));
        }
        return A[0];
    }
}


# def negate:
# def lessOrEqual(x; y): # x <= y
# def long_add(x;y):     # x+y
# def long_minus(x;y):   # x-y
# def long_multiply(x;y) # x*y
# def long_divide(x;y):  # x/y => [q,r]
# def long_div(x;y)      # integer division
# def long_mod(x;y)      # %

# In all cases, x and y must be strings

def negate: (- tonumber) | tostring;

def lessOrEqual(num1; num2): (num1|tonumber) <= (num2|tonumber);

def long_add(num1; num2): ((num1|tonumber) + (num2|tonumber)) | tostring;

def long_minus(x;y): ((num1|tonumber) - (num2|tonumber)) | tostring;

# multiply two decimal strings, which may be signed (+ or -)
def long_multiply(num1; num2):
  ((num1|tonumber) * (num2|tonumber)) | tostring;

# return [quotient, remainder]
# 0/0 = 1; n/0 => error
def long_divide(xx;yy):  # x/y => [q,r] imples x == (y * q) + r
  def ld(x;y):
    def abs: if . < 0 then -. else . end;
    (x|abs) as $x | (y|abs) as $y
    | (if (x >= 0 and y > 0) or (x < 0 and y < 0) then 1 else -1 end) as $sign
    | (if x >= 0 then 1 else -1 end) as $sx
    | [$sign * ($x / $y | floor), $sx * ($x % $y)];
  ld( xx|tonumber; yy|tonumber) | map(tostring);

def long_div(x;y):
  long_divide(x;y) | .[0];

def long_mod(x;y):
  ((x|tonumber) % (y|tonumber)) | tostring;


function bernoulli(n)
    A = Vector{Rational{BigInt}}(undef, n + 1)
    for m = 0 : n
        A[m + 1] = 1 // (m + 1)
        for j = m : -1 : 1
            A[j] = j * (A[j] - A[j + 1])
        end
    end
    return A[1]
end

function display(n)
    B = map(bernoulli, 0 : n)
    pad = mapreduce(x -> ndigits(numerator(x)) + Int(x < 0), max, B)
    argdigits = ndigits(n)
    for i = 0 : n
        if numerator(B[i + 1]) & 1 == 1
            println(
                "B(", lpad(i, argdigits), ") = ",
                lpad(numerator(B[i + 1]), pad), " / ", denominator(B[i + 1])
            )
        end
    end
end

display(60)

# Alternative: Following the comment in the Perl section it is much more efficient
# to compute the list of numbers instead of one number after the other.

function BernoulliList(len)
    A = Vector{Rational{BigInt}}(undef, len + 1)
    B = similar(A)
    for n in 0 : len
        A[n + 1] = 1 // (n + 1)
        for j = n : -1 : 1
            A[j] = j * (A[j] - A[j + 1])
        end
        B[n + 1] =  A[1]
    end
    return B
end

for (n, b) in enumerate(BernoulliList(60))
    isodd(numerator(b)) && println("B($(n-1)) = $b")
end


import org.apache.commons.math3.fraction.BigFraction

object Bernoulli {
    operator fun invoke(n: Int) : BigFraction {
        val A = Array(n + 1, init)
        for (m in 0..n)
            for (j in m downTo 1)
                A[j - 1] = A[j - 1].subtract(A[j]).multiply(integers[j])
        return A.first()
    }

    val max = 60

    private val init = { m: Int -> BigFraction(1, m + 1) }
    private val integers = Array(max + 1, { m: Int -> BigFraction(m) } )
}

fun main(args: Array<String>) {
    for (n in 0..Bernoulli.max)
        if (n % 2 == 0 || n == 1)
            System.out.printf("B(%-2d) = %-1s%n", n, Bernoulli(n))
}


#!/usr/bin/env luajit
local gmp = require 'gmp' ('libgmp')
local ffi = require'ffi'
local mpz, mpq = gmp.types.z, gmp.types.q
local function mpq_for(buf, op, n)
	for i=0,n-1 do
		op(buf[i])
	end
end
local function bernoulli(rop, n)
	local a=ffi.new("mpq_t[?]", n+1)
	mpq_for(a, gmp.q_init, n+1)

	for m=0,n do
		gmp.q_set_ui(a[m],1, m+1)
		for j=m,1,-1 do
			gmp.q_sub(a[j-1], a[j], a[j-1])
			gmp.q_set_ui(rop, j, 1)
			gmp.q_mul(a[j-1], a[j-1], rop)
		end
	end
	gmp.q_set(rop,a[0])
	mpq_for(a, gmp.q_clear, n+1)
end
do --MAIN
	local rop=mpq()
	local n,d=mpz(),mpz()
	gmp.q_init(rop)
	gmp.z_inits(n, d)
	local to=arg[1] and tonumber(arg[1]) or 60
	local from=arg[2] and tonumber(arg[2]) or 0
	if from~=0 then to,from=from,to end

	for i=from,to do
		bernoulli(rop, i)
		if gmp.q_cmp_ui(rop, 0, 1)~=0 then
			gmp.q_get_num(n, rop)
			gmp.q_get_den(d, rop)
			gmp.printf("B(%-2g) = %44Zd / %Zd\n", i, n, d)
		end
	end
	gmp.z_clears(n,d)
	gmp.q_clear(rop)
end


import bignum
import strformat

const Lim = 60

#---------------------------------------------------------------------------------------------------

proc bernoulli(n: Natural): Rat =
  ## Compute a Bernoulli number using Akiyama–Tanigawa algorithm.

  var a = newSeq[Rat](n + 1)
  for m in 0..n:
    a[m] = newRat(1, m + 1)
    for j in countdown(m, 1):
      a[j-1] = j * (a[j] - a[j-1])
  result = a[0]

#———————————————————————————————————————————————————————————————————————————————————————————————————

type Info = tuple
  n: int        # Number index in Bernoulli sequence.
  val: Rat      # Bernoulli number.

var values: seq[Info]   # List of values as Info tuples.
var maxLen = -1         # Maximum length.

# First step: compute the values and prepare for display.
for n in 0..Lim:
  # Compute value.
  if n != 1 and (n and 1) == 1: continue    # Ignore odd "n" except 1.
  let b = bernoulli(n)
  # Check numerator length.
  let len = ($b.num).len
  if len > maxLen: maxLen = len
  # Store information for next step.
  values.add((n, b))

# Second step: display the values with '/' aligned.
for (n, b) in values:
  let s = fmt"{($b.num).alignString(maxLen, '>')} / {b.denom}"
  echo fmt"{n:2}: {s}"


(* Taken from the 'Ada 99' project, https://marquisdegeek.com/code_ada99 *)

program BernoulliForAda99;

uses BigDecimalMath; {library for arbitary high precision BCD numbers}

type
  Fraction = object
  private
    numerator, denominator: BigDecimal;

  public
    procedure assign(n, d: Int64);
    procedure subtract(rhs: Fraction);
    procedure multiply(value: Int64);
    procedure reduce();
    procedure writeOutput();
end;

function gcd(a, b: BigDecimal):BigDecimal;
begin
  if (b = 0) then begin
    gcd := a;
    end
  else begin
    gcd := gcd(b, a mod b);
 end;
end;

procedure Fraction.writeOutput();
var sign : char;
begin
  sign := ' ';
  if (numerator<0) then sign := '-';
  if (denominator<0) then sign := '-';
  write(sign + BigDecimalToStr(abs(numerator)):45);
  write(' / ');
  write(BigDecimalToStr(abs(denominator)));
end;

procedure Fraction.assign(n, d: Int64);
begin

  numerator := n;
  denominator := d;
end;

procedure Fraction.subtract(rhs: Fraction);
begin
  numerator := numerator * rhs.denominator;
  numerator := numerator - (rhs.numerator * denominator);
  denominator := denominator * rhs.denominator;
end;

procedure Fraction.multiply(value: Int64);
var
  temp :BigDecimal;
begin
  temp := value;
  numerator := numerator * temp;
end;

procedure Fraction.reduce();
var gcdResult: BigDecimal;
begin
  gcdResult := gcd(numerator, denominator);
  begin
    numerator := numerator div gcdResult;     (* div is Int64 division *)
    denominator := denominator div gcdResult; (* could also use round(d/r) *)
  end;
end;

function calculateBernoulli(n: Int64) : Fraction;
var
  m, j: Int64;
  results: array of Fraction;

  begin
    setlength(results, 60) ; {largest value 60}
    for m:= 0 to n do
    begin
      results[m].assign(1, m+1);

      for j:= m downto 1 do
        begin
          results[j-1].subtract(results[j]);
          results[j-1].multiply(j);
          results[j-1].reduce();
        end;
    end;

    calculateBernoulli := results[0];
end;

(* Main program starts here *)

var
  b: Int64;
  result: Fraction;

begin
  writeln('Calculating Bernoulli numbers...');
  writeln('B( 0) :                                             1 / 1');
  for b:= 1 to 60  do
    begin
	if (b<3) or ((b mod 2) = 0) then begin
          result := calculateBernoulli(b);
          write('B(',b:2,')');
          write(' : ');
          result.writeOutput();
        writeln;
      end;
  end;
end.


#!perl
use strict;
use warnings;
use List::Util qw(max);
use Math::BigRat;

my $one = Math::BigRat->new(1);
sub bernoulli_print {
	my @a;
	for my $m ( 0 .. 60 ) {
		push @a, $one / ($m + 1);
		for my $j ( reverse 1 .. $m ) {
				# This line:
				( $a[$j-1] -= $a[$j] ) *= $j;
				# is a faster version of the following line:
				# $a[$j-1] = $j * ($a[$j-1] - $a[$j]);
				# since it avoids unnecessary object creation.
		}
		next unless $a[0];
		printf "B(%2d) = %44s/%s\n", $m, $a[0]->parts;
	}
}

bernoulli_print();


with javascript_semantics
include builtins/mpfr.e
procedure bernoulli(mpq rop, integer n)
    sequence a = mpq_inits(n+1)
    for m=1 to n+1 do
        mpq_set_si(a[m], 1, m)
        for j=m-1 to 1 by -1 do
            mpq_sub(a[j], a[j+1], a[j])
            mpq_set_si(rop, j, 1)
            mpq_mul(a[j], a[j], rop)
        end for
    end for
    mpq_set(rop, a[1])
    a = mpq_free(a)
end procedure

mpq rop = mpq_init()
mpz n = mpz_init(),
    d = mpz_init()
for i=0 to 60 do
    bernoulli(rop, i)
    if mpq_cmp_si(rop, 0, 1) then
        mpq_get_num(n, rop)
        mpq_get_den(d, rop)
        string ns = mpz_get_str(n),
               ds = mpz_get_str(d)
        printf(1,"B(%2d) = %44s / %s\n", {i,ns,ds})
    end if
end for
{n,d} = mpz_free({n,d})
rop = mpq_free(rop)


Bern: procedure options (main); /* 4 July 2014 */
   declare i fixed binary;
   declare B complex fixed (31);

Bernoulli: procedure (n) returns (complex fixed (31));
   declare n      fixed binary;
   declare anum(0:n) fixed (31), aden(0:n) fixed (31);
   declare (j, m) fixed;
   declare F fixed (31);

   do m = 0 to n;
      anum(m) = 1;
      aden(m) = m+1;
      do j = m to 1 by -1;
         anum(j-1) = j*( aden(j)*anum(j-1) - aden(j-1)*anum(j) );
         aden(j-1) =   ( aden(j-1) * aden(j) );
         F = gcd(abs(anum(j-1)), abs(aden(j-1)) );
         if F ^= 1 then
            do;
               anum(j-1) = anum(j-1) / F;
               aden(j-1) = aden(j-1) / F;
            end;
      end;
   end;
   return ( complex(anum(0), aden(0)) );
end Bernoulli;

   do i = 0, 1, 2 to 36 by 2; /* 36 is upper limit imposed by hardware. */
      B = Bernoulli(i);
      put skip edit ('B(' , trim(i) , ')=' , real(B) , '/' , trim(imag(B)) )
                    (3 A, column(10), F(32), 2 A);
   end;
end Bern;


from fractions import Fraction as Fr

def bernoulli(n):
    A = [0] * (n+1)
    for m in range(n+1):
        A[m] = Fr(1, m+1)
        for j in range(m, 0, -1):
          A[j-1] = j*(A[j-1] - A[j])
    return A[0] # (which is Bn)

bn = [(i, bernoulli(i)) for i in range(61)]
bn = [(i, b) for i,b in bn if b]
width = max(len(str(b.numerator)) for i,b in bn)
for i,b in bn:
    print('B(%2i) = %*i/%i' % (i, width, b.numerator, b.denominator))


  $ "bigrat.qky" loadfile

  [ 1+
    ' [ [] ] over of swap
    times
      [ i^ 1+ n->v 1/v
        join swap i^ poke
        i^ times
          [ dup i 1+ peek do
            dip over swap i peek do
            v- i 1+ n->v v*
            join swap i poke ] ]
    1 split drop do ]               is bernoulli ( n --> n/d )

  61 times
   [ i^ bernoulli
     2dup v0= iff
       2drop
     else
       [ i^ 10 < if sp
         i^ echo sp
         vulgar$
         char / over find
         44 swap - times sp
         echo$ cr ] ]


library(pracma)

for (idx in c(1,2*0:30)) {
  b <- bernoulli(idx)
  d <- as.character(denominator(b))
  n <- as.character(numerator(b))
  cat("B(",idx,") = ",n,"/",d,"\n", sep = "")
}


#lang racket
;; For: http://rosettacode.org/wiki/Bernoulli_numbers

;; As described in task...
(define (bernoulli.1 n)
  (define A (make-vector (add1 n)))
  (for ((m (in-range 0 (add1 n))))
    (vector-set! A m (/ (add1 m)))
    (for ((j (in-range m (sub1 1) -1)))
      (define new-A_j-1 (* j (- (vector-ref A (sub1 j)) (vector-ref A j))))
      (vector-set! A (sub1 j) new-A_j-1)))
  (vector-ref A 0))

(define (non-zero-bernoulli-indices s)
  (sequence-filter (λ (n) (or (even? n) (= n 1))) s))
(define (bernoulli_0..n B N)
  (for/list ((n (non-zero-bernoulli-indices (in-range (add1 N))))) (B n)))

;; From REXX description / http://mathworld.wolfram.com/BernoulliNumber.html #33
;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;; bernoulli.2 is for illustrative purposes, binomial is very costly if there is no memoisation
;; (which math/number-theory doesn't do)
(require (only-in math/number-theory binomial))
(define (bernoulli.2 n)
  (for/sum ((k (in-range 0 (add1 n))))
    (* (/ (add1 k))
       (for/sum ((r (in-range 0 (add1 k))))
         (* (expt -1 r) (binomial k r) (expt r n))))))

;; Three things to do:
;; 1. (expt -1 r): is 1 for even r, -1 for odd r... split the sum between those two.
;; 2. splitting the sum might has arithmetic advantages, too. We're using rationals, so the smaller
;;    summations should require less normalisation of intermediate, fractional results
;; 3. a memoised binomial... although the one from math/number-theory is fast, it is (and its
;;    factorials are) computed every time which is redundant
(define kCr-memo (make-hasheq))
(define !-memo (make-vector 1000 #f))
(vector-set! !-memo 0 1) ;; seed the memo
(define (! k)
  (cond [(vector-ref !-memo k) => values]
        [else (define k! (* k (! (- k 1)))) (vector-set! !-memo k k!) k!]))
(define (kCr k r)
  ; If we want (kCr ... r>1000000) we'll have to reconsider this. However, until then...
  (define hash-key (+ (* 1000000 k) r))
  (hash-ref! kCr-memo hash-key (λ () (/ (! k) (! r) (! (- k r))))))

(define (bernoulli.3 n)
  (for/sum ((k (in-range 0 (add1 n))))
    (define k+1 (add1 k))
    (* (/ k+1)
       (- (for/sum ((r (in-range 0 k+1 2))) (* (kCr k r) (expt r n)))
          (for/sum ((r (in-range 1 k+1 2))) (* (kCr k r) (expt r n)))))))

(define (display/align-fractions caption/idx-fmt Bs)
  ;; widths are one more than the order of magnitude
  (define oom+1 (compose add1 order-of-magnitude))
  (define-values (I-width N-width D-width)
    (for/fold ((I 0) (N 0) (D 0))
      ((b Bs) (n (non-zero-bernoulli-indices (in-naturals))))
      (define +b (abs b))
      (values (max I (oom+1 (max n 1)))
              (max N (+ (oom+1 (numerator +b)) (if (negative? b) 1 0)))
              (max D (oom+1 (denominator +b))))))
  (define (~a/w/a n w a) (~a n #:width w #:align a))
  (for ((n (non-zero-bernoulli-indices (in-naturals))) (b Bs))
    (printf "~a ~a/~a~%"
            (format caption/idx-fmt (~a/w/a n I-width 'right))
            (~a/w/a (numerator b) N-width 'right)
            (~a/w/a (denominator b) D-width 'left))))

(module+ main
  (display/align-fractions "B(~a) =" (bernoulli_0..n bernoulli.3 60)))

(module+ test
  (require rackunit)
  ; correctness and timing tests
  (check-match (time (bernoulli_0..n bernoulli.1 60))
               (list 1/1 (app abs 1/2) 1/6 -1/30 1/42 -1/30 _ ...))
  (check-match (time (bernoulli_0..n bernoulli.2 60))
               (list 1/1 (app abs 1/2) 1/6 -1/30 1/42 -1/30 _ ...))
  (check-match (time (bernoulli_0..n bernoulli.3 60))
               (list 1/1 (app abs 1/2) 1/6 -1/30 1/42 -1/30 _ ...))
  ; timing only ...
  (void (time (bernoulli_0..n bernoulli.3 100))))


sub bernoulli($n) {
    my @a;
    for 0..$n -> $m {
        @a[$m] = FatRat.new(1, $m + 1);
        for reverse 1..$m -> $j {
          @a[$j - 1] = $j * (@a[$j - 1] - @a[$j]);
        }
    }
    return @a[0];
}

constant @bpairs = grep *.value.so, ($_ => bernoulli($_) for 0..60);

my $width = max @bpairs.map: *.value.numerator.chars;
my $form = "B(%2d) = \%{$width}d/%d\n";

printf $form, .key, .value.nude for @bpairs;


/*REXX program calculates  N  number of Bernoulli numbers expressed as vulgar fractions.*/
parse arg N .;     if N=='' | N==","  then N= 60 /*Not specified?  Then use the default.*/
numeric digits max(9, n*2)                       /*increase the decimal digits if needed*/
w= max(length(N), 4);      Nw= N  + w  +  N % 4  /*used for aligning (output) fractions.*/
say 'B(n)'   center("Bernoulli numbers expressed as vulgar fractions",  max(78-w, Nw) )
say copies('─',w)  copies("─", max(78-w,Nw+2*w)) /*display 2nd line of title, separators*/
!.= .;    do #=0  to  N                          /*process the numbers from  0  ──►  N. */
          b= bern(#);      if b==0  then iterate /*calculate Bernoulli number, skip if 0*/
          indent= max(0, nW - pos('/', b) )      /*calculate the alignment (indentation)*/
          say right(#, w)  left('', indent)  b   /*display the indented Bernoulli number*/
          end   /*#*/                            /* [↑]  align the Bernoulli fractions. */
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
bern: parse arg x; if x==0  then return  '1/1'   /*handle the special case of  zero.    */
                   if x==1  then return '-1/2'   /*   "    "     "      "   "  one.     */
                   if x//2  then return   0      /*   "    "     "      "   "  odds > 1.*/
        do j=2  to x  by 2;      jp= j+1         /*process the positive integers up to X*/
        sn= 1 - j                                /*define the  numerator.               */
        sd= 2                                    /*   "    "   denominator.             */
                   do k=2  to j-1  by 2          /*calculate a  SN/SD  sequence.        */
                   parse var  @.k    bn  '/'  ad /*get a previously calculated fraction.*/
                   an= comb(jp, k) * bn          /*use  COMBination  for the next term. */
                   $lcm= LCM(sd, ad)             /*use Least Common Denominator function*/
                   sn= $lcm % sd * sn;  sd= $lcm /*calculate the   current  numerator.  */
                   an= $lcm % ad * an            /*    "      "      next      "        */
                   sn= sn + an                   /*    "      "    current     "        */
                   end   /*k*/                   /* [↑]  calculate the  SN/SD  sequence.*/
        sn= -sn                                  /*flip the sign for the numerator.     */
        sd= sd * jp                              /*calculate         the denominator.   */
        if sn\==1  then do;  _= GCD(sn, sd)      /*get the  Greatest Common Denominator.*/
                            sn= sn%_;   sd= sd%_ /*reduce the numerator and denominator.*/
                        end                      /* [↑]   done with the reduction(s).   */
        @.j= sn'/'sd                             /*save the result for the next round.  */
        end              /*j*/                   /* [↑]  done calculating Bernoulli #'s.*/
      return sn'/'sd
/*──────────────────────────────────────────────────────────────────────────────────────*/
comb: procedure expose !.; parse arg x,y;   if x==y  then return 1
      if !.C.x.y\==.  then return !.C.x.y                 /*combination computed before?*/
      if   x-y  <  y  then y= x-y                         /*x-y < y?   Then use a new Y.*/
      z= perm(x, y);           do j=2  for y-1;  z= z % j
                               end   /*j*/
      !.C.x.y= z;     return z                            /*assign memoization & return.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
GCD:  procedure;               parse arg x,y;                     x= abs(x)
           do  until y==0;     parse value  x//y  y    with    y  x;  end;        return x
/*──────────────────────────────────────────────────────────────────────────────────────*/
LCM:  procedure; parse arg x,y      /*X=ABS(X);  Y=ABS(Y)   not needed for Bernoulli #s.*/
                                    /*IF Y==0 THEN RETURN 0  "    "    "      "       " */
      $= x * y                                        /*calculate part of the LCM here. */
                   do  until y==0;   parse  value   x//y  y     with     y  x
                   end   /*until*/                    /* [↑]  this is a short & fast GCD*/
      return $ % x                                    /*divide the pre─calculated value.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
perm: procedure expose !.;  parse arg x,y;          if !.P.x.y\==.  then return !.P.x.y
      z= 1;       do j=x-y+1  to x;     z= z*j;     end;        !.P.x.y= z;       return z


bernoulli = Enumerator.new do |y|
  ar = []
  0.step do |m|
    ar << Rational(1, m+1)
    m.downto(1){|j| ar[j-1] = j*(ar[j-1] - ar[j]) }
    y << ar.first  # yield
  end
end

b_nums = bernoulli.take(61)
width  = b_nums.map{|b| b.numerator.to_s.size}.max
b_nums.each_with_index {|b,i| puts "B(%2i) = %*i/%i" % [i, width, b.numerator, b.denominator] unless b.zero? }


// 2.5 implementations presented here:  naive, optimized, and an iterator using
// the optimized function. The speeds vary significantly: relative
// speeds of optimized:iterator:naive implementations is 625:25:1.

#![feature(test)]

extern crate num;
extern crate test;

use num::bigint::{BigInt, ToBigInt};
use num::rational::{BigRational};
use std::cmp::max;
use std::env;
use std::ops::{Mul, Sub};
use std::process;

struct Bn {
    value: BigRational,
    index: i32
}

struct Context {
    bigone_const: BigInt,
    a: Vec<BigRational>,
    index: i32              // Counter for iterator implementation
}

impl Context {
    pub fn new() -> Context {
        let bigone = 1.to_bigint().unwrap();
        let a_vec: Vec<BigRational> = vec![];
        Context {
            bigone_const: bigone,
            a: a_vec,
            index: -1
        }
    }
}

impl Iterator for Context {
    type Item = Bn;

    fn next(&mut self) -> Option<Bn> {
        self.index += 1;
        Some(Bn { value: bernoulli(self.index as usize, self), index: self.index })
    }
}

fn help() {
    println!("Usage: bernoulli_numbers <up_to>");
}

fn main() {
    let args: Vec<String> = env::args().collect();
    let mut up_to: usize = 60;

    match args.len() {
        1 => {},
        2 => {
            up_to = args[1].parse::<usize>().unwrap();
        },
        _ => {
            help();
            process::exit(0);
        }
    }

    let context = Context::new();
    // Collect the solutions by using the Context iterator
    // (this is not as fast as calling the optimized function directly).
    let res = context.take(up_to + 1).collect::<Vec<_>>();
    let width = res.iter().fold(0, |a, r| max(a, r.value.numer().to_string().len()));

    for r in res.iter().filter(|r| *r.value.numer() != ToBigInt::to_bigint(&0).unwrap()) {
        println!("B({:>2}) = {:>2$} / {denom}", r.index, r.value.numer(), width,
            denom = r.value.denom());
    }
}

// Implementation with no reused calculations.
fn _bernoulli_naive(n: usize, c: &mut Context) -> BigRational {
    for m in 0..n + 1 {
        c.a.push(BigRational::new(c.bigone_const.clone(), (m + 1).to_bigint().unwrap()));
        for j in (1..m + 1).rev() {
            c.a[j - 1] = (c.a[j - 1].clone().sub(c.a[j].clone())).mul(
                BigRational::new(j.to_bigint().unwrap(), c.bigone_const.clone())
            );
        }
    }
    c.a[0].reduced()
}

// Implementation with reused calculations (does not require sequential calls).
fn bernoulli(n: usize, c: &mut Context) -> BigRational {
    for i in 0..n + 1 {
        if i >= c.a.len() {
            c.a.push(BigRational::new(c.bigone_const.clone(), (i + 1).to_bigint().unwrap()));
            for j in (1..i + 1).rev() {
                c.a[j - 1] = (c.a[j - 1].clone().sub(c.a[j].clone())).mul(
                    BigRational::new(j.to_bigint().unwrap(), c.bigone_const.clone())
                );
            }
        }
    }
    c.a[0].reduced()
}

#[cfg(test)]
mod tests {
    use super::{Bn, Context, bernoulli, _bernoulli_naive};
    use num::rational::{BigRational};
    use std::str::FromStr;
    use test::Bencher;

    // [tests elided]

    #[bench]
    fn bench_bernoulli_naive(b: &mut Bencher) {
        let mut context = Context::new();
        b.iter(|| {
            let mut res: Vec<Bn> = vec![];
            for n in 0..30 + 1 {
                let b = _bernoulli_naive(n, &mut context);
                res.push(Bn { value:b.clone(), index: n as i32});
            }
        });
    }

    #[bench]
    fn bench_bernoulli(b: &mut Bencher) {
        let mut context = Context::new();
        b.iter(|| {
            let mut res: Vec<Bn> = vec![];
            for n in 0..30 + 1 {
                let b = bernoulli(n, &mut context);
                res.push(Bn { value:b.clone(), index: n as i32});
            }
        });
    }

    #[bench]
    fn bench_bernoulli_iter(b: &mut Bencher) {
        b.iter(|| {
            let context = Context::new();
            let _res = context.take(30 + 1).collect::<Vec<_>>();
        });
    }
}


/** Roll our own pared-down BigFraction class just for these Bernoulli Numbers */
case class BFraction( numerator:BigInt, denominator:BigInt ) {
  require( denominator != BigInt(0), "Denominator cannot be zero" )

  val gcd = numerator.gcd(denominator)

  val num = numerator / gcd
  val den = denominator / gcd

  def unary_- = BFraction(-num, den)
  def -( that:BFraction ) = that match {
    case f if f.num == BigInt(0) => this
    case f if f.den == this.den => BFraction(this.num - f.num, this.den)
    case f => BFraction(((this.num * f.den) - (f.num * this.den)), this.den * f.den )
  }

  def *( that:Int ) = BFraction( num * that, den )

  override def toString = num + " / " + den
}

def bernoulliB( n:Int ) : BFraction = {

  val aa : Array[BFraction] = Array.ofDim(n+1)

  for( m <- 0 to n ) {
    aa(m) = BFraction(1,(m+1))

    for( n <- m to 1 by -1 ) {
      aa(n-1) = (aa(n-1) - aa(n)) * n
    }
  }

  aa(0)
}

assert( {val b12 = bernoulliB(12); b12.num == -691 && b12.den == 2730 } )

val r = for( n <- 0 to 60; b = bernoulliB(n) if b.num != 0 ) yield (n, b)

val numeratorSize = r.map(_._2.num.toString.length).max

// Print the results
r foreach{ case (i,b) => {
  val label = f"b($i)"
  val num = (" " * (numeratorSize - b.num.toString.length)) + b.num
  println( f"$label%-6s $num / ${b.den}" )
}}


; Return the n'th Bernoulli number.

(define bernoulli
  (lambda (n)
    (let ((a (make-vector (1+ n))))
      (do ((m 0 (1+ m)))
          ((> m n))
        (vector-set! a m (/ 1 (1+ m)))
        (do ((j m (1- j)))
            ((< j 1))
          (vector-set! a (1- j) (* j (- (vector-ref a (1- j)) (vector-ref a j))))))
      (vector-ref a 0))))

; Convert a rational to a string.  If an integer, ends with "/1".

(define rational->string
  (lambda (rational)
    (format "~a/~a" (numerator rational) (denominator rational))))

; Returns the string length of the numerator of a rational.

(define rational-numerator-length
  (lambda (rational)
    (string-length (format "~a" (numerator rational)))))

; Formats a rational with left-padding such that total length to the slash is as given.

(define rational-padded
  (lambda (rational total-length-to-slash)
    (let* ((length-padding (- total-length-to-slash (rational-numerator-length rational)))
           (padding-string (make-string length-padding #\ )))
      (string-append padding-string (rational->string rational)))))

; Return the Bernoulli numbers 0 through n in a list.

(define make-bernoulli-list
  (lambda (n)
    (if (= n 0)
      (list (bernoulli n))
      (append (make-bernoulli-list (1- n)) (list (bernoulli n))))))

; Print the non-zero Bernoulli numbers 0 through 60 aligning the slashes.

(let* ((bernoullis-list (make-bernoulli-list 60))
       (numerator-lengths (map rational-numerator-length bernoullis-list))
       (max-numerator-length (apply max numerator-lengths)))
  (let print-bernoulli ((index 0) (numbers bernoullis-list))
    (cond
      ((null? numbers))
      ((= 0 (car numbers))
        (print-bernoulli (1+ index) (cdr numbers)))
      (else
        (printf "B([email protected]) = ~a~%" index (rational-padded (car numbers) max-numerator-length))
        (print-bernoulli (1+ index) (cdr numbers))))))


$ include "seed7_05.s7i";
  include "bigrat.s7i";

const func bigRational: bernoulli (in integer: n) is func
  result
    var bigRational: bernoulli is bigRational.value;
  local
    var integer: m is 0;
    var integer: j is 0;
    var array bigRational: a is 0 times bigRational.value;
  begin
    a := [0 .. n] times bigRational.value;
    for m range 0 to n do
      a[m] := 1_ / bigInteger(succ(m));
      for j range m downto 1 do
        a[pred(j)] := bigRational(j) * (a[j] - a[pred(j)]);
      end for;
    end for;
    bernoulli := a[0];
  end func;

const proc: main is func
  local
    var bigRational: bernoulli is bigRational.value;
    var integer: i is 0;
  begin
    for i range 0 to 60 do
      bernoulli := bernoulli(i);
      if bernoulli <> bigRational.value then
        writeln("B(" <& i lpad 2 <& ") = " <& bernoulli.numerator lpad 44 <&
                " / " <& bernoulli.denominator rpad 8 <& " " <& bernoulli);
      end if;
    end for;
  end func;


for n in 0..60 | (b:=bernoulli(n)$INTHEORY; b~=0) repeat print [n,b]


import BigInt

public func bernoulli<T: BinaryInteger & SignedNumeric>(n: Int) -> Frac<T> {
  guard n != 0 else {
    return 1
  }

  var arr = [Frac<T>]()

  for m in 0...n {
    arr.append(Frac(numerator: 1, denominator: T(m) + 1))

    for j in stride(from: m, through: 1, by: -1) {
      arr[j-1] = (arr[j-1] - arr[j]) * Frac(numerator: T(j), denominator: 1)
    }
  }

  return arr[0]
}

for n in 0...60 {
  let b = bernoulli(n: n) as Frac<BigInt>

  guard b != 0 else {
    continue
  }

  print("B(\(n)) = \(b)")
}


proc bernoulli {n} {
    for {set m 0} {$m <= $n} {incr m} {
	lappend A [list 1 [expr {$m + 1}]]
	for {set j $m} {[set i $j] >= 1} {} {
	    lassign [lindex $A [incr j -1]] a1 b1
	    lassign [lindex $A $i] a2 b2
	    set x [set p [expr {$i * ($a1*$b2 - $a2*$b1)}]]
	    set y [set q [expr {$b1 * $b2}]]
	    while {$q} {set q [expr {$p % [set p $q]}]}
	    lset A $j [list [expr {$x/$p}] [expr {$y/$p}]]
	}
    }
    return [lindex $A 0]
}

set len 0
for {set n 0} {$n <= 60} {incr n} {
    set b [bernoulli $n]
    if {[lindex $b 0]} {
	lappend result $n {*}$b
	set len [expr {max($len, [string length [lindex $b 0]])}]
    }
}
foreach {n num denom} $result {
    puts [format {B_%-2d = %*lld/%lld} $n $len $num $denom]
}


F bellTriangle(n)
   [[BigInt]] tri
   L(i) 0 .< n
      tri.append([BigInt(0)] * i)
   tri[1][0] = 1
   L(i) 2 .< n
      tri[i][0] = tri[i - 1][i - 2]
      L(j) 1 .< i
         tri[i][j] = tri[i][j - 1] + tri[i - 1][j - 1]
   R tri

V bt = bellTriangle(51)
print(‘First fifteen and fiftieth Bell numbers:’)
L(i) 1..15
   print(‘#2: #.’.format(i, bt[i][0]))
print(‘50: ’bt[50][0])
print()
print(‘The first ten rows of Bell's triangle:’)
L(i) 1..10
   print(bt[i])


' Bernoulli numbers - vb.net - 06/03/2017
Imports System.Numerics 'BigInteger

Module Bernoulli_numbers

    Function gcd_BigInt(ByVal x As BigInteger, ByVal y As BigInteger) As BigInteger
        Dim y2 As BigInteger
        x = BigInteger.Abs(x)
        Do
            y2 = BigInteger.Remainder(x, y)
            x = y
            y = y2
        Loop Until y = 0
        Return x
    End Function 'gcd_BigInt

    Sub bernoul_BigInt(n As Integer, ByRef bnum As BigInteger, ByRef bden As BigInteger)
        Dim j, m As Integer
        Dim f As BigInteger
        Dim anum(), aden() As BigInteger
        ReDim anum(n + 1), aden(n + 1)
        For m = 0 To n
            anum(m + 1) = 1
            aden(m + 1) = m + 1
            For j = m To 1 Step -1
                anum(j) = j * (aden(j + 1) * anum(j) - aden(j) * anum(j + 1))
                aden(j) = aden(j) * aden(j + 1)
                f = gcd_BigInt(BigInteger.Abs(anum(j)), BigInteger.Abs(aden(j)))
                If f <> 1 Then
                    anum(j) = anum(j) / f
                    aden(j) = aden(j) / f
                End If
            Next
        Next
        bnum = anum(1) : bden = aden(1)
    End Sub 'bernoul_BigInt

    Sub bernoulli_BigInt()
        Dim i As Integer
        Dim bnum, bden As BigInteger
        bnum = 0 : bden = 0
        For i = 0 To 60
            bernoul_BigInt(i, bnum, bden)
            If bnum <> 0 Then
                Console.WriteLine("B(" & i & ")=" & bnum.ToString("D") & "/" & bden.ToString("D"))
            End If
        Next i
    End Sub 'bernoulli_BigInt

End Module 'Bernoulli_numbers


import "/fmt" for Fmt
import "/big" for BigRat

var bernoulli = Fn.new { |n|
    if (n < 0) Fiber.abort("Argument must be non-negative")
    var a = List.filled(n+1, null)
    for (m in 0..n) {
        a[m] = BigRat.new(1, m+1)
        var j = m
        while (j >= 1) {
            a[j-1] = (a[j-1] - a[j]) * BigRat.new(j, 1)
            j = j - 1
        }
    }
    return (n != 1) ? a[0] : -a[0] // 'first' Bernoulli number
}

for (n in 0..60) {
    var b = bernoulli.call(n)
    if (b != BigRat.zero) Fmt.print("B($2d) = $44i / $i", n, b.num, b.den)
}


with Ada.Text_IO; use Ada.Text_IO;
procedure Main is
	type Bell_Triangle is array(Positive range <>, Positive range <>) of Natural;

	procedure Print_Rows (Row : in Positive; Triangle : in Bell_Triangle) is
		begin
			if Row in Triangle'Range(1) then
				for I in Triangle'First(1) .. Row loop
					Put_Line (Triangle (I, 1)'Image);
				end loop;
			end if;
	end Print_Rows;

	procedure Print_Triangle (Num : in Positive; Triangle : in Bell_Triangle) is
		begin
			if Num in Triangle'Range then
				for I in Triangle'First(1) .. Num loop
					for J in Triangle'First(2) .. Num loop
						if Triangle (I, J) /= 0 then
							Put (Triangle (I, J)'Image);
						end if;
					end loop;
					New_Line;
				end loop;
			end if;
	end Print_Triangle;

	procedure Bell_Numbers is
		Triangle : Bell_Triangle(1..15, 1..15) := (Others => (Others => 0));
		Temp     : Positive := 1;
		begin

			Triangle (1, 1) := 1;

			for I in Triangle'First(1) + 1 .. Triangle'Last(1) loop
				Triangle (I, 1) := Temp;

				for J in Triangle'First(2) .. Triangle'Last(2) - 1 loop
					if Triangle (I - 1, J) /= 0 then
						Triangle (I, J + 1) := Triangle (I, J) + Triangle (I - 1, J);
					else
						Temp := Triangle (I, J);
						exit;
					end if;
				end loop;
			end loop;

			Put_Line ("First 15 Bell numbers:");
			Print_Rows (15, Triangle);

			New_Line;

			Put_Line ("First 10 rows of the Bell triangle:");
			Print_Triangle (10, Triangle);
	end Bell_Numbers;
begin
	Bell_Numbers;
end Main;


class Rational{  // Weenie Rational class, can handle BigInts
   fcn init(_a,_b){ var a=_a, b=_b; normalize(); }
   fcn toString{ "%50d / %d".fmt(a,b) }
   fcn normalize{  // divide a and b by gcd
      g:= a.gcd(b);
      a/=g; b/=g;
      if(b<0){ a=-a; b=-b; } // denominator > 0
      self
   }
   fcn __opAdd(n){
      if(Rational.isChildOf(n)) self(a*n.b + b*n.a, b*n.b); // Rat + Rat
      else self(b*n + a, b);				    // Rat + Int
   }
   fcn __opSub(n){ self(a*n.b - b*n.a, b*n.b) }		    // Rat - Rat
   fcn __opMul(n){
      if(Rational.isChildOf(n)) self(a*n.a, b*n.b);	    // Rat * Rat
      else self(a*n, b);				    // Rat * Int
   }
   fcn __opDiv(n){ self(a*n.b,b*n.a) }			    // Rat / Rat
}


BEGIN # show some Bell numbers #
    PROC show bell = ( INT n, LONG LONG INT bell number )VOID:
         print( ( whole( n, -2 ), ": ", whole( bell number, 0 ), newline ) );
    INT max bell = 50;
    [ 0 : max bell - 2 ]LONG LONG INT a; FOR i TO UPB a DO a[ i ] := 0 OD;
    a[ 0 ] := 1;
    show bell( 1, a[ 0 ] );
    FOR n FROM 0 TO UPB a DO
        # replace a with the next line of the triangle #
        a[ n ] := a[ 0 ];
        FOR j FROM n BY -1 TO 1 DO
            a[ j - 1 ] +:= a[ j ]
        OD;
        IF   n < 14       THEN
            show bell( n + 2, a[ 0 ] )
        ELIF n = UPB a THEN
            print( ( "...", newline ) );
            show bell( n + 2, a[ 0 ] )
        FI
    OD
END


begin
integer function index(row, col);
integer row, col;
index := row * (row-1)/ 2 + col;

integer ROWS; ROWS := 15;
begin
    decimal(11) array bell[0:ROWS*(ROWS+1)/2];
    integer i, j;

    bell[index(1, 0)] := 1.;
    for i := 2 step 1 until ROWS do
    begin
        bell[index(i, 0)] := bell[index(i-1, i-2)];
        for j := 1 step 1 until i-1 do
            bell[index(i,j)] := bell[index(i,j-1)] + bell[index(i-1,j-1)];
    end;

    write("First fifteen Bell numbers:");
    for i := 1 step 1 until ROWS do
    begin
        write(i);
        writeon(": ");
        writeon(bell[index(i,0)]);
    end;

    write("");
    write("First ten rows of Bell's triangle:");
    for i := 1 step 1 until 10 do
    begin
        write("");
        for j := 0 step 1 until i-1 do
            writeon(bell[index(i,j)]);
    end;
end;
end


bell←{
    tr←↑(⊢,(⊂⊃∘⌽+0,+\)∘⊃∘⌽)⍣14⊢,⊂,1
    ⎕←'First 15 Bell numbers:'
    ⎕←tr[;1]
    ⎕←'First 10 rows of Bell''s triangle:'
    ⎕←tr[⍳10;⍳10]
}


bellTriangle: function[n][
    tri: map 0..n-1 'x [ map 0..n 'y -> 0 ]
    set get tri 1 0 1
    loop 2..n-1 'i [
        set get tri i 0  get (get tri i-1) i-2
        loop 1..i-1 'j [
            set get tri i j (get (get tri i) j-1) + ( get (get tri i-1) j-1)
        ]
    ]
    return tri
]
bt: bellTriangle 51

loop 1..15 'x ->
    print [x "=>" first bt\[x]]
print ["50 =>" first last bt]
print ""
print "The first ten rows of Bell's triangle:"

loop 1..10 'i ->
    print filter bt\[i] => zero?


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

// row starts with 1; col < row
size_t bellIndex(int row, int col) {
    return row * (row - 1) / 2 + col;
}

int getBell(int *bellTri, int row, int col) {
    size_t index = bellIndex(row, col);
    return bellTri[index];
}

void setBell(int *bellTri, int row, int col, int value) {
    size_t index = bellIndex(row, col);
    bellTri[index] = value;
}

int *bellTriangle(int n) {
    size_t length = n * (n + 1) / 2;
    int *tri = calloc(length, sizeof(int));
    int i, j;

    setBell(tri, 1, 0, 1);
    for (i = 2; i <= n; ++i) {
        setBell(tri, i, 0, getBell(tri, i - 1, i - 2));
        for (j = 1; j < i; ++j) {
            int value = getBell(tri, i, j - 1) + getBell(tri, i - 1, j - 1);
            setBell(tri, i, j, value);
        }
    }

    return tri;
}

int main() {
    const int rows = 15;
    int *bt = bellTriangle(rows);
    int i, j;

    printf("First fifteen Bell numbers:\n");
    for (i = 1; i <= rows; ++i) {
        printf("%2d: %d\n", i, getBell(bt, i, 0));
    }

    printf("\nThe first ten rows of Bell's triangle:\n");
    for (i = 1; i <= 10; ++i) {
        printf("%d", getBell(bt, i, 0));
        for (j = 1; j < i; ++j) {
            printf(", %d", getBell(bt, i, j));
        }
        printf("\n");
    }

    free(bt);
    return 0;
}


using System;
using System.Numerics;

namespace BellNumbers {
    public static class Utility {
        public static void Init<T>(this T[] array, T value) {
            if (null == array) return;
            for (int i = 0; i < array.Length; ++i) {
                array[i] = value;
            }
        }
    }

    class Program {
        static BigInteger[][] BellTriangle(int n) {
            BigInteger[][] tri = new BigInteger[n][];
            for (int i = 0; i < n; ++i) {
                tri[i] = new BigInteger[i];
                tri[i].Init(BigInteger.Zero);
            }
            tri[1][0] = 1;
            for (int i = 2; i < n; ++i) {
                tri[i][0] = tri[i - 1][i - 2];
                for (int j = 1; j < i; ++j) {
                    tri[i][j] = tri[i][j - 1] + tri[i - 1][j - 1];
                }
            }
            return tri;
        }

        static void Main(string[] args) {
            var bt = BellTriangle(51);
            Console.WriteLine("First fifteen and fiftieth Bell numbers:");
            for (int i = 1; i < 16; ++i) {
                Console.WriteLine("{0,2}: {1}", i, bt[i][0]);
            }
            Console.WriteLine("50: {0}", bt[50][0]);
            Console.WriteLine();
            Console.WriteLine("The first ten rows of Bell's triangle:");
            for (int i = 1; i < 11; ++i) {
                //Console.WriteLine(bt[i]);
                var it = bt[i].GetEnumerator();
                Console.Write("[");
                if (it.MoveNext()) {
                    Console.Write(it.Current);
                }
                while (it.MoveNext()) {
                    Console.Write(", ");
                    Console.Write(it.Current);
                }
                Console.WriteLine("]");
            }
        }
    }
}


#include <iostream>
#include <vector>

#ifdef HAVE_BOOST
#include <boost/multiprecision/cpp_int.hpp>
typedef boost::multiprecision::cpp_int integer;
#else
typedef unsigned int integer;
#endif

auto make_bell_triangle(int n) {
    std::vector<std::vector<integer>> bell(n);
    for (int i = 0; i < n; ++i)
        bell[i].assign(i + 1, 0);
    bell[0][0] = 1;
    for (int i = 1; i < n; ++i) {
        std::vector<integer>& row = bell[i];
        std::vector<integer>& prev_row = bell[i - 1];
        row[0] = prev_row[i - 1];
        for (int j = 1; j <= i; ++j)
            row[j] = row[j - 1] + prev_row[j - 1];
    }
    return bell;
}

int main() {
#ifdef HAVE_BOOST
    const int size = 50;
#else
    const int size = 15;
#endif
    auto bell(make_bell_triangle(size));

    const int limit = 15;
    std::cout << "First " << limit << " Bell numbers:\n";
    for (int i = 0; i < limit; ++i)
        std::cout << bell[i][0] << '\n';

#ifdef HAVE_BOOST
    std::cout << "\n50th Bell number is " << bell[49][0] << "\n\n";
#endif

    std::cout << "First 10 rows of the Bell triangle:\n";
    for (int i = 0; i < 10; ++i) {
        std::cout << bell[i][0];
        for (int j = 1; j <= i; ++j)
            std::cout << ' ' << bell[i][j];
        std::cout << '\n';
    }
    return 0;
}


bell = cluster is make, get
    rep = array[int]

    idx = proc (row, col: int) returns (int)
        return (row * (row - 1) / 2 + col)
    end idx

    get = proc (tri: cvt, row, col: int) returns (int)
        return (tri[idx(row, col)])
    end get

    make = proc (rows: int) returns (cvt)
        length: int := rows * (rows+1) / 2
        arr: rep := rep$fill(0, length, 0)

        arr[idx(1,0)] := 1
        for i: int in int$from_to(2, rows) do
            arr[idx(i,0)] := arr[idx(i-1, i-2)]
            for j: int in int$from_to(1, i-1) do
                arr[idx(i,j)] := arr[idx(i,j-1)] + arr[idx(i-1,j-1)]
            end
        end
        return(arr)
    end make
end bell

start_up = proc ()
    rows = 15

    po: stream := stream$primary_output()
    belltri: bell := bell$make(rows)

    stream$putl(po, "The first 15 Bell numbers are:")
    for i: int in int$from_to(1, rows) do
        stream$putl(po, int$unparse(i)
                     || ": " || int$unparse(bell$get(belltri, i, 0)))
    end

    stream$putl(po, "\nThe first 10 rows of the Bell triangle:")
    for row: int in int$from_to(1, 10) do
        for col: int in int$from_to(0, row-1) do
            stream$putright(po, int$unparse(bell$get(belltri, row, col)), 7)
        end
        stream$putc(po, '\n')
    end
end start_up


;; The triangle is a list of arrays; each array is a
;; triangle's row; the last row is at the head of the list.
(defun grow-triangle (triangle)
    (if (null triangle)
      '(#(1))
       (let* ((last-array (car triangle))
              (last-length (length last-array))
              (new-array (make-array (1+ last-length)
                                     :element-type 'integer)))
          ;; copy over the last element of the last array
          (setf (aref new-array 0) (aref last-array (1- last-length)))
          ;; fill in the rest of the array
          (loop for i from 0
                ;; the last index of the new array is the length
                ;; of the last array, which is 1 unit shorter
                for j from 1 upto last-length
                for sum = (+ (aref last-array i) (aref new-array i))
                do (setf (aref new-array j) sum))
          ;; return the grown list
          (cons new-array triangle))))

(defun make-triangle (num)
    (if (<= num 1)
      (grow-triangle nil)
      (grow-triangle (make-triangle (1- num)))))

(defun bell (num)
    (cond ((< num 0) nil)
          ((= num 0) 1)
          (t (aref (first (make-triangle num)) (1- num)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Printing section
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defparameter *numbers-to-print*
    (append
      (loop for i upto 19 collect i)
      '(49 50)))

(defun array->list (array)
    (loop for i upto (1- (length array))
      collect (aref array i)))

(defun print-bell-number (index bell-number)
    (format t "B_~d (~:r Bell number) = ~:d~%"
        index (1+ index) bell-number))

(defun print-bell-triangle (triangle)
    (loop for row in (reverse triangle)
      do (format t "~{~d~^, ~}~%" (array->list row))))

;; Final invocation
(loop for n in *numbers-to-print* do
    (print-bell-number n (bell n)))

(princ #\newline)

(format t "The first 10 rows of Bell triangle:~%")
(print-bell-triangle (make-triangle 10))


include "cowgol.coh";

typedef B is uint32;
typedef I is intptr;

sub bellIndex(row: I, col: I): (addr: I) is
    addr := (row * (row - 1) / 2 + col) * @bytesof B;
end sub;

sub getBell(row: I, col: I): (bell: B) is
    bell := [LOMEM as [B] + bellIndex(row, col)];
end sub;

sub setBell(row: I, col: I, bell: B) is
    [LOMEM as [B] + bellIndex(row, col)] := bell;
end sub;

sub bellTriangle(n: I) is
    var length := n * (n + 1) / 2;
    var bytes := length * @bytesof B;

    if HIMEM - LOMEM < bytes then
        print("not enough memory\n");
        ExitWithError();
    end if;

    MemZero(LOMEM, bytes);

    setBell(1, 0, 1);
    var i: I := 2;
    while i <= n loop
        setBell(i, 0, getBell(i-1, i-2));
        var j: I := 1;
        while j < i loop
            var value := getBell(i, j-1) + getBell(i-1, j-1);
            setBell(i, j, value);
            j := j + 1;
        end loop;
        i := i + 1;
    end loop;
end sub;

const ROWS := 15;
bellTriangle(ROWS);
print("First fifteen Bell numbers:\n");
var i: I := 1;
while i <= ROWS loop
    print_i32(i as uint32);
    print(": ");
    print_i32(getBell(i, 0) as uint32);
    print_nl();
    i := i + 1;
end loop;

print("\nThe first ten rows of Bell's triangle:\n");
i := 1;
while i <= 10 loop
    var j: I := 0;
    loop
        print_i32(getBell(i, j) as uint32);
        j := j + 1;
        if j == i then break;
        else print(", ");
        end if;
    end loop;
    i := i + 1;
    print_nl();
end loop;


import std.array : uninitializedArray;
import std.bigint;
import std.stdio : writeln, writefln;

auto bellTriangle(int n) {
    auto tri = uninitializedArray!(BigInt[][])(n);
    foreach (i; 0..n) {
        tri[i] = uninitializedArray!(BigInt[])(i);
        tri[i][] = BigInt(0);
    }
    tri[1][0] = 1;
    foreach (i; 2..n) {
        tri[i][0] = tri[i - 1][i - 2];
        foreach (j; 1..i) {
            tri[i][j] = tri[i][j - 1] + tri[i - 1][j - 1];
        }
    }
    return tri;
}

void main() {
    auto bt = bellTriangle(51);
    writeln("First fifteen and fiftieth Bell numbers:");
    foreach (i; 1..16) {
        writefln("%2d: %d", i, bt[i][0]);
    }
    writeln("50: ", bt[50][0]);
    writeln;
    writeln("The first ten rows of Bell's triangle:");
    foreach (i; 1..11) {
        writeln(bt[i]);
    }
}


program BellNumbers;

// For Rosetta Code.
// Delphi console application to display the Bell numbers B_0, ..., B_25.
// Uses signed 64-bit integers, the largest integer type available in Delphi.

{$APPTYPE CONSOLE}

uses SysUtils; // only for the display

const
  MAX_INDEX = 25; // maximum index within the limits of int64
var
  n : integer; // index of Bell number
  j : integer; // loop variable
  a : array [0..MAX_INDEX - 1] of int64; // working array to build up B_n

  { Subroutine to display that a[0] is the Bell number B_n }
  procedure Display();
  begin
    WriteLn( SysUtils.Format( 'B_%-2d = %d', [n, a[0]]));
  end;

(* Main program *)
begin
  n := 0;
  a[0] := 1;
  Display(); // some programmers would prefer Display;
  while (n < MAX_INDEX) do begin // and give begin a line to itself
    a[n] := a[0];
    for j := n downto 1 do inc( a[j - 1], a[j]);
    inc(n);
    Display();
  end;
end.


defmodule Bell do
    def triangle(), do: Stream.iterate([1], fn l -> bell_row l, [List.last l] end)
    def numbers(), do: triangle() |> Stream.map(&List.first/1)

    defp bell_row([], r), do: Enum.reverse r
    defp bell_row([a|a_s], r = [r0|_]), do: bell_row(a_s, [a + r0|r])
end

:io.format "The first 15 bell numbers are ~p~n~n",
    [Bell.numbers() |> Enum.take(15)]

IO.puts "The 50th Bell number is #{Bell.numbers() |> Enum.take(50) |> List.last}"
IO.puts ""

IO.puts "THe first 10 rows of Bell's triangle:"
IO.inspect(Bell.triangle() |> Enum.take(10))


// Generate bell triangle. Nigel Galloway: July 6th., 2019
let bell=Seq.unfold(fun g->Some(g,List.scan(+) (List.last g) g))[1I]


USING: formatting io kernel math math.matrices sequences vectors ;

: next-row ( prev -- next )
    [ 1 1vector ]
    [ dup last [ + ] accumulate swap suffix! ] if-empty ;

: aitken ( n -- seq )
    V{ } clone swap [ next-row dup ] replicate nip ;

0 50 aitken col [ 15 head ] [ last ] bi
"First 15 Bell numbers:\n%[%d, %]\n\n50th: %d\n\n" printf
"First 10 rows of the Bell triangle:" print
10 aitken [ "%[%d, %]\n" printf ] each


#define MAX 21

#macro ncp(n, p)
   (fact(n)/(fact(p))/(fact(n-p)))
#endmacro

dim as ulongint fact(0 to MAX), bell(0 to MAX)
dim as uinteger n=0, k

fact(0) = 1
for k=1 to MAX
    fact(k) = k*fact(k-1)
next k

bell(n) = 1
print n, bell(n)
for n=0 to MAX-1
    for k=0 to n
        bell(n+1) += ncp(n, k)*bell(k)
    next k
    print n+1, bell(n+1)
next n


package main

import (
    "fmt"
    "math/big"
)

func bellTriangle(n int) [][]*big.Int {
    tri := make([][]*big.Int, n)
    for i := 0; i < n; i++ {
        tri[i] = make([]*big.Int, i)
        for j := 0; j < i; j++ {
            tri[i][j] = new(big.Int)
        }
    }
    tri[1][0].SetUint64(1)
    for i := 2; i < n; i++ {
        tri[i][0].Set(tri[i-1][i-2])
        for j := 1; j < i; j++ {
            tri[i][j].Add(tri[i][j-1], tri[i-1][j-1])
        }
    }
    return tri
}

func main() {
    bt := bellTriangle(51)
    fmt.Println("First fifteen and fiftieth Bell numbers:")
    for i := 1; i <= 15; i++ {
        fmt.Printf("%2d: %d\n", i, bt[i][0])
    }
    fmt.Println("50:", bt[50][0])
    fmt.Println("\nThe first ten rows of Bell's triangle:")
    for i := 1; i <= 10; i++ {
        fmt.Println(bt[i])
    }
}


class Bell {
    private static class BellTriangle {
        private List<Integer> arr

        BellTriangle(int n) {
            int length = (int) (n * (n + 1) / 2)
            arr = new ArrayList<>(length)
            for (int i = 0; i < length; ++i) {
                arr.add(0)
            }

            set(1, 0, 1)
            for (int i = 2; i <= n; ++i) {
                set(i, 0, get(i - 1, i - 2))
                for (int j = 1; j < i; ++j) {
                    int value = get(i, j - 1) + get(i - 1, j - 1)
                    set(i, j, value)
                }
            }
        }

        private static int index(int row, int col) {
            if (row > 0 && col >= 0 && col < row) {
                return row * (row - 1) / 2 + col
            } else {
                throw new IllegalArgumentException()
            }
        }

        int get(int row, int col) {
            int i = index(row, col)
            return arr.get(i)
        }

        void set(int row, int col, int value) {
            int i = index(row, col)
            arr.set(i, value)
        }
    }

    static void main(String[] args) {
        final int rows = 15
        BellTriangle bt = new BellTriangle(rows)

        System.out.println("First fifteen Bell numbers:")
        for (int i = 0; i < rows; ++i) {
            System.out.printf("%2d: %d\n", i + 1, bt.get(i + 1, 0))
        }

        for (int i = 1; i <= 10; ++i) {
            System.out.print(bt.get(i, 0))
            for (int j = 1; j < i; ++j) {
                System.out.printf(", %d", bt.get(i, j))
            }
            System.out.println()
        }
    }
}


bellTri :: [[Integer]]
bellTri =
  let f xs = (last xs, xs)
   in map snd (iterate (f . uncurry (scanl (+))) (1, [1]))

bell :: [Integer]
bell = map head bellTri

main :: IO ()
main = do
  putStrLn "First 10 rows of Bell's Triangle:"
  mapM_ print (take 10 bellTri)
  putStrLn "\nFirst 15 Bell numbers:"
  mapM_ print (take 15 bell)
  putStrLn "\n50th Bell number:"
  print (bell !! 49)


import java.util.ArrayList;
import java.util.List;

public class Bell {
    private static class BellTriangle {
        private List<Integer> arr;

        BellTriangle(int n) {
            int length = n * (n + 1) / 2;
            arr = new ArrayList<>(length);
            for (int i = 0; i < length; ++i) {
                arr.add(0);
            }

            set(1, 0, 1);
            for (int i = 2; i <= n; ++i) {
                set(i, 0, get(i - 1, i - 2));
                for (int j = 1; j < i; ++j) {
                    int value = get(i, j - 1) + get(i - 1, j - 1);
                    set(i, j, value);
                }
            }
        }

        private int index(int row, int col) {
            if (row > 0 && col >= 0 && col < row) {
                return row * (row - 1) / 2 + col;
            } else {
                throw new IllegalArgumentException();
            }
        }

        public int get(int row, int col) {
            int i = index(row, col);
            return arr.get(i);
        }

        public void set(int row, int col, int value) {
            int i = index(row, col);
            arr.set(i, value);
        }
    }

    public static void main(String[] args) {
        final int rows = 15;
        BellTriangle bt = new BellTriangle(rows);

        System.out.println("First fifteen Bell numbers:");
        for (int i = 0; i < rows; ++i) {
            System.out.printf("%2d: %d\n", i + 1, bt.get(i + 1, 0));
        }

        for (int i = 1; i <= 10; ++i) {
            System.out.print(bt.get(i, 0));
            for (int j = 1; j < i; ++j) {
                System.out.printf(", %d", bt.get(i, j));
            }
            System.out.println();
        }
    }
}


# nth Bell number
def bell:
  . as $n
  | if $n < 0 then "non-negative integer expected"
    elif $n < 2 then 1
    else
    reduce range(1; $n) as $i ([1];
      reduce range(1; $i) as $j (.;
        .[$i - $j] as $x
        | .[$i - $j - 1] += $x )
      | .[$i] = .[0] + .[$i - 1] )
      | .[$n - 1]
    end;

# The task
range(1;51) | bell


"""
    bellnum(n)
Compute the ``n``th Bell number.
"""
function bellnum(n::Integer)
    if n < 0
        throw(DomainError(n))
    elseif n < 2
        return 1
    end
    list = Vector{BigInt}(undef, n)
    list[1] = 1
    for i = 2:n
        for j = 1:i - 2
            list[i - j - 1] += list[i - j]
        end
        list[i] = list[1] + list[i - 1]
    end
    return list[n]
end

for i in 1:50
    println(bellnum(i))
end


class BellTriangle(n: Int) {
    private val arr: Array<Int>

    init {
        val length = n * (n + 1) / 2
        arr = Array(length) { 0 }

        set(1, 0, 1)
        for (i in 2..n) {
            set(i, 0, get(i - 1, i - 2))
            for (j in 1 until i) {
                val value = get(i, j - 1) + get(i - 1, j - 1)
                set(i, j, value)
            }
        }
    }

    private fun index(row: Int, col: Int): Int {
        require(row > 0)
        require(col >= 0)
        require(col < row)
        return row * (row - 1) / 2 + col
    }

    operator fun get(row: Int, col: Int): Int {
        val i = index(row, col)
        return arr[i]
    }

    private operator fun set(row: Int, col: Int, value: Int) {
        val i = index(row, col)
        arr[i] = value
    }
}

fun main() {
    val rows = 15
    val bt = BellTriangle(rows)

    println("First fifteen Bell numbers:")
    for (i in 1..rows) {
        println("%2d: %d".format(i, bt[i, 0]))
    }

    for (i in 1..10) {
        print("${bt[i, 0]}")
        for (j in 1 until i) {
            print(", ${bt[i, j]}")
        }
        println()
    }
}


// Little Man Computer, for Rosetta Code.
// Calculate Bell numbers, using a 1-dimensional array and addition.
//
// After the calculation of B_n (n > 0), the array contains n elements,
// of which B_n is the first. Example to show calculation of B_(n+1):
// After calc. of B_3 = 5, array holds:      5,  3,  2
// Extend array by copying B_3 to high end:  5,  3,  2,  5
// Replace 2 by 5 + 2 = 7:                   5,  3,  7,  5
// Replace 3 by 7 + 3 = 10:                  5, 10,  7,  5
// Replace first 5 by 10 + 5 = 15:          15, 10,  7,  5
// First element of array is now B_4 = 15.

// Initialize; B_0 := 1
         LDA c1
         STA Bell
         LDA c0
         STA index
         BRA print    // skip increment of index
// Increment index of Bell number
inc_ix   LDA index
         ADD c1
         STA index
// Here acc = index; print index and Bell number
print    OUT
         LDA colon
         OTC          // non-standard instruction; cosmetic only
         LDA Bell
         OUT
         LDA index
         BRZ inc_ix   // if index = 0, skip rest and loop back
         SUB c7       // reached maximum index yet?
         BRZ done     // if so, jump to exit
// Manufacture some instructions
         LDA lda_0
         ADD index
         STA lda_ix
         SUB c200     // convert LDA to STA with same address
         STA sta_ix
// Copy latest Bell number to end of array
lda_0    LDA Bell     // load Bell number
sta_ix   STA 0        // address was filled in above
// Manufacture more instructions
         LDA lda_ix   // load LDA instruction
loop     SUB c401     // convert to ADD with address 1 less
         STA add_ix_1
         ADD c200     // convert to STA
         STA sta_ix_1
// Execute instructions; zero addresses were filled in above
lda_ix   LDA 0        // load element of array
add_ix_1 ADD 0        // add to element below
sta_ix_1 STA 0        // update element below
         LDA sta_ix_1 // load previous STA instruction
         SUB sta_Bell // does it refer to first element of array?
         BRZ inc_ix   // yes, loop to inc index and print
         LDA lda_ix   // no, repeat with addresses 1 less
         SUB c1
         STA lda_ix
         BRA loop
// Here when done
done     HLT
// Constants
colon    DAT 58
c0       DAT 0
c1       DAT 1
c7       DAT 7        // maximum index
c200     DAT 200
c401     DAT 401
sta_Bell STA Bell     // not executed; used for comparison
// Variables
index    DAT
Bell     DAT
// Rest of array goes here
// end


-- Bell numbers in Lua
-- db 6/11/2020 (to replace missing original)

local function bellTriangle(n)
  local tri = { {1} }
  for i = 2, n do
    tri[i] = { tri[i-1][i-1] }
    for j = 2, i do
      tri[i][j] = tri[i][j-1] + tri[i-1][j-1]
    end
  end
  return tri
end

local N = 25 -- in lieu of 50, practical limit with double precision floats
local tri = bellTriangle(N)

print("First 15 and "..N.."th Bell numbers:")
for i = 1, 15 do
  print(i, tri[i][1])
end
print(N, tri[N][1])

print()

print("First 10 rows of Bell triangle:")
for i = 1, 10 do
  print("[ " .. table.concat(tri[i],", ") .. " ]")
end


BellTriangle[n_Integer?Positive] := NestList[Accumulate[# /. {a___, b_} :> {b, a, b}] &, {1}, n - 1];
BellNumber[n_Integer] := BellTriangle[n][[n, 1]];


import math

iterator b(): int =
  ## Iterator yielding the bell numbers.
  var numbers = @[1]
  yield 1
  var n = 0
  while true:
    var next = 0
    for k in 0..n:
      next += binom(n, k) * numbers[k]
    numbers.add(next)
    yield next
    inc n

when isMainModule:

  import strformat

  const Limit = 25      # Maximum index beyond which an overflow occurs.

  echo "Bell numbers from B0 to B25:"
  var i = 0
  for n in b():
    echo fmt"{i:2d}: {n:>20d}"
    inc i
    if i > Limit:
      break


genit(maxx=50)={bell=List();
for(n=0,maxx,q=sum(k=0,n,stirling(n,k,2));
listput(bell,q));bell}
END


program BellNumbers;
{$Ifdef FPC}
  {$optimization on,all}
{$ElseIf}
  {Apptype console}
{$EndIf}
uses
  sysutils,gmp;
var
  T0 :TDateTime;
procedure BellNumbersUint64(OnlyBellNumbers:Boolean);
var
  BList : array[0..24] of Uint64;
  BellNum : Uint64;
  BListLenght,i :nativeUInt;
begin
  IF OnlyBellNUmbers then
  Begin
    writeln('Bell triangles ');
    writeln('  1 = 1');
  end
  else
  Begin
    writeln('Bell numbers');
    writeln('  1 = 1');
    writeln('  2 = 1');
  end;

  BList[0]:= 1;
  BListLenght := 1;
  BellNum := 1;
  repeat
//  For i := BListLenght downto 1 do BList[i] := BList[i-1]; or
    move(Blist[0],Blist[1],BListLenght*SizeOf(Blist[0]));
    BList[0] := BellNum;
    For i := 1 to BListLenght do
    Begin
      BellNum += BList[i];
      BList[i] := BellNum;
    end;

//  Output
    IF OnlyBellNUmbers then
    Begin
      IF BListLenght<=9 then
      Begin
        write(BListLenght+1:3,' = ');
        For i := 0 to BListLenght do
          write(BList[i]:7);
        writeln;
      end
      ELSE
        BREAK;
    end
    else
      writeln(BListLenght+2:3,' = ',BellNum);

    inc(BListLenght);
  until  BListLenght >= 25;
  writeln;
end;

procedure BellNumbersMPInteger;
const
  MaxIndex = 5000;//must be > 0
var
//MPInteger as alternative to mpz_t -> selfcleaning
  BList : array[0..MaxIndex] of MPInteger;
  BellNum : MPInteger;
  BListLenght,i :nativeUInt;
  BellNumStr : AnsiString;
Begin
  BellNumStr := '';
  z_init(BellNum);
  z_ui_pow_ui(BellNum,10,32767);
  BListLenght := z_size(BellNum);
  writeln('init length ',BListLenght);
  For i := 0 to MaxIndex do
  Begin
//    z_init2_set(BList[i],BListLenght);
    z_add_ui( BList[i],i);
  end;
  writeln('init length ',z_size(BList[0]));

  T0 := now;
  BListLenght := 1;
  z_set_ui(BList[0],1);
  z_set_ui(BellNum,1);
  repeat
    //Move does not fit moving interfaces //    call    fpc_intf_assign
    For i := BListLenght downto 1 do  BList[i] := BList[i-1];
    z_set(BList[0],BellNum);
    For i := 1 to BListLenght do
    Begin
      BellNum := z_add(BellNum,BList[i]);
      z_set(BList[i],BellNum);
    end;
    inc(BListLenght);
    if (BListLenght+1) MOD 100 = 0 then
    Begin
      BellNumStr:= z_get_str(10,BellNum);
      //z_sizeinbase (BellNum, 10) is not exact :-(
      write('Bell(',(IntToStr(BListLenght)):6,') has ',
           (IntToStr(Length(BellNumStr))):6,' decimal digits');
      writeln(FormatDateTime(' NN:SS.ZZZ',now-T0),'s');
    end;
  until  BListLenght>=MaxIndex;
  BellNumStr:= z_get_str(10,BellNum);
  writeln(BListLenght:6,'.th ',Length(BellNumStr):8);

//clean up ;-)
  BellNumStr := '';
  z_clear(BellNum);
  For i := MaxIndex downto 0 do
    z_clear(BList[i]);
end;

BEGIN
  BellNumbersUint64(True);BellNumbersUint64(False);
  BellNumbersMPInteger;
END.


use strict 'vars';
use warnings;
use feature 'say';
use bigint;

my @b = 1;
my @Aitkens = [1];

push @Aitkens, do {
    my @c = $b[-1];
    push @c, $b[$_] + $c[$_] for 0..$#b;
    @b = @c;
    [@c]
} until (@Aitkens == 50);

my @Bell_numbers = map { @$_[0] } @Aitkens;

say 'First fifteen and fiftieth Bell numbers:';
printf "%2d: %s\n", 1+$_, $Bell_numbers[$_] for 0..14, 49;

say "\nFirst ten rows of Aitken's array:";
printf '%-7d'x@{$Aitkens[$_]}."\n", @{$Aitkens[$_]} for 0..9;


with javascript_semantics
include mpfr.e
function bellTriangle(integer n)
-- nb: returns strings to simplify output
    mpz z = mpz_init(1)
    string sz = "1"
    sequence tri = {}, line = {}
    for i=1 to n do
        line = prepend(line,mpz_init_set(z))
        tri = append(tri,{sz})
        for j=2 to length(line) do
            mpz_add(z,z,line[j])
            mpz_set(line[j],z)
            sz = mpz_get_str(z)
            tri[$] = append(tri[$],sz)
        end for
    end for
    line = mpz_free(line)
    z = mpz_free(z)
    return tri
end function

sequence bt = bellTriangle(50)
printf(1,"First fifteen and fiftieth Bell numbers:\n%s\n50:%s\n\n",
         {join(vslice(bt[1..15],1)),bt[50][1]})
printf(1,"The first ten rows of Bell's triangle:\n")
for i=1 to 10 do
    printf(1,"%s\n",{join(bt[i])})
end for


(de bell (N)
   (make
      (setq L (link (list 1)))
      (do N
         (setq L
            (link
               (make
                  (setq A (link (last L)))
                  (for B L
                     (setq A (link (+ A B))) ) ) ) ) ) ) )
(setq L (bell 51))
(for N 15
   (tab (2 -2 -2) N ":" (get L N 1)) )
(prinl 50 ": " (get L 50 1))
(prinl)
(prinl "First ten rows:")
(for N 10
   (println (get L N)) )


bell(N, Bell):-
    bell(N, Bell, [], _).

bell(0, [[1]|T], T, [1]):-!.
bell(N, Bell, B, Row):-
    N1 is N - 1,
    bell(N1, Bell, [Row|B], Last),
    next_row(Row, Last).

next_row([Last|Bell], Bell1):-
    last(Bell1, Last),
    next_row1(Last, Bell, Bell1).

next_row1(_, [], []):-!.
next_row1(X, [Y|Rest], [B|Bell]):-
    Y is X + B,
    next_row1(Y, Rest, Bell).

print_bell_numbers(_, 0):-!.
print_bell_numbers([[Number|_]|Bell], N):-
    writef('%w\n', [Number]),
    N1 is N - 1,
    print_bell_numbers(Bell, N1).

print_bell_rows(_, 0):-!.
print_bell_rows([Row|Rows], N):-
    print_bell_row(Row),
    N1 is N - 1,
    print_bell_rows(Rows, N1).

print_bell_row([Number]):-
    !,
    writef('%w\n', [Number]).
print_bell_row([Number|Numbers]):-
    writef('%w ', [Number]),
    print_bell_row(Numbers).

main:-
    bell(49, Bell),
    writef('First 15 Bell numbers:\n'),
    print_bell_numbers(Bell, 15),
    last(Bell, [Number|_]),
    writef('\n50th Bell number: %w\n', [Number]),
    writef('\nFirst 10 rows of Bell triangle:\n'),
    print_bell_rows(Bell, 10).


def bellTriangle(n):
    tri = [None] * n
    for i in xrange(n):
        tri[i] = [0] * i
    tri[1][0] = 1
    for i in xrange(2, n):
        tri[i][0] = tri[i - 1][i - 2]
        for j in xrange(1, i):
            tri[i][j] = tri[i][j - 1] + tri[i - 1][j - 1]
    return tri

def main():
    bt = bellTriangle(51)
    print "First fifteen and fiftieth Bell numbers:"
    for i in xrange(1, 16):
        print "%2d: %d" % (i, bt[i][0])
    print "50:", bt[50][0]
    print
    print "The first ten rows of Bell's triangle:"
    for i in xrange(1, 11):
        print bt[i]

main()


  [ ' [ [ 1 ] ]  ' [ 1 ]
    rot 1 - times
      [ dup -1 peek nested
        swap witheach
          [ over -1 peek + join ]
        tuck nested join swap ]
    drop ]                        is bell's-triangle ( n --> [ )

  [ bell's-triangle [] swap
    witheach [ 0 peek join ] ]    is bell-numbers    ( n --> [ )

  say "First fifteen Bell numbers:" cr
  15 bell-numbers echo
  cr cr
    say "Fiftieth Bell number:" cr
  50 bell-numbers -1 peek echo
  cr cr
  say "First ten rows of Bell's triangle:" cr
  10 bell's-triangle witheach [ echo cr ]


#lang racket

(define (build-bell-row previous-row)
  (define seed (last previous-row))
  (reverse
   (let-values (((reversed _) (for/fold ((acc (list seed)) (prev seed))
                                        ((pprev previous-row))
                                (let ((n (+ prev pprev))) (values (cons n acc) n)))))
     reversed)))

(define reverse-bell-triangle
  (let ((memo (make-hash '((0 . ((1)))))))
    (λ (rows) (hash-ref! memo
                         rows
                         (λ ()
                           (let ((prev (reverse-bell-triangle (sub1 rows))))
                             (cons (build-bell-row (car prev)) prev)))))))

(define bell-triangle (compose reverse reverse-bell-triangle))

(define bell-number (compose caar reverse-bell-triangle))

(module+ main
  (map bell-number (range 15))
  (bell-number 50)
  (bell-triangle 10))


 my @Aitkens-array = lazy [1], -> @b {
     my @c = @b.tail;
     @c.push: @b[$_] + @c[$_] for ^@b;
     @c
 } ... *;

 my @Bell-numbers = @Aitkens-array.map: { .head };

say "First fifteen and fiftieth Bell numbers:";
printf "%2d: %s\n", 1+$_, @Bell-numbers[$_] for flat ^15, 49;

say "\nFirst ten rows of Aitken's array:";
.say for @Aitkens-array[^10];


/*REXX program calculates and displays a range of  Bell numbers  (index starts at zero).*/
parse arg LO HI .                                /*obtain optional arguments from the CL*/
if LO=='' & HI==""   then do; LO=0; HI=14;  end  /*Not specified?  Then use the default.*/
if LO=='' | LO==","  then LO=  0                 /* "      "         "   "   "     "    */
if HI=='' | HI==","  then HI= 15                 /* "      "         "   "   "     "    */
numeric digits max(9, HI*2)                      /*crudely calculate the # decimal digs.*/
!.=.;             !.0= 1;   !.1= 1;      @.= 1   /*the  FACT  function uses memoization.*/
     do j=0  for  HI+1;     $= j==0;     jm= j-1 /*JM  is used for a shortcut  (below). */
            do k=0  for j;            _= jm - k  /* [↓]  calculate a Bell # the easy way*/
            $= $ + comb(jm, k) * @._             /*COMB≡combination or binomial function*/
            end   /*k*/
     @.j= $                                      /*assign the Jth Bell number to @ array*/
     if j>=LO  &  j<=HI  then say '      Bell('right(j, length(HI) )") = "    commas($)
     end   /*j*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
commas:  parse arg _;  do c=length(_)-3  to 1  by -3; _=insert(',', _, c); end;   return _
/*──────────────────────────────────────────────────────────────────────────────────────*/
comb: procedure expose !.; parse arg x,y;        if x==y      then  return 1
      if x-y<y  then y= x - y;                   if !.x.y\==. then  return !.x.y / fact(y)
      _= 1;          do j=x-y+1  to x;  _= _*j;  end;    !.x.y= _;  return     _ / fact(y)
/*──────────────────────────────────────────────────────────────────────────────────────*/
fact: procedure expose !.; parse arg x;    if !.x\==.   then return !.x;          != 1
                     do f=2  for x-1;      != ! * f;    end;        !.x= !;       return !


def bellTriangle(n)
    tri = Array.new(n)
    for i in 0 .. n - 1 do
        tri[i] = Array.new(i)
        for j in 0 .. i - 1 do
            tri[i][j] = 0
        end
    end
    tri[1][0] = 1
    for i in 2 .. n - 1 do
        tri[i][0] = tri[i - 1][i - 2]
        for j in 1 .. i - 1 do
            tri[i][j] = tri[i][j - 1] + tri[i - 1][j - 1]
        end
    end
    return tri
end

def main
    bt = bellTriangle(51)
    puts "First fifteen and fiftieth Bell numbers:"
    for i in 1 .. 15 do
        puts "%2d: %d" % [i, bt[i][0]]
    end
    puts "50: %d" % [bt[50][0]]
    puts

    puts "The first ten rows of Bell's triangle:"
    for i in 1 .. 10 do
        puts bt[i].inspect
    end
end

main()


use num::BigUint;

fn main() {
    let bt = bell_triangle(51);
    // the fifteen first
    for i in 1..=15 {
        println!("{}: {}", i, bt[i][0]);
    }

    // the fiftieth
    println!("50: {}", bt[50][0])
}

fn bell_triangle(n: usize) -> Vec<Vec<BigUint>> {
    let mut tri: Vec<Vec<BigUint>> = Vec::with_capacity(n);
    for i in 0..n {
        let v = vec![BigUint::from(0u32); i];
        tri.push(v);
    }
    tri[1][0] = BigUint::from(1u32);

    for i in 2..n {
        tri[i][0] = BigUint::from_bytes_be(&tri[i - 1][i - 2].to_bytes_be());
        for j in 1..i {
            let added_big_uint = &tri[i][j - 1] + &tri[i - 1][j - 1];
            tri[i][j] = BigUint::from_bytes_be(&added_big_uint.to_bytes_be());
        }
    }

    tri
}


import scala.collection.mutable.ListBuffer

object BellNumbers {
  class BellTriangle {
    val arr: ListBuffer[Int] = ListBuffer.empty[Int]

    def this(n: Int) {
      this()

      val length = n * (n + 1) / 2
      for (_ <- 0 until length) {
        arr += 0
      }

      this (1, 0) = 1
      for (i <- 2 to n) {
        this (i, 0) = this (i - 1, i - 2)
        for (j <- 1 until i) {
          this (i, j) = this (i, j - 1) + this (i - 1, j - 1)
        }
      }
    }

    private def index(row: Int, col: Int): Int = {
      require(row > 0, "row must be greater than zero")
      require(col >= 0, "col must not be negative")
      require(col < row, "col must be less than row")

      row * (row - 1) / 2 + col
    }

    def apply(row: Int, col: Int): Int = {
      val i = index(row, col)
      arr(i)
    }

    def update(row: Int, col: Int, value: Int): Unit = {
      val i = index(row, col)
      arr(i) = value
    }
  }

  def main(args: Array[String]): Unit = {
    val rows = 15
    val bt = new BellTriangle(rows)

    println("First fifteen Bell numbers:")
    for (i <- 0 until rows) {
      printf("%2d: %d\n", i + 1, bt(i + 1, 0))
    }

    for (i <- 1 to 10) {
      print(bt(i, 0))
      for (j <- 1 until i) {
        print(s", ${bt(i, j)}")
      }
      println()
    }
  }
}


; Given the remainder of the previous row and the final cons of the current row,
; extend (in situ) the current row to be a complete row of the Bell triangle.
; Return the final value in the extended row (for use in computing the following row).

(define bell-triangle-row-extend
  (lambda (prevrest thisend)
    (cond
      ((null? prevrest)
        (car thisend))
      (else
        (set-cdr! thisend (list (+ (car prevrest) (car thisend))))
        (bell-triangle-row-extend (cdr prevrest) (cdr thisend))))))

; Return the Bell triangle of rows 0 through N (as a list of lists).

(define bell-triangle
  (lambda (n)
    (let* ((tri (list (list 1)))
           (triend tri)
           (rowendval (caar tri)))
      (do ((index 0 (1+ index)))
          ((>= index n) tri)
        (let ((nextrow (list rowendval)))
          (set! rowendval (bell-triangle-row-extend (car triend) nextrow))
          (set-cdr! triend (list nextrow))
          (set! triend (cdr triend)))))))

; Print out the Bell numbers 0 through 19 and 49 thgough 51.
; (The Bell numbers are the first number on each row of the Bell triangle.)

(printf "~%The Bell numbers:~%")
(let loop ((triangle (bell-triangle 51)) (count 0))
  (when (pair? triangle)
    (when (or (<= count 19) (>= count 49))
      (printf "  ~2d: ~:d~%" count (caar triangle)))
    (loop (cdr triangle) (1+ count))))

; Print out the Bell triangle of 10 rows.

(printf "~%First 10 rows of the Bell triangle:~%")
(let rowloop ((triangle (bell-triangle 9)))
  (when (pair? triangle)
    (let eleloop ((rowlist (car triangle)))
      (when (pair? rowlist)
        (printf " ~7:d" (car rowlist))
        (eleloop (cdr rowlist))))
    (newline)
    (rowloop (cdr triangle))))


public struct BellTriangle<T: BinaryInteger> {
  @usableFromInline
  var arr: [T]

  @inlinable
  public internal(set) subscript(row row: Int, col col: Int) -> T {
    get { arr[row * (row - 1) / 2 + col] }
    set { arr[row * (row - 1) / 2 + col] = newValue }
  }

  @inlinable
  public init(n: Int) {
    arr = Array(repeating: 0, count: n * (n + 1) / 2)

    self[row: 1, col: 0] = 1

    for i in 2...n {
      self[row: i, col: 0] = self[row: i - 1, col: i - 2]

      for j in 1..<i {
        self[row: i, col: j] = self[row: i, col: j - 1] + self[row: i - 1, col: j - 1]
      }
    }
  }
}

let tri = BellTriangle<Int>(n: 15)

print("First 15 Bell numbers:")

for i in 1...15 {
  print("\(i): \(tri[row: i, col: 0])")
}

for i in 1...10 {
  print(tri[row: i, col: 0], terminator: "")

  for j in 1..<i {
    print(", \(tri[row: i, col: j])", terminator: "")
  }

  print()
}


Imports System.Numerics
Imports System.Runtime.CompilerServices

Module Module1

    <Extension()>
    Sub Init(Of T)(array As T(), value As T)
        If IsNothing(array) Then Return
        For i = 0 To array.Length - 1
            array(i) = value
        Next
    End Sub

    Function BellTriangle(n As Integer) As BigInteger()()
        Dim tri(n - 1)() As BigInteger
        For i = 0 To n - 1
            Dim temp(i - 1) As BigInteger
            tri(i) = temp
            tri(i).Init(0)
        Next
        tri(1)(0) = 1
        For i = 2 To n - 1
            tri(i)(0) = tri(i - 1)(i - 2)
            For j = 1 To i - 1
                tri(i)(j) = tri(i)(j - 1) + tri(i - 1)(j - 1)
            Next
        Next
        Return tri
    End Function

    Sub Main()
        Dim bt = BellTriangle(51)
        Console.WriteLine("First fifteen Bell numbers:")
        For i = 1 To 15
            Console.WriteLine("{0,2}: {1}", i, bt(i)(0))
        Next
        Console.WriteLine("50: {0}", bt(50)(0))
        Console.WriteLine()
        Console.WriteLine("The first ten rows of Bell's triangle:")
        For i = 1 To 10
            Dim it = bt(i).GetEnumerator()
            Console.Write("[")
            If it.MoveNext() Then
                Console.Write(it.Current)
            End If
            While it.MoveNext()
                Console.Write(", ")
                Console.Write(it.Current)
            End While
            Console.WriteLine("]")
        Next
    End Sub

End Module


import math.big

fn bell_triangle(n int) [][]big.Integer {
    mut tri := [][]big.Integer{len: n}
    for i in 0..n {
        tri[i] = []big.Integer{len: i}
        for j in 0..i {
            tri[i][j] = big.zero_int
        }
    }
    tri[1][0] = big.integer_from_u64(1)
    for i in 2..n {
        tri[i][0] = tri[i-1][i-2]
        for j := 1; j < i; j++ {
            tri[i][j] = tri[i][j-1] + tri[i-1][j-1]
        }
    }
    return tri
}

fn main() {
    bt := bell_triangle(51)
    println("First fifteen and fiftieth Bell numbers:")
    for i := 1; i <= 15; i++ {
        println("${i:2}: ${bt[i][0]}")
    }
    println("50: ${bt[50][0]}")
    println("\nThe first ten rows of Bell's triangle:")
    for i := 1; i <= 10; i++ {
        println(bt[i])
    }
}


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

var bellTriangle = Fn.new { |n|
    var tri = List.filled(n, null)
    for (i in 0...n) {
        tri[i] = List.filled(i, null)
        for (j in 0...i) tri[i][j] = BigInt.zero
    }
    tri[1][0] = BigInt.one
    for (i in 2...n) {
        tri[i][0] = tri[i-1][i-2]
        for (j in 1...i) {
            tri[i][j] = tri[i][j-1] + tri[i-1][j-1]
        }
    }
    return tri
}

var bt = bellTriangle.call(51)
System.print("First fifteen and fiftieth Bell numbers:")
for (i in 1..15) Fmt.print("$2d: $,i", i, bt[i][0])
Fmt.print("$2d: $,i", 50, bt[50][0])
System.print("\nThe first ten rows of Bell's triangle:")
for (i in 1..10) Fmt.print("$,7i", bt[i])


fcn bellTriangleW(start=1,wantRow=False){	// --> iterator
   Walker.zero().tweak('wrap(row){
      row.insert(0,row[-1]);
      foreach i in ([1..row.len()-1]){ row[i]+=row[i-1] }
      wantRow and row or row[-1]
   }.fp(List(start))).push(start,start);
}


package binning is
   type Nums_Array is array (Natural range <>) of Integer;
   function Is_Sorted (Item : Nums_Array) return Boolean;
   subtype Limits_Array is Nums_Array with
        Dynamic_Predicate => Is_Sorted (Limits_Array);
   function Bins (Limits : Limits_Array; Data : Nums_Array) return Nums_Array;
   procedure Print (Limits : Limits_Array; Bin_Result : Nums_Array);
end binning;


BEGIN # count the number pf items that fall into "bins" given he limits #
    # returns an array of "bins" containing the counts of the data items #
    #         that fall into the bins given the limits                   #
    PRIO INTOBINS = 1;
    OP   INTOBINS = ( []INT data, []INT limits )[]INT:
         BEGIN
            [ LWB limits : UPB limits + 1 ]INT bins;
            FOR bin number FROM LWB bins TO UPB bins DO bins[ bin number ] := 0 OD;
            FOR d pos FROM LWB data TO UPB data DO
                INT bin number := LWB bins;
                INT item        = data[ d pos ];
                FOR b pos FROM LWB bins TO UPB bins - 1 WHILE item >= limits[ b pos ] DO
                    bin number +:= 1
                OD;
                bins[ bin number ] +:= 1
            OD;
            bins
         END # INTOBINS # ;
    # shows the limits of the bins and the number of items in each #
    PROC show bins = ( []INT limits, []INT bins )VOID:
         BEGIN
             print( ( "            < ", whole( limits[ LWB limits ], -4 )
                    , ": ", whole( bins[ LWB bins ], -4 )
                    , newline
                    )
                  );
             INT bin number := LWB bins + 1;
             FOR l pos FROM LWB limits + 1 TO UPB limits DO
                 print( ( ">= ",     whole( limits[ l pos - 1 ], -4 )
                        , " and < ", whole( limits[ l pos     ], -4 )
                        , ": ", whole( bins[ bin number ], -4 )
                        , newline
                        )
                      );
                 bin number +:= 1
             OD;
             print( ( "            > ", whole( limits[ UPB limits ], -4 )
                    , ": ", whole( bins[ UPB bins ], -4 )
                    , newline
                    )
                  )
         END # show bins # ;

    # task test cases #
    BEGIN
        print( ( "data set 1", newline ) );
        []INT limits =
            ( 23, 37, 43, 53, 67, 83 );
        []INT data   =
            ( 95, 21, 94, 12, 99,  4, 70, 75, 83, 93, 52, 80, 57,  5, 53, 86, 65, 17, 92, 83, 71, 61, 54, 58, 47
            , 16,  8,  9, 32, 84,  7, 87, 46, 19, 30, 37, 96,  6, 98, 40, 79, 97, 45, 64, 60, 29, 49, 36, 43, 55
            );
        show bins( limits, data INTOBINS limits )
    END;
    print( ( newline ) );
    BEGIN
        print( ( "data set 2", newline ) );
        []INT limits =
            (   14,  18, 249, 312, 389, 392, 513, 591, 634, 720 );
        []INT data   =
             ( 445, 814, 519, 697, 700, 130, 255, 889, 481, 122, 932,  77, 323, 525, 570, 219, 367, 523, 442, 933
             , 416, 589, 930, 373, 202, 253, 775,  47, 731, 685, 293, 126, 133, 450, 545, 100, 741, 583, 763, 306
             , 655, 267, 248, 477, 549, 238,  62, 678,  98, 534, 622, 907, 406, 714, 184, 391, 913,  42, 560, 247
             , 346, 860,  56, 138, 546,  38, 985, 948,  58, 213, 799, 319, 390, 634, 458, 945, 733, 507, 916, 123
             , 345, 110, 720, 917, 313, 845, 426,   9, 457, 628, 410, 723, 354, 895, 881, 953, 677, 137, 397,  97
             , 854, 740,  83, 216, 421,  94, 517, 479, 292, 963, 376, 981, 480,  39, 257, 272, 157,   5, 316, 395
             , 787, 942, 456, 242, 759, 898, 576,  67, 298, 425, 894, 435, 831, 241, 989, 614, 987, 770, 384, 692
             , 698, 765, 331, 487, 251, 600, 879, 342, 982, 527, 736, 795, 585,  40,  54, 901, 408, 359, 577, 237
             , 605, 847, 353, 968, 832, 205, 838, 427, 876, 959, 686, 646, 835, 127, 621, 892, 443, 198, 988, 791
             , 466,  23, 707, 467,  33, 670, 921, 180, 991, 396, 160, 436, 717, 918,   8, 374, 101, 684, 727, 749
             );
        show bins( limits, data INTOBINS limits )
    END
END


Bin_given_limits(limits, data){
    bin := [], counter := 0
    for i, val in data	{
        if (limits[limits.count()] <= val)
            bin["∞", ++counter] := val

        else for j, limit in limits
            if (limits[j-1] <= val && val < limits[j])
                bin[limit, ++counter] := val
    }

    for j, limit in limits	{
        output .=  (prevlimit ? prevlimit : "-∞") ", " limit " : " ((x:=bin[limit].Count())?x:0) "`n"
        prevlimit := limit
    }
    return output .=  (prevlimit ? prevlimit : "-∞") ",  ∞ : " ((x:=bin["∞"].Count())?x:0) "`n"
}


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

size_t upper_bound(const int* array, size_t n, int value) {
    size_t start = 0;
    while (n > 0) {
        size_t step = n / 2;
        size_t index = start + step;
        if (value >= array[index]) {
            start = index + 1;
            n -= step + 1;
        } else {
            n = step;
        }
    }
    return start;
}

int* bins(const int* limits, size_t nlimits, const int* data, size_t ndata) {
    int* result = calloc(nlimits + 1, sizeof(int));
    if (result == NULL)
        return NULL;
    for (size_t i = 0; i < ndata; ++i)
        ++result[upper_bound(limits, nlimits, data[i])];
    return result;
}

void print_bins(const int* limits, size_t n, const int* bins) {
    if (n == 0)
        return;
    printf("           < %3d: %2d\n", limits[0], bins[0]);
    for (size_t i = 1; i < n; ++i)
        printf(">= %3d and < %3d: %2d\n", limits[i - 1], limits[i], bins[i]);
    printf(">= %3d          : %2d\n", limits[n - 1], bins[n]);
}

int main() {
    const int limits1[] = {23, 37, 43, 53, 67, 83};
    const int data1[] = {95, 21, 94, 12, 99, 4,  70, 75, 83, 93, 52, 80, 57,
                         5,  53, 86, 65, 17, 92, 83, 71, 61, 54, 58, 47, 16,
                         8,  9,  32, 84, 7,  87, 46, 19, 30, 37, 96, 6,  98,
                         40, 79, 97, 45, 64, 60, 29, 49, 36, 43, 55};

    printf("Example 1:\n");
    size_t n = sizeof(limits1) / sizeof(int);
    int* b = bins(limits1, n, data1, sizeof(data1) / sizeof(int));
    if (b == NULL) {
        fprintf(stderr, "Out of memory\n");
        return EXIT_FAILURE;
    }
    print_bins(limits1, n, b);
    free(b);

    const int limits2[] = {14, 18, 249, 312, 389, 392, 513, 591, 634, 720};
    const int data2[] = {
        445, 814, 519, 697, 700, 130, 255, 889, 481, 122, 932, 77,  323, 525,
        570, 219, 367, 523, 442, 933, 416, 589, 930, 373, 202, 253, 775, 47,
        731, 685, 293, 126, 133, 450, 545, 100, 741, 583, 763, 306, 655, 267,
        248, 477, 549, 238, 62,  678, 98,  534, 622, 907, 406, 714, 184, 391,
        913, 42,  560, 247, 346, 860, 56,  138, 546, 38,  985, 948, 58,  213,
        799, 319, 390, 634, 458, 945, 733, 507, 916, 123, 345, 110, 720, 917,
        313, 845, 426, 9,   457, 628, 410, 723, 354, 895, 881, 953, 677, 137,
        397, 97,  854, 740, 83,  216, 421, 94,  517, 479, 292, 963, 376, 981,
        480, 39,  257, 272, 157, 5,   316, 395, 787, 942, 456, 242, 759, 898,
        576, 67,  298, 425, 894, 435, 831, 241, 989, 614, 987, 770, 384, 692,
        698, 765, 331, 487, 251, 600, 879, 342, 982, 527, 736, 795, 585, 40,
        54,  901, 408, 359, 577, 237, 605, 847, 353, 968, 832, 205, 838, 427,
        876, 959, 686, 646, 835, 127, 621, 892, 443, 198, 988, 791, 466, 23,
        707, 467, 33,  670, 921, 180, 991, 396, 160, 436, 717, 918, 8,   374,
        101, 684, 727, 749};

    printf("\nExample 2:\n");
    n = sizeof(limits2) / sizeof(int);
    b = bins(limits2, n, data2, sizeof(data2) / sizeof(int));
    if (b == NULL) {
        fprintf(stderr, "Out of memory\n");
        return EXIT_FAILURE;
    }
    print_bins(limits2, n, b);
    free(b);

    return EXIT_SUCCESS;
}


% Bin the given data, return an array of counts.
% CLU allows arrays to start at any index; the result array
% will have the same lower bound as the limit array.

% The datatype for the limits and data may be any type
% that allows the < comparator.
bin_count = proc [T: type] (limits, data: array[T]) returns (array[int])
            where T has lt: proctype (T,T) returns (bool)
    ad = array[T]       % abbreviations for array types
    ai = array[int]

    lowbin: int := ad$low(limits)
    bins: ai := ai$fill(lowbin, ad$size(limits)+1, 0)

    for item: T in ad$elements(data) do
        bin: int := lowbin
        while bin <= ad$high(limits) do
            if item < limits[bin] then break end
            bin := bin + 1
        end
        bins[bin] := bins[bin] + 1
    end

    return(bins)
end bin_count

% Display the bins and the amount of items in each bin.
% This imposes the further restriction on the datatype
% that it allows `unparse' (may be turned into a string).
display_bins = proc [T: type] (limits, data: array[T])
               where T has unparse: proctype (T) returns (string),
                     T has lt: proctype (T,T) returns (bool)
    ad = array[T]
    ai = array[int]

    po: stream := stream$primary_output()
    bins: ai := bin_count[T](limits, data)

    for i: int in int$from_to(ad$low(limits), ad$high(limits)+1) do
        lo, hi: string
        if i-1 < ad$low(limits)
            then lo := "-inf"
            else lo := T$unparse(limits[i-1])
        end
        if i > ad$high(limits)
            then hi := "inf"
            else hi := T$unparse(limits[i])
        end

        stream$putright(po, lo, 5)
        stream$puts(po, " - ")
        stream$putright(po, hi, 5)
        stream$puts(po, " : ")
        stream$putright(po, int$unparse(bins[i]), 5)
        stream$putl(po, "")
    end

    stream$putl(po, "------------------------------------------\n")
end display_bins

% Try both example inputs
start_up = proc ()
    ai = array[int]

    limits1: ai := ai$[23, 37, 43, 53, 67, 83]
    data1: ai := ai$
     [95,21,94,12,99,4,70,75,83,93,52,80,57,5,53,86,65,17,92,83,71,61,54,58,47,
      16, 8, 9,32,84,7,87,46,19,30,37,96,6,98,40,79,97,45,64,60,29,49,36,43,55]

    limits2: ai := ai$[14, 18, 249, 312, 389, 392, 513, 591, 634, 720]
    data2: ai := ai$
     [445,814,519,697,700,130,255,889,481,122,932, 77,323,525,570,219,367,523,442,933,
      416,589,930,373,202,253,775, 47,731,685,293,126,133,450,545,100,741,583,763,306,
      655,267,248,477,549,238, 62,678, 98,534,622,907,406,714,184,391,913, 42,560,247,
      346,860, 56,138,546, 38,985,948, 58,213,799,319,390,634,458,945,733,507,916,123,
      345,110,720,917,313,845,426,  9,457,628,410,723,354,895,881,953,677,137,397, 97,
      854,740, 83,216,421, 94,517,479,292,963,376,981,480, 39,257,272,157,  5,316,395,
      787,942,456,242,759,898,576, 67,298,425,894,435,831,241,989,614,987,770,384,692,
      698,765,331,487,251,600,879,342,982,527,736,795,585, 40, 54,901,408,359,577,237,
      605,847,353,968,832,205,838,427,876,959,686,646,835,127,621,892,443,198,988,791,
      466, 23,707,467, 33,670,921,180,991,396,160,436,717,918,  8,374,101,684,727,749]

    display_bins[int](limits1, data1)
    display_bins[int](limits2, data2)
end start_up


import Control.Monad (foldM)
import Data.List (partition)

binSplit :: Ord a => [a] -> [a] -> [[a]]
binSplit lims ns = counts ++ [rest]
  where
    (counts, rest) = foldM split ns lims
    split l i = let (a, b) = partition (< i) l in ([a], b)

binCounts :: Ord a => [a] -> [a] -> [Int]
binCounts b = fmap length . binSplit b


Idotr=: |[email protected][ (#@[ - I.) ]             NB. reverses order of limits to obtain intervals closed on left, open on right (>= y <)
binnedData=: adverb define
  bidx=. [email protected]>:@# x                    NB. indicies of bins
  x (Idotr (u@}./.)&(bidx&,) ]) y     NB. apply u to data in each bin after dropping first value
)

require 'format/printf'
printBinCounts=: verb define
  counts =. y
  '%2d   in [ -∞, %3d)' printf ({. counts) , {. x
  '%2d   in [%3d, %3d)' printf (}.}: counts) ,. 2 ]\ x
  '%2d   in [%3d, ∞]' printf ({: counts) , {: x
)


import java.util.Arrays;
import java.util.Collections;
import java.util.List;

public class Bins {
    public static <T extends Comparable<? super T>> int[] bins(
            List<? extends T> limits, Iterable<? extends T> data) {
        int[] result = new int[limits.size() + 1];
        for (T n : data) {
            int i = Collections.binarySearch(limits, n);
            if (i >= 0) {
                // n == limits[i]; we put it in right-side bin (i+1)
                i = i+1;
            } else {
                // n is not in limits and i is ~(insertion point)
                i = ~i;
            }
            result[i]++;
        }
        return result;
    }

    public static void printBins(List<?> limits, int[] bins) {
        int n = limits.size();
        if (n == 0) {
            return;
        }
        assert n+1 == bins.length;
        System.out.printf("           < %3s: %2d\n", limits.get(0), bins[0]);
        for (int i = 1; i < n; i++) {
            System.out.printf(">= %3s and < %3s: %2d\n", limits.get(i-1), limits.get(i), bins[i]);
        }
        System.out.printf(">= %3s          : %2d\n", limits.get(n-1), bins[n]);
    }

    public static void main(String[] args) {
        List<Integer> limits = Arrays.asList(23, 37, 43, 53, 67, 83);
        List<Integer> data = Arrays.asList(
            95, 21, 94, 12, 99, 4,  70, 75, 83, 93, 52, 80, 57, 5,  53, 86, 65,
            17, 92, 83, 71, 61, 54, 58, 47, 16, 8,  9,  32, 84, 7,  87, 46, 19,
            30, 37, 96, 6,  98, 40, 79, 97, 45, 64, 60, 29, 49, 36, 43, 55);

        System.out.println("Example 1:");
        printBins(limits, bins(limits, data));

        limits = Arrays.asList(14,  18,  249, 312, 389,
                               392, 513, 591, 634, 720);
        data = Arrays.asList(
            445, 814, 519, 697, 700, 130, 255, 889, 481, 122, 932, 77,  323, 525,
            570, 219, 367, 523, 442, 933, 416, 589, 930, 373, 202, 253, 775, 47,
            731, 685, 293, 126, 133, 450, 545, 100, 741, 583, 763, 306, 655, 267,
            248, 477, 549, 238, 62,  678, 98,  534, 622, 907, 406, 714, 184, 391,
            913, 42,  560, 247, 346, 860, 56,  138, 546, 38,  985, 948, 58,  213,
            799, 319, 390, 634, 458, 945, 733, 507, 916, 123, 345, 110, 720, 917,
            313, 845, 426, 9,   457, 628, 410, 723, 354, 895, 881, 953, 677, 137,
            397, 97,  854, 740, 83,  216, 421, 94,  517, 479, 292, 963, 376, 981,
            480, 39,  257, 272, 157, 5,   316, 395, 787, 942, 456, 242, 759, 898,
            576, 67,  298, 425, 894, 435, 831, 241, 989, 614, 987, 770, 384, 692,
            698, 765, 331, 487, 251, 600, 879, 342, 982, 527, 736, 795, 585, 40,
            54,  901, 408, 359, 577, 237, 605, 847, 353, 968, 832, 205, 838, 427,
            876, 959, 686, 646, 835, 127, 621, 892, 443, 198, 988, 791, 466, 23,
            707, 467, 33,  670, 921, 180, 991, 396, 160, 436, 717, 918, 8,   374,
            101, 684, 727, 749);

        System.out.println();
        System.out.println("Example 2:");
        printBins(limits, bins(limits, data));
    }
}


# input and output: {limits, count} where
#   .limits holds an array defining the limits, and
#   .count[$i] holds the count of bin $i, where bin[0] is the left-most bin
def bin($x):
  (.limits | bsearch($x)) as $ix
  | (if $ix > -1 then $ix + 1 else -1 - $ix end) as $i
  | .count[$i] += 1;

# pretty-print for the structure defined at bin/1
def pp:
   (.limits|length) as $length
   | (range(0;$length) as $i
      | "< \(.limits[$i]) => \(.count[$i] // 0)" ),
     ">= \(.limits[$length-1] ) => \(.count[$length] // 0)"  ;

# Main program
reduce inputs as $x ({$limits, count: []}; bin($x))
| pp


F get_fibs()
   V a = 1.0
   V b = 1.0
   [Float] r
   L 1000
      r [+]= a
      (a, b) = (b, a + b)
   R r

F benford(seq)
   V freqs = [(0.0, 0.0)] * 9
   V seq_len = 0
   L(d) seq
      I d != 0
         freqs[String(d)[0].code - ‘1’.code][1]++
         seq_len++

   L(&f) freqs
      f = (log10(1.0 + 1.0 / (L.index + 1)), f[1] / seq_len)
   R freqs

print(‘#9 #9 #9’.format(‘Actual’, ‘Expected’, ‘Deviation’))

L(p) benford(get_fibs())
   print(‘#.: #2.2% | #2.2% | #.4%’.format(L.index + 1, p[1] * 100, p[0] * 100, abs(p[1] - p[0]) * 100))


#import <Foundation/Foundation.h>

NSArray<NSNumber *> *bins(NSArray<NSNumber *> *limits, NSArray<NSNumber *> *data) {
  NSMutableArray<NSNumber *> *result = [[NSMutableArray alloc] initWithCapacity:[limits count] + 1];
  for (NSInteger i = 0; i <= [limits count]; i++) {
    [result addObject:@0];
  }
  for (NSNumber *n in data) {
    NSUInteger i = [limits indexOfObject:n
                           inSortedRange:NSMakeRange(0, [limits count])
                                 options:NSBinarySearchingInsertionIndex|NSBinarySearchingLastEqual
                         usingComparator:^(NSNumber *x, NSNumber *y){ return [x compare: y]; }];
    result[i] = @(result[i].integerValue + 1);
  }
  return result;
}

void printBins(NSArray<NSNumber *> *limits, NSArray<NSNumber *> *bins) {
  NSUInteger n = [limits count];
  if (n == 0)
      return;
  NSCAssert(n + 1 == [bins count], @"Wrong size of bins");
  NSLog(@"           < %[email protected]: %[email protected]", limits[0], bins[0]);
  for (NSInteger i = 1; i < n; i++) {
    NSLog(@">= %[email protected] and < %[email protected]: %[email protected]", limits[i-1], limits[i], bins[i]);
  }
  NSLog(@">= %[email protected]          : %[email protected]", limits[n-1], bins[n]);
}

int main(void) {
  @autoreleasepool {
    NSArray<NSNumber *> *limits = @[@23, @37, @43, @53, @67, @83];
    NSArray<NSNumber *> *data = @[
      @95, @21, @94, @12, @99, @4,  @70, @75, @83, @93, @52, @80, @57, @5,  @53, @86, @65,
      @17, @92, @83, @71, @61, @54, @58, @47, @16, @8,  @9,  @32, @84, @7,  @87, @46, @19,
      @30, @37, @96, @6,  @98, @40, @79, @97, @45, @64, @60, @29, @49, @36, @43, @55];

    NSLog(@"Example 1:");
    printBins(limits, bins(limits, data));

    limits = @[@14,  @18,  @249, @312, @389, @392, @513, @591, @634, @720];
    data = @[
      @445, @814, @519, @697, @700, @130, @255, @889, @481, @122, @932, @77,  @323, @525,
      @570, @219, @367, @523, @442, @933, @416, @589, @930, @373, @202, @253, @775, @47,
      @731, @685, @293, @126, @133, @450, @545, @100, @741, @583, @763, @306, @655, @267,
      @248, @477, @549, @238, @62,  @678, @98,  @534, @622, @907, @406, @714, @184, @391,
      @913, @42,  @560, @247, @346, @860, @56,  @138, @546, @38,  @985, @948, @58,  @213,
      @799, @319, @390, @634, @458, @945, @733, @507, @916, @123, @345, @110, @720, @917,
      @313, @845, @426, @9,   @457, @628, @410, @723, @354, @895, @881, @953, @677, @137,
      @397, @97,  @854, @740, @83,  @216, @421, @94,  @517, @479, @292, @963, @376, @981,
      @480, @39,  @257, @272, @157, @5,   @316, @395, @787, @942, @456, @242, @759, @898,
      @576, @67,  @298, @425, @894, @435, @831, @241, @989, @614, @987, @770, @384, @692,
      @698, @765, @331, @487, @251, @600, @879, @342, @982, @527, @736, @795, @585, @40,
      @54,  @901, @408, @359, @577, @237, @605, @847, @353, @968, @832, @205, @838, @427,
      @876, @959, @686, @646, @835, @127, @621, @892, @443, @198, @988, @791, @466, @23,
      @707, @467, @33,  @670, @921, @180, @991, @396, @160, @436, @717, @918, @8,   @374,
      @101, @684, @727, @749];

    NSLog(@"");
    NSLog(@"Example 2:");
    printBins(limits, bins(limits, data));
  }
  return 0;
}


: n:log10e ` 1 10 ln / ` ;

with: n

: n:log10  \ n -- n
    ln log10e * ;

: benford  \ x -- x
    1 swap / 1+ log10 ;

: fibs \ xt n
    swap >r
    0.0 1.0 rot
    ( dup [email protected] w:exec tuck + ) swap times
    2drop rdrop ;

var counts

: init
    a:new ( 0 a:push ) 9 times counts ! ;

: leading \ n -- n
    "%g" s:strfmt
    0 s:@ '0 - nip ;

: bump-digit \ n --
    1 swap
    counts @ swap 1- ' + a:op! drop ;

: count-fibs \ --
    ( leading bump-digit ) 1000 fibs ;

: adjust \ --
    counts @  ( 0.001 * ) a:map  counts ! ;

: spaces \ n --
    ' space swap times ;

: .fw \ s n --
    >r s:len r> rot . swap - spaces ;

: .header \ --
    "Digit" 8 .fw "Expected" 10 .fw "Actual" 10 .fw cr ;

: .digit \ n --
    >s 8 .fw ;

: .actual \ n --
    "%.3f" s:strfmt 10 .fw ;

: .expected \ n --
    "%.4f" s:strfmt 10 .fw ;

: report \ --
    .header
    counts @
    ( swap 1+ dup benford swap
      .digit .expected .actual cr )
    a:each drop ;

: benford-test
    init count-fibs adjust report ;

;with

benford-test
bye