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;
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;
var a,b,c,d:byte;
e:shortint;
begin
a:=Length(s1);
b:=Length(s2);
if a<b then c:=a else c:=b;
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
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;
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;
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;
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
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;
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
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;
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;
if sysTridiciTbl^[256]=1 then
begin
poms1:=s1;
poms2:=s2;
z1:=Nahrad_ch(s1,c);
z2:=Nahrad_ch(s2,c);
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;
if e=0
then CmpString:=b>=a
else CmpString:=e>0;
if sysTridiciTbl^[256]=1 then
begin
if Z1 then s1:=poms1;
if Z2 then s2:=poms2;
end;
end;