huffman (empty) → 1.0.0

raw patch · 4 files changed

+131/−0 lines, 4 filesdep +basedep +containersdep +fingertreesetup-changed

Dependencies added: base, containers, fingertree

Files

Data/Compression/Huffman.hs +76/−0
LICENSE +23/−0
Setup.hs +3/−0
huffman.cabal +29/−0

+ Data/Compression/Huffman.hs view

@@ -0,0 +1,76 @@+module Data.Compression.Huffman+  ( HuffmanTree(..)+  , Bit(..)+  , Code++  , huffman+  , huffmanSorted+  , codewords+  , ppCode+  ) where++import Data.List (intercalate)+import Control.Arrow (first,second)+import qualified Data.PriorityQueue.FingerTree as PQ+import Data.Sequence as S++data Bit = Zero | One++instance Show Bit where+  show Zero = "0"+  show One  = "1"++data HuffmanTree a = Empty+                   | Node (HuffmanTree a) (HuffmanTree a)+                   | Leaf a+  deriving Show++type Code a = [(a,[Bit])]++-- Simple implementation, O(n log n).+huffman :: (Ord w, Num w) => [(a,w)] -> HuffmanTree a+huffman = build . prepare+  where+   prepare  = PQ.fromList . map (\(x,w) -> (w, Leaf x))+   build pq =+     case PQ.minViewWithKey pq of+       Nothing -> Empty+       Just ((w,x), pq') ->+         case PQ.minViewWithKey pq' of+           Nothing -> x+           Just ((w',y), pq'') -> build $ PQ.insert (w+w') (Node x y) pq''++-- More efficient implementation, O(n).  Requires that the input+-- list of symbols and weight is sorted by increasing weight.+huffmanSorted :: (Ord w, Num w) => [(a,w)] -> HuffmanTree a+huffmanSorted = build S.empty . prepare+  where+   prepare = S.fromList . map (first Leaf)+   dequeue s t =+     case (viewl s, viewl t) of+       (EmptyL, EmptyL)    -> Nothing+       (EmptyL, (x :< ts)) -> Just (x,s,ts)+       ((x :< ss), EmptyL) -> Just (x,ss,t)+       (((x,w) :< ss), ((y,w') :< ts))+         | w < w'    -> Just ((x,w),ss,t)+         | otherwise -> Just ((y,w'),s,ts)+   build s t =+     case dequeue s t of+       Nothing -> Empty+       Just ((x,w),s',t') ->+         case dequeue s' t' of+           Nothing -> x+           Just ((y,w'),s'',t'') -> build (s'' |> (Node x y, w+w')) t''++-- Derive the prefix-free binary code from a huffman tree.+codewords :: HuffmanTree a -> Code a+codewords = code' []+  where code' _    Empty      = []+        code' bits (Leaf x)   = [(x,bits)]+        code' bits (Node l r) = map (second (Zero:)) (code' bits l) +++                                map (second (One:)) (code' bits r)++-- Pretty-print a binary code.  Mostly useful for debugging.+ppCode :: Show a => Code a -> String+ppCode = intercalate "\n" .+           map (\(x,bits) -> show x ++ ": " ++ concat (map show bits))

+ LICENSE view

@@ -0,0 +1,23 @@+Copyright (c) 2010 Maxime Henrion <mhenrion@gmail.com>+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain

+ huffman.cabal view

@@ -0,0 +1,29 @@+Name:		huffman+Version:	1.0.0+License-File:	LICENSE+License:	BSD3+Author:		Maxime Henrion+Copyright:	2010, Maxime Henrion+Maintainer:	Maxime Henrion <mhenrion@gmail.com>+Bug-Reports:	http://bitbucket.org/mumux/huffman/issues/+Category:	Data, Compression+Synopsis:	Pure Haskell implementation of the Huffman encoding algorithm+Description:+	A simple and pure Haskell implementation of the Huffman encoding+	algorithm.+	.+	The @huffman@ function provides the original O(n log n) algorithm+	implemented with a priority queue.  If the input symbols are sorted+	by probability, the O(n) @huffmanSorted@ function can be used instead.+Build-Type:	Simple+Cabal-Version:	>= 1.6+Tested-with:	GHC ==6.12++Source-Repository head+  Type:			mercurial+  Location:		http://bitbucket.org/mumux/huffman/++Library+  Build-Depends:	base >= 3 && < 5, containers, fingertree+  Exposed-Modules:	Data.Compression.Huffman+  GHC-Options:		-Wall -O2 -funbox-strict-fields