|
|
вернуться в форумProblem 1067 : I can't understand why it crash ? Please help me ! ( along with source code ) 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) ; |
|
|