Advertisement
Guest User

Untitled

a guest
Feb 25th, 2018
85
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 13.49 KB | None | 0 0
  1. #!/afs/cats.ucsc.edu/courses/cmps112-wm/usr/smalltalk/bin/gst -f
  2. "$Id: tree.st,v 1.10 2012-02-23 18:57:51-08 - - $"
  3.  
  4. nl := Character nl.
  5.  
  6.  
  7.  
  8. FileStream extend [
  9. |bitIndex currentChar|
  10.  
  11. nextBit [
  12. |bit|
  13. bitIndex isNil ifTrue: [bitIndex := 0].
  14. bitIndex = 0 ifTrue: [
  15. bitIndex := 8.
  16. currentChar := self next.
  17. ].
  18. bit := currentChar value bitAt: bitIndex.
  19. bitIndex := bitIndex - 1.
  20. ^ bit
  21. ]
  22.  
  23. atBitEnd [
  24. ^ (bitIndex isNil | (bitIndex = 0)) & self atEnd
  25. ]
  26.  
  27. ]
  28. "------------------------------------------------------------"
  29. Object subclass: OutBits [
  30. |bitIndex currentByte myStream|
  31. OutBits class >> new [
  32. self shouldNotImplement.
  33. ]
  34. OutBits class >> new: fileStream [
  35. |result|
  36. result := super new.
  37. result init: fileStream.
  38. ^result
  39. ]
  40. clearByte [
  41. bitIndex := 8.
  42. currentByte := 0.
  43. ]
  44. init: fileStream [
  45. myStream := fileStream.
  46. self clearByte.
  47. ]
  48. flushByte [
  49. bitIndex = 8 ifFalse: [
  50. myStream nextPutByte: currentByte.
  51. self clearByte.
  52. ]
  53. ]
  54. writeBit: bit [
  55. currentByte := currentByte bitAt: bitIndex put: bit.
  56. bitIndex := bitIndex - 1.
  57. bitIndex = 0 ifTrue: [self flushByte].
  58. ]
  59. ]
  60.  
  61. "----------------------------------------------------------"
  62. Object subclass: Leaf [
  63. |char count|
  64. char [ ^ char ]
  65. count [ ^ count ]
  66.  
  67. Leaf class >> new [
  68. self shouldNotImplement
  69. ]
  70.  
  71. Leaf class >> new: aChar count: aCount [
  72. |result|
  73. result := super new.
  74. result setChar: aChar andCount: aCount.
  75. ^result
  76. ]
  77.  
  78. setChar: aChar andCount: aCount [
  79. char := aChar.
  80. count := aCount.
  81. ]
  82.  
  83. <= other [
  84. ^ (count < other count)
  85. | ((count = other count) & (char <= other char))
  86. ]
  87.  
  88. printBase: aStream [
  89. ^ aStream << self class << '(' << char << ',' << count
  90. ]
  91.  
  92. printOn: aStream [
  93. (self printBase: aStream) << ')'.
  94. ]
  95.  
  96. inorder: visitor prefix: string [
  97. visitor value: char value: string.
  98. ]
  99.  
  100.  
  101. treeAsBit: visitor sum: qlength queue: stackq [
  102. stackq nextPut: 1.
  103.  
  104. stackq nextPut: ((char asInteger) bitAt: 8).
  105. stackq nextPut: ((char asInteger) bitAt: 7).
  106. stackq nextPut: ((char asInteger) bitAt: 6).
  107. stackq nextPut: ((char asInteger) bitAt: 5).
  108. stackq nextPut: ((char asInteger) bitAt: 4).
  109. stackq nextPut: ((char asInteger) bitAt: 3).
  110. stackq nextPut: ((char asInteger) bitAt: 2).
  111. stackq nextPut: ((char asInteger) bitAt: 1).
  112.  
  113. ^ 9.
  114.  
  115. ]
  116.  
  117. isLeaf [
  118. ^1
  119. ]
  120. ]
  121.  
  122. Leaf subclass: Tree [
  123. |left right|
  124.  
  125. Tree class >> new: aChar count: aCount [
  126. self shouldNotImplement
  127. ]
  128.  
  129. Tree class >> new: aChar count: aCount left: aLeft right: aRight [
  130. |result|
  131. result := super new: aChar count: aCount.
  132. result setLeft: aLeft andRight: aRight.
  133. ^ result
  134. ]
  135.  
  136. setLeft: aLeft andRight: aRight [
  137. left := aLeft.
  138. right := aRight.
  139. ]
  140.  
  141. left [
  142. ^ left
  143. ]
  144.  
  145. right [
  146. ^ right
  147. ]
  148.  
  149. printOn: aStream [
  150. (self printBase: aStream) << ',' << left << ',' << right << ')'.
  151. ]
  152.  
  153. inorder: visitor prefix: string [
  154. left inorder: visitor prefix: string, '0'.
  155. right inorder: visitor prefix: string, '1'.
  156. ]
  157.  
  158. treeAsBit: visitor sum: qlength queue: stackq[
  159. |sum1 sum2 sum |
  160. sum1 := left treeAsBit: visitor sum: qlength queue: stackq.
  161. sum2 := right treeAsBit: visitor sum: qlength queue: stackq.
  162. sum := sum1 + sum2.
  163. sum := sum + 1.
  164. stackq nextPut: 0.
  165. ^ sum
  166. ]
  167.  
  168.  
  169. isLeaf [
  170. ^0
  171. ]
  172.  
  173. ]
  174.  
  175.  
  176. "----------------------------------------------------------------------"
  177.  
  178. Character extend [
  179. isPrint [
  180. ^ (Character space <= self) & (self <= $~)
  181. ]
  182. visible [
  183. self isPrint ifTrue: [^ '$', self asString]
  184. ifFalse: [^ self asInteger printStringRadix: 8]
  185. ]
  186. ]
  187.  
  188. Object subclass: ZeroArray [
  189. |theArray|
  190.  
  191. ZeroArray class >> new [
  192. self shouldNotImplement.
  193. ]
  194.  
  195. ZeroArray class >> new: size [
  196. |result|
  197. result := super new.
  198. result init: size.
  199. ^ result
  200. ]
  201.  
  202. init: size [
  203. theArray := Array new: size.
  204. ]
  205.  
  206. size [
  207. ^ theArray size.
  208. ]
  209.  
  210. at: index [
  211. ^ theArray at: index + 1.
  212. ]
  213.  
  214. at: index put: value [
  215. ^ theArray at: index + 1 put: value.
  216. ]
  217.  
  218. incr: index [
  219. (self at: index) isNil
  220. ifTrue: [ self at: index put: 0].
  221. self at: index put: (self at: index) + 1.
  222. ]
  223.  
  224. keysAndValuesDo: aBlock [
  225. (0 to: (self size) - 1) do: [:index |
  226. aBlock value: index value: (self at: index).
  227. ]
  228. ]
  229.  
  230.  
  231.  
  232. ]
  233. "-------------------------------------------------------------------"
  234.  
  235.  
  236. d := 0.
  237. t := 0.
  238. c := 0.
  239. u := 0.
  240.  
  241.  
  242. Smalltalk arguments: '-d -t -c -u'
  243. do: [:opt :arg |
  244. opt = $d ifTrue: [ d :=1. ].
  245. opt = $t ifTrue: [ t :=1. ].
  246. opt = $c ifTrue: [ c :=1. ].
  247. opt = $u ifTrue: [ u :=1. ].
  248. ]
  249. ifError: [
  250. 'Error: invalid option' displayNl.
  251. ].
  252.  
  253.  
  254. freqtable := ZeroArray new: 257.
  255.  
  256. c = 1 ifTrue: [ "compressing"
  257.  
  258.  
  259. infile := FileStream open: (Smalltalk arguments at: 2)
  260. mode: FileStream read.
  261.  
  262. [infile atEnd not] whileTrue: [
  263. |ordChar|
  264. ordChar := infile next asInteger.
  265. freqtable incr: ordChar.
  266. ].
  267. freqtable at: 256 put: 1.
  268.  
  269. infile close.
  270.  
  271. sortcol := SortedCollection new.
  272. chars_in_file := SortedCollection new.
  273.  
  274. freqtable keysAndValuesDo: [:key :value |
  275. (value notNil and: [value > 0]) ifTrue: [
  276. val := Leaf new: key asCharacter count: value.
  277. sortcol add: val.
  278. chars_in_file add: key
  279. ]
  280. ].
  281.  
  282.  
  283. [sortcol size > 1] whileTrue: [
  284. |first second t|
  285. first := sortcol removeFirst.
  286. second := sortcol removeFirst.
  287. t := Tree new: (second char) count: (first count + second count) left: first right: second.
  288. sortcol add: t.
  289. ].
  290. root := sortcol removeFirst.
  291.  
  292. encode_table := ZeroArray new: 257.
  293. root inorder: [:char :string |
  294. encode_table at: char asInteger put: string.
  295. ] prefix: ''.
  296.  
  297. formatOutput := [:let :freq :bits|
  298. let asString size to: 3 do: [:skip| stdout << ' '].
  299. stdout << let.
  300. freq asString size to: 5 do: [:skip| stdout << ' '].
  301. stdout << freq << ' ' << bits << nl.
  302. ].
  303.  
  304. arraylen := 0.
  305.  
  306. encode_table keysAndValuesDo: [:key :value |
  307. (value notNil and: [value > 0]) ifTrue: [
  308. arraylen := arraylen + ((freqtable at: key)*(value size)).
  309. ]
  310. ].
  311.  
  312.  
  313.  
  314.  
  315.  
  316. stackq := SharedQueue new.
  317. qlength := 0.
  318. qlength := root treeAsBit: [:char :string ] sum: qlength queue: stackq.
  319. qlength := qlength + 1.
  320. stackq nextPut: 0.
  321.  
  322.  
  323.  
  324.  
  325.  
  326. bitArray := Array new: (arraylen+qlength).
  327.  
  328. index := 1.
  329.  
  330.  
  331. [stackq isEmpty not] whileTrue: [
  332. |bit|
  333. bit := stackq next.
  334. bitArray at: index put: bit.
  335. index := index + 1.
  336. ].
  337.  
  338. infile := FileStream open: (Smalltalk arguments at: 2)
  339. mode: FileStream read.
  340.  
  341. [infile atEnd not] whileTrue: [
  342. |ordChar|
  343. ordChar := infile next asInteger.
  344.  
  345. index to: (index+((encode_table at: ordChar) size))-1 do:
  346. [ :x |
  347. bit := 0.
  348. (((encode_table at: ordChar) at: ((x-index)+1)) = $1) ifTrue: [bit:= 1.].
  349. bitArray at: x put: bit.
  350. ].
  351.  
  352. index := (index+((encode_table at: ordChar) size)).
  353. ].
  354.  
  355. "so at this point we want to add our EOF character to our BitArray"
  356. index to: (index+((encode_table at: 256) size))-1 do:
  357. [ :x |
  358. bit := 0.
  359. (((encode_table at: 256) at: ((x-index)+1)) = $1) ifTrue: [bit:= 1.].
  360. bitArray at: x put: bit.
  361. ].
  362.  
  363.  
  364. "filling up our bit array"
  365.  
  366.  
  367.  
  368. writeEncodedOutFile := [:outfile|
  369. |outBytes|
  370. outBytes := OutBits new: outfile.
  371. bitArray do: [:bit| outBytes writeBit: bit.].
  372. outBytes flushByte.
  373. ].
  374.  
  375. Smalltalk arguments size = 2
  376. ifTrue: [writeEncodedOutFile value: stdout]
  377. ifFalse: [
  378. |outfilename|
  379. outfilename := Smalltalk arguments at: 3.
  380. [ |outfile|
  381. outfile := FileStream open: outfilename mode: FileStream write.
  382. writeEncodedOutFile value: outfile.
  383. outfile close.
  384. ] on: SystemExceptions.FileError do: [:signal |
  385. |errno|
  386. errno := File errno.
  387. stdout flush.
  388. stderr << execname << ': ' << filename << ': '
  389. << signal messageText << nl.
  390. stderr flush.
  391. ]
  392. ].
  393.  
  394. d = 1 ifTrue: [
  395. stdout << 'DEBUG STMTS: '<<nl.
  396. root inspect.
  397. bitArray do: [:bit| stdout <<bit.].
  398. stdout << nl. ].
  399. ].
  400. "-----------------------------------------------------------------"
  401. "decompression----------------------------------------------------"
  402. u = 1
  403. ifTrue: [
  404.  
  405.  
  406.  
  407. infile := FileStream open: (Smalltalk arguments at: 2)
  408. mode: FileStream read.
  409.  
  410.  
  411.  
  412. treeq := OrderedCollection new.
  413. priority := 1000.
  414. endOfTree := 1.
  415.  
  416. [infile atBitEnd not and: [endOfTree = 1]] whileTrue: [
  417. | bit |
  418. bit := infile nextBit.
  419. bit = 1 ifTrue: [ "if we see a one"
  420. | char count |
  421. char := 255.
  422. count := 8.
  423. [count > 0 ] whileTrue: [
  424. count := count - 1.
  425. infile nextBit = 0 ifTrue: [
  426. num := 2 raisedTo: count.
  427. char := char - num.
  428. ]
  429. ].
  430. val := Leaf new: char asCharacter count: priority.
  431. priority := priority - 10.
  432. treeq addFirst: val.
  433. ]
  434. ifFalse: [ "for when we see a zero"
  435. treeq size = 1
  436. ifTrue: [
  437. endOfTree := 0. ]
  438. ifFalse: [
  439. |first second t|
  440. first := treeq removeFirst.
  441. second := treeq removeFirst.
  442.  
  443. t := Tree new: (first char) count: priority left: second right: first.
  444. priority := priority - 10.
  445. treeq addFirst: t.
  446. ].
  447.  
  448. ].
  449.  
  450. ].
  451.  
  452. root := treeq removeFirst.
  453. encode_table := ZeroArray new: 256.
  454.  
  455.  
  456. "creating an encoding table based of tree we created above ^"
  457. root inorder: [:char :string |
  458. encode_table at: char asInteger put: string.
  459. ] prefix: ''.
  460.  
  461.  
  462. t_current := root.
  463. result := OrderedCollection new.
  464.  
  465. [infile atBitEnd not] whileTrue: [
  466. | bit |
  467. t_current isLeaf = 1
  468. ifTrue: [
  469. t_current char asInteger = 0
  470. ifFalse:[
  471. freqtable incr: (t_current char asInteger).
  472. result addLast: ((t_current char asInteger) bitAt: 8).
  473. result addLast: ((t_current char asInteger) bitAt: 7).
  474. result addLast: ((t_current char asInteger) bitAt: 6).
  475. result addLast: ((t_current char asInteger) bitAt: 5).
  476. result addLast: ((t_current char asInteger) bitAt: 4).
  477. result addLast: ((t_current char asInteger) bitAt: 3).
  478. result addLast: ((t_current char asInteger) bitAt: 2).
  479. result addLast: ((t_current char asInteger) bitAt: 1).
  480. ].
  481. t_current := root.
  482. ]
  483. ifFalse: [
  484. bit := infile nextBit.
  485. bit = 1 ifTrue: [
  486. t_current := t_current right.
  487. ]
  488. ifFalse: [
  489. t_current := t_current left.
  490. ].
  491. ].
  492.  
  493. ].
  494.  
  495. infile close.
  496.  
  497.  
  498.  
  499.  
  500.  
  501.  
  502. d = 1 ifTrue: [
  503. infile := FileStream open: (Smalltalk arguments at: 2)
  504. mode: FileStream read.
  505.  
  506. [infile atBitEnd not] whileTrue: [
  507. bit := infile nextBit.
  508. stdout << bit.
  509. ].
  510. stdout <<nl.
  511.  
  512. infile close.
  513. ].
  514.  
  515.  
  516.  
  517.  
  518.  
  519.  
  520. writeDecodedOutFile := [:outfile|
  521. |outBytes|
  522. outBytes := OutBits new: outfile.
  523. [result size > 8] whileTrue: [ outBytes writeBit: result removeFirst.].
  524. outBytes flushByte.
  525. ].
  526.  
  527. Smalltalk arguments size = 2
  528. ifTrue: [writeDecodedOutFile value: stdout]
  529. ifFalse: [
  530. |outfilename|
  531. outfilename := Smalltalk arguments at: 3.
  532. [ |outfile|
  533. outfile := FileStream open: outfilename mode: FileStream write.
  534. writeDecodedOutFile value: outfile.
  535. outfile close.
  536. ] on: SystemExceptions.FileError do: [:signal |
  537. |errno|
  538. errno := File errno.
  539. stdout flush.
  540. stderr << execname << ': ' << filename << ': '
  541. << signal messageText << nl.
  542. stderr flush.
  543. ]
  544. ].
  545.  
  546. ].
  547.  
  548. "-----------------------------------------------------------------"
  549. "table writing----------------------------------------------------"
  550. t = 1
  551. ifTrue: [
  552.  
  553. formatOutput := [:let :freq :bits| "if let < 128"
  554. let asString size to: 3 do: [:skip| stdout << ' '].
  555. stdout << let.
  556. freq asString size to: 5 do: [:skip| stdout << ' '].
  557. stdout << freq << ' ' << bits << nl.
  558. ].
  559.  
  560.  
  561. encode_table keysAndValuesDo: [:key :value |
  562. (value notNil and: [value > 0]) ifTrue: [
  563. formatOutput value: (key asCharacter visible) value: (freqtable at: key) value: value.
  564. ]
  565. ].
  566.  
  567. ].
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement