Sudoku4x4.pl

#! /usr/bin/env perl

use warnings;
use strict;
use utf8;
use feature qw<say>;
use boolean;
use List::Util qw<any uniq>;

my @cells;

my %posToElem = (
  11 => 0,
  12 => 1,
  13 => 2,
  14 => 3,
  21 => 4,
  22 => 5,
  23 => 6,
  24 => 7,
  31 => 8,
  32 => 9,
  33 => 10,
  34 => 11,
  41 => 12,
  42 => 13,
  43 => 14,
  44 => 15
);

my @sudokuPos = (
  [11, [12, 13, 14, 21, 22, 31, 41]],
  [12, [11, 13, 14, 21, 22, 32, 42]],
  [13, [11, 12, 14, 23, 24, 33, 43]],
  [14, [11, 12, 13, 23, 24, 34, 44]],
  [21, [22, 23, 24, 11, 12, 31, 41]],
  [22, [21, 23, 24, 11, 12, 32, 42]],
  [23, [21, 22, 24, 13, 14, 33, 43]],
  [24, [21, 22, 23, 13, 14, 34, 44]],
  [31, [32, 33, 34, 41, 42, 11, 21]],
  [32, [31, 33, 34, 41, 42, 12, 22]],
  [33, [31, 32, 34, 43, 44, 13, 23]],
  [34, [31, 32, 33, 43, 44, 14, 24]],
  [41, [42, 43, 44, 31, 32, 11, 21]],
  [42, [41, 43, 44, 31, 32, 12, 22]],
  [43, [41, 42, 44, 33, 34, 13, 23]],
  [44, [41, 42, 43, 33, 34, 14, 24]]
);

sub getSudokuCells {
  my $sudokuStr;

  {
    local $/ = undef;
    chop($sudokuStr = <DATA>);
  }

  map {int($_)} (split(//, $sudokuStr));
}

sub fixedCell {
  my ($num) = @_;
  $num == 0 ? false : true;
}

sub calValidSet {
  my($cells, $edges) = @_;
  my @ans;
  for my $elem (@$cells) {
    if (any{$_ == $elem} (@$edges)) {
      push(@ans, $elem);
    }
  }
  \@ans;
}

sub buildSudokuStructure {
  my ($r_cells, $p_to_e) = @_;
  my @ans;
  while (my ($index, $elem) = each (@$r_cells)) {
    my @edges;
    for my $e (@{$sudokuPos[$index]->[1]}) {
      push(@edges, \$r_cells->[$p_to_e->{$e}]);
    }
    push(
      @ans,
      {
        fixed => fixedCell($elem),
        elem => $elem,
        pos => $sudokuPos[$index]->[0],
        edges => \@edges
        });
  }
  \@ans;
}

sub startingNumbers {
  my ($edges) = @_;
  my @nums;
  my @ans;
  for my $n (@$edges) {#ref to cell value
    push(@nums, $$n) if $$n;
  }
  @nums = uniq @nums;
  for my $elem (1..4) {
    push(@ans, $elem) unless any {$elem == $_} @nums;
  }
  \@ans;
}

sub generateStartingNums {
  my ($sudoku) = @_;
  for my $elem (@$sudoku) {
    if ($elem->{fixed}) {
      $elem->{startingNums} = [];
    }else {
      $elem->{startingNums} = startingNumbers($elem->{edges});
    }
  }
}

sub validateTry {
  my ($edges, $value) = @_;
  for my $elem (@$edges) {
    return false if ($$elem == $value);
  }
  true;
}

sub solveSudoku {
  my ($sudoku) = @_;
  if ($sudoku->[0]->{fixed}) {
    solveSudokuAux($sudoku, 1);
  }else {
    for my $elem (@{$sudoku->[0]->{startingNums}}) {
      if (validateTry($sudoku->[0]->{edges}, $elem)) {
        my $old_value = $cells[0];
        @cells[0] = $elem;
        solveSudokuAux($sudoku, 1);
        @cells[0] = $old_value;
      }
    }
  }

  say "The solving is all done";
}

sub solveSudokuAux {
  my ($sudoku, $pos) = @_;
  if ($pos < 16) {
    if ($sudoku->[$pos]->{fixed}) {
      solveSudokuAux($sudoku, ++$pos);
    }else {
      for my $elem (@{$sudoku->[$pos]->{startingNums}}) {
        if (validateTry($sudoku->[$pos]->{edges}, $elem)) {
          my $old_value = $cells[$pos];
          my $old_pos = $pos;
          @cells[$pos] = $elem;
          solveSudokuAux($sudoku, ++$pos);
          @cells[$old_pos] = $old_value;
          $pos = $old_pos;
        }
      }
    }
  }else {
    my $g_counter = 0;
    my $l_counter = 0;
    my $s_counter = 0;
    for my $elem (@cells) {
      ++$g_counter;
      ++$l_counter;
      ++$s_counter;
      print $elem, " ";
      if ($g_counter > 1) {
        print " ";
        $g_counter = 0;
      }
      if ($l_counter > 3) {
        print "\n";
        $l_counter = 0;
      }
      if ($s_counter > 7) {
        print "\n";
        $s_counter = 0;
      }
    }
  }
}

@cells = getSudokuCells();

my $sudokuStr = buildSudokuStructure(\@cells, \%posToElem);

generateStartingNums($sudokuStr);

solveSudoku($sudokuStr);

exit(0);
#0340400210030210
#0000430000420000-
#0010400000020300
#2000003004000001-
#1040000000000102
__DATA__
0010400000000000