Re: JESS: Puzzle 15

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





--
Senlin Liang