Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ рекурсия- разбиение и сборка квадрата

Автор: Екатерина7 23.11.2009 22:18

помогите, пожалуйста, разобраться с задачей

Лист бумаги в клетку квадратной формы размера NxN произвольно разрезан на прямоугольные части, каждая из которых имеет целое число клеток. Полученные прямоугольные куски перемешаны. Требуется из заданных прямоугольников снова составить квадрат. Квадрат не обязательно должен быть составлен из прямоугольников в том же порядке, в каком он разрезан. При сборке прямоугольники можно поворачивать.

(число N не задано, можно брать любое)

Автор: Lapp 23.11.2009 22:41

Цитата(Екатерина7 @ 23.11.2009 18:18) *
(число N не задано, можно брать любое)
Любое - какое? Например, случаи N=10 и N=100 могут оказаться существенно разными..
Пожалуйста, уточни верхний предел.

Автор: Екатерина7 23.11.2009 22:45

хорошо, допустим N=10

Автор: Unconnected 24.11.2009 2:21

А как входные данные выглядят? smile.gif

Автор: Гость 24.11.2009 14:05

может входными данными могут быть массивы этих прямоугольников,состоящие из клеточек?

Автор: Lapp 26.11.2009 16:20

Цитата(Гость @ 24.11.2009 10:05) *
может входными данными могут быть массивы этих прямоугольников,состоящие из клеточек?
Unconnected верно заметил - в этой проге подготовка входных данных - это, считай, отдельная задача. Собственно, я поэтому посоветовал именно такое название для этой темы.. )) Но об этом потом.

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

Представлений информации в этой задаче может быть несколько. Во-первых, сам прямоугольник может быть представлен своими размерами: длиной и шириной. Затем, есть по крайней мере два способа привязать прямоугольник к координатной сетке (то есть "положить"). Первое, что приходит в голову - сразу завести массив NxN скажем, из целых, и каждую клетку помечать номером того прямоугольника разбиения, к которому она принадлежит. Этот способ требует довольно много памяти.. А другой подход состоит в том, чтобы задавать прямоугольник координатами его двух противоположных вершин либо координатами одной вершины (с минимальными координатами) плюс все те же длина и ширина.

Итак, давай остановимся на следющем. Каждый прямоугольник сам по себе обозначаем длиной и ширинойобозначаем по двум противоположным углам (вершинам). Таким образом, прямоугольник представляется переменной такого типа:
type
tRectangle=record
lx,ly: integer;
end;
tLocation=record
x,y: integer
end;
, где lx - размер по x, а ly - размер по y, а x,y - положение угла с минимальными координатами. У нас координаты будут идти так:
x - слева направо;
y - сверху вниз.
То есть как в матрице (или, если хотите, на графическом экране). Это будет важно только для вывода информации (псевдографика в основном), но если уж так, то будем называть угол по которому мы указываем положение прямоугольника левым-верхним (top-left).

Теперь, когда у нас есть, с чем иметь дело, будем иметь дело. Вопрос, который стоит перед нами, я уже поставил выше:
Допустим, у нас есть два прямоугольника, а также их положения; нужно найти способ определения, пересекаются они или нет.

Или, более конкретно:
var
r1,r2: tRectangle;
l1,l2: tLocation;

function Overlap(r1,l1,r2,l2): boolean;

То есть прежде всего нужно написать функцию, которая выдает TRUE, если два прямоугольника, переданные в параметрах, пересекаются и FALSE, если они не пересекаются.

Перед написанием, конечно, неплохо было бы описать, как будет работать эта функция, словами плюс обычная математика. То есть пока без программирования, просто основные принципы работы. Вот с этого и начнем. Ekaterina7, какие у тебя соображения на этот счет?

Автор: Екатерина7 26.11.2009 22:30

может просто сравнивать положения этих прямоугольников, их воординаты? если совпадут-то пересекаются.. может там цикл нужен?

Автор: Unconnected 27.11.2009 0:16

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

Автор: Екатерина7 27.11.2009 3:50

да я в приниципе поняла про что.. думаю конкретно как..

Добавлено через 11 мин.
походу нужно какое-то условие..

Добавлено через 17 мин.
сравнивать координаты расположения

Автор: Unconnected 27.11.2009 4:58

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

type
tRectangle=record
lx,ly:integer;
end;
tLocation=record
x,y:integer;
end;

function overlapp(r1,r2:tRectangle; l1,l2:tLocation):boolean;
begin
overlapp:=false; //заранее присваиваем функции значение false, т.е. что прям-ки не пересекаются. Оно может
//измениться в процессе выполнения. Не изменится - значит, не пересекаются.

if ((l1.x=l2.x) and (l1.y=l2.y)) then overlapp:=true; //самая первая проверка. Если координаты совпадают,
//то прям-ки пересекаются

if (l1.x>=l2.x) then if (l2.x+r2.lx)>=l1.x then overlapp:=true;
if (l2.x>=l1.x) then if (l1.x+r1.lx)>=l2.x then overlapp:=true; //далее. Если сумма координаты X одного
//прям-ка и его длины больше или равна координате X второго прям-ка, то они пересекаются.

if (l1.y>=l2.y) then if (l2.y+r2.ly)>=l1.y then overlapp:=true;
if (l2.y>=l1.y) then if (l1.y+r1.ly)>=l2.y then overlapp:=true; //и ещё пара условий. Если сумма
//координаты Y одного прям-ка и его ширины больше или равна координате Y второго прям-ка, то
//они пересекаются.

end;


Автор: volvo 27.11.2009 5:08

Цитата
//далее. Если сумма координаты X одного
//прям-ка и его длины больше или равна координате X второго прям-ка, то они пересекаются.
blink.gif То есть, ордината тут как бы не при делах? Хорошенькое дело. А если один прямоугольник - прямо надо осью OX, а второй - гораздо выше? Так что не проходит это условие. Равно как и следующее, с координатами Y. Комбинировать их надо, ага...

А я бы вообще в другую сторону смотрел для написания этой функции.

Автор: Unconnected 27.11.2009 14:22

volvo,

Цитата

У нас координаты будут идти так:
x - слева направо;
y - сверху вниз.


Добавлено: Но сути это не меняет..

