int21h

Abecední řazení

Úvod

Před více než deseti lety, když jsem začínal s pascalem, jsem se pokusil napsat funkce pro abecední třídění, které by dokázalo zpracovávat i české znaky.
Tehdy jsem to rozumně nedokázal napsat, tak jsem to po krátkém snažení zabalil. Od té doby jsem to vlastně nepotřeboval, takže k novému pokusu jsem se dostal až nedávno.

Tentokrát jsem ale záměr pojal velkoryseji - chtěl jsem, aby bylo možné přepínat mezi tříděními v různých normách češtiny a také aby se třídila azbuka, zkrátka, aby procedura byla jednoduše konfigurovatelná. Další požadavek je, aby se nedělal rozdíl mezi velkými a malými písmeny, t.j., aby
"auto" bylo zařazeno před "Zrno", i když ASCII(a)=97 a ASCII(Z)=90.

Úroveň 1

Postup byl vcelku jasný. V textu se může vyskytnout 256 různých znaků, takže si nadeklaruju pole o 256 bajtech, indexy do pole budou dány ASCII hodnotou znaků a hodnoty v poli budou určovat, kam budou dané ASCII znaky zařazeny.
Například pole[97{a}]=1, pole[65{A}]=1, pole[90{z}]=27 a podobně.
Spíš jde o to, jakým způsobem jednoduše takové pole nadeklarovat.
Nakonec jsem to udělal takhle:

trid_spol = '__!!##$$--00112233445566778899';
trid_czlat2 = trid_spol+'aA µbBcCĽ¬dDÔŇeE‚Ř·fFgGhHiI·ÖjJkKlLmMnNoO˘ŕpPq'+
                        'QrRýüsSçćtT¶›uUŁé…ŢvVxXyYěízZ§¦';

trid_czwin = trid_spol+'aAáÁbBcCčČdDďĎeEéÉěĚfFgGhHiIíÍjJkKlLmMnNoOóÓpPq'+
                       'QrRřŘsSšŠtTťŤuUúÚůŮvVxXyYýÝzZžŽ';

type PsortTable=^TSortTable;
TsortTable=array[0..255] of byte;

var _sysTridiciTbl:TSortTable;
    sysTridiciTbl:PSortTable;


Procedure PripravTridiciTabulku(t:string);
var a,b:byte;
begin
b:=Length(t);
if odd(b) then begin dec(b);delete(t,b,1);end; {delka retezce musi byt suda}
for a:=1 to b do sysTridiciTbl^[byte(t[a])]:=(a-1) div 2;
b:=b div 2;
for a:=0 to 255 do
    begin
    if Pos(char(a),t)=0 then
       begin
       sysTridiciTbl^[a]:=b;
       inc(b);
       if b>255 then
          b:=b;
       end;
    end;
end;

Takhle není nutno definovat všech 256 znaků, ale určím si jen ty, na kterých mi záleží.
V prvním kroku zpracuji definiční řetězec. Pozice každého znaku v definičním řetězci odpovídá abecední pozici. v třídícím poli.
Ještě před písmena jsem dal číslice a několik dalších znaků, jejichž výskyt běžně připadá do úvahy. Jelikož algoritmus očekává, že každý element má variantu velkého a malého písmene, tak musím jiné znaky než písmena uvádět dvojmo.
V druhém kroku pak přidělím abecední pozici zbylým znakům, t.j. těm, které nebyly uvedeny v definičním řetězci.
Pak už je to jednoduché. Umíme-li porovnat dva znaky a určit, který je v abecedě dál, tak umíme porovnat a utřídit i řetězce.

Function CmpChar(a,b:char):shortint;
var c,d:byte;
begin
c:=sysTridiciTbl^[byte(a)];
d:=sysTridiciTbl^[byte(b)];
if c<d then CmpChar:=1 else
if c>d then CmpChar:=-1 else CmpChar:=0;
end;


Function CmpString(var s1,s2:string):boolean;
{kdyz je dle tridici tabulky s1<=s2 vrati true, jinak false}
var a,b,c,d:byte;
    e:shortint;
begin
a:=Length(s1);
b:=Length(s2);

if a<b then c:=a else c:=b; {budeme porovnavat pocet znaku v kratsim retezci}

for d:=1 to c do
    begin
    e:=CmpChar(s1[d],s2[d]);
    if e<>0 then Break;
    end;

if e=0
   then CmpString:=b>=a {kdyz i po projiti celeho useku jsou retezce ident.}
   else CmpString:=e>0;
end;

Úroveň 2

