September 2017 Update

Task/Symmetric-difference/Aime/symmetric-difference.aime

@@ -13,14 +13,14 @@ show_sdiff(record u, record x)
             } else {
                 r_p_integer(r, s, 0);
             }
-        } while (r_greater(x, s, s));
+        } while (rsk_greater(x, s, s));
     }
 
     if (r_first(r, s)) {
         do {
             o_text(s);
             o_byte('\n');
-        } while (r_greater(r, s, s));
+        } while (rsk_greater(r, s, s));
     }
 }
 

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

Task/Symmetric-difference/JavaScript/symmetric-difference-3.js

@@ -1,66 +1,64 @@
-((a, b) => {
+(() => {
     'use strict';
 
+    const symmetricDifference = (xs, ys) =>
+        union(difference(xs, ys), difference(ys, xs));
 
-    let // UNION AND DIFFERENCE
+
+    // GENERIC FUNCTIONS ------------------------------------------------------
+
+    // First instance of x (if any) removed from xs
+    // delete_ :: Eq a => a -> [a] -> [a]
+    const delete_ = (x, xs) => {
+        const i = xs.indexOf(x);
+        return i !== -1 ? (xs.slice(0, i)
+            .concat(xs.slice(i, -1))) : xs;
+    };
+
+    //  (\\)  :: (Eq a) => [a] -> [a] -> [a]
+    const difference = (xs, ys) =>
+        ys.reduce((a, x) => filter(z => z !== x, a), xs);
+
+    // filter :: (a -> Bool) -> [a] -> [a]
+    const filter = (f, xs) => xs.filter(f);
+
+    // flip :: (a -> b -> c) -> b -> a -> c
+    const flip = f => (a, b) => f.apply(null, [b, a]);
+
+    // foldl :: (b -> a -> b) -> b -> [a] -> b
+    const foldl = (f, a, xs) => xs.reduce(f, a);
+
+    // nub :: [a] -> [a]
+    const nub = xs => {
+        const mht = unconsMay(xs);
+        return mht.nothing ? xs : (
+            ([h, t]) => [h].concat(nub(t.filter(s => s !== h)))
+        )(mht.just);
+    };
+
+    // show :: a -> String
+    const show = x => JSON.stringify(x, null, 2);
+
+    // unconsMay :: [a] -> Maybe (a, [a])
+    const unconsMay = xs => xs.length > 0 ? {
+        just: [xs[0], xs.slice(1)],
+        nothing: false
+    } : {
+        nothing: true
+    };
 
     // union :: [a] -> [a] -> [a]
-        union = (xs, ys) => unionBy((a, b) => a === b, xs, ys),
+    const union = (xs, ys) => {
+        const sx = nub(xs);
+        return sx.concat(foldl(flip(delete_), nub(ys), sx));
+    };
 
-        // difference :: [a] -> [a] -> [a]
-        difference = (xs, ys) =>
-            ys.reduce((a, y) =>
-                a.indexOf(y) !== -1 ? (
-                    delete_(y, a)
-                ) : a.concat(y), xs),
+    // TEST -------------------------------------------------------------------
+    const
+        a = ["John", "Serena", "Bob", "Mary", "Serena"],
+        b = ["Jim", "Mary", "John", "Jim", "Bob"];
 
-
-
-        // GENERAL PRIMITIVES
-
-        // unionBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
-        unionBy = (f, xs, ys) => {
-            let sx = nubBy(f, xs),
-                sy = nubBy(f, ys);
-
-            return sx.concat(
-                sx
-                .reduce(
-                    (a, x) => deleteBy(f, x, a),
-                    sy
-                )
-            )
-        },
-
-        // deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a]
-        deleteBy = (f, x, xs) =>
-            xs.reduce((a, y) => f(x, y) ? a : a.concat(y), []),
-
-        // delete_  :: a -> [a] -> [a]
-        delete_ = (x, xs) =>
-            deleteBy((a, b) => a === b, x, xs),
-
-        // nubBy :: (a -> a -> Bool) -> [a] -> [a]
-        nubBy = (f, xs) => {
-            let x = (xs.length ? xs[0] : undefined);
-
-            return x !== undefined ? [x].concat(
-                nubBy(f, xs.slice(1)
-                    .filter(y => !f(x, y))
-                )
-            ) : [];
-        };
-
-
-
-    // 'SYMMETRIC DIFFERENCE'
-
-    return union(
-        difference(a, b),
-        difference(b, a)
+    return show(
+        symmetricDifference(a, b)
     );
-
-})(
-    ["John", "Serena", "Bob", "Mary", "Serena"],
-    ["Jim", "Mary", "John", "Jim", "Bob"]
-);
+})();

Task/Symmetric-difference/Kotlin/symmetric-difference.kotlin

@@ -0,0 +1,14 @@
+// version 1.1.2
+
+fun main(args: Array<String>) {
+    val a = setOf("John", "Bob", "Mary", "Serena")
+    val b = setOf("Jim", "Mary", "John", "Bob")
+    println("A     = $a")
+    println("B     = $b")
+    val c =  a - b
+    println("A \\ B = $c")
+    val d = b - a
+    println("B \\ A = $d")
+    val e = c.union(d)
+    println("A Δ B = $e")
+}

Task/Symmetric-difference/OoRexx/symmetric-difference.rexx

@@ -0,0 +1,6 @@
+a = .set~of("John", "Bob", "Mary", "Serena")
+b = .set~of("Jim", "Mary", "John", "Bob")
+-- the xor operation is a symmetric difference
+do item over a~xor(b)
+   say item
+end

Task/Symmetric-difference/Pascal/symmetric-difference.pascal

@@ -0,0 +1,28 @@
+PROGRAM Symmetric_difference;
+
+TYPE
+  TName = (Bob, Jim, John, Mary, Serena);
+  TList = SET OF TName;
+
+PROCEDURE Put(txt : String; ResSet : TList);
+VAR
+  I : TName;
+
+BEGIN
+  Write(txt);
+  FOR I IN ResSet DO Write(I,' ');
+  WriteLn
+END;
+
+VAR
+  ListA : TList = [John, Bob, Mary, Serena];
+  ListB : TList = [Jim, Mary, John, Bob];
+
+BEGIN
+  Put('ListA          -> ', ListA);
+  Put('ListB          -> ', ListB);
+  Put('ListA >< ListB -> ', ListA >< ListB);
+  Put('ListA -  ListB -> ', ListA -  ListB);
+  Put('ListB -  ListA -> ', ListB -  ListA);
+  ReadLn;
+END.

Task/Symmetric-difference/Phix/symmetric-difference.phix

@@ -0,0 +1,30 @@
+function Union(sequence a, sequence b)
+    for i=1 to length(a) do
+        if not find(a[i],b) then
+            b = append(b,a[i])
+        end if
+    end for
+    return b
+end function
+
+function Difference(sequence a, sequence b)
+sequence res = {}
+    for i=1 to length(a) do
+        if not find(a[i],b)
+        and not find(a[i],res) then
+            res = append(res,a[i])
+        end if
+    end for
+    return res
+end function
+
+function Symmetric_Difference(sequence a, sequence b)
+    return Union(Difference(a, b), Difference(b, a))
+end function
+
+sequence a = {"John", "Serena", "Bob", "Mary", "Serena"},
+         b = {"Jim", "Mary", "John", "Jim", "Bob"}
+?Symmetric_Difference(a,a)
+?Symmetric_Difference(a,b)
+?Symmetric_Difference(b,a)
+?Symmetric_Difference(b,b)

Task/Symmetric-difference/Ruby/symmetric-difference-3.rb

@@ -1 +0,0 @@
-sym_diff = a ^ b

Task/Symmetric-difference/Scheme/symmetric-difference-1.ss

@@ -0,0 +1,30 @@
+(import (scheme base)
+        (scheme write))
+
+;; -- given two sets represented as lists, return (A \ B)
+(define (a-without-b a b)
+  (cond ((null? a)
+         '())
+        ((member (car a) (cdr a)) ; drop head of a if it's a duplicate
+         (a-without-b (cdr a) b))
+        ((member (car a) b) ; head of a is in b so drop it
+         (a-without-b (cdr a) b))
+        (else ; head of a not in b, so keep it
+          (cons (car a) (a-without-b (cdr a) b)))))
+
+;; -- given two sets represented as lists, return symmetric difference
+(define (symmetric-difference a b)
+  (append (a-without-b a b)
+          (a-without-b b a)))
+
+;; -- test case
+(define A '(John Bob Mary Serena))
+(define B '(Jim Mary John Bob))
+
+(display "A\\B: ") (display (a-without-b A B)) (newline)
+(display "B\\A: ") (display (a-without-b B A)) (newline)
+(display "Symmetric difference: ") (display (symmetric-difference A B)) (newline)
+;; -- extra test as we are using lists
+(display "Symmetric difference 2: ")
+(display (symmetric-difference '(John Serena Bob Mary Serena)
+                               '(Jim Mary John Jim Bob))) (newline)

Task/Symmetric-difference/Scheme/symmetric-difference-2.ss

@@ -0,0 +1,25 @@
+(import (scheme base)
+        (scheme write)
+        (srfi 1))
+
+(define (a-without-b a b)
+  (lset-difference equal?
+                   (delete-duplicates a)
+                   (delete-duplicates b)))
+
+(define (symmetric-difference a b)
+  (lset-xor equal?
+            (delete-duplicates a)
+            (delete-duplicates b)))
+
+;; -- test case
+(define A '(John Bob Mary Serena))
+(define B '(Jim Mary John Bob))
+
+(display "A\\B: ") (display (a-without-b A B)) (newline)
+(display "B\\A: ") (display (a-without-b B A)) (newline)
+(display "Symmetric difference: ") (display (symmetric-difference A B)) (newline)
+;; -- extra test as we are using lists
+(display "Symmetric difference 2: ")
+(display (symmetric-difference '(John Serena Bob Mary Serena)
+                               '(Jim Mary John Jim Bob))) (newline)

Task/Symmetric-difference/Zkl/symmetric-difference-1.zkl

@@ -0,0 +1,3 @@
+fcn setCommon(list1,list2){ list1.filter(list2.holds); }
+fcn sdiff(list1,list2)
+   { list1.extend(list2).copy().removeEach(setCommon(list1,list2)) }

Task/Symmetric-difference/Zkl/symmetric-difference-2.zkl

@@ -0,0 +1,3 @@
+a:=T("John","Bob","Mary","Serena");
+b:=T("Jim","Mary","John","Bob");
+sdiff(a,b).println();

Task/Symmetric-difference/Zkl/symmetric-difference-3.zkl

@@ -0,0 +1,3 @@
+a:=T("John", "Serena", "Bob", "Mary", "Serena");
+b:=T("Jim", "Mary", "John", "Jim", "Bob");
+sdiff(a,b) : Utils.Helpers.listUnique(_).println();