Skip to content

Instantly share code, notes, and snippets.

@TimToady
Created January 22, 2012 00:00
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save TimToady/1654636 to your computer and use it in GitHub Desktop.
Save TimToady/1654636 to your computer and use it in GitHub Desktop.
Revised for list infixes; added (elem) and (cont) as Texas version
class Set does Associative;
has Bool %!elems;
method keys { %!elems.keys }
method values { %!elems.values }
method elems returns Int { %!elems.elems }
method exists returns Bool { %!elems.exists }
method Bool { %!elems.Bool }
method Numeric { %!elems.Numeric }
method hash { %!elems.hash }
method postcircumfix:<{ }> ($k) { %!elems{$k} }
#constant Set term:<∅> = set();
# Constructor
sub set(*@args --> Set) is export {
Set.new(@args);
}
method new(*@args --> Set) {
self.bless(*, :elems(%(@args X=> True)));
}
submethod BUILD (%!elems) { }
# Coercions to and from
method postcircumfix:<( )> ($s --> Set) { to-set($s) }
multi to-set (Set $set --> Set) { $set }
multi to-set (@elems --> Set) { Set.new: @elems }
multi to-set ([*@elems] --> Set) { Set.new: @elems }
multi to-set (%elems --> Set) { Set.new: %elems.keys }
multi to-set ($elem --> Set) { die "Cannot coerce $elem.perl() to a Set; use set($elem.perl()) to create a one-element set" }
submethod Str(Any:D $ : --> Str) { "set(< %!elems.keys() >)" }
submethod gist(Any:D $ : --> Str) { "set({ %!elems.keys».gist.join(', ') })" }
submethod perl(Any:D $ : --> Str) { 'set(' ~ join(', ', map { .perl }, %!elems.keys) ~ ')' }
method iterator() { %!elems.keys.iterator }
method list() { %!elems.keys }
method pick(\$args) { %!elems.keys.pick: |$args }
method roll(\$args) { %!elems.keys.roll: |$args }
# Set operators
proto sub infix:<∈>($, $ --> Bool) is equiv(&infix:<==>) is export {*}
multi sub infix:<∈>($a, Any $b --> Bool) { $a ∈ to-set($b) }
multi sub infix:<∈>($a, Set $b --> Bool) { $b!elems{$a}:exists }
multi sub infix:<(elem)>($a, $b --> Bool) { $a ∈ $b }
multi sub infix:<∉>($a, $b --> Bool) is equiv(&infix:<==>) is export { $a !∈ $b }
proto sub infix:<∋>($, $ --> Bool) is equiv(&infix:<==>) is export {*}
multi sub infix:<∋>($a, Any $b --> Bool) { to-set($a) ∋ $b }
multi sub infix:<∋>($a, Set $b --> Bool) { $a!elems{$b}:exists }
multi sub infix:<(cont)>($a, $b --> Bool) { $a ∋ $b }
multi sub infix:<∌>($a, $b --> Bool) is equiv(&infix:<==>) is export { $a !∋ $b }
multi sub infix:<∪>(Any $a, Any $b --> Set) is equiv(&infix:<X>) is export { to-set($a) ∪ to-set($b) }
multi sub infix:<∪>(Set $a, Set $b --> Set) is equiv(&infix:<X>) is export { Set.new: $a.keys, $b.keys }
multi sub infix:<(|)>($a, $b --> Set) is equiv(&infix:<X>) is export { $a ∪ $b }
multi sub infix:<∩>(Any $a, Any $b --> Set) is equiv(&infix:<X>) is export { to-set($a) ∩ to-set($b) }
multi sub infix:<∩>(Set $a, Set $b --> Set) is equiv(&infix:<X>) is export { Set.new: $a.keys.grep: -> $k { ?$b{$k} } }
multi sub infix:<(&)>($a, $b --> Set) is equiv(&infix:<X>) is export { $a ∩ $b }
multi sub infix:<(-)>(Any $a, Any $b --> Set) is equiv(&infix:<X>) is export { to-set($a) (-) to-set($b) }
multi sub infix:<(-)>(Set $a, Set $b --> Set) is equiv(&infix:<X>) is export { Set.new: $a.keys.grep: * ∉ $b }
multi sub infix:<(^)>(Any $a, Any $b --> Set) is equiv(&infix:<X>) is export { to-set($a) (^) to-set($b) }
multi sub infix:<(^)>(Set $a, Set $b --> Set) is equiv(&infix:<X>) is export { ($a (-) $b) ∪ ($b (-) $a) }
multi sub infix:<===>(Any $a, Any $b --> Bool) is export { to-set($a) === to-set($b) }
multi sub infix:<===>(Set $a, Set $b --> Bool) is export { $a == $b and so $a.keys.all ∈ $b }
multi sub infix:<eqv>(Any $a, Any $b --> Bool) is export { to-set($a) eqv to-set($b) }
multi sub infix:<eqv>(Set $a, Set $b --> Bool) is export { $a == $b and so $a.keys.all ∈ $b }
proto sub infix:<⊆>($, $ --> Bool) is equiv(&infix:<==>) is export {*}
multi sub infix:<⊆>(Any $a, Any $b --> Bool) { to-set($a) ⊆ to-set($b) }
multi sub infix:<⊆>(Set $a, Set $b --> Bool) { $a <= $b and so $a.keys.all ∈ $b }
multi sub infix:['(<=)']($a, $b --> Bool) is equiv(&infix:<==>) is export { $a ⊆ $b }
multi sub infix:<⊈>($a, $b --> Bool) is equiv(&infix:<==>) is export { $a !⊆ $b }
proto sub infix:<⊂>($, $ --> Bool) is equiv(&infix:<==>) is export {*}
multi sub infix:<⊂>(Any $a, Any $b --> Bool) { to-set($a) ⊂ to-set($b) }
multi sub infix:<⊂>(Set $a, Set $b --> Bool) { $a < $b and so $a.keys.all ∈ $b }
multi sub infix:['(<)']($a, $b --> Bool) is equiv(&infix:<==>) is export { $a ⊂ $b }
multi sub infix:<⊄>($a, $b --> Bool) is equiv(&infix:<==>) is export { $a !⊂ $b }
proto sub infix:<⊇>($, $ --> Bool) is equiv(&infix:<==>) is export {*}
multi sub infix:<⊇>(Any $a, Any $b --> Bool) { to-set($a) ⊇ to-set($b) }
multi sub infix:<⊇>(Set $a, Set $b --> Bool) { $a >= $b and so $b.keys.all ∈ $a }
multi sub infix:['(>=)']($a, $b --> Bool) is equiv(&infix:<==>) is export { $a ⊇ $b }
multi sub infix:<⊉>($a, $b --> Bool) is equiv(&infix:<==>) is export { $a !⊇ $b }
proto sub infix:<⊃>($, $ --> Bool) is equiv(&infix:<==>) is export {*}
multi sub infix:<⊃>(Any $a, Any $b --> Bool) { to-set($a) ⊃ to-set($b) }
multi sub infix:<⊃>(Set $a, Set $b --> Bool) { $a > $b and so $b.keys.all ∈ $a }
multi sub infix:['(>)']($a, $b --> Bool) is equiv(&infix:<==>) is export { $a ⊃ $b }
multi sub infix:<⊅>($a, $b --> Bool) is equiv(&infix:<==>) is export { $a !⊃ $b }
# vim: ft=perl6
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment