September 2017 Update

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

@@ -1,26 +1,24 @@
--- matrixMultiply :: [[n]] -> [[n]] -> [[n]]
+-- matrixMultiply :: Num a => [[a]] -> [[a]] -> [[a]]
 to matrixMultiply(a, b)
     script rows
         property xs : transpose(b)
 
-        on lambda(row)
+        on |λ|(row)
             script columns
-                on lambda(col)
-                    dotProduct(row, col)
-                end lambda
+                on |λ|(col)
+                    my dotProduct(row, col)
+                end |λ|
             end script
 
             map(columns, xs)
-        end lambda
+        end |λ|
     end script
 
     map(rows, a)
 end matrixMultiply
 
 
-
--- TEST
-
+-- TEST -----------------------------------------------------------
 on run
     matrixMultiply({¬
         {-1, 1, 4}, ¬
@@ -37,64 +35,34 @@ on run
 end run
 
 
+-- GENERIC FUNCTIONS ----------------------------------------------
+
 -- dotProduct :: [n] -> [n] -> Maybe n
 on dotProduct(xs, ys)
-    script product
-        on lambda(a, b)
+    script mult
+        on |λ|(a, b)
             a * b
-        end lambda
+        end |λ|
     end script
 
     if length of xs is not length of ys then
         missing value
     else
-        sum(zipWith(product, xs, ys))
+        sum(zipWith(mult, 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)
+-- foldr :: (a -> b -> a) -> a -> [b] -> a
+on foldr(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)
+        repeat with i from lng to 1 by -1
+            set v to |λ|(v, item i of xs, i, xs)
         end repeat
         return v
     end tell
-end foldl
+end foldr
 
 -- map :: (a -> b) -> [a] -> [b]
 on map(f, xs)
@@ -102,35 +70,80 @@ on map(f, xs)
         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)
+            set end of lst to |λ|(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
+-- min :: Ord a => a -> a -> a
+on min(x, y)
+    if y < x then
+        y
     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
+        x
     end if
-end zipWith
+end min
 
--- Script | Handler -> Script
+-- 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 lambda : f
+            property |λ| : f
         end script
     end if
 end mReturn
+
+-- product :: Num a => [a] -> a
+on product(xs)
+    script mult
+        on |λ|(a, b)
+            a * b
+        end |λ|
+    end script
+
+    foldr(mult, 1, xs)
+end product
+
+-- sum :: Num a => [a] -> a
+on sum(xs)
+    script add
+        on |λ|(a, b)
+            a + b
+        end |λ|
+    end script
+
+    foldr(add, 0, xs)
+end sum
+
+-- transpose :: [[a]] -> [[a]]
+on transpose(xss)
+    script column
+        on |λ|(_, iCol)
+            script row
+                on |λ|(xs)
+                    item iCol of xs
+                end |λ|
+            end script
+
+            map(row, xss)
+        end |λ|
+    end script
+
+    map(column, item 1 of xss)
+end transpose
+
+-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
+on zipWith(f, xs, ys)
+    set lng to min(length of xs, length of ys)
+    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)
+        end repeat
+        return lst
+    end tell
+end zipWith