Добавлено через 18 мин.
type
tRectangle=record
lx,ly:integer;
end;
tLocation=record
x,y:integer;
end;

function overlapp(r1,r2:tRectangle; l1,l2:tLocation):boolean;
begin
overlapp:=false;
if ((l1.x=l2.x) and (l1.y=l2.y)) then overlapp:=true;

if (l1.x>l2.x) then if (l2.x+r2.lx)>l1.x then
begin
if (l1.y>l2.y) then if (l2.y+r2.ly)>l1.y then overlapp:=true;
if (l1.y<l2.y) then if (l1.y+r1.ly)>l2.y then overlapp:=true;
end;

if (l2.x>l1.x) then if (l1.x+r1.lx)>l2.x then
begin
if (l2.y>l1.y) then if (l1.y+r1.ly)>l2.y then overlapp:=true;
if (l2.y<l1.y) then if (l2.y+r2.ly)>l1.y then overlapp:=true;
end;

end;




Автор: volvo 27.11.2009 17:44

Цитата
Добавлено через 18 мин.
Это тоже сути не меняет, функция как не работала, так и не работает:

const
r1: trectangle = (lx:10; ly:5);
r2: trectangle = (lx:10; ly:5);
l1: tlocation = (x:0; y:0);
l2: tlocation = (x:11; y:5);

begin
writeln(overlapp(r1, r2, l1, l2));
end.
, и почему у меня ощущение, что должно быть False, а выдается True?

Кстати, Unconnected, это ты специально функцию переназвал? cool.gif


Автор: Unconnected 27.11.2009 21:04

volvo, у нас квадрат ограничивается 10 smile.gif

Я написал такой код, принцип у него другой, нежели у первого, но вот почему-то в конце массивов не координаты а чушь какая-то вперемешку с ними, и на введённых данных тоже True выдаёт:


type
tRectangle=record
lx,ly:integer;
end;
tLocation=record
x,y:integer;
end;

const n=10;
r1:trectangle=(lx:10;ly:5);
r2:trectangle=(lx:10;ly:5);
l1:TLocation=(x:0;y:0);
l2:TLocation=(x:11;y:5);

function overlapp(r1,r2:tRectangle; l1,l2:tLocation):boolean;
var rec1,rec2:array[0..500] of tLocation;
i,j,k,l:byte;
begin
k:=0;
for i:=l1.x to l1.x+r1.lx do
for j:=l1.y to l1.y+r1.ly do begin
rec1[k].x:=i;
rec1[k].y:=j;
inc(k);
end;
k:=1;
for i:=l2.x to l2.x+r2.lx do
for j:=l2.y to l2.y+r2.ly do begin
rec2[k].x:=i;
rec2[k].y:=j;
inc(k);
end;
overlapp:=false;
for i:=0 to k do
for j:=0 to k do
begin
if (rec1[i].x=rec2[i].x) and (rec1[i].y=rec2[i].y) then begin
overlapp:=true;
break;
end;
end;
end;
begin
writeln(overlapp(r1,r2,l1,l2));
readln;
end.


Цитата

Кстати, Unconnected, это ты специально функцию переназвал? cool.gif


Случайно cool.gif

Автор: Екатерина7 27.11.2009 23:09

-что-то я не пойму, а какой тут принцип?

Автор: Unconnected 28.11.2009 3:01

type
tRectangle=record
lx,ly:integer;
end;
tLocation=record
x,y:integer;
end;

const n=10;
r11:trectangle=(lx:10;ly:5);
r22:trectangle=(lx:10;ly:5);
l11:TLocation=(x:0;y:0);
l22:TLocation=(x:9;y:5);

function overlapp(r1,r2:tRectangle; l1,l2:tLocation):boolean;
var rec1,rec2:array[0..n*n] of tLocation;
i,j,k,l:integer;
begin
k:=0;
fillchar(rec1,n*n*sizeof(tLocation),0);
fillchar(rec2,n*n*sizeof(tLocation),0);
for i:=l1.x to l1.x+r1.lx do
for j:=l1.y to l1.y+r1.ly do begin
rec1[k].x:=i;
rec1[k].y:=j;
inc(k);
end;
l:=0;
for i:=l2.x to l2.x+r2.lx do
for j:=l2.y to l2.y+r2.ly do begin
rec2[l].x:=i;
rec2[l].y:=j;
inc(l);
end;
overlapp:=false;
for i:=1 to k-1 do
for j:=1 to l-1 do
begin
if (rec1[i].x=rec2[j].x) and (rec1[i].y=rec2[j].y) then begin
overlapp:=true;
break;
end;
end;
end;


Вот эта вроде как работает. На данных volvo выдала false, на немного изменённых - true.

toЕкатерина7, принцип следующий. Проходим в циклах по обоим прямоугольникам и заносим в два массива соответственно координаты каждой клетки каждого прямоугольника. Потом проверяем, если в одном массиве есть координаты, которые есть и во втором массиве, то прямоугольники пересекаются, если нету - не пересекаются..

Автор: Archon 28.11.2009 3:31

Unconnected, что-то сложновато smile.gif.

Hint: условие того, что прямоугольники не пересекаются: (r1.Right < r2.Left) or (r1.Left > r2.Right) or (r1.Top > r2.Bottom) or (r1.Bottom < r2.Top).

Автор: Lapp 28.11.2009 13:34

Не знаю, как с точки зрения Екатерина7, но лично мне нравится, что обсуждение получилось оживленным )). Также спасибо volvo за осторожные коррекции направлений.

Unconnected пошел хитрым путем, решив, что "против лома нет приема". Если математические соотношения становятся слишком сложными - будем решать тупо в лоб: массивы координат, смотрим наличие в них одинаковых. Способ чрезвычайно ресурсоемкий и совершенно непригодный для случая непрерывных координат (что, впрочем, тут не нужно).

Archon говорит в принципе верные вещи, но они мало отличаются от того, что завело в тупик Неприсоединенного. Слишком много проверок.

Катя, дальше следи внимательно, и если что-то неясно - говори.

Мы немного отойдем от условия и будем пока рассматривать не прямоугольники, а , скажем, круги на плоскости. Поначалу кажется, что ситуация только усложнилась - круг со многих точек зрения сложнее прямоугольника. Но на самом деле, после первого взгляда на чертеж (даже в уме)) становится ясно, что нужно сравнивать не координаты точек на окружности, а координаты центров. А именно: если расстояние между центрами больше, чем сумма радиусов этих кругов, то круги не пересекаются. Если меньше (либо равно) - пересекаются (касаются). Вот и все. Это понятно?

