Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Yet Another :: N-Queens Solution

by Elgon (Curate)
on Feb 10, 2003 at 20:13 UTC ( #234226=perlcraft: print w/ replies, xml ) Need Help??

   1: #!/usr/bin/perl -w
   2: 
   3: use strict;
   4: 
   5: # Nonspecific N-Queens Solution Generator by Elgon
   6: # Not sure whether truly crafty, but I'm happy with it!
   7: # Update: Added regexp to make the end result prettier.
   8: 
   9: # Set up parameters
  10: my $n = 8;
  11: my $row_counter = 0;
  12: my @board;
  13: $board[0] = ('x'x$n);
  14: 
  15: # Start the loop
  16: while ()
  17: {
  18:     # Are there any free spaces in the current row?
  19: 
  20:     if ($board[$row_counter] =~ m/x/)
  21:     {
  22:         # If yes, then place a piece in the first available slot
  23:         my @row = split(//, $board[$row_counter]);
  24:         foreach $_(@row)
  25:         {
  26:             if ($_ eq 'x')
  27: 	    {
  28:                 $_ = 'q';
  29:                 last;
  30:             }    
  31:         }
  32: 
  33:         $board[$row_counter] = join ('', @row);
  34:         ++$row_counter;
  35: 
  36:         # Have we finished 'n' rows?
  37: 
  38:         if ($row_counter == $n)
  39:         {
  40: 
  41:             # If so we have a valid solution. Save it to a file.
  42:             open (DEST, ">> solutions.q") or die ('Couldn\'t open dest file!');
  43:             print DEST "\n\n";
  44:             foreach $_(@board)
  45:             {
  46:                 my $temp_row = $_;
  47:                 $temp_row =~ tr/q/X;
  48:                 $temp_row =~ tr/yx/O/;
  49:                 print DEST "$temp_row\n";
  50: 	    }
  51:             print DEST "\n";
  52:             close DEST;
  53: 
  54:             # Now go back one row and make the old queen's spot invalid
  55: 
  56:             --$row_counter;
  57:             pop @board;
  58:             --$row_counter;
  59:             $board[$row_counter] =~ tr/q/y/;
  60: 	}
  61: 
  62:         #  Otherwise out which slots in the next row down will be unavailable
  63: 
  64:         else
  65:         {
  66:             my @current_row;
  67:             for ($_ = 0; $_ < $n; ++$_)
  68:             {
  69:                 push @current_row, 'x';
  70: 	    }
  71:             my $row;
  72:             for ($row = 0; $row < scalar(@board); ++$row)
  73:             {
  74:                 @row = split '', $board[$row];
  75:                 my $square;
  76:                 for ($square = 0; $square < scalar(@row); ++$square)
  77:                 {
  78:                     if ($row[$square] eq 'q')
  79:                     {
  80:                         $current_row[$square] = 'y';
  81:                         if (($square - ($row_counter - $row)) >= 0)
  82:                         {
  83:                             $current_row[($square - ($row_counter - $row))] = 'y';
  84: 		        }
  85:                         if (($square + ($row_counter - $row)) <= ($n - 1))
  86:                         {
  87:                             $current_row[($square + ($row_counter - $row))] = 'y';
  88: 		        }
  89: 		    }
  90: 	        }
  91:             }
  92: 
  93:             # Add the row to the board and go round again
  94:             $board[$row_counter] = join ('', @current_row); 
  95:         }
  96:     }
  97: 
  98:     # If there are no available slots then we need to go back a row
  99: 
 100:     else
 101:     {
 102: 
 103:         # But if we've used up the whole first row then all solutions are done
 104: 
 105:         if (!$row_counter && defined($row_counter))
 106:         {
 107:             print "\n\nCompleted!";
 108:             exit;
 109:         }
 110:         else
 111: 
 112:         # Otherwise, go back a row...
 113: 
 114:         {
 115:             pop @board;
 116:             --$row_counter;
 117:             $board[$row_counter] =~ tr/q/y/;
 118:         }
 119:     }
 120: }

Comment on Yet Another :: N-Queens Solution
Download Code
Re: Yet Another :: N-Queens Solution
by dmitri (Curate) on Feb 11, 2003 at 20:07 UTC
    ++. I'd suggest you use a slightly different format -- 'x', 'y', and 'q' are consufing.

    I remember I did something similar for my homework once (in C++): http://rm-f.net/~dmitri/#code.

      Thanks Dmitri,

      I've added a small bit of extra code to make the written file contain 'X' and 'O' as the queens and empty spaces respectively.

      I've tested it up to n=12 now, which takes about 2 1/2 hours on my P120 laptop (Debian with X and enlightenment running.) I wrote it just for fun, as I don't come from a rigorous programming background but am trying to work through some of the things that a CS undergrad would have to do.

      Elgon

      "What this book tells me is that goose-stepping morons, such as yourself, should read books instead of burning them."
             - Dr. Jones Snr, Indiana Jones and the Last Crusade

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlcraft [id://234226]
Approved by FoxtrotUniform
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (5)
As of 2014-11-28 18:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (199 votes), past polls