Разработка

Начинаем определение класса, как полагается, с команды

package Polyomino;

При программировании метода canonize выберем следующую стратегию: в переменную $str отправим кодирующую строку. Её получим как выражение $$self ($self — сам объект). Такое же значение первоначально получит и переменная $strMin, в которую в конце концов попадёт канонический представитель класса эквивалентности кодирующей строки. Затем будем в цикле подвергать строку преобразованиям, отражающим всевозможные повороты и всевозможные способы выбора начальной точки контура. Среди этих строк найдём минимальную (в лексикографическом смысле) и отправим её в переменную $strMin, которую сразу после выхода из цикла сделаем кодирующей строкой полимино.

Естественно, нет никакой нужды накапливать в памяти весь список эквивалентных кодирующих строк, чтобы потом выбрать из них минимальную. Будем искать минимальную строку индуктивно, по мере появления новых строк из класса эквивалентности.

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

$str=~s/^(.)(.*)$/$2$1/;

Или то же самое сделать при помощи substr:

$str=substr($str, 1).substr($str, 0, 1);

(мы подозреваем, что второй способ будет работать быстрее).

Во внутреннем цикле кодирующая строка будет подвергаться поворотам на 90° против часовой стрелки, то есть тотальной замене символов R, U, L, D на U, L, D, R соответственно. Для таких операций над строками идеален оператор tr///:

$str=~tr/RULD/ULDR/;

Получившаяся строка $str сравнивается со строкой $strMin, и, если окажется меньше, становится на место последней.

В итоге получаем следующий код:

sub canonize()
{
	my $self=shift;
	my $str=my $strMin=$$self;
	for(my $k=0; $k<$self->perimeter; $k++)
	{
		$str=~s/^(.)(.*)$/$2$1/;
		for(my $j=0; $j<4; $j++)
		{
			$str=~tr/RULD/ULDR/;
			$strMin=$str if $strMin gt $str;
		}
	}
	$$self=$strMin;
}

Параметр $n конструктора offshut содержит номер стороны фигуры. Первым делом создаётся новый объект Polyomino с той же кодирующей строкой, что и данный объект (для которого вызывался метод offshut). Новый объект отправляется в переменную $polyomino.

Затем извлекается $n-й символ из кодирующей строки этого объекта и заменяется на соответствующую трёхсимвольную строку. Проще всего использовать готовую таблицу соответствий в анонимном ассоциативном массиве: тогда символ $c заменяется на {R=>'DRU', L=>'ULD', U=>'RUL', D=>'LDR'}->{$c}.

Вспомним, что появление отростка не всегда проходит гладко. Во-первых, на новой фигуре могут появиться разрезы глубиной один или два. Их лечение, соответственно, проводится в один или два этапа по одной и той же схеме: устранение двухсимвольных сочетаний RL, UD, DU, LR в кодирующей строке (здесь мы представляем кодирующую строку свёрнутой в кольцо). Но строка, увы, не свёрнута в кольцо, и парные, подлежащие сокращению символы могут оказаться в начале и в конце строки; не забудем про этот особый случай. Так что будем устранять эти неприятности в цикле, пока хотя бы одна из них встречается:

while
	(
		$$polyomino=~s/RL|UD|DU|LR//g
			or $$polyomino=~s/^R(.*)L$/$1/
			or $$polyomino=~s/^L(.*)R$/$1/
			or $$polyomino=~s/^U(.*)D$/$1/
			or $$polyomino=~s/^D(.*)U$/$1/
	)
{}

Тело цикла пустое, поскольку устранение неприятностей происходит одновременно с их обнаружением: каждое из выражений $$polyomino=~s/…/…/ возвращает истинное значение в случае обнаружения и устранения разреза того или иного сорта. Обратите внимание на модификатор g в самом первом операторе замены: он вынуждает удалять все встретившиеся в кодирующей строке буквосочетания, подлежащие сокращению. Это нужно для того, чтобы быстро и за один присест уничтожить оба разреза первого сорта, а их при добавлении отростка может оказаться больше одного (но не больше двух). Без модификатора второй разрез будет вылечен при следующем проходе цикла while, но строку придётся просматривать лишний раз, сопоставляя с регулярным выражением.