Теперь обсудим другую ситуацию, тоже не совсем прямо вытекающую из условий задачи; а именно - отрезки на прямой. По сути, отрезок на прямой - это есть КРУГ в одномерном пространстве. И хотя обычно, говоря об отрезке, мало кто специально указывает положение его центра (как в случае окружности), он у него все же есть )). Давайте будем описывать отрезки не как обычно (началом и концом), а их центрами и радиусами (радиус отрезка равен половине его длины). И сразу же становится понятно, что условие пересечения двух отрезков на прямой записывается точно так же, как и кругов на плоскости. И не надо проверять несколько случаев.. ))

Дальше. Фактически, условие пересечения двух прямоугольников распадается на два условия по координатам, причем нужно брать их логическое пересечение (условие выполнено только когда оба условия по координатам отдельно выполнены) - это легко понять, нарисовав несколько случаев на бумажке(или снова в уме)).

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

Прикрепленное изображение

|C2 - C1| <= L1/2 + L2/2

Это соотношение нужно проверить по X и по Y, и если в обоих случаях условия выполняются - значит, прямоугольники пересекаются. Прежде чем выписать окончательное выражение, я замечу еще вот, что. В выражении присутствует деление на два, которое добавляет ложку дегтя в нашу бочку с медом, так как требует введения переменных действительного типа со всеми вытекающими (сравнение действительных переменных протекает сложнее..) Поэтому мы заменим эту формулу эквивалентной, умноженной на два.
Итак, в результате имеем:

( 2*|Cx2-Cx1| <= Lx1 + Lx2 ) /\ ( 2*|Cy2-Cy1| <= Ly1 + Ly2 )


Катя, ты поняла математику? пожалуйста, ответь.


Ну вот, теперь можно переходить к программированию..
Я немного изменил названия переменных - извиняюсь за это, просто я тогда поспешил. Для однообразия лучше иметь вместо lx и ly однобуквенные идентификаторы a и b для длины и ширины. Вллюще, это не в полном смысле длина и ширина, а просто размер по x (это a) и по y (это b).

В итоге пресловутая функция будет выглядеть примерно так:

type
tRectangle=record
a,b: integer
end;
tLocation=record
x,y: integer
end;

function Overlap(r1: tRectangle; l1: tLocation; r2: tRectangle; l2: tLocation): boolean;
begin
Overlap:=
(Abs(l2.x*2+r2.a-l1.x*2-r1.a) < r1.a+r2.a) and
(Abs(l2.y*2+r2.b-l1.y*2-r1.b) < r1.b+r2.b)
end;


Unconnected, спасибо за аллюзию, я appreciate that )).

Катя, пожалуйста, посмотри все и задавай вопросы. В принципе, мы готовы двигаться дальше, и следующим шагом будет как раз та подготовка входных данных, о которой шла речь выше. У кого какие соображения? smile.gif

Автор: Unconnected 28.11.2009 14:34

Цитата
У кого какие соображения? smile.gif


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

Добавлено через 11 мин.
Цитата
Archon говорит в принципе верные вещи, но они мало отличаются от того, что завело в тупик Неприсоединенного. Слишком много проверок.


По сравнению с количеством проверок в моих функциях 4 проверки очень даже мобильными кажутся)

Автор: Unconnected 28.11.2009 15:08

Хотя, по словам Lapp'а,

Цитата

Общая стратегия состоит в том, что мы (используя полный перебор, организованный рекурсией) набрасываем прямоугольники из имеющегося у нас набора на квадрат, а в процессе этого смотрим, пересекаются они или нет.


функция для определения пересечений есть, остаётся перебирать?)

Автор: Lapp 28.11.2009 18:44

Цитата(Unconnected @ 28.11.2009 11:08) *
функция для определения пересечений есть, остаётся перебирать?)
Перебирать что? Входных данных пока еще нет..
Можно, конечно, полагать, что это забота не наша, а проверяющего задание, но как тогда отлаживаться? И, в любом случае, как ни крути, нужно все же договориться о формате ввода..

Я все же предлагаю подумать о том, как подготовить (ну и в какой форме сохранить) входной набор прямоугольников.

И еще одна просьба: не гоните, дайте автору темы хотя бы отреагировать и задать вопросы..

Автор: Lapp 30.11.2009 10:25

Кать, если тебе не актуально уже, ты скажи.
А если такими темпами, то и к следующему пнд не будет готово.
С чем загвоздка? Если что-то неясно - спрашивай.

Автор: Екатерина7 30.11.2009 11:38

да,Lapp, с математикой все понятно.. да и с кусочком программы вроде бы тоже..)

