;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; This file is part of "NOVA":  NOVA = search + COCOMO tools
; Copyright, 2008, Tim Menzies tim@menzies.us
;
; NOVA is free software: you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation, either version 3 of the License, or
; (at your option) any later version.
;
; NOVA is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU General Public License for more details.
; You should have received a copy of the GNU General Public License
; a long with NOVA.  If not, see <http://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :nova-test.search)

(deftestsuite treatments-search-test-suite (fresh-db-test-suite-mixin) ()
  :setup (progn (register-db-default-configuration-list 'test-default-configurations
                                                        (list
                                                         (cons 'a (make-num :min 6 :max 10 :discretize-bins 5))
                                                         (cons 'b (make-bag :range (list 5 6 7 8)))))
                (init-db)))

;;;; treatments stuff

;;; current-treatments
(addtest current-treatments-num
  (ensure-same (current-treatments 'a)
               '(a 6 10)
               :test #'equalp
               :report "check current-treatments with num"))

(addtest current-treatments-bag
  (ensure-same (current-treatments 'b)
               '(b 5 6 7 8)
               :test #'equalp
               :report "check current-treatments with bag"))

;;; coalesce-treatments

;;num
(addtest coalesce-attribute-treatments-num-nil-item
  (ensure-same (coalesce-attribute-treatments 'a nil 2)
               '(2)
               :test #'equalp
               :report "test coalesce-attribute-treatments of num with nil and item"))
(addtest coalesce-attribute-treatments-num-nil-list
  (ensure-same (coalesce-attribute-treatments 'a nil '(2 3))
               '(2 3)
               :test #'equalp
               :report "test coalesce-attribute-treatments of num with nil and list"))
(addtest coalesce-attribute-treatments-num-list-item
  (ensure-same (coalesce-attribute-treatments 'a '(1 2) 3)
               '(1 3)
               :test #'equalp
               :report "test coalesce-attribute-treatments of num with list and item"))
(addtest coalesce-attribute-treatments-num-list-list
  (ensure-same (coalesce-attribute-treatments 'a '(1 3) '(2 4))
               '(1 4)
               :test #'equalp
               :report "test coalesce-attribute-treatments of num with list and list"))
(addtest coalesce-attribute-treatments-num-singleton
  (ensure-same (coalesce-attribute-treatments 'a '(1) '(1 1))
               '(1)
               :test #'equalp
               :report "test coalesce-attribute-treatments of num which returns a singleton"))

;;bag
(addtest coalesce-attribute-treatments-bag-nil-item
  (ensure-same (coalesce-attribute-treatments 'b nil 2)
               '(2)
               :test #'subset-compare
               :report "test coalesce-attribute-treatments of bag with nil and item"))
(addtest coalesce-attribute-treatments-bag-nil-list
  (ensure-same (coalesce-attribute-treatments 'b nil '(2))
               '(2)
               :test #'subset-compare
               :report "test coalesce-attribute-treatments of bag with nil and list"))
(addtest coalesce-attribute-treatments-bag-list-item
  (ensure-same (coalesce-attribute-treatments 'b '(1) 2)
               '(1 2)
               :test #'subset-compare
               :report "test coalesce-attribute-treatments of bag with list and item"))
(addtest coalesce-attribute-treatments-bag-list-list
  (ensure-same (coalesce-attribute-treatments 'b '(1) '(2))
               '(1 2)
               :test #'subset-compare
               :report "test coalesce-attribute-treatments of bag with list and list"))

(addtest coalesce-treatments
  (ensure-same (coalesce-treatments '((a 1) (a 2) (b 1) (b 2)))
               '((b 1 2) (a 1 2))
               :test #'subset-compare-equalp
               :report "coalescing treatments"))


;;; seperate treatments

(addtest separate-attribute-treatments-num
  (ensure-same (separate-attribute-treatments 'a '(1 5))
               '((a 1) (a 2) (a 3) (a 4) (a 5))
               :test #'subset-compare-equalp
               :report "test separate-attribute-treatments of num"))

(addtest separate-attribute-treatments-bag
  (ensure-same (separate-attribute-treatments 'b '(1 2 3))
               '((b 1) (b 2) (b 3))
               :test #'subset-compare-equalp
               :report "test separate-attribute-treatments of bag"))

(addtest seperate-treatments
  (ensure-same (separate-treatments '((a 6 10) (b 1 2)))
               '((b 2) (b 1) (a 6) (a 7) (a 8) (a 9) (a 10))
               :test #'subset-compare-equalp
               :report "seperating treatments"))

;;; apply treatments

(addtest check-apply-treatment-num
  (apply-treatment 'a '(1 2))
  (let ((a-val (? 'a)))
    (ensure (<= 1 a-val 2)
            :report "check that apply-treatment works for num: ~a"
            :arguments (a-val))))

(addtest check-apply-treatment-bag
  (apply-treatment 'b '(11 21 31))
  (let ((b-val (? 'b)))    
    (ensure (member b-val '(11 21 31))
            :report "check that apply-treatment works for bag: ~a"
            :arguments (b-val))))

(addtest check-apply-treatments
  (apply-treatments '((a 3 4) (b 3 4 5)))
  (let ((a-val (? 'a))
        (b-val (? 'b)))
    (ensure (<= 3 a-val 4)
            :report "check that apply-treatments works for num: ~a"
            :arguments (a-val))
    (ensure (member b-val '(3 4 5))
            :report "check that apply-treatment works for bag: ~a"
            :arguments (b-val))))            

;;; helper functions

(addtest check-complete-treatments
  (let ((ct (complete-treatments '((a 1 2)))))
    (ensure (assoc 'a ct)
            :report "make sure previous treatments are in complete")
    (ensure (assoc 'b ct)
            :report "make sure other treatments are in complete")))

(addtest check-with-treatments-apply-treatment
  (with-treatments '((a 1 1))
    (ensure-same (? 'a)
                 1
                 :test #'=
                 :report "check that with-treatments applies treatment")))

(addtest check-with-treatments-db-is-restored
  (with-treatments '((a 1 1))
    (zaps)
    (! 'a))
  (ensure (<= 6 (? 'a) 10)
          :report "ensure db is the same after with-treatments"))

(addtest check-with-treatments-org-cache-is-same
  (let ((org-a (! 'a)))
    (with-treatments '((a 1 1))
      (zaps)
      (! 'a))
    (ensure-same (! 'a)
                 org-a
                 :report "check the previously cached values remain")))


(addtest check-singleton-p-singleton
  (ensure (singleton-p '(a 1))
          :report "check that singleton-p is t for a singleton"))          

(addtest check-singleton-p-not-singleton
  (ensure-null (singleton-p '(a 1 3))
               :report "check that singleton-p is nil for a non-singleton"))

(addtest check-singleton-p-singleton
  (ensure (singleton-p '((a 1) (b 2)))
          :report "check that singletons-p is t for all singletons"))          

(addtest check-singletons-p-not-singleton
  (ensure-null (singletons-p '((a 1 3) (b 2)))
               :report "check that singletons-p is nil when there is a non-singleton"))

(addtest check-singletons?
  (ensure (every #'singleton-p (singletons? '((a 1 3) (b 2))))
          :report "check that singletons? returns singletons in a treatment list"))

(addtest check-non-singletons?
  (ensure-null (some #'singleton-p (non-singletons? '((a 1 3) (b 2))))
               :report "check that non-singletons? returns non-singletons in a treatment list"))