Доброго всем утра!
Попалась задача: дано дерево, в узлах которого записаны неповторяющиеся числа. Задача: вывести в выходной файл зеркальное отражение дерева. При этом во входном файле дерево может быть записано двумя способами: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.
Нажмите для просмотра прикрепленного файлаНажмите для просмотра прикрепленного файлаНажмите для просмотра прикрепленного файла

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

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

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

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

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

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

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

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

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

В общем, вот немного отредактированная процедура 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.

Заметишь еще баги - говори...

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

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

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

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

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

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

Оговорки:
1. Я сильно полагаюсь на корректность данных, которая в программе не проверяется. Если в данных ошибка (граф зациклен, например) - результат непредсказуем.
2. Я ничуть не заботился об экономии времени и ресурсов. Но это исправимо при желании

{Зеркальное отражение графа с упорядочиванием}
{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, ты забыл Rewrite(f), будет ошибка №103

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

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

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

retail prices for cialis