Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2004.11.21;
Скачать: CL | DM;

Вниз

Сжатие данных   Найти похожие ветки 

 
Logun   (2004-11-07 01:02) [0]

Доброй ночи!
Есть задачка написать архиватор на основе полуадаптивной схемы и алгоритма Хаффмана.
Подскажите пожалуйста ссылочкии по теме, может исходники где есть. Буду очень признателен


 
Defunct ©   (2004-11-07 05:10) [1]

Алгоритм Хаффмана основанный на битовом дереве?
есть что-то подобное, но очень-очень старое, так что за код не ручаюсь.

Упаковщик:

{$D+}
Program BitMapAnaliz;

Const Code : Array[0..3] of Word = ($0703, $0603, $0202, $0001);

Var B,B1:Array[0..32000] Of Byte;
   I,N,W:Word;
   E:Array[0..3] Of Word;
   Ves:Array[0..3] Of Byte;
   F:File;
   PakByte:Byte;

Procedure InitArray;
Begin
  Assign(F,ParamStr(1));
  Reset(F,1);
  BlockRead(F,B,32000,N);
  Dec(N);
  Close(F);
End;

Procedure InitStrukture;
Begin
 For I:=0 To 3 Do
 Begin
   E[i]:=0;
   Ves[i]:=0;
 End;
End;

Procedure ByteAnaliz(B:Byte);Assembler;
Asm
  Xor Ax,Ax
  Mov AL,B
  Mov Cx,4

@@Start:

  Shl Ax,1
  Shl Ax,1

  Or  Ah,Ah
  Jnz @@L1

  Inc Word Ptr [E]
  Jmp @@Exit

@@L1:
  Shr AH,1
  JC  @@L2

  Inc Word Ptr [E+4]
  Jmp @@Exit

@@L2:
  Shr AH,1
  JC  @@L3

  Inc Word Ptr [E+2]
  Jmp @@Exit

@@L3:
  Inc Word Ptr [E+6]

@@Exit:
  Loop @@Start

End;

Procedure GeneratePakByte;
Var B1,B2,BF:Byte;
Begin
  PakByte:=0;
  For I:=0 To 3 Do
  For W:=0 To 3 Do
    If E[i]>E[w] Then Inc(Ves[i]);

  For I:=0 To 3 Do
  Begin
    B1:=Ves[i];
    Asm
      Mov Ax,I
      Mov CL,B1
      Shl Cl,1
      Shl AL,CL
      Mov B2,AL
    End;
    PakByte:=PakByte Or B2;
  End;
End;

Procedure PakStream;
Var LenthOfDx:Byte;
   CodeInDx:Word;
Begin
  W:=0;LenthOfDx:=0;
       CodeInDx:=0;
  For I:=0 To N Do
  Begin
    Asm
      Push Ds
      Pop  Es
      Mov  Dx,CodeInDx
      Mov  BL,LenthOfDx
      Mov  Cx,4

      Mov Si,I
      Add Si,OffSet B
      LodsB

@@StartPByte:
      Mov  AH,0
      SHL  Ax,1
      SHL  Ax,1
      Push Cx
      Mov  CL,AH
      Mov  DI,Cx
      Mov  CL,Byte Ptr DS:[Ves+Di]
      Shl  CL,1
      Mov  Di,Cx
      Mov  Cx,Word Ptr DS:[Code+Di]  { в CL - длинна кода (бит) }
      Push Cx
      CMP  BL,8
      Jna  @@NotProblem

{ Сдесь формирование выходного байта }
      Mov  Di,W
      Add  Di,OffSet B1
      Mov  CL,16
      Sub  CL,BL
      Push Cx
      SHL  Dx,Cl
      Push Ax
      Mov  AL,DH
      StosB
      Pop  Ax
      Pop  Cx
      Sub  BL,8
      Shr  Dx,Cl
      Inc  W

@@NotProblem:
      Pop  Cx
      Add  BL,CL
      SHL  Dx,CL                     { сдвинем Dx на длиину поступившего}
      Add  DL,CH                     { кода, и поместим его в DL}

      Pop  Cx
      Loop @@StartPByte

      Mov  CodeInDx,Dx
      Mov  LenthOfDx,BL

    End;
  End;
  Asm
      Mov  Di,W
      Add  Di,OffSet B1
      Mov  CL,16
      Sub  CL,LenthOfDx
      Push Cx
      SHL  Dx,Cl
      Push Ax
      Mov  AL,DH
      StosB
      Pop  Ax
      Pop  Cx
      Sub  LenthOfDx,8
      Shr  Dx,Cl
      Inc  W
  End;
End;

Begin
  InitArray;
  InitStrukture;
  For I:=0 To N Do
    ByteAnaliz(B[i]);

  GeneratePakByte;

