uses crt, {az assignscrt()-hez kell} dos {FSearch()};
{31. Adott egy binaris fa lancolt abrazolassal.
Keszitsd el a folytonos abrazolasu változatat!
Ezt ird is ki! Pl.:
A fat billentyuzetrol igy add meg:
   a b   a c   b d   b e   c f.
Epitsd fol a lancolt abrazolasu fat, majd konvertald a masik abrazolasuva!
A folytonos abrazolasu fa kiiraskor: /KBJ/ - /BKJ/
   a b d e c 0 f vagy d e b 0 f c a ...}

const nmax=100; {egy tombnek max. ennyi eleme lehet}
type Tindex=integer; Tertek=char;
     Tstatfa= array [1..nmax] of Tertek;
     Tmutrec=array[1..nmax] of TIndex;
     Trec=record
            ertek:tertek;
            m:tmutrec;
        end;
     Ttomb=array [1..nmax] of trec;
     Tvalaki=string[2];
     Tlancfa=^tlancfaRec;
     TlancfaRec=record
               os:tlancfa;
               ertek:tertek;
               balmut:tlancfa;
               jobbmut:tlancfa;
        end;
var fbe,fki:text;
    stf:Tstatfa; lcf:Tlancfa;
    hiba:boolean; {tlancfa}

Procedure sfanullaz(var tomb:tstatfa);
var i:integer;
begin for i:=1 to nmax do tomb[i]:='0'; end;

Procedure ugrnullaz(var ugrtomb:array of integer);
var i:integer;
begin for i:=1 to nmax do ugrtomb[i]:=0; end;

Function Vege(const lfa:tlancfa):boolean;
begin
if ((lfa^.balmut=nil) and (lfa^.jobbmut=nil) {es nincs testvere})
  then vege:=true
  else if not( (ord(lfa^.ertek) in [64..90]) or  (ord(lfa^.ertek) in [97..122]))
  {((ofs(lfa^.balmut)=0) and (ofs(lfa^.jobbmut)=0) )}
    then vege:=true
    else vege:=false;
end;

Procedure hatvanyoz(const mit,mire:integer; var hvsv:integer);
var hvi:integer;
begin hvsv:=mit; for hvi:=1 to mire do hvsv:=hvsv*mit; end;

{--rokonsagi fv-k--}
Function Szulo(const n:Tindex):Tindex;
begin szulo:=( n-(n mod 2) ) div 2; end;

Function Balgyerek(const n:Tindex):Tindex;
begin Balgyerek:=2*n; end;

Function Jobbgyerek(const n:Tindex):Tindex;
begin Jobbgyerek:=(2*n)+1; end;

Function Gyokere(lf:Tlancfa):boolean;
begin gyokere:=(lf^.os=nil); end;

Procedure NedikOs(const lfa:tlancfa; n:integer; var lfn:tlancfa);
var i:integer;
begin lfn:=lfa^.os; for i:=1 to (n-1) do lfn:=lfn^.os; end;

Procedure NedikRokon(const n:integer; elem:tlancfa; var rokon:tlancfa);
var i:integer;
begin
  nedikos(elem,n,rokon);
  rokon:=rokon^.jobbmut;
  for i:=1 to (n-1) do rokon:=rokon^.balmut;
end;

Procedure FaElejere(const lfa:tlancfa; var svfa:tlancfa; hiba:boolean);
begin
  svfa:=lfa; while not(svfa^.os=nil) do svfa:=svfa^.os;
end;

Procedure BKJ_keres(const lfa:tlancfa; er:tertek; var ezaz:tlancfa);
begin
  if lfa^.ertek=er then ezaz:=lfa
  else
    if not(vege(lfa))
      then begin if (lfa^.ertek<>er)
             then begin bkj_keres(lfa^.balmut,er,ezaz);
                       bkj_keres(lfa^.jobbmut,er,ezaz);
                  end;
           end; {vege(lfa)}
end;
{--rokonsagi fv-k vege--}

