Data commit

Task/Set/Quackery/set-1.quackery

@@ -0,0 +1,92 @@
+  [ [] $ "" rot
+    sort$ witheach
+      [ tuck != if
+        [ dup dip
+            [ nested join ] ] ]
+    drop ]                             is -duplicates  (   { --> {   )
+
+  [ [] $ "" rot
+    sort$ witheach
+      [ tuck = if
+        [ nested join
+          $ "" ] ]
+    drop -duplicates ]                 is duplicates   (   { --> {   )
+
+
+  [ [] $ "" rot
+    sort$ witheach
+      [ tuck != iff
+          [ dup dip [ nested join ] ]
+        else
+          [ dip [ -1 pluck ]
+            over != if
+              [ nested join $ "" ] ] ]
+    drop ]                             is --duplicates (   { --> {   )
+
+  [ [] swap
+    [ trim
+      dup $ "" = if
+        [ $ '"set{" without "}set"'
+          message put bail ]
+      nextword
+      dup $ "}set" != while
+      nested rot join swap
+      again ]
+    drop swap
+    -duplicates
+    ' [ ' ] swap nested join
+    swap dip [ nested join ] ]     builds set{         ( [ $ --> [ $ )
+
+  [ -duplicates
+    say "{ "
+    witheach [ echo$ sp ]
+    say "}" ]                          is echoset      (   { --> {   )
+
+  [ join duplicates ]                  is intersection ( { { --> {   )
+
+  [ join -duplicates ]                 is union        ( { { --> {   )
+
+  [ join --duplicates ]                is symmdiff     ( { { --> {   )
+
+  [ over intersection symmdiff ]       is difference   ( { { --> {   )
+
+  [ over intersection = ]              is subset       ( { { --> b   )
+
+  [ dip nested subset ]                is element      ( $ { --> b   )
+
+  [ 2dup = iff
+      [ 2drop false ]
+    else subset ]                      is propersubset ( { { --> b   )
+
+( ------------------------------ demo ------------------------------ )
+
+set{ apple peach pear melon
+     apricot banana orange }set        is fruits       (     --> {   )
+
+set{ red orange green blue
+     purple apricot peach }set         is colours      (     --> {   )
+
+fruits  dup echoset say " are fruits" cr
+
+colours dup echoset say " are colours" cr
+
+2dup intersection echoset say " are both fruits and colours" cr
+
+2dup union echoset say " are fruits or colours" cr
+
+2dup symmdiff echoset say " are fruits or colours but not both" cr
+
+difference echoset say " are fruits that are not colours" cr
+
+set{ red green blue }set dup echoset say " are"
+colours subset not if [ say " not" ] say " all colours"  cr
+
+say "fruits and colours are" fruits colours = not if [ say " not" ]
+say " exactly the same" cr
+
+$ "orange" dup echo$ say " is"
+fruits element not if [ say " not" ] say " a fruit" cr
+
+set{ orange }set dup echoset say " is"
+fruits propersubset dup if [ say " not" ] say " the only fruit"
+                    not if [ say " or not a fruit" ] cr

Task/Set/Quackery/set-2.quackery

@@ -0,0 +1,86 @@
+  [ stack [ ] ]                     is elements     (     --> s   )
+
+  [ elements share 2dup find
+    dup rot found iff nip done
+    swap elements take
+    swap nested join
+    elements put ]                  is elementid    (   $ --> n   )
+
+  [ 0 temp put
+    [ trim
+      dup $ "" = if
+        [ $ '"set{" without "}set"'
+          message put bail ]
+      nextword
+      dup $ "}set" = iff drop done
+      elementid bit
+      temp take | temp put
+      again ]
+   temp take
+   swap dip
+     [ nested nested join ] ]   builds set{         ( [ $ --> [ $ )
+
+  [ [] 0 rot
+    [ dup while
+      dup 1 & if
+        [ over elements share
+          swap peek nested
+          swap dip
+            [ rot join swap ] ]
+      dip 1+
+      1 >>
+      again ]
+    2drop ]                         is set->nest    (   { --> [   )
+
+  [ say "{ "
+    set->nest witheach [ echo$ sp ]
+    say "}" ]                       is echoset      (   { -->     )
+
+  [ & ]                             is intersection ( { { --> {   )
+
+  [ | ]                             is union        ( { { --> {   )
+
+  [ ^ ]                             is symmdiff     ( { { --> {   )
+
+  [ over intersection symmdiff ]    is difference   ( { { --> {   )
+
+  [ over intersection = ]           is subset       ( { { --> b   )
+
+  [ dip [ elementid bit ] subset ]  is element      ( $ { --> b   )
+
+  [ 2dup = iff
+      [ 2drop false ]
+    else subset ]                   is propersubset ( { { --> b   )
+
+( ----------------------------- demo ---------------------------- )
+
+  set{ apple peach pear melon
+       apricot banana orange }set   is fruits       (     --> {   )
+
+  set{ red orange green blue
+       purple apricot peach }set    is colours      (     --> {   )
+
+fruits dup echoset say " are fruits" cr
+
+colours dup echoset say " are colours" cr
+
+2dup intersection echoset say " are both fruits and colours" cr
+
+2dup union echoset say " are fruits or colours" cr
+
+2dup symmdiff echoset say " are fruits or colours but not both" cr
+
+difference echoset say " are fruits that are not colours" cr
+
+set{ red green blue }set dup echoset say " are"
+colours subset not if [ say " not" ] say " all colours"  cr
+
+say "fruits and colours are" fruits colours = not if [ say " not" ]
+say " exactly the same" cr
+
+$ "orange" dup echo$ say " is"
+fruits element not if [ say " not" ] say " a fruit" cr
+
+set{ orange }set dup echoset say " is"
+fruits propersubset dup if [ say " not" ] say " the only fruit"
+                    not if [ say " or not a fruit" ] cr