package main

import "fmt"

type md struct {
    dim []int
    ele []float64
}

func newMD(dim ...int) *md {
    n := 1
    for _, d := range dim {
        n *= d
    }
    return &md{append([]int{}, dim...), make([]float64, n)}
}

func (m *md) index(i ...int) (x int) {
    for d, dx := range m.dim {
        x = x*dx + i[d]
    }
    return
}

func (m *md) at(i ...int) float64 {
    return m.ele[m.index(i...)]
}

func (m *md) set(x float64, i ...int) {
    m.ele[m.index(i...)] = x
}

func (m *md) show(i ...int) {
    fmt.Printf("m%d = %g\n", i, m.at(i...))
}

func main() {
    m := newMD(5, 4, 3, 2)
    m.show(4, 3, 2, 1)
    m.set(87, 4, 3, 2, 1)
    m.show(4, 3, 2, 1)

    for i := 0; i < m.dim[0]; i++ {
        for j := 0; j < m.dim[1]; j++ {
            for k := 0; k < m.dim[2]; k++ {
                for l := 0; l < m.dim[3]; l++ {
                    x := m.index(i, j, k, l)
                    m.set(float64(x)+.1, i, j, k, l)
                }
            }
        }
    }
    fmt.Println(m.ele[:10])
    fmt.Println(m.ele[len(m.ele)-10:])
    m.show(4, 3, 2, 1)
}


(import
  [numpy [ones column-stack]]
  [numpy.random [randn]]
  [numpy.linalg [lstsq]])

(setv n 1000)
(setv x1 (randn n))
(setv x2 (randn n))
(setv y (+ 3 (* 1 x1) (* -2 x2) (* .25 x1 x2) (randn n)))

(print (first (lstsq
  (column-stack (, (ones n) x1 x2 (* x1 x2)))
  y)))


public class MultiDimensionalArray {
    public static void main(String[] args) {
        // create a regular 4 dimensional array and initialize successive elements to the values 1 to 120
        int m = 1;
        int[][][][] a4 = new int[5][4][3][2];
        for (int i = 0; i < a4.length; ++i) {
            for (int j = 0; j < a4[0].length; ++j) {
                for (int k = 0; k < a4[0][0].length; ++k) {
                    for (int l = 0; l < a4[0][0][0].length; ++l) {
                        a4[i][j][k][l] = m++;
                    }
                }
            }
        }

        System.out.println("First element = " + a4[0][0][0][0]);  // access and print value of first element
        a4[0][0][0][0] = 121;                                     // change value of first element
        System.out.println();

        for (int i = 0; i < a4.length; ++i) {
            for (int j = 0; j < a4[0].length; ++j) {
                for (int k = 0; k < a4[0][0].length; ++k) {
                    for (int l = 0; l < a4[0][0][0].length; ++l) {
                        System.out.printf("%4d", a4[i][j][k][l]);
                    }
                }
            }
        }
    }
}


import java.util.Arrays;
import java.util.Objects;

public class MultipleRegression {
    public static void require(boolean condition, String message) {
        if (condition) {
            return;
        }
        throw new IllegalArgumentException(message);
    }

    public static class Matrix {
        private final double[][] data;
        private final int rowCount;
        private final int colCount;

        public Matrix(int rows, int cols) {
            require(rows > 0, "Need at least one row");
            this.rowCount = rows;

            require(cols > 0, "Need at least one column");
            this.colCount = cols;

            this.data = new double[rows][cols];
            for (double[] row : this.data) {
                Arrays.fill(row, 0.0);
            }
        }

        public Matrix(double[][] source) {
            require(source.length > 0, "Need at least one row");
            this.rowCount = source.length;

            require(source[0].length > 0, "Need at least one column");
            this.colCount = source[0].length;

            this.data = new double[this.rowCount][this.colCount];
            for (int i = 0; i < this.rowCount; i++) {
                set(i, source[i]);
            }
        }

        public double[] get(int row) {
            Objects.checkIndex(row, this.rowCount);
            return this.data[row];
        }

        public void set(int row, double[] data) {
            Objects.checkIndex(row, this.rowCount);
            require(data.length == this.colCount, "The column in the row must match the number of columns in the matrix");
            System.arraycopy(data, 0, this.data[row], 0, this.colCount);
        }

        public double get(int row, int col) {
            Objects.checkIndex(row, this.rowCount);
            Objects.checkIndex(col, this.colCount);
            return this.data[row][col];
        }

        public void set(int row, int col, double value) {
            Objects.checkIndex(row, this.rowCount);
            Objects.checkIndex(col, this.colCount);
            this.data[row][col] = value;
        }

        @SuppressWarnings("UnnecessaryLocalVariable")
        public Matrix times(Matrix that) {
            var rc1 = this.rowCount;
            var cc1 = this.colCount;
            var rc2 = that.rowCount;
            var cc2 = that.colCount;
            require(cc1 == rc2, "Cannot multiply if the first columns does not equal the second rows");
            var result = new Matrix(rc1, cc2);
            for (int i = 0; i < rc1; i++) {
                for (int j = 0; j < cc2; j++) {
                    for (int k = 0; k < rc2; k++) {
                        var prod = get(i, k) * that.get(k, j);
                        result.set(i, j, result.get(i, j) + prod);
                    }
                }
            }
            return result;
        }

        public Matrix transpose() {
            var rc = this.rowCount;
            var cc = this.colCount;
            var trans = new Matrix(cc, rc);
            for (int i = 0; i < cc; i++) {
                for (int j = 0; j < rc; j++) {
                    trans.set(i, j, get(j, i));
                }
            }
            return trans;
        }

        public void toReducedRowEchelonForm() {
            int lead = 0;
            var rc = this.rowCount;
            var cc = this.colCount;
            for (int r = 0; r < rc; r++) {
                if (cc <= lead) {
                    return;
                }
                var i = r;

                while (get(i, lead) == 0.0) {
                    i++;
                    if (rc == i) {
                        i = r;
                        lead++;
                        if (cc == lead) {
                            return;
                        }
                    }
                }

                var temp = get(i);
                set(i, get(r));
                set(r, temp);

                if (get(r, lead) != 0.0) {
                    var div = get(r, lead);
                    for (int j = 0; j < cc; j++) {
                        set(r, j, get(r, j) / div);
                    }
                }

                for (int k = 0; k < rc; k++) {
                    if (k != r) {
                        var mult = get(k, lead);
                        for (int j = 0; j < cc; j++) {
                            var prod = get(r, j) * mult;
                            set(k, j, get(k, j) - prod);
                        }
                    }
                }

                lead++;
            }
        }

        public Matrix inverse() {
            require(this.rowCount == this.colCount, "Not a square matrix");
            var len = this.rowCount;
            var aug = new Matrix(len, 2 * len);
            for (int i = 0; i < len; i++) {
                for (int j = 0; j < len; j++) {
                    aug.set(i, j, get(i, j));
                }
                // augment identity matrix to right
                aug.set(i, i + len, 1.0);
            }
            aug.toReducedRowEchelonForm();
            var inv = new Matrix(len, len);
            // remove identity matrix to left
            for (int i = 0; i < len; i++) {
                for (int j = len; j < 2 * len; j++) {
                    inv.set(i, j - len, aug.get(i, j));
                }
            }
            return inv;
        }
    }

    public static double[] multipleRegression(double[] y, Matrix x) {
        var tm = new Matrix(new double[][]{y});
        var cy = tm.transpose();
        var cx = x.transpose();
        return x.times(cx).inverse().times(x).times(cy).transpose().get(0);
    }

    public static void printVector(double[] v) {
        System.out.println(Arrays.toString(v));
        System.out.println();
    }

    public static double[] repeat(int size, double value) {
        var a = new double[size];
        Arrays.fill(a, value);
        return a;
    }

    public static void main(String[] args) {
        double[] y = new double[]{1.0, 2.0, 3.0, 4.0, 5.0};
        var x = new Matrix(new double[][]{{2.0, 1.0, 3.0, 4.0, 5.0}});
        var v = multipleRegression(y, x);
        printVector(v);

        y = new double[]{3.0, 4.0, 5.0};
        x = new Matrix(new double[][]{
            {1.0, 2.0, 1.0},
            {1.0, 1.0, 2.0}
        });
        v = multipleRegression(y, x);
        printVector(v);

        y = new double[]{52.21, 53.12, 54.48, 55.84, 57.20, 58.57, 59.93, 61.29, 63.11, 64.47, 66.28, 68.10, 69.92, 72.19, 74.46};
        var a = new double[]{1.47, 1.50, 1.52, 1.55, 1.57, 1.60, 1.63, 1.65, 1.68, 1.70, 1.73, 1.75, 1.78, 1.80, 1.83};
        x = new Matrix(new double[][]{
            repeat(a.length, 1.0),
            a,
            Arrays.stream(a).map(it -> it * it).toArray()
        });

        v = multipleRegression(y, x);
        printVector(v);
    }
}


function array() {
	var dimensions= Array.prototype.slice.call(arguments);
	var N=1, rank= dimensions.length;
	for (var j= 0; j<rank; j++) N*= dimensions[j];
	this.dimensions= dimensions;
	this.values= new Array(N);
}


# The input is used to initialize the elements of the
# multi-dimensional array:
def multiarray(d):
  . as $in
  | if (d|length) == 1 then [range(0;d[0]) | $in]
    else multiarray(d[1:]) | multiarray( d[0:1] )
    end;


include ..\Utilitys.tlhy

0 ( 4 3 2 ) dim pstack

5432 ( 4 3 2 ) set pstack

( 4 3 2 ) get ?

( 4 3 ) get %row !row
$row ?

$row 1 2 set !row
$row ?

$row ( 4 3 ) set
0 4 repeat ( 4 2 ) set

pstack

"End " input


// modifies the matrix "in place"
Matrix.prototype.inverse = function() {
    if (this.height != this.width) {
        throw "can't invert a non-square matrix";
    }

    var I = new IdentityMatrix(this.height);
    for (var i = 0; i < this.height; i++)
        this.mtx[i] = this.mtx[i].concat(I.mtx[i])
    this.width *= 2;

    this.toReducedRowEchelonForm();

    for (var i = 0; i < this.height; i++)
        this.mtx[i].splice(0, this.height);
    this.width /= 2;

    return this;
}

function ColumnVector(ary) {
    return new Matrix(ary.map(function(v) {return [v]}))
}
ColumnVector.prototype = Matrix.prototype

Matrix.prototype.regression_coefficients = function(x) {
    var x_t = x.transpose();
    return x_t.mult(x).inverse().mult(x_t).mult(this);
}

// the Ruby example
var y = new ColumnVector([1,2,3,4,5]);
var x = new ColumnVector([2,1,3,4,5]);
print(y.regression_coefficients(x));
print();

// the Tcl example
y = new ColumnVector([
    52.21, 53.12, 54.48, 55.84, 57.20, 58.57, 59.93, 61.29,
    63.11, 64.47, 66.28, 68.10, 69.92, 72.19, 74.46
]);
x = new Matrix(
    [1.47,1.50,1.52,1.55,1.57,1.60,1.63,1.65,1.68,1.70,1.73,1.75,1.78,1.80,1.83].map(
        function(v) {return [Math.pow(v,0), Math.pow(v,1), Math.pow(v,2)]}
    )
);
print(y.regression_coefficients(x));


// version 1.1.2

fun main(args: Array<String>) {
    // create a regular 4 dimensional array and initialize successive elements to the values 1 to 120
    var m = 1
    val a4 = Array<Array<Array<Array<Int>>>>(5) {
        Array<Array<Array<Int>>>(4) {
            Array<Array<Int>>(3) {
                Array<Int>(2) { m++ }
            }
        }
    }

    println("First element = ${a4[0][0][0][0]}")  // access and print value of first element
    a4[0][0][0][0] = 121                          // change value of first element
    println()

    // access and print values of all elements
    val f = "%4d"
    for (i in 0..4)
        for (j in 0..3)
            for (k in 0..2)
                for (l in 0..1)
                    print(f.format(a4[i][j][k][l]))

}


on array ()
    cnt = paramCount()
    if cnt=0 then return
    arr = []
    arr[param(cnt)] = 0
    repeat with d = cnt-1 down to 1
        newArr = []
        repeat with i = 1 to param(d)
            newArr[i] = arr.duplicate() -- duplicate does a deep copy
        end repeat
        arr = newArr.duplicate()
    end repeat
    return arr
end


