Red set operation mezzanines (unique, intersect, etc.)

sets.red

Red [
	Title:   "Red set-related functions"
	Author:  "Gregg Irwin"
	File: 	 %sets.red
	Tabs:	 4
	Rights:  "Copyright (C) 2013 All Mankind. All rights reserved."
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/dockimbel/Red/blob/master/BSL-License.txt
	}
]

exclude: function [
	;"Returns a unique copy of series1, excluding all values found in series2."
	"Returns the unique difference (NOT, COMPLEMENT) of two sets."
	series1 [series!]
	series2 [series!]
;	/case "Perform a case-sensitive search"
;	/skip "Treat the series as fixed size records"
;		size [integer!]
][
    res: unique series1
    foreach val unique series2 [remove find/only res val]
    res
]
;exclude [a b c] [a b d]
;exclude [a b d] [a b c]


intersect: function [
	"Returns the unique intersection (AND) of two sets."
	series1 [series!]
	series2 [series!]
;	/case "Perform a case-sensitive search"
;	/skip "Treat the series as fixed size records"
;		size [integer!]
][
    series1: unique series1
    res: make series1 length? series1
    foreach val unique series2 [
        if find/only series1 val [append/only res val]
    ]
    res
]
;intersect  [a b c] [a b d]

series-difference: function [
	"Returns the unique symmetric difference (XOR) between two sets."
	series1 [series!]
	series2 [series!]
;	/case "Perform a case-sensitive search"
;	/skip "Treat the series as fixed size records"
;		size [integer!]
][
    res: make series1 length? series1
    series1: unique series1
    series2: unique series2
    foreach val series1 [
        if not find/only series2 val [append/only res val]
    ]
    foreach val series2 [
        if not find/only series1 val [append/only res val]
    ]
    unique res
]
; series-difference [a b a c] [a b b d]

union: function [
	"Returns the unique union (OR) of two sets."
	series1 [series!]
	series2 [series!]
;	/case "Perform a case-sensitive search"
;	/skip "Treat the series as fixed size records"
;		size [integer!]
][
    unique append copy series1 series2
]
;union [a b c] [a b d]

unique: function [
	"Returns a copy of the series with duplicate values removed."
	series [series!]
;	/case "Perform a case-sensitive search"
;	/skip "Treat the series as fixed size records"
;		size [integer!]
][
    res: make series length? series
    foreach val series [
        if not find/only res val [append/only res val]
    ]
    res
]

;=== Set predicates

disjoint?: func [
	"Returns true if A and B have no elements in common; false otherwise."
	a [series! bitset!]
	b [series! bitset!]
][
	empty? intersect a b
]

intersect?: func [
	"Returns true if A and B have at least one element in common; false otherwise."
	a [series! bitset!]
	b [series! bitset!]
][
	not empty? intersect a b
]

subset?: func [
	"Returns true if A is a subset of B; false otherwise."
	a [series! bitset!]
	b [series! bitset!]
][
	empty? exclude a b
]

superset?: func [
	"Returns true if A is a superset of B; false otherwise."
	a [series! bitset!]
	b [series! bitset!]
][
	subset? b a
]


;-------------------------------------------------------------------------------

; The idea here is that the various funcs all have very short bodies
; but require separate (matching) func interfaces, and individual 
; doc strings.
set-check: func [
	"Returns true if the sets match the test; false otherwise."
	test [word!] "disjoint? intersect? subset? superset"
	a [series! bitset!]
	b [series! bitset!]
][
	switch test [
		disjoint?  [empty? intersect a b]
		insersect? [not empty? intersect a b]
		subset?    [subset? a b]
		superset?  [subset? b a]
	]
]


; Function builder approaches

; Doc string first, as in normal func specs
make-set-predicate: func [doc-string body][
	func compose [(doc-string) a [series! bitset!] b [series! bitset!]] body
]
disjoint?:  make-set-predicate "Returns true if A and B have no elements in common; false otherwise." [empty? intersect a b]
intersect?: make-set-predicate "Returns true if A and B have at least one element in common; false otherwise." [not empty? intersect a b]
subset?:    make-set-predicate "Returns true if A is a subset of B; false otherwise." [subset? a b]
superset?:  make-set-predicate "Returns true if A is a superset of B; false otherwise." [subset? b a]

