---------------- MAXIMUM TRIANGLE PATH SUM ---------------

-- Working from the bottom of the triangle upwards,
-- summing each number with the larger of the two below
-- until the maximum emerges at the top.

-- maxPathSum :: [[Int]] -> Int
on maxPathSum(xss)

    -- With the last row as the initial accumulator,
    -- folding from the penultimate line,
    -- towards the top of the triangle:

    -- sumWithRowBelow :: [Int] -> [Int] -> [Int]
    script sumWithRowBelow
        on |λ|(row, accum)

            -- plusGreaterOfTwoBelow :: Int -> Int -> Int -> Int
            script plusGreaterOfTwoBelow
                on |λ|(x, intLeft, intRight)
                    x + max(intLeft, intRight)
                end |λ|
            end script

            -- The accumulator, zipped with the tail of the
            -- accumulator, yields pairs of adjacent sums so far.

            zipWith3(plusGreaterOfTwoBelow, row, accum, tail(accum))
        end |λ|
    end script

    -- A list of lists folded down to a list of just one remaining integer.
    -- Head returns that integer from the list.

    head(foldr1(sumWithRowBelow, xss))
end maxPathSum

--------------------------- TEST -------------------------
on run

    maxPathSum({¬
        {55}, ¬
        {94, 48}, ¬
        {95, 30, 96}, ¬
        {77, 71, 26, 67}, ¬
        {97, 13, 76, 38, 45}, ¬
        {7, 36, 79, 16, 37, 68}, ¬
        {48, 7, 9, 18, 70, 26, 6}, ¬
        {18, 72, 79, 46, 59, 79, 29, 90}, ¬
        {20, 76, 87, 11, 32, 7, 7, 49, 18}, ¬
        {27, 83, 58, 35, 71, 11, 25, 57, 29, 85}, ¬
        {14, 64, 36, 96, 27, 11, 58, 56, 92, 18, 55}, ¬
        {2, 90, 3, 60, 48, 49, 41, 46, 33, 36, 47, 23}, ¬
        {92, 50, 48, 2, 36, 59, 42, 79, 72, 20, 82, 77, 42}, ¬
        {56, 78, 38, 80, 39, 75, 2, 71, 66, 66, 1, 3, 55, 72}, ¬
        {44, 25, 67, 84, 71, 67, 11, 61, 40, 57, 58, 89, 40, 56, 36}, ¬
        {85, 32, 25, 85, 57, 48, 84, 35, 47, 62, 17, 1, 1, 99, 89, 52}, ¬
        {6, 71, 28, 75, 94, 48, 37, 10, 23, 51, 6, 48, 53, 18, 74, 98, 15}, ¬
        {27, 2, 92, 23, 8, 71, 76, 84, 15, 52, 92, 63, 81, 10, 44, 10, 69, 93} ¬
            })

    --> 1320
end run

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

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

-- foldr1 :: (a -> a -> a) -> [a] -> a
on foldr1(f, xs)
    if length of xs > 1 then
        tell mReturn(f)
            set v to item -1 of xs
            set lng to length of xs
            repeat with i from lng - 1 to 1 by -1
                set v to |λ|(item i of xs, v, i, xs)
            end repeat
            return v
        end tell
    else
        xs
    end if
end foldr1

-- head :: [a] -> a
on head(xs)
    if length of xs > 0 then
        item 1 of xs
    else
        missing value
    end if
end head

-- max :: Ord a => a -> a -> a
on max(x, y)
    if x > y then
        x
    else
        y
    end if
end max

-- min :: Ord a => a -> a -> a
on min(x, y)
    if y < x then
        y
    else
        x
    end if
end min

-- minimum :: [a] -> a
on minimum(xs)
    script min
        on |λ|(a, x)
            if x < a or a is missing value then
                x
            else
                a
            end if
        end |λ|
    end script

    foldl(min, missing value, xs)
end minimum

-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- tail :: [a] -> [a]
on tail(xs)
    if length of xs > 1 then
        items 2 thru -1 of xs
    else
        {}
    end if
end tail

-- zipWith3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
on zipWith3(f, xs, ys, zs)
    set lng to minimum({length of xs, length of ys, length of zs})
    set lst to {}
    tell mReturn(f)
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, item i of ys, item i of zs)
        end repeat
        return lst
    end tell
end zipWith3


# syntax: GAWK -f MAXIMUM_TRIANGLE_PATH_SUM.AWK filename(s)
{   printf("%s\n",$0)
    cols[FNR] = NF
    for (i=1; i<=NF; i++) {
      arr[FNR][i] = $i
    }
}
ENDFILE {
    for (row=FNR-1; row>0; row--) {
      for (col=1; col<=cols[row]; col++) {
        arr[row][col] += max(arr[row+1][col],arr[row+1][col+1])
      }
    }
    printf("%d using %s\n\n",arr[1][1],FILENAME)
    delete arr
    delete cols
}
END {
    exit(0)
}
function max(x,y) { return((x > y) ? x : y) }


(ns clojure.examples.rosetta
	(:gen-class)
        (:require [clojure.string :as string]))

