program m_by_n_sumofdgts_m;
//Like https://oeis.org/A131382/b131382.txt
{$IFDEF FPC} {$MODE DELPHI} {$OPTIMIZATION ON,ALL} {$ENDIF}
uses
  sysutils;
const
   BASE = 10;
   BASE4 = BASE*BASE*BASE*BASE;
   MAXDGTSUM4 = 4*(BASE-1);
var
  {$ALIGN 32}
  SoD: array[0..BASE4-1] of byte;
  {$ALIGN 32}
  DtgBase4 :array[0..7] of Uint32;
  DtgPartSums :array[0..7] of Uint32;
  DgtSumBefore :array[0..7] of Uint32;

procedure Init_SoD;
var
  d0,d1,i,j : NativeInt;
begin
  i := 0;
  For d1 := 0 to BASE-1 do
    For d0 := 0 to BASE-1 do
      begin SoD[i]:= d1+d0;inc(i); end;

  j := Base*Base;
  For i := 1 to Base*Base-1 do
    For d1 := 0 to BASE-1 do
      For d0 := 0 to BASE-1 do
      begin
        SoD[j] := SoD[i]+d1+d0;
        inc(j);
      end;
end;

procedure OutDgt;
var
   i : integer;
begin
  for i := 5 downto 0 do
    write(DtgBase4[i]:4);
  writeln;
  for i := 5 downto 0 do
    write(DtgPartSums[i]:4);
  writeln;
  for i := 5 downto 0 do
    write(DgtSumBefore[i]:4);
  writeln;
end;

procedure InitDigitSums(m:NativeUint);
var
  n,i,s: NativeUint;
begin
  //constructing minimal number with sum of digits = m ;k+9+9+9+9+9+9
  //21 -> 299
  n := m;
  if n>BASE then
  begin
    i := 1;
    while n>BASE-1 do
    begin
      i *= BASE;
      dec(n,BASE-1);
    end;
    n := i*(n+1)-1;
    //make n multiple of m
    n := (n div m)*m;
    //m ending in 0
    i := m;
    while i mod BASE = 0 do
    begin
      n *= BASE;
      i := i div BASE;
    end;
  end;

  For i := 0 to 4 do
  begin
    s := n MOD BASE4;
    DtgBase4[i] := s;
    DtgPartSums[i] := SoD[s];
    n := (n-s) DIV BASE4;
  end;

  s := 0;
  For i := 3 downto 0 do
  begin
    s += DtgPartSums[i+1];
    DgtSumBefore[i]:= s;
  end;
end;

function CorrectSums(sum:NativeUint):NativeUint;
var
i,q,carry : NativeInt;
begin
  i := 0;
  q := sum MOD Base4;
  sum := sum DIV Base4;
  result := q;

  DtgBase4[i] := q;
  DtgPartSums[i] := SoD[q];

  carry := 0;
  repeat
    inc(i);
    q := sum MOD Base4+DtgBase4[i]+carry;
    sum := sum DIV Base4;
    carry := 0;
    if q >= BASE4 then
    begin
      carry := 1;
      q -= BASE4;
    end;
    DtgBase4[i]:= q;
    DtgPartSums[i] := SoD[q];
  until (sum =0) AND( carry = 0);

  sum := 0;
  For i := 3 downto 0 do
  begin
    sum += DtgPartSums[i+1];
    DgtSumBefore[i]:= sum;
  end;
end;

function TakeJump(dgtSum,m:NativeUint):NativeUint;
var
  n,i,j,carry : nativeInt;
begin
  i := dgtsum div MAXDGTSUM4-1;
  n := 0;
  j := 1;
  for i := i downto 0 do
  Begin
    n:= n*BASE4+DtgBase4[i];
    j:= j*BASE4;
  end;
  n := ((j-n) DIV m)*m;
//  writeln(n:10,DtgBase4[i]:10);
  i := 0;
  carry := 0;
  repeat
    j := DtgBase4[i]+ n mod BASE4 +carry;
    n := n div BASE4;
    carry := 0;
    IF j >=BASE4 then
    begin
      j -= BASE4;
      carry := 1;
    end;
    DtgBase4[i] := j;
    DtgPartSums[i]:= SoD[j];
    inc(i);
  until (n= 0) AND (carry=0);
  j := 0;
  For i := 3 downto 0 do
  begin
    j += DtgPartSums[i+1];
    DgtSumBefore[i]:= j;
  end;
  result := DtgBase4[0];
end;

procedure CalcN(m:NativeUint);
var
  dgtsum,sum: NativeInt;
begin
  InitDigitSums(m);

  sum := DtgBase4[0];
  dgtSum:= m-DgtSumBefore[0];
  //  while dgtsum+SoD[sum] <> m do
  while dgtsum<>SoD[sum] do
  begin
    inc(sum,m);
    if sum >= BASE4 then
    begin
      sum := CorrectSums(sum);
      dgtSum:= m-DgtSumBefore[0];
      if dgtSum > MAXDGTSUM4 then
      begin
        sum := TakeJump(dgtSum,m);
        dgtSum:= m-DgtSumBefore[0];
      end;
    end;
  end;
  DtgBase4[0] := sum;
end;

var
  T0:INt64;
  i : NativeInt;
  m,n: NativeUint;
Begin
  T0 := GetTickCount64;
  Init_SoD;
  for m := 1 to 70 do
  begin
    CalcN(m);
    //Check sum of digits
    n := SoD[DtgBase4[4]];
    For i := 3 downto 0 do
      n += SoD[DtgBase4[i]];
    If n<>m then
    begin
      writeln('ERROR at ',m);
      HALT(-1);
    end;

    n := DtgBase4[4];
    For i := 3 downto 0 do
      n := n*BASE4+DtgBase4[i];
    write(n DIV m :15);
    if m mod 10 = 0 then
      writeln;
  end;
  writeln;
  writeln('Total runtime  ',GetTickCount64-T0,' ms');
  {$IFDEF WINDOWS} readln{$ENDIF}
end.


#!/usr/bin/perl

use strict; # https://rosettacode.org/wiki/Minimum_multiple_of_m_where_digital_sum_equals_m
use warnings;
use ntheory qw( sumdigits );

my @answers = map
  {
  my $m = 1;
  $m++ until sumdigits($m*$_) == $_;
  $m;
  } 1 .. 70;
print "@answers\n\n" =~ s/.{65}\K /\n/gr;


with javascript_semantics
integer c = 0, n = 1
while c<70 do
    integer m = 1
    while true do
        integer nm = n*m, t = 0
        while nm do
            t += remainder(nm,10)
            nm = floor(nm/10)
        end while
        if t=n then exit end if
        m += 1
    end while
    c += 1
    printf(1,"%-8d%s",{m,iff(remainder(c,10)=0?"\n":"")})
    n += 1
end while


main:-
    between(1, 40, N),
    min_mult_dsum(N, M),
    writef('%6r', [M]),
    (0 is N mod 10 -> nl ; true),
    fail.
main.

min_mult_dsum(N, M):-
    min_mult_dsum(N, 1, M).

min_mult_dsum(N, M, M):-
    P is M * N,
    digit_sum(P, N),
    !.
min_mult_dsum(N, K, M):-
    L is K + 1,
    min_mult_dsum(N, L, M).

digit_sum(N, Sum):-
    digit_sum(N, Sum, 0).

digit_sum(N, Sum, S1):-
    N < 10,
    !,
    Sum is S1 + N.
digit_sum(N, Sum, S1):-
    divmod(N, 10, M, Digit),
    S2 is S1 + Digit,
    digit_sum(M, Sum, S2).


'''A131382'''

from itertools import count, islice

# a131382 :: [Int]
def a131382():
    '''An infinite series of the terms of A131382'''
    return (
        elemIndex(x)(
            productDigitSums(x)
        ) for x in count(1)
    )

# productDigitSums :: Int -> [Int]
def productDigitSums(n):
    '''The sum of the decimal digits of n'''
    return (digitSum(n * x) for x in count(0))

# ------------------------- TEST -------------------------
# main :: IO ()
def main():
    '''First 40 terms of A131382'''

    print(
        table(10)([
            str(x) for x in islice(
                a131382(),
                40
            )
        ])
    )

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

# chunksOf :: Int -> [a] -> [[a]]
def chunksOf(n):
    '''A series of lists of length n, subdividing the
       contents of xs. Where the length of xs is not evenly
       divisible, the final list will be shorter than n.
    '''
    def go(xs):
        return (
            xs[i:n + i] for i in range(0, len(xs), n)
        ) if 0 < n else None
    return go

# digitSum :: Int -> Int
def digitSum(n):
    '''The sum of the digital digits of n.
    '''
    return sum(int(x) for x in list(str(n)))

# elemIndex :: a -> [a] -> (None | Int)
def elemIndex(x):
    '''Just the first index of x in xs,
       or None if no elements match.
    '''
    def go(xs):
        try:
            return next(
                i for i, v in enumerate(xs) if x == v
            )
        except StopIteration:
            return None
    return go

# table :: Int -> [String] -> String
def table(n):
    '''A list of strings formatted as
       right-justified rows of n columns.
    '''
    def go(xs):
        w = len(xs[-1])
        return '\n'.join(
            ' '.join(row) for row in chunksOf(n)([
                s.rjust(w, ' ') for s in xs
            ])
        )
    return go

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


sub min-mult-dsum ($n) { (1..∞).first: (* × $n).comb.sum == $n }

say .fmt("%2d: ") ~ .&min-mult-dsum for flat 1..40, 41..70;


var e = Enumerator({|f|
    for n in (1..Inf) {

        var k = 0
        while (k.sumdigits != n) {
            k += n
        }

        f(k/n)
    }
})

var N = 60
var A = []

e.each {|v|
    A << v
    say A.splice.map { '%7s' % _ }.join(' ') if (A.len == 10)
    break if (--N <= 0)
}


import Foundation

func digitSum(_ num: Int) -> Int {
    var sum = 0
    var n = num
    while n > 0 {
        sum += n % 10
        n /= 10
    }
    return sum
}

for n in 1...70 {
    for m in 1... {
        if digitSum(m * n) == n {
            print(String(format: "%8d", m), terminator: n % 10 == 0 ? "\n" : " ")
            break
        }
    }
}


import "./math" for Int
import "./seq" for Lst
import "./fmt" for Fmt

var res = []
for (n in 1..70) {
    var m = 1
    while (Int.digitSum(m * n) != n) m = m + 1
    res.add(m)
}
for (chunk in Lst.chunks(res, 10)) Fmt.print("$,10d", chunk)


func SumDigits(N);      \Return sum of digits in N
int  N, S;
[S:= 0;
while N do
    [N:= N/10;
    S:= S + rem(0);
    ];
return S;
];

int  C, N, M;
[C:= 0; N:= 1;
repeat  M:= 1;
        while SumDigits(N*M) # N do M:= M+1;
        IntOut(0, M);
        C:= C+1;
        if rem (C/10) then ChOut(0, 9\tab\) else CrLf(0);
        N:= N+1;
until   C >= 40+30;
]


with Ada.Text_IO;

procedure Modular_Demo is

   type Modul_13 is mod 13;

   function F (X : Modul_13) return Modul_13 is
   begin
      return X**100 + X + 1;
   end F;

   package Modul_13_IO is
      new Ada.Text_IO.Modular_IO (Modul_13);

   use Ada.Text_IO;
   use Modul_13_IO;
   X_Integer  : constant Integer  := 10;
   X_Modul_13 : constant Modul_13 := Modul_13'Mod (X_Integer);
   F_10       : constant Modul_13 := F (X_Modul_13);
begin
   Put ("f("); Put (X_Modul_13); Put (" mod "); Put (Modul_13'Modulus'Image); Put (") = ");
   Put (F_10); Put (" mod ");    Put (Modul_13'Modulus'Image);
   New_Line;
end Modular_Demo;


# allow for large integers in Algol 68G #
PR precision 200 PR

# modular integer type #
MODE MODULARINT = STRUCT( LONG LONG INT v, INT modulus );

# modular integer + and * operators #
# where both operands are modular, they must have the same modulus #
OP +  = ( MODULARINT a,     b )MODULARINT: ( ( v OF a + v OF b ) MOD modulus OF a, modulus OF a );
OP +  = ( MODULARINT a, INT b )MODULARINT: ( ( v OF a + b      ) MOD modulus OF a, modulus OF a );
OP *  = ( MODULARINT a,     b )MODULARINT: ( ( v OF a * v OF b ) MOD modulus OF a, modulus OF a );
OP ** = ( MODULARINT a, INT b )MODULARINT: ( ( v OF a ** b     ) MOD modulus OF a, modulus OF a );

# f(x) function - can be applied to either LONG LONG INT or MODULARINT values #
# the result is always a LONG LONG INT #
PROC f = ( UNION( LONG LONG INT, MODULARINT ) x )LONG LONG INT:
    CASE x
      IN ( LONG LONG INT ix ):      ( ix**100 + ix + 1 )
       , ( MODULARINT    mx ): v OF ( mx**100 + mx + 1 )
    ESAC;

print( ( whole( f( MODULARINT( 10, 13 ) ), 0 ), newline ) )


#include <stdio.h>

struct ModularArithmetic {
    int value;
    int modulus;
};

struct ModularArithmetic make(const int value, const int modulus) {
    struct ModularArithmetic r = { value % modulus, modulus };
    return r;
}

