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