patchwork.pl

#!/usr/bin/perl
use strict;
use warnings;

use File::Slurp;
use YAML;

my @text = read_file(shift);

my %cl;
my @data;
for my $y (0..$#text) {
    chomp $text[$y];
    next unless ($text[$y]);
    my @line = split //, $text[$y];
    push @data, \@line;
}
my $maxy = $#data;

my %log;
for my $y (0..$#data) {
    for my $x (0..$#{$data[$y]}) {
        next if (defined $log{$y.','.$x});
        
        $cl{$y.','.$x} = check_n(\@data, \%log, $x, $y, $data[$y][$x], $maxy);
    }
}

my @ssets = sort {$b->{num} <=> $a->{num}} values %cl;
my $maxset = $ssets[0];
for my $p (@{$maxset->{points}}) {
    $data[$p->{y}][$p->{x}] = '_';
}

if (shift) {
    my @result;
    for my $y (0..$#data) {
        my $us = 0;
        for my $x (0..$#{$data[$y]}) {
            $us++ if ($data[$y][$x] eq '_');
        }
        push @result, $us;
    }
    print join "\n", @result;
    print "\n";
}
else {
    for my $y (0..$#data) {
        for my $x (0..$#{$data[$y]}) {
            print $data[$y][$x];
        }
        print "\n";
    }
}

exit;

sub check_n {
    my ($data, $log, $px, $py, $pc, $maxy) = @_;

    my %llog;
    $log->{$py.','.$px} = 1;
    $llog{$py.','.$px} = 1;
    
    my @queue = ({x=>$px, y=>$py, c=>$pc});
    my @result = @queue;
    while (my $p = shift @queue) {
        for my $d ([-1, 0], [1, 0], [0, 1], [0, -1]) {
            my $dx = $p->{x} + $d->[0];
            my $dy = $p->{y} + $d->[1];
           
            next if ($dx < 0 || $dy < 0);
            next if ($dy > $maxy);
            next unless (defined $data->[$dy][$dx]);
            next if (defined $llog{$dy.','.$dx});
            $llog{$dy.','.$dx} = 1;
            
            if ($data->[$dy][$dx] eq $pc) {
                my $point = {
                    x => $dx,
                    y => $dy,
                    c => $pc,
                };
                push @queue, $point;
                push @result, $point;
                $log->{$dy.','.$dx} = 1;
            }
        }
    }
   
    #warn join ",", $px, $py, scalar(@result);
    return {
        num => scalar(@result),
        char => $pc,
        str => join(',', (map {'('.$_->{x}.','.$_->{y}.')'} @result)), 
        points => \@result,
    };
}