Object subclass: #HuffmanCompressor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Huffman'! !HuffmanCompressor methodsFor: 'private'! ConvertDictToSortCollOfLeafs: theDict "Converts a Dictionary to a SortedCollection of TreeLeaf. Sorting is done according to the dictionary's value, not keys. (This method would better go into Dictionary!!)" | sortCollection | sortCollection := SortedCollection sortBlock: [ :a :b | (a weight) <= (b weight) ]. theDict associationsDo: [ :each | sortCollection add: (TreeLeaf with: (each key) weight: (each value) ) ]. ^sortCollection.! CountSymbols: text "Counts the occurences of each symbol in text. Returns a dictionary; keys are symbols, values are number of occurences in integer" | theDict | theDict := Dictionary new. text do: [ :symbol | theDict at: symbol put: ( ( theDict at: symbol ifAbsent: [ 0 ] ) + 1 ) ]. ^theDict.! ! !HuffmanCompressor methodsFor: 'algorithms'! compress: text with: encodingTree "Compresses text by using encodingTree as Huffmann-Tree. Returns a bitstream of type OrderedCollection. (Because this is an algorithm, it should rather be a class method. PS: Note that HuffmanCompressor does have neither instance- nor classVariables.)" | coding encodingDict | coding := OrderedCollection new. encodingDict := encodingTree LeafsPaths: (OrderedCollection new). text do: [ :symbol | coding addAll: (encodingDict at: symbol) ]. ^coding.! decompress: bits with: encodingTree "Decompresses bits bitstream using encodingTree as Huffmann-Tree. Returns a string. (Because this is an algorithm, it should rather be a class method. PS: Note that HuffmanCompressor does have neither instance- nor classVariables.)" | iterator text stringOne | stringOne := String new: 1. " to convert char to string; see below " iterator := encodingTree. text := String new. [ (bits size) > 0 ] whileTrue: [ iterator isLeaf ifFalse: [ (bits removeFirst) = 1 ifTrue: [ iterator := iterator leftSon ] ifFalse: [ iterator := iterator rightSon ] ] ifTrue: [ stringOne at: 1 put: (iterator letter). " Ugly, I know. Couldn't find how to " text := text , stringOne. " append char to string. " iterator := encodingTree. "reset to root" ] ]. stringOne at: 1 put: (iterator letter). text := text, stringOne. ^text.! generateTreeFor: text "Generates the Huffmann-Tree for text. (^ ) (Because this is an algorithm, it should rather be a class method. PS: Note that HuffmanCompressor does have neither instance- nor classVariables.)" | sortedLeafs | sortedLeafs := (self ConvertDictToSortCollOfLeafs: (self CountSymbols: text) ). [ (sortedLeafs size) > 1] whileTrue: [ sortedLeafs add: ( TreeNode leftSon: (sortedLeafs at: 1) rightSon: (sortedLeafs at: 2) ). sortedLeafs removeFirst: 2. ]. ^sortedLeafs at: 1! ! ApplicationModel subclass: #Huffman instanceVariableNames: 'compressedText sourceText sourceFileName destFileName destText destBits encodingTree sourceBits ' classVariableNames: '' poolDictionaries: '' category: 'Huffman'! !Huffman methodsFor: 'initialize-release'! initialize sourceText := String new asValue. sourceText onChangeSend: #changedSourceText to: self. sourceFileName := '/home/schinz/textes/poeme' asValue. sourceBits := 0 asValue. destText := String new asValue. destText onChangeSend: #changedDestText to: self. destFileName := String new asValue. destBits := 0 asValue.! ! !Huffman methodsFor: 'change messages'! changedDestText destBits value: destText value size. self uncompressText! changedSourceText sourceBits value: sourceText value size * 8. self compressText! ! !Huffman methodsFor: 'actions'! compressText | compressor text encodedBits encodedText | compressor := HuffmanCompressor new. text := self sourceText value. encodingTree := compressor generateTreeFor: text. encodedBits := compressor compress: text with: encodingTree. encodedText := String new: (encodedBits size). 1 to: (encodedBits size) do: [ :index | encodedText at: index put: (((encodedBits at: index) isZero) ifTrue: [ $0 ] ifFalse: [ $1 ])]. self destText retractInterestsFor: self. self destText value: encodedText. self destText onChangeSend: #changedDestText to: self. self destBits value: (self destText value size)! loadDestText | boss | boss := BinaryObjectStorage onOld: (self destFileName value asFilename readStream). encodingTree := boss next. self destText value: (boss next). boss close.! loadSourceText | stream | stream := self sourceFileName value asFilename readStream. sourceText value: (stream upToEnd). stream close! saveDestText | boss | boss := BinaryObjectStorage onNew: (self destFileName value asFilename writeStream). boss nextPut: encodingTree. boss nextPut: (self destText value). boss close.! saveSourceText | stream | stream := self sourceFileName value asFilename writeStream. stream nextPutAll: (self sourceText value). stream close! uncompressText | encodedBits compressor | encodedBits := OrderedCollection new. self destText value do: [ :char | encodedBits addLast: (char = $0 ifTrue: [ 0 ] ifFalse: [ 1 ])]. compressor := HuffmanCompressor new. self sourceText retractInterestsFor: self. self sourceText value: (compressor decompress: encodedBits with: encodingTree). self sourceText onChangeSend: #changedSourceText to: self. self sourceBits value: (self sourceText value size * 8)! ! !Huffman methodsFor: 'aspects'! destBits "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined." ^destBits! destFileName "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined." ^destFileName! destText "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined." ^destText! sourceBits "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined." ^sourceBits! sourceFileName "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined." ^sourceFileName! sourceText "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined." ^sourceText! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Huffman class instanceVariableNames: ''! !Huffman class methodsFor: 'interface specs'! windowSpec "UIPainter new openOnClass: self andSelector: #windowSpec" ^#(#FullSpec #window: #(#WindowSpec #label: 'Huffman' #bounds: #(#Rectangle 99 194 763 624 ) ) #component: #(#SpecCollection #collection: #( #(#TextEditorSpec #layout: #(#LayoutFrame 10 0 45 0 -10 0.5 -110 1 ) #model: #sourceText ) #(#LabelSpec #layout: #(#Point 10 8 ) #label: 'Texte non compresse') #(#TextEditorSpec #layout: #(#LayoutFrame 10 0.5 45 0 -10 1 -110 1 ) #model: #destText ) #(#LabelSpec #layout: #(#LayoutOrigin 10 0.5 8 0 ) #label: 'Texte compresse') #(#LabelSpec #layout: #(#LayoutOrigin 10 0 -70 1 ) #label: 'Fichier' ) #(#InputFieldSpec #layout: #(#LayoutFrame 60 0 -70 1 -10 0.5 -50 1 ) #model: #sourceFileName ) #(#ActionButtonSpec #layout: #(#LayoutFrame 10 0 -45 1 -10 0.25 -10 1 ) #model: #loadSourceText #label: 'Charger' #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 10 0.25 -45 1 -10 0.5 -10 1 ) #model: #saveSourceText #label: 'Sauvegarder' #defaultable: true ) #(#LabelSpec #layout: #(#LayoutOrigin 10 0.5 -70 1 ) #label: 'Fichier' ) #(#InputFieldSpec #layout: #(#LayoutFrame 60 0.5 -70 1 -10 1 -50 1 ) #model: #destFileName ) #(#ActionButtonSpec #layout: #(#LayoutFrame 10 0.5 -45 1 -10 0.75 -10 1 ) #model: #loadDestText #label: 'Charger' #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 10 0.75 -45 1 -10 1 -10 1 ) #model: #saveDestText #label: 'Sauvegarder' #defaultable: true ) #(#LabelSpec #layout: #(#LayoutOrigin 10 0 -100 1 ) #label: 'Taille en bits' ) #(#InputFieldSpec #layout: #(#LayoutFrame 99 0 -100 1 -10 0.5 -80 1 ) #model: #sourceBits #isReadOnly: true #type: #number ) #(#LabelSpec #layout: #(#LayoutOrigin 10 0.5 -100 1 ) #label: 'Taille en bits' ) #(#InputFieldSpec #layout: #(#LayoutFrame 99 0.5 -100 1 -10 1 -80 1 ) #model: #destBits #isReadOnly: true #type: #number ) #(#DividerSpec #layout: #(#LayoutFrame -1 0.5 10 0 408 0 -10 1 ) #orientation: #vertical ) ) ) )! ! Object subclass: #TreeElement instanceVariableNames: 'theWeight ' classVariableNames: '' poolDictionaries: '' category: 'Huffman'! !TreeElement methodsFor: 'testing'! isLeaf ^self subclassResponsibility! ! !TreeElement methodsFor: 'accessing'! weight ^theWeight! weight: anInteger theWeight := anInteger! ! TreeElement subclass: #TreeLeaf instanceVariableNames: 'theSymbol ' classVariableNames: '' poolDictionaries: '' category: 'Huffman'! !TreeLeaf methodsFor: 'testing'! isLeaf ^true! ! !TreeLeaf methodsFor: 'accessing'! letter ^theSymbol! letter: aLetter theSymbol := aLetter! ! !TreeLeaf methodsFor: 'printing'! printOn: aStream "This is for debugging only. The cool thing is that the internal debugger calls this method whenever a TreeLeaf object is inspected. This method can then print a much more usefull text than the std 'a TreeLeaf' " aStream print: theSymbol; nextPut: $(; print: theWeight; nextPut: $)! ! !TreeLeaf methodsFor: 'enumerating'! LeafsPaths: path "see comment in same method in TreeNode" | theDict | theDict := Dictionary new. theDict at: theSymbol put: path. ^theDict! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! TreeLeaf class instanceVariableNames: ''! !TreeLeaf class methodsFor: 'initialization'! with: aLetter weight: anInteger ^( ( (self new) letter: aLetter) weight: anInteger )! ! TreeElement subclass: #TreeNode instanceVariableNames: 'left right ' classVariableNames: '' poolDictionaries: '' category: 'Huffman'! !TreeNode methodsFor: 'testing'! isLeaf ^false! ! !TreeNode methodsFor: 'accessing'! leftSon ^left! leftSon: lSon left := lSon! leftSon: lSon rightSon: rSon left := lSon. right := rSon. theWeight := (lSon weight) + (rSon weight)! rightSon ^right! rightSon: rSon right := rSon! ! !TreeNode methodsFor: 'printing'! printOn: aStream "This is for debugging only. The cool thing is that the internal debugger calls this method whenever a TreeLeaf object is inspected. This method can then print a much more usefull text than the std 'a TreeNode' " aStream print: 'a Node with weight='; print: theWeight; print: 'left='; print: (left printOn: aStream); print: 'right='; print: (right printOn: aStream).! ! !TreeNode methodsFor: 'enumerating'! LeafsPaths: path "Returns a dictionary that contains all leaves of this partial-tree as keys. The value of each leaf is the path from this node to the leaf; 1=left, 0=right. The argument 'path' is prepended to all those values; allowing the recursive call. USAGE: Initial call with empty path like this: tree LeafsPaths: (OrderedCollection new) " | leftPath rightPath theDict | leftPath := path copy. leftPath add: 1. rightPath := path copy. rightPath add: 0. theDict := left LeafsPaths: leftPath. theDict addAll: (right LeafsPaths: rightPath) associations. " Joins two dicts " ^theDict. " ^( (left LeafsPaths: (path add: 1)) addAll: (( (right LeafsPaths: (path add: 0)) associations)) ) " " short form; does not work because path add: 1 returns 1 and not the new path "! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! TreeNode class instanceVariableNames: ''! !TreeNode class methodsFor: 'initialization'! leftSon: lSon rightSon: rSon ^super new leftSon: lSon rightSon: rSon! !