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

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

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

> Черно-белые деревья, программа перевода изображения в строку чисел и обратного преобразован
Слай
сообщение 17.11.2007 13:46
Сообщение #1


Новичок
*

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

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


Требуется написать программу перевода изображения в строку чисел и обратного преобразования — строки чисел в изображение.

Входные данные

Файл содержит описание одного или нескольких изображений. Все изображения — это квадратные рисунки, длины сторон квадратов — целые числа, являющиеся степенями двойки. Входной файл начинается с целого числа n, где |n| — длина стороны квадрата (|n| < 64). Если число n больше 0, то затем следует |n| строк по |n| знаков в строке, заполненных 0 и 1. При этом 1 соответствует черному цвету. Если n меньше 0, то затем следует описание изображения в виде строки из десятичных чисел, оканчивающейся -1. Полностью черному квадрату соответствует строка из одного 0. Белый квадрат кодируется пустой строкой (ничего не вводится). Признаком конца входного файла является значение n, равное 0.

Выходные данные

Для каждого изображения из входного файла выводится его номер. В том случае, когда изображение задается с помощью 0 и 1, в выходной файл записывается его представление в виде строки десятичных чисел. Числа в строке сортируются в порядке возрастания. Для изображений, содержащих больше 12 черных областей, после каждых 12 чисел вывод начинается с новой строки. Количество черных областей выводится после строки из десятичных чисел. В том случае, когда изображение задается строкой из десятичных чисел, в выходной файл записывается его представление в виде квадрата, в котором символ ‘.’ соответствует 0, а символ ‘*’ — 1. Пример входного и выходного файлов приведен в таблице.


Входной файл Выходной файл
===============================================================
8 Изображение 1
0 0 0 0 0 0 0 0 9 14 17 22 23 44
0 0 0 0 0 0 0 0 63 69 88 94 113
0 0 0 0 1 1 1 1 Общее число черных областей 11
0 0 0 0 1 1 1 1
0 0 0 1 1 1 1 1
0 0 1 1 1 1 1 1
0 0 1 1 1 1 0 0
0 0 1 1 1 0 0 0
===============================================================
-8 Изображение 2
. . . . . . . .
9 14 17 22 23 44 . . . . . . . .
63 69 88 94 113 -1 . . . . * * * *
. . . . * * * *
. . . * * * * *
. . * * * * * *
. . * * * * . .
. . * * * . . .

================================================================
2 Изображение 3
0 0 Общее число черных областей 0
0 0
================================================================
-4 Изображение 4
0 -1 * * * *
* * * *
* * * *
* * * *
================================================================



Вот мои попытки:


Program Black_White_Trees;

