From a0840eb343214c8237444fa56e162e83ddb421ab Mon Sep 17 00:00:00 2001 From: Yarin Heffes Date: Tue, 17 Sep 2024 11:26:01 -0700 Subject: [PATCH] Added filtering for ord-map and -tree. --- library/ord-map.lisp | 26 ++++++++++++++++++++++++-- library/ord-tree.lisp | 33 ++++++++++++++++++++++++++++++++- 2 files changed, 56 insertions(+), 3 deletions(-) diff --git a/library/ord-map.lisp b/library/ord-map.lisp index 3bed6580..8f969339 100644 --- a/library/ord-map.lisp +++ b/library/ord-map.lisp @@ -24,6 +24,7 @@ #:collect #:update #:merge #:union #:intersection #:difference #:sdifference + #:filter-by-key #:filter-by-value #:filter-by-entry #:zip #:zip-with-default)) (in-package :coalton-library/ord-map) @@ -176,6 +177,9 @@ If `iter` contains duplicate keys, later values will overwrite earlier values." empty iter)) + (define-instance (Ord :key => iter:FromIterator (Map :key :value) (Tuple :key :value)) + (define iter:collect! collect!)) + (declare collect ((Ord :key) (Foldable :collection) => ((:collection (Tuple :key :value)) -> (Map :key :value)))) (define (collect coll) "Construct a `Map` containing all the `(key value)` pairs in `coll`. @@ -186,8 +190,8 @@ If `coll` contains duplicate keys, later values will overwrite earlier values." empty coll)) - (define-instance (Ord :key => iter:FromIterator (Map :key :value) (Tuple :key :value)) - (define iter:collect! collect!)) + (define-instance ((Ord :key) (Foldable :collection) => (Into (:collection (Tuple :key :value)) (Map :key :value))) + (define into collect)) (declare update ((Ord :key) => (:value -> :value) -> (Map :key :value) -> :key -> (Optional (Map :key :value)))) (define (update func mp key) @@ -252,6 +256,24 @@ Construct a Map containing only those mappings of `a` and `b` which do not assoc (let (%Map b) = b) (%Map (tree:sdifference a b))) + (declare filter-by-key (Ord :key => (:key -> Boolean) -> Map :key :value -> Map :key :value)) + (define (filter-by-key keep? mp) + "Construct a Map containing only those entries of `mp` which contain keys which satisfy `keep?`." + (let (%Map mp) = mp) + (%Map (tree:filter (compose keep? key) mp))) + + (declare filter-by-value (Ord :key => (:value -> Boolean) -> Map :key :value -> Map :key :value)) + (define (filter-by-value keep? mp) + "Construct a Map containing only those entries of `mp` which contain values which satisfy `keep?`." + (let (%Map mp) = mp) + (%Map (tree:filter (compose keep? value) mp))) + + (declare filter-by-entry (Ord :key => ((Tuple :key :value) -> Boolean) -> Map :key :value -> Map :key :value)) + (define (filter-by-entry keep? mp) + "Construct a Map containing only those entries of `mp` which satisfy `keep?`." + (let (%Map mp) = mp) + (%Map (tree:filter (compose keep? into) mp))) + (declare zip (Ord :key => Map :key :value1 -> Map :key :value2 -> Map :key (Tuple :value1 :value2))) (define (zip a b) "Construct a Map associating only those keys included in both `a` and `b` to the Tuple containing their respective values." diff --git a/library/ord-tree.lisp b/library/ord-tree.lisp index 24b1614f..6395d723 100644 --- a/library/ord-tree.lisp +++ b/library/ord-tree.lisp @@ -19,8 +19,10 @@ #:remove #:without #:increasing-order #:decreasing-order - #:collect! + #:collect! #:collect + #:filter-collect! #:filter-collect #:merge #:union #:intersection #:difference #:sdifference + #:filter #:make)) (in-package :coalton-library/ord-tree) @@ -509,9 +511,33 @@ The result tree may be in an intermediate state with a double-black node." If ITER contains duplicates, later elements will overwrite earlier elements." (iter:fold! insert-or-replace Empty iter)) + (declare filter-collect! ((Ord :elt) => (:elt -> Boolean) -> (iter:Iterator :elt) -> (Tree :elt))) + (define (filter-collect! keep? iter) + "Construct a Tree containing only those elements of `iter` which satisfy `keep?`. + +If ITER contains duplicates, later elements will overwrite earlier elements." + (collect! (iter:filter! keep? iter))) + (define-instance (Ord :elt => iter:FromIterator (Tree :elt) :elt) (define iter:collect! collect!)) + (declare collect ((Ord :elt) (Foldable :collection) => (:collection :elt)-> (Tree :elt))) + (define (collect coll) + "Construct a Tree containing all the elements of COLL. + +If COLL contains duplicates, later elements will overwrite earlier elements." + (fold insert-or-replace Empty coll)) + + (declare filter-collect ((Ord :elt) (Foldable :collection) => (:elt -> Boolean) -> (:collection :elt)-> (Tree :elt))) + (define (filter-collect keep? coll) + "Construct a Tree containing only those elements of `coll` which satisfy `keep?`. + +If COLL contains duplicates, later elements will overwrite earlier elements." + (fold (fn (tre elt) (if (keep? elt) (insert-or-replace tre elt) tre)) Empty coll)) + + (define-instance ((Ord :elt) (Foldable :collection) => (Into (:collection :elt) (Tree :elt))) + (define into collect)) + (declare merge (Ord :elt => Tree :elt -> Tree :elt -> Tree :elt)) (define (merge a b) "Construct a Tree containing all the elements of both A and B. @@ -548,6 +574,11 @@ Construct a Tree containing only those elements of `a` and `b` which are not `== (merge (difference a b) (difference b a))) + (declare filter (Ord :elt => (:elt -> Boolean) -> Tree :elt -> Tree :elt)) + (define (filter keep? tre) + "Construct a Tree containing only those elements of `tre` which satisfy `keep?`." + (fold (fn (new-tre elt) (if (keep? elt) (insert-or-replace new-tre elt) new-tre)) Empty tre)) + (define-instance (Ord :elt => Semigroup (Tree :elt)) (define <> merge))