После лечения разрезов нас может подстерегать ещё одна беда: наложение отростка на другие клетки полимино, или касание с другими клетками — потеря односвязности. Эта опасность грозит фигурам, которые содержат 7 или больше клеток, и поэтому могут охватить клетку, не принадлежащую фигуре. Признаком всех этих осложнений является наличие самопересечений контура, то есть наличие хотя бы двух совпадающих вершин. Этот изъян не лечится; такая ситуация означает, что на $n-й стороне отросток построить невозможно (или возможно, но полученная фигура окажется бракованной, непригодной для дальнейшей работы). Проверку простоты контура (отсутствия самопересечений) мы поручаем методу isSimple, о котором речь пойдёт ниже. Брак после проверки уничтожается, а если контроль качества пройден успешно, новая фигура канонизируется и возвращается из конструктора.

Всё сказанное отражено в определении конструктора offshut:

sub offshut($)
{
	my $self=shift;
	my $n=shift;
	my $polyomino=__PACKAGE__->new($$self);
	my $c=substr($$polyomino, $n, 1);
	substr($$polyomino, $n, 1, {R=>'DRU', L=>'ULD', U=>'RUL', D=>'LDR'}->{$c});
	while
		(
			$$polyomino=~s/RL|UD|DU|LR//g
				or $$polyomino=~s/^R(.*)L$/$1/
				or $$polyomino=~s/^L(.*)R$/$1/
				or $$polyomino=~s/^U(.*)D$/$1/
				or $$polyomino=~s/^D(.*)U$/$1/
		)
	{}
	undef $polyomino unless $polyomino->isSimple;
	$polyomino->canonize if defined $polyomino;
	return $polyomino;
}

Извлечение части контура, начинающуюся с заданной вершины и имеющую заданную длину, мы возлагаем на метод subpath, а проверку всевозможных частей — на метод isSimple. При обнаружении первой же петли последний возвращает ложное значение, а поиск других петель больше не производится. Если все отрезки контура перебраны, а петель среди них не обнаружено, метод isSimple возвращает истинное значение.

Итак, метод subpath принимает два параметра — номер вершины ($k), с которой начинается отрезок контура, и длину отрезка $l. В типичном случае соответствующий этому отрезку кусок кодирующей строки возвращается выражением substr($$self, $k, $l) (если извлекаемый отрезок не содержит начальную точку контура). Если же содержит, потребуются особые манипуляции. Приведём без пояснений код, в котором учтено данное обстоятельство; укажем лишь, что типичному случаю соответствует условие $k+$l<=$self->perimeter:

sub subpath($$)
{
	my $self=shift;
	my $k=shift;
	my $l=shift;
	return substr($$self, $k, $l) if $k+$l<=$self->perimeter;
	my $h=$self->perimeter-$k;
	return substr($$self, $k, $h).substr($$self, 0, $l-$h);
}

Конечно же предполагается, что $l меньше периметра фигуры.

Метод toSVG возвращает строку, содержащую документ SVG с изображением фигуры полимино. Документ содержит элемент svg:svg — контейнер для рисунка, внутри которого размещается единственный элемент svg:path. Содержательная часть кода предназначена для вычисления значений нужных атрибутов этих двух элементов:

sub toSVG()
{
	my $self=shift;
	вычислить значения атрибутов

	return <<__SVG__;
<svg:svg
	version="1.1"
	viewBox="@viewBox"
	width="$width"
	height="$height"
	>
	<svg:path d="M 0 0 ${path}z"/>
</svg:svg>
__SVG__
}

