I tried the brute force procedure search with a maximal depth limit, it is
really slow. while in other systems (like yap)it much faster.
In yap, I defined
move(x,y) :- up(x,y).
move(x,y) :- down(x,y).
move(x,y) :- right(x,y).
move(x,y) :- left(x,y).
and keep all the seen state in a list to avoid infinite loop.
I jess, I do the procedural search and my program is like
----
; define initial state
(bind ?initial
(create$
3 3 0 3 1 1 3 4 2 2 3 3
1 2 4 4 2 5 4 4 6 3 2 7
1 3 8 2 1 9 2 2 10 2 4 11
1 1 12 1 4 13 4 1 14 4 3 15)
)
(printout t "initial = " ?initial crlf)
; define final state
(bind ?final
(create$
1 1 0 1 2 1 1 3 2 1 4 3
2 1 4 2 2 5 2 3 6 2 4 7
3 1 8 3 2 9 3 3 10 3 4 11
4 1 12 4 2 13 4 3 14 4 4 15)
)
(printout t "final = " ?final crlf crlf)
; find the position of tile 0 in ?inlist
(deffunction find0 (?inlist)
(for (bind ?i 3) (<= ?i 48) (bind ?i (+ ?i 3))
(bind ?tile (nth$ ?i ?inlist))
(if (= ?tile 0) then
(bind ?x (nth$ (- ?i 2) ?inlist))
(bind ?y (nth$ (- ?i 1) ?inlist))
(bind ?coord (create$ ?x ?y))
(return ?coord)
) ;end-if
); end-for
)
;(printout t "find0(initial) = " (find0 ?initial) crlf)
;(printout t "find0(final) = " (find0 ?final) crlf)
; find the tile at coordinate (?x, ?y) in ?inlist
(deffunction findtile (?inlist ?x ?y)
(for (bind ?i 1) (<= ?i 16) (++ ?i)
(bind ?x_comp (nth$ (- (* ?i 3) 2) ?inlist))
(bind ?y_comp (nth$ (- (* ?i 3) 1) ?inlist))
;(printout t "x, y = " ?x ?y crlf)
;(printout t "x_comp, y_comp = " ?x_comp ?y_comp crlf)
(if (and (eq ?x ?x_comp) (eq ?y ?y_comp)) then
(bind ?return_val (nth$ (* ?i 3) ?inlist))
(return ?return_val)
) ;end-if
) ;end-for
)
;(printout t "findtile(initial 2 3) = " (findtile ?initial 2 3) crlf)
;(printout t "findtile(final 2 3) = " (findtile ?final 2 3) crlf)
; remove a tile at coordinate (?x, ?y) from ?inlist
(deffunction removetile (?inlist ?x ?y)
;(printout t "removing (" ?x ", " ?y ") from " ?inlist crlf)
(for (bind ?i 1) (<= ?i 16) (++ ?i)
(bind ?x_comp (nth$ (- (* ?i 3) 2) ?inlist))
(bind ?y_comp (nth$ (- (* ?i 3) 1) ?inlist))
(if (and (eq ?x ?x_comp) (eq ?y ?y_comp)) then
;(printout t " found, deleting" crlf)
(bind ?outlist (delete$ ?inlist (- (* ?i 3) 2) (* ?i 3)))
(return ?outlist)
)
)
)
;(printout t "remove(iniaitl 2 3) = " (removetile ?initial 2 3) crlf)
;(printout t "remove(final 2 3) = " (removetile ?final 2 3) crlf)
; check whether two states are equal, states are represented as lists
(deffunction equallist (?inlist1 ?inlist2)
(for (bind ?i 1) (<= ?i 4) (++ ?i)
(for (bind ?j 1) (<= ?j 4) (++ ?j)
(bind ?tile1 (findtile ?inlist1 ?i ?j))
(bind ?tile2 (findtile ?inlist2 ?i ?j))
(bind ?comp_result (<> ?tile1 ?tile2))
(if (<> ?tile1 ?tile2) then
(return FALSE)
)
) ;end-for-inner
) ;end-for-outer
(return TRUE)
)
;(printout t "comp(initial final) = " (equallist ?initial ?final) crlf)
;(printout t "comp(initial initial2) = " (equallist ?initial ?initial2)
crlf)
; history will be asserted into memory, for the easy of keeping structured
list
(defquery query-history
(history $?one_history)
)
; assert initial state into memory
(assert-string (str-cat "(history " (implode$ ?initial) ")"))
; whether a state is in history
(deffunction seen (?inlist)
;(printout t crlf "checking whether seen before" crlf)
;(printout t "inlist = " ?inlist crlf)
;(printout t "facts: " crlf)
;(facts)
(bind ?histories (run-query* query-history))
(while (?histories next)
(bind ?one_history (?histories get one_history))
;(printout t " one history = " ?one_history crlf)
(if (equallist ?inlist ?one_history) then
;(printout t " found, returning true" crlf)
(return TRUE)
)
) ;end-while
;(printout t " not found, returning false" crlf)
(return FALSE)
)
; define moves
; define right
(deffunction right (?inlist)
;(printout t "moving right ..." crlf)
(bind ?coord0 (find0 ?inlist))
(bind ?x0 (nth$ 1 ?coord0))
(bind ?y0 (nth$ 2 ?coord0))
(if (< ?y0 4) then
(bind ?y1 (+ ?y0 1))
(bind ?tile (findtile ?inlist ?x0 ?y1))
(bind ?outlist (removetile ?inlist ?x0 ?y0))
(bind ?outlist (removetile ?outlist ?x0 ?y1))
(bind ?outlist (create$ ?x0 ?y0 ?tile ?x0 ?y1 0 ?outlist))
(return ?outlist)
else
(return ?inlist)
) ;end-if
)
; define left
(deffunction left (?inlist)
;(printout t "moving left ..." crlf)
(bind ?coord0 (find0 ?inlist))
(bind ?x0 (nth$ 1 ?coord0))
(bind ?y0 (nth$ 2 ?coord0))
(if (> ?y0 1) then
(bind ?y1 (- ?y0 1))
(bind ?tile (findtile ?inlist ?x0 ?y1))
(bind ?outlist (removetile ?inlist ?x0 ?y0))
(bind ?outlist (removetile ?outlist ?x0 ?y1))
(bind ?outlist (create$ ?x0 ?y0 ?tile ?x0 ?y1 0 ?outlist))
(return ?outlist)
else
(return ?inlist)
) ;end-if
)
; define up
(deffunction up (?inlist)
;(printout t "moving up ..." crlf)
(bind ?coord0 (find0 ?inlist))
(bind ?x0 (nth$ 1 ?coord0))
(bind ?y0 (nth$ 2 ?coord0))
(if (< ?x0 4) then
(bind ?x1 (+ ?x0 1))
(bind ?tile (findtile ?inlist ?x1 ?y0))
(bind ?outlist (removetile ?inlist ?x0 ?y0))
(bind ?outlist (removetile ?outlist ?x1 ?y0))
(bind ?outlist (create$ ?x0 ?y0 ?tile ?x1 ?y0 0 ?outlist))
(return ?outlist)
else
(return ?inlist)
) ;end-if
)
; define down
(deffunction down (?inlist)
;(printout t "moving down ..." crlf)
(bind ?coord0 (find0 ?inlist))
(bind ?x0 (nth$ 1 ?coord0))
(bind ?y0 (nth$ 2 ?coord0))
(if (> ?x0 1) then
(bind ?x1 (- ?x0 1))
(bind ?tile (findtile ?inlist ?x1 ?y0))
(bind ?outlist (removetile ?inlist ?x0 ?y0))
(bind ?outlist (removetile ?outlist ?x1 ?y0))
(bind ?outlist (create$ ?x0 ?y0 ?tile ?x1 ?y0 0 ?outlist))
(return ?outlist)
else
(return ?inlist)
) ;end-if
)
; define find
(deffunction find (?inlist ?curstep ?maxstep)
;(printout t crlf crlf "entering find ..." crlf)
;(printout t "inlist = " ?inlist crlf)
;(printout t "curstep = " ?curstep crlf)
;(printout t "maxstep = " ?maxstep crlf crlf)
(if (equallist ?inlist ?final) then
;(printout t crlf "reached final state ^-^" crlf crlf)
(return TRUE)
)
(if (>= ?curstep ?maxstep) then
;(printout t "maximal steps reached, backtracking" crlf crlf)
(return FALSE)
)
;(printout t "searching normally ..." crlf)
(bind ?rightlist (right ?inlist))
;(printout t "rightlist = " ?rightlist crlf)
(bind ?seenright (seen ?rightlist))
;(printout t "seenright = " ?seenright crlf crlf)
(bind ?leftlist (left ?inlist))
;(printout t "leftlist = " ?leftlist crlf)
(bind ?seenleft (seen ?leftlist))
;(printout t "seenleft = " ?seenleft crlf crlf)
(bind ?uplist (up ?inlist))
;(printout t "uplist = " ?uplist crlf)
(bind ?seenup (seen ?uplist))
;(printout t "seenup = " ?seenup crlf crlf)
(bind ?downlist (down ?inlist))
;(printout t "downlist = " ?downlist crlf)
(bind ?seendown (seen ?downlist))
;(printout t "seendown = " ?seendown crlf crlf)
;(printout t "testing searching done ..." crlf crlf crlf)
(if (and (not (equallist ?rightlist ?inlist)) (not ?seenright)) then
(bind ?toassert (str-cat "(history " (implode$ ?rightlist) ")"))
;(printout t "toassertRight = " ?toassert crlf)
(assert-string ?toassert)
(bind ?right_r (find ?rightlist (+ ?curstep 1) ?maxstep))
;(printout t "?right_r = " ?right_r ", ?curstep = " ?curstep crlf
crlf)
(if ?right_r then
(return TRUE)
)
)
(if (and (not (equallist ?leftlist ?inlist)) (not ?seenleft)) then
(bind ?toassert (str-cat "(history " (implode$ ?leftlist) ")"))
;(printout t "toassertLeft = " ?toassert crlf)
(assert-string ?toassert)
(bind ?left_r (find ?leftlist (+ ?curstep 1) ?maxstep))
;(printout t "?left_r = " ?left_r ", ?curstep = " ?curstep crlf
crlf)
(if ?left_r then
(return TRUE)
)
)
(if (and (not (equallist ?uplist ?inlist)) (not ?seenup)) then
(bind ?toassert (str-cat "(history " (implode$ ?uplist) ")"))
;(printout t "toassertUp = " ?toassert crlf)
(assert-string ?toassert)
(bind ?up_r (find ?uplist (+ ?curstep 1) ?maxstep))
;(printout t "?up_r = " ?up_r ", ?curstep = " ?curstep crlf crlf)
(if ?up_r then
(return TRUE)
)
)
(if (and (not (equallist ?downlist ?inlist)) (not ?seendown)) then
;(printout t "asserting downlist" crlf)
(bind ?toassert (str-cat "(history " (implode$ ?downlist) ")"))
;(printout t "toassertDown = " ?toassert crlf)
(assert-string ?toassert)
(bind ?down_r (find ?downlist (+ ?curstep 1) ?maxstep))
;(printout t "?down_r = " ?down_r ", ?curstep = " ?curstep crlf
crlf)
(if ?down_r then
(return TRUE)
)
)
;(printout t "all search directions tried, returing false" crlf)
;(printout t "curstep = " ?curstep crlf crlf crlf)
(return FALSE)
)
; get cputime
; get cputime
(bind ?tmx (call java.lang.management.ManagementFactory getThreadMXBean))
(deffunction cputime ()
(return (* (?tmx getCurrentThreadCpuTime) 1E-9))
)
; tests
(bind ?starttime (time))
(bind ?starttime_cpu (cputime))
(printout t "success = " (find ?initial 0 14) crlf)
(bind ?endtime (time))
(bind ?endtime_cpu (cputime))
(printout t "steps = 14, walltime = " (- ?endtime ?starttime) " sec" crlf)
(printout t "steps = 14, cpu time = " (- ?endtime_cpu ?starttime_cpu) " sec"
crlf crlf)
---
Thanks, Senlin
On Fri, May 9, 2008 at 8:24 AM, Wolfgang Laun <[EMAIL PROTECTED]>
wrote:
>
>
> On Thu, May 8, 2008 at 8:30 PM, <[EMAIL PROTECTED]> wrote:
>
>> It's probably one of those things that
>> would be easier to do procedurally, since brute forcing seems to be
>> relatively straight forward.
>>
>
> Yes, although it might be slow without heuristics, i.e., some good strategy
> according to what you've outlined.
>
>
>>
>> Also, I believe there are number combinations of the 15-puzzle that are
>> not
>> solvable, so keep that in mind.
>>
>
> All the odd permutations cannot be solved. (I used to have a mechanical
> version where you could rearrange the squares...)
>
>
>>
>> I'm not exactly a jess master, so I'll leave that part up to someone else.
>>
>> --
>> Dane Wyrick
>> [EMAIL PROTECTED]
>> 402-544-0872
>>
>>
>> "Wolfgang Laun"
>>
>>
>> I have never seen a program for this one in any language. Have you, or
>> anybody else?
>> -W
>>
>> On Thu, May 8, 2008 at 2:39 PM, Senlin Liang wrote:
>> Dear all,
>>
>> I am trying to solve the puzzle 15 problem using jess, but failed to find
>> a good solution. Is anyone has a ready program for it?
>>
>> Thanks,
>> Senlin
>>
>>
>> .
>>
>> This message and any attachments contain information from Union Pacific
>> which may be confidential and/or privileged.
>> If you are not the intended recipient, be aware that any disclosure,
>> copying, distribution or use of the contents of this message is strictly
>> prohibited by law. If you receive this message in error, please contact the
>> sender immediately and delete the message and any attachments.
>>
>>
>>
>> --------------------------------------------------------------------
>> 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]
>> .
>> --------------------------------------------------------------------
>>
>>
>
--
Senlin Liang