procedure fileinic;
var bf,kf:boolean; fc:char; fn:string; hol:string; i:byte;
begin
  writeln; writeln; writeln; writeln; writeln;
  write('File-bol olvassak? '); readln(fc);
  if (upcase(fc)='N') then bf:=false else bf:=true;
  write('File-ba irjak? '); readln(fc);
  if (upcase(fc)='N') then kf:=false else kf:=true;

  if bf=true then begin i:=1;
      repeat
        repeat
          write('Melyik file-bol (letezo, 8 kar. hosszu nevu)? ');
          readln(fn); inc(i);
        until ((length(fn)<=8) or (i=4));
        if length(fn)<=8 then begin
            fn:=fn+'.txt'; hol:=FSearch(fn,GetEnv('PATH'));
          end
        else hol:='';
      until ((i=4) or (hol<>''));
            {eleresi ut:FExpand(holvanfile)}
      if (hol<>'') then assign(fbe,fn);
      end {then}
    else assigncrt(fbe);
  if kf=true
    then begin
        repeat
          write('Melyik file-ba (max. 8 hosszu nev)? ');
          readln(fn); inc(i);
        until ((i=4) or (length(fn) in [1..8]));
        if (length(fn) in [1..8]) then begin fn:=fn+'.txt'; assign(fki,fn); end;
      end {then}
    else assigncrt(fki);
end;

procedure file2lancfa(var fb:text; var lf:tlancfa);
var sz:Tvalaki; c:string; {a sorvegi "szemethez"}
  procedure LfaBeszur(const er:tertek; irany:boolean; var lf:tlancfa);
  var svfa:tlancfa;
  begin
    {uj: ertek, gy1,gy2 os:az eddigi * regi.gyx:=uj * regi:=uj}
    new(svfa);
    if lf<>nil then begin
      svfa^.ertek:=er; svfa^.balmut:=nil; svfa^.jobbmut:=nil;
      svfa^.os:=lf;
      if (irany=false)
        then begin {bal}
               lf^.balmut:=svfa; lf:=lf^.balmut;
             end
        else begin {jobb}
               lf^.jobbmut:=svfa; lf:=lf^.jobbmut;
             end;
      hiba:=false;
    end
    else hiba:=true; {(svfa=nil)}
  end;

  procedure lfajobbbeszur(const er:tertek; irany:boolean; var lf:tlancfa);
  var svfa:tlancfa;
  begin
    new(svfa);
    if svfa<>nil then begin
      svfa^.ertek:=er;
      svfa^.os:=lf^.os; svfa^.balmut:=nil; svfa^.jobbmut:=nil;
      lf^.os^.jobbmut:=svfa;
      lf:=lf^.os^.jobbmut;
      hiba:=false;
    end
    else hiba:=true; {(svfa=nil)}
  end;
begin
  reset(fb); read(fb,sz); readln(fb,c);
  new(lf);
  if lf<>nil
    then begin
      lf^.ertek:=sz[1]; lf^.os:=nil;
      lfabeszur(sz[2],false,lf); {bal}
      read(fb,sz); readln(fb,c);
      lfajobbbeszur(sz[2],true,lf); {jobb}
      repeat
        read(fb,sz); readln(fb,c);
        faelejere(lf,lf,hiba);
        bkj_keres(lf,sz[1],lf);
        lfabeszur(sz[2],false,lf); {bal}
        read(fb,sz); readln(fb,c);
        lfabeszur(sz[2],true,lf^.os); {jobb}
      until (eof(fbe));
      hiba:=false; end
    else hiba:=true;
end;

procedure lancfa2statfa(const lfa:tlancfa; var sf:tstatfa); {szelessegi bejarassal}
var i:integer; irany:boolean; {0:bal, 1:jobb}
    melyseg:integer; {eleg lenne tombmax-ig}
    svfa:tlancfa;
    hatvany:integer; j:integer; {cv}
type tugralt=array[1..255] of integer;
var UgralTomb:tugralt;

  procedure gy_ertekad(const svfa:tlancfa);
  begin
    inc(i); sf[i]:=svfa^.balmut^.ertek;
    inc(i); sf[i]:=svfa^.jobbmut^.ertek;
  end;

  procedure UgralTFelt(const m:integer; var ugrt:Tugralt);
  var sv:string; {sv: akt+valtozas+akt (mindig a megfelelot hozzaadja)}
      akt:string; {akt: az eddigi, a valtozas nelkul}
      strsv:string; {az str() parameterezese miatt kell}
      ok:integer; {a val() parameterezese miatt kell}
      eddigivalt:integer; i,j:integer;
  begin
    akt:='1'; val(akt,Ugrt[1],ok);
    sv:=akt; i:=1; eddigivalt:=1;
    hatvanyoz(2,m,hatvany);
    while ( i<=(hatvany-1) ) do begin
      inc(i); inc(eddigivalt);
      UgrT[i]:=eddigivalt;
      str(eddigivalt,strsv); sv:=akt+strsv;
      for j:=1 to (length(sv)-1) do begin
        val(sv[j],UgrT[i+j],ok)
      end;
      i:=i+j;
      sv:=sv+akt;
      akt:=sv;
    end; {while}
  end;

  procedure ugral(const UgrT:Tugralt; var lfa:Tlancfa; const param:integer);
  var mennyitugrik:integer; k:integer; hatv:integer;
  begin
    k:=1; hatvanyoz(2,param,hatv);
    while ( k <= (hatv-1) ) do begin
      mennyitugrik:=UgrT[k];
      if (mennyitugrik=1)
        then begin
               lfa:=lfa^.os^.jobbmut; inc(k);
               if not(vege(lfa))
                 then gy_ertekad(lfa);
             end
        else begin
          {if ( svszamlal <= (hatv-1) ) then}
                 begin
                   nedikrokon(param,lfa,lfa); inc(k);
                   if not(vege(lfa))
                     then gy_ertekad(lfa);
                 end;
          end; {else}
    end; {while}
  end;

