From 67105a854be1ab180feedc5c82e47a197bc26bdb Mon Sep 17 00:00:00 2001 From: Liam Fitzgerald Date: Thu, 10 Feb 2022 11:52:37 -0600 Subject: [PATCH] lull: move ordered-map from zuse --- pkg/arvo/sys/lull.hoon | 407 +++++++++++++++++++++++++++++++++++++++++ pkg/arvo/sys/zuse.hoon | 406 ---------------------------------------- 2 files changed, 407 insertions(+), 406 deletions(-) diff --git a/pkg/arvo/sys/lull.hoon b/pkg/arvo/sys/lull.hoon index 3f25c1c13..9583db07c 100644 --- a/pkg/arvo/sys/lull.hoon +++ b/pkg/arvo/sys/lull.hoon @@ -36,6 +36,413 @@ depth=_1 == :: +:: +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) + ?> (apt:((on key value) ord) b) + b +:: +:: +++ ordered-map on +:: +on: treap with user-specified horizontal order, ordered-map +:: +:: WARNING: ordered-map will not work properly if two keys can be +:: unequal under noun equality but equal via the compare gate +:: +++ on + ~/ %on + |* [key=mold val=mold] + => |% + +$ item [key=key val=val] + -- + :: +compare: item comparator for horizontal order + :: + ~% %comp +>+ ~ + |= compare=$-([key key] ?) + ~% %core + ~ + |% + :: +all: apply logical AND boolean test on all values + :: + ++ all + ~/ %all + |= [a=(tree item) b=$-(item ?)] + ^- ? + |- + ?~ a + & + ?&((b n.a) $(a l.a) $(a r.a)) + :: +any: apply logical OR boolean test on all values + :: + ++ any + ~/ %any + |= [a=(tree item) b=$-(item ?)] + |- ^- ? + ?~ a + | + ?|((b n.a) $(a l.a) $(a r.a)) + :: +apt: verify horizontal and vertical orderings + :: + ++ apt + ~/ %apt + |= a=(tree item) + =| [l=(unit key) r=(unit key)] + |- ^- ? + :: empty tree is valid + :: + ?~ a %.y + :: nonempty trees must maintain several criteria + :: + ?& :: if .n.a is left of .u.l, assert horizontal comparator + :: + ?~(l %.y (compare key.n.a u.l)) + :: if .n.a is right of .u.r, assert horizontal comparator + :: + ?~(r %.y (compare u.r key.n.a)) + :: if .a is not leftmost element, assert vertical order between + :: .l.a and .n.a and recurse to the left with .n.a as right + :: neighbor + :: + ?~(l.a %.y &((mor key.n.a key.n.l.a) $(a l.a, l `key.n.a))) + :: if .a is not rightmost element, assert vertical order + :: between .r.a and .n.a and recurse to the right with .n.a as + :: left neighbor + :: + ?~(r.a %.y &((mor key.n.a key.n.r.a) $(a r.a, r `key.n.a))) + == + :: +bap: convert to list, right to left + :: + ++ bap + ~/ %bap + |= a=(tree item) + ^- (list item) + =| b=(list item) + |- ^+ b + ?~ a b + $(a r.a, b [n.a $(a l.a)]) + :: +del: delete .key from .a if it exists, producing value iff deleted + :: + ++ del + ~/ %del + |= [a=(tree item) =key] + ^- [(unit val) (tree item)] + ?~ a [~ ~] + :: we found .key at the root; delete and rebalance + :: + ?: =(key key.n.a) + [`val.n.a (nip a)] + :: recurse left or right to find .key + :: + ?: (compare key key.n.a) + =+ [found lef]=$(a l.a) + [found a(l lef)] + =+ [found rig]=$(a r.a) + [found a(r rig)] + :: +dip: stateful partial inorder traversal + :: + :: Mutates .state on each run of .f. Starts at .start key, or if + :: .start is ~, starts at the head. Stops when .f produces .stop=%.y. + :: Traverses from left to right keys. + :: Each run of .f can replace an item's value or delete the item. + :: + ++ dip + ~/ %dip + |* state=mold + |= $: a=(tree item) + =state + f=$-([state item] [(unit val) ? state]) + == + ^+ [state a] + :: acc: accumulator + :: + :: .stop: set to %.y by .f when done traversing + :: .state: threaded through each run of .f and produced by +abet + :: + =/ acc [stop=`?`%.n state=state] + =< abet =< main + |% + ++ this . + ++ abet [state.acc a] + :: +main: main recursive loop; performs a partial inorder traversal + :: + ++ main + ^+ this + :: stop if empty or we've been told to stop + :: + ?: =(~ a) this + ?: stop.acc this + :: inorder traversal: left -> node -> right, until .f sets .stop + :: + =. this left + ?: stop.acc this + =^ del this node + =? this !stop.acc right + =? a del (nip a) + this + :: +node: run .f on .n.a, updating .a, .state, and .stop + :: + ++ node + ^+ [del=*? this] + :: run .f on node, updating .stop.acc and .state.acc + :: + ?> ?=(^ a) + =^ res acc (f state.acc n.a) + ?~ res + [del=& this] + [del=| this(val.n.a u.res)] + :: +left: recurse on left subtree, copying mutant back into .l.a + :: + ++ left + ^+ this + ?~ a this + =/ lef main(a l.a) + lef(a a(l a.lef)) + :: +right: recurse on right subtree, copying mutant back into .r.a + :: + ++ right + ^+ this + ?~ a this + =/ rig main(a r.a) + rig(a a(r a.rig)) + -- + :: +gas: put a list of items + :: + ++ gas + ~/ %gas + |= [a=(tree item) b=(list item)] + ^- (tree item) + ?~ b a + $(b t.b, a (put a i.b)) + :: +get: get val at key or return ~ + :: + ++ get + ~/ %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) + :: +got: need value at key + :: + ++ got + |= [a=(tree item) b=key] + ^- val + (need (get a b)) + :: +has: check for key existence + :: + ++ has + ~/ %has + |= [a=(tree item) b=key] + ^- ? + !=(~ (get a b)) + :: +lot: take a subset range excluding start and/or end and all elements + :: outside the range + :: + ++ lot + ~/ %lot + |= $: 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 ~))) + == + -- + :: +nip: remove root; for internal use + :: + ++ nip + ~/ %nip + |= a=(tree item) + ^- (tree item) + ?> ?=(^ a) + :: delete .n.a; merge and balance .l.a and .r.a + :: + |- ^- (tree item) + ?~ l.a r.a + ?~ r.a l.a + ?: (mor key.n.l.a key.n.r.a) + l.a(r $(l.a r.l.a)) + r.a(l $(r.a l.r.a)) + :: + :: +pop: produce .head (leftmost item) and .rest or crash if empty + :: + ++ pop + ~/ %pop + |= a=(tree item) + ^- [head=item rest=(tree item)] + ?~ a !! + ?~ l.a [n.a r.a] + =/ l $(a l.a) + :- head.l + :: load .rest.l back into .a and rebalance + :: + ?: |(?=(~ rest.l) (mor key.n.a key.n.rest.l)) + a(l rest.l) + rest.l(r a(r r.rest.l)) + :: +pry: produce head (leftmost item) or null + :: + ++ pry + ~/ %pry + |= a=(tree item) + ^- (unit item) + ?~ a ~ + |- + ?~ l.a `n.a + $(a l.a) + :: +put: ordered item insert + :: + ++ put + ~/ %put + |= [a=(tree item) =key =val] + ^- (tree item) + :: base case: replace null with single-item tree + :: + ?~ a [n=[key val] l=~ r=~] + :: base case: overwrite existing .key with new .val + :: + ?: =(key.n.a key) a(val.n val) + :: if item goes on left, recurse left then rebalance vertical order + :: + ?: (compare key key.n.a) + =/ l $(a l.a) + ?> ?=(^ l) + ?: (mor key.n.a key.n.l) + a(l l) + l(r a(l r.l)) + :: item goes on right; recurse right then rebalance vertical order + :: + =/ r $(a r.a) + ?> ?=(^ r) + ?: (mor key.n.a key.n.r) + a(r r) + r(l a(r l.r)) + :: +ram: produce tail (rightmost item) or null + :: + ++ ram + ~/ %ram + |= a=(tree item) + ^- (unit item) + ?~ a ~ + |- + ?~ r.a `n.a + $(a r.a) + :: +run: apply gate to transform all values in place + :: + ++ run + ~/ %run + |* [a=(tree item) b=$-(val *)] + |- + ?~ a a + [n=[key.n.a (b val.n.a)] l=$(a l.a) r=$(a r.a)] + :: +tab: tabulate a subset excluding start element with a max count + :: + ++ tab + ~/ %tab + |= [a=(tree item) b=(unit key) c=@] + ^- (list item) + |^ + (flop e:(tabulate (del-span a b) b c)) + :: + ++ tabulate + |= [a=(tree item) b=(unit key) c=@] + ^- [d=@ e=(list item)] + ?: ?&(?=(~ b) =(c 0)) + [0 ~] + =| f=[d=@ e=(list item)] + |- ^+ f + ?: ?|(?=(~ a) =(d.f c)) f + =. f $(a l.a) + ?: =(d.f c) f + =. f [+(d.f) [n.a e.f]] + ?:(=(d.f c) f $(a r.a)) + :: + ++ del-span + |= [a=(tree item) b=(unit key)] + ^- (tree item) + ?~ a a + ?~ b a + ?: =(key.n.a u.b) + r.a + ?: (compare key.n.a u.b) + $(a r.a) + a(l $(a l.a)) + -- + :: +tap: convert to list, left to right + :: + ++ tap + ~/ %tap + |= a=(tree item) + ^- (list item) + =| b=(list item) + |- ^+ b + ?~ a b + $(a l.a, b [n.a $(a r.a)]) + :: +uni: unify two ordered maps + :: + :: .b takes precedence over .a if keys overlap. + :: + ++ uni + ~/ %uni + |= [a=(tree item) b=(tree item)] + ^- (tree item) + ?~ b a + ?~ a b + ?: =(key.n.a key.n.b) + [n=n.b l=$(a l.a, b l.b) r=$(a r.a, b r.b)] + ?: (mor key.n.a key.n.b) + ?: (compare key.n.b key.n.a) + $(l.a $(a l.a, r.b ~), b r.b) + $(r.a $(a r.a, l.b ~), b l.b) + ?: (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) + -- + +:: +$ deco ?(~ %bl %br %un) :: text decoration +$ json :: normal json value $@ ~ :: null diff --git a/pkg/arvo/sys/zuse.hoon b/pkg/arvo/sys/zuse.hoon index 38cc98d1d..bea070310 100644 --- a/pkg/arvo/sys/zuse.hoon +++ b/pkg/arvo/sys/zuse.hoon @@ -5184,412 +5184,6 @@ $(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) - ?> (apt:((on key value) ord) b) - b -:: -:: -++ ordered-map on -:: +on: treap with user-specified horizontal order, ordered-map -:: -:: WARNING: ordered-map will not work properly if two keys can be -:: unequal under noun equality but equal via the compare gate -:: -++ on - ~/ %on - |* [key=mold val=mold] - => |% - +$ item [key=key val=val] - -- - :: +compare: item comparator for horizontal order - :: - ~% %comp +>+ ~ - |= compare=$-([key key] ?) - ~% %core + ~ - |% - :: +all: apply logical AND boolean test on all values - :: - ++ all - ~/ %all - |= [a=(tree item) b=$-(item ?)] - ^- ? - |- - ?~ a - & - ?&((b n.a) $(a l.a) $(a r.a)) - :: +any: apply logical OR boolean test on all values - :: - ++ any - ~/ %any - |= [a=(tree item) b=$-(item ?)] - |- ^- ? - ?~ a - | - ?|((b n.a) $(a l.a) $(a r.a)) - :: +apt: verify horizontal and vertical orderings - :: - ++ apt - ~/ %apt - |= a=(tree item) - =| [l=(unit key) r=(unit key)] - |- ^- ? - :: empty tree is valid - :: - ?~ a %.y - :: nonempty trees must maintain several criteria - :: - ?& :: if .n.a is left of .u.l, assert horizontal comparator - :: - ?~(l %.y (compare key.n.a u.l)) - :: if .n.a is right of .u.r, assert horizontal comparator - :: - ?~(r %.y (compare u.r key.n.a)) - :: if .a is not leftmost element, assert vertical order between - :: .l.a and .n.a and recurse to the left with .n.a as right - :: neighbor - :: - ?~(l.a %.y &((mor key.n.a key.n.l.a) $(a l.a, l `key.n.a))) - :: if .a is not rightmost element, assert vertical order - :: between .r.a and .n.a and recurse to the right with .n.a as - :: left neighbor - :: - ?~(r.a %.y &((mor key.n.a key.n.r.a) $(a r.a, r `key.n.a))) - == - :: +bap: convert to list, right to left - :: - ++ bap - ~/ %bap - |= a=(tree item) - ^- (list item) - =| b=(list item) - |- ^+ b - ?~ a b - $(a r.a, b [n.a $(a l.a)]) - :: +del: delete .key from .a if it exists, producing value iff deleted - :: - ++ del - ~/ %del - |= [a=(tree item) =key] - ^- [(unit val) (tree item)] - ?~ a [~ ~] - :: we found .key at the root; delete and rebalance - :: - ?: =(key key.n.a) - [`val.n.a (nip a)] - :: recurse left or right to find .key - :: - ?: (compare key key.n.a) - =+ [found lef]=$(a l.a) - [found a(l lef)] - =+ [found rig]=$(a r.a) - [found a(r rig)] - :: +dip: stateful partial inorder traversal - :: - :: Mutates .state on each run of .f. Starts at .start key, or if - :: .start is ~, starts at the head. Stops when .f produces .stop=%.y. - :: Traverses from left to right keys. - :: Each run of .f can replace an item's value or delete the item. - :: - ++ dip - ~/ %dip - |* state=mold - |= $: a=(tree item) - =state - f=$-([state item] [(unit val) ? state]) - == - ^+ [state a] - :: acc: accumulator - :: - :: .stop: set to %.y by .f when done traversing - :: .state: threaded through each run of .f and produced by +abet - :: - =/ acc [stop=`?`%.n state=state] - =< abet =< main - |% - ++ this . - ++ abet [state.acc a] - :: +main: main recursive loop; performs a partial inorder traversal - :: - ++ main - ^+ this - :: stop if empty or we've been told to stop - :: - ?: =(~ a) this - ?: stop.acc this - :: inorder traversal: left -> node -> right, until .f sets .stop - :: - =. this left - ?: stop.acc this - =^ del this node - =? this !stop.acc right - =? a del (nip a) - this - :: +node: run .f on .n.a, updating .a, .state, and .stop - :: - ++ node - ^+ [del=*? this] - :: run .f on node, updating .stop.acc and .state.acc - :: - ?> ?=(^ a) - =^ res acc (f state.acc n.a) - ?~ res - [del=& this] - [del=| this(val.n.a u.res)] - :: +left: recurse on left subtree, copying mutant back into .l.a - :: - ++ left - ^+ this - ?~ a this - =/ lef main(a l.a) - lef(a a(l a.lef)) - :: +right: recurse on right subtree, copying mutant back into .r.a - :: - ++ right - ^+ this - ?~ a this - =/ rig main(a r.a) - rig(a a(r a.rig)) - -- - :: +gas: put a list of items - :: - ++ gas - ~/ %gas - |= [a=(tree item) b=(list item)] - ^- (tree item) - ?~ b a - $(b t.b, a (put a i.b)) - :: +get: get val at key or return ~ - :: - ++ get - ~/ %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) - :: +got: need value at key - :: - ++ got - |= [a=(tree item) b=key] - ^- val - (need (get a b)) - :: +has: check for key existence - :: - ++ has - ~/ %has - |= [a=(tree item) b=key] - ^- ? - !=(~ (get a b)) - :: +lot: take a subset range excluding start and/or end and all elements - :: outside the range - :: - ++ lot - ~/ %lot - |= $: 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 ~))) - == - -- - :: +nip: remove root; for internal use - :: - ++ nip - ~/ %nip - |= a=(tree item) - ^- (tree item) - ?> ?=(^ a) - :: delete .n.a; merge and balance .l.a and .r.a - :: - |- ^- (tree item) - ?~ l.a r.a - ?~ r.a l.a - ?: (mor key.n.l.a key.n.r.a) - l.a(r $(l.a r.l.a)) - r.a(l $(r.a l.r.a)) - :: - :: +pop: produce .head (leftmost item) and .rest or crash if empty - :: - ++ pop - ~/ %pop - |= a=(tree item) - ^- [head=item rest=(tree item)] - ?~ a !! - ?~ l.a [n.a r.a] - =/ l $(a l.a) - :- head.l - :: load .rest.l back into .a and rebalance - :: - ?: |(?=(~ rest.l) (mor key.n.a key.n.rest.l)) - a(l rest.l) - rest.l(r a(r r.rest.l)) - :: +pry: produce head (leftmost item) or null - :: - ++ pry - ~/ %pry - |= a=(tree item) - ^- (unit item) - ?~ a ~ - |- - ?~ l.a `n.a - $(a l.a) - :: +put: ordered item insert - :: - ++ put - ~/ %put - |= [a=(tree item) =key =val] - ^- (tree item) - :: base case: replace null with single-item tree - :: - ?~ a [n=[key val] l=~ r=~] - :: base case: overwrite existing .key with new .val - :: - ?: =(key.n.a key) a(val.n val) - :: if item goes on left, recurse left then rebalance vertical order - :: - ?: (compare key key.n.a) - =/ l $(a l.a) - ?> ?=(^ l) - ?: (mor key.n.a key.n.l) - a(l l) - l(r a(l r.l)) - :: item goes on right; recurse right then rebalance vertical order - :: - =/ r $(a r.a) - ?> ?=(^ r) - ?: (mor key.n.a key.n.r) - a(r r) - r(l a(r l.r)) - :: +ram: produce tail (rightmost item) or null - :: - ++ ram - ~/ %ram - |= a=(tree item) - ^- (unit item) - ?~ a ~ - |- - ?~ r.a `n.a - $(a r.a) - :: +run: apply gate to transform all values in place - :: - ++ run - ~/ %run - |* [a=(tree item) b=$-(val *)] - |- - ?~ a a - [n=[key.n.a (b val.n.a)] l=$(a l.a) r=$(a r.a)] - :: +tab: tabulate a subset excluding start element with a max count - :: - ++ tab - ~/ %tab - |= [a=(tree item) b=(unit key) c=@] - ^- (list item) - |^ - (flop e:(tabulate (del-span a b) b c)) - :: - ++ tabulate - |= [a=(tree item) b=(unit key) c=@] - ^- [d=@ e=(list item)] - ?: ?&(?=(~ b) =(c 0)) - [0 ~] - =| f=[d=@ e=(list item)] - |- ^+ f - ?: ?|(?=(~ a) =(d.f c)) f - =. f $(a l.a) - ?: =(d.f c) f - =. f [+(d.f) [n.a e.f]] - ?:(=(d.f c) f $(a r.a)) - :: - ++ del-span - |= [a=(tree item) b=(unit key)] - ^- (tree item) - ?~ a a - ?~ b a - ?: =(key.n.a u.b) - r.a - ?: (compare key.n.a u.b) - $(a r.a) - a(l $(a l.a)) - -- - :: +tap: convert to list, left to right - :: - ++ tap - ~/ %tap - |= a=(tree item) - ^- (list item) - =| b=(list item) - |- ^+ b - ?~ a b - $(a l.a, b [n.a $(a r.a)]) - :: +uni: unify two ordered maps - :: - :: .b takes precedence over .a if keys overlap. - :: - ++ uni - ~/ %uni - |= [a=(tree item) b=(tree item)] - ^- (tree item) - ?~ b a - ?~ a b - ?: =(key.n.a key.n.b) - [n=n.b l=$(a l.a, b l.b) r=$(a r.a, b r.b)] - ?: (mor key.n.a key.n.b) - ?: (compare key.n.b key.n.a) - $(l.a $(a l.a, r.b ~), b r.b) - $(r.a $(a r.a, l.b ~), b l.b) - ?: (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) - -- :: :: :::: ++userlib :: (2u) non-vane utils :: ::::