Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Re^2: Tk - Discipulus 15 puzzle

by zentara (Archbishop)
on Jun 13, 2017 at 15:47 UTC ( [id://1192708]=note: print w/replies, xml ) Need Help??


in reply to Re: Tk - Discipulus 15 puzzle
in thread Tk - Discipulus 15 puzzle

So, you have familiarity on how to programatically solve the problem? I hope Perl6 is well-suited to writing AI software, we need something like that to solve this efficiently. There must be some clue as to the way the slides must be moved to efficiently move 1 number from here to there? I sometimes wish I was back in school, studying the matrix math needed to solve that problem

I'm not really a human, but I play one on earth. ..... an animated JAPH

Replies are listed 'Best First'.
Re^3: Tk - Discipulus 15 puzzle
by tybalt89 (Monsignor) on Jun 18, 2017 at 23:12 UTC

    Unsolved problem + boredom =

    #!/usr/bin/perl # 15 puzzle solver use strict; use warnings; my $start = <<END; # initial layout, 0 for empty cell 14 15 1 2 12 7 6 10 13 3 11 9 8 4 5 0 END my @squarestomove = solve( split ' ', $start ); while( @squarestomove > 10 ) { print "steps: @{[ splice @squarestomove, 0, 10 ]}\n"; } print "steps: @squarestomove\n"; exit; sub solve # internally runs in letters, not numbers, for regex purpose +s { my (%numbers2letters, %letters2numbers); @numbers2letters{ 0..15 } = (' ', 'a'..'o'); %letters2numbers = reverse %numbers2letters; my $board = join '', @numbers2letters{@_}; $board =~ s/....\K(?=.)/\n/g; my $win = "abcd\nefgh\nijkl\nmno "; my $moves = ''; for my $n (1..18) # place first, then first two, first three, etc. { (my $path, $board) = solvepart($board, substr $win, 0, $n ); print "path: $path\n\n$board\n\n"; $moves .= $path; } #print "\nmoves: $moves\n"; 1 while $moves =~ s/(.)\1//g; # remove dups print "\nmoves: $moves\n\n"; return @letters2numbers{ split //, $moves}; } sub solvepart { my ($have, $want) = @_; my @stack = $have; my %seen; my $delta = length $have =~ s/\n.*//sr; my $count = 0; while( $_ = shift @stack ) { $count++; if( $count > 1e7 ) # loop protection, may need to be larger { my $size = keys %seen; die "died with $size seen\n"; } my ($path, $board) = /(.*),(.*)/s ? ($1, $2 ) : ('', $_); #print "$board\n\n"; if( $want eq substr $board, 0, length $want) { return $path, $board; } elsif( $seen{$board}++ ) { } else { my $new = $board; if( $new =~ s/(\w) / $1/ ) # right { $seen{$new} or push @stack, "$path$1,$new"; } $new = $board; if( $new =~ s/ (\w)/$1 / ) # left { $seen{$new} or push @stack, "$path$1,$new"; } $new = $board; if( $new =~ s/(\w)(.{$delta}) / $2$1/s ) # down { $seen{$new} or push @stack, "$path$1,$new"; } $new = $board; if( $new =~ s/ (.{$delta})(\w)/$2$1 /s ) # up { $seen{$new} or push @stack, "$path$2,$new"; } } } die "no solution for $_"; }

    It's just a simple breadth first search looking to position the 1 first, then 1 & 2, then 1 & 2 & 3, etc. Trying to do the whole thing at once was too big for my machine (and maybe any machine :).

    There are still some debug prints left on, and some near infinite loop detection code.

    Internally I use letters to simplify (and speed up?) the regex for finding moves.

Re^3: Tk - Discipulus 15 puzzle
by perldigious (Priest) on Jun 13, 2017 at 16:09 UTC

    So, you have familiarity on how to programmatically solve the problem?

    Ha, no, in fact the "feature inclusive" comment I made was based on my being impressed Discipulus' code actively can figure out things like the minimum number of moves remaining or even that a solution was impossible based on the random shuffle. My college course's 15 puzzle was, I believe, primarily selected by our professor because he wanted us to use a Windows environment and actually take input from mouse clicks and resolve screen position and current board state for what action to take for changing the appearance on the screen (we hadn't done any sort of GUI yet either). It didn't include any such features beyond those goals (and it was still really difficult for all of us in the class at the time).

    I sometimes wish I was back in school, studying the matrix math needed to solve that problem

    I often have the, "I wish I was back in school," thought too, and then I remember what school was like and being massively in debt, with no spending cash, living on ramen noodles, in a slum apartment I shared with 2-3 other people every semester, beating my brains out over my course load so I could actually finish an engineering degree in 4 years with a good GPA, and I compare that with my relatively awesome life now and I think twice. :-)

    Just a few weeks ago I was trying to use some simple matrix math for what's called Cramer's Rule to solve a linear system of equations for a circuit I was analyzing, only to quickly determine I can no longer correctly do the matrix math I was probably capable of early on in high school... so naturally I just used a computer.

    Most people get wiser as they age, or so I'm told, I swear I'm getting dumber every year I get further from school.

    Just another Perl hooker - Yep, I've definitely seen more than my share of d*cks in the world, that's for sure.
      > being impressed Discipulus' code actively can figure out things like the minimum number of moves remaining or even that a solution was impossible based on the random shuffle.

      Oh do not overstimate me, nor my code: I have no idea about the minimum number of moves nor how to solve the puzzle programatically.

      The possible/impossible solution is another matter and is a simple one: see the link to the mathworld site in the reference or run with the --verbose switch to see how to compute it.

      Infact it is calculated counting, for every tile, how many are lesser of the current one, as if they lay on a single row and adding all these number: if the result is odd the game is impossible.

      You can read on wikipedia:

      > .. offering a $1,000 prize for anyone who could provide a solution for achieving a particular combination specified by Loyd, namely reversing the 14 and 15. This was impossible, as had been shown over a decade earlier by Johnson & Story (1879), as it required a transformation from an even to an odd combination.

      Infact I simply do: $perm += grep {$_ < $appear[$num]} @appear[$num+1..$#appear]; and later on if ($permutation % 2){ print "Impossible game with odd permutations!"

      Running with --verbose shows it clearly:

      --------------------------------------------------------- Appearence of the board: [14 15 12 2 10 6 1 7 13 5 9 11 4 3 8 X] --------------------------------------------------------- current followers less than current --------------------------------------------------------- [14] 15 12 2 10 6 1 7 13 5 9 11 4 3 8 13 + [15] 12 2 10 6 1 7 13 5 9 11 4 3 8 13 + [12] 2 10 6 1 7 13 5 9 11 4 3 8 11 + [2] 10 6 1 7 13 5 9 11 4 3 8 1 + [10] 6 1 7 13 5 9 11 4 3 8 8 + [6] 1 7 13 5 9 11 4 3 8 4 + [1] 7 13 5 9 11 4 3 8 0 + [7] 13 5 9 11 4 3 8 3 + [13] 5 9 11 4 3 8 6 + [5] 9 11 4 3 8 2 + [9] 11 4 3 8 3 + [11] 4 3 8 3 + [4] 3 8 1 + [3] 8 0 = ---- MEDIUM game with even permutations 68

      Being 105 the highest value for permutations I just assign solved, easy, medium and hard difficulty level for permutations with values of 0, 1-35, 36-70 and 71-105

      The real fun is running the program with --perl switch... ;=)

      L*

      There are no rules, there are no thumbs..
      Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
        Discipulus, The very fact that you write code like that, shows that you have earned true monk-dom.

        I'm not really a human, but I play one on earth. ..... an animated JAPH
      so naturally I just used a computer.

      Only an idiot would want to do matrix equations by hand!! :-)


      I'm not really a human, but I play one on earth. ..... an animated JAPH

        Please, a little respect... for I am perldigious, King of the Idiots. :-)

        Just another Perl hooker - Yep, I've definitely seen more than my share of d*cks in the world, that's for sure.

        Back in high school, I was very good at doing matrix math "by hand".

        Of course, once I wasn't (explicitly1) required to do it by hand, I didn't.


        1The instructor didn't specify, I didn't ask. But, I did include a note that I was also taking a 400-level CS class in algorithms and that he was welcome to see my source code.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1192708]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others surveying the Monastery: (8)
As of 2024-03-28 11:47 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found