September 2017 Update

Task/Order-disjoint-list-items/AppleScript/order-disjoint-list-items.applescript

@@ -1,3 +1,5 @@
+-- DISJOINT ORDER ------------------------------------------------------------
+
 -- disjointOrder :: String -> String -> String
 on disjointOrder(m, n)
     set {ms, ns} to map(my |words|, {m, n})
@@ -8,15 +10,17 @@ end disjointOrder
 -- segments :: [String] -> [String] -> [String]
 on segments(ms, ns)
     script segmentation
-        on lambda(a, x)
+        on |λ|(a, x)
             set wds to |words| of a
 
             if wds contains x then
-                {parts:(parts of a) & [current of a], current:[], |words|:deleteFirst(x, wds)}
+                {parts:(parts of a) & ¬
+                    [current of a], current:[], |words|:deleteFirst(x, wds)} ¬
+
             else
                 {parts:(parts of a), current:(current of a) & x, |words|:wds}
             end if
-        end lambda
+        end |λ|
     end script
 
     tell foldl(segmentation, {|words|:ns, parts:[], current:[]}, ms)
@@ -25,14 +29,14 @@ on segments(ms, ns)
 end segments
 
 
--- TEST --------------------------------------------------------------------------------------
+-- TEST ----------------------------------------------------------------------
 on run
     script order
-        on lambda(rec)
+        on |λ|(rec)
             tell rec
                 [its m, its n, my disjointOrder(its m, its n)]
             end tell
-        end lambda
+        end |λ|
     end script
 
     arrowTable(map(order, [¬
@@ -43,18 +47,18 @@ on run
         {m:"A B", n:"B"}, {m:"A B", n:"B A"}, ¬
         {m:"A B B A", n:"B A"}]))
 
--- the cat sat on the mat  ->  mat cat  ->  the mat sat on the cat
--- the cat sat on the mat  ->  cat mat  ->  the cat sat on the mat
--- A B C A B C A B C       ->  C A C A  ->  C B A C B A A B C
--- A B C A B D A B E       ->  E A D A  ->  E B C A B D A B A
--- A B                     ->  B        ->  A B
--- A B                     ->  B A      ->  B A
--- A B B A                 ->  B A      ->  B A B A
+    -- the cat sat on the mat  ->  mat cat  ->  the mat sat on the cat
+    -- the cat sat on the mat  ->  cat mat  ->  the cat sat on the mat
+    -- A B C A B C A B C       ->  C A C A  ->  C B A C B A A B C
+    -- A B C A B D A B E       ->  E A D A  ->  E B C A B D A B A
+    -- A B                     ->  B        ->  A B
+    -- A B                     ->  B A      ->  B A
+    -- A B B A                 ->  B A      ->  B A B A
 
 end run
 
 
--- GENERIC FUNCTIONS ----------------------------------------------------------------------
+-- GENERIC FUNCTIONS ---------------------------------------------------------
 
 -- Formatting test results
 
@@ -63,52 +67,99 @@ on arrowTable(rows)
 
     script leftAligned
         script width
-            on lambda(a, b)
+            on |λ|(a, b)
                 (length of a) - (length of b)
-            end lambda
+            end |λ|
         end script
 
-        on lambda(col)
+        on |λ|(col)
             set widest to length of maximumBy(width, col)
 
             script padding
-                on lambda(s)
+                on |λ|(s)
                     justifyLeft(widest, space, s)
-                end lambda
+                end |λ|
             end script
 
             map(padding, col)
-        end lambda
+        end |λ|
     end script
 
     script arrows
-        on lambda(row)
+        on |λ|(row)
             intercalate("  ->  ", row)
-        end lambda
+        end |λ|
     end script
 
     intercalate(linefeed, ¬
         map(arrows, ¬
             transpose(map(leftAligned, transpose(rows)))))
-
 end arrowTable
 
--- 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
+-- concatMap :: (a -> [b]) -> [a] -> [b]
+on concatMap(f, xs)
+    script append
+        on |λ|(a, b)
+            a & b
+        end |λ|
     end script
 