В элементе svg:svg атрибут version принимает значение 1.1 (это версия языка SVG). Атрибут viewBox должен содержать четвёрку чисел, разделённых пробелами. Первые два из них — координаты левого нижнего угла прямоугольника, ограничивающего рисунок (элементы изображения могут выходить за пределы прямоугольника, но показано будет только то, что попало в прямоугольник). Два оставшихся числа — это ширина и высота ограничивающего прямоугольника.

Атрибуты width и height задают «внешние» размеры рисунка, то есть размеры того прямоугольника, на который будет отображён прямоугольник viewBox. Размеры (и даже пропорции) этих двух прямоугольников не обязаны совпадать. В случае несовпадения размеров прямоугольник viewBox может растягиваться или сжиматься по горизонтали и вертикали до нужной ширины и высоты, либо с сохранением пропорций (тогда при необходимости остаются поля), либо без сохранения (тогда изображение сжимается или растягивается). Этим поведением можно управлять при помощи дополнительных атрибутов, однако нам это не понадобится: мы укажем в точности ту же ширину и высоту, что и у viewBox.

Размеры viewBox легко вычисляются через значения, возвращаемые методом boundingBox. Однако boundingBox возвращает размеры в клетках фигуры, а требуются размеры в пикселах. Мы выбрали для клетки фигуры приемлемый размер 36 × 36 пикселов. Поскольку фигуры на рисунке будут очерчены чёрной линией, потребуется дополнительные поля вокруг фигуры (мы выбрали половину размера клетки). С учётом сказанного, если $llx, $lly, $urx, $ury — числа, возвращённые при вызове boundingBox, то ширина и высота viewBox даются выражениями $urx-$llx+1 и $ury-$lly+1 (добавочная единица возникла из-за полей). Абсцисса левого нижнего угла получается как $llx-.5. Что касается ординаты, мы используем не $ury-.5, а -$ury-.5. Это связано с тем, что в SVG применяются декартовы координаты с осью ординат, направленной вниз. После того как значения @viewBox вычислены в клетках, умножим их на 36 — размер клетки в пикселах.

my ($llx, $lly, $urx, $ury)=$self->boundingBox;
my @viewBox=($llx-.5, -$ury-.5, $urx-$llx+1, $ury-$lly+1);
my $cellSize=36;
$_*=$cellSize for @viewBox;
my ($width, $height)=@viewBox[2, 3];

Дальше вычисляется значение атрибута d элемента svg:path. Это значение всегда имеет вид M 0 0 … z: путь начинается из начала координат и оканчивается замыканием. На место многоточия можно было бы вставить команды сдвигов по горизонтали h 36 и h -36 для букв R и L кодирующей строки и команды сдвигов по вертикали v -36 и v 36 для U и D (вверх в наших координатах — это вниз в координатах SVG). Но такое решение было бы следствием исключительного малодушия. Если в кодирующей строке идут подряд несколько одинаковых букв, скажем, …RRRR…, то получится … h 36 h 36 h 36 h 36 …, хотя можно было бы написать короче: … h 144 …. Примем во внимание, что язык SVG не отличается лаконичностью, и нельзя пренебрегать никакой возможностью сократить размер документа.

Напрашивается такое решение: разбить строку на фрагменты, состоящие из одинаковых букв. В зависимости от буквы формируется команда сдвига: h для буквы R, h - для L, v - для U и v для D. После команды и возможного минуса записывается размер клетки, умноженный на длину фрагмента.

И как же найти в строке фрагменты, состоящие из одинаковых букв? Конечно, с помощью регулярных выражений:

while($$self=~m/((.)\2*)/g)
{
	$path.={R=>'h ', U=>'v -', L=>'h -', D=>'v '}->{$2}
		.($cellSize*length $1).' ';
}

При вычислении условия цикла $$self=~m/((.)\2*)/g во вторую (внутреннюю) группу захвата попадает символ. Первая, внешняя группа должна захватить, помимо этого символа, ещё ноль или больше таких же символов. Содержимое второй группы, $2, позволяет выбрать команду сдвига, если использовать его как ключ в анонимном ассоциативном массиве. Длина строки $1, умноженная на размер клетки, дает величину сдвига.

