Merge branches 'algorithm-tests' and 'treap-traverse' (#1777, #1799)

* treap-traverse:
  tests: replace bogus queue in test-qeu
  pills: update solid
  hoon: replaces manual +tree cons with explicit %=

* 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 2019-10-10 10:33:15 +04:00
commit 8a6912e42a
No known key found for this signature in database
GPG Key ID: 0E4647D58F8A69E4
7 changed files with 2067 additions and 80 deletions

View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:1cbde0698df3e9ed5d2dfd1b1481ad7614c35f81f69ca25900758af20f9d9649
size 16538059
oid sha256:2a023a62720e4d7df04c8f5aa10f65106ecac7e9d2b1c3840367acf668e6cbdb
size 16793064

View File

@ -1197,10 +1197,10 @@
?: (gor b n.a)
=+ c=$(a l.a)
?> ?=(^ c)
[n.c l.c [n.a r.c r.a]]
c(r a(l r.c))
=+ c=$(a r.a)
?> ?=(^ c)
[n.c [n.a l.a l.c] r.c]
c(l a(r l.c))
::
++ del :: b without any a
~/ %del
@ -1210,14 +1210,14 @@
~
?. =(b n.a)
?: (gor b n.a)
[n.a $(a l.a) r.a]
[n.a l.a $(a r.a)]
a(l $(a l.a))
a(r $(a r.a))
|- ^- {$?(~ _a)}
?~ l.a r.a
?~ r.a l.a
?: (mor n.l.a n.r.a)
[n.l.a l.l.a $(l.a r.l.a)]
[n.r.a $(r.a l.r.a) r.r.a]
l.a(r $(l.a r.l.a))
r.a(l $(r.a l.r.a))
::
++ dif :: difference
~/ %dif
@ -1235,8 +1235,8 @@
?~ d e
?~ e d
?: (mor n.d n.e)
[n.d l.d $(d r.d)]
[n.e $(e l.e) r.e]
d(r $(d r.d))
e(l $(e l.e))
--
::
++ dig :: axis of a in b
@ -1298,10 +1298,10 @@
?. (mor n.a n.b)
$(a b, b a)
?: =(n.b n.a)
[n.a $(a l.a, b l.b) $(a r.a, b r.b)]
a(l $(a l.a, b l.b), r $(a r.a, b r.b))
?: (gor n.b n.a)
%- uni(a $(a l.a, b [n.b l.b ~])) $(b r.b)
%- uni(a $(a r.a, b [n.b ~ r.b])) $(b l.b)
%- uni(a $(a l.a, r.b ~)) $(b r.b)
%- uni(a $(a r.a, l.b ~)) $(b l.b)
--
::
++ put :: puts b in a, sorted
@ -1316,13 +1316,13 @@
=+ c=$(a l.a)
?> ?=(^ c)
?: (mor n.a n.c)
[n.a c r.a]
[n.c l.c [n.a r.c r.a]]
a(l c)
c(r a(l r.c))
=+ c=$(a r.a)
?> ?=(^ c)
?: (mor n.a n.c)
[n.a l.a c]
[n.c [n.a l.a l.c] r.c]
a(r c)
c(r a(r l.c))
::
++ rep :: replace by product
|* b/_=>(~ |=({* *} +<+))
@ -1359,17 +1359,15 @@
a
?~ a
b
?: =(n.b n.a)
b(l $(a l.a, b l.b), r $(a r.a, b r.b))
?: (mor n.a n.b)
?: =(n.b n.a)
[n.b $(a l.a, b l.b) $(a r.a, b r.b)]
?: (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)]
$(l.a $(a l.a, r.b ~), b r.b)
$(r.a $(a r.a, l.b ~), b l.b)
?: (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)
$(l.b $(b l.b, r.a ~), a r.a)
$(r.b $(b r.b, l.a ~), a l.a)
--
::
++ wyt :: size of set
@ -1414,14 +1412,14 @@
?: =(b p.n.a)
?: =(c q.n.a)
a
[[b c] l.a r.a]
a(n [b c])
?: (gor b p.n.a)
=+ d=$(a l.a)
?> ?=(^ d)
[n.d l.d [n.a r.d r.a]]
d(r a(l r.d))
=+ d=$(a r.a)
?> ?=(^ d)
[n.d [n.a l.a l.d] r.d]
d(l a(r l.d))
::
++ del :: delete at key b
~/ %del
@ -1431,14 +1429,14 @@
~
?. =(b p.n.a)
?: (gor b p.n.a)
[n.a $(a l.a) r.a]
[n.a l.a $(a r.a)]
a(l $(a l.a))
a(r $(a r.a))
|- ^- {$?(~ _a)}
?~ l.a r.a
?~ r.a l.a
?: (mor p.n.l.a p.n.r.a)
[n.l.a l.l.a $(l.a r.l.a)]
[n.r.a $(r.a l.r.a) r.r.a]
l.a(r $(l.a r.l.a))
r.a(l $(r.a l.r.a))
::
++ dif :: difference
~/ %dif
@ -1456,8 +1454,8 @@
?~ d e
?~ e d
?: (mor p.n.d p.n.e)
[n.d l.d $(d r.d)]
[n.e $(e l.e) r.e]
d(r $(d r.d))
e(l $(e l.e))
--
::
++ dig :: axis of b key
@ -1527,15 +1525,15 @@
~
?: (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)]
b(l $(a l.a, b l.b), r $(a r.a, b r.b))
?: (gor p.n.b p.n.a)
%- uni(a $(a l.a, b [n.b l.b ~])) $(b r.b)
%- uni(a $(a r.a, b [n.b ~ r.b])) $(b l.b)
%- uni(a $(a l.a, r.b ~)) $(b r.b)
%- uni(a $(a r.a, l.b ~)) $(b l.b)
?: =(p.n.a p.n.b)
[n.b $(b l.b, a l.a) $(b r.b, a r.a)]
b(l $(b l.b, a l.a), r $(b r.b, a r.a))
?: (gor p.n.a p.n.b)
%- uni(a $(b l.b, a [n.a l.a ~])) $(a r.a)
%- uni(a $(b r.b, a [n.a ~ r.a])) $(a l.a)
%- uni(a $(b l.b, r.a ~)) $(a r.a)
%- uni(a $(b r.b, l.a ~)) $(a l.a)
--
::
++ jab
@ -1568,18 +1566,18 @@
?: =(b p.n.a)
?: =(c q.n.a)
a
[[b c] l.a r.a]
a(n [b c])
?: (gor b p.n.a)
=+ d=$(a l.a)
?> ?=(^ d)
?: (mor p.n.a p.n.d)
[n.a d r.a]
[n.d l.d [n.a r.d r.a]]
a(l d)
d(r a(l r.d))
=+ d=$(a r.a)
?> ?=(^ d)
?: (mor p.n.a p.n.d)
[n.a l.a d]
[n.d [n.a l.a l.d] r.d]
a(r d)
d(l a(r l.d))
::
++ rep :: replace by product
|* b/_=>(~ |=({* *} +<+))
@ -1595,7 +1593,7 @@
=. n.a +.d
=+ e=$(a l.a, b -.d)
=+ f=$(a r.a, b -.e)
[-.f [n.a +.e +.f]]
[-.f a(l +.e, r +.f)]
::
++ run :: apply gate to values
|* b/gate
@ -1628,17 +1626,15 @@
a
?~ a
b
?: =(p.n.b p.n.a)
b(l $(a l.a, b l.b), r $(a r.a, b r.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)]
?: (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)]
$(l.a $(a l.a, r.b ~), b r.b)
$(r.a $(a r.a, l.b ~), b l.b)
?: (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)
$(l.b $(b l.b, r.a ~), a r.a)
$(r.b $(b r.b, l.a ~), a l.a)
--
::
++ uno :: general union
@ -1651,19 +1647,17 @@
a
?~ a
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)]
?: (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.b p.n.a)
:+ [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)
?: (mor p.n.a p.n.b)
?: (gor p.n.b p.n.a)
$(l.a $(a l.a, r.b ~), b r.b)
$(r.a $(a r.a, l.b ~), b l.b)
?: (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)
$(l.b $(b l.b, r.a ~), a r.a)
$(r.b $(b r.b, l.a ~), a l.a)
--
::
::
@ -1671,7 +1665,7 @@
|* b/$-({* *} *)
|-
?~ a ~
[n=[p=p.n.a q=(b p.n.a q.n.a)] l=$(a l.a) r=$(a r.a)]
a(n n.a(q (b p.n.a q.n.a)), l $(a l.a), r $(a r.a))
::
++ wyt :: depth of map
|- ^- @
@ -1750,20 +1744,19 @@
=| 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
?~ a ~
?. |(?=(~ l.a) (mor n.a n.l.a))
$(a [n.l.a l.l.a $(a [n.a r.l.a r.a])])
$(a l.a(r $(a a(l r.l.a))))
?. |(?=(~ r.a) (mor n.a n.r.a))
$(a [n.r.a $(a [n.a l.a l.r.a]) r.r.a])
$(a r.a(l $(a a(r l.r.a))))
a
::
++ dep :: max depth of queue
@ -1785,30 +1778,30 @@
=+ b=$(a r.a)
:- p.b
?: |(?=(~ q.b) (mor n.a n.q.b))
[n.a l.a q.b]
[n.q.b [n.a l.a l.q.b] r.q.b]
a(r q.b)
a(n n.q.b, l a(r l.q.b), r r.q.b)
::
++ nip :: remove root
++ nip :: removes root
|- ^+ a
?~ a ~
?~ l.a r.a
?~ r.a l.a
?: (mor n.l.a n.r.a)
[n.l.a l.l.a $(l.a r.l.a)]
[n.r.a $(r.a l.r.a) r.r.a]
l.a(r $(l.a r.l.a))
r.a(l $(r.a l.r.a))
::
++ nap :: removes head
++ nap :: removes root
?> ?=(^ a)
?: =(~ l.a) r.a
=+ b=get(a l.a)
bal(a ^+(a [p.b q.b r.a]))
bal(n.a p.b, l.a q.b)
::
++ put :: insert new tail
|* b/*
|- ^+ a
?~ a
[b ~ ~]
bal(a a(l $(a l.a)))
bal(l.a $(a l.a))
::
++ tap :: adds list to end
=+ b=`(list _?>(?=(^ a) n.a))`~

View 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))
==
--

View 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])
--

View File

@ -30,6 +30,6 @@
::
%+ expect-eq
!> ~
!> ((soft (qeu)) [98 [97 ~ ~] [100 ~ [99 ~ ~]]])
!> ((soft (qeu)) [97 [98 ~ ~] [100 ~ [99 ~ ~]]])
==
--

View 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)
==
--

View 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])
--