mirror of
https://github.com/urbit/shrub.git
synced 2024-12-26 21:44:11 +03:00
505 lines
12 KiB
Plaintext
505 lines
12 KiB
Plaintext
:: 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 branch 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])
|
|
--
|