Added "lookupBetween" "leftMost" and "rightMost" to Data.SortedMap

Author: redfish64

libs/contrib/Data/SortedMap.idr

@@ -319,6 +319,58 @@ export
 mergeLeft : SortedMap k v -> SortedMap k v -> SortedMap k v
 mergeLeft = mergeWith const
 
+treeLeftMost : Tree n k v o -> (k,v)
+treeLeftMost (Leaf x y) = (x,y)
+treeLeftMost (Branch2 x _ _) = treeLeftMost x
+treeLeftMost (Branch3 x _ _ _ _) = treeLeftMost x
+
+treeRightMost : Tree n k v o -> (k,v)
+treeRightMost (Leaf x y) = (x,y)
+treeRightMost (Branch2 _ _ x) = treeRightMost x
+treeRightMost (Branch3 _ _ _ _ x) = treeRightMost x
+
+treeLookupBetween : Ord k => k -> Tree n k v o -> (Maybe (k,v),Maybe (k,v))
+treeLookupBetween k (Leaf k' v) with (k < k')
+  treeLookupBetween k (Leaf k' v) | True = (Nothing, Just (k',v))
+  treeLookupBetween k (Leaf k' v) | False = (Just (k',v), Nothing)
+treeLookupBetween k (Branch2 t1 k' t2) with (k < k')
+  treeLookupBetween k (Branch2 t1 k' t2) | True = -- k < k'
+    let (lower, upper) = treeLookupBetween k t1 in
+    (lower, upper <|> pure (treeLeftMost t2))
+  treeLookupBetween k (Branch2 t1 k' t2) | False = -- k >= k'
+    let (lower, upper) = treeLookupBetween k t2 in
+    (lower <|> pure (treeRightMost t1), upper)
+treeLookupBetween k (Branch3 t1 k1 t2 k2 t3) with (k < k1)
+  treeLookupBetween k (Branch3 t1 k1 t2 k2 t3) | True = treeLookupBetween k (Branch2 t1 k1 t2)
+  treeLookupBetween k (Branch3 t1 k1 t2 k2 t3) | False with (k < k2)
+    treeLookupBetween k (Branch3 t1 k1 t2 k2 t3) | False | False = treeLookupBetween k (Branch2 t2 k2 t3)
+    treeLookupBetween k (Branch3 t1 k1 t2 k2 t3) | False | True = --k1 <= k < k2
+      let (lower, upper) = treeLookupBetween k (Branch2 t1 k1 t2) in
+      (lower, upper <|> pure (treeLeftMost t3))
+
+||| looks up a key in map, returning the left and right closest values, so that
+|||  k1 <= k < k2. If at the end of the beginning and/or end of the sorted map, returns
+||| nothing appropriately
+export
+lookupBetween : key -> SortedMap key val -> (Maybe (key,val), Maybe (key,val))
+lookupBetween k Empty =  (Nothing, Nothing)
+lookupBetween k (M _ t) = treeLookupBetween k t
+
+
+||| Returns the leftmost (least) key and value
+export
+leftMost : SortedMap key val -> Maybe (key,val)
+leftMost Empty = Nothing
+leftMost (M _ t) = Just $ treeLeftMost t
+
+
+||| Returns the rightmost (greatest) key and value
+export
+rightMost : SortedMap key val -> Maybe (key,val)
+rightMost Empty = Nothing
+rightMost (M _ t) = Just $ treeRightMost t
+
+
 export
 (Show k, Show v) => Show (SortedMap k v) where
    show m = "fromList " ++ (show $ toList m)
@@ -341,3 +393,5 @@ Semigroup v => Semigroup (SortedMap k v) where
 export
 (Ord k, Semigroup v) => Monoid (SortedMap k v) where
   neutral = empty
+(&~) : a -> (a -> b) -> b
+(&~) x f = f x

tests/contrib/sortedmap_001/SortedMapTest.idr

@@ -0,0 +1,57 @@
+import Data.SortedMap
+
+(&~) : a -> (a -> b) -> b
+(&~) x f = f x
+
+infixl 2 &~
+
+testLookupBetween : List (Maybe (Maybe (Int,Int),Maybe (Int,Int)))
+testLookupBetween =
+  let maps : List (((Maybe (Int,Int), Maybe (Int,Int))),(Maybe (Int,Int), Maybe (Int,Int)))
+      maps =
+        [
+         (lookupBetween 1 (singleton 0 10),((Just (0,10)), Nothing))
+        ,(lookupBetween 1 (singleton 0 10 &~ insert 9 90), (Just (0,10), Just (9,90)))
+        ,(lookupBetween 7 (singleton 0 10 &~ insert 5 50 &~ insert 9 90 &~ delete 5), (Just (0,10), Just (9,90)))
+        ,(lookupBetween (-1) (singleton 0 10), (Nothing,Just (0,10)))
+        ,(lookupBetween (-1) (singleton 0 10 &~ insert 9 90), (Nothing,Just (0,10)))
+        ,(lookupBetween (-1) (singleton 0 10 &~ insert 9 90 &~ insert 5 50), (Nothing,Just (0,10)))
+        ,(lookupBetween (-1) (singleton 0 10 &~ insert 6 60), (Nothing,Just (0,10)))
+        ,(lookupBetween 1 (singleton 0 10 &~ insert 9 90 &~ insert 5 50 &~ insert 3 30 &~ insert 7 70 &~ delete 3 &~ delete 7),
+                        (Just (0,10),Just (5,50)))
+        ,(lookupBetween 4 (singleton 0 10 &~ insert 9 90 &~ insert 5 50 &~ insert 3 30 &~ insert 7 70 &~ delete 3 &~ delete 7),
+                        (Just (0,10),Just (5,50)))
+        ,(lookupBetween 6 (singleton 0 10 &~ insert 9 90 &~ insert 5 50 &~ insert 3 30 &~ insert 7 70 &~ delete 3 &~ delete 7),
+                        (Just (5,50),Just (9,90)))
+        ,(lookupBetween 8 (singleton 0 10 &~ insert 9 90 &~ insert 5 50 &~ insert 3 30 &~ insert 7 70 &~ delete 3 &~ delete 7),
+                        (Just (5,50),Just (9,90)))
+        ,(lookupBetween 10 (singleton 0 10 &~ insert 9 90 &~ insert 5 50 &~ insert 3 30 &~ insert 7 70 &~ delete 3 &~ delete 7),
+                        (Just (9,90), Nothing))
+        ,(lookupBetween 100 (singleton 10 100 &~ insert 15 150 &~ insert 40 400 &~ insert 60 600 &~ insert 80 800 &~ insert 90 900),
+                        (Just (90,900), Nothing))
+        ,(lookupBetween 100 (singleton 10 100 &~ insert 15 150 &~ insert 40 400 &~ insert 60 600 &~ insert 80 800 &~ insert 90 900),
+                        (Just (90,900), Nothing))
+        ,(lookupBetween 61 (singleton 10 100 &~ insert 15 150 &~ insert 40 400 &~ insert 60 600 &~ insert 80 800 &~ insert 90 900),
+                        (Just (60,600), Just (80,800)))
+        ]
+  in
+    map (\(t,ev) => if t == ev then Nothing else Just t) maps
+
+testLeftRight : List (Maybe (Maybe (Int,Int)))
+testLeftRight =
+  let maps : List (Maybe (Int,Int),Maybe (Int,Int))
+      maps =
+        [
+         (leftMost (singleton 10 100 &~ insert 15 150 &~ insert 40 400 &~ insert 60 600 &~ insert 80 800 &~ insert 90 900), Just (10,100))
+        ,(rightMost (singleton 10 100 &~ insert 15 150 &~ insert 40 400 &~ insert 60 600 &~ insert 80 800 &~ insert 90 900), Just (90,900))
+        ]
+  in
+    map (\(t,ev) => if t == ev then Nothing else Just t) maps
+
+main : IO ()
+main =
+  do
+    ignore $ traverse (printLn . show) testLookupBetween
+    ignore $ traverse (printLn . show) testLeftRight
+
+

tests/contrib/sortedmap_001/expected

@@ -0,0 +1,19 @@
+1/1: Building SortedMapTest (SortedMapTest.idr)
+Main> "Nothing"
+"Nothing"
+"Nothing"
+"Nothing"
+"Nothing"
+"Nothing"
+"Nothing"
+"Nothing"
+"Nothing"
+"Nothing"
+"Nothing"
+"Nothing"
+"Nothing"
+"Nothing"
+"Nothing"
+"Nothing"
+"Nothing"
+Main> Bye for now!

tests/contrib/sortedmap_001/input

@@ -0,0 +1,2 @@
+:exec main
+:q

tests/contrib/sortedmap_001/run

@@ -0,0 +1,3 @@
+$1 --no-banner --no-color --console-width 0 -p contrib SortedMapTest.idr < input
+
+rm -rf build