There are two tasks to be solved: (1) generate all possible squares and (2)
check for magic-ness. Jeff's solution is based on the fact that some square
has a certain value, so that the value can be used in one of the 8 sums. For
an alternative approach, consider that there are some other facts lurking
behind each of these nine facts. Consider an element a(i,j): it contributes
to the sum of row i, column j and, possibly, to one or both diagonals. So,
if we had two or three or four facts like these instead of the simple
value-at-a-square-fact, a more general set of rules could be applied where
the dimension of the array isn't explicit. This is elaborated below.
(defglobal ?*ord* = 3)
(defglobal ?*ord2* = (* ?*ord* ?*ord*))
(defglobal ?*expect* = (round (/ (* ?*ord* (+ ?*ord2* 1)) 2)))
(set-reset-globals FALSE)
(deftemplate Perm (declare (ordered TRUE)))
(deftemplate Square (declare (ordered TRUE)))
(deftemplate Add (slot type)(slot index)(slot val))
(deftemplate Row (slot row)(slot sum (default 0)))
(deftemplate Col (slot col)(slot sum (default 0)))
(deftemplate Diag (slot type)(slot sum (default 0)))
(defrule sumByRow
?add <- (Add (type row)(index ?i)(val ?v))
?row <- (Row (row ?i)(sum ?srow))
=>
(modify ?row (sum (+ ?srow ?v)))
(retract ?add)
)
(defrule sumByCol
?add <- (Add (type col)(index ?i)(val ?v))
?col <- (Col (col ?i)(sum ?scol))
=>
(modify ?col (sum (+ ?scol ?v)))
(retract ?add)
)
(defrule sumDiag
?add <- (Add (type ?t)(val ?v))
?dia <- (Diag (type ?t)(sum ?sdia))
=>
(modify ?dia (sum (+ ?sdia ?v)))
(retract ?add)
)
(defrule checkFailure
?s <- (Square $?l)
(not (Add))
(exists (or (Row (sum ~?*expect*))
(Col (sum ~?*expect*))
(Diag (sum ~?*expect*))))
=>
;;(printout t "Sorry, not a magic square: " $?l crlf)
(retract ?s)
)
(defrule checkSuccess
?s <- (Square $?l)
(not (Add))
(not (Row (sum ~?*expect*)))
(not (Col (sum ~?*expect*)))
(not (Diag (sum ~?*expect*)))
=>
(printout t "It's magic!" $?l crlf)
(retract ?s)
)
(defrule usePerm
?p <- (Perm $?l &:(= (length$ $?l) ?*ord2*))
=>
(retract ?p)
(assert (Square $?l))
(assert (Diag (type d1)))
(assert (Diag (type d2)))
(for (bind ?i 1)(<= ?i ?*ord*)(++ ?i)
(assert (Row (row ?i)))
(assert (Col (col ?i)))
(for (bind ?j 1)(<= ?j ?*ord*)(++ ?j)
(bind ?v (first$ $?l))
(bind ?l (rest$ $?l))
(assert (Add (type row)(index ?i)(val ?v)))
(assert (Add (type col)(index ?j)(val ?v)))
(if (= ?i ?j) then
(assert (Add (type d1)(val ?v)))
)
(if (= ?*ord* (+ ?i ?j -1)) then
(assert (Add (type d2)(val ?v)))
)
)
)
)
;;
;; Construct permutations of a list and call a lambda for each.
;;
(deffunction permrec (?f ?perm ?elem)
(if (> (length$ ?elem) 0) then
(bind ?el (first$ ?elem))
(bind ?b (rest$ ?elem))
(bind ?lim (+ 1 (length$ ?perm)))
(for (bind ?i 1) (<= ?i ?lim) (++ ?i)
(bind ?a (insert$ ?perm ?i ?el))
(permrec ?f ?a ?b)
)
else
(call ?f ?perm)
)
)
(deffunction permute (?f $?elem)
(permrec ?f (list) $?elem)
)
(bind ?func
(lambda ($?l)
(reset)
(assert (Perm $?l))
(run)
)
)
(bind ?l (list))
(for (bind ?i 0) (<= ?i ?*ord2*) (++ ?i) (bind ?l (list ?l ?i)))
(permute ?func ?l)
On Tue, May 6, 2008 at 10:29 PM, Jeff Brown <[EMAIL PROTECTED]> wrote:
> I have worked up a jess program that identifies permutations of the
> "magic square" which is 3x3 and contains the numbers 1-9, 1 in each
> cell such that each of the 3 rows, 3 columns and 2 diagonals sum to
> 15. The output includes all 8 solutions (1 arrangement rotated 4 ways
> and flipped for a total of 8).
>
> Is this code anything close to idiomatic Jess? The way that I am
> expressing that all 9 squares must have unique values seems like it
> must not be the "right" way.
>
> I would appreciate any feedback.
>
> (deftemplate square (slot number) (slot hasValue))
>
> (defrule find-solution
> (square (number 1) (hasValue ?value1))
> (square (number 2) (hasValue ?value2&~?value1))
> (square (number 3) (hasValue ?value3&~?value2&~?value1))
> (square (number 4) (hasValue ?value4&~?value3&~?value2&~?value1))
> (square (number 5) (hasValue
> ?value5&~?value4&~?value3&~?value2&~?value1))
> (square (number 6) (hasValue
> ?value6&~?value5&~?value4&~?value3&~?value2&~?value1))
> (square (number 7) (hasValue
> ?value7&~?value6&~?value5&~?value4&~?value3&~?value2&~?value1))
> (square (number 8) (hasValue
> ?value8&~?value7&~?value6&~?value5&~?value4&~?value3&~?value2&~?value1))
> (square (number 9) (hasValue
>
> ?value9&~?value8&~?value7&~?value6&~?value5&~?value4&~?value3&~?value2&~?value1))
>
> ;; rows must sum 15
> (test (= (+ ?value1 ?value2 ?value3) 15))
> (test (= (+ ?value4 ?value5 ?value6) 15))
> (test (= (+ ?value7 ?value8 ?value9) 15))
>
> ;; columns must sum 15
> (test (= (+ ?value1 ?value4 ?value7) 15))
> (test (= (+ ?value2 ?value5 ?value8) 15))
> (test (= (+ ?value3 ?value6 ?value9) 15))
>
> ;; diagonals must sum 15
> (test (= (+ ?value3 ?value5 ?value7) 15))
> (test (= (+ ?value1 ?value5 ?value9) 15))
> =>
> (printout t ?value1 " " ?value2 " " ?value3 crlf)
> (printout t ?value4 " " ?value5 " " ?value6 crlf)
> (printout t ?value7 " " ?value8 " " ?value9 crlf crlf))
>
> (defrule generate-combinations
> =>
> (bind ?squareNumber 1)
> (while (<= ?squareNumber 9) do
> (bind ?squareValue 1)
> (while (<= ?squareValue 9) do
> (assert (square (number ?squareNumber) (hasValue ?squareValue)))
> (bind ?squareValue (+ ?squareValue 1)))
> (bind ?squareNumber (+ ?squareNumber 1))))
>
> (reset)
> (run)
>
>
>
>
>
>
> --
> Jeff Brown
> Director North American Operations
> G2One Inc.
> http://www.g2one.com/
>
> Autism Strikes 1 in 166
> Find The Cause ~ Find The Cure
> http://www.autismspeaks.org/
>
>
> --------------------------------------------------------------------
> To unsubscribe, send the words 'unsubscribe jess-users [EMAIL PROTECTED]'
> in the BODY of a message to [EMAIL PROTECTED], NOT to the list
> (use your own address!) List problems? Notify [EMAIL PROTECTED]
> --------------------------------------------------------------------
>
>
