18.pl

# Het zijn altijd vierkanten.
$size = 0;

@lijst = ();
%kandidatenLijst = ();

while(<>) {
    chomp;

    @parts = split " ", $_;

    if($size == 0) {
        $size = scalar @parts;

        for $i (0 .. $size * $size) {
            $kandidatenLijst{$i} = "0";
        }
    }
    
    $rij = $.-1;
    $lijst[$rij] = [];

    for $kolom ( 0 .. $size-1) {
        $lijst[$rij][$kolom] = {};

        $part = @parts[$kolom];

        if($part ne "...") {
            $lijst[$rij][$kolom]{int($part)} = "0";

            delete $kandidatenLijst{int($part)};
        }
    }
}

for $i ( 0 .. $size - 1 ) {
    for $j ( 0 .. $size - 1 ) {
        %cel = %{$lijst[$i][$j]};

        $aantal = scalar keys %cel;

        $lijst[$i][$j] = {%{\%kandidatenLijst}} if $aantal == 0;
    }
}

$aantalChanges = -1;

while($aantalChanges != 0) {
    $aantalChanges = 0;

    # Criterium 1
    for $i ( 0 .. $size -1 ) {
        for $j ( 0 .. $size - 1) {
            %cel = %{$lijst[$i][$j]};

            next if scalar keys %cel == 1;

            while(($key) = each(%cel)) {
                $gevonden = 0;

                # Bovenbuur
                if($i-1 >= 0) {
                    %bovenbuur = %{$lijst[$i-1][$j]};
                    $aantal = scalar grep {$_ == $key + 1 || $_ == $key - 1 } keys %bovenbuur;

                    $gevonden++ if $aantal > 0;
                }

                # Onderbuur
                if($i+1 <= $size) {
                    %onderbuur = %{$lijst[$i+1][$j]};
                    $aantal = scalar grep {$_ == $key + 1 || $_ == $key - 1 } keys %onderbuur;

                    $gevonden++ if $aantal > 0;
                }

                # Linkerbuur
                if($j-1 >= 0) {
                    %linkerbuur = %{$lijst[$i][$j-1]};
                    $aantal = scalar grep {$_ == $key + 1 || $_ == $key - 1 } keys %linkerbuur;

                    $gevonden++ if $aantal > 0;
                }

                # Rechterbuur
                if($j-1 <= $size) {
                    %rechterbuur = %{$lijst[$i][$j+1]};
                    $aantal = scalar grep {$_ == $key + 1 || $_ == $key - 1 } keys %rechterbuur;

                    $gevonden++ if $aantal > 0;
                }

                if($gevonden < 2) {
                    # Als je hier komt, geen twee buren gevonden.
                    delete $lijst[$i][$j]->{$key};

                    $aantalChanges++;
                }
            }
        }
    }
}




print "\n\n";
for $i ( 0 .. $size - 1 ) {
    for $j ( 0 .. $size - 1 ) {
        %cel = %{ $lijst[$i]->[$j] };
        printf "%30s", join " ", keys %cel;
    }
    print "\n";
}