2016 Update

Task/Matrix-multiplication/00DESCRIPTION

@@ -1 +1,5 @@
-Multiply two matrices together. They can be of any dimensions, so long as the number of columns of the first matrix is equal to the number of rows of the second matrix.
+;Task:
+Multiply two matrices together.
+
+They can be of any dimensions, so long as the number of columns of the first matrix is equal to the number of rows of the second matrix.
+<br><br>

Task/Matrix-multiplication/AppleScript/matrix-multiplication-1.applescript

@@ -0,0 +1,136 @@
+-- matrixMultiply :: [[n]] -> [[n]] -> [[n]]
+to matrixMultiply(a, b)
+    script rows
+        property xs : transpose(b)
+
+        on lambda(row)
+            script columns
+                on lambda(col)
+                    dotProduct(row, col)
+                end lambda
+            end script
+
+            map(columns, xs)
+        end lambda
+    end script
+
+    map(rows, a)
+end matrixMultiply
+
+
+
+-- TEST
+
+on run
+    matrixMultiply({¬
+        {-1, 1, 4}, ¬
+        {6, -4, 2}, ¬
+        {-3, 5, 0}, ¬
+        {3, 7, -2} ¬
+            }, {¬
+        {-1, 1, 4, 8}, ¬
+        {6, 9, 10, 2}, ¬
+        {11, -4, 5, -3}})
+
+    --> {{51, -8, 26, -18}, {-8, -38, -6, 34},
+    --     {33, 42, 38, -14}, {17, 74, 72, 44}}
+end run
+
+
+-- dotProduct :: [n] -> [n] -> Maybe n
+on dotProduct(xs, ys)
+    script product
+        on lambda(a, b)
+            a * b
+        end lambda
+    end script
+
+    if length of xs is not length of ys then
+        missing value
+    else
+        sum(zipWith(product, xs, ys))
+    end if
+end dotProduct
+
+-- transpose :: [[a]] -> [[a]]
+on transpose(xss)
+    script column
+        on lambda(_, iCol)
+            script row
+                on lambda(xs)
+                    item iCol of xs
+                end lambda
+            end script
+
+            map(row, xss)
+        end lambda
+    end script
+
+    map(column, item 1 of xss)
+end transpose
+
+-- sum :: [n] -> n
+on sum(xs)
+    script add
+        on lambda(a, b)
+            a + b
+        end lambda
+    end script
+
+    foldl(add, 0, xs)
+end sum
+
+
+
+-- GENERIC LIBRARY 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 lambda(v, item i of xs, i, xs)
+        end repeat
+        return v
+    end tell
+end foldl
+
+-- map :: (a -> b) -> [a] -> [b]
+on map(f, xs)
+    tell mReturn(f)
+        set lng to length of xs
+        set lst to {}
+        repeat with i from 1 to lng
+            set end of lst to lambda(item i of xs, i, xs)
+        end repeat
+        return lst
+    end tell
+end map
+
+-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
+on zipWith(f, xs, ys)
+    set lng to length of xs
+    if lng is not length of ys then
+        missing value
+    else
+        tell mReturn(f)
+            set lst to {}
+            repeat with i from 1 to lng
+                set end of lst to lambda(item i of xs, item i of ys)
+            end repeat
+            return lst
+        end tell
+    end if
+end zipWith
+
+-- Script | Handler -> Script
+on mReturn(f)
+    if class of f is script then
+        f
+    else
+        script
+            property lambda : f
+        end script
+    end if
+end mReturn

Task/Matrix-multiplication/AppleScript/matrix-multiplication-2.applescript

@@ -0,0 +1 @@
+{{51, -8, 26, -18}, {-8, -38, -6, 34}, {33, 42, 38, -14}, {17, 74, 72, 44}}

Task/Matrix-multiplication/Ela/matrix-multiplication.ela