struct ModularArithmetic add(const struct ModularArithmetic a, const struct ModularArithmetic b) {
    return make(a.value + b.value, a.modulus);
}

struct ModularArithmetic addi(const struct ModularArithmetic a, const int v) {
    return make(a.value + v, a.modulus);
}

struct ModularArithmetic mul(const struct ModularArithmetic a, const struct ModularArithmetic b) {
    return make(a.value * b.value, a.modulus);
}

struct ModularArithmetic pow(const struct ModularArithmetic b, int pow) {
    struct ModularArithmetic r = make(1, b.modulus);
    while (pow-- > 0) {
        r = mul(r, b);
    }
    return r;
}

void print(const struct ModularArithmetic v) {
    printf("ModularArithmetic(%d, %d)", v.value, v.modulus);
}

struct ModularArithmetic f(const struct ModularArithmetic x) {
    return addi(add(pow(x, 100), x), 1);
}

int main() {
    struct ModularArithmetic input = make(10, 13);
    struct ModularArithmetic output = f(input);

    printf("f(");
    print(input);
    printf(") = ");
    print(output);
    printf("\n");

    return 0;
}


using System;

namespace ModularArithmetic {
    interface IAddition<T> {
        T Add(T rhs);
    }
    interface IMultiplication<T> {
        T Multiply(T rhs);
    }
    interface IPower<T> {
        T Power(int pow);
    }
    interface IOne<T> {
        T One();
    }

    class ModInt : IAddition<ModInt>, IMultiplication<ModInt>, IPower<ModInt>, IOne<ModInt> {
        private int modulo;

        public ModInt(int value, int modulo) {
            Value = value;
            this.modulo = modulo;
        }

        public int Value { get; }

        public ModInt One() {
            return new ModInt(1, modulo);
        }

        public ModInt Add(ModInt rhs) {
            return this + rhs;
        }

        public ModInt Multiply(ModInt rhs) {
            return this * rhs;
        }

        public ModInt Power(int pow) {
            return Pow(this, pow);
        }

        public override string ToString() {
            return string.Format("ModInt({0}, {1})", Value, modulo);
        }

        public static ModInt operator +(ModInt lhs, ModInt rhs) {
            if (lhs.modulo != rhs.modulo) {
                throw new ArgumentException("Cannot add rings with different modulus");
            }
            return new ModInt((lhs.Value + rhs.Value) % lhs.modulo, lhs.modulo);
        }

        public static ModInt operator *(ModInt lhs, ModInt rhs) {
            if (lhs.modulo != rhs.modulo) {
                throw new ArgumentException("Cannot add rings with different modulus");
            }
            return new ModInt((lhs.Value * rhs.Value) % lhs.modulo, lhs.modulo);
        }

        public static ModInt Pow(ModInt self, int p) {
            if (p < 0) {
                throw new ArgumentException("p must be zero or greater");
            }

            int pp = p;
            ModInt pwr = self.One();
            while (pp-- > 0) {
                pwr *= self;
            }
            return pwr;
        }
    }

    class Program {
        static T F<T>(T x) where T : IAddition<T>, IMultiplication<T>, IPower<T>, IOne<T> {
            return x.Power(100).Add(x).Add(x.One());
        }

        static void Main(string[] args) {
            ModInt x = new ModInt(10, 13);
            ModInt y = F(x);
            Console.WriteLine("x ^ 100 + x + 1 for x = {0} is {1}", x, y);
        }
    }
}


#include <iostream>
#include <ostream>

template<typename T>
T f(const T& x) {
    return (T) pow(x, 100) + x + 1;
}

class ModularInteger {
private:
    int value;
    int modulus;

    void validateOp(const ModularInteger& rhs) const {
        if (modulus != rhs.modulus) {
            throw std::runtime_error("Left-hand modulus does not match right-hand modulus.");
        }
    }

public:
    ModularInteger(int v, int m) {
        modulus = m;
        value = v % m;
    }

    int getValue() const {
        return value;
    }

    int getModulus() const {
        return modulus;
    }

    ModularInteger operator+(const ModularInteger& rhs) const {
        validateOp(rhs);
        return ModularInteger(value + rhs.value, modulus);
    }

    ModularInteger operator+(int rhs) const {
        return ModularInteger(value + rhs, modulus);
    }

    ModularInteger operator*(const ModularInteger& rhs) const {
        validateOp(rhs);
        return ModularInteger(value * rhs.value, modulus);
    }

    friend std::ostream& operator<<(std::ostream&, const ModularInteger&);
};

std::ostream& operator<<(std::ostream& os, const ModularInteger& self) {
    return os << "ModularInteger(" << self.value << ", " << self.modulus << ")";
}

ModularInteger pow(const ModularInteger& lhs, int pow) {
    if (pow < 0) {
        throw std::runtime_error("Power must not be negative.");
    }

    ModularInteger base(1, lhs.getModulus());
    while (pow-- > 0) {
        base = base * lhs;
    }
    return base;
}

int main() {
    using namespace std;

    ModularInteger input(10, 13);
    auto output = f(input);
    cout << "f(" << input << ") = " << output << endl;

    return 0;
}


import std.stdio;

version(unittest) {
    void assertEquals(T)(T actual, T expected) {
        import core.exception;
        import std.conv;
        if (actual != expected) {
            throw new AssertError("Actual [" ~ to!string(actual) ~ "]; Expected [" ~ to!string(expected) ~ "]");
        }
    }
}

void main() {
    auto input = ModularInteger(10,13);
    auto output = f(input);
    writeln("f(", input, ") = ", output);
}

V f(V)(const V x) {
    return x^^100 + x + 1;
}

/// Integer tests on f
unittest {
    assertEquals(f(1), 3);
    assertEquals(f(0), 1);
}

/// Floating tests on f
unittest {
    assertEquals(f(1.0), 3.0);
    assertEquals(f(0.0), 1.0);
}

struct ModularInteger {
    private:
    int value;
    int modulus;

    public:
    this(int value, int modulus) {
        this.modulus = modulus;
        this.value = value % modulus;
    }

    ModularInteger opBinary(string op : "+")(ModularInteger rhs) const in {
        assert(this.modulus == rhs.modulus);
    } body {
        return ModularInteger((this.value + rhs.value) % this.modulus, this.modulus);
    }

    ModularInteger opBinary(string op : "+")(int rhs) const {
        return ModularInteger((this.value + rhs) % this.modulus, this.modulus);
    }

    ModularInteger opBinary(string op : "*")(ModularInteger rhs) const in {
        assert(this.modulus == rhs.modulus);
        assert(this.value < this.modulus);
        assert(rhs.value < this.modulus);
    } body {
        return ModularInteger((this.value * rhs.value) % this.modulus, this.modulus);
    }

    ModularInteger opBinary(string op : "^^")(int pow) const in {
        assert(pow >= 0);
    } body {
        auto base = ModularInteger(1, this.modulus);
        while (pow-- > 0) {
            base = base * this;
        }
        return base;
    }

    string toString() {
        import std.format;
        return format("ModularInteger(%s, %s)", value, modulus);
    }
}

/// Addition with same type of int
unittest {
    auto a = ModularInteger(2,5);
    auto b = ModularInteger(3,5);
    assertEquals(a+b, ModularInteger(0,5));
}

/// Addition with differnt int types
unittest {
    auto a = ModularInteger(2,5);
    assertEquals(a+0, a);
    assertEquals(a+1, ModularInteger(3,5));
}

/// Muliplication
unittest {
    auto a = ModularInteger(2,5);
    auto b = ModularInteger(3,5);
    assertEquals(a*b, ModularInteger(1,5));
}

/// Power
unittest {
    const a = ModularInteger(3,13);
    assertEquals(a^^2, ModularInteger(9,13));
    assertEquals(a^^3, ModularInteger(1,13));

    const b = ModularInteger(10,13);
    assertEquals(b^^1, ModularInteger(10,13));
    assertEquals(b^^2, ModularInteger(9,13));
    assertEquals(b^^3, ModularInteger(12,13));
    assertEquals(b^^4, ModularInteger(3,13));
    assertEquals(b^^5, ModularInteger(4,13));
    assertEquals(b^^6, ModularInteger(1,13));
    assertEquals(b^^7, ModularInteger(10,13));
    assertEquals(b^^8, ModularInteger(9,13));
    assertEquals(b^^10, ModularInteger(3,13));
    assertEquals(b^^20, ModularInteger(9,13));
    assertEquals(b^^30, ModularInteger(1,13));
    assertEquals(b^^50, ModularInteger(9,13));
    assertEquals(b^^75, ModularInteger(12,13));
    assertEquals(b^^90, ModularInteger(1,13));
    assertEquals(b^^95, ModularInteger(4,13));
    assertEquals(b^^97, ModularInteger(10,13));
    assertEquals(b^^98, ModularInteger(9,13));
    assertEquals(b^^99, ModularInteger(12,13));
    assertEquals(b^^100, ModularInteger(3,13));
}


USING: accessors generalizations io kernel math math.functions
parser prettyprint prettyprint.custom sequences ;
IN: rosetta-code.modular-arithmetic
RENAME: ^ math.functions => **

! Define a modular integer class.
TUPLE: mod-int
    { n integer read-only } { mod integer read-only } ;

! Define a constructor for mod-int.
C: <mod-int> mod-int

ERROR: non-equal-modulus m1 m2 ;

! Define a literal syntax for mod-int.
<< SYNTAX: MI{ \ } [ first2 <mod-int> ] parse-literal ; >>

! Implement prettyprinting for mod-int custom syntax.
M: mod-int pprint-delims drop \ MI{ \ } ;
M: mod-int >pprint-sequence [ n>> ] [ mod>> ] bi { } 2sequence ;
M: mod-int pprint* pprint-object ;

<PRIVATE

! Helper words for displaying the results of an arithmetic
! operation.
: show ( quot -- )
    [ unparse 2 tail but-last "= " append write ] [ call . ] bi
    ; inline

: 2show ( quots -- )
    [ 2curry show ] map-compose [ call( -- ) ] each ; inline

! Check whether two mod-ints have the same modulus and throw an
! error if not.
: check-mod ( m1 m2 -- )
    2dup [ mod>> ] [email protected] = [ 2drop ] [ non-equal-modulus ] if ;

! Apply quot to the integer parts of two mod-ints and create a
! new mod-int from the result.
: mod-int-op ( m1 m2 quot -- m3 )
    [ [ n>> ] [email protected] ] prepose [ 2dup check-mod ] dip over
    mod>> [ call( x x -- x ) ] dip [ mod ] keep <mod-int>
    ; inline

! Promote an integer to a mod-int and call mod-int-op.
: integer-op ( obj1 obj2 quot -- mod-int )
    [
        dup integer?
        [ over mod>> <mod-int> ]
        [ dup [ mod>> <mod-int> ] dip ] if
    ] dip mod-int-op ; inline

! Apply quot, a binary function, to any combination of integers
! and mod-ints.
: binary-op ( obj1 obj2 quot -- mod-int )
    2over [ mod-int? ] both? [ mod-int-op ] [ integer-op ] if
    ; inline

PRIVATE>

! This is where the arithmetic words are 'redefined' by adding a
! method to them that specializes on the object class.
M: object + [ + ] binary-op ;
M: object - [ - ] binary-op ;
M: object * [ * ] binary-op ;
M: object /i [ /i ] binary-op ;

! ^ is a special case because it is not generic.
: ^ ( obj1 obj2 -- obj3 )
    2dup [ mod-int? ] either? [ [ ** ] binary-op ] [ ** ] if ;