-    map(column, item 1 of xss)
-end transpose
+    foldl(append, {}, map(f, xs))
+end concatMap
+
+-- deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a]
+on deleteBy(fnEq, x, xs)
+    if length of xs > 0 then
+        set {h, t} to uncons(xs)
+        if |λ|(x, h) of mReturn(fnEq) then
+            t
+        else
+            {h} & deleteBy(fnEq, x, t)
+        end if
+    else
+        {}
+    end if
+end deleteBy
+
+-- deleteFirst :: a -> [a] -> [a]
+on deleteFirst(x, xs)
+    script Eq
+        on |λ|(a, b)
+            a = b
+        end |λ|
+    end script
+
+    deleteBy(Eq, x, xs)
+end deleteFirst
+
+-- flatten :: Tree a -> [a]
+on flatten(t)
+    if class of t is list then
+        concatMap(my flatten, t)
+    else
+        t
+    end if
+end flatten
+
+-- 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
+
+-- intercalate :: Text -> [Text] -> Text
+on intercalate(strText, lstText)
+    set {dlm, my text item delimiters} to {my text item delimiters, strText}
+    set strJoined to lstText as text
+    set my text item delimiters to dlm
+    return strJoined
+end intercalate
 
 -- justifyLeft :: Int -> Char -> Text -> Text
 on justifyLeft(n, cFiller, strText)
@@ -119,22 +170,61 @@ on justifyLeft(n, cFiller, strText)
     end if
 end justifyLeft
 
+-- 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 |λ|(item i of xs, i, xs)
+        end repeat
+        return lst
+    end tell
+end map
+
 -- maximumBy :: (a -> a -> Ordering) -> [a] -> a
 on maximumBy(f, xs)
     set cmp to mReturn(f)
     script max
-        on lambda(a, b)
-            if a is missing value or cmp's lambda(a, b) < 0 then
+        on |λ|(a, b)
+            if a is missing value or cmp's |λ|(a, b) < 0 then
                 b
             else
                 a
             end if
-        end lambda
+        end |λ|
     end script
 
     foldl(max, missing value, xs)
 end maximumBy
 
+-- 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
+
 -- Egyptian multiplication - progressively doubling a list, appending
 -- stages of doubling to an accumulator where needed for binary
 -- assembly of a target length
@@ -153,114 +243,22 @@ on replicate(n, a)
     return out & dbl
 end replicate
 
--- List functions
+-- transpose :: [[a]] -> [[a]]
+on transpose(xss)
+    script column
+        on |λ|(_, iCol)
+            script row
+                on |λ|(xs)
+                    item iCol of xs
+                end |λ|
+            end script
 
--- 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
-
--- 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
-
--- zip :: [a] -> [b] -> [(a, b)]
-on zip(xs, ys)
-    script pair
-        on lambda(x, i)
-            [x, item i of ys]
-        end lambda
+            map(row, xss)
+        end |λ|
     end script
 
-    map(pair, items 1 thru minimum([length of xs, length of ys]) of xs)
-end zip
-
--- flatten :: Tree a -> [a]
-on flatten(t)
-    if class of t is list then
-        concatMap(my flatten, t)
-    else
-        t
-    end if
-end flatten
-
--- concatMap :: (a -> [b]) -> [a] -> [b]
-on concatMap(f, xs)
-    script append
-        on lambda(a, b)
-            a & b
-        end lambda
-    end script
-
-    foldl(append, {}, map(f, xs))
-end concatMap
-
--- 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
-        end script
-    end if
-end mReturn
-
--- deleteFirst :: a -> [a] -> [a]
-on deleteFirst(x, xs)
-    script Eq
-        on lambda(a, b)
-            a = b
-        end lambda
-    end script
-
-    deleteBy(Eq, x, xs)
-end deleteFirst
-
--- minimum :: [a] -> a
-on minimum(xs)
-    script min
-        on lambda(a, x)
-            if x < a or a is missing value then
-                x
-            else
-                a
-            end if
-        end lambda
-    end script
-
-    foldl(min, missing value, xs)
-end minimum
-
--- deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a]
-on deleteBy(fnEq, x, xs)
-    if length of xs > 0 then
-        set {h, t} to uncons(xs)
-        if lambda(x, h) of mReturn(fnEq) then
-            t
-        else
-            {h} & deleteBy(fnEq, x, t)
-        end if
-    else
-        {}
-    end if
-end deleteBy
+    map(column, item 1 of xss)
+end transpose
 
 -- uncons :: [a] -> Maybe (a, [a])
 on uncons(xs)
@@ -276,15 +274,19 @@ on unwords(xs)
     intercalate(space, xs)
 end unwords
 
--- intercalate :: Text -> [Text] -> Text
-on intercalate(strText, lstText)
-    set {dlm, my text item delimiters} to {my text item delimiters, strText}
-    set strJoined to lstText as text
-    set my text item delimiters to dlm
-    return strJoined
-end intercalate
 
 -- words :: String -> [String]
 on |words|(s)
     words of s
 end |words|
+
+-- zip :: [a] -> [b] -> [(a, b)]
+on zip(xs, ys)
+    script pair
+        on |λ|(x, i)
+            [x, item i of ys]
+        end |λ|
+    end script
+
+    map(pair, items 1 thru minimum([length of xs, length of ys]) of xs)
+end zip