#!/usr/bin/perl

# ##################################################
# packages
#

use integer;

use Getopt::Std;
use Data::Dumper;

# ##################################################
# options
#

getopts("gsv",\%opt);

# ##################################################
# utility - merge
#
# collapse a list down to a value as follows:
#
#  - $zero &plus $vals[0] &plus $vals[1] &plus ... &plus $vals[$#vals]
#
# for example:
#
#  - &merge(0, \&OR, @list)
#
# "or"-s together all the elements of @list
#

sub merge {
   my $zero = shift;
   my $plus = shift;
   my @vals = @_;
   my $sum  = $zero;
   
   for ( @vals ) {
      $sum = &$plus($sum,$_);
   }

   return $sum;
}

sub OR  { shift() | shift() }
sub AND { shift() & shift() }
sub PLUS{ shift() + shift() }
sub SUB { my $a = shift(); $a & ( $a ^ shift() ) }

# ##################################################
# some useful data structures
#

sub bit  { 1 << shift }

@index = ( 0 .. 80 );			  # indexes into grid
@dims  = ( 0 .. 2  );			  # dimensions
@rcbs  = ( 0 .. 8  );			  # indexes for rows, columns, boxes
@cells = ( 0 .. 8  );			  # indexes for cells

@vals  = map { &bit($_)       } @cells;	  # possible values
%vals  = map { (&bit($_), $_) } @cells;	  # hash on possible values

@sets  = ( 1 .. &bit(9) - 1 );		  # sets of values or cells

for ( @vals ) { $all |= $_ }		  # mask for all bit values

sub nbits {				  # return number of bits set in a bit pattern
   my $bs = shift;
   my $c  = 0;
   for ( @vals ) {
      $c += ( ($bs & $_) ? 1 : 0 )
   }
   $c
}

%nbits = map { ($_,&nbits($_)) } @sets;	  # precompute nbits

# ##################################################
# index operations
#
# row(row, index) => (0..80)
# col(col, index) => (0..80)
# box(box, index) => (0..80)
#
# grids are stored as one-dimensional arrays of 81 cells from 0 to 80.
# the row, col and box functions calculate the index in that range for a
# cell at a particular position within a particular row, column or box.
# 
# the 'any' function calculates the index of a cell in particular row,
# column or box.  it simplaifies generic code across all
# three cases.
#

sub row {
   my $r = shift;
   my $i = shift;
   return $r * 9 + $i
}

sub col {
   my $c = shift;
   my $i = shift;
   return row($i, $c)
}

sub box {
   my $b = shift;
   my $i = shift;
   my $a = 0;
   
   # choose box row
   $a += 27 * ($b / 3);
   $b  = $b - ($b / 3) * 3;

   # choose box column
   $a += 3 * $b;

   # choose box position
   $a += 9  * ($i / 3);
   $i  = $i - ($i / 3) * 3;
   $a += $i;
   return $a
}

sub any {
   my $d = shift; # dimension
   my $w = shift; # which row or column or box
   my $c = shift; # cell index

   return row($w,$c) if $d == 0;
   return col($w,$c) if $d == 1;
   return box($w,$c) if $d == 2;

   die "invalid dimension $d\n";
}

# ##################################################
# flip grid around main diagonal, thereby making rows columns and
# columns rows
#

sub flip {
   my $grid = shift;
   my $r;
   my $c;
   for $r ( @rcbs ) {
      for $c ( grep { $_ < $r } @rcbs ) {
	 my $t;
	 $t = $grid->[&row($r,$c)];
	      $grid->[&row($r,$c)] = $grid->[&col($r,$c)];
	      $grid->[&col($r,$c)] = $t;
      }
   }
   return $grid;
}

# ##################################################
# copy grid
#
sub copy {
   my $grid = shift;
   my $copy;
   my $i;
   for $i ( @index ) {
      $copy->[$i] = $grid->[$i];
   }
   return $copy;
}

# ##################################################
# progress ??
#

sub progress {
   splice  @progress, 1;
   unshift @progress, join "-", @{shift()};
   return  $progress[0] ne $progress[1]
}

# ##################################################
# show a grid on standard output
#

sub show_cell {
   my $cell = shift;

   if ( ! $opt{v} ) {
      return defined $vals{$cell} ? $vals{$cell} + 1 : "_"
   }

   join "", map { $cell & $_ ? $vals{$_} + 1 : "_" } @vals;
}

sub show {
   my $grid = shift;
   my $r;
   my $c;

   for $r ( @rcbs ) {
      print "-------------------------------------\n"
	 if $r == ($r / 3) * 3;
      for $c ( @cells ) {
	 print $c == ($c / 3) * 3 ? "|" : " ";
	 print " ", &show_cell($grid->[row($r,$c)]), " ";
      }
      print "|\n";
   }
   print "-------------------------------------\n";

}