: fn ( obj -- obj' ) dup 100 ^ + 1 + ;

: modular-arithmetic-demo ( -- )
    [ MI{ 10 13 } fn ]
    [ 2 fn ] [ show ] [email protected]
    {
        [ MI{ 10 13 } MI{ 5 13 } [ + ] ]
        [ MI{ 10 13 } 5 [ + ] ]
        [ 5 MI{ 10 13 } [ + ] ]
        [ MI{ 10 13 } 2 [ /i ] ]
        [ 5 10 [ * ] ]
        [ MI{ 3 7 } MI{ 4 7 } [ * ] ]
        [ MI{ 3 7 } 50 [ ^ ] ]
    } 2show ;

MAIN: modular-arithmetic-demo


\ We would normally define operators that have a suffix `m' in order
\ not to be confused:  +m -m *m /m **m
\ Also useful is %:m reduce a number modulo.

\ Words that may be not be present in the kernel.
\ This example loads them in ciforth.
WANT ALIAS VOCABULARY

VARIABLE _m ( Modulo number)
\ Set the modulus to  m .
: set-modulus  _m ! ;

\ For A B return C GCD where C*A+x*B=GCD
: XGCD 1 0 2SWAP   BEGIN OVER /MOD OVER WHILE >R SWAP
   2SWAP OVER R> * - SWAP 2SWAP REPEAT 2DROP NIP ;
\ Suffix n : normalized number.
: _norm_-m  DUP 0< _m @ AND + ; ( x -- xn ) \ -m<xn<+m
: +m   + _m @ - _norm_-m  ;   ( an bn -- sumn )
: -m   - _norm_-m  ;         ( an bn -- diffn)
: *m   M* _m @ SM/REM DROP ;  ( an bn -- prodn)
: /m    _m @ XGCD DROP _norm_-m  *m ; ( a b -- quotn)
: %:m  S>D _m @ SM/REM DROP _norm_-m  ;  ( a -- an)

\ Both steps: For A B and C: return A B en C.  Invariant A*B^C.
: _reduce_1-  1- >R >R    [email protected] *m   R> R> ;
: _reduce_2/  2/ >R    DUP *m        R> ;
( a b -- apowbn )
: **m    1 ROT ROT BEGIN   DUP 1 AND IF   _reduce_1-   THEN
    _reduce_2/ DUP 0= UNTIL   2DROP   ;

\ The solution is
13 set-modulus
10  DUP 100 **m +m 1 +m . CR

\ In order to comply with the problem we can generate a separate namespace
\ and import the above definitions.

VOCABULARY MODULO
ALSO MODULO DEFINITIONS
' set-modulus ALIAS set-modulus
' +m   ALIAS   +
' -m   ALIAS   -
' *m   ALIAS   *
' /m   ALIAS   /
' **m  ALIAS   **
' %:m   ALIAS   %:m

\ now the calculation becomes
13 set-modulus
10  DUP 100 ** + 1 + . CR


package main

import "fmt"

// Define enough of a ring to meet the needs of the task.  Addition and
// multiplication are mentioned in the task; multiplicative identity is not
// mentioned but is useful for the power function.

type ring interface {
    add(ringElement, ringElement) ringElement
    mul(ringElement, ringElement) ringElement
    mulIdent() ringElement
}

type ringElement interface{}

// Define a power function that works for any ring.

func ringPow(r ring, a ringElement, p uint) (pow ringElement) {
    for pow = r.mulIdent(); p > 0; p-- {
        pow = r.mul(pow, a)
    }
    return
}

// The task function f has that constant 1 in it.
// Define a special kind of ring that has this element.

type oneRing interface {
    ring
    one() ringElement // return ring element corresponding to '1'
}

// Now define the required function f.
// It works for any ring (that has a "one.")

func f(r oneRing, x ringElement) ringElement {
    return r.add(r.add(ringPow(r, x, 100), x), r.one())
}

// With rings and the function f defined in a general way, now define
// the specific ring of integers modulo n.

type modRing uint // value is congruence modulus n

func (m modRing) add(a, b ringElement) ringElement {
    return (a.(uint) + b.(uint)) % uint(m)
}

func (m modRing) mul(a, b ringElement) ringElement {
    return (a.(uint) * b.(uint)) % uint(m)
}

func (modRing) mulIdent() ringElement { return uint(1) }

func (modRing) one() ringElement { return uint(1) }

// Demonstrate the general function f on the specific ring with the
// specific values.

func main() {
    fmt.Println(f(modRing(13), uint(10)))
}


-- We use a couple of GHC extensions to make the program cooler.  They let us
-- use / as an operator and 13 as a literal at the type level.  (The library
-- also provides the fancy Zahlen (ℤ) symbol as a synonym for Integer.)

{-# Language DataKinds #-}
{-# Language TypeOperators #-}

import Data.Modular

f :: ℤ/13 -> ℤ/13
f x = x^100 + x + 1

main :: IO ()
main = print (f 10)


public class ModularArithmetic {
    private interface Ring<T> {
        Ring<T> plus(Ring<T> rhs);

        Ring<T> times(Ring<T> rhs);

        int value();

        Ring<T> one();

        default Ring<T> pow(int p) {
            if (p < 0) {
                throw new IllegalArgumentException("p must be zero or greater");
            }

            int pp = p;
            Ring<T> pwr = this.one();
            while (pp-- > 0) {
                pwr = pwr.times(this);
            }
            return pwr;
        }
    }

    private static class ModInt implements Ring<ModInt> {
        private int value;
        private int modulo;

        private ModInt(int value, int modulo) {
            this.value = value;
            this.modulo = modulo;
        }

        @Override
        public Ring<ModInt> plus(Ring<ModInt> other) {
            if (!(other instanceof ModInt)) {
                throw new IllegalArgumentException("Cannot add an unknown ring.");
            }
            ModInt rhs = (ModInt) other;
            if (modulo != rhs.modulo) {
                throw new IllegalArgumentException("Cannot add rings with different modulus");
            }
            return new ModInt((value + rhs.value) % modulo, modulo);
        }

        @Override
        public Ring<ModInt> times(Ring<ModInt> other) {
            if (!(other instanceof ModInt)) {
                throw new IllegalArgumentException("Cannot multiple an unknown ring.");
            }
            ModInt rhs = (ModInt) other;
            if (modulo != rhs.modulo) {
                throw new IllegalArgumentException("Cannot multiply rings with different modulus");
            }
            return new ModInt((value * rhs.value) % modulo, modulo);
        }

        @Override
        public int value() {
            return value;
        }

        @Override
        public Ring<ModInt> one() {
            return new ModInt(1, modulo);
        }

        @Override
        public String toString() {
            return String.format("ModInt(%d, %d)", value, modulo);
        }
    }

    private static <T> Ring<T> f(Ring<T> x) {
        return x.pow(100).plus(x).plus(x.one());
    }

    public static void main(String[] args) {
        ModInt x = new ModInt(10, 13);
        Ring<ModInt> y = f(x);
        System.out.print("x ^ 100 + x + 1 for x = ModInt(10, 13) is ");
        System.out.println(y);
        System.out.flush();
    }
}


def assert($e; $msg): if $e then . else "assertion violation @ \($msg)" | error end;

def is_integer: type=="number" and floor == .;

# To take advantage of gojq's arbitrary-precision integer arithmetic:
def power($b): . as $in | reduce range(0;$b) as $i (1; . * $in);


struct Modulo{T<:Integer} <: Integer
    val::T
    mod::T
    Modulo(n::T, m::T) where T = new{T}(mod(n, m), m)
end
modulo(n::Integer, m::Integer) = Modulo(promote(n, m)...)

Base.show(io::IO, md::Modulo) = print(io, md.val, " (mod $(md.mod))")
Base.convert(::Type{T}, md::Modulo) where T<:Integer = convert(T, md.val)
Base.copy(md::Modulo{T}) where T = Modulo{T}(md.val, md.mod)

Base.:+(md::Modulo) = copy(md)
Base.:-(md::Modulo) = Modulo(md.mod - md.val, md.mod)
for op in (:+, :-, :*, :÷, :^)
    @eval function Base.$op(a::Modulo, b::Integer)
        val = $op(a.val, b)
        return Modulo(mod(val, a.mod), a.mod)
    end
    @eval Base.$op(a::Integer, b::Modulo) = $op(b, a)
    @eval function Base.$op(a::Modulo, b::Modulo)
        if a.mod != b.mod throw(InexactError()) end
        val = $op(a.val, b.val)
        return Modulo(mod(val, a.mod), a.mod)
    end
end

f(x) = x ^ 100 + x + 1
@show f(modulo(10, 13))


// version 1.1.3

interface Ring<T> {
    operator fun plus(other: Ring<T>): Ring<T>
    operator fun times(other: Ring<T>): Ring<T>
    val value: Int
    val one: Ring<T>
}

fun <T> Ring<T>.pow(p: Int): Ring<T> {
    require(p >= 0)
    var pp = p
    var pwr = this.one
    while (pp-- > 0) pwr *= this
    return pwr
}

class ModInt(override val value: Int, val modulo: Int): Ring<ModInt> {

    override operator fun plus(other: Ring<ModInt>): ModInt {
        require(other is ModInt &&  modulo == other.modulo)
        return ModInt((value + other.value) % modulo, modulo)
    }

    override operator fun times(other: Ring<ModInt>): ModInt {
        require(other is ModInt && modulo == other.modulo)
        return ModInt((value * other.value) % modulo, modulo)
    }

    override val one get() = ModInt(1, modulo)

    override fun toString() = "ModInt($value, $modulo)"
}

fun <T> f(x: Ring<T>): Ring<T> = x.pow(100) + x + x.one

fun main(args: Array<String>) {
    val x = ModInt(10, 13)
    val y = f(x)
    println("x ^ 100 + x + 1 for x == ModInt(10, 13) is $y")
}


function make(value, modulo)
    local v = value % modulo
    local tbl = {value=v, modulo=modulo}

    local mt = {
        __add = function(lhs, rhs)
            if type(lhs) == "table" then
                if type(rhs) == "table" then
                    if lhs.modulo ~= rhs.modulo then
                        error("Cannot add rings with different modulus")
                    end
                    return make(lhs.value + rhs.value, lhs.modulo)
                else
                    return make(lhs.value + rhs, lhs.modulo)
                end
            else
                error("lhs is not a table in +")
            end
        end,
        __mul = function(lhs, rhs)
            if lhs.modulo ~= rhs.modulo then
                error("Cannot multiply rings with different modulus")
            end
            return make(lhs.value * rhs.value, lhs.modulo)
        end,
        __pow = function(b,p)
            if p<0 then
                error("p must be zero or greater")
            end

            local pp = p
            local pwr = make(1, b.modulo)
            while pp > 0 do
                pp = pp - 1
                pwr = pwr * b
            end
            return pwr
        end,
        __concat = function(lhs, rhs)
            if type(lhs) == "table" and type(rhs) == "string" then
                return "ModInt("..lhs.value..", "..lhs.modulo..")"..rhs
            elseif type(lhs) == "string" and type(rhs) == "table" then
                return lhs.."ModInt("..rhs.value..", "..rhs.modulo..")"
            else
                return "todo"
            end
        end
    }

    setmetatable(tbl, mt)
    return tbl
end

function func(x)
    return x ^ 100 + x + 1
end

-- main
local x = make(10, 13)
local y = func(x)
print("x ^ 100 + x + 1 for "..x.." is "..y)


import macros, sequtils, strformat, strutils

const Subscripts: array['0'..'9', string] = ["₀", "₁", "₂", "₃", "₄", "₅", "₆", "₇", "₈", "₉"]

# Modular integer with modulus N.
type ModInt[N: static int] = distinct int

#---------------------------------------------------------------------------------------------------
# Creation.

func initModInt[N](n: int): ModInt[N] =
  ## Create a modular integer from an integer.
  static:
    when N < 2: error "Modulus must be greater than 1."
  if n >= N: raise newException(ValueError, &"value must be in 0..{N - 1}.")
  result = ModInt[N](n)

#---------------------------------------------------------------------------------------------------
# Arithmetic operations: ModInt op ModInt, ModInt op int and int op ModInt.

func `+`*[N](a, b: ModInt[N]): ModInt[N] =
  ModInt[N]((a.int + b.int) mod N)

func `+`*[N](a: ModInt[N]; b: int): ModInt[N] =
  a + initModInt[N](b)

func `+`*[N](a: int; b: ModInt[N]): ModInt[N] =
  initModInt[N](a) + b

func `*`*[N](a, b: ModInt[N]): ModInt[N] =
  ModInt[N]((a.int * b.int) mod N)

func `*`*[N](a: ModInt[N]; b: int): ModInt[N] =
  a * initModInt[N](b)

func `*`*[N](a: int; b: ModInt[N]): ModInt[N] =
  initModInt[N](a) * b

func `^`*[N](a: ModInt[N]; n: Natural): ModInt[N] =
  var a = a
  var n = n
  result = initModInt[N](1)
  while n > 0:
    if (n and 1) != 0:
      result = result * a
    n = n shr 1
    a = a * a

#---------------------------------------------------------------------------------------------------
# Representation of a modular integer as a string.

template subscript(n: Natural): string =
  mapIt($n, Subscripts[it]).join()

func `$`(a: ModInt): string =
  &"{a.int}{subscript(a.N)})"

#---------------------------------------------------------------------------------------------------
# The function "f" defined for any modular integer, the same way it would be defined for an
# integer argument (except that such a function would be of no use as it would overflow for
# any argument different of 0 and 1).

func f(x: ModInt): ModInt = x^100 + x + 1

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

when isMainModule:

  var x = initModInt[13](10)
  echo &"f({x}) = {x}^100 + {x} + 1 = {f(x)}."


use Math::ModInt qw(mod);
sub f { my $x = shift; $x**100 + $x + 1 };
print f mod(10, 13);


type mi(object m)
    return sequence(m) and length(m)=2 and integer(m[1]) and integer(m[2])
end type

type mii(object m)
    return mi(m) or atom(m)
end type

function mi_one(mii a)
    if atom(a) then a=1 else a = {1,a[2]} end if
    return a
end function

function mi_add(mii a, mii b)
    if atom(a) then
        if not atom(b) then throw("error") end if
        return a+b
    end if
    if a[2]!=b[2] then throw("error") end if
    a[1] = mod(a[1]+b[1],a[2])
    return a
end function

function mi_mul(mii a, mii b)
    if atom(a) then
        if not atom(b) then throw("error") end if
        return a*b
    end if
    if a[2]!=b[2] then throw("error") end if
    a[1] = mod(a[1]*b[1],a[2])
    return a
end function

function mi_power(mii x, integer p)
    mii res = mi_one(x)
    for i=1 to p do
        res = mi_mul(res,x)
    end for
    return res
end function

function mi_print(mii m)
    return sprintf(iff(atom(m)?"%g":"modint(%d,%d)"),m)
end function

function f(mii x)
    return mi_add(mi_power(x,100),mi_add(x,mi_one(x)))
end function

procedure test(mii x)
    printf(1,"x^100 + x + 1 for x == %s is %s\n",{mi_print(x),mi_print(f(x))})
end procedure
test(10)
test({10,13})


:- use_module(library(lambda)).

congruence(Congruence,  In, Fun, Out) :-
	maplist(Congruence +\X^Y^(Y is X mod Congruence), In, In1),
	call(Fun, In1, Out1),
	maplist(Congruence +\X^Y^(Y is X mod Congruence), Out1, Out).

fun_1([X], [Y]) :-
	Y is X^100 + X + 1.

fun_2(L, [R]) :-
	sum_list(L, R).


import operator
import functools

@functools.total_ordering
class Mod:
    __slots__ = ['val','mod']

    def __init__(self, val, mod):
        if not isinstance(val, int):
            raise ValueError('Value must be integer')
        if not isinstance(mod, int) or mod<=0:
            raise ValueError('Modulo must be positive integer')
        self.val = val % mod
        self.mod = mod

    def __repr__(self):
        return 'Mod({}, {})'.format(self.val, self.mod)

    def __int__(self):
        return self.val

    def __eq__(self, other):
        if isinstance(other, Mod):
            if self.mod == other.mod:
                return self.val==other.val
            else:
                return NotImplemented
        elif isinstance(other, int):
            return self.val == other
        else:
            return NotImplemented

    def __lt__(self, other):
        if isinstance(other, Mod):
            if self.mod == other.mod:
                return self.val<other.val
            else:
                return NotImplemented
        elif isinstance(other, int):
            return self.val < other
        else:
            return NotImplemented

    def _check_operand(self, other):
        if not isinstance(other, (int, Mod)):
            raise TypeError('Only integer and Mod operands are supported')
        if isinstance(other, Mod) and self.mod != other.mod:
            raise ValueError('Inconsistent modulus: {} vs. {}'.format(self.mod, other.mod))

    def __pow__(self, other):
        self._check_operand(other)
        # We use the built-in modular exponentiation function, this way we can avoid working with huge numbers.
        return Mod(pow(self.val, int(other), self.mod), self.mod)

    def __neg__(self):
        return Mod(self.mod - self.val, self.mod)

    def __pos__(self):
        return self # The unary plus operator does nothing.

    def __abs__(self):
        return self # The value is always kept non-negative, so the abs function should do nothing.

# Helper functions to build common operands based on a template.
# They need to be implemented as functions for the closures to work properly.
def _make_op(opname):
    op_fun = getattr(operator, opname)  # Fetch the operator by name from the operator module
    def op(self, other):
        self._check_operand(other)
        return Mod(op_fun(self.val, int(other)) % self.mod, self.mod)
    return op

def _make_reflected_op(opname):
    op_fun = getattr(operator, opname)
    def op(self, other):
        self._check_operand(other)
        return Mod(op_fun(int(other), self.val) % self.mod, self.mod)
    return op

# Build the actual operator overload methods based on the template.
for opname, reflected_opname in [('__add__', '__radd__'), ('__sub__', '__rsub__'), ('__mul__', '__rmul__')]:
    setattr(Mod, opname, _make_op(opname))
    setattr(Mod, reflected_opname, _make_reflected_op(opname))

def f(x):
    return x**100+x+1

print(f(Mod(10,13)))
# Output: Mod(1, 13)


[ stack ]                        is modulus           (     --> s )

[ this ]                         is modular           (     --> [ )

[ modulus share mod
  modular nested join ]          is modularise        (   n --> N )

[ dup nest? iff
    [ -1 peek modular oats ]
  else [ drop false ] ]          is modular?          (   N --> b )

[ modular? swap
  modular? or ]                  is 2modular?         ( N N --> b )

[ dup modular? if [ 0 peek ] ]   is demodularise      (   N --> n )

[ demodularise swap
  demodularise swap ]            is 2demodularise     ( N N --> n )

[ dup $ '' = if
    [ $ '"modularify(2-->1)" '
      $ "needs a name after it."
      join message put bail ]
  nextword
  $ "[ 2dup 2modular? iff
     [ 2demodularise " over join
  $ " modularise ]
      else " join over join
  $ " ] is " join swap join
  space join
  swap join ]                builds modularify(2-->1) (     -->   )

( --------------------------------------------------------------- )

                  modularify(2-->1) +                 ( N N --> N )

                  modularify(2-->1) **                ( N N --> N )

( --------------------------------------------------------------- )

[ dup 100 ** + 1 + ]             is f                 (   N --> N )

13 modulus put
10 f echo cr
10 modularise f echo
modulus release cr


#lang racket
(require racket/require
         ;; grab all "mod*" names, but get them without the "mod", so
         ;; `+' and `expt' is actually `mod+' and `modexpt'
         (filtered-in (λ(n) (and (regexp-match? #rx"^mod" n)
                                 (regexp-replace #rx"^mod" n "")))
                      math)
         (only-in math with-modulus))
(define (f x) (+ (expt x 100) x 1))
(with-modulus 13 (f 10))
;; => 1


use Modular;
sub f(\x) { x**100 + x + 1};
say f( 10 Mod 13 )


Red ["Modular arithmetic"]

; defining the modular integer class, and a constructor
modulus: 13
m: function [n] [
	either object? n [make n []] [context [val: n % modulus]]
]
; redefining operators +, -, *, / to include modular integers
foreach [op fun][+ add - subtract * multiply / divide][
	set op make op! function [a b] compose/deep [
		either any [object? a object? b][
			a: m a
			b: m b
			m (fun) a/val b/val
		][(fun) a b]
	]
]
; redefining power - ** ; second operand must be an integer
**: make op! function [a n] [
	either object? a [
		tmp: 1
		loop n [tmp: tmp * a/val % modulus]
		m tmp
	][power a n]
]
; testing
f: function [x] [x ** 100 + x + 1]
print ["f definition is:" mold :f]
print ["f((integer) 10) is:" f 10]
print ["f((modular) 10) is: (modular)" f m 10]


# stripped version of Andrea Fazzi's submission to Ruby Quiz #179

class Modulo
  include Comparable

  def initialize(n = 0, m = 13)
    @n, @m = n % m, m
  end

  def to_i
    @n
  end

  def <=>(other_n)
    @n <=> other_n.to_i
  end

  [:+, :-, :*, :**].each do |meth|
    define_method(meth) { |other_n| Modulo.new(@n.send(meth, other_n.to_i), @m) }
  end

  def coerce(numeric)
    [numeric, @n]
  end

end

# Demo
x, y = Modulo.new(10), Modulo.new(20)

p x > y          # true
p x == y         # false
p [x,y].sort     #[#<Modulo:0x000000012ae0f8 @n=7, @m=13>, #<Modulo:0x000000012ae148 @n=10, @m=13>]
p x + y          ##<Modulo:0x0000000117e110 @n=4, @m=13>
p 2 + y          # 9
p y + 2          ##<Modulo:0x00000000ad1d30 @n=9, @m=13>

p x**100 + x +1  ##<Modulo:0x00000000ad1998 @n=1, @m=13>


object ModularArithmetic extends App {
  private val x = new ModInt(10, 13)
  private val y = f(x)

  private def f[T](x: Ring[T]) = (x ^ 100) + x + x.one

  private trait Ring[T] {
    def +(rhs: Ring[T]): Ring[T]

    def *(rhs: Ring[T]): Ring[T]

    def one: Ring[T]

    def ^(p: Int): Ring[T] = {
      require(p >= 0, "p must be zero or greater")
      var pp = p
      var pwr = this.one
      while ( {
        pp -= 1;
        pp
      } >= 0) pwr = pwr * this
      pwr
    }
  }

  private class ModInt(var value: Int, var modulo: Int) extends Ring[ModInt] {
    def +(other: Ring[ModInt]): Ring[ModInt] = {
      require(other.isInstanceOf[ModInt], "Cannot add an unknown ring.")
      val rhs = other.asInstanceOf[ModInt]
      require(modulo == rhs.modulo, "Cannot add rings with different modulus")
      new ModInt((value + rhs.value) % modulo, modulo)
    }

    def *(other: Ring[ModInt]): Ring[ModInt] = {
      require(other.isInstanceOf[ModInt], "Cannot multiple an unknown ring.")
      val rhs = other.asInstanceOf[ModInt]
      require(modulo == rhs.modulo,
        "Cannot multiply rings with different modulus")
      new ModInt((value * rhs.value) % modulo, modulo)
    }

    override def one = new ModInt(1, modulo)

    override def toString: String = f"ModInt($value%d, $modulo%d)"
  }

  println("x ^ 100 + x + 1 for x = ModInt(10, 13) is " + y)

}


class Modulo(n=0, m=13) {

  method init {
     (n, m) = (n % m, m)
  }

  method to_n { n }

  < + - * ** >.each { |meth|
      Modulo.def_method(meth, method(n2) { Modulo(n.(meth)(n2.to_n), m) })
  }

  method to_s { "#{n} 「mod #{m}」" }
}

func f(x) { x**100 + x + 1 }
say f(Modulo(10, 13))


precedencegroup ExponentiationGroup {
  higherThan: MultiplicationPrecedence
}

infix operator ** : ExponentiationGroup

protocol Ring {
  associatedtype RingType: Numeric

  var one: Self { get }

  static func +(_ lhs: Self, _ rhs: Self) -> Self
  static func *(_ lhs: Self, _ rhs: Self) -> Self
  static func **(_ lhs: Self, _ rhs: Int) -> Self
}

extension Ring  {
  static func **(_ lhs: Self, _ rhs: Int) -> Self {
    var ret = lhs.one

    for _ in stride(from: rhs, to: 0, by: -1) {
      ret = ret * lhs
    }

    return ret
  }
}

struct ModInt: Ring {
  typealias RingType = Int

  var value: Int
  var modulo: Int

  var one: ModInt { ModInt(1, modulo: modulo) }

  init(_ value: Int, modulo: Int) {
    self.value = value
    self.modulo = modulo
  }

  static func +(lhs: ModInt, rhs: ModInt) -> ModInt {
    precondition(lhs.modulo == rhs.modulo)

    return ModInt((lhs.value + rhs.value) % lhs.modulo, modulo: lhs.modulo)
  }

  static func *(lhs: ModInt, rhs: ModInt) -> ModInt {
    precondition(lhs.modulo == rhs.modulo)

    return ModInt((lhs.value * rhs.value) % lhs.modulo, modulo: lhs.modulo)
  }
}

func f<T: Ring>(_ x: T) -> T { (x ** 100) + x + x.one }

let x = ModInt(10, modulo: 13)
let y = f(x)

print("x ^ 100 + x + 1 for x = ModInt(10, 13) is \(y)")


package require Tcl 8.6
package require pt::pgen

###
### A simple expression parser for a subset of Tcl's expression language
###

# Define the grammar of expressions that we want to handle
set grammar {
PEG Calculator (Expression)
    Expression	<- Term (' '* AddOp ' '* Term)*			;
    Term	<- Factor (' '* MulOp ' '* Factor)*		;
    Fragment	<- '(' ' '* Expression ' '*  ')' / Number / Var	;
    Factor	<- Fragment (' '* PowOp ' '* Fragment)*		;
    Number	<- Sign? Digit+					;
    Var		<- '$' ( 'x'/'y'/'z' )				;

    Digit	<- '0'/'1'/'2'/'3'/'4'/'5'/'6'/'7'/'8'/'9'	;
    Sign	<- '-' / '+'					;
    MulOp	<- '*' / '/'					;
    AddOp	<- '+' / '-'					;
    PowOp	<- '**'						;
END;
}

# Instantiate the parser class
catch [pt::pgen peg $grammar snit -class Calculator -name Grammar]

# An engine that compiles an expression into Tcl code
oo::class create CompileAST {
    variable sourcecode opns
    constructor {semantics} {
	set opns $semantics
    }
    method compile {script} {
	# Instantiate the parser
	set c [Calculator]
	set sourcecode $script
	try {
	    return [my {*}[$c parset $script]]
	} finally {
	    $c destroy
	}
    }

    method Expression-Empty args {}
    method Expression-Compound {from to args} {
	foreach {o p} [list Expression-Empty {*}$args] {
	    set o [my {*}$o]; set p [my {*}$p]
	    set v [expr {$o ne "" ? "$o \[$v\] \[$p\]" : $p}]
	}
	return $v
    }
    forward Expression	my Expression-Compound
    forward Term	my Expression-Compound
    forward Factor	my Expression-Compound
    forward Fragment	my Expression-Compound

    method Expression-Operator {from to args} {
	list ${opns} [string range $sourcecode $from $to]
    }
    forward AddOp	my Expression-Operator
    forward MulOp	my Expression-Operator
    forward PowOp	my Expression-Operator

    method Number {from to args} {
	list ${opns} value [string range $sourcecode $from $to]
    }

    method Var {from to args} {
	list ${opns} variable [string range $sourcecode [expr {$from+1}] $to]
    }
}


Option Base 1
Private Function mi_one(ByVal a As Variant) As Variant
    If IsArray(a) Then
        a(1) = 1
    Else
        a = 1
    End If
    mi_one = a
End Function

Private Function mi_add(ByVal a As Variant, b As Variant) As Variant
    If IsArray(a) Then
        If IsArray(b) Then
             If a(2) <> b(2) Then
                mi_add = CVErr(2019)
            Else
                a(1) = (a(1) + b(1)) Mod a(2)
                mi_add = a
            End If
        Else
            mi_add = CVErr(2018)
        End If
    Else
        If IsArray(b) Then
            mi_add = CVErr(2018)
        Else
           a = a + b
           mi_add = a
        End If
    End If
End Function

Private Function mi_mul(ByVal a As Variant, b As Variant) As Variant
    If IsArray(a) Then
        If IsArray(b) Then
            If a(2) <> b(2) Then
                mi_mul = CVErr(2019)
            Else
                a(1) = (a(1) * b(1)) Mod a(2)
                mi_mul = a
            End If
        Else
            mi_mul = CVErr(2018)
        End If
    Else
        If IsArray(b) Then
            mi_mul = CVErr(2018)
        Else
            a = a * b
            mi_mul = a
        End If
    End If
End Function

Private Function mi_power(x As Variant, p As Integer) As Variant
    res = mi_one(x)
    For i = 1 To p
        res = mi_mul(res, x)
    Next i
    mi_power = res
End Function

Private Function mi_print(m As Variant) As Variant
    If IsArray(m) Then
        s = "modint(" & m(1) & "," & m(2) & ")"
    Else
        s = CStr(m)
    End If
    mi_print = s
End Function

Private Function f(x As Variant) As Variant
    f = mi_add(mi_power(x, 100), mi_add(x, mi_one(x)))
End Function

Private Sub test(x As Variant)
    Debug.Print "x^100 + x + 1 for x == " & mi_print(x) & " is " & mi_print(f(x))
End Sub
Public Sub main()
    test 10
    test [{10,13}]
End Sub


Module Module1

    Interface IAddition(Of T)
        Function Add(rhs As T) As T
    End Interface

    Interface IMultiplication(Of T)
        Function Multiply(rhs As T) As T
    End Interface

    Interface IPower(Of T)
        Function Power(pow As Integer) As T
    End Interface

    Interface IOne(Of T)
        Function One() As T
    End Interface

    Class ModInt
        Implements IAddition(Of ModInt), IMultiplication(Of ModInt), IPower(Of ModInt), IOne(Of ModInt)

        Sub New(value As Integer, modulo As Integer)
            Me.Value = value
            Me.Modulo = modulo
        End Sub

        ReadOnly Property Value As Integer
        ReadOnly Property Modulo As Integer

        Public Function Add(rhs As ModInt) As ModInt Implements IAddition(Of ModInt).Add
            Return Me + rhs
        End Function

        Public Function Multiply(rhs As ModInt) As ModInt Implements IMultiplication(Of ModInt).Multiply
            Return Me * rhs
        End Function

        Public Function Power(pow_ As Integer) As ModInt Implements IPower(Of ModInt).Power
            Return Pow(Me, pow_)
        End Function

        Public Function One() As ModInt Implements IOne(Of ModInt).One
            Return New ModInt(1, Modulo)
        End Function

        Public Overrides Function ToString() As String
            Return String.Format("ModInt({0}, {1})", Value, Modulo)
        End Function

        Public Shared Operator +(lhs As ModInt, rhs As ModInt) As ModInt
            If lhs.Modulo <> rhs.Modulo Then
                Throw New ArgumentException("Cannot add rings with different modulus")
            End If
            Return New ModInt((lhs.Value + rhs.Value) Mod lhs.Modulo, lhs.Modulo)
        End Operator

        Public Shared Operator *(lhs As ModInt, rhs As ModInt) As ModInt
            If lhs.Modulo <> rhs.Modulo Then
                Throw New ArgumentException("Cannot multiply rings with different modulus")
            End If
            Return New ModInt((lhs.Value * rhs.Value) Mod lhs.Modulo, lhs.Modulo)
        End Operator

        Public Shared Function Pow(self As ModInt, p As Integer) As ModInt
            If p < 0 Then
                Throw New ArgumentException("p must be zero or greater")
            End If

            Dim pp = p
            Dim pwr = self.One()
            While pp > 0
                pp -= 1
                pwr *= self
            End While
            Return pwr
        End Function
    End Class

    Function F(Of T As {IAddition(Of T), IMultiplication(Of T), IPower(Of T), IOne(Of T)})(x As T) As T
        Return x.Power(100).Add(x).Add(x.One)
    End Function

    Sub Main()
        Dim x As New ModInt(10, 13)
        Dim y = F(x)
        Console.WriteLine("x ^ 100 + x + 1 for x = {0} is {1}", x, y)
    End Sub

End Module


// Semi-abstract though we can define a 'pow' method in terms of the other operations.
class Ring {
    +(other) {}
    *(other) {}
    one      {}

    pow(p) {
        if (p.type != Num || !p.isInteger || p < 0) {
            Fiber.abort("Argument must be non-negative integer.")
        }
        var pwr = one
        while (p > 0) {
            pwr = pwr * this
            p = p - 1
        }
        return pwr
    }
}

class ModInt is Ring {
    construct new(value, modulo) {
        _value = value
        _modulo = modulo
    }

    value  { _value }
    modulo { _modulo }

    +(other) {
        if (other.type != ModInt || _modulo != other.modulo) {
            Fiber.abort("Argument must be a ModInt with the same modulus.")
        }
        return ModInt.new((_value + other.value) % _modulo, _modulo)
    }

    *(other) {
        if (other.type != ModInt || _modulo != other.modulo) {
            Fiber.abort("Argument must be a ModInt with the same modulus.")
        }
        return ModInt.new((_value * other.value) % _modulo, _modulo)
    }

    one { ModInt.new(1, _modulo) }

    toString { "Modint(%(_value), %(_modulo))" }
}

var f = Fn.new { |x|
    if (!(x is Ring)) Fiber.abort("Argument must be a Ring.")
    return x.pow(100) + x + x.one
}

var x = ModInt.new(10, 13)
System.print("x^100 + x + 1 for x = %(x) is %(f.call(x))")


class MC{
   fcn init(n,mod){ var N=n,M=mod; }
   fcn toString   { String(N.divr(M)[1],"M",M) }
   fcn pow(p)     { self( N.pow(p).divr(M)[1], M ) }
   fcn __opAdd(mc){
      if(mc.isType(Int)) z:=N+mc; else z:=N*M + mc.N*mc.M;
      self(z.divr(M)[1],M)
   }
}


T Mintab
   Set[Int] divs, subs
   [Int] table
   [[String]] hows

   F (divs, subs)
      .divs = copy(divs)
      .subs = copy(subs)

   F _mintab(n)
      ‘Tabulation, memoised minimised steps to 1’
      V table = [n + 2] * (n + 1)
      table[1] = 0
      V how = (0 .< n + 2).map(_ -> [‘’])
      how[1] = [String(‘=’)]
      L(t) 1 .< n
         V thisplus1 = table[t] + 1
         L(d) .divs
            V dt = d * t
            I dt <= n & thisplus1 < table[dt]
               table[dt] = thisplus1
               how[dt] = how[t] [+] [‘/#.=>#2’.format(d, t)]
         L(s) .subs
            V st = s + t
            I st <= n & thisplus1 < table[st]
               table[st] = thisplus1
               how[st] = how[t] [+] [‘-#.=>#2’.format(s, t)]
      .table = table
      .hows = how.map(h -> reversed(h)[0 .< (len)-1])
      R (.table, .hows)

   F ()(n)
      ‘Tabulation’
      V (table, hows) = ._mintab(n)
      R (table[n], hows[n])

L(DIVS, SUBS) [([2, 3], [1]), ([2, 3], [2])]
   print("\nMINIMUM STEPS TO 1: Tabulation algorithm")
   print(‘  Possible divisors:   ’DIVS)
   print(‘  Possible decrements: ’SUBS)
   V mintab = Mintab(Set(DIVS), Set(SUBS))
   mintab(10)
   L(n) 1..10
      V (steps, how) = (mintab.table[n], mintab.hows[n])
      print(‘    mintab(#2) in #2 by: ’.format(n, steps)‘ ’how.join(‘, ’))

   L(upto) [2000, 50'000]
      mintab(upto)
      print("\n    Those numbers up to "upto‘ that take the maximum, "minimal steps down to 1":’)
      V mx = max(mintab.table[1..])
      V ans = enumerate(mintab.table).filter((n, steps) -> steps == @mx).map((n, steps) -> n)
      print(‘      Taking ’mx‘ steps is/are the ’ans.len‘ numbers: ’ans.map(n -> String(n)).join(‘, ’))


using System;
using System.Collections.Generic;
using System.Linq;

public static class MinimalSteps
{
    public static void Main() {
        var (divisors, subtractors) = (new int[] { 2, 3 }, new [] { 1 });
        var lookup = CreateLookup(2_000, divisors, subtractors);
        Console.WriteLine($"Divisors: [{divisors.Delimit()}], Subtractors: [{subtractors.Delimit()}]");
        PrintRange(lookup, 10);
        PrintMaxMins(lookup);
        lookup = CreateLookup(20_000, divisors, subtractors);
        PrintMaxMins(lookup);
        Console.WriteLine();

        subtractors = new [] { 2 };
        lookup = CreateLookup(2_000, divisors, subtractors);
        Console.WriteLine($"Divisors: [{divisors.Delimit()}], Subtractors: [{subtractors.Delimit()}]");
        PrintRange(lookup, 10);
        PrintMaxMins(lookup);
        lookup = CreateLookup(20_000, divisors, subtractors);
        PrintMaxMins(lookup);
    }

    private static void PrintRange((char op, int param, int steps)[] lookup, int limit) {
        for (int goal = 1; goal <= limit; goal++) {
            var x = lookup[goal];
            if (x.param == 0) {
                Console.WriteLine($"{goal} cannot be reached with these numbers.");
                continue;
            }
            Console.Write($"{goal} takes {x.steps} {(x.steps == 1 ? "step" : "steps")}: ");
            for (int n = goal; n > 1; ) {
                Console.Write($"{n},{x.op}{x.param}=> ");
                n = x.op == '/' ? n / x.param : n - x.param;
                x = lookup[n];
            }
            Console.WriteLine("1");
        }
    }

    private static void PrintMaxMins((char op, int param, int steps)[] lookup) {
        var maxSteps = lookup.Max(x => x.steps);
        var items = lookup.Select((x, i) => (i, x)).Where(t => t.x.steps == maxSteps).ToList();
        Console.WriteLine(items.Count == 1
            ? $"There is one number below {lookup.Length-1} that requires {maxSteps} steps: {items[0].i}"
            : $"There are {items.Count} numbers below {lookup.Length-1} that require {maxSteps} steps: {items.Select(t => t.i).Delimit()}"
        );
    }

    private static (char op, int param, int steps)[] CreateLookup(int goal, int[] divisors, int[] subtractors)
    {
        var lookup = new (char op, int param, int steps)[goal+1];
        lookup[1] = ('/', 1, 0);
        for (int n = 1; n < lookup.Length; n++) {
            var ln = lookup[n];
            if (ln.param == 0) continue;
            for (int d = 0; d < divisors.Length; d++) {
                int target = n * divisors[d];
                if (target > goal) break;
                if (lookup[target].steps == 0 || lookup[target].steps > ln.steps) lookup[target] = ('/', divisors[d], ln.steps + 1);
            }
            for (int s = 0; s < subtractors.Length; s++) {
                int target = n + subtractors[s];
                if (target > goal) break;
                if (lookup[target].steps == 0 || lookup[target].steps > ln.steps) lookup[target] = ('-', subtractors[s], ln.steps + 1);
            }
        }
        return lookup;
    }

    private static string Delimit<T>(this IEnumerable<T> source) => string.Join(", ", source);
}


Dim Shared As Integer minPasos       'minimal number of steps to get to 1
Dim Shared As Integer Subtractor     '1 or 2
Dim Shared As Integer Ns(20000), Ops(20000), MinNs(20000), MinOps(20000)

Sub Reduce(N As Integer, Paso As Integer) 'Reduce N to 1, recording minimum steps
    If N = 1 Then
        If Paso < minPasos Then
            For i As Integer = 0 To Paso-1
                MinOps(i) = Ops(i)
                MinNs(i) = Ns(i)
            Next i
            minPasos = Paso
        End If
    End If
    If Paso >= minPasos Then Exit Sub     'don't search further
    If N Mod 3 = 0 Then Ops(Paso) = 3 : Ns(Paso) = N/3 : Reduce(N/3, Paso+1)
    If N Mod 2 = 0 Then Ops(Paso) = 2 : Ns(Paso) = N/2 : Reduce(N/2, Paso+1)
    Ops(Paso) = -Subtractor
    Ns(Paso) = N-Subtractor
    Reduce(N-Subtractor, Paso+1)
End Sub

Sub ShowSteps(N As Integer)     'Show minimal steps and how N steps to 1
    minPasos = 50000
    Reduce(N, 0)
    Print "N = " & N & " takes " & minPasos & " steps: N";
    For i As Integer = 0 To minPasos-1
        Print Iif(Sgn(MinOps(i)) < 0, " -", " /");
        Print Abs(MinOps(i)) & "=>" & MinNs(i); '" "
    Next i
    Print
End Sub

Sub ShowCount(Range As Integer) 'Show count of maximum minimal steps and their Ns
    Dim As Integer N, MaxSteps
    MaxSteps = 0          'find maximum number of minimum steps
    For N = 1 To Range
        minPasos = 50000
        Reduce(N, 0)
        If minPasos > MaxSteps Then MaxSteps = minPasos
    Next N
    Print "Maximum steps:"; MaxSteps; " for N =";
    For N = 1 To Range    'show numbers (Ns) for Maximum steps
        minPasos = 50000
        Reduce(N, 0)
        If minPasos = MaxSteps Then Print N; '" ";
    Next N
    Print
End Sub

Dim As Integer N
Subtractor = 1        '1.
For N = 1 To 10
    ShowSteps(N)
Next N
ShowCount(2000)       '2.
ShowCount(20000)      '2a.

Print
Subtractor = 2        '3.
For N = 1 To 10
    ShowSteps(N)
Next N
ShowCount(2000)       '4.
ShowCount(20000)      '4a.
Sleep


package main

import (
    "fmt"
    "strings"
)

const limit = 50000

var (
    divs, subs []int
    mins       [][]string
)

// Assumes the numbers are presented in order up to 'limit'.
func minsteps(n int) {
    if n == 1 {
        mins[1] = []string{}
        return
    }
    min := limit
    var p, q int
    var op byte
    for _, div := range divs {
        if n%div == 0 {
            d := n / div
            steps := len(mins[d]) + 1
            if steps < min {
                min = steps
                p, q, op = d, div, '/'
            }
        }
    }
    for _, sub := range subs {
        if d := n - sub; d >= 1 {
            steps := len(mins[d]) + 1
            if steps < min {
                min = steps
                p, q, op = d, sub, '-'
            }
        }
    }
    mins[n] = append(mins[n], fmt.Sprintf("%c%d -> %d", op, q, p))
    mins[n] = append(mins[n], mins[p]...)
}

func main() {
    for r := 0; r < 2; r++ {
        divs = []int{2, 3}
        if r == 0 {
            subs = []int{1}
        } else {
            subs = []int{2}
        }
        mins = make([][]string, limit+1)
        fmt.Printf("With: Divisors: %v, Subtractors: %v =>\n", divs, subs)
        fmt.Println("  Minimum number of steps to diminish the following numbers down to 1 is:")
        for i := 1; i <= limit; i++ {
            minsteps(i)
            if i <= 10 {
                steps := len(mins[i])
                plural := "s"
                if steps == 1 {
                    plural = " "
                }
                fmt.Printf("    %2d: %d step%s: %s\n", i, steps, plural, strings.Join(mins[i], ", "))
            }
        }
        for _, lim := range []int{2000, 20000, 50000} {
            max := 0
            for _, min := range mins[0 : lim+1] {
                m := len(min)
                if m > max {
                    max = m
                }
            }
            var maxs []int
            for i, min := range mins[0 : lim+1] {
                if len(min) == max {
                    maxs = append(maxs, i)
                }
            }
            nums := len(maxs)
            verb, verb2, plural := "are", "have", "s"
            if nums == 1 {
                verb, verb2, plural = "is", "has", ""
            }
            fmt.Printf("  There %s %d number%s in the range 1-%d ", verb, nums, plural, lim)
            fmt.Printf("that %s maximum 'minimal steps' of %d:\n", verb2, max)
            fmt.Println("   ", maxs)
        }
        fmt.Println()
    }
}


{-# LANGUAGE DeriveFunctor #-}
import Data.List
import Data.Ord
import Data.Function (on)

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

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

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

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

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

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

data Step = Div Int | Sub Int
  deriving Show

run :: Int -> Step -> [(Step, Int)]
run n s = case s of
  Sub i | n > i -> [(s, n - i)]
  Div d | n `mod` d == 0 -> [(s, n `div` d)]
  _ -> []

minSteps :: [Step] -> Int -> (Int, [Step])
minSteps steps = go
  where
    go = memoize goM

    goM 1 = (0, [])
    goM n = minimumBy (comparing fst) $ do
      (s, k) <- steps >>= run n
      let (m, ss) = go k
      return (m+1, s:ss)


import java.util.ArrayList;
import java.util.HashMap;
import java.util.List;
import java.util.Map;

public class MinimalStepsDownToOne {

    public static void main(String[] args) {
        runTasks(getFunctions1());
        runTasks(getFunctions2());
        runTasks(getFunctions3());
    }

    private static void runTasks(List<Function> functions) {
        Map<Integer,List<String>> minPath = getInitialMap(functions, 5);

        //  Task 1
        int max = 10;
        populateMap(minPath, functions, max);
        System.out.printf("%nWith functions:  %s%n", functions);
        System.out.printf("  Minimum steps to 1:%n");
        for ( int n = 2 ; n <= max ; n++ ) {
            int steps = minPath.get(n).size();
            System.out.printf("    %2d: %d step%1s: %s%n", n, steps, steps == 1 ? "" : "s", minPath.get(n));
        }

        //  Task 2
        displayMaxMin(minPath, functions, 2000);

        //  Task 2a
        displayMaxMin(minPath, functions, 20000);

        //  Task 2a +
        displayMaxMin(minPath, functions, 100000);
    }

    private static void displayMaxMin(Map<Integer,List<String>> minPath, List<Function> functions, int max) {
        populateMap(minPath, functions, max);
        List<Integer> maxIntegers = getMaxMin(minPath, max);
        int maxSteps = maxIntegers.remove(0);
        int numCount = maxIntegers.size();
        System.out.printf("  There %s %d number%s in the range 1-%d that have maximum 'minimal steps' of %d:%n    %s%n", numCount == 1 ? "is" : "are", numCount, numCount == 1 ? "" : "s", max, maxSteps, maxIntegers);

    }

    private static List<Integer> getMaxMin(Map<Integer,List<String>> minPath, int max) {
        int maxSteps = Integer.MIN_VALUE;
        List<Integer> maxIntegers = new ArrayList<Integer>();
        for ( int n = 2 ; n <= max ; n++ ) {
            int len = minPath.get(n).size();
            if ( len > maxSteps ) {
                maxSteps = len;
                maxIntegers.clear();
                maxIntegers.add(n);
            }
            else if ( len == maxSteps ) {
                maxIntegers.add(n);
            }
        }
        maxIntegers.add(0, maxSteps);
        return maxIntegers;
    }

    private static void populateMap(Map<Integer,List<String>> minPath, List<Function> functions, int max) {
        for ( int n = 2 ; n <= max ; n++ ) {
            if ( minPath.containsKey(n) ) {
                continue;
            }
            Function minFunction = null;
            int minSteps = Integer.MAX_VALUE;
            for ( Function f : functions ) {
                if ( f.actionOk(n) ) {
                    int result = f.action(n);
                    int steps = 1 + minPath.get(result).size();
                    if ( steps < minSteps ) {
                        minFunction = f;
                        minSteps = steps;
                    }
                }
            }
            int result = minFunction.action(n);
            List<String> path = new ArrayList<String>();
            path.add(minFunction.toString(n));
            path.addAll(minPath.get(result));
            minPath.put(n, path);
        }

    }

    private static Map<Integer,List<String>> getInitialMap(List<Function> functions, int max) {
        Map<Integer,List<String>> minPath = new HashMap<>();
        for ( int i = 2 ; i <= max ; i++ ) {
            for ( Function f : functions ) {
                if ( f.actionOk(i) ) {
                    int result = f.action(i);
                    if ( result == 1 ) {
                        List<String> path = new ArrayList<String>();
                        path.add(f.toString(i));
                        minPath.put(i, path);
                    }
                }
            }
        }
        return minPath;
    }

    private static List<Function> getFunctions3() {
        List<Function> functions = new ArrayList<>();
        functions.add(new Divide2Function());
        functions.add(new Divide3Function());
        functions.add(new Subtract2Function());
        functions.add(new Subtract1Function());
        return functions;
    }

    private static List<Function> getFunctions2() {
        List<Function> functions = new ArrayList<>();
        functions.add(new Divide3Function());
        functions.add(new Divide2Function());
        functions.add(new Subtract2Function());
        return functions;
    }

    private static List<Function> getFunctions1() {
        List<Function> functions = new ArrayList<>();
        functions.add(new Divide3Function());
        functions.add(new Divide2Function());
        functions.add(new Subtract1Function());
        return functions;
    }

    public abstract static class Function {
        abstract public int action(int n);
        abstract public boolean actionOk(int n);
        abstract public String toString(int n);
    }

    public static class Divide2Function extends Function {
        @Override public int action(int n) {
            return n/2;
        }

        @Override public boolean actionOk(int n) {
            return n % 2 == 0;
        }

        @Override public String toString(int n) {
            return "/2 -> " + n/2;
        }

        @Override public String toString() {
            return "Divisor 2";
        }

    }

    public static class Divide3Function extends Function {
        @Override public int action(int n) {
            return n/3;
        }

        @Override public boolean actionOk(int n) {
            return n % 3 == 0;
        }

        @Override public String toString(int n) {
            return "/3 -> " + n/3;
        }

        @Override public String toString() {
            return "Divisor 3";
        }

    }

    public static class Subtract1Function extends Function {
        @Override public int action(int n) {
            return n-1;
        }

        @Override public boolean actionOk(int n) {
            return true;
        }

        @Override public String toString(int n) {
            return "-1 -> " + (n-1);
        }

        @Override public String toString() {
            return "Subtractor 1";
        }

    }

    public static class Subtract2Function extends Function {
        @Override public int action(int n) {
            return n-2;
        }

        @Override public boolean actionOk(int n) {
            return n > 2;
        }

        @Override public String toString(int n) {
            return "-2 -> " + (n-2);
        }

        @Override public String toString() {
            return "Subtractor 2";
        }

    }

}


import Base.print

struct Action{T}
    f::Function
    i::T
end

struct ActionOutcome{T}
    act::Action{T}
    out::T
end

Base.print(io::IO, ao::ActionOutcome) = print(io, "$(ao.act.f) $(ao.act.i) yields $(ao.out)")

memoized = Dict{Int, Int}()

function findshortest(start, goal, fails, actions, verbose=true, maxsteps=100000)
    solutions, numsteps = Vector{Vector{ActionOutcome}}(), 0
    seqs = [ActionOutcome[ActionOutcome(Action(div, 0), start)]]
    if start == goal
        verbose && println("For start of $start, no steps needed.\n")
        return 0
    end
    while numsteps < maxsteps && isempty(solutions)
        newsequences = Vector{Vector{ActionOutcome}}()
        numsteps += 1
        for seq in seqs
            for (act, arr) in actions, x in arr
                result = act(seq[end].out, x)
                if !fails(result)
                    newactionseq = vcat(seq, ActionOutcome(Action(act, x), result))
                    numsteps == 1 && popfirst!(newactionseq)
                    if result == goal
                        push!(solutions, newactionseq)
                    else
                        push!(newsequences, newactionseq)
                    end
                end
            end
            if !verbose && isempty(solutions) &&
                           all(x -> haskey(memoized, x[end].out), newsequences)
                minresult = minimum(x -> memoized[x[end].out], newsequences) + numsteps
                memoized[start] = minresult
                return minresult
            end
        end
        seqs = newsequences
    end
    if verbose
        l = length(solutions)
        print("There ", l > 1 ? "are $l solutions" : "is $l solution",
            " for path of length ", numsteps, " from $start to $goal.\nExample: ")
        for step in solutions[1]
            print(step, step.out == 1 ? "\n\n" : ", ")
        end
    end
    memoized[start] = numsteps
    return numsteps
end

failed(n) = n < 1

const divisors = [2, 3]
divide(n, x) = begin q, r = divrem(n, x); r == 0 ? q : -1 end

const subtractors1, subtractors2 = [1], [2]
subtract(n, x) = n - x

actions1 = Dict(divide => divisors, subtract => subtractors1)
actions2 = Dict(divide => divisors, subtract => subtractors2)

function findmaxshortest(g, fails, acts, maxn)
    stepcounts = [findshortest(n, g, fails, acts, false) for n in 1:maxn]
    maxs = maximum(stepcounts)
    maxstepnums = findall(x -> x == maxs, stepcounts)
    println("There are $(length(maxstepnums)) with $maxs steps for start between 1 and $maxn: ", maxstepnums)
end

function teststeps(g, fails, acts, maxes)
    println("\nWith goal $g, divisors $(acts[divide]), subtractors $(acts[subtract]):")
    for n in 1:10
        findshortest(n, g, fails, acts)
    end
    for maxn in maxes
        findmaxshortest(g, fails, acts, maxn)
    end
end

teststeps(1, failed, actions1, [2000, 20000, 50000])
empty!(memoized)
teststeps(1, failed, actions2, [2000, 20000, 50000])


$RecursionLimit = 3000;
ClearAll[MinimalStepToOne, MinimalStepToOneHelper]
MinimalStepToOne[n_Integer] := Module[{res},
  res = Reap[MinimalStepToOneHelper[{n}]][[-1, 1]];
  SortBy[res, Length]
  ]
MinimalStepToOneHelper[steps_List] := Module[{n, out},
  n = Last[steps];
  If[n == 1,
   Sow[steps];
   ,
   If[Divisible[n, 3],
    out = steps~Join~{" /3=> ", n/3};
    MinimalStepToOneHelper[out]
    ];
   If[Divisible[n, 2],
    out = steps~Join~{" /2=> ", n/2};
    MinimalStepToOneHelper[out]
    ];
   If[n > 1,
    out = steps~Join~{" -1=> ", n - 1};
    MinimalStepToOneHelper[out]
    ];
   ]
  ]
Do[
 sel = First[MinimalStepToOne[i]];
 Print[First[sel],
  ": (" <> ToString[(Length[sel] - 1)/2] <> " steps) ", sel // Row]
 ,
 {i, 1, 10}
 ]

$RecursionLimit = 3000;
ClearAll[MinimalStepToOne2, MinimalStepToOneHelper2]
MinimalStepToOne2[nn_Integer] :=
 Module[{res, done, solution, maxsteps},
  done = False;
  solution = {};
  MinimalStepToOneHelper2[steps_List] := Module[{n, out},
    n = Last[steps];
    If[n == 1,
     solution = steps;
     ,
     If[solution === {},
       If[Divisible[n, 3],
        out = steps~Join~{" /3=> ", n/3};
        MinimalStepToOneHelper2[out]
        ];
       If[Divisible[n, 2],
        out = steps~Join~{" /2=> ", n/2};
        MinimalStepToOneHelper2[out]
        ];
       If[n > 1,
        out = steps~Join~{" -1=> ", n - 1};
        MinimalStepToOneHelper2[out]
        ];
       ];
     ];
    ];
  MinimalStepToOneHelper2[{nn}];
  maxsteps = (Length[solution] - 1)/2;
  maxsteps
  ]

$RecursionLimit = 3000;
ClearAll[MinimalStepToOneMaxSteps, MinimalStepToOneMaxStepsHelper]
MinimalStepToOneMaxSteps[n_Integer, maxsteps_Integer] :=
 Module[{res},
  res = Reap[MinimalStepToOneMaxStepsHelper[{n}, maxsteps]][[-1, 1]];
  (Min[Length /@ res] - 1)/2
  ]
MinimalStepToOneMaxStepsHelper[steps_List, maxsteps_Integer] :=
 Module[{n, out},
  n = Last[steps];
  If[n == 1,
   Sow[steps];
   ,
   If[maxsteps > 0,
     If[Divisible[n, 3],
      out = steps~Join~{" /3=> ", n/3};
      MinimalStepToOneMaxStepsHelper[out, maxsteps - 1]
      ];
     If[Divisible[n, 2],
      out = steps~Join~{" /2=> ", n/2};
      MinimalStepToOneMaxStepsHelper[out, maxsteps - 1]
      ];
     If[n > 1,
      out = steps~Join~{" -1=> ", n - 1};
      MinimalStepToOneMaxStepsHelper[out, maxsteps - 1]
      ];
     ];
   ];
  ]

allsols = Table[
   max = MinimalStepToOne2[i];
   {i, MinimalStepToOneMaxSteps[i, max]}
   ,
   {i, 1, 2000}
   ];

a = Last[SortBy[GatherBy[allsols, Last], First /* Last]];
{a[[1, 2]], a[[All, 1]]}

$RecursionLimit = 3000;
ClearAll[MinimalStepToOne, MinimalStepToOneHelper]
MinimalStepToOne[n_Integer] := Module[{res},
  res = Reap[MinimalStepToOneHelper[{n}]][[-1, 1]];
  SortBy[res, Length]
  ]
MinimalStepToOneHelper[steps_List] := Module[{n, out},
  n = Last[steps];
  If[n == 1,
   Sow[steps];
   ,
   If[Divisible[n, 3],
    out = steps~Join~{" /3=> ", n/3};
    MinimalStepToOneHelper[out]
    ];
   If[Divisible[n, 2],
    out = steps~Join~{" /2=> ", n/2};
    MinimalStepToOneHelper[out]
    ];
   If[n > 2,
    out = steps~Join~{" -2=> ", n - 2};
    MinimalStepToOneHelper[out]
    ];
   ]
  ]
Do[
 sel = First[MinimalStepToOne[i]];
 Print[First[sel],
  ": (" <> ToString[(Length[sel] - 1)/2] <> " steps) ", sel // Row]
 ,
 {i, 1, 10}
 ]

$RecursionLimit = 3000;
ClearAll[MinimalStepToOne2, MinimalStepToOneHelper2]
MinimalStepToOne2[nn_Integer] :=
 Module[{res, done, solution, maxsteps},
  done = False;
  solution = {};
  MinimalStepToOneHelper2[steps_List] := Module[{n, out},
    n = Last[steps];
    If[n == 1,
     solution = steps;
     ,
     If[solution === {},
       If[Divisible[n, 3],
        out = steps~Join~{" /3=> ", n/3};
        MinimalStepToOneHelper2[out]
        ];
       If[Divisible[n, 2],
        out = steps~Join~{" /2=> ", n/2};
        MinimalStepToOneHelper2[out]
        ];
       If[n > 2,
        out = steps~Join~{" -2=> ", n - 2};
        MinimalStepToOneHelper2[out]
        ];
       ];
     ];
    ];
  MinimalStepToOneHelper2[{nn}];
  maxsteps = (Length[solution] - 1)/2;
  maxsteps
  ]

$RecursionLimit = 3000;
ClearAll[MinimalStepToOneMaxSteps, MinimalStepToOneMaxStepsHelper]
MinimalStepToOneMaxSteps[n_Integer, maxsteps_Integer] :=
 Module[{res},
  res = Reap[MinimalStepToOneMaxStepsHelper[{n}, maxsteps]][[-1, 1]];
  (Min[Length /@ res] - 1)/2
  ]
MinimalStepToOneMaxStepsHelper[steps_List, maxsteps_Integer] :=
 Module[{n, out},
  n = Last[steps];
  If[n == 1,
   Sow[steps];
   ,
   If[maxsteps > 0,
     If[Divisible[n, 3],
      out = steps~Join~{" /3=> ", n/3};
      MinimalStepToOneMaxStepsHelper[out, maxsteps - 1]
      ];
     If[Divisible[n, 2],
      out = steps~Join~{" /2=> ", n/2};
      MinimalStepToOneMaxStepsHelper[out, maxsteps - 1]
      ];
     If[n > 2,
      out = steps~Join~{" -2=> ", n - 2};
      MinimalStepToOneMaxStepsHelper[out, maxsteps - 1]
      ];
     ];
   ];
  ]

allsols = Table[
   max = MinimalStepToOne2[i];
   {i, MinimalStepToOneMaxSteps[i, max]}
   ,
   {i, 1, 2000}
   ];

a = Last[SortBy[GatherBy[allsols, Last], First /* Last]];
{a[[1, 2]], a[[All, 1]]}


import strformat, strutils, tables

type

  Sequence = seq[Natural]

  Context = object
    divisors: seq[int]
    subtractors: seq[int]
    seqCache: Table[int, Sequence]  # Mapping number -> sequence to reach 1.
    stepCache: Table[int, int]      # Mapping number -> number of steps to reach 1.

proc initContext(divisors, subtractors: openArray[int]): Context =
  ## Initialize a context.
  for d in divisors: doAssert d > 1, "divisors must be greater than 1."
  for s in subtractors: doAssert s > 0, "substractors must be greater than 0."
  result.divisors = @divisors
  result.subtractors = @subtractors
  result.seqCache[1] = @[Natural 1]
  result.stepCache[1] = 0

proc minStepsDown(context: var Context; n: Natural): Sequence =
  # Return a minimal sequence to reach the value 1.

  assert n > 0, "“n” must be positive."
  if n in context.seqCache: return context.seqCache[n]

  var
    minSteps = int.high
    minPath: Sequence

  for val in context.divisors:
    if n mod val == 0:
      var path = context.minStepsDown(n div val)
      if path.len < minSteps:
        minSteps = path.len
        minPath = move(path)

  for val in context.subtractors:
    if n - val > 0:
      var path = context.minStepsDown(n - val)
      if path.len < minSteps:
        minSteps = path.len
        minPath = move(path)

  result = n & minPath
  context.seqCache[n] = result

proc minStepsDownCount(context: var Context; n: Natural): int =
  ## Compute the mininum number of steps without keeping the sequence.

  assert n > 0, "“n” must be positive."
  if n in context.stepCache: return context.stepCache[n]

  result = int.high

  for val in context.divisors:
    if n mod val == 0:
      let steps = context.minStepsDownCount(n div val)
      if steps < result: result = steps

  for val in context.subtractors:
    if n - val > 0:
      let steps = context.minStepsDownCount(n - val)
      if steps < result: result = steps

  inc result
  context.stepCache[n] = result

template plural(n: int): string =
  if n > 1: "s" else: ""

proc printMinStepsDown(context: var Context; n: Natural) =
  ## Search and print the sequence to reach one.

  let sol = context.minStepsDown(n)
  stdout.write &"{n} takes {sol.len - 1} step{plural(sol.len - 1)}: "
  var prev = 0
  for val in sol:
    if prev == 0:
      stdout.write val
    elif prev - val in context.subtractors:
      stdout.write " - ", prev - val, " → ", val
    else:
      stdout.write " / ", prev div val, " → ", val
    prev = val
  stdout.write '\n'

proc maxMinStepsCount(context: var Context; nmax: Positive): tuple[steps: int; list: seq[int]] =
  ## Return the maximal number of steps needed for numbers between 1 and "nmax"
  ## and the list of numbers needing this number of steps.

  for n in 2..nmax:
    let nsteps = context.minStepsDownCount(n)
    if nsteps == result.steps:
      result.list.add n
    elif nsteps > result.steps:
      result.steps = nsteps
      result.list = @[n]

proc run(divisors, subtractors: openArray[int]) =
  ## Run the search for given divisors and subtractors.

  var context = initContext(divisors, subtractors)
  echo &"Using divisors: {divisors} and substractors: {subtractors}"
  for n in 1..10: context.printMinStepsDown(n)
  for nmax in [2_000, 20_000]:
    let (steps, list) = context.maxMinStepsCount(nmax)
    stdout.write if list.len == 1: &"There is 1 number " else: &"There are {list.len} numbers "
    echo &"below {nmax} that require {steps} steps: ", list.join(", ")

run(divisors = [2, 3], subtractors = [1])
echo ""
run(divisors = [2, 3], subtractors = [2])


#!/usr/bin/perl

use strict; # https://rosettacode.org/wiki/Minimal_steps_down_to_1
use warnings;
no warnings 'recursion';
use List::Util qw( first );
use Data::Dump 'dd';

for ( [ 2000, [2, 3], [1] ], [ 2000, [2, 3], [2] ] )
  {
  my ( $n, $div, $sub ) = @$_;
  print "\n", '-' x 40, " divisors @$div subtractors @$sub\n";
  my ($solve, $max) = minimal( @$_ );
  printf "%4d takes %s step(s): %s\n",
    $_, $solve->[$_] =~ tr/ // - 1, $solve->[$_] for 1 .. 10;
  print "\n";
  printf "%d number(s) below %d that take $#$max steps: %s\n",
    $max->[-1] =~ tr/ //, $n, $max->[-1];
  ($solve, $max) = minimal( 20000, $div, $sub );
  printf "%d number(s) below %d that take $#$max steps: %s\n",
    $max->[-1] =~ tr/ //, 20000, $max->[-1];
  }

sub minimal
  {
  my ($top, $div, $sub) = @_;
  my @solve = (0, ' ');
  my @maximal;
  for my $n ( 2 .. $top )
    {
    my @pick;
    for my $d ( @$div )
      {
      $n % $d and next;
      my $ans = "/$d $solve[$n / $d]";
      $pick[$ans =~ tr/ //] //= $ans;
      }
    for my $s ( @$sub )
      {
      $n > $s or next;
      my $ans = "-$s $solve[$n - $s]";
      $pick[$ans =~ tr/ //] //= $ans;
      }
    $solve[$n] = first { defined  } @pick;
    $maximal[$solve[$n] =~ tr/ // - 1] .= " $n";
    }
  return \@solve, \@maximal;
  }


with javascript_semantics
sequence cache = {},
         ckeys = {}

function ms21(integer n, sequence ds)
    integer cdx = find(ds,ckeys)
    if cdx=0 then
        ckeys = append(ckeys,ds)
        cache = append(cache,{{}})
        cdx = length(cache)
    end if
    for i=length(cache[cdx])+1 to n do
        integer ms = n+2
        sequence steps = {}
        for j=1 to length(ds) do    -- (d then s)
            for k=1 to length(ds[j]) do
                integer dsk = ds[j][k],
                        ok = iff(j=1?remainder(i,dsk)=0:i>dsk)
                if ok then
                    integer m = iff(j=1?i/dsk:i-dsk),
                            l = length(cache[cdx][m])+1
                    if ms>l then
                        ms = l
                        string step = sprintf("%s%d -> %d",{"/-"[j],dsk,m})
                        steps = prepend(deep_copy(cache[cdx][m]),step)
                    end if
                end if
            end for
        end for
        if steps = {} then ?9/0 end if
        cache[cdx] = append(cache[cdx],steps)
    end for
    return cache[cdx][n]
end function

procedure show10(sequence ds)
    printf(1,"\nWith divisors %v and subtractors %v:\n",ds)
    for n=1 to 10 do
        sequence steps = ms21(n,ds)
        integer ns = length(steps)
        string ps = iff(ns=1?"":"s"),
               eg = iff(ns=0?"":", eg "&join(steps,","))
        printf(1,"%2d takes %d step%s%s\n",{n,ns,ps,eg})
    end for
end procedure

procedure maxsteps(sequence ds, integer lim)
    integer ms = -1, ls
    sequence mc = {}, steps, args
    for n=1 to lim do
        steps = ms21(n,ds)
        ls = length(steps)
        if ls>ms then
            ms = ls
            mc = {n}
        elsif ls=ms then
            mc &= n
        end if
    end for
    integer lm = length(mc)
    string {are,ps,ns} = iff(lm=1?{"is","","s"}:{"are","s",""})
    args = {       are,lm,      ps,     lim,            ns,ms, shorten(mc,"",3)}
    printf(1,"There %s %d number%s below %d that require%s %d steps: %v\n",args)
end procedure

show10({{2,3},{1}})
maxsteps({{2,3},{1}},2000)
maxsteps({{2,3},{1}},20000)
maxsteps({{2,3},{1}},50000)

show10({{2,3},{2}})
maxsteps({{2,3},{2}},2000)
maxsteps({{2,3},{2}},20000)
maxsteps({{2,3},{2}},50000)


from functools import lru_cache

#%%

DIVS = {2, 3}
SUBS = {1}

class Minrec():
    "Recursive, memoised minimised steps to 1"

    def __init__(self, divs=DIVS, subs=SUBS):
        self.divs, self.subs = divs, subs

    @lru_cache(maxsize=None)
    def _minrec(self, n):
        "Recursive, memoised"
        if n == 1:
            return 0, ['=1']
        possibles = {}
        for d in self.divs:
            if n % d == 0:
                possibles[f'/{d}=>{n // d:2}'] = self._minrec(n // d)
        for s in self.subs:
            if n > s:
                possibles[f'-{s}=>{n - s:2}'] = self._minrec(n - s)
        thiskind, (count, otherkinds) = min(possibles.items(), key=lambda x: x[1])
        ret = 1 + count, [thiskind] + otherkinds
        return ret

    def __call__(self, n):
        "Recursive, memoised"
        ans = self._minrec(n)[1][:-1]
        return len(ans), ans

if __name__ == '__main__':
    for DIVS, SUBS in [({2, 3}, {1}), ({2, 3}, {2})]:
        minrec = Minrec(DIVS, SUBS)
        print('\nMINIMUM STEPS TO 1: Recursive algorithm')
        print('  Possible divisors:  ', DIVS)
        print('  Possible decrements:', SUBS)
        for n in range(1, 11):
            steps, how = minrec(n)
            print(f'    minrec({n:2}) in {steps:2} by: ', ', '.join(how))

        upto = 2000
        print(f'\n    Those numbers up to {upto} that take the maximum, "minimal steps down to 1":')
        stepn = sorted((minrec(n)[0], n) for n in range(upto, 0, -1))
        mx = stepn[-1][0]
        ans = [x[1] for x in stepn if x[0] == mx]
        print('      Taking', mx, f'steps is/are the {len(ans)} numbers:',
              ', '.join(str(n) for n in sorted(ans)))
        #print(minrec._minrec.cache_info())
        print()


//import random
V n = 52
V Black = ‘Black’
V Red = ‘Red’
V blacks = [Black] * (n I/ 2)
V reds = [Red] * (n I/ 2)
V pack = blacks [+] reds
random:shuffle(&pack)

[String] black_stack, red_stack, discard
L !pack.empty
   V top = pack.pop()
   I top == Black
      black_stack.append(pack.pop())
   E
      red_stack.append(pack.pop())
   discard.append(top)
print(‘(Discards: ’(discard.map(d -> d[0]).join(‘ ’))" )\n")

V max_swaps = min(black_stack.len, red_stack.len)
V swap_count = random:(0 .. max_swaps)
print(‘Swapping ’swap_count)

F random_partition(stack, count)
   V stack_copy = copy(stack)
   random:shuffle(&stack_copy)
   R (stack_copy[count ..], stack_copy[0 .< count])

(black_stack, V black_swap) = random_partition(black_stack, swap_count)
(red_stack, V red_swap) = random_partition(red_stack, swap_count)

black_stack [+]= red_swap
red_stack [+]= black_swap

I black_stack.count(Black) == red_stack.count(Red)
   print(‘Yeha! The mathematicians assertion is correct.’)
E
   print(‘Whoops - The mathematicians (or my card manipulations) are flakey’)


use Lingua::EN::Numbers;

for [2,3], 1, 2000,
    [2,3], 1, 50000,
    [2,3], 2, 2000,
    [2,3], 2, 50000
  -> @div, $sub, $limit {
    my %min = 1 => {:op(''), :v(1), :s(0)};
    (2..$limit).map( -> $n {
       my @ops;
       @ops.push: ($n / $_, "/$_") if $n %% $_ for @div;
       @ops.push: ($n - $sub, "-$sub") if $n > $sub;
       my $op = @ops.min( {%min{.[0]}<s>} );
       %min{$n} = {:op($op[1]), :v($op[0]), :s(1 + %min{$op[0]}<s>)};
    });

    my $max = %min.max( {.value<s>} ).value<s>;
    my @max = %min.grep( {.value.<s> == $max} )».key.sort(+*);

    if $limit == 2000 {
        say "\nDivisors: {@div.perl}, subtract: $sub";
        steps(1..10);
    }
    say "\nUp to {comma $limit} found {[email protected]max} number{[email protected]max == 1 ?? '' !! 's'} " ~
        "that require{[email protected]max == 1 ?? 's' !! ''} at least $max steps.";
    steps(@max);

    sub steps (*@list) {
        for @list -> $m {
            my @op;
            my $n = $m;
            while %min{$n}<s> {
                @op.push: "{%min{$n}<op>}=>{%min{$n}<v>}";
                $n = %min{$n}<v>;
            }
            say "($m) {%min{$m}<s>} steps: ", @op.join(', ');
        }
    }
}


func minToOne(divs: [Int], subs: [Int], upTo n: Int) -> ([Int], [[String]]) {
  var table = Array(repeating: n + 2, count: n + 1)
  var how = Array(repeating: [""], count: n + 2)

  table[1] = 0
  how[1] = ["="]

  for t in 1..<n {
    let thisPlus1 = table[t] + 1

    for div in divs {
      let dt = div * t

      if dt <= n && thisPlus1 < table[dt] {
        table[dt] = thisPlus1
        how[dt] = how[t] + ["/\(div)=>  \(t)"]
      }
    }

    for sub in subs {
      let st = sub + t

      if st <= n && thisPlus1 < table[st] {
        table[st] = thisPlus1
        how[st] = how[t] + ["-\(sub)=> \(t)"]
      }
    }
  }

  return (table, how.map({ $0.reversed().dropLast() }))
}

for (divs, subs) in [([2, 3], [1]), ([2, 3], [2])] {
  print("\nMINIMUM STEPS TO 1:")
  print("  Possible divisors:  \(divs)")
  print("  Possible decrements: \(subs)")

  let (table, hows) = minToOne(divs: divs, subs: subs, upTo: 10)

  for n in 1...10 {
    print("    mintab(  \(n)) in {  \(table[n])} by: ", hows[n].joined(separator: ", "))
  }

  for upTo in [2_000, 50_000] {
    print("\n    Those numbers up to \(upTo) that take the maximum, \"minimal steps down to 1\":")
    let (table, _) = minToOne(divs: divs, subs: subs, upTo: upTo)
    let max = table.dropFirst().max()!
    let maxNs = table.enumerated().filter({ $0.element == max })

    print(
      "      Taking", max, "steps are the \(maxNs.count) numbers:",
      maxNs.map({ String($0.offset) }).joined(separator: ", ")
    )
  }
}


import "/fmt" for Fmt

var limit = 50000
var divs = []
var subs = []
var mins = []

// Assumes the numbers are presented in order up to 'limit'.
var minsteps = Fn.new { |n|
    if (n == 1) {
        mins[1] = []
        return
    }
    var min = limit
    var p = 0
    var q = 0
    var op = ""
    for (div in divs) {
        if (n%div == 0) {
            var d = (n/div).floor
            var steps = mins[d].count + 1
            if (steps < min) {
                min = steps
                p = d
                q = div
                op = "/"
            }
        }
    }
    for (sub in subs) {
        var d = n - sub
        if (d >= 1) {
            var steps = mins[d].count + 1
            if (steps < min) {
                min = steps
                p = d
                q = sub
                op = "-"
            }
        }
    }
    mins[n].add("%(op)%(q) -> %(p)")
    mins[n].addAll(mins[p])
}

for (r in 0..1) {
    divs = [2, 3]
    subs = (r == 0) ? [1] : [2]
    mins = List.filled(limit+1, null)
    for (i in 0..limit) mins[i] = []
    Fmt.print("With: Divisors: $n, Subtractors: $n =>", divs, subs)
    System.print("  Minimum number of steps to diminish the following numbers down to 1 is:")
    for (i in 1..limit) {
        minsteps.call(i)
        if (i <= 10) {
            var steps = mins[i].count
            var plural = (steps == 1) ? " " : "s"
            var mi = Fmt.v("s", 0, mins[i], 0, ", ", "")
            Fmt.print("    $2d: $d step$s: $s", i, steps, plural, mi)
        }
    }
    for (lim in [2000, 20000, 50000]) {
        var max = 0
        for (min in mins[0..lim]) {
            var m = min.count
            if (m > max) max = m
        }
        var maxs = []
        var i = 0
        for (min in mins[0..lim]) {
            if (min.count == max) maxs.add(i)
            i = i + 1
        }
        var nums = maxs.count
        var verb   = (nums == 1) ? "is" : "are"
        var verb2  = (nums == 1) ? "has" : "have"
        var plural = (nums == 1) ? "": "s"
        Fmt.write("  There $s $d number$s in the range 1-$d ", verb, nums, plural, lim)
        Fmt.print("that $s maximum 'minimal steps' of $d:", verb2, max)
        System.print("   %(maxs)")
    }
    System.print()
}


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

on cardTrick()
    (* Create a pack of "cards" and shuffle it. *)
    set suits to {"♥", "♣", "♦", "♠"}
    set cards to {"A", "2", "3", "4", "5", "6", "7", "8", "9", "10", "J", "Q", "K"}
    set deck to {}
    repeat with s from 1 to (count suits)
        set suit to item s of suits
        repeat with c from 1 to (count cards)
            set end of deck to item c of cards & suit
        end repeat
    end repeat
    set deck to (current application's class "GKRandomSource"'s new()'s arrayByShufflingObjectsInArray:(deck)) as list

    (* Perform the black pile/red pile/discard stuff. *)
    set {blackPile, redPile, discardPile} to {{}, {}, {}}
    repeat with c from 1 to (count deck) by 2
        set topCard to item c of deck
        if (character -1 of topCard is in "♣♠") then
            set end of blackPile to item (c + 1) of deck
        else
            set end of redPile to item (c + 1) of deck
        end if
        set end of discardPile to topCard
    end repeat
    -- When equal numbers of two possibilities are randomly paired, the number of pairs whose members are
    -- both one of the possibilities is the same as the number whose members are both the other. The cards
    -- in the red and black piles have effectively been paired with cards of the eponymous colours, so
    -- the number of reds in the red pile is already the same as the number of blacks in the black.

    (* Take a random number of random cards from one pile and swap them with an equal number from the other,
      religiously following the "red bunch"/"black bunch" ritual instead of simply swapping pairs of cards. *)
    -- Where swapped cards are the same colour, this will make no difference at all. Where the colours
    -- are different, both piles will either gain or lose a card of their relevant colour, maintaining
    -- the defining balance either way.
    set {redBunch, blackBunch} to {{}, {}}
    set {redPileCount, blackPileCount} to {(count redPile), (count blackPile)}
    set maxX to blackPileCount
    if (redPileCount < maxX) then set maxX to redPileCount
    set X to (current application's class "GKRandomDistribution"'s distributionForDieWithSideCount:(maxX))'s nextInt()
    set RNG to current application's class "GKShuffledDistribution"'s distributionForDieWithSideCount:(redPileCount)
    repeat X times
        set r to RNG's nextInt()
        set end of redBunch to item r of redPile
        set item r of redPile to missing value
    end repeat
    set RNG to current application's class "GKShuffledDistribution"'s distributionForDieWithSideCount:(blackPileCount)
    repeat X times
        set b to RNG's nextInt()
        set end of blackBunch to item b of blackPile
        set item b of blackPile to missing value
    end repeat
    set blackPile to (blackPile's text) & redBunch
    set redPile to (redPile's text) & blackBunch

    (* Count and compare the number of blacks in the black pile and the number of reds in the red. *)
    set blacksInBlackPile to 0
    repeat with card in blackPile
        if (character -1 of card is in "♣♠") then set blacksInBlackPile to blacksInBlackPile + 1
    end repeat
    set redsInRedPile to 0
    repeat with card in redPile
        if (character -1 of card is in "♥♦") then set redsInRedPile to redsInRedPile + 1
    end repeat

    return {truth:(blacksInBlackPile = redsInRedPile), reds:redPile, blacks:blackPile, discards:discardPile}
end cardTrick

on join(lst, delim)
    set astid to AppleScript's text item delimiters
    set AppleScript's text item delimiters to delim
    set txt to lst as text
    set AppleScript's text item delimiters to astid
    return txt
end join

on task()
    set output to {}
    repeat with i from 1 to 5
        set {truth:truth, reds:reds, blacks:blacks, discards:discards} to cardTrick()
        set end of output to "Test " & i & ": Assertion is " & truth
        set end of output to "Red pile:   " & join(reds, ", ")
        set end of output to "Black pile: " & join(blacks, ", ")
        set end of output to "Discards:   " & join(items 1 thru 13 of discards, ", ")
        set end of output to "            " & (join(items 14 thru 26 of discards, ", ") & linefeed)
    end repeat
    return text 1 thru -2 of join(output, linefeed)
end task
return task()