@@ -0,0 +1,7 @@
+open list
+
+mmult a b = [ [ sum $ zipWith (*) ar bc \\ bc <- (transpose b) ] \\ ar <- a ]
+
+[[1, 2],
+ [3, 4]] `mmult` [[-3, -8, 3],
+                  [-2,  1, 4]]

Task/Matrix-multiplication/Elixir/matrix-multiplication.elixir

@@ -0,0 +1,11 @@
+  def mult(m1, m2) do
+    Enum.map m1, fn (x) -> Enum.map t(m2), fn (y) -> Enum.zip(x, y)
+        |> Enum.map(fn {x, y} -> x * y end)
+        |> Enum.sum
+      end
+    end
+  end
+
+  def t(m) do # transpose
+    List.zip(m) |> Enum.map(&Tuple.to_list(&1))
+  end

Task/Matrix-multiplication/Haskell/matrix-multiplication-3.hs

@@ -0,0 +1,26 @@
+foldlZipWith::(a -> b -> c) -> (d -> c -> d) -> d -> [a] -> [b]  -> d
+foldlZipWith _ _ u [] _          = u
+foldlZipWith _ _ u _ []          = u
+foldlZipWith f g u (x:xs) (y:ys) = foldlZipWith f g (g u (f x y)) xs ys
+
+foldl1ZipWith::(a -> b -> c) -> (c -> c -> c) -> [a] -> [b] -> c
+foldl1ZipWith _ _ [] _          = error "First list is empty"
+foldl1ZipWith _ _ _ []          = error "Second list is empty"
+foldl1ZipWith f g (x:xs) (y:ys) = foldlZipWith f g (f x y) xs ys
+
+multAdd::(a -> b -> c) -> (c -> c -> c) -> [[a]] -> [[b]] -> [[c]]
+multAdd f g xs ys = map (\us -> foldl1ZipWith (\u vs -> map (f u) vs) (zipWith g) us ys) xs
+
+mult:: Num a => [[a]] -> [[a]] -> [[a]]
+mult xs ys = multAdd (*) (+) xs ys
+
+test a b = do
+  let c = mult a b
+  putStrLn "a ="
+  mapM_ print a
+  putStrLn "b ="
+  mapM_ print b
+  putStrLn "c = a * b = mult a b ="
+  mapM_ print c
+
+main = test [[1, 2],[3, 4]] [[-3, -8, 3],[-2,  1, 4]]

Task/Matrix-multiplication/JavaScript/matrix-multiplication-2.js

@@ -0,0 +1,67 @@
+(function () {
+    'use strict';
+
+    // matrixMultiply:: [[n]] -> [[n]] -> [[n]]
+    function matrixMultiply(a, b) {
+        var bCols = transpose(b);
+
+        return a.map(function (aRow) {
+            return bCols.map(function (bCol) {
+                return dotProduct(aRow, bCol);
+            });
+        });
+    }
+
+    // [[n]] -> [[n]] -> [[n]]
+    function dotProduct(xs, ys) {
+        return sum(zipWith(product, xs, ys));
+    }
+
+    return matrixMultiply(
+        [[-1,  1,  4],
+         [ 6, -4,  2],
+         [-3,  5,  0],
+         [ 3,  7, -2]],
+
+        [[-1,  1,  4,  8],
+         [ 6,  9, 10,  2],
+         [11, -4,  5, -3]]
+    );
+
+    // --> [[51, -8, 26, -18], [-8, -38, -6, 34],
+    //        [33, 42, 38, -14], [17, 74, 72, 44]]
+
+
+    // GENERIC LIBRARY FUNCTIONS
+
+    // (a -> b -> c) -> [a] -> [b] -> [c]
+    function zipWith(f, xs, ys) {
+        return xs.length === ys.length ? (
+            xs.map(function (x, i) {
+                return f(x, ys[i]);
+            })
+        ) : undefined;
+    }
+
+    // [[a]] -> [[a]]
+    function transpose(lst) {
+        return lst[0].map(function (_, iCol) {
+            return lst.map(function (row) {
+                return row[iCol];
+            });
+        });
+    }
+
+    // sum :: (Num a) => [a] -> a
+    function sum(xs) {
+        return xs.reduce(function (a, x) {
+            return a + x;
+        }, 0);
+    }
+
+    // product :: n -> n -> n
+    function product(a, b) {
+        return a * b;
+    }
+
+})();

