;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;  learning.lisp
;;;  Written by:  Shaul Markovitch
;;;  Last time modified: 31/03/96 10:00
;;;
;;; learn-macros
;;; report-learning-state
;;; update-consumed-resources
;;; remaining-resources
;;; perform-test
;;;  
;;;  
;;;  


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; learn-macros
;;;
;;; The main procedure of this project.  The procedure loops as long
;;; as there are still learning resources.  In most cases the learning
;;; resources that are used for determining the length of the session
;;; are the training problems.  The program loops and generate training
;;; problems.  Each training problem is solved by calling the search
;;; procedure.  The outcome of the search (including the node of the final
;;; state which can be used for extracting the solution) is given
;;; to the function which generate new macros.  
;;; The new macros are given to the acquisition filter which decides
;;; what macros will go in.
;;; It is possible to give the learning procedure a set of testing
;;; problems and a set of testing points.
;;; If testing points are not given then the test set is solved
;;; once before the learning and once after.  If there is a list,
;;; then this list is interpreted as a list of number of training problems
;;; solved by the learning.  Whenever the number of the training problems 
;;; is equal to an elemnt in the list, a test is performed.
;;;  The procedue returns the macros learned, the resources consumed
;;;  and a list of results of the tests erformed during the learning
;;; session.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun learn-macros (&key
		     (learning-strategy *default-learning-strategy*)
		     (macro-db nil)
		     (test-set nil)
		     (test-points nil)
		     )
  (let ((resources (make-learning-resources))
	(testing-points (copy-list test-points))
	(history nil)
	(test-results nil))
    (setf macro-db (generate-new-db (learning-domain
				     learning-strategy)))
    (when test-set
	  (push (list (copy-learning-resources resources)
		      (perform-test test-set
					      macro-db
					      learning-strategy ))
		test-results))
    (loop while (remaining-resources resources learning-strategy)
	for training-problem = (generate-problem
				(learning-domain learning-strategy)
				(learning-generation-filtering
				   learning-strategy)
			
				)
	for search-outcome = (perform-search training-problem
					     (learning-domain
					      learning-strategy)
					     (learning-training-search-strategy
					      learning-strategy)
					     macro-db)
	for new-macros = (generate-macros search-outcome
					  (learning-attention-filtering learning-strategy)
					  (learning-domain
					   learning-strategy)
					  macro-db
					  (learning-training-search-strategy
					      learning-strategy))
	do
	(push (list training-problem search-outcome) history)
	(loop for m in new-macros
	      when
	      (acquisition-filtering
	       (learning-acquisition-filtering learning-strategy)
	       m macro-db (learning-domain learning-strategy))
	      do
	      (add-macro macro-db m (learning-domain learning-strategy))
	      )
	(update-consumed-resources resources search-outcome
				   (length (macro-db-macros macro-db)))
	(report-learning-state resources)
	(when (and test-set
		   (>= (get-resources (learning-resource-type
				       learning-strategy)
				      resources)
		      (first testing-points)))
	      (pop testing-points)
	      (push (list (copy-learning-resources resources)
			  (perform-test test-set macro-db learning-strategy))
		test-results))
	
	)
    (when (and test-set (null testing-points))
	  (push (list (copy-learning-resources resources)
		      (perform-test test-set
					      macro-db
					      learning-strategy ))
		test-results))
    (make-learning-outcome
     :macros macro-db
     :resources resources
     :test-results (reverse test-results))))
		
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;  report=learning-state
;;;  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		
(defun report-learning-state
  (resources)
  (when *learning-report-flag*
  (format t "~%~4D ] Macros: ~5D generated: ~6D expanded: ~6D cpu seconds: ~7,2F"
	  (learning-resources-problems resources)
	  (learning-resources-macros resources)
	  (learning-resources-generated resources)
	  (learning-resources-expanded resources)
	  (learning-resources-cpu-seconds resources))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun update-consumed-resources
  (resources search-outcome n-macros)
  (incf (learning-resources-generated resources)
	(search-outcome-generated search-outcome))
  (incf (learning-resources-expanded resources)
	(search-outcome-expanded search-outcome))
  (incf (learning-resources-cpu-seconds resources)
	(search-outcome-cpu-seconds search-outcome))
  (incf (learning-resources-problems resources)
	1)
  (setf (learning-resources-macros resources) n-macros)
  resources)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun remaining-resources
  (resources learning-strategy)
  (case (learning-resource-type learning-strategy)
	(problems (< (learning-resources-problems resources)
		     (learning-max-resources learning-strategy)))
	(generated (< (learning-resources-generated resources)
		     (learning-max-resources learning-strategy)))
	(expanded (< (learning-resources-expanded resources)
		     (learning-max-resources learning-strategy)))
	(cpu-seconds (< (learning-resources-cpu-seconds resources)
		     (learning-max-resources learning-strategy)))
	(macros  (< (learning-resources-macros resources)
		     (learning-max-resources learning-strategy)))
	(t (error "No such resource type: ~A"
		  (learning-resource-type learning-strategy)))))

(defun get-resources
  (resource-type resources)
  (funcall (intern (concatenate 'string "LEARNING-RESOURCES-"
				(symbol-name resource-type)))
	   resources))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defparameter *default-macro-hash-size* 10000)

(defmethod generate-new-db
  ((domain domain))
  (let ((new-db (make-instance 'macro-db)))
    (setf (macro-db-hash new-db)
      (make-hash-table :test #'equal
		     :size *default-macro-hash-size*))
    new-db))

(defmethod add-macro
  ((db macro-db) new-macro (domain domain))
  (push new-macro (macro-db-macros db))
  (push new-macro (gethash (macro-start-state new-macro)
			   (macro-db-hash db))))

(defmethod remove-macro
  ((db macro-db) macro (domain domain))
  (declare (ignore macro))
  )

(defmethod get-hashed-macros
  ((db macro-db) state (domain domain))
  (gethash state (macro-db-hash db)))


(defmethod print-object
  ((db macro-db) stream)
  (print (macro-db-macros db) stream))

(defun create-macro-db
  (macro-list domain)
  (let ((new-db (generate-new-db domain)))
    (loop for macro in (reverse macro-list)
	  do (add-macro new-db macro domain))
    new-db))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun perform-test
  (test-set macro-db learning-strategy)
  (let
     ((outcome (solve-problem-set test-set
				  (learning-domain learning-strategy)
				  (learning-testing-search-strategy
				   learning-strategy)
				  macro-db)))

    (when *learning-report-flag*
	  (format t "~%~% [TEST] n-problems: ~5d Generated: ~7,2f Solution Length: ~7,2f~%~%"
		  (problem-set-outcome-n outcome)
		  (statistics-mean (problem-set-outcome-generated outcome))
		  (statistics-mean (problem-set-outcome-solution-length outcome))))
    outcome))