Добавлено через 2 мин.
извиняюсь,у меня пару дней с инетом проблемы были,не могла ответить..(( все нормально..вроде бы понятно.. все остается так же актуальным..

Добавлено через 9 мин.
входные данные- параметры прямоугольников,как говорил Unconnected.так?

Автор: Lapp 30.11.2009 13:26

Цитата(Екатерина7 @ 30.11.2009 7:38) *
входные данные- параметры прямоугольников,как говорил Unconnected.так?
Да, так. Вопрос, как. smile.gif

По условию, у нас должен быть на входе набор прямоугольников, из которого заведомо можно построить квадрат, поскольку "Лист бумаги в клетку квадратной формы размера NxN произвольно разрезан на прямоугольные части, каждая из которых имеет целое число клеток". Если такой набор приложен к условию, то наша задача облегчается (Катя, ты спроси преподавателя - может, у него есть такой). Если нет - то надо его сначала сделать, то есть нам нужно имплементить способ разрезания квадрата. Либо..

У набора, из которого можно построить квадрат есть одно обязательное свойство: сумма всех клеток всех его прямоугольников равна количеству клеток в квадрате, то есть N*N. Но это не есть достаточное условие.

Предположим, мы создали набор прямоугольников (со стороной не больше, чем N), и сумма их площадей (клеток) равна N*N (это сделать нетрудно - легче, чем разрезать). Далее, наша будущая программа попытается собрать из них квадрат. Если у нее это получается, то она выдает ответ: "квадрат собрать можно" (и, может быть, порядок сборки). Если же все ее попытки заканчиваются ничем. то она говорит: "квадрат собрать невозможно".

То, что я предложил выше - это видоизменение условия. Я не знаю, насколько такие зменения допустимы. Поэтому я предлагаю: Катя, спроси преподавателя:
1. существует ли набор входных данных для проверки? Если да, то где его взять и в каком он формате.
2. если нет, то возможно ли вместо повторной сборки просто брать случайный набор (с суммарной площадью N*N) и говорить, можно ли из него собрать квадрат (с выдачей порядка сборки в случае удачи).

Либо спроси, либо сама скажи, что делать, потому что от этого зависит программа. Ok? smile.gif



Автор: Екатерина7 30.11.2009 18:20

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

Автор: Lapp 2.12.2009 11:39

Цитата(Екатерина7 @ 30.11.2009 14:20) *
думаю, что можно брать вместо повторной сборки просто случайный набор..
Хорошо. Ну, давай тогда делать случайный набор. Создать и записать в файл square.dat в таком формате: длина и ширина на одной строке; строк стролько, сколько прямоугольников.
Сможешь сделать?

Автор: Екатерина7 2.12.2009 22:03

если честно, несовсем:( у меня с этим возникли трудности.. вооюще затрудняюсь начать..

Автор: Lapp 2.12.2009 22:12

Ну, начать я тебе помогу

var
s,q: integer;
t: tRectangle;
f: text;

begin
s:=0; {сумма всех клеток}
m:=0; {количество прямоугольников}
with t do repeat
...

Можешь продолжить?

Автор: Екатерина7 4.12.2009 18:59

наверно нет.. затрудняюсь.. в написанном могу разобраться.. а так..

Автор: Unconnected 5.12.2009 2:33

Екатерина7, ты какой курс, если не секрет?

Просто, видимо, у тебя практики мало было. Очень мало. А тут раз - и рекурсия с квадратами...


Автор: Екатерина7 5.12.2009 3:42

не секрет- 4-й.. да.. нас плохо научили программир.. первые курсы особенно.. вот так все и пошло.. сейчас более менее с остальным стараюсь разбираться, а вот эту задачу не могу сделать..(

Автор: Екатерина7 5.12.2009 20:03

wacko.gif

Автор: klem4 6.12.2009 21:02

Перебор с рекурсией, код неважнецкий, но работает

{$mode TP}
{$r-}
uses crt;

type

TBlock = object
constructor _new(const r, c: integer; const s: char);
procedure shift;
row, col: integer;
sign: char;
end;

TRow = array [1..1] of char;
PTRow = ^TRow;

TField = array [1..1] of PTRow;
PTField = ^TField;

TBlockField = object
constructor _new( const n: integer );
destructor _free;
procedure _print;
procedure _assign( const b: TBlock; const row, col: integer; const unassign: boolean);
function can_assign( const b: TBlock; const row, col: integer ): boolean;

function fill(f: array of TBlock; fi: integer): boolean;

field: PTField;
sz: integer;

done: boolean;
end;

constructor TBlock._new(const r, c: integer; const s: char);
begin
row := r; col := c; sign := s;
end;

procedure TBlock.shift;
var
t: integer;
begin
t := row; row := col; col := t;
end;

constructor TBlockField._new( const n: integer );
var
i, j: integer;
begin
GetMem( field, n * sizeof( PTRow ));
for i := 1 to n do
GetMem( field^[i], n * sizeof(integer));

for i := 1 to n do
for j := 1 to n do
field^[i]^[j] := '0';

sz := n;
done := false;
end;

destructor TBlockField._free;
var
i, j: integer;
begin
for i := 1 to sz do FreeMem( field^[i], sz * sizeof(integer));
FreeMem(field, sz * sizeof(PTRow));
end;

procedure TBlockField._print;
const colors: array ['a'..'g'] of byte = (red,blue,green,lightred,yellow,lightblue,lightgreen);
var
i, j: integer;
begin
for i := 1 to sz do begin
for j := 1 to sz do begin
if (field^[i]^[j] = '0') then TextColor(white) else TextColor(colors[field^[i]^[j]]);
write(field^[i]^[j]:2);
end;
writeln;
end;
writeln;
end;

procedure TBlockField._assign( const b: TBlock; const row, col: integer;
const unassign: boolean);
var
i, j: integer;
s: char;
begin
if ( unassign ) then s := '0' else s := b.sign;
for i := row to row + b.row - 1 do
for j := col to col + b.col - 1 do
field^[i]^[j] := s;
end;

function TBlockField.can_assign( const b: TBlock;
const row, col: integer ): boolean;
var
r, c: integer;
ok: boolean;
begin
if ( row + b.row - 1 > sz ) or ( col + b.col - 1 > sz ) then
can_assign := false
else begin
ok := true;
r := row;
while (( r < row + b.row ) and ( ok )) do begin
c := col;
while (( c < col + b.col ) and ( ok )) do begin
ok := field^[r]^[c] = '0';
inc©;
end;
inc®;
end;
can_assign := ok;
end;
end;


function TBlockField.fill(f: array of TBlock; fi: integer): boolean;
var
i, r, c, s: integer;
begin
if ( fi = length(f) ) then done := true;

if done then fill := true;

for r := 1 to sz - f[fi].row + 1 do
for c := 1 to sz - f[fi].col + 1 do
for s := 0 to 1 do begin
if ( s = 1 ) then f[fi].shift;
if not(done) and ( field^[r]^[c] = '0' ) and ( can_assign(f[fi], r, c ) ) then begin
_assign(f[fi], r, c, false);
fill := fill(f, fi + 1);
if not done then _assign(f[fi], r, c, true);

end;
end;
fill := done;
end;

var
bf: TBlockField;
b: TBlock;
f: array [1..6] of TBlock;

begin
clrscr;

f[1]._new(2,1,'a');
f[2]._new(2,2,'b');
f[3]._new(1,1,'c');
f[4]._new(1,1,'d');
f[5]._new(2,1,'e');
f[6]._new(2,3,'f');

bf._new( 4 );
writeln(bf.fill(f, 0));
bf._print;

bf._free;
readln;
end.


Автор: Lapp 6.12.2009 23:34

Цитата(klem4 @ 6.12.2009 17:02) *
Перебор с рекурсией, код неважнецкий, но работает
Круто, Клёма! smile.gif А как ты задаешь начальные данные?
Я седни попожжее выложу свой тож тогда.

Автор: klem4 7.12.2009 1:07

Код
f[1]._new(2,1,'a');
f[2]._new(2,2,'b');
...


это массив "кусочков", параметры - длина, ширина и буква.

Код

bf._new( 4 ); // собственно объект - поле, параметр - размер (4х4)
writeln(bf.fill(f, 0)); // заполнение поля, вернет true если можно заполнить из кусочков, хранящихся в f


Автор: Unconnected 7.12.2009 1:26

А теперь возникает вопрос: с какой вероятностью Екатерине7 поверят, что она это писала сама?smile.gif

Автор: Екатерина7 7.12.2009 1:51

поверят, я постараюсь разобраться))

Добавлено через 3 мин.
проверим потом на практике с какой вероятностью))

