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

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

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

 
 Ответить  Открыть новую тему 
> Дерево в зеркальном отражении
сообщение
Сообщение #1


Пионер
**

Группа: Пользователи
Сообщений: 61
Пол: Женский
Реальное имя: Jekaterina Lauce

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


Доброго всем утра!
Попалась задача: дано дерево, в узлах которого записаны неповторяющиеся числа. Задача: вывести в выходной файл зеркальное отражение дерева. При этом во входном файле дерево может быть записано двумя способами: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 килобайт ) Кол-во скачиваний: 697
Прикрепленный файл  testiPD4.zip ( 2.69 килобайт ) Кол-во скачиваний: 211
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






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

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


Пионер
**

Группа: Пользователи
Сообщений: 61
Пол: Женский
Реальное имя: Jekaterina Lauce

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


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

Если сказать честно, у нас лекций как таковых с примерами на эти темы не было, а на лету не получается ухватить идею и реализовать.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Пионер
**

Группа: Пользователи
Сообщений: 61
Пол: Женский
Реальное имя: Jekaterina Lauce

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


blink.gif mega_chok.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Гость






Ну, вот такой набросок попробуй использовать:
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 килобайт ) Кол-во скачиваний: 167
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Пионер
**

Группа: Пользователи
Сообщений: 61
Пол: Женский
Реальное имя: Jekaterina Lauce

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


Большое спасибо! Буду пробовать. С наступающим Новым годом!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Гость






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.
Заметишь еще баги - говори...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Пионер
**

Группа: Пользователи
Сообщений: 61
Пол: Женский
Реальное имя: Jekaterina Lauce

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


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

Есть еще одна проблема-нам не позволяют писать свои модули, поскольку программы отсылаем на специальный тестирующий сервер.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Пионер
**

Группа: Пользователи
Сообщений: 61
Пол: Женский
Реальное имя: Jekaterina Lauce

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


Может быть, все-таки эта задача решается без указателей? Строки немного напоминают перестановки.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Гость






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


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

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

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


Цитата(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)

Сообщение отредактировано: Lapp -


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


Гость






Lapp, ты забыл Rewrite(f), будет ошибка №103 blum.gif
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


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

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

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


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

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

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

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


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


Пионер
**

Группа: Пользователи
Сообщений: 61
Пол: Женский
Реальное имя: Jekaterina Lauce

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


give_rose.gif Спасибо, буду изучать.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





- Текстовая версия 19.09.2020 20:27
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name