https://wiki.haskell.org/api.php?action=feedcontributions&user=Philh&feedformat=atomHaskellWiki - User contributions [en]2024-03-29T11:33:10ZUser contributionsMediaWiki 1.35.5https://wiki.haskell.org/index.php?title=99_questions/46_to_50&diff=982399 questions/46 to 502006-12-29T20:55:17Z<p>Philh: General solution to problem 48</p>
<hr />
<div>__NOTOC__<br />
<br />
This is part of [[H-99:_Ninety-Nine_Haskell_Problems|Ninety-Nine Haskell Problems]], based on [http://www.hta-bi.bfh.ch/~hew/informatik3/prolog/p-99/ Ninety-Nine Prolog Problems].<br />
<br />
If you want to work on one of these, put your name in the block so we know someone's working on it. Then, change n in your block to the appropriate problem number, and fill in the <Problem description>,<example in lisp>,<example in Haskell>,<solution in haskell> and <description of implementation> fields. <br />
<br />
== Logic and Codes ==<br />
<br />
== Problem 46 ==<br />
<br />
(**) Define predicates and/2, or/2, nand/2, nor/2, xor/2, impl/2 and equ/2 (for logical equivalence) which succeed or fail according to the result of their respective operations; e.g. and(A,B) will succeed, if and only if both A and B succeed.<br />
<br />
A logical expression in two variables can then be written as in the following example: and(or(A,B),nand(A,B)).<br />
<br />
Now, write a predicate table/3 which prints the truth table of a given logical expression in two variables.<br />
<br />
<pre><br />
Example:<br />
(table A B (and A (or A B)))<br />
true true true<br />
true fail true<br />
fail true fail<br />
fail fail fail<br />
<br />
Example in Haskell:<br />
> table2 (\a b -> (and' a (or' a b))<br />
True True True<br />
True False True<br />
False True False<br />
False False False<br />
</pre><br />
<br />
Solution:<br />
<haskell><br />
not' :: Bool -> Bool<br />
not' True = False<br />
not' False = True<br />
<br />
and',or',nor',nand',xor',impl',equ' :: Bool -> Bool -> Bool<br />
and' True True = True<br />
and' _ _ = False<br />
<br />
or' True _ = True<br />
or' _ True = True<br />
or' _ _ = False<br />
<br />
nor' a b = not' $ or' a b<br />
nand' a b = not' $ and' a b<br />
<br />
xor' True False = True<br />
xor' False True = True<br />
xor' _ _ = False<br />
<br />
impl' a b = (not' a) `or'` b<br />
<br />
equ' True True = True<br />
equ' False False = True<br />
equ' _ _ = False<br />
<br />
table2 :: (Bool -> Bool -> Bool) -> IO ()<br />
table2 f = putStrLn . unlines $ [show a ++ " " ++ show b ++ " " ++ show (f a b)<br />
| a <- [True, False], b <- [True, False]]<br />
</haskell><br />
<br />
The implementations of the logic functions are quite verbose and can be shortened in places (like "equ' = (==)").<br />
<br />
The table function in Lisp supposedly uses Lisp's symbol handling to substitute variables on the fly in the expression. I chose passing a binary function instead because parsing an expression would be more verbose in haskell than it is in Lisp. Template Haskell could also be used :)<br />
<br />
== Problem 47 ==<br />
<br />
(*) Truth tables for logical expressions (2).<br />
<br />
Continue problem P46 by defining and/2, or/2, etc as being operators. This allows to write the logical expression in the more natural way, as in the example: A and (A or not B). Define operator precedence as usual; i.e. as in Java.<br />
<br />
<pre><br />
Example:<br />
* (table A B (A and (A or not B)))<br />
true true true<br />
true fail true<br />
fail true fail<br />
fail fail fail<br />
<br />
Example in Haskell:<br />
> table2 (\a b -> a `and'` (a `or'` not b))<br />
True True True<br />
True False True<br />
False True False<br />
False False False<br />
</pre><br />
<br />
Solution:<br />
<haskell><br />
-- functions as in solution 46<br />
infixl 4 `or'`<br />
infixl 6 `and'`<br />
-- "not" has fixity 9 by default<br />
</haskell><br />
<br />
Java operator precedence (descending) as far as I could fathom it:<br />
<pre><br />
logical not<br />
equality<br />
and<br />
xor<br />
or<br />
</pre><br />
<br />
Using "not" as a non-operator is a little evil, but then again these problems were designed for languages other than haskell :)<br />
<br />
== Problem 48 ==<br />
<br />
(**) Truth tables for logical expressions (3).<br />
<br />
Generalize problem P47 in such a way that the logical expression may contain any number of logical variables. Define table/2 in a way that table(List,Expr) prints the truth table for the expression Expr, which contains the logical variables enumerated in List.<br />
<br />
<pre><br />
Example:<br />
* (table (A,B,C) (A and (B or C) equ A and B or A and C))<br />
true true true true<br />
true true fail true<br />
true fail true true<br />
true fail fail true<br />
fail true true true<br />
fail true fail true<br />
fail fail true true<br />
fail fail fail true<br />
<br />
Example in Haskell:<br />
> tablen 3 (\[a,b,c] -> a `and'` (b `or'` c) `equ'` a `and'` b `or'` a `and'` c)<br />
True True True True<br />
True True False True<br />
True False True True<br />
True False False True<br />
False True True True<br />
False True False True<br />
False False True True<br />
False False False True<br />
</pre><br />
<br />
Solution:<br />
<haskell><br />
-- functions as in solution 46<br />
infixl 4 `or'`<br />
infixl 4 `nor'`<br />
infixl 5 `xor'`<br />
infixl 6 `and'`<br />
infixl 6 `nand'`<br />
infixl 3 `equ'` -- was 7, changing it to 3 got me the same results as in the original question :(<br />
<br />
tablen :: Int -> ([Bool] -> Bool) -> IO ()<br />
tablen n f = putStrLn $ unlines [toStr a ++ " => " ++ show (f a) | a <- args n]<br />
where args 1 = [[True],[False]]<br />
args n = concatMap (\x -> [x ++ [True], x ++ [False]]) $ args (n-1)<br />
toStr [] = ""<br />
toStr [x] = show x --otherwise we get a trailing space<br />
toStr (x:xs) = show x ++ " " ++ toStr xs<br />
</haskell><br />
<br />
== Problem 49 ==<br />
<br />
(**) Gray codes.<br />
<br />
An n-bit Gray code is a sequence of n-bit strings constructed according to certain rules. For example,<br />
<pre><br />
n = 1: C(1) = ['0','1'].<br />
n = 2: C(2) = ['00','01','11','10'].<br />
n = 3: C(3) = ['000','001','011','010',´110´,´111´,´101´,´100´].<br />
</pre><br />
<br />
Find out the construction rules and write a predicate with the following specification:<br />
<br />
% gray(N,C) :- C is the N-bit Gray code<br />
<br />
Can you apply the method of "result caching" in order to make the predicate more efficient, when it is to be used repeatedly?<br />
<br />
<pre><br />
Example in Haskell:<br />
P49> gray 3<br />
["000","001","011","010","110","111","101","100"]<br />
</pre><br />
<br />
Solution:<br />
<haskell><br />
gray :: Int -> [String]<br />
gray 0 = [""]<br />
gray n = let xs = gray (n-1) in map ('0':) xs ++ map ('1':) (reverse xs)<br />
</haskell><br />
<br />
It seems that the Gray code can be recursively defined in the way that for determining the gray code of n we take the Gray code of n-1, prepend a 0 to each word, take the Gray code for n-1 again, reverse it and prepend a 1 to each word. At last we have to append these two lists.<br />
(The [http://en.wikipedia.org/wiki/Gray_code Wikipedia article] seems to approve this.)<br />
<br />
== Problem 50 ==<br />
<br />
(***) Huffman codes.<br />
<br />
We suppose a set of symbols with their frequencies, given as a list of fr(S,F) terms. Example: [fr(a,45),fr(b,13),fr(c,12),fr(d,16),fr(e,9),fr(f,5)]. Our objective is to construct a list hc(S,C) terms, where C is the Huffman code word for the symbol S. In our example, the result could be Hs = [hc(a,'0'), hc(b,'101'), hc(c,'100'), hc(d,'111'), hc(e,'1101'), hc(f,'1100')] [hc(a,'01'),...etc.]. The task shall be performed by the predicate huffman/2 defined as follows: <br />
<br />
% huffman(Fs,Hs) :- Hs is the Huffman code table for the frequency table Fs<br />
<br />
Example in Haskell:<br />
<pre><br />
*Exercises> huffman [('a',45),('b',13),('c',12),('d',16),('e',9),('f',5)]<br />
[('a',"0"),('b',"101"),('c',"100"),('d',"111"),('e',"1101"),('f',"1100")]<br />
</pre><br />
<br />
Solution:<br />
<haskell><br />
import Data.List<br />
<br />
data HTree a = Leaf a | Branch (HTree a) (HTree a)<br />
deriving Show<br />
<br />
huffman :: (Ord a, Ord w, Num w) => [(a,w)] -> [(a,[Char])]<br />
huffman freq = sortBy (comparing fst) $ serialize $<br />
htree $ sortBy (comparing fst) $ [(w, Leaf x) | (x,w) <- freq]<br />
where htree [(_, t)] = t<br />
htree ((w1,t1):(w2,t2):wts) =<br />
htree $ insertBy (comparing fst) (w1 + w2, Branch t1 t2) wts<br />
comparing f x y = compare (f x) (f y)<br />
serialize (Branch l r) =<br />
[(x, '0':code) | (x, code) <- serialize l] ++<br />
[(x, '1':code) | (x, code) <- serialize r]<br />
serialize (Leaf x) = [(x, "")]<br />
</haskell><br />
The argument to <tt>htree</tt> is a list of (weight, tree) pairs, in order of increasing weight.<br />
The implementation could be made more efficient by using a priority queue instead of an ordered list. <br />
<br />
[[Category:Tutorials]]</div>Philh