Merge pull request #2972 from urbit/la/ordered-map-subset

zuse: add subset arm to ordered-map
This commit is contained in:
Philip Monk 2020-07-21 18:09:22 -07:00 committed by GitHub
commit 452b668c5f
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 129 additions and 5 deletions

View File

@ -7084,6 +7084,18 @@
$(pops [oldest pops])
--
--
::
:: +mop: constructs and validates ordered ordered map based on key,
:: val, and comparator gate
::
++ mop
|* [key=mold value=mold]
|= ord=$-([key key] ?)
|= a=*
=/ b ;;((tree [key=key val=value]) a)
?> (check-balance:((ordered-map key value) ord) b)
b
::
:: $mk-item: constructor for +ordered-map item type
::
++ mk-item |$ [key val] [key=key val=val]
@ -7093,6 +7105,9 @@
:: smallest key can be popped off the head. If $key is `@` and
:: .compare is +lte, then the numerically smallest item is the head.
::
:: WARNING: ordered-map will not work properly if two keys can be
:: unequal under noun equality but equal via the compare gate
::
++ ordered-map
|* [key=mold val=mold]
=> |%
@ -7165,6 +7180,7 @@
?~ a ~
?~ l.a `n.a
$(a l.a)
::
:: +pop: produce .head (smallest item) and .rest or crash if empty
::
++ pop
@ -7331,6 +7347,68 @@
?: (compare key.n.a key.n.b)
$(l.b $(b l.b, r.a ~), a r.a)
$(r.b $(b r.b, l.a ~), a l.a)
::
:: +get: get val at key or return ~
::
++ get
|= [a=(tree item) b=key]
^- (unit val)
?~ a ~
?: =(b key.n.a)
`val.n.a
?: (compare b key.n.a)
$(a l.a)
$(a r.a)
::
:: +subset: take a range excluding start and/or end and all elements
:: outside the range
::
++ subset
|= $: tre=(tree item)
start=(unit key)
end=(unit key)
==
^- (tree item)
|^
?: ?&(?=(~ start) ?=(~ end))
tre
?~ start
(del-span tre %end end)
?~ end
(del-span tre %start start)
?> (compare u.start u.end)
=. tre (del-span tre %start start)
(del-span tre %end end)
::
++ del-span
|= [a=(tree item) b=?(%start %end) c=(unit key)]
^- (tree item)
?~ a a
?~ c a
?- b
%start
:: found key
?: =(key.n.a u.c)
(nip a(l ~))
:: traverse to find key
?: (compare key.n.a u.c)
:: found key to the left of start
$(a (nip a(l ~)))
:: found key to the right of start
a(l $(a l.a))
::
%end
:: found key
?: =(u.c key.n.a)
(nip a(r ~))
:: traverse to find key
?: (compare key.n.a u.c)
:: found key to the left of end
a(r $(a r.a))
:: found key to the right of end
$(a (nip a(r ~)))
==
--
--
:: ::
:::: ++userlib :: (2u) non-vane utils

View File

@ -1,8 +1,4 @@
:: TODO: move +ordered-map to zuse
::
/+ *test
/= ames /sys/vane/ames
::
=/ items-from-keys
|= keys=(list @ud)
%+ turn keys
@ -12,7 +8,7 @@
=/ test-items=(list [@ud @tas])
(items-from-keys (gulf 0 6))
::
=/ atom-map ((ordered-map:ames @ud @tas) lte)
=/ atom-map ((ordered-map @ud @tas) lte)
::
|%
++ test-ordered-map-gas ^- tang
@ -57,6 +53,56 @@
!> (gas:atom-map ~ ~[[0^%a] [1^%b] [2^%c] [3^%d] [4^%e] [5^%f]])
!> b
::
++ test-ordered-map-subset ^- tang
::
=/ a=(tree [@ud @tas]) (gas:atom-map ~ test-items)
::
=/ b (subset:atom-map a `0 `4)
::
%+ expect-eq
!> (gas:atom-map ~ ~[[1^%b] [2^%c] [3^%d]])
!> b
::
++ test-ordered-map-null-start-subset ^- tang
::
=/ a=(tree [@ud @tas]) (gas:atom-map ~ test-items)
::
=/ b (subset:atom-map a ~ `5)
::
%+ expect-eq
!> (gas:atom-map ~ ~[[0^%a] [1^%b] [2^%c] [3^%d] [4^%e]])
!> b
::
++ test-ordered-map-null-end-subset ^- tang
::
=/ a=(tree [@ud @tas]) (gas:atom-map ~ test-items)
::
=/ b (subset:atom-map a `1 ~)
::
%+ expect-eq
!> (gas:atom-map ~ ~[[2^%c] [3^%d] [4^%e] [5^%f] [6^%g]])
!> b
::
++ test-ordered-map-double-null-subset ^- tang
::
=/ a=(tree [@ud @tas]) (gas:atom-map ~ test-items)
::
=/ b (subset:atom-map a ~ ~)
::
%+ expect-eq
!> (gas:atom-map ~ ~[[0^%a] [1^%b] [2^%c] [3^%d] [4^%e] [5^%f] [6^%g]])
!> b
::
++ test-ordered-map-not-found-start-subset ^- tang
::
=/ a=(tree [@ud @tas]) (gas:atom-map ~ ~[[1^%b]])
::
=/ b (subset:atom-map a `0 ~)
::
%+ expect-eq
!> (gas:atom-map ~ ~[[1^%b]])
!> b
::
++ test-ordered-map-traverse ^- tang
::
=/ a=(tree [@ud @tas]) (gas:atom-map ~ test-items)