// version 1.1.2

import java.math.BigDecimal
import java.math.MathContext

val mc = MathContext(256)

fun gcd(a: Long, b: Long): Long = if (b == 0L) a else gcd(b, a % b)

class Frac : Comparable<Frac> {
    val num: Long
    val denom: Long

    companion object {
        val ZERO = Frac(0, 1)
        val ONE  = Frac(1, 1)
    }

    constructor(n: Long, d: Long) {
        require(d != 0L)
        var nn = n
        var dd = d
        if (nn == 0L) {
            dd = 1
        }
        else if (dd < 0) {
            nn = -nn
            dd = -dd
        }
        val g = Math.abs(gcd(nn, dd))
        if (g > 1) {
            nn /= g
            dd /= g
        }
        num = nn
        denom = dd
    }

    constructor(n: Int, d: Int) : this(n.toLong(), d.toLong())

    operator fun plus(other: Frac) =
        Frac(num * other.denom + denom * other.num, other.denom * denom)

    operator fun unaryMinus() = Frac(-num, denom)

    operator fun minus(other: Frac) = this + (-other)

    operator fun times(other: Frac) = Frac(this.num * other.num, this.denom * other.denom)

    fun abs() = if (num >= 0) this else -this

    override fun compareTo(other: Frac): Int {
        val diff = this.toDouble() - other.toDouble()
        return when {
            diff < 0.0  -> -1
            diff > 0.0  -> +1
            else        ->  0
        }
    }

    override fun equals(other: Any?): Boolean {
       if (other == null || other !is Frac) return false
       return this.compareTo(other) == 0
    }

    override fun toString() = if (denom == 1L) "$num" else "$num/$denom"

    fun toDouble() = num.toDouble() / denom

    fun toBigDecimal() = BigDecimal(num).divide(BigDecimal(denom), mc)
}

fun bernoulli(n: Int): Frac {
    require(n >= 0)
    val a = Array(n + 1) { Frac.ZERO }
    for (m in 0..n) {
        a[m] = Frac(1, m + 1)
        for (j in m downTo 1) a[j - 1] = (a[j - 1] - a[j]) * Frac(j, 1)
    }
    return if (n != 1) a[0] else -a[0] // returns 'first' Bernoulli number
}

fun binomial(n: Int, k: Int): Long {
    require(n >= 0 && k >= 0 && n >= k)
    if (n == 0 || k == 0) return 1
    val num = (k + 1..n).fold(1L) { acc, i -> acc * i }
    val den = (2..n - k).fold(1L) { acc, i -> acc * i }
    return num / den
}

fun faulhaberTriangle(p: Int): Array<Frac> {
    val coeffs = Array(p + 1) { Frac.ZERO }
    val q = Frac(1, p + 1)
    var sign = -1
    for (j in 0..p) {
        sign *= -1
        coeffs[p - j] = q * Frac(sign, 1) * Frac(binomial(p + 1, j), 1) * bernoulli(j)
    }
    return coeffs
}

fun main(args: Array<String>) {
    for (i in 0..9){
        val coeffs = faulhaberTriangle(i)
        for (coeff in coeffs) print("${coeff.toString().padStart(5)}  ")
        println()
    }
    println()
    // get coeffs for (k + 1)th row
    val k = 17
    val cc = faulhaberTriangle(k)
    val n = 1000
    val nn  = BigDecimal(n)
    var np  = BigDecimal.ONE
    var sum = BigDecimal.ZERO
    for (c in cc) {
        np *= nn
        sum += np * c.toBigDecimal()
    }
    println(sum.toBigInteger())
}


with javascript_semantics
include builtins\pfrac.e -- (0.8.0+)

function bernoulli(integer n)
    sequence a = {}
    for m=0 to n do
        a = append(a,{1,m+1})
        for j=m to 1 by -1 do
            a[j] = frac_mul({j,1},frac_sub(a[j+1],a[j]))
        end for
    end for
    if n!=1 then return a[1] end if
    return frac_uminus(a[1])
end function

function binomial(integer n, k)
    if n<0 or k<0 or n<k then ?9/0 end if
    if n=0 or k=0 then return 1 end if
    integer num = 1,
            denom = 1
    for i=k+1 to n do
        num *= i
    end for
    for i=2 to n-k do
        denom *= i
    end for
    return num / denom
end function

procedure faulhaber(integer p)
    string res = sprintf("%d : ", p)
    frac q = {1, p+1}
    for j=0 to p do
        frac bj = bernoulli(j)
        if frac_ne(bj,frac_zero) then
            frac coeff = frac_mul({binomial(p+1,j),p+1},bj)
            string s = frac_sprint(coeff)
            if j=0 then
                if s="1" then
                    s = ""
                end if
            else
                if s[1]='-' then
                    s[1..1] = " - "
                else
                    s[1..0] = " + "
                end if
            end if
            res &= s&"n"
            integer pwr = p+1-j
            if pwr>1 then
                res &= sprintf("^%d", pwr)
            end if
        end if
    end for
    printf(1,"%s\n",{res})
end procedure

for i=0 to 9 do
    faulhaber(i)
end for


function binomial(n,k)
    if n<0 or k<0 or n<k then return -1 end
    if n==0 or k==0 then return 1 end

    local num = 1
    for i=k+1,n do
        num = num * i
    end

    local denom = 1
    for i=2,n-k do
        denom = denom * i
    end

    return num / denom
end

function gcd(a,b)
    while b ~= 0 do
        local temp = a % b
        a = b
        b = temp
    end
    return a
end

function makeFrac(n,d)
    local result = {}

    if d==0 then
        result.num = 0
        result.denom = 0
        return result
    end

    if n==0 then
        d = 1
    elseif d < 0 then
        n = -n
        d = -d
    end

    local g = math.abs(gcd(n, d))
    if g>1 then
        n = n / g
        d = d / g
    end

    result.num = n
    result.denom = d
    return result
end

function negateFrac(f)
    return makeFrac(-f.num, f.denom)
end

function subFrac(lhs, rhs)
    return makeFrac(lhs.num * rhs.denom - lhs.denom * rhs.num, rhs.denom * lhs.denom)
end

function multFrac(lhs, rhs)
    return makeFrac(lhs.num * rhs.num, lhs.denom * rhs.denom)
end

function equalFrac(lhs, rhs)
    return (lhs.num == rhs.num) and (lhs.denom == rhs.denom)
end

function lessFrac(lhs, rhs)
    return (lhs.num * rhs.denom) < (rhs.num * lhs.denom)
end

function printFrac(f)
    local str = tostring(f.num)
    if f.denom ~= 1 then
        str = str.."/"..f.denom
    end
    for i=1, 7 - string.len(str) do
        io.write(" ")
    end
    io.write(str)
    return nil
end

function bernoulli(n)
    if n<0 then
        return {num=0, denom=0}
    end

    local a = {}
    for m=0,n do
        a[m] = makeFrac(1, m+1)
        for j=m,1,-1 do
            a[j-1] = multFrac(subFrac(a[j-1], a[j]), makeFrac(j, 1))
        end
    end

    if n~=1 then
        return a[0]
    end
    return negateFrac(a[0])
end

function faulhaber(p)
    local q = makeFrac(1, p+1)
    local sign = -1
    local coeffs = {}
    for j=0,p do
        sign = -1 * sign
        coeffs[p-j] = multFrac(multFrac(multFrac(q, makeFrac(sign, 1)), makeFrac(binomial(p + 1, j), 1)), bernoulli(j))
    end
    for j=0,p do
        printFrac(coeffs[j])
    end
    print()
    return nil
end

-- main
for i=0,9 do
    faulhaber(i)
end


from fractions import Fraction

def nextu(a):
    n = len(a)
    a.append(1)
    for i in range(n - 1, 0, -1):
        a[i] = i * a[i] + a[i - 1]
    return a

def nextv(a):
    n = len(a) - 1
    b = [(1 - n) * x for x in a]
    b.append(1)
    for i in range(n):
        b[i + 1] += a[i]
    return b

def sumpol(n):
    u = [0, 1]
    v = [[1], [1, 1]]
    yield [Fraction(0), Fraction(1)]
    for i in range(1, n):
        v.append(nextv(v[-1]))
        t = [0] * (i + 2)
        p = 1
        for j, r in enumerate(u):
            r = Fraction(r, j + 1)
            for k, s in enumerate(v[j + 1]):
                t[k] += r * s
        yield t
        u = nextu(u)

def polstr(a):
    s = ""
    q = False
    n = len(a) - 1
    for i, x in enumerate(reversed(a)):
        i = n - i
        if i < 2:
            m = "n" if i == 1 else ""
        else:
            m = "n^%d" % i
        c = str(abs(x))
        if i > 0:
            if c == "1":
                c = ""
            else:
                m = " " + m
        if x != 0:
            if q:
                t = " + " if x > 0 else " - "
                s += "%s%s%s" % (t, c, m)
            else:
                t = "" if x > 0 else "-"
                s = "%s%s%s" % (t, c, m)
                q = True
    if q:
        return s
    else:
        return "0"

for i, p in enumerate(sumpol(10)):
    print(i, ":", polstr(p))


ClearAll[Faulhaber]
bernoulliB[1] := 1/2
bernoulliB[n_] := BernoulliB[n]
Faulhaber[n_, p_] := 1/(p + 1) Sum[Binomial[p + 1, j] bernoulliB[j] n^(p + 1 - j), {j, 0, p}]
Table[[email protected][Faulhaber[n, t], n], {t, 0, 9}] // Grid
Faulhaber[1000, 17]


import algorithm, math, strutils
import bignum

type FaulhaberSequence = seq[Rat]

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

func bernoulli(n: Natural): Rat =
  ## Return nth Bernoulli coefficient.

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

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

func faulhaber(n: Natural): FaulhaberSequence =
  ## Return nth Faulhaber sequence (high degree first).

  var a = newRat(1, n + 1)
  var sign = -1
  for k in 0..n:
    sign = -sign
    result.add(a * sign * binom(n + 1, k) * bernoulli(k))

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

proc display(fs: FaulhaberSequence) =
  ## Return the string representing a Faulhaber sequence.

  var str = ""
  for i, coeff in reversed(fs):
    str.addSep(" ", 0)
    str.add(($coeff).align(6))
  echo str

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

func evaluate(fs: FaulhaberSequence; n: int): Rat =
  ## Evaluate the polynomial associated to a sequence for value "n".

  result = newRat(0)
  for coeff in fs:
    result = result * n + coeff
  result *= n

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

for n in 0..9:
  display(faulhaber(n))

echo ""
let fs18 = faulhaber(17)  # 18th row.
echo fs18.evaluate(1000)


program FaulhaberTriangle;
uses uIntX, uEnums, // units in the library IntXLib4Pascal
     SysUtils;

// Convert a rational num/den to a string, right-justified in the given width.
// Before converting, remove any common factor of num and den.
// For this application we can assume den > 0.
function RationalToString( num, den : TIntX;
                           minWidth : integer) : string;
var
  num1, den1, divisor : TIntX;
  w : integer;
begin
  divisor := TIntX.GCD( num, den);
  // TIntx.Divide requires the caller to specifiy the division mode
  num1 := TIntx.Divide( num, divisor, uEnums.dmClassic);
  den1 := TIntx.Divide( den, divisor, uEnums.dmClassic);
  result := num1.ToString;
  if not den1.IsOne then result := result + '/' + den1.ToString;
  w := minWidth - Length( result);
  if (w > 0) then result := StringOfChar(' ', w) + result;
end;

// Main routine
const
  r_MAX = 17;
var
  g : array [1..r_MAX + 1] of TIntX;
  r, s, k : integer;
  r_1_fac, sum, k_intx : TIntX;
begin
  // Calculate rows 0..17 of Faulhaner's triangle, and show rows 0..9.
  // For a given r, the subarray g[1..(r+1)] contains (r + 1)! times row r.
  r_1_fac := 1; // (r + 1)!
  g[1] := 1;
  for r := 0 to r_MAX do begin
    r_1_fac := r_1_fac * (r+1);
    sum := 0;
    for s := r downto 1 do begin
      g[s + 1] := r*(r+1)*g[s] div (s+1);
      sum := sum + g[s + 1];
    end;
    g[1] := r_1_fac - sum; // the scaled row must sum to (r + 1)!
    if (r <= 9) then begin
      for s := 1 to r + 1 do Write( RationalToString( g[s], r_1_fac, 7));
      WriteLn;
    end;
  end;

  // Use row 17 to sum 17th powers from 1 to 1000
  sum := 0;
  for s := r_MAX + 1 downto 1 do sum := (sum + g[s]) * 1000;
  sum := TIntx.Divide( sum, r_1_fac, uEnums.dmClassic);
  WriteLn;
  WriteLn( 'Sum by Faulhaber = ' + sum.ToString);

  // Check by direct calculation
  sum := 0;
  for k := 1 to 1000 do begin
    k_intx := k;
    sum := sum + TIntX.Pow( k_intx, r_MAX);
  end;
  WriteLn( 'by direct calc.  = ' + sum.ToString);
end.


#lang racket/base

(require racket/match
         racket/string
         math/number-theory)

