(.module:
  [library
   [lux #*
    ["_" test (#+ Test)]
    [abstract
     [equivalence (#+ Equivalence)]
     [monad (#+ do)]
     [\\specification
      [functor
       ["$." contravariant]]]]
    [data
     ["." bit ("#\." equivalence)]
     [collection
      ["." list]
      ["." set]]]
    [math
     ["." random (#+ Random)]
     [number
      ["n" nat]
      ["r" rev]]]]]
  [\\library
   ["." / (#+ Fuzzy)
    ["/#" // #_
     ["#" continuous]]]])

(def: trivial
  Test
  (do random.monad
    [sample random.rev]
    ($_ _.and
        (_.cover [/.empty]
                 (r.= //.false (/.empty sample)))
        (_.cover [/.full]
                 (r.= //.true (/.full sample)))
        )))

(def: simple
  Test
  (do {! random.monad}
    [sample random.rev
     
     threshold_0 (\ ! each (r.% .5)
                    random.rev)
     threshold_1 (\ ! each (|>> (r.% .5) (r.+ .5))
                    random.rev)

     .let [bottom (r.min threshold_0 threshold_1)
           top (r.max threshold_0 threshold_1)]]
    ($_ _.and
        (_.cover [/.gradient]
                 (let [ascending!
                       (let [set (/.gradient bottom top)]
                         (and (r.= //.false (set bottom))
                              (r.= //.true (set top))
                              (let [membership (set sample)]
                                (cond (r.<= bottom sample)
                                      (r.= //.false membership)
                                      
                                      (r.>= top sample)
                                      (r.= //.true membership)

                                      (r.> //.false membership)))))

                       descending!
                       (let [set (/.gradient top bottom)]
                         (and (r.= //.true (set bottom))
                              (r.= //.false (set top))
                              (let [membership (set sample)]
                                (cond (r.<= bottom sample)
                                      (r.= //.true membership)
                                      
                                      (r.>= top sample)
                                      (r.= //.false membership)

                                      (r.> //.false membership)))))]
                   (and ascending!
                        descending!)))
        (_.cover [/.membership]
                 (let [set (/.gradient bottom top)]
                   (r.= (set sample)
                        (/.membership set sample))))
        )))

(def: composition
  Test
  (do {! random.monad}
    [sample random.rev
     
     [bottom middle_bottom middle_top top]
     (|> random.rev
         (random.set r.hash 4)
         (\ ! each (|>> set.list (list.sorted r.<)))
         (random.one (function (_ thresholds)
                       (case thresholds
                         (^ (list threshold_0 threshold_1 threshold_2 threshold_3))
                         (#.Some [threshold_0 threshold_1 threshold_2 threshold_3])

                         _
                         #.None))))

     .let [bottom_set (/.gradient bottom middle_bottom)
           top_set (/.gradient middle_top top)]]
    ($_ _.and
        (_.cover [/.union]
                 (let [set (/.gradient bottom top)]
                   (and (r.= (/.membership set sample)
                             (/.membership (/.union /.empty set) sample))
                        (r.= (/.membership /.full sample)
                             (/.membership (/.union /.full set) sample))

                        (r.>= (/.membership bottom_set sample)
                              (/.membership (/.union bottom_set top_set) sample))
                        (r.>= (/.membership top_set sample)
                              (/.membership (/.union bottom_set top_set) sample)))))
        (_.cover [/.intersection]
                 (let [set (/.gradient bottom top)]
                   (and (r.= (/.membership /.empty sample)
                             (/.membership (/.intersection /.empty set) sample))
                        (r.= (/.membership set sample)
                             (/.membership (/.intersection /.full set) sample))

                        (r.<= (/.membership bottom_set sample)
                              (/.membership (/.intersection bottom_set top_set) sample))
                        (r.<= (/.membership top_set sample)
                              (/.membership (/.intersection bottom_set top_set) sample)))))
        (_.cover [/.complement]
                 (let [set (/.gradient bottom top)

                       trivial!
                       (and (r.= (/.membership /.full sample)
                                 (/.membership (/.complement /.empty) sample))
                            (r.= (/.membership /.empty sample)
                                 (/.membership (/.complement /.full) sample)))

                       common!
                       (and (r.>= (/.membership set sample)
                                  (/.membership (/.union set (/.complement set)) sample))
                            (r.<= (/.membership set sample)
                                  (/.membership (/.intersection set (/.complement set)) sample)))

                       de_morgan!
                       (and (r.= (/.membership (/.complement (/.union bottom_set top_set))
                                               sample)
                                 (/.membership (/.intersection (/.complement bottom_set) (/.complement top_set))
                                               sample))
                            (r.= (/.membership (/.complement (/.intersection bottom_set top_set))
                                               sample)
                                 (/.membership (/.union (/.complement bottom_set) (/.complement top_set))
                                               sample)))]
                   (and trivial!
                        common!
                        de_morgan!)))
        (_.cover [/.difference]
                 (let [set (/.gradient bottom top)]
                   (and (r.= (/.membership set sample)
                             (/.membership (/.difference /.empty set) sample))
                        (r.= (/.membership /.empty sample)
                             (/.membership (/.difference /.full set) sample))

                        (r.<= (/.membership top_set sample)
                              (/.membership (/.difference bottom_set top_set) sample))
                        (r.<= (/.membership bottom_set sample)
                              (/.membership (/.difference bottom_set top_set) sample)))))
        )))

(def: geometric
  Test
  (<| (_.covering /._)
      (_.for [/.Fuzzy])
      (do {! random.monad}
        [sample random.rev

         [bottom middle_bottom middle_top top]
         (|> random.rev
             (random.set r.hash 4)
             (\ ! each (|>> set.list (list.sorted r.<)))
             (random.one (function (_ thresholds)
                           (case thresholds
                             (^ (list threshold_0 threshold_1 threshold_2 threshold_3))
                             (#.Some [threshold_0 threshold_1 threshold_2 threshold_3])

                             _
                             #.None))))]
        ($_ _.and
            (_.cover [/.triangle]
                     (let [reference (/.triangle bottom middle_bottom top)

                           irrelevant_order!
                           (list.every? (function (_ set)
                                          (r.= (/.membership reference sample)
                                               (/.membership set sample)))
                                        (list (/.triangle bottom top middle_bottom)
                                              (/.triangle middle_bottom bottom top)
                                              (/.triangle middle_bottom top bottom)
                                              (/.triangle top bottom middle_bottom)
                                              (/.triangle top middle_bottom bottom)))

                           middle_maximum!
                           (r.= //.true (/.membership reference middle_bottom))

                           boundary_minima!
                           (and (r.= //.false (/.membership reference bottom))
                                (r.= //.false (/.membership reference top)))

                           inside_range!
                           (bit\= (r.> //.false (/.membership reference sample))
                                  (and (r.> bottom sample)
                                       (r.< top sample)))

                           outside_range!
                           (bit\= (r.= //.false (/.membership reference sample))
                                  (or (r.<= bottom sample)
                                      (r.>= top sample)))]
                       (and irrelevant_order!
                            middle_maximum!
                            boundary_minima!
                            inside_range!
                            outside_range!)))
            (_.cover [/.trapezoid]
                     (let [reference (/.trapezoid bottom middle_bottom middle_top top)

                           irrelevant_order!
                           (list.every? (function (_ set)
                                          (r.= (/.membership reference sample)
                                               (/.membership set sample)))
                                        (let [r0 bottom
                                              r1 middle_bottom
                                              r2 middle_top
                                              r3 top]
                                          (list (/.trapezoid r0 r1 r2 r3)
                                                (/.trapezoid r0 r1 r3 r2)
                                                (/.trapezoid r0 r2 r1 r3)
                                                (/.trapezoid r0 r2 r3 r1)
                                                (/.trapezoid r0 r3 r1 r2)
                                                (/.trapezoid r0 r3 r2 r1)
                                                
                                                (/.trapezoid r1 r0 r2 r3)
                                                (/.trapezoid r1 r0 r3 r2)
                                                (/.trapezoid r1 r2 r0 r3)
                                                (/.trapezoid r1 r2 r3 r0)
                                                (/.trapezoid r1 r3 r0 r2)
                                                (/.trapezoid r1 r3 r2 r0)

                                                (/.trapezoid r2 r0 r1 r3)
                                                (/.trapezoid r2 r0 r3 r1)
                                                (/.trapezoid r2 r1 r0 r3)
                                                (/.trapezoid r2 r1 r3 r0)
                                                (/.trapezoid r2 r3 r0 r1)
                                                (/.trapezoid r2 r3 r1 r0)

                                                (/.trapezoid r3 r0 r1 r2)
                                                (/.trapezoid r3 r0 r2 r1)
                                                (/.trapezoid r3 r1 r0 r2)
                                                (/.trapezoid r3 r1 r2 r0)
                                                (/.trapezoid r3 r2 r0 r1)
                                                (/.trapezoid r3 r2 r1 r0)
                                                )))

                           middle_maxima!
                           (and (r.= //.true (/.membership reference middle_bottom))
                                (r.= //.true (/.membership reference middle_top)))

                           boundary_minima!
                           (and (r.= //.false (/.membership reference bottom))
                                (r.= //.false (/.membership reference top)))

                           inside_range!
                           (bit\= (r.> //.false (/.membership reference sample))
                                  (and (r.> bottom sample)
                                       (r.< top sample)))

                           outside_range!
                           (bit\= (r.= //.false (/.membership reference sample))
                                  (or (r.<= bottom sample)
                                      (r.>= top sample)))


                           inside_inner_range!
                           (bit\= (r.= //.true (/.membership reference sample))
                                  (and (r.<= middle_top sample)
                                       (r.>= middle_bottom sample)))]
                       (and irrelevant_order!
                            middle_maxima!
                            boundary_minima!
                            inside_range!
                            outside_range!
                            inside_inner_range!)))
            ))))

(def: discrete
  Test
  (do random.monad
    [threshold random.nat
     .let [under? (n.< threshold)
           set (set.of_list n.hash (list threshold))]
     sample random.nat]
    ($_ _.and
        (_.cover [/.of_predicate]
                 (bit\= (r.= //.true (/.membership (/.of_predicate under?) sample))
                        (under? sample)))
        (_.cover [/.of_set]
                 (and (r.= //.true (/.membership (/.of_set set) threshold))
                      (bit\= (r.= //.true (/.membership (/.of_set set) sample))
                             (set.member? set sample))))
        )))

(def: gradient
  (Random [[Rev Rev] (Fuzzy Rev)])
  (do random.monad
    [sample random.rev
     
     threshold_0 random.rev
     threshold_1 random.rev

     .let [bottom (r.min threshold_0 threshold_1)
           top (r.max threshold_0 threshold_1)]]
    (in [[bottom top]
         (/.gradient bottom top)])))

(def: threshold
  Test
  (do random.monad
    [[_ set] ..gradient
     threshold random.rev
     sample random.rev]
    ($_ _.and
        (_.cover [/.predicate]
                 (bit\= (not ((/.predicate threshold set) sample))
                        (r.< threshold (/.membership set sample))))
        (_.cover [/.cut]
                 (bit\= (r.= //.false (/.membership (/.cut threshold set) sample))
                        (r.< threshold (/.membership set sample))))
        )))

(def: .public test
  Test
  (<| (_.covering /._)
      (_.for [/.Fuzzy])
      (do random.monad
        [sample random.rev
         [_ fuzzy] ..gradient
         .let [equivalence (: (Equivalence (/.Fuzzy Rev))
                              (implementation
                               (def: (= left right)
                                 (r.= (left sample)
                                      (right sample)))))]]
        ($_ _.and
            (_.for [/.functor]
                   ($contravariant.spec equivalence fuzzy /.functor))
            
            ..trivial
            ..simple
            ..composition
            ..geometric
            ..discrete
            ..threshold
            ))))