module Sol_Exercise_12 where ---------------------------------------------------- -- -- Modifizierte Angabe -- by Fabian Raab -- ---------------------------------------------------- import Control.Monad (liftM) import qualified Data.ByteString as BS import Data.Bits import Data.Char import Data.List (permutations, subsequences, find, sortBy) import Data.Function (on) import Data.Maybe (fromJust) import Data.Word (Word8) import qualified Huffman as H import System.IO {- Library -- nicht veraendern -} data Html = Text String | Block String [Html] deriving Show html_ex1 = Text "Every string should learn to swim" html_ex2 = Block "head" [] html_ex3 = Block "body" [Block "p" [Text "My cat"], Text "is not a float"] html_ex4 = Text "Sei Epsilon < 0" html_ex5 = Text "Üblicherweise ist 𝜀 > 0" data Expr = Input Integer | Add Expr Expr | Sub Expr Expr | Mul Expr Expr deriving Eq instance Show Expr where show (Input n) = show n show (Add e₁ e₂) = "(" ++ show e₁ ++ " + " ++ show e₂ ++ ")" show (Sub e₁ e₂) = "(" ++ show e₁ ++ " - " ++ show e₂ ++ ")" show (Mul e₁ e₂) = "(" ++ show e₁ ++ " * " ++ show e₂ ++ ")" foldExpr :: (Integer -> a) -> (a -> a -> a) -> (a -> a -> a) -> (a -> a -> a) -> Expr -> a foldExpr f _ _ _ (Input n) = f n foldExpr f g h i (Add e₁ e₂) = g (foldExpr f g h i e₁) (foldExpr f g h i e₂) foldExpr f g h i (Sub e₁ e₂) = h (foldExpr f g h i e₁) (foldExpr f g h i e₂) foldExpr f g h i (Mul e₁ e₂) = i (foldExpr f g h i e₁) (foldExpr f g h i e₂) {- ----Example:---- Hier nochmal das vorgestellte Beispiel zu einer Huffman Codierung: Quellalphabet: X = {a,b,c,d} Codealpabet (hier Binärcode): C = {0,1} ein möglicher Beispieltext auf dem Alphabet X:-} text = "aababcabcd" {- relative Häufigheiten (Wahrscheinlichkeit): p_a=0.4 p_b=0.3 p_c=0.2 p_d=0.1 relative Häufigkeiten (Anzahl): c_a=4 c_b=3 p_c=2 p_d=1 mithilfe von der Funktion mkFTable :: String -> FTable können die Häufigkeiten ("Frequency") berechnet werden: ftable :: H.FTable-} ftable = H.mkFTable text {- ergibt: [('a',4),('b',3),('c',2),('d',1)] Huffman-Baum: wobei aus Huffman.hs data Bit = L | R ist. L R L<->R 0 | 1 0<->1 .------+-----. | | | RL | RR | 10 | 11 | .----+----. | | | | RLL | RLR | | 100 | 101 | | .--+--. | | | | | a d c b 0.4 0.1 0.2 0.3 Dieser kann mithilfe der Funktion mkTree :: FTable -> Tree berechnet werden:-} tree :: H.Tree tree = H.mkTree ftable {- Der eigentliche Huffman code ist bereits im Baum oben eigetragen. Im Programm muss dieser mithilfe der Funktion mkCTable :: Tree -> CTable noch extra berechnet werden: ctable :: H.CTable-} ctable = H.mkCTable tree {- ergibt: [('a',[L]),('d',[R,L,L]),('c',[R,L,R]),('b',[R,R])] Nun muss noch der Text mithilfe der Funktion encode :: CTable -> String -> [Bit] codiert werden: -} bits :: [H.Bit] bits = H.encode ctable text {-ergibt: [L,L,R,R,L,R,R,R,L,R,L,R,R,R,L,R,R,L,L] Die Funktion compress :: String -> FilePath -> IO() die nun implementiert werden soll, soll mithilfe der obigen Funktionen und letztendlich des Ergebnisesder Funktion H.encode einen Bytecode erzeugen und in eine Datei schreiben. Da die Länge des letzten Bytes des codierten Textes nicht unbedingt die Länge von 8bits, sondern auch weniger haben kann, muss zusätzlich noch gepadded werden und in einem weiteren Byte ganz am schluss der Datei die tatsächliche Länge (in Anzahl von bits) angegeben werden. Der Aufruf compress text "./bsp-text" sollte eine Datei bsp-text.huff, die folgenden Inhalt hat 00110111010111011000000000000011 Zur Übersicht noch im Vergleich: LLRRLRRRLRLRRRLRRLL 00110111010111011000000000000011 aab ab c ab c d PAD LENGTH `------´`------´`------´`------´ 1.Byte 2.Byte 3.Byte 4.Byte Da man den Baum zum Rekonstruieren benötigt muss dieser auch gespeichert werden. Die Funktion serializeTree :: Tree -> BS.ByteString erzeugt einen fertigen ByteString, der nur noch in eine Datei geschreiben werden muss. Der obige Aufruf compress text "./bsp-text" erzeugt also noch zusätzlich eine Datei bsp-text.code, in der der Baum serialisiert ist. Dementsprechend list die Funktion decompress :: FilePath -> IO (Maybe String) wieder beide Dateien ein und decodiert wieder den ursprünglichen Text 'text'. Wobei Die .code Datei die den Baum enthält mit der Funktion deserializeTree :: BS.ByteString -> Tree wieder in eine Tree Struktur umgewandelt werden kann. -} {- G11.1 -} {- Diese Funktion nimmt als eingabe eine beliebig lange Liste von H.Bit und erzeugt dann einen ByteString, der dann ein eine Datei geschreiben werden soll. Dabei muss die Funktion eigentlich nur die Eingabeliste in 8ter Blöcke unterteilen und jeden Block toWord8 übergeben. Die ergebnisse müssen dass natürlich konkarteniert werden und eventuell muss das letzte Byte des Textes noch auf 8 bit gepadded werden und im letzten Byte des Rückgabewertes noch die Länge des letzten Bytes des Textes angegeben werden, damit beim Rekonstruieren man weiß wie viel gepadded wurde. Alles kokarteniert kann dann pack benutzt werden. Nützliche Funktionen aus Data.ByteString pack :: String -> ByteString O(n) Convert a String into a ByteString For applications with large numbers of string literals, pack can be a bottleneck. -} serializeHuff :: [H.Bit] -> BS.ByteString serializeHuff = BS.pack . ser where ser bits = if len == 8 -- Fortschaltbedingung, falls Text groß genug ist um noch ein -- koplettes Byte herauszunehmen then ch8 : ser bits2 {- fromInteger $ toInteger ist ein Trick um Zahlen in andere Typen umzuwandeln. Zuerst wierd eine Beliebige Zahl, die eine Instanz von Integral ist in einen Int umgewandelt und dann wieder zurück in einen Integral, wobei dieser dann in einen beliebigen anderen numerischen Typen impliziet cecastet wird.-} {- `shiftL` (8 - len) padded nach dem umwandeln noch mit Nullen sodass es ein komplettes Byte ist. -} else [ch8 `shiftL` (8 - len), fromInteger $ toInteger len] where (bits1, bits2) = splitAt 8 bits len = length bits1 ch8 = toWord8 0 bits1 {- Diese Funktion nimmt als Eingabe eine Liste von maximal 8 Elemente vom Typ H.Bit . Implementierungstechnisch ist die Grenze von 8 bits nicht unbedingt festgelegt. Die Funktion macht aber in den Zusammenhang dieser Aufgabe nur Sinn wenn die Liste genau 8 Elemente oder für das letzte Byte des Textes <=8 Elemente verarbeitet. Als Ausgabe kommt dann eine Folge von Nullen und Einsen raus, wobei 0 =^ L und 1 =^ R. Wichtig ist hier, dass man mit Bitoperationen arbeitet. Wenn man im Code irgendwo einfach nur 1 hinschreibt, dann hat er kein Bit 1 sondern eine Zahl 1, daher mit beliebig vielen führenden Nullen ...0000001 Der Typ ist nur durch "Bits a" beschränkt (Hier könnte man die Funktion dann als Int initialisieren. Die Rückgabe wäre dann auch ein Int, was letztendlich auch eine Folge von Nullen und Einsen ist). Nützliche Funktionen aus Data.Bits: (.&.) :: a -> a -> a Bitwise "and" (.|.) :: a -> a -> a Bitwise "or" shiftL :: a -> Int -> a Shift the argument left by the specified number of bits (which must be non-negative). An instance can define either this and shiftR or the unified shift, depending on which is more convenient for the type in question. setBit :: a -> Int -> a x `setBit` i is the same as x .|. bit i -} toWord8 :: (Num a, Bits a) => a -> [H.Bit] -> a toWord8 n [] = n {- Durch das shiftL wird immer das ganz rechte Bit verändert. Das ganze muss genau 8 mal passieren damit es eine korrekte Zahl ist. Beim letzten gleicht serializeHuff noch die letzten Stellen aus. -} toWord8 n (H.L:xs) = toWord8 (n `shiftL` 1) xs {- .|. 1 setzt das rechte Bit auf 1 -} toWord8 n (H.R:xs) = toWord8 ((n `shiftL` 1) .|. 1) xs {-Gegenteil von serializeHuff. Nimmt als Eingabe einen ByteString und wandelt sie wieder in eine H.Bit Struktur um. Bei einem Fehler (wenn z.B. die Eingabe nicht groß genug ist) soll Nothing zurückgegeben werden. fromWord8 soll benutzt werden um einzelen Bytes nach H.Bit zu konvertieren. Außerdem muss die Funktion beachten dass das letzte Byte die Längenangabe des eventuell gepaddeten vorletzten Bytes. Nützliche Funktionen aus Data.ByteString: unpack :: ByteString -> [Char] O(n) Converts a ByteString to a String. -} deserializeHuff :: BS.ByteString -> Maybe [H.Bit] deserializeHuff = deser . BS.unpack where deser :: [Word8] -> Maybe [H.Bit] {- fromInteger $ toInteger ist ein Trick um Zahlen in andere Typen umzuwandeln. Zuerst wierd eine Beliebige Zahl, die eine Instanz von Integral ist in einen Int umgewandelt und dann wieder zurück in einen Integral, wobei dieser dann in einen beliebigen anderen numerischen Typen impliziet cecastet wird.-} {- Das hier ist die Abbruchbedingung, wobei x das letzte Byte des Textes ist und l dessen Länge.-} deser [x,l] = Just $ take (fromInteger $ toInteger l) (fromWord8 x) {- (x:xs) liest die Datei rekuriv Byteweise aus (ein char ist ein Byte groß) -} deser (x:xs) = case deser xs of Nothing -> Nothing Just res -> Just $ fromWord8 x ++ res deser _ = Nothing -- Falls Datei zu klein, Fehler zurückgeben {- Gegenteil von toWord8. Nimmt eine Binärdarstelung und wandelt sie wieder in die H.Bit struktur um. Auch hier ist es wieder sinnvoll wenn die Eingabe maximal 8Bit Groß groß ist. Nützliche Funktionen aus Data.Bits: testBit :: a -> Int -> Bool Return True if the nth bit of the argument is 1 -} fromWord8 :: Bits a => a -> [H.Bit] fromWord8 c = reverse [ if testBit c n then H.R else H.L | n <- [0..7] ] {- Diese Funktion muss nur noch die Funktionen die oben definiert sind und die aus dem Modul Huffman in der richtigen Reihenfolge aufrufen (siehe Example) und dann die Ergebnisse in die Dateien schreiben. Nützliche Funktionen aus Data.ByteString: writeFile :: FilePath -> ByteString -> IO () Write a ByteString to a file. -} compress :: String -> FilePath -> IO () compress xs file = do BS.writeFile (file ++ ".code") (H.serializeTree tree) BS.writeFile (file ++ ".huff") (serializeHuff huff) where tree = H.mkTree $ H.mkFTable xs huff = H.encode (H.mkCTable tree) xs {- Gegenteil von compress. List aus den Dateien und wandelt deren Inhalt wieder in einen String um, indem die oben definierten Funktionen und die aus dem Modul Huffman korrekt aufgerufen werden. Nützliche Funktionen aus Data.ByteString readFile :: FilePath -> IO ByteString Read an entire file strictly into a ByteString. This is far more efficient than reading the characters into a String and then using pack. It also may be more efficient than opening the file and reading it using hGet. -} decompress :: FilePath -> IO (Maybe String) decompress file = do rawTree <- BS.readFile (file ++ ".code") rawHuff <- BS.readFile (file ++ ".huff") let tree = H.deserializeTree rawTree return $ case deserializeHuff rawHuff of Nothing -> Nothing Just huff -> Just $ H.decode tree huff {- G11.2 -} namedEntities :: [(Char, String)] namedEntities = [('<', "lt"), ('>', "gt"), ('&',"amp"), ('ß', "szlig"), ('Ä', "Auml"), ('Ö', "Ouml"), ('Ü', "Uuml"), ('ä', "auml"), ('ö', "ouml"), ('ü', "uuml")] htmlChar :: Char -> String htmlChar c = case lookup c namedEntities of Just name -> "&" ++ name ++ ";" Nothing -> if n < 128 then [c] else "&#" ++ show n ++ ";" where n = ord c plainHtml :: Html -> String plainHtml (Text cs) = concatMap htmlChar cs plainHtml (Block s hs) = "<" ++ s ++ ">" ++ concatMap plainHtml hs ++ ""