-- Variadic, first argument is the value with which to populate the array.
function multiArray (initVal, ...)
    local function copy (t)
        local new = {}
        for k, v in pairs(t) do
            if type(v) == "table" then
                new[k] = copy(v)
            else
                new[k] = v
            end
        end
        return new
    end
    local dimensions, arr, newArr = {...}, {}
    for i = 1, dimensions[#dimensions] do table.insert(arr, initVal) end
    for d = #dimensions - 1, 1, -1 do
        newArr = {}
        for i = 1, dimensions[d] do table.insert(newArr, copy(arr)) end
        arr = copy(newArr)
    end
    return arr
end

-- Function to print out the specific example created here
function show4dArray (a)
    print("\nPrinting 4D array in 2D...")
    for k, v in ipairs(a) do
        print(k)
        for l, w in ipairs(v) do
            print("\t" .. l)
                for m, x in ipairs(w) do
                    print("\t", m, unpack(x))
                end
        end
    end
end

-- Main procedure
local t = multiArray("a", 2, 3, 4, 5)
show4dArray(t)
t[1][1][1][1] = true
show4dArray(t)


def dot_product(a; b):
  reduce range(0;a|length) as $i (0; . + (a[$i] * b[$i]) );

# A and B should both be numeric matrices, A being m by n, and B being n by p.
def multiply(A; B):
  (B[0]|length) as $p
  | (B|transpose) as $BT
  | reduce range(0; A|length) as $i
       ([];
       reduce range(0; $p) as $j
         (.;
          .[$i][$j] = dot_product( A[$i]; $BT[$j] ) ));


// Version 1.2.31

typealias Vector = DoubleArray
typealias Matrix = Array<Vector>

operator fun Matrix.times(other: Matrix): Matrix {
    val rows1 = this.size
    val cols1 = this[0].size
    val rows2 = other.size
    val cols2 = other[0].size
    require(cols1 == rows2)
    val result = Matrix(rows1) { Vector(cols2) }
    for (i in 0 until rows1) {
        for (j in 0 until cols2) {
            for (k in 0 until rows2) {
                result[i][j] += this[i][k] * other[k][j]
            }
        }
    }
    return result
}

fun Matrix.transpose(): Matrix {
    val rows = this.size
    val cols = this[0].size
    val trans = Matrix(cols) { Vector(rows) }
    for (i in 0 until cols) {
        for (j in 0 until rows) trans[i][j] = this[j][i]
    }
    return trans
}

fun Matrix.inverse(): Matrix {
    val len = this.size
    require(this.all { it.size == len }) { "Not a square matrix" }
    val aug = Array(len) { DoubleArray(2 * len) }
    for (i in 0 until len) {
        for (j in 0 until len) aug[i][j] = this[i][j]
        // augment by identity matrix to right
        aug[i][i + len] = 1.0
    }
    aug.toReducedRowEchelonForm()
    val inv = Array(len) { DoubleArray(len) }
    // remove identity matrix to left
    for (i in 0 until len) {
        for (j in len until 2 * len) inv[i][j - len] = aug[i][j]
    }
    return inv
}

fun Matrix.toReducedRowEchelonForm() {
    var lead = 0
    val rowCount = this.size
    val colCount = this[0].size
    for (r in 0 until rowCount) {
        if (colCount <= lead) return
        var i = r

        while (this[i][lead] == 0.0) {
            i++
            if (rowCount == i) {
                i = r
                lead++
                if (colCount == lead) return
            }
        }

        val temp = this[i]
        this[i] = this[r]
        this[r] = temp

        if (this[r][lead] != 0.0) {
           val div = this[r][lead]
           for (j in 0 until colCount) this[r][j] /= div
        }

        for (k in 0 until rowCount) {
            if (k != r) {
                val mult = this[k][lead]
                for (j in 0 until colCount) this[k][j] -= this[r][j] * mult
            }
        }

        lead++
    }
}

fun printVector(v: Vector) {
    println(v.asList())
    println()
}

fun multipleRegression(y: Vector, x: Matrix): Vector {
    val cy = (arrayOf(y)).transpose()  // convert 'y' to column vector
    val cx = x.transpose()             // convert 'x' to column vector array
    return ((x * cx).inverse() * x * cy).transpose()[0]
}

fun main(args: Array<String>) {
    var y = doubleArrayOf(1.0, 2.0, 3.0, 4.0, 5.0)
    var x = arrayOf(doubleArrayOf(2.0, 1.0, 3.0, 4.0, 5.0))
    var v = multipleRegression(y, x)
    printVector(v)

    y = doubleArrayOf(3.0, 4.0, 5.0)
    x = arrayOf(
        doubleArrayOf(1.0, 2.0, 1.0),
        doubleArrayOf(1.0, 1.0, 2.0)
    )
    v = multipleRegression(y, x)
    printVector(v)

    y = doubleArrayOf(52.21, 53.12, 54.48, 55.84, 57.20, 58.57, 59.93, 61.29,
                      63.11, 64.47, 66.28, 68.10, 69.92, 72.19, 74.46)

    val a = doubleArrayOf(1.47, 1.50, 1.52, 1.55, 1.57, 1.60, 1.63, 1.65, 1.68, 1.70,
                          1.73, 1.75, 1.78, 1.80, 1.83)
    x = arrayOf(DoubleArray(a.size) { 1.0 }, a, a.map { it * it }.toDoubleArray())
    v = multipleRegression(y, x)
    printVector(v)
}


use feature 'say';

# Perl arrays are internally always one-dimensional, but multi-dimension arrays are supported via references.
# So a two-dimensional array is an arrays-of-arrays, (with 'rows' that are references to arrays), while a
# three-dimensional array is an array of arrays-of-arrays, and so on. There are no arbitrary limits on the
# sizes or number of dimensions (i.e. the 'depth' of nesting references).

# To generate a zero-initialized 2x3x4x5 array
for $i (0..1) {
  for $j (0..2) {
    for $k (0..3) {
      $a[$i][$j][$k][$l] = [(0)x5];
    }
  }
}

# There is no requirement that the overall shape of array be regular, or that contents of
# the array elements be of the the same type.  Arrays can contain almost any type of values
@b = (
     [1, 2, 4, 8, 16, 32],                                                      # numbers
     [<Mon Tue Wed Thu Fri Sat Sun>],                                           # strings
     [sub{$_[0]+$_[1]}, sub{$_[0]-$_[1]}, sub{$_[0]*$_[1]}, sub{$_[0]/$_[1]}]   # coderefs
);
say $b[0][5];           # prints '32'
say $b[1][2];           # prints 'Wed'
say $b[2][0]->(40,2);   # prints '42', sum of 40 and 2

# Pre-allocation is possible, can result in a more efficient memory layout
# (in general though Perl allows minimal control over memory)
$#$big = 1_000_000;

# But dimensions do not need to be pre-declared or pre-allocated.
# Perl will auto-vivify the necessary storage slots on first access.
$c[2][2] = 42;
# @c =
#    [undef]
#    [undef]
#    [undef, undef, 42]

# Negative indicies to count backwards from the end of each dimension
say $c[-1][-1]; # prints '42'

# Elements of an array can be set one-at-a-time or in groups via slices
my @d = <Mon Tue Ned Sat Fri Thu>;
push @d, 'Sun';
$d[2] = 'Wed';
@d[3..5] = @d[reverse 3..5];
say "@d"; # prints 'Mon Tue Wed Thu Fri Sat Sun'


sequence xyz = repeat(repeat(repeat(0,x),y),z)


# Using Wikipedia data sample.

import math
import arraymancer, sequtils

var

  height = [1.47, 1.50, 1.52, 1.55, 1.57, 1.60, 1.63, 1.65,
            1.68, 1.70, 1.73, 1.75, 1.78, 1.80, 1.83].toTensor()

  weight = [52.21, 53.12, 54.48, 55.84, 57.20, 58.57, 59.93, 61.29,
            63.11, 64.47, 66.28, 68.10, 69.92, 72.19, 74.46].toTensor()

# Create Vandermonde matrix.
var a = stack(height.ones_like, height, height *. height, axis = 1)

echo toSeq(least_squares_solver(a, weight).solution.items)


pseudoinv(M)=my(sz=matsize(M),T=conj(M))~;if(sz[1]<sz[2],T/(M*T),(T*M)^-1*T)
addhelp(pseudoinv, "pseudoinv(M): Moore pseudoinverse of the matrix M.");

y*pseudoinv(X)


include ..\Utilitys.pmt

0 ( 5 4 3 2 ) dim

5432 ( 5 4 3 2 ) sset

( 5 4 3 2 ) sget print nl

( 5 4 3 ) sget var row
row print nl

row 1 2 set var row
row print nl

row ( 5 4 3 ) sset
0 10 repeat ( 5 4 2 ) sset

pstack


with javascript_semantics
constant N = 15, M=3
sequence x = {1.47,1.50,1.52,1.55,1.57,
              1.60,1.63,1.65,1.68,1.70,
              1.73,1.75,1.78,1.80,1.83},
         y = {52.21,53.12,54.48,55.84,57.20,
              58.57,59.93,61.29,63.11,64.47,
              66.28,68.10,69.92,72.19,74.46},
         s = repeat(0,N),
         t = repeat(0,N),
         a = repeat(repeat(0,M+1),M)

for k=1 to 2*M do
    for i=1 to N do
        s[k] += power(x[i],k-1)
        if k<=M then t[k] += y[i]*power(x[i],k-1) end if
    end for
end for

-- build linear system

for row=1 to M do
    for col=1 to M do
        a[row,col] = s[row+col-1]
    end for
    a[row,M+1] = t[row]
end for

puts(1,"Linear system coefficents:\n")
pp(a,{pp_Nest,1,pp_IntFmt,"%7.1f",pp_FltFmt,"%7.1f"})

for j=1 to M do
    integer i = j
    while a[i,j]=0 do i += 1 end while
    if i=M+1 then
        ?"SINGULAR MATRIX !"
        ?9/0
    end if
    for k=1 to M+1 do
        {a[j,k],a[i,k]} = {a[i,k],a[j,k]}
    end for
    atom Y = 1/a[j,j]
    a[j] = sq_mul(a[j],Y)
    for k=1 to M do
        if k<>j then
            Y=-a[k,j]
            for m=1 to M+1 do
                a[k,m] += Y*a[j,m]
            end for
        end if
    end for
end for

puts(1,"Solutions:\n")
?columnize(a,M+1)[1]


# Raku supports multi dimension arrays natively. There are no arbitrary limits on the number of dimensions or maximum indices. Theoretically, you could have an infinite number of dimensions of infinite length, though in practice more than a few dozen dimensions gets unwieldy. An infinite maximum index is a fairly common idiom though. You can assign an infinite lazy list to an array and it will only produce the values when they are accessed.

my @integers = 1 .. Inf; # an infinite array containing all positive integers

say @integers[100000]; #100001 (arrays are zero indexed.)

# Multi dimension arrays may be predeclared which constrains the indices to the declared size:

my @dim5[3,3,3,3,3];

#Creates a preallocated 5 dimensional array where each branch has 3 storage slots and constrains the size to the declared size.
#It can then be accessed like so:

@dim5[0;1;2;1;0] = 'Raku';

say @dim5[0;1;2;1;0]; # prints 'Raku'

#@dim5[0;1;2;1;4] = 'error'; # runtime error: Index 4 for dimension 5 out of range (must be 0..2)

# Note that the dimensions do not _need_ to be predeclared / allocated. Raku will auto-vivify the necessary storage slots on first access.

my @a2;

@a2[0;1;2;1;0] = 'Raku';

@a2[0;1;2;1;4] = 'not an error';

# It is easy to access array "slices" in Raku.

my @b = map { [$_ X~ 1..5] }, <a b c d>;

.say for @b;
# [a1 a2 a3 a4 a5]
# [b1 b2 b3 b4 b5]
# [c1 c2 c3 c4 c5]
# [d1 d2 d3 d4 d5]

say @b[*;2]; # Get the all of the values in the third "column"
# (a3 b3 c3 d3)

# By default, Raku can store any object in an array, and it is not very compact. You can constrain the type of values that may be stored which can allow the optimizer to store them much more efficiently.

my @c = 1 .. 10; # Stores integers, but not very compactly since there are no constraints on what the values _may_ be

my uint16 @d = 1 .. 10 # Since there are and only can be unsigned 16 bit integers, the optimizer will use a much more compact memory layout.

# Indices must be a positive integer. Negative indices are not permitted, fractional indices will be truncated to an integer.


(scl 20)

# Matrix transposition
(de matTrans (Mat)
   (apply mapcar Mat list) )

# Matrix multiplication
(de matMul (Mat1 Mat2)
   (mapcar
      '((Row)
         (apply mapcar Mat2
            '(@ (sum */ Row (rest) (1.0 .))) ) )
      Mat1 ) )

# Matrix identity
(de matIdent (N)
   (let L (need N (1.0) 0)
      (mapcar '(() (copy (rot L))) L) ) )

# Reduced row echelon form
(de reducedRowEchelonForm (Mat)
   (let (Lead 1  Cols (length (car Mat)))
      (for (X Mat X (cdr X))
         (NIL
            (loop
               (T (seek '((R) (n0 (get R 1 Lead))) X)
                  @ )
               (T (> (inc 'Lead) Cols)) ) )
         (xchg @ X)
         (let D (get X 1 Lead)
            (map
               '((R) (set R (*/ (car R) 1.0 D)))
               (car X) ) )
         (for Y Mat
            (unless (== Y (car X))
               (let N (- (get Y Lead))
                  (map
                     '((Dst Src)
                        (inc Dst (*/ N (car Src) 1.0)) )
                     Y
                     (car X) ) ) ) )
         (T (> (inc 'Lead) Cols)) ) )
   Mat )


# Project : Multi-dimensional array

a4 = newlist4(5,4,3,2)

func main()
        m = 1
        for i = 1 to 5
             for j = 1 to 4
                  for k = 1 to 3
                        for l = 1 to 2
                             a4[i][j][k][l] = m
                             m = m + 1
                        next
                  next
             next
       next
       see "First element = " + a4[1][1][1][1] + nl
       a4[1][1][1][1] = 121
       see nl
       for i = 1 to 5
            for j = 1 to 4
                 for k = 1 to 3
                       for l = 1 to 2
                            see "" + a4[i][j][k][l] + " "
                       next
                 next
            next
      next

func newlist(x, y)
       if isstring(x) x=0+x ok
       if isstring(y) y=0+y ok
       alist = list(x)
       for t in alist
            t = list(y)
       next
       return alist

func newlist3(x, y, z)
       if isstring(x) x=0+x ok
       if isstring(y) y=0+y ok
       if isstring(z) z=0+z ok
       alist = list(x)
       for t in alist
            t = newlist(y,z)
       next
       return alist

func newlist4(x, y, z, w)
       if isstring(x) x=0+x ok
       if isstring(y) y=0+y ok
       if isstring(z) z=0+z ok
       if isstring(w) w=0+w ok
       alist = list(x)
       for t in alist
            t = newlist3(y,z,w)
       next
       return alist


object MultiDimensionalArray extends App {

  // Create a regular 4 dimensional array and initialize successive elements to the values 1 to 120
  val a4 = Array.fill[Int](5, 4, 3, 2) { m += 1; m }
  var m = 0

  println("First element = " + a4(0)(0)(0)(0)) // access and print value of first element
  println("Last element  = " + a4.last.last.last.last)
  a4(0)(0)(0)(0) = 121 // change value of first element

  println(a4.flatten.flatten.flatten.mkString(", "))

}


proc multilist {value args} {
    set res $value
    foreach dim [lreverse $args] {
        set res [lrepeat $dim $res]
    }
    return $res
}


#lang racket
(require math)
(define T matrix-transpose)

(define (fit X y)
  (matrix-solve (matrix* (T X) X) (matrix* (T X) y)))


smd := [][]string{len: 4, init: []string{len:2, init: 'Hello'}}
imd := [][]int{len: 3, init: []int{len:4, init: it}}
mut mmd := [][]f64{len: 5, init: []f64{len: 5}}
mmd[0][2] = 2.0
mmd[1][3] = 4.2
mmd[2][4] = 1.8
mmd[3][0] = 5.0
mut omd := [][]bool{} // initialize without defining size
omd << [true, false, true]
println(smd)
println(imd)
println(mmd)
println(omd)


import "/fmt" for Fmt

// create a 4 dimensional list of the required size and initialize successive elements to the values 1 to 120
var m = 1
var a4 = List.filled(5, null)
for (i in 0..4) {
    a4[i] = List.filled(4, null)
    for (j in 0..3) {
        a4[i][j] = List.filled(3, null)
        for (k in 0..2) {
            a4[i][j][k] = List.filled(2, 0)
            for (l in 0..1) {
                a4[i][j][k][l] = m
                m = m + 1
            }
        }
    }
}

System.print("First element = %(a4[0][0][0][0])")  // access and print value of first element
a4[0][0][0][0] = 121                               // change value of first element
System.print()

// access and print values of all elements
for (i in 0..4) {
    for (j in 0..3) {
        for (k in 0..2) {
            for (l in 0..1) {
                Fmt.write("$4d", a4[i][j][k][l])
            }
        }
    }
}


option casemap:none

printf  proto :qword, :vararg
exit    proto :dword

ROW_LEN   equ (4*4)
MEM_SIZE  equ 4

.data
;; A 2d array - 2 rows, 4 columns
;; int twodimen[2][4] = { {0,1,2,3},
;;                        {4,5,6,7}};
twodimen   db 48 dup (0)
tpl        db "%d",13,10,0

.code
main proc
  local cols:qword

  lea rbx, twodimen
  mov cols, 0
  ;; Forgive me for the multiple loops, I'm just to lazy to
  ;; do the conditional jumps required for 2 for loops. -.-
  @1:
    mov rcx, cols
    mov dword ptr [rbx+0*ROW_LEN + rcx*MEM_SIZE], ecx    ;; first row, rcx column
    inc cols
    cmp cols, 3
    jle @1

  mov cols, 0
  mov rdx, 4
  @2:
    mov rcx, cols
    mov dword ptr [rbx+1*ROW_LEN + rcx*MEM_SIZE], edx    ;; second row, rcx column
    inc cols
    inc edx
    cmp cols, 3
    jle @2

  invoke printf, CSTR("--> Printing columns in row 1",10)
  mov cols, 0
  @3:
    mov rcx, cols
    mov esi, dword ptr [rbx+0*ROW_LEN + rcx*MEM_SIZE]
    lea rdi, tpl
    call printf
    inc cols
    cmp cols, 3
    jle @3

  invoke printf, CSTR("--> Printing columns in row 2",10)
  mov cols, 0
  @4:
    mov rcx, cols
    mov esi, dword ptr [rbx+1*ROW_LEN + rcx*MEM_SIZE]
    lea rdi, tpl
    call printf
    inc cols
    cmp cols, 3
    jle @4

  mov rax, 0
  xor edi, edi
  call exit
  leave
  ret
main endp


require 'matrix'

def regression_coefficients y, x
  y = Matrix.column_vector y.map { |i| i.to_f }
  x = Matrix.columns x.map { |xi| xi.map { |i| i.to_f }}

  (x.t * x).inverse * x.t * y
end


set rng=mc seed=17760704.
new file.
input program.
  vector x(4).
  loop #i=1 to 200.
    loop #j=1 to 4.
        compute x(#j)=rv.normal(0,1).
    end loop.
    end case.
  end loop.
  end file.
end input program.
compute y=1.5+0.8*x1-0.7*x2+1.1*x3-1.7*x4+rv.normal(0,1).
execute.


package require math::linearalgebra
namespace eval multipleRegression {
    namespace export regressionCoefficients
    namespace import ::math::linearalgebra::*

    # Matrix inversion is defined in terms of Gaussian elimination
    # Note that we assume (correctly) that we have a square matrix
    proc invert {matrix} {
	solveGauss $matrix [mkIdentity [lindex [shape $matrix] 0]]
    }
    # Implement the Ordinary Least Squares method
    proc regressionCoefficients {y x} {
	matmul [matmul [invert [matmul $x [transpose $x]]] $x] $y
    }
}
namespace import multipleRegression::regressionCoefficients


Module Module1

    Sub Swap(Of T)(ByRef x As T, ByRef y As T)
        Dim temp = x
        x = y
        y = temp
    End Sub

    Sub Require(condition As Boolean, message As String)
        If condition Then
            Return
        End If
        Throw New ArgumentException(message)
    End Sub

    Class Matrix
        Private data As Double(,)
        Private rowCount As Integer
        Private colCount As Integer

        Public Sub New(rows As Integer, cols As Integer)
            Require(rows > 0, "Need at least one row")
            rowCount = rows

            Require(cols > 0, "Need at least one column")
            colCount = cols

            data = New Double(rows - 1, cols - 1) {}
        End Sub

        Public Sub New(source As Double(,))
            Dim rows = source.GetLength(0)
            Require(rows > 0, "Need at least one row")
            rowCount = rows

            Dim cols = source.GetLength(1)
            Require(cols > 0, "Need at least one column")
            colCount = cols

            data = New Double(rows - 1, cols - 1) {}
            For i = 1 To rows
                For j = 1 To cols
                    data(i - 1, j - 1) = source(i - 1, j - 1)
                Next
            Next
        End Sub

        Default Public Property Index(i As Integer, j As Integer) As Double
            Get
                Return data(i, j)
            End Get
            Set(value As Double)
                data(i, j) = value
            End Set
        End Property

        Public Property Slice(i As Integer) As Double()
            Get
                Dim m(colCount - 1) As Double
                For j = 1 To colCount
                    m(j - 1) = Index(i, j - 1)
                Next
                Return m
            End Get
            Set(value As Double())
                Require(colCount = value.Length, "Slice must match the number of columns")
                For j = 1 To colCount
                    Index(i, j - 1) = value(j - 1)
                Next
            End Set
        End Property

        Public Shared Operator *(m1 As Matrix, m2 As Matrix) As Matrix
            Dim rc1 = m1.rowCount
            Dim cc1 = m1.colCount
            Dim rc2 = m2.rowCount
            Dim cc2 = m2.colCount
            Require(cc1 = rc2, "Cannot multiply if the first columns does not equal the second rows")
            Dim result As New Matrix(rc1, cc2)
            For i = 1 To rc1
                For j = 1 To cc2
                    For k = 1 To rc2
                        result(i - 1, j - 1) += m1(i - 1, k - 1) * m2(k - 1, j - 1)
                    Next
                Next
            Next
            Return result
        End Operator

        Public Function Transpose() As Matrix
            Dim rc = rowCount
            Dim cc = colCount

            Dim trans As New Matrix(cc, rc)
            For i = 1 To cc
                For j = 1 To rc
                    trans(i - 1, j - 1) = Index(j - 1, i - 1)
                Next
            Next
            Return trans
        End Function

        Public Sub ToReducedRowEchelonForm()
            Dim lead = 0
            Dim rc = rowCount
            Dim cc = colCount
            For r = 1 To rc
                If cc <= lead Then
                    Return
                End If
                Dim i = r

                While Index(i - 1, lead) = 0.0
                    i += 1
                    If rc = i Then
                        i = r
                        lead += 1
                        If cc = lead Then
                            Return
                        End If
                    End If
                End While

                Dim temp = Slice(i - 1)
                Slice(i - 1) = Slice(r - 1)
                Slice(r - 1) = temp

                If Index(r - 1, lead) <> 0.0 Then
                    Dim div = Index(r - 1, lead)
                    For j = 1 To cc
                        Index(r - 1, j - 1) /= div
                    Next
                End If

                For k = 1 To rc
                    If k <> r Then
                        Dim mult = Index(k - 1, lead)
                        For j = 1 To cc
                            Index(k - 1, j - 1) -= Index(r - 1, j - 1) * mult
                        Next
                    End If
                Next

                lead += 1
            Next
        End Sub

        Public Function Inverse() As Matrix
            Require(rowCount = colCount, "Not a square matrix")
            Dim len = rowCount
            Dim aug As New Matrix(len, 2 * len)
            For i = 1 To len
                For j = 1 To len
                    aug(i - 1, j - 1) = Index(i - 1, j - 1)
                Next
                REM augment identity matrix to right
                aug(i - 1, i + len - 1) = 1.0
            Next
            aug.ToReducedRowEchelonForm()
            Dim inv As New Matrix(len, len)
            For i = 1 To len
                For j = len + 1 To 2 * len
                    inv(i - 1, j - len - 1) = aug(i - 1, j - 1)
                Next
            Next
            Return inv
        End Function
    End Class

    Function ConvertArray(source As Double()) As Double(,)
        Dim dest(0, source.Length - 1) As Double
        For i = 1 To source.Length
            dest(0, i - 1) = source(i - 1)
        Next
        Return dest
    End Function

    Function MultipleRegression(y As Double(), x As Matrix) As Double()
        Dim tm As New Matrix(ConvertArray(y))
        Dim cy = tm.Transpose
        Dim cx = x.Transpose
        Return ((x * cx).Inverse * x * cy).Transpose.Slice(0)
    End Function

    Sub Print(v As Double())
        Dim it = v.GetEnumerator()

        Console.Write("[")
        If it.MoveNext() Then
            Console.Write(it.Current)
        End If
        While it.MoveNext
            Console.Write(", ")
            Console.Write(it.Current)
        End While
        Console.Write("]")
    End Sub

    Sub Main()
        Dim y() = {1.0, 2.0, 3.0, 4.0, 5.0}
        Dim x As New Matrix({{2.0, 1.0, 3.0, 4.0, 5.0}})
        Dim v = MultipleRegression(y, x)
        Print(v)
        Console.WriteLine()

        y = {3.0, 4.0, 5.0}
        x = New Matrix({
            {1.0, 2.0, 1.0},
            {1.0, 1.0, 2.0}
        })
        v = MultipleRegression(y, x)
        Print(v)
        Console.WriteLine()

        y = {52.21, 53.12, 54.48, 55.84, 57.2, 58.57, 59.93, 61.29, 63.11, 64.47, 66.28, 68.1, 69.92, 72.19, 74.46}
        Dim a = {1.47, 1.5, 1.52, 1.55, 1.57, 1.6, 1.63, 1.65, 1.68, 1.7, 1.73, 1.75, 1.78, 1.8, 1.83}

        Dim xs(2, a.Length - 1) As Double
        For i = 1 To a.Length
            xs(0, i - 1) = 1.0
            xs(1, i - 1) = a(i - 1)
            xs(2, i - 1) = a(i - 1) * a(i - 1)
        Next
        x = New Matrix(xs)
        v = MultipleRegression(y, x)
        Print(v)
        Console.WriteLine()
    End Sub

End Module


F multifact(n, d)
   R product((n .< 1).step(-d))

L(d) 1..5
   print(‘Degree ’d‘: ’(1..10).map(n -> multifact(n, @d)))


*        Multifactorial            09/05/2016
MULFACR  CSECT
         USING MULFACR,13
SAVEAR   B     STM-SAVEAR(15)
         DC    17F'0'
STM      STM   14,12,12(13) prolog
         ST    13,4(15)     "
         ST    15,8(13)     "
         LR    13,15        "
         LA    I,1          i=1
LOOPI    C     I,D          do i=1 to deg
         BH    ELOOPI       leave i
         LA    L,W+4          [email protected]
         LA    J,1            j=1
LOOPJ    C     J,N            do j=1 to num
         BH    ELOOPJ         leave j
         LA    R,1              r=1
         LCR   S,I              s=-i
         LR    K,J              k=j
LOOPK    C     K,=F'2'          do k=j to 2 by s
         BL    ELOOPK           leave k
         MR    RR,K               r=r*k
         AR    K,S                k=k+s
         B     LOOPK            next k
ELOOPK   CVD   R,Y              pack r
         MVC   X,=XL12'402020202020202020202120' ed mask
         ED    X,Y+2            edit r
         MVC   0(8,L),X+4       output r
         LA    L,8(L)           l=l+8
         LA    J,1(J)           j=j+1
         B     LOOPJ          next j
ELOOPJ   WTO   MF=(E,W)
         LA    I,1(I)         i=i+1
         B     LOOPI        next i
ELOOPI   L     13,4(0,13)   epilog
         LM    14,12,12(13) "
         XR    15,15        "
         BR    14           "
N        DC    F'10'        number
D        DC    F'5'         degree
W        DC    0F,H'84',H'0',CL80' ' length,zero,text
X        DS    CL12         temp
Y        DS    D            packed PL8
I        EQU   6
J        EQU   7
K        EQU   8
S        EQU   9
RR       EQU   10           even reg of R for MR opcode
R        EQU   11
L        EQU   12
         END   MULFACR


INCLUDE "D2:REAL.ACT" ;from the Action! Tool Kit

PROC Multifactorial(INT n,d REAL POINTER res)
  REAL r

  IntToReal(1,res)
  WHILE n>1
  DO
    IntToReal(n,r)
    RealMult(res,r,res)
    n==-d
  OD
RETURN

PROC Main()
  BYTE n,d
  REAL r

  Put(125) PutE() ;clear the screen
  FOR d=1 TO 5
  DO
    PrintF("Degree %B:",d)
    FOR n=1 TO 10
    DO
      Multifactorial(n,d,r)
      Put(32) PrintR(r)
    OD
    PutE()
  OD
RETURN


with Ada.Text_IO; use Ada.Text_IO;
procedure Mfact is

   function MultiFact (num : Natural; deg : Positive) return Natural is
      Result, N : Integer := num;
   begin
      if N = 0 then return 1; end if;
      loop
         N := N - deg; exit when N <= 0; Result := Result * N;
      end loop; return Result;
   end MultiFact;

begin
   for deg in 1..5 loop
      Put("Degree"& Integer'Image(deg) &":");
      for num in 1..10 loop Put(Integer'Image(MultiFact(num,deg))); end loop;
      New_line;
   end loop;
end Mfact;


BEGIN
   INT highest degree = 5;
   INT largest number = 10;
CO Recursive implementation of multifactorial function CO
   PROC multi fact = (INT n, deg) INT :
   (n <= deg | n | n * multi fact(n - deg, deg));
CO Iterative implementation of multifactorial function CO
   PROC multi fact i = (INT n, deg) INT :
   BEGIN
      INT result := n, nn := n;
      WHILE (nn >= deg + 1) DO
	 result TIMESAB nn - deg;
	 nn MINUSAB deg
      OD;
      result
   END;
CO Print out multifactorials CO
   FOR i TO highest degree DO
      printf (($l, "Degree ", g(0), ":"$, i));
      FOR j TO largest number DO
	 printf (($xg(0)$, multi fact (j, i)))
      OD
   OD
END


begin
    % returns the multifactorial of n with the specified degree %
    integer procedure multifactorial ( integer value n, degree ) ;
        begin
            integer mf, v;
            mf := v := n;
            while begin
                      v := v - degree;
                      v > 1
            end do mf := mf * v;
            mf
        end multifactorial ;

    % tests as per task %
    for degree := 1 until 5 do begin
        i_w := 1; s_w := 0; % output formatting %
        write( "Degree: ", degree, ":" );
        for v := 1 until 10 do begin
            writeon( " ", multifactorial( v, degree ) )
        end for_v
    end for_degree
end.


100 FUNCTION multiFactorial (n, degree)
110    IF  n < 2 THEN
120       LET multiFactorial = 1
130       EXIT FUNCTION
140    END IF
150    LET result = n
160    FOR i = n - degree TO 2 STEP -degree
170       LET result = result * i
180    NEXT i
190    LET multiFactorial = result
200 END FUNCTION
210
220 FOR degree = 1 TO 5
230    PRINT "Degree"; degree; " => ";
240    FOR n = 1 TO 10
250       PRINT multiFactorial(n, degree); " ";
260    NEXT n
270    PRINT
280 NEXT degree
290 END


multifact: function [n deg][
	if? n =< deg -> n
	else -> n * multifact n-deg deg
]

loop 1..5 'i [
	prints ["Degree" i ":"]
	loop 1..10 'j [
		prints [multifact j i " "]
	]
	print ""
]


Loop, 5 {
    Output .= "Degree " (i := A_Index) ": "
    Loop, 10
        Output .= MultiFact(A_Index, i) (A_Index = 10 ? "`n" : ", ")
}
MsgBox, % Output

MultiFact(n, d) {
    Result := n
    while 1 < n -= d
        Result *= n
    return, Result
}


# syntax: GAWK -f MULTIFACTORIAL.AWK
# converted from Go
BEGIN {
    for (k=1; k<=5; k++) {
      printf("degree %d:",k)
      for (n=1; n<=10; n++) {
        printf(" %d",multi_factorial(n,k))
      }
      printf("\n")
    }
    exit(0)
}
function multi_factorial(n,k,  r) {
    r = 1
    for (; n>1; n-=k) {
      r *= n
    }
    return(r)
}


REM >multifact
FOR i% = 1 TO 5
  PRINT "Degree "; i%; ":";
  FOR j% = 1 TO 10
    PRINT " ";FNmultifact(j%, i%);
  NEXT
  PRINT
NEXT
END
:
DEF FNmultifact(n%, degree%)
LOCAL i%, mfact%
mfact% = 1
FOR i% = n% TO 1 STEP -degree%
  mfact% = mfact% * i%
NEXT
= mfact%


/* Include statements and constant definitions */
#include <stdio.h>
#define HIGHEST_DEGREE 5
#define LARGEST_NUMBER 10

/* Recursive implementation of multifactorial function */
int multifact(int n, int deg){
   return n <= deg ? n : n * multifact(n - deg, deg);
}

/* Iterative implementation of multifactorial function */
int multifact_i(int n, int deg){
   int result = n;
   while (n >= deg + 1){
      result *= (n - deg);
      n -= deg;
   }
   return result;
}

/* Test function to print out multifactorials */
int main(void){
   int i, j;
   for (i = 1; i <= HIGHEST_DEGREE; i++){
      printf("\nDegree %d: ", i);
      for (j = 1; j <= LARGEST_NUMBER; j++){
         printf("%d ", multifact(j, i));
      }
   }
}


namespace RosettaCode.Multifactorial
{
    using System;
    using System.Linq;

    internal static class Program
    {
        private static void Main()
        {
            Console.WriteLine(string.Join(Environment.NewLine,
                                          Enumerable.Range(1, 5)
                                                    .Select(
                                                        degree =>
                                                        string.Join(" ",
                                                                    Enumerable.Range(1, 10)
                                                                              .Select(
                                                                                number =>
                                                                                Multifactorial(number, degree))))));
        }

        private static int Multifactorial(int number, int degree)
        {
            if (degree < 1)
            {
                throw new ArgumentOutOfRangeException("degree");
            }

            var count = 1 + (number - 1) / degree;
            if (count < 1)
            {
                throw new ArgumentOutOfRangeException("number");
            }

            return Enumerable.Range(0, count)
                             .Aggregate(1, (accumulator, index) => accumulator * (number - degree * index));
        }
    }
}


#include <algorithm>
#include <iostream>
#include <iterator>
/*Generate multifactorials to 9

  Nigel_Galloway
  November 14th., 2012.
*/
int main(void) {
   for (int g = 1; g < 10; g++) {
     int v[11], n=0;
     generate_n(std::ostream_iterator<int>(std::cout, " "), 10, [&]{n++; return v[n]=(g<n)? v[n-g]*n : n;});
     std::cout << std::endl;
   }
   return 0;
}


(defn !! [m n]
  (->> (iterate #(- % m) n) (take-while pos?) (apply *)))

(doseq [m (range 1 6)]
  (prn m (map #(!! m %) (range 1 11))))


multifactorial = proc (n, degree: int) returns (int)
    result: int := 1
    for i: int in int$from_to_by(n, 1, -degree) do
        result := result * i
    end
    return (result)
end multifactorial

start_up = proc ()
    po: stream := stream$primary_output()
    for n: int in int$from_to(1, 10) do
        for d: int in int$from_to(1, 5) do
            stream$putright(po, int$unparse(multifactorial(n,d)), 10)
        end
        stream$putc(po, '\n')
    end
end start_up


(defun mfac (n m)
  (reduce #'* (loop for i from n downto 1 by m collect i)))

(loop for i from 1 to 10
      do (format t "[email protected]: ~{~a~^ ~}~%"
                 i (loop for j from 1 to 10
                         collect (mfac j i))))


def multifact(n, d)
  n.step(to: 1, by: -d).product
end

(1..5).each {|d| puts "Degree #{d}: #{(1..10).map{|n| multifact(n, d)}.join "\t"}"}


import std.stdio, std.algorithm, std.range;

T multifactorial(T=long)(in int n, in int m) pure /*nothrow*/ {
    T one = 1;
    return reduce!q{a * b}(one, iota(n, 0, -m));
}

void main() {
    foreach (immutable m; 1 .. 11)
        writefln("%2d: %s", m, iota(1, 11)
                               .map!(n => multifactorial(n, m)));
}


main()
{
  int n=5,d=3;
int z= fact(n,d);
print('$n factorial of degree $d is $z');
for(var j=1;j<=5;j++)
{
  print('first 10 numbers of degree $j :');
  for(var i=1;i<=10;i++)
  {
    int z=fact(i,j);
 print('$z');
}
  print('\n');
}
}

int fact(int a,int b)
{

  if(a<=b||a==0)
    return a;
  if(a>1)
    return a*fact((a-b),b);
}


proc nonrec multifac(int n, deg) ulong:
    ulong result;
    result := 1;
    while n > 1 do
        result := result * n;
        n := n - deg
    od;
    result
corp

proc nonrec main() void:
    byte n, d;
    for n from 1 upto 10 do
        for d from 1 upto 5 do
            write(multifac(n,d):10)
        od;
        writeln()
    od
corp


defmodule RC do
  def multifactorial(n,d) do
    Enum.take_every(n..1, d) |> Enum.reduce(1, fn x,p -> x*p end)
  end
end

Enum.each(1..5, fn d ->
  multifac = for n <- 1..10, do: RC.multifactorial(n,d)
  IO.puts "Degree #{d}: #{inspect multifac}"
end)


-module(multifac).
-compile(export_all).

multifac(N,D) ->
    lists:foldl(fun (X,P) -> X * P end, 1, lists:seq(N,1,-D)).

main() ->
    Ds = lists:seq(1,5),
    Ns = lists:seq(1,10),
    lists:foreach(fun (D) ->
                          io:format("Degree ~b: ~p~n",[D, [ multifac(N,D) || N <- Ns]])
                  end, Ds).


PROGRAM MULTIFACTORIAL

PROCEDURE MULTI_FACT(NUM,DEG->MF)
   RESULT=NUM
   N=NUM
   IF N=0 THEN
      MF=1
      EXIT PROCEDURE
   END IF
   LOOP
      N-=DEG
      EXIT IF N<=0
      RESULT*=N
   END LOOP
   MF=RESULT
END PROCEDURE

BEGIN
  PRINT(CHR$(12);)
  FOR DEG=1 TO 10 DO
      PRINT("Degree";DEG;":";)
      FOR NUM=1 TO 10 DO
          MULTI_FACT(NUM,DEG->MF)
          PRINT(MF;)
      END FOR
      PRINT
  END FOR
END PROGRAM


let rec mfact d = function
    | n when n <= d   -> n
    | n -> n * mfact d (n-d)

[<EntryPoint>]
let main argv =
    let (|UInt|_|) = System.UInt32.TryParse >> function | true, v -> Some v | false, _ -> None
    let (maxDegree, maxN) =
        match argv with
            | [| UInt d; UInt n |] -> (int d, int n)
            | [| UInt d |]         -> (int d, 10)
            | _                    -> (5, 10)
    let showFor d = List.init maxN (fun i -> mfact d (i+1)) |> printfn "%i: %A" d
    ignore (List.init maxDegree (fun i -> showFor (i+1)))
    0


USING: formatting io kernel math math.ranges prettyprint
sequences ;
IN: rosetta-code.multifactorial

: multifactorial ( n degree -- m )
    neg 1 swap <range> product ;

: mf-row ( degree -- )
    dup "Degree %d: " printf
    10 [1,b] [ swap multifactorial pprint bl ] with each ;

: main ( -- )
    5 [1,b] [ mf-row nl ] each ;

MAIN: main


: !n negate swap 1 dup rot do i * over +loop nip ;
: test cr 6 1 ?do 11 1 ?do i j !n . loop cr loop ;


program test
  implicit none
  integer :: i, j, n

  do i = 1, 5
    write(*, "(a, i0, a)", advance = "no") "Degree ", i, ": "
    do j = 1, 10
      n = multifactorial(j, i)
      write(*, "(i0, 1x)", advance = "no") n
    end do
    write(*,*)
  end do

contains

function multifactorial (range, degree)
  integer :: multifactorial, range, degree
  integer :: k

  multifactorial = product((/(k, k=range, 1, -degree)/))

end function multifactorial
end program test


' FB 1.05.0 Win64

Function multiFactorial (n As UInteger, degree As Integer) As UInteger
  If  n < 2 Then Return 1
  Var result = n
  For i As Integer = n - degree To 2 Step -degree
    result *= i
  Next
  Return result
End Function

For degree As Integer = 1 To 5
  Print "Degree"; degree; " => ";
  For n As Integer = 1 To 10
    Print multiFactorial(n, degree); " ";
  Next n
  Print
Next degree

Print
Print "Press any key to quit"
Sleep


def multifactorial( n, d ) = product( n..1 by -d )

for d <- 1..5
  println( d, [multifactorial(i, d) | i <- 1..10] ))


package main

import "fmt"

func multiFactorial(n, k int) int {
    r := 1
    for ; n > 1; n -= k {
        r *= n
    }
    return r
}

func main() {
    for k := 1; k <= 5; k++ {
        fmt.Print("degree ", k, ":")
        for n := 1; n <= 10; n++ {
            fmt.Print(" ", multiFactorial(n, k))
        }
        fmt.Println()
    }
}


mulfac :: (Num a, Enum a) => a -> [a]
mulfac k = 1 : s
  where
    s = [1 .. k] <> zipWith (*) s [k + 1 ..]

-- For single n:

mulfac1 :: (Num a, Enum a) => a -> a -> a
mulfac1 k n = product [n, n - k .. 1]

main :: IO ()
main =
  mapM_
    (print . take 10 . tail . mulfac)
    [1 .. 5]


procedure main(A)
    l := integer(A[1]) | 10
    every writeRow(n := !l, [: mf(!10,n) :])
end

procedure writeRow(n, r)
    writes(right(n,3),": ")
    every writes(right(!r,8)|"\n")
end

procedure mf(n, m)
    if n <= 0 then return 1
    return n*mf(n-m, m)
end


100 PROGRAM "Multifac.bas"
110 FOR I=1 TO 5
120   PRINT "Degree";I;":";
130   FOR N=1 TO 10
140     PRINT MFACT(N,I);
150   NEXT
160   PRINT
170 NEXT
180 DEF MFACT(N,D)
190   NUMERIC I,RES
200   IF N<2 THEN LET MFACT=1:EXIT DEF
210   LET RES=N
220   FOR I=N-D TO 2 STEP-D
230     LET RES=RES*I
240   NEXT
250   LET MFACT=RES
260 END DEF


   NB. tacit implementation of the recursive c function
   NB. int multifact(int n,int deg){return n<=deg?n:n*multifact(n-deg,deg);}

   multifact=: [`([ * - $: ])@.(<~)
   (a:,<'       degree'),multifact table >:i.10
┌─────────┬──────────────────────────────────────┐
│         │       degree                         │
├─────────┼──────────────────────────────────────┤
│multifact│      1    2   3   4  5  6  7  8  9 10│
├─────────┼──────────────────────────────────────┤
│ 1       │      1    1   1   1  1  1  1  1  1  1│
│ 2       │      2    2   2   2  2  2  2  2  2  2│
│ 3       │      6    3   3   3  3  3  3  3  3  3│
│ 4       │     24    8   4   4  4  4  4  4  4  4│
│ 5       │    120   15  10   5  5  5  5  5  5  5│
│ 6       │    720   48  18  12  6  6  6  6  6  6│
│ 7       │   5040  105  28  21 14  7  7  7  7  7│
│ 8       │  40320  384  80  32 24 16  8  8  8  8│
│ 9       │ 362880  945 162  45 36 27 18  9  9  9│
│10       │3628800 3840 280 120 50 40 30 20 10 10│
└─────────┴──────────────────────────────────────┘


public class MultiFact {
	private static long multiFact(long n, int deg){
		long ans = 1;
		for(long i = n; i > 0; i -= deg){
			ans *= i;
		}
		return ans;
	}

	public static void main(String[] args){
		for(int deg = 1; deg <= 5; deg++){
			System.out.print("degree " + deg + ":");
			for(long n = 1; n <= 10; n++){
				System.out.print(" " + multiFact(n, deg));
			}
			System.out.println();
		}
	}
}


function multifact(n, deg){
	var result = n;
	while (n >= deg + 1){
		result *= (n - deg);
		n -= deg;
	}
	return result;
}


# Input: n
# Output: n * (n - d) * (n - 2d) ...
def multifactorial(d):
  . as $n
  | ($n / d | floor) as $k
  | reduce ($n - (d * range(0; $k))) as $i (1; . * $i);


using Printf

function multifact(n::Integer, k::Integer)
    n > 0 && k > 0 || throw(DomainError())
    k > 1 || factorial(n)
    return prod(n:-k:2)
end

const khi = 5
const nhi = 10
println("Showing multifactorial for n in [1, $nhi] and k in [1, $khi].")
for k = 1:khi
    a = multifact.(1:nhi, k)
    lab = "n" * "!" ^ k
    @printf("  %-6s →  %s\n", lab, a)
end


fun multifactorial(n: Long, d: Int) : Long {
    val r = n % d
    return (1..n).filter { it % d == r } .reduce { i, p -> i * p }
}

fun main(args: Array<String>) {
    val m = 5
    val r = 1..10L
    for (d in 1..m) {
        print("%${m}s:".format( "!".repeat(d)))
        r.forEach { print(" " + multifactorial(it, d)) }
        println()
    }
}


use 'format importAllSigils.

multiFactorial := {
  Range make ($1, 0, - $2) product.
}.

1 upto 6 visit {
  takes '[degree].
  answers := 1 upto 11 to (Array) map { multiFactorial ($1, degree). }.
  $stdout printf: ~fmt "Degree ~S: ~S", degree, answers.
}.


function multiFact (n, degree)
    local fact = 1
    for i = n, 2, -degree do
        fact = fact * i
    end
    return fact
end

print("Degree\t|\tMultifactorials 1 to 10")
print(string.rep("-", 52))
for d = 1, 5 do
    io.write(" " .. d, "\t| ")
    for n = 1, 10 do
        io.write(multiFact(n, d) .. " ")
    end
    print()
end


            NORMAL MODE IS INTEGER

            INTERNAL FUNCTION(N,DEG)
            ENTRY TO MLTFAC.
            RSLT = 1
            THROUGH MULT, FOR MPC=N, -DEG, MPC.L.1
MULT        RSLT = RSLT * MPC
            FUNCTION RETURN RSLT
            END OF FUNCTION

            THROUGH SHOW, FOR I=1, 1, I.G.10
SHOW        PRINT FORMAT OUTP, MLTFAC.(I,1), MLTFAC.(I,2),
          0      MLTFAC.(I,3), MLTFAC.(I,4), MLTFAC.(I,5)

            VECTOR VALUES OUTP = $5(I10,S1)*$
            END OF PROGRAM


f := proc (n, m)
	local fac, i;
	fac := 1;
	for i from n by -m to 1 do
		fac := fac*i;
	end do;
	return fac;
end proc:

a:=Matrix(5,10):
for i from 1 to 5 do
	for j from 1 to 10 do
		a[i,j]:=f(j,i);
	end do;
end do;
a;


Multifactorial[n_, d_] := Product[x, {x, n, 1, -d}]
Table[Multifactorial[j, i], {i, 5}, {j, 10}]//TableForm


(:d (dup 0 <=) (pop 1) (dup d -) (*) linrec) :multifactorial
(:d 1 (dup d multifactorial print! " " print! succ) 10 times newline pop) :row

1 (dup "Degree " print! print ": " print! row succ) 5 times


# Recursive
proc multifact(n, deg: int): int =
  result = (if n <= deg: n else: n * multifact(n - deg, deg))

# Iterative
proc multifactI(n, deg: int): int =
  result = n
  var n = n
  while n >= deg + 1:
    result *= n - deg
    n -= deg

for i in 1..5:
  stdout.write "Degree ", i, ": "
  for j in 1..10:
    stdout.write multifactI(j, i), " "
  stdout.write('\n')


class Multifact {
   function : MultiFact(n : Int, deg : Int) ~ Int {
      result := n;
      while (n >= deg + 1){
         result *= (n - deg);
         n -= deg;
      };

      return result;
   }

   function : Main(args : String[]) ~ Nil {
      for (i := 1; i <= 5; i+=1;){
         IO.Console->Print("Degree ")->Print(i)->Print(": ");
         for (j := 1; j <= 10; j+=1;){
            IO.Console->Print(' ')->Print(MultiFact(j, i));
         };
         IO.Console->PrintLine();
      };
   }
}


: multifact(n, deg)  1 while( n 0 > ) [ n * n deg - ->n ] ;

: printMulti
| i |
   5 loop: i [ System.Out i << " : " << 10 seq map(#[ i multifact]) << cr ] ;


{ # <-- scoping the cache and bigint clause
	my @cache;
	use bigint;
	sub mfact {
		my ($s, $n) = @_;
		return 1 if $n <= 0;
		$cache[$s][$n] //= $n * mfact($s, $n - $s);
	}
}

for my $s (1 .. 10) {
	print "step=$s: ";
	print join(" ", map(mfact($s, $_), 1 .. 10)), "\n";
}


with javascript_semantics
function multifactorial(integer n, order)
    atom res = 1
    if n>0 then
        res = n*multifactorial(n-order,order)
    end if
    return res
end function

sequence s = repeat(0,10)
for i=1 to 5 do
    for j=1 to 10 do
        s[j] = multifactorial(j,i)
    end for
    pp(s)
end for


multifactorial(N,Degree) = prod([ I : I in N..-Degree..1]).


(de multifact (N Deg)
   (let Res N
      (while (> N Deg)
         (setq Res (* Res (dec 'N Deg))) )
      Res ) )

(for I 5
   (prin "Degree " I ":")
   (for J 10
      (prin " " (multifact J I)) )
   (prinl) )


multi: procedure options (main);      /* 29 October 2013 */
   declare (i, j, n) fixed binary;
   declare text character (6) static initial ('n!!!!!');

   do i = 1 to 5;
      put skip edit (substr(text, 1, i+1), '=' ) (A, COLUMN(8));
      do n = 1 to 10;
         put edit ( trim( multifactorial(n,i) ) ) (X(1), A);
      end;
   end;

multifactorial: procedure (n, j) returns (fixed(15));
   declare (n, j) fixed binary;
   declare f fixed (15), m fixed(15);

      f, m = n;
      do while (m > j); f = f * (m-fixed(j)); m = m - j; end;
      return (f);
end multifactorial;

end multi;


\long\def\antefi#1#2\fi{#2\fi#1}
\def\fornum#1=#2to#3(#4){%
    \edef#1{\number\numexpr#2}\edef\fornumtemp{\noexpand\fornumi\expandafter\noexpand\csname fornum\string#1\endcsname
        {\number\numexpr#3}{\ifnum\numexpr#4<0 <\else>\fi}{\number\numexpr#4}\noexpand#1}\fornumtemp
}
\long\def\fornumi#1#2#3#4#5#6{\def#1{\unless\ifnum#5#3#2\relax\antefi{#6\edef#5{\number\numexpr#5+(#4)\relax}#1}\fi}#1}
\newcount\result
\def\multifact#1#2{%
    \result=1
    \fornum\multifactiter=#1 to 1(-#2){\multiply\result\multifactiter}%
    \number\result
}
\fornum\degree=1 to 5(+1){Degree \degree: \fornum\ii=1 to 10(+1){\multifact\ii\degree\space\space}\par}
\bye


  [ 1 rot times
      [ i 1+ *
        dip [ over step ] ]
    nip ]                   is m! ( n --> n! )

  5 times
    [ i^ 1+ 10 times
      [ i^ 1+ over m!
        echo sp ]
      drop cr ]


#x is Input
#n is Factorial Number
multifactorial=function(x,n){
  if(x<=n+1){
    return(x)
  }else{
    return(x*multifactorial(x-n,n))
  }
}


#lang racket

(define (multi-factorial-fn m)
  (lambda (n)
    (let inner ((acc 1) (n n))
      (if (<= n m) (* acc n)
          (inner (* acc n) (- n m))))))

;; using (multi-factorial-fn m) as a first-class function
(for*/list ([m (in-range 1 (add1 5))] [mf-m (in-value (multi-factorial-fn m))])
  (for/list ([n (in-range 1 (add1 10))])
  (mf-m n)))

(define (multi-factorial m n) ((multi-factorial-fn m) n))

(for/list ([m (in-range 1 (add1 5))])
  (for/list ([n (in-range 1 (add1 10))])
  (multi-factorial m n)))


/*REXX program calculates and displays K-fact (multifactorial) of non-negative integers.*/
numeric digits 1000                              /*get ka-razy with the decimal digits. */
parse arg num deg .                              /*get optional arguments from the C.L. */
if num=='' | num==","   then num=15              /*Not specified?  Then use the default.*/
if deg=='' | deg==","   then deg=10              /* "      "         "   "   "     "    */
say '═══showing multiple factorials (1 ──►'     deg")  for numbers  1 ──►"      num
say
     do d=1  for deg                             /*the factorializing (degree)  of  !'s.*/
     _=                                          /*the list of factorials  (so far).    */
            do f=1  for num                      /* ◄── perform a ! from  1 ───► number.*/
            _=_  Kfact(f, d)                     /*build a  list  of factorial products.*/
            end   /*f*/                          /* [↑]    D   can default to  unity.   */

     say right('n'copies("!", d), 1+deg)    right('['d"]", 2+length(num) )':'     _
     end          /*d*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
Kfact: procedure; !=1;   do j=arg(1)  to 2  by -word(arg(2) 1,1);  !=!*j;  end;   return !


see "Degree  " +  "|" + "           Multifactorials 1 to 10" + nl
see copy("-", 52) + nl
for d = 1 to 5
    see "" + d + "       " + "| "
    for n = 1 to 10
        see "" + multiFact(n, d) + " "
    next
    see nl
next

func multiFact n, degree
     fact = 1
     for i = n to 2 step -degree
         fact = fact * i
     next
     return fact


def multifact(n, d)
  n.step(1, -d).inject( :* )
end

(1..5).each {|d| puts "Degree #{d}: #{(1..10).map{|n| multifact(n, d)}.join "\t"}"}


print "Degree  " +  "|" + "           Multifactorials 1 to 10" + nl
print copy("-", 52) + nl
for d = 1 to 5
    print "" + d + "       " + "| "
    for n = 1 to 10
        print "" + multiFact(n, d) + " ";
    next
    print
next

function multiFact(n,degree)
     fact = 1
     for i = n to 2 step -degree
         fact = fact * i
     next
     multiFact = fact
 end function


fn multifactorial(n: i32, deg: i32) -> i32 {
	if n < 1 {
		1
	} else {
		n * multifactorial(n - deg, deg)
	}
}

fn main() {
	for i in 1..6 {
		for j in 1..11 {
			print!("{} ", multifactorial(j, i));
		}
	println!("");
	}
}


def multiFact(n : BigInt, degree : BigInt) = (n to 1 by -degree).product

for{
  degree <- 1 to 5
  str = (1 to 10).map(n => multiFact(n, degree)).mkString(" ")
} println(s"Degree $degree: $str")


(import (scheme base)
        (scheme write)
        (srfi 1))

(define (multi-factorial n m)
  (fold * 1 (iota (ceiling (/ n m)) n (- m))))

(for-each
  (lambda (degree)
    (display (string-append "degree "
                            (number->string degree)
                            ": "))
    (for-each
      (lambda (num)
        (display (string-append (number->string (multi-factorial num degree))
                                " ")))
      (iota 10 1))
    (newline))
  (iota 5 1))


$ include "seed7_05.s7i";

const func integer: multiFact (in var integer: num, in integer: degree) is func
  result
    var integer: multiFact is 1;
  begin
    while num > 1 do
      multiFact *:= num;
      num -:= degree;
    end while;
  end func;

const proc: main is func
  local
    var integer: degree is 0;
    var integer: num is 0;
  begin
    for degree range 1 to 5 do
      write("Degree " <& degree <& ": ");
      for num range 1 to 10 do
        write(multiFact(num, degree) <& " ");
      end for;
      writeln;
    end for;
  end func;


func multiFactorial(_ n: Int, k: Int) -> Int {
  return stride(from: n, to: 0, by: -k).reduce(1, *)
}

let multis = (1...5).map({degree in
  (1...10).map({member in
    multiFactorial(member, k: degree)
  })
})

for (i, degree) in multis.enumerated() {
  print("Degree \(i + 1): \(degree)")
}


package require Tcl 8.6

proc mfact {n m} {
    set mm [expr {-$m}]
    for {set r $n} {[incr n $mm] > 1} {set r [expr {$r * $n}]} {}
    return $r
}

foreach n {1 2 3 4 5 6 7 8 9 10} {
    puts $n:[join [lmap m {1 2 3 4 5 6 7 8 9 10} {mfact $m $n}] ,]
}


print "Degree  |           Multifactorials 1 to 10"
for x = 1 to 53 : print "-"; : next : print
for d = 1 to 5
  print d;"       ";"| ";
  for n = 1 to 10
    print FUNC(_multiFact(n, d));" ";
  next
  print
next

end

_multiFact param (2)
  local (2)
  [email protected] = 1
  for [email protected] = [email protected] to 2 step [email protected]
    [email protected] = [email protected] * [email protected]
  next
return ([email protected])


Function multifactorial(n,d)
	If n = 0 Then
		multifactorial = 1
	Else
		For i = n To 1 Step -d
			If i = n Then
				multifactorial = n
			Else
				multifactorial = multifactorial * i
			End If
		Next
	End If
End Function

For j = 1 To 5
	WScript.StdOut.Write "Degree " & j & ": "
	For k = 1 To 10
		If k = 10 Then
			WScript.StdOut.Write multifactorial(k,j)
		Else
			WScript.StdOut.Write multifactorial(k,j) & " "
		End If
	Next
	WScript.StdOut.WriteLine
Next


@let {
  facd  &[d n]?{<= n d n @[email protected][n 1 @-d]}
  ; tacit implementation
  facdt ^(!?(/^> .1 ^(@prod @range ~1jdtShj &^!(@- @id))) @,)
  ; recursive
  facdrec &[n d] ?{<= n d n *n !!facdrec -n d d}
  ; output
  l @to 10
  [email protected] @to 5 &n !console.log "Degree {n}: {@join @s !*\facd n l}"
}


import "/fmt" for Fmt

var mf = Fn.new { |n, d|
    var prod = 1
    while (n > 1) {
        prod = prod * n
        n = n - d
    }
    return prod
}

for (d in 1..5) {
    System.write("degree %(d): ")
    for (n in 1..10) System.write(Fmt.d(8, mf.call(n, d)))
    System.print()
}


code ChOut=8, CrLf=9, IntOut=11;

func MultiFac(N, D);    \Return multifactorial of N in degree D
int  N, D;
int  F;
[F:= 1;
repeat  F:= F*N;
        N:= N-D;
until   N <= 1;
return F;
];

int I, J;               \generate table of multifactorials
for J:= 1 to 5 do
    [for I:= 1 to 10 do
        [IntOut(0, MultiFac(I, J));  ChOut(0, 9\tab\)];
    CrLf(0);
    ]


fcn mfact(n,m){ [n..1,-m].reduce('*,1) }
foreach m in ([1..5]){ println("%d: %s".fmt(m,[1..10].apply(mfact.fp1(m)))) }


#include <algorithm>
#include <cmath>
#include <cstdint>
#include <cstdlib>
#include <cstring>
#include <iostream>
#include <string>
#include <vector>
#include <primesieve.hpp>

class prime_sieve {
public:
    explicit prime_sieve(uint64_t limit);
    bool is_prime(uint64_t n) const {
        return n == 2 || ((n & 1) == 1 && sieve[n >> 1]);
    }

private:
    std::vector<bool> sieve;
};

prime_sieve::prime_sieve(uint64_t limit) : sieve((limit + 1) / 2, false) {
    primesieve::iterator iter;
    uint64_t prime = iter.next_prime(); // consume 2
    while ((prime = iter.next_prime()) <= limit) {
        sieve[prime >> 1] = true;
    }
}

template <typename T> void print(std::ostream& out, const std::vector<T>& v) {
    if (!v.empty()) {
        out << '[';
        auto i = v.begin();
        out << *i++;
        for (; i != v.end(); ++i)
            out << ", " << *i;
        out << ']';
    }
}

std::string to_string(const std::vector<unsigned int>& v) {
    static constexpr char digits[] =
        "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
    std::string str;
    for (auto i : v)
        str += digits[i];
    return str;
}

bool increment(std::vector<unsigned int>& digits, unsigned int max_base) {
    for (auto i = digits.rbegin(); i != digits.rend(); ++i) {
        if (*i + 1 != max_base) {
            ++*i;
            return true;
        }
        *i = 0;
    }
    return false;
}

void multi_base_primes(unsigned int max_base, unsigned int max_length) {
    prime_sieve sieve(static_cast<uint64_t>(std::pow(max_base, max_length)));
    for (unsigned int length = 1; length <= max_length; ++length) {
        std::cout << length
                  << "-character strings which are prime in most bases: ";
        unsigned int most_bases = 0;
        std::vector<
            std::pair<std::vector<unsigned int>, std::vector<unsigned int>>>
            max_strings;
        std::vector<unsigned int> digits(length, 0);
        digits[0] = 1;
        std::vector<unsigned int> bases;
        do {
            auto max = std::max_element(digits.begin(), digits.end());
            unsigned int min_base = 2;
            if (max != digits.end())
                min_base = std::max(min_base, *max + 1);
            if (most_bases > max_base - min_base + 1)
                continue;
            bases.clear();
            for (unsigned int b = min_base; b <= max_base; ++b) {
                if (max_base - b + 1 + bases.size() < most_bases)
                    break;
                uint64_t n = 0;
                for (auto d : digits)
                    n = n * b + d;
                if (sieve.is_prime(n))
                    bases.push_back(b);
            }
            if (bases.size() > most_bases) {
                most_bases = bases.size();
                max_strings.clear();
            }
            if (bases.size() == most_bases)
                max_strings.emplace_back(digits, bases);
        } while (increment(digits, max_base));
        std::cout << most_bases << '\n';
        for (const auto& m : max_strings) {
            std::cout << to_string(m.first) << " -> ";
            print(std::cout, m.second);
            std::cout << '\n';
        }
        std::cout << '\n';
    }
}

int main(int argc, char** argv) {
    unsigned int max_base = 36;
    unsigned int max_length = 4;
    for (int arg = 1; arg + 1 < argc; ++arg) {
        if (strcmp(argv[arg], "-max_base") == 0)
            max_base = strtoul(argv[++arg], nullptr, 10);
        else if (strcmp(argv[arg], "-max_length") == 0)
            max_length = strtoul(argv[++arg], nullptr, 10);
    }
    if (max_base > 62) {
        std::cerr << "Max base cannot be greater than 62.\n";
        return EXIT_FAILURE;
    }
    if (max_base < 2) {
        std::cerr << "Max base cannot be less than 2.\n";
        return EXIT_FAILURE;
    }
    multi_base_primes(max_base, max_length);
    return EXIT_SUCCESS;
}


// Multi-base primes. Nigel Galloway: July 4th., 2021
let digits="0123456789abcdefghijklmnopqrstuvwxyz"
let fG n g=let rec fN g=function i when i<n->i::g |i->fN((i%n)::g)(i/n) in primes32()|>Seq.skipWhile((>)(pown n (g-1)))|>Seq.takeWhile((>)(pown n g))|>Seq.map(fun g->(n,fN [] g))
let fN g={2..36}|>Seq.collect(fun n->fG n g)|>Seq.groupBy snd|>Seq.groupBy(snd>>(Seq.length))|>Seq.maxBy fst
{1..4}|>Seq.iter(fun g->let n,i=fN g in printfn "The following strings of length %d represent primes in the maximum number of bases(%d):" g n
                        i|>Seq.iter(fun(n,g)->printf "  %s->" (n|>List.map(fun n->digits.[n])|>Array.ofList|>System.String)
                                              g|>Seq.iter(fun(g,_)->printf "%d " g); printfn ""); printfn "")


USING: assocs assocs.extras formatting io kernel math
math.functions math.parser math.primes math.ranges present
sequences ;

: prime?* ( n -- ? ) [ prime? ] [ f ] if* ; inline

: (bases) ( n -- range quot )
    present 2 36 [a,b] [ base> prime?* ] with ; inline

: <digits> ( n -- range ) [ 1 - ] keep [ 10^ ] [email protected] [a,b) ;

: multibase ( n -- assoc )
    <digits> [ (bases) count ] zip-with assoc-invert
    expand-keys-push-at >alist [ first ] supremum-by ;

: multibase. ( n -- )
    dup multibase first2
    [ "%d-digit numbers that are prime in the most bases: %d\n" printf ] dip
    [ dup (bases) filter "%d => %[%d, %]\n" printf ] each ;

4 [1,b] [ multibase. nl ] each


package main

import (
    "fmt"
    "math"
    "rcu"
)

var maxDepth = 6
var maxBase = 36
var c = rcu.PrimeSieve(int(math.Pow(float64(maxBase), float64(maxDepth))), true)
var digits = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
var maxStrings [][][]int
var mostBases = -1

func maxSlice(a []int) int {
    max := 0
    for _, e := range a {
        if e > max {
            max = e
        }
    }
    return max
}

func maxInt(a, b int) int {
    if a > b {
        return a
    }
    return b
}

func process(indices []int) {
    minBase := maxInt(2, maxSlice(indices)+1)
    if maxBase - minBase + 1 < mostBases {
        return  // can't affect results so return
    }
    var bases []int
    for b := minBase; b <= maxBase; b++ {
        n := 0
        for _, i := range indices {
            n = n*b + i
        }
        if !c[n] {
            bases = append(bases, b)
        }
    }
    count := len(bases)
    if count > mostBases {
        mostBases = count
        indices2 := make([]int, len(indices))
        copy(indices2, indices)
        maxStrings = [][][]int{[][]int{indices2, bases}}
    } else if count == mostBases {
        indices2 := make([]int, len(indices))
        copy(indices2, indices)
        maxStrings = append(maxStrings, [][]int{indices2, bases})
    }
}

func printResults() {
    fmt.Printf("%d\n", len(maxStrings[0][1]))
    for _, m := range maxStrings {
        s := ""
        for _, i := range m[0] {
            s = s + string(digits[i])
        }
        fmt.Printf("%s -> %v\n", s, m[1])
    }
}

func nestedFor(indices []int, length, level int) {
    if level == len(indices) {
        process(indices)
    } else {
        indices[level] = 0
        if level == 0 {
            indices[level] = 1
        }
        for indices[level] < length {
            nestedFor(indices, length, level+1)
            indices[level]++
        }
    }
}

func main() {
    for depth := 1; depth <= maxDepth; depth++ {
        fmt.Print(depth, " character strings which are prime in most bases: ")
        maxStrings = maxStrings[:0]
        mostBases = -1
        indices := make([]int, depth)
        nestedFor(indices, maxBase, 0)
        printResults()
        fmt.Println()
    }
}


using Primes

function maxprimebases(ndig, maxbase)
    maxprimebases = [Int[]]
    nwithbases = [0]
    maxprime = 10^(ndig) - 1
    for p in div(maxprime + 1, 10):maxprime
        dig = digits(p)
        bases = [b for b in 2:maxbase if (isprime(evalpoly(b, dig)) && all(i -> i < b, dig))]
        if length(bases) > length(first(maxprimebases))
            maxprimebases = [bases]
            nwithbases = [p]
        elseif length(bases) == length(first(maxprimebases))
            push!(maxprimebases, bases)
            push!(nwithbases, p)
        end
    end
    alen, vlen = length(first(maxprimebases)), length(maxprimebases)
    println("\nThe maximum number of prime valued bases for base 10 numeric strings of length ",
        ndig, " is $alen. The base 10 value list of ", vlen > 1 ? "these" : "this", " is:")
    for i in eachindex(maxprimebases)
        println(nwithbases[i], " => ", maxprimebases[i])
    end
end

@time for n in 1:6
    maxprimebases(n, 36)
end


ClearAll[OtherBasePrimes, OtherBasePrimesPower]
OtherBasePrimes[n_Integer] := Module[{digs, minbase, bases},
  digs = IntegerDigits[n];
  minbase = Max[digs] + 1;
  bases = Range[minbase, 36];
  Pick[bases, PrimeQ[FromDigits[digs, #] & /@ bases], True]
  ]
OtherBasePrimesPower[p_] := Module[{min, max, out, maxlen},
  min = 10^p;
  max = 10^(p + 1) - 1;
  out = {#, OtherBasePrimes[#]} & /@ Range[min, max];
  maxlen = Max[Length /@ out[[All, 2]]];
  Select[out, Last /* Length /* EqualTo[maxlen]]
  ]
OtherBasePrimesPower[0] // Column
OtherBasePrimesPower[1] // Column
OtherBasePrimesPower[2] // Column
OtherBasePrimesPower[3] // Column
OtherBasePrimesPower[4] // Column
OtherBasePrimesPower[5] // Column


import math, sequtils, strutils

const
  MaxDepth = 6
  Max = 36^MaxDepth - 1  # Max value for MaxDepth digits in base 36.
  Digits = "0123456789abcdefghijklmnopqrstuvwxyz"

# Sieve of Erathostenes.
var composite: array[1..(Max div 2), bool]    # Only odd numbers.
for i in 1..composite.high:
  let n = 2 * i + 1
  let n2 = n * n
  if n2 > Max: break
  if not composite[i]:
    for k in countup(n2, Max, 2 * n):
      composite[k shr 1] = true

template isPrime(n: int): bool =
  if n <= 1: false
  elif (n and 1) == 0: n == 2
  else: not composite[n shr 1]

type Context = object
  indices: seq[int]
  mostBases: int
  maxStrings: seq[tuple[indices, bases: seq[int]]]

func initContext(depth: int): Context =
  result.indices.setLen(depth)
  result.mostBases = -1

proc process(ctx: var Context) =
  let minBase = max(2, max(ctx.indices) + 1)
  if 37 - minBase < ctx.mostBases: return

  var bases: seq[int]
  for b in minBase..36:
    var n = 0
    for i in ctx.indices:
      n = n * b + i
    if n.isPrime: bases.add b

  var count = bases.len
  if count > ctx.mostBases:
    ctx.mostBases = count
    ctx.maxStrings = @{ctx.indices: bases}
  elif count == ctx.mostBases:
    ctx.maxStrings.add (ctx.indices, bases)

proc nestedFor(ctx: var Context; length, level: int) =
  if level == ctx.indices.len:
    ctx.process()
  else:
    ctx.indices[level] = if level == 0: 1 else: 0
    while ctx.indices[level] < length:
      ctx.nestedFor(length, level + 1)
      inc ctx.indices[level]

for depth in 1..MaxDepth:
  var ctx = initContext(depth)
  ctx.nestedFor(Digits.len, 0)
  echo depth, " character strings which are prime in most bases: ", ctx.maxStrings[0].bases.len
  for m in ctx.maxStrings:
    echo m.indices.mapIt(Digits[it]).join(), " → ", m[1].join(" ")
  echo()


program MAXBaseStringIsPrimeInBase;
{$IFDEF FPC}
  {$MODE DELPHI}
  {$OPTIMIZATION ON,ALL}
{$ELSE}
  {$APPTYPE CONSOLE}
{$ENDIF}
uses
  sysutils;
const
  CharOfBase= '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
  MINBASE = 2;
  MAXBASE = 62;//36;//62;
  MAXDIGITCOUNT = 5;//6;
type
  tdigits    = packed record
                 dgtDgts : array [0..13] of byte;
                 dgtMaxIdx,
                 dgtMaxDgtVal :byte;
                 dgtNum  : Uint64;
               end;
  tSol       = array of Uint64;
var
  BoolPrimes: array  of boolean;

function BuildWheel(primeLimit:Int64):NativeUint;
var
  myPrimes : pBoolean;
  wheelprimes :array[0..31] of byte;
  wheelSize,wpno,
  pr,pw,i, k: NativeUint;
begin
  myPrimes := @BoolPrimes[0];
  pr := 1;
  myPrimes[1]:= true;
  WheelSize := 1;
  wpno := 0;
  repeat
    inc(pr);
    pw := pr;
    if pw > wheelsize then
      dec(pw,wheelsize);
    If myPrimes[pw] then
    begin
      k := WheelSize+1;
      for i := 1 to pr-1 do
      begin
        inc(k,WheelSize);
        if k<primeLimit then
          move(myPrimes[1],myPrimes[k-WheelSize],WheelSize)
        else
        begin
          move(myPrimes[1],myPrimes[k-WheelSize],PrimeLimit-WheelSize*i);
          break;
        end;
      end;
      dec(k);
      IF k > primeLimit then
        k := primeLimit;
      wheelPrimes[wpno] := pr;
      myPrimes[pr] := false;
      inc(wpno);
      WheelSize := k;
      i:= pr;
      i := i*i;
      while i <= k do
      begin
        myPrimes[i] := false;
        inc(i,pr);
      end;
    end;
  until WheelSize >= PrimeLimit;

  while wpno > 0 do
  begin
    dec(wpno);
    myPrimes[wheelPrimes[wpno]] := true;
  end;
  myPrimes[0] := false;
  myPrimes[1] := false;
  BuildWheel  := pr+1;
end;

procedure Sieve(PrimeLimit:Uint64);
var
  myPrimes : pBoolean;
  sieveprime,
  fakt : NativeUint;
begin
  setlength(BoolPrimes,PrimeLimit+1);

  myPrimes := @BoolPrimes[0];
  sieveprime := BuildWheel(PrimeLimit);
  repeat
    if myPrimes[sieveprime] then
    begin
      fakt := PrimeLimit DIV sieveprime;
      IF fakt < sieveprime then
        BREAK;
      repeat
        myPrimes[sieveprime*fakt] := false;
        repeat
          dec(fakt);
        until myPrimes[fakt];
      until fakt < sieveprime;
    end;
    inc(sieveprime);
  until false;
  myPrimes[1] := false;
end;

procedure CnvtoBASE(var dgt:tDigits;n:Uint64;base:NativeUint);
var
  q,r: Uint64;
  i : Int32;
Begin
  i := 0;
  with dgt do
  Begin
    fillchar(dgtDgts,SizeOf(dgtDgts),#0);
    dgtNum:= n;
    repeat
      r := n;
      q := n div base;
      r  -= q*base;
      n := q;
      dgtDgts[i] := r;
      inc(i);
    until (q = 0);
    dec(i);
    dgtMaxIdx := i;

    r := 1;
    repeat
      q := dgtDgts[i];
      if r < q then
        r := q;
      dec(i);
    until i <0 ;
    dgtMaxDgtVal := r;
  end;
end;

function CnvDgtAsInBase(const dgt:tDigits;base:NativeUint):Uint64;
var
  tmpDgt,i: NativeInt;
Begin
  result := 0;
  with dgt do
  Begin
    i:= dgtMaxIdx;
    repeat
      tmpDgt := dgtDgts[i];
      result *= base;
      dec(i);
      result +=tmpDgt;
    until (i< 0);
  end;
end;

procedure IncInBaseDigits(var dgt:tDigits;base:NativeInt);
var
  i,q,tmp :NativeInt;
Begin
  with dgt do
  Begin
    tmp := dgtMaxIdx;
    i := 0;
    repeat
      q := dgtDgts[i]+1;
      q -= (-ORD(q >=base) AND base);
      dgtDgts[i] := q;
      inc(i);
    until q <> 0;
    dec(i);
    if tmp < i then
    begin
      tmp := i;
      dgtMaxIdx := i;
    end;
    i := tmp;
    repeat
      tmp := dgtDgts[i];
      if q< tmp then
        q := tmp;
      dec(i);
    until i <0;
    inc(dgtNum);
    dgtMaxDgtVal := q;
  end;
end;

function CntPrimeInBases(var Digits :tdigits;max:Int32):Uint32;
var
  pr : Uint64;
  base: Uint32;
begin
  result := 0;
  IncInBaseDigits(Digits,MAXBASE);
  base := Digits.dgtMaxDgtVal+1;
  //divisible by every base
  IF Digits.dgtDgts[0] = 0 then
    EXIT;
  IF base < MINBASE then  base := MINBASE;
// if (MAXBASE - Base) <= (max-result)  then  BREAK;
  max := (max+Base-MAXBASE);
  if (max>=0) then
    EXIT;
  for base := base TO MAXBASE do
  begin
    pr := CnvDgtAsInBase(Digits,base);
    inc(result,Ord(boolprimes[pr]));
    //no chance to reach max then exit
    if result<max then
      break;
    inc(max);
  end;
end;

function GetMaxBaseCnt(var dgt:tDigits;MinLmt,MaxLmt:Uint32):tSol;
var
  i : Uint32;
  baseCnt,max,Idx: Int32;
Begin
  setlength(result,0);
  max :=-1;
  Idx:= 0;
  For i := MinLmt to MaxLmt do
  Begin
    baseCnt := CntPrimeInBases(dgt,max);
    if baseCnt = 0 then
      continue;
    if max<=baseCnt then
    begin
      if max = baseCnt then
      begin
        inc(Idx);
        if Idx > High(result) then
          setlength(result,Idx);
        result[idx-1] := i;
      end
      else
      begin
        Idx:= 1;
        setlength(result,1);
        result[0] := i;
        max := baseCnt;
      end;
    end;
  end;
end;

function Out_String(n:Uint64;var s: AnsiString):Uint32;
//out-sourced for debugging purpose
var
  dgt:tDigits;
  sl : string[15];
  base,i: Int32;
Begin
  result := 0;
  CnvtoBASE(dgt,n,MaxBase);
  sl := '';
  with dgt do
  begin
    base:= dgtMaxDgtVal+1;
    IF base < MINBASE then
      base := MINBASE;
    i := dgtMaxIdx;
    while (i>=0)do
    Begin
      sl += CharOfBase[dgtDgts[i]+1];
      dec(i);
    end;
    s := sl+' -> [';
  end;
  For base := base to MAXBASE do
    if boolprimes[CnvDgtAsInBase(dgt,base)] then
    begin
      inc(result);
      str(base,sl);
      s := s+sl+',';
    end;
  s[length(s)] := ']';
end;

procedure Out_Sol(sol:tSol);
var
  s : AnsiString;
  i,cnt : Int32;
begin
  if length(Sol) = 0 then
    EXIT;
  for i := 0 to High(Sol) do
  begin
    cnt := Out_String(sol[i],s);
    if i = 0 then
      writeln(cnt);
    writeln(s);
  end;
  writeln;
  setlength(Sol,0);
end;

var
  dgt:tDigits;
  T0 : Int64;
  i : NativeInt;
  lmt,minLmt : UInt64;
begin
  T0 := GetTickCount64;
  lmt := 0;
  //maxvalue in Maxbase
  for i := 1 to MAXDIGITCOUNT do
    lmt :=lmt*MAXBASE+MAXBASE-1;
  writeln('max prime limit ',lmt);
  Sieve(lmt);
  writeln('Prime sieving ',(GetTickCount64-T0)/1000:6:3,' s');

  T0 := GetTickCount64;
  CnvtoBASE(dgt,0,MAXBASE);
  i := 1;
  minLmt := 1;
  repeat
    write(i:2,' character strings which are prime in count bases = ');
    Out_Sol(GetMaxBaseCnt(dgt,minLmt,MAXBASE*minLmt-1));
    minLmt *= MAXBASE;
    inc(i);
  until i>MAXDIGITCOUNT;
  writeln('   Converting ',(GetTickCount64-T0)/1000:6:3,' s');
  {$IFDEF WINDOWS} readln; {$ENDIF}
end.


use strict;
use warnings;
use feature 'say';
use List::AllUtils <firstidx max>;
use ntheory qw/fromdigits todigitstring primes/;

my(%prime_base, %max_bases, $l);

my $chars  = 5;
my $upto   = fromdigits( '1' . 'Z' x $chars, 36);
my @primes = @{primes( $upto )};

for my $base (2..36) {
    my $n = todigitstring($base-1, $base) x $chars;
    my $threshold = fromdigits($n, $base);
    my $i = firstidx { $_ > $threshold } @primes;
    map { push @{$prime_base{ todigitstring($primes[$_],$base) }}, $base } 0..$i-1;
}

$l = length and $max_bases{$l} = max( $#{$prime_base{$_}}, $max_bases{$l} // 0 ) for keys %prime_base;

for my $m (1 .. $chars) {
    say "$m character strings that are prime in maximum bases: ", 1+$max_bases{$m};
    for (sort grep { length($_) ==  $m } keys %prime_base) {
        my @bases = @{($prime_base{$_})[0]};
        say "$_: " . join ' ', @bases if $max_bases{$m} eq $#bases;
    }
    say ''
}


with javascript_semantics
constant maxbase=36 -- or 62

function evalpoly(integer x, sequence p)
    integer result = 0
    for y=1 to length(p) do
        result = result*x + p[y]
    end for
    return result
end function

function stringify(sequence digits)
    string res = repeat('0',length(digits))
    for i=1 to length(digits) do
        integer di = digits[i]
        res[i] = di + iff(di<=9?'0':iff(di<36?'A'-10:'a'-36))
    end for
    return res
end function

procedure max_prime_bases(integer ndig, maxbase)
    atom t0 = time(),
         t1 = time()+1
    sequence maxprimebases = {},
             digits = repeat(0,ndig)
    integer maxlen = 0,
            limit = power(10,ndig),
            maxdigit = maxbase
    if ndig>1 then digits[1] = 1 end if
    while true do
        for i=length(digits) to 1 by -1 do
            integer di = digits[i]+1
            if di<maxdigit then -- (or 9, see below)
                digits[i] = di
                exit
            else
                di = 0
                digits[i] = 0
            end if
        end for
        integer minbase = max(digits)+1,
                maxposs = maxbase-minbase+1
        if minbase=1 then exit end if   -- (ie we just wrapped round to all 0s)
        sequence bases = {}
        for base=minbase to maxbase do
            if is_prime(evalpoly(base,digits)) then
                bases &= base
            else
                maxposs -= 1
                if maxposs<maxlen then exit end if -- (a 5-fold speedup)
            end if
        end for
        integer l = length(bases)
        if l>maxlen then
            maxlen = l
            maxdigit = maxbase-maxlen       -- (around 20-fold speedup)
            maxprimebases = {}
        end if
        if l=maxlen then
            maxprimebases &= {{stringify(digits), bases}}
        end if
        if platform()!=JS and time()>t1 then
            progress("%V\r",{digits})
            t1 = time()+1
        end if
    end while
    string e = elapsed(time()-t0)
    printf(1,"%d character numeric strings that are prime in %d bases (%s):\n",{ndig,maxlen,e})
    for i=1 to length(maxprimebases) do
        printf(1," %s => %V\n", maxprimebases[i])
    end for
    printf(1,"\n")
end procedure

for n=1 to iff(platform()=JS or maxbase>36?4:6) do
    max_prime_bases(n, maxbase)
end for


use Math::Primesieve;
my $sieve = Math::Primesieve.new;

my %prime-base;

my $chars = 4; # for demonstration purposes. Change to 5 for the whole shmegegge.

my $threshold = ('1' ~ 'Z' x $chars).parse-base(36);

my @primes = $sieve.primes($threshold);

%prime-base.push: $_ for (2..36).map: -> $base {
    $threshold = (($base - 1).base($base) x $chars).parse-base($base);
    @primes[^(@primes.first: * > $threshold, :k)].race.map: { .base($base) => $base }
}

%prime-base.=grep: +*.value.elems > 10;

for 1 .. $chars -> $m {
    say "$m character strings that are prime in maximum bases: " ~ (my $e = ((%prime-base.grep( *.key.chars == $m )).max: +*.value.elems).value.elems);
    .say for %prime-base.grep( +*.value.elems == $e ).grep(*.key.chars == $m).sort: *.key;
    say '';
}


/*REXX pgm finds primes whose values in other bases (2──►36) have the most diff. bases. */
parse arg widths .                               /*obtain optional argument from the CL.*/
if widths=='' | widths==","  then widths= 5      /*Not specified?  Then use the default.*/
call genP                                        /*build array of semaphores for primes.*/
names= 'one two three four five six seven eight' /*names for some low decimal numbers.  */
$.=
    do j=1  for #                                /*only use primes that are within range*/
       do b=36  by -1  for 35;  n= base(@.j, b)  /*use different bases for each prime.  */
       L= length(n);  if L>widths  then iterate  /*obtain length; Length too big?  Skip.*/
       if L==1  then $.L.n= b  $.L.n             /*Length  =  unity?   Prepend the base.*/
                else $.L.n= $.L.n  b             /*   "   ¬=    "       Append  "    "  */
       end   /*b*/
    end      /*j*/
                                                 /*display info for each of the widths. */
      do w=1  for widths;             cnt= 0     /*show for each width: cnt,number,bases*/
               bot= left(1, w, 0);    top= left(9, w, 9)      /*calculate range for DO. */
          do n=bot  to top;     y= words($.w.n)  /*find the sets of numbers for a width.*/
          if y>cnt  then do;  mxn=n;  cnt= max(cnt, y);  end  /*found a max? Remember it*/
          end   /*n*/
      say
      say;  say center(' 'word(names, w)"─character numbers that are"      ,
                       'prime in the most bases: ('cnt      "bases) ",  101, '─')
          do n=bot  to top;     y= words($.w.n)             /*search again for maximums.*/
          if y==cnt  then say n  '──►'  strip($.w.n)        /*display  ───a─── maximum. */
          end   /*n*/
      end       /*w*/
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
base: procedure; parse arg x,r,,z;               @= '0123456789abcdefghijklmnopqrsruvwxyz'
                    do j=1;  _= r**j;  if _>x  then leave
                    end   /*j*/
         do k=j-1  to 1  by -1;   _= r**k;  z= z || substr(@, (x % _) + 1, 1);   x= x // _
         end   /*k*/;                   return z || substr(@, x+1, 1)
/*──────────────────────────────────────────────────────────────────────────────────────*/
genP: @.1=2;  @.2=3;  @.3=5;  @.4=7;  @.5=11     /*define some low primes.              */
                       #= 5;  sq.#= @.# ** 2     /*number primes so far;  prime squared.*/
        do [email protected].#+2  by 2  to 2 * 36 * 10**widths /*find odd primes from here on.        */
        parse var  j   ''  -1  _;  if _==5  then iterate     /*J is ÷ by 5? (right dig).*/
        if j//3==0  then iterate;  if j//7==0  then iterate  /*"  " " "  3?;  ÷ by  7?  */
               do k=5  while sq.k<=j             /* [↓]  divide by the known odd primes.*/
               if j//@.k==0  then iterate j      /*Is  J ÷ X?  Then not prime.     ___  */
               end   /*k*/                       /* [↑]  only process numbers  ≤  √ J   */
        #= # + 1;            @.#= j;  sq.#= j*j  /*bump # Ps; assign next P;  P squared.*/
        end          /*j*/;           return


// [dependencies]
// primal = "0.3"

fn digits(mut n: u32, dig: &mut [u32]) {
    for i in 0..dig.len() {
        dig[i] = n % 10;
        n /= 10;
    }
}

fn evalpoly(x: u64, p: &[u32]) -> u64 {
    let mut result = 0;
    for y in p.iter().rev() {
        result *= x;
        result += *y as u64;
    }
    result
}

fn max_prime_bases(ndig: u32, maxbase: u32) {
    let mut maxlen = 0;
    let mut maxprimebases = Vec::new();
    let limit = 10u32.pow(ndig);
    let mut dig = vec![0; ndig as usize];
    for n in limit / 10..limit {
        digits(n, &mut dig);
        let bases: Vec<u32> = (2..=maxbase)
            .filter(|&x| dig.iter().all(|&y| y < x) && primal::is_prime(evalpoly(x as u64, &dig)))
            .collect();
        if bases.len() > maxlen {
            maxlen = bases.len();
            maxprimebases.clear();
        }
        if bases.len() == maxlen {
            maxprimebases.push((n, bases));
        }
    }
    println!(
        "{} character numeric strings that are prime in maximum bases: {}",
        ndig, maxlen
    );
    for (n, bases) in maxprimebases {
        println!("{} => {:?}", n, bases);
    }
    println!();
}

fn main() {
    for n in 1..=6 {
        max_prime_bases(n, 36);
    }
}


func max_prime_bases(ndig, maxbase=36) {

    var maxprimebases = [[]]
    var nwithbases = [0]
    var maxprime = (10**ndig - 1)

    for p in (idiv(maxprime + 1, 10) .. maxprime) {
        var dig = p.digits
        var bases = (2..maxbase -> grep {|b| dig.all { _ < b } && dig.digits2num(b).is_prime })
        if (bases.len > maxprimebases.first.len) {
            maxprimebases = [bases]
            nwithbases = [p]
        }
        elsif (bases.len == maxprimebases.first.len) {
            maxprimebases << bases
            nwithbases << p
        }
    }

    var (alen, vlen) = (maxprimebases.first.len, maxprimebases.len)

    say("\nThe maximum number of prime valued bases for base 10 numeric strings of length ",
        ndig, " is #{alen}. The base 10 value list of ", vlen > 1 ? "these" : "this", " is:")
    maxprimebases.each_kv {|k,v| say(nwithbases[k], " => ", v) }
}

for n in (1..5) {
    max_prime_bases(n)
}


import "/math" for Int, Nums

var maxDepth = 5
var maxBase = 36
var c = Int.primeSieve(maxBase.pow(maxDepth), false)
var digits = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
var maxStrings = []
var mostBases = -1

var process = Fn.new { |indices|
    var minBase = 2.max(Nums.max(indices) + 1)
    if (maxBase - minBase + 1 < mostBases) return  // can't affect results so return
    var bases = []
    for (b in minBase..maxBase) {
        var n = 0
        for (i in indices) n = n * b + i
        if (!c[n]) bases.add(b)
    }
    var count = bases.count
    if (count > mostBases) {
        mostBases = count
        maxStrings = [[indices.toList, bases]]
    } else if (count == mostBases) {
        maxStrings.add([indices.toList, bases])
    }
}

var printResults = Fn.new {
    System.print("%(maxStrings[0][1].count)")
    for (m in maxStrings) {
        var s = m[0].reduce("") { |acc, i| acc + digits[i] }
        System.print("%(s) -> %(m[1])")
    }
}

var nestedFor // recursive
nestedFor = Fn.new { |indices, length, level|
    if (level == indices.count) {
        process.call(indices)
    } else {
        indices[level] = (level == 0) ? 1 : 0
        while (indices[level] < length) {
             nestedFor.call(indices, length, level + 1)
             indices[level] = indices[level] + 1
        }
    }
}

for (depth in 1..maxDepth) {
    System.write("%(depth) character strings which are prime in most bases: ")
    maxStrings = []
    mostBases = -1
    var indices = List.filled(depth, 0)
    nestedFor.call(indices, maxBase, 0)
    printResults.call()
    System.print()
}


package  {

    import flash.display.Sprite;
    import flash.events.Event;
    import flash.text.TextField;
    import flash.text.TextFieldAutoSize;
    import flash.text.TextFormat;

    public class MousePosition extends Sprite {

        private var _textField:TextField = new TextField();

        public function MousePosition() {
            if ( stage ) init();
            else addEventListener(Event.ADDED_TO_STAGE, init);
        }

        private function init(e:Event = null):void {
            removeEventListener(Event.ADDED_TO_STAGE, init);

            _textField.autoSize = TextFieldAutoSize.RIGHT;
            _textField.x = stage.stageWidth - 10;
            _textField.defaultTextFormat = new TextFormat(null, 15);
            _textField.text = "Mouse position: X = 0, Y = 0";
            _textField.y = stage.stageHeight - _textField.textHeight - 14;
            addChild(_textField);

            addEventListener(Event.ENTER_FRAME, _onEnterFrame);
        }

        private function _onEnterFrame(e:Event):void {
            _textField.text = "Mouse position: X = " + stage.mouseX + ", Y = " + stage.mouseY;
        }

    }

}


with GLib;        use GLib;
with Gtk.Button;  use Gtk.Button;
with Gtk.Label;   use Gtk.Label;
with Gtk.Window;  use Gtk.Window;
with Gtk.Widget;  use Gtk.Widget;
with Gtk.Table;   use Gtk.Table;

with Gtk.Handlers;
with Gtk.Main;

procedure Tell_Mouse is
   Window : Gtk_Window;
   Grid   : Gtk_Table;
   Button : Gtk_Button;
   Label  : Gtk_Label;

   package Handlers is new Gtk.Handlers.Callback (Gtk_Widget_Record);
   package Return_Handlers is
      new Gtk.Handlers.Return_Callback (Gtk_Widget_Record, Boolean);

   function Delete_Event (Widget : access Gtk_Widget_Record'Class)
      return Boolean is
   begin
      return False;
   end Delete_Event;

   procedure Destroy (Widget : access Gtk_Widget_Record'Class) is
   begin
      Gtk.Main.Main_Quit;
   end Destroy;

   procedure Clicked (Widget : access Gtk_Widget_Record'Class) is
      X, Y : GInt;
   begin
      Get_Pointer (Window, X, Y);
      Set_Text (Label, "At" & GInt'Image (X) & GInt'Image (Y));
   end Clicked;

begin
   Gtk.Main.Init;
   Gtk.Window.Gtk_New (Window);
   Gtk_New (Grid, 1, 2, False);
   Add (Window, Grid);
   Gtk_New (Label);
   Attach (Grid, Label, 0, 1, 0, 1);
   Gtk_New (Button, "Click me");
   Attach (Grid, Button, 0, 1, 1, 2);
   Return_Handlers.Connect
   (  Window,
      "delete_event",
      Return_Handlers.To_Marshaller (Delete_Event'Access)
   );
   Handlers.Connect
   (  Window,
      "destroy",
      Handlers.To_Marshaller (Destroy'Access)
   );
   Handlers.Connect
   (  Button,
      "clicked",
      Handlers.To_Marshaller (Clicked'Access)
   );
   Show_All (Grid);
   Show (Window);

   Gtk.Main.Main;
end Tell_Mouse;


MOUSE ON

WHILE 1
  m=MOUSE(0)
  PRINT MOUSE(1),MOUSE(2)
WEND


use framework "AppKit"

tell application id "com.apple.SystemEvents" to tell ¬
	(the first process where it is frontmost) to ¬
	set {x, y} to the front window's position

tell the current application
	set H to NSHeight(its NSScreen's mainScreen's frame)
	tell [] & its NSEvent's mouseLocation
		set item 1 to (item 1) - x
		set item 2 to H - (item 2) - y
		set coords to it as point
	end tell
end tell

log coords


#i:: ; (Optional) Assigns a hotkey to display window info, Windows+i
MouseGetPos, x, y ; Gets x/y pos relative to active window
WinGetActiveTitle, WinTitle ; Gets active window title
Traytip, Mouse position, x: %x%`ny: %y%`rWindow: %WinTitle%, 4 ; Displays the info as a Traytip for 4 seconds
return


      MOUSE xmouse%, ymouse%, buttons%
      PRINT xmouse%, ymouse%