;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 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 fresh-evaluate-state-fn-test-suite-mixin () ()
  :documentation "By using this mixin, each test will run with a fresh evaluate-state-function set to noop."
  :export-p t
  :dynamic-variables (*evaluate-state-function*)
  :setup (setf *evaluate-state-function* #'noop)
  :teardown (setf *evaluate-state-function* nil))

(defvar *test-states* nil)
(deftestsuite state-scoring-test-suite (fresh-db-test-suite-mixin fresh-evaluate-state-fn-test-suite-mixin nova-tests) ()
  :dynamic-variables (*test-states*)
  :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 10 30 50 70)))
                                                         (cons 'e (make-num :min 0 :max 1 :discretize-bins 3))))
                (init-db)
                (setf *evaluate-state-function* #'(lambda (state) (declare (ignore state)) 2)
                      *test-states*
                      (list
                       ;;0
                       (create-state '() ;ignore
                                     '((a 6) (b 5) (c 2) (d 10)) ;open
                                     '((a 7) (a 8) (a 9) (a 10)
                                       (b 6) (b 7) (b 8)
                                       (c 3) (c 4)
                                       (d 30) (d 50) (d 70))
                                     )
                       ;;1
                       (create-state '() ;ignore
                                     '((a 6) (b 5) (c 2) (d 10)) ;open
                                     '((a 7) (a 8) (a 9) (a 10)
                                       (b 6) (b 7) (b 8)
                                       (c 3) (c 4)
                                       (d 30) (d 50) (d 70))
                                     )
                       ;;2
                       (create-state '() ;ignore
                                     '((a 6) (b 6) (c 2) (d 30)) ;open
                                     '((a 7) (a 8) (a 9) (a 10)
                                       (b 5) (b 7) (b 8)
                                       (c 3) (c 4)
                                       (d 10) (d 50) (d 70))
                                     )
                       ;;3
                       (create-state '() ;ignore
                                     '((a 6) (b 7) (c 2) (d 50)) ;open
                                     '((a 7) (a 8) (a 9) (a 10)
                                       (b 5) (b 6) (b 8)
                                       (c 3) (c 4)
                                       (d 10) (d 30) (d 70))
                                     )
                       ;;4
                       (create-state '() ;ignore
                                     '((a 6) (b 8) (c 2) (d 70)) ;open
                                     '((a 7) (a 8) (a 9) (a 10)
                                       (b 5) (b 6) (b 7)
                                       (c 3) (c 4)
                                       (d 10) (d 30) (d 50))
                                     )
                       ;;5
                       (create-state '() ;ignore
                                     '((a 6) (b 8) (c 2) (d 70)) ;open
                                     '((a 7) (a 8) (a 9) (a 10)
                                       (b 5) (b 6) (b 7)
                                       (c 3) (c 4)
                                       (d 10) (d 30) (d 50))
                                     )))))

;;;
;;; Evaluate State Function
;;;

(addtest check-evaluate-state
  (ensure-same (evaluate-state (create-state nil nil nil))
               2))