Task/Matrix-multiplication/Lua/matrix-multiplication-2.lua

@@ -0,0 +1,5 @@
+local alg = require("sci.alg")
+mat1 = alg.tomat{{1, 2, 3}, {4, 5, 6}}
+mat2 = alg.tomat{{1, 2}, {3, 4}, {5, 6}}
+mat3 = mat1[] ** mat2[]
+print(mat3)

Task/Matrix-multiplication/PowerShell/matrix-multiplication.psh

@@ -1,31 +1,38 @@
-function array-mult($A, $B) {
-    $C = @()
-    if($n -gt 0) {
-        $C = 0..($n-1)| foreach{@(0)}
-        0..($n-1)| foreach{
-            $i = $_
-            $C[$i] = 0..($n-1)| foreach{
-                $j = $_
-                $((0..($n-1) | foreach{
-                    $k = $_
-                    $A[$i][$k]*$B[$k][$j]
-                } | measure -Sum).Sum)
+function multarrays($a, $b) {
+    $c = @()
+    if($a -and $b) {
+        $n = $a.count - 1
+        $m = $b[0].count - 1
+        $c = @(0)*($n+1)
+        foreach ($i in 0..$n) {
+            $c[$i] = foreach ($j in 0..$m) {
+                $sum = 0
+                foreach ($k in 0..$n){$sum += $a[$i][$k]*$b[$k][$j]}
+                $sum
             }
         }
     }
-    $C
+    $c
 }
 function show($a) {
-    if($a.Count -gt 0) {
-        $n = $a.Count - 1
-        0..$n | foreach{ "$($a[$_][0..$n])" }
+    if($a) {
+        0..($a.count - 1) | foreach{ if($a[$_]){"$($a[$_])"}else{""} }
     }
 }
-$A = @(@(1,2),@(3,4))
-$B = @(@(5,6),@(7,8))
-$I = @(@(1,0),@(0,1))
-$C = array-mult $A $B
-$D = array-mult $A $I
-show $C
+$a = @(@(1,2),@(3,4))
+$b = @(@(5,6),@(7,8))
+$c = @(5,6)
+"`$a ="
+show $a
+""
+"`$b ="
+show $b
+""
+"`$c ="
+$c
+""
+"`$a * `$b ="
+show (multarrays $a $b)
 " "
-show $D
+"`$a * `$c ="
+show (multarrays $a $c)

Task/Matrix-multiplication/REXX/matrix-multiplication.rexx

@@ -1,37 +1,36 @@
-/*REXX program multiplies two matrices together, displays matrices and result.*/
-x.=; x.1=1 2                           /*╔═══════════════════════════════════╗*/
-     x.2=3 4                           /*║ As none of the matrix values have ║*/
-     x.3=5 6                           /*║ a sign,  quotes aren't needed.    ║*/
-     x.4=7 8                           /*╚═══════════════════════════════════╝*/
-              do   r=1  while x.r\=='' /*build the "A" matrix from X. numbers.*/
-                do c=1  while x.r\=='';     parse var x.r a.r.c x.r;      end
-              end   /*r*/
-Arows=r-1                              /*adjust the number of rows  (DO loop).*/
-Acols=c-1                              /*   "    "     "    " cols    "   "  .*/
-y.=; y.1=1 2 3
-     y.2=4 5 6
-              do   r=1  while y.r\=='' /*build the "B" matrix from Y. numbers.*/
-                do c=1  while y.r\=='';     parse var y.r b.r.c y.r;      end
-              end   /*r*/
-Brows=r-1                              /*adjust the number of rows  (DO loop).*/
-Bcols=c-1                              /*   "     "    "    " cols    "   "   */
-c.=0;  w=0                             /*W  is max width of an matrix element.*/
-             do       i=1  for Arows   /*multiply matrix  A  and  B  ───►   C */
-               do     j=1  for Bcols
-                   do k=1  for Acols
-                   c.i.j = c.i.j + a.i.k * b.k.j;        w=max(w, length(c.i.j))
-                   end   /*k*/
-               end       /*j*/
-             end         /*i*/
+/*REXX program multiplies two matrices together, displays the matrices and the results. */
+x.=;  x.1=1 2                                    /*╔═══════════════════════════════════╗*/
+      x.2=3 4                                    /*║ As none of the matrix values have ║*/
+      x.3=5 6                                    /*║ a sign,  quotes aren't needed.    ║*/
+      x.4=7 8                                    /*╚═══════════════════════════════════╝*/
+                 do   r=1  while x.r\==''        /*build the "A" matrix from X. numbers.*/
+                   do c=1  while x.r\=='';   parse var x.r a.r.c x.r;      end  /*c*/
+                 end   /*r*/
+Arows=r-1                                        /*adjust the number of rows  (DO loop).*/
+Acols=c-1                                        /*   "    "     "    " cols    "   "  .*/
+y.=;  y.1=1 2 3
+      y.2=4 5 6
+                 do   r=1  while y.r\==''        /*build the "B" matrix from Y. numbers.*/
+                   do c=1  while y.r\=='';   parse var y.r b.r.c y.r;      end  /*c*/
+                 end   /*r*/
+Brows=r-1                                        /*adjust the number of rows  (DO loop).*/
+Bcols=c-1                                        /*   "     "    "    " cols    "   "   */
+c.=0;  w=0                                       /*W  is max width of an matrix element.*/
+            do       i=1  for Arows              /*multiply matrix  A  and  B  ───►   C */
+              do     j=1  for Bcols
+                  do k=1  for Acols;    c.i.j=c.i.j  +  a.i.k * b.k.j
+                                                     w=max(w, length(c.i.j))
+                  end   /*k*/                    /*  ↑                                  */
+              end       /*j*/                    /*  └──◄─── maximum width of elements. */
+            end         /*i*/
 
-call showMatrix  'A',  Arows,  Acols   /*display matrix  A ───►  the terminal.*/
-call showMatrix  'B',  Brows,  Bcols   /*   "       "    B ───►   "     "     */
-call showMatrix  'C',  Arows,  Bcols   /*   "       "    C ───►   "     "     */
-exit                                   /*stick a fork in it,  we're all done. */
-/*────────────────────────────────────────────────────────────────────────────*/
-showMatrix:  parse arg mat,rows,cols;            say
-say center(mat 'matrix', cols*(w+1)+4, "─")
-        do r    =1  for rows;  _=
-            do c=1  for cols;  _=_ right(value(mat'.'r'.'c), w);  end;     say _
-        end   /*r*/
-return
+call showMatrix  'A',  Arows,  Acols             /*display matrix  A ───►  the terminal.*/
+call showMatrix  'B',  Brows,  Bcols             /*   "       "    B ───►   "     "     */
+call showMatrix  'C',  Arows,  Bcols             /*   "       "    C ───►   "     "     */
+exit                                             /*stick a fork in it,  we're all done. */
+/*──────────────────────────────────────────────────────────────────────────────────────*/
+showMatrix: parse arg mat,rows,cols;   say;   say center(mat 'matrix', cols*(w+1) +4, "─")
+                    do   r=1  for rows;  _=
+                      do c=1  for cols;  _=_ right(value(mat'.'r"."c), w);  end;     say _
+                    end   /*r*/
+            return