;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 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)

(defvar *state* nil)

(deftestsuite state-search-test-suite (fresh-db-test-suite-mixin nova-tests) ()
  :dynamic-variables (*state*)
  :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)))
                                                         (cons 'c (make-num :min 2 :max 4 :discretize-bins 3))
                                                         (cons 'd (make-bag :range (list 1 3 5 7)))))
                (init-db)
                (setf *state*
                      (create-state (separate-treatments (list (current-treatments 'a))) ;ignore
                                    (separate-treatments '((b 5 6) (d 1 3))) ;open
                                    (separate-treatments (list (current-treatments 'c) '(b 7 8) '(d 5 7))) ;closed
                                    )))
  :teardown (setf *state* nil))

;;; state

(addtest check-copy-state-similar-state
  (let ((os *state*)
        (ns (copy-state *state*)))
;;TODO need to check tick is different, but the two state are made close enough together that the ticks are the sam
    (ensure-same      (state-ignore ns)
                      (state-ignore os)
                      :test #'equalp
                      :report "ignore isn't the same")
    (ensure-same      (state-open ns)
                      (state-open os)
                      :test #'equalp
                      :report "open isn't the same")
    (ensure-same      (state-closed ns)
                      (state-closed os)
                      :test #'equalp
                      :report "closed isn't the same")
    (ensure-same      (state-cache ns)
                      (state-cache os)
                      :test #'equalp
                      :report "cache isn't the same")
    (ensure-same      (state-scores ns)
                      (state-scores os)
                      :test #'equalp
                      :report "scores aren't the same")))

(addtest check-copy-state-diffent-innards
  (let ((os *state*)
        (ns (copy-state *state*)))
    (switch-elts '((b 6) (d 7))
                 (state-open ns)
                 (state-closed ns))
    (move-elt '(a 6)
              (state-ignore ns)
              (state-open ns))
    (move-elts '((c 2) (c 4))
               (state-closed ns)
               (state-ignore ns))
    (puta 'new-test-score -123 (state-scores ns))
    (puta 'c 0 (state-cache ns))
    (ensure-different (state-ignore ns)
                      (state-ignore os)
                      :test #'equalp
                      :report "ignore isn't different")
    (ensure-different (state-open ns)
                      (state-open os)
                      :test #'equalp
                      :report "open isn't different")
    (ensure-different (state-closed ns)
                      (state-closed os)
                      :test #'equalp
                      :report "closed isn't different")
    (ensure-different (state-cache ns)
                      (state-cache os)
                      :test #'equalp
                      :report "cache isn't different")
    (ensure-different (state-scores ns)
                      (state-scores os)
                      :test #'equalp
                      :report "scores aren't different")))

(addtest check-constraints?
  (ensure (subset-compare (constraints? *state*)
                          '((d 1) (d 3) (b 5) (b 6))
                          :test #'equalp)))

(addtest check-constraints?-all
  (ensure (subset-compare (constraints? *state* t)
                          '((a 6) (a 7) (a 8) (a 9) (a 10) (b 5) (b 6)
                            (c 2) (c 3) (c 4) (d 1) (d 3))
                          :test #'equalp)))

;;TODO add more scenarios for constraints?

(addtest check-constraint-count-ranges
  (ensure-same (constraint-count *state* :which :ranges)
               4
               :test #'=))

(addtest check-constraint-count-features
  (ensure-same (constraint-count *state* :which :features)
               2
               :test #'=))               

(addtest check-max-constraints-ranges
  (ensure-same (max-constraints *state* :which :ranges)
               8
               :test #'=))

(addtest check-max-constraints-features
  (ensure-same (max-constraints *state* :which :features)
               3
               :test #'=))

(addtest check-constrained%-ranges
  (ensure-same (constrained% *state* :which :ranges)
               (/ 4 8)
               :test #'=))

(addtest check-constrained%-features
  (ensure-same (constrained% *state* :which :features)
               (/ 2 3)
               :test #'=))

(addtest check-with-constraints-of-state
  (with-constraints-of-state *state*
    (ensure (<= 6 (? 'a) 10)
            :report "bad value for num 'a")
    (ensure (member (? 'b) '(5 6))
            :report "bad value for bag b")
    (ensure (<= 2 (? 'c) 4)
            :report "bad value for num 'c")    
    (ensure (member (? 'd) '(1 3))
            :report "bad value for bag d")))