hdcompressutils.pas

RAY压缩是综合统计和字典方法

unit HdCompressUtils;

interface

uses
  Math,HDRecLst,HdCompress,Classes;

type
  T2Byte = array [0..1] of Byte;
  TarrayInteger = array of Integer;


function RAYCompress(const V:string):string;


implementation

function T2ByteToWord(const T:T2Byte;const LowFront:Boolean=False):Word;
//T2Byte类型转换成Word类型
var
  a1,a2:Byte;
begin
  if LowFront then
  begin
    a1:=T[1];
    a2:=T[0];
  end
  else begin
    a1:=T[0];
    a2:=T[1];
  end;
  Result:=a1;
  Result:=(Result shl 8) + a2;
end;

function WordToT2Byte(const aNum:Word;const LowFront:Boolean=False):T2Byte;//Word类型转换成T2Byte类型
var
  a1,a2:Byte;
begin
  a1:=aNum;
  a2:=aNum shr 8;
  if LowFront then
  begin
    Result[0]:=a1;
    Result[1]:=a2;
  end
  else begin
    Result[0]:=a2;
    Result[1]:=a1;
  end;
end;


function GetNewAgentCode(const List:TListAgentCode):Integer;
//找一个代表字符
var
  I:Integer;
begin
  Result:=-1;
  for I:=0 to List.Count-1 do
  begin
    if List[I].Str='' then
    begin
      Result:=I;
      Break;
    end;
  end;
end;

function GetMaxJoinFreq(const List:TListJoinCodeNum;var R:TarrayInteger;const freq:Integer=3):Boolean;
var
  M:Integer;
  I:Integer;
  Max:Integer;
begin
  Result:=False;
  M:=freq;
  for I:=0 to List.Count-1 do
  begin
    if List[I].Num>freq then
    begin
      Result:=True;
      if (List[I].Num>M) and (List[I].Num>Max) then
      begin
        Max:= List[I].Num;
        SetLength(R,1);
        R[0]:=I;
      end
      else if List[I].Num=M then
      begin
        SetLength(R,High(R)+2);
        R[High(R)]:=I;
      end;
    end;
  end;
end;

procedure RunRay(var V:string;var LZ:TarrayInteger;var PList:TListJoinCodeNum;var CList:TListAgentCode;var PC:Integer);
var
  I,GG:Integer;
  J:Integer;
  S:string;
  K,P:Integer;
  a2:TJoinCodeNum;
  
  procedure DoTrans;
  begin
    Inc(P);
    S[P]:=V[K];
    Inc(K);
  end;

begin
  for I:=0 to High(LZ) do
  begin
    J:=GetNewAgentCode(CList);
    if J>=0 then
    begin
      PAgentCode(CList.ItemsPointer[J])^.Str:=PList[LZ[I]].Str;
      SetLength(S,Length(V));
      P:=0;
      K:=1;
      while K<=Length(V) do
      begin
        if (V[K]=PList[LZ[I]].Str[1])and(K<Length(V)) then
        begin
          if V[K+1]=PList[LZ[I]].Str[2] then
          begin
            Inc(P);
            S[P]:=Chr(CList.Items[J].Code);
            Inc(K,2);
          end
          else begin
            DoTrans;
          end;
        end
        else begin
          DoTrans;
        end;
      end;
      SetLength(V,P);
      for K:=1 to P do
        V[K]:=S[K];
    end
    else Break;
  end;
  PC:=GetNewAgentCode(CList);
  for GG:=0 to 255 do
        begin
          if  GG>256 then
          begin
          end;
        end;
  S:='';
  if PC>=0 then
  begin
    PList.Clear;
    for I:=1 to Length(V) do
    begin
      SetLength(S,Length(S)+1);
      S[Length(S)]:=V[I];
      if Length(S)=2 then
      begin
        K:=PList.IndexOf(S);
        if K>=0 then
        begin
          Inc(PJoinCodeNum(PList.ItemsPointer[K])^.Num);//:=PList.Items[T].Num+1;
        end
        else begin
          a2.Str:=S;
          a2.Num:=1;
          PList.Add(a2);
        end;
        S:=V[I];
      end;
    end;
  end;
end;

function GetRuleNum(var CList:TListAgentCode):Byte;
var
  I:Integer;
begin
  I:=0;
  while I<=CList.Count-1 do
  begin
    if CList.Items[I].Str='' then
      CList.Delete(I)
    else Inc(I);
  end;
  Result:=CList.Count;
