; Nel seguito è riportata una versione modificata del mondo dei blocchi
; in cui la strategia di ricerca simulata è quella della iterative deepening.
; Questa è ottenuta andando a definire nel modulo main lo stato iniziale e finale nonchè  
; la creazione di un fatto (maxdepth 0) che corrisponde al livello iniziale di cutoff. 
;  La vera ricerca in profondita fino al livello corrente di cutoff è effettuata invocando
;  il modulo MAIN2 (invocato nella parte azione della regola risolvi). 
; Questa regola incrementa di due il valore dle cutoff dal momneto che assume che non 
; ci sia un goal in cui dsi richeide di avere un blocco nella mano del robot
;
; Per un modo alternativo di realizzare la strategia con iterative deepening  si veda il 
; codice riportato dopo questa versione.
; Risoluzione di problemi nel mondo dei blocchi in CLIPS.
; la strategia e' Iterative Deepening

(defmodule MAIN (export ?ALL))

(deftemplate solution (slot value (default no))) 
(deffacts param
       (solution (value no)) (maxdepth 0))

(deffacts S0
      (status 0 clear a NA) (status 0 on a b ) (status 0 on b c ) (status 0 ontable c NA) 
      (status 0 ontable d NA) (status 0 clear d NA)
      (status 0 handempty NA NA))

(deffacts final
      (goal on  a b) (goal on c d) (goal ontable d NA) (goal on b c))

(defrule trovato
(declare (salience 100))
	(risolto)=>
	(printout t crlf "risolto" crlf)(halt)
)

(defrule pulisci
	(declare (salience 75))
	?f <- (status ?x&~0 ? ? ?) => (retract ?f))

(defrule pulisci2
	(declare (salience 75))
	?f <- (exec $?) => (retract ?f))

(defrule pulisci3
	(declare (salience 75))
	?f <- (ancestor $?) => (retract ?f))

(defrule risolvi
(declare (salience 50))
    ?f1<-(maxdepth ?x)=>
	(retract ?f1)
	(assert (maxdepth (+ ?x 2)))
	(focus MAIN2)
)
	


(defmodule MAIN2 (import MAIN ?ALL)(export ?ALL))
(defrule got-solution
(declare (salience 100))
(solution (value yes)) => 
	(assert (risolto))
	(pop-focus)
)

(defrule pick
   (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
        (apply ?s pick ?x ?y)
 ?f <-  (status ?t ? ? ?)
        (test (> ?t ?s))
 =>     (retract ?f))

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

(defrule apply-pick3
?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
   (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
        (apply ?s picktable ?x ?y)
 ?f <-  (status ?t ? ? ?)
        (test (> ?t ?s))
 =>     (retract ?f))

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

(defrule apply-picktable3
?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
   (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
        (apply ?s put ?x ?y)
 ?f <-  (status ?t ? ? ?)
        (test (> ?t ?s))
 =>     (retract ?f))

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

(defrule apply-put3
?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
   (status ?s holding ?x ?)
   (maxdepth ?d)
   (test (<  ?s  ?d))
   (not (exec ?s puttable ?x NA)) 
   => (assert (apply ?s puttable ?x NA)))

(defrule apply-puttable1
        (apply ?s puttable ?x ?y)
 ?f <-  (status ?t ? ? ?)
        (test (> ?t ?s))
 =>     (retract ?f))

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

(defrule apply-puttable3
?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)))

(defmodule CHECK (import MAIN2 ?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))


; Nel seguito è riportata una versione modificata della iterative deepening nel 
; mondo dei blocchi sviluppata da Mapelli, Cornaz, Schifanella
;  
; Questa versione sfrutta l'azione reset per ripristinare la situazione iniziale e
; per incrementare il cutoff (regola deepning) mentre il cutoff iniziale e' messo ad uno ; dalla regola Start. Ni noti che queste due regole hanno priorità piu' bassa delle altre.




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