Pragmatic Perl

Выпуск 9. Ноябрь 2013

Как я решал Perl Golf от PragmaticPerl

В прошлом номере журнала был объявлен конкурс Perl Golf, в котором я решил поучаствовать.

Условия задачи здесь приводить не буду, они есть по ссылке http://pragmaticperl.com/issues/08/pragmaticperl-08-perl-golf.html

Сначала я набросал прототип решения задачи. Алгоритм был выбран довольно простой — вначале собираем входные данные в одну строку, потом регулярным выражением проходим по горизонтали строку и заменяем на пробелы нужные цифры. Для обработки вертикалей входные данные разбирались на вертикальные строчки, по ним проходило то же регулярное выражение, что и для горизонталей, а затем строки поворачивались обратно.

Вот что получилось в первой итерации:

#!perl
sub h {
    ($x) = @_;
    while ($x =~ /(\d)(\s*)(?=\d)/g)
    {    # проходим по горизонтали
        $f = $1;    # первое число
        $s = $2;    # промежуток
        $' =~ /^(.)/
          ; # разбираем POSTMATCH, получаем второе число
        if ($f + $1 == 10 || $f == $1) {
            $x =~
              s/$f$s$1/ $s / # заменяем числа пробелами
        }
    }
    $x;
}

sub v {
    ($y) = @_;
    @e = ();
    for $i (0 .. 8) {
        $l = '';

        # получаем вертикальные строки
        map { $l .= substr($y, $i + $_ * 9, 1) } 0 .. $w;

        # проходим по ним процедурой h, как для горизонталей,
        # и записываем в массив @e
        push @e, h($l);
    }
    $y = '';

    # получаем строку в формате исходных данных
    for $i (0 .. $w) {
        map { $y .= substr($_, $i, 1) } @e;
    }
    $y;
}
($c = join '', <>) =~ s/\n//g; # объединяем в одну строку, убираем пробелы
$w = length($c) / 9 - 1;       # получаем высоту поля
while (1) {
    $d = v(h($c));             # проходим по горизонтали и вертикали
    last if $d eq $c;          # если ничего не изменилось - завершаем
    $c = $d;
}
for ($d =~ /[ \d]{9}/g)
{    # разбиваем на строки по 9 символов
     # и выводим их на экран, если строка содержит хоть одну цифру
    print "$_\n" if /\d/;
}

Примечание: код здесь и далее отформатирован для улучшения читаемости — в реальном гольфе это все записано в одну строку.

372 символа! Это очень много по меркам гольфа. К счастью, тут есть что улучшать.

