The Adventurers' Guild

Posted: **Thu Dec 22, 2011 1:48 pm**

Succes!
I managed to complete my script. It can now create a Huffman tree out of a txt file using vbscript

When I launch my script on the example text I used above, I get the following result:

SYMBOL	WEIGHT	HUFFMAN CODE
46		1		001110
72		1		001111
73		1		100010
84		1		100011
100		1		100110
114		1		100111
117		1		101010
119		1		101011
99		2		00110
108		2		10000
109		2		10010
111		2		10100
102		3		11010
104		3		11011
110		3		0010
97		5		1011
105		5		1100
115		6		1110
116		6		1111
101		7		000
32		15		01

I'll see if I can post the script also... it's quite long

Posted: **Fri Dec 23, 2011 8:12 am**

And here's the script:

Code: Select all

Dim objFSO, objCodedFile, objTextFile 
Dim strCharacter
Dim strHuffVal
Dim strCount, tmpCount, tmpFreq1, tmpFreq2
Dim arrHuff(255)
Dim arrHuffVal(255)
Dim arrHuffChar(255)
Dim arrHuffNewVal(255)
Dim arrHuffLeftChild(255)
Dim arrHuffRightChild(255)
Dim arrHuffNewLeftChild(255)
Dim arrHuffNewRightChild(255)
Dim arrHuffCode(255)
Dim arrHuffFinalCode(255)

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objTextFile = objFSO.OpenTextFile ("C:\Huffman\test.txt", 1) 
Set objCodedFile = objFSO.OpenTextFile ("C:\Huffman\coded_test.txt", 8, True) 
strCount = 0

Do Until objTextFile.AtEndOfStream 
  strCharacter = objTextFile.Read(1)
  strHuffVal = asc(strCharacter)
  arrHuff(strHuffVal) = arrHuff(strHuffVal) + 1
  strCharacter = ""
  strHuffVal = ""
  strTotalChar = strTotalChar + 1
Loop 

sub_remove_blanks
sub_sort

k=1
l=1
c=1
tmpFreq1=arrHuffVal(k)
tmpFreq2=arrHuffVal(k+1)
arrHuffNewVal(l)=tmpFreq1+tmpFreq2
arrHuffLeftChild(c)=k
arrHuffRightChild(c)=k+1
k=k+2
c=c+1

do until arrHuffNewVal(c-1) >= strTotalChar
  if arrHuffVal(k) = 0 then
    arrHuffVal(k) = arrHuffVal(k)+strTotalChar+1
  end if
  if arrHuffVal(k) <= arrHuffNewVal(l) then
    tmpFreq1 = arrHuffVal(k)
    arrHuffLeftChild(c)=k
    k=k+1
    if arrHuffVal(k) < arrHuffNewVal(l) then
      tmpFreq2 = arrHuffVal(k)
      arrHuffRightChild(c)=k
      k=k+1
    else
      tmpFreq2 = arrHuffNewVal(l)
      arrHuffNewRightChild(c)=l
      l=l+1
    end if
  else
    tmpFreq1 = arrHuffNewVal(l)
    arrHuffNewLeftChild(c)=l
    l=l+1
    if arrHuffVal(k) <= arrHuffNewVal(l) then
      tmpFreq2 = arrHuffVal(k)
      arrHuffRightChild(c)=k
      k=k+1
    else
      tmpFreq2 = arrHuffNewVal(l)
      arrHuffNewRightChild(c)=l
      l=l+1
    end if
  end if
  arrHuffNewVal(c) = tmpFreq1 + tmpFreq2
  c=c+1
  sub_remove_new_blanks
  sub_new_sort
loop

  for x = c-1 to 1 step -1
    strParentCode=arrHuffCode(x)
    if arrHuffLeftChild(x)<>"" then
      y=arrHuffLeftChild(x)
      arrHuffCode(y)=strParentCode&"0"
    end if
    if arrHuffRightChild(x)<>"" then
      y=arrHuffRightChild(x)
      arrHuffCode(y)=strParentCode&"1"
    end if
    if arrHuffNewLeftChild(x)<>"" then
      y=arrHuffNewLeftChild(x)
      arrHuffCode(y)=strParentCode&"0"
    end if
    if arrHuffNewRightChild(x)<>"" then
      y=arrHuffNewRightChild(x)
      arrHuffCode(y)=strParentCode&"1"
    end if
  next

  for x = c-1 to 1 step -1
    if arrHuffLeftChild(x)<>"" then
      y=arrHuffLeftChild(x)
      z=arrHuffCode(x)
      arrHuffFinalCode(y)=z&"0"
    end if
    if arrHuffRightChild(x)<>"" then
      y=arrHuffRightChild(x)
      z=arrHuffCode(x)
      arrHuffFinalCode(y)=z&"1"
    end if
  next

  objCodedFile.Writeline("SYMBOL" & chr(9) & "WEIGHT" & chr(9) & "HUFFMAN CODE")

  for x = 1 to tmpCount
    objCodedFile.Writeline(chr(34) & chr(arrHuffChar(x)) & chr(34) & chr(9) & arrHuffVal(x) & chr(9) & arrHuffcode(x))
  next

sub sub_remove_blanks 'removes blanks from the array 
for i = 0 to 255
  strCount = arrHuff(i)
  if strCOunt = "" then
  'do nothing
  else
  tmpCount = tmpCount + 1
  arrHuffVal(tmpCount) = arrHuff(i)
  arrHuffChar(tmpCount) = i
  end if
next
end sub

sub sub_sort 'sorts the array from small to large
for a = tmpCount - 1 To 0 Step -1
  for j= 0 to a
    if arrHuffVal(j)>arrHuffVal(j+1) then
      temp=arrHuffVal(j+1)
      tempChar=arrHuffChar(j+1)
      arrHuffVal(j+1)=arrHuffVal(j)
      arrHUffChar(j+1)=arrHuffChar(j)
      arrHuffVal(j)=temp
      arrHuffChar(j)=tempChar
    end if
  next
next
end sub

sub sub_remove_new_blanks 'removes blanks from the new array 
for i = 0 to 255
  arrHuff(i) = arrHuffNewVal(i)
next
for j = 0 to 255
  strCount = arrHuff(j)
  if strCOunt = "" then
  'do nothing
  else
  tmpNewCount = tmpNewCount + 1
  arrHuffNewVal(tmpNewCount) = arrHuff(j)
  end if
next
end sub

sub sub_new_sort 'sorts the new array from small to large
for a = tmpNewCount - 1 To 0 Step -1
  for j= 0 to a
    if arrHuffNewVal(j)>arrHuffNewVal(j+1) then
      temp=arrHuffNewVal(j+1)
      arrHuffNewVal(j+1)=arrHuffNewVal(j)
      arrHuffNewVal(j)=temp
    end if
  next
next
tmpNewCount = 0
end sub

objTextFile.Close 
objCodedFile.Close

Merry Christmas and a happy New Year to all

The Adventurers' Guild

Decode Bard's Tale Huffman files