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:
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
