// [snippet: Ninety-Nine F# Problems - Problems 90 - 94 - Miscellaneous problems] /// Ninety-Nine F# Problems - Problems 90 - 94 /// /// These are F# solutions of Ninety-Nine Haskell Problems /// (http://www.haskell.org/haskellwiki/H-99:_Ninety-Nine_Haskell_Problems), /// which are themselves translations of Ninety-Nine Lisp Problems /// (http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html) /// and Ninety-Nine Prolog Problems /// (https://sites.google.com/site/prologsite/prolog-problems). /// /// If you would like to contribute a solution or fix any bugs, send /// an email to paks at kitiara dot org with the subject "99 F# problems". /// I'll try to update the problem as soon as possible. /// /// The problems have different levels of difficulty. Those marked with a single asterisk (*) /// are easy. If you have successfully solved the preceeding problems you should be able to /// solve them within a few (say 15) minutes. Problems marked with two asterisks (**) are of /// intermediate difficulty. If you are a skilled F# programmer it shouldn't take you more than /// 30-90 minutes to solve them. Problems marked with three asterisks (***) are more difficult. /// You may need more time (i.e. a few hours or more) to find a good solution /// /// Though the problems number from 1 to 99, there are some gaps and some additions marked with /// letters. There are actually only 88 problems. /// // [/snippet] // [snippet: (**) Problem 90 : Eight queens problem] /// This is a classical problem in computer science. The objective is to place eight queens on a /// chessboard so that no two queens are attacking each other; i.e., no two queens are in the /// same row, the same column, or on the same diagonal. /// /// Hint: Represent the positions of the queens as a list of numbers 1..N. Example: /// [4,2,7,3,6,8,5,1] means that the queen in the first column is in row 4, the queen in the /// second column is in row 2, etc. Use the generate-and-test paradigm. /// /// Example in F#: /// /// > queens 8 |> Seq.length;; /// val it : int = 92 /// > queens 8 |> Seq.head;; /// val it : int list = [1; 5; 8; 6; 3; 7; 2; 4] /// > queens 20 |> Seq.head;; /// val it : int list = /// [1; 3; 5; 2; 4; 13; 15; 12; 18; 20; 17; 9; 16; 19; 8; 10; 7; 14; 6; 11] (*[omit:(Solution)]*) // instead of solving the problem for 8 queens lets solve if for N queens. // To solve the problem we are going to start with an empty board and then we're going // add queen to it for each row. Elimitating invalid solutions. To do that we need a function // (invalidPosition) that detects if one queen is in conflict with another one. And another // function (validSolution) that would test if the queen that we're adding is not in // conflict with any queen already on the board. // Also, the solution is going to return a a sequence of solutions instead of a list. // That way we can get one solution realy fast if that is only what we care. For example // getting all the solutions for a 20x20 board would take a long time, but finding // the first solution only takes 5 seconds. // let queens n = let invalidPosition (x1, y1) (x2, y2) = (x1 = x2) || (y1 = y2) || abs (x1 - x2) = abs (y1 - y2) let validSolution (queen, board) = board |> Seq.exists (invalidPosition queen) |> not // With the function "loop", we're going to move one column at time, placing queens // on each row and creating new boards with only valid solutions. let rec loop boards y = if y = 0 then boards else let boards' = boards |> Seq.collect(fun board -> [1 .. n] |> Seq.map(fun x -> (x,y),board)) |> Seq.filter validSolution |> Seq.map(fun (pos, xs) -> pos::xs) loop boards' (y - 1) loop (Seq.singleton([])) n |> Seq.map (List.rev >> List.map fst) (*[/omit]*) // [/snippet] // [snippet: (**) Problem 91 : Knight's tour] /// Another famous problem is this one: How can a knight jump on an NxN chessboard in such a way /// that it visits every square exactly once? A set of solutions is given on the The_Knights_Tour /// page. /// /// Hints: Represent the squares by pairs of their coordinates of the form X/Y, where both X and /// Y are integers between 1 and N. (Note that '/' is just a convenient functor, not division!) /// Define the relation jump(N,X/Y,U/V) to express the fact that a knight can jump from X/Y to U/V /// on a NxN chessboard. And finally, represent the solution of our problem as a list of N*N knight /// positions (the knight's tour). /// /// There are two variants of this problem: /// 1. find a tour ending at a particular square /// 2. find a circular tour, ending a knight's jump from the start (clearly it doesn't matter where /// you start, so choose (1,1)) /// /// Example in F#: /// /// > knightsTour 8 (1,1) |> Seq.head;; /// val it : (int * int) list = /// [(4, 3); (6, 4); (5, 6); (4, 8); (3, 6); (5, 5); (6, 3); (4, 4); (2, 3); /// (1, 5); (3, 4); (5, 3); (6, 5); (4, 6); (2, 7); (3, 5); (5, 4); (6, 6); /// (4, 5); (2, 4); (1, 6); (2, 8); (4, 7); (6, 8); (8, 7); (7, 5); (8, 3); /// (7, 1); (5, 2); (3, 1); (1, 2); (3, 3); (4, 1); (2, 2); (1, 4); (2, 6); /// (1, 8); (3, 7); (5, 8); (7, 7); (8, 5); (7, 3); (8, 1); (6, 2); (7, 4); /// (8, 2); (6, 1); (4, 2); (2, 1); (1, 3); (2, 5); (1, 7); (3, 8); (5, 7); /// (7, 8); (8, 6); (6, 7); (8, 8); (7, 6); (8, 4); (7, 2); (5, 1); (3, 2); /// (1, 1)] /// /// > endKnightsTour 8 (4,2);; /// val it : (int * int) list = /// [(4, 2); (2, 1); (1, 3); (3, 2); (1, 1); (2, 3); (1, 5); (2, 7); (4, 8); /// (6, 7); (8, 8); (7, 6); (6, 8); (8, 7); (7, 5); (8, 3); (7, 1); (5, 2); /// (3, 1); (1, 2); (2, 4); (1, 6); (2, 8); (4, 7); (2, 6); (1, 8); (3, 7); /// (5, 8); (7, 7); (8, 5); (7, 3); (8, 1); (6, 2); (4, 1); (2, 2); (1, 4); /// (3, 5); (5, 6); (4, 4); (2, 5); (1, 7); (3, 8); (5, 7); (7, 8); (8, 6); /// (7, 4); (6, 6); (4, 5); (3, 3); (5, 4); (4, 6); (6, 5); (8, 4); (7, 2); /// (6, 4); (4, 3); (5, 1); (6, 3); (8, 2); (6, 1); (5, 3); (3, 4); (5, 5); /// (3, 6)] /// /// > closedKnightsTour 8;; /// val it : (int * int) list = /// [(2, 3); (4, 4); (6, 3); (5, 5); (4, 3); (6, 4); (5, 6); (4, 8); (3, 6); /// (1, 5); (3, 4); (5, 3); (6, 5); (4, 6); (2, 7); (3, 5); (5, 4); (6, 6); /// (4, 5); (2, 4); (1, 6); (2, 8); (4, 7); (6, 8); (8, 7); (7, 5); (8, 3); /// (7, 1); (5, 2); (3, 1); (1, 2); (3, 3); (4, 1); (2, 2); (1, 4); (2, 6); /// (1, 8); (3, 7); (5, 8); (7, 7); (8, 5); (7, 3); (8, 1); (6, 2); (7, 4); /// (8, 2); (6, 1); (4, 2); (2, 1); (1, 3); (2, 5); (1, 7); (3, 8); (5, 7); /// (7, 8); (8, 6); (6, 7); (8, 8); (7, 6); (8, 4); (7, 2); (5, 1); (3, 2); /// (1, 1)] (*[omit:(Solution)]*) // Wikipedia has a nice article about this problem http://en.wikipedia.org/wiki/Knights_tour // // The way this algorithm works is like this. We create a set (board) with all the positions // in the board that have not being used. Also we have a function (moves) that returns a // list of posible moves from the current position. The variable 'validMoves' is the result of // removing all the positions returned by 'moves' that are not in the set 'board' (positions // that are still available). If validMoves is empty, that means that we can not move // anymore. If at that time the board is empty, we have a solution! Otherwise we remove the // current position from the board add the curent position to the tour and continue to one // of the valid moves. // Now, the trick to make the algorithm converge is to move first to the valid position // that has the less options once we move (Warnsdorff's rule). // let moves n (x,y) = [(x + 2, y + 1); (x + 2, y - 1); (x - 2, y + 1); (x - 2, y - 1); (x - 1, y + 2); (x - 1, y - 2); (x + 1, y + 2); (x + 1, y - 2) ] |> List.filter(fun (x,y) -> x > 0 && x <= n && y > 0 && y <= n) let knightsTours n start = let board = [1 .. n] |> List.collect(fun x -> [1 .. n] |> List.map(fun y -> (x,y))) |> Set.ofList let rec loop tour board = seq { let validMoves = tour |> List.head // the head of the tour is our current position |> moves n |> List.filter(fun p -> board |> Set.contains p) match validMoves with | [] -> if board |> Set.isEmpty then yield tour // we found a solution! | _ -> // the call to sortBy is what makes this algorithm converge fast. // We want to go first to the position with the less options // once we move (Warnsdorff's rule). for p in validMoves |> List.sortBy(moves n >> List.length) do yield! loop (p::tour) <| Set.remove p board } loop [start] <| Set.remove start board let closedKnightsTour n = let start = (1,1) let finish = moves n start |> Set.ofList let flip f a b = f b a // lets find the first solution that ends in a position next to the start knightsTours n start |> Seq.find(List.head >> flip Set.contains finish) let endKnightsTour n finish = // just find a tour that starts with finish and reverse it! knightsTours n finish |> Seq.head |> List.rev (*[/omit]*) // [/snippet] // [snippet: (***) Problem 92 : Von Koch's conjecture] /// Several years ago I met a mathematician who was intrigued by a problem for which he didn't /// know a solution. His name was Von Koch, and I don't know whether the problem has been /// solved since. /// /// 6 /// (d) (e)---(f) (4) (1)---(7) /// | | 1 | | 5 /// (a)---(b)---(c) (3)---(6)---(2) /// | 2 | 3 4 /// (g) (5) /// /// Anyway the puzzle goes like this: Given a tree with N nodes (and hence N-1 edges). Find a /// way to enumerate the nodes from 1 to N and, accordingly, the edges from 1 to N-1 in such /// a way, that for each edge K the difference of its node numbers equals to K. The conjecture /// is that this is always possible. /// /// For small trees the problem is easy to solve by hand. However, for larger trees, and 14 is /// already very large, it is extremely difficult to find a solution. And remember, we don't /// know for sure whether there is always a solution! /// /// Write a predicate that calculates a numbering scheme for a given tree. What is the solution /// for the larger tree pictured below? /// /// (i) (g) (d)---(k) (p) /// \ | | | /// (a)---(c)---(e)---(q)---(n) /// / | | | /// (h) (b) (f) (m) /// /// Example in F#: /// > vonKoch (['d';'a';'g';'b';'c';'e';'f'],[('d', 'a');('a', 'g');('a', 'b');('b', 'e'); /// ('b', 'c');('e', 'f')]) |> Seq.head;; /// /// val it : int list * (int * int * int) list = /// ([4; 3; 5; 6; 2; 1; 7], /// [(4, 3, 1); (3, 5, 2); (3, 6, 3); (6, 1, 5); (6, 2, 4); (1, 7, 6)]) /// (*[omit:(Solution)]*) // After some searching on the internet I couldn't find an algorithm for Graceful labeling. // So I decided to go the brute force route. I knew this would work with the first the example // but I wasn't sure if it would work for the second tree (a tree with 14 Nodes means that we have // 14! (87,178,291,200) posible ways to tag the tree). // Luckly, it did!! // To represent the trees, I decided to use a tuple with a list of nodes and a list of tuples with the edges type 'a Graph = 'a list * ('a * 'a) list // Here are the two examples above using that representation. let g = (['d';'a';'g';'b';'c';'e';'f'],[('d', 'a');('a', 'g');('a', 'b');('b', 'e');('b', 'c');('e', 'f')]) let g' = (['i';'h';'g';'a';'b';'d';'c';'f';'k';'e';'q';'m';'p';'n'],[('i', 'a');('h', 'a');('a', 'b');('a', 'g');('a', 'c');('c', 'f');('c','d');('d','k');('c','e');('e','q');('q','m');('q','n');('n','p')]) // Now I knew how to generate permutations in F# from this snippet: http://fssnip.net/48 // But the problem was, that implementation was using lists and it would not work to generate the // 87 billion permutations for the 14 node tree. Then I remember the LazyList type in the F# // Power Pack. Now I can generate the permutations in a lazy way and pray that a solution // can be found fast. // Here is the implemetation of using LazyList. #if INTERACTIVE #r "FSharp.PowerPack.dll" #endif open Microsoft.FSharp.Collections // the term interleave x ys returns a list of all possible ways of inserting // the element x into the list ys. let rec interleave x = function | LazyList.Nil -> LazyList.ofList [ LazyList.ofList [x]] | LazyList.Cons(y,ys) -> LazyList.ofSeq (seq { yield LazyList.cons x (LazyList.cons y ys) for zs in interleave x ys do yield LazyList.cons y zs }) // the function perms returns a lazy list of all permutations of a list. let rec perms = function | LazyList.Nil -> LazyList.ofList [LazyList.empty] | LazyList.Cons(x,xs) -> LazyList.concat ( LazyList.map (interleave x) (perms xs)) // Now with the problem of generating all the permutations solved. // It's time to tackle the real problem. let vonKoch (nodes, edges) = // diff is used to compute the edge difference acording the the map m let diff (m : Map<_, _>) (a,b) = abs <| m.[a] - m.[b] let size = nodes |> List.length let edgSize = edges |> List.length match nodes with | [] -> failwith "Empty graph!!" | _ when size <> (edgSize + 1) -> // make sure that we have a valid tree failwith "The tree doesn't have N - 1 egdes. Where N is the number of nodes" | _ -> seq { for p in perms <| LazyList.ofList [1 .. size] do let sol = LazyList.toList p let m = sol |> List.zip nodes |> Map.ofList // I'm using Set here to filter out any duplicates. // It's faster than Seq.distinct let count = edges |> List.map (diff m) |> Set.ofList |> Set.count // if the number of distint differences is equal to the number // of edges, we found a solution! if count = edgSize then yield (sol, edges |> List.map (fun ((a,b) as e) -> m.[a], m.[b], diff m e)) } (*[/omit]*) // [/snippet] // [snippet: (***) Problem 93 : An arithmetic puzzle] /// Given a list of integer numbers, find a correct way of inserting arithmetic signs (operators) /// such that the result is a correct equation. Example: With the list of numbers [2,3,5,7,11] we /// can form the equations 2-3+5+7 = 11 or 2 = (3*5+7)/11 (and ten others!). /// /// Division should be interpreted as operating on rationals, and division by zero should be /// avoided. /// /// Example in F#: /// /// > solutions [2;3;5;7;11] |> List.iter (printfn "%s");; /// 2 = 3 - (5 + (7 - 11)) /// 2 = 3 - ((5 + 7) - 11) /// 2 = (3 - 5) - (7 - 11) /// 2 = (3 - (5 + 7)) + 11 /// 2 = ((3 - 5) - 7) + 11 /// 2 = ((3 * 5) + 7) / 11 /// 2 * (3 - 5) = 7 - 11 /// 2 - (3 - (5 + 7)) = 11 /// 2 - ((3 - 5) - 7) = 11 /// (2 - 3) + (5 + 7) = 11 /// (2 - (3 - 5)) + 7 = 11 /// ((2 - 3) + 5) + 7 = 11 /// val it : unit = () /// (*[omit:(Solution)]*) // This is similar to "The countdow problem" on chapter 11 in the book // Programming in Haskell by Graham Hutton // First let's define our operations. The ToString override is there to help // on printing the solutions later on. type Op = Add | Sub | Mult | Div with override op.ToString() = match op with | Add -> "+" | Sub -> "-" | Mult -> "*" | Div -> "/" // Here we define wich opertaions are valid. // For Add or Sub there is no problem // For Mult we dont want trivial mutiplications by 1. Although the // problem statement is not clear if that is an issue. // For Div we don't want division by 0, by 1 or fractions let valid op x y = match op with | Add -> true | Sub -> true | Mult -> x <> 1 && y <> 1 | Div -> y <> 0 && y <> 1 && x % y = 0 // this is function applies the operation to the x and y arguments let app op x y = match op with | Add -> x + y | Sub -> x - y | Mult -> x * y | Div -> x / y // Now, we define our expresions. This is how are we going to build the // solutions type Expr = Val of int | App of Op * Expr * Expr // Just for fun, I implemented the fold function for our expresions. // There was no need since we only use it once on the toString function. let foldExpr fval fapp expr = let rec loop expr cont = match expr with | Val n -> cont <| fval n | App(op, l, r) -> loop l <| fun ls -> loop r <| fun rs -> cont <| fapp op ls rs loop expr id // Once we have fold over expresions impelmenting toString is a one-liner. // The code after the fold is just to remove the outher parentesis. let toString exp = let str = exp |> foldExpr string (fun op l r -> "(" + l + " " + string op + " " + r + ")") if str.StartsWith("(") then str.Substring(1,str.Length - 2) else str // The 'eval' function returns a sigleton list with the result of the evaluation. // If the expresion is not valid, returns the empty list ([]) let rec eval = function | Val n -> [n] | App(op, l, r) -> [for x in eval l do for y in eval r do if valid op x y then yield app op x y] // The function 'init', 'inits', 'tails' are here to help implement the // function splits and came from haskell // the function inits accepts a list and returns the list without its last item let rec init = function | [] -> failwith "empty list!" | [_] -> [] | x::xs -> x :: init xs // The function inits returns the list of all initial segments // of a list , in order of increasing length. // Example: // > inits [1..4];; // val it : int list list = [[]; [1]; [1; 2]; [1; 2; 3]; [1; 2; 3; 4]] let rec inits = function | [] -> [[]] | x::xs -> [ yield [] for ys in inits xs do yield x::ys] // the function tails returns the list of initial segments // of its argument list, shortest last // Example: // > tails [1..4];; // val it : int list list = [[1; 2; 3; 4]; [2; 3; 4]; [3; 4]; [4]; []] let rec tails = function | [] -> [[]] | x::xs as ls -> [ yield ls for ys in tails xs do yield ys ] // this is what drives the solution to this problem and // came from the haskell solution. // Here is an example of its use: // > splits [1..4];; // val it : (int list * int list) list = // [([1], [2; 3; 4]); ([1; 2], [3; 4]); ([1; 2; 3], [4])] // As you can see, it returs all the ways we can split a list. let splits xs = List.tail (init (List.zip (inits xs) (tails xs))) // Now that we're armed with all these functions, we're ready to tackle the real problem. // The goal of the function expressions is to build all valid expressions and its value given a // list of numbers. First we split the list in all posible ways (1). Then we take // the left side of the split and build all the valid expresions (2). We do the same for the // right side (3). Now we combine the two expresions with all the operators (4). If the operation // is valid, we add it to the list of expressions (5,6). let rec expressions = function | [x] -> [(Val x, x)] | xs -> [ for xsl, xsr in splits xs do (* 1 *) for (expl, vall) in expressions xsl do (* 2 *) for (expr, valr) in expressions xsr do (* 3 *) for op in [Add; Sub; Mult; Div] do (* 4 *) if valid op vall valr then (* 5 *) yield (App (op, expl, expr) ,app op vall valr) (* 6 *)] // Now that we have a way of generating valid expressions, it's time to // generate the equaions. Again, we split the list of numbers (1). Then we generate the // list of expressions from the left side of the split (2). Same with the right side (3). // If both expressions have the same value, add it to our soutions (4,5). let equations = function | [] -> failwith "error: empty list" | [_] -> failwith "error: singleton list" | xs -> [for xsl, xsr in splits xs do (* 1 *) for el, vl in expressions xsl do (* 2 *) for er, vr in expressions xsr do (* 3 *) if vl = vr then (* 4 *) yield (el, er) (* 5 *)] // Go thought the list of equations a pretty-print them. let solutions = equations >> List.map(fun (exp1, exp2) -> toString exp1 + " = " + toString exp2) (*[/omit]*) // [/snippet] // [snippet: (***) Problem 94 : Generate K-regular simple graphs with N nodes] /// In a K-regular graph all nodes have a degree of K; i.e. the number of edges incident in each /// node is K. How many (non-isomorphic!) 3-regular graphs with 6 nodes are there? (*[omit:(Solution needed)]*) let solution94 = "your solution here!!" (*[/omit]*) // [/snippet]