Add tasks for all the new languages

Task/LU-decomposition/EchoLisp/lu-decomposition.echolisp

@@ -0,0 +1,38 @@
+(lib 'matrix) ;; the matrix library provides LU-decomposition
+(decimals 5)
+
+(define A (list->array' (1 3 5 2 4 7 1 1 0 ) 3 3))
+(define PLU (matrix-lu-decompose A)) ;; -> list of three matrices, P, Lower, Upper
+
+(array-print (first PLU))
+0  1  0
+1  0  0
+0  0  1
+(array-print (second PLU))
+1    0   0
+0.5  1   0
+0.5  -1  1
+(array-print (caddr PLU))
+2  4  7
+0  1  1.5
+0  0  -2
+
+(define A (list->array '(11 9 24 2 1 5 2 6 3 17 18 1 2 5 7 1 ) 4 4))
+(define PLU (matrix-lu-decompose A)) ;; -> list of three matrices, P, Lower, Upper
+(array-print (first PLU))
+1  0  0  0
+0  0  1  0
+0  1  0  0
+0  0  0  1
+
+(array-print (second PLU))
+1        0        0       0
+0.27273  1        0       0
+0.09091  0.2875   1       0
+0.18182  0.23125  0.0036  1
+
+(array-print (caddr PLU))
+11  9         24        2
+0   14.54545  11.45455  0.45455
+0   0         -3.475    5.6875
+0   0         0         0.51079

Task/LU-decomposition/Idris/lu-decomposition.idris

@@ -0,0 +1,155 @@
+module Main
+
+import Data.Vect
+
+Matrix : Nat -> Nat -> Type -> Type
+Matrix m n t = Vect m (Vect n t)
+
+-- Creates list from 0 to n (not including n)
+upTo : (m : Nat) -> Vect m (Fin m)
+upTo Z = []
+upTo (S n) = 0 :: (map FS (upTo n))
+
+-- Creates list from 0 to n-1  (not including n-1)
+upToM1 : (m : Nat) -> (sz ** Vect sz (Fin m))
+upToM1 m = case (upTo m) of
+                  (y::ys) => (_ ** init(y::ys))
+                  [] => (_ ** [])
+
+-- Creates list from i to n (not including n)
+fromUpTo : {n : Nat} -> Fin n -> (sz ** Vect sz (Fin n))
+fromUpTo {n} m = filter (>= m) (upTo n)
+
+-- Creates list from i+1 to n (not including n)
+fromUpTo1 : {n : Nat} -> Fin n -> (sz ** Vect sz (Fin n))
+fromUpTo1 {n} m with (fromUpTo m)
+  | (_ ** xs) = case xs of
+                  (y::ys) => (_ ** ys)
+                  [] => (_ ** [])
+
+
+-- Create Zero Matrix of size m by n
+zeros : (m : Nat) -> (n : Nat) -> Matrix m n Double
+zeros m n = replicate m (replicate n 0.0)
+
+replaceAtM : (Fin m, Fin n) -> t -> Matrix m n t -> Matrix m n t
+replaceAtM (i, j) e a = replaceAt i (replaceAt j e (index i a)) a
+
+-- Create Identity Matrix of size m by m
+eye : (m : Nat) -> Matrix m m Double
+eye m = map create1Vec (upTo m)
+  where
+    set1 : Vect m Double -> Fin m -> Vect m Double
+    set1 a n = replaceAt n 1.0 a
+
+    create1Vec : Fin m -> Vect m Double
+    create1Vec n = set1 (replicate m 0.0) n
+
+
+indexM : (Fin m, Fin n) -> Matrix m n t -> t
+indexM (i, j) a = index j (index i a)
+
+
+-- Obtain index for the row containing the
+-- largest absolute value for the given column
+colAbsMaxIndex : Fin m -> Fin m -> Matrix m m Double -> Fin m
+colAbsMaxIndex startRow col a {m} with (fromUpTo startRow)
+  | (_ ** xs) =
+    snd $ foldl (\(absMax, idx), curIdx =>
+          let curAbsVal = abs(indexM (curIdx, col) a) in
+            if (curAbsVal > absMax)
+              then (curAbsVal, curIdx)
+              else (absMax, idx)
+        ) (0.0, startRow) xs
+
+
+-- Swaps two rows in a given matrix
+swapRows : Fin m -> Fin m -> Matrix m n t -> Matrix m n t
+swapRows r1 r2 a = replaceAt r2 tempRow $ replaceAt r1 (index r2 a) a
+  where tempRow = index r1 a
+
+
+-- Swaps two individual values in a matrix
+swapValues : (Fin m, Fin m) -> (Fin m, Fin m) -> Matrix m m Double -> Matrix m m Double
+swapValues (i1, j1) (i2, j2) m = replaceAtM (i2, j2) v1 $ replaceAtM (i1, j1) v2 m
+  where
+      v1 = indexM (i1, j1) m
+      v2 = indexM (i2, j2) m
+
+-- Perform row Swap on Lower Triangular Matrix
+lSwapRow : Fin m -> Fin m -> Matrix m m Double -> Matrix m m Double
+lSwapRow row1 row2 l {m} with (filter (< row1) (upTo m))
+  | (_ ** xs) =  foldl (\l',col => swapValues (row1, col) (row2, col) l') l xs
+
+
+rowSwap : Fin m -> (Matrix m m Double,  Matrix m m Double, Matrix m m Double) ->
+                        (Matrix m m Double, Matrix m m Double, Matrix m m Double)
+rowSwap col (l,u,p) = (lSwapRow col row l, swapRows col row u, swapRows col row p)
+      where row = colAbsMaxIndex col col u
+
+
+calc : (Fin m) -> (Fin m) -> (Matrix m m Double, Matrix m m Double) ->
+                                (Matrix m m Double, Matrix m m Double)
+calc i j (l, u) {m} = (l', u')
+   where
+         l' : Matrix m m Double
+         l' = replaceAtM (j, i) ((indexM (j, i) u) / indexM (i, i) u) l
+
+         u'' : (Fin m) -> (Matrix m m Double) -> (Matrix m m Double)
+         u'' k u = replaceAtM (j, k) ((indexM (j, k) u) -
+                  ((indexM (j, i) l') * (indexM (i, k) u))) u
+
+         u' : (Matrix m m Double)
+         u' with (fromUpTo i) | (_ ** xs) = foldl (\curU, idx => u'' idx curU) u xs
+
+
+-- Perform a single iteration of the algorithm for the given column
+iteration : Fin m -> (Matrix m m Double, Matrix m m Double, Matrix m m Double) ->
+                        (Matrix m m Double, Matrix m m Double, Matrix m m Double)
+iteration i lup {m} = iterate' (rowSwap i lup)
+
+          where
+                modify : (Matrix m m Double, Matrix m m Double) ->
+                            (Matrix m m Double, Matrix m m Double)
+                modify lu with (fromUpTo1 i) | (_ ** xs) =
+                                            foldl (\lu',j => calc i j lu') lu xs
+
+                iterate' : (Matrix m m Double, Matrix m m Double, Matrix m m Double) ->
+                              (Matrix m m Double, Matrix m m Double, Matrix m m Double)
+                iterate' (l, u, p) with (modify (l, u)) | (l', u') = (l', u', p)
+
+
+-- Generate L, U, P matricies from a given square matrix.
+-- Where L * U = A, and P is the permutation matrix
+luDecompose : Matrix m m Double -> (Matrix m m Double, Matrix m m Double, Matrix m m Double)
+luDecompose a {m} with (upToM1 m)
+  | (_ ** xs) = foldl (\lup,idx => iteration idx lup) (eye m,a,eye m) xs
+
+
+
+ex1 : (Matrix 3 3 Double, Matrix 3 3 Double, Matrix 3 3 Double)
+ex1 = luDecompose [[1, 3, 5], [2, 4, 7], [1, 1, 0]]
+
+ex2 : (Matrix 4 4 Double, Matrix 4 4 Double, Matrix 4 4 Double)
+ex2 = luDecompose [[11, 9, 24, 2], [1, 5, 2, 6], [3, 17, 18, 1], [2, 5, 7, 1]]
+
+printEx : (Matrix n n Double, Matrix n n Double, Matrix n n Double) -> IO ()
+printEx (l, u, p) = do
+  putStr "l:"
+  print l
+  putStrLn "\n"
+
+  putStr "u:"
+  print u
+  putStrLn "\n"
+
+  putStr "p:"
+  print p
+  putStrLn "\n"
+
+main : IO()
+main = do
+  putStrLn "Solution 1:"
+  printEx ex1
+  putStrLn "Solution 2:"
+  printEx ex2

Task/LU-decomposition/Sidef/lu-decomposition.sidef

@@ -0,0 +1,74 @@
+func is_square(m) { m.all { .len == m.len } }
+func matrix_zero(n, m=n) { m.of { n.of(0) } }
+func matrix_ident(n) { n.of {|i| [(i-1).of(0)..., 1, (n-i).of(0)...] } }
+
+func pivotize(m) {
+    var size = m.len
+    var id = matrix_ident(size)
+    for i in ^size {
+        var max = m[i][i]
+        var row = i
+        for j in range(i, size-1) {
+            if (m[j][i] > max) {
+                max = m[j][i]
+                row = j
+            }
+        }
+        if (row != i) {
+            id.swap(row, i)
+        }
+    }
+    return id
+}
+
+func mmult(a, b) {
+    var p = []
+    for r,c in (^a ~X ^b[0]) {
+        for i in ^b {
+            p[r][c] := 0 += (a[r][i] * b[i][c])
+        }
+    }
+    return p
+}
+
+func lu(a) {
+    is_square(a) || die "Defined only for square matrices!";
+    var n = a.len
+    var P = pivotize(a)
+    var Aʼ = mmult(P, a)
+    var L = matrix_ident(n)
+    var U = matrix_zero(n)
+    for i,j in (^n ~X ^n) {
+        if (j >= i) {
+            U[i][j] = (Aʼ[i][j] - (^i->map { U[_][j] * L[i][_] }.sum(0)))
+        } else {
+            L[i][j] = ((Aʼ[i][j] - (^j->map { U[_][j] * L[i][_] }.sum(0))) / U[j][j])
+        }
+    }
+    return [P, Aʼ, L, U]
+}
+
+func say_it(message, array) {
+    say "\n#{message}"
+    array.each { |row|
+        say row.map{"%7s" % .as_rat}.join(' ')
+    }
+}
+
+var t = [[
+   %n(1 3 5),
+   %n(2 4 7),
+   %n(1 1 0),
+],[
+   %n(11  9 24  2),
+   %n( 1  5  2  6),
+   %n( 3 17 18  1),
+   %n( 2  5  7  1),
+]]
+
+t.each { |test|
+    say_it('A Matrix', test);
+    for a in (['P Matrix', 'Aʼ Matrix', 'L Matrix', 'U Matrix'] ~Z lu(test)) {
+        say_it(a[0], a[1])
+    }
+}

Task/LU-decomposition/jq/lu-decomposition-1.jq

@@ -0,0 +1,45 @@
+# Create an m x n matrix
+def matrix(m; n; init):
+  if m == 0 then []
+  elif m == 1 then [range(0;n)] | map(init)
+  elif m > 0 then
+    matrix(1;n;init) as $row
+    | [range(0;m)] | map( $row )
+  else error("matrix\(m);_;_) invalid")
+  end ;
+
+def I(n): matrix(n;n;0) as $m
+  | reduce range(0;n) as $i ($m; . | setpath( [$i,$i]; 1));
+
+def dot_product(a; b):
+  reduce range(0;a|length) as $i (0; . + (a[$i] * b[$i]) );
+
+# transpose/0 expects its input to be a rectangular matrix
+def transpose:
+  if (.[0] | length) == 0 then []
+  else [map(.[0])] + (map(.[1:]) | transpose)
+  end ;
+
+# A and B should both be numeric matrices, A being m by n, and B being n by p.
+def multiply(A; B):
+  (B[0]|length) as $p
+  | (B|transpose) as $BT
+  | reduce range(0; A|length) as $i
+       ([];
+       reduce range(0; $p) as $j
+         (.;
+          .[$i][$j] = dot_product( A[$i]; $BT[$j] ) ));
+
+def swap_rows(i;j):
+  if i == j then .
+  else .[i] as $i | .[i] = .[j] | .[j] = $i
+  end ;
+
+# Print a matrix neatly, each cell occupying n spaces, but without truncation
+def neatly(n):
+  def right: tostring | ( " " * (n-length) + .);
+  . as $in
+  | length as $length
+  | reduce range (0;$length) as $i
+      (""; . + reduce range(0;$length) as $j
+      (""; "\(.) \($in[$i][$j] | right )" ) + "\n" ) ;

Task/LU-decomposition/jq/lu-decomposition-2.jq

@@ -0,0 +1,42 @@
+# Create the pivot matrix for the input matrix.
+# Use "range(0;$n) as $i" to handle ill-conditioned cases.
+def pivotize:
+  def abs: if .<0 then -. else . end;
+  length as $n
+  | . as $m
+  | reduce range(0;$n) as $j
+      (I($n);
+       # state: [row; max]
+       (reduce range(0; $n) as $i
+          ([$j, $m[$j][$j]|abs ];
+           ($m[$i][$j]|abs) as $a
+           | if $a > .[1] then [ $i, $a ] else . end) | .[0]) as $row
+        | swap_rows( $j; $row)
+      ) ;
+
+# Decompose the input nxn matrix A by PA=LU and return [L, U, P].
+def lup:
+  def div(i;j):
+    if j == 0 then if i==0 then 0 else error("\(i)/0") end
+    else i/j
+    end;
+  . as $A
+  | length as $n
+  | I($n) as $L         #  matrix($n; $n; 0.0) as $L
+  | matrix($n; $n; 0.0) as $U
+  | ($A|pivotize) as $P
+  | multiply($P;$A) as $A2
+  # state: [L, U]
+  | reduce range(0; $n) as $i ( [$L, $U];
+      reduce range(0; $n) as $j (.;
+          .[0] as $L
+        | .[1] as $U
+        | if ($j >= $i) then
+            (reduce range(0;$i) as $k (0; . + ($U[$k][$j] * $L[$i][$k] ))) as $s1
+            | [$L, ($U| setpath([$i,$j]; ($A2[$i][$j] - $s1))) ]
+          else
+            (reduce range(0;$j) as $k (0; . + ($U[$k][$j] * $L[$i][$k]))) as $s2
+            | [ ($L | setpath([$i,$j]; div(($A2[$i][$j] - $s2) ; $U[$j][$j] ))), $U ]
+          end ))
+    | . + [ $P ]
+;

Task/LU-decomposition/jq/lu-decomposition-3.jq

@@ -0,0 +1,2 @@
+def a: [[1, 3, 5], [2, 4, 7], [1, 1, 0]];
+a | lup[] | neatly(4)

Task/LU-decomposition/jq/lu-decomposition-4.jq

@@ -0,0 +1,12 @@
+ $ /usr/local/bin/jq -M -n -r -f LU.jq
+    1    0    0
+  0.5    1    0
+  0.5   -1    1
+
+    2    4    7
+    0    1  1.5
+    0    0   -2
+
+    0    1    0
+    1    0    0
+    0    0    1

Task/LU-decomposition/jq/lu-decomposition-5.jq

@@ -0,0 +1,2 @@
+def b: [[11,9,24,2],[1,5,2,6],[3,17,18,1],[2,5,7,1]];
+b | lup[] | neatly(21)

Task/LU-decomposition/jq/lu-decomposition-6.jq

@@ -0,0 +1,15 @@
+$ /usr/local/bin/jq -M -n -r -f LU.jq
+                     1                     0                     0                     0
+    0.2727272727272727                     1                     0                     0
+   0.09090909090909091                0.2875                     1                     0
+   0.18181818181818182   0.23124999999999996 0.0035971223021580693                     1
+
+                    11                     9                    24                     2
+                     0    14.545454545454547    11.454545454545455    0.4545454545454546
+                     0                     0   -3.4749999999999996                5.6875
+                     0                     0                     0     0.510791366906476
+
+                     1                     0                     0                     0
+                     0                     0                     1                     0
+                     0                     1                     0                     0
+                     0                     0                     0                     1

Task/LU-decomposition/jq/lu-decomposition-7.jq

@@ -0,0 +1,12 @@
+# A|lup|verify(A) should be true
+def verify(A):
+  .[0] as $L | .[1] as $U | .[2] as $P
+  | multiply($P; A) == multiply($L; $U);
+
+def A:
+  [[1,  1,  1,  1],
+   [1,  1, -1, -1],
+   [1, -1,  0,  0],
+   [0,  0,  1, -1]];
+
+A|lup|verify(A)