use strict; use warnings; sub solve_grid { my $n = shift; # Indicate whether each row, column and diagonal is full. my $grid = {row => [(1) x $n], col => [(1) x $n], diag => [1, 1]}; --$n; # zero-base it # Go through the grid, finding who's still a member of # lines. Choose one with the smallest positive count. while (1) { my $candidate; ROW: for my $row (0..$n) { for my $col (0..$n) { my $this_count = $grid->{row}[$row] + $grid->{col}[$col]; if ($row == $col) { $this_count += $grid->{diag}[0]; } elsif ($row == $n - $col) { $this_count += $grid->{diag}[1]; } next unless $this_count > 0; if (!defined($candidate) or $this_count < $candidate->[2]) { $candidate = [$row,$col, $this_count]; last ROW if $this_count == 1; } } } last unless $candidate; # Reduce the count for all members of the same row, column, # and (if applicable) diagonal my ($row, $col, $count) = @$candidate; print "Blank row $row, column $col ($count lines)\n"; $grid->{row}[$row] = 0; $grid->{col}[$col] = 0; if ($row == $col) { $grid->{diag}[0] = 0; } elsif ($row == $n - $col) { $grid->{diag}[1] = 0; } } } solve_grid(4);