use integer; use strict; use Data::Dumper; =rem my $str = <<'*END*'; 9 - - 2 - - - - 4 - 6 - - - 7 9 - - - 4 - 6 - - - - - - - 5 - - - 3 - - - - - - - - 2 5 - - 2 - - 4 - - - 8 - - 4 - - - - 2 3 - 1 7 8 - - 6 - - - 5 - - 3 - - - 1 *END* =cut =rem my $str = <<'*END*'; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *END* =cut my $str = <<'*END*'; 5 - - - 7 - 6 8 2 - - - 5 9 6 - - - - - - - - - - - - - - - - 8 - - 4 9 - 3 6 - - - - - - - - - - - - - - - - - 8 - - 7 - - 1 - - 3 - - 4 - - 7 6 4 - 3 - - - 2 - *END* sub parse_data { my $data = shift; $data =~ s/\r\n/\n/g; $data =~ /(([0-9\-] ){8}[0-9\-]\n){9}/s or die "Not well formatted"; $data =~ s/\n/ /g; my @data = map {$_ eq '-' ? undef : $_+0} split / /, $data; return \@data; } my (@id2row,@id2col,@id2square); for my $id (0..9*9-1) { $id2row[$id] = $id / 9; $id2col[$id] = $id % 9; $id2square[$id] = int($id2col[$id] / 3) + 3*int($id2row[$id] / 3); } my (@num2bit, %bit2num); for my $num (1 .. 9) { my $bit = 1 << ($num - 1); $num2bit[$num] = $bit; $bit2num{$bit} = $num; } sub prepare_struct { my $data = shift; my $struct = { data => $data, rows => [(0) x 9], cols => [(0) x 9], squares => [(0) x 9], fixed => {}, }; foreach my $id (0 .. (9*9-1)) { next unless $data->[$id]; my $bit = $num2bit[$data->[$id]]; $data->[$id] = $bit; $struct->{rows}[$id2row[$id]] |= $bit; $struct->{cols}[$id2col[$id]] |= $bit; $struct->{squares}[$id2square[$id]] |= $bit; $struct->{fixed}{$id} = 1; } return $struct; } my $data = prepare_struct(parse_data($str)); print_solution($data); sub ALL_TAKEN () {0b111111111} # all 9 numbers used sub get_allowed { my ($data, $id) = @_; return [$data->{data}[$id]] if defined($data->{data}[$id]); # preset my $map = ALL_TAKEN & ~($data->{rows}[$id2row[$id]] | $data->{cols}[$id2col[$id]] | $data->{squares}[$id2square[$id]]); return if $map == 0; return $map if exists $bit2num{$map}; return [grep( ($_ && ($_&$map)), @num2bit)]; } sub add_single_allowed { my ($data) = @_; my $cnt = 0; my @added; eval { do { $cnt = 0; foreach my $id (0 .. (9*9-1)) { next if defined($data->{data}[$id]); # preset my $map = ALL_TAKEN & ~($data->{rows}[$id2row[$id]] | $data->{cols}[$id2col[$id]] | $data->{squares}[$id2square[$id]]); die "failed" if $map == 0; if (exists $bit2num{$map}) { # only a single bit is set set_number( $data, $id, $map); push @added, $id; $cnt++; } }; } while ($cnt > 0); }; if ($@ =~ /^failed/) { for (@added) { unset_number( $data, $_); }; die "failed"; } return \@added; } sub set_number { my ($data, $id, $bit) = @_; return if $data->{data}[$id] == $bit; die "Huuumpf, trying to set id $id (row $id2row[$id], col $id2col[$id]) from $data->{data}[$id] to $bit!!!\n" if $data->{data}[$id]; $data->{data}[$id] = $bit; $data->{rows}[$id2row[$id]] |= $bit; $data->{cols}[$id2col[$id]] |= $bit; $data->{squares}[$id2square[$id]] |= $bit; } sub unset_number { my ($data, $id) = @_; return if $data->{fixed}{$id} or !$data->{data}[$id]; my $bit = $data->{data}[$id]; $data->{data}[$id] = undef; $bit = ~$bit; $data->{rows}[$id2row[$id]] &= $bit; $data->{cols}[$id2col[$id]] &= $bit; $data->{squares}[$id2square[$id]] &= $bit; } #script { my $clear = add_single_allowed($data); # find the items that only have one option possible foreach (@$clear) { $data->{fixed}{$_} = 1; } } #print_solution($data); my @backtrack = (undef) x (9*9); my $pos = 0; FIELD: while ($pos >= 0 and $pos < (9*9)) { if ($data->{data}[$pos]) { # already known $backtrack[$pos] = undef; $pos++; next; } my $allowed = get_allowed( $data, $pos); if ($allowed) { ALLOWED: while (@$allowed) { set_number( $data, $pos, $allowed->[0]); if (eval { my $clear = add_single_allowed($data); $backtrack[$pos] = [$allowed, $clear]; }) { $pos++; next FIELD; } else { unset_number( $data, $pos); shift(@$allowed); next ALLOWED; } } # we ran out of allowed values for the current field } $pos--; while ($pos >= 0) { if ($backtrack[$pos]) { if ($backtrack[$pos][1]) { foreach (@{$backtrack[$pos][1]}) { # unset those that were "clear" unset_number( $data, $_); } } unset_number( $data, $pos); if (ref($backtrack[$pos]) and ref($backtrack[$pos][0]) and @{$backtrack[$pos][0]} > 1) { shift(@{$backtrack[$pos][0]}); $allowed = $backtrack[$pos][0]; $backtrack[$pos] = undef; goto ALLOWED; } else { $pos--; } } else { $pos-- } } } print_solution($data); sub print_solution { my $data = shift; print "-" x 18, "\n"; foreach my $r (0 .. 8) { foreach my $c (0 .. 8) { print( ($bit2num{$data->{data}[$r*9 + $c]} || ' ')." "); } print "\n" } print "-" x 18, "\n"; print "\n"; } print join(',', times);