begin
  i:=1; melyseg:=1; new(svfa);
  sfanullaz(sf); ugrnullaz(ugraltomb);
  faelejere(lfa,svfa,hiba); sf[i]:=svfa^.ertek;
  ugraltfelt(melyseg-2,ugraltomb);
  gy_ertekad(svfa); svfa:=svfa^.balmut;
  {at-van-dobva, de-ertek-nelkul +tombrendebn
  ertekad; ugral; mnagyotdob +melyseg}
  while not(vege(svfa)) do begin
    if not(vege(svfa))
      then gy_ertekad(svfa); {h,i}
    ugral(ugraltomb,svfa,melyseg-1);
    inc(melyseg);
    ugraltfelt(melyseg-2,ugraltomb);
    nedikos(svfa,melyseg-1,svfa); {fel}
    {utolso sf-ertek: (h,i), de lefele nem normalisan jon vissza!}
    for j:=1 to melyseg do begin
      svfa:=svfa^.balmut; {le}
    end;
  end; {while}
end;

Procedure StatfaKiir(var fki:text; const sf:tstatfa);
  Function uresegyerek(const svsf:tstatfa; sfind:tindex; irany:boolean):boolean;
  begin
    if ( (sfind*2)>nmax ) then uresegyerek:=true
    else if ( ((sfind*2)+1)>nmax ) then uresegyerek:=true
    else
      if not( (ord(svsf[sfind]) in [65..90]) or (ord(svsf[sfind]) in [97..122]))
        then uresegyerek:=true
    {else if... -> tovabbi feltetelek}
        else uresegyerek:=false;
  end;
  Procedure KBJ_kiir(var fki:text; const svsf:tstatfa; akti:tindex);
  var bale:boolean; {a bal-gyerekerol van-e szo}
  begin
    write(fki,svsf[akti]); write(fki,' ');
    bale:=true; {bal}
    if not(uresegyerek(svsf,akti,bale))
      then kbj_kiir(fki,svsf,2*akti);
    bale:=false; {jobb}
    if not(uresegyerek(svsf,akti,bale))
      then kbj_kiir(fki,svsf,(2*akti)+1);
  end;
begin
  rewrite(fki); writeln(fki); write(fki,' ');
  kbj_kiir(fki,sf,1); {a rekurzio miatt van kulon eljarasban}
  close(fki);
end;

begin
  fileinic;
  file2lancfa(fbe,lcf);
  lancfa2statfa(lcf,stf);
  statfakiir(fki,stf);
  {beolvas_filebol(file 2 lancfa)
  konvertal (lancfa 2 statfa)

    szim_lepes:
    sf[i].ertek:=lf.akt.ertek
    sf[i].os:=sf( [i-(i mod 2)] div 2 )

    sf[i].balmut:=2*i        \
                              > lf-fuggetlen
    sf[i].jobbmut:=(2*i)+1   /
                1
         2             3
      4     5      6      7
     8 9  10 11  12 13  14 15
         szulo: [ n-(n mod 2) ] div 2
                  i----v----i
         (pl.)      10 es 11

         gyerek: 2*n es 2*n+1

  kiir_KBJ (statfa) <- az ea alapjan

  Adatszerk:
    lancfa: rekord
               (os:tlancfamut;
               ertek:tertek;
               balmut:tlancfamut;
               jobbmut:tlancfamut)
    statfa: tomb(1..nmax) of tertek
   Fv. Szulo(n:Tindex):Tindex
     szulo:=( n-(n mod 2) ) div 2
   Fv. v.
   Fv. Balgyerek(n:Tindex):Tindex   *  Fv. Jobbgyerek
    Balgyerek:=2*n                  *    Jobbgyerek:=(2*n)+1
   Fv. v.                           *  Fv. v. }
end.