Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Re^2: Parks Puzzle

by aartist (Monk)
on Jan 23, 2018 at 21:16 UTC ( #1207779=note: print w/replies, xml ) Need Help??


in reply to Re: Parks Puzzle
in thread Parks Puzzle

Thank you, for the wonderful solution that works for puzzle.

Having said that, my original idea is to provide rules to human being to solve the puzzle with limited observation at a time. For example, simple observation that if it finds any color is occupied by only a single row or columns than all the other cell of that row or column are 'blanked'. simple rules. It is more about detecting small patterns in the data visually and provide an action associated with it. Pattern needs to be small enough to be identified visually. Thus, in other words, I am looking for helping hand algorithm rather than brute force solution. It is like see the 'X' if you can and do the 'Y'. In the end, solution will be there.

Replies are listed 'Best First'.
Re^3: Parks Puzzle
by tybalt89 (Priest) on Jan 25, 2018 at 04:50 UTC

    In setting up a game playing program to allow easy addition of patterns (see X -> do Y), I discovered the complete list of patterns for this puzzle:

    1. Find a square that, if you plant a tree there, will cause the elimination of at least one color. Mark that square as unavailable.
    2. Repeat step 1. until solved.


    That's it :)

    Here's the code for it:

    #!/usr/bin/perl # http://perlmonks.org/?node_id=1207779 use strict; use warnings; print local $_ = my $grid = <<END, "starting\n"; GRBBB GRBBW ORBBW OOOWW OOOOW END my $N = $grid =~ /\n/ && $-[0]; my $n = $N - 1; sub clear # the no longer available squares { my $pick = qr/[a-z]/; local $_ = shift; 1 while s/\w(?=.*?$pick)/-/ + s/$pick.*?\K\w/-/ # row + s/\w(?=(?:.{$N}.)*.{$N}$pick)/-/s # column + s/$pick(?:.{$N}.)*.{$N}\K\w/-/s # column + s/$pick.{$n}(..)?\K\w/-/s # lower diagonals + s/\w(?=.{$n}(..)?$pick)/-/s # upper diagonals ; return $_; } sub missingcolor { $N > keys %{{ map +($_, $_), shift =~ /\w/g }} } while( /[A-Z]/g ) # mark square to '-' if tree there causes a missing +color { missingcolor( lc clear( "$`\l$&$'" ) ) and $_ = "$`-$'", print $_, ' ' x $N, " mark ", $-[0] % ($N + 1), ',', int $-[0] / ($N + 1), "\n"; # x,y coords } print s/[A-Z]/$&/g == $N ? "\nSolved!\n" : "Failed\n";

    It prints a grid for each step of the solution (slightly more than 120 lines).

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1207779]
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (11)
As of 2018-07-16 12:42 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    It has been suggested to rename Perl 6 in order to boost its marketing potential. Which name would you prefer?















    Results (334 votes). Check out past polls.

    Notices?