V dalším kroku jsem chtěl, aby se písmeno (respektive spřežka)CH chovalo tak, jak jsme my Češi zvyklí. T.j. aby se řadilo mezi H a I, místo toho, aby se chovalo jako písmeno C, t.j. mezi znaky B a D.
Napřed jsem uvažoval o tom, napsat rutinu na zpracování spřežek univerzálně, ale když jsem se tak díval na stránky unicode, tak jsem zjistil, že československá "CH-anomálie" je velký unikát a vlastně jsem žádné jiné abecedu měnící spřežky nenašel.
Tudíž stačí udělat rutinu na zpracování CH jednoúčelovou a jediná konfigurovatelná věc bude to, jestli rutina bude nebo nebude použita.
V prvé řadě je třeba rozšířit definiční řetězce:

const
trid_spol = '__!!##$$--00112233445566778899';
trid__ch = #255#255;
trid_czlat2 = trid_spol+'aA µbBcCĽ¬dDÔŇeE‚Ř·fFgGhH'+trid__ch+'iI·ÖjJkKlLm'+
                        'MnNoO˘ŕpPqQrRýüsSçćtT¶›uUŁé…ŢvVxXyYěízZ§¦';

trid_czwin = trid_spol+'aAáÁbBcCčČdDďĎeEéÉěĚfFgGhH'+trid__ch+'iIíÍjJkKlLm'+
                       'MnNoOóÓpPqQrRřŘsSšŠtTťŤuUúÚůŮvVxXyYýÝzZžŽ';

trid_rudos = trid_spol+' €·˘‚Łƒ¤„ˇ…ń𦆧‡¨ˆ©‰ŞŠ«‹¬¦­Ť®ŽŻ¬ŕá‘â’ă“ä”ĺ•ć–'+
                       'ç—č˜é™ęšë›ě¶íťîžďĽ'+
                       'aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVxXyYzZ';

type PsortTable=^TSortTable;
TsortTable=array[0..{!}256{!}] of byte;

Spřežka CH bude vložena na místo trid__ch. Do znakových sad, které CH neznají, prostě nebudeme trid__ch uvádět.
Algoritmus je jednoduchý.
Zaprvé se při vstupním zpracování definičního řetězce poznamená, jestli obsahuje "CH-anomálii". To je důvod, proč jsem rozšířil typ TSortTable z 256 na 257 bajtů. Na indexu [256] je uvedeno, jestli je přítomna CH-anomálie.
Zadruhé - rutina na porovnání znaků zůstane nezměněna.
Zatřetí - při porovnávání řetězců se ve všech spřežkách CH nahradí znak "C" znakem trid__ch[1]
Kód dotčených procedur je změněn takto.

Procedure PripravTridiciTabulku(t:string);
var a,b:byte;
begin
b:=Length(t);
if odd(b) then begin dec(b);delete(t,b,1);end; {delka retezce musi byt suda}
for a:=1 to b do sysTridiciTbl^[byte(t[a])]:=(a-1) div 2;

b:=b div 2;
for a:=0 to 255 do
    begin
    if Pos(char(a),t)=0 then
       begin
       sysTridiciTbl^[a]:=b;
       inc(b);
       if b>255 then
          b:=b;
       end;
    end;

if Pos(trid__ch,t)<>0 then
   sysTridiciTbl^[256]:=1 else sysTridiciTbl^[256]:=0;
end;


Function Nahrad_ch(var s:string;c:byte):boolean;
var a:byte;
    z:boolean;
begin
z:=false;
for a:=1 to c do
    if (s[a]='c') or (s[a]='C') then
       if (a<>c) and ((s[a+1]='h') or (s[a+1]='H')) then
          begin
          s[a]:=trid__ch[1];
          z:=true;
          end;
Nahrad_ch:=z;
end;


Function CmpString(var s1,s2:string):boolean;
{kdyz je dle tridici tabulky s1<=s2 vrati true, jinak false}
var a,b,c,d:byte;
    e:shortint;
    z1,z2:boolean;
    poms1:string;
    poms2:string;

begin
a:=Length(s1);
b:=Length(s2);

if a<b then c:=a else c:=b; {budeme porovnavat pocet znaku v kratsim retezci}

if sysTridiciTbl^[256]=1 then
   begin
   poms1:=s1;
   poms2:=s2;
   z1:=Nahrad_ch(s1,c);
   z2:=Nahrad_ch(s2,c);
   end;

for d:=1 to c do
    begin
    e:=CmpChar(s1[d],s2[d]);
    if e<>0 then Break;
    end;

if e=0
   then CmpString:=b>=a {kdyz i po projiti celeho useku jsou retezce ident.}
   else CmpString:=e>0;

if sysTridiciTbl^[256]=1 then
   begin
   if Z1 then s1:=poms1;
   if Z2 then s2:=poms2;
   end;
end;

Úroveň 3

Jako poslední věc jsem chtěl zavést věc, které se říká "přirozené řazení".
Jde o způsob, jak se řadí řetězce obsahující v sobě číslice.
Drtivá většina programů provede takovéto setřídění:
FOTO1.JPG
FOTO13.JPG
FOTO15.JPG
FOTO2.JPG
FOTO9.JPG
Jednou z mála světlých výjimek je průzkumník z windows XP, který názvy setřídí takto:
FOTO1.JPG
FOTO2.JPG
FOTO9.JPG
FOTO13.JPG
FOTO15.JPG
Mnohem lepší, ne?
Znovu je potřeba upravit proceduru CmpString, aby za určitých podmínek volala nikoliv CmpChar, ale CmpNum.
Procedura CmpNum není úplně triviální. Jde o to, že nelze jednoduše zavolat proceduru Val, protože za prvé může snadno být převáděné číslo větší než pascalovské číselné typy a za druhé budou proceduru Val mást případné další znaky za číslicemi. Také je potřeba počítat s tím, že čísla mohou být uvozena nulami.
Přes všechna uvedená rizika se mi ale zdá lepší proceduru Val využít než psát svoji rutinu úplně od nuly.
Výsledek je zde.

Function CmpNum(var s1,s2:string;var d:byte;c:byte):shortint;
{Bohuzel nelze snadno pouzit proceduru VAL - selhala by u cisel s vice rady
 nez pojme longint}
var a,b:byte;
    t1,t2:string;
    w1,w2:word;
    i1,i2:integer;
begin
a:=d;
repeat
t1:=Copy(s1,a,4);
t2:=Copy(s2,a,4);

Val(t1,w1,i1);
Val(t2,w2,i2);

if (i1=0) and (i2=0) then
   begin
   if w1>w2 then begin CmpNum:=-1;Exit;end;
   if w1<w2 then begin CmpNum:=1;Exit;end;
   end;

if i1=i2 then {zde uz vime, ze i1=i2<>0}
   begin
   t1:=Copy(s1,a,i1-1);
   t2:=Copy(s2,a,i2-1);
   Val(t1,w1,i1);
   Val(t2,w2,i2);
   if w1>w2 then begin CmpNum:=-1;Exit;end;
   if w1<w2 then begin CmpNum:=1;Exit;end;
   end;

if i1<>i2 then
   begin
   if i1<>0 then begin t1:=Copy(s1,a,i1-1);Val(t1,w1,i1);end;
   if i2<>0 then begin t2:=Copy(s2,a,i2-1);Val(t2,w2,i2);end;
   if w1>w2 then begin CmpNum:=-1;Exit;end;
   if w1<w2 then begin CmpNum:=1;Exit;end;

   CmpNum:=0;
   if i1<i2 then d:=i1 else d:=i2;
   Exit;
   end;
inc(a,4);
until 1=2;
end;


Function CmpString(var s1,s2:string):boolean;
{kdyz je dle tridici tabulky s1<=s2 vrati true, jinak false}
var a,b,c,d:byte;
    e:shortint;
    z1,z2:boolean;
    poms1:string;
    poms2:string;

begin
a:=Length(s1);
b:=Length(s2);

if a<b then c:=a else c:=b; {budeme porovnavat pocet znaku v kratsim retezci}

if sysTridiciTbl^[256]=1 then  {zna tridici sada anomalii s CH?}
   begin
   poms1:=s1;
   poms2:=s2;
   z1:=Nahrad_ch(s1,c);        {"C" v "CH" nahradi zastupnym znakem}
   z2:=Nahrad_ch(s2,c);        {to same i v druhem retezci}
   end;

d:=1;
while d<=c do
    begin
    if (byte(s1[d])>=byte('0')) and (byte(s1[d])<=byte('9')) and
       (byte(s2[d])>=byte('0')) and (byte(s2[d])<=byte('9'))
       then e:=CmpNum(s1,s2,d,c)
       else e:=CmpChar(s1[d],s2[d]);
    if e<>0 then Break;
    inc(d);
    end;  {while}

if e=0
   then CmpString:=b>=a {kdyz i po projiti celeho useku jsou retezce ident.}
   else CmpString:=e>0;

if sysTridiciTbl^[256]=1 then
   begin
   if Z1 then s1:=poms1;       {probehla zamena u S1? Tak to vrat zpatky}
   if Z2 then s2:=poms2;       {to same v druem retezci}
   end;
end;