Алгоритм и код Хаффмана. $$$!

Нужна программа!
Текст задания:
"Используя построения дерева Хаффмана получить код Хаффмана для произвольного текстового файла и при помощи кода сжать файл, а затем разархифировать. Оценить время работы"
Может кто-нибудь, разбирающийся в этом, взяться?
И какова ВАША цена?
shved@msx.ru

Здесь, в основном, математики сидят. У них программы чисто умозрительные. Для абстрактных, возможно не существующих в реальном мире контуперов.

Так что, внимательнее читай ФАК

Сообщение отредактировано: Visitor - 31.10.03, 20:36

Цитата shved, 31.10.03, 23:17:59

И какова ВАША цена?

НАША цена научить и помочь самому разбираться в поставленных задачах и находить решения  ;D

Сообщение отредактировано: GrAnd - 01.11.03, 08:24

http://www.yandex.ru/yandsearch?rpt=rad&text=\%C0\%EB\%E3\%EE\%F0\%E8\%F2\%EC+\%E8+\%EA\%EE\%E4+\%D5\%E0\%F4\%F4\%EC\%E0\%ED\%E0
Вот описание с алгоритмом:
http://mindspring.narod.ru/alg/huffman.html

Я вам очень благодарен за совет, и я понимаю что надо учицца, учицца и учицца,
но в данном случае мне этот вариант не подходит, т.к. еслия не сдам эту и еще кучу программ, учиться будет негде...
Поэтому, если кто может сделать, скажите ВАШУ цену.
Пожалуйста!

