Next problem to be covered in this series is maximum subarray problem: the task of finding the contiguous subarray within a one-dimensional array of numbers (containing at least one positive number) which has the largest sum.
An algorithm having O(n) complexity was first found by Jay Kadane. It scans through values computing at each position a maximum subarray ending in this position. This subarray is either empty having sum of elements equal to zero, or has one more element, than the same subarray ending in the previous position. Expressing this generically in F# is almost trivial with Array.fold combinator:
let inline kadanesV1 (xs: 'a []) =
(LanguagePrimitives.GenericZero, LanguagePrimitives.GenericZero)
|> Array.fold (fun (maxSum, maxSumEndingHere) x ->
let maxSumEndingHere = (max LanguagePrimitives.GenericZero (maxSumEndingHere + x)) in
((max maxSum maxSumEndingHere), maxSumEndingHere))
<| xs
|> fst
Folder function in line 4 maintains a maximum subarray, updating maximum sum in line 5. Here are some tests:
[| 1; -2; 1; -3; 4; -1; 2; 1; -5; 4 |] |> kadanesV1
val it : int = 6
[| 1.0; -2.0; 1.0; -3.0; 4.0; -1.0; 2.0; 1.0; -5.0; 4.0 |] |> kadanesV1
val it : float = 6.0
[| -1;-2;-3;0 |] |> kadanesV1
val it : int = 0
[| -1;-2;-3; |] |> kadanesV1
val it : int = 0
[| -3;-2;-1; |] |> kadanesV1
val it : int = 0
So far so good, but results of the last two test cases ask for a further generalization: how can we also correctly handle arrays consisting of just negative numbers? Comes out this requires trivial changes in lines 2 and 4:
let inline kadanesV2 (xs: 'a []) =
(xs.[0], xs.[0])
|> Array.fold (fun (maxSum, maxSumEndingHere) x ->
let maxSumEndingHere = if maxSumEndingHere < LanguagePrimitives.GenericZero then x else maxSumEndingHere + x in
((max maxSum maxSumEndingHere), maxSumEndingHere))
<| xs
|> fst
Now we handle arrays of negative numbers too:
[| -1;-2;-3; |] |> kadanesV2
val it : int = -1
[| -3;-2;-1; |] |> kadanesV2
val it : int = -1
But what if we are also required to accompany the found largest sum with indices of subarray that constitutes it? This is where functional approach must seemingly get into trouble: so far we didn’t need dealing with any indices whatsoever, right?
Comes out we still would be able getting away with a folder. However, now we are forced to take care of much more moving parts, including the array element indices. This is where Array.fold2 combinator comes to help:
let inline kadanesV3 (xs: 'a []) =
((xs.[0], 0, 0), (xs.[0], 0))
|> Array.fold2 (fun (maxSum, maxSumEndingHere) x i ->
let maxSumEndingHere =
let maxSumEndingHere, startIdxEndingHere = maxSumEndingHere
if maxSumEndingHere < LanguagePrimitives.GenericZero then
(x,i)
else
(maxSumEndingHere + x, startIdxEndingHere) in
let maxSum =
let maxSum, startIdx, endIdx = maxSum
if maxSum < fst maxSumEndingHere then
(fst maxSumEndingHere, snd maxSumEndingHere, i)
else
(maxSum, startIdx, endIdx) in
(maxSum, maxSumEndingHere)
)
<|| (xs,(xs |> Array.mapi (fun i _ -> i)))
|> fst
Here in line #18 we arrange for folding the second array just consisting of indices of the first array, so our Array.fold2 folder in line #3 is getting access to the current index, represented by lambda argument i. Although now we are taking care of significantly extended state we still can make folder state looking very similar to previous versions. However, now maxSum is 3-element tuple (line # 11) and maxSumEndingHere is 2-element tuple (line #5), carrying indices. Nevertheless, F# let bindings and shadowing allow us to fully localize these details within the folder, where these tuples are disassembled and reassembled at need.
Quick tests follow:
[| 1; -2; 1; -3; 4; -1; 2; 1; -5; 4 |] |> kadanesV3
val it : int * int * int = (6, 4, 7)
[| 1.0; -2.0; 1.0; -3.0; 4.0; -1.0; 2.0; 1.0; -5.0; 4.0 |] |> kadanesV3
val it : float * int * int = (6.0, 4, 7)
[| -1;-2;-3;0 |] |> kadanesV3
val it : int * int * int = (0, 3, 3)
[| -1;-2;-3; |] |> kadanesV3
val it : int * int * int = (-1, 0, 0)
[| -3;-2;-1; |] |> kadanesV3
val it : int * int * int = (-1, 2, 2)
Folding is a workhorse of functional programming, indeed.
To be continued…
As the next installment of the series let’s take the following problem from the book – given an arbitrary positive number find a next higher number consisting of the same digits. If such does not exist, then return the original number.
The base line approach would be splitting the number into a list of digits, making the list of all digit permutations, assembling digits back into numbers, sorting list of numbers, and finally picking the element next to the given. Apparently, the time and space complexities of this “solution” are awful, so let’s improve.
- The first useful observation towards the optimized solution would be the following: solution exists iff a pair of adjacent digits exists in the given number, where the left is strictly less, than right.
- The next useful observation would be: if we scan the list of digits of the given number from right to left by a sliding window of width 2, then the first occurred pair that matches the first observation would be the place of change; everything to the left of it (if any exists) must stay intact.
- The final useful observation: taken the pair matching second observation, the sublist to the right including the right element of the pair is sorted from right to left; the digit that must substitute the left element of the pair must be minimal greater digit from the sublist; the left element that we just substituted should be placed some place to the right preserving the sublist order.
Now if we concatenate (if non-empty) the sublist to the left of changing digit, followed by substituting digit, followed by reversed sublist after accommodating of changing digit, and convert resulting digit list back to number, this would yield the solution with surprisingly good time complexity of O(n) and space complexity of O(n), where n is number of digits in the original number.
As this problem is of “puzzle” type let’s add some spice to the solution showing how F# can be advantageous for its coding. One such feature would be making the solution generic, i.e. accepting any integral type as input (byte, BigInteger, nativeint, whatever consisting of just digits). Achieving this statically (i.e. relying onto compiler with constraining right types) would require using inline F# facility. Let’s see this implemented in the code below:
let inline nextHigher number =
let GenericTen = (LanguagePrimitives.GenericOne<'a> <<< 3) +
(LanguagePrimitives.GenericOne<'a> <<< 1)
let toDigits n =
let rec toDigitList digits n =
if n = LanguagePrimitives.GenericZero then digits
else toDigitList ((n % GenericTen) :: digits) (n / GenericTen)
toDigitList [] n
let fromDigits digits =
let rec fromDigitList n = function
| [] -> n
| h::t -> fromDigitList (n * GenericTen + h) t
fromDigitList LanguagePrimitives.GenericZero digits
let make p ll =
ll |> List.rev |> List.partition ((<) p)
|> fun (x,y) -> (x.Head::y) @ (p::(x.Tail))
let rec scan (changing: 'a list) source =
match source with
| [] -> changing
| h::t -> if h >= changing.Head then
scan (h::changing) t
else
(List.rev t) @ (make h changing)
number |> toDigits |> List.rev
|> fun x -> scan [(x.Head)] (x.Tail) |> fromDigits
A reader has commented upon previous posts that despite his previous F# coding experience the snippets look quite opaque. I’ll try addressing this matter by giving extended comments over the code.
The main inlined function nextHigher number definition in line #1 yields a quite impressive inferred list of constraints:
val inline nextHigher :
number: ^a -> ^d
when ( ^a or ^b) : (static member ( % ) : ^a * ^b -> ^a0) and
^a : (static member get_Zero : -> ^a) and
( ^a or ^b) : (static member ( / ) : ^a * ^b -> ^a) and
^a : equality and
( ^d or ^b) : (static member ( * ) : ^d * ^b -> ^c) and
^a0 : (static member get_One : -> ^a0) and
^a0 : (static member ( + ) : ^a0 * ^a0 -> ^b) and
^a0 : (static member ( << ^a0) and
^a0 : comparison and
( ^c or ^a0) : (static member ( + ) : ^c * ^a0 -> ^d) and
^d : (static member get_Zero : -> ^d)
While the constraints above can be slightly simplified it is still quite impressive how good is type inference in F#.
A variable Generic10 in line #3 is self-described – it resolves to 10 for any primitive numeric type with a static member One and operators <<< and +.
A pair of auxiliary functions defined in lines #6 and #12 perform disassembly of a numeric value into digits (toDigits) and vice versa (fromDigits). The functions allow solution to work upon any integral type via static checks.
The code in lines #18 – #31 implements the algorithm per se. Function make p ll declared in line #18 performs the conversion of pivot digit p and scanned part of the input number into corresponding part of the final order. Function scan in line #22 performs search for the pivot digit in the reversed list of digits ensuring either return of original value (line #24) if the solution does not exist, or the solution itself in line #28. Finally, lines #30-31 represent the execution pipeline.
I want to wrap up this post with some tests and corner cases demonstrating the implementation in action:
nextHigher 1987654321 // Just working on int
val it : int = 2113456789
nextHigher 987654321L // Working on long, solution does not exist
val it : int64 = 987654321L
nextHigher 32154321 // Pivot digit is in the middle
nextHigher 12uy // Working on unsigned bytes
val it : byte = 21uy
// Working on bigint
nextHigher 5598734987954054911111111111111I
val it : System.Numerics.BigInteger =
5598734987954059111111111111114 {IsEven = true;
IsOne = false;
IsPowerOfTwo = false;
IsZero = false;
Sign = 1;}
nextHigher 136442n // It even works with nativeints!!
val it : nativeint = 142346n
The next problem to cover in these series would be the following: in a list of comparable items find Kth smallest item.
We may approach the solution with a variant of quickselect algorithm. Let’s begin with the signature of target function:
findKthSmallest: k:int -> ls:’a list -> ‘a when ‘a: comparison
Instead of brute forcing the solution via the full sort we’ll have recourse to somewhat lighter data partitioning approach that would be gradually shrinking the search space. Let’s pick the head element of our source list as a pivot point with an arbitrary value p and then partition the list into the two (possibly empty) buckets: lt for elements that are smaller, than p, and gt for elements that are greater, leaving out the pivot element itself and possibly other elements with the same value p. Then let’s see where our desired Kth smallest element may end up:
- it may get into bucket lt iff lt.Length >= k and, consequently can be found through applying the same process to lt only, i.e. with findKthSmallest k lt
- iff k > ls.Length – gt.Length this means that k belongs to gt; but as we already placed lt.Length elements into lt and got rid of current pivot(s) the sought element would be (k – (ls.Length – gt.Length))th smallest of gt and in order to find it we may do findKthSmallest (k – ls.Length + gt.Length) gt
- iff both options above are failed this means that the sought element in not either in lt, or in gt, so it only can be pivot p and we do not need any further partitioning.
This wordy algorithm description translates into a quite compact F# code:
let findKthSmallest k ls =
let rec splitter k ls =
let pivot = List.head ls
let (lt,gt) =
(([],[]),ls)
||> List.fold
(fun (lt,gt) n -> match (System.Math.Sign(Operators.compare n pivot)) with
| -1 -> (n::lt,gt)
| 1 -> (lt,n::gt)
| _ -> (lt,gt))
let leLength = ls.Length - gt.Length in
if k <= lt.Length then
splitter k lt
elif k > leLength then
splitter (k - leLength) gt
else
pivot
splitter k ls
// Tests:
findKthSmallest 3 [1;2;3;4;-1]
//val it : int = 2
findKthSmallest 5 [1;1;1;1;1;1;1;1;1;1]
//val it : int = 1
findKthSmallest 4 ['a';'b';'c';'d']
//val it : char = 'd'
findKthSmallest 3 [4.5;2.2;3.33;1.5]
//val it : float = 3.33
The workhorse is splitter recursive function in line 2; code in lines 2-10 performs partitioning of ls elements into buckets lt & gt in one pass using a custom folder function defined in lines 7-10.
It’s important to understand the role of System.Math.Sign wrapping around generic comparison at line 7; without it line 10 instead of matching with the single possible zero value may bring unpleasantly surprising behavior for some ls element types.
Lines 22-29 demonstrate the solution at work, some corner cases of input, and that it is generic, indeed. And, not to forget mentioning, the worst case complexity of the solution is O(k*n), where n is the length of the original list.
Problem #2 from the book reads: “write an efficient algorithm that searches for a given element in a 2D array, which elements are sorted by rows and columns, i.e. for each pair of indices i and j elem[i,j] <= elem[i+1,j] and elem[i,j] <= elem[i,j+1]".
This problem is known as saddleback search. It has received a lot of attention in the literature. I am not going to dig too dip and will provide a “good enough” solution that allows for further improvement.
My solution would be similarly to Nuts and Bolts problem based upon “divide and conquer” approach.
Let’s begin the search from the lower left corner having the whole 2D array aa of n columns and m rows as the search space. Compare element aa.[0,m - 1] with the pattern x. If they are equal, our mission is accomplished (we will disregard here that multiple occurences of the pattern may have place). If not and aa.[0,m - 1] > x, then we should exclude the last row from search space as elements there just grow towards right side, and move new comparison element one row up. This effectively makes the search space narrower by one row. For the scenario aa.[0,m - 1] < x the similar considerations exclude from search space leftmost column moving comparison one element to the right to aa.[1,m - 1]. Repeating these actions on the shrinking search space eventually either brings the matched element, or the conclusion that the match does not exist.
F# implementation below is quite literal reproduction of this search strategy description:
let saddlebackSearch (aa: 'a[,]) n m x =
let up (h, v) =
match v with
| 0 -> None
| _ -> Some((h, v - 1))
let right (h, v) =
match m - 1 - h with
| 0 -> None
| _ -> Some((h + 1, v))
let rec searcher = function
| None -> None
| Some(h, v) -> match (Operators.compare aa.[h,v] x) with
| 0 -> Some(h, v)
| -1 -> searcher (right(h, v))
| _ -> searcher (up(h, v))
searcher (Some((0, m - 1)))
Talking of the effectiveness of the code above is should be clear that it delivers conclusion by time O(n+m) in the worst case scenario. Exercising the implementation with the code below
let aa = Array2D.init 10 10 (fun i j -> 3*i + 27*j + j*j) saddlebackSearch aa 10 10 22 saddlebackSearch aa 10 10 175
delivers the following results:
val aa : int [,] = [[0; 28; 58; 90; 124; 160; 198; 238; 280; 324]
[3; 31; 61; 93; 127; 163; 201; 241; 283; 327]
[6; 34; 64; 96; 130; 166; 204; 244; 286; 330]
[9; 37; 67; 99; 133; 169; 207; 247; 289; 333]
[12; 40; 70; 102; 136; 172; 210; 250; 292; 336]
[15; 43; 73; 105; 139; 175; 213; 253; 295; 339]
[18; 46; 76; 108; 142; 178; 216; 256; 298; 342]
[21; 49; 79; 111; 145; 181; 219; 259; 301; 345]
[24; 52; 82; 114; 148; 184; 222; 262; 304; 348]
[27; 55; 85; 117; 151; 187; 225; 265; 307; 351]]
val it : (int * int) option = None
val it : (int * int) option = Some (5, 5)
Recently I came across the book Top 10 coding interview problems asked in Google with solutions: Algorithmic Approach. This is perhaps a good book with solutions given in C++, I must admit I just browsed thru the book contents shown by Amazon. Then I thought about an imaginary setting when these coding problems would be given in functional programming interview setting. It seems to me quite tempting to approach them with F# in hand. This post opens a 10 part series where each post would be devoted to F# solution of a problem from this set.
The first problem originates from the “old, but gold” book by Gregory Rawlings Compared to What?: An Introduction to the Analysis of Algorithms under the name “Nuts and bolts” (p.293): We wish to sort a bag of n nuts and n bolts by size in the dark. We can compare the sizes of a nut and a bolt by attempting to screw one into the other. This operation tells us that either the nut is bigger than the bolt; the bolt is bigger than the nut; or they are the same size (and so fit together). Because it is dark we are not allowed to compare nuts directly or bolts directly. Devise how to fit all nuts and bolts minimizing number of fittings.
Let’s first establish a solution baseline by using a naïve approach:
- select a random nut;
- fit random bolts one by one until finding the match; put the matching pair aside;
- repeat the process for each of remaining nuts.
Easy to notice that required number of fittings is O(n*n). Can we do better? Sure. Let’s modify the approach:
- as before select a random nut;
- now partition ALL bolts into three piles of fitting, bigger, and smaller, than the pivot nut
- then taking a fitting bolt as the pivot (we always have at least one by definition) make the similar partitioning to ALL nuts
- at this point we end up with (probably empty) pair of nuts and bolts piles smaller, than pivot, pair of piles of nuts and bolts (having at least one of each) that fit, and (again, probably empty) pair of nuts and bolts piles bigger, than pivot. This is the AHA! moment as it is easy to notice that fitting piles of smaller items and/or fitting piles of bigger items is fully equivalent to the original task, but for shrink dimension.
Using such “divide and conquer” approach we can decrease required number of fittings to only O(n*log(n))! And we’ve just rediscovered quickselect, an essential constituent of the famous quicksort.
Now let’s jump to coding. Interestingly, F# would allow us to express the solution very closely to the approach description given above; in other words we can kind of come up with a micro-DSL for solving this particular task:
type Size = int
type Bolt = Bolt of Size
type Nut = Nut of Size
let nutSize = function Nut(size) -> size
let boltSize = function Bolt(size) -> size
type Bolt with
member bolt.Size = boltSize bolt
type Nut with
member nut.Size = nutSize nut
type Bolt with
member bolt.Fit (nut: Nut) = bolt.Size.CompareTo nut.Size
member bolt.Fit nuts =
nuts |> List.partition (bolt.Fit >> (=) 0)
|> fun (fit, nonfit) -> let (smaller, bigger) = nonfit |> List.partition (bolt.Fit >> (<) 0)
in (fit, smaller, bigger)
type Nut with
member nut.Fit (bolt: Bolt) = nut.Size.CompareTo bolt.Size
member nut.Fit bolts =
bolts |> List.partition (nut.Fit >> (=) 0)
|> fun (fit, nonfit) -> let (smaller, bigger) = nonfit |> List.partition (nut.Fit >> (<) 0)
in (fit, smaller, bigger)
let rec fit (nuts: Nut list) (bolts: Bolt list) =
seq { match nuts with
| [] -> ()
| _ -> let (boltsFit, boltsSmaller, boltsBigger) = nuts.Head.Fit bolts
let (nutsFit, nutsSmaller, nutsBigger) = boltsFit.Head.Fit nuts
for (nut,bolt) in (List.zip nutsFit boltsFit) do yield (nut,bolt)
yield! fit nutsSmaller boltsSmaller
yield! fit nutsBigger boltsBigger
}
Let’s see how this works by entertaining the following snippet in FSI:
let amount = 10 let variety = 8 let rand = System.Random() let pieces = [ for i in 1..amount -> rand.Next(1, variety) ] let bagOfNuts = pieces |> List.map Nut let bagOfBolts = pieces |> List.map Bolt |> List.rev fit bagOfNuts bagOfBolts |> Seq.toList
getting:
val pieces : int list = [2; 3; 5; 6; 2; 2; 1; 1; 3; 3] val bagOfNuts : Nut list = [Nut 2; Nut 3; Nut 5; Nut 6; Nut 2; Nut 2; Nut 1; Nut 1; Nut 3; Nut 3] val bagOfBolts : Bolt list = [Bolt 3; Bolt 3; Bolt 1; Bolt 1; Bolt 2; Bolt 2; Bolt 6; Bolt 5; Bolt 3; Bolt 2] val it : (Nut * Bolt) list = [(Nut 2, Bolt 2); (Nut 2, Bolt 2); (Nut 2, Bolt 2); (Nut 1, Bolt 1); (Nut 1, Bolt 1); (Nut 3, Bolt 3); (Nut 3, Bolt 3); (Nut 3, Bolt 3); (Nut 5, Bolt 5); (Nut 6, Bolt 6)]
When covering the matter of mutually-recursive functions the first Edition of Programming F# comes up with the following sample on page 55:
let rec isOdd n = (n = 1) || isEven (n - 1) and isEven n = (n = 0) || isOdd (n - 1)
Looks beautiful, but unfortunately does not work. The second Edition Programming F# 3.0 attempts fixing the problem with the following code on page 60:
let rec isOdd x =
if x = 0 then false
elif x = 1 then true
else isEven(x - 1)
and isEven x =
if x = 0 then true
elif x = 1 then false
else isOdd(x - 1)
This snippet works correctly, but it got four times longer, than the original and apparently smells. May it be refactored towards DRY? Sure, for example:
let rec isOdd = function | 0 | 1 as n -> (n = 1) | n -> isEven (n - 1) and isEven n = isOdd (n - 1)
Good, but still 100% longer, than the original, so let’s keep trying:
let rec isOdd n = if n >= 2 then isEven (n - 1) else n = 1 and isEven n = if n >= 2 then isOdd (n - 1) else n = 0
Cool, this works correctly and is as succinct as the original. But wait a minute, boolean if-then-else expression can be rewritten to the equivalent expression using && and || operators:
let rec isOdd n = n >= 2 && isEven (n - 1) || n = 1 and isEven n = n >= 2 && isOdd (n - 1) || n = 0
Almost perfect, but what if we out of curiosity try something like isOdd 10000000? Oh,no! Although equivalent to previous snippet, the latest one gets not tail-recursive and blows the stack.
OK, let’s convert it back to a tail-recursive equivalent:
let rec isOdd n = n = 1 || n >= 2 && isEven (n - 1) and isEven n = n = 0 || n >= 2 && isOdd (n - 1)
or even to just another tail-recursive equivalent:
let rec isOdd n = n < 2 && n = 1 || isEven (n - 1) and isEven n = n < 2 && n = 0 || isOdd (n - 1)
The latest snippet is almost similar to the original, but works perfectly.
The bottom line: often a boolean expression may perfectly substitute one built with if-then-else. But watch for subtleties, like inadvertently losing tail-recursiveness.
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