(def rosetta                     "55
	                        94 48
	                       95 30 96
	                     77 71 26 67
	                    97 13 76 38 45
	                  07 36 79 16 37 68
	                 48 07 09 18 70 26 06
	               18 72 79 46 59 79 29 90
	              20 76 87 11 32 07 07 49 18
	            27 83 58 35 71 11 25 57 29 85
	           14 64 36 96 27 11 58 56 92 18 55
	         02 90 03 60 48 49 41 46 33 36 47 23
	        92 50 48 02 36 59 42 79 72 20 82 77 42
	      56 78 38 80 39 75 02 71 66 66 01 03 55 72
	     44 25 67 84 71 67 11 61 40 57 58 89 40 56 36
	   85 32 25 85 57 48 84 35 47 62 17 01 01 99 89 52
	  06 71 28 75 94 48 37 10 23 51 06 48 53 18 74 98 15
	27 02 92 23 08 71 76 84 15 52 92 63 81 10 44 10 69 93")

;; The technique is described here in more detail http://mishadoff.com/blog/clojure-euler-problem-018/
;; Most of the code converts the string data to a nested array of integers.
;; The code to calculate the max sum is then only a  single line

;; First convert string data to nested list
;;  with each inner list containing one row of the triangle
;;   [[55] [94 48] [95 30 96] ... [...10 69 93]
(defn parse-int [s]
    " Convert digits to a number (finds digits when could be surrounded by non-digits"
  (Integer. (re-find #"\d+" s)))

(defn data-int-array [s]
  " Convert string to integer array"
  (map parse-int (string/split (string/trim s) #"\s+")))

(defn nested-triangle [s]
  " Convert triangle to nested vector, with each inner vector containing one triangle row"
  (loop [lst s n 1 newlist nil]
    (if (empty? lst) (reverse newlist)
                     (recur (drop n lst) (inc n) (cons (take n lst) newlist)))))
; Create nested list
(def nested-list (nested-triangle (data-int-array rosetta)))

;; Function to compute maximum path sum
(defn max-sum [s]
  " Compute maximum path sum using a technique described here: http://mishadoff.com/blog/clojure-euler-problem-018/"
  (reduce (fn [a b] (map + b (map max a (rest a)))) (reverse s)))

; Print result
(println (max-sum nested-list))


(defun find-max-path-sum (s)
  (let ((triangle (loop for line = (read-line s NIL NIL)
                        while line
                        collect (with-input-from-string (str line)
                                  (loop for n = (read str NIL NIL)
                                        while n
                                        collect n)))))
    (flet ((get-max-of-pairs (xs)
             (maplist (lambda (ys)
                        (and (cdr ys) (max (car ys) (cadr ys))))
                      xs)))
      (car (reduce (lambda (xs ys)
                     (mapcar #'+ (get-max-of-pairs xs) ys))
                   (reverse triangle))))))

(defparameter *small-triangle*
  "    55
     94 48
    95 30 96
  77 71 26 67")
(format T "~a~%" (with-input-from-string (s *small-triangle*)
                   (find-max-path-sum s)))
(format T "~a~%" (with-open-file (f "triangle.txt")
                   (find-max-path-sum f)))


void main() {
    import std.stdio, std.algorithm, std.range, std.file, std.conv;

    "triangle.txt".File.byLine.map!split.map!(to!(int[])).array.retro
    .reduce!((x, y) => zip(y, x, x.dropOne)
                       .map!(t => t[0] + t[1 .. $].max)
                       .array)[0]
    .writeln;
}


-mode(compile).
-import(lists, [foldl/3]).

main(_) ->
   {ok, Tmat} = file:open("triangle.txt", [read, raw, {read_ahead, 16384}]),
   Max = max_sum(Tmat, []),
   io:format("The maximum total is ~b~n", [Max]).

max_sum(FD, Last) ->
    case file:read_line(FD) of
        eof -> foldl(fun erlang:max/2, 0, Last);
        {ok, Line} ->
            Current = [binary_to_integer(B) || B <- re:split(Line, "[ \n]"), byte_size(B) > 0],
            max_sum(FD, fold_row(Last, Current))
    end.

% The first argument has one more element than the second, so compute
% the initial sum so that both lists have identical length for fold_rest().
fold_row([], L) -> L;
fold_row([A|_] = Last, [B|Bs]) ->
    [A+B | fold_rest(Last, Bs)].

% Both lists must have same length
fold_rest([A], [B]) -> [A+B];
fold_rest([A1 | [A2|_] = As], [B|Bs]) -> [B + max(A1,A2) | fold_rest(As, Bs)].


USING: grouping.extras io.encodings.utf8 io.files kernel
math.order math.parser math.vectors prettyprint sequences
splitting ;
IN: rosetta-code.maximum-triangle-path-sum

: parse-triangle ( path -- seq )
    utf8 file-lines [ " " split harvest ] map
    [ [ string>number ] map ] map ;

: max-triangle-path-sum ( seq -- n )
    <reversed> unclip-slice [ swap [ max ] 2clump-map v+ ]
    reduce first ;

"triangle.txt" parse-triangle max-triangle-path-sum .


      MODULE PYRAMIDS	!Produces a pyramid of numbers in 1-D array.
       INTEGER MANY		!The usual storage issues.
       PARAMETER (MANY = 666)	!This should suffice.
       INTEGER BRICK(MANY),IN,LAYERS	!Defines a pyramid.
       CONTAINS
        SUBROUTINE IMHOTEP(PLAN)!The architect.
Counting is from the apex down, the Erich von Daniken construction.
         CHARACTER*(*) PLAN	!The instruction file.
         INTEGER I,IT		!Steppers.
         CHARACTER*666 ALINE	!A scratchpad for input.
          IN = 0		!No bricks.
          LAYERS = 0		!In no courses.
          WRITE (6,*) "Reading from ",PLAN	!Here we go.
          OPEN(10,FILE=PLAN,FORM="FORMATTED",ACTION="READ",ERR=6)	!I hope.
          GO TO 10		!Why can't OPEN be a [email protected]*&%#^%!
    6     STOP "Can't grab the file!"
Chew into the plan.
   10     READ (10,11,END = 20) ALINE	!Get the whole line in one piece.
   11     FORMAT (A)			!As plain text.
          IF (ALINE .EQ. "") GO TO 10	!Ignoring any blank lines.
          IF (ALINE(1:1).EQ."%") GO TO 10	!A comment opportunity.
          LAYERS = LAYERS + 1		!Righto, this should be the next layer.
          IF (IN + LAYERS.GT.MANY) STOP "Too many bricks!"	!Perhaps not.
          READ (ALINE,*,END = 15,ERR = 15) BRICK(IN + 1:IN + LAYERS)	!Free format.
          IN = IN + LAYERS		!Insufficient numbers will provoke trouble.
          GO TO 10			!Extra numbers/stuff will be ignored.
Caught a crab? A bad number, or too few numbers on a line? No read-next-record antics, thanks.
   15     WRITE (6,16) LAYERS,ALINE	!Just complain.
   16     FORMAT ("Bad layer ",I0,": ",A)
Completed the plan.
   20     WRITE (6,21) IN,LAYERS	!Announce some details.
   21     FORMAT (I0," bricks in ",I0," layers.")
          CLOSE(10)			!Finished with input.
Cast forth the numbers in a nice pyramid.
   30     IT = 0		!For traversing the pyramid.
          DO I = 1,LAYERS	!Each course has one more number than the one before.
            WRITE (6,31) BRICK(IT + 1:IT + I)	!Sweep along the layer.
   31       FORMAT (<LAYERS*2 - 2*I>X,666I4)	!Leading spaces may be zero in number.
            IT = IT + I				!Thus finger the last of a layer.
          END DO		!On to the start of the next layer.
        END SUBROUTINE IMHOTEP	!The pyramid's plan is ready.

        SUBROUTINE TRAVERSE	!Clamber around the pyramid. Thoroughly.
C   The idea is that a pyramid of numbers is provided, and then, starting at the peak,
c work down to the base summing the numbers at each step to find the maximum value path.
c The constraint is that from a particular brick, only the two numbers below left and below right
c may be reached in stepping to that lower layer.
c   Since that is a 0/1 choice, recorded in MOVE, a base-two scan searches the possibilities.
         INTEGER MOVE(LAYERS)		!Choices are made at the various positions.
         INTEGER STEP(LAYERS),WALK(LAYERS)	!Thus determining the path.
         INTEGER I,L,IT		!Steppers.
         INTEGER PS,WS		!Scores.
          WRITE (6,1) LAYERS		!Announce the intention.
    1     FORMAT (//,"Find the highest score path across a pyramid of ",
     1     I0," layers."/)	!I'm not worrying over singular/plural.
          MOVE = 0	!All 0/1 values to zero.
          MOVE(1) = 1	!Except the first.
          STEP(1) = 1	!Every path starts here, without option.
          WS = -666	!The best score so far.
Commence a multi-level loop, using the values of MOVE as the digits, one digit per level.
   10       IT = 1		!All paths start with the first step.
            PS = BRICK(1)	!The starting score,.
c            write (6,8) "Move",MOVE,WS
            DO L = 2,LAYERS	!Deal with the subsequent layers.
              IT = IT + L - 1 + MOVE(L)	!Choose a brick.
              STEP(L) = IT		!Remember this step.
              PS = PS + BRICK(IT)	!Count its score.
c              WRITE (6,6) L,IT,BRICK(IT),PS
    6         FORMAT ("Layer ",I0,",Brick(",I0,")=",I0,",Sum=",I0)
            END DO		!Thus is the path determined.
            IF (PS .GT. WS) THEN	!An improvement?
              IF (WS.GT.0) WRITE (6,7) WS,PS	!Yes! Announce.
    7         FORMAT ("Improved path score: ",I0," to ",I0)
              WRITE (6,8) "Moves",MOVE		!Show the choices at each layer..
              WRITE (6,8) "Steps",STEP		!That resulted in this path.
              WRITE (6,8) "Score",BRICK(STEP)	!Whose steps were scored thus.
    8         FORMAT (A8,666I4)			!This should suffice.
              WS = PS				!Record the new best value.
              WALK = STEP			!And the path thereby.
            END IF			!So much for an improvement.
            DO L = LAYERS,1,-1		!Now add one to the number in MOVE.
              IF (MOVE(L).EQ.0) THEN	!By finding the lowest order zero.
                MOVE(L) = 1		!Making it one,
                MOVE(L + 1:LAYERS) = 0	!And setting still lower orders back to zero.
                GO TO 10		!And if we did, there's more to do!
              END IF		!But if that bit wasn't zero,
            END DO		!Perhaps the next one up will be.
          WRITE (6,*) WS," is the highest score."	!So much for that.
        END SUBROUTINE TRAVERSE	!All paths considered...

        SUBROUTINE REFINE	!Ascertain the highest score without searching.
         INTEGER BEST(LAYERS)	!A scratchpad.
         INTEGER I,L		!Steppers.
          L = LAYERS*(LAYERS - 1)/2 + 1	!Finger the first brick of the lowest layer.
          BEST = BRICK(L:L + LAYERS - 1)!Syncopation. Copy the lowest layer.
          DO L = LAYERS - 1,1,-1	!Work towards the peak.
            FORALL (I = 1:L) BEST(I) = BRICK(L*(L - 1)/2 + I)	!Add to each brick's value
     1                               + MAXVAL(BEST(I:I + 1))	!The better of its two possibles.
          END DO			!On to the next layer.
          WRITE (6,*) BEST(1)," is the highest score. By some path."
        END SUBROUTINE REFINE	!Who knows how we get there.
      END MODULE PYRAMIDS

      PROGRAM TRICKLE
      USE PYRAMIDS
c      CALL IMHOTEP("Sakkara.txt")
      CALL IMHOTEP("Cheops.txt")
      CALL TRAVERSE			!Do this the definite way.
      CALL REFINE			!Only the result by more cunning.
      END


parse = map (map read . words) . lines
f x y z = x + max y z
g xs ys = zipWith3 f xs ys $ tail ys
solve = head . foldr1 g
main = readFile "triangle.txt" >>= print . solve . parse


padTri=: 0 ". ];._2                  NB. parse triangle and (implicitly) pad with zeros
maxSum=: [: {. (+ (0 ,~ 2 >./\ ]))/  NB. find max triangle path sum


import java.nio.file.*;
import static java.util.Arrays.stream;

public class MaxPathSum {

    public static void main(String[] args) throws Exception {
        int[][] data = Files.lines(Paths.get("triangle.txt"))
                .map(s -> stream(s.trim().split("\\s+"))
                        .mapToInt(Integer::parseInt)
                        .toArray())
                .toArray(int[][]::new);

        for (int r = data.length - 1; r > 0; r--)
            for (int c = 0; c < data[r].length - 1; c++)
                data[r - 1][c] += Math.max(data[r][c], data[r][c + 1]);

        System.out.println(data[0][0]);
    }
}


# Usage: TRIANGLE | solve
def solve:

  # update(next) updates the input row of maxima:
  def update(next):
    . as $maxima
    | [ range(0; next|length)
       | next[.] + ([$maxima[.], $maxima[. + 1]] | max) ];

  . as $in
  | reduce range(length -2; -1; -1) as $i
      ($in[-1];  update( $in[$i] ) ) ;


program TriSum;
{'triangle.txt'
* one element per line
55
94
48
95
30
96
...}
const
 cMaxTriHeight = 18;
 cMaxTriElemCnt = (cMaxTriHeight+1)*cMaxTriHeight DIV 2 +1;
type
  tElem = longint;
  tbaseRow =  array[0..cMaxTriHeight] of tElem;
  tmyTri   =  array[0..cMaxTriElemCnt] of tElem;

function ReadTri(     fname:string;
                  out     t:tmyTri):integer;
{read triangle values into t and returns height}
var
  f : text;
  s : string;
  i : integer;
  ValCode : word;
begin
  i := 0;
  fillchar(t,Sizeof(t),#0);

  Assign(f,fname);
  {$I-}
  reset(f);
  IF ioResult <> 0 then
  begin
    writeln('IO-Error ',ioResult);
    close(f);
    ReadTri := i;
    EXIT;
  end;
  {$I+}

  while NOT(EOF(f)) AND (i<cMaxTriElemCnt) do
  begin
    readln(f,s);
    val(s,t[i],ValCode);
    inc(i);
    IF ValCode <> 0 then
    begin
      writeln(ValCode,' conversion error at line ',i);
      fillchar(t,Sizeof(t),#0);
      i := 0;
      BREAK;
    end;
  end;
  close(f);
  ReadTri := round(sqrt(2*(i-1)));
end;

function TriMaxSum(var t: tmyTri;hei:integer):integer;
{sums up higher values bottom to top}
var
  i,r,h,tmpMax : integer;
  idxN : integer;
  sumrow : tbaseRow;
begin
  h := hei;
  idxN := (h*(h+1)) div 2 -1;
  {copy base row}
  move(t[idxN-h+1],sumrow[0],SizeOf(tElem)*h);
  dec(h);
{  for r := 0 to h do write(sumrow[r]:4);writeln;}
  idxN := idxN-h;
  while idxN >0 do
  begin
    i := idxN-h;
    r := 0;
    while r < h do
    begin
      tmpMax:= sumrow[r];
      IF tmpMax<sumrow[r+1] then
        tmpMax:=sumrow[r+1];
      sumrow[r]:= tmpMax+t[i];
      inc(i);
      inc(r);
    end;
    idxN := idxN-h;
    dec(h);
{  for r := 0 to h do write(sumrow[r]:4);writeln;}
  end;
  TriMaxSum := sumrow[0];
end;

var
  h : integer;
  triangle : tmyTri;
Begin
{  writeln(TriMaxSum(triangle,ReadTri('triangle.txt',triangle))); -> 1320}
  h := ReadTri('triangle.txt',triangle);
  writeln('height sum');
  while h > 0 do
  begin
    writeln(h:4,TriMaxSum(triangle,h):7);
    dec(h);
  end;
end.


table (+,+,+,max)
pp(Row,_Column,Tri,Sum),Row>Tri.length => Sum=0.
pp(Row,Column,Tri,Sum) ?=>
  pp(Row+1,Column,Tri,Sum1),
  Sum = Sum1+Tri[Row,Column].
pp(Row,Column,Tri,Sum) =>
  pp(Row+1,Column+1,Tri,Sum1),
  Sum = Sum1+Tri[Row,Column].


(de maxpath (Lst)
   (let (Lst (reverse Lst)  R (car Lst))
      (for I (cdr Lst)
         (setq R
            (mapcar
               +
               (maplist
                  '((L)
                     (and (cdr L) (max (car L) (cadr L))) )
                  R )
               I ) ) )
      (car R) ) )


object MaximumTrianglePathSum extends App {
    // Solution:
    def sum(triangle: Array[Array[Int]]) =
        triangle.reduceRight((upper, lower) =>
            upper zip (lower zip lower.tail)
            map {case (above, (left, right)) => above + Math.max(left, right)}
        ).head

    // Tests:
    def triangle = """
                          55
                        94 48
                       95 30 96
                     77 71 26 67
    """
    def parse(s: String) = s.trim.split("\\s+").map(_.toInt)
    def parseLines(s: String) = s.trim.split("\n").map(parse)
    def parseFile(f: String) = scala.io.Source.fromFile(f).getLines.map(parse).toArray
    println(sum(parseLines(triangle)))
    println(sum(parseFile("triangle.txt")))
}


var sum = [0]

ARGF.each {  |line|
    var x = line.words.map{.to_n}
    sum = [
            x.first + sum.first,
            1 ..^ x.end -> map{|i| x[i] + [sum[i-1, i]].max}...,
            x.last + sum.last,
          ]
}

say sum.max


import delimited triangle.txt, delim(" ") clear
mata
a = st_data(.,.)
n = rows(a)
for (i=n-1; i>=1; i--) {
	for (j=1; j<=i; j++) {
		a[i,j] = a[i,j]+max((a[i+1,j],a[i+1,j+1]))
	}
}
a[1,1]
end


package require Tcl 8.6

proc maxTrianglePathSum {definition} {
    # Parse the definition, stripping whitespace and leading zeroes.
    set lines [lmap line [split [string trim $definition] "\n"] {
	lmap val $line {scan $val %d}
    }]
    # Paths are bit strings (0 = go left, 1 = go right).
    # Enumerate the possible paths.
    set numPaths [expr {2 ** [llength $lines]}]
    for {set path 0; set max -inf} {$path < $numPaths} {incr path} {
	# Work out how much the current path costs.
	set sum [set idx [set row 0]]
	for {set bit 1} {$row < [llength $lines]} {incr row} {
	    incr sum [lindex $lines $row $idx]
	    if {$path & $bit} {incr idx}
	    set bit [expr {$bit << 1}]
	}
	# Remember the max so far.
	if {$sum > $max} {set max $sum}
    }
    return $max
}

puts [maxTrianglePathSum {
                          55
                        94 48
                       95 30 96
                     77 71 26 67
                    97 13 76 38 45
                  07 36 79 16 37 68
                 48 07 09 18 70 26 06
               18 72 79 46 59 79 29 90
              20 76 87 11 32 07 07 49 18
            27 83 58 35 71 11 25 57 29 85
           14 64 36 96 27 11 58 56 92 18 55
         02 90 03 60 48 49 41 46 33 36 47 23
        92 50 48 02 36 59 42 79 72 20 82 77 42
      56 78 38 80 39 75 02 71 66 66 01 03 55 72
     44 25 67 84 71 67 11 61 40 57 58 89 40 56 36
   85 32 25 85 57 48 84 35 47 62 17 01 01 99 89 52
  06 71 28 75 94 48 37 10 23 51 06 48 53 18 74 98 15
27 02 92 23 08 71 76 84 15 52 92 63 81 10 44 10 69 93
}]
# Reading from a file is left as an exercise…


'Solution derived from http://stackoverflow.com/questions/8002252/euler-project-18-approach.

Set objfso = CreateObject("Scripting.FileSystemObject")
Set objinfile = objfso.OpenTextFile(objfso.GetParentFolderName(WScript.ScriptFullName) &_
	"\triangle.txt",1,False)

row = Split(objinfile.ReadAll,vbCrLf)

For i = UBound(row) To 0 Step -1
	row(i) = Split(row(i)," ")
	If i < UBound(row) Then
		For j = 0 To UBound(row(i))
			If (row(i)(j) + row(i+1)(j)) > (row(i)(j) + row(i+1)(j+1)) Then
				row(i)(j) = CInt(row(i)(j)) + CInt(row(i+1)(j))
			Else
				row(i)(j) = CInt(row(i)(j)) + CInt(row(i+1)(j+1))
			End If
		Next
	End If
Next

WScript.Echo row(0)(0)

objinfile.Close
Set objfso = Nothing


tri:=File("triangle.txt").pump(List,fcn(s){ s.strip().split(" ").apply("toInt") }).copy();
while(tri.len()>1){
   t0:=tri.pop();
   t1:=tri.pop();
   tri.append( [[(it); t1.enumerate();
	'wrap([(i,t)]){ t + t0[i].max(t0[i+1]) }]])
}
tri[0][0].println();


T Optimizer
   [Int] dims
   [[Int]] m, s

   F (dims)
      .dims = dims

   F findMatrixChainOrder()
      V n = .dims.len - 1
      .m = [[0] * n] * n
      .s = [[0] * n] * n

      L(lg) 1 .< n
         L(i) 0 .< n - lg
            V j = i + lg
            .m[i][j] = 7FFF'FFFF
            L(k) i .< j
               V cost = .m[i][k] + .m[k + 1][j] + .dims[i] * .dims[k + 1] * .dims[j + 1]
               I cost < .m[i][j]
                  .m[i][j] = cost
                  .s[i][j] = k

   F optimalChainOrder(i, j)
      I i == j
         R String(Char(code' i + ‘A’.code))
      E
         R ‘(’(.optimalChainOrder(i, .s[i][j]))‘’
            ‘’(.optimalChainOrder(.s[i][j] + 1, j))‘)’

V Dims1 = [5, 6, 3, 1]
V Dims2 = [1, 5, 25, 30, 100, 70, 2, 1, 100, 250, 1, 1000, 2]
V Dims3 = [1000, 1, 500, 12, 1, 700, 2500, 3, 2, 5, 14, 10]

L(dims) [Dims1, Dims2, Dims3]
   V opt = Optimizer(dims)
   opt.findMatrixChainOrder()
   print(‘Dims:  ’dims)
   print(‘Order: ’opt.optimalChainOrder(0, dims.len - 2))
   print(‘Cost:  ’opt.m[0][dims.len - 2])
   print(‘’)


package mat_chain is
   type Vector is array (Natural range <>) of Integer;
   procedure Chain_Multiplication (Dims : Vector);
end mat_chain;


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

int **m;
int **s;

void optimal_matrix_chain_order(int *dims, int n) {
    int len, i, j, k, temp, cost;
    n--;
    m = (int **)malloc(n * sizeof(int *));
    for (i = 0; i < n; ++i) {
        m[i] = (int *)calloc(n, sizeof(int));
    }

    s = (int **)malloc(n * sizeof(int *));
    for (i = 0; i < n; ++i) {
        s[i] = (int *)calloc(n, sizeof(int));
    }

    for (len = 1; len < n; ++len) {
        for (i = 0; i < n - len; ++i) {
            j = i + len;
            m[i][j] = INT_MAX;
            for (k = i; k < j; ++k) {
                temp = dims[i] * dims[k + 1] * dims[j + 1];
                cost = m[i][k] + m[k + 1][j] + temp;
                if (cost < m[i][j]) {
                    m[i][j] = cost;
                    s[i][j] = k;
                }
            }
        }
    }
}

void print_optimal_chain_order(int i, int j) {
    if (i == j)
        printf("%c", i + 65);
    else {
        printf("(");
        print_optimal_chain_order(i, s[i][j]);
        print_optimal_chain_order(s[i][j] + 1, j);
        printf(")");
    }
}

int main() {
    int i, j, n;
    int a1[4]  = {5, 6, 3, 1};
    int a2[13] = {1, 5, 25, 30, 100, 70, 2, 1, 100, 250, 1, 1000, 2};
    int a3[12] = {1000, 1, 500, 12, 1, 700, 2500, 3, 2, 5, 14, 10};
    int *dims_list[3] = {a1, a2, a3};
    int sizes[3] = {4, 13, 12};
    for (i = 0; i < 3; ++i) {
        printf("Dims  : [");
        n = sizes[i];
        for (j = 0; j < n; ++j) {
            printf("%d", dims_list[i][j]);
            if (j < n - 1) printf(", "); else printf("]\n");
        }
        optimal_matrix_chain_order(dims_list[i], n);
        printf("Order : ");
        print_optimal_chain_order(0, n - 2);
        printf("\nCost  : %d\n\n", m[0][n - 2]);
        for (j = 0; j <= n - 2; ++j) free(m[j]);
        free(m);
        for (j = 0; j <= n - 2; ++j) free(s[j]);
        free(s);
    }
    return 0;
}


using System;

class MatrixChainOrderOptimizer {
    private int[,] m;
    private int[,] s;

    void OptimalMatrixChainOrder(int[] dims) {
        int n = dims.Length - 1;
        m = new int[n, n];
        s = new int[n, n];
        for (int len = 1; len < n; ++len) {
            for (int i = 0; i < n - len; ++i) {
                int j = i + len;
                m[i, j] = Int32.MaxValue;
                for (int k = i; k < j; ++k) {
                    int temp = dims[i] * dims[k + 1] * dims[j + 1];
                    int cost = m[i, k] + m[k + 1, j] + temp;
                    if (cost < m[i, j]) {
                        m[i, j] = cost;
                        s[i, j] = k;
                    }
                }
            }
        }
    }

    void PrintOptimalChainOrder(int i, int j) {
        if (i == j)
            Console.Write((char)(i + 65));
        else {
            Console.Write("(");
            PrintOptimalChainOrder(i, s[i, j]);
            PrintOptimalChainOrder(s[i, j] + 1, j);
            Console.Write(")");
        }
    }

    static void Main() {
        var mcoo = new MatrixChainOrderOptimizer();
        var dimsList = new int[3][];
        dimsList[0] = new int[4] {5, 6, 3, 1};
        dimsList[1] = new int[13] {1, 5, 25, 30, 100, 70, 2, 1, 100, 250, 1, 1000, 2};
        dimsList[2] = new int[12] {1000, 1, 500, 12, 1, 700, 2500, 3, 2, 5, 14, 10};
        for (int i = 0; i < dimsList.Length; ++i) {
            Console.Write("Dims  : [");
            int n = dimsList[i].Length;
            for (int j = 0; j < n; ++j) {
                Console.Write(dimsList[i][j]);
                if (j < n - 1)
                    Console.Write(", ");
                else
                    Console.WriteLine("]");
            }
            mcoo.OptimalMatrixChainOrder(dimsList[i]);
            Console.Write("Order : ");
            mcoo.PrintOptimalChainOrder(0, n - 2);
            Console.WriteLine("\nCost  : {0}\n",  mcoo.m[0, n - 2]);
        }
    }
}


module optim_mod
    implicit none
contains
    subroutine optim(a)
        implicit none
        integer :: a(:), n, i, j, k
        integer, allocatable :: u(:, :)
        integer(8) :: c
        integer(8), allocatable :: v(:, :)

        n = ubound(a, 1) - 1
        allocate (u(n, n), v(n, n))
        v = huge(v)
        u(:, 1) = -1
        v(:, 1) = 0
        do j = 2, n
            do i = 1, n - j + 1
                do k = 1, j - 1
                    c = v(i, k) + v(i + k, j - k) + int(a(i), 8) * int(a(i + k), 8) * int(a(i + j), 8)
                    if (c < v(i, j)) then
                        u(i, j) = k
                        v(i, j) = c
                    end if
                end do
            end do
        end do
        write (*, "(I0,' ')", advance="no") v(1, n)
        call aux(1, n)
        print *
        deallocate (u, v)
    contains
        recursive subroutine aux(i, j)
            integer :: i, j, k

            k = u(i, j)
            if (k < 0) then
                write (*, "(I0)", advance="no") i
            else
                write (*, "('(')", advance="no")
                call aux(i, k)
                write (*, "('*')", advance="no")
                call aux(i + k, j - k)
                write (*, "(')')", advance="no")
            end if
        end subroutine
    end subroutine
end module

program matmulchain
    use optim_mod
    implicit none

    call optim([5, 6, 3, 1])
    call optim([1, 5, 25, 30, 100, 70, 2, 1, 100, 250, 1, 1000, 2])
    call optim([1000, 1, 500, 12, 1, 700, 2500, 3, 2, 5, 14, 10])
end program


package main

import "fmt"

// PrintMatrixChainOrder prints the optimal order for chain
// multiplying matrices.
// Matrix A[i] has dimensions dims[i-1]×dims[i].
func PrintMatrixChainOrder(dims []int) {
	n := len(dims) - 1
	m, s := newSquareMatrices(n)

	// m[i,j] will be minimum number of scalar multiplactions
	// needed to compute the matrix A[i]A[i+1]…A[j] = A[i…j].
	// Note, m[i,i] = zero (no cost).
	// s[i,j] will be the index of the subsequence split that
	// achieved minimal cost.
	for lenMinusOne := 1; lenMinusOne < n; lenMinusOne++ {
		for i := 0; i < n-lenMinusOne; i++ {
			j := i + lenMinusOne
			m[i][j] = -1
			for k := i; k < j; k++ {
				cost := m[i][k] + m[k+1][j] + dims[i]*dims[k+1]*dims[j+1]
				if m[i][j] < 0 || cost < m[i][j] {
					m[i][j] = cost
					s[i][j] = k
				}
			}
		}
	}

	// Format and print result.
	const MatrixNames = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
	var subprint func(int, int)
	subprint = func(i, j int) {
		if i == j {
			return
		}
		k := s[i][j]
		subprint(i, k)
		subprint(k+1, j)
		fmt.Printf("%*s -> %s × %s%*scost=%d\n",
			n, MatrixNames[i:j+1],
			MatrixNames[i:k+1],
			MatrixNames[k+1:j+1],
			n+i-j, "", m[i][j],
		)
	}
	subprint(0, n-1)
}

func newSquareMatrices(n int) (m, s [][]int) {
	// Allocates two n×n matrices as slices of slices but
	// using only one [2n][]int and one [2n²]int backing array.
	m = make([][]int, 2*n)
	m, s = m[:n:n], m[n:]
	tmp := make([]int, 2*n*n)
	for i := range m {
		m[i], tmp = tmp[:n:n], tmp[n:]
	}
	for i := range s {
		s[i], tmp = tmp[:n:n], tmp[n:]
	}
	return m, s
}

func main() {
	cases := [...][]int{
		{1, 5, 25, 30, 100, 70, 2, 1, 100, 250, 1, 1000, 2},
		{1000, 1, 500, 12, 1, 700, 2500, 3, 2, 5, 14, 10},
	}
	for _, tc := range cases {
		fmt.Println("Dimensions:", tc)
		PrintMatrixChainOrder(tc)
		fmt.Println()
	}
}


import Data.List (elemIndex)
import Data.Char (chr, ord)
import Data.Maybe (fromJust)

mats :: [[Int]]
mats =
  [ [5, 6, 3, 1]
  , [1, 5, 25, 30, 100, 70, 2, 1, 100, 250, 1, 1000, 2]
  , [1000, 1, 500, 12, 1, 700, 2500, 3, 2, 5, 14, 10]
  ]

cost :: [Int] -> Int -> Int -> (Int, Int)
cost a i j
  | i < j =
    let m =
          [ fst (cost a i k) + fst (cost a (k + 1) j) +
           (a !! i) * (a !! (j + 1)) * (a !! (k + 1))
          | k <- [i .. j - 1] ]
        mm = minimum m
    in (mm, fromJust (elemIndex mm m) + i)
  | otherwise = (0, -1)

optimalOrder :: [Int] -> Int -> Int -> String
optimalOrder a i j
  | i < j =
    let c = cost a i j
    in "(" ++ optimalOrder a i (snd c) ++ optimalOrder a (snd c + 1) j ++ ")"
  | otherwise = [chr ((+ i) $ ord 'a')]

printBlock :: [Int] -> IO ()
printBlock v =
  let c = cost v 0 (length v - 2)
  in putStrLn
       ("for " ++
        show v ++
        " we have " ++
        show (fst c) ++
        " possibilities, z.B " ++ optimalOrder v 0 (length v - 2))

main :: IO ()
main = mapM_ printBlock mats


moo =: verb define
  s =. m =. 0 $~ ,~ n=._1+#y
  for_lmo. 1+i.<:n do.
    for_i. i. n-lmo do.
      j =. i + lmo
      m =. _ (<i;j)} m
      for_k. i+i.j-i do.
        cost =. ((<i;k){m) + ((<(k+1);j){m) + */ y {~ i,(k+1),(j+1)
        if. cost < ((<i;j){m) do.
          m =. cost (<i;j)} m
          s =. k (<i;j)} s
        end.
      end.
    end.
  end.

  m;s
)

poco =: dyad define
  'i j' =. y
   if. i=j do.
     a. {~ 65 + i      NB. 65 = a.i.'A'
   else.
     k =. x {~ <y      NB. y = i,j
     '(' , (x poco i,k) , (x poco j ,~ 1+k) , ')'
   end.
)

optMM =: verb define
  'M S' =. moo y
  smoutput 'Cost: ' , ": x: M {~ <0;_1
  smoutput 'Order: ', S poco 0 , <:#M
)


import java.util.Arrays;

public class MatrixChainMultiplication {

    public static void main(String[] args) {
        runMatrixChainMultiplication(new int[] {5, 6, 3, 1});
        runMatrixChainMultiplication(new int[] {1, 5, 25, 30, 100, 70, 2, 1, 100, 250, 1, 1000, 2});
        runMatrixChainMultiplication(new int[] {1000, 1, 500, 12, 1, 700, 2500, 3, 2, 5, 14, 10});
    }

    private static void runMatrixChainMultiplication(int[] dims) {
        System.out.printf("Array Dimension  = %s%n", Arrays.toString(dims));
        System.out.printf("Cost             = %d%n", matrixChainOrder(dims));
        System.out.printf("Optimal Multiply = %s%n%n", getOptimalParenthesizations());
    }

    private static int[][]cost;
    private static int[][]order;

    public static int matrixChainOrder(int[] dims) {
        int n = dims.length - 1;
        cost = new int[n][n];
        order = new int[n][n];

        for (int lenMinusOne = 1 ; lenMinusOne < n ; lenMinusOne++) {
            for (int i = 0; i < n - lenMinusOne; i++) {
                int j = i + lenMinusOne;
                cost[i][j] = Integer.MAX_VALUE;
                for (int k = i; k < j; k++) {
                    int currentCost = cost[i][k] + cost[k+1][j] + dims[i]*dims[k+1]*dims[j+1];
                    if (currentCost < cost[i][j]) {
                        cost[i][j] = currentCost;
                        order[i][j] = k;
                    }
                }
            }
        }
        return cost[0][n-1];
    }

    private static String getOptimalParenthesizations() {
        return getOptimalParenthesizations(order, 0, order.length - 1);
    }

    private static String getOptimalParenthesizations(int[][]s, int i, int j) {
        if (i == j) {
            return String.format("%c", i+65);
        }
        else {
            StringBuilder sb = new StringBuilder();
            sb.append("(");
            sb.append(getOptimalParenthesizations(s, i, s[i][j]));
            sb.append(" * ");
            sb.append(getOptimalParenthesizations(s, s[i][j] + 1, j));
            sb.append(")");
            return sb.toString();
        }
    }

}


F matrix_mul(m1, m2)
   assert(m1[0].len == m2.len)
   V r = [[0] * m2[0].len] * m1.len
   L(j) 0 .< m1.len
      L(i) 0 .< m2[0].len
         V s = 0
         L(k) 0 .< m2.len
            s += m1[j][k] * m2[k][i]
         r[j][i] = s
   R r

F identity(size)
   V rsize = 0 .< size
   R rsize.map(j -> @rsize.map(i -> Int(i == @j)))

F matrixExp(m, pow)
   assert(pow >= 0 & Int(pow) == pow, ‘Only non-negative, integer powers allowed’)
   V accumulator = identity(m.len)
   L(i) 0 .< pow
      accumulator = matrix_mul(accumulator, m)
   R accumulator

F printtable(data)
   L(row) data
      print(row.map(cell -> ‘#<5’.format(cell)).join(‘ ’))

V m = [[3, 2], [2, 1]]
L(i) 5
   print("\n#.:".format(i))
   printtable(matrixExp(m, i))

print("\n10:")
printtable(matrixExp(m, 10))


# Input: array of dimensions
# output: {m, s}
def optimalMatrixChainOrder:
  . as $dims
  | (($dims|length) - 1) as $n
  | reduce range(1; $n) as $len ({m: [], s: []};
      reduce range(0; $n-$len) as $i (.;
        ($i + $len) as $j
        | .m[$i][$j] = infinite
        | reduce range($i; $j) as $k (.;
            ($dims[$i] * $dims [$k + 1] * $dims[$j + 1]) as $temp
            | (.m[$i][$k] + .m[$k + 1][$j] + $temp) as $cost
            | if $cost < .m[$i][$j]
              then .m[$i][$j] = $cost
              | .s[$i][$j] = $k
              else .
	      end ) )) ;

# input: {s}
def printOptimalChainOrder($i; $j):
  if $i == $j
  then [$i + 65] | implode #=> "A", "B", ...
  else "(" +
      printOptimalChainOrder($i; .s[$i][$j]) +
      printOptimalChainOrder(.s[$i][$j] + 1; $j) + ")"
  end;

def dimsList: [
    [5, 6, 3, 1],
    [1, 5, 25, 30, 100, 70, 2, 1, 100, 250, 1, 1000, 2],
    [1000, 1, 500, 12, 1, 700, 2500, 3, 2, 5, 14, 10]
];

dimsList[]
| "Dims  : \(.)",
  (optimalMatrixChainOrder
   | "Order : \(printOptimalChainOrder(0; .s|length - 1))",
     "Cost  : \(.m[0][.s|length - 1])\n" )


module MatrixChainMultiplications

using OffsetArrays

function optim(a)
    n = length(a) - 1
    u = fill!(OffsetArray{Int}(0:n, 0:n), 0)
    v = fill!(OffsetArray{Int}(0:n, 0:n), typemax(Int))
    u[:, 1] .= -1
    v[:, 1] .= 0
    for j in 2:n, i in 1:n-j+1, k in 1:j-1
        c = v[i, k] + v[i+k, j-k] + a[i] * a[i+k] * a[i+j]
        if c < v[i, j]
            u[i, j] = k
            v[i, j] = c
        end
    end
    return v[1, n], aux(u, 1, n)
end

function aux(u, i, j)
    k = u[i, j]
    if k < 0
        return sprint(print, i)
    else
        return sprint(print, '(', aux(u, i, k), '×', aux(u, i + k, j - k), ")")
    end
end

end  # module MatrixChainMultiplications


// Version 1.2.31

lateinit var m: List<IntArray>
lateinit var s: List<IntArray>

fun optimalMatrixChainOrder(dims: IntArray) {
    val n = dims.size - 1
    m = List(n) { IntArray(n) }
    s = List(n) { IntArray(n) }
    for (len in 1 until n) {
        for (i in 0 until n - len) {
            val j = i + len
            m[i][j] = Int.MAX_VALUE
            for (k in i until j) {
                val temp = dims[i] * dims [k + 1] * dims[j + 1]
                val cost = m[i][k] + m[k + 1][j] + temp
                if (cost < m[i][j]) {
                    m[i][j] = cost
                    s[i][j] = k
                }
            }
        }
    }
}

fun printOptimalChainOrder(i: Int, j: Int) {
    if (i == j)
        print("${(i + 65).toChar()}")
    else {
        print("(")
        printOptimalChainOrder(i, s[i][j])
        printOptimalChainOrder(s[i][j] + 1, j)
        print(")")
    }
}

fun main(args: Array<String>) {
    val dimsList = listOf(
        intArrayOf(5, 6, 3, 1),
        intArrayOf(1, 5, 25, 30, 100, 70, 2, 1, 100, 250, 1, 1000, 2),
        intArrayOf(1000, 1, 500, 12, 1, 700, 2500, 3, 2, 5, 14, 10)
    )
    for (dims in dimsList) {
        println("Dims  : ${dims.asList()}")
        optimalMatrixChainOrder(dims)
        print("Order : ")
        printOptimalChainOrder(0, s.size - 1)
        println("\nCost  : ${m[0][s.size - 1]}\n")
    }
}


with Ada.Text_IO;  use Ada.Text_IO;

procedure Test_Matrix is
   generic
      type Element is private;
      Zero : Element;
      One  : Element;
      with function "+" (A, B : Element) return Element is <>;
      with function "*" (A, B : Element) return Element is <>;
      with function Image (X : Element) return String is <>;
   package Matrices is
      type Matrix is array (Integer range <>, Integer range <>) of Element;
      function "*" (A, B : Matrix) return Matrix;
      function "**" (A : Matrix; Power : Natural) return Matrix;
      procedure Put (A : Matrix);
   end Matrices;

   package body Matrices is
      function "*" (A, B : Matrix) return Matrix is
         R   : Matrix (A'Range (1), B'Range (2));
         Sum : Element := Zero;
      begin
         for I in R'Range (1) loop
            for J in R'Range (2) loop
               Sum := Zero;
               for K in A'Range (2) loop
                  Sum := Sum + A (I, K) * B (K, J);
               end loop;
               R (I, J) := Sum;
            end loop;
         end loop;
         return R;
      end "*";

      function "**" (A : Matrix; Power : Natural) return Matrix is
      begin
         if Power = 1 then
            return A;
         end if;
         declare
            R : Matrix (A'Range (1), A'Range (2)) := (others => (others => Zero));
            P : Matrix  := A;
            E : Natural := Power;
         begin
            for I in P'Range (1) loop -- R is identity matrix
               R (I, I) := One;
            end loop;
            if E = 0 then
               return R;
            end if;
            loop
               if E mod 2 /= 0 then
                  R := R * P;
               end if;
               E := E / 2;
               exit when E = 0;
               P := P * P;
            end loop;
            return R;
         end;
      end "**";

      procedure Put (A : Matrix) is
      begin
         for I in A'Range (1) loop
            for J in A'Range (1) loop
               Put (Image (A (I, J)));
            end loop;
            New_Line;
         end loop;
      end Put;
   end Matrices;

   package Integer_Matrices is new Matrices (Integer, 0, 1, Image => Integer'Image);
   use Integer_Matrices;

   M : Matrix (1..2, 1..2) := ((3,2),(2,1));
begin
   Put_Line ("M =");       Put (M);
   Put_Line ("M**0 =");    Put (M**0);
   Put_Line ("M**1 =");    Put (M**1);
   Put_Line ("M**2 =");    Put (M**2);
   Put_Line ("M*M =");     Put (M*M);
   Put_Line ("M**3 =");    Put (M**3);
   Put_Line ("M*M*M =");   Put (M*M*M);
   Put_Line ("M**4 =");    Put (M**4);
   Put_Line ("M*M*M*M ="); Put (M*M*M*M);
   Put_Line ("M**10 =");   Put (M**10);
   Put_Line ("M*M*M*M*M*M*M*M*M*M ="); Put (M*M*M*M*M*M*M*M*M*M);
end Test_Matrix;


-- Matrix A[i] has dimension dims[i-1] x dims[i] for i = 1..n
local function MatrixChainOrder(dims)
    local m = {}
    local s = {}
    local n = #dims - 1;
    -- m[i,j] = Minimum number of scalar multiplications (i.e., cost)
    -- needed to compute the matrix A[i]A[i+1]...A[j] = A[i..j]
    -- The cost is zero when multiplying one matrix
    for i = 1,n do
        m[i] = {}
        m[i][i] = 0
        s[i] = {}
    end

    for len = 2,n do -- Subsequence lengths
        for i = 1,(n - len + 1) do
            local j = i + len - 1
            m[i][j] = math.maxinteger
            for k = i,(j - 1) do
                local cost = m[i][k] + m[k+1][j] + dims[i]*dims[k+1]*dims[j+1];
                if (cost < m[i][j]) then
                    m[i][j] = cost;
                    s[i][j] = k; --Index of the subsequence split that achieved minimal cost
                end
            end
        end
    end
    return m,s
end

local function printOptimalChainOrder(s)
    local function find_path(start,finish)
        local chainOrder = ""
        if (start == finish) then
            chainOrder = chainOrder .."A"..start
        else
            chainOrder = chainOrder .."(" ..
                         find_path(start,s[start][finish]) ..
                         find_path(s[start][finish]+1,finish) .. ")"
        end
        return chainOrder
    end
    print("Order : "..find_path(1,#s))
end

local dimsList = {{5, 6, 3, 1},{1, 5, 25, 30, 100, 70, 2, 1, 100, 250, 1, 1000, 2},{1000, 1, 500, 12, 1, 700, 2500, 3, 2, 5, 14, 10}}

for k,dim in ipairs(dimsList) do
    io.write("Dims  : [")
    for v=1,(#dim-1) do
        io.write(dim[v]..", ")
    end
    print(dim[#dim].."]")
    local m,s = MatrixChainOrder(dim)
    printOptimalChainOrder(s)
    print("Cost  : "..tostring(m[1][#s]).."\n")
end


INT default upb=3;
MODE VEC = [default upb]COSCAL;
MODE MAT = [default upb,default upb]COSCAL;

OP * = (VEC a,b)COSCAL: (
    COSCAL result:=0;
    FOR i FROM LWB a TO UPB a DO result+:= a[i]*b[i] OD;
    result
  );

OP * = (VEC a, MAT b)VEC: ( # overload vec times matrix #
    [2 LWB b:2 UPB b]COSCAL result;
    FOR j FROM 2 LWB b TO 2 UPB b DO result[j]:=a*b[,j] OD;
    result
  );

OP * = (MAT a, b)MAT: ( # overload matrix times matrix #
    [LWB a:UPB a, 2 LWB b:2 UPB b]COSCAL result;
    FOR k FROM LWB result TO UPB result DO result[k,]:=a[k,]*b OD;
    result
  );

OP IDENTITY = (INT upb)MAT:(
  [upb,upb] COSCAL out;
  FOR i TO upb DO
    FOR j TO upb DO
      out[i,j]:= ( i=j |1|0)
    OD
  OD;
  out
);


      DIM matrix(1,1), output(1,1)
      matrix() = 3, 2, 2, 1

      FOR power% = 0 TO 9
        PROCmatrixpower(matrix(), output(), power%)
        PRINT "matrix()^" ; power% " = "
        FOR row% = 0 TO DIM(output(), 1)
          FOR col% = 0 TO DIM(output(), 2)
            PRINT output(row%,col%);
          NEXT
          PRINT
        NEXT row%
      NEXT power%
      END

      DEF PROCmatrixpower(src(), dst(), pow%)
      LOCAL i%
      dst() = 0
      FOR i% = 0 TO DIM(dst(), 1) : dst(i%,i%) = 1 : NEXT
      IF pow% THEN
        FOR i% = 1 TO pow%
          dst() = dst() . src()
        NEXT
      ENDIF
      ENDPROC


function [r,s] = optim(a)
    n = length(a)-1;
    u = zeros(n,n);
    v = ones(n,n)*inf;
    u(:,1) = -1;
    v(:,1) = 0;
    for j = 2:n
        for i = 1:n-j+1
            for k = 1:j-1
                c = v(i,k)+v(i+k,j-k)+a(i)*a(i+k)*a(i+j);
                if c<v(i,j)
                    u(i,j) = k;
                    v(i,j) = c;
                end
            end
        end
    end
    r = v(1,n);
    s = aux(u,1,n);
end

function s = aux(u,i,j)
    k = u(i,j);
    if k<0
        s = sprintf("%d",i);
    else
        s = sprintf("(%s*%s)",aux(u,i,k),aux(u,i+k,j-k));
    end
end


import sequtils

type Optimizer = object
  dims: seq[int]
  m: seq[seq[Natural]]
  s: seq[seq[Natural]]

proc initOptimizer(dims: openArray[int]): Optimizer =
  ## Create an optimizer for the given dimensions.
  Optimizer(dims: @dims)

proc findMatrixChainOrder(opt: var Optimizer) =
  ## Find the best order for matrix chain multiplication.

  let n = opt.dims.high
  opt.m = newSeqWith(n, newSeq[Natural](n))
  opt.s = newSeqWith(n, newSeq[Natural](n))

  for lg in 1..<n:
    for i in 0..<(n - lg):
      let j = i + lg
      opt.m[i][j] = Natural.high
      for k in i..<j:
        let cost = opt.m[i][k] + opt.m[k+1][j] + opt.dims[i] * opt.dims[k+1] * opt.dims[j+1]
        if cost < opt.m[i][j]:
          opt.m[i][j] = cost
          opt.s[i][j] = k

proc optimalChainOrder(opt: Optimizer; i, j: Natural): string =
  ## Return the optimal chain order as a string.
  if i == j:
    result.add chr(i + ord('A'))
  else:
    result.add '('
    result.add opt.optimalChainOrder(i, opt.s[i][j])
    result.add opt.optimalChainOrder(opt.s[i][j] + 1, j)
    result.add ')'

when isMainModule:

  const
    Dims1 = @[5, 6, 3, 1]
    Dims2 = @[1, 5, 25, 30, 100, 70, 2, 1, 100, 250, 1, 1000, 2]
    Dims3 = @[1000, 1, 500, 12, 1, 700, 2500, 3, 2, 5, 14, 10]

  for dims in [Dims1, Dims2, Dims3]:
    var opt = initOptimizer(dims)
    opt.findMatrixChainOrder()
    echo "Dims:  ", dims
    echo "Order: ", opt.optimalChainOrder(0, dims.len - 2)
    echo "Cost:  ", opt.m[0][dims.len - 2]
    echo ""


MatMul ← +˝∘×⎉1‿∞

MatEx ← {𝕨 MatMul⍟(𝕩-1) 𝕨}

(>⟨3‿2
   2‿1⟩) MatEx 1‿2‿3‿4‿10


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

typedef struct squareMtxStruct {
    int   dim;
    double *cells;
    double **m;
} *SquareMtx;

/* function for initializing row r of a new matrix */
typedef void (*FillFunc)( double *cells, int r, int dim, void *ff_data);

SquareMtx NewSquareMtx( int dim, FillFunc fillFunc, void *ff_data )
{
    SquareMtx sm = malloc(sizeof(struct squareMtxStruct));
    if (sm) {
        int rw;
        sm->dim = dim;
        sm->cells = malloc(dim*dim * sizeof(double));
        sm->m = malloc( dim * sizeof(double *));
        if ((sm->cells != NULL) && (sm->m != NULL)) {
            for (rw=0; rw<dim; rw++) {
                sm->m[rw] = sm->cells + dim*rw;
                fillFunc( sm->m[rw], rw, dim, ff_data );
            }
        }
        else {
            free(sm->m);
            free(sm->cells);
            free(sm);
            printf("Square Matrix allocation failure\n");
            return NULL;
        }
    }
    else {
        printf("Malloc failed for square matrix\n");
    }
    return sm;
}

void ffMatxSquare( double *cells, int rw, int dim, SquareMtx m0 )
{
    int col, ix;
    double sum;
    double *m0rw = m0->m[rw];

    for (col = 0; col < dim; col++) {
        sum = 0.0;
        for (ix=0; ix<dim; ix++)
            sum += m0rw[ix] * m0->m[ix][col];
        cells[col] = sum;
    }
}

void ffMatxMulply( double *cells, int rw, int dim, SquareMtx mplcnds[] )
{
    SquareMtx mleft = mplcnds[0];
    SquareMtx mrigt = mplcnds[1];
    double sum;
    double *m0rw = mleft->m[rw];
    int col, ix;

    for (col = 0; col < dim; col++) {
        sum = 0.0;
        for (ix=0; ix<dim; ix++)
            sum += m0rw[ix] * mrigt->m[ix][col];
        cells[col] = sum;
    }
}

void MatxMul( SquareMtx mr, SquareMtx left, SquareMtx rigt)
{
    int rw;
    SquareMtx mplcnds[2];
    mplcnds[0] = left; mplcnds[1] = rigt;

    for (rw = 0; rw < left->dim; rw++)
        ffMatxMulply( mr->m[rw], rw, left->dim, mplcnds);
}

void ffIdentity( double *cells, int rw, int dim, void *v )
{
    int col;
    for (col=0; col<dim; col++) cells[col] = 0.0;
    cells[rw] = 1.0;
}
void ffCopy(double *cells, int rw, int dim, SquareMtx m1)
{
    int col;
    for (col=0; col<dim; col++) cells[col] = m1->m[rw][col];
}

void FreeSquareMtx( SquareMtx m )
{
    free(m->m);
    free(m->cells);
    free(m);
}

SquareMtx SquareMtxPow( SquareMtx m0, int exp )
{
    SquareMtx v0 = NewSquareMtx(m0->dim, ffIdentity, NULL);
    SquareMtx v1 = NULL;
    SquareMtx base0 = NewSquareMtx( m0->dim, ffCopy, m0);
    SquareMtx base1 = NULL;
    SquareMtx mplcnds[2], t;

    while (exp) {
        if (exp % 2) {
            if (v1)
                MatxMul( v1, v0, base0);
            else  {
                mplcnds[0] = v0; mplcnds[1] = base0;
                v1 = NewSquareMtx(m0->dim, ffMatxMulply, mplcnds);
            }
            {t = v0; v0=v1; v1 = t;}
        }
        if (base1)
            MatxMul( base1, base0, base0);
        else
            base1 = NewSquareMtx( m0->dim, ffMatxSquare, base0);
        t = base0; base0 = base1; base1 = t;
        exp = exp/2;
    }
    if (base0) FreeSquareMtx(base0);
    if (base1) FreeSquareMtx(base1);
    if (v1) FreeSquareMtx(v1);
    return v0;
}

FILE *fout;
void SquareMtxPrint( SquareMtx mtx, const char *mn )
{
    int rw, col;
    int d = mtx->dim;

    fprintf(fout, "%s dim:%d =\n", mn, mtx->dim);

    for (rw=0; rw<d; rw++) {
        fprintf(fout, " |");
        for(col=0; col<d; col++)
            fprintf(fout, "%8.5f ",mtx->m[rw][col] );
        fprintf(fout, " |\n");
    }
    fprintf(fout, "\n");
}

void fillInit( double *cells, int rw, int dim, void *data)
{
    double theta = 3.1415926536/6.0;
    double c1 = cos( theta);
    double s1 = sin( theta);

    switch(rw) {
    case 0:
        cells[0]=c1; cells[1]=s1; cells[2]=0.0;
        break;
    case 1:
        cells[0]=-s1; cells[1]=c1; cells[2]=0;
        break;
    case 2:
        cells[0]=0.0; cells[1]=0.0; cells[2]=1.0;
        break;
    }
}

int main()
{
    SquareMtx m0 = NewSquareMtx( 3, fillInit, NULL);
    SquareMtx m1 = SquareMtxPow( m0, 5);
    SquareMtx m2 = SquareMtxPow( m0, 9);
    SquareMtx m3 = SquareMtxPow( m0, 2);

//  fout = stdout;
    fout = fopen("matrx_exp.txt", "w");
    SquareMtxPrint(m0, "m0"); FreeSquareMtx(m0);
    SquareMtxPrint(m1, "m0^5"); FreeSquareMtx(m1);
    SquareMtxPrint(m2, "m0^9"); FreeSquareMtx(m2);
    SquareMtxPrint(m3, "m0^2"); FreeSquareMtx(m3);
    fclose(fout);

    return 0;
}


use strict;
use feature 'say';

sub matrix_mult_chaining {
    my(@dimensions) = @_;
    my(@cp,@path);

    # a matrix never needs to be multiplied with itself, so it has cost 0
    $cp[$_][$_] = 0 for keys @dimensions;

    my $n = $#dimensions;
    for my $chain_length (1..$n) {
        for my $start (0 .. $n - $chain_length - 1) {
            my $end = $start + $chain_length;
            $cp[$end][$start] = 10e10;
            for my $step ($start .. $end - 1) {
                my $new_cost = $cp[$step][$start]
                             + $cp[$end][$step + 1]
                             + $dimensions[$start] * $dimensions[$step+1] * $dimensions[$end+1];
                if ($new_cost < $cp[$end][$start]) {
                    $cp[$end][$start] = $new_cost; # cost
                    $cp[$start][$end] = $step;     # path
                }
            }
       }
    }

    $cp[$n-1][0] . ' ' . find_path(0, $n-1, @cp);
}

sub find_path {
    my($start,$end,@cp) = @_;
    my $result;

    if ($start == $end) {
        $result .= 'A' . ($start + 1);
    } else {
        $result .= '(' .
                   find_path($start, $cp[$start][$end], @cp) .
                   find_path($cp[$start][$end] + 1, $end, @cp) .
                   ')';
    }
    return $result;
}

say matrix_mult_chaining(<1 5 25 30 100 70 2 1 100 250 1 1000 2>);
say matrix_mult_chaining(<1000 1 500 12 1 700 2500 3 2 5 14 10>);


using System;
using System.Collections;
using System.Collections.Generic;
using static System.Linq.Enumerable;

public static class MatrixExponentation
{
    public static double[,] Identity(int size) {
        double[,] matrix = new double[size, size];
        for (int i = 0; i < size; i++) matrix[i, i] = 1;
        return matrix;
    }

    public static double[,] Multiply(this double[,] left, double[,] right) {
        if (left.ColumnCount() != right.RowCount()) throw new ArgumentException();
        double[,] m = new double[left.RowCount(), right.ColumnCount()];
        foreach (var (row, column) in from r in Range(0, m.RowCount()) from c in Range(0, m.ColumnCount()) select (r, c)) {
            m[row, column] = Range(0, m.RowCount()).Sum(i => left[row, i] * right[i, column]);
        }
        return m;
    }

    public static double[,] Pow(this double[,] matrix, int exp) {
        if (matrix.RowCount() != matrix.ColumnCount()) throw new ArgumentException("Matrix must be square.");
        double[,] accumulator = Identity(matrix.RowCount());
        for (int i = 0; i < exp; i++) {
            accumulator = accumulator.Multiply(matrix);
        }
        return accumulator;
    }

    private static int RowCount(this double[,] matrix) => matrix.GetLength(0);
    private static int ColumnCount(this double[,] matrix) => matrix.GetLength(1);

    private static void Print(this double[,] m) {
        foreach (var row in Rows()) {
            Console.WriteLine("[ " + string.Join("   ", row) + " ]");
        }
        Console.WriteLine();

        IEnumerable<IEnumerable<double>> Rows() =>
            Range(0, m.RowCount()).Select(row => Range(0, m.ColumnCount()).Select(column => m[row, column]));
    }

    public static void Main() {
        var matrix = new double[,] {
            { 3, 2 },
            { 2, 1 }
        };

        matrix.Pow(0).Print();
        matrix.Pow(1).Print();
        matrix.Pow(2).Print();
        matrix.Pow(3).Print();
        matrix.Pow(4).Print();
        matrix.Pow(50).Print();
    }

}


with javascript_semantics
function optimal_chain_order(int i, int j, sequence s)
    if i==j then
        return i+'A'-1
    end if
    return "("&optimal_chain_order(i,s[i,j],s)
              &optimal_chain_order(s[i,j]+1,j,s)&")"
end function

function optimal_matrix_chain_order(sequence dims)
    integer n = length(dims)-1
    sequence m = repeat(repeat(0,n),n),
             s = deep_copy(m)
    for len=2 to n do
        for i=1 to n-len+1 do
            integer j = i+len-1
            m[i][j] = -1
            for k=i to j-1 do
                atom cost := m[i][k] + m[k+1][j] + dims[i]*dims[k+1]*dims[j+1]
                if m[i][j]<0
                or cost<m[i][j] then
                    m[i][j] = cost;
                    s[i][j] = k;
                end if
            end for
        end for
    end for
    return {optimal_chain_order(1,n,s),m[1,n]}
end function

constant tests = {{5, 6, 3, 1},
                  {1, 5, 25, 30, 100, 70, 2, 1, 100, 250, 1, 1000, 2},
                  {1000, 1, 500, 12, 1, 700, 2500, 3, 2, 5, 14, 10}}
for i=1 to length(tests) do
    sequence ti = tests[i]
    printf(1,"Dims  : %s\n",{sprint(ti)})
    printf(1,"Order : %s\nCost  : %d\n",optimal_matrix_chain_order(ti))
end for


#include <complex>
#include <cmath>
#include <iostream>
using namespace std;

template<int MSize = 3, class T = complex<double> >
class SqMx {
  typedef T Ax[MSize][MSize];
  typedef SqMx<MSize, T> Mx;

private:
  Ax a;
  SqMx() { }

public:
  SqMx(const Ax &_a) { // constructor with pre-defined array
    for (int r = 0; r < MSize; r++)
      for (int c = 0; c < MSize; c++)
        a[r][c] = _a[r][c];
  }

  static Mx identity() {
    Mx m;
    for (int r = 0; r < MSize; r++)
      for (int c = 0; c < MSize; c++)
        m.a[r][c] = (r == c ? 1 : 0);
    return m;
  }

  friend ostream &operator<<(ostream& os, const Mx &p)
  { // ugly print
    for (int i = 0; i < MSize; i++) {
      for (int j = 0; j < MSize; j++)
        os << p.a[i][j] << ',';
      os << endl;
    }
    return os;
  }

  Mx operator*(const Mx &b) {
    Mx d;
    for (int r = 0; r < MSize; r++)
      for (int c = 0; c < MSize; c++) {
        d.a[r][c] = 0;
        for (int k = 0; k < MSize; k++)
          d.a[r][c] += a[r][k] * b.a[k][c];
      }
    return d;
  }


def parens(n):
    def aux(n, k):
        if n == 1:
            yield k
        elif n == 2:
            yield [k, k + 1]
        else:
            a = []
            for i in range(1, n):
                for u in aux(i, k):
                    for v in aux(n - i, k + i):
                        yield [u, v]
    yield from aux(n, 0)


proc **(a, e) {
    // create result matrix of same dimensions
    var r:[a.domain] a.eltType;
    // and initialize to identity matrix
    forall ij in r.domain do
        r(ij) = if ij(1) == ij(2) then 1 else 0;

    for 1..e do
        r *= a;

    return r;
}


(defun multiply-matrices (matrix-0 matrix-1)
  "Takes two 2D arrays and returns their product, or an error if they cannot be multiplied"
  (let* ((m0-dims (array-dimensions matrix-0))
         (m1-dims (array-dimensions matrix-1))
         (m0-dim (length m0-dims))
         (m1-dim (length m1-dims)))
    (if (or (/= 2 m0-dim) (/= 2 m1-dim))
        (error "Array given not a matrix")
        (let ((m0-rows (car m0-dims))
              (m0-cols (cadr m0-dims))
              (m1-rows (car m1-dims))
              (m1-cols (cadr m1-dims)))
          (if (/= m0-cols m1-rows)
              (error "Incompatible dimensions")
              (do ((rarr (make-array (list m0-rows m1-cols)
                                     :initial-element 0) rarr)
                   (n 0 (if (= n (1- m0-cols)) 0 (1+ n)))
                   (cc 0 (if (= n (1- m0-cols))
                             (if (/= cc (1- m1-cols))
                                 (1+ cc) 0) cc))
                   (cr 0 (if (and (= (1- m0-cols) n)
                                  (= (1- m1-cols) cc))
                             (1+ cr)
                             cr)))
                  ((= cr m0-rows) rarr)
                (setf (aref rarr cr cc)
                      (+ (aref rarr cr cc)
                         (* (aref matrix-0 cr n)
                            (aref matrix-1 n cc))))))))))

(defun matrix-identity (dim)
  "Creates a new identity matrix of size dim*dim"
  (do ((rarr (make-array (list dim dim)
                         :initial-element 0) rarr)
       (n 0 (1+ n)))
      ((= n dim) rarr)
    (setf (aref rarr n n) 1)))

(defun matrix-expt (matrix exp)
  "Takes the first argument (a matrix) and multiplies it by itself exp times"
  (let* ((m-dims (array-dimensions matrix))
         (m-rows (car m-dims))
         (m-cols (cadr m-dims)))
    (cond
      ((/= m-rows m-cols) (error "Non-square matrix"))
      ((zerop exp) (matrix-identity m-rows))
      ((= 1 exp) (do ((rarr (make-array (list m-rows m-cols)) rarr)
                      (cc 0 (if (= cc (1- m-cols))
                                0
                                (1+ cc)))
                      (cr 0 (if (= cc (1- m-cols))
                                (1+ cr)
                                cr)))
                     ((= cr m-rows) rarr)
                   (setf (aref rarr cr cc) (aref matrix cr cc))))
      ((zerop (mod exp 2)) (let ((me2 (matrix-expt matrix (/ exp 2))))
                             (multiply-matrices me2 me2)))
      (t (let ((me2 (matrix-expt matrix (/ (1- exp) 2))))
           (multiply-matrices matrix (multiply-matrices me2 me2)))))))


#lang racket

(define (memoize f)
  (define table (make-hash))
  (λ args (hash-ref! table args (thunk (apply f args)))))

(struct $ (cost expl))
(define @ vector-ref)

(define (+: #:combine [combine (thunk* #f)] . xs)
  ($ (apply + (map $-cost xs)) (apply combine (map $-expl xs))))

(define (min: . xs) (argmin $-cost xs))

(define (compute dims)
  (define loop
    (memoize
     (λ (left right)
       (cond
         [(= 1 (- right left)) ($ 0 left)]
         [else (for/fold ([ans ($ +inf.0 #f)]) ([mid (in-range (add1 left) right)])
                 (min: ans (+: (loop left mid) (loop mid right)
                               ($ (* (@ dims left) (@ dims mid) (@ dims right)) #f)
                               #:combine (λ (left-answer right-answer _)
                                           (list left-answer '× right-answer)))))]))))
  (loop 0 (sub1 (vector-length dims))))


sub matrix-mult-chaining(@dimensions) {
    my @cp;
    # @cp has a dual function:
    # * the upper triangle of the diagonal matrix stores the cost (c) for
    #   multiplying matrices $i and $j in @cp[$j][$i], where $j > $i
    # * the lower triangle stores the path (p) that was used for the lowest cost
    #   multiplication to get from $i to $j.

    # a matrix never needs to be multiplied with itself, so it has cost 0
    @cp[$_][$_] = 0 for @dimensions.keys;
    my @path;

    my $n = @dimensions.end;
    for 1 .. $n -> $chain-length {
        for 0 .. $n - $chain-length - 1 -> $start {
            my $end = $start + $chain-length;
            @cp[$end][$start] = Inf;  # until we find a better connection
            for $start .. $end - 1 -> $step {
                my $new-cost = @cp[$step][$start]
                             + @cp[$end][$step + 1]
                             + [*] @dimensions[$start, $step+1, $end+1];
                if $new-cost < @cp[$end][$start] {
                    @cp[$end][$start] = $new-cost; # cost
                    @cp[$start][$end] = $step;     # path
                }
            }
       }
    }

    sub find-path(Int $start, Int $end) {
        if $start == $end {
            take 'A' ~ ($start + 1);
        } else {
            take '(';
            find-path($start, @cp[$start][$end]);
            find-path(@cp[$start][$end] + 1, $end);
            take ')';
        }
    }

   return @cp[$n-1][0], gather { find-path(0, $n - 1) }.join;
}

say matrix-mult-chaining(<1 5 25 30 100 70 2 1 100 250 1 1000 2>);
say matrix-mult-chaining(<1000 1 500 12 1 700 2500 3 2 5 14 10>);


import std.stdio, std.string, std.math, std.array, std.algorithm;

struct SquareMat(T = creal) {
    public static string fmt = "%8.3f";
    private alias TM = T[][];
    private TM a;

    public this(in size_t side) pure nothrow @safe
    in {
        assert(side > 0);
    } body {
        a = new TM(side, side);
    }

    public this(in TM m) pure nothrow @safe
    in {
        assert(!m.empty);
        assert(m.all!(row => row.length == m.length)); // Is square.
    } body {
        // 2D dup.
        a.length = m.length;
        foreach (immutable i, const row; m)
            a[i] = row.dup;
    }

    string toString() const @safe {
        return format("<%(%(" ~ fmt ~ ", %)\n %)>", a);
    }

    public static SquareMat identity(in size_t side) pure nothrow @safe {
        auto m = SquareMat(side);
        foreach (immutable r, ref row; m.a)
            foreach (immutable c; 0 .. side)
                row[c] = (r == c) ? 1+0i : 0+0i;
        return m;
    }

    public SquareMat opBinary(string op:"*")(in SquareMat other)
    const pure nothrow @safe in {
        assert (a.length == other.a.length);
    } body {
        immutable side = other.a.length;
        auto d = SquareMat(side);
        foreach (immutable r; 0 .. side)
            foreach (immutable c; 0 .. side) {
                d.a[r][c] = 0+0i;
                foreach (immutable k, immutable ark; a[r])
                    d.a[r][c] += ark * other.a[k][c];
            }
        return d;
    }

    public SquareMat opBinary(string op:"^^")(int n) // The task part.
    const pure nothrow @safe in {
        assert(n >= 0, "Negative exponent not implemented.");
    } body {
        auto sq = SquareMat(this.a);
        auto d = SquareMat.identity(a.length);
        for (; n > 0; sq = sq * sq, n >>= 1)
            if (n & 1)
                d = d * sq;
        return d;
    }
}

void main() {
    alias M = SquareMat!();
    enum real q = 0.5.sqrt;
    immutable m = M([[   q + 0*1.0Li,    q + 0*1.0Li, 0.0L + 0.0Li],
                     [0.0L - q*1.0Li, 0.0L + q*1.0Li, 0.0L + 0.0Li],
                     [0.0L +   0.0Li, 0.0L +   0.0Li, 0.0L + 1.0Li]]);
    M.fmt = "%5.2f";
    foreach (immutable p; [0, 1, 23, 24])
        writefln("m ^^ %d =\n%s", p, m ^^ p);
}


use std::collections::HashMap;

fn main() {
    println!("{}\n", mcm_display(vec![5, 6, 3, 1]));
    println!(
        "{}\n",
        mcm_display(vec![1, 5, 25, 30, 100, 70, 2, 1, 100, 250, 1, 1000, 2])
    );
    println!(
        "{}\n",
        mcm_display(vec![1000, 1, 500, 12, 1, 700, 2500, 3, 2, 5, 14, 10])
    );
}

fn mcm_display(dims: Vec<i32>) -> String {
    let mut costs: HashMap<Vec<i32>, (i32, Vec<usize>)> = HashMap::new();
    let mut line = format!("Dims : {:?}\n", dims);
    let ans = mcm(dims, &mut costs);
    let mut mats = (1..=ans.1.len() + 1)
        .map(|x| x.to_string())
        .collect::<Vec<String>>();
    for i in 0..ans.1.len() {
        let mat_taken = mats[ans.1[i]].clone();
        mats.remove(ans.1[i]);
        mats[ans.1[i]] = "(".to_string() + &mat_taken + "*" + &mats[ans.1[i]] + ")";
    }
    line += &format!("Order: {}\n", mats[0]);
    line += &format!("Cost : {}", ans.0);
    line
}

fn mcm(dims: Vec<i32>, costs: &mut HashMap<Vec<i32>, (i32, Vec<usize>)>) -> (i32, Vec<usize>) {
    match costs.get(&dims) {
        Some(c) => c.clone(),
        None => {
            let ans = if dims.len() == 3 {
                (dims[0] * dims[1] * dims[2], vec![0])
            } else {
                let mut min_cost = std::i32::MAX;
                let mut min_path = Vec::new();
                for i in 1..dims.len() - 1 {
                    let taken = dims[(i - 1)..(i + 2)].to_vec();
                    let mut rest = dims[..i].to_vec();
                    rest.extend_from_slice(&dims[(i + 1)..]);
                    let a1 = mcm(taken, costs);
                    let a2 = mcm(rest, costs);
                    if a1.0 + a2.0 < min_cost {
                        min_cost = a1.0 + a2.0;
                        min_path = vec![i - 1];
                        min_path.extend_from_slice(&a2.1);
                    }
                }
                (min_cost, min_path)
            };
            costs.insert(dims, ans.clone());
            ans
        }
    }
}


mata
struct ans {
	real scalar p,q,s
	string scalar u
}

struct ans scalar function aux(n,k) {
	external dim,opt
	struct ans scalar r,r1,r2
	real scalar s,i

	if (n==1) {
		r.p = dim[k]
		r.q = dim[k+1]
		r.s = 0
		r.u = strofreal(k)
		return(r)
	} else if (n==2) {
		r.p = dim[k]
		r.q = dim[k+2]
		r.s = r.p*r.q*dim[k+1]
		r.u = sprintf("(%f*%f)",k,k+1)
		return(r)
	} else if (asarray_contains(opt,(n,k))) {
		return(asarray(opt,(n,k)))
	} else {
		r.p = dim[k]
		r.q = dim[k+n]
		r.s = .
		for (i=1; i<n; i++) {
			r1 = aux(i,k)
			r2 = aux(n-i,k+i)
			s = r1.s+r2.s+r1.p*r1.q*r2.q
			if (s<r.s) {
				r.s = s
				r.u = sprintf("(%s*%s)",r1.u,r2.u)
			}
		}
		asarray(opt,(n,k),r)
		return(r)
	}
}

function optim(a) {
	external dim,opt
	struct ans scalar r
	real scalar t

	timer_clear()
	dim = a
	opt = asarray_create("real",2)
	timer_on(1)
	r = aux(length(a)-1,1)
	timer_off(1)
	t = timer_value(1)[1]
	printf("%10.0f %10.0f %s\n",t*1000,r.s,r.u)
}

optim((1,5,25,30,100,70,2,1,100,250,1,1000,2))
optim((1000,1,500,12,1,700,2500,3,2,5,14,10))
end


Option Explicit
Option Base 1
Dim N As Long, U() As Long, V() As Long
Sub Optimize(A As Variant)
    Dim I As Long, J As Long, K As Long, C As Long
    N = UBound(A) - 1
    ReDim U(N, N), V(N, N)
    For I = 1 To N
        U(I, 1) = -1
        V(I, 1) = 0
    Next I

    For J = 2 To N
        For I = 1 To N - J + 1
            V(I, J) = &H7FFFFFFF
            For K = 1 To J - 1
                C = V(I, K) + V(I + K, J - K) + A(I) * A(I + K) * A(I + J)
                If C < V(I, J) Then
                    U(I, J) = K
                    V(I, J) = C
                End If
            Next K
        Next I
    Next J

    Debug.Print V(1, N);
    Call Aux(1, N)
    Debug.Print
    Erase U, V
End Sub
Sub Aux(I As Long, J As Long)
    Dim K As Long
    K = U(I, J)
    If K < 0 Then
        Debug.Print CStr(I);
    Else
        Debug.Print "(";
        Call Aux(I, K)
        Debug.Print "*";
        Call Aux(I + K, J - K)
        Debug.Print ")";
    End If
End Sub
Sub Test()
    Call Optimize(Array(5, 6, 3, 1))
    Call Optimize(Array(1, 5, 25, 30, 100, 70, 2, 1, 100, 250, 1, 1000, 2))
    Call Optimize(Array(1000, 1, 500, 12, 1, 700, 2500, 3, 2, 5, 14, 10))
End Sub


program Matrix_exponentiation_operator;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

type
  TCells = array of array of double;

  TMatrix = record
  private
    FCells: TCells;
    function GetCells(r, c: Integer): Double;
    procedure SetCells(r, c: Integer; const Value: Double);
    class operator Implicit(a: TMatrix): string;
    class operator BitwiseXor(a: TMatrix; e: Integer): TMatrix;
    class operator Multiply(a: TMatrix; b: TMatrix): TMatrix;
  public
    constructor Create(w, h: integer); overload;
    constructor Create(c: TCells); overload;
    constructor Ident(size: Integer);
    function Rows: Integer;
    function Columns: Integer;
    property Cells[r, c: Integer]: Double read GetCells write SetCells; default;
  end;

{ TMatrix }

constructor TMatrix.Create(c: TCells);
begin
  Create(Length(c), Length(c[0]));
  FCells := c;
end;

constructor TMatrix.Create(w, h: integer);
begin
  SetLength(FCells, w, h);
end;

class operator TMatrix.BitwiseXor(a: TMatrix; e: Integer): TMatrix;
begin
  if e < 0 then
    raise Exception.Create('Matrix inversion not implemented');

  Result.Ident(a.Rows);
  while e > 0 do
  begin
    Result := Result * a;
    dec(e);
  end;
end;

function TMatrix.Rows: Integer;
begin
  Result := Length(FCells);
end;

function TMatrix.Columns: Integer;
begin
  Result := 0;
  if Rows > 0 then
    Result := Length(FCells);
end;

function TMatrix.GetCells(r, c: Integer): Double;
begin
  Result := FCells[r, c];
end;

constructor TMatrix.Ident(size: Integer);
var
  i: Integer;
begin
  Create(size, size);

  for i := 0 to size - 1 do
    Cells[i, i] := 1;
end;

class operator TMatrix.Implicit(a: TMatrix): string;
var
  i, j: Integer;
begin
  Result := '[';
  if a.Rows > 0 then
    for i := 0 to a.Rows - 1 do
    begin
      if i > 0 then
        Result := Trim(Result) + ']'#10'[';
      for j := 0 to a.Columns - 1 do
      begin
        Result := Result + Format('%f', [a[i, j]]) + ' ';
      end;
    end;
  Result := trim(Result) + ']';
end;

class operator TMatrix.Multiply(a, b: TMatrix): TMatrix;
var
  size: Integer;
  r: Integer;
  c: Integer;
  k: Integer;
begin
  if (a.Rows <> b.Rows) or (a.Columns <> b.Columns) then
    raise Exception.Create('The matrix must have same size');

  size := a.Rows;
  Result.Create(size, size);

  for r := 0 to size - 1 do
    for c := 0 to size - 1 do
    begin
      Result[r, c] := 0;
      for k := 0 to size - 1 do
        Result[r, c] := Result[r, c] + a[r, k] * b[k, c];
    end;
end;

procedure TMatrix.SetCells(r, c: Integer; const Value: Double);
begin
  FCells[r, c] := Value;
end;

var
  M: TMatrix;

begin
  M.Create([[3, 2], [2, 1]]);
// Delphi don't have a ** and can't override ^ operator, then XOR operator was used
  Writeln(string(M xor 0), #10);
  Writeln(string(M xor 1), #10);
  Writeln(string(M xor 2), #10);
  Writeln(string(M xor 3), #10);
  Writeln(string(M xor 4), #10);
  Writeln(string(M xor 50), #10);
  Readln;
end.


var m = []
var s = []

var optimalMatrixChainOrder = Fn.new { |dims|
    var n = dims.count - 1
    m = List.filled(n, null)
    s = List.filled(n, null)
    for (i in 0...n) {
        m[i] = List.filled(n, 0)
        s[i] = List.filled(n, 0)
    }
    for (len in 1...n) {
        for (i in 0...n-len) {
            var j = i + len
            m[i][j] = 1/0
            for (k in i...j) {
                var temp = dims[i] * dims [k + 1] * dims[j + 1]
                var cost = m[i][k] + m[k + 1][j] + temp
                if (cost < m[i][j]) {
                    m[i][j] = cost
                    s[i][j] = k
                }
            }
        }
    }
}

var printOptimalChainOrder
printOptimalChainOrder = Fn.new { |i, j|
    if (i == j) {
        System.write(String.fromByte(i + 65))
    } else {
        System.write("(")
        printOptimalChainOrder.call(i, s[i][j])
        printOptimalChainOrder.call(s[i][j] + 1, j)
        System.write(")")
    }
}

var dimsList = [
    [5, 6, 3, 1],
    [1, 5, 25, 30, 100, 70, 2, 1, 100, 250, 1, 1000, 2],
    [1000, 1, 500, 12, 1, 700, 2500, 3, 2, 5, 14, 10]
]
for (dims in dimsList) {
    System.print("Dims  : %(dims)")
    optimalMatrixChainOrder.call(dims)
    System.write("Order : ")
    printOptimalChainOrder.call(0, s.count - 1)
    System.print("\nCost  : %(m[0][s.count - 1])\n")
}


                               10
This example calculates | 3 2 |
                        | 2 1 |


USING: kernel math math.matrices sequences ;

: my-m^n ( m n -- m' )
    dup 0 < [ "no negative exponents" throw ] [
        [ drop length identity-matrix ]
        [ swap '[ _ m. ] times ] 2bi
    ] if ;


fcn optim3(a){	     // list --> (int,list)
   aux:=fcn(n,k,a){  // (int,int,list) --> (int,int,int,list)
      if(n==1){
	 p,q := a[k,2];
	 return(0,p,q,k);
      }
      if(n==2){
	 p,q,r := a[k,3];
	 return(p*q*r, p, r, T(k,k+1));
      }
      m,p,q,u := Void, a[k], a[k + n], Void;
      foreach i in ([1..n-1]){
      #if 0	// 0.70 sec for both tests
	 s1,p1,q1,u1 := self.fcn(i,k,a);
	 s2,p2,q2,u2 := self.fcn(n - i, k + i, a);
      #else	// 0.33 sec for both tests
	 s1,p1,q1,u1 := memoize(self.fcn, i,k,a);
	 s2,p2,q2,u2 := memoize(self.fcn, n - i, k + i, a);
      #endif
	 _assert_(q1==p2);
	 s:=s1 + s2 + p1*q1*q2;
	 if((Void==m) or (s<m)) m,u = s,T(u1,u2);
      }
      return(m,p,q,u);
   };

   h=Dictionary();		// reset memoize
   s,_,_,u := aux(a.len() - 1, 0,a);
   return(s,u);
}

var h;		// a Dictionary, set/reset in optim3()
fcn memoize(f,n,k,a){
   key:="%d,%d".fmt(n,k);	// Lists make crappy keys
   if(r:=h.find(key)) return(r);
   r:=f(n,k,a);
   h[key]=r;
   return(r);
}


module matmod
  implicit none

! Overloading the ** operator does not work because the compiler cannot
! differentiate between matrix exponentiation and the elementwise raising
! of an array to a power therefore we define a new operator
  interface operator (.matpow.)
    module procedure matrix_exp
  end interface

contains

function matrix_exp(m, n) result (res)
  real, intent(in)  :: m(:,:)
  integer, intent(in)  :: n
  real :: res(size(m,1),size(m,2))
  integer :: i

  if(n == 0) then
    res = 0
    do i = 1, size(m,1)
      res(i,i) = 1
    end do
    return
  end if

  res = m
  do i = 2, n
    res = matmul(res, m)
  end do

end function matrix_exp
end module matmod

program Matrix_exponentiation
  use matmod
  implicit none

  integer, parameter :: n = 3
  real, dimension(n,n) :: m1, m2
  integer :: i, j

  m1 = reshape((/ (i, i = 1, n*n) /), (/ n, n /), order = (/ 2, 1 /))

  do i = 0, 4
    m2 = m1 .matpow. i
    do j = 1, size(m2,1)
      write(*,*) m2(j,:)
    end do
    write(*,*)
  end do

end program Matrix_exponentiation


#include once "matmult.bas"
#include once "rowech.bas"
#include once "matinv.bas"

operator ^ (byval M as Matrix, byval n as integer ) as Matrix
    dim as uinteger i, j, k = ubound( M.m, 1 )
    if n < 0 then return matinv(M) ^ (-n)
    if n = 0 then return M * matinv(M)
    return (M ^ (n-1)) * M
end operator

dim as Matrix M = Matrix(2,2), Q
dim as integer i, j, n
M.m(0,0) = 1./3 : M.m(0,1) = 2./3
M.m(1,0) = 2./7 : M.m(1,1) = 5./7

for n = -2 to 4
    Q = (M ^ n)
    for i = 0 to 1
        for j = 0 to 1
            print Q.m(i, j),
        next j
        print
    next i
    print
next n


package main

import "fmt"

type vector = []float64
type matrix []vector

func (m1 matrix) mul(m2 matrix) matrix {
    rows1, cols1 := len(m1), len(m1[0])
    rows2, cols2 := len(m2), len(m2[0])
    if cols1 != rows2 {
        panic("Matrices cannot be multiplied.")
    }
    result := make(matrix, rows1)
    for i := 0; i < rows1; i++ {
        result[i] = make(vector, cols2)
        for j := 0; j < cols2; j++ {
            for k := 0; k < rows2; k++ {
                result[i][j] += m1[i][k] * m2[k][j]
            }
        }
    }
    return result
}

func identityMatrix(n int) matrix {
    if n < 1 {
        panic("Size of identity matrix can't be less than 1")
    }
    ident := make(matrix, n)
    for i := 0; i < n; i++ {
        ident[i] = make(vector, n)
        ident[i][i] = 1
    }
    return ident
}

func (m matrix) pow(n int) matrix {
    le := len(m)
    if le != len(m[0]) {
        panic("Not a square matrix")
    }
    switch {
    case n < 0:
        panic("Negative exponents not supported")
    case n == 0:
        return identityMatrix(le)
    case n == 1:
        return m
    }
    pow := identityMatrix(le)
    base := m
    e := n
    for e > 0 {
        if (e & 1) == 1 {
            pow = pow.mul(base)
        }
        e >>= 1
        base = base.mul(base)
    }
    return pow
}

func main() {
    m := matrix{{3, 2}, {2, 1}}
    for i := 0; i <= 10; i++ {
        fmt.Println("** Power of", i, "**")
        fmt.Println(m.pow(i))
        fmt.Println()
    }
}


import Data.List (transpose)

(<+>)
  :: Num a
  => [a] -> [a] -> [a]
(<+>) = zipWith (+)

(<*>)
  :: Num a
  => [a] -> [a] -> a
(<*>) = (sum .) . zipWith (*)

newtype Mat a =
  Mat [[a]]
  deriving (Eq, Show)

instance Num a =>
         Num (Mat a) where
  negate (Mat x) = Mat $ map (map negate) x
  Mat x + Mat y = Mat $ zipWith (<+>) x y
  Mat x * Mat y =
    Mat
      [ [ xs Main.<*> ys -- Main prefix to distinguish fron applicative operator
        | ys <- transpose y ]
      | xs <- x ]
  abs = undefined
  fromInteger _ = undefined -- don't know dimension of the desired matrix
  signum = undefined

-- TEST ----------------------------------------------------------------------
main :: IO ()
main = print $ Mat [[1, 2], [0, 1]] ^ 4


mp=: +/ .*   NB. Matrix multiplication
pow=: pow0=: 4 : 'mp&x^:y =i.#x'


// IdentityMatrix is a "subclass" of Matrix
function IdentityMatrix(n) {
    this.height = n;
    this.width = n;
    this.mtx = [];
    for (var i = 0; i < n; i++) {
        this.mtx[i] = [];
        for (var j = 0; j < n; j++) {
            this.mtx[i][j] = (i == j ? 1 : 0);
        }
    }
}
IdentityMatrix.prototype = Matrix.prototype;

// the Matrix exponentiation function
// returns a new matrix
Matrix.prototype.exp = function(n) {
    var result = new IdentityMatrix(this.height);
    for (var i = 1; i <= n; i++) {
        result = result.mult(this);
    }
    return result;
}

var m = new Matrix([[3, 2], [2, 1]]);
[0,1,2,3,4,10].forEach(function(e){print(m.exp(e)); print()})


# produce an array of length n that is 1 at i and 0 elsewhere
def indicator(i;n): [range(0;n) | 0] | .[i] = 1;

# Identity matrix:
def identity(n): reduce range(0;n) as $i ([]; . + [indicator( $i; n )] );

def direct_matrix_exp(n):
  . as $in
  | if n == 0 then identity($in|length)
    else reduce range(1;n) as $i ($in; . as $m | multiply($m; $in))
    end;

def matrix_exp(n):
  if n < 4 then direct_matrix_exp(n)
  else . as $in
  | ((n|2)|floor) as $m
  | matrix_exp($m) as $ans
  | multiply($ans;$ans) as $ans
  | (n - (2 * $m) ) as $residue
  | if $residue == 0 then $ans
    else matrix_exp($residue) as $residue
    | multiply($ans; $residue )
    end
  end;


/Matrix Exponentiation
/mpow.k
pow: {:[0=y; :({a=/:a:!x}(#x))];a: x; do[y-1; a: x _mul a]; :a}


// 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 identityMatrix(n: Int): Matrix {
    require(n >= 1)
    val ident = Matrix(n) { Vector(n) }
    for (i in 0 until n) ident[i][i] = 1.0
    return ident
}

infix fun Matrix.pow(n : Int): Matrix {
    require (n >= 0 && this.size == this[0].size)
    if (n == 0) return identityMatrix(this.size)
    if (n == 1) return this
    var pow = identityMatrix(this.size)
    var base = this
    var e = n
    while (e > 0) {
        if ((e and 1) == 1) pow *= base
        e = e shr 1
        base *= base
    }
    return pow
}

fun printMatrix(m: Matrix, n: Int) {
    println("** Power of $n **")
    for (i in 0 until m.size) println(m[i].contentToString())
    println()
}

fun main(args: Array<String>) {
    val m = arrayOf(
        doubleArrayOf(3.0, 2.0),
        doubleArrayOf(2.0, 1.0)
    )
    for (i in 0..10) printMatrix(m pow i, i)
}


MatrixD$ ="3, 3,          0.86603,  0.50000,  0.00000,     -0.50000,  0.86603,  0.00000,     0.00000,  0.00000,  1.00000"

print "Exponentiation of a matrix"
call DisplayMatrix MatrixD$
print "         Raised to power 5 ="
MatrixE$ =MatrixToPower$( MatrixD$, 5)
call DisplayMatrix MatrixE$
print "         Raised to power 9 ="
MatrixE$ =MatrixToPower$( MatrixD$, 9)
call DisplayMatrix MatrixE$


Matrix = {}

function Matrix.new( dim_y, dim_x )
    assert( dim_y and dim_x )

    local matrix = {}
    local metatab = {}
    setmetatable( matrix, metatab )
    metatab.__add = Matrix.Add
    metatab.__mul = Matrix.Mul
    metatab.__pow = Matrix.Pow

    matrix.dim_y = dim_y
    matrix.dim_x = dim_x

    matrix.data = {}
    for i = 1, dim_y do
        matrix.data[i] = {}
    end
    return matrix
end

function Matrix.Show( m )
    for i = 1, m.dim_y do
        for j = 1, m.dim_x do
            io.write( tostring( m.data[i][j] ), " " )
        end
        io.write( "\n" )
    end
end

function Matrix.Add( m, n )
    assert( m.dim_x == n.dim_x and m.dim_y == n.dim_y )

    local r = Matrix.new( m.dim_y, m.dim_x )
    for i = 1, m.dim_y do
        for j = 1, m.dim_x do
            r.data[i][j] = m.data[i][j] + n.data[i][j]
        end
    end
    return r
end

function Matrix.Mul( m, n )
    assert( m.dim_x == n.dim_y )

    local r = Matrix.new( m.dim_y, n.dim_x )
    for i = 1, m.dim_y do
        for j = 1, n.dim_x do
            r.data[i][j] = 0
            for k = 1, m.dim_x do
                r.data[i][j] = r.data[i][j] + m.data[i][k] * n.data[k][j]
            end
        end
    end
    return r
end

function Matrix.Pow( m, p )
    assert( m.dim_x == m.dim_y )

    local r = Matrix.new( m.dim_y, m.dim_x )

    if p == 0 then
        for i = 1, m.dim_y do
            for j = 1, m.dim_x do
                if i == j then
                    r.data[i][j] = 1
                else
                    r.data[i][j] = 0
                end
            end
        end
    elseif p == 1 then
        for i = 1, m.dim_y do
            for j = 1, m.dim_x do
                r.data[i][j] = m.data[i][j]
            end
        end
    else
        r = m
        for i = 2, p do
            r = r * m
        end
    end

    return r
end

m = Matrix.new( 2, 2 )
m.data = { { 1, 2 }, { 3, 4 } }

n = m^4;

Matrix.Show( n )


Module CheckIt {
	Class cArray {
		a=(,)
		Function Power(n as integer){
			cArr=This     ' create a copy
			dim new()
			new()=cArr.a   ' get a pointer from a to new()
			Let cArr.a=new()    ' now new() return a copy
			cArr.a*=0  ' make zero all elements
			link cArr.a to v()
			for i=dimension(cArr.a,1,0) to dimension(cArr.a, 1,1) : v(i,i)=1: next i
			while n>0
				let cArr=cArr*this    ' * is the operator "*"
				n--
			end while
			=cArr
		}
		Operator "*"{
			Read cArr
			b=cArr.a
			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)
			.a<=c()
			}
		Module Print {
			link .a to v()
			for i=dimension(.a,1,0) to dimension(.a, 1,1)
			for j=dimension(.a,2,0) to dimension(.a, 2,1)
			print  v(i,j),: next j: print : next i

		}
	Class:
		\\ this module used as constructor, and not returned to final group (user object in M2000)
		Module cArray (r) {
			c=r
			Dim a(r,c)
			For i=0 to r-1 : For j=0 to c-1: Read a(i,j): Next j : Next i
			.a<=a()
		}
	}
	Print "matrix():"
	P=cArray(2,3,2,2,1)
	P.Print
	For i=0 to 9
		Print "matrix()^"+str$(i,0)+"="
		K=P.Power(i)
		K.Print
	next i
}
Checkit


a = {{3, 2}, {4, 1}};
MatrixPower[a, 0]
MatrixPower[a, 1]
MatrixPower[a, -1]
MatrixPower[a, 4]
MatrixPower[a, 1/2]
MatrixPower[a, Pi]


function [output] = matrixexponentiation(matrixA, exponent)
   output = matrixA^(exponent);


import sequtils, strutils

type Matrix[N: static int; T] = array[1..N, array[1..N, T]]

func `*`[N, T](a, b: Matrix[N, T]): Matrix[N, T] =
  for i in 1..N:
    for j in 1..N:
      for k in 1..N:
        result[i][j] += a[i][k] * b[k][j]

func identityMatrix[N; T](): Matrix[N, T] =
  for i in 1..N:
    result[i][i] = T(1)

func `^`[N, T](m: Matrix[N, T]; n: Natural): Matrix[N, T] =
  if n == 0: return identityMatrix[N, T]()
  if n == 1: return m
  var n = n
  var m = m
  result = identityMatrix[N, T]()
  while n > 0:
    if (n and 1) != 0:
      result = result * m
    n = n shr 1
    m = m * m

proc `$`(m: Matrix): string =
  var lg = 0
  for i in 1..m.N:
    for j in 1..m.N:
      lg = max(lg, len($m[i][j]))
  for i in 1..m.N:
    echo m[i].mapIt(align($it, lg)).join(" ")

when isMainModule:

  let m1: Matrix[3, int] = [[ 3, 2, -1],
                            [-1, 0,  5],
                            [ 2, -1, 3]]
  echo m1^10

  import math
  const
    C30 = sqrt(3.0) / 2
    S30 = 1 / 2
  let m2: Matrix[2, float] = [[C30, -S30], [S30,  C30]]  # 30° rotation matrix.
  echo m2^12    # Nearly the identity matrix.


(* identity matrix *)
let eye n =
  let a = Array.make_matrix n n 0.0 in
  for i=0 to n-1 do
    a.(i).(i) <- 1.0
  done;
  (a)
;;

(* matrix dimensions *)
let dim a = Array.length a, Array.length a.(0);;

(* make matrix from list in row-major order *)
let matrix p q v =
  if (List.length v) <> (p * q)
  then failwith "bad dimensions"
  else
    let a = Array.make_matrix p q (List.hd v) in
    let rec g i j = function
    | [] -> a
    | x::v ->
        a.(i).(j) <- x;
        if j+1 < q
        then g i (j+1) v
        else g (i+1) 0 v
    in
    g 0 0 v
;;

(* matrix product *)
let matmul a b =
  let n, p = dim a
  and q, r = dim b in
  if p <> q then failwith "bad dimensions" else
  let c = Array.make_matrix n r 0.0 in
  for i=0 to n-1 do
    for j=0 to r-1 do
      for k=0 to p-1 do
        c.(i).(j) <- c.(i).(j) +. a.(i).(k) *. b.(k).(j)
      done
    done
  done;
  (c)
;;

(* generic exponentiation, usual algorithm *)
let pow one mul a n =
  let rec g p x = function
  | 0 -> x
  | i ->
      g (mul p p) (if i mod 2 = 1 then mul p x else x) (i/2)
  in
  g a one n
;;

(* example with integers *)
pow 1 ( * ) 2 16;;
(* - : int = 65536 *)


use strict;
package SquareMatrix;
use Carp;                       # standard, "it's not my fault" module

use overload (
        '""'    => \&_string,   # overload string operator so we can just print
        '*'     => \&_mult,     # multiplication, needed for expo
        '*='    => \&_mult,     # ditto, explicitly defined to trigger copy
        '**'    => \&_expo,     # overload exponentiation
        '='     => \&_copy,     # copy operator
);

sub make {
        my $cls = shift;
        my $n = @_;
        for (@_) {
                # verify each row given is the right length
                confess "Bad data @$_: matrix must be square "
                        if @$_ != $n;
        }

        bless [ map [@$_], @_ ] # important: actually copy all the rows
}

sub identity {
        my $self = shift;
        my $n = @$self - 1;
        my @rows = map [ (0) x $_, 1, (0) x ($n - $_) ], 0 .. $n;
        bless \@rows
}

sub zero {
        my $self = shift;
        my $n = @$self;
        bless [ map [ (0) x $n ], 1 .. $n ]
}

sub _string {
        "[ ".join("\n  " =>
                map join(" " => map(sprintf("%12.6g", $_), @$_)), @{+shift}
        )."  ]\n";
}

sub _mult {
        my ($a, $b) = @_;
        my $x = $a->zero;
        my @idx = (0 .. $#$x);
        for my $j (@idx) {
                my @col = map($a->[$_][$j], @idx);
                for my $i (@idx) {
                        my $row = $b->[$i];
                        $x->[$i][$j] += $row->[$_] * $col[$_] for @idx;
                }
        }
        $x
}

sub _expo {
        my ($self, $n) = @_;
        confess "matrix **: must be non-negative integer power"
                        unless $n >= 0 && $n == int($n);

        my ($tmp, $out) = ($self, $self->identity);
        do {
                $out *= $tmp    if $n & 1;
                $tmp *= $tmp;
        } while $n >>= 1;

        $out
}

sub _copy { bless [ map [ @$_ ], @{+shift} ] }

# now use our matrix class
package main;

my $m = SquareMatrix->make(
                [1, 2, 0],
                [0, 3, 1],
                [1, 0, 0] );
print "### Order $_\n", $m ** $_        for 0 .. 10;

$m = SquareMatrix->make(
        [ 1.0001, 0,      0, 1       ],
        [ 0,      1.001,  0, 0       ],
        [ 0,      0,      1, 0.99998 ],
        [ 1e-8,   0,      0, 1.0002  ]);

print "\n### Matrix is now\n",  $m;
print "\n### Big power:\n",     $m ** 100_000;
print "\n### Too big:\n",       $m ** 1_000_000;
print "\n### WAY too big:\n",   $m ** 1_000_000_000_000;
print "\n### But identity matrix can handle that\n",
                $m->identity ** 1_000_000_000_000;


with javascript_semantics
function identity(integer n)
    sequence res = repeat(repeat(0,n),n)
    for i=1 to n do
        res[i][i] = 1
    end for
    return res
end function

function matrix_mul(sequence a, b)
    integer {ha,wa,hb,wb} = apply({a,a[1],b,b[1]},length)
    if wa!=hb then return 0 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

function matrix_exponent(sequence m, integer n)
    integer l = length(m)
    if n=0 then return identity(l) end if
    sequence res = m
    for i=2 to n do
        res = matrix_mul(res,m)
    end for
    return res
end function

constant M1 = {{5}},
         M2 = {{3, 2},
               {2, 1}},
         M3 = {{1, 2, 0},
               {0, 3, 1},
               {1, 0, 0}}

ppOpt({pp_Nest,1})
pp(matrix_exponent(M1,0))
pp(matrix_exponent(M1,1))
pp(matrix_exponent(M1,2))
puts(1,"==\n")
pp(matrix_exponent(M2,0))
pp(matrix_exponent(M2,1))
pp(matrix_exponent(M2,2))
pp(matrix_exponent(M2,10))
puts(1,"==\n")
pp(matrix_exponent(M3,10))
puts(1,"==\n")
pp(matrix_exponent(identity(4),5))


(de matIdent (N)
   (let L (need N (1) 0)
      (mapcar '(() (copy (rot L))) L) ) )

(de matExp (Mat N)
   (let M (matIdent (length Mat))
      (do N
         (setq M (matMul M Mat)) )
      M ) )

(matExp '((3 2) (2 1)) 3)


>>> from operator import mul
>>> def matrixMul(m1, m2):
  return map(
    lambda row:
      map(
        lambda *column:
          sum(map(mul, row, column)),
        *m2),
    m1)

>>> def identity(size):
	size = range(size)
	return [[(i==j)*1 for i in size] for j in size]

>>> def matrixExp(m, pow):
	assert pow>=0 and int(pow)==pow, "Only non-negative, integer powers allowed"
	accumulator = identity(len(m))
	for i in range(pow):
		accumulator = matrixMul(accumulator, m)
	return accumulator

>>> def printtable(data):
	for row in data:
		print ' '.join('%-5s' % ('%s' % cell) for cell in row)

>>> m = [[3,2], [2,1]]
>>> for i in range(5):
	print '\n%i:' % i
	printtable( matrixExp(m, i) )

0:
1     0
0     1

1:
3     2
2     1

2:
13    8
8     5

3:
55    34
34    21

4:
233   144
144   89
>>> printtable( matrixExp(m, 10) )
1346269 832040
832040 514229
>>>


subset SqMat of Array where { .elems == all(.[]».elems) }

multi infix:<*>(SqMat $a, SqMat $b) {[
    for ^$a -> $r {[
        for ^$b[0] -> $c {
            [+] ($a[$r][] Z* $b[].map: *[$c])
        }
    ]}
]}

multi infix:<**> (SqMat $m, Int $n is copy where { $_ >= 0 }) {
    my $tmp = $m;
    my $out = [for ^$m -> $i { [ for ^$m -> $j { +($i == $j) } ] } ];
    loop {
        $out = $out * $tmp if $n +& 1;
        last unless $n +>= 1;
        $tmp = $tmp * $tmp;
    }

    $out;
}

multi show (SqMat $m) {
    my $size = $m.map( *.list».chars ).flat.max;
    say .fmt("%{$size}s", ' ') for $m.list;
}

my @m = [1, 2, 0],
        [0, 3, 1],
        [1, 0, 0];

for 0 .. 10 -> $order {
    say "### Order $order";
    show @m ** $order;
}


use std::fmt;
use std::ops;
const WIDTH: usize = 6;

#[derive(Clone)]
struct SqMat {
    data: Vec<Vec<i64>>,
}

impl fmt::Debug for SqMat {
    fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
        let mut row = "".to_string();
        for i in &self.data {
            for j in i {
                row += &format!("{:>w$} ", j, w = WIDTH);
            }
            row += &"\n";
        }
        write!(f, "{}", row)
    }
}

impl ops::BitXor<u32> for SqMat {
    type Output = Self;

    fn bitxor(self, n: u32) -> Self::Output {
        let mut aux = self.data.clone();
        let mut ans: SqMat = SqMat {
            data: vec![vec![0; aux.len()]; aux.len()],
        };
        for i in 0..aux.len() {
            ans.data[i][i] = 1;
        }
        let mut b = n;
        while b > 0 {
            if b & 1 > 0 {
                // ans = ans * aux
                let mut tmp = aux.clone();
                for i in 0..aux.len() {
                    for j in 0..aux.len() {
                        tmp[i][j] = 0;
                        for k in 0..aux.len() {
                            tmp[i][j] += ans.data[i][k] * aux[k][j];
                        }
                    }
                }
                ans.data = tmp;
            }
            b >>= 1;
            if b > 0 {
                // aux = aux * aux
                let mut tmp = aux.clone();
                for i in 0..aux.len() {
                    for j in 0..aux.len() {
                        tmp[i][j] = 0;
                        for k in 0..aux.len() {
                            tmp[i][j] += aux[i][k] * aux[k][j];
                        }
                    }
                }
                aux = tmp;
            }
        }
        ans
    }
}

fn main() {
    let sm: SqMat = SqMat {
        data: vec![vec![1, 2, 0], vec![0, 3, 1], vec![1, 0, 0]],
    };
    for i in 0..11 {
        println!("Power of {}:\n{:?}", i, sm.clone() ^ i);
    }
}


class Matrix[T](matrix:Array[Array[T]])(implicit n: Numeric[T], m: ClassManifest[T])
{
  import n._
  val rows=matrix.size
  val cols=matrix(0).size
  def row(i:Int)=matrix(i)
  def col(i:Int)=matrix map (_(i))

  def *(other: Matrix[T]):Matrix[T] = new Matrix(
    Array.tabulate(rows, other.cols)((row, col) =>
      (this.row(row), other.col(col)).zipped.map(_*_) reduceLeft (_+_)
  ))

  def **(x: Int)=x match {
    case 0 => createIdentityMatrix
    case 1 => this
    case 2 => this * this
    case _ => List.fill(x)(this) reduceLeft (_*_)
  }

  def createIdentityMatrix=new Matrix(Array.tabulate(rows, cols)((row,col) =>
    if (row == col) one else zero)
  )

  override def toString = matrix map (_.mkString("[", ", ", "]")) mkString "\n"
}

object MatrixTest {
  def main(args:Array[String])={
    val m=new Matrix[BigInt](Array(Array(3,2), Array(2,1)))
    println("-- m --\n"+m)

    Seq(0,1,2,3,4,10,20,50) foreach {x =>
      println("-- m**"+x+" --")
      println(m**x)
    }
  }
}


(define (dec x)
  (- x 1))

(define (halve x)
  (/ x 2))

(define (row*col row col)
  (apply + (map * row col)))

(define (matrix-multiply m1 m2)
  (map
    (lambda (row)
      (apply map (lambda col (row*col row col))
        m2))
    m1))

(define (matrix-exp mat exp)
  (cond ((= exp 1) mat)
        ((even? exp) (square-matrix (matrix-exp mat (halve exp))))
        (else (matrix-multiply mat (matrix-exp mat (dec exp))))))

(define (square-matrix mat)
  (matrix-multiply mat mat))