; Body first, so doc string is more like a trailing comment
make-set-predicate: func [body doc-string][
	func compose [(doc-string) a [series! bitset!] b [series! bitset!]] body
]
disjoint?:  make-set-predicate [empty? intersect a b] 	  "Returns true if A and B have no elements in common; false otherwise."
intersect?: make-set-predicate [not empty? intersect a b] "Returns true if A and B have at least one element in common; false otherwise."
subset?:    make-set-predicate [subset? a b] 			  "Returns true if A is a subset of B; false otherwise."
superset?:  make-set-predicate [subset? b a] 			  "Returns true if A is a superset of B; false otherwise."

; Shorter lines, but more of them
make-set-predicate: func [spec [block!] "[doc-string body]"][
	func compose [(spec/1) a [series! bitset!] b [series! bitset!]] spec/2
]
disjoint?: make-set-predicate [
	"Returns true if A and B have no elements in common; false otherwise."
	[empty? intersect a b]
]
intersect?: make-set-predicate [
	"Returns true if A and B have at least one element in common; false otherwise."
	[not empty? intersect a b]
]
subset?: make-set-predicate [
	"Returns true if A is a subset of B; false otherwise."
	[subset? a b]
]
superset?: make-set-predicate [
	"Returns true if A is a superset of B; false otherwise."
	[subset? b a]
]

; Delcarative specs. Body first, so doc string is more like a trailing comment
make-set-predicate: func [body desc][
	func compose [(desc) a [series! bitset!] b [series! bitset!]] body
]
foreach [word body desc][
	disjoint?  [empty? intersect a b] 	  "Returns true if A and B have no elements in common; false otherwise."
	intersect? [not empty? intersect a b] "Returns true if A and B have at least one element in common; false otherwise."
	subset?    [subset? a b] 			  "Returns true if A is a subset of B; false otherwise."
	superset?  [subset? b a] 			  "Returns true if A is a superset of B; false otherwise."
][set word make-set-predicate body desc]

; Declarative specs, with redundancy broken out.
make-set-predicate: func [body doc-string][
	func compose [(doc-string) a [series! bitset!] b [series! bitset!]] body
]
foreach [word body desc][
	disjoint?  [empty? intersect a b] 	  "A and B have no elements in common"
	intersect? [not empty? intersect a b] "A and B have at least one element in common"
	subset?    [subset? a b] 			  "A is a subset of B"
	superset?  [subset? b a] 			  "A is a superset of B"
][set word make-set-predicate body rejoin ["Returns true if" desc "; false otherwise."]]

; Not declarative, with redundancy broken out
make-set-predicate: func [body doc-string][
	func compose [
		(rejoin ["Returns true if" doc-string "; false otherwise."])
		a [series! bitset!] b [series! bitset!]
	] body
]
disjoint?:  make-set-predicate [empty? intersect a b] 	  "A and B have no elements in common"
intersect?: make-set-predicate [not empty? intersect a b] "A and B have at least one element in common"
subset?:    make-set-predicate [subset? a b] 			  "A is a subset of B"
superset?:  make-set-predicate [subset? b a] 			  "A is a superset of B"

; Maker func not global, so can have a shorter, more general name
context [ ; make-set-predicate msp
	mk-pred: func ["make-set-predicate" body doc-string][
		func compose [
			(rejoin ["Returns true if" doc-string "; false otherwise."])
			a [series! bitset!] b [series! bitset!]
		] body
	]
	set 'disjoint?  mk-pred [empty? intersect a b] 	   "A and B have no elements in common"
	set 'intersect? mk-pred [not empty? intersect a b] "A and B have at least one element in common"
	set 'subset?    mk-pred [subset? a b] 			   "A is a subset of B"
	set 'superset?  mk-pred [subset? b a] 			   "A is a superset of B"
]

;-------------------------------------------------------------------------------

e.g.: :comment

e.g. [
	unique [a b b c c c d]
	unique [a a b c d d d d]
	unique [[a] [a] [b] b c c c d]

	exclude [a b c] [a b d]
	exclude [a b d] [a b c]
	exclude [a b d] [a [b] c]
	exclude [a [b] d] [a [b] c]
	exclude [[a] [a]] [[a] [a]]
	
	intersect [a b c] [a b d]
	intersect [a b d] [a b c]
	intersect [a b d] [a [b] c]
	intersect [a [b] d] [a [b] c]
	intersect [[a] [a]] [[a] [a]]

	union [a b c] [a b d]
	union [a b d] [a b c]
	union [a b d] [a [b] c]
	union [a [b] d] [a [b] c]
	union [[a] [a]] [[a] [a]]

	series-difference [a b c] [a b d]
	series-difference [a b d] [a b c]
	series-difference [a b d] [a [b] c]
	series-difference [a [b] d] [a [b] c]
	series-difference [[a] [a]] [[a] [a]]
	
]