end;
При сжатии символа мы находим его узел в дереве. Затем мы выполняем переходы вверх по дереву, сохраняя соответствующие биты в стеке (левой связи соответствует нулевой бит, а правой - единичный). По достижении корневого узла можно вытолкнуть биты из стека. Они определят код символа (в коде, приведенном в листинге 11.19, в качестве стека используется короткая строка).
Затем выполняется скос родительского узла по направлению к корневому узлу. Мы не выполняем скос к корню самого узла символа ввиду того, что требуется сохранить размещение символов в узлах листьев. В противном случае было бы совершенно исключено, чтобы код одного символа становился началом кода следующего. Скос родительского узла повлечет 'перетаскивание' вместе с ним и дочернего узла. В результате чаще используемые символы окажутся ближе к верхушке дерева.
Листинг 11.19. Методы EncodeByte и stSplay
procedure TSplayTree.EncodeByte(aBitStream : TtdOutputBitStream;
aValue : byte)/
var
NodeInx : integer;
ParentInx : integer;
RevCodeStr : ShortString;
BitString : TtdBitString;
begin
{начиная с узла aValue, сохранить на каждом шаге (0) бит при перемещении вверх по дереву по левой связи и (1) бит при перемещении по правой связи}
RevCodeStr := 1 ';
NodeInx := aValue + 255;
while (NodeInx <> 0) do
begin
ParentInx := FTree[NodeInx].hnParentInx;
inc(RevCodeStr[0]);
if (FTree[ParentInx].hnLeftInx = NodeInx) then
RevCodeStr[length(RevCodeStr)] := f0' else
RevCodeStr[length(RevCodeStr)] := ' 11;
NodeInx := ParentInx;
end;
{преобразовать строковый код в строку битов}
stConvertCodeStr(RevCodeStr, BitString);
{записать строку битов в поток битов}
aBitStream.WriteBits(BitString);
{выполнить скос узла}
stSplay(aValue + 255);
end;
procedure TSplayTree.stConvertCodeStr(const aRevCodeStr : ShortString;
var aBitString : TtdBitString);
var
ByteNum : integer;
i : integer;
Mask : byte;
Accum : byte;
begin
{подготовиться к выполнению цикла преобразования}
ByteNum := 0;
Mask := 1;
Accum := 0;
{преобразовать порядок следования битов на противоположный}
for i := length (aRevCodeStr) downto 1 do
begin
if (aRevCodeStr[i] = '1') then
Accum := Accum or Mask;
Mask := Mask shl 1;
if (Mask = 0) then begin
aBitString.bsBits[ByteNum] := Accum;
inc(ByteNum);
Mask := 1;
Accum :- 0;
end;
end;
{сохранить биты, расположенные слева от текущего}
if (Mask <> 1) then
aBitString.bsBits [ByteNum] := Accum;
{сохранить двоичный код в массиве кодов}
aBitString.bsCount := length(aRevCodeStr);
end;
procedure TSplayTree.stSplay(aNodeInx : integer);
var
Dad : integer;
GrandDad : integer;
Uncle : integer;
begin
{выполнить скос узла}
repeat
{извлечь родительский узел данного узла}
Dad := FTree[aNodeInx].hnParentInx;
{если родительский узел является корневым, задача выполнена}
if (Dad= 0) then
aNodeInx := 0
{в противном случае необходимо выполнить поворот узла на 90 градусов с целью его перемещения вверх по дереву}
else begin
{извлечь родительский узел родительского узла}
GrandDad := FTree[Dad].hnParentInx;
{выполнить поворот на 90 градусов (т.е. поменять мечтами узел и его узел-дядю)}
if (FTree[GrandDad].hnLeftInx = Dad) then begin
Uncle := FTree[GrandDad].hnRightInx;
FTree[GrandDad].hnRightInx := aNodeInx;
end
else begin
Uncle := FTree[GrandDad].hnLeftInx;
