Developing.ru

Код: Выделить всё

Program TreeIO;
USES CRT;

TYPE
  ukaz=^uzel;
  uzel=record
         name: string;     {имя вершины}
         Date: STRING;     {Дата статьи}
         left,right: ukaz; {сыновья}
         fath: ukaz;       {отец в исходном дереве}
         urov: integer;    {уровень исходного дерева, начиная с 0}
         Flag: boolean;    {признак последнего сына}
       end;
Var
  result: STRING;
  t,kon,root,p: ukaz;
  i,k,m,Len: integer;
  S, R, D, D1: string;
  Fin,Fout: text;
  Delims: STRING;
function strtok(var s:string;delims:string):string;
{Функция разбивает строку s на слова, разделенные символами-разделителями,
указанными в строке delims. Функция возвращает первое найденное слово, при
этом из строки s удаляется начальная часть до следующего слова}
var res:string; state:byte; i:integer;
begin
  state:=1;
  res:='';
  if s='' then
  begin
    result:='';
    exit;
  end;
  while pos(s[state],delims)<>0 do
  begin
    inc(state);
    if state>length(s) then
    begin
      s:='';
      result:='';
      exit;
    end;
  end;
  while pos(s[state],delims)=0 do
  begin
     res:=res+s[state];
     inc(state);
     if state>length(s) then
     begin
       s:='';
       result:=res;
       exit;
     end;
  end;
  while pos(s[state],delims)<>0 do
  begin
    inc(state);
    if state>length(s) then
    begin
      s:='';
      result:=res;
      exit;
    end;
  end;
  delete(s,1,state-1);
  result:=res;
end;
Begin
  CLRSCR;
  BEGIN
    Assign(Fin,'tree.txt');
    Reset(Fin);
    New(root);
    ReadLn(Fin,S);
    root^.name:=S;
    root^.urov:=0;
    root^.Flag:=true; {признак последнего сына-для корня не обязательно}
    root^.fath:=nil;  {отец}
    m:=0;             {уровень вершины}
    t:=root;          {предыдущая вершина для следующей в файле}
    While not Eof(Fin) do
      begin
        ReadLn(Fin,S);
        k:=0;
        Len:=Length(S);
        While S[k+1]='.'
        do
          k:=k+1;   {k-уровень вершины, начиная с 0}
        R:=Copy(S,k+1,Len-k);         {имя вершины}
        New(kon);
        kon^.name:=R;
        kon^.left:=nil;
        kon^.right:=nil;
        kon^.urov:=k;
        if k>m then               {переход на следующий уровень}
          begin
            t^.left:=kon;
            kon^.fath:=t;
            kon^.Flag:=true;      {признак последнего сына}
          end
        else
          if k=m then             {тот же уровень}
            begin
              t^.right:=kon;
              kon^.fath:=t^.fath; {отец тот же, что у брата}
              t^.Flag:=false;     {снятие признака последнего сына}
              kon^.Flag:=true;    {признак последнего сына}
            end
          else                    {подъем по дереву на m-k уровней}
            begin
              p:=t;
              For i:=1 to m-k do
                p:=p^.fath;
              {p-предыдущая вершина того же уровня}
              kon^.fath:=p^.fath; {отец в исходном дереве тот же, что у брата}
              p^.right:=kon;
              p^.Flag:=false;     {снятие признака последнего сына}
              kon^.Flag:=true;    {признак последнего сына}
            end;
        m:=k;       {запомнили текущий уровень}
        t:=kon;     {для работы со следующей вершиной}
      end;          {конец While}
    Close(Fin);
  END;
End.