end;

function RAYCompress(const V: string): string;
var
  I,GG:Integer;
  PList:TListJoinCodeNum;
  CList:TListAgentCode;
  S:string;
  T:Integer;
  a1:TAgentCode;
  a2:TJoinCodeNum;
  LZ:TarrayInteger;
  PC:Integer;
  tmpStr:string;
  RuleNum:Byte;
  OLen:T2Byte;
begin
  PList:=TListJoinCodeNum.Create();
  CList:=TListAgentCode.Create();
  tmpStr:=V;
  S:='';
  try
    if Length(V)>=8 then
    begin
    //初始化a1，clist
      for I:=1 to 255 do
      begin
        a1.Code:=I;
        a1.Str:='';
        CList.Add(a1);
      end;
      CList.CheckSort;//排序


      for I:=1 to Length(V) do
      begin

        T:=CList.IndexOf(Ord(V[I]));
        if T>=0 then
          CList.Delete(T);
         
        SetLength(S,Length(S)+1);
        S[Length(S)]:=V[I];
        if Length(S)=2 then
        begin
          T:=PList.IndexOf(S);
          if T>=0 then
          begin
            Inc(PJoinCodeNum(PList.ItemsPointer[T])^.Num);//:=PList.Items[T].Num+1;
          end
          else begin
            a2.Str:=S;
            a2.Num:=1;
            PList.Add(a2);
          end;
          S:=V[I];
        end;
      end;
      for GG:=0 to 255 do
        begin
          if  GG>256 then
          begin
          end;
        end;
      PC:=GetNewAgentCode(CList);
      while GetMaxJoinFreq(PList,LZ) and (PC>=0) do
      begin
        RunRay(tmpStr,LZ,PList,CList,PC);
      end;
    end;
    if tmpStr=V then
      RuleNum:=0
    else RuleNum:=GetRuleNum(CList);
    SetLength(Result,4+Length(TmpStr)+3*RuleNum);
    Result[1]:=Chr($BB);
    Result[2]:=Chr(RuleNum);
    OLen:=WordToT2Byte(Length(V));
    Result[3]:=Chr(OLen[0]);
    Result[4]:=Chr(Olen[1]);
    for I:=1 to Length(TmpStr) do
      Result[4+I]:=TmpStr[I];
    T:=4+Length(TmpStr);
    for I:=0 to RuleNum-1 do
    begin
      Result[T+3*I+1]:=Chr(CList[I].Code);
      Result[T+3*I+2]:=CList[I].Str[1];
      Result[T+3*I+3]:=CList[I].Str[2];
    end;

//    Memo3.Clear;
//    for I:=0 to PList.Count-1 do
//    begin
//      Memo3.Lines.Add(StrToHexStr(PList[I].Str)+'='+IntToStr(PList[I].Num));
//    end;
//
//    Memo2.Clear;
//    Memo2.Lines.BeginUpdate;
//    for I:=0 to CList.Count-1 do
//    begin
//      Memo2.Lines.Add(IntToHex(CList[I].Code,2));
//    end;
//    Memo2.Lines.EndUpdate;

  finally
    CList.Free;
    PList.Free;
  end;
//  A:=@(V[1]);

//  Memo3.Clear;
//  for I:=0 to Length(V)-1 do
//  begin
//    Memo3.Lines.Add(IntTostr(A^));
//    Inc(A);
//  end;
end;

function InTable(const Str:string;const CList:TListAgentCode):Boolean;
var
  I:Integer;
begin
  Result:=False;
  for I:=1 to Length(Str) do
  begin
    if CList.IndexOf(Ord(Str[I]))>=0 then
    begin
      Result:=True;
      Break;
    end;
  end;
end;

procedure GoTransTable(var Str:string;const CList:TListAgentCode);
var
  I:Integer;
  S1:string;
  P1,P2:Integer;
begin
  SetLength(S1,2*Length(Str));
  P1:=0;
  for I:=1 to Length(Str) do
  begin
    P2:=CList.IndexOf(Ord(Str[I]));
    if P2>=0 then
    begin
      Inc(P1,2);
      S1[P1-1]:=CList.Items[P2].Str[1];
      S1[P1]:=CList.Items[P2].Str[2];
    end
    else begin
      Inc(P1);
      S1[P1]:=Str[I];
    end;
  end;
  SetLength(Str,P1);
  for I:=1 to P1 do
    Str[I]:=S1[I];
end;


end.