ENG  RUSTimus Online Judge
Online Judge
Задачи
Авторы
Соревнования
О системе
Часто задаваемые вопросы
Новости сайта
Форум
Ссылки
Архив задач
Отправить на проверку
Состояние проверки
Руководство
Регистрация
Исправить данные
Рейтинг авторов
Текущее соревнование
Расписание
Прошедшие соревнования
Правила
вернуться в форум

Обсуждение задачи 1067. Структура папок

Problem 1067 : I can't understand why it crash ? Please help me ! ( along with source code )
Послано Nguyen Viet Bang 11 июн 2002 15:10

CONST
     INP                =               '1067.inp';
     OUT                =               '1067.out';
     maxtro             =               10000 ;

TYPE
     st1                =               string[9] ;

VAR
  last,tro,n     :       integer;
  s     :       string ;
  rec   :       array[0..maxtro] of ^st1;
  dad   :       array[0..maxtro] of integer;

PROCEDURE               ReadInput;
  begin
    assign (input,inp);
    reset(input);
    assign (output,out) ;
    rewrite (output) ;

    readln ( n) ;
  end;

PROCEDURE               readbuf ;
  begin
    readln (s) ;
    while  (s[length(s)] in [#10,#13] ) do delete(s,length(s),1) ;
  end ;

PROCEDURE               get (var dir : st1 ) ;
  begin
    dir:='';
    while s[1] = '\' do delete (s,1,1) ;
    while (s[1] <> '\') and (s <> '') do
      begin
        dir:=dir + s[1] ;
        delete(s,1,1) ;
      end ;
  end ;

FUNCTION                recognize ( i: integer ) : boolean ;
  begin
    recognize:=false ;
    if last <> 0 then
      begin
        if dad[i] = last then recognize:=true ;
      end
    else
      recognize:=true ;
  end ;

FUNCTION                getpos ( dir : st1 ) : integer ;
  var
    i,l,r,mid           :       integer ;
  begin
    getpos:=0 ;
    l:=1 ; r:=tro ; mid:=0 ;
    while l <= r do
      begin
        mid:= (l+r) div 2 ;
        if (rec[mid]^ = dir)  then break ;
        if dir > rec[mid]^ then l:=mid+1
        else r:=mid-1 ;
      end ;

    l:=mid ; if l = 0 then exit ;
    while (rec[l]^ = dir) do
    begin
      if recognize ( l ) then
        begin
          getpos:=l ; exit ;
        end ;
      dec (l) ;
    end ;

    l:=mid ;
    while rec[l]^ = dir do
    begin
      if recognize ( l ) then
        begin
          getpos:=l ; exit ;
        end ;
      inc(l) ;
    end ;
  end ;

FUNCTION                findcache ( dir : st1 ) : integer ;
  var
    l,r,mid             :       integer ;
  begin
    l:=1 ; r:=tro ;
    while l <= r do
      begin
        mid := (l+r) div 2 ;
        if dir > rec[mid]^ then l:=mid+1
        else r:=mid-1 ;
      end ;
    findcache:=(l+r) div 2 ;
  end ;

FUNCTION                newpos ( dir : st1 ) : integer ;
  var
    i,j           :       integer ;
  begin
    j:= findcache ( dir ) ;
    for i:=1 to tro do
      if dad[i] > j then inc(dad[i]) ;
    if last > j then inc (last) ;

    for i:=tro downto j+1 do
      begin
        rec[i+1]:=rec[i] ;
        dad[i+1]:=dad[i] ;
      end ;
    new (rec[j+1]) ;
    rec[j+1]^:=dir ;
    dad[j+1]:=0 ;
    newpos:=j+1 ;
    inc (tro) ;
  end ;

PROCEDURE               makelink ( j : integer ) ;
  begin
    if last <> 0 then
      begin
        dad[j]:=last ;
      end ;
    last:=j ;
  end ;

PROCEDURE               analys ;
  var
    dir         :       st1 ;
    j           :       integer ;
  begin
    last:=0 ;
    repeat
      get ( dir ) ;
      j:=getpos (dir) ;
      if j = 0 then j:= newpos ( dir ) ;
      makelink (j) ;
    until s = '';
  end ;

PROCEDURE               xuly ;
  var
    i           :       integer ;
  begin
    tro:=0 ;
    fillchar (dad,sizeof(dad),0) ;
    for i:=1 to n do
      begin
        readbuf ;
        analys ;
      end ;

  end;

PROCEDURE               spread ( i,ccc  : integer ) ;
  var
    j           :       integer ;
  begin
    for j:=1 to ccc do write(' ') ;
    writeln(rec[i]^) ;
    for j:=1 to tro do
      if dad[j] = i then
        begin
          spread ( j,ccc+1) ;
        end ;
  end ;

PROCEDURE               Writeoutput ;
  var
    i           :       integer ;
  begin
    for i:=1 to tro do
      if dad[i] = 0 then
        begin
          spread ( i,0 ) ;
        end ;

    close (output);
    close (input) ;