aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/data/collection/bits.lux
blob: 59d7e3443d9b4f0fb7aae23f7595b0dd4325ec10 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
(.module:
  [lux #*
   ["%" data/text/format (#+ format)]
   ["_" test (#+ Test)]
   [abstract
    [monad (#+ do)]
    ["." predicate]
    {[0 #spec]
     [/
      ["$." equivalence]]}]
   [data
    [number
     ["n" nat]]]
   [math
    ["r" random (#+ Random)]]]
  {1
   ["." / (#+ Bits)]})

(def: (size min max)
  (-> Nat Nat (Random Nat))
  (|> r.nat
      (:: r.monad map (|>> (n.% max) (n.max min)))))

(def: #export bits
  (Random Bits)
  (do {@ r.monad}
    [size (size 1 1,000)
     idx (|> r.nat (:: @ map (n.% size)))]
    (wrap (|> /.empty (/.set idx)))))

(def: #export test
  Test
  (<| (_.context (%.name (name-of /._)))
      ($_ _.and
          ($equivalence.spec /.equivalence ..bits)
          (do {@ r.monad}
            [size (size 1 1,000)
             idx (|> r.nat (:: @ map (n.% size)))
             sample bits]
            ($_ _.and
                (_.test "Can set individual bits."
                        (and (|> /.empty (/.get idx) not)
                             (|> /.empty (/.set idx) (/.get idx))))
                (_.test "Can clear individual bits."
                        (|> /.empty (/.set idx) (/.clear idx) (/.get idx) not))
                (_.test "Can flip individual bits."
                        (and (|> /.empty (/.flip idx) (/.get idx))
                             (|> /.empty (/.flip idx) (/.flip idx) (/.get idx) not)))
                (_.test "Bits (only) grow when (and as much as) necessary."
                        (and (n.= 0 (/.capacity /.empty))
                             (|> /.empty (/.set idx) /.capacity
                                 (n.- idx)
                                 (predicate.unite (n.>= 0)
                                                  (n.< /.chunk-size)))))
                (_.test "Bits (must) shrink when (and as much as) possible."
                        (let [grown (/.flip idx /.empty)]
                          (and (n.> 0 (/.capacity grown))
                               (is? /.empty (/.flip idx grown)))))
                (_.test "Intersection can be detected when there are set bits in common."
                        (and (not (/.intersects? /.empty
                                                 /.empty))
                             (/.intersects? (/.set idx /.empty)
                                            (/.set idx /.empty))
                             (not (/.intersects? (/.set (inc idx) /.empty)
                                                 (/.set idx /.empty)))))
                (_.test "Cannot intersect with one's opposite."
                        (not (/.intersects? sample (/.not sample))))
                (_.test "'and' with oneself changes nothing"
                        (:: /.equivalence = sample (/.and sample sample)))
                (_.test "'and' with one's opposite yields the empty bit-set."
                        (is? /.empty (/.and sample (/.not sample))))
                
                (_.test "'or' with one's opposite fully saturates a bit-set."
                        (n.= (/.size (/.or sample (/.not sample)))
                             (/.capacity sample)))
                (_.test "'xor' with oneself yields the empty bit-set."
                        (is? /.empty (/.xor sample sample)))
                (_.test "'xor' with one's opposite fully saturates a bit-set."
                        (n.= (/.size (/.xor sample (/.not sample)))
                             (/.capacity sample)))
                (_.test "Double negation results in original bit-set."
                        (:: /.equivalence = sample (/.not (/.not sample))))
                (_.test "Negation does not affect the empty bit-set."
                        (is? /.empty (/.not /.empty)))
                )))))