• Параметр процедуры получаем как $x=pop; вместо ($x)=@_; — экономия в один символ.
• Используем постфиксные if и for везде где только возможно — это дает экономию в 3 символа на каждое условие или цикл.
• Если процедура определена выше, то скобки при вызове не обязательны — h($l) можно записать как h$l.
• length($c) можно записать как $c=~y///c, а это на один символ короче.
• Условие выхода пишем прямо в while — last не нужен.
• Использование $_ позволяет заметно сократить программу. К примеру, $x=~s/a/b/ заменяется на s/a/b/ — экономия в 4 символа.
• Вместо $'=~/^(.)/ и получения результата в $1 пишем $'=~/./ — результат будет в специальной переменной $&. Еще 3 символа.
• Поскольку нам все равно нужен диапазон 0..$w ($w — это высота поля), его лучше получить заранее и сохранить в массив — получится сэкономить порядка 7 символов.
• Флаги командной строки (http://perldoc.perl.org/perlrun.html) заметно упрощают жизнь. Добавим -0 (в итоге входные данные сразу приходят как одна строка), -l (при выводе в конце строк автоматически добавится \n) и -n (не нужно отдельно обрабатывать STDIN, он сразу будет в $_).
• Для экономии можно использовать встроенные переменные Perl. К примеру, переменная $, (разделитель вывода для print) и другие ей подобные хороши тем, что после них можно не ставить пробел: $,ne$_ вместо $a ne$_.

После всех этих оптимизаций получаем 299 символов:

#!perl -ln0
sub h {
    $_ = pop;
    while (/(\d)(\s*)(?=\d)/g) {
        $f = $1;
        $s = $2;
        $' =~ /./;
        s/$f$s$&/ $s / if $f + $& == 10 || $f == $&;
    }
    $_;
}

sub v {
    $y = pop;
    @e = ();
    for $i (0 .. 8) {
        $l = '';
        $l .= substr $y, $i + $_ * 9, 1 for @r;
        push @e, h $l;
    }
    $y = '';
    for $i (@r) {
        $y .= substr $_, $i, 1 for @e;
    }
    $y;
}
s/\n//g;
@r = 0 .. y///c / 9 - 1;
while ($, ne $_) {
    $, = $_;
    $_ = v h $,;
}
for (/.{9}/g) {
    print if /\d/;
}

Оптимизируем дальше:

• Зачем нам процедура v, если мы все равно вызываем ее только один раз? Поместим ее код внутрь основного цикла while, это сэкономит немало символов.
• Тернарные операторы короче, чем if — используем их везде где возможно.

• Регулярное выражение в процедуре h можно существенно оптимизировать — в цикле достаточно пройтись по всем цифрам, а промежуток и вторую цифру получить из postmatch. В результате код:

  while (/(\d)(\s*)(?=\d)/g) {
      $f = $1;
      $s = $2;
      $' =~ /./;
      s/$f$s$&/ $s / if $f + $& == 10 || $f == $&;
  }

  превращается в:

  $f = $&, $' =~ /\d/, $f + $& == 10 || $f == $& ? s/$f(\s*)$&/ $1 / : 0
    while /\d/g;

• Получение высоты поля и удаление переносов строки можно улучшить — ведь высота поля равна количеству переносов строки, и наше

  s/\n//g;
  @r = 0 .. y///c / 9 - 1;

  можно записать как:

  @r = 0 .. (s/\n//g) - 1;

• Разбиение на вертикали тоже можно улучшить, если немного вспомнить математику:

  $e["@-" % 9] .= $& while /./g;

С помощью регулярного выражения проходим все символы, сам символ (совпадение шаблона) хранится в переменной $&. Текущая позиция совпадения шаблона находится в массиве @-, а поскольку там всего один элемент, мы его преобразуем в скаляр, взяв в кавычки. Остаток от деления позиции совпадения на 9 даст нам номер колонки.

• Вычитать 1 из высоты поля совсем необязательно, алгоритм все равно будет игнорировать undef-значения.
• Несмотря на то, что мы не используем strict, мы можем использовать my для того, чтобы очистить массив.

После всех этих оптимизаций удалось достичь 214 символов.

Потом, изучив внимательно perlrun, я обнаружил ключик -p, который заставляет Perl выводить значение $_ после завершения программы. Но для этого нужно было не удалять из него переводы строк, а также учитывать что длина каждой строки теперь 10 символов. Так удалось перейти очередной лимит и дойти до 199 символов:

#!perl -n0p
sub h {
    my $_ = pop;
    $f = $&, $' =~ /\d/, $f + $& == 10 || $f == $& ? s/$f(\D*)$&/ $1 / : 0
      while /\d/g;
    $_;
}
while ($, ne $_) {
    my @e;
    $e["@-" % 10] .= $& while /./gs;
    $, = '';
    for $i (0 .. y/\n//) {
        $, .= substr h($_), $i, 1 for @e;
    }
    $_ = h $,;
    s/ {9}\n//;
}

Похоже, это финиш и оптимизировать этот алгоритм дальше некуда. Но что, если попробовать другой алгоритм?

В принципе, большую часть программы занимает код для получения вертикалей. Вот если бы найти регулярное выражение, которое могло бы обрабатывать вертикальные совпадения, да еще и любой высоты… Я уже пробовал это сделать на начальном этапе, но вместо этого сосредоточился на улучшении алгоритма. Как оказалось, зря :)

Задача оказалась не такой уж простой, но после нескольких попыток у меня получилось подобрать подходящий регэксп. Код сразу же уменьшился до 172 символов, и похоже что это не предел:

#!perl -n0p
while ($, ne $_) {
    $, = $_;
    $f = $&, $p = $', $p =~ /\d/,
      $f + $& == 10 || $f == $& ? s/$f(\D*)$&/ $1 / : 0,
      $p =~ /((.{9}\s)*.{9})(.)/s, $s = $1,
      $f + $3 == 10 || $f == $3 ? s/$f$s$3/ $s / : 0
      while /\d/g;
    s/ {9}\n//;
}

В дальнейшем у меня вышло сделать одно регулярное выражение, под которое попадали и горизонтальные, и вертикальные совпадения. Но как оказалось, код можно улучшить еще больше, если снова вспомнить математику. В условии гольфа сказано — “если сумма равна 10 или обе цифры одинаковы”. То есть успешное совпадение для цифры Х — это когда на второй позиции стоит либо Х, либо 10-Х. А это означает что нам не нужно проверять ни сумму, ни совпадение цифр — достаточно прогнать регулярное выражение для довольно ограниченного количества вариантов.

В результате получилось всего 96 символов:

#!perl -0p
while ($, ne $_) {
    $, = $_;
    for $a (1 .. 9) {
        for $b ($a, 10 - $a) {
            s/$a((.{9} )*.{9}|\D*)$b/ $1 /s;
        }
    }
    s/ {9}\n//;
}

Финальная оптимизация:

• Два цикла здесь не нужны — поскольку совпадением является одна цифра, мы можем использовать [$a$b] как шаблон для второй цифры.
• Наконец, можно избавиться от промежуточной переменной, в которой хранится предыдущее состояние поля. Достаточно просто считать, сколько раз сработали регулярные выражения, и выполнять цикл, пока это число не станет равным нулю. В качестве начального значения я решил использовать переменную $/ — по умолчанию она равна \n и при проверке даст true.

И вот он, окончательный результат — 90 символов:

#!perl -0p
while ($/) {
    $/ = s/ {9}\n//;
    for $a (1 .. 9) {
        $b = 10 - $a;
        $/ += s/$a((.{9} )*.{9}|\D*)[$a$b]/ $1 /s;
    }
}

Вот такая история.

Во время решения гольфа я узнал немало нового про возможности Perl, о которых раньше даже не слышал или же никогда не пользовался. Надеюсь, и вы тоже узнали из этой статьи что-то новое для себя :)

P.S. Спасибо Владимиру Леттиеву за организацию конкурса!

■ Сергей Можайский