1 ! Copyright (C) 2022 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs kernel math parser prettyprint.custom
7 TUPLE: multiset size avl hash ;
9 : <multiset> ( -- multiset )
13 H{ } clone >>hash ; inline
15 : multiset-emplace ( obj multiset -- )
16 [ dup 1 + ] change-size
18 [ hash>> swapd push-at ] 3bi ; inline
20 : multiset-erase ( obj multiset -- )
22 hash>> delete-at* drop
25 [ avl>> '[ _ delete-at ] each ]
26 [ [ length ] dip [ swap - ] change-size drop ] 2bi
29 : multiset-clear ( multiset -- )
30 [ hash>> clear-assoc ]
31 [ avl>> f >>root 0 >>count drop ] bi ;
33 : multiset-empty? ( multiset -- ? ) avl>> assoc-size 0 eq? ; inline
35 : multiset-in? ( multiset obj -- ? ) swap hash>> key? ; inline
37 : multiset-count ( multiset obj -- n )
38 swap hash>> at* [ length ] [ drop 0 ] if ; inline
40 : multiset-members ( multiset -- seq )
41 avl>> >alist values ; inline
43 : multiset-each ( multiset quot -- )
44 [ multiset-members ] dip each ; inline
46 : >multiset ( seq -- multiset )
48 [ '[ _ multiset-emplace ] each ] keep ;
51 \ } [ >multiset ] parse-literal ;
53 M: multiset pprint-delims drop \ multiset{ \ } ;
55 M: multiset >pprint-sequence avl>> >alist values ;
57 M: multiset pprint-narrow? drop t ;
59 M: multiset pprint* pprint-object ;