Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2004.11.21;
Скачать: [xml.tar.bz2];

Вниз

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

 
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;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.48 MB
Время: 0.035 c
4-1097339762
Clip
2004-10-09 20:36
2004.11.21
Clipboard (Unicode) -> Clipboard/File (Win-1252)


3-1098348656
Jet
2004-10-21 12:50
2004.11.21
Выборка из двух таблиц


3-1098197683
iat
2004-10-19 18:54
2004.11.21
Если спрятать колонку в DBGrid, то она исчезнет из отчета...


9-1090517851
2_XBOCTA
2004-07-22 21:37
2004.11.21
Сценарий к квесту...


3-1098692061
starling13
2004-10-25 12:14
2004.11.21
IBDataSet, IBTable





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский