// some useful functions
(
~grid = { 0 ! 60 } ! 60;

~at = { |coord|
	var col = ~grid.at(coord[0]);
	if(col.notNil) { col.at(coord[1]) }
};
~put = { |coord, value|
	var col = ~grid.at(coord[0]);
	if(col.notNil) { col.put(coord[1], value) }
};

~coord = ~grid.shape.rand;
~next = { |p|
	var possible = [p] + [[0, 1], [1, 0], [-1, 0], [0, -1]];
	possible = possible.select { |x|
		var c = ~at.(x);
		c.notNil and: { c == 0 }
	};
	possible.choose
};
~walkN = { |p, scale|
	var next = ~next.(p);
	if(next.notNil) {
		~put.(next, 1);
		Pen.lineTo(~topoint.(next, scale));
		~walkN.(next, scale);
		~walkN.(next, scale);
		Pen.moveTo(~topoint.(p, scale));
	};
};

~topoint = { |c, scale| (c + [1, 1] * scale).asPoint };

)

// do the drawing
(
var b, w;

b = Rect(100, 100, 700, 700);
w = Window("so-a-mazing", b);
w.view.background_(Color.black);

w.drawFunc = {
	var p = ~grid.shape.rand;
	var scale = b.width / ~grid.size * 0.98;
	Pen.moveTo(~topoint.(p, scale));
	~walkN.(p, scale);
	Pen.width = scale / 4;
	Pen.color = Color.white;
	Pen.stroke;
};
w.front.refresh;
)


import Foundation

extension Array {
    mutating func shuffle() {
        guard count > 1 else { return }

        for i in 0..<self.count - 1 {
            let j = Int(arc4random_uniform(UInt32(count - i))) + i
            guard i != j else { continue }
            swap(&self[i], &self[j])
        }
    }
}

enum Direction:Int {
    case north = 1
    case south = 2
    case east = 4
    case west = 8

    static var allDirections:[Direction] {
        return [Direction.north, Direction.south, Direction.east, Direction.west]
    }

    var opposite:Direction {
        switch self {
        case .north:
            return .south
        case .south:
            return .north
        case .east:
            return .west
        case .west:
            return .east
        }
    }

    var diff:(Int, Int) {
        switch self {
        case .north:
            return (0, -1)
        case .south:
            return (0, 1)
        case .east:
            return (1, 0)
        case .west:
            return (-1, 0)
        }
    }

    var char:String {
        switch self {
        case .north:
            return "N"
        case .south:
            return "S"
        case .east:
            return "E"
        case .west:
            return "W"
        }
    }

}

class MazeGenerator {
    let x:Int
    let y:Int
    var maze:[[Int]]

    init(_ x:Int, _ y:Int) {
        self.x  = x
        self.y = y
        let column = [Int](repeating: 0, count: y)
        self.maze = [[Int]](repeating: column, count: x)
        generateMaze(0, 0)
    }

    private func generateMaze(_ cx:Int, _ cy:Int) {
        var directions = Direction.allDirections
        directions.shuffle()
        for direction in directions {
            let (dx, dy) = direction.diff
            let nx = cx + dx
            let ny = cy + dy
            if inBounds(nx, ny) && maze[nx][ny] == 0 {
                maze[cx][cy] |= direction.rawValue
                maze[nx][ny] |= direction.opposite.rawValue
                generateMaze(nx, ny)
            }
        }
    }

    private func inBounds(_ testX:Int, _ testY:Int) -> Bool {
        return inBounds(value:testX, upper:self.x) && inBounds(value:testY, upper:self.y)
    }

    private func inBounds(value:Int, upper:Int) -> Bool {
        return (value >= 0) && (value < upper)
    }

    func display() {
        let cellWidth = 3
        for j in 0..<y {
            // Draw top edge
            var topEdge = ""
            for i in 0..<x {
                topEdge += "+"
                topEdge += String(repeating: (maze[i][j] & Direction.north.rawValue) == 0 ? "-" : " ", count: cellWidth)
            }
            topEdge += "+"
            print(topEdge)

            // Draw left edge
            var leftEdge = ""
            for i in 0..<x {
                leftEdge += (maze[i][j] & Direction.west.rawValue) == 0 ? "|" : " "
                leftEdge += String(repeating: " ", count: cellWidth)
            }
            leftEdge += "|"
            print(leftEdge)
        }

        // Draw bottom edge
        var bottomEdge = ""
        for _ in 0..<x {
            bottomEdge += "+"
            bottomEdge += String(repeating: "-", count: cellWidth)
        }
        bottomEdge += "+"
        print(bottomEdge)
    }

    func displayInts() {
        for j in 0..<y {
            var line = ""
            for i in 0..<x {
                line += String(maze[i][j]) + "\t"
            }
            print(line)
        }
    }

    func displayDirections() {
        for j in 0..<y {
            var line = ""
            for i in 0..<x {
                line += getDirectionsAsString(maze[i][j]) + "\t"
            }
            print(line)
        }
    }

    private func getDirectionsAsString(_ value:Int) -> String {
        var line = ""
        for direction in Direction.allDirections {
            if (value & direction.rawValue) != 0 {
                line += direction.char
            }
        }
        return line
    }
}

let x = 20
let y = 10
let maze = MazeGenerator(x, y)
maze.display()


import Data.List

 mmult :: Num a => [[a]] -> [[a]] -> [[a]]
 mmult a b = [ [ sum $ zipWith (*) ar bc | bc <- (transpose b) ] | ar <- a ]

 -- Example use:
 test = [[1, 2],
         [3, 4]] `mmult` [[-3, -8, 3],
                          [-2,  1, 4]]


REAL :: m=4, n=2, p=3, a(m,n), b(n,p), res(m,p)

a = $ ! initialize to 1, 2, ..., m*n
b = $ ! initialize to 1, 2, ..., n*p

res = 0
DO i = 1, m
  DO j = 1, p
    DO k = 1, n
      res(i,j) = res(i,j) + a(i,k) * b(k,j)
    ENDDO
  ENDDO
ENDDO

DLG(DefWidth=4, Text=a, Text=b,Y=0, Text=res,Y=0)


package require TclOO; # Or Tcl 8.6

# Helper to pick a random number
proc rand n {expr {int(rand() * $n)}}
# Helper to pick a random element of a list
proc pick list {lindex $list [rand [llength $list]]}
# Helper _function_ to index into a list of lists
proc tcl::mathfunc::idx {v x y} {lindex $v $x $y}

oo::class create maze {
    variable x y horiz verti content
    constructor {width height} {
	set y $width
	set x $height

	set n [expr {$x * $y - 1}]
	if {$n < 0} {error "illegal maze dimensions"}
	set horiz [set verti [lrepeat $x [lrepeat $y 0]]]
	# This matrix holds the output for the Maze Solving task; not used for generation
	set content [lrepeat $x [lrepeat $y " "]]
	set unvisited [lrepeat [expr {$x+2}] [lrepeat [expr {$y+2}] 0]]
	# Helper to write into a list of lists (with offsets)
	proc unvisited= {x y value} {
	    upvar 1 unvisited u
	    lset u [expr {$x+1}] [expr {$y+1}] $value
	}

	lappend stack [set here [list [rand $x] [rand $y]]]
	for {set j 0} {$j < $x} {incr j} {
	    for {set k 0} {$k < $y} {incr k} {
		unvisited= $j $k [expr {$here ne [list $j $k]}]
	    }
	}

	while {0 < $n} {
	    lassign $here hx hy
	    set neighbours {}
	    foreach {dx dy} {1 0  0 1  -1 0	 0 -1} {
		if {idx($unvisited, $hx+$dx+1, $hy+$dy+1)} {
		    lappend neighbours [list [expr {$hx+$dx}] [expr {$hy+$dy}]]
		}
	    }
	    if {[llength $neighbours]} {
		lassign [set here [pick $neighbours]] nx ny
		unvisited= $nx $ny 0
		if {$nx == $hx} {
		    lset horiz $nx [expr {min($ny, $hy)}] 1
		} else {
		    lset verti [expr {min($nx, $hx)}] $ny 1
		}
		lappend stack $here
		incr n -1
	    } else {
		set here [lindex $stack end]
		set stack [lrange $stack 0 end-1]
	    }
	}

	rename unvisited= {}
    }

    # Maze displayer; takes a maze dictionary, returns a string
    method view {} {
	set text {}
	for {set j 0} {$j < $x*2+1} {incr j} {
	    set line {}
	    for {set k 0} {$k < $y*4+1} {incr k} {
		if {$j%2 && $k%4==2} {
		    # At the centre of the cell, put the "content" of the cell
		    append line [expr {idx($content, $j/2, $k/4)}]
		} elseif {$j%2 && ($k%4 || $k && idx($horiz, $j/2, $k/4-1))} {
		    append line " "
		} elseif {$j%2} {
		    append line "|"
		} elseif {0 == $k%4} {
		    append line "+"
		} elseif {$j && idx($verti, $j/2-1, $k/4)} {
		    append line " "
		} else {
		    append line "-"
		}
	    }
	    if {!$j} {
		lappend text [string replace $line 1 3 "   "]
	    } elseif {$x*2-1 == $j} {
		lappend text [string replace $line end end " "]
	    } else {
		lappend text $line
	    }
	}
	return [join $text \n]
    }
}

# Demonstration
maze create m 11 8
puts [m view]


link matrix

procedure main ()
  m1 := [[1,2,3], [4,5,6]]
  m2 := [[1,2],[3,4],[5,6]]
  m3 := mult_matrix (m1, m2)
  write ("Multiply:")
  write_matrix ("", m1) # first argument is filename, or "" for stdout
  write ("by:")
  write_matrix ("", m2)
  write ("Result: ")
  write_matrix ("", m3)
end


@(bind (width height) (15 15))
@(do
   (defvar *r* (make-random-state nil))
   (defvar vi)
   (defvar pa)

   (defun neigh (loc)
     (let ((x (from loc))
           (y (to loc)))
       (list (- x 1)..y (+ x 1)..y
             x..(- y 1) x..(+ y 1))))

   (defun make-maze-rec (cu)
     (set [vi cu] t)
     (each ((ne (shuffle (neigh cu))))
       (cond ((not [vi ne])
              (push ne [pa cu])
              (push cu [pa ne])
              (make-maze-rec ne)))))

   (defun make-maze (w h)
     (let ((vi (hash :equal-based))
           (pa (hash :equal-based)))
       (each ((x (range -1 w)))
         (set [vi x..-1] t)
         (set [vi x..h] t))
       (each ((y (range* 0 h)))
         (set [vi -1..y] t)
         (set [vi w..y] t))
       (make-maze-rec 0..0)
       pa))

   (defun print-tops (pa w j)
     (each ((i (range* 0 w)))
       (if (memqual i..(- j 1) [pa i..j])
         (put-string "+    ")
         (put-string "+----")))
     (put-line "+"))

   (defun print-sides (pa w j)
     (let ((str ""))
       (each ((i (range* 0 w)))
         (if (memqual (- i 1)..j [pa i..j])
           (set str `@str     `)
           (set str `@str|    `)))
       (put-line `@str|\[email protected]|`)))

   (defun print-maze (pa w h)
     (each ((j (range* 0 h)))
       (print-tops pa w j)
       (print-sides pa w j))
     (print-tops pa w h)))
@;;
@(bind m @(make-maze width height))
@(do (print-maze m width height))


code Ran=1, CrLf=9, Text=12;            \intrinsic routines
def  Cols=20, Rows=6;                   \dimensions of maze (cells)
int  Cell(Cols+1, Rows+1, 3);           \cells (plus right and bottom borders)
def  LeftWall, Ceiling, Connected;      \attributes of each cell (= 0, 1 and 2)

proc ConnectFrom(X, Y);         \Connect cells starting from cell X,Y
int  X, Y;
int  Dir, Dir0;
[Cell(X, Y, Connected):= true;  \mark current cell as connected
Dir:= Ran(4);                   \randomly choose a direction
Dir0:= Dir;                     \save this initial direction
repeat  case Dir of             \try to connect to cell at Dir
          0: if X+1<Cols & not Cell(X+1, Y, Connected) then     \go right
                [Cell(X+1, Y, LeftWall):= false; ConnectFrom(X+1, Y)];
          1: if Y+1<Rows & not Cell(X, Y+1, Connected) then     \go down
                [Cell(X, Y+1, Ceiling):= false;  ConnectFrom(X, Y+1)];
          2: if X-1>=0 & not Cell(X-1, Y, Connected) then       \go left
                [Cell(X, Y, LeftWall):= false;   ConnectFrom(X-1, Y)];
          3: if Y-1>=0 & not Cell(X, Y-1, Connected) then       \go up
                [Cell(X, Y, Ceiling):= false;    ConnectFrom(X, Y-1)]
        other   [];             \(never occurs)
        Dir:= Dir+1 & $03;      \next direction
until   Dir = Dir0;
];

int  X, Y;
[for Y:= 0 to Rows do
    for X:= 0 to Cols do
        [Cell(X, Y, LeftWall):= true;           \start with all walls and
         Cell(X, Y, Ceiling):= true;            \ ceilings in place
         Cell(X, Y, Connected):= false;         \ and all cells disconnected
        ];
Cell(0, 0, LeftWall):= false;                   \make left and right doorways
Cell(Cols, Rows-1, LeftWall):= false;
ConnectFrom(Ran(Cols), Ran(Rows));              \randomly pick a starting cell
for Y:= 0 to Rows do                            \display the maze
        [CrLf(0);
        for X:= 0 to Cols do
                Text(0, if X#Cols & Cell(X, Y, Ceiling)  then "+--" else "+  ");
        CrLf(0);
        for X:= 0 to Cols do
                Text(0, if Y#Rows & Cell(X, Y, LeftWall) then "|  " else "   ");
        ];
]


import Data.Vect

Matrix : Nat -> Nat -> Type -> Type
Matrix m n t = Vect m (Vect n t)

multiply : Num t => Matrix m1 n t -> Matrix n m2 t -> Matrix m1 m2 t
multiply a b = multiply' a (transpose b)
  where
        dot : Num t => Vect n t -> Vect n t -> t
        dot v1 v2 = sum $ map (\(s1, s2) => (s1 * s2)) (zip v1 v2)

        multiply' : Num t => Matrix m1 n t -> Matrix m2 n t -> Matrix m1 m2 t
        multiply' (a::as) b = map (dot a) b :: multiply' as b
        multiply' [] _ = []


with Ada.Text_IO;  use Ada.Text_IO;

procedure Man_Or_Boy is
   function Zero return Integer is begin return  0; end Zero;
   function One return Integer  is begin return  1; end One;
   function Neg return Integer  is begin return -1; end Neg;

   function A
            (  K : Integer;
               X1, X2, X3, X4, X5 : access function return Integer
            )  return Integer is
      M : Integer := K; -- K is read-only in Ada. Here is a mutable copy of
      function B return Integer is
      begin
         M := M - 1;
         return A (M, B'Access, X1, X2, X3, X4);
      end B;
   begin
      if M <= 0 then
         return X4.all + X5.all;
      else
         return B;
      end if;
   end A;
begin
   Put_Line
   (  Integer'Image
       (  A
          (  10,
             One'Access, -- Returns  1
             Neg'Access, -- Returns -1
             Neg'Access, -- Returns -1
             One'Access, -- Returns  1
             Zero'Access -- Returns  0
   )  )  );
end Man_Or_Boy;


import "random" for Random
import "os" for Process

var Rand = Random.new()

class Direction {
    static n { __n }
    static s { __s }
    static e { __e }
    static w { __w }

    static init() {
        __n = new_(1,  0, -1)
        __s = new_(2,  0,  1)
        __e = new_(4,  1,  0)
        __w = new_(8, -1,  0)

        __n.opposite = __s
        __s.opposite = __n
        __e.opposite = __w
        __w.opposite = __e
    }

    construct new_(bit, dx, dy) {
        _bit = bit
        _dx = dx
        _dy = dy
        _opposite = null
    }

    bit { _bit }
    dx  { _dx  }
    dy  { _dy  }

    opposite     { _opposite }
    opposite=(d) { _opposite = d }
}

Direction.init()

class MazeGenerator {
    construct new(x, y) {
        _x = x
        _y = y
        _maze = List.filled(x, null)
        for (i in 0...x) _maze[i] = List.filled(y, 0)
    }

    between_(v, upper) { v >= 0 && v < upper }

    generate(cx, cy) {
        var values = [Direction.n, Direction.s, Direction.e, Direction.w]
        Rand.shuffle(values)
        values.each { |v|
            var nx = cx + v.dx
            var ny = cy + v.dy
            if (between_(nx, _x) && between_(ny, _y) && _maze[nx][ny] == 0) {
                _maze[cx][cy] = _maze[cx][cy] | v.bit
                _maze[nx][ny] = _maze[nx][ny] | v.opposite.bit
                generate(nx, ny)
            }
        }
    }

    display() {
        for (i in 0..._y) {
            // draw the north edge
            for (j in 0..._x) System.write((_maze[j][i] & 1) == 0 ? "+---" : "+   ")
            System.print("+")

            // draw the west edge
            for (j in 0..._x) System.write((_maze[j][i] & 8) == 0 ? "|   " : "    ")
            System.print("|")
        }

        // draw the bottom line
        for (j in 0..._x) System.write("+---")
        System.print("+")
    }
}

var args = Process.arguments
var x = (args.count >= 1) ? Num.fromString(args[0]) : 8
var y = (args.count == 2) ? Num.fromString(args[1]) : 8
var mg = MazeGenerator.new(x, y)
mg.generate(0, 0)
mg.display()


public static double[][] mult(double a[][], double b[][]){//a[m][n], b[n][p]
   if(a.length == 0) return new double[0][0];
   if(a[0].length != b.length) return null; //invalid dims

   int n = a[0].length;
   int m = a.length;
   int p = b[0].length;

   double ans[][] = new double[m][p];

   for(int i = 0;i < m;i++){
      for(int j = 0;j < p;j++){
         for(int k = 0;k < n;k++){
            ans[i][j] += a[i][k] * b[k][j];
         }
      }
   }
   return ans;
}


integer
F(list l)
{
    l[1];
}

integer
eval(list l)
{
    l[0](l);
}

integer A(list);

integer
B(list l)
{
    A(list(B, l[1] = l[1] - 1, l, l[-5], l[-4], l[-3], l[-2]));
}

integer
A(list l)
{
    integer x;

    if (l[1] < 1) {
        x = eval(l[-2]) + eval(l[-1]);
    } else {
        x = B(l);
    }

    x;
}

integer
main(void)
{
    list f1, f0, fn1;

    l_append(f1, F);
    l_append(f1, 1);

    l_append(f0, F);
    l_append(f0, 0);

    l_append(fn1, F);
    l_append(fn1, -1);

    o_(A(list(B, 10, f1, fn1, fn1, f1, f0)), "\n");

    0;
}


begin
  real procedure A (k, x1, x2, x3, x4, x5);
  value k; integer k;
  real x1, x2, x3, x4, x5;
  begin
    real procedure B;
    begin k:= k - 1;
          B:= A := A (k, B, x1, x2, x3, x4)
    end;
    if k <= 0 then A:= x4 + x5 else B
  end;
  outreal (A (10, 1, -1, -1, 1, 0))
end


fcn make_maze(w = 16, h = 8){
   // make arrays with lists of lists (all mutable)
   vis:=(w.pump(List().write,0)+1)*h + w.pump(List().write,1);
   ver:=(w.pump(List().write,T(Void,"|   ")) + "|")*h + T;
   hor:=(w.pump(List().write,T(Void,"+---")) + "+")*(h + 1);

   fcn(x,y,vis,ver,hor){
      vis[y][x] = 1;

      d:=L(T(x - 1, y), T(x, y + 1), T(x + 1, y), T(x, y - 1)).shuffle();
      foreach xx,yy in (d){
	 if(vis[yy][xx]) continue;
	 if(xx==x) hor[y.max(yy)][x]="+   ";
	 if(yy==y) ver[y][x.max(xx)]="    ";
	 self.fcn(xx,yy,vis,ver,hor);
      }
   }((0).random(w),(0).random(h),vis,ver,hor);
   foreach a,b in (hor.zip(ver)) { println(a.concat(),"\n",b.concat()) }
   return(ver,hor);
}
make_maze();


// returns a new matrix
Matrix.prototype.mult = function(other) {
    if (this.width != other.height) {
        throw "error: incompatible sizes";
    }

    var result = [];
    for (var i = 0; i < this.height; i++) {
        result[i] = [];
        for (var j = 0; j < other.width; j++) {
            var sum = 0;
            for (var k = 0; k < this.width; k++) {
                sum += this.mtx[i][k] * other.mtx[k][j];
            }
            result[i][j] = sum;
        }
    }
    return new Matrix(result);
}

var a = new Matrix([[1,2],[3,4]])
var b = new Matrix([[-3,-8,3],[-2,1,4]]);
print(a.mult(b));


PROC a = (INT in k, PROC INT xl, x2, x3, x4, x5) INT:(
  INT k := in k;
  PROC b = INT: a(k-:=1, b, xl, x2, x3, x4);
  ( k<=0 | x4 + x5 | b )
);

test:(
 printf(($gl$,a(10, INT:1, INT:-1, INT:-1, INT:1, INT:0)))
)


begin
  real procedure A (integer value k; real procedure x1, x2, x3, x4, x5);
  begin
    real procedure B;
    begin k:= k - 1;
          A (k, B, x1, x2, x3, x4)
    end;
    if k <= 0 then x4 + x5 else B
  end;
  write (r_format := "A", r_w := 8, r_d := 2, A (10, 1, -1, -1, 1, 0))
end.


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

# transpose/0 expects its input to be a rectangular matrix (an array of equal-length arrays)
def transpose:
  if (.[0] | length) == 0 then []
  else [map(.[0])] + (map(.[1:]) | transpose)
  end ;

# A and B should both be numeric matrices, A being m by n, and B being n by p.
def multiply(A; B):
  A as $A | B as $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] ) )) ;


on a(k, x1, x2, x3, x4, x5)
	script b
		set k to k - 1
		return a(k, b, x1, x2, x3, x4)
	end script
	if k ≤ 0 then
		return (run x4) + (run x5)
	else
		return (run b)
	end if
end a

on int(x)
	script s
		return x
	end script
	return s
end int

a(10, int(1), int(-1), int(-1), int(1), int(0))


julia> [1 2 3 ; 4 5 6] * [1 2 ; 3 4 ; 5 6]  # product of a 2x3 by a 3x2
2x2 Array{Int64,2}:
 22  28
 49  64

julia> [1 2 3] * [1,2,3]   # product of a row vector by a column vector
1-element Array{Int64,1}:
 14


/* man-or-boy.c */
#include <stdio.h>
#include <stdlib.h>

// --- thunks
typedef struct arg
{
  int       (*fn)(struct arg*);
  int        *k;
  struct arg *x1, *x2, *x3, *x4, *x5;
} ARG;

// --- lambdas
int f_1 (ARG* _) { return -1; }
int f0  (ARG* _) { return  0; }
int f1  (ARG* _) { return  1; }

// --- helper
int eval(ARG* a) { return a->fn(a); }
#define MAKE_ARG(...) (&(ARG){__VA_ARGS__})
#define FUN(...) MAKE_ARG(B, &k, __VA_ARGS__)

int A(ARG*);

// --- functions
int B(ARG* a)
{
  int k = *a->k -= 1;
  return A(FUN(a, a->x1, a->x2, a->x3, a->x4));
}

int A(ARG* a)
{
  return *a->k <= 0 ? eval(a->x4) + eval(a->x5) : B(a);
}

int main(int argc, char **argv)
{
  int k = argc == 2 ? strtol(argv[1], 0, 0) : 10;
  printf("%d\n", A(FUN(MAKE_ARG(f1), MAKE_ARG(f_1), MAKE_ARG(f_1),
                       MAKE_ARG(f1), MAKE_ARG(f0))));
  return 0;
}


// version 1.1.3

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 printMatrix(m: Matrix) {
    for (i in 0 until m.size) println(m[i].contentToString())
}

fun main(args: Array<String>) {
    val m1 = arrayOf(
        doubleArrayOf(-1.0,  1.0,  4.0),
        doubleArrayOf( 6.0, -4.0,  2.0),
        doubleArrayOf(-3.0,  5.0,  0.0),
        doubleArrayOf( 3.0,  7.0, -2.0)
    )
    val m2 = arrayOf(
        doubleArrayOf(-1.0,  1.0,  4.0,  8.0),
        doubleArrayOf( 6.0,  9.0, 10.0,  2.0),
        doubleArrayOf(11.0, -4.0,  5.0, -3.0)
    )
    printMatrix(m1 * m2)
}


using System;

delegate T Func<T>();

class ManOrBoy
{
    static void Main()
    {
        Console.WriteLine(A(10, C(1), C(-1), C(-1), C(1), C(0)));
    }

    static Func<int> C(int i)
    {
        return delegate { return i; };
    }

    static int A(int k, Func<int> x1, Func<int> x2, Func<int> x3, Func<int> x4, Func<int> x5)
    {
        Func<int> b = null;
        b = delegate { k--; return A(k, b, x1, x2, x3, x4); };
        return k <= 0 ? x4() + x5() : b();
    }
}


#include <iostream>
#include <tr1/memory>
using std::tr1::shared_ptr;
using std::tr1::enable_shared_from_this;

struct Arg {
  virtual int run() = 0;
  virtual ~Arg() { };
};

int A(int, shared_ptr<Arg>, shared_ptr<Arg>, shared_ptr<Arg>,
      shared_ptr<Arg>, shared_ptr<Arg>);

class B : public Arg, public enable_shared_from_this<B> {
private:
  int k;
  const shared_ptr<Arg> x1, x2, x3, x4;

public:
  B(int _k, shared_ptr<Arg> _x1, shared_ptr<Arg> _x2, shared_ptr<Arg> _x3,
    shared_ptr<Arg> _x4)
    : k(_k), x1(_x1), x2(_x2), x3(_x3), x4(_x4) { }
  int run() {
    return A(--k, shared_from_this(), x1, x2, x3, x4);
  }
};

class Const : public Arg {
private:
  const int x;
public:
  Const(int _x) : x(_x) { }
  int run () { return x; }
};

int A(int k, shared_ptr<Arg> x1, shared_ptr<Arg> x2, shared_ptr<Arg> x3,
      shared_ptr<Arg> x4, shared_ptr<Arg> x5) {
  if (k <= 0)
    return x4->run() + x5->run();
  else {
    shared_ptr<Arg> b(new B(k, x1, x2, x3, x4));
    return b->run();
  }
}

int main() {
  std::cout << A(10, shared_ptr<Arg>(new Const(1)),
                 shared_ptr<Arg>(new Const(-1)),
                 shared_ptr<Arg>(new Const(-1)),
                 shared_ptr<Arg>(new Const(1)),
                 shared_ptr<Arg>(new Const(0))) << std::endl;
  return 0;
}


Procedure Main()
   Local k
   For k := 0 to 20
      ? "A(", k, ", 1, -1, -1, 1, 0) =", A(k, 1, -1, -1, 1, 0)
   Next
Return

Static Function A(k, x1, x2, x3, x4, x5)
   Local ARetVal
   Local B := {|| --k, ARetVal := A(k, B, x1, x2, x3, x4) }
   If k <= 0
      ARetVal := Evaluate(x4) + Evaluate(x5)
   Else
      B:Eval()
   Endif
Return ARetVal

Static Function Evaluate(x)
   Local xVal
   If ValType(x) == "B"
      xVal := x:Eval()
   Else
      xVal := x
   Endif
Return xVal


(declare a)

(defn man-or-boy
  "Man or boy test for Clojure"
  [k]
  (let [k (atom k)]
    (a k
       (fn [] 1)
       (fn [] -1)
       (fn [] -1)
       (fn [] 1)
       (fn [] 0))))

(defn a
  [k x1 x2 x3 x4 x5]
  (let [k (atom @k)]
    (letfn [(b []
               (swap! k dec)
               (a k b x1 x2 x3 x4))]
      (if (<= @k 0)
        (+ (x4) (x5))
        (b)))))

(man-or-boy 10)


