#!/usr/local/bin/perl -w
use strict;

my $size = 8;
$size = shift() || $size;

# Queens are anon arrays set up like so: [x, y, #contentions]
my @queen;

my ($cqueens, $uqueens) = setup();

while (@{$cqueens} > 0) {
  my ($queen1, $queen2) = pickQueens($cqueens);
  my $ff = @{$cqueens} == 2 ? "true" : "false";

  ($cqueens, $uqueens) = quickCheck($queen1, $queen2, swap($queen1,$queen2));

  # if we had two before and we have two again, then put one of the
  # uncontested back into the mix so that we have the possibility of
  # finishing still.
  if (($ff eq "true") && @{$cqueens} == 2) {
    my $rdm = int rand(@{$uqueens})+1;
    push @{$cqueens}, splice @{$uqueens}, $rdm, 1;
  }
}

print "The board after finishing:\n";
my $x;
foreach (@queen) {
  print ++$x, " ", (join",",map{$_+1}@$_[0,1]), "\n";
}

sub setup {
  my @poss = (0..$size-1);

  foreach my $x (0..$size-1) {
    my $y = int rand(@poss);
    ($y) = splice @poss, $y, 1;
    push @queen, [$x,$y,0];
  }

  # This does the initial check, other checks are handled by quickCheck :)
  foreach my $q1 (@queen) {
    LOOP: foreach my $q2 (@queen) {
      next LOOP if $q1->[0]==$q2->[0] && $q1->[1]==$q2->[1];
      $q1->[2]++ if abs($q1->[0]-$q2->[0])==abs($q1->[1]-$q2->[1]);
    }
  }

  my ($cq, $uq) = ([],[]);
  $_->[2] ? (push @{$cq}, $_) : (push @{$uq}, $_) foreach @queen;

  return $cq, $uq;
}

sub swap {
  my ($oq1, $oq2) = @_;
  my $nq1 = [$oq2->[0],$oq1->[1],$oq1->[2]];
  my $nq2 = [$oq1->[0],$oq2->[1],$oq2->[2]];
 
  return $nq1, $nq2;
}

sub pickQueens {
  my @queens = @{ shift() };
  return @queens if @queens <= 2;
  my ($q1, $q2);

  @queens = map { my$q=$_; map{$q->[1]}1..$_->[0] }
            sort{ $b->[0] <=> $a->[0] }
            map { [$_->[2], $_] } @queens;

  $q1 = shift @queens;
  shift @queens for (1..$q1->[2] - 1);
  $q2 = $queens[int rand(@queens)];

  return $q1, $q2;
}

sub quickCheck {
  my ($oq1,$oq2,$nq1,$nq2) = @_;

  foreach (@queen) {
    if (($oq1->[0]==$_->[0] && $oq1->[1]==$_->[1]) ||
        ($oq2->[0]==$_->[0] && $oq2->[1]==$_->[1])) {
      next;
    }
    if (linear(@$oq1[0,1],@$_[0,1]) && !linear(@$nq1[0,1],@$_[0,1])) {
      $_->[2]--;
      $oq1->[2]--;
    }
    if (linear(@$oq2[0,1],@$_[0,1]) && !linear(@$nq2[0,1],@$_[0,1])) {
      $_->[2]--;
      $oq2->[2]--;
    }
    if (!linear(@$oq1[0,1],@$_[0,1]) && linear(@$nq1[0,1],@$_[0,1])) {
      $_->[2]++;
      $oq1->[2]++;
    }
    if (!linear(@$oq2[0,1],@$_[0,1]) && linear(@$nq2[0,1],@$_[0,1])) {
      $_->[2]++;
      $oq2->[2]++;
    }
  }

  $oq1->[0] = $nq1->[0]; $oq1->[1] = $nq1->[1];
  $oq2->[0] = $nq2->[0]; $oq2->[1] = $nq2->[1];

  my ($contested, $uncontested) = ([],[]);
  $_->[2] ? (push @$contested, $_) : (push @$uncontested, $_) foreach @queen;

  return $contested, $uncontested;
}

sub linear {
  my ($x1,$y1,$x2,$y2) = @_;
  return abs($x1-$x2)==abs($y1-$y2);
}