Первая часть тела метода toASCII посвящена заполнению двумерного массива @intersections. В этом массиве j-й элемент — список абсцисс i вертикальных отрезков на контуре полимино, лежащих в j-й полосе. Список размещается в элементе массива @intersections как ссылка на анонимный массив. Система координат i j выбрана из-за того, что координаты клеток фигуры в ней всегда неотрицательны, что, как правило, неверно для координат x y . Отрицательные координаты невозможно использовать как индексы в массиве.

Значения добавляются в массив @intersections в порядке обхода вершин контура. Обход начинается с начальной точки контура i 0 j 0 = x min y min . Итак, начальные координаты сначала берутся как x y -координаты левого нижнего угла ограничивающего прямоугольника (первые два значения из списка, возвращаемого при вызове boundingBox), а затем у них меняется знак:

sub toASCII()
{
	my $self=shift;
	my ($i, $j)=$self->boundingBox;
	($i, $j)=(-$i, -$j);
	

Затем в цикле перебираются символы кодирующей строки. Для горизонтальных участков (R или L) просто увеличивается или уменьшается абсцисса $i, а для вертикальных (U или D) увеличивается или уменьшается ордината $j, и, кроме того, значение текущей абсциссы добавляется в список абсцисс из $j-й полосы:

	for my $c(split //, $$self)
	{
		if($c eq 'R')
		{
			$i++;
		}
		elsif($c eq 'U')
		{
			push @{$intersections[$j++]}, $i;
		}
		elsif($c eq 'L')
		{
			$i--;
		}
		elsif($c eq 'D')
		{
			push @{$intersections[--$j]}, $i;
		}
	}
	

Обратите внимание, на то, что при движении по контуру вверх абсцисса добавляется в список до того, как увеличится ордината ($j++). При движении вниз сначала уменьшается ордината (--$j), и только после этого происходит добавление абсциссы. Объяснение содержится на рисунке 42.2. «Преобразование контурного описания полимино в клеточное». Там видно, что стрелки, отвечающие вертикальным сторонам фигуры и попавшие в j-ю полосу, начинаются на нижнем краю полосы (отмечен пунктиром) при движении вверх, и заканчиваются там при движении вниз. Поскольку нас интересуют пересечения вертикальных сторон именно с нижним краем полосы, при движении вниз сначала выполняется сдвиг, и уж затем добавляется абсцисса в j-й список для нового, уменьшенного на единицу, значения j.

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

Поскольку ряды фигуры нумеруются снизу вверх, а выводиться должны, по замыслу, сверху вниз, нам потребуется организовать циклический перебор рядов в обратном порядке:

Perl
my $string=''; for(reverse @intersections) { } return $string; }

Цикл посвящён построению значения переменной $string.

В теле цикла список абсцисс, доступный в массиве @$_, сортируется в арифметическом порядке, и попадает в массив @row. Затем следует преобразовать ряд в строку $rowString, состоящую из блоков и пробелов. Эта строка будет добавлена к переменной $string вместе с символом конца строки, завершающим ряд:

Perl
my @row=sort { $a<=>$b } @$_; my $rowString=''; while(@row) { my ($start, $stop)=splice @row, 0, 2; $rowString.=(' ' x ($start-length $rowString)); $rowString.=('▒' x ($stop-$start)); } $string.="$rowString\n";

Во внутреннем цикле пара абсцисс $start, $stop извлекается из отсортированного по возрастанию массива @row строка $rowString сначала дополняется пробелами до длины $start, а затем дополняется блочными символами в количестве $stop-$start. По завершении цикла (когда @row опустеет) строка $rowString вместе с символом конца строки добавляется, как и было обещано, к строке $string.

Информатика-54© А. Н. Швец