#!/usr/bin/perl use strict; use warnings; my @grid = ( [qw( _ _ _ | 1 _ _ | 7 4 _ )], [qw( _ 5 _ | _ 9 _ | _ 3 2 )], [qw( _ _ 6 | 7 _ _ | 9 _ _ )], # ------+-------+------- [qw( 4 _ _ | 8 _ _ | _ _ _ )], [qw( _ 2 _ | _ _ _ | _ 1 _ )], [qw( _ _ _ | _ _ 9 | _ _ 5 )], # ------+-------+------- [qw( _ _ 4 | _ _ 7 | 3 _ _ )], [qw( 7 3 _ | _ 2 _ | _ 6 _ )], [qw( _ 6 5 | _ _ 4 | _ _ _ )], ); @$_ = grep { /[^|]/ } @$_ foreach @grid; my $size = @grid; our $grid_h = ''; our $grid_v = ''; foreach my $y (0 .. $#grid) { foreach my $x (0 .. $#grid) { $grid_h .= $grid[$y][$x]; $grid_v .= $grid[$x][$y]; } } our $match_grid; sub print_grid { local $_ = $_[0]; local $\ = "\n"; print substr($_, 0, $size, '') while length; } sub valid { my $spot = substr($grid_h, $_[0]*$size+$_[1], 1); return 1 if $spot eq $_[2]; return if $spot ne '_'; return if index(substr($grid_h, $_[0] * $size, $size), $_[2]) >= 0; return if index(substr($grid_v, $_[1] * $size, $size), $_[2]) >= 0; return 1; } my $re = ''; my $fail = 'x'; foreach my $y (0 .. $#grid) { foreach my $x (0 .. $#grid) { my @attempts; foreach my $n (1 .. @grid) { # The following statment simplifies the regexp, # but makes it specific to the puzzle. # Comment it out to make the regexp reusable. next unless valid($y, $x, "$n"); push(@attempts, "(?(?{ !valid($y, $x, '$n') })$fail)" . "(?{ " . "local \$grid_h = \$grid_h; " . "substr(\$grid_h, @{[ $y*$size+$x ]}, 1, '$n'); " . "local \$grid_v = \$grid_v; " . "substr(\$grid_v, @{[ $x*$size+$y ]}, 1, '$n'); " . "})" ); } $re .= "(?:\n " . join(" |\n ", @attempts) . "\n)\n"; } } $re .= "(?{ \$match_grid = \$grid_h })\n"; { use re 'eval'; $re = qr/$re/x; } # print($re); "" =~ $re or die("No solution.\n"); print("Original\n"); print("========\n"); print_grid($grid_h); print("\n"); print("Solution\n"); print("========\n"); print_grid($match_grid);