CSC - SY

شكراً بلال
شو شباب ما في حدا نشيط يكمل

شو رأيك؟؟؟

بكرا رح حاول اشرح يلي بعرفه عن تقنية هوفمان يلي يمكن كل طلاب السنة التالتة بجامعة دمشق عندهم فكرة عنها لإنها كانت انطلبت منا كوظيفة السنة الماضية
على كل حال يلي بيحب يشوف الكود كمان فيني ابعتله ياه و هو مكتوب بالـ pascal لإنو السنة الماضية ما كنت بعرف غيرها

أنا ما كتير بعرف عن Huffman ..
و هي مزبوط انطلبت كوظيفة خوارزميات2 السنة الماضية ..
الفكرة فيها ضغض البيانات ..
بيستخدمو فيها بنية شجرة ثنائية و بيكون النص مخزن بالأوراق تبعوت هالشجرة ..
و بيكون عنوان ورقة ما X هو الطريق للورقة X ..
ذهاب يساري =1
ذهاب يميني=0
أو العكس ..

بتصور أنو الطلاب يلي اشتغلو فيها بيفيدونا أكتر بهالمسألة ..
(طلاب الثالثة - دمشق)

تدعى هذه الشجرة بشجرة هوفمان الثنائية Huffman Binary Tree، بعد بناء شجرة هوفمان يتم الترميز اعتماداً عليها فلترميز أي محرف نسند إلى الرمز الموافق السلسلة الخالية ونبدأ عند جذر شجرة هوفمان فإذا صعدنا نحو فرع يميني فإننا نضيف 1 إلى الرمز الموافق و إذا صعدنا إلى فرع يساري فإننا نضيف 0 إلى الرمز الموافق حتى نصل إلى الورقة المطابقة للحرف.
خوارزمية هوفمان Huffman Algorithm:
كيف يتم بناء شجرة هوفمان:
المعطيات: الأبجدية Σ والنص P
المخرجات: اللائحة L ثم الشجرة T

٨ αi є Σ ; f(i) = frequency(αi);
من أجل كل α تنتمي إلى الأبجدية Σ احسب تردد αi في P وهو f(i).
احشر (αi ، f(i)) في اللائحة L في موقعها المناسب مرتبة تصاعدياً بحسب قيمة f(i)

عندما ننتهي من بناء السلسلة نطبق ما يلي:

طالما i<length(P) كرر:
1-
o:=(αi + αi+1، f(i) + f(i+1))
o.left := (αi ، f(i))
o.right := ( αi+1 ، f(i+1))
2- احشر o في السلسلة
ولنوضح ذلك بشكل عملي :

نشكل لائحة مترابطة مبنية على المؤشرات وندع المؤشر يشير إلى بدايتها نضيف العناصر بشكل مرتب إلى هذه السلسلة كما يلي:
نحسب تردد كل محرف ونحشره بموقعه المناسب بواسطة التابع BuildList أي إذا كان لدينا المحارف الآتية مع تكرارها:
ونقوم بعملية الإضافة كما يلي:
نفحص أول عنصر في القائمة فإذا كان تردده أكبر من تردد المحرف الجديد إننا نجعل المحرف الجديد بداية السلسلة ونجعل المؤشر يشير إلى هذا المحرف أما إذا كان تردد الحرف الأول في السلسلة أصغر من تردد الحرف الجديد فإننا ننتقل إلى المحرف الثاني وهكذا إلى نصل إلى الموقع المناسب عندئذ نجعل مؤشر الحرف السابق لهذا الموقع في السلسلة يشير إلى الحرف الجديد ونجعل مؤشر هذا الأخير يشير إلى الموقع الذي كان يشير إليه المحرف السابق.
و يمثل الشكل التالي عملية بناء القائمة List وفقاً للإجراء Build():

عندما ننتهي من بناء القائمة سيكون علينا بناء الشجرة كما يلي:
نأخذ أول عنصرين من القائمة ونجعلهما ابنان يساري (للعنصر الأول) ويميني (للعنصر الثاني) لعنصر جديد محرفه هو مجموع المحرفين وتردده مجموع ترددي المحرفين ونحذف هذان العنصران من القائمة ثم نضيف العنصر الجديد وبموقعه المناسب بحسب تردده إلى القائمة ونكرر ذلك حتى يبقى هناك عنصر واحد في القائمة يصبح هو جذر شجرة هوفمان وتكون هذه الشجرة مرتبة على شكل كومة ثنائية إن محرف الجذر هو الأبجدية بكاملها وتردده هو طول النص.
تمثل الأوراق في الشجرة السابقة الأحرف الأصلية في النص والتي نريد الحصول على ترميزها.

و فيما يلي نبين كيفية تحويل القائمة إلى شجرة Huffman وفق الإجراء merge():

يتم الحصول على الترميز عن طريق التجول في الشجرة ابتداء من الجذر وانتهاء بالورقة، فكلما اتجهنا يمينا نضيف إلى الرمز 1 وكلما اتجهنا يساراً نضيف 0 وهكذا إلى أن نصل إلى ورقة، وبهذا الشكل نحصل على ترميز كل حرف حيث نلاحظ أنه تم ترميز الأحرف ذات التكرار الكبير بعدد صغير من الرموز والأحرف ذات التكرار الصغير بعدد كبير من الرموز، مما يؤدي إلى تصغير حجم النص المطلوب، وكتابته على القرص، ونجد أيضاً أنه لا يوجد ترميز لمحرف يشكل بادئة لترميز محرف آخر
لو كان فيني حط صور لوضت الشغلة أكتر....