<br>{$A+,B-,D+,E+,F-,G-,I-,L+,N-,O-,R+,S+,V+,X-}<br>{$M 16384,0,655360}<br>{******************************************************}<br>{*         Алгоритм уплотнения данных по методу       *}<br>{*                     Хафмана.                       *}<br>{******************************************************}<br>Program Hafman;<br>Uses Crt,Dos,Printer;<br>Type    PCodElement = ^CodElement;<br>        CodElement = record<br>                      NewLeft,NewRight,<br>                      P0, P1 : PCodElement;   {элемент входящий одновременно}<br>                      LengthBiteChain : byte; { в массив , очередь и дерево }<br>                      BiteChain : word;<br>                      CounterEnter : word;<br>                      Key : boolean;<br>                      Index : byte;<br>                     end;<br>        TCodeTable = array [0..255] of PCodElement;<br>Var     CurPoint,HelpPoint,<br>        LeftRange,RightRange : PCodElement;<br>        CodeTable : TCodeTable;<br>        Root : PCodElement;<br>        InputF, OutputF, InterF : file;<br>        TimeUnPakFile : longint;<br>        AttrUnPakFile : word;<br>        NumRead, NumWritten: Word;<br>        InBuf  : array[0..10239] of byte;<br>        OutBuf : array[0..10239] of byte;<br>        BiteChain : word;<br>        CRC,<br>        CounterBite : byte;<br>        OutCounter : word;<br>        InCounter : word;<br>        OutWord : word;<br>        St : string;<br>        LengthOutFile, LengthArcFile : longint;<br>        Create : boolean;<br>        NormalWork : boolean;<br>        ErrorByte : byte;<br>        DeleteFile : boolean;<br>{-------------------------------------------------}<br>procedure ErrorMessage;<br>{ --- вывод сообщения об ошибке --- }<br>begin<br> If ErrorByte <> 0 then<br>  begin<br>   Case ErrorByte of<br>    2 : Writeln('File not found ...');<br>    3 : Writeln('Path not found ...');<br>    5 : Writeln('Access denied ...');<br>    6 : Writeln('Invalid handle ...');<br>    8 : Writeln('Not enough memory ...');<br>   10 : Writeln('Invalid environment ...');<br>.<br>   11 : Writeln('Invalid format ...');<br>   18 : Writeln('No more files ...');<br>   else Writeln('Error #',ErrorByte,' ...');<br>   end;<br>   NormalWork:=False;<br>   ErrorByte:=0;<br>  end;<br>end;<br>procedure ResetFile;<br>{ --- открытие файла для архивации --- }<br>Var St : string;<br>begin<br>  Assign(InputF, ParamStr(3));<br>  Reset(InputF, 1);<br>  ErrorByte:=IOResult;<br>  ErrorMessage;<br>  If NormalWork then Writeln('Pak file : ',ParamStr(3),'...');<br>end;<br>procedure ResetArchiv;<br>{ --- открытие файла архива, или его создание --- }<br>begin<br>  St:=ParamStr(2);<br>  If Pos('.',St)<>0 then Delete(St,Pos('.',St),4);<br>  St:=St+'.vsg';<br>  Assign(OutputF, St);<br>  Reset(OutPutF,1);<br>  Create:=False;<br>  If IOResult=2 then<br>   begin<br>    Rewrite(OutputF, 1);<br>    Create:=True;<br>   end;<br>  If NormalWork then<br>   If Create then Writeln('Create archiv : ',St,'...')<br>    else Writeln('Open archiv : ',St,'...')<br>end;<br>procedure SearchNameInArchiv;<br>{ --- в дальнейшем - поиск имени файла в архиве --- }<br>begin<br> Seek(OutputF,FileSize(OutputF));<br> ErrorByte:=IOResult;<br> ErrorMessage;<br>end;<br>procedure DisposeCodeTable;<br>{ --- уничтожение кодовой таблицы и очереди --- }<br>Var I : byte;<br>begin<br> For I:=0 to 255 do Dispose(CodeTable[I]);<br>end;<br>procedure ClosePakFile;<br>{ --- закрытие архивируемого файла --- }<br>Var I : byte;<br>begin<br> If DeleteFile then Erase(InputF);<br>.<br> Close(InputF);<br>end;<br>procedure CloseArchiv;<br>{ --- закрытие архивного файла --- }<br>begin<br> If FileSize(OutputF)=0 then Erase(OutputF);<br> Close(OutputF);<br>end;<br>procedure InitCodeTable;<br>{ --- инициализация таблицы кодировки --- }<br>Var I : byte;<br>begin<br> For I:=0 to 255 do<br>  begin<br>    New(CurPoint);<br>    CodeTable[I]:=CurPoint;<br>    With CodeTable[I]^ do<br>     begin<br>      P0:=Nil;<br>      P1:=Nil;<br>      LengthBiteChain:=0;<br>      BiteChain:=0;<br>      CounterEnter:=1;<br>      Key:=True;<br>      Index:=I;<br>     end;<br>  end;<br> For I:=0 to 255 do<br>  begin<br>   If I>0 then CodeTable[I-1]^.NewRight:=CodeTable[I];<br>   If I<255 then CodeTable[I+1]^.NewLeft:=CodeTable[I];<br>  end;<br> LeftRange:=CodeTable[0];<br> RightRange:=CodeTable[255];<br> CodeTable[0]^.NewLeft:=Nil;<br> CodeTable[255]^.NewRight:=Nil;<br>end;<br>procedure SortQueueByte;<br>{ --- пузырьковая сортировка по возрастанию --- }<br>Var Pr1,Pr2 : PCodElement;<br>begin<br> CurPoint:=LeftRange;<br> While CurPoint <> RightRange do<br>  begin<br>   If CurPoint^.CounterEnter > CurPoint^.NewRight^.CounterEnter then<br>    begin<br>     HelpPoint:=CurPoint^.NewRight;<br>     HelpPoint^.NewLeft:=CurPoint^.NewLeft;<br>     CurPoint^.NewLeft:=HelpPoint;<br>     If HelpPoint^.NewRight<>Nil then HelpPoint^.NewRight^.NewLeft:=CurPoint;<br>     CurPoint^.NewRight:=HelpPoint^.NewRight;<br>     HelpPoint^.NewRight:=CurPoint;<br>     If HelpPoint^.NewLeft<>Nil then HelpPoint^.NewLeft^.NewRight:=HelpPoint;<br>     If CurPoint=LeftRange then LeftRange:=HelpPoint;<br>     If HelpPoint=RightRange then RightRange:=CurPoint;<br>     CurPoint:=CurPoint^.NewLeft;<br>.<br>     If CurPoint = LeftRange then CurPoint:=CurPoint^.NewRight<br>      else CurPoint:=CurPoint^.NewLeft;<br>    end<br>    else CurPoint:=CurPoint^.NewRight;<br>  end;<br>end;<br>procedure CounterNumberEnter;<br>{ --- подсчет частот вхождений байтов в блоке --- }<br>Var C : word;<br>begin<br> For C:=0 to NumRead-1 do<br>  Inc(CodeTable[(InBuf[C])]^.CounterEnter);<br>end;<br>function SearchOpenCode : boolean;<br>{ --- поиск в очереди пары открытых по Key минимальных значений --- }<br>begin<br> CurPoint:=LeftRange;<br> HelpPoint:=LeftRange;<br> HelpPoint:=HelpPoint^.NewRight;<br> While not CurPoint^.Key do<br>  CurPoint:=CurPoint^.NewRight;<br> While (not (HelpPoint=RightRange)) and (not HelpPoint^.Key) do<br>  begin<br>   HelpPoint:=HelpPoint^.NewRight;<br>   If (HelpPoint=CurPoint) and (HelpPoint<>RightRange) then<br>    HelpPoint:=HelpPoint^.NewRight;<br>  end;<br> If HelpPoint=CurPoint then SearchOpenCode:=False else SearchOpenCode:=True;<br>end;<br>procedure CreateTree;<br>{ --- создание дерева частот вхождения --- }<br>begin<br> While SearchOpenCode do<br>  begin<br>   New(Root);<br>   With Root^ do<br>    begin<br>     P0:=CurPoint;<br>     P1:=HelpPoint;<br>     LengthBiteChain:=0;<br>     BiteChain:=0;<br>     CounterEnter:=P0^.CounterEnter + P1^.CounterEnter;<br>     Key:=True;<br>     P0^.Key:=False;<br>     P1^.Key:=False;<br>    end;<br>   HelpPoint:=LeftRange;<br>   While (HelpPoint^.CounterEnter < Root^.CounterEnter) and<br>    (HelpPoint<>Nil) do HelpPoint:=HelpPoint^.NewRight;<br>   If HelpPoint=Nil then { добавление в конец }<br>    begin<br>     Root^.NewLeft:=RightRange;<br>     RightRange^.NewRight:=Root;<br>     Root^.NewRight:=Nil;<br>     RightRange:=Root;<br>    end<br>.<br>   else<br>    begin { вставка перед HelpPoint }<br>     Root^.NewLeft:=HelpPoint^.NewLeft;<br>     HelpPoint^.NewLeft:=Root;<br>     Root^.NewRight:=HelpPoint;<br>     If Root^.NewLeft<>Nil then Root^.NewLeft^.NewRight:=Root;<br>    end;<br>  end;<br>end;<br>procedure ViewTree( P : PCodElement );<br>{ --- просмотр дерева частот и присваивание кодировочных цепей листьям --- }<br>Var Mask,I : word;<br>begin<br> Inc(CounterBite);<br> If P^.P0<>Nil then ViewTree( P^.P0 );<br> If P^.P1<>Nil then<br>  begin<br>   Mask:=(1 SHL (16-CounterBite));<br>   BiteChain:=BiteChain OR Mask;<br>   ViewTree( P^.P1 );<br>   Mask:=(1 SHL (16-CounterBite));<br>   BiteChain:=BiteChain XOR Mask;<br>  end;<br> If (P^.P0=Nil) and (P^.P1=Nil) then<br>  begin<br>   P^.BiteChain:=BiteChain;<br>   P^.LengthBiteChain:=CounterBite-1;<br>  end;<br> Dec(CounterBite);<br>end;<br>procedure CreateCompressCode;<br>{ --- обнуление переменных и запуск просмотра дерева с вершины --- }<br>begin<br> BiteChain:=0;<br> CounterBite:=0;<br> Root^.Key:=False;<br> ViewTree(Root);<br>end;<br>procedure DeleteTree;<br>{ --- удаление дерева --- }<br>Var P : PCodElement;<br>begin<br> CurPoint:=LeftRange;<br> While CurPoint<>Nil do<br>  begin<br>   If (CurPoint^.P0<>Nil) and (CurPoint^.P1<>Nil) then<br>    begin<br>     If CurPoint^.NewLeft <> Nil then<br>      CurPoint^.NewLeft^.NewRight:=CurPoint^.NewRight;<br>     If CurPoint^.NewRight <> Nil then<br>      CurPoint^.NewRight^.NewLeft:=CurPoint^.NewLeft;<br>     If CurPoint=LeftRange then LeftRange:=CurPoint^.NewRight;<br>     If CurPoint=RightRange then RightRange:=CurPoint^.NewLeft;<br>     P:=CurPoint;<br>     CurPoint:=P^.NewRight;<br>     Dispose(P);<br>    end<br>.<br>   else CurPoint:=CurPoint^.NewRight;<br>  end;<br>end;<br>procedure SaveBufHeader;<br>{ --- запись в буфер заголовка архива --- }<br>Type<br>      ByteField = array[0..6] of byte;<br>Const<br>      Header : ByteField = ( $56, $53, $31, $00, $00, $00, $00 );<br>begin<br> If Create then<br>  begin<br>   Move(Header,OutBuf[0],7);<br>   OutCounter:=7;<br>  end<br> else<br>  begin<br>   Move(Header[3],OutBuf[0],4);<br>   OutCounter:=4;<br>  end;<br>end;<br>procedure SaveBufFATInfo;<br>{ --- запись в буфер всей информации по файлу --- }<br>Var I : byte;<br>    St : PathStr;<br>    R : SearchRec;<br>begin<br> St:=ParamStr(3);<br> For I:=0 to Length(St)+1 do<br>  begin<br>   OutBuf[OutCounter]:=byte(Ord(St[I]));<br>   Inc(OutCounter);<br>  end;<br> FindFirst(St,$00,R);<br> Dec(OutCounter);<br> Move(R.Time,OutBuf[OutCounter],4);<br> OutCounter:=OutCounter+4;<br> OutBuf[OutCounter]:=R.Attr;<br> Move(R.Size,OutBuf[OutCounter+1],4);<br> OutCounter:=OutCounter+5;<br>end;<br>procedure SaveBufCodeArray;<br>{ --- сохранить массив частот вхождений в архивном файле --- }<br>Var I : byte;<br>begin<br> For I:=0 to 255 do<br>  begin<br>   OutBuf[OutCounter]:=Hi(CodeTable[I]^.CounterEnter);<br>   Inc(OutCounter);<br>   OutBuf[OutCounter]:=Lo(CodeTable[I]^.CounterEnter);<br>   Inc(OutCounter);<br>  end;<br>end;<br>.<br>procedure CreateCodeArchiv;<br>{ --- создание кода сжатия --- }<br>begin<br> InitCodeTable;      { инициализация кодовой таблицы                      }<br> CounterNumberEnter; { подсчет числа вхождений байт в блок                }<br> SortQueueByte;      { cортировка по возрастанию числа вхождений          }<br> SaveBufHeader;      { сохранить заголовок архива в буфере                }<br> SaveBufFATInfo;     { сохраняется FAT информация по файлу                }<br> SaveBufCodeArray;   { сохранить массив частот вхождений в архивном файле }<br> CreateTree;         { создание дерева частот                             }<br> CreateCompressCode; { cоздание кода сжатия                               }<br> DeleteTree;         { удаление дерева частот                             }<br>end;<br>procedure PakOneByte;<br>{ --- сжатие и пересылка в выходной буфер одного байта --- }<br>Var Mask : word;<br>    Tail : boolean;<br>begin<br> CRC:=CRC XOR InBuf[InCounter];<br> Mask:=CodeTable[InBuf[InCounter]]^.BiteChain SHR CounterBite;<br> OutWord:=OutWord OR Mask;<br> CounterBite:=CounterBite+CodeTable[InBuf[InCounter]]^.LengthBiteChain;<br> If CounterBite>15 then Tail:=True else Tail:=False;<br> While CounterBite>7 do<br>  begin<br>   OutBuf[OutCounter]:=Hi(OutWord);<br>   Inc(OutCounter);<br>   If OutCounter=(SizeOf(OutBuf)-4) then<br>    begin<br>     BlockWrite(OutputF,OutBuf,OutCounter,NumWritten);<br>     OutCounter:=0;<br>    end;<br>   CounterBite:=CounterBite-8;<br>   If CounterBite<>0 then OutWord:=OutWord SHL 8 else OutWord:=0;<br>  end;<br> If Tail then<br>  begin<br>   Mask:=CodeTable[InBuf[InCounter]]^.BiteChain SHL<br>   (CodeTable[InBuf[InCounter]]^.LengthBiteChain-CounterBite);<br>   OutWord:=OutWord OR Mask;<br>  end;<br> Inc(InCounter);<br> If (InCounter=(SizeOf(InBuf))) or (InCounter=NumRead) then<br>  begin<br>   InCounter:=0;<br>   BlockRead(InputF,InBuf,SizeOf(InBuf),NumRead);<br>  end;<br>end;<br>procedure PakFile;<br>{ --- процедура непосредственного сжатия файла --- }<br>begin<br> ResetFile;<br> SearchNameInArchiv;<br> If NormalWork then<br>  begin<br>   BlockRead(InputF,InBuf,SizeOf(InBuf),NumRead);<br>   OutWord:=0;<br>.<br>   CounterBite:=0;<br>   OutCounter:=0;<br>   InCounter:=0;<br>   CRC:=0;<br>   CreateCodeArchiv;<br>   While (NumRead<>0) do PakOneByte;<br>   OutBuf[OutCounter]:=Hi(OutWord);<br>   Inc(OutCounter);<br>   OutBuf[OutCounter]:=CRC;<br>   Inc(OutCounter);<br>   BlockWrite(OutputF,OutBuf,OutCounter,NumWritten);<br>   DisposeCodeTable;<br>   ClosePakFile;<br>  end;<br>end;<br>procedure ResetUnPakFiles;<br>{ --- открытие файла для распаковки --- }<br>begin<br> InCounter:=7;<br> St:='';<br> repeat<br>  St[InCounter-7]:=Chr(InBuf[InCounter]);<br>  Inc(InCounter);<br> until InCounter=InBuf[7]+8;<br> Assign(InterF,St);<br> Rewrite(InterF,1);<br> ErrorByte:=IOResult;<br> ErrorMessage;<br> If NormalWork then<br>  begin<br>   WriteLn('UnPak file : ',St,'...');<br>   Move(InBuf[InCounter],TimeUnPakFile,4);<br>   InCounter:=InCounter+4;<br>   AttrUnPakFile:=InBuf[InCounter];<br>   Inc(InCounter);<br>   Move(InBuf[InCounter],LengthArcFile,4);<br>   InCounter:=InCounter+4;<br>  end;<br>end;<br>procedure CloseUnPakFile;<br>{ --- закрытие файла для распаковки --- }<br>begin<br> If not NormalWork then Erase(InterF)<br>  else<br>   begin<br>    SetFAttr(InterF,AttrUnPakFile);<br>    SetFTime(InterF,TimeUnPakFile);<br>   end;<br> Close(InterF);<br>end;<br>procedure RestoryCodeTable;<br>{ --- воссоздание кодовой таблицы по архивному файлу --- }<br>Var I : byte;<br>begin<br> InitCodeTable;<br> For I:=0 to 255 do<br>.<br>  begin<br>   CodeTable[I]^.CounterEnter:=InBuf[InCounter];<br>   CodeTable[I]^.CounterEnter:=CodeTable[I]^.CounterEnter SHL 8;<br>   Inc(InCounter);<br>   CodeTable[I]^.CounterEnter:=CodeTable[I]^.CounterEnter+InBuf[InCounter];<br>   Inc(InCounter);<br>  end;<br>end;<br>procedure UnPakByte( P : PCodElement );<br>{ --- распаковка одного байта --- }<br>Var Mask : word;<br>begin<br> If (P^.P0=Nil) and (P^.P1=Nil) then<br>  begin<br>   OutBuf[OutCounter]:=P^.Index;<br>   Inc(OutCounter);<br>   Inc(LengthOutFile);<br>   If OutCounter = (SizeOf(OutBuf)-1) then<br>    begin<br>     BlockWrite(InterF,OutBuf,OutCounter,NumWritten);<br>     OutCounter:=0;<br>    end;<br>  end<br> else<br>  begin<br>   Inc(CounterBite);<br>   If CounterBite=9 then<br>    begin<br>     Inc(InCounter);<br>     If InCounter = (SizeOf(InBuf)) then<br>      begin<br>       InCounter:=0;<br>       BlockRead(OutputF,InBuf,SizeOf(InBuf),NumRead);<br>      end;<br>     CounterBite:=1;<br>    end;<br>   Mask:=InBuf[InCounter];<br>   Mask:=Mask SHL (CounterBite-1);<br>   Mask:=Mask OR $FF7F; { установка всех битов кроме старшего }<br>   If Mask=$FFFF then UnPakByte(P^.P1)<br>    else UnPakByte(P^.P0);<br>  end;<br>end;<br>procedure UnPakFile;<br>{ --- распаковка одного файла --- }<br>begin<br> BlockRead(OutputF,InBuf,SizeOf(InBuf),NumRead);<br> ErrorByte:=IOResult;<br> ErrorMessage;<br> If NormalWork then ResetUnPakFiles;<br> If NormalWork then<br>  begin<br>   RestoryCodeTable;<br>   SortQueueByte;<br>   CreateTree;                   { создание дерева частот }<br>   CreateCompressCode;<br>   CounterBite:=0;<br>.<br>   OutCounter:=0;<br>   LengthOutFile:=0;<br>   While LengthOutFile<LengthArcFile do<br>    UnPakByte(Root);<br>   BlockWrite(InterF,OutBuf,OutCounter,NumWritten);<br>   DeleteTree;<br>   DisposeCodeTable;<br>  end;<br> CloseUnPakFile;<br>end;<br>{ ------------------------- main text ------------------------- }<br>begin<br> DeleteFile:=False;<br> NormalWork:=True;<br> ErrorByte:=0;<br> WriteLn;<br> WriteLn('ArcHaf version 1.0  (c) Copyright VVS Soft Group, 1992.');<br> ResetArchiv;<br> If NormalWork then<br>  begin<br>   St:=ParamStr(1);<br>   Case St[1] of<br>    'a','A' : PakFile;<br>    'm','M' : begin<br>               DeleteFile:=True;<br>               PakFile;<br>              end;<br>    'e','E' : UnPakFile;<br>    else ;<br>   end;<br>  end;<br> CloseArchiv;<br>end.<br>

В дальнейшем разобраться труда не составит..