This is a quite popular coding interview question: “Add two numbers without using arithmetic operators“. Solving it assumes candidate’s understanding (or just re-inventing) of how summation was implemented in early days of computer electronics – see how half-adder performs addition of two bits using **XOR**, **AND**, and **SHIFT**. F# one-liner implementing the same approach for adding two integers using just bit manipulations looks elegant enough to deserve a post:

let rec sum n = function 0 -> n | _ as n' -> sum (n^^^n') ((n&&&n')<<<1)

Just beautiful!

Solving Project Euler Problem 90 in a pure functional manner is fun. First and foremost, when picking an approach, we may notice that there are only “6 of 10” different combinations exist for dices with numbers **0** to **9** on sides, which equals to **210**. In turn, this gives only **44100** combinations for a pair of dices, so simple brute forcing the solution is feasible.

Let’s begin with the list of target squares. We represent it as a list **squares** of tuples **(tens, ones)** for all digit squares; also there is no need to differentiate **9** from **6**, so the final list is

**[(0, 1); (0, 4); (0, 6); (1, 6); (2, 5); (3, 6); (4, 6); (6, 4); (8, 1)]**. This list is the key piece of function **isValidArrangement** that for two sets of digits representing a dice sides each determines if all elements of **squares** list can be represented by pair of sides given as arguments.

Then, function **combinations** yields all combinations of the given **size** from the given list **ls**, i.e. all possible dice side lists **allDices** would be contained in **combinations 6 [0..9]**. Finally, as we want to represent a dice as a set of its sides with the help of function **asSetofSides** we would turn **9** to **6** unless both these digits are present on the same dice.

The rest is trivial: build a sequence of all dice pairs **allDicePairs** where each pair is a tuple of side sets and count number of elements that are recognized as **isValidArrangement**. As each valid arrangement is duplicated by dice switch, the solution would be this number divided by **2**.

let squares = [ for i in 1..9 -> i*i ] |> List.map (fun square -> let tens, ones = square/10, square%10 in (tens, if ones = 9 then 6 else ones)) let isValidArrangement dice1 dice2 = let rec scan = function | [] -> true | (tens,ones)::t -> if (Set.contains tens dice1 && Set.contains ones dice2) || (Set.contains tens dice2 && Set.contains ones dice1) then scan t else false scan squares let rec combinations size ls = let rec bead = function | [] -> [] | h::t -> (h,t) :: [ for (l, ls) in bead t -> (l, ls) ] [match size with | 0 -> yield [] | _ -> for (first, rest) in bead ls do for tail in combinations (size - 1) rest do yield first::tail] let allDices = combinations 6 [0..9] let asSetofSides dice = let sides = Set.ofList dice in if sides.Contains 9 && not (sides.Contains 6) then (sides.Remove 9).Add 6 else sides let allDicePairs = seq { for dice1 in allDices do for dice2 in allDices do yield (asSetofSides dice1, asSetofSides dice2) } let problem090() = allDicePairs |> Seq.sumBy (fun (dice1, dice2) -> if isValidArrangement dice1 dice2 then 1 else 0) |> (/) <| 2

Solving Problem 89 was easy. In fact, solving the problem does not require any conversion of the source data as the question is how much shorter the converted numbers are going to be. It can be derived from the problem outline that cases for the length reduction are **IIII**, VIIII, XXXX, LXXXX, CCCC, and DCCCC. As each reduction of these yields just two digits, correspondent reductions are going to be **2**,**3**,**2**,**3**,**2**,**3**. Accumulating all reductions, being applied from the beginning of the file each time for the closest available reduction to the end will be the sought solution. Very simple recursive function **reduce** does exactly this.

open System.IO let rec reduce saved (roman: string) = match ([| "IIII"; "VIIII"; "XXXX"; "LXXXX"; "CCCC"; "DCCCC" |] |> Array.map (fun x -> (x, roman.IndexOf(x))) |> Array.filter (fun (x, i) -> i >= 0)) with | [||] -> saved | _ as a -> a |> Array.minBy(fun (x,i) -> i) |> fun (x,i) -> reduce (saved + x.Length - 2) (roman.Substring(i + x.Length)) let problem089() = File.ReadAllText( @"..\..\..\Datafiles\Problem089.data") |> reduce 0

After a quite long silence I’m back with F# solution to one of the relatively challenging (based on the number of people that solved it up to the date) Project Euler problems – Problem 88.

Two things are needed to be realized if approaching the solution from combinatorial search standpoint:

- Every number can be converted to a product-sum by the following simple operation – if a number
**n**is represented by a set of**f**factors we can convert it to a product-sum by adding to**f**factors**(n – sum(factors))**of**1s**that increase sum part while keeping product part constant. The result set would be a product-sum (not necessarily minimal) of the set of size**f + n – sum(factors)**. - For pretty obvious reasons the minimal product-sum for some
**k**is between**k**and**2k**.

So, if we manage to factorize all numbers between **2** and **24000** this would give us an answer. However, we can approach the task from the opposite consideration. If we manage building all combinations of factors yielding product-sums for different **k** in the above range and select minimum for each particular **k**, then after adding together all distinct minimums we should arrive to the same result.

What would help us assessing the latter approach is finding few boundary conditions. First, the maximum factorization of two factors yielding result closest to **24000** is **154*155**. Second, what would be the maximal number of factors yielding the same? Taking the minimal factor of **2** it is easy to find that this length is **14**.

Now, equipped with all these consideration we can lay out the algorithm for finding the solution. We can build a factors generator yielding us all possible sets of factors limited from up by set power of **14** and the product of **24000**. This is what the pair of functions **prodSums** and **moveNext** in the code below does: it first builds all lists of two factors from** [2;2]** to **[155;154]**, then all lists of three factors** [2;2;2]** to **[30;28;28]**, etc till the final list **[2;2;2;2;2;2;2;2;2;2;2;2;2;2]**. Using this sequence of factor lists **prodSums** we iterate thru it making a product-sum of each member and collecting correspondent minimums in array **prodSumMins**. Finally, we take a sum of each distinct number among all product-sum minimums for **2..12000**, which gives us the answer.

let K = 12000 let K2 = K*2 module List = let mul xs = xs |> List.reduce (fun a x -> a * x) let rec moveNext = function | h::t as x when x.Length = 14 -> if (h + 1) * (List.mul t) <= K2 then (h + 1) :: t else moveNext t | [] -> [] | h::t -> let mutable candidate = [] for i in 1 .. (14 - t.Length) do candidate <- (h + 1)::candidate candidate <- candidate @ t if (List.mul candidate) <= K2 then candidate else moveNext t let prodSums = [2;2;1;1;1;1;1;1;1;1;1;1;1;1] |> Seq.unfold (fun state -> if state = [] then None else Some(state, moveNext(state))) |> Seq.map (List.filter ((<>) 1)) let prodSumMins = Array.init (K + 1) ((*) 2) prodSumMins.[1] <- 0 let factorsProductSum xs = let sum, prod = List.sum xs, List.mul xs (xs.Length + prod - sum, prod) let updateMins = function size,prodSum -> if size <= K && prodSum < prodSumMins.[size] then prodSumMins.[size] <- prodSum let problem088() = prodSums |> Seq.iter (factorsProductSum >> updateMins) prodSumMins |> set |> Set.toArray |> Array.sum

Solving Project Euler Problem 87 was very straightforward.

Reusing **primes** sequence from solution to Project Euler Problem 10 limit it from up by **TOPPRIME**. Then build arrays of squares, cubes and powers of 4, similarly limited by **TOPSUM**. Finally, produce all possible sums of elements of these arrays, one of each, that again are limited by **TOPSUM**, accounting for unique values with the help of HashSet **unique**. Power of **unique** gives the problem solution.

#nowarn "40" let rec primes = Seq.cache <| seq { yield 2; yield! Seq.unfold nextPrime 3 } and nextPrime n = if isPrime n then Some(n, n + 2) else nextPrime(n + 2) and isPrime n = if n >= 2 then primes |> Seq.tryFind (fun x -> n % x = 0 || x * x > n) |> fun x -> x.Value * x.Value > n else false let TOPSUM = 50000000L let TOPPRIME = int(sqrt (float TOPSUM)) let problem087() = let candidates = primes |> Seq.takeWhile (fun x -> x <= TOPPRIME) |> Seq.map int64 let squares = candidates |> Seq.map (fun x -> x * x) |> Seq.toArray let cubes = candidates |> Seq.map (fun x -> x * x * x) |> Seq.takeWhile (fun x -> x < TOPSUM) |> Seq.toArray let fours = squares |> Seq.map (fun x -> x * x) |> Seq.takeWhile (fun x -> x < TOPSUM) |> Seq.toArray let unique = System.Collections.Generic.HashSet() for i in [0..squares.Length-1] do for j in [0..cubes.Length-1] do for k in [0..fours.Length-1] do let sum = squares.[i] + cubes.[j] + fours.[k] in if sum <= TOPSUM then unique.Add(sum) |> ignore unique.Count

Solving Project Euler Problem 86 requires a single geometry-related “AHA”: the shortest path from one corner of a cuboid with sides **l*w*h** to the diagonally opposite one is the hypotenuse of right triangle with cathetes **l** and **(w + h)**. The rest of the solution comes out quite straightforward: if we agree that **1<=h<=w<=l<=M**, then for each **l** from **1** to **M** sum **(h + w)** runs from **2** to **2*M**. For a sequence of growing **l**s we can find those sums **(w + h)** that yield positive integer of expression **sqrt(l*l + (w + h)*(w + h))**. Now the only thing is left to determine: how to for each suitable value **(w + h)** find the number of combinations of individual values **w** and **h** that are in line with **1<=h<=w<=l<=M**. This is what function **combinations** detects in the code below.

With these prerequisites the solution is straightforward: from infinite sequence of growing **M**s construct a sequence of tuples **(l, (h + w))**, then filter out all tuples, but those that yield integer hypotenuse lengths, then scan this filtered sequence into another sequence **(paths, M)**, of which skip members until the first where **paths >= 1000000**. The associated **M** is the solution answer.

let combinations l ``h + w`` = if l >= ``h + w`` then ``h + w``/ 2 else l - (``h + w`` + 1) / 2 + 1 let isIntegerHypotenuse (cathetus1,cathetus2) = let hypotenuse = sqrt (float (cathetus1 * cathetus1 + cathetus2 * cathetus2)) hypotenuse = floor hypotenuse let problem086() = Seq.initInfinite id |> Seq.collect (fun l -> seq {for ``h + w`` in [2..2*l] -> (l,``h + w``)}) |> Seq.filter isIntegerHypotenuse |> Seq.scan (fun (paths, M) (l, ``h + w``) -> (paths + (combinations l ``h + w``), l))(0,0) |> Seq.skipWhile (fun (paths, M) -> paths < 1000000) |> Seq.head |> snd

Today a question popped up on Stack Overflow on how to arrange running F# scripts from Windows context menu, but in case of abnormal termination still having opportunity to access diagnostics. Regular context menu item **Run with F# interactive** lacks the latter because interactive console window closes abruptly on script failure.

Although I gave an outline of the solution as Stack Overflow answer, it lacks level of details that those who want to use such feature may find useful. So, I decided to give here a more detailed description. I will show the implementation for my own work environment, which is Windows 7 Ultra x64 + VS2012 Ultra RC. Reproducing the approach for other environments may require trivial adjustments.

1. Let’s begin with spying the mechanics of stock context menu item **Run with F# interactive…** implementation. Let’s fire **regedit **in **Run as Administrator** mode and search through the registry for string value **Run with F# interactive**:

Getting one level down to the subkey **HKEY_CLASSES_ROOT\VisualStudio.fsx.11.0\shell\openRunFsi\command**

we can see how exactly this context menu item is implemented on my box:

"C:\Program Files (x86)\Microsoft SDKs\F#\3.0\Framework\v4.0\Fsi.exe" --quiet --exec "%1"

Now the outline of an unobtrusive solution gets clear: let’s create a custom key similar to **HKEY_CLASSES_ROOT\VisualStudio.fsx.11.0\shell\openRunFsi**, but with our own context menu command having desired properties. In order to make interactive console window stay we can shoot out a shell **cmd.exe** with command key **/k** preventing the associated window from closing. However, it came out a problem: being offered the **fsi.exe** path regular **cmd.exe** shell cannot correctly interprete quoted string having both spaces and parentethes. In order to workaround this complication we may use as command our own shim batch script **fsx.bat** that will correctly process the path and pass the argument (.fsx script name) to **fsi.exe**. So, the context menu command is to be

c:\windows\system32\cmd.exe /Q /K %%USERPROFILE%%\fsx.bat "%1"

and the shim batch script **fsx.bat** that we’re going to place *into the root of user’s directory* would be

"C:\Program Files (x86)\Microsoft SDKs\F#\3.0\Framework\v4.0\Fsi.exe" --quiet --exec "%~1"

The only outstanding task to do is adding our custom keys to the registry:

**HKEY_CLASSES_ROOT\VisualStudio.fsx.11.0\shell\openRunCmd**

and **HKEY_CLASSES_ROOT\VisualStudio.fsx.11.0\shell\openRunCmd\command**

Finally, let’s check out how everything sticks together. A simplest script **sample.fsx** will do:

printfn "Let's crash..." failwith "...but window stays" |> ignore

Let’s invoke it through context menu new item:

getting as expected

Voila!

After detail-laden Problem 84 solving Project Euler Problem 85 is a breeze. Nevertheless, prior to coding we need to do some preparatory math.

For our grid of **h*w** cells a specific rectangle can be selected by crossing 2 horizontal lines with 2 vertical. We can pick 2 horizontal lines in **(h + 1)!/2!*(h + 1 – 2)!** ways (see combination for justification). Similar is true for vertical lines: **(w + 1)!/2!*(w + 1 – 2)!**. After simplification it comes out that the number of different rectangles on a grid of **h*w** cells is **h*(h + 1)*w*(w + 1)/4**.

Now, let’s express approximate value of **w** via **h** assuming that overall number of rectangles is less, than 2000000:

**w = int(sqrt(float(8000000/(h*(h + 1)))))**. As we took **w*w** for **w*(w + 1)** approximation sometimes we may overshoot by 1; in these cases we would need to decrease **w** by 1.

The rest is quite simple: starting with **h=1** and ending with largest **h **less, than** w **let’s find all pairs ** (w,h) **that function

**yields value closest to 2000000. Of this sequence we select such area**

**rectangles w h****w*h**that yields minimal difference with 2000000:

let rectangles w h = w * (w + 1) * h * (h + 1) / 4 let solutions = Seq.unfold(fun h -> let w = int(sqrt(float (8000000/(h*(h+1))))) let solution = if rectangles w h > 2000000 then (w - 1,h) else (w,h) if fst solution <= h then None else Some(solution, h + 1)) 1 let problem085() = solutions |> Seq.toList |> List.map (fun (w,h) -> (2000000 - (rectangles w h), w*h)) |> List.sortBy (fun (diff,area) -> diff) |> List.head |> snd

Project Euler Problem 84 is fun. Took some time to choose the approach to solve. After some amount of consideration I decided to go with straightforward MonteCarlo simulation.

The only mutable piece of information in the solution below is **board** array of counters, the rest is pure functional. The state is passed around as a 4-member tuple **(boardPosition, chestCard, chanceCard, doubles)** containing current main board position, community chest deck card position, chance deck card position, and subsequent double rolls.

Dices are rolled at **rollDice** function. If it anything, but triple double in row, the state is passed to **ifChance** function. There if the current position is on a chance square, chance is processed by **processChanceCard**, and then passed to **ifChest**, otherwise goes there directly. Similar approach is implemented for community chest squares with **ifChest** and **processChestCard** functions.

let [<Literal>]BOARDSIZE = 40 let [<Literal>]CCSIZE = 16 let [<Literal>]CHANCESIZE = 16 let [<Literal>]DICESIDES = 4 let [<Literal>]GO = 0 let [<Literal>]CC1 = 2 let [<Literal>]R1 = 5 let [<Literal>]CH1 = 7 let [<Literal>]JAIL = 10 let [<Literal>]C1 = 11 let [<Literal>]U1 = 12 let [<Literal>]R2 = 15 let [<Literal>]CC2 = 17 let [<Literal>]CH2 = 22 let [<Literal>]E3 = 24 let [<Literal>]R3 = 25 let [<Literal>]U2 = 28 let [<Literal>]G2J = 30 let [<Literal>]CC3 = 34 let [<Literal>]CH3 = 36 let [<Literal>]H2 = 39 let rand = System.Random() let board = Array.zeroCreate<int> BOARDSIZE type Doubles = ZeroDouble | OnceDouble | TwiceDouble let nextRoll() = (rand.Next(DICESIDES) + 1, rand.Next(DICESIDES) + 1) let (|Double|Ordinary|) roll = let sum = fst roll + snd roll in if fst roll = snd roll then Double sum else Ordinary sum let forward boardPosition score = (boardPosition + score) % BOARDSIZE let inc square = board.[square] <- board.[square] + 1 let processChestCard (boardPosition, chestCard, chanceCard, doubles) = let newChestCard = (chestCard + 1) % CCSIZE match newChestCard with | 0 -> inc GO; (GO, newChestCard, chanceCard, doubles) | 1 -> inc JAIL; (JAIL, newChestCard, chanceCard, doubles) | _ -> inc boardPosition; (boardPosition, newChestCard, chanceCard, doubles) let ifChest (boardPosition, chestCard, chanceCard, doubles) = match boardPosition with | CC1 | CC2 | CC3 -> processChestCard (boardPosition, chestCard, chanceCard, doubles) | G2J -> inc JAIL; (JAIL, chestCard, chanceCard, doubles) | _ -> inc boardPosition; (boardPosition, chestCard, chanceCard, doubles) let processChanceCard (boardPosition, chestCard, chanceCard, doubles) = let newChanceCard = (chanceCard + 1) % CHANCESIZE match newChanceCard with | 0 -> ifChest (GO, chestCard, newChanceCard, doubles) | 1 -> ifChest (JAIL, chestCard, newChanceCard, doubles) | 2 -> ifChest (C1, chestCard, newChanceCard, doubles) | 3 -> ifChest (E3, chestCard, newChanceCard, doubles) | 4 -> ifChest (H2, chestCard, newChanceCard, doubles) | 5 -> ifChest (R1, chestCard, newChanceCard, doubles) | 6 | 7 -> if boardPosition = CH1 then ifChest (R2, chestCard, newChanceCard, doubles) elif boardPosition = CH2 then ifChest (R3, chestCard, newChanceCard, doubles) elif boardPosition = CH3 then ifChest (R1, chestCard, newChanceCard, doubles) else ifChest (boardPosition, chestCard, newChanceCard, doubles) | 8 -> if boardPosition = CH2 then ifChest (U2, chestCard, newChanceCard, doubles) else ifChest (U1, chestCard, newChanceCard, doubles) | 9 -> ifChest (boardPosition - 3, chestCard, newChanceCard, doubles) | _ -> ifChest (boardPosition, chestCard, newChanceCard, doubles) let ifChance (boardPosition, chestCard, chanceCard, doubles) = match boardPosition with | CH1 | CH2 | CH3 -> processChanceCard (boardPosition, chestCard, chanceCard, doubles) | _ -> ifChest (boardPosition, chestCard, chanceCard, doubles) let rollDice (boardPosition, chestCard, chanceCard, doubles) = match nextRoll() with | Double score -> match doubles with | ZeroDouble -> ifChance ((forward boardPosition score), chestCard, chanceCard, OnceDouble) | OnceDouble -> ifChance ((forward boardPosition score), chestCard, chanceCard, TwiceDouble) | TwiceDouble -> inc JAIL; (JAIL, chestCard, chanceCard, ZeroDouble) | Ordinary score -> ifChance ((forward boardPosition score), chestCard, chanceCard, ZeroDouble) let problem084() = let _ = Seq.initInfinite id |> Seq.scan (fun (boardPosition, chestCard, chanceCard, doubles) x -> rollDice (boardPosition, chestCard, chanceCard, doubles)) (0,0,0,ZeroDouble) |> Seq.nth 1000000 board |> Array.mapi (fun i x -> (-x,i)) |> Array.sortBy(fun (x,y) -> x) |> Array.map (fun (x,y) -> y) |> Array.toSeq |> Seq.take 3 |> Seq.fold (fun a x -> a + string x) ""

Few interesting F# features used are: active patterns for handling dice rolls, state passing thru arguments, literals for use in pattern matching. Also an interesting technique is applied with generation of potentially infinite sequence of states using **Seq.scan** function driven by simply infinite sequence of integers. Evaluating this state sequence to desired length yields the sought frequences for board squares.

Although Project Euler Problem 83 seems further generalization of Problem 81 and Problem 82, solution is not based on any of those.

I came up with working solution in couple of minutes after reading thru A* Pathfinding for Beginners. The role of open list plays an F# PowerPack’s **HashMultiMap** carrying **path cost** as key and **path end location** as value. Closed list is a standard .NET **HashSet** carrying processed locations. We begin with placing left corner element with cost and coordinates into open list.

Each step is quite trivial – take one of the points with current minimal cost from open list; remove it from there; find all points reachable in one step from it; those of them that are not in closed list yet put into open list with newly calculated cost. If the just processed point is not a target point, place it into the closed list and repeat the step; otherwise finish, the cost associated with target point is the answer.

open System open System.IO open Microsoft.FSharp.Collections open System.Collections.Generic [<Literal>] let SIDE = 80 let matrix: int[,] = Array2D.zeroCreate SIDE SIDE let getData (path: string) = use sr = new StreamReader(path) let line, col = ref 0, ref 0 while not sr.EndOfStream do col := 0 sr.ReadLine().Split(',') |> Array.iter (fun x -> matrix.[!line, !col] <- int x; incr col) incr line let findMinPath (matrix: int[,]) = let openList = new HashMultiMap<_,_>(HashIdentity.Structural) let closeList = HashSet<_>() openList.Add(matrix.[0, 0], (0,0)) let rec step () = if openList.Count = 0 then failwith "No path exists" let minKey = openList.Fold (fun key _ acc -> if key < acc then key else acc) Int32.MaxValue let minElem = openList.FindAll minKey |> List.head let cost, (x,y) = minKey, minElem openList.Remove minKey [ (x-1,y); (x+1,y); (x,y-1); (x, y+1) ] // reachable from node |> List.filter (fun (x,y) -> x >= 0 && y >=0 && x < SIDE && y < SIDE) |> List.iter (fun (x,y) -> if not (closeList.Contains (x,y)) then openList.Add(cost + matrix.[x, y], (x,y))) closeList.Add(x,y) |> ignore if (x,y) = (SIDE-1,SIDE-1) then cost else step() step() let problem083() = getData @"..\..\..\Datafiles\Problem081.data" // same data P.81 & 82 & 83 findMinPath matrix