ما بعرف ليش طلع التنسيق هيك .....
بس لوضوح أكتر انسخوها و عملوا الalignment على اليسار
ملاحظة : إذا حدا بوا الexe أو الsource ل ويندوز أو للينكس يقلي ....

شو قلبت بروجكتك على Linux ؟ ..
عن جد مبروك ... و عقبال عنا ..

فينك تنسق الكود بالشكل التالي:

[code ] code here [ /code ]

بس بدون فراغات.

النتيجة:

code here

جربت طلعت النتيجة أسوأ...

إذا فيك تظبطها انت بكون ممنون....

ما ظبطت، لانو عربي و انكليزي مع بعض.

but u consumed n^2 to build ur queue ...
I think it's the same ..or what....
if I didn't understand this ...plz tell me how did u build the first tree...

yeaaa that's good ...
and I think it's good to put this algorithm too.....

but I think u need O(n) to build the first heap

رح وضح كيف بنيت السلسلة المترابطة ......
استخدمت المؤشرات و أدخلت كل حرف جديد بمكانه ....على طريقة السلاسل الخطية يللي أخدناها السنة الماضية ...
بعتقد أنها ذات تعقيد O(n) time

(كتاب الخوارزميات 1 ص 147) ....
اما الإجراء build موجود بكتاب البرمجة 2 ص 92 و ص 93

بعدين عملت إجراء التحيل إلى شجرة ....
لمعلومات أكتر راجع كتاب intro to algorithms

مجرد مثال عن تقنية ضغط هوفمان :

http://ciips.ee.uwa.edu.au/~morris/Year2/PLDS210/huffman.html

في بآخرة الصفحة مثال تطبيقي عن التقنية من أولتا لآخرتا ..........
بس اضغط :
Run the Animation

Great applet!

لا تحتاج إلى شيء بعد بناء السلسلة الأولى O(n)0000
سوى أن تدمج كل أول عنصرين لتخلق العنصر الجديد ....ثم تضيفه إلى القائمة مرة أخرى وفي موقعه المناسب
o(n)+o(n)00
أي العمليتلن منفصلتان ....الثانية نحتاج إليها تماماً لأن العناصر جديدة ....
التعقيد هو كما أعتقد o(n)0
المثال بكتاب intro into algorithms
واضح كتير

الصفار منشان يزبط التنسيق

طيب، بهالحالة انت بتدمج عنصرين (n - 1) مرة ، مو لحتى تدمج أصغر عنصرين لازم تدور عليهن؟؟ يعني لازم تعمل 2(n - 1) عملية بحث.
كل عملية تدوير (بحث) بتاخد (n) لأنو البحث خطي (لا يمكن إلا البحث خطيا ففي هذه الحالة).
الكلفة الكلية: (n - 1) * (n) ~ (n ^ 2) ....... اتفقنا ولا لسا؟؟

لأ ما لازم تدور عليهم ....
عطول بتدمج أول عنصرين
ما السلسلة مرتبة ....

ammar_halaby محق

أنا استعملت linked list وما عملت temporary array

<br />
type st=string;<br />
type Hufft=^nod;<br />
     nod=record<br />
        left,right,next:Hufft;<br />
        symbol:String;<br />
        Frq:integer;<br />
        isLeaf:boolean;<br />
     end;<br />
procedure BuildList(var tree:Hufft;f1:integer;s:st;b:boolean;l,r:hufft);<br />
var p,n1,pr:Hufft;<br />
begin<br />
  if tree=nil then<br />
  begin<br />
  new(tree);<br />
tree^.next:=nil;<br />
tree^.isLeaf:=b;<br />
    if b then begin</p>
<p>  tree^.left:=nil;<br />
  tree^.right:=nil;<br />
  end<br />
  else<br />
  begin<br />
  tree^.left:=l;<br />
  tree^.right:=r;<br />
  end ;</p>
<p>tree^.symbol:=s;</p>
<p>tree^.Frq:=f1;<br />
  end<br />
else<br />
if (f1<tree^.Frq) or  ((tree^.Frq =f1) and (tree^.symbol>s)) then<br />
begin<br />
new(n1);<br />
n1^.next:=tree;</p>
<p>n1^.Frq:=f1;<br />
n1^.symbol:=s;<br />
n1^.isLeaf:=b;<br />
  if b then<br />
  begin<br />
n1^.left:=nil;<br />
n1^.right:=nil;<br />
  end<br />
  else<br />
begin<br />
n1^.right:=r;<br />
n1^.left:=l;<br />
end;<br />
tree:=n1;<br />
end<br />
else<br />
begin<br />
p:=tree;pr:=p;<br />
while(p<>nil) and ( (p^.Frq <=f1) or ((p^.Frq =f1) and (p^.symbol<s))   ) do<br />
begin</p>
<p>pr:=p;<br />
p:=p^.next;<br />
end;</p>
<p>begin<br />
new(n1);<br />
n1^.next:=p;<br />
n1^.isLeaf:=b;<br />
n1^.Frq:=f1;<br />
n1^.symbol:=s;<br />
  if b then<br />
  begin<br />
