Sýkora

sykora.pl

#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

my $coef = 0.75;

my %shape = (
    1 => { z => { c => 'bbbw', s => '0001' },
           b => { c => 'bbwb', s => '0010' },
           y => { c => 'bwbb', s => '0100' },
           i => { c => 'wbbb', s => '1000' },
           r => { c => 'bwbw', s => '0101' },
           d => { c => 'wbwb', s => '1010' },
    },
    2 => { z => { c => 'wwwb', s => '0001' },
           b => { c => 'wwbw', s => '0010' },
           y => { c => 'wbww', s => '0100' },
           r => { c => 'bwww', s => '1000' },
    },
    3 => { z => { c => 'bbbw', s => '0001' },
           b => { c => 'bbwb', s => '0010' },
           y => { c => 'bwbb', s => '0100' },
           r => { c => 'wbbb', s => '1000' },
    },
    4 => { z => { c => 'wwwb', s => '0001' },
           b => { c => 'wwbw', s => '0010' },
           y => { c => 'wbww', s => '0100' },
           i => { c => 'bwww', s => '1000' },
           r => { c => 'wbwb', s => '0101' },
           d => { c => 'bwbw', s => '1010' },
    }
);

{   package Grid;
    use List::Util qw{ sum0 };

    sub new { my ($class, $grid) = @_; bless $grid, $class }
    sub is_empty { my ($grid, $x, $y) = @_; $grid->at($x, $y) =~ /. / }

    sub at {
        my ($grid, $x, $y) = @_;
        return
            if $x < 0 || $x > $#$grid || $y < 0 || $y > $#{ $grid->[$x] };

        return $grid->[$x][$y]
    }

    sub following {
        my ($grid, $x, $y) = @_;
        return (0, 0) if ! defined $x;

        my $step = 1 - $x % 2 * 2;
        $y += $step;
        if ($y < 0 || $y > $#{ $grid->[$x] }) {
            $y -= $step;
            ++$x;
            return if $x > $#$grid;
        }
        return ($x, $y)
    }

    sub neighbours {
        my ($grid, $x, $y, $size) = @_;
        my @n;
        for my $i ($x - $size .. $x + $size) {
            for my $j ($y - $size .. $y + $size) {
                push @n, $grid->at($i, $j) unless $i == $x && $j == $y;
            }
        }
        return @n
    }

    sub avg {
        my ($grid, $x, $y) = @_;
        my $c = $coef
            * ({ '+ ' => 1, '- ' => -1 }->{ $grid->at($x, $y) } || 0);
        for my $size (1 .. 4) {
            my @neighbours = map /(\d)/, $grid->neighbours($x, $y, $size);
            my $avg = $c;
            $avg += sum0(@neighbours) / @neighbours if @neighbours;
            return $avg if abs(($avg - int $avg) - 0.5) > 1e-6;
        }
        die "Can't determine avg\n";
    }
}

my @grid;
while (<DATA>) {
    push @grid, [ /(..)/g ];
}

my $grid = 'Grid'->new(\@grid);
my ($x, $y);
while (($x, $y) = $grid->following($x, $y)) {
    if ($grid->is_empty($x, $y)) {
        my $avg = $grid->avg($x, $y);
        $avg = 1 if $avg < 1;
        $avg = 4 if $avg > 4;
        $avg = int($avg + .5);
        $grid->[$x][$y] = $avg;
    }
    say $x + 1, '/', $y + 1, ' : ', $grid->at($x, $y) =~ /(\d)/;
}

__DATA__
- - - . 3r1r+ + . - - 
- 1r+ + - - - 4z+ - 2r
- + + 4i- 1i- . . . . 
- + + + - - - 3b+ + . 
1z. . . - 1d- + + . - 
- + + . - - 1y+ + + 1d
- + 4z+ 1r- - . + . - 
. + + + . - - 3b. - - 
+ + + 1d. - - + + 4r- 
+ . 3b+ . . 1r+ + . - 
1z- - - 1b1z. - - - 1i
1d. 1d. . . 1d- - - 1b
. 4z- - 1d. . . + + 4r
. . . . . . 1y. + + . 
+ + . 1b. . . . 4z. . 
2r. . + + 1r. + + . - 
- . 4y. + . . + + . - 
- . . + + . 1d. 3y- - 
- . . 3r+ . + + + - 1y
1b. . 3y. 1y+ + + . - 
- . + . - - + + 4i. - 
- . 3y. + 1r. + + + .