Автор: Lapp 7.12.2009 2:36

Цитата(Екатерина7 @ 6.12.2009 21:51) *
проверим потом на практике с какой вероятностью))
Если бы я принимал, она бы стремилась к нулю )). И все же желаю успехов (особенно в "разобраться").

Выкладываю свой код тоже. Я хотел выделить подготовку начальных данных в отдельную прогу и писать их в файл, но не сделал..
uses
CRT;
const
n=8; {размер квадрата}

type
tRectangle=record
a,b: integer
end;
tLocation=record
x,y: integer
end;

const
r0: tRectangle=(a:1; b:1);
l0: tLocation=(x: 0; y: 0);

function Overlap(r1: tRectangle; l1: tLocation; r2: tRectangle; l2: tLocation): boolean;
begin
Overlap:=
(Abs(l2.x*2+r2.a-l1.x*2-r1.a) < r1.a+r2.a) and
(Abs(l2.y*2+r2.b-l1.y*2-r1.b) < r1.b+r2.b)
end;

var
r: array[1..n*n+10]of tRectangle;
l: array[1..n*n+10]of tLocation;
s,i,m,k,done: integer;
t: tRectangle;
u: tLocation;
Clear: boolean;

procedure Show; {печать квадрата}
var
i,j,k: integer;
c: char;
begin
for j:=1 to n do begin
for i:=1 to n do begin
c:='.';
for k:=1 to m do with r[k] do with l[k] do
if (x>0)and(x<=i)and(i<x+a)and(y<=j)and(j<y+b) then c:=Chr(k+64);
Write©
end;
WriteLn
end;
WriteLn
end;

procedure JustSet; {подготовка входных данных}
var
s,q,k: integer;
t: tRectangle;
begin
s:=0;
m:=0;
k:=2;
with t do repeat
a:=Random(k)+1;
b:=Random(k)+1;
q:=s+a*b;
if q<=n*n then begin
Inc(m);
r[m]:=t;
l[m]:=u;
s:=q
end
until s=n*n
end;

procedure Put(x,y: integer);
var
i,j: integer;
li: tLocation;
NoOne: boolean;
c: char;
begin
if y<=n then begin
li.x:=x;
li.y:=y;
NoOne:=true;
for i:=1 to m do with r[i] do if l[i].x=0 then begin
if (x+a<n+2)and(y+b<n+2) then begin
Clear:=true;
for j:=1 to m do if l[j].x>0 then Clear:=Clear and not Overlap(r[i],li,r[j],l[j]);
if Clear then begin
Inc(k);
l[i]:=li;
if k=m then begin
Inc(done);
WriteLn('Done ',done);
Show;
c:=ReadKey;
if c=#27 then Halt
end
else Put(x mod n+1,y+x div n);
l[i]:=l0;
Dec(k);
NoOne:=false
end
end;
if a<>b then begin
j:=a;
a:=b;
b:=j;
if (x+a<n+2)and(y+b<n+2) then begin
Clear:=true;
for j:=1 to m do if l[j].x>0 then Clear:=Clear and not Overlap(r[i],li,r[j],l[j]);
if Clear then begin
Inc(k);
l[i]:=li;
if k<>m then Put(x mod n+1,y+x div n);
l[i]:=l0;
Dec(k);
NoOne:=false
end
end;
j:=a;
a:=b;
b:=j;
end
end;
if NoOne then Put(x mod n+1,y+x div n)
end
end;

begin
JustSet;
WriteLn('m=',m);
s:=0;
for i:=1 to m do with r[i] do begin
s:=s+a*b;
WriteLn('a=',a:2,' b=',b:2,' ab=',a*b:4,' s=',s:4);
end;
done:=0;
Put(1,1);
WriteLn('Completed')
end.

Катя, ты спрашивай больше. Не стесняйся smile.gif

Добавлено через 4 мин.
klem4, зачем отключил $R ?

Автор: volvo 7.12.2009 3:43

Цитата
klem4, зачем отключил $R ?
Ну, так со включенным-то работать не будет smile.gif Вылетит за границы массива и все, ко второму элементу уже не обратиться. А я ведь этот случай описывал специально, в "Как не надо писать программы"...

Автор: klem4 7.12.2009 12:31

К сожалению не знаю как еще дин. массивы в таком виде с fpc подружить sad.gif

Автор: Екатерина7 7.12.2009 23:33

спасибо, Lappsmile.gif)

Добавлено через 5 мин.
я в принципе с тобой согласна,я программир плохо знаю..

Автор: Екатерина7 11.12.2009 0:31

Lapp, что-то я вообще не могу понять этой программы... точнее ее выполенение.. что-то странно.. какие-то буквы, цифры.. можешь объяснить, пожалуйста.sad.gif

Автор: Unconnected 11.12.2009 1:09

Екатерина7, какой у тебя уровень программирования в целом? Ты знаешь о типах данных, описании пользовательских типов, функциях, процедурах, операторах в конце концов и т.п.? Просто "буквы, цифры" заставляют задуматься, не рано ли тебе квадраты собирать..smile.gif

Автор: Екатерина7 11.12.2009 12:43

извини, но хватит говорить про мой уровень программир.. не могу понять результата выполнения.вот и просила объяснить.. как и что получается.

