рекурсия- разбиение и сборка квадрата Опции

[Екатерина7]

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

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

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

[klem4]

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

{$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(c);
        end;
        inc(r);
    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]

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

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