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

my $baregrid=0;
$baregrid=shift @ARGV if(@ARGV and "-b" eq $ARGV[0]);
my $verbose=0;
$verbose++ while(@ARGV and "-v" eq $ARGV[0] and shift @ARGV);

# Indexed by number of squares and then the total of those squares
my @poss=();
push @poss,{} while($#poss<9);

sub makeposs($$@);
sub makeposs($$@) {
	my ($total,$used,@rest)=@_;
	if(@rest) {
		my $me=shift @rest;
		makeposs($total,$used,@rest);
		makeposs($total+$me,[@$used,$me],@rest);
	} else {
		my $num=@$used;
		$poss[$num]{$total}=[] unless($poss[$num]{$total});
		push @{$poss[$num]{$total}},$used;
	}
}
makeposs(0,[],(1,2,3,4,5,6,7,8,9));

sub strposs($) {
	my @poss=sort {$a<=>$b} keys %{$_[0]};
#	return "" if(9==@poss);
	my $s="";
	while(@poss) {
		my $start=shift @poss;
		my $stop=$start;
		$stop++ while(@poss and $stop+1==$poss[0] and shift @poss);
		if(3<$stop-$start) {
			$s.="$start-$stop";
		} else {
			$s.=join("",$start..$stop);
		}
	}
	return $s;
}

sub loadgrid($) {
	my ($filename)=@_;
	my @grid=();
	my $diff=0;
	open(INPUT,"<",$filename) or die "open: $!";
	for(my $i=0;defined(my $line=<INPUT>);$i++) {
		chomp $line;
		my @line=split /\t/,$line,-1;
		$grid[$i]=[];
		die if($i and @{$grid[0]} != @line);
		for(my $j=0;$j<@line;$j++) {
			if($line[$j] =~ /^(\d*)\/(\d*)$/s) {
				$grid[$i][$j]=[length($1)?$1:undef,length($2)?$2:undef];
				$diff+=$1 if(length($1));
				$diff-=$2 if(length($2));
			} elsif("" eq $line[$j]) {
				$grid[$i][$j]={};
				map {$grid[$i][$j]{$_}=1} 1..9;
			} elsif($line[$j] =~ /^[1-9]$/s) {
				$grid[$i][$j]={$line[$j]=>1};
			} else {
				die $line[$j];
			}
		}
	}
	close(INPUT) or die;
	die "horiz-vert=$diff" if($diff);
	return \@grid;
}

sub blocks($) {
	my ($grid)=@_;
	my @blocks=();
	for(my $i=0;$i<@$grid;$i++) {
		for(my $j=0;$j<@{$$grid[$i]};$j++) {
			next unless("ARRAY" eq ref($$grid[$i][$j]));
			if(defined($$grid[$i][$j][0])) {
				my $block=[$$grid[$i][$j][0]];
				for(my $k=$j+1;$k<@{$$grid[$i]} and "HASH" eq ref($$grid[$i][$k]);$k++) {
					push @$block,$$grid[$i][$k];
				}
				die "$i/$j" unless(1<@$block);
				push @blocks,$block;
			}
			if(defined($$grid[$i][$j][1])) {
				my $block=[$$grid[$i][$j][1]];
				for(my $k=$i+1;$k<@$grid and "HASH" eq ref($$grid[$k][$j]);$k++) {
					push @$block,$$grid[$k][$j];
				}
				die "$i/$j" unless(1<@$block);
				push @blocks,$block;
			}
		}
	}
	return @blocks;
}

# Do a simple full-block check; only makes progress once
sub solveblock0($) {
	my ($total,@cells)=@$_;
	my $progress=0;
	my %allposs=();
	foreach my $p (@{$poss[@cells]{$total}}) {
		map {$allposs{$_}=1} @$p;
	}
	foreach my $cell (@cells) {
		foreach my $val (keys %$cell) {
			unless(exists $allposs{$val}) {
				delete $$cell{$val};
				$progress++;
			}
		}
	}
	return $progress;
}

sub solveblocks0(@) {
	map {solveblock0(@$_)} @_;
}

# Tries all arrangements of applying digits to cells, and sets the celldigit value for each working combo to 1
# (useful if they start out at 0).  Returns true if it found a match.
sub matches($@);
sub matches($@) {
	my ($digits,$first,@rest)=@_;
	my $match=0;
	for(my $i=0;$i<@$digits;$i++) {
		my $digit=$$digits[$i];
		next unless(exists $$first{$digit});
		if(@rest) {
			my @otherdigits=grep {$_!=$digit} @$digits;
			if(matches(\@otherdigits,@rest)) {
				$$first{$digit}=1;
				$match=1;
			}
		} else {
			die if(1 != @$digits);
			$$first{$digit}=1;
			$match=1;
		}
	}
	return $match;
}

# Do a more in-depth block check
sub solveblock2($) {
	my ($total,@cells)=@$_;
	my $progress=0;
# Mark all possibilities with 0 as the value
	foreach my $cell (@cells) {
		map {$$cell{$_}=0} keys %$cell;
	}
# Set possibilities to 1 as we find things it can match
	foreach my $p (@{$poss[@cells]{$total}}) {
		matches($p,@cells);
	}
# See what isn't a possibility
	foreach my $cell (@cells) {
		map {
			unless($$cell{$_}) {
				delete $$cell{$_};
				$progress++;
			}
		} keys %$cell;
	}
	return $progress;
}

sub solveblocks2(@) {
	my $progress=0;
	map {$progress+=solveblock2(@$_)} @_;
	return $progress;
}

sub filldiff($%) {
	my ($start,%groups)=@_;
	my $diff=0;
	my @working=(+1,$start);
	my %seen=();
	while(@working) {
		my ($sign,$cur)=splice @working,0,2;
		next if($seen{$cur});
		$seen{$cur}=1;
		my ($num,@spaces)=@$cur;
		$diff+=$sign*$num;
		foreach my $space (@spaces) {
			my @poss=keys %$space;
			if(1==@poss) {
# If there's only one possibility for the space, just subtract the value instead of processing its crossing blocks
				$diff-=$sign*$poss[0];
			} else {
				my ($obj,@blocks)=@{$groups{$space}};
				map {push @working,-$sign,$_ unless($seen{$_})} @blocks;
			}
		}
	}
	return $diff;
}

# Returns list of blocks that haven't yet been solved
sub unsolvedblocks(@) {
	my @unsolved=();
BLOCK:
	foreach my $block (@_) {
		my $solved=1;
		for(my $i=1;$i<@$block;$i++) {
			my @poss=keys %{$$block[$i]};
			$solved=0 if(1<@poss);
		}
		push @unsolved,$block unless($solved);
	}
	return @unsolved;
}

sub hiddenblockshelper($$$$$%) {
	my ($grid,$i0,$j0,$di,$dj,%groups)=@_;
	my @a=();
	for(my ($i1,$j1)=($i0,$j0);"HASH" eq ref($$grid[$i1][$j1]);$i1-=$di,$j1-=$dj) {
		unshift @a,$$grid[$i1][$j1];
	}
	return() unless(unsolvedblocks([undef,@a]));
	my @b=();
	for(my ($i1,$j1)=($i0+$di,$j0+$dj);$i1<@$grid and $j1<@{$$grid[$i1]} and "HASH" eq ref($$grid[$i1][$j1]);$i1+=$di,$j1+=$dj) {
		push @b,$$grid[$i1][$j1];
	}
	return() unless(unsolvedblocks([undef,@b]));
	my ($i1,$j1)=($i0+$di,$j0+$dj);
	my $curblock;
	if($groups{$$grid[$i0][$j0]}[1] eq $groups{$$grid[$i1][$j1]}[1] or $groups{$$grid[$i0][$j0]}[1] eq $groups{$$grid[$i1][$j1]}[2]) {
		$curblock=$groups{$$grid[$i0][$j0]}[1];
	} elsif($groups{$$grid[$i0][$j0]}[2] eq $groups{$$grid[$i1][$j1]}[1] or $groups{$$grid[$i0][$j0]}[2] eq $groups{$$grid[$i1][$j1]}[2]) {
		$curblock=$groups{$$grid[$i0][$j0]}[2];
	} else {
		die "$i0,$j0 and $i1,$j1 don't share a block?";
	}
# "Break" the curblock's squares without breaking our caller's %groups hash
	map {
		$groups{$_}=[grep {$_ ne $curblock} @{$groups{$_}}];
	} @a,@b;
	map {
		push @{$groups{$_}},\@a;
	} @a;
	map {
		push @{$groups{$_}},\@b;
	} @b;
	unshift @a,0;
	unshift @b,0;
	my $diffa=filldiff(\@a,%groups);
	my $diffb=filldiff(\@b,%groups);
	$a[0]=-$diffa;
	$b[0]=-$diffb;
	if($verbose) {
		print "Found hidden slice point at $i0,$j0 and $i1,$j1, yielding:\n";
		showblocks(\@a);
		showblocks(\@b);
	}
	die "$$curblock[0] vs. $diffa,$diffb" unless($diffa and $diffb and $$curblock[0]==$a[0]+$b[0]);
	return(\@a,\@b);
}

# Returns a list of "hidden" subblocks
sub hiddenblocks($) {
	my ($grid)=@_;
	my $wall=[]; # 0 for open square, 1 for inside wall, -1 for outside wall
# First just mark the walls as basic walls
	for(my $i=0;$i<@$grid;$i++) {
		$$wall[$i]=[];
		for(my $j=0;$j<@{$$grid[$i]};$j++) {
			$$wall[$i][$j]=("ARRAY" eq ref($$grid[$i][$j]))?1:0;
		}
	}
# Then note the walls on the right-hand side and bottom (we get left and top for free because of the structure of the grid)
	my @working=();
	for(my $i=0;$i<$#$grid;$i++) {
		my $j=$#{$$wall[$i]};
		push @working,[$i,$j] if($$wall[$i][$j]);
	}
	for(my $i=$#$grid;$i<@$grid;$i++) {
		for(my $j=0;$j<@{$$grid[$i]};$j++) {
			push @working,[$i,$j] if($$wall[$i][$j]);
		}
	}
# Now expand out those noted walls
	while(@working) {
		my $cur=shift @working;
		next unless(1==$$wall[$$cur[0]][$$cur[1]]);
		$$wall[$$cur[0]][$$cur[1]]=-1;
		if(0<$$cur[0]) {
			push @working,[$$cur[0]-1,$$cur[1]-1] if(0<$$cur[1] and 1==$$wall[$$cur[0]-1][$$cur[1]-1]);
			push @working,[$$cur[0]-1,$$cur[1]] if(1==$$wall[$$cur[0]-1][$$cur[1]]);
			push @working,[$$cur[0]-1,$$cur[1]+1] if($$cur[1]<$#{$$wall[$$cur[0]-1]} and 1==$$wall[$$cur[0]-1][$$cur[1]+1]);
		}
		push @working,[$$cur[0],$$cur[1]-1] if(0<$$cur[1] and 1==$$wall[$$cur[0]][$$cur[1]-1]);
		push @working,[$$cur[0],$$cur[1]+1] if($$cur[1]<$#{$$wall[$$cur[0]]} and 1==$$wall[$$cur[0]][$$cur[1]+1]);
		if($$cur[0]<$#$wall) {
			push @working,[$$cur[0]+1,$$cur[1]-1] if(0<$$cur[1] and 1==$$wall[$$cur[0]+1][$$cur[1]-1]);
			push @working,[$$cur[0]+1,$$cur[1]] if(1==$$wall[$$cur[0]+1][$$cur[1]]);
			push @working,[$$cur[0]+1,$$cur[1]+1] if($$cur[1]<$#{$$wall[$$cur[0]+1]} and 1==$$wall[$$cur[0]+1][$$cur[1]+1]);
		}
	}
# Now we calculate a %groups hash mapping squares to the list of their blocks
	my %groups=();
	foreach my $b (blocks($grid)) {
		map {
			$groups{$_}=[$_] unless($groups{$_});
			push @{$groups{$_}},$b;
		} @$b[1..$#$b];
	}
	my @blocks=();
# Now loop through and find "slice points" in horizontal groups
	for(my $i=1;$i<$#$grid;$i++) {
		for(my $j=1;$j<$#{$$grid[$i]};$j++) {
			next if($$wall[$i][$j] or $$wall[$i][$j+1]);
			next unless(-1==$$wall[$i-1][$j] or -1==$$wall[$i-1][$j+1]);
			next unless(-1==$$wall[$i+1][$j] or -1==$$wall[$i+1][$j+1]);
			my @new=hiddenblockshelper($grid,$i,$j,0,1,%groups);
			push @blocks,@new;
		}
	}
# Now loop through and find "slice points" in vertical groups
	for(my $i=1;$i<$#$grid;$i++) {
		for(my $j=1;$j<$#{$$grid[$i]};$j++) {
			next if($$wall[$i][$j] or $$wall[$i+1][$j]);
			next unless(-1==$$wall[$i][$j-1] or -1==$$wall[$i+1][$j-1]);
			next unless(-1==$$wall[$i][$j+1] or -1==$$wall[$i+1][$j+1]);
			my @new=hiddenblockshelper($grid,$i,$j,1,0,%groups);
			push @blocks,@new;
		}
	}
	return @blocks;
}

sub showgrid($) {
	my ($grid)=@_;
	my $base=$baregrid?1:0;
	for(my $i=$base;$i<@$grid;$i++) {
		for(my $j=$base;$j<@{$$grid[$i]};$j++) {
			print "\t" if($base != $j);
			if("ARRAY" eq ref($$grid[$i][$j])) {
				next if($baregrid);
				print defined($$grid[$i][$j][0])?$$grid[$i][$j][0]:"";
				print "/";
				print defined($$grid[$i][$j][1])?$$grid[$i][$j][1]:"";
			} else {
				print strposs($$grid[$i][$j]);
			}
		}
		print "\n";
	}
}

sub showblocks(@) {
	foreach my $b (@_) {
		print "$$b[0]";
		print map {"\t".strposs($$b[$_])} 1..$#$b;
		print "\n";
	}
}

if(1==@ARGV and $ARGV[0] =~ /^([1-9]\d*)\/([1-9])((?:\+[1-9])*)$/s) {
	my ($total,$n)=($1,$2);
	my @req=split /\+/,$3;
	shift @req if(@req);
POSS:
	foreach my $p (@{$poss[$2]{$1}}) {
		my %p=map {($_,1)} @$p;
		map {next POSS unless($p{$_})} @req;
		for(my $i=1;$i<=9;$i++) {
			print " " if(1<$i);
			print $p{$i}?$i:" ";
		}
		print "\n";
	}
} elsif(1==@ARGV and -f $ARGV[0]) {
	my $g=loadgrid($ARGV[0]);
	my @b=blocks($g);
	solveblocks0(@b);
	if(1<$verbose) {
		showblocks(@b);
		print "-"x60,"\n";
	}
	my $didhidden=0;
TRY_AGAIN:
	while(solveblocks2(@b)) {
		if(1<$verbose) {
			showblocks(@b);
			print "-"x60,"\n";
		} elsif($verbose) {
			showgrid($g);
			print "-"x60,"\n";
		}
	}
	unless($didhidden) {
		$didhidden=1;
		@b=unsolvedblocks(@b);
		if(@b) {
			my @hidden=hiddenblocks($g);
			push @b,@hidden;
			goto TRY_AGAIN if(@hidden);
		}
	}
	showgrid($g);
} else {
	die "usage: $0 [-b] [-v] {<in.grid> | <total>/<n>[+v1+v2...]}\n";
}
0;