Автор: Lapp 11.12.2009 15:03

Цитата(Unconnected @ 10.12.2009 21:09) *
заставляют задуматься,
Ты задумывайся, никто не против. Это без ограничений. А вот, прежде чем флудить - .. еще раз задумайся )) yes2.gif

Цитата(Екатерина7 @ 11.12.2009 8:43) *
извини, но хватит говорить про мой уровень программир..
Совершенно согласен.

Кать, мне просто хотелось, чтоб ты поняла, что думать, что в написанной программе легко разобраться - это большая ошибка. Так же, как разбираться в математических выкладках с трехэтажными интегралами. Конечно, с программой все же проще, чем без нее, но все же.. Я, например, сам, когда смотрю на свои (!) старые программы, думаю, что проще написать новую. Вот, свежий случай - в соседней теме ( http://forum.pascal.net.ru/index.php?showtopic=14197 ) меня попросили пояснить. И я вот уже несколько часов тупо смотрю на нее и думаю: и новую написать, что ли.. Я, конечно, понимаю, что тебе это все не очень важно..

Ладно, объясняю. Коротко.
Я прохожу по ВСЕМ клеткам (слева направо, сверху вниз). В каждую клетку я кладу ВСЕ имеющиеся в наличии прямоугольники (каждый дважды: горизонтально и вертикально - если он не квадрат) по очереди. При этом я проверяю, пересекается ли он с уже положенными прямоугольниками. Если да - отбрасываю, если не пересекается - оставляю его там лежать и перехожу к следующей клетке. Если мне удается таким образом уложить ВСЕ прямоугольники - очень хорошо, я вывожу картинку.

Это был общий принцип. Теперь, как это организовано.
Процедура Put перебирает в цикле (первый for) все прямоугольники. Если он еще не лежит (l[i]=0), то прикладываем его так, чтоб верхний левый угол попал в клетку x,y.
Затем в цикле (второй for) проверяем его на пересечение с теми, которые уже лежат (l[j]>0). Переменная Clear равна true в том случае, если не было ни одного пересечения.

Дальше.
Если Clear, то мы приделываем этот прямоугольник к этому месту (l[i]:=li) и увеличиваем число положенных прямоугольников k.
Если при этом число k достигло m (число всех прямоугольников), то это значит, что все прямоугольники уложены - в этом случае мы выводим картинку.
Если k<m , то вызываем процедуоу Put для следующей клетки (расчет ее координат непосредственно в вызове).
После вызова восстанавливаем прежнее состояние массива положений l и число k.
Затем поворачиваем прямоугольник (меняем местами a и b) и делаем все то же самое с повернутым.
Все.

Рекурсия делает полный перебор по дереву сама, безо всяких дополнительных циклов. Она, правда, медленная и требует много ресурсов, но зато программа простая.
Стало понятнее?


Автор: Екатерина7 11.12.2009 16:22

ммм. да, это поняла.. такой вопрос: то, что выводится в результатах, Done:... квадрат с буквами, это и есть наш лист бумаги , разбитый на прямоугольники? и несовсем пойму,что за колонки букв в начале с цифрами (это тоже в результатах) , это набор , из которого строятся прямоугольники ниже?

Автор: Lapp 11.12.2009 17:33

Цитата(Екатерина7 @ 11.12.2009 12:22) *
что выводится в результатах, Done:... квадрат с буквами, это и есть наш лист бумаги , разбитый на прямоугольники?
Да.

Цитата
что за колонки букв в начале с цифрами (это тоже в результатах) , это набор , из которого строятся прямоугольники ниже?
Да, строИтся. Не прямоугольники, а квадрат.
m - число прямоугольников
a - размер по x
b - размер по y
ab - произведение a*b (площадь)
s - сумма площадей, которая в конце должна сравняться с n2 (площадь квадрата)

Автор: Екатерина7 11.12.2009 19:31

а почему Done выводится одно и тоже бесконечное количество раз, программа зацикливается кажется.. как сделать выход из рекурсии? или не нужно?

Добавлено через 5 мин.
большие заглавные буквы латинские, это ячейки , в смысле эти прямоугольники , которые мы подбираем. так?

Добавлено через 1 мин.
еще вопрос) а почему вначале параметров а,b,s,там 14 ?там же вроде как квадрат 8*8..

Автор: Lapp 12.12.2009 2:10

Цитата(Екатерина7 @ 11.12.2009 15:31) *
а почему Done выводится одно и тоже бесконечное количество раз,
Не бесконечное, а просто очень большое. Потому что много способов есть собрать квадрат. Если найден один - значит, есть по крайней мере 8 уже (в силу симметрий: поворот и отражение). А в этой программе вообще два прямоугольника с одинаковыми параметрами рассматриваются как разные. Там этих способов тысячи и тысячи.

Цитата
программа зацикливается кажется..
Прежде чем делать подобные упреки в ошибках, дай себе труд подумать. Спрашивать - одно, делать ТАКИЕ выводы - другое.. norespect.gif

Цитата
как сделать выход из рекурсии?
Нажать Esc. Если хочешь ограничиться выводом одной конфигурации - отработай Halt после вывода квадрата.

Цитата
большие заглавные буквы латинские, это ячейки , в смысле эти прямоугольники , которые мы подбираем. так?
Одна буква - один прямоугольник. Можно отмечать цветом (четырьмя цветами) - но это другая задача..

Цитата
еще вопрос) а почему вначале параметров а,b,s,там 14 ?там же вроде как квадрат 8*8..
Какое еще 14? я не могу видеть, что там у тебя на экране - слишком далеко. НУ НЕУЖЕЛИ так трудно скопировать? Или словами объяснить поточнее.. Почему я тебе все стараюсь как можно яснее говорить, а ты - в основном намеками? Все, Кать, я устал и обиделся. Это был мой последний пост в этой теме.
Успехов тебе.

Автор: Екатерина7 12.12.2009 13:17

результаты выполнения:

a=2 b=2 ab=4 s=32
a=1 b=2 ab=2 s=34
a=2 b=1 ab=2 s=36
a=1 b=1 ab=1 s=37
a=2 b=1 ab=2 s=39
a=2 b=1 ab=2 s=41
a=2 b=2 ab=4 s=45
a=2 b=2 ab=4 s=49
a=2 b=1 ab=2 s=51
a=2 b=2 ab=4 s=55
a=2 b=2 ab=4 s=59
a=2 b=1 ab=2 s=61
a=2 b=1 ab=2 s=63
a=1 b=1 ab=1 s=64

