FSharp exercism solutions for 12in23
Exercism is running an event called “12in23” this year which is a challenge to use 12 different programming languages and solve 5 exercises in each one to get a badge, these are my solutions and commentary on each exercise as I solve them in F# for the first language.
Allergies
1module Allergies
2
3open System
4
5type Allergen =
6 | Eggs
7 | Peanuts
8 | Shellfish
9 | Strawberries
10 | Tomatoes
11 | Chocolate
12 | Pollen
13 | Cats
14
15
16let maxAllergen value =
17 match value with
18 | x when x >= 128 -> (Cats, value - 128)
19 | x when x >= 64 -> (Pollen, value - 64)
20 | x when x >= 32 -> (Chocolate, value - 32)
21 | x when x >= 16 -> (Tomatoes, value - 16)
22 | x when x >= 8 -> (Strawberries, value - 8)
23 | x when x >= 4 -> (Shellfish, value - 4)
24 | x when x >= 2 -> (Peanuts, value - 2)
25 | x when x >= 1 -> (Eggs, value - 1)
26 | _ -> failwith "invalid value"
27
28let allergyValue (allergen: Allergen) =
29 match allergen with
30 | Eggs -> 1
31 | Peanuts -> 2
32 | Shellfish -> 4
33 | Strawberries -> 8
34 | Tomatoes -> 16
35 | Chocolate -> 32
36 | Pollen -> 64
37 | Cats -> 128
38
39let sortAllergiesList (allergies: Allergen list) =
40 List.sortBy allergyValue allergies
41
42let rec listAcc (value: int) (acc: Allergen Set) =
43 match value with
44 | 0 -> sortAllergiesList (Set.toList acc)
45 | v ->
46 let (highest, newVal) = maxAllergen v
47 printfn $"curr value: %d{v}, next: %d{newVal}, added: %A{highest}"
48 listAcc newVal (Set.add highest acc)
49
50let list (codedAllergies: int) = listAcc codedAllergies Set.empty
51
52let allergicTo (codedAllergies: int) (allergen: Allergen) =
53 codedAllergies &&& allergyValue allergen <> 0
This wasn’t too bad, from first look I saw that it was basically a reducer problem, I implemented that using a recursive function listAcc, I could have massaged that into an actual reducer but it was a bit easier for me to understand when written this way. Looking back I realise now that the allergicTo function could help you to write the list function - Looking at community solutions I picked up some useful tips on adding the values to the union directly which I tried first, but didn’t use, e.g.:
1[<Flags>]
2type Allergen =
3 | Eggs = 1
4 | Peanuts = 2
5 | Shellfish = 4
6 | Strawberries = 8
7 | Tomatoes = 16
8 | Chocolate = 32
9 | Pollen = 64
10 | Cats = 128
The Flags attribute lets you treat the union as a bit field, very useful! And then you can grab the values using Enum.GetValues typeof<Allergen> which is good to know!
Bird watcher
I picked this one by accident not realising it was an easy one, no commentary, but it was a nice refresher on arrays I guess?
1module BirdWatcher
2
3let lastWeek: int[] =
4 [| 0; 2; 5; 3; 7; 8; 4 |]
5
6let yesterday(counts: int[]): int =
7 counts.[counts.Length - 2]
8
9let total(counts: int[]): int =
10 Array.sum counts
11
12let dayWithoutBirds(counts: int[]): bool =
13 Array.exists (fun b -> b = 0) counts
14
15let incrementTodaysCount(counts: int[]): int[] =
16 match counts with
17 | [| a; b; c; d; e; f; g; |] -> [| a; b; c; d; e; f; g + 1 |]
18 | _ -> Array.singleton 0
19
20let oddWeek(counts: int[]): bool =
21 match counts with
22 | [| _; 0; _; 0; _; 0; _; |] -> true
23 | [| _; 10; _; 10; _; 10; _; |] -> true
24 | [| 5; _; 5; _; 5; _; 5; |] -> true
25 | _ -> false
Looking closer, I can see it was marked as a “learning exercise”, woops, missing those from now on then.
Phone numbers
This one was fun! It took me a while to get used to using active patterns, the magic being that I had to declare the N and X patterns separately to reap the full benefits, I wasn’t getting a proper match when I defined them as one pattern. The validation of the actual number is a bit messy, I probably could have written it recursively and for 11 digits numbers strip off the 1 at the front if its valid and use the validation rules for 10 digit numbers.
I saw a couple of solutions from the exercism community using Result.Bind which was very clean, using the Monad properties of the Result type, that would have made it easier to chain together the input validation for punctuation and letters - I saw those tests lasts and had to shoehorn the checks in.
1module PhoneNumber
2
3open System
4
5(*
6Numbers are in the form:
7(NXX)-NXX-XXXX
8
9Where N = 2 - 9
10X = 0 - 9
11*)
12
13let (|N|_|) (i: int) = if i >= 2 && i <= 9 then Some N else None
14let (| X | _ |) (i: int) = if i >= 0 && i <= 9 then Some X else None
15
16let arrayInts (input: int list) =
17 input
18 |> (List.map (sprintf "%i") >> String.concat "")
19 |> UInt64.Parse
20
21let validateInts inputIntsList =
22 let inputInts =
23 inputIntsList
24 |> List.filter (Char.IsNumber)
25 |> List.map (Int32.Parse << Char.ToString)
26
27 match inputInts with
28 | [ N; X; X; N; X; X; X; X; X; X; ] -> Ok (arrayInts inputInts)
29 | [ 1; N; X; X; N; X; X; X; X; X; X; ] -> Ok (arrayInts inputInts[1..])
30 | [ 0; X; X; N; X; X; X; X; X; X; ] -> Error "area code cannot start with zero"
31 | [ 1; 0; X; X; N; X; X; X; X; X; X; ] -> Error "area code cannot start with zero"
32 | [ 1; X; X; N; X; X; X; X; X; X; ] -> Error "area code cannot start with one"
33 | [ 1; 1; X; X; N; X; X; X; X; X; X; ] -> Error "area code cannot start with one"
34 | [ N; X; X; 1; X; X; X; X; X; X; ] -> Error "exchange code cannot start with one"
35 | [ N; X; X; 0; X; X; X; X; X; X; ] -> Error "exchange code cannot start with zero"
36 | [ 1; N; X; X; 1; X; X; X; X; X; X; ] -> Error "exchange code cannot start with one"
37 | [ 1; N; X; X; 0; X; X; X; X; X; X; ] -> Error "exchange code cannot start with zero"
38 | [ _; N; X; X; N; X; X; X; X; X; X; ] -> Error "11 digits must start with 1"
39 | x when x.Length < 10 -> Error "incorrect number of digits"
40 | x when x.Length > 11 -> Error "more than 11 digits"
41 | _ -> Error "not recognised"
42
43let clean (input: string): Result<uint64, string> =
44 let inputIntsList =
45 input
46 |> Seq.toList
47
48 let isBadPunctuation x =
49 Char.IsPunctuation(x) && not (Seq.contains x ['('; ')'; '-'; '.'])
50
51 match inputIntsList with
52 | x when (Seq.exists Char.IsLetter x) -> Error "letters not permitted"
53 | x when (Seq.exists isBadPunctuation x) -> Error "punctuations not permitted"
54 | _ -> validateInts inputIntsList
Bank accounts
This was a fun one to write, I learnt about AsyncReplyChannel here, I submitted one solution first with the agent code broken out and then simplified the function to pass the balance as a parameter to the internal loop function which made things a lot easier to read.
One other handy tip was combining the request and response types, originally I had them separate and it didn’t occur to me that I could specify that only GetBalance needed a reply channel - very handy!
1module BankAccount
2
3type BankMessage =
4 | OpenAccount
5 | CloseAccount
6 | GetBalance of AsyncReplyChannel<decimal option>
7 | UpdateBalance of decimal
8
9type BankAccount = MailboxProcessor<BankMessage>
10
11let agent (account: BankAccount) =
12 let rec loop (balance: decimal option) = async {
13 let! message = account.Receive()
14
15 match message with
16 | OpenAccount ->
17 return! loop (Some 0.0m)
18 | CloseAccount ->
19 return! loop (None)
20 | GetBalance replyChannel ->
21 replyChannel.Reply balance
22 return! loop balance
23 | UpdateBalance amt ->
24 return! loop (balance |> Option.map((+) amt))
25
26 }
27
28 loop
29
30let mkBankAccount(): BankAccount = MailboxProcessor.Start(fun account -> agent account None)
31
32let openAccount (account: BankAccount) =
33 account.Post OpenAccount
34 account
35
36let closeAccount (account: BankAccount) =
37 account.Post CloseAccount
38 account
39
40let getBalance (account: BankAccount) =
41 account.PostAndReply GetBalance
42
43let updateBalance (change: decimal) (account: BankAccount) =
44 account.Post (UpdateBalance change)
45 account
Ledger
A fairly simple refactoring exercise to wrap things up, nothing much to say here, it was nice to move this to use recursion instead of a mutable variable.
1module Ledger
2
3open System
4open System.Globalization
5
6type Entry =
7 { dat: DateTime
8 des: string
9 chg: int }
10
11let mkEntry (date: string) description change =
12 { dat = DateTime.Parse(date, CultureInfo.InvariantCulture)
13 des = description
14 chg = change }
15
16let header locale =
17 match locale with
18 | "en-US" -> "Date | Description | Change "
19 | _ -> "Datum | Omschrijving | Verandering "
20
21let formatDate locale (date: DateTime) =
22 match locale with
23 | "nl-NL" -> date.ToString("dd-MM-yyyy")
24 | "en-US" -> date.ToString("MM\/dd\/yyyy")
25 | _ -> failwith "bad date"
26
27let pad (str: string) (threshold: int) =
28 match str.Length with
29 | x when x = threshold -> str
30 | x when x <= threshold -> str.PadRight(threshold)
31 | _ -> str.[0..21] + "..."
32
33let sign currency =
34 match currency with
35 | "USD" -> "$"
36 | "EUR" -> "€"
37 | _ -> failwith "Invalid currency"
38
39let formatCurrency (locale: string) (currency: string) (c: float) =
40 match (locale, c) with
41 | ("nl-NL", c) when c < 0.0 -> (sign currency + " " + c.ToString("#,#0.00", CultureInfo(locale))).PadLeft(13)
42 | ("en-US", c) when c < 0.0 ->
43 ("(" + (sign currency) + c.ToString("#,#0.00", CultureInfo("en-US")).Substring(1) + ")").PadLeft(13)
44 | ("nl-NL", _) -> (sign currency + " " + c.ToString("#,#0.00", CultureInfo("nl-NL")) + " ").PadLeft(13)
45 | ("en-US", _) -> (sign currency + c.ToString("#,#0.00", CultureInfo("en-US")) + " ").PadLeft(13)
46 | _ -> failwith "Invalid locale"
47
48let separatedBy (sep: string) (parts: string list) = String.Join(sep, parts)
49
50let formatLedger currency locale (entriesOut: Entry list): string =
51 let rec loop currency locale (entries: Entry list) res =
52 match entries with
53 | [] -> res
54 | { Entry.dat = dat; Entry.des = des; Entry.chg = chg } :: rest ->
55 let c = float chg / 100.0
56 let txt =
57 separatedBy " | "
58 [ formatDate locale dat
59 pad des 25
60 formatCurrency locale currency c ]
61 loop currency locale rest (res + "\n" + txt)
62
63 header locale + loop currency locale (List.sortBy (fun x -> x.dat, x.des, x.chg) entriesOut) ""