Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Дерево в зеркальном отражении

Автор: Jekaterina 29.12.2006 16:08

Доброго всем утра!
Попалась задача: дано дерево, в узлах которого записаны неповторяющиеся числа. Задача: вывести в выходной файл зеркальное отражение дерева. При этом во входном файле дерево может быть записано двумя способами:1)в каждой строчке содержится информация об узле, не являющемся листом (внутренним узлом); либо 2) в записи первое число есть номер внутреннего узла, за которым выписаны дети в порядке с левой стороны в правую. Если, напр.б дан граф, как в пиложенном рисунке, то во входном файле запись его может быть и
1 2 3 4 5
3 6 7
5 8
8 9 10 11
и
5 8
3 6 7
8 9 10 11
1 2 3 4 5
В выходном файле граф выводистя подобным образом, но при условии, что внутренние узлы в порядке preoder (т.е. запись о родителе предшествует записи о ребенке). Я нашла решение задачи на с++, но очень плохо знаю этот язык. Если у кого-то будет время и желание, помогите, пожалуйста, перевести на паскаль эту программу. Прилагаю также тесты: из 8 тестов корректо выполняются 6.
Прикрепленное изображениеПрикрепленный файл  PD4.cpp ( 4.64 килобайт ) Кол-во скачиваний: 760
Прикрепленный файл  testiPD4.zip ( 2.69 килобайт ) Кол-во скачиваний: 255

Автор: volvo 29.12.2006 18:01

Самый простой (на мой взгляд) вариант - работать НЕ с таким графом, который у тебя нарисован, а вот с таким:
Прикрепленное изображение

Чувствуешь разницу? Список списков... Чтобы "развернуть" такой граф достаточно просто применить Invert (разворот списка) к каждому списку, содержащемуся в нем, и вывести результат в файл... Сможешь по любому заданному тебе представлению построить граф, или нужна помошь?

Автор: Jekaterina 29.12.2006 18:11

Нужна помощь. У меня маленький опыт программирования со списками, деревьями, стеками.

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

Автор: Jekaterina 30.12.2006 1:51

blink.gif mega_chok.gif

Автор: volvo 30.12.2006 21:35

Ну, вот такой набросок попробуй использовать:

uses list;

function fill_list(var f: text): ptlist;

function get_num(var f: text): integer;
var
X: integer;
ch: char;
begin
get_num := -1;
if not seekeof(f) then begin

ch := #0; X := 0;
while not (ch in ['0'..'9']) do read(f, ch);

while (ch in ['0'..'9']) do begin
X := X * 10 + (Ord(ch) - Ord('0'));
read(f, ch);
end;
get_num := X
end;
end;

var
X, to_find: ttype;
curr_lst, unattended, main_start: ptlist;
up, upp, was_found: ptitem;
finished: boolean;

begin
unattended := new(ptlist, init);
while not seekeof(f) do begin

curr_lst := new(ptlist, init);
while not seekeoln(f) do begin

X := get_num(f);
if X > 0 then curr_lst.append(X);

end;
readln(f);

curr_lst.print;
if not curr_lst.empty then begin
unattended.append(curr_lst^.first^.info);
unattended^.last^.sublist := curr_lst;
end;

end;

up := unattended.first;
while up <> nil do begin

to_find := up^.sublist^.first^.info;
if to_find = 1 then main_start := up^.sublist
else begin

upp := unattended^.first;
finished := false;
while (upp <> nil) and (not finished) do begin

if upp^.sublist <> up^.sublist then begin
was_found := upp^.sublist^.find(to_find);
if was_found <> nil then finished := true
else upp := upp^.next;
end
else upp := upp^.next;

end;

if finished then begin
was_found^.sublist := up^.sublist;
end;

end;


up := up^.next;
end;
fill_list := main_start;
end;

var
f: text;
p: ptlist;
begin
assign(f, 'test_7.txt'); reset(f);
p := fill_list(f);
writeln('before invert');
p^.print;
p^.invert;
writeln('after invert');
p^.print;
end.
(вместо print - использовать процедуру записи в файл значений... После Invert в списке хранится зеркальная копия)...

Программа тестировалась и корректно отработала (под корректной работой имеется в виду "правильно отобразила инвертирование дерева") с тестовыми файлами №7 и №8...

"Развивайте мысль" (С) "Кролики"


Прикрепленные файлы
Прикрепленный файл  LIST.PAS ( 3.4 килобайт ) Кол-во скачиваний: 207

Автор: Jekaterina 31.12.2006 0:16

Большое спасибо! Буду пробовать. С наступающим Новым годом!

Автор: volvo 31.12.2006 4:08

blink.gif Высокая температура сказывается... Приведенная мной выше программа делает не совсем то, что нужно... Точнее почти то, но один момент все-же упускается из вида: происходит полная инверсия списка, и первый элемент становится последним, а вот этого делать как раз не надо...

В общем, вот немного отредактированная процедура Print из модуля List, теперь она печатает результат именно так, как нужно:

procedure tlist.print;
var p: ptitem;
begin

write('(list) <');
p := first;
if assigned(p) then begin
while assigned(p^.next) do p := p^.next;
write(p^.info, ' ');
end;

p := first;
while assigned(p) and assigned(p^.next) do begin
write(p^.info, ' ');
p := p^.next
end;
writeln('>');

