Разработка
Пред. Глава 42. Полимино След.

Разработка

Класс Polyomino

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

Perl
package Polyomino;

Типовой конструктор принимает кодирующую строку и возвращает ссылку на неё, выполнив предварительно bless: 

Perl
sub new($)
{
	my $class=shift;
	my $string=shift;
	return bless \$string, $class;
}

Определения этих методов настолько банальны, что вряд ли нуждаются в пояснениях: 

Perl
sub toString()
{
	my $self=shift;
	return $$self;
}

sub perimeter()
{
	my $self=shift;
	return length $$self;
}

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

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

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

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

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

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

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

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

Perl
$str=~tr/RULD/ULDR/;

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

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

Perl
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 в кодирующей строке (здесь мы представляем кодирующую строку свёрнутой в кольцо). Но строка, увы, не свёрнута в кольцо, и парные, подлежащие сокращению символы могут оказаться в начале и в конце строки; не забудем про этот особый случай. Так что будем устранять эти неприятности в цикле, пока хотя бы одна из них встречается: 

Perl
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: 

Perl
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: 

Perl
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 меньше периметра фигуры.

Мы аплодируем Александру и досадуем, что эта гениальная идея не пришла в голову нам.

Уже после опубликования этой версии метода subpath наш ученик Александр Волков предложил гораздо более изящное (и более эффективное) решение. Александр заметил, что если даже $k+$l и больше периметра фигуры, то не больше удвоенного периметра. Таким образом проблема выхода за пределы кодирующей строки при вызове substr($$self, $k, $l) полностью снимается, если «удвоить» кодирующую строку: substr($$self x 2, $k, $l). В итоге отпадает потребность и в условном операторе, и в вызове метода perimeter, да и в переменных $k и $l, которые теперь использовались лишь однократно. 

Perl
sub subpath($$)
{
	my $self=shift;
	return substr($$self x 2, shift, shift);
}

Это маленькое улучшение ускоряет нашу программу при n = 10 на 15 %, а при n = 11  — на 21 %. Очень неплохо.

Теперь нам осталось перебирать все отрезки контура (с началами во всевозможных вершинах и всевозможными допустимыми длинами) и проверять, не является ли хотя бы один из них петлёй.

В соответствии с соображениями, высказанными в разделе «Утрата односвязности», организуем перебор участков границы, которые могут претендовать на роль петель. Подсчёт символов проводим при помощи оператора tr///. Первая же найденная петля делает ненужным дальнейший перебор. 

Perl
sub isSimple()
{
	my $self=shift;
	my $perimeter=$self->perimeter;
	for(my $k=1; $k<$perimeter; $k++)
	{
		for(my $l=4; $l<=$perimeter-12; $l+=2)
		{
			my $subpath=$self->subpath($k, $l);
			return 0 if
				($subpath=~tr/R//)==($subpath=~tr/L//)
					and ($subpath=~tr/U//)==($subpath=~tr/D//)
		}
	}
	return 1;
}

Теперь, когда метод subpath стал совсем простым, необходимость в нём отпадает, а ту единственную строчку, где он вызывается, 

Perl
my $subpath=$self->subpath($k, $l);

мы заменим на 

Perl
my $subpath=substr($$self x 2, $k, $l);

Тем самым мы дополнительно ускорим программу, поскольку вызов метода и передача параметров при вызове — операция, требующая времени. С учётом этого быстродействие программы по сравнению с первоначальной версией выросло при n = 10 на 29 %, а при n = 11  — на 40 %. Очевидно, метод subpath был слабым местом в программе.

Метод boundingBox будет играть вспомогательную роль. Он будет вызываться в методах toSVG и toASCII. Алгоритм вычисления координат левого нижнего ($llx и $lly) и правого верхнего ($urx и $ury) углов прямоугольника, ограничивающего фигуру, очень прост. В цикле перебираются символы кодирующей строки и вычисляются координаты $x и $y очередной вершины. Наименьшее и наибольшее значения абсциссы $x отправятся соответственно в переменные $llx и $urx, а наименьшее и наибольшее значения ординаты $y — в переменные $lly и $ury. Найденные четыре значения возвращаются в массиве. 

Perl
sub boundingBox()
{
	my $self=shift;
	my ($llx, $lly, $urx, $ury)=(0, 0, 0, 0);
	my ($x, $y)=(0, 0);
	for(split //, $$self)
	{
		if($_ eq 'R')		{ $x++; }
		elsif($_ eq 'U')	{ $y++; }
		elsif($_ eq 'L')	{ $x--; }
		elsif($_ eq 'D')	{ $y--; }
		$llx=$x if $llx>$x;
		$lly=$y if $lly>$y;
		$urx=$x if $urx<$x;
		$ury=$y if $ury<$y;
	}
	return ($llx, $lly, $urx, $ury);
}

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

Perl
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 — размер клетки в пикселах. 

Perl
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. После команды и возможного минуса записывается размер клетки, умноженный на длину фрагмента.

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

Perl
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), а затем у них меняется знак: 

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

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

Perl
	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© А. Н. Швец