IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

4 страниц V < 1 2 3 4 >  
 Ответить  Открыть новую тему 
> рекурсия- разбиение и сборка квадрата
Lapp
сообщение 28.11.2009 14:44
Сообщение #21


Уникум
*******

Группа: Модераторы
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


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

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

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


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Lapp
сообщение 30.11.2009 6:25
Сообщение #22


Уникум
*******

Группа: Модераторы
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


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


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Екатерина7
сообщение 30.11.2009 7:38
Сообщение #23


Новичок
*

Группа: Пользователи
Сообщений: 43
Пол: Женский

Репутация: -  0  +


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

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

Добавлено через 9 мин.
входные данные- параметры прямоугольников,как говорил Unconnected.так?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Lapp
сообщение 30.11.2009 9:26
Сообщение #24


Уникум
*******

Группа: Модераторы
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


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

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

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

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

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

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




--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Екатерина7
сообщение 30.11.2009 14:20
Сообщение #25


Новичок
*

Группа: Пользователи
Сообщений: 43
Пол: Женский

Репутация: -  0  +


набора входных данных нет.. думаю, что можно брать вместо повторной сборки просто случайный набор..
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Lapp
сообщение 2.12.2009 7:39
Сообщение #26


Уникум
*******

Группа: Модераторы
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


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


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Екатерина7
сообщение 2.12.2009 18:03
Сообщение #27


Новичок
*

Группа: Пользователи
Сообщений: 43
Пол: Женский

Репутация: -  0  +


если честно, несовсем:( у меня с этим возникли трудности.. вооюще затрудняюсь начать..
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Lapp
сообщение 2.12.2009 18:12
Сообщение #28


Уникум
*******

Группа: Модераторы
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


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

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

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

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


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Екатерина7
сообщение 4.12.2009 14:59
Сообщение #29


Новичок
*

Группа: Пользователи
Сообщений: 43
Пол: Женский

Репутация: -  0  +


наверно нет.. затрудняюсь.. в написанном могу разобраться.. а так..
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Unconnected
сообщение 4.12.2009 22:33
Сообщение #30


mea culpa
*****

Группа: Пользователи
Сообщений: 1 372
Пол: Мужской
Реальное имя: Николай

Репутация: -  24  +


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

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



--------------------
"Знаешь, стыдно - когда не видно, что услышал всё, что слушал.."
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Екатерина7
сообщение 4.12.2009 23:42
Сообщение #31


Новичок
*

Группа: Пользователи
Сообщений: 43
Пол: Женский

Репутация: -  0  +


не секрет- 4-й.. да.. нас плохо научили программир.. первые курсы особенно.. вот так все и пошло.. сейчас более менее с остальным стараюсь разбираться, а вот эту задачу не могу сделать..(
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Екатерина7
сообщение 5.12.2009 16:03
Сообщение #32


Новичок
*

Группа: Пользователи
Сообщений: 43
Пол: Женский

Репутация: -  0  +


wacko.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
klem4
сообщение 6.12.2009 17:02
Сообщение #33


Perl. Just code it!
******

Группа: Модераторы
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


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

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



--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Lapp
сообщение 6.12.2009 19:34
Сообщение #34


Уникум
*******

Группа: Модераторы
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


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


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
klem4
сообщение 6.12.2009 21:07
Сообщение #35


Perl. Just code it!
******

Группа: Модераторы
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


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


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

Код

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



--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Unconnected
сообщение 6.12.2009 21:26
Сообщение #36


mea culpa
*****

Группа: Пользователи
Сообщений: 1 372
Пол: Мужской
Реальное имя: Николай

Репутация: -  24  +


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


--------------------
"Знаешь, стыдно - когда не видно, что услышал всё, что слушал.."
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Екатерина7
сообщение 6.12.2009 21:51
Сообщение #37


Новичок
*

Группа: Пользователи
Сообщений: 43
Пол: Женский

Репутация: -  0  +


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

Добавлено через 3 мин.
проверим потом на практике с какой вероятностью))
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Lapp
сообщение 6.12.2009 22:36
Сообщение #38


Уникум
*******

Группа: Модераторы
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


Цитата(Екатерина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(c)
    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 ?


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 6.12.2009 23:43
Сообщение #39


Гость






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


Perl. Just code it!
******

Группа: Модераторы
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


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


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

4 страниц V < 1 2 3 4 >
 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 

- Текстовая версия 19.07.2025 4:08
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"