寻求压缩算法

Question

要求：高效率压缩字符串
原字符串长度在600到700字节左右，全部为0到9的数字组成，要求压缩后的字符串大小不大于120字节，压缩速度慢些没关系

Answer 1

哈夫曼编码的压缩极限为1:8但是就你说所的概率大体相同,那就很难说了你可以把两个数字和一个转成byte 00....99存储其中最大的99只占7bit,还能空一个bit来让后面一个字节的低位补上来，这样每8个字节可以存储9个字节的容量现在的压缩比为 50%*8/9 大约为45% ,不过还不能达到要求 ..

Answer 2

to  pazee(耙子)(灵感点亮生活)
    是啊，这正是头痛的地方

Answer 3

谢谢各位的参与，下午揭帖，也许我的要求是不可能达到的。下面是我的一点尝试，压缩率>40。效果和 jinjazz(我是jin) 的差不多，但是没有 jinjazz(我是jin) 的方法来的简单Function OctToBin(iValue:Integer):String;
begin
  Case iValue of
    0:      Result:='0000';
    1:      Result:='0001';
    2:      Result:='0010';
    3:      Result:='0011';
    4:      Result:='0100';
    5:      Result:='0101';
    6:      Result:='0110';
    7:      Result:='0111';
    8:      Result:='1000';
    9:      Result:='1001';
    else    Result:='';
  end;
end;Function BinToOct(sBin:String):Integer;
var
  iBit:Integer;
begin
  Result:=0;  iBit:=0;
  While sBin>'' do
  begin
    Inc(iBit);
    if RightStr(sBin,1)='1' then
      Result:=Result+Trunc(Power(2,iBit));
    Delete(sBin,Length(sBin),1);
  end;
end;Function Compress(sSource:String):String;
//压缩由全部位数字组成的字符串
Const
  CEnc:Array[0..9] of String = (
    '000',
    '001',
    '010',
    '100',
    '101',
    '110',
    '0110',
    '0111',
    '1110',
    '1111'
  );
var
  iProbability:Array[0..9] of Integer;//字符0到9出现的概率
  i,j,iPos,iChar,iTemp:Integer;
  sBin,sSeq,sTemp:String;
begin
  //求各字符出现的概率
  for i:=0 to 9 do iProbability[i]:=0;
  for i:=1 to Length(sSource) do
  begin
    iChar:=StrToInt(sSource[i]);
    Inc(iProbability[iChar]);
  end;  //将各字符的顺序按出现概率的高低排列保存在sSeq中
  //冒泡法排序
  sSeq:='0123456789';
  for i:=0 to 9 do
    for j:=i+1 to 9 do
    begin
      if iProbability[i]>=iProbability[j] then Continue;      iTemp:=iProbability[i];
      iProbability[i]:=iProbability[j];
      iProbability[j]:=iTemp;      sTemp:=Copy(sSeq,i+1,1);
      sSeq:=LeftStr(sSeq,i)+Copy(sSeq,j+1,1)+Copy(sSeq,i+2,Length(sSeq));
      sSeq:=LeftStr(sSeq,j)+sTemp+Copy(sSeq,j+2,Length(sSeq));
    end;  //按出现概率将原字符串编码成二进制
  sBin:='';
  for i:=1 to Length(sSource) do
  begin
    sTemp:=sSource[i];
    iPos:=Pos(sTemp,sSeq);
    sBin:=sBin+CEnc[iPos-1];
  end;  //将编码字典保存在二进制字符的前面
  for i:=1 to 10 do
    sBin:=OctToBin(StrtoInt(sSeq[i]))+sBin;  //补足8位
  sBin:=sBin+StringOfChar('1',8-(Length(sBin) Mod 8));
  //二进制转换为字符输出
  Result:='';
  While sBin>'' do
  begin
    Result:=Result+Chr(BinToOct(LeftStr(sBin,8)));
    Delete(sBin,1,8);
  end;
end;procedure TForm1.Button1Click(Sender: TObject);
var
  s,d:String;
  iProbability:Array[0..9] of Integer;
  i,j:Integer;
begin
  s:='';
  for i:=1 to 600 do
    s:=s+IntToStr(Random(10));  d:=Compress(s);
  ShowMessage(IntToStr(Length(s))+#13+IntToStr(Length(d)));
end;

Answer 4

我的算法代码：没加移位的function encode(s:string):string;
var i,m:integer;
begin
  i:=1;
  result:='';
  while i<= length(s)  do
  begin
    m:=strtoint(copy(s,i,2));
    result:=result+chr(m);
    i:=i+2;
  end;
end;
function decode(s:string):string;
var i,m:integer;
begin
  result:='';
  for i:=1 to length(s)  do
  begin
    m:=ord(s[i]);
    result:=result+inttostr(m);
  end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
  memo1.Lines.LoadFromFile('c:\a.txt');
  memo1.Text:=decode(memo1.Text);
  memo1.Lines.SaveToFile('c:\a.txt');
end;
=========我测了一下 737字节的文件压缩到了369，并能正常解压

Answer 5

还一个"压缩"简单的办法，
既然你这个都是数字，你不妨把它按照9位一截，变成若干个9位的10进制整数。把这9位数用StrToInt变成一个4字节的无符号整形数（2^32大约等于4.2E+10)，这不就相当于压缩了吗，还原的时候只要把这个整数用IntToStr就行了，比哈夫曼还简单。它的压缩率大约是 4/9大约44%