JESS: Puzzle 15

[Senlin Liang]

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

[Wolfgang Laun-2]

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

[DCWYRICK]

A quick "15 puzzle" google search yields some JavaScript implementations of
the game.  I got bored one day and did some quick internet research on how
to solve these.  Apparently, one of the easiest tricks is to solve an outer
row and column first.

For example,
 1 2 3 4
 5 x x x
 9 x x x
13 x x x


This will make that column/row correct, leaving you with a simpler 3x3
square to take care of.  Iterate this process until you get a 2x2 square.
Then solve the 2x2 square and you are pretty much done.  You should be able
to solve one in a few minutes.  It's probably one of those things that
would be easier to do procedurally, since brute forcing seems to be
relatively straight forward.

Also, I believe there are number combinations of the 15-puzzle that are not
solvable, so keep that in mind.

I'm not exactly a jess master, so I'll leave that part up to someone else.

--
Dane Wyrick
dcwyrick@...
402-544-0872



                                                                           
             "Wolfgang Laun"                                              
             <wolfgang.laun@gm                                            
             ail.com>                                                   To
             Sent by:                  jess-users@...              
             owner-jess-users@                                          cc
             sandia.gov                                                    
                                                                   Subject
                                       Re: JESS: Puzzle 15                
             05/08/2008 01:17                                              
             PM                                                            
                                                                           
                                                                           
             Please respond to                                            
             jess-users@sandia                                            
                   .gov                                                    
                                                                           
                                                                           




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 <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 you@...'
in the BODY of a message to majordomo@..., NOT to the list
(use your own address!) List problems? Notify owner-jess-users@....
--------------------------------------------------------------------

[Wolfgang Laun-2]

On Thu, May 8, 2008 at 8:30 PM, <DCWYRICK@...> 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
dcwyrick@...
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 you@...'
in the BODY of a message to majordomo@..., NOT to the list
(use your own address!) List problems? Notify owner-jess-users@....
--------------------------------------------------------------------

[Senlin Liang]

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 <wolfgang.laun@...> wrote:

On Thu, May 8, 2008 at 8:30 PM, <DCWYRICK@...> 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
dcwyrick@...
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 you@...'
in the BODY of a message to majordomo@..., NOT to the list
(use your own address!) List problems? Notify owner-jess-users@....
--------------------------------------------------------------------

--
Senlin Liang

[Ernest Friedman-Hill]

On May 9, 2008, at 10:13 AM, Senlin Liang wrote:

> 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.
>

There's no earthly reason why you'd write a big procedural program  
like this in Jess; that's just not what it's for.


---------------------------------------------------------
Ernest Friedman-Hill
Informatics & Decision Sciences          Phone: [phone]
Sandia National Labs                FAX:   [phone]
PO Box 969, MS 9012                 ejfried@...
Livermore, CA 94550                 http://www.jessrules.com




--------------------------------------------------------------------
To unsubscribe, send the words 'unsubscribe jess-users you@...'
in the BODY of a message to majordomo@..., NOT to the list
(use your own address!) List problems? Notify owner-jess-users@....
--------------------------------------------------------------------

[Senlin Liang]

I am testing several systems including Jess. I programmed it in Yap in a similar procedural way, since there is no easy way to implement it in prolog back-tracking systems, while this problem can be solved easily by constraint programming systems like DLV.

I know the above procedural program is bad, but I really have no idea about how to solve this problem in Jess more efficiently. Any help will be appreciated.

Thanks a lot,
Senlin

On Mon, May 12, 2008 at 9:47 AM, Ernest Friedman-Hill <ejfried@...> wrote:

On May 9, 2008, at 10:13 AM, Senlin Liang wrote:

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.

There's no earthly reason why you'd write a big procedural program like this in Jess; that's just not what it's for.


---------------------------------------------------------
Ernest Friedman-Hill
Informatics & Decision Sciences          Phone: [phone]
Sandia National Labs                FAX:   [phone]
PO Box 969, MS 9012                 ejfried@...
Livermore, CA 94550                 http://www.jessrules.com

--------------------------------------------------------------------
To unsubscribe, send the words 'unsubscribe jess-users you@...'
in the BODY of a message to majordomo@..., NOT to the list
(use your own address!) List problems? Notify owner-jess-users@....
--------------------------------------------------------------------

--
Senlin Liang