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