# ##################################################
# solve -- heuristic 2
# 
# each box consists of three mini columns and three
# mini rows
#
# if, within a box, some value must appear in just one mini
# row or mini column, then that value cannot occur elsewhere
# within that row or column
#
# similarly, w.r.t. row or column segments and boxes
# 
# if called with second argument false, the code below works with
# horizontal rows.  otherwise, the grid is flipped to work with vertical
# columns (and then flipped back again at the end)
# 

sub heuristic_2 {
   my $grid = shift;
   my $flip = shift;

   my $d;   # dimension
   my $a;   # row or box
   my $i;   # index
   my $j;   # other index
   my @A;						    # accumulators

   $grid = &flip($grid) if $flip;

   for $i ( @index ) {
      $A[$i / 3] |= $grid->[$i];			    # calculate accumulator
   }

   for $d (0,2) {					    # the dimension - row or box
      my $D = $d ? 0 : 2;				    # the other dimension
      for $a ( @rcbs ) {				    # each row or box
	 for $i (0..2) {				    # each segment
	    #
	    my $B = &merge(   $A[&any($D,$a,$i*3)/3],		  # starting with current row or box segment
			      \&AND,				  # '&' them together
			      map  { ~$A[&any($D,$a,$_*3)/3] }	  # invert mask
			      grep { $_ != $i                }	  # except current
			      (0..2)			     );	  # possible row or box segments
	    #
	    # $B is the set of values that MUST occur in the current row
	    # or box segment
	    #
	    # therefore, these values cannot occur elsewhere within the
	    # current row or box
	    #
	    my $rb = $a / 3 * 3 + $i;			    # row or box
	    for $j ( grep { $_ / 3 != $a % 3 } @rcbs ) {
	       $grid->[&any($d,$rb,$j)] &= ~$B;
	    }

	 }
      }
   }

   $grid = &flip($grid) if $flip;
   return;
}

# ##################################################
# heuristic 5
#

sub heuristic_5 {
   my $grid = shift;

   my $d; # dimension
   my $a; # row, col or box
   my $s; # a set
   my $c; # cell

   for $d ( @dims ) {
      for $a ( @rcbs ) {
	 for $s ( grep { $_ != $all } @sets ) {
	    my $A = &merge( 0, \&OR,
			    map  { $grid->[&any($d,$a,$_)]  }
			    grep { $s & &bit($_)            } @cells );
	    next unless $nbits{$s} == $nbits{$A};
	    for $c ( grep { ! ( $s & &bit($_) ) } @cells ) {
	       $grid->[&any($d,$a,$c)] = $grid->[&any($d,$a,$c)] & ~$A;
	    }
	 }
      }
   }

}

# ##################################################
# read puzzle, initialise grid
#

@input = map  { $_ eq "_" ? 0 : $_ }   # map "_" to 0
	 grep { $_                 }   # ignore empty strings
	 split /[^_0-9]*/,	       # split into "_" and digits
	 join "", <>;		       # suck in input

$grid  = [ map { $input[$_] ? &bit($input[$_] - 1) : $all } @index ];

for ( @index ) {
   die unless $grid->[$_];
}

&show($grid) if $opt{s};

# ##################################################
# solve puzzle
#

sub unsolved {
   my $grid = shift;
   81 - &merge( 0,
	        \&PLUS,
	        map { defined $vals{$_} ? 1 : 0 } @{$grid}
	       );
}

sub broken {
   my $grid = shift;
   for ( @{$grid} ) {
      return 1 unless $_;
   }
   return 0;
}

sub solve {
   my $grid = shift;

   while ( &progress($grid) && &unsolved($grid) && ! &broken($grid) ) {
      print STDERR &unsolved($grid), "\n";
      for (0..1) {
	 &heuristic_2($grid, $_);
      }
      &heuristic_5($grid)
   }
   
   if ( &broken($grid) ) {
      print STDERR "   ... broken\n";
      return undef;
   }
   
   return undef
      if &broken($grid);

   # ###############################################
   # guessing
   #

   if ( $opt{g} && &unsolved($grid) ) {
      #
      # heuristics haven't worked, let's try making a guess
      #

      $depth += 1;

      my $index = (grep { ! defined $vals{$grid->[$_]} } @index)[0];
      my $c = 0;	      # count of solutions
      my $C;		      # copy of most recent solution
      my $g;		      # guessed value

      print STDERR "depth=$depth, guessing at index $index\n";

      for $g ( grep { $_ & $grid->[$index] } @vals ) {
	 print STDERR ".. trying ", &show_cell($g), " at index $index\n";
	 my $copy = &copy($grid);
	 $copy->[$index] = $g;
	 $copy = &solve($copy);
	 if ( $copy && ! &unsolved($copy) ) {
	    $c += 1;
	    $C = $copy;
	 }
      }

      $depth -= 1;

      return $c == 1 ? $C : undef;
   }

   return $grid;
}

# ##################################################
# main
#

$grid = &solve($grid);
&show ($grid);

exit ( &unsolved($grid) ? 1 : 0 );