4 people like it.

Like the snippet!

## 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 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))

// 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))

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))

// The rules to contruct gray codes can be found here : http://en.wikipedia.org/wiki/Gray_code

let rec gray = function

| 0 -> [""]

| n ->

let prev = gray (n - 1)

(prev |> List.map ((+) "0")) @ (prev |> List.rev |> List.map((+) "1"))

let rec gray = function

| 0 -> [""]

| n ->

let prev = gray (n - 1)

(prev |> List.map ((+) "0")) @ (prev |> List.rev |> List.map((+) "1"))

// 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 *)

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: |
3 years ago |

Author: |
Cesar Mendoza (website) |

Tags: |
Ninety-Nine F# Problems, tutorial, F#, logic, codes |