p := first;
while assigned(p) do begin

if p^.sublist <> nil then p^.sublist^.print;
p := p^.next;

end;

end;

...

{ основная программа сокращается до: }
begin
assign(f, 'test_8.txt'); reset(f);
p := fill_list(f);
p^.invert;
p^.print;
end.
Заметишь еще баги - говори...

Автор: Jekaterina 1.01.2007 0:28

Уважаемый Volvo, спасибо! Будете смеяться надо мной, но я до сих пор в благоговейном восхищении расшифровываю ваш код. wacko.gif На самом деле, думаю, при моем уровне до багов я доберусь приметно марту к 8-му. Скажите, а без указателей нельзя как-нибудь этот код реализовать? Мне стыдно, но для меня это слишком умное решение (в хорошем смысле).

Есть еще одна проблема-нам не позволяют писать свои модули, поскольку программы отсылаем на специальный тестирующий сервер.

Автор: Jekaterina 4.01.2007 5:52

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

Автор: volvo 4.01.2007 13:52

Интересная история получается, тебе не кажется? ТЫ, значит, в качестве решения на С++ приводишь работу с классами (что есть ООП), да еще и с названиями на непонятном большинству языке (вот вам, разбирайтесь, типа)... А когда ТЕБЕ приводят программу на Паскале (заметь, работающую программу, да и названия переменных - по английски, не разобраться очень сложно), то вдруг ООП тебя сразу перестает устраивать, и ты ищещь более легкую программу... dry.gif Чего ж ты не нашла на Сях более легкую, и не привела? Приведи, посмотрим...

Автор: Lapp 4.01.2007 14:00

Цитата(Jekaterina @ 4.01.2007 2:52) *

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

Если подходить с позиций списков, то, боюсь, без указателей нельзя sad.gif. Но это не единственный возможный подход. Использование списков помогает при решении подобных задач, но конкретно тут вполне можно обойтись. Более того, решение на основе обычных массивов тут мне показалось интересным и не вполне тривиальным..

Отражение действительно напоминает операции со строками, но лучше все же оперировать обычными числовыми массивами - отражение все равно делается в пару строчек.. smile.gif Главная изюминка в этой задаче, имхо, как ни странно - это то дополнительное условие упорядоченности. Оно заняло у меня 90% времени написания проги (которое, кстати, оказалось больше, чем я полагал).

Оговорки:
1. Я сильно полагаюсь на корректность данных, которая в программе не проверяется. Если в данных ошибка (граф зациклен, например) - результат непредсказуем.
2. Я ничуть не заботился об экономии времени и ресурсов. Но это исправимо при желании smile.gif
{Зеркальное отражение графа с упорядочиванием}
{for jekaterina by Lapp}
{Jan 3, 2007}
const
Nx=200;
Mx=200;

type
tBranch=record
Dad,Num:integer;
Kid:array[1..Mx]of integer
end;

var
n,i,j,k,r,Top:integer;
a,c:array[1..Nx]of tBranch;
b:tBranch;
f:text;
Flag:boolean;

procedure Add(p:integer);
var
i,j:integer;
begin
Inc®;
c[r]:=a[p];
with a[p] do for i:=1 to Num do for j:=1 to n-1 do if Kid[i]=a[j].Dad then Add(j)
end;


begin
Assign(f,'test-i.txt');
ReSet(f);
n:=0;
repeat
Inc(n);
with a[n] do begin
Read(f,Dad);
i:=0;
while not EoLn(f) do begin
Inc(i);
Read(f,Kid[i])
end;
Num:=i
end;
until a[n].Dad=0;
Close(f);

{Отражение}
for i:=1 to n-1 do begin
b:=a[i];
with a[i] do for j:=1 to Num do Kid[j]:=b.Kid[Num-j+1]
end;

{Упорядочивание от вершины}
for i:=1 to n-1 do begin
Flag:=false;
for j:=1 to n-1 do with a[j] do
for k:=1 to Num do Flag:=Flag or(Kid[k]=a[i].Dad);
if not Flag then Top:=i
end;
Add(Top); {рекурсивное добавление строк в упорядоченный массив}
a:=c;

Assign(f,'test-o.txt');
ReWrite(f);
for i:=1 to n do with a[i] do begin
Write(f,Dad);
for j:=1 to Num do begin
Write(f,' ');
Write(f,Kid[j])
end;
WriteLn(f)
end;
Close(f)
end.

PS
1. удалил лишний кусок кода уже после отправки; извиняюсь.
2. Добавил ReWrite(f) (замечено volvo, thnx)

Автор: volvo 4.01.2007 14:11

Lapp, ты забыл Rewrite(f), будет ошибка №103 blum.gif

Автор: Lapp 4.01.2007 14:15

Цитата(volvo @ 4.01.2007 11:11) *

Lapp, ты забыл Rewrite(f), будет ошибка №103 blum.gif

lol.gif lol.gif lol.gif
надеюсь, ты понимаешь, почему.. smile.gif
Спасибо!

Чтоб не переписывать, добавлю прямо в том мессадже..

Автор: Jekaterina 4.01.2007 14:31

give_rose.gif Спасибо, буду изучать.

Автор: do i need a doctor prescription 12.11.2021 3:43

retail prices for cialis