n1^.right:=nil;<br />
n1^.left:=nil;<br />
  end<br />
else<br />
begin<br />
n1^.right:=r;<br />
n1^.left:=l;<br />
end;<br />
pr^.next:=n1;<br />
end;</p>
<p>end;</p>
<p>end;<br />
procedure merge(var list:Hufft;var z:Hufft);<br />
var q:Hufft;</p>
<p>begin<br />
        new(q);</p>
<p>if list^.next^.next<>nil then<br />
     begin<br />
      z:=list^.next^.next ;<br />
       list^.next^.next:=nil; //i<br />
        q^.left:=list;<br />
      q^.right:=list^.next;<br />
         list^.next:=nil;          //i<br />
      q^.isLeaf:=false;<br />
      q^.Frq:=q^.left^.Frq + q^.right^.Frq;<br />
    q^.next:=nil;<br />
       q^.symbol:=q^.right^.symbol + q^.left^.symbol;<br />
        BuildList(z,q^.Frq,q^.symbol,q^.isLeaf,q^.left,q^.right);</p>
<p>      end<br />
else<br />
   begin</p>
<p>   q^.left:=list;<br />
      q^.right:=list^.next;<br />
     list^.next:=nil;//ii</p>
<p>         q^.isLeaf:=false;<br />
      q^.Frq:=q^.right^.Frq + q^.left^.Frq ;<br />
      q^.next:=nil;<br />
       q^.symbol:=q^.right^.symbol + q^.left^.symbol;</p>
<p>       z:=q;</p>
<p>end;<br />
end;

هدا جزء من الكود
ال symbol و ترتيبه كان فزلكة...

بس عم يستدعى بعد بناء السلسلة المرتبة ...و بظن الخلاف كان هنيك ....
الإستدعاء كان للعنصر الجديد يعني كأنك زدت عدد العناصر بس ...من n ل n+n/2

ما صحي ولا....

بعدين باللينك يللي فوق (مشاركة rima) في animation
متبعين فيه نفس طريقتي

أولا: مشاركة Rima ماي نفس طريقتك لأنو مستخدمين Heap structure يللي حكيت عليها سابقاً.
ثانياً: المهم أنو تعقيد BuildList = O(n) 0 في حال كانت السلسلة مرتبة ولا مفشكلة، يعني بكل الأحوال نفس الشي O(n^2) 0.
ثالثاً: كأنو مناقشتنا صارت بلا طعمة، شو رأيك نتقاتل حول إذا كانت طريقتك O(n.Log(n)) 0 ولا لأ......لأنو متل ما قلت من قبل: لا يمكن تكون طريقتك أفضل من O(n.Log(n)) 0.

تصطفل ....أنا عبرت عن رأيي ....و حطيت الكود ...
طبعاً الشجرة كاملة ما معؤول تكون o(n)
طريقة بناء السلسلة المرتبة o(n) ولا لأ .....
راجعت كتاب intro to algorithm ???
شوف الشكل 17-5 بتلاقي نفس الطريقة يللي متبعة انا ببناء الشجرة .....

عا كل حال يا استاذ مارح إزعجك أكتر لأني بعد بكرا رايح ع المعسكر....

شغلة تانية animation يللي بلينك rima متبع نفس طريقتي .....
سواء ببناء السلسلة أو ببناء الشجرة يللي ما بظن إنا متقاتلين منشانها .....
ع كل الأحوال إذا كنت مقتنع أنو طريقتي بتكلف (n^2)
فهادي مشكلتك لأنوا وضحت بما فيه الكفاية ....

Never Mind Baby ...
ur welcome

smashing/

بس ما قلتلي شو صار معك

Thank you Kinan very much for your explanations.

Thank you ammar_halaby very much for your analysis.

It doesn't deserves to make such a confusion.

For you Kinan, you should accepts others' criticism, while you ammar_halaby should express your ideas in a less sharp manner.

Above all, the truth is our purpose as students.

We all have ideas and should discuss about them to improve correct ones and get rid of wrong ones. This is the scientific discussion process by defintion.
The aim isn't to succeed or to show that others' ideas are incorrect.
The success is when we cooperate and guide each others to conclude the right conclusion.

I wish no one gets confused.

Hi Kinan,

Suppose the following list of frequencies values 1,2,3,4,.....,n.
For the first element we need one comparison, for the second element which is 2 we need 2 comparisons and so on. so we fine that the total complexity is :

1+2+3+4+5+.....+n = ?

Using Heap costs n.log(n) only. Do you agree?? so Ammar's opinon is the right one.

Ammar_halaby i think Heap data structure is used as Min or Max Priority Queue so no reason to cosider them different.

Ok tht's n)n+1)/2
but in the worst case ....
I thought that it will b like the comlexity of the hash table

coz it uses the same tichniqe but after discussing it with ammar tha't was not accurate ....

مشكورين اخاني كلكم بس انا مشكلتي انة لازم افهمها من الداخل لاني احاول اعمل ملف ضغط صغير باستخدام هوفمان بلغة السي شارب عشان هيك بدي افهمها هية وعمل البوينتير في نفس اللغة

السلام عليكم ورحمة الله وبركاته
اود ان اشكركم على المعلومات القيمه التي استفدت منها بشكل كبير
ولكن لدي سؤال بسيط اذا سمحتم واريد مساعدتكم في الاجابه عليه:
كما تعلمون جميعا ان تقنية هوفمان لضغط الصور هي واحده من العديد من التقنيات وانا درستها كمشروع تخرج وفهمتها ولله الحمد ولكن هناك تقنية اخرى تدعى الفراكتل fractal بصراحه لم افهمها جيدا واريد ولو فكره بسيطه عنها اذا سمحتم

مرفق هنا تكويد لضغط الصور فقط باستخدام هوفمان يمكن استخدامة فى هذه التقنية

Private Const PROGRESS_CALCFREQUENCY = 7
Private Const PROGRESS_CALCCRC = 5
Private Const PROGRESS_ENCODING = 88

'Progress Values for the decoding routine
Private Const PROGRESS_DECODING = 89
Private Const PROGRESS_CHECKCRC = 11

'Events
Event Progress(Procent As Integer)

Private Type HUFFMANTREE
ParentNode As Integer
RightNode As Integer
LeftNode As Integer
Value As Integer
Weight As Long
End Type

Private Type ByteArray
Count As Byte
Data() As Byte
End Type

Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Sub EncodeFile(SourceFile As String, DestFile As String)

Dim ByteArray() As Byte
Dim Filenr As Integer

'Make sure the source file exists
If (Not FileExist(SourceFile)) Then
Err.Raise vbObjectError, "clsHuffman.EncodeFile()", "Source file does not exist"
End If

'Read the data from the sourcefile
Filenr = FreeFile
Open SourceFile For Binary As #Filenr
ReDim ByteArray(0 To LOF(Filenr) - 1)
Get #Filenr, , ByteArray()
Close #Filenr

'Compress the data
Call EncodeByte(ByteArray(), UBound(ByteArray) + 1)

'If the destination file exist we need to
'destroy it because opening it as binary
'will not clear the old data
If (FileExist(DestFile)) Then Kill DestFile

'Save the destination string
Open DestFile For Binary As #Filenr
Put #Filenr, , ByteArray()
Close #Filenr

End Sub

Private Sub CreateTree(Nodes() As HUFFMANTREE, NodesCount As Long, Char As Long, Bytes As ByteArray)

Dim a As Integer
Dim NodeIndex As Long

NodeIndex = 0
For a = 0 To (Bytes.Count - 1)
If (Bytes.Data(a) = 0) Then
'Left node
If (Nodes(NodeIndex).LeftNode = -1) Then
Nodes(NodeIndex).LeftNode = NodesCount
Nodes(NodesCount).ParentNode = NodeIndex
Nodes(NodesCount).LeftNode = -1
Nodes(NodesCount).RightNode = -1
Nodes(NodesCount).Value = -1
NodesCount = NodesCount + 1
End If
NodeIndex = Nodes(NodeIndex).LeftNode
ElseIf (Bytes.Data(a) = 1) Then
'Right node
If (Nodes(NodeIndex).RightNode = -1) Then
Nodes(NodeIndex).RightNode = NodesCount
Nodes(NodesCount).ParentNode = NodeIndex
Nodes(NodesCount).LeftNode = -1
Nodes(NodesCount).RightNode = -1
Nodes(NodesCount).Value = -1
NodesCount = NodesCount + 1
End If
NodeIndex = Nodes(NodeIndex).RightNode
Else
Stop
End If
Next

Nodes(NodeIndex).Value = Char

End Sub
Public Sub EncodeByte(ByteArray() As Byte, ByteLen As Long)

Dim i As Long
Dim j As Long
Dim Char As Byte
Dim BitPos As Byte
Dim lNode1 As Long
Dim lNode2 As Long
Dim lNodes As Long
Dim lLength As Long
Dim Count As Integer
Dim lWeight1 As Long
Dim lWeight2 As Long
Dim Result() As Byte
Dim ByteValue As Byte
Dim ResultLen As Long
Dim Bytes As ByteArray
Dim NodesCount As Integer
Dim NewProgress As Integer
Dim CurrProgress As Integer
Dim BitValue(0 To 7) As Byte
Dim CharCount(0 To 255) As Long
Dim Nodes(0 To 511) As HUFFMANTREE
Dim CharValue(0 To 255) As ByteArray

'If the source string is empty or contains
'only one character we return it uncompressed
'with the prefix string "HEO" & vbCr
If (ByteLen = 0) Then
ReDim Preserve ByteArray(0 To ByteLen + 3)
If (ByteLen > 0) Then
Call CopyMem(ByteArray(4), ByteArray(0), ByteLen)
End If
ByteArray(0) = 72 '"H"
ByteArray(1) = 69 '"E"
ByteArray(2) = 48 '"0"
ByteArray(3) = 13 'vbCr
Exit Sub
End If

'Create the temporary result array and make
'space for identifier, checksum, textlen and
'the ASCII values inside the Huffman Tree
ReDim Result(0 To 522)

'Prefix the destination string with the
'"HE3" & vbCr identification string
Result(0) = 72
Result(1) = 69
Result(2) = 51
Result(3) = 13
ResultLen = 4

'Count the frequency of each ASCII code
For i = 0 To (ByteLen - 1)
CharCount(ByteArray(i)) = CharCount(ByteArray(i)) + 1
If (i Mod 1000 = 0) Then
NewProgress = i / ByteLen * PROGRESS_CALCFREQUENCY
If (NewProgress <> CurrProgress) Then
CurrProgress = NewProgress
RaiseEvent Progress(CurrProgress)
End If
End If
Next

'Create a leaf for each character
For i = 0 To 255
If (CharCount(i) > 0) Then
With Nodes(NodesCount)
.Weight = CharCount(i)
.Value = i
.LeftNode = -1
.RightNode = -1
.ParentNode = -1
End With
NodesCount = NodesCount + 1
End If
Next

'Create the Huffman Tree
For lNodes = NodesCount To 2 Step -1
'Get the two leafs with the smallest weights
lNode1 = -1: lNode2 = -1
For i = 0 To (NodesCount - 1)
If (Nodes(i).ParentNode = -1) Then
If (lNode1 = -1) Then
lWeight1 = Nodes(i).Weight
lNode1 = i
ElseIf (lNode2 = -1) Then
lWeight2 = Nodes(i).Weight
lNode2 = i
ElseIf (Nodes(i).Weight < lWeight1) Then
If (Nodes(i).Weight < lWeight2) Then
If (lWeight1 < lWeight2) Then
lWeight2 = Nodes(i).Weight
lNode2 = i
Else
lWeight1 = Nodes(i).Weight
lNode1 = i
End If
Else
lWeight1 = Nodes(i).Weight
lNode1 = i
End If
ElseIf (Nodes(i).Weight < lWeight2) Then
lWeight2 = Nodes(i).Weight
lNode2 = i
End If
End If
Next

'Create a new leaf
With Nodes(NodesCount)
.Weight = lWeight1 + lWeight2
.LeftNode = lNode1
.RightNode = lNode2
.ParentNode = -1
.Value = -1
End With

'Set the parentnodes of the two leafs
Nodes(lNode1).ParentNode = NodesCount
Nodes(lNode2).ParentNode = NodesCount

'Increase the node counter
NodesCount = NodesCount + 1
Next

'Traverse the tree to get the bit sequence
'for each character, make temporary room in
'the data array to hold max theoretical size
ReDim Bytes.Data(0 To 255)
Call CreateBitSequences(Nodes(), NodesCount - 1, Bytes, CharValue)

'Calculate the length of the destination
'string after encoding
For i = 0 To 255
If (CharCount(i) > 0) Then
lLength = lLength + CharValue(i).Count * CharCount(i)
End If
Next
lLength = IIf(lLength Mod 8 = 0, lLength \ 8, lLength \ 8 + 1)

'If the destination is larger than the source
'string we leave it uncompressed and prefix
'it with a 4 byte header ("HE0" & vbCr)
If ((lLength = 0) Or (lLength > ByteLen)) Then
ReDim Preserve ByteArray(0 To ByteLen + 3)
Call CopyMem(ByteArray(4), ByteArray(0), ByteLen)
ByteArray(0) = 72
ByteArray(1) = 69
ByteArray(2) = 48
ByteArray(3) = 13
Exit Sub
End If

'Add a simple checksum value to the result
'header for corruption identification
Char = 0
For i = 0 To (ByteLen - 1)
Char = Char Xor ByteArray(i)
If (i Mod 10000 = 0) Then
NewProgress = i / ByteLen * PROGRESS_CALCCRC + PROGRESS_CALCFREQUENCY
If (NewProgress <> CurrProgress) Then
CurrProgress = NewProgress
RaiseEvent Progress(CurrProgress)
End If
End If
Next
Result(ResultLen) = Char
ResultLen = ResultLen + 1

'Add the length of the source string to the
'header for corruption identification
Call CopyMem(Result(ResultLen), ByteLen, 4)
ResultLen = ResultLen + 4

'Create a small array to hold the bit values,
'this is faster than calculating on-fly
For i = 0 To 7
BitValue(i) = 2 ^ i
Next

'Store the number of characters used
Count = 0
For i = 0 To 255
If (CharValue(i).Count > 0) Then
Count = Count + 1
End If
Next
Call CopyMem(Result(ResultLen), Count, 2)
ResultLen = ResultLen + 2

'Store the used characters and the length
'of their respective bit sequences
Count = 0
For i = 0 To 255
If (CharValue(i).Count > 0) Then
Result(ResultLen) = i
ResultLen = ResultLen + 1
Result(ResultLen) = CharValue(i).Count
ResultLen = ResultLen + 1
Count = Count + 16 + CharValue(i).Count
End If
Next