(define simplify-arithmetic-expression
  (letrec ((s-a-e
            (match-lambda
              [(list (and op '+) l ... (list '+ m ...) r ...) (s-a-e `(,op ,@l ,@m ,@r))]
              [(list (and op '+) l ... (? number? n1) m ... (? number? n2) r ...) (s-a-e `(,op ,@l ,(+ n1 n2) ,@m ,@r))]
              [(list (and op '+) (app s-a-e l _) ... 0 (app s-a-e r _) ...) (s-a-e `(,op ,@l ,@r))]
              [(list (and op '+) (app s-a-e x _)) (values x #t)]
              [(list (and op '*) l ... (list '* m ...) r ...) (s-a-e `(,op ,@l ,@m ,@r))]
              [(list (and op '*) l ... (? number? n1) m ... (? number? n2) r ...) (s-a-e `(,op ,@l ,(* n1 n2) ,@m ,@r))]
              [(list (and op '*) (app s-a-e l _) ... 1 (app s-a-e r _) ...) (s-a-e `(,op ,@l ,@r))]
              [(list (and op '*) (app s-a-e l _) ... 0 (app s-a-e r _) ...) (values 0 #t)]
              [(list (and op '*) (app s-a-e x _)) (values x #t)]
              [(list 'expt (app s-a-e x x-simplified?) 1) (values x x-simplified?)]
              [(list op (app s-a-e a #f) ...) (values `(,op ,@a) #f)]
              [(list op (app s-a-e a _) ...) (s-a-e `(,op ,@a))]
              [e (values e #f)])))
    s-a-e))

(define (expression->infix-string e)
  (define (parenthesise-maybe s p?)
    (if p? (string-append "(" s ")") s))

  (letrec ((e->is
            (lambda (paren?)
              (match-lambda
                [(list (and op (or '+ '- '* '*)) (app (e->is #t) a p?) ...)
                 (define bits (map parenthesise-maybe a p?))
                 (define compound (string-join bits (format " ~a " op)))
                 (values (if paren? (string-append "(" compound ")") compound) #f)]
                [(list 'expt (app (e->is #t) x xp?) (app (e->is #t) n np?))
                 (values (format "~a^~a" (parenthesise-maybe x xp?) (parenthesise-maybe n np?)) #f)]
                [(? number? (app number->string s)) (values s #f)]
                [(? symbol? (app symbol->string s)) (values s #f)]))))
    (define-values (str needs-parens?) ((e->is #f) e))
    str))

(define (faulhaber p)
  (define p+1 (add1 p))
  (define-values (simpler simplified?)
    (simplify-arithmetic-expression
     `(* ,(/ 1 p+1)
         (+ ,@(for/list ((j (in-range p+1)))
                `(* ,(* (expt -1 j)
                        (binomial p+1 j))
                    (* ,(bernoulli-number j)
                       (expt n ,(- p+1 j)))))))))
  simpler)

(for ((p (in-range 0 (add1 9))))
  (printf "f(~a) = ~a~%" p (expression->infix-string (faulhaber p))))


use 5.010;
use List::Util qw(sum);
use Math::BigRat try => 'GMP';
use ntheory qw(binomial bernfrac);

sub faulhaber_triangle {
    my ($p) = @_;
    map {
        Math::BigRat->new(bernfrac($_))
          * binomial($p, $_)
          / $p
    } reverse(0 .. $p-1);
}

# First 10 rows of Faulhaber's triangle
foreach my $p (1 .. 10) {
    say map { sprintf("%6s", $_) } faulhaber_triangle($p);
}

# Extra credit
my $p = 17;
my $n = Math::BigInt->new(1000);
my @r = faulhaber_triangle($p+1);
say "\n", sum(map { $r[$_] * $n**($_ + 1) } 0 .. $#r);


with javascript_semantics
include builtins\pfrac.e -- (0.8.0+)

function bernoulli(integer n)
    sequence a = {}
    for m=0 to n do
        a = append(a,{1,m+1})
        for j=m to 1 by -1 do
            a[j] = frac_mul({j,1},frac_sub(a[j+1],a[j]))
        end for
    end for
    if n!=1 then return a[1] end if
    return frac_uminus(a[1])
end function

function binomial(integer n, k)
    if n<0 or k<0 or n<k then ?9/0 end if
    if n=0 or k=0 then return 1 end if
    atom num = 1,
         denom = 1
    for i=k+1 to n do
        num *= i
    end for
    for i=2 to n-k do
        denom *= i
    end for
    return num / denom
end function

function faulhaber_triangle(integer p, bool asString=true)
    sequence coeffs = repeat(frac_zero,p+1)
    for j=0 to p do
        frac coeff = frac_mul({binomial(p+1,j),p+1},bernoulli(j))
        coeffs[p-j+1] = iff(asString?sprintf("%5s",{frac_sprint(coeff)}):coeff)
    end for
    return coeffs
end function

for i=0 to 9 do
    printf(1,"%s\n",{join(faulhaber_triangle(i),"  ")})
end for
puts(1,"\n")

if platform()!=JS then
    sequence row18 = faulhaber_triangle(17,false)
    frac res = frac_zero
    atom t1 = time()+1
    integer lim = 1000
    for k=1 to lim do
        bigatom nn = BA_ONE
        for i=1 to length(row18) do
            res = frac_add(res,frac_mul(row18[i],{nn,1}))
            nn = ba_mul(nn,lim)
        end for
        if time()>t1 then printf(1,"calculating, k=%d...\r",k) t1 = time()+1 end if
    end for
    printf(1,"%s        \n",{frac_sprint(res)})
end if


def binomial(n,k)
    if n < 0 or k < 0 or n < k then
        return -1
    end
    if n == 0 or k == 0 then
        return 1
    end

    num = 1
    for i in k+1 .. n do
        num = num * i
    end

    denom = 1
    for i in 2 .. n-k do
        denom = denom * i
    end

    return num / denom
end

def bernoulli(n)
    if n < 0 then
        raise "n cannot be less than zero"
    end

    a = Array.new(16)
    for m in 0 .. n do
        a[m] = Rational(1, m + 1)
        for j in m.downto(1) do
            a[j-1] = (a[j-1] - a[j]) * Rational(j)
        end
    end

    if n != 1 then
        return a[0]
    end
    return -a[0]
end

def faulhaber(p)
    print("%d : " % [p])
    q = Rational(1, p + 1)
    sign = -1
    for j in 0 .. p do
        sign = -1 * sign
        coeff = q * Rational(sign) * Rational(binomial(p+1, j)) * bernoulli(j)
        if coeff == 0 then
            next
        end
        if j == 0 then
            if coeff != 1 then
                if coeff == -1 then
                    print "-"
                else
                    print coeff
                end
            end
        else
            if coeff == 1 then
                print " + "
            elsif coeff == -1 then
                print " - "
            elsif 0 < coeff then
                print " + "
                print coeff
            else
                print " - "
                print -coeff
            end
        end
        pwr = p + 1 - j
        if pwr > 1 then
            print "n^%d" % [pwr]
        else
            print "n"
        end
    end
    print "\n"
end

def main
    for i in 0 .. 9 do
        faulhaber(i)
    end
end

main()


ft_rows(Lz) :-
    lazy_list(ft_row, [], Lz).

ft_row([], R1, R1) :- R1 = [1].
ft_row(R0, R2, R2) :-
    length(R0, P),
    Jmax is 1 + P, numlist(2, Jmax, Qs),
    maplist(term(P), Qs, R0, R1),
    sum_list(R1, S), Bk is 1 - S, % Bk is Bernoulli number
    R2 = [Bk | R1].

term(P, Q, R, S) :- S is R * (P rdiv Q).

show(N) :-
    ft_rows(Rs),
    length(Rows, N), prefix(Rows, Rs),
    forall(
        member(R, Rows),
            (format(string(S), "~w", [R]),
             re_replace(" rdiv "/g, "/", S, T),
             re_replace(","/g, ", ", T, U),
             write(U), nl)).

sum(N, K, S) :- % sum I=1,N (I ** K)
    ft_rows(Rows), drop(K, Rows, [Coefs|_]),
    reverse([0|Coefs], Poly),
    foldl(horner(N), Poly, 0, S).

horner(N, A, S0, S1) :-
    S1 is N*S0 + A.

drop(N, Lz1, Lz2) :-
    append(Pfx, Lz2, Lz1), length(Pfx, N), !.


import scala.math.Ordering.Implicits.infixOrderingOps

abstract class Frac extends Comparable[Frac] {
  val num: BigInt
  val denom: BigInt

  def unary_-(): Frac = {
    Frac(-num, denom)
  }

  def +(rhs: Frac): Frac = {
    Frac(
      num * rhs.denom + rhs.num * denom,
      denom * rhs.denom
    )
  }

  def -(rhs: Frac): Frac = {
    Frac(
      num * rhs.denom - rhs.num * denom,
      denom * rhs.denom
    )
  }

  def *(rhs: Frac): Frac = {
    Frac(num * rhs.num, denom * rhs.denom)
  }

  override def compareTo(rhs: Frac): Int = {
    val ln = num * rhs.denom
    val rn = rhs.num * denom
    ln.compare(rn)
  }

  def canEqual(other: Any): Boolean = other.isInstanceOf[Frac]

  override def equals(other: Any): Boolean = other match {
    case that: Frac =>
      (that canEqual this) &&
        num == that.num &&
        denom == that.denom
    case _ => false
  }

  override def hashCode(): Int = {
    val state = Seq(num, denom)
    state.map(_.hashCode()).foldLeft(0)((a, b) => 31 * a + b)
  }

  override def toString: String = {
    if (denom == 1) {
      return s"$num"
    }
    s"$num/$denom"
  }
}

object Frac {
  val ZERO: Frac = Frac(0)
  val ONE: Frac = Frac(1)

  def apply(n: BigInt): Frac = new Frac {
    val num: BigInt = n
    val denom: BigInt = 1
  }

  def apply(n: BigInt, d: BigInt): Frac = {
    if (d == 0) {
      throw new IllegalArgumentException("Parameter d may not be zero.")
    }

    var nn = n
    var dd = d

    if (nn == 0) {
      dd = 1
    } else if (dd < 0) {
      nn = -nn
      dd = -dd
    }

    val g = nn.gcd(dd)
    if (g > 0) {
      nn /= g
      dd /= g
    }

    new Frac {
      val num: BigInt = nn
      val denom: BigInt = dd
    }
  }
}

object Faulhaber {
  def bernoulli(n: Int): Frac = {
    if (n < 0) {
      throw new IllegalArgumentException("n may not be negative or zero")
    }

    val a = Array.fill(n + 1)(Frac.ZERO)
    for (m <- 0 to n) {
      a(m) = Frac(1, m + 1)
      for (j <- m to 1 by -1) {
        a(j - 1) = (a(j - 1) - a(j)) * Frac(j)
      }
    }

    // returns 'first' Bernoulli number
    if (n != 1) {
      return a(0)
    }
    -a(0)
  }

  def binomial(n: Int, k: Int): Int = {
    if (n < 0 || k < 0 || n < k) {
      throw new IllegalArgumentException()
    }
    if (n == 0 || k == 0) {
      return 1
    }
    val num = (k + 1 to n).product
    val den = (2 to n - k).product
    num / den
  }

  def faulhaber(p: Int): Unit = {
    print(s"$p : ")
    val q = Frac(1, p + 1)
    var sign = -1
    for (j <- 0 to p) {
      sign *= -1
      val coeff = q * Frac(sign) * Frac(binomial(p + 1, j)) * bernoulli(j)
      if (Frac.ZERO != coeff) {
        if (j == 0) {
          if (Frac.ONE != coeff) {
            if (-Frac.ONE == coeff) {
              print('-')
            } else {
              print(coeff)
            }
          }
        } else {
          if (Frac.ONE == coeff) {
            print(" + ")
          } else if (-Frac.ONE == coeff) {
            print(" - ")
          } else if (coeff > Frac.ZERO) {
            print(s" + ${coeff}")
          } else {
            print(s" - ${-coeff}")
          }
        }
        val pwr = p + 1 - j
        if (pwr > 1) {
          print(s"n^${pwr}")
        } else {
          print('n')
        }
      }
    }
    println()
  }

  def main(args: Array[String]): Unit = {
    for (i <- 0 to 9) {
      faulhaber(i)
    }
  }
}


'''Faulhaber's triangle'''

from itertools import accumulate, chain, count, islice
from fractions import Fraction

# faulhaberTriangle :: Int -> [[Fraction]]
def faulhaberTriangle(m):
    '''List of rows of Faulhaber fractions.'''
    def go(rs, n):
        def f(x, y):
            return Fraction(n, x) * y
        xs = list(map(f, islice(count(2), m), rs))
        return [Fraction(1 - sum(xs), 1)] + xs

    return list(accumulate(
        [[]] + list(islice(count(0), 1 + m)),
        go
    ))[1:]

# faulhaberSum :: Integer -> Integer -> Integer
def faulhaberSum(p, n):
    '''Sum of the p-th powers of the first n
       positive integers.
    '''
    def go(x, y):
        return y * (n ** x)

    return sum(
        map(go, count(1), faulhaberTriangle(p)[-1])
    )

# ------------------------- TEST -------------------------
def main():
    '''Tests'''

    fs = faulhaberTriangle(9)
    print(
        fTable(__doc__ + ':\n')(str)(
            compose(concat)(
                fmap(showRatio(3)(3))
            )
        )(
            index(fs)
        )(range(0, len(fs)))
    )
    print('')
    print(
        faulhaberSum(17, 1000)
    )

# ----------------------- DISPLAY ------------------------

# fTable :: String -> (a -> String) ->
# (b -> String) -> (a -> b) -> [a] -> String
def fTable(s):
    '''Heading -> x display function ->
       fx display function -> f -> xs -> tabular string.
    '''
    def gox(xShow):
        def gofx(fxShow):
            def gof(f):
                def goxs(xs):
                    ys = [xShow(x) for x in xs]
                    w = max(map(len, ys))

                    def arrowed(x, y):
                        return y.rjust(w, ' ') + ' -> ' + (
                            fxShow(f(x))
                        )
                    return s + '\n' + '\n'.join(
                        map(arrowed, xs, ys)
                    )
                return goxs
            return gof
        return gofx
    return gox

# ----------------------- GENERIC ------------------------

# compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
def compose(g):
    '''Right to left function composition.'''
    return lambda f: lambda x: g(f(x))

# concat :: [[a]] -> [a]
# concat :: [String] -> String
def concat(xs):
    '''The concatenation of all the elements
       in a list or iterable.
    '''
    def f(ys):
        zs = list(chain(*ys))
        return ''.join(zs) if isinstance(ys[0], str) else zs

    return (
        f(xs) if isinstance(xs, list) else (
            chain.from_iterable(xs)
        )
    ) if xs else []

# fmap :: (a -> b) -> [a] -> [b]
def fmap(f):
    '''fmap over a list.
       f lifted to a function over a list.
    '''
    def go(xs):
        return list(map(f, xs))

    return go

# index (!!) :: [a] -> Int -> a
def index(xs):
    '''Item at given (zero-based) index.'''
    return lambda n: None if 0 > n else (
        xs[n] if (
            hasattr(xs, "__getitem__")
        ) else next(islice(xs, n, None))
    )

# showRatio :: Int -> Int -> Ratio -> String
def showRatio(m):
    '''Left and right aligned string
       representation of the ratio r.
    '''
    def go(n):
        def f(r):
            d = r.denominator
            return str(r.numerator).rjust(m, ' ') + (
                ('/' + str(d).ljust(n, ' ')) if 1 != d else (
                    ' ' * (1 + n)
                )
            )
        return f
    return go

# MAIN ---
if __name__ == '__main__':
    main()


const AnyNum = require('Math::AnyNum')
const Poly   = require('Math::Polynomial')

Poly.string_config(Hash(
    fold_sign => true, prefix => "",
    suffix => "", variable => "n"
))

func anynum(n) {
    AnyNum.new(n.as_rat)
}

func faulhaber_formula(p) {
    (p+1).of { |j|
        Poly.monomial(p - j + 1)\
            .mul_const(anynum(bernoulli(j)))\
            .mul_const(anynum(binomial(p+1, j)))
    }.reduce(:add).div_const(p+1)
}

for p in (^10) {
    printf("%2d: %s\n", p, faulhaber_formula(p))
}


Module Module1
    Function Gcd(a As Long, b As Long)
        If b = 0 Then
            Return a
        End If
        Return Gcd(b, a Mod b)
    End Function

    Class Frac
        ReadOnly num As Long
        ReadOnly denom As Long

        Public Shared ReadOnly ZERO As New Frac(0, 1)
        Public Shared ReadOnly ONE As New Frac(1, 1)

        Public Sub New(n As Long, d As Long)
            If d = 0 Then Throw New ArgumentException("d must not be zero")
            Dim nn = n
            Dim dd = d
            If nn = 0 Then
                dd = 1
            ElseIf dd < 0 Then
                nn = -nn
                dd = -dd
            End If
            Dim g = Math.Abs(Gcd(nn, dd))
            If g > 1 Then
                nn /= g
                dd /= g
            End If
            num = nn
            denom = dd
        End Sub

        Public Shared Operator -(self As Frac) As Frac
            Return New Frac(-self.num, self.denom)
        End Operator

        Public Shared Operator +(lhs As Frac, rhs As Frac) As Frac
            Return New Frac(lhs.num * rhs.denom + lhs.denom * rhs.num, rhs.denom * lhs.denom)
        End Operator

        Public Shared Operator -(lhs As Frac, rhs As Frac) As Frac
            Return lhs + -rhs
        End Operator

        Public Shared Operator *(lhs As Frac, rhs As Frac) As Frac
            Return New Frac(lhs.num * rhs.num, lhs.denom * rhs.denom)
        End Operator

        Public Shared Operator <(lhs As Frac, rhs As Frac) As Boolean
            Dim x = lhs.num / lhs.denom
            Dim y = rhs.num / rhs.denom
            Return x < y
        End Operator

        Public Shared Operator >(lhs As Frac, rhs As Frac) As Boolean
            Dim x = lhs.num / lhs.denom
            Dim y = rhs.num / rhs.denom
            Return x > y
        End Operator

        Public Shared Operator =(lhs As Frac, rhs As Frac) As Boolean
            Return lhs.num = rhs.num AndAlso lhs.denom = rhs.denom
        End Operator

        Public Shared Operator <>(lhs As Frac, rhs As Frac) As Boolean
            Return lhs.num <> rhs.num OrElse lhs.denom <> rhs.denom
        End Operator

        Public Overloads Function Equals(obj As Object) As Boolean
            Dim frac = CType(obj, Frac)
            Return Not IsNothing(frac) AndAlso num = frac.num AndAlso denom = frac.denom
        End Function

        Public Overloads Function GetHashCode() As Integer
            Dim hashCode = 1317992671
            hashCode = hashCode * -1521134295 + num.GetHashCode()
            hashCode = hashCode * -1521134295 + denom.GetHashCode()
            Return hashCode
        End Function

        Public Overloads Function ToString() As String
            If denom = 1 Then Return num.ToString()
            Return String.Format("{0}/{1}", num, denom)
        End Function
    End Class

    Function Bernoulli(n As Integer) As Frac
        If n < 0 Then Throw New ArgumentException("n may not be negative or zero")
        Dim a(n + 1) As Frac
        For m = 0 To n
            a(m) = New Frac(1, m + 1)
            For j = m To 1 Step -1
                a(j - 1) = (a(j - 1) - a(j)) * New Frac(j, 1)
            Next
        Next
        'returns the first Bernoulli number
        If n <> 1 Then Return a(0)
        Return -a(0)
    End Function

    Function Binomial(n As Integer, k As Integer) As Integer
        If n < 0 OrElse k < 0 OrElse n < k Then
            Throw New ArgumentException()
        End If
        If n = 0 OrElse k = 0 Then
            Return 1
        End If
        Dim num = 1
        For i = k + 1 To n
            num *= i
        Next
        Dim denom = 1
        For i = 2 To n - k
            denom *= i
        Next
        Return num / denom
    End Function

    Sub Faulhaber(p As Integer)
        Console.Write("{0} : ", p)
        Dim q As New Frac(1, p + 1)
        Dim sign = -1
        For j = 0 To p
            sign *= -1
            Dim coeff = q * New Frac(sign, 1) * New Frac(Binomial(p + 1, j), 1) * Bernoulli(j)
            If Frac.ZERO = coeff Then Continue For
            If j = 0 Then
                If Frac.ONE <> coeff Then
                    If -Frac.ONE = coeff Then
                        Console.Write("-")
                    Else
                        Console.Write(coeff.ToString())
                    End If
                End If
            Else
                If Frac.ONE = coeff Then
                    Console.Write(" + ")
                ElseIf -Frac.ONE = coeff Then
                    Console.Write(" - ")
                ElseIf Frac.ZERO < coeff Then
                    Console.Write(" + {0}", coeff.ToString())
                Else
                    Console.Write(" - {0}", (-coeff).ToString())
                End If
            End If
            Dim pwr = p + 1 - j
            If pwr > 1 Then
                Console.Write("n^{0}", pwr)
            Else
                Console.Write("n")
            End If
        Next
        Console.WriteLine()
    End Sub

    Sub Main()
        For i = 0 To 9
            Faulhaber(i)
        Next
    End Sub
End Module


#lang racket
(require math/number-theory)

(define (second-bernoulli-number n)
  (if (= n 1) 1/2 (bernoulli-number n)))

(define (faulhaber-row:formulaic p)
  (let ((p+1 (+ p 1)))
    (reverse
     (for/list ((j (in-range p+1)))
       (* (/ p+1) (second-bernoulli-number j) (binomial p+1 j))))))

(define (sum-k^p:formulaic p n)
  (for/sum ((f (faulhaber-row:formulaic p)) (i (in-naturals 1)))
    (* f (expt n i))))

(module+ main
  (map faulhaber-row:formulaic (range 10))
  (sum-k^p:formulaic 17 1000))

(module+ test
  (require rackunit)
  (check-equal? (sum-k^p:formulaic 17 1000)
                (for/sum ((k (in-range 1 (add1 1000)))) (expt k 17))))


# Helper subs

sub infix:<reduce> (\prev, \this) { this.key => this.key * (this.value - prev.value) }

sub next-bernoulli ( (:key($pm), :value(@pa)) ) {
    $pm + 1 => [ map *.value, [\reduce] ($pm + 2 ... 1) Z=> 1 / ($pm + 2), |@pa ]
}

constant bernoulli = (0 => [1.FatRat], &next-bernoulli ... *).map: { .value[*-1] };

sub binomial (Int $n, Int $p) { combinations($n, $p).elems }

sub asRat (FatRat $r) { $r ?? $r.denominator == 1 ?? $r.numerator !! $r.nude.join('/') !! 0 }

# The task
sub faulhaber_triangle ($p) { map { binomial($p + 1, $_) * bernoulli[$_] / ($p + 1) }, ($p ... 0) }

# First 10 rows of Faulhaber's triangle:
say faulhaber_triangle($_)».&asRat.fmt('%5s') for ^10;
say '';

# Extra credit:
my $p = 17;
my $n = 1000;
say sum faulhaber_triangle($p).kv.map: { $^value * $n**($^key + 1) }


import "/math" for Int
import "/rat" for Rat

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] = Rat.new(1, m+1)
        var j = m
        while (j >= 1) {
            a[j-1] = (a[j-1] - a[j]) * Rat.new(j, 1)
            j = j - 1
        }
    }
    return (n != 1) ? a[0] : -a[0] // 'first' Bernoulli number
}

var binomial = Fn.new { |n, k|
    if (n < 0 || k < 0) Fiber.abort("Arguments must be non-negative integers")
    if (n < k) Fiber.abort("The second argument cannot be more than the first.")
    if (n == k) return 1
    var prod = 1
    var i = n - k + 1
    while (i <= n) {
        prod = prod * i
        i = i + 1
    }
    return prod / Int.factorial(k)
}

var faulhaber = Fn.new { |p|
    System.write("%(p) : ")
    var q = Rat.new(1, p+1)
    var sign = -1
    for (j in 0..p) {
        sign = sign * -1
        var b = Rat.new(binomial.call(p+1, j), 1)
        var coeff = q * Rat.new(sign, 1) * b * bernoulli.call(j)
        if (coeff != Rat.zero) {
            if (j == 0) {
                System.write((coeff == Rat.one) ? "" : (coeff == Rat.minusOne) ? "-" : "%(coeff)")
            } else {
                System.write((coeff == Rat.one) ? " + " : (coeff == Rat.minusOne) ? " - " :
                             (coeff > Rat.zero) ? " + %(coeff)" : " - %(-coeff)")
            }
            var pwr = p + 1 - j
            System.write((pwr > 1) ? "n^%(pwr)" : "n")
        }
    }
    System.print()
}

for (i in 0..9) faulhaber.call(i)


Numeric Digits 100
Do r=0 To 20
  ra=r-1
  If r=0 Then
    f.r.1=1
  Else Do
    rsum=0
    Do c=2 To r+1
      ca=c-1
      f.r.c=fdivide(fmultiply(f.ra.ca,r),c)
      rsum=fsum(rsum,f.r.c)
      End
    f.r.1=fsubtract(1,rsum)
    End
  End
Do r=0 To 9
  ol=''
  Do c=1 To r+1
    ol=ol right(f.r.c,5)
    End
  Say ol
  End
Say ''
x=0
Do c=1 To 18
  x=fsum(x,fmultiply(f.17.c,(1000**c)))
  End
Say k(x)
s=0
Do k=1 To 1000
  s=s+k**17
  End
Say s
Exit

fmultiply: Procedure
Parse Arg a,b
Parse Var a ad '/' an
Parse Var b bd '/' bn
If an='' Then an=1
If bn='' Then bn=1
res=(abs(ad)*abs(bd))'/'||(an*bn)
Return s(ad,bd)k(res)

fdivide: Procedure
Parse Arg a,b
Parse Var a ad '/' an
Parse Var b bd '/' bn
If an='' Then an=1
If bn='' Then bn=1
res=s(ad,bd)(abs(ad)*bn)'/'||(an*abs(bd))
Return k(res)

fsum: Procedure
Parse Arg a,b
Parse Var a ad '/' an
Parse Var b bd '/' bn
If an='' Then an=1
If bn='' Then bn=1
n=an*bn
d=ad*bn+bd*an
res=d'/'n
Return k(res)

fsubtract: Procedure
Parse Arg a,b
Parse Var a ad '/' an
Parse Var b bd '/' bn
If an='' Then an=1
If bn='' Then bn=1
n=an*bn
d=ad*bn-bd*an
res=d'/'n
Return k(res)

s: Procedure
Parse Arg ad,bd
s=sign(ad)*sign(bd)
If s<0 Then Return '-'
       Else Return ''

k: Procedure
Parse Arg a
Parse Var a ad '/' an
Select
  When ad=0 Then Return 0
  When an=1 Then Return ad
  Otherwise Do
    g=gcd(ad,an)
    ad=ad/g
    an=an/g
    Return ad'/'an
    End
  End

gcd: procedure
Parse Arg a,b
if b = 0 then return abs(a)
return gcd(b,a//b)


var [const] BN=Import("zklBigNum");	// libGMP (GNU MP Bignum Library)

fcn faulhaberFormula(p){  //-->(Rational,Rational...)
   [p..0,-1].pump(List(),'wrap(k){ B(k)*BN(p+1).binomial(k) })
   .apply('*(Rational(1,p+1)))
}


class Frac
    attr_accessor:num
    attr_accessor:denom

    def initialize(n,d)
        if d == 0 then
            raise ArgumentError.new('d cannot be zero')
        end

        nn = n
        dd = d
        if nn == 0 then
            dd = 1
        elsif dd < 0 then
            nn = -nn
            dd = -dd
        end

        g = nn.abs.gcd(dd.abs)
        if g > 1 then
            nn = nn / g
            dd = dd / g
        end

        @num = nn
        @denom = dd
    end

    def to_s
        if self.denom == 1 then
            return self.num.to_s
        else
            return "%d/%d" % [self.num, self.denom]
        end
    end

    def -@
        return Frac.new(-self.num, self.denom)
    end

    def +(rhs)
        return Frac.new(self.num * rhs.denom + self.denom * rhs.num, rhs.denom * self.denom)
    end
    def -(rhs)
        return Frac.new(self.num * rhs.denom - self.denom * rhs.num, rhs.denom * self.denom)
    end

    def *(rhs)
        return Frac.new(self.num * rhs.num, rhs.denom * self.denom)
    end
end

FRAC_ZERO = Frac.new(0, 1)
FRAC_ONE  = Frac.new(1, 1)

def bernoulli(n)
    if n < 0 then
        raise ArgumentError.new('n cannot be negative')
    end

    a = Array.new(n + 1)
    a[0] = FRAC_ZERO

    for m in 0 .. n do
        a[m] = Frac.new(1, m + 1)
        m.downto(1) do |j|
            a[j - 1] = (a[j - 1] - a[j]) * Frac.new(j, 1)
        end
    end

    if n != 1 then
        return a[0]
    end
    return -a[0]
end

def binomial(n, k)
    if n < 0 then
        raise ArgumentError.new('n cannot be negative')
    end
    if k < 0 then
        raise ArgumentError.new('k cannot be negative')
    end
    if n < k then
        raise ArgumentError.new('n cannot be less than k')
    end

    if n == 0 or k == 0 then
        return 1
    end

    num = 1
    for i in k + 1 .. n do
        num = num * i
    end

    den = 1
    for i in 2 .. n - k do
        den = den * i
    end

    return num / den
end

def faulhaberTriangle(p)
    coeffs = Array.new(p + 1)
    coeffs[0] = FRAC_ZERO
    q = Frac.new(1, p + 1)
    sign = -1
    for j in 0 .. p do
        sign = -sign
        coeffs[p - j] = q * Frac.new(sign, 1) * Frac.new(binomial(p + 1, j), 1) * bernoulli(j)
    end
    return coeffs
end

def main
    for i in 0 .. 9 do
        coeffs = faulhaberTriangle(i)
        coeffs.each do |coeff|
            print "%5s  " % [coeff]
        end
        puts
    end
end

main()


import java.math.MathContext

import scala.collection.mutable

abstract class Frac extends Comparable[Frac] {
  val num: BigInt
  val denom: BigInt

  def unary_-(): Frac = {
    Frac(-num, denom)
  }

  def +(rhs: Frac): Frac = {
    Frac(
      num * rhs.denom + rhs.num * denom,
      denom * rhs.denom
    )
  }

  def -(rhs: Frac): Frac = {
    Frac(
      num * rhs.denom - rhs.num * denom,
      denom * rhs.denom
    )
  }

  def *(rhs: Frac): Frac = {
    Frac(num * rhs.num, denom * rhs.denom)
  }

  override def compareTo(rhs: Frac): Int = {
    val ln = num * rhs.denom
    val rn = rhs.num * denom
    ln.compare(rn)
  }

  def canEqual(other: Any): Boolean = other.isInstanceOf[Frac]

  override def equals(other: Any): Boolean = other match {
    case that: Frac =>
      (that canEqual this) &&
        num == that.num &&
        denom == that.denom
    case _ => false
  }

  override def hashCode(): Int = {
    val state = Seq(num, denom)
    state.map(_.hashCode()).foldLeft(0)((a, b) => 31 * a + b)
  }

  override def toString: String = {
    if (denom == 1) {
      return s"$num"
    }
    s"$num/$denom"
  }
}

object Frac {
  val ZERO: Frac = Frac(0)
  val ONE: Frac = Frac(1)

  def apply(n: BigInt): Frac = new Frac {
    val num: BigInt = n
    val denom: BigInt = 1
  }

  def apply(n: BigInt, d: BigInt): Frac = {
    if (d == 0) {
      throw new IllegalArgumentException("Parameter d may not be zero.")
    }

    var nn = n
    var dd = d

    if (nn == 0) {
      dd = 1
    } else if (dd < 0) {
      nn = -nn
      dd = -dd
    }

    val g = nn.gcd(dd)
    if (g > 0) {
      nn /= g
      dd /= g
    }

    new Frac {
      val num: BigInt = nn
      val denom: BigInt = dd
    }
  }
}

object Faulhaber {
  def bernoulli(n: Int): Frac = {
    if (n < 0) {
      throw new IllegalArgumentException("n may not be negative or zero")
    }

    val a = Array.fill(n + 1)(Frac.ZERO)
    for (m <- 0 to n) {
      a(m) = Frac(1, m + 1)
      for (j <- m to 1 by -1) {
        a(j - 1) = (a(j - 1) - a(j)) * Frac(j)
      }
    }

    // returns 'first' Bernoulli number
    if (n != 1) {
      return a(0)
    }
    -a(0)
  }

  def binomial(n: Int, k: Int): Int = {
    if (n < 0 || k < 0 || n < k) {
      throw new IllegalArgumentException()
    }
    if (n == 0 || k == 0) {
      return 1
    }
    val num = (k + 1 to n).product
    val den = (2 to n - k).product
    num / den
  }

  def faulhaberTriangle(p: Int): List[Frac] = {
    val coeffs = mutable.MutableList.fill(p + 1)(Frac.ZERO)

    val q = Frac(1, p + 1)
    var sign = -1
    for (j <- 0 to p) {
      sign *= -1
      coeffs(p - j) = q * Frac(sign) * Frac(binomial(p + 1, j)) * bernoulli(j)
    }
    coeffs.toList
  }

  def main(args: Array[String]): Unit = {
    for (i <- 0 to 9) {
      val coeffs = faulhaberTriangle(i)
      for (coeff <- coeffs) {
        print("%5s  ".format(coeff))
      }
      println()
    }
    println()
  }
}


; Return the first row-count rows of Faulhaber's Triangle as a vector of vectors.
(define faulhabers-triangle
  (lambda (row-count)
    ; Calculate and store the value of the first column of a row.
    ; The value is one minus the sum of all the rest of the columns.
    (define calc-store-first!
      (lambda (row)
        (vector-set! row 0
          (do ((col-inx 1 (1+ col-inx))
               (col-sum 0 (+ col-sum (vector-ref row col-inx))))
              ((>= col-inx (vector-length row)) (- 1 col-sum))))))
    ; Generate the Faulhaber's Triangle one row at a time.
    ; The element at row i >= 0, column j >= 1 (both 0-based) is the product
    ; of the element at i - 1, j - 1 and the fraction ( i / ( j + 1 ) ).
    ; The element at column 0 is one minus the sum of all the rest of the columns.
    (let ((tri (make-vector row-count)))
      (do ((row-inx 0 (1+ row-inx)))
          ((>= row-inx row-count) tri)
        (let ((row (make-vector (1+ row-inx))))
          (vector-set! tri row-inx row)
          (do ((col-inx 1 (1+ col-inx)))
              ((>= col-inx (vector-length row)))
            (vector-set! row col-inx
              (* (vector-ref (vector-ref tri (1- row-inx)) (1- col-inx))
                 (/ row-inx (1+ col-inx)))))
          (calc-store-first! row))))))

; Convert elements of a vector to a string for display.
(define vector->string
  (lambda (vec)
    (do ((inx 0 (1+ inx))
         (str "" (string-append str (format "[email protected]" (vector-ref vec inx)))))
        ((>= inx (vector-length vec)) str))))

; Display a Faulhaber's Triangle.
(define faulhabers-triangle-display
  (lambda (tri)
    (do ((inx 0 (1+ inx)))
        ((>= inx (vector-length tri)))
      (printf "~a~%" (vector->string (vector-ref tri inx))))))

; Task..
(let ((row-count 10))
  (printf "The first ~a rows of Faulhaber's Triangle..~%" row-count)
  (faulhabers-triangle-display (faulhabers-triangle row-count)))
(newline)
(let ((power 17)
      (sum-to 1000))
  (printf "Sum over k=1..~a of k^~a using Faulhaber's Triangle..~%" sum-to power)
  (let* ((tri (faulhabers-triangle (1+ power)))
         (coefs (vector-ref tri power)))
    (printf "~a~%" (do ((inx 0 (1+ inx))
                        (term-expt sum-to (* term-expt sum-to))
                        (sum 0 (+ sum (* (vector-ref coefs inx) term-expt))))
                       ((>= inx (vector-length coefs)) sum)))))


func faulhaber_triangle(p) {
    { binomial(p, _) * bernoulli(_) / p }.map(p ^.. 0)
}

{ |p|
    say faulhaber_triangle(p).map{ '%6s' % .as_rat }.join
} << 1..10

const p = 17
const n = 1000

say ''
say faulhaber_triangle(p+1).map_kv {|k,v| v * n**(k+1) }.sum


Module Module1

    Class Frac
        Private ReadOnly num As Long
        Private ReadOnly denom As Long

        Public Shared ReadOnly ZERO = New Frac(0, 1)
        Public Shared ReadOnly ONE = New Frac(1, 1)

        Public Sub New(n As Long, d As Long)
            If d = 0 Then
                Throw New ArgumentException("d must not be zero")
            End If
            Dim nn = n
            Dim dd = d
            If nn = 0 Then
                dd = 1
            ElseIf dd < 0 Then
                nn = -nn
                dd = -dd
            End If
            Dim g = Math.Abs(Gcd(nn, dd))
            If g > 1 Then
                nn /= g
                dd /= g
            End If
            num = nn
            denom = dd
        End Sub

        Private Shared Function Gcd(a As Long, b As Long) As Long
            If b = 0 Then
                Return a
            Else
                Return Gcd(b, a Mod b)
            End If
        End Function

        Public Shared Operator -(self As Frac) As Frac
            Return New Frac(-self.num, self.denom)
        End Operator

        Public Shared Operator +(lhs As Frac, rhs As Frac) As Frac
            Return New Frac(lhs.num * rhs.denom + lhs.denom * rhs.num, rhs.denom * lhs.denom)
        End Operator

        Public Shared Operator -(lhs As Frac, rhs As Frac) As Frac
            Return lhs + -rhs
        End Operator

        Public Shared Operator *(lhs As Frac, rhs As Frac) As Frac
            Return New Frac(lhs.num * rhs.num, lhs.denom * rhs.denom)
        End Operator

        Public Shared Operator <(lhs As Frac, rhs As Frac) As Boolean
            Dim x = lhs.num / lhs.denom
            Dim y = rhs.num / rhs.denom
            Return x < y
        End Operator

        Public Shared Operator >(lhs As Frac, rhs As Frac) As Boolean
            Dim x = lhs.num / lhs.denom
            Dim y = rhs.num / rhs.denom
            Return x > y
        End Operator

        Public Shared Operator =(lhs As Frac, rhs As Frac) As Boolean
            Return lhs.num = rhs.num AndAlso lhs.denom = rhs.denom
        End Operator

        Public Shared Operator <>(lhs As Frac, rhs As Frac) As Boolean
            Return lhs.num <> rhs.num OrElse lhs.denom <> rhs.denom
        End Operator

        Public Overrides Function ToString() As String
            If denom = 1 Then
                Return num.ToString
            Else
                Return String.Format("{0}/{1}", num, denom)
            End If
        End Function

        Public Overrides Function Equals(obj As Object) As Boolean
            Dim frac = CType(obj, Frac)
            Return Not IsNothing(frac) AndAlso num = frac.num AndAlso denom = frac.denom
        End Function
    End Class

    Function Bernoulli(n As Integer) As Frac
        If n < 0 Then
            Throw New ArgumentException("n may not be negative or zero")
        End If
        Dim a(n + 1) As Frac
        For m = 0 To n
            a(m) = New Frac(1, m + 1)
            For j = m To 1 Step -1
                a(j - 1) = (a(j - 1) - a(j)) * New Frac(j, 1)
            Next
        Next
        ' returns 'first' Bernoulli number
        If n <> 1 Then
            Return a(0)
        Else
            Return -a(0)
        End If
    End Function

    Function Binomial(n As Integer, k As Integer) As Integer
        If n < 0 OrElse k < 0 OrElse n < k Then
            Throw New ArgumentException()
        End If
        If n = 0 OrElse k = 0 Then
            Return 1
        End If
        Dim num = 1
        For i = k + 1 To n
            num *= i
        Next
        Dim denom = 1
        For i = 2 To n - k
            denom *= i
        Next
        Return num \ denom
    End Function

    Function FaulhaberTriangle(p As Integer) As Frac()
        Dim coeffs(p + 1) As Frac
        For i = 1 To p + 1
            coeffs(i - 1) = Frac.ZERO
        Next
        Dim q As New Frac(1, p + 1)
        Dim sign = -1
        For j = 0 To p
            sign *= -1
            coeffs(p - j) = q * New Frac(sign, 1) * New Frac(Binomial(p + 1, j), 1) * Bernoulli(j)
        Next
        Return coeffs
    End Function

    Sub Main()
        For i = 1 To 10
            Dim coeffs = FaulhaberTriangle(i - 1)
            For Each coeff In coeffs
                Console.Write("{0,5}  ", coeff)
            Next
            Console.WriteLine()
        Next
    End Sub

End Module


import math.fractions
import math.big

fn bernoulli(n int) fractions.Fraction {
    mut a := []fractions.Fraction{len: n+1}
    for m,_ in a {
        a[m] = fractions.fraction(1, i64(m+1))
        for j := m; j >= 1; j-- {
            mut d := a[j-1]
            d = fractions.fraction(i64(j),i64(1)) * (d-a[j])
            a[j-1]=d
        }
    }
    // return the 'first' Bernoulli number
    if n != 1 {
        return a[0]
    }
    a[0] = a[0].negate()
    return a[0]
}

fn binomial(n int, k int) i64 {
    if n <= 0 || k <= 0 || n < k {
        return 1
    }
    mut num, mut den := i64(1), i64(1)
    for i := k + 1; i <= n; i++ {
        num *= i64(i)
    }
    for i := 2; i <= n-k; i++ {
        den *= i64(i)
    }
    return num / den
}

fn faulhaber_triangle(p int) []fractions.Fraction {
    mut coeffs := []fractions.Fraction{len: p+1}
    q := fractions.fraction(1, i64(p)+1)
    mut t := fractions.fraction(1,1)
    mut u := fractions.fraction(1,1)
    mut sign := -1
    for j,_ in coeffs {
        sign *= -1
        mut d := coeffs[p-j]
        t=fractions.fraction(i64(sign),1)
        u = fractions.fraction(binomial(p+1, j),1)
        d=q*t
        d*=u
        d*=bernoulli(j)
        coeffs[p-j]=d
    }
    return coeffs
}

fn main() {
    for i in 0..10 {
        coeffs := faulhaber_triangle(i)
        for coeff in coeffs {
            print("${coeff:5}  ")
        }
        println('')
    }
    println('')
}


import "/fmt" for Fmt
import "/math" for Int
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
}

var binomial = Fn.new { |n, k|
    if (n < 0 || k < 0) Fiber.abort("Arguments must be non-negative integers")
    if (n < k) Fiber.abort("The second argument cannot be more than the first.")
    if (n == k) return 1
    var prod = 1
    var i = n - k + 1
    while (i <= n) {
        prod = prod * i
        i = i + 1
    }
    return prod / Int.factorial(k)
}

var faulhaberTriangle = Fn.new { |p|
    var coeffs = List.filled(p+1, null)
    var q = BigRat.new(1, p+1)
    var sign = -1
    for (j in 0..p) {
        sign = sign * -1
        var b = BigRat.new(binomial.call(p+1, j), 1)
        coeffs[p-j] = q * BigRat.new(sign, 1) * b * bernoulli.call(j)
    }
    return coeffs
}

BigRat.showAsInt = true
for (i in 0..9) {
    var coeffs = faulhaberTriangle.call(i)
    for (coeff in coeffs) Fmt.write("$5s ", coeff)
    System.print()
}
System.print()
 // get coeffs for (k + 1)th row
var k = 17
var cc = faulhaberTriangle.call(k)
var n = BigRat.new(1000, 1)
var np = BigRat.one
var sum = BigRat.zero
for (c in cc) {
    np = np * n
    sum = sum + np*c
}
System.print(sum)


foreach p in (10){
   faulhaberFormula(p).apply("%7s".fmt).concat().println();
}

// each term of faulhaberFormula is BigInt/BigInt
[1..].zipWith(fcn(n,rat){ rat*BN(1000).pow(n) }, faulhaberFormula(17))
.walk()		// -->(0, -3617/60 * 1000^2, 0, 595/3 * 1000^4 ...)
.reduce('+)	// rat + rat + ...
.println();


F _basechange_int(=num, b)
   ‘
    Return list of ints representing positive num in base b
   ’
   I num == 0
      R [0]
   [Int] result
   L num != 0
      (num, V d) = divmod(num, b)
      result.append(d)
   R reversed(result)

F fairshare(b, n)
   [Int] r
   L(i) 0..
      r [+]= sum(_basechange_int(i, b)) % b
      I r.len == n
         L.break
   R r

L(b) (2, 3, 5, 11)
   print(‘#2’.format(b)‘: ’String(fairshare(b, 25))[1 .< (len)-1])


-- thueMorse :: Int -> [Int]
on thueMorse(base)
    -- Non-finite sequence of Thue-Morse terms for a given base.
    fmapGen(baseDigitsSumModBase(base), enumFrom(0))
end thueMorse

-- baseDigitsSumModBase :: Int -> Int -> Int
on baseDigitsSumModBase(b)
    script
        on |λ|(n)
            script go
                on |λ|(x)
                    if 0 < x then
                        Just(Tuple(x mod b, x div b))
                    else
                        Nothing()
                    end if
                end |λ|
            end script
            sum(unfoldl(go, n)) mod b
        end |λ|
    end script
end baseDigitsSumModBase

-------------------------- TEST ---------------------------
on run
    script rjust
        on |λ|(x)
            justifyRight(2, space, str(x))
        end |λ|
    end script

    script test
        on |λ|(n)
            |λ|(n) of rjust & " -> " & ¬
                showList(map(rjust, take(25, thueMorse(n))))
        end |λ|
    end script

    unlines({"First 25 fairshare terms for N players:"} & ¬
        map(test, {2, 3, 5, 11}))
end run

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

-- Just :: a -> Maybe a
on Just(x)
    -- Constructor for an inhabited Maybe (option type) value.
    -- Wrapper containing the result of a computation.
    {type:"Maybe", Nothing:false, Just:x}
end Just

-- Nothing :: Maybe a
on Nothing()
    -- Constructor for an empty Maybe (option type) value.
    -- Empty wrapper returned where a computation is not possible.
    {type:"Maybe", Nothing:true}
end Nothing

-- Tuple (,) :: a -> b -> (a, b)
on Tuple(a, b)
    -- Constructor for a pair of values, possibly of two different types.
    {type:"Tuple", |1|:a, |2|:b, length:2}
end Tuple

-- enumFrom :: Enum a => a -> [a]
on enumFrom(x)
    script
        property v : missing value
        property blnNum : class of x is not text
        on |λ|()
            if missing value is not v then
                if blnNum then
                    set v to 1 + v
                else
                    set v to succ(v)
                end if
            else
                set v to x
            end if
            return v
        end |λ|
    end script
end enumFrom

-- fmapGen <$> :: (a -> b) -> Gen [a] -> Gen [b]
on fmapGen(f, gen)
    script
        property g : mReturn(f)
        on |λ|()
            set v to gen's |λ|()
            if v is missing value then
                v
            else
                g's |λ|(v)
            end if
        end |λ|
    end script
end fmapGen

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

-- intercalateS :: String -> [String] -> String
on intercalate(delim, xs)
    set {dlm, my text item delimiters} to ¬
        {my text item delimiters, delim}
    set s to xs as text
    set my text item delimiters to dlm
    s
end intercalate

-- justifyRight :: Int -> Char -> String -> String
on justifyRight(n, cFiller, s)
    if n > length of s then
        text -n thru -1 of ((replicate(n, cFiller) as text) & s)
    else
        s
    end if
end justifyRight

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

-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
    -- 2nd class handler function lifted into 1st class script wrapper.
    if script is class of f then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- Egyptian multiplication - progressively doubling a list, appending
-- stages of doubling to an accumulator where needed for binary
-- assembly of a target length
-- replicate :: Int -> a -> [a]
on replicate(n, a)
    set out to {}
    if 1 > n then return out
    set dbl to {a}

    repeat while (1 < n)
        if 0 < (n mod 2) then set out to out & dbl
        set n to (n div 2)
        set dbl to (dbl & dbl)
    end repeat
    return out & dbl
end replicate

-- showList :: [a] -> String
on showList(xs)
    "[" & intercalate(",", map(my str, xs)) & "]"
end showList

-- str :: a -> String
on str(x)
    x as string
end str

-- sum :: [Num] -> Num
on sum(xs)
    script add
        on |λ|(a, b)
            a + b
        end |λ|
    end script

    foldl(add, 0, xs)
end sum

-- take :: Int -> [a] -> [a]
-- take :: Int -> String -> String
on take(n, xs)
    set c to class of xs
    if list is c then
        if 0 < n then
            items 1 thru min(n, length of xs) of xs
        else
            {}
        end if
    else if string is c then
        if 0 < n then
            text 1 thru min(n, length of xs) of xs
        else
            ""
        end if
    else if script is c then
        set ys to {}
        repeat with i from 1 to n
            set v to |λ|() of xs
            if missing value is v then
                return ys
            else
                set end of ys to v
            end if
        end repeat
        return ys
    else
        missing value
    end if
end take

-- > unfoldl (\b -> if b == 0 then Nothing else Just (b, b-1)) 10
-- > [1,2,3,4,5,6,7,8,9,10]
-- unfoldl :: (b -> Maybe (b, a)) -> b -> [a]
on unfoldl(f, v)
    set xr to Tuple(v, v) -- (value, remainder)
    set xs to {}
    tell mReturn(f)
        repeat -- Function applied to remainder.
            set mb to |λ|(|2| of xr)
            if Nothing of mb then
                exit repeat
            else -- New (value, remainder) tuple,
                set xr to Just of mb
                -- and value appended to output list.
                set xs to ({|1| of xr} & xs)
            end if
        end repeat
    end tell
    return xs
end unfoldl

-- unlines :: [String] -> String
on unlines(xs)
    -- A single string formed by the intercalation
    -- of a list of strings with the newline character.
    set {dlm, my text item delimiters} to ¬
        {my text item delimiters, linefeed}
    set s to xs as text
    set my text item delimiters to dlm
    s
end unlines


thueMorse: function [base, howmany][
    i: 0
    result: new []
    while [howmany > size result][
        'result ++ (sum digits.base:base i) % base
        i: i + 1
    ]

    return result
]

loop [2 3 5 11] 'b ->
    print [
        (pad.right "Base "++(to :string b) 7)++" =>"
        join.with:" " map to [:string] thueMorse b 25 'x -> pad x 2
    ]


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

int turn(int base, int n) {
    int sum = 0;
    while (n != 0) {
        int rem = n % base;
        n = n / base;
        sum += rem;
    }
    return sum % base;
}

void fairshare(int base, int count) {
    int i;

    printf("Base %2d:", base);
    for (i = 0; i < count; i++) {
        int t = turn(base, i);
        printf(" %2d", t);
    }
    printf("\n");
}

void turnCount(int base, int count) {
    int *cnt = calloc(base, sizeof(int));
    int i, minTurn, maxTurn, portion;

    if (NULL == cnt) {
        printf("Failed to allocate space to determine the spread of turns.\n");
        return;
    }

    for (i = 0; i < count; i++) {
        int t = turn(base, i);
        cnt[t]++;
    }

    minTurn = INT_MAX;
    maxTurn = INT_MIN;
    portion = 0;
    for (i = 0; i < base; i++) {
        if (cnt[i] > 0) {
            portion++;
        }
        if (cnt[i] < minTurn) {
            minTurn = cnt[i];
        }
        if (cnt[i] > maxTurn) {
            maxTurn = cnt[i];
        }
    }

    printf("  With %d people: ", base);
    if (0 == minTurn) {
        printf("Only %d have a turn\n", portion);
    } else if (minTurn == maxTurn) {
        printf("%d\n", minTurn);
    } else {
        printf("%d or %d\n", minTurn, maxTurn);
    }

    free(cnt);
}

int main() {
    fairshare(2, 25);
    fairshare(3, 25);
    fairshare(5, 25);
    fairshare(11, 25);

    printf("How many times does each get a turn in 50000 iterations?\n");
    turnCount(191, 50000);
    turnCount(1377, 50000);
    turnCount(49999, 50000);
    turnCount(50000, 50000);
    turnCount(50001, 50000);

    return 0;
}


#include <iostream>
#include <vector>

int turn(int base, int n) {
    int sum = 0;
    while (n != 0) {
        int rem = n % base;
        n = n / base;
        sum += rem;
    }
    return sum % base;
}

void fairshare(int base, int count) {
    printf("Base %2d:", base);
    for (int i = 0; i < count; i++) {
        int t = turn(base, i);
        printf(" %2d", t);
    }
    printf("\n");
}

void turnCount(int base, int count) {
    std::vector<int> cnt(base, 0);

    for (int i = 0; i < count; i++) {
        int t = turn(base, i);
        cnt[t]++;
    }

    int minTurn = INT_MAX;
    int maxTurn = INT_MIN;
    int portion = 0;
    for (int i = 0; i < base; i++) {
        if (cnt[i] > 0) {
            portion++;
        }
        if (cnt[i] < minTurn) {
            minTurn = cnt[i];
        }
        if (cnt[i] > maxTurn) {
            maxTurn = cnt[i];
        }
    }

    printf("  With %d people: ", base);
    if (0 == minTurn) {
        printf("Only %d have a turn\n", portion);
    } else if (minTurn == maxTurn) {
        printf("%d\n", minTurn);
    } else {
        printf("%d or %d\n", minTurn, maxTurn);
    }
}

int main() {
    fairshare(2, 25);
    fairshare(3, 25);
    fairshare(5, 25);
    fairshare(11, 25);

    printf("How many times does each get a turn in 50000 iterations?\n");
    turnCount(191, 50000);
    turnCount(1377, 50000);
    turnCount(49999, 50000);
    turnCount(50000, 50000);
    turnCount(50001, 50000);

    return 0;
}


import std.array;
import std.stdio;

int turn(int base, int n) {
    int sum = 0;
    while (n != 0) {
        int re = n % base;
        n /= base;
        sum += re;
    }
    return sum % base;
}

void fairShare(int base, int count) {
    writef("Base %2d:", base);
    foreach (i; 0..count) {
        auto t = turn(base, i);
        writef(" %2d", t);
    }
    writeln;
}

void turnCount(int base, int count) {
    auto cnt = uninitializedArray!(int[])(base);
    cnt[] = 0;

    foreach (i; 0..count) {
        auto t = turn(base, i);
        cnt[t]++;
    }

    auto minTurn = int.max;
    auto maxTurn = int.min;
    int portion = 0;
    foreach (num; cnt) {
        if (num > 0) {
            portion++;
        }
        if (num < minTurn) {
            minTurn = num;
        }
        if (maxTurn < num) {
            maxTurn = num;
        }
    }

    writef("  With %d people: ", base);
    if (minTurn == 0) {
        writefln("Only %d have a turn", portion);
    } else if (minTurn == maxTurn) {
        writeln(minTurn);
    } else {
        writeln(minTurn," or ", maxTurn);
    }
}

void main() {
    fairShare(2, 25);
    fairShare(3, 25);
    fairShare(5, 25);
    fairShare(11, 25);

    writeln("How many times does each get a turn in 50000 iterations?");
    turnCount(191, 50000);
    turnCount(1377, 50000);
    turnCount(49999, 50000);
    turnCount(50000, 50000);
    turnCount(50001, 50000);
}


USING: formatting kernel math math.parser sequences ;

: nth-fairshare ( n base -- m )
    [ >base string>digits sum ] [ mod ] bi ;

: <fairshare> ( n base -- seq )
    [ nth-fairshare ] curry { } map-integers ;

{ 2 3 5 11 }
[ 25 over <fairshare> "%2d -> %u\n" printf ] each


Function Turn(mibase As Integer, n As Integer) As Integer
    Dim As Integer sum = 0
    While n <> 0
        Dim As Integer re = n Mod mibase
        n \= mibase
        sum += re
    Wend
    Return sum Mod mibase
End Function

Sub Fairshare(mibase As Integer, count As Integer)
    Print Using "mibase ##:"; mibase;
    For i As Integer = 1 To count
        Dim As Integer t = Turn(mibase, i - 1)
        Print Using " ##"; t;
    Next i
    Print
End Sub

Sub TurnCount(mibase As Integer, count As Integer)
    Dim As Integer cnt(mibase), i
    For i = 1 To mibase
        cnt(i - 1) = 0
    Next i

    For i = 1 To count
        Dim As Integer t = Turn(mibase, i - 1)
        cnt(t) += 1
    Next i

    Dim As Integer minTurn = 4294967295 'MaxValue of uLong
    Dim As Integer maxTurn = 0 'MinValue of uLong
    Dim As Integer portion = 0
    For i As Integer = 1 To mibase
        Dim As Integer num = cnt(i - 1)
        If num > 0 Then portion += 1
        If num < minTurn Then minTurn = num
        If num > maxTurn Then maxTurn = num
    Next i

    Print Using "  With ##### people: "; mibase;
    If 0 = minTurn Then
        Print Using "Only & have a turn"; portion
    Elseif minTurn = maxTurn Then
        Print minTurn
    Else
        Print Using "& or &"; minTurn; maxTurn
    End If
End Sub

Fairshare(2, 25)
Fairshare(3, 25)
Fairshare(5, 25)
Fairshare(11, 25)

Print "How many times does each get a turn in 50000 iterations?"
TurnCount(191, 50000)
TurnCount(1377, 50000)
TurnCount(49999, 50000)
TurnCount(50000, 50000)
TurnCount(50001, 50000)
Sleep


package main

import (
    "fmt"
    "sort"
    "strconv"
    "strings"
)

func fairshare(n, base int) []int {
    res := make([]int, n)
    for i := 0; i < n; i++ {
        j := i
        sum := 0
        for j > 0 {
            sum += j % base
            j /= base
        }
        res[i] = sum % base
    }
    return res
}

func turns(n int, fss []int) string {
    m := make(map[int]int)
    for _, fs := range fss {
        m[fs]++
    }
    m2 := make(map[int]int)
    for _, v := range m {
        m2[v]++
    }
    res := []int{}
    sum := 0
    for k, v := range m2 {
        sum += v
        res = append(res, k)
    }
    if sum != n {
        return fmt.Sprintf("only %d have a turn", sum)
    }
    sort.Ints(res)
    res2 := make([]string, len(res))
    for i := range res {
        res2[i] = strconv.Itoa(res[i])
    }
    return strings.Join(res2, " or ")
}

func main() {
    for _, base := range []int{2, 3, 5, 11} {
        fmt.Printf("%2d : %2d\n", base, fairshare(25, base))
    }
    fmt.Println("\nHow many times does each get a turn in 50000 iterations?")
    for _, base := range []int{191, 1377, 49999, 50000, 50001} {
        t := turns(base, fairshare(50000, base))
        fmt.Printf("  With %d people: %s\n", base, t)
    }
}


import Data.Bool (bool)
import Data.List (intercalate, unfoldr)
import Data.Tuple (swap)

------------- FAIR SHARE BETWEEN TWO AND MORE ------------

thueMorse :: Int -> [Int]
thueMorse base = baseDigitsSumModBase base <$> [0 ..]

baseDigitsSumModBase :: Int -> Int -> Int
baseDigitsSumModBase base n =
  mod
    ( sum $
        unfoldr
          ( bool Nothing
              . Just
              . swap
              . flip quotRem base
              <*> (0 <)
          )
          n
    )
    base

--------------------------- TEST -------------------------
main :: IO ()
main =
  putStrLn $
    fTable
      ( "First 25 fairshare terms "
          <> "for a given number of players:\n"
      )
      show
      ( ('[' :) . (<> "]") . intercalate ","
          . fmap show
      )
      (take 25 . thueMorse)
      [2, 3, 5, 11]

------------------------- DISPLAY ------------------------
fTable ::
  String ->
  (a -> String) ->
  (b -> String) ->
  (a -> b) ->
  [a] ->
  String
fTable s xShow fxShow f xs =
  unlines $
    s :
    fmap
      ( ((<>) . justifyRight w ' ' . xShow)
          <*> ((" -> " <>) . fxShow . f)
      )
      xs
  where
    w = maximum (length . xShow <$> xs)

justifyRight :: Int -> Char -> String -> String
justifyRight n c = (drop . length) <*> (replicate n c <>)


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

public class FairshareBetweenTwoAndMore {

    public static void main(String[] args) {
        for ( int base : Arrays.asList(2, 3, 5, 11) ) {
            System.out.printf("Base %d = %s%n", base, thueMorseSequence(25, base));
        }
    }

    private static List<Integer> thueMorseSequence(int terms, int base) {
        List<Integer> sequence = new ArrayList<Integer>();
        for ( int i = 0 ; i < terms ; i++ ) {
            int sum = 0;
            int n = i;
            while ( n > 0 ) {
                //  Compute the digit sum
                sum += n % base;
                n /= base;
            }
            //  Compute the digit sum module base.
            sequence.add(sum % base);
        }
        return sequence;
    }

}


(() => {
    'use strict';

    // thueMorse :: Int -> [Int]
    const thueMorse = base =>
        // Thue-Morse sequence for a given base
        fmapGen(baseDigitsSumModBase(base))(
            enumFrom(0)
        )

    // baseDigitsSumModBase :: Int -> Int -> Int
    const baseDigitsSumModBase = base =>
        // For any integer n, the sum of its digits
        // in a given base, modulo that base.
        n => sum(unfoldl(
            x => 0 < x ? (
                Just(quotRem(x)(base))
            ) : Nothing()
        )(n)) % base

    // ------------------------TEST------------------------
    const main = () =>
        console.log(
            fTable(
                'First 25 fairshare terms for a given number of players:'
            )(str)(
                xs => '[' + map(
                    compose(justifyRight(2)(' '), str)
                )(xs) + ' ]'
            )(
                compose(take(25), thueMorse)
            )([2, 3, 5, 11])
        );

    // -----------------GENERIC FUNCTIONS------------------

    // Just :: a -> Maybe a
    const Just = x => ({
        type: 'Maybe',
        Nothing: false,
        Just: x
    });

    // Nothing :: Maybe a
    const Nothing = () => ({
        type: 'Maybe',
        Nothing: true,
    });

    // Tuple (,) :: a -> b -> (a, b)
    const Tuple = a => b => ({
        type: 'Tuple',
        '0': a,
        '1': b,
        length: 2
    });

    // compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
    const compose = (...fs) =>
        x => fs.reduceRight((a, f) => f(a), x);

    // enumFrom :: Enum a => a -> [a]
    function* enumFrom(x) {
        // A non-finite succession of enumerable
        // values, starting with the value x.
        let v = x;
        while (true) {
            yield v;
            v = 1 + v;
        }
    }

    // fTable :: String -> (a -> String) -> (b -> String)
    //                      -> (a -> b) -> [a] -> String
    const fTable = s => xShow => fxShow => f => xs => {
        // Heading -> x display function ->
        //           fx display function ->
        //    f -> values -> tabular string
        const
            ys = xs.map(xShow),
            w = Math.max(...ys.map(length));
        return s + '\n' + zipWith(
            a => b => a.padStart(w, ' ') + ' -> ' + b
        )(ys)(
            xs.map(x => fxShow(f(x)))
        ).join('\n');
    };

    // fmapGen <$> :: (a -> b) -> Gen [a] -> Gen [b]
    const fmapGen = f =>
        function*(gen) {
            let v = take(1)(gen);
            while (0 < v.length) {
                yield(f(v[0]))
                v = take(1)(gen)
            }
        };

    // justifyRight :: Int -> Char -> String -> String
    const justifyRight = n =>
        // The string s, preceded by enough padding (with
        // the character c) to reach the string length n.
        c => s => n > s.length ? (
            s.padStart(n, c)
        ) : s;

    // length :: [a] -> Int
    const length = xs =>
        // Returns Infinity over objects without finite
        // length. This enables zip and zipWith to choose
        // the shorter argument when one is non-finite,
        // like cycle, repeat etc
        (Array.isArray(xs) || 'string' === typeof xs) ? (
            xs.length
        ) : Infinity;

    // map :: (a -> b) -> [a] -> [b]
    const map = f =>
        // The list obtained by applying f to each element of xs.
        // (The image of xs under f).
        xs => (Array.isArray(xs) ? (
            xs
        ) : xs.split('')).map(f);

    // quotRem :: Int -> Int -> (Int, Int)
    const quotRem = m => n =>
        Tuple(Math.floor(m / n))(
            m % n
        );

    // str :: a -> String
    const str = x => x.toString();

    // sum :: [Num] -> Num
    const sum = xs =>
        // The numeric sum of all values in xs.
        xs.reduce((a, x) => a + x, 0);

    // take :: Int -> [a] -> [a]
    // take :: Int -> String -> String
    const take = n =>
        // The first n elements of a list,
        // string of characters, or stream.
        xs => 'GeneratorFunction' !== xs
        .constructor.constructor.name ? (
            xs.slice(0, n)
        ) : [].concat.apply([], Array.from({
            length: n
        }, () => {
            const x = xs.next();
            return x.done ? [] : [x.value];
        }));

    // unfoldl :: (b -> Maybe (b, a)) -> b -> [a]
    const unfoldl = f => v => {
        // Dual to reduce or foldl.
        // Where these reduce a list to a summary value, unfoldl
        // builds a list from a seed value.
        // Where f returns Just(a, b), a is appended to the list,
        // and the residual b is used as the argument for the next
        // application of f.
        // Where f returns Nothing, the completed list is returned.
        let
            xr = [v, v],
            xs = [];
        while (true) {
            const mb = f(xr[0]);
            if (mb.Nothing) {
                return xs
            } else {
                xr = mb.Just;
                xs = [xr[1]].concat(xs);
            }
        }
    };

    // zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
    const zipWith = f =>
        xs => ys => {
            const
                lng = Math.min(length(xs), length(ys)),
                vs = take(lng)(ys);
            return take(lng)(xs)
                .map((x, i) => f(x)(vs[i]));
        };

    // MAIN ---
    return main();
})();


# Using a "reverse array" representations of the integers base b (b>=2),
# generate an unbounded stream of the integers from [0] onwards.
# E.g. for binary: [0], [1], [0,1], [1,1] ...

def integers($base):
  def add1:
    [foreach (.[], null) as $d ({carry: 1};
     if $d then ($d + .carry ) as $r
     | if $r >= $base
       then {carry: 1, emit: ($r - $base)}
       else {carry: 0, emit: $r }
       end
     elif (.carry == 0) then .emit = null
     else .emit = .carry
     end;
  select(.emit).emit)];

  [0] | recurse(add1);

def fairshare($base; $numberOfTerms):
  limit($numberOfTerms;
        integers($base) | add | . % $base);

# The task:
(2,3,5,11)
| "Fairshare \((select(.>2)|"among") // "between") \(.) people: \([fairshare(.; 25)])"


fairshare(nplayers,len) = [sum(digits(n, base=nplayers)) % nplayers for n in 0:len-1]

for n in [2, 3, 5, 11]
    println("Fairshare ", n > 2 ? "among" : "between", " $n people: ", fairshare(n, 25))
end


fun turn(base: Int, n: Int): Int {
    var sum = 0
    var n2 = n
    while (n2 != 0) {
        val re = n2 % base
        n2 /= base
        sum += re
    }
    return sum % base
}

fun fairShare(base: Int, count: Int) {
    print(String.format("Base %2d:", base))
    for (i in 0 until count) {
        val t = turn(base, i)
        print(String.format(" %2d", t))
    }
    println()
}

fun turnCount(base: Int, count: Int) {
    val cnt = IntArray(base) { 0 }
    for (i in 0 until count) {
        val t = turn(base, i)
        cnt[t]++
    }

    var minTurn = Int.MAX_VALUE
    var maxTurn = Int.MIN_VALUE
    var portion = 0
    for (i in 0 until base) {
        val num = cnt[i]
        if (num > 0) {
            portion++
        }
        if (num < minTurn) {
            minTurn = num
        }
        if (num > maxTurn) {
            maxTurn = num
        }
    }

    print("  With $base people: ")
    when (minTurn) {
        0 -> {
            println("Only $portion have a turn")
        }
        maxTurn -> {
            println(minTurn)
        }
        else -> {
            println("$minTurn or $maxTurn")
        }
    }
}

fun main() {
    fairShare(2, 25)
    fairShare(3, 25)
    fairShare(5, 25)
    fairShare(11, 25)

    println("How many times does each get a turn in 50000 iterations?")
    turnCount(191, 50000)
    turnCount(1377, 50000)
    turnCount(49999, 50000)
    turnCount(50000, 50000)
    turnCount(50001, 50000)
}


function turn(base, n)
    local sum = 0
    while n ~= 0 do
        local re = n % base
        n = math.floor(n / base)
        sum = sum + re
    end
    return sum % base
end

function fairShare(base, count)
    io.write(string.format("Base %2d:", base))
    for i=1,count do
        local t = turn(base, i - 1)
        io.write(string.format(" %2d", t))
    end
    print()
end

function turnCount(base, count)
    local cnt = {}

    for i=1,base do
        cnt[i - 1] = 0
    end

    for i=1,count do
        local t = turn(base, i - 1)
        if cnt[t] ~= nil then
            cnt[t] = cnt[t] + 1
        else
            cnt[t] = 1
        end
    end

    local minTurn = count
    local maxTurn = -count
    local portion = 0
    for _,num in pairs(cnt) do
        if num > 0 then
            portion = portion + 1
        end
        if num < minTurn then
            minTurn = num
        end
        if maxTurn < num then
            maxTurn = num
        end
    end

    io.write(string.format("  With %d people: ", base))
    if minTurn == 0 then
        print(string.format("Only %d have a turn", portion))
    elseif minTurn == maxTurn then
        print(minTurn)
    else
        print(minTurn .. " or " .. maxTurn)
    end
end

function main()
    fairShare(2, 25)
    fairShare(3, 25)
    fairShare(5, 25)
    fairShare(11, 25)

    print("How many times does each get a turn in 50000 iterations?")
    turnCount(191, 50000)
    turnCount(1377, 50000)
    turnCount(49999, 50000)
    turnCount(50000, 50000)
    turnCount(50001, 50000)
end

main()


ClearAll[Fairshare]
Fairshare[n_List, b_Integer : 2] := Fairshare[#, b] & /@ n
Fairshare[n_Integer, b_Integer : 2] := Mod[Total[IntegerDigits[n, b]], b]
Fairshare[Range[0, 24], 2]
Fairshare[Range[0, 24], 3]
Fairshare[Range[0, 24], 5]
Fairshare[Range[0, 24], 11]


import math, strutils

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

iterator countInBase(b: Positive): seq[Natural] =
  ## Yield the successive integers in base "b" as a sequence of digits.

  var value = @[Natural 0]
  yield value

  while true:

    # Add one to current value.
    var c = 1
    for i in countdown(value.high, 0):
      let val = value[i] + c
      if val < b:
        value[i] = val
        c = 0
      else:
        value[i] = val - b
        c = 1

    if c == 1:
      # Add a new digit at the beginning.
      # In this case, for better performances, we could have add it at the end.
      value.insert(c, 0)

    yield value

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

func thueMorse(b: Positive; count: Natural): seq[Natural] =
  ## Return the "count" first elements of Thue-Morse sequence for base "b".

  var count = count
  for n in countInBase(b):
    result.add(sum(n) mod b)
    dec count
    if count == 0: break

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

for base in [2, 3, 5, 11]:
  echo "Base ", ($base & ": ").alignLeft(4), thueMorse(base, 25).join(" ")


use strict;
use warnings;
use Math::AnyNum qw(sum polymod);

sub fairshare {
    my($b, $n) = @_;
    sprintf '%3d'x$n, map { sum ( polymod($_, $b, $b )) % $b } 0 .. $n-1;
}

for (<2 3 5 11>) {
    printf "%3s:%s\n", $_, fairshare($_, 25);
}


function fairshare(integer n, base)
    sequence res = repeat(0,n)
    for i=1 to n do
        integer j = i-1,
                t = 0
        while j>0 do
            t += remainder(j,base)
            j = floor(j/base)
        end while
        res[i] = remainder(t,base)
    end for
    return {base,res}
end function

constant tests = {2,3,5,11}
for i=1 to length(tests) do
    printf(1,"%2d : %v\n", fairshare(25, tests[i]))
end for


from itertools import count, islice

def _basechange_int(num, b):
    """
    Return list of ints representing positive num in base b

    >>> b = 3
    >>> print(b, [_basechange_int(num, b) for num in range(11)])
    3 [[0], [1], [2], [1, 0], [1, 1], [1, 2], [2, 0], [2, 1], [2, 2], [1, 0, 0], [1, 0, 1]]
    >>>
    """
    if num == 0:
        return [0]
    result = []
    while num != 0:
        num, d = divmod(num, b)
        result.append(d)
    return result[::-1]

def fairshare(b=2):
    for i in count():
        yield sum(_basechange_int(i, b)) % b

if __name__ == '__main__':
    for b in (2, 3, 5, 11):
        print(f"{b:>2}: {str(list(islice(fairshare(b), 25)))[1:-1]}")


  [ dup dip digitsum mod ] is fairshare ( n n --> n )

  ' [ 2 3 5 11 ]
  witheach
    [ dup echo say ": "
      25 times
        [ i^ over fairshare echo sp ]
      drop cr ]


#lang racket

(define (Thue-Morse base)
  (letrec ((q/r (curryr quotient/remainder base))
           (inner (λ (n (s 0))
                    (match n
                      [0 (modulo s base)]
                      [(app q/r q r) (inner q (+ s r))]))))
    inner))

(define (report-turns B n)
  (printf "Base:\t~a\t~a~%" B (map (Thue-Morse B) (range n))))

(define (report-stats B n)
  (define TM (Thue-Morse B))
  (define h0 (for/hash ((b B)) (values b 0)))
  (define d (for/fold ((h h0)) ((i n)) (hash-update h (TM i) add1 0)))
  (define d′ (for/fold ((h (hash))) (([k v] (in-hash d))) (hash-update h v add1 0)))
  (define d′′ (hash-map d′ (λ (k v) (format "~a people have ~a turn(s)" v k))))
  (printf "Over ~a turns for ~a people:~a~%" n B (string-join d′′ ", ")))

(define (Fairshare-between-two-and-more)
  (report-turns 2 25)
  (report-turns 3 25)
  (report-turns 5 25)
  (report-turns 11 25)
  (newline)
  (report-stats 191 50000)
  (report-stats 1377 50000)
  (report-stats 49999 50000)
  (report-stats 50000 50000)
  (report-stats 50001 50000))

(module+ main
  (Fairshare-between-two-and-more))


sub fairshare (\b) { ^∞ .hyper.map: { .polymod( b xx * ).sum % b } }

.say for <2 3 5 11>.map: { .fmt('%2d:') ~ .&fairshare[^25]».fmt('%2d').join: ', ' }

say "\nRelative fairness of this method. Scaled fairness correlation. The closer to 1.0 each person
is, the more fair the selection algorithm is. Gets better with more iterations.";

for <2 3 5 11 39> -> $people {
    print "\n$people people: \n";
    for $people * 1, $people * 10, $people * 1000 -> $iterations {
        my @fairness;
        fairshare($people)[^$iterations].kv.map: { @fairness[$^v % $people] += $^k }
        my $scale = @fairness.sum / @fairness;
        my @range = @fairness.map( { $_ / $scale } );
        printf "After round %4d: Best advantage: %-10.8g - Worst disadvantage: %-10.8g - Spread between best and worst: %-10.8g\n",
            $iterations/$people, @range.min, @range.max, @range.max - @range.min;
    }
}


/*REXX program calculates  N  terms of the fairshare sequence for some group of peoples.*/
parse arg n g                                    /*obtain optional arguments from the CL*/
if n=='' | n==","  then n= 25                    /*Not specified?  Then use the default.*/
if g=''  | g=","   then g=  2 3 5 11             /* "      "         "   "   "     "    */
                                                 /* [↑]  a list of a number of peoples. */
     do p=1  for words(g);        r= word(g, p)  /*traipse through the bases specfiied. */
     $= 'base' right(r, 2)': '                   /*construct start of the 1─line output.*/
        do j=0  for n;   $= $ right( sumDigs( base(j, r))  //  r, 2)','
        end   /*j*/                              /* [↑] append # (base R) mod R──►$ list*/
     say strip($, , ",")                         /*elide trailing comma from the $ list.*/
     end      /*p*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
base: parse arg #,b,,y;          @= 0123456789abcdefghijklmnopqrstuvwxyz;  @@= substr(@,2)
        do while #>=b; y= substr(@, #//b + 1, 1)y; #= #%b; end;  return substr(@, #+1, 1)y
/*──────────────────────────────────────────────────────────────────────────────────────*/
sumDigs: parse arg x; !=0; do i=1 for length(x); != !+pos(substr(x,i,1),@@); end; return !


str    = []
people = [2,3,5,11]

result = people
for i in people
    str = []
    see "" + i + ": "
    fair(25, i)
    for n in result
        add(str,n)
    next
    showarray(str)
next

func fair n,base

     result = list(n)
     for i=1 to n
         j = i-1
         t = 0
         while j>0
               t = t + j % base
               j = floor(j/base)
         end
         result[i] = t % base
     next

func showarray vect
     svect = ""
     for n in vect
         svect += " " + n + ","
     next
     svect = left(svect, len(svect) - 1)
     ? "[" + svect + "]"


def turn(base, n)
    sum = 0
    while n != 0 do
        rem = n % base
        n = n / base
        sum = sum + rem
    end
    return sum % base
end

def fairshare(base, count)
    print "Base %2d: " % [base]
    for i in 0 .. count - 1 do
        t = turn(base, i)
        print " %2d" % [t]
    end
    print "\n"
end

def turnCount(base, count)
    cnt = Array.new(base, 0)

    for i in 0 .. count - 1 do
        t = turn(base, i)
        cnt[t] = cnt[t] + 1
    end

    minTurn = base * count
    maxTurn = -1
    portion = 0
    for i in 0 .. base - 1 do
        if cnt[i] > 0 then
            portion = portion + 1
        end
        if cnt[i] < minTurn then
            minTurn = cnt[i]
        end
        if cnt[i] > maxTurn then
            maxTurn = cnt[i]
        end
    end

    print "  With %d people: " % [base]
    if 0 == minTurn then
        print "Only %d have a turn\n" % portion
    elsif minTurn == maxTurn then
        print "%d\n" % [minTurn]
    else
        print "%d or %d\n" % [minTurn, maxTurn]
    end
end

def main
    fairshare(2, 25)
    fairshare(3, 25)
    fairshare(5, 25)
    fairshare(11, 25)

    puts "How many times does each get a turn in 50000 iterations?"
    turnCount(191, 50000)
    turnCount(1377, 50000)
    turnCount(49999, 50000)
    turnCount(50000, 50000)
    turnCount(50001, 50000)
end

main()


struct Digits {
    rest: usize,
    base: usize,
}

impl Iterator for Digits {
    type Item = usize;

    fn next(&mut self) -> Option<usize> {
        if self.rest == 0 {
            return None;
        }
        let (digit, rest) = (self.rest % self.base, self.rest / self.base);
        self.rest = rest;
        Some(digit)
    }
}

fn digits(num: usize, base: usize) -> Digits {
    Digits { rest: num, base: base }
}

struct FairSharing {
    participants: usize,
    index: usize,
}

impl Iterator for FairSharing {
    type Item = usize;
    fn next(&mut self) -> Option<usize> {
        let digit_sum: usize = digits(self.index, self.participants).sum();
        let selected = digit_sum % self.participants;
        self.index += 1;
        Some(selected)
    }
}

fn fair_sharing(participants: usize) -> FairSharing {
    FairSharing { participants: participants, index: 0 }
}

fn main() {
    for i in vec![2, 3, 5, 7] {
        println!("{}: {:?}", i, fair_sharing(i).take(25).collect::<Vec<usize>>());
    }
}


Module Module1

    Function Turn(base As Integer, n As Integer) As Integer
        Dim sum = 0
        While n <> 0
            Dim re = n Mod base
            n \= base
            sum += re
        End While
        Return sum Mod base
    End Function

    Sub Fairshare(base As Integer, count As Integer)
        Console.Write("Base {0,2}:", base)
        For i = 1 To count
            Dim t = Turn(base, i - 1)
            Console.Write(" {0,2}", t)
        Next
        Console.WriteLine()
    End Sub

    Sub TurnCount(base As Integer, count As Integer)
        Dim cnt(base) As Integer
        For i = 1 To base
            cnt(i - 1) = 0
        Next

        For i = 1 To count
            Dim t = Turn(base, i - 1)
            cnt(t) += 1
        Next

        Dim minTurn = Integer.MaxValue
        Dim maxTurn = Integer.MinValue
        Dim portion = 0
        For i = 1 To base
            Dim num = cnt(i - 1)
            If num > 0 Then
                portion += 1
            End If
            If num < minTurn Then
                minTurn = num
            End If
            If num > maxTurn Then
                maxTurn = num
            End If
        Next

        Console.Write("  With {0} people: ", base)
        If 0 = minTurn Then
            Console.WriteLine("Only {0} have a turn", portion)
        ElseIf minTurn = maxTurn Then
            Console.WriteLine(minTurn)
        Else
            Console.WriteLine("{0} or {1}", minTurn, maxTurn)
        End If
    End Sub

    Sub Main()
        Fairshare(2, 25)
        Fairshare(3, 25)
        Fairshare(5, 25)
        Fairshare(11, 25)

        Console.WriteLine("How many times does each get a turn in 50000 iterations?")
        TurnCount(191, 50000)
        TurnCount(1377, 50000)
        TurnCount(49999, 50000)
        TurnCount(50000, 50000)
        TurnCount(50001, 50000)
    End Sub

End Module


fn fairshare(n int, base int) []int {
    mut res := []int{len: n}
    for i in 0..n {
        mut j := i
        mut sum := 0
        for j > 0 {
            sum += j % base
            j /= base
        }
        res[i] = sum % base
    }
    return res
}

fn turns(n int, fss []int) string {
    mut m := map[int]int{}
    for fs in fss {
        m[fs]++
    }
    mut m2 := map[int]int{}
    for _,v in m {
        m2[v]++
    }
    mut res := []int{}
    mut sum := 0
    for k, v in m2 {
        sum += v
        res << k
    }
    if sum != n {
        return "only $sum have a turn"
    }
    res.sort()
    mut res2 := []string{len: res.len}
    for i,_ in res {
        res2[i] = '${res[i]}'
    }
    return res2.join(" or ")
}

fn main() {
    for base in [2, 3, 5, 11] {
        println("${base:2} : ${fairshare(25, base):2}")
    }
    println("\nHow many times does each get a turn in 50000 iterations?")
    for base in [191, 1377, 49999, 50000, 50001] {
        t := turns(base, fairshare(50000, base))
        println("  With $base people: $t")
    }
}


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

var fairshare = Fn.new { |n, base|
    var res = List.filled(n, 0)
    for (i in 0...n) {
        var j = i
        var sum = 0
        while (j > 0) {
            sum = sum + (j%base)
            j = (j/base).floor
        }
        res[i] = sum % base
    }
    return res
}

var turns = Fn.new { |n, fss|
    var m = {}
    for (fs in fss) {
        var k = m[fs]
        if (!k) {
            m[fs] = 1
        } else {
            m[fs] = k + 1
        }
    }
    var m2 = {}
    for (k in m.keys) {
        var v = m[k]
        var k2 = m2[v]
        if (!k2) {
            m2[v] = 1
        } else {
            m2[v] = k2 + 1
        }
    }
    var res = []
    var sum = 0
    for (k in m2.keys) {
        var v = m2[k]
        sum = sum + v
        res.add(k)
    }
    if (sum != n) return "only %(sum) have a turn"
    Sort.quick(res)
    var res2 = List.filled(res.count, "")
    for (i in 0...res.count) res2[i] = res[i].toString
    return res2.join(" or ")
}

for (base in [2, 3, 5, 11]) {
    Fmt.print("$2d : $2d", base, fairshare.call(25, base))
}
System.print("\nHow many times does each get a turn in 50,000 iterations?")
for (base in [191, 1377, 49999, 50000, 50001]) {
    var t = turns.call(base, fairshare.call(50000, base))
    Fmt.print("  With $5d people: $s", base, t)
}


proc Fair(Base); \Show first 25 terms of fairshare sequence
int  Base, Count, Sum, N, Q;
[RlOut(0, float(Base));  Text(0, ": ");
for Count:= 0 to 25-1 do
    [Sum:= 0;  N:= Count;
    while N do
        [Q:= N/Base;
        Sum:= Sum + rem(0);
        N:= Q;
        ];
    RlOut(0, float(rem(Sum/Base)));
    ];
CrLf(0);
];

[Format(3,0);
Fair(2);  Fair(3);  Fair(5);  Fair(11);
]


fcn fairShare(n,b){    // b<=36
   n.pump(List,'wrap(n){ n.toString(b).split("").apply("toInt",b).sum(0)%b })
}
foreach b in (T(2,3,5,11)){
   println("%2d: %s".fmt(b,fairShare(25,b).pump(String,"%2d ".fmt)));
}


V fact = [1]
L(n) 1..11
   fact.append(fact[n-1] * n)

L(b) 9..12
   print(‘The factorions for base ’b‘ are:’)
   L(i) 1..1'499'999
      V fact_sum = 0
      V j = i
      L j > 0
         V d = j % b
         fact_sum += fact[d]
         j I/= b
      I fact_sum == i
         print(i, end' ‘ ’)
   print("\n")


*        Factorions                26/04/2020
FACTORIO CSECT
         USING  FACTORIO,R13       base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         SAVE   (14,12)            save previous context
         ST     R13,4(R15)         link backward
         ST     R15,8(R13)         link forward
         LR     R13,R15            set addressability
         XR     R4,R4              ~
         LA     R5,1               f=1
         LA     R3,FACT+4          @fact(1)
         LA     R6,1               i=1
       DO WHILE=(C,R6,LE,=A(NN2))  do i=1 to nn2
         MR     R4,R6                fact(i-1)*i
         ST     R5,0(R3)             fact(i)=fact(i-1)*i
         LA     R3,4(R3)             @fact(i+1)
         LA     R6,1(R6)             i++
       ENDDO    ,                  enddo i
         LA     R7,NN1             base=nn1
       DO WHILE=(C,R7,LE,=A(NN2))  do base=nn1 to nn2
	     MVC    PG,PGX               init buffer
         LA     R3,PG+6              @buffer
         XDECO  R7,XDEC              edit base
         MVC    PG+5(2),XDEC+10      output base
         LA     R3,PG+10             @buffer
         LA     R6,1                 i=1
       DO WHILE=(C,R6,LE,LIM)        do i=1 to lim
         LA     R9,0                   s=0
         LR     R8,R6                  t=i
       DO WHILE=(C,R8,NE,=F'0')        while t<>0
         XR     R4,R4                    ~
         LR     R5,R8                    t
         DR     R4,R7                    r5=t/base; r4=d=(t mod base)
         LR     R1,R4                    d
         SLA    R1,2                     ~
         L      R2,FACT(R1)              fact(d)
         AR     R9,R2                    s=s+fact(d)
         LR     R8,R5                    t=t/base
       ENDDO    ,                      endwhile
       IF    CR,R9,EQ,R6 THEN          if s=i then
         XDECO  R6,XDEC                  edit i
         MVC    0(6,R3),XDEC+6           output i
         LA     R3,7(R3)                 @buffer
       ENDIF    ,                      endif
         LA     R6,1(R6)               i++
       ENDDO    ,                    enddo i
         XPRNT  PG,L'PG              print buffer
         LA     R7,1(R7)             base++
       ENDDO    ,                  enddo base
         L      R13,4(0,R13)       restore previous savearea pointer
         RETURN (14,12),RC=0       restore registers from calling save
NN1      EQU    9                  nn1=9
NN2      EQU    12                 nn2=12
LIM      DC     f'1499999'         lim=1499999
FACT     DC     (NN2+1)F'1'        fact(0:12)
PG       DS     CL80               buffer
PGX      DC     CL80'Base .. : '   buffer init
XDEC     DS     CL12               temp fo xdeco
         REGEQU
         END    FACTORIO


BEGIN
    # cache factorials from 0 to 11 #
    [ 0 : 11 ]INT fact;
    fact[0] := 1;
    FOR n TO 11 DO
        fact[n] := fact[n-1] * n
    OD;
    FOR b FROM 9 TO 12 DO
        print( ( "The factorions for base ", whole( b, 0 ), " are:", newline ) );
        FOR i TO 1500000 - 1 DO
            INT sum := 0;
            INT j := i;
            WHILE j > 0 DO
                sum +:= fact[ j MOD b ];
                j OVERAB b
            OD;
            IF sum = i THEN print( ( whole( i, 0 ), " " ) ) FI
        OD;
        print( ( newline ) )
    OD
END


100 DIM FACT(12)
110 FACT(0) = 1
120 FOR N = 1 TO 11
130     FACT(N) = FACT(N - 1) * N
140 NEXT
200 FOR B = 9 TO 12
210     PRINT "THE FACTORIONS ";
215     PRINT "FOR BASE "B" ARE:"
220     FOR I = 1 TO 1499999
230         SUM = 0
240         FOR J = I TO 0 STEP 0
245             M =  INT (J / B)
250             D = J - M * B
260             SUM = SUM + FACT(D)
270             J = M
280         NEXT J
290         IF SU = I THEN  PRINT I" ";
300     NEXT I
310     PRINT : PRINT
320 NEXT B


factorials: [1 1 2 6 24 120 720 5040 40320 362880 3628800 39916800]

factorion?: function [n, base][
    try? [
        n = sum map digits.base:base n 'x -> factorials\[x]
    ]
    else [
        print ["n:" n "base:" base]
        false
    ]
]

loop 9..12 'base ->
    print ["Base" base "factorions:" select 1..45000 'z -> factorion? z base]
]


fact:=[]
fact[0] := 1
while (A_Index < 12)
	fact[A_Index] := fact[A_Index-1] * A_Index
b := 9
while (b <= 12) {
	res .= "base " b " factorions:  `t"
	while (A_Index < 1500000){
		sum := 0
		j := A_Index
		while (j > 0){
			d := Mod(j, b)
			sum += fact[d]
			j /= b
		}
		if (sum = A_Index)
			res .= A_Index "  "
	}
	b++
	res .= "`n"
}
MsgBox % res
return


# syntax: GAWK -f FACTORIONS.AWK
# converted from C
BEGIN {
    fact[0] = 1 # cache factorials from 0 to 11
    for (n=1; n<12; ++n) {
      fact[n] = fact[n-1] * n
    }
    for (b=9; b<=12; ++b) {
      printf("base %d factorions:",b)
      for (i=1; i<1500000; ++i) {
        sum = 0
        j = i
        while (j > 0) {
          d = j % b
          sum += fact[d]
          j = int(j/b)
        }
        if (sum == i) {
          printf(" %d",i)
        }
      }
      printf("\n")
    }
    exit(0)
}


#include <stdio.h>

int main() {
    int n, b, d;
    unsigned long long i, j, sum, fact[12];
    // cache factorials from 0 to 11
    fact[0] = 1;
    for (n = 1; n < 12; ++n) {
        fact[n] = fact[n-1] * n;
    }

    for (b = 9; b <= 12; ++b) {
        printf("The factorions for base %d are:\n", b);
        for (i = 1; i < 1500000; ++i) {
            sum = 0;
            j = i;
            while (j > 0) {
                d = j % b;
                sum += fact[d];
                j /= b;
            }
            if (sum == i) printf("%llu ", i);
        }
        printf("\n\n");
    }
    return 0;
}