September 2017 Update

Task/Symmetric-difference/AppleScript/symmetric-difference-1.applescript

@@ -1,44 +1,69 @@
--- UNION AND DIFFERENCE
+-- SYMMETRIC DIFFERENCE -------------------------------------------
 
--- union :: [a] -> [a] -> [a]
-on union(xs, ys)
-    nub(xs & ys)
-end union
-
--- difference :: [a] -> [a] -> [a]
-on difference(xs, ys)
-    script except
-        on lambda(a, y)
-            if a contains y then
-                |delete|(y, a)
-            else
-                a
-            end if
-        end lambda
-    end script
-
-    foldl(except, xs, ys)
-end difference
-
-
--- TEST
+-- symmetricDifference :: [a] -> [a] -> [a]
+on symmetricDifference(xs, ys)
+    union(difference(xs, ys), difference(ys, xs))
+end symmetricDifference
 
+-- TEST -----------------------------------------------------------
 on run
-
     set a to ["John", "Serena", "Bob", "Mary", "Serena"]
     set b to ["Jim", "Mary", "John", "Jim", "Bob"]
 
-
-    -- 'Symmetric difference'
-
-    union(difference(a, b), difference(b, a))
+    symmetricDifference(a, b)
 
     -->  {"Serena", "Jim"}
-
 end run
 
 
--- GENERIC LIBRARY FUNCTIONS
+-- GENERIC FUNCTIONS ----------------------------------------------
+
+-- delete :: Eq a => a -> [a] -> [a]
+on |delete|(x, xs)
+    set mbIndex to elemIndex(x, xs)
+    set lng to length of xs
+
+    if mbIndex is not missing value then
+        if lng > 1 then
+            if mbIndex = 1 then
+                items 2 thru -1 of xs
+            else if mbIndex = lng then
+                items 1 thru -2 of xs
+            else
+                tell xs to items 1 thru (mbIndex - 1) & ¬
+                    items (mbIndex + 1) thru -1
+            end if
+        else
+            {}
+        end if
+    else
+        xs
+    end if
+end |delete|
+
+-- difference :: [a] -> [a] -> [a]
+on difference(xs, ys)
+    script
+        on |λ|(a, y)
+            if a contains y then
+                my |delete|(y, a)
+            else
+                a
+            end if
+        end |λ|
+    end script
+
+    foldl(result, xs, ys)
+end difference
+
+-- elemIndex :: a -> [a] -> Maybe Int
+on elemIndex(x, xs)
+    set lng to length of xs
+    repeat with i from 1 to lng
+        if x = (item i of xs) then return i
+    end repeat
+    return missing value
+end elemIndex
 
 -- foldl :: (a -> b -> a) -> a -> [b] -> a
 on foldl(f, startValue, xs)
@@ -46,13 +71,24 @@ on foldl(f, startValue, xs)
         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)
+            set v to |λ|(v, item i of xs, i, xs)
         end repeat
         return v
     end tell
 end foldl
 
--- unique set of members of xs
+-- 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
+
 -- nub :: [a] -> [a]
 on nub(xs)
     if (length of xs) > 1 then
@@ -63,49 +99,14 @@ on nub(xs)
     end if
 end nub
 
--- uncons :: [a] -> Maybe (a, [a])
-on uncons(xs)
-    if length of xs > 0 then
-        {item 1 of xs, rest of xs}
-    else
-        missing value
-    end if
-end uncons
-
--- 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
-
--- delete :: a -> [a] -> [a]
-on |delete|(x, xs)
-    script Eq
-        on lambda(a, b)
-            a = b
-        end lambda
+-- union :: [a] -> [a] -> [a]
+on union(xs, ys)
+    script flipDelete
+        on |λ|(xs, x)
+            my |delete|(x, xs)
+        end |λ|
     end script
 
-    deleteBy(Eq, x, xs)
-end |delete|
-
-
--- 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
+    set sx to nub(xs)
+    sx & foldl(flipDelete, nub(ys), sx)
+end union