;Soluzione Mondo dei Blocchi Iterative Deepening
;Aggiunta di una regola deepening (vedi commenti piú avanti)

(defmodule MAIN (export ?ALL))

(deftemplate solution (slot value (default no))) 
(deffacts param
       (solution (value no)))
       
(deffacts S0
      (status 0 clear a NA) (status 0 on a b ) (status 0 ontable b NA) 
      (status 0 clear c NA) (status 0 ontable c NA)
      (status 0 clear e NA) (status 0 on e f ) (status 0 on f g) (status 0 ontable g NA)
      (status 0 handempty NA NA))

(deffacts final
      (goal clear c NA) (goal on c a ) (goal ontable a NA) 
      (goal clear b NA) (goal on b g ) (goal ontable g NA)
      (goal clear e NA) (goal on e f) (goal ontable f NA))

(defrule got-solution
(declare (salience 100))
(solution (value yes)) => (halt))

(defrule pick
(declare (salience 10))
   (status ?s on ?x ?y)
   (status ?s clear ?x ?)
   (status ?s handempty ? ?)
   (maxdepth ?d)
    (test (< ?s ?d))
      (not (exec ?s pick ?x ?y)) 
   => (assert (apply ?s pick ?x ?y)))

(defrule apply-pick1
(declare (salience 10))
        (apply ?s pick ?x ?y)
 ?f <-  (status ?t ? ? ?)
        (test (> ?t ?s))
 =>     (retract ?f))

(defrule apply-pick2
(declare (salience 10))
       (apply ?s pick ?x ?y)
?f <-  (exec ?t ? ? ?)
       (test (> ?t ?s))
 =>    (retract ?f))

(defrule apply-pick3
(declare (salience 10))
?f <- (apply ?s pick ?x ?y)
 =>    (retract ?f)
      (assert (delete ?s on ?x ?y))
      (assert (delete ?s clear ?x NA))
      (assert (delete ?s handempty NA NA))
      (assert (status (+ ?s 1) clear ?y NA))
      (assert (status (+ ?s 1) holding ?x NA))
      (assert (current ?s))
      (assert (news (+ ?s 1)))
      (focus CHECK)
      (assert (exec ?s pick ?x ?y )))

(defrule picktable
(declare (salience 10))
   (status ?s ontable ?x ?)
   (status ?s clear ?x ?)
   (status ?s handempty ? ?)
   (maxdepth ?d)
   (test (< ?s ?d))
   (not (exec ?s picktable ?x NA)) 
   => (assert (apply ?s picktable ?x NA)))

(defrule apply-picktable1
(declare (salience 10))
        (apply ?s picktable ?x ?y)
 ?f <-  (status ?t ? ? ?)
        (test (> ?t ?s))
 =>     (retract ?f))

(defrule apply-picktable2
(declare (salience 10))
        (apply ?s picktable ?x ?y)
?f <-  (exec ?t ? ? ?)
       (test (> ?t ?s))
 =>    (retract ?f))

(defrule apply-picktable3
(declare (salience 10))
?f <- (apply ?s picktable ?x ?y)
 =>   (retract ?f)
      (assert (delete ?s ontable ?x NA))
      (assert (delete ?s clear ?x NA))
      (assert (delete ?s handempty NA NA))
      (assert (status (+ ?s 1) holding ?x NA))
      (assert (current ?s))
      (assert (news (+ ?s 1)))
      (focus CHECK)
      (assert (exec ?s picktable ?x NA)))

(defrule put
(declare (salience 10))
   (status ?s holding ?x ?)
   (status ?s clear ?y ?)
   (maxdepth ?d)
   (test (< ?s ?d)) 
   (not (exec ?s put ?x ?y)) 
   => (assert (apply ?s put ?x ?y)))

(defrule apply-put1
(declare (salience 10))
        (apply ?s put ?x ?y)
 ?f <-  (status ?t ? ? ?)
        (test (> ?t ?s))
 =>     (retract ?f))

(defrule apply-put2
(declare (salience 10))
        (apply ?s put ?x ?y)
 ?f <-  (exec ?t ? ? ?)
        (test (> ?t ?s))
 =>     (retract ?f))