{   ByteAnaliz($01);
  ByteAnaliz($FF);}

  WriteLn("00 -> ",E[0]);
  WriteLn("01 -> ",E[1]);
  WriteLn("10 -> ",E[2]);
  WriteLn("11 -> ",E[3]);
  WriteLn;
  WriteLn("00 -> ",Ves[0]);
  WriteLn("01 -> ",Ves[1]);
  WriteLn("10 -> ",Ves[2]);
  WriteLn("11 -> ",Ves[3]);

  WriteLn;
  WriteLn("PakByte is => ",PakByte);

  PakStream;
  WriteLn("Длинна входного потока => ",N+1);
  WriteLn("Длинна выходного потока => ",W+1);
  WriteLn("Выходной поток сохранён в файл Out.mdp");
  Assign(F,"Out.Mdp");
  ReWrite(F,1);
  BlockWrite(F,PakByte,1);
  BlockWrite(F,B1,W+1);
  Close(F);

End.


 
Defunct ©   (2004-11-07 05:12) [2]

Распаковщик:

Program BitMapAnaliz;

Var B,B1:Array[0..32000] Of Byte;
   I,N,W:Word;
   E:Array[0..3] Of Word;
   BitMap:Array[0..3] Of Byte;
   F:File;
   PakByte:Byte;

Procedure InitArray;
Begin
  Assign(F,ParamStr(1));
  Reset(F,1);
  BlockRead(F,B,32000,N);
  Dec(N);
  Close(F);
End;

Procedure CreateBitMap;
Begin
 PakByte:=B[0];
 Asm
   Push Ds
   Pop  Es
   Mov  Cx,4
   Mov  Di,OffSet BitMap

   Mov  AL,PakByte
@@LL1:
   Mov  AH,0
   Shl  Ax,1
   Shl  Ax,1
   Xchg Ah,Al
   Stosb
   Xchg AH,AL
   Loop @@LL1
 End
End;

Procedure UnPakStream;
Var NumberOfMap:Byte;
   CodeInDL:Byte;
   TekCL,NextBit:Byte;
Begin

  NumberOfMap:=3; W:=0;
  CodeInDL:=0;    TekCL:=0;

  For I:=1 To N Do
  Begin
    Asm
      Push Ds
      Pop  Es

      Mov  DL,CodeInDL
      Mov  NextBit,8
      Mov  Si,I
      Add  Si,OffSet B
      LodsB                { В AL закодированный символ}

@@L0:  Xor  Cx,Cx
      Mov  CodeInDL,DL     { сохраним текущий DL }
      Mov  CL,TekCL
@@L1:
      Mov  TekCL,CL
      Dec  NextBit
      Js   @@Exit

      Shl  AL,1
      Jnc  @@CreateSumbol

      Inc  Cx
      Cmp  CL,3
      Jnz  @@L1
@@CreateSumbol:             { на этой метке CL содержит номер из BitMap }

      Mov  Si,Cx
      Add  Si,OffSet BitMap
      Push Ax
      LodsB                { читаем в AL сивол из BitMap }
      Mov  TekCL,0

      Shl  DL,1
      Shl  DL,1
      Add  DL,AL
      Pop  Ax
      Dec  NumberOfMap     { уменьшим позицию в байте }
      Jns  @@L0            { если позиция не была равна 0, то повторим}

      Mov  NumberOfMap,3   { иначе загрузим верхнее значение }
      Push Ax
      Mov  AL,DL           { подготовим выходной байт }
      Mov  Di,W
      Add  Di,OffSet B1
      StosB                { запишем в выходной поток }
      Pop  Ax
      Inc  W               { увеличим позицию байта в потоке }
      Mov  DL,0            { обнулим текущий байт }
      Jmp  @@L0

@@Exit:
    End;
  End;
End;

Begin
 InitArray;
 CreateBitMap;
 UnPakStream;
 WriteLn("BitMap is => ");

 WriteLn(BitMap[0]);
 WriteLn(BitMap[1]);
 WriteLn(BitMap[2]);
 WriteLn(BitMap[3]);
 WriteLn;
 WriteLn("Длинна входного потока => ",N);
 WriteLn("Длинна распакованного потока => ",W+1);

 WriteLn("поток записан в файл UnPak.MDP");

 Assign(F,"UnPak.MDP");
 ReWrite(F,1);
 BlockWrite(F,B1,W+1);
 Close(F);
End.


Здесь строго соблюден алгоритм Хаффмана ни более ни менее.


 
Defunct ©   (2004-11-07 05:15) [3]

PS: то что я привел [1,2], разумеется для TP7.


 
Defunct ©   (2004-11-07 05:18) [4]

Более того, судя по асм коду, это было для процессора 8088.



Страницы: 1 вся ветка

Текущий архив: 2004.11.21;
Скачать: CL | DM;

Наверх




Память: 0.49 MB
Время: 0.035 c
14-1099410088
Murkt
2004-11-02 18:41
2004.11.21
Лол


14-1099482873
VEG
2004-11-03 14:54
2004.11.21
Ограничение на количество окон в Windows


1-1099987827
Dmitrij_K
2004-11-09 11:10
2004.11.21
Динамические массивы


1-1099788577
Роман
2004-11-07 03:49
2004.11.21
Автозагрузка файла


1-1099551584
Владимир
2004-11-04 09:59
2004.11.21
Как узнать...