All pastes #2134119 Raw Edit

Miscellany

public text v1 · immutable
#2134119 ·published 2012-03-30 17:22 UTC
rendered paste body
(deffacts startup (player-has 1 3 4 5) (player-has 2 1 7 9) (player-has 3 2 6 8)
                  (slot 1 has 1) (slot 1 has 2) (slot 1 has 3)
                  (slot 2 has 4) (slot 2 has 5) (slot 2 has 6)
                  (slot 3 has 7) (slot 3 has 8) (slot 3 has 9)
                  (player-turn 1) )

(defrule init-sum
    (player-has ?player ?a ?b ?c)
    =>
    (bind ?total (+ ?a ?b ?c))
    (assert (sum ?player is ?total)))
    
(defrule initialize
    (declare (salience 2))
    (slot $? has ?a)
    (slot $? has ?b)
    (slot $? has ?c)
    (test(< ?a ?b))
    (test(< ?b ?c))    
    (sum ?player is ?s)
    (test (= (+ ?a ?b ?c) ?s))    
    =>
    (assert (can-have ?player list ?a ?b ?c)))

(defrule combine
    (declare (salience 2))
    (can-have 1 list ?a ?b ?c)
    (can-have 2 list ?d ?e ?f)
    (can-have 3 list ?g ?h ?i)
    (slot 1 has ?g)
    (slot 2 has ?h)
    (slot 3 has ?i)
    (test(= 45 (+ ?a ?b ?c ?d ?e ?f ?g ?h ?i)))
    (test(= 362880 (* ?a ?b ?c ?d ?e ?f ?g ?h ?i)))    
    =>
    (assert (possible-combination # 1 ?a ?b ?c # 2 ?d ?e ?f # 3 ?g ?h ?i)))
    (printout t "possible combination " ?a " " ?b " " ?c " " ?d " " ?e " " ?f " " ?g " " ?h " " ?i crlf)
    
(defglobal
    ?*player* = 1
)

(defrule can-guess
    (player-turn ?player)
    (player-has ?player ?x ?y ?z)
    (possible-combination $? # ?player ?x ?y ?z $? # 3 ?d ?e ?f)
    (forall (possible-combination $? # ?player ?x ?y ?z $? # 3 ?a ?b ?c) (test(= ?a ?d)) (test(= ?b ?e)) (test(= ?c ?f)))
    =>
    (assert (game-stopped))
    (printout t "Player " ?player " found secret is " ?d " " ?e " " ?f crlf))

(defrule cannot-guess
    ?fact <- (player-turn ?player)
    (player-has ?player ?x ?y ?z)
    (possible-combination $? # ?player ?x ?y ?z $? # 3 ?d ?e ?f)
    (not (forall (possible-combination $? # ?player ?x ?y ?z $? # 3 ?a ?b ?c) (test(= ?a ?d)) (test(= ?b ?e)) (test(= ?c ?f))))
    =>
    (printout t ?player " cannot guess" crlf)
    (assert (fail-guess ?player))
    (retract ?fact))

(defrule remove-fail-combination
    (fail-guess ?player)
    ?fact <- (possible-combination $? # ?player ?x ?y ?z $? # 3 ?g ?h ?i)
    (forall (possible-combination $? # ?player ?x ?y ?z $? # 3 ?gg ?hh ?ii) (test(= ?g ?gg)) (test(= ?h ?hh)) (test(= ?i ?ii)))
    =>
    (printout t "retract fact " ?fact " player " ?player " " ?x " " ?y " " ?z crlf)
    (retract ?fact))

(defrule done-remove-combinations
    (fail-guess ?player)
    (forall (possible-combination $? # ?player ?a ?b ?c $? # 3 ?d ?e ?f)
        (exists (possible-combination $? # ?player ?a ?b ?c $? # 3 ?dd ?ee ?ff) (or (not(test(= ?d ?dd))) (not(test(= ?e ?ee))) (not(test(= ?f ?ff)))   ) ) )
    =>
    (printout t "removed all facts that would help player " ?player " guess" crlf)
    (assert (done-removal ?player)))

(defrule next-player
    ?fact1 <- (fail-guess ?player)
    ?fact2 <- (done-removal ?player)
    (test(= ?*player* ?player))
    =>
    (bind ?*player* (+ (mod  ?*player* 2) 1))
    (retract ?fact1)
    (retract ?fact2)
    (assert (player-turn ?*player*))
    (printout t "current player is " ?*player* crlf))