(addtest check-set-evaluate-state-function
  (set-evaluate-state-function #'(lambda (state) (declare (ignore state)) 3))
  (ensure-same (evaluate-state (create-state nil nil nil))
               3))

(addtest check-with-evaluate-state-function
  (ensure-same (with-evaluate-state-function #'(lambda (state) (declare (ignore state)) 4)
                 (evaluate-state (create-state nil nil nil)))
               4)
  (ensure-same (evaluate-state (create-state nil nil nil))
               2))
;;;
;;; Evaluate State Augmentor
;;;

(addtest check-augment-evaluate-state-function
  (with-evaluate-state-function (augment-evaluate-state-function #'(lambda () 8)
                                                                   #'evaluate-state-augmentor-store-evaluation-score
                                                                   #'evaluate-state-augmentor-ignore-state)
    (let ((state (create-state nil nil nil)))
      (ensure-same (evaluate-state state)
                   8)
      (ensure-same (geta 'nova.search:evaluation-score (state-scores state))
                   8))))

(addtest check-augment-evaluate-state-function-by-ids
  (with-evaluate-state-function (augment-evaluate-state-function-by-ids #'(lambda () 18) :store-evaluation-score :ignore-state)
    (let ((state (create-state nil nil nil)))
      (ensure-same (evaluate-state state)
                   18)
      (ensure-same (geta 'nova.search:evaluation-score (state-scores state))
                   18))))

;;
;; Standard Evaluate State Augmentors
;;


(addtest check-evaluate-state-augmentor-with-constraints
  (labels ((test-score (state)
             (declare (ignore state))
             (? 'a)))
    (with-new-db
      (register-db-default-configuration-list 'test `((a . ,(make-bag :range '(1 2)))))
      (init-db)
      (let* ((test-state (create-state nil '((a 3)) '((a 4))))
             (normal-score (with-evaluate-state-function #'test-score
                             (evaluate-state test-state)))
             (constraint-score (with-evaluate-state-function (evaluate-state-augmentor-with-constraints #'test-score)
                                 (evaluate-state test-state))))
        (ensure-different normal-score
                          constraint-score)))))

(addtest check-evaluate-state-augmentor-ignore-state
  (ensure-no-warning (set-evaluate-state-function (evaluate-state-augmentor-ignore-state #'(lambda () 7) )))
  (ensure-same (evaluate-state (create-state nil nil nil))
               7))

(addtest check-evaluate-n-store
  (let ((evaluate-state-function #'(lambda (state) (declare (ignore state)) 13))
        (state (create-state nil nil nil))
        (evaluation-score nil))
    (ensure-no-warning (setf evaluation-score
                             (evaluate-n-store evaluate-state-function state)))
    (ensure-same evaluation-score
                 13)
    (ensure-same (geta *evaluation-score-symbol* (state-scores state))
                 13)))

(addtest check-evaluate-state-augmentor-store-evaluation-score
  (with-evaluate-state-function (evaluate-state-augmentor-store-evaluation-score #'(lambda (state) (declare (ignore state)) 5) )
    (let ((state (create-state nil nil nil)))
      (ensure-same (evaluate-state state)
                   5)
      (ensure-same (geta 'nova.search:evaluation-score (state-scores state))
                   5))))

(addtest check-evaluate-state-augmentor-evaluate-once
  (let ((call-once-fn (evaluate-state-augmentor-evaluate-once (let ((been-called nil))
                                                                #'(lambda (state)
                                                                    (declare (ignore state))
                                                                    (when been-called
                                                                      (error "this function has already been called"))
                                                                    (setf been-called t)
                                                                    6))))
        (state (create-state nil nil nil)))
    (with-evaluate-state-function call-once-fn
      (ensure-same (evaluate-state state)
                   6)
      (ensure-same (evaluate-state state)
                   (geta 'nova.search:evaluation-score (state-scores state)))
      (ensure-error (funcall call-once-fn nil)))))

;;;
;;; 'Best' evaluation score states
;;;

(labels ((db-sum () (reduce #'+ (mapcar #'! (all-db-keys))))
         (monte-carlo-db-sum () (monte-carlo :score-fn #'db-sum
                                             :combine-fn #'median)))
  (let ((monte-carlo-db-sum-score (augment-evaluate-state-function-by-ids #'monte-carlo-db-sum :with-constraints :ignore-state)))

    (addtest check-max-evaluation-score-state?
      (with-evaluate-state-function monte-carlo-db-sum-score
        (ensure (member (position (max-evaluation-score-state? *test-states*)
                                  *test-states*)
                        '(4 5)))))

    (addtest check-min-evaluation-score-state?
      (with-evaluate-state-function monte-carlo-db-sum-score
        (ensure (member (position (min-evaluation-score-state? *test-states*)
                                  *test-states*)
                        '(0 1)))))))