Ninety-Nine F# Problems - Problems 46 - 50 - Logic and Codes

These are F# solutions of Ninety-Nine Haskell Problems which are themselves translations of Ninety-Nine Lisp Problems and Ninety-Nine Prolog Problems. The solutions are hidden so you can try to solve them yourself.

Ninety-Nine F# Problems - Problems 46 - 50 - Logic and Codes

 1: /// These are F# solutions of Ninety-Nine Haskell Problems 
 2: /// (http://www.haskell.org/haskellwiki/H-99:_Ninety-Nine_Haskell_Problems), 
 3: /// which are themselves translations of Ninety-Nine Lisp Problems
 4: /// (http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
 5: /// and Ninety-Nine Prolog Problems
 6: /// (https://sites.google.com/site/prologsite/prolog-problems).
 7: ///
 8: /// If you would like to contribute a solution or fix any bugs, send 
 9: /// an email to paks at kitiara dot org with the subject "99 F# problems". 
10: /// I'll try to update the problem as soon as possible.
11: ///
12: /// The problems have different levels of difficulty. Those marked with a single asterisk (*) 
13: /// are easy. If you have successfully solved the preceeding problems you should be able to 
14: /// solve them within a few (say 15) minutes. Problems marked with two asterisks (**) are of 
15: /// intermediate difficulty. If you are a skilled F# programmer it shouldn't take you more than 
16: /// 30-90 minutes to solve them. Problems marked with three asterisks (***) are more difficult. 
17: /// You may need more time (i.e. a few hours or more) to find a good solution
18: ///
19: /// Though the problems number from 1 to 99, there are some gaps and some additions marked with 
20: /// letters. There are actually only 88 problems.

(**) Problem 46 : Define Logical predicates

 1: /// Define predicates and/2, or/2, nand/2, nor/2, xor/2, impl/2 and equ/2 (for logical 
 2: /// equivalence) which succeed or fail according to the result of their respective 
 3: /// operations; e.g. and(A,B) will succeed, if and only if both A and B succeed.
 4: ///  
 5: /// A logical expression in two variables can then be written as in the following example: 
 6: /// and(or(A,B),nand(A,B)).
 7: ///  
 8: /// Now, write a predicate table/3 which prints the truth table of a given logical 
 9: /// expression in two variables.
10: ///  
11: /// Example: 
12: /// (table A B (and A (or A B)))
13: /// true true true
14: /// true fail true
15: /// fail true fail
16: /// fail fail fail
17: ///  
18: /// Example in F#: 
19: /// 
20: /// > table (fun a b -> (and' a (or' a b)));;
21: /// true true true
22: /// true false true
23: /// false true false
24: /// false false false
25: /// val it : unit = ()
26: 
27: (Solution)

(*) Problem 47 : Truth tables for logical expressions (2).

 1: /// Continue problem P46 by defining and/2, or/2, etc as being operators. This allows to write 
 2: /// the logical expression in the more natural way, as in the example: A and (A or not B). 
 3: /// Define operator precedence as usual; i.e. as in Java.
 4: ///  
 5: /// Example: 
 6: /// * (table A B (A and (A or not B)))
 7: /// true true true
 8: /// true fail true
 9: /// fail true fail
10: /// fail fail fail
11: ///  
12: /// Example in F#: 
13: /// 
14: /// > table2 (fun a b -> a && (a || not b));;
15: /// true true true
16: /// true false true
17: /// false true false
18: /// false false false
19: /// val it : unit = ()
20: 
21: (Solution)

(**) Problem 48 : Truth tables for logical expressions (3).

 1: /// Generalize problem P47 in such a way that the logical expression may contain any 
 2: /// number of logical variables. Define table/2 in a way that table(List,Expr) prints the 
 3: /// truth table for the expression Expr, which contains the logical variables enumerated 
 4: /// in List.
 5: ///  
 6: /// Example: 
 7: /// * (table (A,B,C) (A and (B or C) equ A and B or A and C))
 8: /// true true true true
 9: /// true true fail true
10: /// true fail true true
11: /// true fail fail true
12: /// fail true true true
13: /// fail true fail true
14: /// fail fail true true
15: /// fail fail fail true
16: ///  
17: /// Example in F#: 
18: /// 
19: /// > tablen 3 (fun [a;b;c] -> a && (b || c) = a && b || a && c)
20: /// warning FS0025: Incomplete pattern matches on this expression. ...
21: /// True True True true
22: /// False True True false
23: /// True False True true
24: /// False False True false
25: /// True True False true
26: /// False True False false
27: /// True False False false
28: /// False False False false
29: /// val it : unit = ()
30: 
31: (Solution)

(**) Problem 49 : Gray codes.

 1: /// An n-bit Gray code is a sequence of n-bit strings constructed according to certain rules.
 2: /// For example,
 3: ///
 4: /// n = 1: C(1) = ['0','1'].
 5: /// n = 2: C(2) = ['00','01','11','10'].
 6: /// n = 3: C(3) = ['000','001','011','010',´110´,´111´,´101´,´100´].
 7: ///  
 8: /// Find out the construction rules and write a predicate with the following specification:
 9: ///  % gray(N,C) :- C is the N-bit Gray code
