
![]() |
Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
|
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[18.97.9.175] |
![]() |
|
Сообщ.
#1
,
|
|
|
Нужна программа!
Текст задания: "Используя построения дерева Хаффмана получить код Хаффмана для произвольного текстового файла и при помощи кода сжать файл, а затем разархифировать. Оценить время работы" Может кто-нибудь, разбирающийся в этом, взяться? И какова ВАША цена? shved@msx.ru |
Сообщ.
#2
,
|
|
|
Здесь, в основном, математики сидят. У них программы чисто умозрительные. Для абстрактных, возможно не существующих в реальном мире контуперов.
Так что, внимательнее читай ФАК ![]() |
Сообщ.
#3
,
|
|
|
Цитата shved, 31.10.03, 23:17:59 И какова ВАША цена? НАША цена научить и помочь самому разбираться в поставленных задачах и находить решения ;D ![]() ![]() |
Сообщ.
#4
,
|
|
|
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 |
Сообщ.
#5
,
|
|
|
Я вам очень благодарен за совет, и я понимаю что надо учицца, учицца и учицца,
но в данном случае мне этот вариант не подходит, т.к. еслия не сдам эту и еще кучу программ, учиться будет негде... Поэтому, если кто может сделать, скажите ВАШУ цену. Пожалуйста! |
Сообщ.
#6
,
|
|
|
![]() ![]() <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> |
Сообщ.
#7
,
|
|
|
В дальнейшем разобраться труда не составит..
|