'Make room for the Huffman Tree in the
'destination byte array
ReDim Preserve Result(0 To ResultLen + Count \

'Store the Huffman Tree into the result
'converting the bit sequences into bytes
BitPos = 0
ByteValue = 0
For i = 0 To 255
With CharValue(i)
If (.Count > 0) Then
For j = 0 To (.Count - 1)
If (.Data(j)) Then ByteValue = ByteValue + BitValue(BitPos)
BitPos = BitPos + 1
If (BitPos = Then
Result(ResultLen) = ByteValue
ResultLen = ResultLen + 1
ByteValue = 0
BitPos = 0
End If
Next
End If
End With
Next
If (BitPos > 0) Then
Result(ResultLen) = ByteValue
ResultLen = ResultLen + 1
End If

'Resize the destination string to be able to
'contain the encoded string
ReDim Preserve Result(0 To ResultLen - 1 + lLength)

'Now we can encode the data by exchanging each
'ASCII byte for its appropriate bit string.
Char = 0
BitPos = 0
For i = 0 To (ByteLen - 1)
With CharValue(ByteArray(i))
For j = 0 To (.Count - 1)
If (.Data(j) = 1) Then Char = Char + BitValue(BitPos)
BitPos = BitPos + 1
If (BitPos = Then
Result(ResultLen) = Char
ResultLen = ResultLen + 1
BitPos = 0
Char = 0
End If
Next
End With
If (i Mod 10000 = 0) Then
NewProgress = i / ByteLen * PROGRESS_ENCODING + PROGRESS_CALCCRC + PROGRESS_CALCFREQUENCY
If (NewProgress <> CurrProgress) Then
CurrProgress = NewProgress
RaiseEvent Progress(CurrProgress)
End If
End If
Next

'Add the last byte
If (BitPos > 0) Then
Result(ResultLen) = Char
ResultLen = ResultLen + 1
End If

'Return the destination in string format
ReDim ByteArray(0 To ResultLen - 1)
Call CopyMem(ByteArray(0), Result(0), ResultLen)

'Make sure we get a "100%" progress message
If (CurrProgress <> 100) Then
RaiseEvent Progress(100)
End If

End Sub
Private Sub CreateBitSequences(Nodes() As HUFFMANTREE, ByVal NodeIndex As Integer, Bytes As ByteArray, CharValue() As ByteArray)

Dim NewBytes As ByteArray

'If this is a leaf we set the characters bit
'sequence in the CharValue array
If (Nodes(NodeIndex).Value > -1) Then
CharValue(Nodes(NodeIndex).Value) = Bytes
Exit Sub
End If

'Traverse the left child
If (Nodes(NodeIndex).LeftNode > -1) Then
NewBytes = Bytes
NewBytes.Data(NewBytes.Count) = 0
NewBytes.Count = NewBytes.Count + 1
Call CreateBitSequences(Nodes(), Nodes(NodeIndex).LeftNode, NewBytes, CharValue)
End If

'Traverse the right child
If (Nodes(NodeIndex).RightNode > -1) Then
NewBytes = Bytes
NewBytes.Data(NewBytes.Count) = 1
NewBytes.Count = NewBytes.Count + 1
Call CreateBitSequences(Nodes(), Nodes(NodeIndex).RightNode, NewBytes, CharValue)
End If

End Sub

استخدم هذا الكود لتقنية الضغط بهوفمان

Private Const PROGRESS_CALCFREQUENCY = 7
Private Const PROGRESS_CALCCRC = 5
Private Const PROGRESS_ENCODING = 88

'Progress Values for the decoding routine
Private Const PROGRESS_DECODING = 89
Private Const PROGRESS_CHECKCRC = 11

'Events
Event Progress(Procent As Integer)

Private Type HUFFMANTREE
ParentNode As Integer
RightNode As Integer
LeftNode As Integer
Value As Integer
Weight As Long
End Type

Private Type ByteArray
Count As Byte
Data() As Byte
End Type

Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Sub EncodeFile(SourceFile As String, DestFile As String)

Dim ByteArray() As Byte
Dim Filenr As Integer

'Make sure the source file exists
If (Not FileExist(SourceFile)) Then
Err.Raise vbObjectError, "clsHuffman.EncodeFile()", "Source file does not exist"
End If

'Read the data from the sourcefile
Filenr = FreeFile
Open SourceFile For Binary As #Filenr
ReDim ByteArray(0 To LOF(Filenr) - 1)
Get #Filenr, , ByteArray()
Close #Filenr

'Compress the data
Call EncodeByte(ByteArray(), UBound(ByteArray) + 1)

'If the destination file exist we need to
'destroy it because opening it as binary
'will not clear the old data
If (FileExist(DestFile)) Then Kill DestFile

'Save the destination string
Open DestFile For Binary As #Filenr
Put #Filenr, , ByteArray()
Close #Filenr

End Sub

Private Sub CreateTree(Nodes() As HUFFMANTREE, NodesCount As Long, Char As Long, Bytes As ByteArray)

Dim a As Integer
Dim NodeIndex As Long

NodeIndex = 0
For a = 0 To (Bytes.Count - 1)
If (Bytes.Data(a) = 0) Then
'Left node
If (Nodes(NodeIndex).LeftNode = -1) Then
Nodes(NodeIndex).LeftNode = NodesCount
Nodes(NodesCount).ParentNode = NodeIndex
Nodes(NodesCount).LeftNode = -1
Nodes(NodesCount).RightNode = -1
Nodes(NodesCount).Value = -1
NodesCount = NodesCount + 1
End If
NodeIndex = Nodes(NodeIndex).LeftNode
ElseIf (Bytes.Data(a) = 1) Then
'Right node
If (Nodes(NodeIndex).RightNode = -1) Then
Nodes(NodeIndex).RightNode = NodesCount
Nodes(NodesCount).ParentNode = NodeIndex
Nodes(NodesCount).LeftNode = -1
Nodes(NodesCount).RightNode = -1
Nodes(NodesCount).Value = -1
NodesCount = NodesCount + 1
End If
NodeIndex = Nodes(NodeIndex).RightNode
Else
Stop
End If
Next

Nodes(NodeIndex).Value = Char

End Sub
Public Sub EncodeByte(ByteArray() As Byte, ByteLen As Long)

Dim i As Long
Dim j As Long
Dim Char As Byte
Dim BitPos As Byte
Dim lNode1 As Long
Dim lNode2 As Long
Dim lNodes As Long
Dim lLength As Long
Dim Count As Integer
Dim lWeight1 As Long
Dim lWeight2 As Long
Dim Result() As Byte
Dim ByteValue As Byte
Dim ResultLen As Long
Dim Bytes As ByteArray
Dim NodesCount As Integer
Dim NewProgress As Integer
Dim CurrProgress As Integer
Dim BitValue(0 To 7) As Byte
Dim CharCount(0 To 255) As Long
Dim Nodes(0 To 511) As HUFFMANTREE
Dim CharValue(0 To 255) As ByteArray

'If the source string is empty or contains
'only one character we return it uncompressed
'with the prefix string "HEO" & vbCr
If (ByteLen = 0) Then
ReDim Preserve ByteArray(0 To ByteLen + 3)
If (ByteLen > 0) Then
Call CopyMem(ByteArray(4), ByteArray(0), ByteLen)
End If
ByteArray(0) = 72 '"H"
ByteArray(1) = 69 '"E"
ByteArray(2) = 48 '"0"
ByteArray(3) = 13 'vbCr
Exit Sub
End If

'Create the temporary result array and make
'space for identifier, checksum, textlen and
'the ASCII values inside the Huffman Tree
ReDim Result(0 To 522)

'Prefix the destination string with the
'"HE3" & vbCr identification string
Result(0) = 72
Result(1) = 69
Result(2) = 51
Result(3) = 13
ResultLen = 4

'Count the frequency of each ASCII code
For i = 0 To (ByteLen - 1)
CharCount(ByteArray(i)) = CharCount(ByteArray(i)) + 1
If (i Mod 1000 = 0) Then
NewProgress = i / ByteLen * PROGRESS_CALCFREQUENCY
If (NewProgress <> CurrProgress) Then
CurrProgress = NewProgress
RaiseEvent Progress(CurrProgress)
End If
End If
Next

'Create a leaf for each character
For i = 0 To 255
If (CharCount(i) > 0) Then
With Nodes(NodesCount)
.Weight = CharCount(i)
.Value = i
.LeftNode = -1
.RightNode = -1
.ParentNode = -1
End With
NodesCount = NodesCount + 1
End If
Next

'Create the Huffman Tree
For lNodes = NodesCount To 2 Step -1
'Get the two leafs with the smallest weights
lNode1 = -1: lNode2 = -1
For i = 0 To (NodesCount - 1)
If (Nodes(i).ParentNode = -1) Then
If (lNode1 = -1) Then
lWeight1 = Nodes(i).Weight
lNode1 = i
ElseIf (lNode2 = -1) Then
lWeight2 = Nodes(i).Weight
lNode2 = i
ElseIf (Nodes(i).Weight < lWeight1) Then
If (Nodes(i).Weight < lWeight2) Then
If (lWeight1 < lWeight2) Then
lWeight2 = Nodes(i).Weight
lNode2 = i
Else
lWeight1 = Nodes(i).Weight
lNode1 = i
End If
Else
lWeight1 = Nodes(i).Weight
lNode1 = i
End If
ElseIf (Nodes(i).Weight < lWeight2) Then
lWeight2 = Nodes(i).Weight
lNode2 = i
End If
End If
Next

'Create a new leaf
With Nodes(NodesCount)
.Weight = lWeight1 + lWeight2
.LeftNode = lNode1
.RightNode = lNode2
.ParentNode = -1
.Value = -1
End With

'Set the parentnodes of the two leafs
Nodes(lNode1).ParentNode = NodesCount
Nodes(lNode2).ParentNode = NodesCount

'Increase the node counter
NodesCount = NodesCount + 1
Next

'Traverse the tree to get the bit sequence
'for each character, make temporary room in
'the data array to hold max theoretical size
ReDim Bytes.Data(0 To 255)
Call CreateBitSequences(Nodes(), NodesCount - 1, Bytes, CharValue)

'Calculate the length of the destination
'string after encoding
For i = 0 To 255
If (CharCount(i) > 0) Then
lLength = lLength + CharValue(i).Count * CharCount(i)
End If
Next
lLength = IIf(lLength Mod 8 = 0, lLength \ 8, lLength \ 8 + 1)

'If the destination is larger than the source
'string we leave it uncompressed and prefix
'it with a 4 byte header ("HE0" & vbCr)
If ((lLength = 0) Or (lLength > ByteLen)) Then
ReDim Preserve ByteArray(0 To ByteLen + 3)
Call CopyMem(ByteArray(4), ByteArray(0), ByteLen)
ByteArray(0) = 72
ByteArray(1) = 69
ByteArray(2) = 48
ByteArray(3) = 13
Exit Sub
End If

'Add a simple checksum value to the result
'header for corruption identification
Char = 0
For i = 0 To (ByteLen - 1)
Char = Char Xor ByteArray(i)
If (i Mod 10000 = 0) Then
NewProgress = i / ByteLen * PROGRESS_CALCCRC + PROGRESS_CALCFREQUENCY
If (NewProgress <> CurrProgress) Then
CurrProgress = NewProgress
RaiseEvent Progress(CurrProgress)
End If
End If
Next
Result(ResultLen) = Char
ResultLen = ResultLen + 1

'Add the length of the source string to the
'header for corruption identification
Call CopyMem(Result(ResultLen), ByteLen, 4)
ResultLen = ResultLen + 4

'Create a small array to hold the bit values,
'this is faster than calculating on-fly
For i = 0 To 7
BitValue(i) = 2 ^ i
Next

'Store the number of characters used
Count = 0
For i = 0 To 255
If (CharValue(i).Count > 0) Then
Count = Count + 1
End If
Next
Call CopyMem(Result(ResultLen), Count, 2)
ResultLen = ResultLen + 2

'Store the used characters and the length
'of their respective bit sequences
Count = 0
For i = 0 To 255
If (CharValue(i).Count > 0) Then
Result(ResultLen) = i
ResultLen = ResultLen + 1
Result(ResultLen) = CharValue(i).Count
ResultLen = ResultLen + 1
Count = Count + 16 + CharValue(i).Count
End If
Next

'Make room for the Huffman Tree in the
'destination byte array
ReDim Preserve Result(0 To ResultLen + Count \

'Store the Huffman Tree into the result
'converting the bit sequences into bytes
BitPos = 0
ByteValue = 0
For i = 0 To 255
With CharValue(i)
If (.Count > 0) Then
For j = 0 To (.Count - 1)
If (.Data(j)) Then ByteValue = ByteValue + BitValue(BitPos)
BitPos = BitPos + 1
If (BitPos = Then
Result(ResultLen) = ByteValue
ResultLen = ResultLen + 1
ByteValue = 0
BitPos = 0
End If
Next
End If
End With
Next
If (BitPos > 0) Then
Result(ResultLen) = ByteValue
ResultLen = ResultLen + 1
End If

'Resize the destination string to be able to
'contain the encoded string
ReDim Preserve Result(0 To ResultLen - 1 + lLength)

'Now we can encode the data by exchanging each
'ASCII byte for its appropriate bit string.
Char = 0
BitPos = 0
For i = 0 To (ByteLen - 1)
With CharValue(ByteArray(i))
For j = 0 To (.Count - 1)
If (.Data(j) = 1) Then Char = Char + BitValue(BitPos)
BitPos = BitPos + 1
If (BitPos = Then
Result(ResultLen) = Char
ResultLen = ResultLen + 1
BitPos = 0
Char = 0
End If
Next
End With
If (i Mod 10000 = 0) Then
NewProgress = i / ByteLen * PROGRESS_ENCODING + PROGRESS_CALCCRC + PROGRESS_CALCFREQUENCY
If (NewProgress <> CurrProgress) Then
CurrProgress = NewProgress
RaiseEvent Progress(CurrProgress)
End If
End If
Next

'Add the last byte
If (BitPos > 0) Then
Result(ResultLen) = Char
ResultLen = ResultLen + 1
End If

'Return the destination in string format
ReDim ByteArray(0 To ResultLen - 1)
Call CopyMem(ByteArray(0), Result(0), ResultLen)

'Make sure we get a "100%" progress message
If (CurrProgress <> 100) Then
RaiseEvent Progress(100)
End If

End Sub
Private Sub CreateBitSequences(Nodes() As HUFFMANTREE, ByVal NodeIndex As Integer, Bytes As ByteArray, CharValue() As ByteArray)

Dim NewBytes As ByteArray

'If this is a leaf we set the characters bit
'sequence in the CharValue array
If (Nodes(NodeIndex).Value > -1) Then
CharValue(Nodes(NodeIndex).Value) = Bytes
Exit Sub
End If

'Traverse the left child
If (Nodes(NodeIndex).LeftNode > -1) Then
NewBytes = Bytes
NewBytes.Data(NewBytes.Count) = 0
NewBytes.Count = NewBytes.Count + 1
Call CreateBitSequences(Nodes(), Nodes(NodeIndex).LeftNode, NewBytes, CharValue)
End If

'Traverse the right child
If (Nodes(NodeIndex).RightNode > -1) Then
NewBytes = Bytes
NewBytes.Data(NewBytes.Count) = 1
NewBytes.Count = NewBytes.Count + 1
Call CreateBitSequences(Nodes(), Nodes(NodeIndex).RightNode, NewBytes, CharValue)
End If

End Sub

مساء الخير

يبدو اني وصلت متاخرا

لا شك ان تقنية هوفمان تعتبر من اهم التقنيات في ضغط البيانات هي ليست الافضل لكنها فتحت الباب بمصراعيه لبناء تقنيات جديدة للضغط

على كل الضغط نوعان

نوع لا يتم فقد اي جزء من البيانات فيه loseless و تعتبر
rle
hufman
lzw
و غيرها من الطرق ضمن هذا النوع

و نوع اخر فيه فقدان للبيانات او دقتها لصالح زيادة كمش البيانات lossy

ويوجد اساليب كثيرة ولكنه اكثر تعقيد

و بالنيبة لاسلوب هوفمان اعتقد ان وضع الصور هي الطريقة الافضل لتوضيحه

وتحية