(defrule apply-put3
(declare (salience 10))
?f <- (apply ?s put ?x ?y)
 =>   (retract ?f)
      (assert (delete  ?s holding ?x NA))
      (assert (delete  ?s clear ?y NA))
      (assert (status (+ ?s 1) on ?x ?y))
      (assert (status (+ ?s 1) clear ?x NA))
      (assert (status (+ ?s 1) handempty NA NA))
      (assert (current ?s))
      (assert (news (+ ?s 1)))
      (focus CHECK)
      (assert (exec ?s put ?x ?y)))

(defrule puttable
(declare (salience 10))
   (status ?s holding ?x ?)
   (maxdepth ?d)
   (test (<  ?s  ?d))
   (not (exec ?s puttable ?x NA)) 
   => (assert (apply ?s puttable ?x NA)))

(defrule apply-puttable1
;Soluzione di Mapelli I. e Cornaz M.
;Mondo dei blocchi iterative deepening

(declare (salience 10))
        (apply ?s puttable ?x ?y)
 ?f <-  (status ?t ? ? ?)
        (test (> ?t ?s))
 =>     (retract ?f))

(defrule apply-puttable2
(declare (salience 10))
        (apply ?s puttable ?x ?y)
 ?f <-  (exec ?t ? ? ?)
        (test (> ?t ?s))
 =>     (retract ?f))

(defrule apply-puttable3
(declare (salience 10))
?f <- (apply ?s puttable ?x ?y)
 =>    (retract ?f)(assert (delete ?s holding ?x NA))
      (assert (status (+ ?s 1) ontable ?x NA))
      (assert (status (+ ?s 1) clear ?x NA))
      (assert (status (+ ?s 1)handempty NA NA))
      (assert (current ?s))
      (assert (news (+ ?s 1)))
      (focus CHECK)
      (assert (exec ?s puttable ?x NA)))
      
 
 ;In questa regola incrementiamo il massimo livello di profonditá, andiamo a resettare la WM e si 
 ;riparte da livello 0
 (defrule deepening
 (maxdepth ?x)
 =>
 (reset)
 (assert (maxdepth (+ ?x 1))))
 
 (defrule start
 	(not(maxdepth ?))
 	=>
 	(assert (maxdepth 1)))

(defmodule CHECK (import MAIN ?ALL) (export ?ALL))

(defrule comp
    (declare (salience 100))
    (current ?s)
    (status ?s ?op ?x ?y)
    (not (delete ?s ?op ?x ?y))
 => (assert (status (+ ?s 1) ?op ?x ?y)))

(defrule goal-not-yet
      (declare (salience 50))
      (news ?s)
      (goal ?op ?x ?y)
      (not (status ?s ?op ?x ?y))
      => (assert (task go-on)) 
         (assert (ancestor (- ?s 1)))
         (focus NEW))

(defrule solution-exist
 ?f <-  (solution (value no))
         => 
        (modify ?f (value yes))
        (pop-focus))

(defmodule NEW (import CHECK ?ALL) (export ?ALL))

(defrule check-ancestor
    (declare (salience 50))
?f1 <- (ancestor ?a) 
    (or (test (> ?a 0)) (test (= ?a 0)))
    (news ?s)
    (status ?s ?op ?x ?y)
    (not (status ?a ?op ?x ?y)) 
    =>
    (assert (ancestor (- ?a 1)))
    (retract ?f1)
    (assert (diff ?a)))

(defrule all-checked
       (declare (salience 25))
       (diff 0) 
?f2 <- (news ?n)
?f3 <- (task go-on) =>
       (retract ?f2)
       (retract ?f3)
       (focus DEL))

(defrule already-exist
?f <- (task go-on)
      => (retract ?f)
         (assert (remove newstate))
         (focus DEL))

(defmodule DEL (import NEW ?ALL))          
       
(defrule del1
(declare (salience 50))
?f <- (delete $?)
=> (retract ?f))

(defrule del2
(declare (salience 100))
?f <- (diff ?)
=> (retract ?f))

(defrule del3
(declare (salience 25))
       (remove newstate)
       (news ?n)
 ?f <- (status ?n ?  ? ?)
=> (retract ?f))

(defrule del4
(declare (salience 10))
?f1 <- (remove newstate)
?f2 <- (news ?n)
=> (retract ?f1)
   (retract ?f2))

(defrule done
 ?f <- (current ?x) => 
(retract ?f)
(pop-focus)
(pop-focus)
(pop-focus))