![]() |
1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!
![]() ![]() |
![]() |
Lapp |
![]()
Сообщение
#21
|
![]() Уникум ![]() ![]() ![]() ![]() ![]() ![]() ![]() Группа: Модераторы Сообщений: 6 823 Пол: Мужской Реальное имя: Лопáрь (Андрей) Репутация: ![]() ![]() ![]() |
функция для определения пересечений есть, остаётся перебирать?) Перебирать что? Входных данных пока еще нет..Можно, конечно, полагать, что это забота не наша, а проверяющего задание, но как тогда отлаживаться? И, в любом случае, как ни крути, нужно все же договориться о формате ввода.. Я все же предлагаю подумать о том, как подготовить (ну и в какой форме сохранить) входной набор прямоугольников. И еще одна просьба: не гоните, дайте автору темы хотя бы отреагировать и задать вопросы.. -------------------- я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой |
Lapp |
![]()
Сообщение
#22
|
![]() Уникум ![]() ![]() ![]() ![]() ![]() ![]() ![]() Группа: Модераторы Сообщений: 6 823 Пол: Мужской Реальное имя: Лопáрь (Андрей) Репутация: ![]() ![]() ![]() |
Кать, если тебе не актуально уже, ты скажи.
А если такими темпами, то и к следующему пнд не будет готово. С чем загвоздка? Если что-то неясно - спрашивай. -------------------- я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой |
Екатерина7 |
![]()
Сообщение
#23
|
Новичок ![]() Группа: Пользователи Сообщений: 43 Пол: Женский Репутация: ![]() ![]() ![]() |
да,Lapp, с математикой все понятно.. да и с кусочком программы вроде бы тоже..)
Добавлено через 2 мин. извиняюсь,у меня пару дней с инетом проблемы были,не могла ответить..(( все нормально..вроде бы понятно.. все остается так же актуальным.. Добавлено через 9 мин. входные данные- параметры прямоугольников,как говорил Unconnected.так? |
Lapp |
![]()
Сообщение
#24
|
![]() Уникум ![]() ![]() ![]() ![]() ![]() ![]() ![]() Группа: Модераторы Сообщений: 6 823 Пол: Мужской Реальное имя: Лопáрь (Андрей) Репутация: ![]() ![]() ![]() |
входные данные- параметры прямоугольников,как говорил Unconnected.так? Да, так. Вопрос, как. ![]() По условию, у нас должен быть на входе набор прямоугольников, из которого заведомо можно построить квадрат, поскольку "Лист бумаги в клетку квадратной формы размера NxN произвольно разрезан на прямоугольные части, каждая из которых имеет целое число клеток". Если такой набор приложен к условию, то наша задача облегчается (Катя, ты спроси преподавателя - может, у него есть такой). Если нет - то надо его сначала сделать, то есть нам нужно имплементить способ разрезания квадрата. Либо.. У набора, из которого можно построить квадрат есть одно обязательное свойство: сумма всех клеток всех его прямоугольников равна количеству клеток в квадрате, то есть N*N. Но это не есть достаточное условие. Предположим, мы создали набор прямоугольников (со стороной не больше, чем N), и сумма их площадей (клеток) равна N*N (это сделать нетрудно - легче, чем разрезать). Далее, наша будущая программа попытается собрать из них квадрат. Если у нее это получается, то она выдает ответ: "квадрат собрать можно" (и, может быть, порядок сборки). Если же все ее попытки заканчиваются ничем. то она говорит: "квадрат собрать невозможно". То, что я предложил выше - это видоизменение условия. Я не знаю, насколько такие зменения допустимы. Поэтому я предлагаю: Катя, спроси преподавателя: 1. существует ли набор входных данных для проверки? Если да, то где его взять и в каком он формате. 2. если нет, то возможно ли вместо повторной сборки просто брать случайный набор (с суммарной площадью N*N) и говорить, можно ли из него собрать квадрат (с выдачей порядка сборки в случае удачи). Либо спроси, либо сама скажи, что делать, потому что от этого зависит программа. Ok? ![]() -------------------- я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой |
Екатерина7 |
![]()
Сообщение
#25
|
Новичок ![]() Группа: Пользователи Сообщений: 43 Пол: Женский Репутация: ![]() ![]() ![]() |
набора входных данных нет.. думаю, что можно брать вместо повторной сборки просто случайный набор..
|
Lapp |
![]()
Сообщение
#26
|
![]() Уникум ![]() ![]() ![]() ![]() ![]() ![]() ![]() Группа: Модераторы Сообщений: 6 823 Пол: Мужской Реальное имя: Лопáрь (Андрей) Репутация: ![]() ![]() ![]() |
думаю, что можно брать вместо повторной сборки просто случайный набор.. Хорошо. Ну, давай тогда делать случайный набор. Создать и записать в файл square.dat в таком формате: длина и ширина на одной строке; строк стролько, сколько прямоугольников.Сможешь сделать? -------------------- я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой |
Екатерина7 |
![]()
Сообщение
#27
|
Новичок ![]() Группа: Пользователи Сообщений: 43 Пол: Женский Репутация: ![]() ![]() ![]() |
если честно, несовсем:( у меня с этим возникли трудности.. вооюще затрудняюсь начать..
|
Lapp |
![]()
Сообщение
#28
|
![]() Уникум ![]() ![]() ![]() ![]() ![]() ![]() ![]() Группа: Модераторы Сообщений: 6 823 Пол: Мужской Реальное имя: Лопáрь (Андрей) Репутация: ![]() ![]() ![]() |
Ну, начать я тебе помогу
var
s,q: integer;
t: tRectangle;
f: text;
begin
s:=0; {сумма всех клеток}
m:=0; {количество прямоугольников}
with t do repeat
...
Можешь продолжить? -------------------- я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой |
Екатерина7 |
![]()
Сообщение
#29
|
Новичок ![]() Группа: Пользователи Сообщений: 43 Пол: Женский Репутация: ![]() ![]() ![]() |
наверно нет.. затрудняюсь.. в написанном могу разобраться.. а так..
|
Unconnected |
![]()
Сообщение
#30
|
![]() mea culpa ![]() ![]() ![]() ![]() ![]() Группа: Пользователи Сообщений: 1 372 Пол: Мужской Реальное имя: Николай Репутация: ![]() ![]() ![]() |
Екатерина7, ты какой курс, если не секрет?
Просто, видимо, у тебя практики мало было. Очень мало. А тут раз - и рекурсия с квадратами... -------------------- "Знаешь, стыдно - когда не видно, что услышал всё, что слушал.."
|
Екатерина7 |
![]()
Сообщение
#31
|
Новичок ![]() Группа: Пользователи Сообщений: 43 Пол: Женский Репутация: ![]() ![]() ![]() |
не секрет- 4-й.. да.. нас плохо научили программир.. первые курсы особенно.. вот так все и пошло.. сейчас более менее с остальным стараюсь разбираться, а вот эту задачу не могу сделать..(
|
Екатерина7 |
![]()
Сообщение
#32
|
Новичок ![]() Группа: Пользователи Сообщений: 43 Пол: Женский Репутация: ![]() ![]() ![]() |
![]() |
klem4 |
![]()
Сообщение
#33
|
![]() Perl. Just code it! ![]() ![]() ![]() ![]() ![]() ![]() Группа: Модераторы Сообщений: 4 100 Пол: Мужской Реальное имя: Андрей Репутация: ![]() ![]() ![]() |
Перебор с рекурсией, код неважнецкий, но работает
{$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";'
|
Lapp |
![]()
Сообщение
#34
|
![]() Уникум ![]() ![]() ![]() ![]() ![]() ![]() ![]() Группа: Модераторы Сообщений: 6 823 Пол: Мужской Реальное имя: Лопáрь (Андрей) Репутация: ![]() ![]() ![]() |
Перебор с рекурсией, код неважнецкий, но работает Круто, Клёма! ![]() Я седни попожжее выложу свой тож тогда. -------------------- я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой |
klem4 |
![]()
Сообщение
#35
|
![]() Perl. Just code it! ![]() ![]() ![]() ![]() ![]() ![]() Группа: Модераторы Сообщений: 4 100 Пол: Мужской Реальное имя: Андрей Репутация: ![]() ![]() ![]() |
Код 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";'
|
Unconnected |
![]()
Сообщение
#36
|
![]() mea culpa ![]() ![]() ![]() ![]() ![]() Группа: Пользователи Сообщений: 1 372 Пол: Мужской Реальное имя: Николай Репутация: ![]() ![]() ![]() |
А теперь возникает вопрос: с какой вероятностью Екатерине7 поверят, что она это писала сама?
![]() -------------------- "Знаешь, стыдно - когда не видно, что услышал всё, что слушал.."
|
Екатерина7 |
![]()
Сообщение
#37
|
Новичок ![]() Группа: Пользователи Сообщений: 43 Пол: Женский Репутация: ![]() ![]() ![]() |
поверят, я постараюсь разобраться))
Добавлено через 3 мин. проверим потом на практике с какой вероятностью)) |
Lapp |
![]()
Сообщение
#38
|
![]() Уникум ![]() ![]() ![]() ![]() ![]() ![]() ![]() Группа: Модераторы Сообщений: 6 823 Пол: Мужской Реальное имя: Лопáрь (Андрей) Репутация: ![]() ![]() ![]() |
проверим потом на практике с какой вероятностью)) Если бы я принимал, она бы стремилась к нулю )). И все же желаю успехов (особенно в "разобраться").Выкладываю свой код тоже. Я хотел выделить подготовку начальных данных в отдельную прогу и писать их в файл, но не сделал.. 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.
Катя, ты спрашивай больше. Не стесняйся ![]() Добавлено через 4 мин. klem4, зачем отключил $R ? -------------------- я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой |
volvo |
![]()
Сообщение
#39
|
Гость ![]() |
Цитата klem4, зачем отключил $R ? Ну, так со включенным-то работать не будет ![]() |
klem4 |
![]()
Сообщение
#40
|
![]() Perl. Just code it! ![]() ![]() ![]() ![]() ![]() ![]() Группа: Модераторы Сообщений: 4 100 Пол: Мужской Реальное имя: Андрей Репутация: ![]() ![]() ![]() |
К сожалению не знаю как еще дин. массивы в таком виде с fpc подружить
![]() -------------------- perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
|
![]() ![]() |
![]() |
Текстовая версия | 19.07.2025 4:08 |