(defun matrix* (matrix-1 matrix-2)
  (list-comp
    ((<- a matrix-1))
    (list-comp
      ((<- b (transpose matrix-2)))
      (lists:foldl #'+/2 0
                   (lists:zipwith #'*/2 a b)))))


MatrixA$ ="4, 4,         1,  1,  1,  1,         2,  4,  8,  16,             3,  9, 27,  81,          4, 16, 64, 256"
MatrixB$ ="4, 4,         4, -3,  4/3, -1/4 ,   -13/3, 19/4, -7/3, 11/24,    3/2, -2, 7/6, -1/4,   -1/6, 1/4, -1/6, 1/24"

print "Product of two matrices"
call DisplayMatrix MatrixA$
print "         *"
call DisplayMatrix MatrixB$
print "         ="
MatrixP$ =MatrixMultiply$( MatrixA$, MatrixB$)
call DisplayMatrix MatrixP$


(defun man-or-boy (x)
 (a x (lambda () 1)
      (lambda () -1)
      (lambda () -1)
      (lambda () 1)
      (lambda () 0)))

(defun a (k x1 x2 x3 x4 x5)
  (labels ((b ()
             (decf k)
             (a k #'b x1 x2 x3 x4)))
    (if (<= k 0)
        (+ (funcall x4) (funcall x5))
        (b))))

(man-or-boy 10)


TO LISTVMD :A :F :C :NV
;PROCEDURE LISTVMD
;A = LIST
;F = ROWS
;C = COLS
;NV = NAME OF MATRIX / VECTOR NEW
;this procedure transform a list in matrix / vector square or rect

(LOCAL "CF "CC "NV "T "W)
MAKE "CF 1
MAKE "CC 1
MAKE "NV (MDARRAY (LIST :F :C) 1)
MAKE "T :F * :C
FOR [Z 1 :T][MAKE "W ITEM :Z :A
MDSETITEM (LIST :CF :CC) :NV :W
MAKE "CC :CC + 1
IF :CC = :C + 1 [MAKE "CF :CF + 1 MAKE "CC 1]]
OUTPUT :NV
END
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

TO XX
; MAIN PROGRAM
;LRCVS 10.04.12
; THIS PROGRAM multiplies two "square" matrices / vector ONLY!!!
; THE RECTANGULAR NOT WORK!!!

CT CS HT

; FIRST DATA MATRIX / VECTOR
MAKE "A [1 3 5 7 9 11 13 15 17 19 21 23 25 27 29 31 33 35 37 39 41 43 45 47 49]
MAKE "FA 5 ;"ROWS
MAKE "CA 5 ;"COLS

; SECOND DATA MATRIX / VECTOR
MAKE "B [2 4 6 8 10 12 14 16 18 20 22 24 26 28 30 32 34 36 38 40 42 44 46 48 50]
MAKE "FB 5 ;"ROWS
MAKE "CB 5 ;"COLS

IF (OR :FA <> :CA :FB <>:CB) [PRINT "Las_matrices/vector_no_son_cuadradas THROW
"TOPLEVEL ]
IFELSE (OR :CA <> :FB :FA <> :CB) [PRINT
"Las_matrices/vector_no_son_compatibles THROW "TOPLEVEL ][MAKE "MA LISTVMD :A
:FA :CA "MA MAKE "MB LISTVMD :B :FB :CB "MB] ;APPLICATION <<< "LISTVMD"

PRINT (LIST "THIS_IS: "ROWS "X "COLS)
PRINT []
PRINT (LIST :MA "=_M1 :FA "ROWS "X :CA "COLS)
PRINT []
PRINT (LIST :MB "=_M2 :FA "ROWS "X :CA "COLS)
PRINT []

MAKE "T :FA * :CB
MAKE "RE (ARRAY :T 1)

MAKE "CO 0
FOR [AF 1 :CA][
FOR [AC 1 :CA][
MAKE "TEMP 0
FOR [I 1 :CA ][
MAKE "TEMP :TEMP + (MDITEM (LIST :I :AF) :MA) * (MDITEM (LIST :AC :I) :MB)]
MAKE "CO :CO + 1
SETITEM :CO :RE :TEMP]]

PRINT []
PRINT (LIST "THIS_IS: :FA "ROWS "X :CB "COLS)
SHOW LISTVMD :RE :FA :CB "TO ;APPLICATION <<< "LISTVMD"
END

::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::\

               M1 * M2 RESULT / SOLUTION

 1  3  5  7  9    2  4  6  8 10    830 1880 2930 3980 5030
11 13 15 17 19   12 14 16 18 20    890 2040 3190 4340 5490
21 23 25 27 29 X 22 24 26 28 30 =  950 2200 3450 4700 5950
31 33 35 37 39   32 34 36 38 40   1010 2360 3710 5060 6410
41 43 45 47 49   42 44 46 48 50   1070 2520 3970 5420 6870

::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::\

NOW IN LOGO!!!!

THIS_IS: ROWS X COLS

{{1 3 5 7 9} {11 13 15 17 19} {21 23 25 27 29} {31 33 35 37 39} {41 43 45 47
49}} =_M1 5 ROWS X 5 COLS

{{2 4 6 8 10} {12 14 16 18 20} {22 24 26 28 30} {32 34 36 38 40} {42 44 46 48
50}} =_M2 5 ROWS X 5 COLS

THIS_IS: 5 ROWS X 5 COLS
{{830 1880 2930 3980 5030} {890 2040 3190 4340 5490} {950 2200 3450 4700 5950}
{1010 2360 3710 5060 6410} {1070 2520 3970 5420 6870}}


function MatMul( m1, m2 )
    if #m1[1] ~= #m2 then       -- inner matrix-dimensions must agree
        return nil
    end

    local res = {}

    for i = 1, #m1 do
        res[i] = {}
        for j = 1, #m2[1] do
            res[i][j] = 0
            for k = 1, #m2 do
                res[i][j] = res[i][j] + m1[i][k] * m2[k][j]
            end
        end
    end

    return res
end

-- Test for MatMul
mat1 = { { 1, 2, 3 }, { 4, 5, 6 } }
mat2 = { { 1, 2 }, { 3, 4 }, { 5, 6 } }
erg = MatMul( mat1, mat2 )
for i = 1, #erg do
    for j = 1, #erg[1] do
        io.write( erg[i][j] )
        io.write("  ")
    end
    io.write("\n")
end


import core.stdc.stdio: printf;

int a(int k, const lazy int x1, const lazy int x2, const lazy int x3,
      const lazy int x4, const lazy int x5) pure {
    int b() {
        k--;
        return a(k, b(), x1, x2, x3, x4);
    }
    return k <= 0 ? x4 + x5 : b();
}

void main() {
    printf("%d\n", a(10, 1, -1, -1, 1, 0));
}


type
  TFunc<T> = reference to function: T;

function C(x: Integer): TFunc<Integer>;
begin
  Result := function: Integer
  begin
    Result := x;
  end;
end;

function A(k: Integer; x1, x2, x3, x4, x5: TFunc<Integer>): Integer;
var
  b: TFunc<Integer>;
begin
  b := function: Integer
  begin
    Dec(k);
    Result := A(k, b, x1, x2, x3, x4);
  end;
  if k <= 0 then
    Result := x4 + x5
  else
    Result := b;
end;

begin
  Writeln(A(10, C(1), C(-1), C(-1), C(1), C(0))); // -67 output
end.


Module CheckMatMult {
	\\ Matrix Multiplication
	\\ we use array pointers so we pass arrays byvalue but change this by reference
	\\ this can be done because always arrays passed by reference,
	\\ and Read statement decide if this goes to a pointer of array or copied to a local array
	\\ the first line of code for MatMul is: Read a as array, b as array
	\\ interpreter insert this at function construction.
	\\ if a pointer inside function change to point to a new array, the this has no reflect to the passed array.
	Function MatMul(a as array, b as array) {
		if dimension(a)<>2 or dimension(b)<>2 then Error "Need two 2D arrays "
		let a2=dimension(a,2), b1=dimension(b,1)
		if a2<>b1 then Error "Need columns of first array equal to rows of second array"
		let a1=dimension(a,1), b2=dimension(b,2)
		let aBase=dimension(a,1,0)-1, bBase=dimension(b,1,0)-1
		let aBase1=dimension(a,2,0)-1, bBase1=dimension(b,2,0)-1
		link a,b to a(), b()  ' change interface for arrays
		dim base 1, c(a1, b2)
		for i=1 to a1 : let ia=i+abase : for j=1 to b2 : let jb=j+bBase1 : for k=1 to a2
		c(i,j)+=a(ia,k+aBase1)*b(k+bBase,jb)
		next k : next j : next i
		\\ redim to base 0
		dim base 0, c(a1, b2)
		=c()
	}
	\\ define arrays with different base per dimension
	\\ res() defined as empty array
	dim a(10 to 13, 4), b(4, 2 to 5), res()
	\\ numbers from ADA task
	a(10,0)= 1, 1, 1, 1, 2, 4, 8, 16, 3, 9, 27, 81, 4, 16, 64, 256
	b(0,2)= 4, -3, 4/3, -1/4, -13/3, 19/4, -7/3, 11/24, 3/2, -2, 7/6, -1/4, -1/6, 1/4, -1/6, 1/24
	res()=MatMul(a(), b())
	for i=0 to 3 :for j=0 to 3
	Print res(i,j),
	next j : Print : next i
}
CheckMatMult
Module CheckMatMult2 {
	\\ Matrix Multiplication
	\\ pass arrays by reference
	\\ if we change a passed array here, to a new array then this change also the reference array.
	Function MatMul(&a(),&b()) {
		if dimension(a())<>2 or dimension(b())<>2 then Error "Need two 2D arrays "
		let a2=dimension(a(),2), b1=dimension(b(),1)
		if a2<>b1 then Error "Need columns of first array equal to rows of second array"
		let a1=dimension(a(),1), b2=dimension(b(),2)
		let aBase=dimension(a(),1,0)-1, bBase=dimension(b(),1,0)-1
		let aBase1=dimension(a(),2,0)-1, bBase1=dimension(b(),2,0)-1
		dim base 1, c(a1, b2)
		for i=1 to a1 : let ia=i+abase : for j=1 to b2 : let jb=j+bBase1 : for k=1 to a2
		c(i,j)+=a(ia,k+aBase1)*b(k+bBase,jb)
		next k : next j : next i
		\\ redim to base 0
		dim base 0, c(a1, b2)
		=c()
	}
	\\ define arrays with different base per dimension
	\\ res() defined as empty array
	dim a(10 to 13, 4), b(4, 2 to 5), res()
	\\ numbers from ADA task
	a(10,0)= 1, 1, 1, 1, 2, 4, 8, 16, 3, 9, 27, 81, 4, 16, 64, 256
	b(0,2)= 4, -3, 4/3, -1/4, -13/3, 19/4, -7/3, 11/24, 3/2, -2, 7/6, -1/4, -1/6, 1/4, -1/6, 1/24
	res()=MatMul(&a(), &b())
	for i=0 to 3 :for j=0 to 3
	Print res(i,j),
	next j : Print : next i
}
CheckMatMult2


define method a
    (k :: <integer>, x1 :: <function>, x2 :: <function>, x3 :: <function>,
                     x4 :: <function>, x5 :: <function>)
 => (i :: <integer>)

  local b() => (i :: <integer>)
    k := k - 1;
    a(k, b, x1, x2, x3, x4)
  end;

  if (k <= 0) x4() + x5() else b() end if

end method a;

define method man-or-boy
    (x :: <integer>)
 => (i :: <integer>)

  a(x, method()  1 end,
       method() -1 end,
       method() -1 end,
       method()  1 end,
       method()  0 end)

end method man-or-boy;

format-out("%d\n", man-or-boy(10))


a k x1 x2 x3 x4 x5:
	local b:
		set :k -- k
		a k @b @x1 @x2 @x3 @x4
	if <= k 0:
		+ x4 x5
	else:
		b
local x i:
	labda:
		i

!. a 10 x 1 x -1 x -1 x 1 x 0


def a(var k, &x1, &x2, &x3, &x4, &x5) {
    def bS; def &b := bS
    bind bS {
        to get() {
            k -= 1
            return a(k, &b, &x1, &x2, &x3, &x4)
        }
    }
    return if (k <= 0) { x4 + x5 } else { b }
}

def p := 1
def n := -1
def z := 0
println(a(10, &p, &n, &n, &p, &z))


;; copied from Scheme
(define (A k x1 x2 x3 x4 x5)
  (define (B)
    (set! k (- k 1))
    (A k B x1 x2 x3 x4))
  (if (<= k 0)
      (+ (x4) (x5))
      (B)))

(A 10 (lambda () 1) (lambda () -1) (lambda () -1) (lambda () 1) (lambda () 0))
   → -67
(A 13 (lambda () 1) (lambda () -1) (lambda () -1) (lambda () 1) (lambda () 0))
   → -642
(A 14 ..)
❗ InternalError : too much recursion - JS internal error (please, report it)-
   → stack overflow using FireFox


open monad io unsafe.cell unsafe.console

liftM2 f m1 m2 = do
  x1 <- m1
  x2 <- m2
  return (f x1 x2)

a k x1 x2 x3 x4 x5 = do
  r <- return $ ref k
  let b = & do k <- return $ pred (valueof r)
             a k b x1 x2 x3 x4
  if k <= 0 then liftM2 (+) x4 x5 else b

_ = a 10 (!!1) (!! -1) (!! -1) (!!1) (!!0) >>= (putStr << show) ::: IO
  where (!!) f = & return f ::: IO


kounter = fn k, kounter ->
  receive do
    {:decr, pid} ->
      send(pid, k - 1)
      kounter.(k - 1, kounter)
    _ -> :ok
  end
end

a = fn k, x1, x2, x3, x4, x5, a ->
  kounter_process = spawn(fn -> kounter.(k, kounter) end)

  b =
    fn b ->
      send(kounter_process, {:decr, self()})
      receive do
        pred -> a.(pred, fn -> b.(b) end, x1, x2, x3, x4, a)
      end
    end

  if k <= 0,
    do: send(kounter_process, x4.() + x5.()),
    else: send(kounter_process, b.(b))
end

man_or_boy = fn n ->
  a.(n, fn -> 1 end, fn -> -1 end, fn -> -1 end, fn -> 1 end, fn -> 0 end, a)
end

▶ man_or_boy.(10) #⇒ -67
▶ man_or_boy.(14) #⇒ -1446
▶ man_or_boy.(20) #⇒ [error] Too many processes


let matrix_multiply x y =
  let x0 = Array.length x
  and y0 = Array.length y in
  let y1 = if y0 = 0 then 0 else Array.length y.(0) in
  let z = Array.make_matrix x0 y1 0 in
  for i = 0 to x0-1 do
    for j = 0 to y1-1 do
      for k = 0 to y0-1 do
        z.(i).(j) <- z.(i).(j) + x.(i).(k) * y.(k).(j)
      done
    done
  done;
  z


a = zeros(4);
% prepare the matrix
% 1 1 1 1
% 2 4 8 16
% 3 9 27 81
% 4 16 64 256
for i = 1:4
  for j = 1:4
    a(i, j) = i^j;
  endfor
endfor
b = inverse(a);
a * b


kloop(K) ->
    receive
        {decr,Pid} -> Pid ! K-1, kloop(K-1);
        _          -> ok
    end.

a(K, X1, X2, X3, X4, X5) ->
    Kproc = spawn(fun() -> kloop(K) end),
    B = fun (B) ->
                Kproc ! {decr, self()},
                receive Kdecr ->
                        a(Kdecr, fun() -> B(B) end, X1, X2, X3, X4)
                end
        end,
    if
        K =< 0  -> Kproc ! X4() + X5();
        true    -> Kproc ! B(B)
    end.

manorboy(N) ->
     a(N, fun() -> 1 end, fun() -> -1 end, fun() -> -1 end, fun() -> 1 end, fun() -> 0 end ).


[<EntryPoint>]
let main (args : string[]) =
    let k = int(args.[0])

    let l x = fun() -> x

    let rec a k x1 x2 x3 x4 x5 =
        if k <= 0 then
            x4() + x5()
        else
            let k = ref k
            let rec b() =
                k := !k - 1
                a !k b x1 x2 x3 x4
            b()

    a k (l 1) (l -1) (l -1) (l 1) (l 0)
    |> printfn "%A"

    0


; short version based on 'apply'
(define (matrix-multiply matrix1 matrix2)
(map
   (lambda (row)
      (apply map
         (lambda column
            (apply + (map * row column)))
         matrix2))
   matrix1))


  'generic with striding pointers
  'def typ float
  typedef float typ
  '
  function MatMul(typ *r,*a,*b, int n=4) 'NxN MATRIX : N=1..
  ============================================================
  int ystep=sizeof typ
  int xstep=n*sizeof typ
  int i,j,k
  sys px
  for i=1 to n
    [email protected]
    for j=1 to n
      r=0
      for k=1 to n
        r+=(a*b)
        @a+=xstep
        @b+=ystep
      next
      @r+=ystep
      px+=ystep
      @a=px
      @b-=xstep
    next
    @a-=xstep
    @b+=xstep
  next
  end function


: A {: w^ k x1 x2 x3 xt: x4 xt: x5 | w^ B :} recursive
  k @ 0<= IF  x4 x5 f+  ELSE
    B k x1 x2 x3 action-of x4 [{: B k x1 x2 x3 x4 :}L
      -1 k +!
      k @ B @ x1 x2 x3 x4 A ;] dup B !
      execute  THEN ;
10 [: 1e ;] [: -1e ;] 2dup swap [: 0e ;] A f.


module man_or_boy

implicit none

contains

  recursive integer function A(k,x1,x2,x3,x4,x5) result(res)
    integer, intent(in) :: k
    interface
      recursive integer function x1()
      end function
      recursive integer function x2()
      end function
      recursive integer function x3()
      end function
      recursive integer function x4()
      end function
      recursive integer function x5()
      end function
    end interface
    integer :: m
    if ( k <= 0 ) then
      res = x4()+x5()
    else
      m = k
      res = B()
    end if

  contains

    recursive integer function B() result(res)
      m = m-1
      res = A(m,B,x1,x2,x3,x4)
    end function B

  end function A

  recursive integer function one() result(res)
    res = 1
  end function

  recursive integer function minus_one() result(res)
    res = -1
  end function

  recursive integer function zero() result(res)
    res = 0
  end function

end module man_or_boy

program test
  use man_or_boy
  write (*,*) A(10,one,minus_one,minus_one,one,zero)
end program test


with javascript_semantics
function matrix_mul(sequence a, b)
    integer {ha,wa,hb,wb} = apply({a,a[1],b,b[1]},length)
    if wa!=hb then crash("invalid aguments") end if
    sequence c = repeat(repeat(0,wb),ha)
    for i=1 to ha do
        for j=1 to wb do
            for k=1 to wa do
                c[i][j] += a[i][k]*b[k][j]
            end for
        end for
    end for
    return c
end function

ppOpt({pp_Nest,1,pp_IntFmt,"%3d",pp_FltFmt,"%3.0f",pp_IntCh,false})

constant A = { { 1, 2 },
               { 3, 4 },
               { 5, 6 },
               { 7, 8 }},
         B = { { 1, 2, 3 },
               { 4, 5, 6 }}
pp(matrix_mul(A,B))

constant C = { { 1,  1,  1,   1 },
               { 2,  4,  8,  16 },
               { 3,  9, 27,  81 },
               { 4, 16, 64, 256 }},
         D = { {    4,   -3,  4/3, -1/ 4 },
               {-13/3, 19/4, -7/3, 11/24 },
               {  3/2,   -2,  7/6, -1/ 4 },
               { -1/6,  1/4, -1/6,  1/24 }}
pp(matrix_mul(C,D))

constant F = {{1, 2, 3},
              {4, 5, 6},
              {7, 8, 9}},
         G = {{1, 0, 0},
              {0, 1, 0},
              {0, 0, 1}}
pp(matrix_mul(F,G))

constant H = {{1,2},
              {3,4}},
         I = {{5,6},
              {7,8}}
pp(matrix_mul(H,I))

constant r = sqrt(2)/2,
         R = {{ r,r},
              {-r,r}}
pp(matrix_mul(R,R))

-- large matrix example from OI:
function row(integer i, l) return tagset(i+l,i) end function
constant J = apply(true,row,{tagset(16,0),371}),
         K = apply(true,row,{tagset(371,0),16})
pp(shorten(apply(true,shorten,{matrix_mul(J,K),{""},2}),"",2))


package main
import "fmt"

func a(k int, x1, x2, x3, x4, x5 func() int) int {
	var b func() int
	b = func() int {
		k--
		return a(k, b, x1, x2, x3, x4)
	}
	if k <= 0 {
		return x4() + x5()
	}
	return b()
}

func main() {
	x := func(i int) func() int { return func() int { return i } }
	fmt.Println(a(10, x(1), x(-1), x(-1), x(1), x(0)))
}


/* Matrix multiplication of A by B, yielding C */
MMULT: procedure (a, b, c);
   declare (a, b, c)(*,*) float controlled;
   declare (i, j, m, n, p) fixed binary;

   if hbound(a,2) ^= hbound(b,1) then
      do;
         put skip list
            ('Matrices are incompatible for matrix multiplication');
         signal error;
      end;

   m = hbound(a, 1); p = hbound(b, 2);
   if allocation(c) > 0 then free c;

   allocate c(m,p);

   do  i = 1 to m;
      do j = 1 to p;
         c(i,j) = sum(a(i,*) * b(*,j) );
      end;
   end;
end MMULT;


import Data.IORef (modifyIORef, newIORef, readIORef)

a
  :: (Enum a, Num b, Num a, Ord a)
  => a -> IO b -> IO b -> IO b -> IO b -> IO b -> IO b
a k x1 x2 x3 x4 x5 = do
  r <- newIORef k
  let b = do
        k <- pred ! r
        a k b x1 x2 x3 x4
  if k <= 0
    then (+) <$> x4 <*> x5
    else b
  where
    f !r = modifyIORef r f >> readIORef r

main :: IO ()
main = a 10 # 1 # (-1) # (-1) # 1 # 0 >>= print
  where
    ( # ) f = f . return


define matmul(a, b) -> c;
    lvars ba = boundslist(a), bb = boundslist(b);
    lvars i, i0 = ba(1), i1 = ba(2);
    lvars j, j0 = bb(1), j1 = bb(2);
    lvars k, k0 = bb(3), k1 = bb(4);
    if length(ba) /= 4 then
        throw([need_2d_array ^a])
    endif;
    if length(bb) /= 4 then
        throw([need_2d_array ^b])
    endif;
    if ba(3) /= j0 or ba(4) /= j1 then
        throw([dimensions_do_not_match ^a ^b]);
    endif;
    newarray([^i0 ^i1 ^k0 ^k1], 0) -> c;
    for i from i0 to i1 do
        for k from k0 to k1 do
            for j from j0 to j1 do
                c(i, k) + a(i, j)*b(j, k) -> c(i, k);
            endfor;
        endfor;
    endfor;
enddefine;


record mutable(value)                                         # we need mutable integers
                                                              # ... be obvious when we break normal scope rules
procedure main(arglist)                                       # supply the initial k value
k := integer(arglist[1])|10                                   # .. or default to 10=default
write("Man or Boy = ", A( k, 1, -1, -1, 1, 0 ) )
end

procedure eval(ref)                                           # evaluator to distinguish between a simple value and a code reference
return if type(ref) == "co-expression" then @ref  else ref
end

procedure A(k,x1,x2,x3,x4,x5)                                 # Knuth's A
k := mutable(k)                                               # make k mutable for B
return if k.value <= 0 then                                   # -> boy compilers may recurse and die here
   eval(x4) + eval(x5)                                        # the crux of separating man .v. boy compilers
else                                                          # -> boy compilers can run into trouble at k=5+
   B(k,x1,x2,x3,x4,x5)
end

procedure B(k,x1,x2,x3,x4,x5)                                 # Knuth's B
k.value -:= 1                                                 # diddle A's copy of k
return A(k.value, create |B(k,x1,x2,x3,x4,x5),x1,x2,x3,x4)    # call A with a new k and 5 x's
end


Range

a := method(k, xs,
    b := block(
        k = k -1
        a(k, list(b, xs slice(0,4)) flatten))
    if(k <= 0,
        (xs at(3) call) + (xs at(4) call),
        b call))

f := method(x, block(x))
1 to(500) foreach(k,
    (k .. " ") print
    a(k, list(1, -1, -1, 1, 0) map (x, f(x))) println)


% SWI-Prolog has transpose/2 in its clpfd library
:- use_module(library(clpfd)).

% N is the dot product of lists V1 and V2.
dot(V1, V2, N) :- maplist(product,V1,V2,P), sumlist(P,N).
product(N1,N2,N3) :- N3 is N1*N2.

% Matrix multiplication with matrices represented
% as lists of lists. M3 is the product of M1 and M2
mmult(M1, M2, M3) :- transpose(M2,MT), maplist(mm_helper(MT), M1, M3).
mm_helper(M2, I1, M3) :- maplist(dot(I1), M2, M3).


Procedure multiplyMatrix(Array a(2), Array b(2), Array prd(2))
  Protected ar = ArraySize(a())    ;#rows for matrix a
  Protected ac = ArraySize(a(), 2) ;#cols for matrix a
  Protected br = ArraySize(b())    ;#rows for matrix b
  Protected bc = ArraySize(b(), 2) ;#cols for matrix b

  If ac = br
    Dim prd(ar, bc)

    Protected i, j, k
    For i = 0 To ar
      For j = 0 To bc
        For k = 0 To br ;ac
          prd(i, j) = prd(i, j) + (a(i, k) * b(k, j))
        Next
      Next
    Next

    ProcedureReturn #True  ;multiplication performed, product in prd()
  Else
    ProcedureReturn #False ;multiplication not performed, dimensions invalid
  EndIf
EndProcedure


import java.util.function.DoubleSupplier;

public class ManOrBoy {

    static double A(int k, DoubleSupplier x1, DoubleSupplier x2,
                 DoubleSupplier x3, DoubleSupplier x4, DoubleSupplier x5) {

        DoubleSupplier B = new DoubleSupplier() {
            int m = k;
            public double getAsDouble() {
                return A(--m, this, x1, x2, x3, x4);
            }
        };

        return k <= 0 ? x4.getAsDouble() + x5.getAsDouble() : B.getAsDouble();
    }

    public static void main(String[] args) {
        System.out.println(A(10, () -> 1.0, () -> -1.0, () -> -1.0, () -> 1.0, () -> 0.0));
    }
}


function a(k, x1, x2, x3, x4, x5) {
  function b() {
    k -= 1;
    return a(k, b, x1, x2, x3, x4);
  }
  return (k > 0) ? b() : x4() + x5();
}

// this uses lambda wrappers around the numeric arguments
function x(n) {
  return function () {
    return n;
  };
}
alert(a(10, x(1), x(-1), x(-1), x(1), x(0)));


/* Knuth's Man or boy test (local references in recursion), in Jsish */
/* As noted, needs a fair sized stack depth, default is 200 in jsish v2.8.24 */
Interp.conf({maxDepth:2048});

function a(k, x1, x2, x3, x4, x5) {
  function b() {
    k -= 1;
    return a(k, b, x1, x2, x3, x4);
  }
  return (k > 0) ? b() : x4() + x5();
}

// this uses lambda wrappers around the numeric arguments
function x(n) {
  return function () {
    return n;
  };
}

puts(a(10, x(1), x(-1), x(-1), x(1), x(0)));

/*
=!EXPECTSTART!=
-67
=!EXPECTEND!=
*/


// version 1.1.3

typealias Func = () -> Int

fun a(k: Int, x1: Func, x2: Func, x3: Func, x4: Func, x5: Func): Int {
    var kk = k
    fun b(): Int = a(--kk, ::b, x1, x2, x3, x4)
    return if (kk <= 0) x4() + x5() else b()
}

fun main(args: Array<String>) {
    println(" k  a")
    for (k in 0..12) {
        println("${"%2d".format(k)}: ${a(k, { 1 }, { -1 }, { -1 }, { 1 }, { 0 })}")
    }
}


public rel[real, real, real] matrixMultiplication(rel[real x, real y, real v] matrix1, rel[real x, real y, real v] matrix2){
	if (max(matrix1.x) == max(matrix2.y)){
		p = {<x1,y1,x2,y2, v1*v2> | <x1,y1,v1> <- matrix1, <x2,y2,v2> <- matrix2};

		result = {};
		for (y <- matrix1.y){
			for (x <- matrix2.x){
				v = (0.0 | it + v | <x1, y1, x2, y2, v> <- p,  x==x2 && y==y1, x1==y2 && y2==x1);
				result += <x,y,v>;
			}
		}
		return result;
	}
	else throw "Matrix sizes do not match.";

//a matrix, given by a relation of the x-coordinate, y-coordinate and value.
public rel[real x, real y, real v] matrixA = {
<0.0,0.0,12.0>, <0.0,1.0, 6.0>, <0.0,2.0,-4.0>,
<1.0,0.0,-51.0>, <1.0,1.0,167.0>, <1.0,2.0,24.0>,
<2.0,0.0,4.0>, <2.0,1.0,-68.0>, <2.0,2.0,-41.0>
};


/*REXX program multiplies two matrices together, displays the matrices and the results. */
                    x.=;       x.1= 1 2          /*╔═══════════════════════════════════╗*/
                               x.2= 3 4          /*║ As none of the matrix values have ║*/
                               x.3= 5 6          /*║ a sign,  quotes aren't needed.    ║*/
                               x.4= 7 8          /*╚═══════════════════════════════════╝*/
               do   r=1  while x.r\==''          /*build the "A" matrix from X. numbers.*/
                 do c=1  while x.r\=='';   parse var   x.r   a.r.c  x.r;        end  /*c*/
               end   /*r*/
Arows= r - 1                                     /*adjust the number of rows  (DO loop).*/
Acols= c - 1                                     /*   "    "     "    " cols    "   "  .*/
                    y.=;       y.1= 1 2 3
                               y.2= 4 5 6
               do   r=1  while y.r\==''          /*build the "B" matrix from Y. numbers.*/
                 do c=1  while y.r\=='';   parse var    y.r   b.r.c  y.r;       end  /*c*/
               end   /*r*/
Brows= r - 1                                     /*adjust the number of rows  (DO loop).*/
Bcols= c - 1                                     /*   "     "    "    " cols    "   "   */
w= 0                                             /*W  is max width of an matrix element.*/
c.= 0;    do      i=1  for Arows                 /*multiply matrix  A  and  B  ───►   C */
            do    j=1  for Bcols
              do k=1  for Acols;   c.i.j= c.i.j + a.i.k*b.k.j;   w= max(w, length(c.i.j) )
              end   /*k*/                        /*              ↑                      */
            end     /*j*/                        /*              └────────◄───────────┐ */
          end       /*i*/                        /*max width of the matrix elements─►─┘ */

call showMat  'A',  Arows,  Acols                /*display matrix  A ───►  the terminal.*/
call showMat  'B',  Brows,  Bcols                /*   "       "    B ───►   "     "     */
call showMat  'C',  Arows,  Bcols                /*   "       "    C ───►   "     "     */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
showMat: parse arg mat,rows,cols;    say;    say center(mat 'matrix', cols*(w+1) + 9, "─")
                 do   r=1  for rows;   _= '    '
                   do c=1  for cols;   _= _ right( value(mat'.'r"."c), w);  end;     say _
                 end   /*r*/;                               return


fun A (k, xa, xb, xc, xd, xe) {
    print k;
    fun B() {
        k = k - 1;
        return A(k, B, xa, xb, xc, xd);
    }
    if (k <= 0) {
        return xd() + xe();
    } else {
        return B();
    }
}

fun I0()  { return  0; }
fun I1()  { return  1; }
fun I_1() { return -1; }

print A(10, I1, I_1, I_1, I1, I0);


function a(k,x1,x2,x3,x4,x5)
  local function b()
    k = k - 1
    return a(k,b,x1,x2,x3,x4)
  end
   if k <= 0 then return x4() + x5() else return b() end
end

function K(n)
  return function()
    return n
  end
end

print(a(10, K(1), K(-1), K(-1), K(1), K(0)))


load "stdlib.ring"
n = 3
C = newlist(n,n)
A = [[1,2,3], [4,5,6], [7,8,9]]
B = [[1,0,0], [0,1,0], [0,0,1]]
for i = 1 to n
    for j = 1 to n
       for k = 1 to n
           C[i][k] += A[i][j] * B[j][k]
       next
    next
next
for i = 1 to n
    for j = 1 to n
        see C[i][j] + " "
    next
    see nl
next


MODULE Main;
IMPORT IO;

TYPE Function = PROCEDURE ():INTEGER;

PROCEDURE A(k: INTEGER; x1, x2, x3, x4, x5: Function): INTEGER =

  PROCEDURE B(): INTEGER =
  BEGIN
    DEC(k);
    RETURN A(k, B, x1, x2, x3, x4);
  END B;

BEGIN
  IF k <= 0 THEN
    RETURN x4() + x5();
  ELSE
    RETURN B();
  END;
END A;

PROCEDURE F0(): INTEGER = BEGIN RETURN 0; END F0;
PROCEDURE F1(): INTEGER = BEGIN RETURN 1; END F1;
PROCEDURE Fn1(): INTEGER = BEGIN RETURN -1; END Fn1;

BEGIN
  IO.PutInt(A(10, F1, Fn1, Fn1, F1, F0));
  IO.Put("\n");
END Main.


% Matrix multiplication is a built-in with the S-Lang octothorpe operator.
variable A = [1,2,3,4,5,6];
reshape(A, [2,3]);             % reshape 1d array to 2 rows, 3 columns
printf("A is %S\n", A); print(A);

variable B = [1:6];            % index range, 1 to 6 same as above in A
reshape(B, [3,2]);             % reshape to 3 rows, 2 columns
printf("\nB is %S\n", B); print(B);

printf("\nA # B is %S\n", A#B);
print(A#B);

% Multiply binary operator is different, dimensions need to be equal
reshape(B, [2,3]);
printf("\nA * B is %S (with reshaped B to match A)\n", A*B);
print(A*B);


interface Arg {
  method : virtual : public : Run() ~ Int;
}

class ManOrBoy {
  New() {}

  function : A(mb : ManOrBoy, k : Int, x1 : Arg, x2 : Arg, x3 : Arg, x4 : Arg, x5 : Arg) ~ Int {
    if(k <= 0) {
            return x4->Run() + x5->Run();
    };

    return Base->New(mb, k, x1, x2, x3, x4) implements Arg {
      @mb : ManOrBoy; @k : Int; @x1 : Arg; @x2 : Arg; @x3 : Arg; @x4 : Arg; @m : Int;

      New(mb : ManOrBoy, k : Int, x1 : Arg, x2 : Arg, x3 : Arg, x4 : Arg) {
        @mb := mb; @k := k; @x1 := x1; @x2 := x2; @x3 := x3; @x4 := x4; @m := @k;
      }

      method : public : Run() ~ Int {
        @m -= 1;
        return @mb->A(@mb, @m, @self, @x1, @x2, @x3, @x4);
      }
    }->Run();
  }

  function : C(i : Int) ~ Arg {
    return Base->New(i) implements Arg {
      @i : Int;
      New(i : Int) {
        @i := i;
      }

      method : public : Run() ~ Int {
        return @i;
      }
    };
  }

  function : Main(args : String[]) ~ Nil {
    mb := ManOrBoy->New();
    mb->A(mb, 10, C(1), C(-1), C(-1), C(1), C(0))->PrintLine();
  }
}


def mult[A](a: Array[Array[A]], b: Array[Array[A]])(implicit n: Numeric[A]) = {
  import n._
  for (row <- a)
  yield for(col <- b.transpose)
        yield row zip col map Function.tupled(_*_) reduceLeft (_+_)
}


(define (matrix-multiply matrix1 matrix2)
  (map
   (lambda (row)
    (apply map
     (lambda column
      (apply + (map * row column)))
     matrix2))
   matrix1))


#import <Foundation/Foundation.h>

typedef NSInteger (^IntegerBlock)(void);

NSInteger A (NSInteger kParam, IntegerBlock x1, IntegerBlock x2, IntegerBlock x3, IntegerBlock x4, IntegerBlock x5) {
    __block NSInteger k = kParam;
    __block __weak IntegerBlock weak_B;
    IntegerBlock B;
    weak_B = B = ^ {
        return A(--k, weak_B, x1, x2, x3, x4);
    };
    return k <= 0 ? x4() + x5() : B();
}

IntegerBlock K (NSInteger n) {
    return ^{return n;};
}

int main (int argc, const char * argv[]) {
    @autoreleasepool {
        NSInteger result = A(10, K(1), K(-1), K(-1), K(1), K(0));
        NSLog(@"%d\n", result);
    }
    return 0;
}


let rec a k x1 x2 x3 x4 x5 =
  if k <= 0 then
    x4 () + x5 ()
  else
    let m = ref k in
    let rec b () =
      decr m;
      a !m b x1 x2 x3 x4
    in
    b ()

let () =
  Printf.printf "%d\n" (a 10 (fun () -> 1) (fun () -> -1) (fun () -> -1) (fun () -> 1) (fun () -> 0))


const type: matrix is array array float;

const func matrix: (in matrix: left) * (in matrix: right) is func
  result
    var matrix: result is matrix.value;
  local
    var integer: i is 0;
    var integer: j is 0;
    var integer: k is 0;
    var float: accumulator is 0.0;
  begin
    if length(left[1]) <> length(right) then
      raise RANGE_ERROR;
    else
      result := length(left) times length(right[1]) times 0.0;
      for i range 1 to length(left) do
        for j range 1 to length(right) do
          accumulator := 0.0;
          for k range 1 to length(left) do
            accumulator +:= left[i][k] * right[k][j];
          end for;
          result[i][j] := accumulator;
        end for;
      end for;
    end if;
  end func;


; Because argument "k" is a small number, it's a value, not an object.
; So we must 'pack' it in object - 'box' it; And 'unbox' when we try to get value.

(define (box x)  (list x))
(define (unbox x) (car x))
(define (copy x) (box (unbox x)))

(define (A k x1 x2 x3 x4 x5)
   (define (B)
      (set-car! k (- (unbox k) 1))
      (A (copy k) B x1 x2 x3 x4))

   (if (<= (unbox k) 0)
      (+ (x4) (x5))
      (B)))

(define (man-or-boy N)
   (A (box N)
      (lambda ()  1)
      (lambda () -1)
      (lambda () -1)
      (lambda ()  1)
      (lambda () 0)))

(print (man-or-boy 10))
(print (man-or-boy 15))
(print (man-or-boy 20))


CREATE TABLE a (x INTEGER, y INTEGER, e REAL);
CREATE TABLE b (x INTEGER, y INTEGER, e REAL);

-- test data
-- A is a 2x2 matrix
INSERT INTO a VALUES(0,0,1); INSERT INTO a VALUES(1,0,2);
INSERT INTO a VALUES(0,1,3); INSERT INTO a VALUES(1,1,4);

-- B is a 2x3 matrix
INSERT INTO b VALUES(0,0,-3); INSERT INTO b VALUES(1,0,-8); INSERT INTO b VALUES(2,0,3);
INSERT INTO b VALUES(0,1,-2); INSERT INTO b VALUES(1,1, 1); INSERT INTO b VALUES(2,1,4);

-- C is 2x2 * 2x3 so will be a 2x3 matrix
SELECT rhs.x, lhs.y, (SELECT SUM(a.e*b.e) FROM a, b
                             WHERE a.y = lhs.y
                               AND b.x = rhs.x
                               AND a.x = b.y)
       INTO TABLE c
       FROM a AS lhs, b AS rhs
       WHERE lhs.x = 0 AND rhs.y = 0;


declare
  fun {A K X1 X2 X3 X4 X5}
     ReturnA = {NewCell undefined}
     fun {B}
        ReturnB = {NewCell undefined}
     in
        K := @K - 1
        ReturnA := {A {NewCell @K} B X1 X2 X3 X4}
        ReturnB := @ReturnA
        @ReturnB
     end
  in
     if @K =< 0 then ReturnA := {X4} + {X5} else _ = {B} end
     @ReturnA
  end

  fun {C V}
     fun {$} V end
  end
in
  {Show {A {NewCell 10} {C 1} {C ~1} {C ~1} {C 1} {C 0}}}


program manorboy(output);

function zero: integer; begin zero := 0 end;
function one: integer; begin one := 1 end;
function negone: integer; begin negone := -1 end;

function A(
  k: integer;
  function x1: integer;
  function x2: integer;
  function x3: integer;
  function x4: integer;
  function x5: integer
): integer;

  function B: integer;
  begin k := k - 1;
        B := A(k, B, x1, x2, x3, x4)
  end;

begin if k <= 0 then A := x4 + x5 else A := B
end;

begin writeln(A(10, one, negone, negone, one, zero))
end.


structure IMatrix = struct
fun dot(x,y) = Vector.foldli (fn (i,xi,agg) => agg+xi*Vector.sub(y,i)) 0 x
fun x*y =
    let
	open Array2
    in
	tabulate ColMajor (nRows x, nCols y, fn (i,j) => dot(row(x,i),column(y,j)))
    end
end;
(* for display *)
fun toList a =
    let
	open Array2
    in
	List.tabulate(nRows a,  fn i => List.tabulate(nCols a, fn j => sub(a,i,j)))
    end;
(* example *)
let
    open IMatrix
    val m1 = Array2.fromList [[1,2],[3,4]]
    val m2 = Array2.fromList [[~3,~8,3],[~2,1,4]]
in
    toList (m1*m2)
end;


@inlinable
public func matrixMult<T: Numeric>(_ m1: [[T]], _ m2: [[T]]) -> [[T]] {
  let n = m1[0].count
  let m = m1.count
  let p = m2[0].count

  guard m != 0 else {
    return []
  }

  precondition(n == m2.count)

  var ret = Array(repeating: Array(repeating: T.zero, count: p), count: m)

  for i in 0..<m {
    for j in 0..<p {
      for k in 0..<n {
        ret[i][j] += m1[i][k] * m2[k][j]
      }
    }
  }

  return ret
}

@inlinable
public func printMatrix<T>(_ matrix: [[T]]) {
  guard !matrix.isEmpty else {
    print()

    return
  }

  let rows = matrix.count
  let cols = matrix[0].count

  for i in 0..<rows {
    for j in 0..<cols {
      print(matrix[i][j], terminator: " ")
    }

    print()
  }
}

let m1 = [
  [6.5, 2, 3],
  [4.5, 1, 5]
]

let m2 = [
  [10.0, 16, 23, 50],
  [12, -8, 16, -4],
  [70, 60, -1, -2]
]

let m3 = matrixMult(m1, m2)

printMatrix(m3)


without js -- allocate()
forward function A(integer k, object x1, x2, x3, x4, x5)

function B(sequence s)
    object {kptr,x1,x2,x3,x4} = s
    integer k = peek4s(kptr)-1
    poke4(kptr,k)
    return A(k,{kptr,x1,x2,x3,x4},x1,x2,x3,x4)
end function

function A(integer k, object x1, x2, x3, x4, x5)
    if k<=0 then
        return iff(sequence(x4)?B(x4):x4)+
               iff(sequence(x5)?B(x5):x5)
    end if
    atom kptr = allocate(4,1)
    poke4(kptr,k)
    return B({kptr,x1,x2,x3,x4})
end function

for k=0 to 23 do
    printf(1,"A(%d) = %d\n",{k,A(k,1,-1,-1,1,0)})
end for


operator (A matmul B)
  $A -> \[i](
    $B(1) -> \[j](@: 0;
      1..$B::length -> @: [email protected] + $A($i;$) * $B($;$j);
      [email protected] !\) !
  \) !
end matmul

templates printMatrix&{w:}
  templates formatN
    @: [];
    $ -> #
    '[email protected] -> $::length~..$w -> ' ';[email protected](last..1:-1)...;' !
    when <1..> do ..|@: $ mod 10; $ ~/ 10 -> #
    when <=0?([email protected] <[](0)>)> do ..|@: 0;
  end formatN
  $... -> '|$(1) -> formatN;$(2..last)... -> ', $ -> formatN;';|
' !
end printMatrix

def a: [[1, 2, 3], [4, 5, 6]];
'a:
' -> !OUT::write
$a -> printMatrix&{w:2} -> !OUT::write

def b: [[0, 1], [2, 3], [4, 5]];
'
b:
' -> !OUT::write
$b -> printMatrix&{w:2} -> !OUT::write
'
axb:
' -> !OUT::write
($a matmul $b) -> printMatrix&{w:2} -> !OUT::write


package require Tcl 8.5
namespace path ::tcl::mathop
proc matrix_multiply {a b} {
    lassign [size $a] a_rows a_cols
    lassign [size $b] b_rows b_cols
    if {$a_cols != $b_rows} {
        error "incompatible sizes: a($a_rows, $a_cols), b($b_rows, $b_cols)"
    }
    set temp [lrepeat $a_rows [lrepeat $b_cols 0]]
    for {set i 0} {$i < $a_rows} {incr i} {
        for {set j 0} {$j < $b_cols} {incr j} {
            set sum 0
            for {set k 0} {$k < $a_cols} {incr k} {
                set sum [+ $sum [* [lindex $a $i $k] [lindex $b $k $j]]]
            }
            lset temp $i $j $sum
        }
    }
    return $temp
}


<?php
function A($k,$x1,$x2,$x3,$x4,$x5) {
    $b = function () use (&$b,&$k,$x1,$x2,$x3,$x4) {
        return A(--$k,$b,$x1,$x2,$x3,$x4);
    };
    return $k <= 0 ? $x4() + $x5() : $b();
}

echo A(10, function () { return  1; },
           function () { return -1; },
           function () { return -1; },
           function () { return  1; },
           function () { return  0; }) . "\n";
?>


morb: proc options (main) reorder;
 dcl sysprint file;

 put skip list(a((10), lambda1, lambdam1, lambdam1, lambda0, lambda0));

 a: proc(k, x1, x2, x3, x4, x5) returns(fixed bin (31)) recursive;
   dcl k                    fixed bin (31);
   dcl (x1, x2, x3, x4, x5) entry returns(fixed bin (31));

   b: proc returns(fixed bin(31)) recursive;
     k = k - 1;
     return(a((k), b, x1, x2, x3, x4));
   end b;

   if k <= 0 then
     return(x4 + x5);
   else
     return(b);
 end a;

 lambdam1: proc returns(fixed bin (31)); return(-1); end lambdam1;
 lambda0:  proc returns(fixed bin (31)); return(1);  end lambda0;
 lambda1:  proc returns(fixed bin (31)); return(1);  end lambda1;
end morb;


define A(k, x1, x2, x3, x4, x5);
    define B();
        k - 1 -> k;
        A(k, B, x1, x2, x3, x4)
    enddefine;
    if k <= 0 then
        x4() + x5()
    else
        B()
    endif
enddefine;

define one(); 1 enddefine;
define minus_one(); -1 enddefine;
define zero(); 0 enddefine;
A(10, one, minus_one, minus_one, one, zero) =>


#!/usr/bin/env python
import sys
sys.setrecursionlimit(1025)

def a(in_k, x1, x2, x3, x4, x5):
    k = [in_k]
    def b():
        k[0] -= 1
        return a(k[0], b, x1, x2, x3, x4)
    return x4() + x5() if k[0] <= 0 else b()

x = lambda i: lambda: i
print(a(10, x(1), x(-1), x(-1), x(1), x(0)))


#lang transd

MainModule: {
    _start: (λ (with n 5
            A (for i in Range(n) project (for k in Range(n) project k))
            B (for i in Range(n) project (for k in Range(n) project (- n k)))
            C (for i in Range(n) project (for k in Range(n) project 0))

        (for i in Range( n ) do
            (for j in Range( n ) do
                (for k in Range( n ) do
            (+= (get (get C i) j) (* (get (get A i) k) (get (get B k) j)))
        )))
        (lout C))
    )
}


#!/bin/bash

DELAY=0 # increase this if printing of matrices should be slower

echo "This script takes two matrices, henceforth called A and B,
and returns their product, AB.

For the time being, matrices can have integer components only.

"

read -p "Number of rows    of matrix A:  " arows
read -p "Number of columns of matrix A:  " acols
brows="$acols"
echo
echo    "Number of rows    of matrix B:  "$brows
read -p "Number of columns of matrix B:  " bcols

crows="$arows"
ccols="$bcols"
echo

echo "Number of rows    of matrix AB:  " $crows
echo "Number of columns of matrix AB:  " $ccols
echo
echo

matrixa=( )
matrixb=( )

# input matrix A

maxlengtha=0
for ((row=1; row<=arows; row++)); do
    for ((col=1; col<=acols; col++)); do
	checkentry="false"
	while [ "$checkentry" != "true" ]; do
	    read -p "Enter component A[$row, $col]:  " number
	    index=$(((row-1)*acols+col))
	    matrixa[$index]="$number"
	    [ "${matrixa[$index]}" -eq "$number" ] && checkentry="true"
	    echo
	done
	entry="${matrixa[$index]}"
	[ "${#entry}" -gt "$maxlengtha" ] && maxlengtha="${#entry}"
    done
    echo
done

# print matrix A to guard against errors

if [ "$maxlengtha" -le "5" ]; then
    width=8
else
    width=$((maxlengtha + 3))
fi

echo "This is matrix A:

"

for ((row=1; row<=arows; row++)); do
    for ((col=1; col<=acols; col++)); do

	index=$(((row-1)*acols+col))
	printf "%${width}d" "${matrixa[$index]}"
	sleep "$DELAY"

    done
    echo; echo # printf %s "\n\n" does not work...
done

echo
echo

# input matrix B

maxlengthb=0
for ((row=1; row<=brows; row++)); do
    for ((col=1; col<=bcols; col++)); do
	checkentry="false"
	while [ "$checkentry" != "true" ]; do
	    read -p "Enter component B[$row, $col]:  " number
	    index=$(((row-1)*bcols+col))
	    matrixb[$index]="$number"
	    [ "${matrixb[$index]}" -eq "$number" ] && checkentry="true"
	    echo
	done
	entry="${matrixb[$index]}"
	[ "${#entry}" -gt "$maxlengthb" ] && maxlengthb="${#entry}"
    done
    echo
done

# print matrix B to guard against errors

if [ "$maxlengthb" -le "5" ]; then
    width=8
else
    width=$((maxlengthb + 3))
fi

echo "This is matrix B:

"

for ((row=1; row<=brows; row++)); do
    for ((col=1; col<=bcols; col++)); do

	index=$(((row-1)*bcols+col))
	printf "%${width}d" "${matrixb[$index]}"
	sleep "$DELAY"

    done
    echo; echo # printf %s "\n\n" does not work...
done

read -p "Hit enter to continue"

# calculate matrix C := AB

maxlengthc=0
time for ((row=1; row<=crows; row++)); do
    for ((col=1; col<=ccols; col++)); do

	# calculate component C[$row, $col]

	runningtotal=0
	for ((j=1; j<=acols; j++)); do
	    rowa="$row"
	    cola="$j"
	    indexa=$(((rowa-1)*acols+cola))
	    rowb="$j"
	    colb="$col"
	    indexb=$(((rowb-1)*bcols+colb))

	    entry_from_A=${matrixa[$indexa]}
	    entry_from_B=${matrixb[$indexb]}

	    subtotal=$((entry_from_A * entry_from_B))
	    ((runningtotal+=subtotal))
	done

	number="$runningtotal"

	# store component in the result array
	index=$(((row-1)*ccols+col))
	matrixc[$index]="$number"

	entry="${matrixc[$index]}"
	[ "${#entry}" -gt "$maxlengthc" ] && maxlengthc="${#entry}"
    done
done

echo
read -p "Hit enter to continue"
echo

# print the matrix C

if [ "$maxlengthc" -le "5" ]; then
    width=8
else
    width=$((maxlengthc + 3))
fi

echo "The product matrix is:

"

for ((row=1; row<=crows; row++)); do
    for ((col=1; col<=ccols; col++)); do

	index=$(((row-1)*ccols+col))
	printf "%${width}d" "${matrixc[$index]}"
	sleep "$DELAY"

    done
    echo; echo # printf %s "\n\n" does not work...
done

echo
echo


#lang racket

(define (A k x1 x2 x3 x4 x5)
  (define (B)
    (set! k (- k 1))
    (A k B x1 x2 x3 x4))
  (if (<= k 0)
      (+ (x4) (x5))
      (B)))

(A 10 (lambda () 1) (lambda () -1) (lambda () -1) (lambda () 1) (lambda () 0))


Function matrix_multiplication(a As Variant, b As Variant) As Variant
    matrix_multiplication = WorksheetFunction.MMult(a, b)
End Function


Dim matrix1(2,2)
matrix1(0,0) = 3 : matrix1(0,1) = 7 : matrix1(0,2) = 4
matrix1(1,0) = 5 : matrix1(1,1) = -2 : matrix1(1,2) = 9
matrix1(2,0) = 8 : matrix1(2,1) = -6 : matrix1(2,2) = -5
Dim matrix2(2,2)
matrix2(0,0) = 9 : matrix2(0,1) = 2 : matrix2(0,2) = 1
matrix2(1,0) = -7 : matrix2(1,1) = 3 : matrix2(1,2) = -10
matrix2(2,0) = 4 : matrix2(2,1) = 5 : matrix2(2,2) = -6

Call multiply_matrix(matrix1,matrix2)

Sub multiply_matrix(arr1,arr2)
	For i = 0 To UBound(arr1)
		For j = 0 To 2
			WScript.StdOut.Write (arr1(i,j) * arr2(i,j)) & vbTab
		Next
		WScript.StdOut.WriteLine
	Next
End Sub


/*REXX program performs the  "man or boy"  test as far as possible for  N.              */
     do n=0                                      /*increment  N  from  zero  forever.   */
     say 'n='n   a(N,x1,x2,x3,x4,x5)             /*display the result to the terminal.  */
     end  /*n*/                                  /* [↑]  do until something breaks.     */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
a:   procedure; parse arg k, x1, x2, x3, x4, x5
     if k<=0  then return f(x4) + f(x5)
              else return f(b)
/*──────────────────────────────────────────────────────────────────────────────────────*/
b:   k=k-1;                            return  a(k, b, x1, x2, x3, x4)
f:   interpret  'v='  arg(1)"()";      return  v
x1:  procedure;                        return  1
x2:  procedure;                        return -1
x3:  procedure;                        return -1
x4:  procedure;                        return  1
x5:  procedure;                        return  0


LOCAL ARRAY a[4,2], b[2,3], c[4,3]
CLOSE DATABASES ALL
*!* The arrays could be created directly but I prefer to do this:
CREATE CURSOR mat1 (c1 I, c2 I)
CREATE CURSOR mat2 (c1 I, c2 I, c3 I)
*!* Since matrix multiplication of integer arrays
*!* involves only multiplication and addition,
*!* the result will contain integers
CREATE CURSOR result (c1 I, c2 I, c3 I)
INSERT INTO mat1 VALUES (1, 2)
INSERT INTO mat1 VALUES (3, 4)
INSERT INTO mat1 VALUES (5, 6)
INSERT INTO mat1 VALUES (7, 8)
SELECT * FROM mat1 INTO ARRAY a

INSERT INTO mat2 VALUES (1, 2, 3)
INSERT INTO mat2 VALUES (4, 5, 6)
SELECT * FROM mat2 INTO ARRAY b
STORE 0 TO c
MatMult(@a,@b,@c)
SELECT result
APPEND FROM ARRAY c
BROWSE

PROCEDURE MatMult(aa, bb, cc)
LOCAL n As Integer, m As Integer, p As Integer, i As Integer, j As Integer, k As Integer
IF ALEN(aa,2) = ALEN(bb,1)
	n = ALEN(aa,2)
	m = ALEN(aa,1)
	p = ALEN(bb,2)
	FOR i = 1 TO m
		FOR j = 1 TO p
			FOR k = 1 TO n
				cc[i,j] = cc[i,j] + aa[i,k]*bb[k,j]
			ENDFOR
		ENDFOR
	ENDFOR
ELSE
	? "Invalid dimensions"
ENDIF
ENDPROC


import "/matrix" for Matrix
import "/fmt" for Fmt

var a = Matrix.new([
    [1, 2],
    [3, 4],
    [5, 6],
    [7, 8]
])

var b = Matrix.new([
    [1, 2, 3],
    [4, 5, 6]
])

System.print("Matrix A:\n")
Fmt.mprint(a, 2, 0)
System.print("\nMatrix B:\n")
Fmt.mprint(b, 2, 0)
System.print("\nMatrix A x B:\n")
Fmt.mprint(a * b, 3, 0)


use std::cell::Cell;

trait Arg {
    fn run(&self) -> i32;
}

impl Arg for i32 {
    fn run(&self) -> i32 { *self }
}

struct B<'a> {
    k: &'a Cell<i32>,
    x1: &'a Arg,
    x2: &'a Arg,
    x3: &'a Arg,
    x4: &'a Arg,
}

impl<'a> Arg for B<'a> {
    fn run(&self) -> i32 {
        self.k.set(self.k.get() - 1);
        a(self.k.get(), self, self.x1, self.x2, self.x3, self.x4)
    }
}

fn a(k: i32, x1: &Arg, x2: &Arg, x3: &Arg, x4: &Arg, x5: &Arg) -> i32 {
    if k <= 0 {
        x4.run() + x5.run()
    } else {
        B{
            k: &Cell::new(k),
            x1, x2, x3, x4
        }.run()
    }
}

pub fn main() {
    println!("{}", a(10, &1, &-1, &-1, &1, &0));
}


dim a(4, 2)
a(0, 0) = 1 : a(0, 1) = 2
a(1, 0) = 3 : a(1, 1) = 4
a(2, 0) = 5 : a(2, 1) = 6
a(3, 0) = 7 : a(3, 1) = 8
dim b(2, 3)
b(0, 0) = 1 : b(0, 1) = 2 : b(0, 2) = 3
b(1, 0) = 4 : b(1, 1) = 5 : b(1, 2) = 6
dim prod(arraysize(a(),1), arraysize(b(),2))

if (arraysize(a(),2) = arraysize(b(),1)) then
	for i = 0 to arraysize(a(),1)
		for j = 0 to arraysize(b(),2)
			for k = 0 to arraysize(a(),2)
				prod(i, j) = prod(i, j) + (a(i, k) * b(k, j))
			next k
		next j
	next i

	for i = 0 to arraysize(prod(),1)-1
		for j = 0 to arraysize(prod(),2)-1
			print prod(i, j),
		next j
		print
	next i
else
	print "invalid dimensions"
end if
end


var [const] GSL=Import("zklGSL");	// libGSL (GNU Scientific Library)
A:=GSL.Matrix(4,2).set(1,2, 3,4, 5,6, 7,8);
B:=GSL.Matrix(2,3).set(1,2,3, 4,5,6);
(A*B).format().println();   // creates a new matrix


module MatrixOps;
type
	Matrix = array {math} *,* of integer;

	procedure WriteMatrix(x: array {math} *,* of integer);
	var
		i,j: integer;
	begin
		for i := 0 to len(x,0) - 1 do
			for j := 0 to len(x,1) - 1 do
				write(x[i,j]);
			end;
			writeln;
		end
	end WriteMatrix;

	procedure Multiplication;
	var
		a,b: Matrix;
	begin
		a := [[1,2],[3,4],[5,6],[7,8]];
		b := [[1,2,3],[4,5,6]];
		WriteMatrix(a * b);
	end Multiplication;

begin
	Multiplication;
end MatrixOps.


BEGIN # find some magic constants - the row, column and diagonal sums of a magin square #
      # translation of the Free Basic sample with the Julia/Wren inverse function #
    # returns the magic constant of a magic square of order n + 2 #
    PROC a     = ( INT n )LONG LONG INT:
         BEGIN
            LONG LONG INT n2 = n + 2;
            ( n2 * ( ( n2 * n2 ) + 1 ) ) OVER 2
         END # a # ;
    # returns the order of the magic square whose magic constant is at least x #
    PROC inv a = ( LONG LONG INT x )LONG LONG INT:
         ENTIER long long exp( long long ln( x * 2 ) / 3 ) + 1;

    print( ( "The first 20 magic constants are " ) );
    FOR n TO 20 DO
        print( ( whole( a( n ), 0 ), " " ) )
    OD;
    print( ( newline ) );
    print( ( "The 1,000th magic constant is ", whole( a( 1000 ), 0 ), newline ) );
    LONG LONG INT e := 1;
    FOR n TO 20 DO
        e *:= 10;
        print( ( "10^", whole( n, -2 ), ": ", whole( inv a( e ), -9 ), newline ) )
    OD
END


function a(k, x1, x2, x3, x4, x5) {
	let kk = { "k": k.k };
	let b = function b() {
		kk.k--;
		return a(kk, b, x1, x2, x3, x4);
	};
	return kk.k <= 0 ? x4() + x5() : b();
}

function x(n) {
	return function () {
		return n;
	};
}

print(a({ "k": 10 }, x(1), x(-1), x(-1), x(1), x(0)));


program matmultSUMMA;

prototype GetSingleDim(infile:file):integer;
prototype GetInnerDim(infile1:file; infile2:file):integer;

config var
          Afilename: string = "";
          Bfilename: string = "";

          Afile: file = open(Afilename,file_read);
          Bfile: file = open(Bfilename,file_read);

          default_size:integer = 4;
          m:integer = GetSingleDim(Afile);
          n:integer = GetInnerDim(Afile,Bfile);
          p:integer = GetSingleDim(Bfile);

          iters: integer = 1;

          printinput: boolean = false;
          verbose: boolean = true;
          dotiming: boolean = false;

region
       RA = [1..m,1..n];
       RB = [1..n,1..p];
       RC = [1..m,1..p];
       FCol = [1..m,*];
       FRow = [*,1..p];

var
    A : [RA] double;
    B : [RB] double;
    C : [RC] double;
    Aflood : [FCol] double;
    Bflood : [FRow] double;

procedure ReadA();
var step:double;
[RA] begin
       if (Afile != znull) then
         read(Afile,A);
       else
         step := 1.0/(m*n);
         A := ((Index1-1)*n + Index2)*step + 1.0;
       end;
     end;

procedure ReadB();
var step:double;
[RB] begin
       if (Bfile != znull) then
         read(Bfile,B);
       else
         step := 1.0/(n*p);
         B := ((Index1-1)*p + Index2)*step + 1.0;
       end;
     end;

procedure matmultSUMMA();
var
    i: integer;
    it: integer;
    runtime: double;
[RC] begin
       ReadA();
       ReadB();

       if (printinput) then
         [RA] writeln("A is:\n",A);
         [RB] writeln("B is:\n",B);
       end;

       ResetTimer();

       for it := 1 to iters do

         C := 0.0;                       -- zero C

         for i := 1 to n do
           [FCol] Aflood := >>[,i] A;       -- flood A col
           [FRow] Bflood := >>[i,] B;       -- flood B row

           C += (Aflood * Bflood);   -- multiply
         end;
       end;

       runtime := CheckTimer();

       if (verbose) then
         writeln("C is:\n",C);
       end;

       if (dotiming) then
         writeln("total runtime  = %12.6f":runtime);
         writeln("actual runtime = %12.6f":runtime/iters);
       end;
     end;

procedure GetSingleDim(infile:file):integer;
var dim:integer;
begin
  if (infile != znull) then
    read(infile,dim);
  else
    dim := default_size;
  end;
  return dim;
end;

procedure GetInnerDim(infile1:file; infile2:file):integer;
var
   col:integer;
   row:integer;
   retval:integer;
begin
  retval := -1;
  if (infile1 != znull) then
    read(infile1,col);
    retval := col;
  end;
  if (infile2 != znull) then
    read(infile2,row);
    if (retval = -1) then
      retval := row;
    else
      if (row != col) then
        halt("ERROR: Inner dimensions don't match");
      end;
    end;
  end;
  if (retval = -1) then
    retval := default_size;
  end;
  return retval;
end;


a: function [n][
    n: n+2
    return (n*(1 + n^2))/2
]

aInv: function [x][
    k: new 0
    while [x > 2 + k*(1+k^2)/2]
        -> inc 'k
    return k
]
print "The first 20 magic constants are:"
print map 1..19 => a

print ""
print "The 1,000th magic constant is:"
print a 1000

print ""
loop 1..19 'z ->
    print ["10 ^" z "=>" aInv 10^z]


# syntax: GAWK -f MAGIC_CONSTANT.AWK
# converted from FreeBASIC
BEGIN {
    printf("The first 20 magic constants are:")
    for (i=1; i<=20; i++) {
      printf(" %d",a(i))
    }
    printf("\n")
    printf("The 1,000th magic constant is: %d\n",a(1000))
    for (i=1; i<=20; i++) {
      printf("10^%02d: %8d\n",i,inv_a(10^i))
    }
    exit(0)
}
function a(n) {
    n += 2
    return(n*(n^2+1)/2)
}
function inv_a(x,  k) {
    while (k*(k^2+1)/2+2 < x) {
      k++
    }
    return(k)
}


function a(byval n as uinteger) as ulongint
    n+=2
    return n*(n^2 + 1)/2
end function

function inv_a(x as double) as ulongint
    dim as ulongint k = 0
    while k*(k^2+1)/2+2 < x
        k+=1
    wend
    return k
end function

dim as ulongint n
print "The first 20 magic constants are ":
for n = 1 to 20
    print a(n);" ";
next n
print
print "The 1,000th magic constant is ";a(1000)

for e as uinteger = 1 to 20
    print using "10^##: #########";e;inv_a(10^cast(double,e))
next e


func A(_ k: Int,
       _ x1: @escaping () -> Int,
       _ x2: @escaping () -> Int,
       _ x3: @escaping () -> Int,
       _ x4: @escaping () -> Int,
       _ x5: @escaping () -> Int) -> Int {
    var k1 = k

    func B() -> Int {
        k1 -= 1
        return A(k1, B, x1, x2, x3, x4)
    }

    if k1 <= 0 {
        return x4() + x5()
    } else {
        return B()
    }
}

print(A(10, {1}, {-1}, {-1}, {1}, {0}))


proc A {k x1 x2 x3 x4 x5} {
    expr {$k<=0 ? [eval $x4]+[eval $x5] : [B \#[info level]]}
}
proc B {level} {
    upvar $level k k x1 x1 x2 x2 x3 x3 x4 x4
    incr k -1
    A $k [info level 0] $x1 $x2 $x3 $x4
}
proc C {val} {return $val}
interp recursionlimit {} 1157
A 10 {C 1} {C -1} {C -1} {C 1} {C 0}


USING: formatting io kernel math math.functions.integer-logs
math.ranges prettyprint sequences ;

: magic ( m -- n ) dup sq 1 + 2 / * ;

"First 20 magic constants:" print
3 22 [a,b] [ bl ] [ magic pprint ] interleave nl
nl
"1000th magic constant: " write 1002 magic .
nl
"Smallest order magic square with a constant greater than:" print
1 0 20 [
    [ 10 * ] dip
    [ dup magic pick < ] [ 1 + ] while
    over integer-log10 over "10^%02d: %d\n" printf
    dup + 1 -
] times 2drop


package main

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

func magicConstant(n int) int {
    return (n*n + 1) * n / 2
}

var ss = []string{
    "\u2070", "\u00b9", "\u00b2", "\u00b3", "\u2074",
    "\u2075", "\u2076", "\u2077", "\u2078", "\u2079",
}

func superscript(n int) string {
    if n < 10 {
        return ss[n]
    }
    if n < 20 {
        return ss[1] + ss[n-10]
    }
    return ss[2] + ss[0]
}

func main() {
    fmt.Println("First 20 magic constants:")
    for n := 3; n <= 22; n++ {
        fmt.Printf("%5d ", magicConstant(n))
        if (n-2)%10 == 0 {
            fmt.Println()
        }
    }

    fmt.Println("\n1,000th magic constant:", rcu.Commatize(magicConstant(1002)))

    fmt.Println("\nSmallest order magic square with a constant greater than:")
    for i := 1; i <= 20; i++ {
        goal := math.Pow(10, float64(i))
        order := int(math.Cbrt(goal*2)) + 1
        fmt.Printf("10%-2s : %9s\n", superscript(i), rcu.Commatize(order))
    }
}


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

# nth-root
def iroot($n):
  . as $in
  | if $n == 1 then .
    else (. < 0) as $neg
    | if $neg and (n % 2) == 0
      then "Cannot take the \($n)th root of a negative number." | error
      else ($n-1) as $n
      | {t: (if $neg then -. else . end)}
      | .s = .t + 1
      | .u = .t
      | until (.u >= .s;
          .s = .u
          | .u = ((.u * $n) + (.t / (.u|power($n)))) / ($n + 1) )
      | if $neg then - .s else .s end
      end
    end;

# input: an array
# output: a stream of arrays of size size except possibly for the last array
def group(size):
  recurse( .[size:]; length>0) | .[0:size];

def lpad($len): tostring | ($len - length) as $l | (" " * $l)[:$l] + .;

def ss : ["\u2070", "\u00b9", "\u00b2", "\u00b3", "\u2074",
          "\u2075", "\u2076", "\u2077", "\u2078", "\u2079"];

def superscript:
  if . < 10 then ss[.]
  elif . < 20 then ss[1] + ss[. - 10]
  else ss[2] + ss[0]
  end;


using Lazy

magic(x) = (1 + x^2) * x ÷ 2
magics = @>> Lazy.range() map(magic) filter(x -> x > 10) # first 2 values are filtered out
println("First 20 magic constants: ", Int.(take(20, magics)))
println("Thousandth magic constant is: ", collect(take(1000, magics))[end])

println("Smallest magic square with constant greater than:")
for expo in 1:20
    goal = big"10"^expo
    ordr = Int(floor((2 * goal)^(1/3))) + 1
    println("10^", string(expo, pad=2), "    ", ordr)
end


#!/usr/bin/perl

use strict; # https://rosettacode.org/wiki/Magic_constant
use warnings;

my @twenty = map $_ * ( $_ ** 2 + 1 ) / 2, 3 .. 22;
print "first twenty: @twenty\n\n" =~ s/.{50}\K /\n/gr;

my $thousandth = 1002 * ( 1002 ** 2 + 1 ) / 2;
print "thousandth: $thousandth\n\n";

print "10**N   order\n";
for my $i ( 1 .. 20 )
  {
  printf "%3d %9d\n", $i, (10 ** $i * 2) ** ( 1 / 3 ) + 1;
  }


CREATE PROCEDURE dbo.LAMBDA_WRAP_INTEGER

	@v INT

AS
	DECLARE	@name NVARCHAR(MAX) = 'LAMBDA_' + UPPER(REPLACE(NEWID(), '-', '_'))
	DECLARE @SQL NVARCHAR(MAX) = '
			CREATE PROCEDURE dbo.' + @name + '
				AS

			RETURN ' + CAST(@v AS NVARCHAR(MAX))

	EXEC(@SQL)
	RETURN OBJECT_ID(@name)
GO

CREATE PROCEDURE dbo.LAMBDA_EXEC
	@id INT

AS
	DECLARE @name SYSNAME = OBJECT_NAME(@id)
	,	@retval INT
	EXEC	@retval = @name
	RETURN	@retval
GO

-- B-procedure
CREATE PROCEDURE dbo.LAMBDA_B
	@name_out SYSNAME OUTPUT
,	@q INT
AS
BEGIN

	DECLARE	@SQL NVARCHAR(MAX)
	,	@name NVARCHAR(MAX) = 'LAMBDA_B_' + UPPER(REPLACE(NEWID(), '-', '_'))

	SELECT	@SQL = N'
		CREATE PROCEDURE dbo.' + @name + N'

			AS

		DECLARE @retval INT, @k INT, @x1 INT, @x2 INT, @x3 INT, @x4 INT

		SELECT	@k = k - 1, @x1 = x1, @x2 = x2,	@x3 = x3, @x4 = x4
		FROM	#t_args t
		WHERE	t.i = ' + CAST(@q AS NVARCHAR(MAX)) + '

		UPDATE	t
		SET	k = k -1
		FROM	#t_args t
		WHERE	t.i = ' + CAST(@q AS NVARCHAR(MAX)) + '

		EXEC	@retval = LAMBDA_A @k, @@PROCID, @x1, @x2, @x3, @x4
		RETURN @retval'
	EXEC(@SQL)

	SELECT	@name_out = @name
END

GO
-- A-procedure
CREATE PROCEDURE dbo.LAMBDA_A
(

	@k INT
,	@x1 INT
,	@x2 INT
,	@x3 INT
,	@x4 INT
,	@x5 INT
)
AS
	SET NOCOUNT ON;
	DECLARE @res1 INT
	,	@res2 INT
	,	@Name SYSNAME
	,	@q INT

	-- First add the arguments to the "stack"
	INSERT INTO #t_args (k,	x1, x2, x3, x4, x5
	)
	SELECT	@k, @x1, @x2, @x3, @x4, @x5

	SELECT	@q = SCOPE_IDENTITY()

	IF @k <= 0
	BEGIN
		EXEC	@res1 = dbo.LAMBDA_EXEC @x4
		EXEC	@res2 = dbo.LAMBDA_EXEC @x5
		RETURN	@res1 + @res2
	END
	ELSE
	BEGIN
		EXEC	dbo.LAMBDA_B @name_out = @Name OUTPUT, @q = @q
		EXEC	@res1 = @Name
		RETURN	@res1
	END

GO

-------------------------------------------------------------
-- Test script
-------------------------------------------------------------

DECLARE	@x1 INT
,	@x2 INT
,	@x0 INT
,	@x4 INT
,	@x5 INT
,	@K INT
,	@retval INT

-------------------------------------------------------------
-- Create wrapped integers to pass as arguments
-------------------------------------------------------------
EXEC	@x1 = LAMBDA_WRAP_INTEGER 1
EXEC	@x2 = LAMBDA_WRAP_INTEGER -1
EXEC	@x0 = LAMBDA_WRAP_INTEGER 0

-------------------------------------------------------------
-- Argument storage table
-------------------------------------------------------------
CREATE TABLE #t_args (
	k INT
,	x1 INT
,	x2 INT
,	x3 INT
,	x4 INT
,	x5 INT
,	i INT IDENTITY
)

SELECT	@K = 1

-- Anything above 5 blows up the stack
WHILE 	@K <= 4
BEGIN
	EXEC	@retval = dbo.LAMBDA_A @K, @x1, @x2, @x2, @x1, @x0
	PRINT	'For k=' + CAST(@K AS VARCHAR) + ', result=' + CAST(@retval AS VARCHAR)

	SELECT	@K = @K + 1
END


with javascript_semantics

function magic(integer nth)
    integer order = nth+2
    return (order*order+1)/2 * order
end function
printf(1,"First 20 magic constants: %V\n",{apply(tagset(20),magic)})
printf(1,"1000th magic constant: %,d\n",{magic(1000)})

include mpfr.e

mpz {goal, order} = mpz_inits(2)
for i=1 to 20 do
    mpz_ui_pow_ui(goal,10,i)
    mpz_mul_si(order,goal,2)
    mpz_nthroot(order,order,3)
    mpz_add_si(order,order,1)
    printf(1,"1e%d: %s\n",{i,mpz_get_str(order,10,true)})
end for


m(X,Y):- Y is X*(X*X+1)/2.

l(L,R,T,X):- L > R -> X is L; M is div(L+R,2), m(M,F),
    (T < F -> R_ is M-1, l(L,R_,T,X); L_ is M+1, l(L_,R,T,X)).
l(B,X):- l(1,B,B,X).

task:-
    write("First 20 magic constants are:"), forall(between(3,22,N), (m(N,X), format(" ~d",X))), nl,
    write("The 1000th magic constant is:"), forall(m(1002,X), format(" ~d",X)), nl,
    forall(between(1,20,N), (l(10**N,X), format("10^~d:\t~d\n",[N,X]))).


#!/usr/bin/python

def a(n):
    n += 2
    return n*(n**2 + 1)/2

def inv_a(x):
    k = 0
    while k*(k**2+1)/2+2 < x:
        k+=1
    return k

if __name__ == '__main__':
    print("The first 20 magic constants are:");
    for n in range(1, 20):
        print(int(a(n)), end = " ");
    print("\nThe 1,000th magic constant is:",int(a(1000)));

    for e in range(1, 20):
        print(f'10^{e}: {inv_a(10**e)}');


implement main
    open core

clauses
    run():-
        console::init(),
        stdio::write(a(10, {() = 1}, {() = -1}, {() = -1}, {() = 1}, {() = 0})).

class predicates
    a : (integer K, function{integer} X1, function{integer} X2, function{integer} X3, function{integer} X4, function{integer} X5) -> integer Result.
clauses
    a(K, X1, X2, X3, X4, X5) = R :-
        KM = varM::new(K),
        BM = varM{function{integer}}::new({() = 0}),
        BM:value :=
            { () = BR :-
                KM:value := KM:value-1,
                BR = a(KM:value, BM:value, X1, X2, X3, X4)
            },
        R = if KM:value <= 0 then X4() + X5() else BM:value() end if.

end implement main


  [ 3 + dup 3 ** + 2 / ] is magicconstant ( n --> n )

  20 times [ i^ magicconstant echo sp ] cr cr

  1000 magicconstant echo cr cr

  0 1
  [ over magicconstant over > if
      [ over 3 + echo cr
        10 * ]
    dip 1+
    [ 10 21 ** ] constant
    over = until ]
  2drop


use Lingua::EN::Numbers:ver<2.8+>;

my @magic-constants = lazy (3..∞).hyper.map: { (1 + .²) * $_ / 2 };

put "First 20 magic constants: ", @magic-constants[^20]».,
say "1000th magic constant: ", @magic-constants[999].,
say "\nSmallest order magic square with a constant greater than:";

(1..20).map: -> $p {printf "10%-2s: %s\n", $p.&super, comma 3 + @magic-constants.first( * > exp($p, 10), :k ) }


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

var magicConstant = Fn.new { |n| (n*n + 1) * n / 2 }

var ss = ["\u2070", "\u00b9", "\u00b2", "\u00b3", "\u2074",
          "\u2075", "\u2076", "\u2077", "\u2078", "\u2079"]

var superscript = Fn.new { |n| (n < 10) ? ss[n] : (n < 20) ? ss[1] + ss[n - 10] : ss[2] + ss[0] }

System.print("First 20 magic constants:")
var mc20 = (3..22).map { |n| magicConstant.call(n) }.toList
for (chunk in Lst.chunks(mc20, 10)) Fmt.print("$5d", chunk)

Fmt.print("\n1,000th magic constant: $,d", magicConstant.call(1002))

System.print("\nSmallest order magic square with a constant greater than:")
for (i in 1..20) {
    var goal = 10.pow(i)
    var order = (goal * 2).cbrt.floor + 1
    Fmt.print("10$-2s : $,9d", superscript.call(i), order)
}


BEGIN # find some magnanimous numbers - numbers where inserting a + between any #
      # digits ab=nd evaluatinf the sum results in a prime in all cases         #
    # returns the first n magnanimous numbers                                   #
    #         uses global sieve prime which must include 0 and be large enough  #
    #         for all possible sub-sequences of digits                          #
    OP MAGNANIMOUS = ( INT n )[]INT:
       BEGIN
            [ 1 : n ]INT result;
            INT          m count := 0;
            FOR i FROM 0 WHILE m count < n DO
                # split the number into pairs of digit seuences and check the sums of the pairs are all prime #
                INT  divisor   := 1;
                BOOL all prime := TRUE;
                WHILE divisor *:= 10;
                      IF   INT front = i OVER divisor;
                           front = 0
                      THEN FALSE
                      ELSE all prime := prime[ front + ( i MOD divisor ) ]
                      FI
                DO SKIP OD;
                IF all prime THEN result[ m count +:= 1 ] := i FI
            OD;
            result
       END; # MAGNANIMPUS #
    # prints part of a seuence of magnanimous numbers #
    PROC print magnanimous = ( []INT m, INT first, INT last, STRING legend )VOID:
         BEGIN
             print( ( legend, ":", newline ) );
             FOR i FROM first TO last DO print( ( " ", whole( m[ i ], 0 ) ) ) OD;
             print( ( newline ) )
         END ; # print magnanimous #
    # we assume the first 400 magnanimous numbers will be in 0 .. 1 000 000 #
    # so we will need a sieve of 0 up to 99 999 + 9 #
    [ 0 : 99 999 + 9 ]BOOL prime;
    prime[ 0 ] := prime[ 1 ] := FALSE; prime[ 2 ] := TRUE;
    FOR i FROM 3 BY 2 TO UPB prime DO prime[ i ] := TRUE  OD;
    FOR i FROM 4 BY 2 TO UPB prime DO prime[ i ] := FALSE OD;
    FOR i FROM 3 BY 2 TO ENTIER sqrt( UPB prime ) DO
        IF prime[ i ] THEN FOR s FROM i * i BY i + i TO UPB prime DO prime[ s ] := FALSE OD FI
    OD;
    # construct the sequence of magnanimous numbers #
    []INT m = MAGNANIMOUS 400;
    print magnanimous( m,   1,  45, "First 45 magnanimous numbers" );
    print magnanimous( m, 241, 250, "Magnanimous numbers 241-250"  );
    print magnanimous( m, 391, 400, "Magnanimous numbers 391-400"  )
END


self.a = method(k, x1, x2, x3, x4, x5){
  b = method(){
    code.k = code.k - 1
    return( self.a(code.k, code, code.x1, code.x2, code.x3, code.x4) )
  }
  b.k = k
  b.x1 = x1
  b.x2 = x2
  b.x3 = x3
  b.x4 = x4
  b.x5 = x5

  if(k <= 0){
    return(self.apply(x4) + self.apply(x5))
  }
  else{
    return(self.apply(b))
  }
}

self.K = method(n){
  f = method(){
    return(code.n)
  }
  f.n = n
  return(f)
}

self.a(10, self.K(1), self.K(-1), self.K(-1), self.K(1), self.K(0)).print()


import "/fmt" for Fmt

var a
a = Fn.new { |k, x1, x2, x3, x4, x5|
    var b
    b = Fn.new {
        k = k - 1
        return a.call(k, b, x1, x2, x3, x4)
    }
    return (k <= 0) ? x4.call() + x5.call() : b.call()
}

System.print(" k    a")
for (k in 0..20) {
    Fmt.print("$2d : $ d", k, a.call(k, Fn.new { 1 }, Fn.new { -1 }, Fn.new { -1 }, Fn.new { 1 }, Fn.new { 0 }))
}


int  N, X;
real M, Thresh, MC;
[Text(0, "First 20 magic constants:^M^J");
for N:= 3 to 20+3-1 do
    [IntOut(0, (N*N*N+N)/2);  ChOut(0, ^ )];
CrLf(0);
Text(0, "1000th magic constant: ");
N:= 1000+3-1;
IntOut(0, (N*N*N+N)/2);
CrLf(0);
Text(0, "Smallest order magic square with a constant greater than:^M^J");
Thresh:= 10.;
M:= 3.;
Format(1, 0);
for X:= 1 to 10 do
    [repeat MC:= (M*M*M+M)/2.;
            M:= M+1.;
    until   MC > Thresh;
    Text(0, "10^^");
    if X < 10 then ChOut(0, ^0);
    IntOut(0, X);
    Text(0, ": ");
    RlOut(0, M-1.);
    CrLf(0);
    Thresh:= Thresh*10.;
    ];
]


begin
    % find some Magnanimous numbers - numbers where inserting a "+" between  %
    % any two of the digits and evaluating the sum results in a prime number %
    % implements the sieve of Eratosthenes                                   %
    procedure sieve( logical array s ( * ); integer value n ) ;
    begin
        % start with everything flagged as prime                             %
        for i := 1 until n do s( i ) := true;
        % sieve out the non-primes                                           %
        s( 1 ) := false;
        for i := 2 until truncate( sqrt( n ) ) do begin
            if s( i ) then for p := i * i step i until n do s( p ) := false
        end for_i ;
    end sieve ;
    % construct an array of magnanimous numbers using the isPrime sieve      %
    procedure findMagnanimous ( logical array magnanimous, isPrime ( * ) ) ;
    begin
        % 1 digit magnanimous numbers                                        %
        for i :=  0 until 9               do magnanimous( i ) := true;
        % initially, the other magnanimous numbers are unknown               %
        for i := 10 until MAGNANIMOUS_MAX do magnanimous( i ) := false;
        % 2 & 3 digit magnanimous numbers                                    %
        for d1 := 1 until 9 do begin
            for d2 := 0 until 9 do begin
                if isPrime( d1 + d2 ) then magnanimous( ( d1 * 10 ) + d2 ) := true
            end for_d2 ;
            for d23 := 0 until 99 do begin
                if isPrime( d1 + d23 ) then begin
                    integer d12, d3;
                    d3  := d23 rem 10;
                    d12 := ( d1 * 10 ) + ( d23 div 10 );
                    if isPrime( d12 + d3 ) then magnanimous( ( d12 * 10 ) + d3 ) := true
                end if_isPrime_d1_plus_d23
            end for_d23
        end for_d1 ;
        % 4 & 5 digit magnanimous numbers                                    %
        for d12 := 10 until 99 do begin
            for d34 := 0 until 99 do begin
                if isPrime( d12 + d34 ) then begin
                    integer d123, d4;
                    d123 := ( d12 * 10 ) + ( d34 div 10 );
                    d4   := d34 rem 10;
                    if isPrime( d123 + d4 ) then begin
                        integer d1, d234;
                        d1   := d12 div 10;
                        d234 := ( ( d12 rem 10 ) * 100 ) + d34;
                        if  isPrime( d1 + d234 ) then magnanimous( ( d12 * 100 ) + d34 ) := true
                    end if_isPrime_d123_plus_d4
                end if_isPrime_d12_plus_d34
            end for_d34 ;
            for d345 := 0 until 999 do begin
                if isPrime( d12 + d345 ) then begin
                    integer d123, d45;
                    d123 := ( d12 * 10 ) + ( d345 div 100 );
                    d45  := d345 rem 100;
                    if isPrime( d123 + d45 ) then begin
                        integer d1234, d5;
                        d1234 := ( d123 * 10 ) + ( d45 div 10 );
                        d5    := d45 rem 10;
                        if isPrime( d1234 + d5 ) then begin
                            integer d1, d2345;
                            d1    := d12 div 10;
                            d2345 := ( ( d12 rem 10 ) * 1000 ) + d345;
                            if isPrime( d1 + d2345 ) then magnanimous( ( d12 * 1000 ) + d345 ) := true
                        end if_isPrime_d1234_plus_d5
                    end if_isPrime_d123_plus_d45
                end if_isPrime_d12_plus_d345
            end for_d234
        end for_d12 ;
        % find 6 digit magnanimous numbers                                   %
        for d123 := 100 until 999 do begin
            for d456 := 0 until 999 do begin
                if isPrime( d123 + d456 ) then begin
                    integer d1234, d56;
                    d1234 := ( d123 * 10 ) + ( d456 div 100 );
                    d56   := d456 rem 100;
                    if isPrime( d1234 + d56 ) then begin
                        integer d12345, d6;
                        d12345 := ( d1234 * 10 ) + ( d56 div 10 );
                        d6     := d56 rem 10;
                        if isPrime( d12345 + d6 ) then begin
                            integer d12, d3456;
                            d12   := d123 div 10;
                            d3456 := ( ( d123 rem 10 ) * 1000 ) + d456;
                            if isPrime( d12 + d3456 ) then begin
                                integer d1, d23456;
                                d1     := d12 div 10;
                                d23456 := ( ( d12 rem 10 ) * 10000 ) + d3456;
                                if isPrime( d1 + d23456 ) then magnanimous( ( d123 * 1000 ) + d456 ) := true
                            end if_isPrime_d12_plus_d3456
                        end if_isPrime_d12345_plus_d6
                    end if_isPrime_d1234_plus_d56
                end if_isPrime_d123_plus_d456
            end for_d456
        end for_d123
    end findMagnanimous ;
    % we look for magnanimous numbers with up to 6 digits, so we need to     %
    % check for primes up to 99999 + 9 = 100008                              %
    integer PRIME_MAX, MAGNANIMOUS_MAX;
    PRIME_MAX       :=  100008;
    MAGNANIMOUS_MAX := 1000000;
    begin
        logical array magnanimous ( 0 :: MAGNANIMOUS_MAX );
        logical array isPrime     ( 1 :: PRIME_MAX       );
        integer mPos;
        integer lastM;
        sieve( isPrime, PRIME_MAX );
        findMagnanimous( magnanimous, isPrime );
        % show some of the magnanimous numbers                               %
        lastM := mPos  := 0;
        i_w := 3; s_w := 1; % output formatting                              %
        for i := 0 until MAGNANIMOUS_MAX do begin
            if magnanimous( i ) then begin
                mPos  := mPos + 1;
                lastM := i;
                if      mPos =   1 then begin
                    write( "Magnanimous numbers 1-45:" );
                    write( i )
                    end
                else if mPos < 46 then begin
                    if mPos rem 15 = 1 then write( i )
                                       else writeon( i )
                    end
                else if mPos = 241 then begin
                    write( "Magnanimous numbers 241-250:" );
                    write( i )
                    end
                else if mPos > 241 and mPos <= 250 then writeon( i )
                else if mPos = 391 then begin
                    write( "Magnanimous numbers 391-400:" );
                    write( i )
                    end
                else if mPos > 391 and mPos <= 400 then writeon( i )
            end if_magnanimous_i
        end for_i ;
        i_w := 1; s_w := 0;
        write( "Last magnanimous number found: ", mPos, " = ", lastM )
    end
end.