{type SolveA = procedure;}
{type SolveB = procedure;}
Var N, NumTest: integer;
{Cp -- massiv, opisyvayuw'ij izobrazhenie}

Var A : Array [1..64, 1..64] of integer;

{===================== CHTENIE MASSIVA =====================}
Procedure ReadA;
Var i,j: integer;
Var N,M: integer;
BEGIN
{Assign(Input,'Input.txt'); Reset(Input);}
for i:=1 to N do
for j:=1 to M do
begin
Read(A[i,j])
end;
{Close(Input);}
END;

Procedure PrintA;
Var i,j: integer;
Var N,M: integer;
BEGIN
for i:=1 to N do
for j:=1 to M do
begin
Write(A[i,j])
end;
END;

Procedure PrintB;
Var i,j: integer;
Var N,M: integer;
BEGIN
for i:=1 to N do
for j:=1 to M do
begin
Write(A[i,j])
end;
END;

Function RecA(i,j,d:integer;Way:string):boolean;
var k:integer; c:boolean;
begin
if d=1 then c:=A[i,j]
else begin k:=d div 2;
c:=RecA(i,j,k,'1'+Way) and
RecA(i,j+k,k,'2'+Way) and
RecA(i+k,j,d,'3'+Way) and
RecA(i+k,j+k,d,'4'+Way);
IF c then Dec(Cnt,4);
END;
if c then begin Inc(Cnt) ;
Cp[Cnt]:=<Bygaga>
end;
RecA:=c;
End;

{SORTIROVKA_MASSIVA}
Procedure Sort(num: integer);
var V: array [1..64] of integer;
Var i,j,x: integer;
begin
for i:=2 to num do begin
x:=V[i];
j:=i;
while((x<V[j-1])and(j>0)) do begin
V[j]:=V[j-1];
j:=j-1;
end;
V[j]:=x;
end;
end;

Procedure SolveA;
Var i,Cnt:integer;
BEGIN
ReadA; {Chtenie isxodnogo massiva iz fajla}
Cnt:=0;
IF RecA(1,1,N,'') then begin Cnt:=1;
Cp[Cnt]:=0; end;
Sort;
PrintA;
END;

Function Fr5To10(S:String):LongInt;
Var Res:LongInt;
i:integer;
begin
Res:=0;
For i:=1 to Length(S) do
Res:=Res*5+Ord(S[i])-Ord('0');
Fr5To10:=Res;
End;

Procedure SolveB;
Var i:LongInt;
Begin
FillChar(A,SizeOf(A),False);
Read(i);
While i<>-1 Do Begin
RecB(1,1,-N,Fr10To5(i));
Read(i);
End;
PrintB;
End;

Function Fr10ToB(S:LongInt):LongInt;
var d, Res:LongInt;
Begin
Res:=0; d:=1;
While S<>0 Do Begin
Res:=Res+(S Mod 5)*d;
d:=d*10;
S:=S div 5;
End;
Fr10To5:=Res;
End;

Procedure RecB(i,j,d:Integer; Way:LongInt);
Var k,r:Integer;
Begin
If Way=0 Then
For k:=i To i+d-1 Do
For r:=j To j+d-1 Do A[k,r]:=true
Else Begin
k:=Way Mod 5-1;
r:=d div 2;
RecB(i+r*(k Div 2),j+r*(k Mod 2),r,Way Div 10);
End;
End;





Begin
Assign(Input,'Input.txt'); Reset(Input);
Assign(Output,'Output.txt'); Rewrite(Output);
Readln(N);
NumTest:=0;
WHILE N<>0 do begin
Inc(NumTest);
Writeln('Image',NumTest);
IF N>0 then SolveA else SolveB;
END;
Close(Input);
Close(Output);
End.




Прошу помочь собрать программку, то есть связать все процедуры, пожалуйста.))
Надеюсь на помощь. Заранее спасибо.

Сообщение отредактировано: Слай - 17.11.2007 19:25
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов(1 - 5)
Слай
сообщение 18.11.2007 13:53
Сообщение #2


Новичок
*

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

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


up
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Malice
сообщение 18.11.2007 14:29
Сообщение #3


Профи
****

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

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


Цитата(Слай @ 18.11.2007 13:53) *

up

Явно не полное условие, нигде не описан прицип, откуда берутся эти 9, 14, 17 и т.д. Или с этим разобрался уже ? Если да, то не понятно что требуется..
зы на олимпиадную смахивает, не хватает тока ограничивающих условий по памяти и времени выполнения smile.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Слай
сообщение 18.11.2007 15:12
Сообщение #4


Новичок
*

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

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


ТУТ можно посмотреть информацию по задаче.

А принцип получения этих чисел мне понятен))

Сообщение отредактировано: Слай - 18.11.2007 15:16
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Слай
сообщение 19.11.2007 18:36
Сообщение #5


Новичок
*

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

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


up
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Malice
сообщение 19.11.2007 18:57
Сообщение #6


Профи
****

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

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


Ну а что, уп.. Если, как ты говоришь, ты понял принцып, то все просто. Для начала попробуй это скомпилировать, добавь описания недостающих переменных (например глобально cnt, cp..). Как скомпилится пробуй исправлять логические ошибки. Например в процедуре
Procedure PrintA;
Var i,j: integer;
Var N,M: integer;
BEGIN
for i:=1 to N do
for j:=1 to M do
begin
Write(A[i,j])
end;
END;

явно видно, что после описания переменных N и M они используются не инициализируемыми, а должны быть равны размеру матрицы (первому числу в исходном файле). Ну и в таком духе, стобы не осталось строк типа:
      c:=A[i,j]; {, когда с - boolean, а a[i,j]-integer;}

и таких тоже:
      Cp[Cnt]:=<Bygaga>
smile.gif

Сообщение отредактировано: Malice - 19.11.2007 18:58
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 



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