Done 1
ABBCDE FG
HI I I J J MM
KKL LN O OP
KKQQR R SU
T TVVV V V_
WWXXY Y Z_
[ [ [ [ [ [ \_
[ [ ] ] ^ ^^_







Автор: Lapp 12.12.2009 15:19

Цитата(Екатерина7 @ 12.12.2009 9:17) *
результаты выполнения:
Это неполный результат.
14 строчек получилось потому, что остальные уехали за верх экрана (и, в частности, количество прямоугольников m). Число m (оно же количество строк с a, b, ab и s) в данном случае заведомо больше 26, поскольку букв латинского алфавита не хватило и в картинке задействованы небуквенные символы. Советую перестать пользоваться допотопным полноэкранным режимом. Окомпилируй программу в exe-файл и запусти его в обычном скроллируемом cmd-окне (в его свойствах поставь размер прокрутки побольше). А про окно 80х25 давно пора забыть..

Еще совет: уменьши размер квадрата. Попробуй, скажем, 6х6. Там, думаю, букв должно хватить.

Добавлено через 6 мин.
Но тут какая-то лажа..
Цитата(Екатерина7 @ 12.12.2009 9:17) *

[ [ [ [ [ [ \_
[ [ ] ] ^ ^^_

- так быть не может. Ты уверена, что при копировании не изменила ничего? Ты не вручную ли копировала??..

Чтобы скопировать из дос-окна, кликни правой кнопкой на верхней полоске, выбери Редактировать и Пометить (если я правильно перевел), затем пометь и снова кликни правой кнопкой..

Автор: Екатерина7 12.12.2009 21:17

нет, не в ручную.. все печатала.. хорошо, проверю.

Автор: Екатерина7 13.12.2009 14:19

а что делает function Overlap?

Автор: Екатерина7 13.12.2009 16:38

я задала n=6, все получается нормально, без вот этого
[ [ [ [ [ [ \_
[ [ ] ] ^ ^^_

Автор: Lapp 14.12.2009 5:54

Цитата(Екатерина7 @ 13.12.2009 12:38) *
я задала n=6, все получается нормально, без вот этого
[ [ [ [ [ [ \_
[ [ ] ] ^ ^^_
Катюш, дело не в том, что там не буквы. Дело в том, что левые (открывающие) скобки там идут углом (я выделяю красным):

[ [ [ [ [ [ \_
[ [ ] ] ^ ^^_

Если это на самом деле так - плохо. Надо мне искать ошибку.
Я не могу воспроизвести эти результаты. Проверь, плз. Спасибо.

Автор: Екатерина7 15.12.2009 3:52

так там не должно быть этих скобок? или они должны быть красным? что-то у меня ничего не выделяется.. ничего не пойму:(

Добавлено через 1 мин.
я проверяла.. все так же , как я и написала.. результаты такие же..
ааааа.. эти скобочки не должны быть углом?

Автор: Lapp 15.12.2009 4:20

Цитата(Екатерина7 @ 14.12.2009 23:52) *
ааааа.. эти скобочки не должны быть углом?
Конечно, не должны. Какой же это тогда прямоугольник? blink.gif
Похоже, ты еще не усвоила общей идеи..

так что - углом они?

Автор: Екатерина7 15.12.2009 13:41

да, если n брать =8, добавляются скобочки и они углом, как и выше нарисовано

Автор: Unconnected 15.12.2009 17:00

У меня при N=8 первая комбинация такая получается (скопировал из cmd):

Код
a= 2     b= 2     ab=   4     s=  32
a= 1     b= 2     ab=   2     s=  34
a= 2     b= 1     ab=   2     s=  36
a= 1     b= 1     ab=   1     s=  37
a= 2     b= 1     ab=   2     s=  39
a= 2     b= 1     ab=   2     s=  41
a= 2     b= 2     ab=   4     s=  45
a= 2     b= 2     ab=   4     s=  49
a= 2     b= 1     ab=   2     s=  51
a= 2     b= 2     ab=   4     s=  55
a= 2     b= 2     ab=   4     s=  59
a= 2     b= 1     ab=   2     s=  61
a= 2     b= 1     ab=   2     s=  63
a= 1     b= 1     ab=   1     s=  64
Done   1
ABBCDEFG
HIICJJLG
KKMNOOLP
KKQQRRST
UVVWRRST
XX_WYYZZ
XX[[YY\\
]][[^^\\


Угла из скобок нет.

Автор: Екатерина7 15.12.2009 23:49

все, получается. да

Добавлено через 7 мин.
идея понятна.. несовсем пойму расположение этих бкув и символов. точнее почему кое-где по одной букве.. она считается за прямоугольник?

Автор: Lapp 16.12.2009 4:51

Цитата(Unconnected @ 15.12.2009 13:00) *
У меня при N=8 первая комбинация такая получается (скопировал из cmd):
...
Угла из скобок нет.
Спасибо, Unconnected. Я все никак не мог добраться до машины с ТР.
+1 тебе. Еще раз спасибо smile.gif


Цитата(Екатерина7 @ 15.12.2009 19:49) *
все, получается. да
Так зачем тогда было говорить то, чего нет? blink.gif

Цитата
почему кое-где по одной букве.. она считается за прямоугольник?
Конечно. А чем он провинился?.. Не дорос?.. В условии нет границы снизу на размер.

Автор: Екатерина7 16.12.2009 11:33

потому что сначала не получалось..(

Добавлено через 6 мин.
а можно процедуру Put пошагово объяснить, конкретнее,если можно.. blush.gif
и что такое Inc(k);

Добавлено через 1 мин.
tRectangle, tLocation это какой-то тип?

Автор: Lapp 16.12.2009 14:03

Цитата(Екатерина7 @ 16.12.2009 7:33) *
потому что сначала не получалось..(
Что не получалось? Так были скобки углом или не были? Как же трудно от тебя получить ответ на простейший вопрос..

Цитата
а можно процедуру Put пошагово объяснить, конкретнее,если можно..
Можно, конечно. Перечитай пост #45 ( http://forum.pascal.net.ru/index.php?s=&showtopic=25019&view=findpost&p=140035 ). Я не хочу копипастить его сюда. Более конкретно - на более конкретные вопросы..

Цитата
и что такое Inc(k);
Inc(x) эквивалентно x:=x+1 .

Цитата
tRectangle, tLocation это какой-то тип?
Да, типы. Смотри программный код, а также пост #6 ( http://forum.pascal.net.ru/index.php?s=&showtopic=25019&view=findpost&p=139358 ).

Автор: Екатерина7 23.12.2009 1:56

а для чего вот это?
const
r0: tRectangle=(a:1; b:1);
l0: tLocation=(x: 0; y: 0);

что такое r0 и l0?

Добавлено через 4 мин.
еще хотела спросить, а что делает эта функция
function Overlap(r1: tRectangle; l1: tLocation; r2: tRectangle; l2: tLocation): boolean;
begin
Overlap:=
(Abs(l2.x*2+r2.a-l1.x*2-r1.a) < r1.a+r2.a) and
(Abs(l2.y*2+r2.b-l1.y*2-r1.b) < r1.b+r2.b)
end;

var
r: array[1..n*n+10]of tRectangle;
l: array[1..n*n+10]of tLocation;
s,i,m,k,done: integer;
t: tRectangle;
u: tLocation;
Clear: boolean;



Добавлено через 16 мин.
function Overlap- эта функция проверяет пересекаются ли прямоугольники?

Автор: Unconnected 23.12.2009 2:25

Цитата
const
r0: tRectangle=(a:1; b:1);
l0: tLocation=(x: 0; y: 0);


Объявление переменных r0 и l0 типами tRectangle и TLocation соответственно (только почему-то он сделал это в секции констант). Сразу же эти переменные инициализируются, т.е. им присваиваются начальные значения (вот эти части: "=(a:1; b:1);=(x: 0; y: 0);").

Цитата

еще хотела спросить, а что делает эта функция
function Overlap(r1: tRectangle; l1: tLocation; r2: tRectangle; l2: tLocation): boolean;


Ну нифига себе... Мы тут, понимаешь, на первой странице этого топа способы проверки на пересечение двух прямоугольников придумывали, а она и не заметила..))

Цитата

var
r: array[1..n*n+10]of tRectangle;
l: array[1..n*n+10]of tLocation;
s,i,m,k,done: integer;
t: tRectangle;
u: tLocation;
Clear: boolean;


Секция описания переменных, тут всё должно быть понятно.

Автор: Екатерина7 23.12.2009 2:52

заметила. а что такое NoOne?

Добавлено через 9 мин.
например, вот тут

Код
begin
  if y<=n then begin
    li.x:=x;
    li.y:=y;
    NoOne:=true;

или тут
Код
for j:=1 to m do if l[j].x>0 then Clear:=Clear and not Overlap(r[i],li,r[j],l[j]);
          if Clear then begin
            Inc(k);
            l[i]:=li;
            if k<>m then Put(x mod n+1,y+x div n);
            l[i]:=l0;
            Dec(k);
            NoOne:=false
          end
        end;
        j:=a;
        a:=b;
        b:=j;
      end
    end;
    if NoOne then Put(x mod n+1,y+x div n)
  end
end;

Автор: Unconnected 23.12.2009 3:04

Ну, насколько я понял, NoOne - булевая переменная, обеспечивающая условие выхода из рекурсии. Т.е. если рекурсивная функция находит очередной вариант, то рекурсивно вызывается эта же функция с изменёнными параметрами, иначе рекурсия кончается.

Условие выхода из рекурсии:

    if NoOne then Put(x mod n+1,y+x div n)


Автор: Екатерина7 23.12.2009 3:07

я так поняла, что function Overlap(r1: tRectangle; l1: tLocation; r2: tRectangle; l2: tLocation): boolean; -функция, которая выдает True, если прямоугольники пересекаются и False,если нет. так? только если честно, этого я в программе не вижу, в смысле где именно это описывается..

Добавлено через 1 мин.
ааа.. спасибо большое!

Добавлено через 5 мин.
можешь еще объяснить хотя бы в кратце, что делает procedure JustSet; {подготовка входных данных}
вот тут

with t do repeat
a:=Random(k)+1;
b:=Random(k)+1;
q:=s+a*b;
if q<=n*n then begin
Inc(m);
r[m]:=t;
l[m]:=u;
s:=q
end
until s=n*n
end;


Добавлено через 1 мин.
blush.gif

Автор: Lapp 23.12.2009 9:58

Цитата(Екатерина7 @ 22.12.2009 23:07) *
я так поняла, что function Overlap(r1: tRectangle; l1: tLocation; r2: tRectangle; l2: tLocation): boolean; -функция, которая выдает True, если прямоугольники пересекаются и False,если нет. так? только если честно, этого я в программе не вижу, в смысле где именно это описывается..
Это не описывается. Это делается внутри самой функции. Алгоритм я подробно объяснил в одном из постов, посмотри выше.

Цитата
можешь еще объяснить хотя бы в кратце, что делает procedure JustSet; {подготовка входных данных}
конечно.
Это просто случайный выбор набора прямоугольников с условием, что их суммарная площадь равна площади квадрата (ну и каждая сторона не превосходит стороны квадрата). То, что из них действительно можно составить квадрат - не гарантируется (поэтому название JustSet - ПростоНабор).
with t do repeat
// случайным образом выбираем размеры прямоугольника
a:=Random(k)+1;
b:=Random(k)+1;
// вычисляем общую сумму площадей
q:=s+a*b;
// если она меньше, чем площадь разрезаемого квадрата - прямоугольник годится, записываем его в набор
if q<=n*n then begin
Inc(m); // увеличиваем число прямоугольников в наборе
r[m]:=t; // записывем прямоугольник в набор
l[m]:=u; // приписываем ему нулевое положение (означает, что он не положен внутрь квадрата)
s:=q // запоминаем новое значение суммарной площади
end
until s=n*n // до тех пор, пока суммарная площадь не сравняется с площадбю квадрата
end;

Автор: Екатерина7 23.12.2009 20:01

спасибо всем огромное, кто принимал участие в решении этой задачи!!! good.gif