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

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

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

Любое - какое? Например, случаи N=10 и N=100 могут оказаться существенно разными..
Пожалуйста, уточни верхний предел.

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

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

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

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, какие у тебя соображения на этот счет?

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

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

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

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

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

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

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;

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

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

volvo,


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

Добавлено через 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;

Это тоже сути не меняет, функция как не работала, так и не работает:

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, это ты специально функцию переназвал?

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

Я написал такой код, принцип у него другой, нежели у первого, но вот почему-то в конце массивов не координаты а чушь какая-то вперемешку с ними, и на введённых данных тоже 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.

Случайно

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

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

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

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

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

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

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

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

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

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

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

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

Нажмите для просмотра прикрепленного файла

|C₂ - C₁| <= L₁/2 + L₂/2

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

( 2*|Cx₂-Cx₁| <= Lx₁ + Lx₂ ) /\ ( 2*|Cy₂-Cy₁| <= Ly₁ + Ly₂ )


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


Ну вот, теперь можно переходить к программированию..
Я немного изменил названия переменных - извиняюсь за это, просто я тогда поспешил. Для однообразия лучше иметь вместо 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 )).

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

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

Добавлено через 11 мин.


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

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


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

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

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

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

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

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

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

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

Да, так. Вопрос, как.

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

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

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

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

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

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

Хорошо. Ну, давай тогда делать случайный набор. Создать и записать в файл square.dat в таком формате: длина и ширина на одной строке; строк стролько, сколько прямоугольников.
Сможешь сделать?

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

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

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

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

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

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

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

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

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

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

{$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.

Круто, Клёма! А как ты задаешь начальные данные?
Я седни попожжее выложу свой тож тогда.

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

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

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

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

Если бы я принимал, она бы стремилась к нулю )). И все же желаю успехов (особенно в "разобраться").

Выкладываю свой код тоже. Я хотел выделить подготовку начальных данных в отдельную прогу и писать их в файл, но не сделал..

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.

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

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

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

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

спасибо, Lapp)

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

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

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

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

Ты задумывайся, никто не против. Это без ограничений. А вот, прежде чем флудить - .. еще раз задумайся ))

Совершенно согласен.

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

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

Это был общий принцип. Теперь, как это организовано.
Процедура 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) и делаем все то же самое с повернутым.
Все.

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

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

Да.

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

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

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

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

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

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

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

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

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

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

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_
[ [ [ [ [ [ \_
[ [ ] ] ^ ^^_