int21h

Roztažení textu

Každý rok přicházejí noví studenti na fakultu elektrotechniky ČVUT - tedy na FEL. V prvním semestru mají základy programování a zmatení programátorští panicové mají se poprvé seznamují s programovacími jazyky prostřednictvím starého dobrého pascalu. Pak bohužel přecházejí na nové a nové jazyky a tudíž se žádný nenaučí pořádně. Výukové úlohy se příliš neobměňují, a proto se na diskuzních fórech o programování každoročně setkáváme se stejnými žádostmi o pomoc.
V tomto článku rozeberu jeden z nejtypičtějších problémů - roztažení řetězce.
Zadání doslova zní: "Napište a odlaďte funkci, která formátuje řetězec na zadanou šířku pomocí vkládání mezer mezi slova."
V zadání je "pomocí vkládání mezer" - tudíž se nebudeme zabývat případy, že uživatel si ve skutečnosti přeje řetězec scuknout. To bychom totiž mezery ubírali a nikoli přidávali :-)
Úloha není tak blbá, jak by se zdálo, neboť tu vyvstává klasické dilema rychlost vs. jednoduchost programu.
Napřed se podíváme na toto řešení:

Function XMezer(i:byte):string;
var a:byte;
    s:string;
begin
s:='';
for a:=1 to i do s:=s+' ';
XMezer:=s;
end;


Function Expand(var s:string;delka:byte):boolean;
var a,b,l:byte;
    m,n:boolean;
begin
l:=Length(s);
if l>delka then begin Expand:=false;Exit;end;
Expand:=true;
if l=delka then Exit;


n:=false;                   {je ve vyrazu alepon jedna mezera?}
repeat
   m:=false;
   a:=1;
   repeat
      if (s[a]=' ') and (m=false) then
         begin
         m:=true;
         n:=true;           {ve vyrazu je alespon jedna mezera}
         insert(' ',s,a);
         inc(l);
         if l=delka then Exit;
         end else m:=false;
      inc(a);
   until a>l;
until n=false;              {nastane budto v prvnim pruchodu nebo nikdy}


s:=s+Xmezer(delka-l);
end;


var retezec:string;
    delka:byte;
begin
writeln('Napis vetu:');
readln(retezec);


writeln('Na kolik znaku ji mam roztahnout?');
readln(delka);


if Expand(retezec,delka)
   then
   writeln(retezec)
   else
   writeln('Sorry vole, error!');
readln;
end.  

Jak procedura Expand pracuje?
Napřed zkontroluje nekorektně zadaný vstup a možnost, že řetězec už není třeba roztahovat. Dále následuje vlastní algoritmus.
1) od začátku do konce procházím řetězec a hledám mezeru.
2) když ji najdu, tak

a) zaznamenám si, že v řetězci je alespoň jedna mezera
b) přidám, ještě jednu mezeru a zkontroluju, jestli je délka řádku už dosáhla požadované hodnoty. Když ano, tak jsme hotovi. Když ne, tak začnu hledat první znak, který není mezera
3) jakmile jsem na znaku, který není mezera, tak znovu začnu hledat další mezeru.
4) Jestliže jsem se během tohoto procesu dostal na konec řetězce, tak si zkontroluju, jestli jsem doposud na nějakou mezeru vůbec narazil. Když ne, tak na konec řetězce připojím potřebný počet mezer a máme hotovo.
Jestliže nějaké mezery byly, tak skočím na bod 1.

Algoritmus je velice jednoduchý, ale tím, že se mnohokrát znovu a znovu prochází celý řetězec, tak není moc rychlý. Ideální by bylo, projít řetězec poprvé a zjistit počet slov. Pak rozpočítat kolik mezer přidat do každého "mezisloví". A projít ho podruhé a daný počet mezer doplnit.
Bohužel, takový algoritmus je o poznání složitější:

Function XMezer(i:byte):string;
var a:byte;
    s:string;
begin
s:='';
for a:=1 to i do s:=s+' ';
XMezer:=s;
end;


Function ZjistiPocetSlov(s:string):byte;
var a,b:byte;
begin
a:=0;
repeat
a:=a+1;
b:=Pos(' ',s);
if b=0 then begin ZjistiPocetSlov:=a;Exit;end;
delete(s,1,b-1);
while (s[1]=' ') and (Length(s)>1) do delete(s,1,1);
until s='';
ZjistiPocetSlov:=a;
end;


Procedure UpravRetezec(var s:string;x,y:byte);
var a,b:byte;
begin
{Prochazet zepredu nebo zezadu? Je to vec nazoru - ja rad zezadu}
a:=Length(s);
repeat
while s[a]<>' ' do if a>1 then dec(a) else Exit; {najde prvni mezeru odzadu}
if y>0 then begin b:=x+1;dec(y);end else b:=x;   {vyjasnime si, kolik mezer pridame}
Insert(Xmezer(b),s,a+1);                         {pridani jedne davky mezer}
while s[a]=' ' do if a>1 then dec(a) else Exit;  {presun k dalsimu slovu}
until 1=2;
end;


Function Expand(var s:string;delka:byte):boolean;
var l,n:byte;
    u,x,y:byte;
begin
{ tady by jeste mela byt rutina na pripadne odrezani pocatecnich a koncovych mezer }
l:=Length(s);
if delkathen begin Expand:=false;Exit;end;


Expand:=true;
if delka=l then Exit;
n:=ZjistiPocetSlov(s);


u:=delka-l;     { O kolik mezer chceme retezec prodlouzit }


if n=1 then begin s:=s+XMezer(u);Exit;end; { Jestli je v retezci jenom 1 slovo, tak akorat pridam mezery }


{dale pokracujeme, jestlize je retezec alespon ze dvou slov}


{procedu rozpocet, kolik mezer se bude za kazde slovo doplnovat}
x:=u div (n-1);      { jednak za kazde slovo pridame X mezer }
y:=u mod (n-1);      { druhak v Y pripadech pridame jeste 1 mezeru navic }
UpravRetezec(s,x,y); {jdeme na to!}
end;


var retezec:string;
    delka:byte;
begin
writeln('Napis větu:');
readln(retezec);


writeln('Na kolik znaku ji mam roztahnout?');
readln(delka);


if Expand(retezec,delka)
   then
   writeln(retezec)
   else
   writeln('Sorry vole, error!');


readln;
end.  

Myslím, že tady je dostatek komentářů přímo ve zdrojáku a všechno je jasné.
A je to. Doufám, že na FELu vydržíte a že u pascalu zůstanete. Je to skvělý jazyk!

DOS-u-akbar!