mirror of
https://github.com/urbit/shrub.git
synced 2024-11-23 20:26:54 +03:00
Merge branch 'algorithm-tests' into merge-yosoyubik-contribs
* algorithm-tests: pills: update solid tests: unit tests for +in (set) tests: unit tests for +to (queue) tests: unit tests for +by (map) tests: unit tests for +differ (diff/merge) hoon: fix for +uno/uni (#1779) set/map union hoon: fix for +apt:to (#1778) queue correctness Signed-off-by: Jared Tobin <jared@tlon.io>
This commit is contained in:
Jared Tobin
commit
ad53e40e99
@ -1,3 +1,3 @@
|
||||
version https://git-lfs.github.com/spec/v1
|
||||
oid sha256:1cbde0698df3e9ed5d2dfd1b1481ad7614c35f81f69ca25900758af20f9d9649
|
||||
size 16538059
|
||||
oid sha256:b596fbf9765b95e43e9e1e6c7e17689f8561d1b9857a32a8a6df102233e07330
|
||||
size 16709622
|
||||
|
||||
@ -1365,8 +1365,6 @@
|
||||
?: (gor n.b n.a)
|
||||
$(a [n.a $(a l.a, b [n.b l.b ~]) r.a], b r.b)
|
||||
$(a [n.a l.a $(a r.a, b [n.b ~ r.b])], b l.b)
|
||||
?: =(n.a n.b)
|
||||
[n.b $(b l.b, a l.a) $(b r.b, a r.a)]
|
||||
?: (gor n.a n.b)
|
||||
$(b [n.b $(b l.b, a [n.a l.a ~]) r.b], a r.a)
|
||||
$(b [n.b l.b $(b r.b, a [n.a ~ r.a])], a l.a)
|
||||
@ -1634,8 +1632,6 @@
|
||||
?: (gor p.n.b p.n.a)
|
||||
$(a [n.a $(a l.a, b [n.b l.b ~]) r.a], b r.b)
|
||||
$(a [n.a l.a $(a r.a, b [n.b ~ r.b])], b l.b)
|
||||
?: =(p.n.a p.n.b)
|
||||
[n.b $(b l.b, a l.a) $(b r.b, a r.a)]
|
||||
?: (gor p.n.a p.n.b)
|
||||
$(b [n.b $(b l.b, a [n.a l.a ~]) r.b], a r.a)
|
||||
$(b [n.b l.b $(b r.b, a [n.a ~ r.a])], a l.a)
|
||||
@ -1653,14 +1649,12 @@
|
||||
b
|
||||
?: (mor p.n.a p.n.b)
|
||||
?: =(p.n.b p.n.a)
|
||||
[n.b $(a l.a, b l.b) $(a r.a, b r.b)]
|
||||
:+ [p.n.a (meg p.n.a q.n.a q.n.b)]
|
||||
$(b l.b, a l.a)
|
||||
$(b r.b, a r.a)
|
||||
?: (gor p.n.b p.n.a)
|
||||
$(a [n.a $(a l.a, b [n.b l.b ~]) r.a], b r.b)
|
||||
$(a [n.a l.a $(a r.a, b [n.b ~ r.b])], b l.b)
|
||||
?: =(p.n.a p.n.b)
|
||||
:+ [p.n.a (meg p.n.a q.n.a q.n.b)]
|
||||
$(b l.b, a l.a)
|
||||
$(b r.b, a r.a)
|
||||
?: (gor p.n.a p.n.b)
|
||||
$(b [n.b $(b l.b, a [n.a l.a ~]) r.b], a r.a)
|
||||
$(b [n.b l.b $(b r.b, a [n.a ~ r.a])], a l.a)
|
||||
@ -1750,12 +1744,11 @@
|
||||
=| a/(tree) :: (qeu)
|
||||
|@
|
||||
++ apt :: check correctness
|
||||
^- ?
|
||||
?~ a &
|
||||
|- ^- ?
|
||||
?~ l.a &
|
||||
?~ r.a &
|
||||
&((mor n.l.a n.r.a) $(a l.a) $(a r.a))
|
||||
?~ a &
|
||||
?& ?~(l.a & ?&((mor n.a n.l.a) $(a l.a)))
|
||||
?~(r.a & ?&((mor n.a n.r.a) $(a r.a)))
|
||||
==
|
||||
::
|
||||
++ bal
|
||||
|- ^+ a
|
||||
|
||||
386
pkg/arvo/tests/sys/hoon/differ.hoon
Normal file
386
pkg/arvo/tests/sys/hoon/differ.hoon
Normal file
@ -0,0 +1,386 @@
|
||||
:: Tests for +differ (a suite of Hunt-McIlroy diff and merge algorithms)
|
||||
::
|
||||
/+ *test
|
||||
::
|
||||
=, differ
|
||||
:: Testing arms
|
||||
::
|
||||
|%
|
||||
:: ++berk:differ: invert diff patch
|
||||
::
|
||||
++ test-berk ^- tang
|
||||
:: An inverted diff between %a and %b can be checked
|
||||
:: by patching %b and obtaining %a
|
||||
::
|
||||
;: weld
|
||||
:: (some) test examples adapted from:
|
||||
:: https://github.com/gioele/diff-lcs/blob/master/test/test_diff-lcs.rb
|
||||
::
|
||||
=/ a "abcehjlmnp"
|
||||
=/ b "bcdefjklmrst"
|
||||
=/ diff-a-b (lusk a b (loss a b))
|
||||
=/ diff-b-a (lusk b a (loss b a))
|
||||
=/ patch-a (lurk b (berk diff-a-b))
|
||||
=/ patch-b (lurk a (berk diff-b-a))
|
||||
%+ expect-eq
|
||||
!> a^b
|
||||
!> patch-a^patch-b
|
||||
::
|
||||
=/ a "abcde"
|
||||
=/ b "ae"
|
||||
=/ diff-a-b (lusk a b (loss a b))
|
||||
=/ diff-b-a (lusk b a (loss b a))
|
||||
=/ patch-a (lurk b (berk diff-a-b))
|
||||
=/ patch-b (lurk a (berk diff-b-a))
|
||||
%+ expect-eq
|
||||
!> a^b
|
||||
!> patch-a^patch-b
|
||||
::
|
||||
=/ a "ae"
|
||||
=/ b "abcde"
|
||||
=/ diff-a-b (lusk a b (loss a b))
|
||||
=/ diff-b-a (lusk b a (loss b a))
|
||||
=/ patch-a (lurk b (berk diff-a-b))
|
||||
=/ patch-b (lurk a (berk diff-b-a))
|
||||
%+ expect-eq
|
||||
!> a^b
|
||||
!> patch-a^patch-b
|
||||
::
|
||||
=/ a "vxae"
|
||||
=/ b "wyabcde"
|
||||
=/ diff-a-b (lusk a b (loss a b))
|
||||
=/ diff-b-a (lusk b a (loss b a))
|
||||
=/ patch-a (lurk b (berk diff-a-b))
|
||||
=/ patch-b (lurk a (berk diff-b-a))
|
||||
%+ expect-eq
|
||||
!> a^b
|
||||
!> patch-a^patch-b
|
||||
::
|
||||
=/ a "xae"
|
||||
=/ b "abcde"
|
||||
=/ diff-a-b (lusk a b (loss a b))
|
||||
=/ diff-b-a (lusk b a (loss b a))
|
||||
=/ patch-a (lurk b (berk diff-a-b))
|
||||
=/ patch-b (lurk a (berk diff-b-a))
|
||||
%+ expect-eq
|
||||
!> a^b
|
||||
!> patch-a^patch-b
|
||||
::
|
||||
=/ a "ae"
|
||||
=/ b "xabcde"
|
||||
=/ diff-a-b (lusk a b (loss a b))
|
||||
=/ diff-b-a (lusk b a (loss b a))
|
||||
=/ patch-a (lurk b (berk diff-a-b))
|
||||
=/ patch-b (lurk a (berk diff-b-a))
|
||||
%+ expect-eq
|
||||
!> a^b
|
||||
!> patch-a^patch-b
|
||||
::
|
||||
=/ a "aev"
|
||||
=/ b "xabcdewx"
|
||||
=/ diff-a-b (lusk a b (loss a b))
|
||||
=/ diff-b-a (lusk b a (loss b a))
|
||||
=/ patch-a (lurk b (berk diff-a-b))
|
||||
=/ patch-b (lurk a (berk diff-b-a))
|
||||
%+ expect-eq
|
||||
!> a^b
|
||||
!> patch-a^patch-b
|
||||
::
|
||||
:: individuals diffs
|
||||
::
|
||||
=/ a "10qawsedrftg"
|
||||
=/ b "1Aqawsedrftg"
|
||||
=/ diff=(urge:clay cord)
|
||||
:~ :: copies first match
|
||||
::
|
||||
[%.y 1]
|
||||
:: replaces 0 with 'A'
|
||||
::
|
||||
[%.n "0" "A"]
|
||||
:: copies the rest
|
||||
::
|
||||
[%.y 10]
|
||||
==
|
||||
%+ expect-eq
|
||||
!> a
|
||||
!> (lurk b (berk diff))
|
||||
::
|
||||
=/ a "1qawsedrftg10"
|
||||
=/ b "1Aqawsedrftg"
|
||||
=/ diff=(urge:clay cord)
|
||||
:~ :: copies first match
|
||||
::
|
||||
[%.y 1]
|
||||
:: inserts 'A'
|
||||
::
|
||||
[%.n ~ "A"]
|
||||
:: copies all matches
|
||||
::
|
||||
[%.y 10]
|
||||
:: copies '10'
|
||||
::
|
||||
[%.n (flop "10") ~]
|
||||
==
|
||||
%+ expect-eq
|
||||
!> a
|
||||
!> (lurk b (berk diff))
|
||||
==
|
||||
::
|
||||
:: ++loss:differ: longest subsequence
|
||||
::
|
||||
++ test-loss ^- tang
|
||||
;: weld
|
||||
:: null case
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> (loss "abc" "xyz")
|
||||
:: common prefix
|
||||
::
|
||||
%+ expect-eq
|
||||
!> "abc"
|
||||
!> (loss "abcq" "abcxyz")
|
||||
%+ expect-eq
|
||||
!> "qaz"
|
||||
!> (loss "qaz" "qazxyz")
|
||||
:: common suffix
|
||||
::
|
||||
%+ expect-eq
|
||||
!> "wsx"
|
||||
!> (loss "qwsx" "xyzwsx")
|
||||
%+ expect-eq
|
||||
!> "edc"
|
||||
!> (loss "edc" "xyzedc")
|
||||
:: overlap
|
||||
::
|
||||
%+ expect-eq
|
||||
!> "rfv"
|
||||
!> (loss "qrfvp" "xyzrfvdef")
|
||||
%+ expect-eq
|
||||
!> "tgb"
|
||||
!> (loss "qwertytgb" "tgbasdfgh")
|
||||
:: Non contiguous
|
||||
::
|
||||
%+ expect-eq
|
||||
:: Example from wikipedia:
|
||||
:: https://en.wikipedia.org/wiki/Longest_common_subsequence_problem
|
||||
::
|
||||
!> "MJAU"
|
||||
!> (loss "XMJYAUZ" "MZJAWXU")
|
||||
%+ expect-eq
|
||||
!> "qawsxcf"
|
||||
!> (loss "qazwsxedcrfvtb" "qqqawsxcf")
|
||||
==
|
||||
::
|
||||
:: ++lurk:differ: apply list patch
|
||||
::
|
||||
++ test-lurk ^- tang
|
||||
;: weld
|
||||
:: (some) test examples adapted from:
|
||||
:: https://github.com/gioele/diff-lcs/blob/master/test/test_diff-lcs.rb
|
||||
::
|
||||
=/ a "abcehjlmnp"
|
||||
=/ b "bcdefjklmrst"
|
||||
=/ diff-a-b (lusk a b (loss a b))
|
||||
=/ diff-b-a (lusk b a (loss b a))
|
||||
=/ patch-b (lurk a diff-a-b)
|
||||
=/ patch-a (lurk b diff-b-a)
|
||||
%+ expect-eq
|
||||
!> a^b
|
||||
!> patch-a^patch-b
|
||||
::
|
||||
=/ a "abcde"
|
||||
=/ b "ae"
|
||||
=/ diff-a-b (lusk a b (loss a b))
|
||||
=/ diff-b-a (lusk b a (loss b a))
|
||||
=/ patch-b (lurk a diff-a-b)
|
||||
=/ patch-a (lurk b diff-b-a)
|
||||
%+ expect-eq
|
||||
!> a^b
|
||||
!> patch-a^patch-b
|
||||
::
|
||||
=/ a "ae"
|
||||
=/ b "abcde"
|
||||
=/ diff-a-b (lusk a b (loss a b))
|
||||
=/ diff-b-a (lusk b a (loss b a))
|
||||
=/ patch-b (lurk a diff-a-b)
|
||||
=/ patch-a (lurk b diff-b-a)
|
||||
%+ expect-eq
|
||||
!> a^b
|
||||
!> patch-a^patch-b
|
||||
::
|
||||
=/ a "vxae"
|
||||
=/ b "wyabcde"
|
||||
=/ diff-a-b (lusk a b (loss a b))
|
||||
=/ diff-b-a (lusk b a (loss b a))
|
||||
=/ patch-b (lurk a diff-a-b)
|
||||
=/ patch-a (lurk b diff-b-a)
|
||||
%+ expect-eq
|
||||
!> a^b
|
||||
!> patch-a^patch-b
|
||||
::
|
||||
=/ a "xae"
|
||||
=/ b "abcde"
|
||||
=/ diff-a-b (lusk a b (loss a b))
|
||||
=/ diff-b-a (lusk b a (loss b a))
|
||||
=/ patch-b (lurk a diff-a-b)
|
||||
=/ patch-a (lurk b diff-b-a)
|
||||
%+ expect-eq
|
||||
!> a^b
|
||||
!> patch-a^patch-b
|
||||
::
|
||||
=/ a "ae"
|
||||
=/ b "xabcde"
|
||||
=/ diff-a-b (lusk a b (loss a b))
|
||||
=/ diff-b-a (lusk b a (loss b a))
|
||||
=/ patch-b (lurk a diff-a-b)
|
||||
=/ patch-a (lurk b diff-b-a)
|
||||
%+ expect-eq
|
||||
!> a^b
|
||||
!> patch-a^patch-b
|
||||
::
|
||||
=/ a "aev"
|
||||
=/ b "xabcdewx"
|
||||
=/ diff-a-b (lusk a b (loss a b))
|
||||
=/ diff-b-a (lusk b a (loss b a))
|
||||
=/ patch-b (lurk a diff-a-b)
|
||||
=/ patch-a (lurk b diff-b-a)
|
||||
%+ expect-eq
|
||||
!> a^b
|
||||
!> patch-a^patch-b
|
||||
::
|
||||
:: individuals diffs
|
||||
::
|
||||
=/ a "10qawsedrftg"
|
||||
=/ b "1Aqawsedrftg"
|
||||
=/ diff=(urge:clay cord)
|
||||
:~ :: copies first match
|
||||
::
|
||||
[%.y 1]
|
||||
:: replaces 0 with 'A'
|
||||
::
|
||||
[%.n "0" "A"]
|
||||
:: copies the rest
|
||||
::
|
||||
[%.y 10]
|
||||
==
|
||||
%+ expect-eq
|
||||
!> b
|
||||
!> (lurk a diff)
|
||||
::
|
||||
=/ a "1qawsedrftg10"
|
||||
=/ b "1Aqawsedrftg"
|
||||
=/ diff=(urge:clay cord)
|
||||
:~ :: copies first match
|
||||
::
|
||||
[%.y 1]
|
||||
:: inserts 'A'
|
||||
::
|
||||
[%.n ~ "A"]
|
||||
:: copies all matches
|
||||
::
|
||||
[%.y 10]
|
||||
:: copies '10'
|
||||
::
|
||||
[%.n (flop "10") ~]
|
||||
==
|
||||
%+ expect-eq
|
||||
!> b
|
||||
!> (lurk a diff)
|
||||
==
|
||||
:: ++lusk:differ: lcs to list patch
|
||||
::
|
||||
++ test-lusk ^- tang
|
||||
;: weld
|
||||
:: (some) test examples adapted from:
|
||||
:: https://github.com/gioele/diff-lcs/blob/master/test/test_diff-lcs.rb
|
||||
::
|
||||
=/ a "abcehjlmnp"
|
||||
=/ b "bcdefjklmrst"
|
||||
=/ diff
|
||||
:~ [%.n ~['a'] ~]
|
||||
[%.y 2]
|
||||
[%.n ~ ~['d']]
|
||||
[%.y 1]
|
||||
[%.n ~['h'] ~['f']]
|
||||
[%.y 1]
|
||||
[%.n ~ ~['k']]
|
||||
[%.y 2]
|
||||
[%.n (flop "np") (flop "rst")]
|
||||
==
|
||||
%+ expect-eq
|
||||
!> diff
|
||||
!> (lusk a b (loss a b))
|
||||
::
|
||||
=/ a "abcde"
|
||||
=/ b "ae"
|
||||
=/ diff
|
||||
:~ [%.y 1]
|
||||
[%.n (flop "bcd") ~]
|
||||
[%.y 1]
|
||||
==
|
||||
%+ expect-eq
|
||||
!> diff
|
||||
!> (lusk a b (loss a b))
|
||||
::
|
||||
=/ a "ae"
|
||||
=/ b "abcde"
|
||||
=/ diff
|
||||
:~ [%.y 1]
|
||||
[%.n ~ (flop "bcd")]
|
||||
[%.y 1]
|
||||
==
|
||||
%+ expect-eq
|
||||
!> diff
|
||||
!> (lusk a b (loss a b))
|
||||
::
|
||||
=/ a "vxae"
|
||||
=/ b "wyabcde"
|
||||
=/ diff
|
||||
:~ [%.n (flop "vx") (flop "wy")]
|
||||
[%.y 1]
|
||||
[%.n ~ (flop "bcd")]
|
||||
[%.y 1]
|
||||
==
|
||||
%+ expect-eq
|
||||
!> diff
|
||||
!> (lusk a b (loss a b))
|
||||
::
|
||||
=/ a "xae"
|
||||
=/ b "abcde"
|
||||
=/ diff
|
||||
:~ [%.n "x" ~]
|
||||
[%.y 1]
|
||||
[%.n ~ (flop "bcd")]
|
||||
[%.y 1]
|
||||
==
|
||||
%+ expect-eq
|
||||
!> diff
|
||||
!> (lusk a b (loss a b))
|
||||
::
|
||||
=/ a "ae"
|
||||
=/ b "xabcde"
|
||||
=/ diff
|
||||
:~ [%.n ~ "x"]
|
||||
[%.y 1]
|
||||
[%.n ~ (flop "bcd")]
|
||||
[%.y 1]
|
||||
==
|
||||
%+ expect-eq
|
||||
!> diff
|
||||
!> (lusk a b (loss a b))
|
||||
::
|
||||
=/ a "aev"
|
||||
=/ b "xabcdewx"
|
||||
=/ diff
|
||||
:~ [%.n ~ "x"]
|
||||
[%.y 1]
|
||||
[%.n ~ (flop "bcd")]
|
||||
[%.y 1]
|
||||
[%.n "v" (flop "wx")]
|
||||
==
|
||||
%+ expect-eq
|
||||
!> diff
|
||||
!> (lusk a b (loss a b))
|
||||
==
|
||||
--
|
||||
747
pkg/arvo/tests/sys/hoon/map.hoon
Normal file
747
pkg/arvo/tests/sys/hoon/map.hoon
Normal file
@ -0,0 +1,747 @@
|
||||
:: Tests for +by (map logic)
|
||||
::
|
||||
/+ *test
|
||||
::
|
||||
=> :: Utility core
|
||||
::
|
||||
|%
|
||||
++ map-of-doubles
|
||||
|= l=(list @)
|
||||
^- (map @ @)
|
||||
%- my
|
||||
^- (list (pair @ @))
|
||||
%+ turn l
|
||||
|= k=@
|
||||
[k (mul 2 k)]
|
||||
--
|
||||
::
|
||||
=> :: Test Data
|
||||
::
|
||||
|%
|
||||
+| %test-suite
|
||||
++ m-uno (map-of-doubles ~[42])
|
||||
++ m-dos (map-of-doubles ~[6 9])
|
||||
++ m-tre (map-of-doubles ~[1 0 1])
|
||||
++ m-asc (map-of-doubles ~[1 2 3 4 5 6 7])
|
||||
++ m-des (map-of-doubles ~[7 6 5 4 3 2 1])
|
||||
++ m-uns (map-of-doubles ~[1 6 3 5 7 2 4])
|
||||
++ m-dup (map-of-doubles ~[1 1 7 4 6 9 4])
|
||||
++ m-nul *(map @ @)
|
||||
++ m-lis ~[m-nul m-uno m-dos m-tre m-asc m-des m-uns m-dup]
|
||||
--
|
||||
:: Testing arms
|
||||
::
|
||||
|%
|
||||
:: Test logical AND
|
||||
::
|
||||
++ test-map-all ^- tang
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%+ expect-eq
|
||||
!> %.y
|
||||
!> (~(all by m-nul) |=(* &))
|
||||
%+ expect-eq
|
||||
!> %.y
|
||||
!> (~(all by m-nul) |=(* |))
|
||||
:: Checks one element fails
|
||||
::
|
||||
%+ expect-eq
|
||||
!> %.n
|
||||
!> (~(all by m-uno) |=(e=@ =(e 43)))
|
||||
:: Checks >1 element fails
|
||||
::
|
||||
%+ expect-eq
|
||||
!> %.n
|
||||
!> (~(all by m-dos) |=(e=@ (lth e 4)))
|
||||
:: Checks all elements pass
|
||||
::
|
||||
%+ expect-eq
|
||||
!> %.y
|
||||
!> (~(all by m-des) |=(e=@ (lth e 80)))
|
||||
==
|
||||
::
|
||||
:: Test logical OR
|
||||
::
|
||||
++ test-map-any ^- tang
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%+ expect-eq
|
||||
!> %.n
|
||||
!> (~(any by m-nul) |=(* &))
|
||||
%+ expect-eq
|
||||
!> %.n
|
||||
!> (~(any by m-nul) |=(* |))
|
||||
:: Checks one element fails
|
||||
::
|
||||
%+ expect-eq
|
||||
!> %.n
|
||||
!> (~(any by m-uno) |=(e=@ =(e 43)))
|
||||
:: Checks >1 element fails
|
||||
::
|
||||
%+ expect-eq
|
||||
!> %.n
|
||||
!> (~(any by m-dos) |=(e=@ (lth e 4)))
|
||||
:: Checks one element passes
|
||||
::
|
||||
%+ expect-eq
|
||||
!> %.y
|
||||
!> (~(any by m-des) |=(e=@ =(e 14)))
|
||||
:: Checks all element pass
|
||||
::
|
||||
%+ expect-eq
|
||||
!> %.y
|
||||
!> (~(any by m-des) |=(e=@ (lth e 100)))
|
||||
==
|
||||
::
|
||||
:: Test check correctnes (correct horizontal & vertical order)
|
||||
::
|
||||
++ test-map-apt ^- tang
|
||||
:: manually constructed maps with predefined vertical/horizontal
|
||||
:: ordering
|
||||
::
|
||||
:: for the following three keys (1, 2, 3) the vertical priorities are:
|
||||
:: > (mug (mug 1))
|
||||
:: 1.405.103.437
|
||||
:: > (mug (mug 2))
|
||||
:: 1.200.431.393
|
||||
:: > (mug (mug 3))
|
||||
:: 1.576.941.407
|
||||
::
|
||||
:: and the ordering 2 < 1 < 3
|
||||
:: a correctly balanced tree stored as a min-heap
|
||||
:: should have key=2 as the root
|
||||
::
|
||||
:: The horizontal priorities are:
|
||||
:: > (mug 1)
|
||||
:: 1.901.865.568
|
||||
:: > (mug 2)
|
||||
:: 1.904.972.904
|
||||
:: > (mug 3)
|
||||
:: 1.923.673.882
|
||||
::
|
||||
:: and the ordering 1 < 2 < 3.
|
||||
::
|
||||
:: 1 should be in the left brach and 3 in the right one.
|
||||
::
|
||||
=/ balanced-a=(map @ @) [[2 2] [[1 1] ~ ~] [[3 3] ~ ~]]
|
||||
:: doesn't follow vertical ordering
|
||||
::
|
||||
=/ unbalanced-a=(map @ @) [[1 1] [[2 2] ~ ~] [[3 3] ~ ~]]
|
||||
=/ unbalanced-b=(map @ @) [[1 1] ~ [[2 2] ~ ~]]
|
||||
=/ unbalanced-c=(map @ @) [[1 1] [[2 2] ~ ~] ~]
|
||||
:: doesn't follow horizontal ordering
|
||||
::
|
||||
=/ unbalanced-d=(map @ @) [[2 2] [[3 3] ~ ~] [[1 1] ~ ~]]
|
||||
:: doesn't follow horizontal & vertical ordering
|
||||
::
|
||||
=/ unbalanced-e=(map @ @) [[1 1] [[3 3] ~ ~] [[2 2] ~ ~]]
|
||||
;: weld
|
||||
%+ expect-eq
|
||||
!> [%b-a %.y]
|
||||
!> [%b-a ~(apt by balanced-a)]
|
||||
%+ expect-eq
|
||||
!> [%u-a %.n]
|
||||
!> [%u-a ~(apt by unbalanced-a)]
|
||||
%+ expect-eq
|
||||
!> [%u-b %.n]
|
||||
!> [%u-b ~(apt by unbalanced-b)]
|
||||
%+ expect-eq
|
||||
!> [%u-c %.n]
|
||||
!> [%u-c ~(apt by unbalanced-c)]
|
||||
%+ expect-eq
|
||||
!> [%u-d %.n]
|
||||
!> [%u-d ~(apt by unbalanced-d)]
|
||||
%+ expect-eq
|
||||
!> [%u-e %.n]
|
||||
!> [%u-e ~(apt by unbalanced-e)]
|
||||
==
|
||||
::
|
||||
:: Test bifurcation (i.e. splits map a into two, discarding -.a)
|
||||
::
|
||||
++ test-map-bif ^- tang
|
||||
:: The traversal of the +map is done comparing the double +mug
|
||||
:: of the key of the added node and the one from the tree.
|
||||
:: Because of this, the search will stop at different leaves,
|
||||
:: based on the value of the hash, therefore the right and left
|
||||
:: maps that are returned can be different
|
||||
:: (null or a less than the total number of nodes)
|
||||
:: The best way to check is that the sum of the number of nodes
|
||||
:: in both maps are the same as before, and that both returned
|
||||
:: maps are correct
|
||||
::
|
||||
=/ splits-a=[(map) (map)] (~(bif by m-des) [99 99])
|
||||
=/ splits-b=[(map) (map)] (~(bif by m-des) [6 12])
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%+ expect-eq
|
||||
!> [~ ~]
|
||||
!> (~(bif by m-nul) [1 2])
|
||||
:: Checks bifurcating by non-existing element
|
||||
::
|
||||
%+ expect-eq
|
||||
!> 7
|
||||
!> (add ~(wyt by -.splits-a) ~(wyt by +.splits-a))
|
||||
%+ expect-eq
|
||||
!> %.y
|
||||
!> &(~(apt by -.splits-a) ~(apt by +.splits-a))
|
||||
:: Checks splitting by existing element
|
||||
::
|
||||
%+ expect-eq
|
||||
!> 6
|
||||
!> (add ~(wyt by -.splits-b) ~(wyt by +.splits-b))
|
||||
%+ expect-eq
|
||||
!> %.y
|
||||
!> &(~(apt by -.splits-b) ~(apt by +.splits-b))
|
||||
=/ left (~(get by -.splits-b) [6 12])
|
||||
=/ right (~(get by +.splits-b) [6 12])
|
||||
%+ expect-eq
|
||||
!> %.y
|
||||
!> &(=(left ~) =(right ~))
|
||||
==
|
||||
::
|
||||
:: Test delete at key b
|
||||
::
|
||||
++ test-map-del ^- tang
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> (~(del by m-nul) 1)
|
||||
:: Checks deleting non-existing element
|
||||
::
|
||||
%+ expect-eq
|
||||
!> m-des
|
||||
!> (~(del by m-des) 99)
|
||||
:: Checks deleting the only element
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> (~(del by m-uno) 42)
|
||||
:: Checks deleting one element
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (map-of-doubles (limo ~[6 5 4 3 2 1]))
|
||||
!> (~(del by m-des) 7)
|
||||
==
|
||||
::
|
||||
:: Test difference (removes elements of a present in b)
|
||||
::
|
||||
++ test-map-dif ^- tang
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> (~(dif by ~) ~)
|
||||
%+ expect-eq
|
||||
!> m-dup
|
||||
!> (~(dif by m-dup) m-nul)
|
||||
:: Checks same elements, different ordering
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> (~(dif by m-asc) m-des)
|
||||
:: Checks different map length
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (my ~[[7 14] [1 2] [4 8]])
|
||||
!> (~(dif by m-dup) m-dos)
|
||||
:: Checks no elements in common
|
||||
::
|
||||
%+ expect-eq
|
||||
!> m-uno
|
||||
!> (~(dif by m-uno) m-dos)
|
||||
==
|
||||
::
|
||||
:: Test axis of a in b
|
||||
::
|
||||
++ test-map-dig ^- tang
|
||||
=/ custom [[2 4] [[1 2] ~ ~] [[3 6] ~ ~]]
|
||||
=/ custome-vase !>(custom)
|
||||
=/ manual-map=(map @ @) custom
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> (~(dig by m-nul) 6)
|
||||
:: Checks with non-existing key
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> (~(dig by m-des) 9)
|
||||
:: Checks success via tree addressing. Uses the return axis
|
||||
:: to address the raw noun and check that it gives the corresponding
|
||||
:: value from the key.
|
||||
::
|
||||
%+ expect-eq
|
||||
!> [1 (~(got by manual-map) 1)]
|
||||
!> +:(slot (need (~(dig by manual-map) 1)) custome-vase)
|
||||
%+ expect-eq
|
||||
!> [2 (~(got by manual-map) 2)]
|
||||
!> +:(slot (need (~(dig by manual-map) 2)) custome-vase)
|
||||
%+ expect-eq
|
||||
!> [3 (~(got by manual-map) 3)]
|
||||
!> +:(slot (need (~(dig by manual-map) 3)) custome-vase)
|
||||
==
|
||||
::
|
||||
:: Test concatenate
|
||||
::
|
||||
++ test-map-gas ^- tang
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%+ expect-eq
|
||||
!> m-dos
|
||||
!> (~(gas by m-nul) ~[[6 12] [9 18]])
|
||||
:: Checks with > 1 element
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (map-of-doubles (limo ~[42 10]))
|
||||
!> (~(gas by m-uno) [10 20]~)
|
||||
:: Checks appending >1 elements
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (map-of-doubles (limo ~[6 9 3 4 5 7]))
|
||||
!> (~(gas by m-dos) ~[[3 6] [4 8] [5 10] [7 14]])
|
||||
:: Checks concatenating existing elements
|
||||
::
|
||||
%+ expect-eq
|
||||
!> m-des
|
||||
!> (~(gas by m-des) ~[[3 6] [4 8] [5 10] [7 14]])
|
||||
==
|
||||
::
|
||||
:: Test grab value by key
|
||||
::
|
||||
++ test-map-get ^- tang
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> (~(get by m-nul) 6)
|
||||
:: Checks with non-existing key
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> (~(get by m-des) 9)
|
||||
:: Checks success
|
||||
::
|
||||
%+ expect-eq
|
||||
!> `14
|
||||
!> (~(get by m-des) 7)
|
||||
==
|
||||
::
|
||||
:: Test need value by key
|
||||
::
|
||||
++ test-map-got ^- tang
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%- expect-fail
|
||||
|. (~(got by m-nul) 6)
|
||||
:: Checks with non-existing key
|
||||
::
|
||||
%- expect-fail
|
||||
|. (~(got by m-des) 9)
|
||||
:: Checks success
|
||||
::
|
||||
%+ expect-eq
|
||||
!> 14
|
||||
!> (~(got by m-des) 7)
|
||||
==
|
||||
::
|
||||
:: Test fall value by key
|
||||
::
|
||||
++ test-map-gut ^- tang
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%+ expect-eq
|
||||
!> 42
|
||||
!> (~(gut by m-nul) 6 42)
|
||||
:: Checks with non-existing key
|
||||
::
|
||||
%+ expect-eq
|
||||
!> 42
|
||||
!> (~(gut by m-des) 9 42)
|
||||
:: Checks success
|
||||
::
|
||||
%+ expect-eq
|
||||
!> 14
|
||||
!> (~(gut by m-des) 7 42)
|
||||
==
|
||||
::
|
||||
:: Test +has: does :b exist in :a?
|
||||
::
|
||||
++ test-map-has ^- tang
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%+ expect-eq
|
||||
!> %.n
|
||||
!> (~(has by m-nul) 6)
|
||||
:: Checks with non-existing key
|
||||
::
|
||||
%+ expect-eq
|
||||
!> %.n
|
||||
!> (~(has by m-des) 9)
|
||||
:: Checks success
|
||||
::
|
||||
%+ expect-eq
|
||||
!> %.y
|
||||
!> (~(has by m-des) 7)
|
||||
==
|
||||
::
|
||||
:: Test intersection
|
||||
::
|
||||
++ test-map-int ^- tang
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> (~(int by m-nul) m-des)
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> (~(int by m-des) m-nul)
|
||||
:: Checks with all keys different
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> (~(int by m-dos) m-uno)
|
||||
:: Checks success (total intersection)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> m-asc
|
||||
!> (~(int by m-asc) m-des)
|
||||
:: Checks success (partial intersection)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (map-of-doubles (limo ~[1 7 4 6]))
|
||||
!> (~(int by m-des) m-dup)
|
||||
:: Checks replacing value from b
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (my [6 99]~)
|
||||
!> (~(int by m-dos) (my [6 99]~))
|
||||
==
|
||||
::
|
||||
:: Test search for a specific key and modifies
|
||||
:: its value with the result of the provided gate
|
||||
::
|
||||
++ test-map-jab ^- tang
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%- expect-fail
|
||||
|. (~(jab by m-nul) 2 dec)
|
||||
:: Checks success, by modifying
|
||||
:: [2 4] to [2 3]
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (my ~[[1 2] [2 3] [3 6] [4 8] [5 10] [6 12] [7 14]])
|
||||
!> (~(jab by m-asc) 2 dec)
|
||||
==
|
||||
::
|
||||
:: Test produce set of keys
|
||||
::
|
||||
++ test-map-key ^- tang
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> ~(key by m-nul)
|
||||
:: Checks when creating a map from a list with duplicates
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (sy ~[1 1 7 4 6 9 4])
|
||||
!> ~(key by m-dup)
|
||||
:: Checks correctness
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (sy ~[1 2 3 4 5 6 7])
|
||||
!> ~(key by m-des)
|
||||
==
|
||||
::
|
||||
:: Test add key-value pair with validation (the value is a nonempty unit)
|
||||
::
|
||||
++ test-map-mar ^- tang
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (my [6 12]~)
|
||||
!> (~(mar by m-nul) 6 `12)
|
||||
:: Checks with empty value (deletes the key)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (~(del by m-des) 6)
|
||||
!> (~(mar by m-des) 6 ~)
|
||||
:: Checks success (when key exists)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (my ~[[6 12] [9 99]])
|
||||
!> (~(mar by m-dos) 9 `99)
|
||||
:: Checks success (when key does not exist)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (~(put by m-des) [90 23])
|
||||
!> (~(mar by m-des) 90 `23)
|
||||
==
|
||||
::
|
||||
:: Test add key-value pair
|
||||
::
|
||||
++ test-map-put ^- tang
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (my [6 12]~)
|
||||
!> (~(put by m-nul) 6 12)
|
||||
:: Checks with existing key
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (my ~[[6 99] [9 18]])
|
||||
!> (~(put by m-dos) 6 99)
|
||||
:: Checks success (new key)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (my ~[[42 84] [9 99]])
|
||||
!> (~(put by m-uno) 9 99)
|
||||
==
|
||||
::
|
||||
:: Test replace by product
|
||||
::
|
||||
++ test-map-rep ^- tang
|
||||
:: Accumulates differences between keys and values
|
||||
::
|
||||
=/ rep-gate |=([a=[@ @] b=@] (add b (sub +.a -.a)))
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%+ expect-eq
|
||||
!> b=0
|
||||
!> (~(rep by m-nul) rep-gate)
|
||||
:: Checks success
|
||||
::
|
||||
%+ expect-eq
|
||||
:: m-asc => {[5 10] [7 14] [6 12] [1 2] [2 4] [3 6] [4 8]}
|
||||
:: acc => 12-6+10-5+14-7+8-4+6-3+4-2+2-1 => 28
|
||||
!> b=28
|
||||
!> (~(rep by m-asc) rep-gate)
|
||||
==
|
||||
::
|
||||
:: Test Test transform + product
|
||||
::
|
||||
++ test-map-rib ^- tang
|
||||
:: Accumulates multiples in an array and drains the pairs
|
||||
:: whose values are double of their keys.
|
||||
::
|
||||
=/ rib-gate
|
||||
|= [a=[@ @] acc=(list @)]
|
||||
:- (weld acc ~[(div +.a -.a)])
|
||||
?: =(2 (div +.a -.a))
|
||||
[-.a 0]
|
||||
a
|
||||
=/ list-of-2s (reap 7 2)
|
||||
=/ zeroed-map (my ~[[1 0] [2 0] [3 0] [4 0] [5 0] [6 0] [7 0]])
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%+ expect-eq
|
||||
!> [~ ~]
|
||||
!> (~(rib by m-nul) *(list @) rib-gate)
|
||||
:: Checks success
|
||||
::
|
||||
%+ expect-eq
|
||||
!> [list-of-2s zeroed-map]
|
||||
!> (~(rib by m-asc) *(list @) rib-gate)
|
||||
==
|
||||
::
|
||||
:: Test apply gate to values
|
||||
::
|
||||
++ test-map-run ^- tang
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> (~(run by m-nul) dec)
|
||||
:: Checks success
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (my ~[[1 1] [2 3] [3 5] [4 7] [5 9] [6 11] [7 13]])
|
||||
!> (~(run by m-asc) dec)
|
||||
==
|
||||
::
|
||||
:: Test apply gate to nodes
|
||||
::
|
||||
++ test-map-rut ^- tang
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> (~(rut by m-nul) add)
|
||||
:: Checks success
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (my ~[[1 3] [2 6] [3 9] [4 12] [5 15] [6 18] [7 21]])
|
||||
!> (~(rut by m-asc) add)
|
||||
==
|
||||
::
|
||||
:: Test listify pairs
|
||||
::
|
||||
++ test-map-tap ^- tang
|
||||
=/ by-key |=([[k=@ v=@] [q=@ w=@]] (gth k q))
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> ~(tap by ~)
|
||||
:: Checks success with 2 pairs
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (sort ~[[9 18] [6 12]] by-key)
|
||||
!> (sort ~(tap by m-dos) by-key)
|
||||
:: Checks success with 7 pairs
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (sort ~[[1 2] [2 4] [3 6] [4 8] [5 10] [7 14] [6 12]] by-key)
|
||||
!> (sort ~(tap by m-asc) by-key)
|
||||
:: Checks success with 5 pairs (from list with duplicates)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (sort ~[[7 14] [6 12] [9 18] [1 2] [4 8]] by-key)
|
||||
!> (sort ~(tap by m-dup) by-key)
|
||||
==
|
||||
::
|
||||
:: Test the union of maps
|
||||
::
|
||||
++ test-map-uni ^- tang
|
||||
;: weld
|
||||
:: Checks with empty map (a or b)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> m-des
|
||||
!> (~(uni by m-nul) m-des)
|
||||
%+ expect-eq
|
||||
!> m-des
|
||||
!> (~(uni by m-des) m-nul)
|
||||
:: Checks with disjoint keys
|
||||
::
|
||||
=/ keys (limo ~[1 2 3 4 5 6 7 8])
|
||||
=/ a=(map @ @) (map-of-doubles (scag 4 keys))
|
||||
=/ b=(map @ @) (map-of-doubles (slag 4 keys))
|
||||
%+ expect-eq
|
||||
!> (map-of-doubles keys)
|
||||
!> (~(uni by a) b)
|
||||
:: Checks union of sets with all keys equal
|
||||
::
|
||||
%+ expect-eq
|
||||
!> m-asc
|
||||
!> (~(uni by m-asc) m-des)
|
||||
:: Checks union with value replacement from b
|
||||
::
|
||||
=/ c=(map @ @) (my [1 12]~)
|
||||
=/ d=(map @ @) (my [1 24]~)
|
||||
%+ expect-eq
|
||||
!> d
|
||||
!> (~(uni by c) d)
|
||||
==
|
||||
::
|
||||
:: Test general union
|
||||
::
|
||||
++ test-map-uno ^- tang
|
||||
=/ union-gate |=([k=@ v=@ w=@] (add v w))
|
||||
;: weld
|
||||
:: +uno:by arm test
|
||||
::
|
||||
:: Checks with empty map (a or b)
|
||||
::
|
||||
%- expect-fail
|
||||
|. ((~(uno by m-nul) m-des) union-gate)
|
||||
%+ expect-eq
|
||||
!> m-des
|
||||
!> ((~(uno by m-des) m-nul) union-gate)
|
||||
:: Checks with all keys different
|
||||
::
|
||||
=/ keys (limo ~[1 2 3 4 5 6 7 8])
|
||||
=/ a=(map @ @) (map-of-doubles (scag 4 keys))
|
||||
=/ b=(map @ @) (map-of-doubles (slag 4 keys))
|
||||
%+ expect-eq
|
||||
!> (map-of-doubles keys)
|
||||
!> ((~(uno by a) b) union-gate)
|
||||
:: Checks total union
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (my ~[[1 4] [2 8] [3 12] [4 16] [5 20] [6 24] [7 28]])
|
||||
!> ((~(uno by m-asc) m-des) union-gate)
|
||||
:: Checks partial union
|
||||
::
|
||||
=/ a=(map @ @) (my ~[[1 9] [7 3] [8 5]])
|
||||
=/ b=(map @ @) (my ~[[1 2] [7 2]])
|
||||
%+ expect-eq
|
||||
!> (my ~[[1 11] [7 5] [8 5]])
|
||||
!> ((~(uno by a) b) union-gate)
|
||||
==
|
||||
::
|
||||
:: Test apply gate to nodes (duplicates +rut)
|
||||
::
|
||||
++ test-map-urn ^- tang
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> (~(urn by m-nul) add)
|
||||
:: Checks success
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (my ~[[1 3] [2 6] [3 9] [4 12] [5 15] [6 18] [7 21]])
|
||||
!> (~(urn by m-asc) add)
|
||||
==
|
||||
::
|
||||
:: Test produce list of vals
|
||||
::
|
||||
++ test-map-val ^- tang
|
||||
=/ double |=(e=@ (mul 2 e))
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> ~(val by m-nul)
|
||||
:: Checks when creating a set from a list with duplicates
|
||||
::
|
||||
=/ a=(list @) ~(tap in (sy ~[1 1 7 4 6 9 4]))
|
||||
%+ expect-eq
|
||||
!> (sort (turn a double) gth)
|
||||
!> (sort ~(val by m-dup) gth)
|
||||
:: Checks success
|
||||
::
|
||||
=/ b=(list @) ~(tap in (sy (gulf 1 7)))
|
||||
%+ expect-eq
|
||||
!> (sort (turn b double) gth)
|
||||
!> (sort ~(val by m-asc) gth)
|
||||
==
|
||||
::
|
||||
:: Tests the size of map
|
||||
::
|
||||
++ test-map-wyt ^- tang
|
||||
:: Runs all the tests in the suite
|
||||
::
|
||||
=/ sizes=(list @)
|
||||
%+ turn m-lis
|
||||
|=(m=(map @ @) ~(wyt by m))
|
||||
%+ expect-eq
|
||||
!> sizes
|
||||
!> (limo ~[0 1 2 2 7 7 7 5])
|
||||
--
|
||||
357
pkg/arvo/tests/sys/hoon/qeu.hoon
Normal file
357
pkg/arvo/tests/sys/hoon/qeu.hoon
Normal file
@ -0,0 +1,357 @@
|
||||
:: Tests for +to (queue logic)
|
||||
::
|
||||
/+ *test
|
||||
::
|
||||
=> :: Test Data
|
||||
::
|
||||
|%
|
||||
+| %test-suite
|
||||
++ l-uno ~[42]
|
||||
++ l-dos ~[6 9]
|
||||
++ l-tre ~[1 0 1]
|
||||
++ l-tri ~[1 2 3]
|
||||
++ l-tra ~[3 2 1]
|
||||
++ l-asc ~[1 2 3 4 5 6 7]
|
||||
++ l-des ~[7 6 5 4 3 2 1]
|
||||
++ l-uns ~[1 6 3 5 7 2 4]
|
||||
++ l-dup ~[1 1 7 4 6 9 4]
|
||||
:: Each entry in the test suite is tagged to identify
|
||||
:: the +to arm that fails with a specific queue.
|
||||
::
|
||||
++ q-nul [%nul (~(gas to *(qeu)) ~)]
|
||||
++ q-uno [%uno (~(gas to *(qeu)) l-uno)]
|
||||
++ q-dos [%dos (~(gas to *(qeu)) l-dos)]
|
||||
++ q-tre [%tre (~(gas to *(qeu)) l-tre)]
|
||||
++ q-tri [%tri (~(gas to *(qeu)) l-tri)]
|
||||
++ q-tra [%tra (~(gas to *(qeu)) l-tra)]
|
||||
++ q-asc [%asc (~(gas to *(qeu)) l-asc)]
|
||||
++ q-des [%des (~(gas to *(qeu)) l-des)]
|
||||
++ q-uns [%uns (~(gas to *(qeu)) l-uns)]
|
||||
++ q-dup [%dup (~(gas to *(qeu)) l-dup)]
|
||||
+| %grouped-data
|
||||
++ queues ^- (list [term (qeu)])
|
||||
:~ q-uno q-dos q-tre
|
||||
q-tri q-tra q-asc
|
||||
q-des q-uns q-dup
|
||||
==
|
||||
++ lists ^- (list (list))
|
||||
:~ l-uno l-dos l-tre
|
||||
l-tri l-tra l-asc
|
||||
l-des l-uns l-dup
|
||||
==
|
||||
--
|
||||
:: Testing arms
|
||||
::
|
||||
|%
|
||||
:: Test check correctness
|
||||
::
|
||||
++ test-queue-apt ^- tang
|
||||
:: Manually constructed queues with predefined vertical ordering
|
||||
:: for the following three elements (1, 2, 3) the priorities are:
|
||||
:: > (mug (mug 1))
|
||||
:: 1.405.103.437
|
||||
:: > (mug (mug 2))
|
||||
:: 1.200.431.393
|
||||
:: > (mug (mug 3))
|
||||
:: 1.576.941.407
|
||||
::
|
||||
:: and the ordering 2 < 1 < 3
|
||||
:: a correctly balanced tree stored as a min-heap
|
||||
:: should have 2 as the root
|
||||
::
|
||||
=/ balanced-a=(qeu @) [2 [3 ~ ~] [1 ~ ~]]
|
||||
=/ balanced-b=(qeu @) [2 [1 ~ ~] [3 ~ ~]]
|
||||
=/ unbalanced-a=(qeu @) [3 [2 ~ ~] [1 ~ ~]]
|
||||
=/ unbalanced-b=(qeu @) [1 [3 ~ ~] [2 ~ ~]]
|
||||
=/ unbalanced-c=(qeu @) [3 [1 ~ ~] [2 ~ ~]]
|
||||
=/ unbalanced-d=(qeu @) [3 ~ [2 ~ ~]]
|
||||
=/ unbalanced-e=(qeu @) [3 [1 ~ ~] ~]
|
||||
;: weld
|
||||
%+ expect-eq
|
||||
!> [%b-a %.y]
|
||||
!> [%b-a ~(apt to balanced-a)]
|
||||
%+ expect-eq
|
||||
!> [%b-b %.y]
|
||||
!> [%b-b ~(apt to balanced-b)]
|
||||
%+ expect-eq
|
||||
!> [%u-a %.n]
|
||||
!> [%u-a ~(apt to unbalanced-a)]
|
||||
%+ expect-eq
|
||||
!> [%u-b %.n]
|
||||
!> [%u-b ~(apt to unbalanced-b)]
|
||||
%+ expect-eq
|
||||
!> [%u-c %.n]
|
||||
!> [%u-c ~(apt to unbalanced-c)]
|
||||
%+ expect-eq
|
||||
!> [%u-d %.n]
|
||||
!> [%u-d ~(apt to unbalanced-d)]
|
||||
%+ expect-eq
|
||||
!> [%u-e %.n]
|
||||
!> [%u-e ~(apt to unbalanced-e)]
|
||||
==
|
||||
::
|
||||
:: Test balancing the queue
|
||||
::
|
||||
++ test-queue-bal ^- tang
|
||||
:: Manually created queues explicitly unbalanced
|
||||
:: p(2) < p(1) < p(3)
|
||||
:: that places nodes with higher priority as the root
|
||||
::
|
||||
=/ unbalanced-a=(qeu @) [3 [2 ~ ~] [1 ~ ~]]
|
||||
=/ unbalanced-b=(qeu @) [1 [3 ~ ~] [2 ~ ~]]
|
||||
=/ unbalanced-c=(qeu @) [3 [1 ~ ~] [2 ~ ~]]
|
||||
;: weld
|
||||
%+ expect-eq
|
||||
!> [%u-a %.y]
|
||||
!> [%u-a ~(apt to ~(bal to unbalanced-a))]
|
||||
%+ expect-eq
|
||||
!> [%u-b %.y]
|
||||
!> [%u-b ~(apt to ~(bal to unbalanced-b))]
|
||||
%+ expect-eq
|
||||
!> [%u-c %.y]
|
||||
!> [%u-c ~(apt to ~(bal to unbalanced-c))]
|
||||
==
|
||||
::
|
||||
:: Test max depth of queue
|
||||
::
|
||||
++ test-queue-dep ^- tang
|
||||
:: Manually created queues with known depth
|
||||
::
|
||||
=/ length-a=(qeu @) [3 [2 ~ ~] [1 ~ ~]]
|
||||
=/ length-b=(qeu @) [1 ~ ~]
|
||||
=/ length-c=(qeu @) [5 ~ [4 ~ [2 [3 ~ ~] [1 ~ ~]]]]
|
||||
=/ length-d=(qeu @) [5 [4 [2 [3 ~ ~] [1 ~ ~]] ~] ~]
|
||||
=/ length-e=(qeu @) [5 [4 [2 ~ [1 ~ ~]] ~] [3 ~ ~]]
|
||||
=/ length-f=(qeu @) [5 [4 [1 ~ ~] [9 ~ ~]] [3 [6 ~ ~] [7 ~ ~]]]
|
||||
;: weld
|
||||
%+ expect-eq
|
||||
!> [%l-a 2]
|
||||
!> [%l-a ~(dep to length-a)]
|
||||
%+ expect-eq
|
||||
!> [%l-b 1]
|
||||
!> [%l-b ~(dep to length-b)]
|
||||
%+ expect-eq
|
||||
!> [%l-c 4]
|
||||
!> [%l-c ~(dep to length-c)]
|
||||
%+ expect-eq
|
||||
!> [%l-d 4]
|
||||
!> [%l-d ~(dep to length-d)]
|
||||
%+ expect-eq
|
||||
!> [%l-e 4]
|
||||
!> [%l-e ~(dep to length-e)]
|
||||
%+ expect-eq
|
||||
!> [%l-f 3]
|
||||
!> [%l-f ~(dep to length-f)]
|
||||
==
|
||||
::
|
||||
:: Test insert list into queue
|
||||
::
|
||||
++ test-queue-gas ^- tang
|
||||
=/ actual=(list [term ?])
|
||||
%+ turn queues
|
||||
|= [t=term s=(qeu)]
|
||||
:: We use +apt to check the correctness
|
||||
:: of the queues created with +gas
|
||||
::
|
||||
[t ~(apt to s)]
|
||||
%- zing
|
||||
;: weld
|
||||
:: Checks with all tests in the suite
|
||||
::
|
||||
%+ turn actual
|
||||
|= [t=term f=?]
|
||||
%+ expect-eq
|
||||
!> t^&
|
||||
!> t^f
|
||||
:: Checks appending >1 elements
|
||||
::
|
||||
:_ ~
|
||||
%+ expect-eq
|
||||
!> %.y
|
||||
!> ~(apt to (~(gas to +:q-dos) ~[9 10]))
|
||||
:: Checks adding existing elements
|
||||
::
|
||||
:_ ~
|
||||
%+ expect-eq
|
||||
!> (~(gas to *(qeu)) (weld (gulf 1 7) (gulf 1 3)))
|
||||
!> (~(gas to +:q-asc) (gulf 1 3))
|
||||
==
|
||||
::
|
||||
:: Test getting head-rest pair
|
||||
::
|
||||
++ test-queue-get ^- tang
|
||||
=/ expected=(map term [@ (qeu)])
|
||||
%- my
|
||||
:~ uno+[42 ~]
|
||||
dos+[6 (~(gas to *(qeu)) ~[9])]
|
||||
tre+[1 (~(gas to *(qeu)) ~[0 1])]
|
||||
tri+[1 (~(gas to *(qeu)) ~[2 3])]
|
||||
tra+[3 (~(gas to *(qeu)) ~[2 1])]
|
||||
asc+[1 (~(gas to *(qeu)) ~[2 3 4 5 6 7])]
|
||||
des+[7 (~(gas to *(qeu)) ~[6 5 4 3 2 1])]
|
||||
uns+[1 (~(gas to *(qeu)) ~[6 3 5 7 2 4])]
|
||||
dup+[1 (~(gas to *(qeu)) ~[1 7 4 6 9 4])]
|
||||
==
|
||||
=/ pairs=(list [term [* (qeu)]])
|
||||
%+ turn queues
|
||||
|=([t=term q=(qeu)] [t ~(get to q)])
|
||||
%- zing
|
||||
;: weld
|
||||
:: All tests in the suite
|
||||
::
|
||||
%+ turn pairs
|
||||
|= [t=term p=[* (qeu)]]
|
||||
%+ expect-eq
|
||||
!> t^(~(got by expected) t)
|
||||
!> t^p
|
||||
:: Expects crash on empty list
|
||||
::
|
||||
:_ ~
|
||||
%- expect-fail
|
||||
|. ~(get to +:q-nul)
|
||||
==
|
||||
::
|
||||
:: Test removing the root (more specialized balancing operation)
|
||||
::
|
||||
++ test-queue-nip ^- tang
|
||||
=/ actual=(list [term ?])
|
||||
%+ turn queues
|
||||
:: The queue representation follows vertical ordering
|
||||
:: of the tree nodes as a min-heap
|
||||
:: [i.e. priority(parent node) < priority(children)]
|
||||
:: after nip we check that the resulting tree is balanced
|
||||
::
|
||||
|=([t=term q=(qeu)] [t ~(apt to ~(nip to q))])
|
||||
%- zing
|
||||
;: weld
|
||||
:: All tests in the suite
|
||||
::
|
||||
%+ turn actual
|
||||
|= [t=term f=?]
|
||||
(expect-eq !>(t^&) !>(t^f))
|
||||
:: Expects crash on empty list
|
||||
::
|
||||
:_ ~
|
||||
%- expect-fail
|
||||
|. ~(nap to +:q-nul)
|
||||
==
|
||||
::
|
||||
:: Test removing the root
|
||||
::
|
||||
:: Current comment at L:1788 to %/sys/hoon/hoon.hoon is wrong
|
||||
:: For a longer explanation read:
|
||||
:: https://github.com/urbit/urbit/issues/1577#issuecomment-483845590
|
||||
::
|
||||
++ test-queue-nap ^- tang
|
||||
=/ actual=(list [term ?])
|
||||
%+ turn queues
|
||||
:: The queue representation follows vertical ordering
|
||||
:: of the tree nodes as a min-heap
|
||||
:: [i.e. priority(parent node) < priority(children)]
|
||||
:: after nip we check that the resulting tree is balanced
|
||||
::
|
||||
|=([t=term q=(qeu)] [t ~(apt to ~(nap to q))])
|
||||
%- zing
|
||||
;: weld
|
||||
:: All tests in the suite
|
||||
::
|
||||
%+ turn actual
|
||||
|= [t=term f=?]
|
||||
(expect-eq !>(t^&) !>(t^f))
|
||||
:: Expects crash on empty list
|
||||
::
|
||||
:_ ~
|
||||
%- expect-fail
|
||||
|. ~(nap to +:q-nul)
|
||||
==
|
||||
::
|
||||
:: Test inserting new tail
|
||||
::
|
||||
++ test-queue-put ^- tang
|
||||
=/ q-uno (~(gas to *(qeu)) ~[42])
|
||||
=/ q-asc (~(gas to *(qeu)) (gulf 1 7))
|
||||
=/ q-dos (~(gas to *(qeu)) ~[42 43])
|
||||
;: weld
|
||||
:: Checks with empty queue
|
||||
::
|
||||
%+ expect-eq
|
||||
!> q-uno
|
||||
!> (~(put to *(qeu)) 42)
|
||||
:: Checks putting existing element
|
||||
::
|
||||
=/ q-dup (~(gas to *(qeu)) ~[1 2 3 4 5 6 7 6])
|
||||
%+ expect-eq
|
||||
!> q-dup
|
||||
!> (~(put to q-asc) 6)
|
||||
:: Checks putting a new element
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (~(gas to *(qeu)) (gulf 1 8))
|
||||
!> (~(put to q-asc) 8)
|
||||
==
|
||||
::
|
||||
:: Test producing a queue a as a list from front to back
|
||||
::
|
||||
++ test-queue-tap ^- tang
|
||||
:: We ran all queues in the suite against the corresponding lists
|
||||
::
|
||||
=/ queues=(list (qeu))
|
||||
%+ turn lists
|
||||
|=(iq=(list) (~(gas to *(qeu)) iq))
|
||||
=/ actual=(list (list))
|
||||
%+ turn queues
|
||||
|=(iq=(qeu) ~(tap to iq))
|
||||
(expect-eq !>(lists) !>(actual))
|
||||
::
|
||||
:: Test producing the head of the queue
|
||||
::
|
||||
++ test-queue-top ^- tang
|
||||
:: In order to know beforehand which element of the +qeu will become
|
||||
:: the head, we need to look at the way new nodes are added to the
|
||||
:: tree and how it's rebalanced.
|
||||
::
|
||||
:: New nodes are appended to the left-most branch of the tree, and
|
||||
:: then the resulting tree will be balanced following the heap property.
|
||||
:: The idea is that the balancing will be applied to all the subtrees,
|
||||
:: starting from the node whose left branch is the new node that we
|
||||
:: have appended. We will then perform certain tree rotations, depending
|
||||
:: on the different priorities of the nodes considered.
|
||||
::
|
||||
:: If the new node has lower priority, a right-rotation is performed.
|
||||
:: This will push the node (which was the first node) to the right
|
||||
:: branch and balance that sub-branch, while promoting the node in the
|
||||
:: left branch as the new node.
|
||||
::
|
||||
:: If the new node has higher priority, we check the right branch to
|
||||
:: ensure that the heap-priority is conserved. In the case of the first
|
||||
:: insert, the right branch is empty, therefore, no rotations are needed.
|
||||
::
|
||||
:: This means that the first node inserted in the +qeu will be located
|
||||
:: either as the node of the +qeu, or in the right-most branch.
|
||||
::
|
||||
:: By inspecting +top:to we can see that it perfoms a traversal on the right
|
||||
:: branch of the tree returning the last node whose right branch is null,
|
||||
:: which is what we are looking for.
|
||||
::
|
||||
=/ expected=(map term @)
|
||||
(my ~[uno+42 dos+6 tre+1 tri+1 tra+3 asc+1 des+7 uns+1 dup+1])
|
||||
=/ heads=(list [term (unit)])
|
||||
%+ turn queues
|
||||
|=([t=term iq=(qeu)] [t ~(top to iq)])
|
||||
%- zing
|
||||
;: weld
|
||||
:: All the tests in the suite
|
||||
::
|
||||
%+ turn heads
|
||||
|= [t=term u=(unit)]
|
||||
%+ expect-eq
|
||||
!> t^(~(get by expected) t)
|
||||
!> t^u
|
||||
:_ ~
|
||||
:: Top of an empty queue is ~
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> ~(top to +:q-nul)
|
||||
==
|
||||
--
|
||||
504
pkg/arvo/tests/sys/hoon/set.hoon
Normal file
504
pkg/arvo/tests/sys/hoon/set.hoon
Normal file
@ -0,0 +1,504 @@
|
||||
:: Tests for +in (set logic)
|
||||
::
|
||||
/+ *test
|
||||
::
|
||||
:: Testing arms
|
||||
::
|
||||
|%
|
||||
:: Test logical AND
|
||||
::
|
||||
++ test-set-all ^- tang
|
||||
=/ s-asc=(set @) (sy (gulf 1 7))
|
||||
;: weld
|
||||
:: Checks with empty set
|
||||
::
|
||||
%+ expect-eq
|
||||
!> %.y
|
||||
!> (~(all in ~) |=(* &))
|
||||
%+ expect-eq
|
||||
!> %.y
|
||||
!> (~(all in ~) |=(* |))
|
||||
:: Checks one element fails
|
||||
::
|
||||
%+ expect-eq
|
||||
!> %.n
|
||||
!> (~(all in (sy ~[1])) |=(e=@ =(e 43)))
|
||||
:: Checks not all elements pass
|
||||
::
|
||||
%+ expect-eq
|
||||
!> %.n
|
||||
!> (~(all in s-asc) |=(e=@ (lth e 4)))
|
||||
:: Checks all element pass
|
||||
::
|
||||
%+ expect-eq
|
||||
!> %.y
|
||||
!> (~(all in s-asc) |=(e=@ (lth e 100)))
|
||||
==
|
||||
::
|
||||
:: Test logical OR
|
||||
::
|
||||
++ test-set-any ^- tang
|
||||
=/ s-asc=(set @) (sy (gulf 1 7))
|
||||
;: weld
|
||||
:: Checks with empty set
|
||||
::
|
||||
%+ expect-eq
|
||||
!> %.n
|
||||
!> (~(any in ~) |=(* &))
|
||||
%+ expect-eq
|
||||
!> %.n
|
||||
!> (~(any in ~) |=(* |))
|
||||
:: Checks one element fails
|
||||
::
|
||||
%+ expect-eq
|
||||
!> %.n
|
||||
!> (~(any in (sy ~[1])) |=(e=@ =(e 43)))
|
||||
:: Checks >1 element success
|
||||
::
|
||||
%+ expect-eq
|
||||
!> %.y
|
||||
!> (~(any in s-asc) |=(e=@ (lth e 4)))
|
||||
:: Checks all element success
|
||||
::
|
||||
%+ expect-eq
|
||||
!> %.y
|
||||
!> (~(any in s-asc) |=(e=@ (lth e 100)))
|
||||
==
|
||||
::
|
||||
:: Test check correctness
|
||||
::
|
||||
++ test-set-apt ^- tang
|
||||
:: Manually constructed sets with predefined vertical/horizontal
|
||||
:: ordering
|
||||
::
|
||||
:: for the following three elements (1, 2, 3) the vertical priorities are:
|
||||
:: > (mug (mug 1))
|
||||
:: 1.405.103.437
|
||||
:: > (mug (mug 2))
|
||||
:: 1.200.431.393
|
||||
:: > (mug (mug 3))
|
||||
:: 1.576.941.407
|
||||
::
|
||||
:: and the ordering 2 < 1 < 3
|
||||
:: a correctly balanced tree stored as a min-heap
|
||||
:: should have node=2 as the root
|
||||
::
|
||||
:: The horizontal priorities are:
|
||||
:: > (mug 1)
|
||||
:: 1.901.865.568
|
||||
:: > (mug 2)
|
||||
:: 1.904.972.904
|
||||
:: > (mug 3)
|
||||
:: 1.923.673.882
|
||||
::
|
||||
:: and the ordering 1 < 2 < 3.
|
||||
:: 1 should be in the left brach and 3 in the right one.
|
||||
::
|
||||
=/ balanced-a=(set @) [2 [1 ~ ~] [3 ~ ~]]
|
||||
:: Doesn't follow vertical ordering
|
||||
::
|
||||
=/ unbalanced-a=(set @) [1 [2 ~ ~] [3 ~ ~]]
|
||||
=/ unbalanced-b=(set @) [1 ~ [2 ~ ~]]
|
||||
=/ unbalanced-c=(set @) [1 [2 ~ ~] ~]
|
||||
:: Doesn't follow horizontal ordering
|
||||
::
|
||||
=/ unbalanced-d=(set @) [2 [3 ~ ~] [1 ~ ~]]
|
||||
:: Doesn't follow horizontal & vertical ordering
|
||||
::
|
||||
=/ unbalanced-e=(set @) [1 [3 ~ ~] [2 ~ ~]]
|
||||
;: weld
|
||||
%+ expect-eq
|
||||
!> [%b-a %.y]
|
||||
!> [%b-a ~(apt in balanced-a)]
|
||||
%+ expect-eq
|
||||
!> [%u-a %.n]
|
||||
!> [%u-a ~(apt in unbalanced-a)]
|
||||
%+ expect-eq
|
||||
!> [%u-b %.n]
|
||||
!> [%u-b ~(apt in unbalanced-b)]
|
||||
%+ expect-eq
|
||||
!> [%u-c %.n]
|
||||
!> [%u-c ~(apt in unbalanced-c)]
|
||||
%+ expect-eq
|
||||
!> [%u-d %.n]
|
||||
!> [%u-d ~(apt in unbalanced-d)]
|
||||
%+ expect-eq
|
||||
!> [%u-e %.n]
|
||||
!> [%u-e ~(apt in unbalanced-e)]
|
||||
==
|
||||
::
|
||||
:: Test splits a in b
|
||||
::
|
||||
++ test-set-bif ^- tang
|
||||
=/ s-asc=(set @) (sy (gulf 1 7))
|
||||
=/ s-nul=(set @) *(set @)
|
||||
=/ splits-a=[(set) (set)] (~(bif in s-asc) 99)
|
||||
=/ splits-b=[(set) (set)] (~(bif in s-asc) 6)
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%+ expect-eq
|
||||
!> [~ ~]
|
||||
!> (~(bif in s-nul) 1)
|
||||
:: Checks bifurcating in non-existing element
|
||||
::
|
||||
:: The traversal of the +map is done comparing the double +mug
|
||||
:: of the added node and the existing one from the tree.
|
||||
:: Because of this, the search will stop at different leaves,
|
||||
:: based on the value of the hash, therefore the right and left
|
||||
:: maps that are returned can be different
|
||||
:: (null or a less than the total number of nodes)
|
||||
:: The best way to check is that the sum of the number of nodes
|
||||
:: in both maps are the same as before, and that both returned
|
||||
:: sets are correct
|
||||
::
|
||||
%+ expect-eq
|
||||
!> 7
|
||||
!> (add ~(wyt in -.splits-a) ~(wyt in +.splits-a))
|
||||
%+ expect-eq
|
||||
!> %.y
|
||||
!> &(~(apt in -.splits-a) ~(apt in +.splits-a))
|
||||
:: Checks splitting in existing element
|
||||
::
|
||||
%+ expect-eq
|
||||
!> 6
|
||||
!> (add ~(wyt in -.splits-b) ~(wyt in +.splits-b))
|
||||
%+ expect-eq
|
||||
!> %.y
|
||||
!> &(~(apt in -.splits-b) ~(apt in +.splits-b))
|
||||
=/ left (~(has in -.splits-b) 6)
|
||||
=/ right (~(has in +.splits-b) 6)
|
||||
%+ expect-eq
|
||||
!> %.n
|
||||
!> &(left right)
|
||||
==
|
||||
::
|
||||
:: Test b without any a
|
||||
::
|
||||
++ test-set-del ^- tang
|
||||
=/ s-asc=(set @) (sy (gulf 1 7))
|
||||
;: weld
|
||||
:: Checks with empty set
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> (~(del in ~) 1)
|
||||
:: Checks deleting non-existing element
|
||||
::
|
||||
%+ expect-eq
|
||||
!> s-asc
|
||||
!> (~(del in s-asc) 99)
|
||||
:: Checks deleting the only element
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> (~(del in (sy ~[1])) 1)
|
||||
:: Checks deleting one element
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (sy (gulf 1 6))
|
||||
!> (~(del in s-asc) 7)
|
||||
==
|
||||
::
|
||||
:: Test difference
|
||||
::
|
||||
++ test-set-dif ^- tang
|
||||
=/ s-des=(set @) (sy (flop (gulf 1 7)))
|
||||
=/ s-asc=(set @) (sy (gulf 1 7))
|
||||
=/ s-dos=(set @) (sy ~[8 9])
|
||||
;: weld
|
||||
:: Checks with empty set
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> (~(dif in *(set)) ~)
|
||||
%+ expect-eq
|
||||
!> s-asc
|
||||
!> (~(dif in s-asc) ~)
|
||||
:: Checks with equal sets
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> (~(dif in s-asc) s-des)
|
||||
:: Checks no elements in common
|
||||
::
|
||||
%+ expect-eq
|
||||
!> s-dos
|
||||
!> (~(dif in s-dos) s-asc)
|
||||
:: Checks with sets of diferent size
|
||||
::
|
||||
%+ expect-eq
|
||||
!> s-dos
|
||||
!> (~(dif in (sy ~[1 8 9])) s-asc)
|
||||
==
|
||||
::
|
||||
:: Test axis of a in b
|
||||
::
|
||||
++ test-set-dig ^- tang
|
||||
=/ custom [2 [1 ~ ~] [3 ~ ~]]
|
||||
=/ custom-vase !>(custom)
|
||||
=/ manual-set=(set @) custom
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> (~(dig in *(set)) 6)
|
||||
:: Checks with non-existing key
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> (~(dig in manual-set) 9)
|
||||
:: Checks success via tree addressing. It uses the returned axis
|
||||
:: to address the raw noun and check that it gives the corresponding
|
||||
:: value.
|
||||
::
|
||||
%+ expect-eq
|
||||
!> 1
|
||||
!> +:(slot (need (~(dig in manual-set) 1)) custom-vase)
|
||||
%+ expect-eq
|
||||
!> 2
|
||||
!> +:(slot (need (~(dig in manual-set) 2)) custom-vase)
|
||||
%+ expect-eq
|
||||
!> 3
|
||||
!> +:(slot (need (~(dig in manual-set) 3)) custom-vase)
|
||||
==
|
||||
::
|
||||
:: Test concatenate
|
||||
::
|
||||
++ test-set-gas ^- tang
|
||||
:: Uses +apt to check the correctness
|
||||
:: of the sets created with +gas
|
||||
::
|
||||
=+ |%
|
||||
+| %test-suite
|
||||
++ s-uno (~(gas in *(set)) ~[42])
|
||||
++ s-dos (~(gas in *(set)) ~[6 9])
|
||||
++ s-tre (~(gas in *(set)) ~[1 0 1])
|
||||
++ s-asc (~(gas in *(set)) ~[1 2 3 4 5 6 7])
|
||||
++ s-des (~(gas in *(set)) ~[7 6 5 4 3 2 1])
|
||||
++ s-uns (~(gas in *(set)) ~[1 6 3 5 7 2 4])
|
||||
++ s-dup (~(gas in *(set)) ~[1 1 7 4 6 9 4])
|
||||
++ s-nul (~(gas in *(set)) ~)
|
||||
--
|
||||
=/ s-lis=(list (set)) ~[s-nul s-uno s-dos s-tre s-asc s-des s-uns s-dup]
|
||||
=/ actual=?
|
||||
%+ roll s-lis
|
||||
|= [s=(set) b=?]
|
||||
^- ?
|
||||
&(b ~(apt in s))
|
||||
;: weld
|
||||
:: Checks with all tests in the suite
|
||||
::
|
||||
%+ expect-eq
|
||||
!> %.y
|
||||
!> actual
|
||||
:: Checks appending >1 elements
|
||||
::
|
||||
%+ expect-eq
|
||||
!> %.y
|
||||
!> ~(apt in (~(gas in s-dos) ~[9 10]))
|
||||
:: Checks concatenating existing elements
|
||||
::
|
||||
%+ expect-eq
|
||||
!> s-asc
|
||||
!> (~(gas in s-asc) (gulf 1 3))
|
||||
==
|
||||
::
|
||||
:: Test +has: does :b exist in :a?
|
||||
::
|
||||
++ test-set-has ^- tang
|
||||
=/ s-nul=(set @) *(set @)
|
||||
=/ s-asc=(set @) (sy (gulf 1 7))
|
||||
;: weld
|
||||
:: Checks with empty set
|
||||
::
|
||||
%+ expect-eq
|
||||
!> %.n
|
||||
!> (~(has in s-nul) 6)
|
||||
:: Checks with non-existing key
|
||||
::
|
||||
%+ expect-eq
|
||||
!> %.n
|
||||
!> (~(has in s-asc) 9)
|
||||
:: Checks success
|
||||
::
|
||||
%+ expect-eq
|
||||
!> %.y
|
||||
!> (~(has in s-asc) 7)
|
||||
==
|
||||
::
|
||||
:: Test intersection
|
||||
::
|
||||
++ test-set-int ^- tang
|
||||
=/ s-nul=(set @) *(set @)
|
||||
=/ s-asc=(set @) (sy (gulf 1 7))
|
||||
=/ s-des=(set @) (sy (flop (gulf 1 7)))
|
||||
=/ s-dos=(set @) (sy (gulf 8 9))
|
||||
=/ s-dup (sy ~[1 1 4 1 3 5 9 4])
|
||||
;: weld
|
||||
:: Checks with empty set
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> (~(int in s-nul) s-asc)
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> (~(int in s-asc) s-nul)
|
||||
:: Checks with all elements different
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> (~(int in s-dos) s-asc)
|
||||
:: Checks success (total intersection)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> s-asc
|
||||
!> (~(int in s-asc) s-des)
|
||||
:: Checks success (partial intersection)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (sy ~[9])
|
||||
!> (~(int in s-dos) s-dup)
|
||||
==
|
||||
::
|
||||
:: Test puts b in a, sorted
|
||||
::
|
||||
++ test-set-put ^- tang
|
||||
=/ s-nul=(set @) *(set @)
|
||||
=/ s-asc=(set @) (sy (gulf 1 7))
|
||||
;: weld
|
||||
:: Checks with empty set
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (sy ~[6])
|
||||
!> (~(put in s-nul) 6)
|
||||
:: Checks with existing key
|
||||
::
|
||||
%+ expect-eq
|
||||
!> s-asc
|
||||
!> (~(put in s-asc) 6)
|
||||
:: Checks adding new element
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (sy (gulf 1 8))
|
||||
!> (~(put in s-asc) 8)
|
||||
==
|
||||
:: Test replace in product
|
||||
::
|
||||
++ test-set-rep ^- tang
|
||||
=/ s-nul=(set @) *(set @)
|
||||
=/ s-asc=(set @) (sy (gulf 1 7))
|
||||
;: weld
|
||||
:: Checks with empty set
|
||||
::
|
||||
%+ expect-eq
|
||||
!> b=0
|
||||
!> (~(rep in s-nul) add)
|
||||
:: Checks success
|
||||
::
|
||||
%+ expect-eq
|
||||
!> b=28
|
||||
!> (~(rep in s-asc) add)
|
||||
==
|
||||
::
|
||||
:: Test apply gate to values
|
||||
::
|
||||
++ test-set-run ^- tang
|
||||
=/ s-nul *(set @)
|
||||
=/ s-asc (sy (gulf 1 7))
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> (~(run in s-nul) dec)
|
||||
:: Checks success
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (sy (gulf 0 6))
|
||||
!> (~(run in s-asc) dec)
|
||||
==
|
||||
::
|
||||
:: Converts a set to list
|
||||
::
|
||||
++ test-set-tap ^- tang
|
||||
=/ s-dup (sy ~[1 1 4 1 3 5 9 4])
|
||||
=/ s-asc (sy (gulf 1 7))
|
||||
;: weld
|
||||
:: Checks with empty map
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> ~(tap in *(set @))
|
||||
:: Checks with duplicates
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (sort ~[1 4 3 5 9] gth)
|
||||
!> (sort ~(tap in s-dup) gth)
|
||||
:: Checks with ascending list
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (gulf 1 7)
|
||||
!> (sort ~(tap in s-asc) lth)
|
||||
==
|
||||
::
|
||||
:: Test the union of sets
|
||||
::
|
||||
++ test-set-uni ^- tang
|
||||
=/ asc=(list @) (gulf 1 7)
|
||||
=/ des=(list @) (flop (gulf 1 7))
|
||||
=/ s-des=(set @) (sy des)
|
||||
=/ s-asc=(set @) (sy asc)
|
||||
=/ s-nul=(set @) *(set @)
|
||||
;: weld
|
||||
:: Checks with empty map (a or b)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> s-des
|
||||
!> (~(uni in s-nul) s-des)
|
||||
%+ expect-eq
|
||||
!> s-des
|
||||
!> (~(uni in s-des) s-nul)
|
||||
:: Checks with no intersection
|
||||
::
|
||||
=/ a=(set @) (sy (scag 4 asc))
|
||||
=/ b=(set @) (sy (slag 4 asc))
|
||||
%+ expect-eq
|
||||
!> s-asc
|
||||
!> (~(uni in a) b)
|
||||
:: Checks union with equal sets
|
||||
::
|
||||
%+ expect-eq
|
||||
!> s-asc
|
||||
!> (~(uni in s-asc) s-des)
|
||||
:: Checks union with partial intersection
|
||||
::
|
||||
%+ expect-eq
|
||||
!> s-asc
|
||||
!> (~(uni in s-asc) (sy (gulf 1 3)))
|
||||
==
|
||||
::
|
||||
:: Tests the size of set
|
||||
::
|
||||
++ test-set-wyt ^- tang
|
||||
=+ |%
|
||||
++ s-uno (~(gas in *(set)) ~[42])
|
||||
++ s-dos (~(gas in *(set)) ~[6 9])
|
||||
++ s-tre (~(gas in *(set)) ~[1 0 1])
|
||||
++ s-asc (~(gas in *(set)) ~[1 2 3 4 5 6 7])
|
||||
++ s-des (~(gas in *(set)) ~[7 6 5 4 3 2 1])
|
||||
++ s-uns (~(gas in *(set)) ~[1 6 3 5 7 2 4])
|
||||
++ s-dup (~(gas in *(set)) ~[1 1 7 4 6 9 4])
|
||||
++ s-nul (~(gas in *(set)) ~)
|
||||
++ s-lis ~[s-nul s-uno s-dos s-tre s-asc s-des s-uns s-dup]
|
||||
--
|
||||
:: Runs all the tests in the suite
|
||||
::
|
||||
=/ sizes=(list @)
|
||||
%+ turn s-lis
|
||||
|=(s=(set) ~(wyt in s))
|
||||
%+ expect-eq
|
||||
!> sizes
|
||||
!> (limo ~[0 1 2 2 7 7 7 5])
|
||||
--
|
||||
Loading…
Reference in New Issue
Block a user