10: ///  
11: /// Can you apply the method of "result caching" in order to make the predicate more efficient, 
12: /// when it is to be used repeatedly?
13: ///  
14: /// Example in F#: 
15: /// 
16: /// P49> gray 3
17: /// ["000","001","011","010","110","111","101","100"]
18: 
19: (Solution)

(***) Problem 50 : Huffman codes.

 1: /// We suppose a set of symbols with their frequencies, given as a list of fr(S,F) terms. 
 2: /// Example: [fr(a,45),fr(b,13),fr(c,12),fr(d,16),fr(e,9),fr(f,5)]. Our objective is to 
 3: /// construct /// a list hc(S,C) terms, where C is the Huffman code word for the symbol 
 4: /// S. In our example, the result could be Hs = [hc(a,'0'), hc(b,'101'), hc(c,'100'), 
 5: /// hc(d,'111'), hc(e,'1101'), hc(f,'1100')] [hc(a,'01'),...etc.]. The task shall be 
 6: /// performed by the predicate huffman/2 defined as follows:
 7: /// 
 8: ///  % huffman(Fs,Hs) :- Hs is the Huffman code table for the frequency table Fs
 9: ///  
10: /// Example in F#: 
11: /// 
12: /// > huffman [('a',45);('b',13);('c',12);('d',16);('e',9);('f',5)];;
13: /// val it : (char * string) list =
14: ///   [('a', "0"); ('b', "101"); ('c', "100"); ('d', "111"); ('e', "1101");
15: ///    ('f', "1100")]
16: 
17: (Solution)

let and' = (&&)

let or' = (||)

let nand a b = not <| and' a b

let nor a b = not <| or' a b

let xor a b = if a <> b then true else false

let impl a b = compare a b |> (<>) 1

let eq = (=)

let table expr =
let inputs = [ (true, true); (true, false); (false, true); (false, false) ]
inputs |> Seq.iter (fun (a,b) -> printfn "%b %b %b" a b (expr a b))

// let's use the F# built-in operateros plus:

// xor
let (&|) a b = if a <> b then true else false

// nand
let (^&&) a b = not <| a && b

// nor
let (^||) a b = not <| a || b

// impl
let (|->) a b = compare a b |> (<>) 1

// same as problem 46
let table2 expr =
let inputs = [ (true, true); (true, false); (false, true); (false, false) ]
inputs |> Seq.iter (fun (a,b) -> printfn "%b %b %b" a b (expr a b))

let tablen n expr =
    let replicate n xs =
        let rec repl acc n =
            match n with
                | 0 -> acc
                | n ->
                    let acc' = acc |> List.collect(fun ys -> xs |> List.map(fun x -> x::ys))
                    repl acc' (n-1)
        repl [[]] n

    let values = replicate n [true; false]
    let toString bs = System.String.Join(" ", Array.ofList (bs |> List.map string))
    values |> Seq.iter(fun bs -> printfn "%s %b" (bs |> toString) (expr bs))

// First we create a representation of the Huffman tree
type 'a HuffmanTree = Node of int (*frecuency*) * 'a (* left *) HuffmanTree * 'a (* right *) HuffmanTree | Leaf of int * 'a (* term *)

// Auxiliary function to get the frecuency
let frecuency = function
    | Leaf (frec, _) -> frec
    | Node(frec, _, _) -> frec

// Once we have build the Huffman tree, we can use this function to assing the codes
// nodes to the left get a '0'. Nodes to the right get a '1'.
let encode tree =
    let rec enc code tree cont =
        match tree with
            | Leaf (_, a) -> cont [(a, code)]
            | Node(_, lt, rt) ->
                enc (code + "0") lt <| fun ltacc -> enc (code + "1") rt <| fun rtacc -> cont (ltacc @ rtacc)
    enc "" tree id

// The algorithm is explained here: http://en.wikipedia.org/wiki/Huffman_coding
// The implementation below uses lists. For better performance use a priority queue.
// This is how it works. First we transform the list of terms and frecuencies into a list of Leafs (6).
// Then, before anything happpens, we sort the list to place the terms with the lowest frecuency
// at the head of the List (1) (this is where a priority queue would shine).
// Otherwise, we combine the first two elements into a Node with the combined frecuency of the two nodes (4).
// We add the node to the list and try again (5). Eventualy the list is reduced to
// one term and we're done constructing the tree (2). Once we have the tree, we just need to encode it (7).
let huffman symbols =
    let rec createTree tree =
        let xs = tree |> List.sortBy frecuency (* 1 *)
        match xs with
            | [] -> failwith "Empty list"
            | [x] -> x (* 2 *)
            | x::y::xs -> (* 3 *)
                let ht = Node(frecuency x + frecuency y, x , y) (* 4 *)
                createTree (ht::xs) (* 5 *)
    let ht = symbols
             |> List.map(fun (a,f) -> Leaf (f,a)) (* 6 *)
             |> createTree
    encode ht |> List.sortBy(fst) (* 7 *)

More information

Link:	http://fssnip.net/ar
Posted:	1 years ago
Author:	Cesar Mendoza (website)
Tags:	Ninety-Nine F# Problems, tutorial, F#, logic, codes