diff --git a/config.json b/config.json index 9cb0296..1ebbd42 100644 --- a/config.json +++ b/config.json @@ -817,6 +817,14 @@ "prerequisites": [], "difficulty": 7 }, + { + "slug": "alphametics", + "name": "Alphametics", + "uuid": "fb9e5c15-2480-4267-8235-6ad5ac5bfdd8", + "practices": [], + "prerequisites": [], + "difficulty": 8 + }, { "slug": "circular-buffer", "name": "Circular Buffer", diff --git a/exercises/practice/alphametics/.docs/instructions.md b/exercises/practice/alphametics/.docs/instructions.md new file mode 100644 index 0000000..ef2cbb4 --- /dev/null +++ b/exercises/practice/alphametics/.docs/instructions.md @@ -0,0 +1,29 @@ +# Instructions + +Given an alphametics puzzle, find the correct solution. + +[Alphametics][alphametics] is a puzzle where letters in words are replaced with numbers. + +For example `SEND + MORE = MONEY`: + +```text + S E N D + M O R E + +----------- +M O N E Y +``` + +Replacing these with valid numbers gives: + +```text + 9 5 6 7 + 1 0 8 5 + +----------- +1 0 6 5 2 +``` + +This is correct because every letter is replaced by a different number and the words, translated into numbers, then make a valid sum. + +Each letter must represent a different digit, and the leading digit of a multi-digit number must not be zero. + +[alphametics]: https://en.wikipedia.org/wiki/Alphametics diff --git a/exercises/practice/alphametics/.meta/config.json b/exercises/practice/alphametics/.meta/config.json new file mode 100644 index 0000000..7e553cd --- /dev/null +++ b/exercises/practice/alphametics/.meta/config.json @@ -0,0 +1,17 @@ +{ + "authors": [ + "keiravillekode" + ], + "files": { + "solution": [ + "alphametics.sml" + ], + "test": [ + "test.sml" + ], + "example": [ + ".meta/example.sml" + ] + }, + "blurb": "Given an alphametics puzzle, find the correct solution." +} diff --git a/exercises/practice/alphametics/.meta/example.sml b/exercises/practice/alphametics/.meta/example.sml new file mode 100644 index 0000000..b7429af --- /dev/null +++ b/exercises/practice/alphametics/.meta/example.sml @@ -0,0 +1,122 @@ +fun solve (puzzle: string): string = + let + (* Tokenize: words and "=" retained; "+" and spaces are separators *) + val tokens = String.tokens (fn c => c = #" " orelse c = #"+") puzzle + + val nColumns = foldl (fn (t, m) => Int.max (String.size t, m)) 0 tokens + + fun isWord token = Char.isAlpha (String.sub (token, 0)) + + (* Letter info: weight vector has per-column coefficients, rank is rightmost column *) + type info = {letter: char, leading: int, weight: int vector, rank: int} + + (* Build info for a given letter by scanning all tokens *) + fun letterInfo (ch: char): info option = + let + (* Is ch the leading letter of a non-trivial word? *) + val leading = + if List.exists (fn t => + isWord t andalso String.size t > 1 andalso String.sub (t, 0) = ch) tokens + then 1 else 0 + + (* Per-column weight coefficients *) + fun weightAt col = + let + fun processToken (token, (sign, sum)) = + if not (isWord token) then (~sign, sum) + else + let val len = String.size token + in + if col < len andalso String.sub (token, len - 1 - col) = ch + then (sign, sum + sign) + else (sign, sum) + end + in #2 (foldl processToken (1, 0) tokens) end + + val weight = Vector.tabulate (nColumns, weightAt) + + (* Rightmost column where ch appears *) + val rank = Vector.foldli (fn (i, w, r) => + if w <> 0 then Int.min (i, r) else r) nColumns weight + in + if rank = nColumns then NONE + else SOME { + letter = ch, + leading = leading, + weight = weight, + rank = rank + } + end + + (* Assemble letter infos for A-Z, sorted by rank *) + fun sortByRank infos = + let + fun insert (x: info, []) = [x] + | insert (x, (y: info) :: ys) = + if #rank x <= #rank y then x :: y :: ys + else y :: insert (x, ys) + in foldl (fn (e, acc) => insert (e, acc)) [] infos end + + val letters: info list = + sortByRank (List.mapPartial letterInfo + (List.tabulate (26, fn i => chr (Char.ord #"A" + i)))) + + (* Mapping: associates each letter with its assigned digit *) + type mapping = (char * int) list + + fun lookup (_, []: mapping) = 0 + | lookup (ch, (c, digit) :: rest) = if c = ch then digit else lookup (ch, rest) + + fun isClaimed (claimed, d) = + Word.andb (claimed, Word.<< (0w1, Word.fromInt d)) <> 0w0 + + fun claim (claimed, d) = + Word.orb (claimed, Word.<< (0w1, Word.fromInt d)) + + (* Sum of weight[col] * digit for all letters *) + fun columnSum (col, mapping) = + foldl (fn ({letter, weight, ...}: info, sum) => + if col < Vector.length weight + then sum + Vector.sub (weight, col) * lookup (letter, mapping) + else sum) 0 letters + + (* Check column and advance, or finish *) + fun advanceColumn (remaining, col, claimed, carry, mapping) = + let val colSum = carry + columnSum (col, mapping) + in + if colSum mod 10 <> 0 then NONE + else if col + 1 < nColumns then + search (remaining, col + 1, claimed, colSum div 10, mapping) + else if colSum = 0 then SOME mapping + else NONE + end + + (* Search: assign digits to letters column by column *) + and search (remaining, col, claimed, carry, mapping) = + case remaining of + [] => advanceColumn ([], col, claimed, carry, mapping) + | (letter :: rest) => + if #rank letter > col then + advanceColumn (remaining, col, claimed, carry, mapping) + else + let + fun tryDigit digit = + if digit > 9 then NONE + else if isClaimed (claimed, digit) then tryDigit (digit + 1) + else + case search (rest, col, claim (claimed, digit), + carry, (#letter letter, digit) :: mapping) of + SOME m => SOME m + | NONE => tryDigit (digit + 1) + in tryDigit (#leading letter) end + + (* Convert puzzle string by substituting digits from mapping *) + fun substitute mapping = + String.implode (map (fn c => + if Char.isAlpha c then chr (Char.ord #"0" + lookup (c, mapping)) + else c) (String.explode puzzle)) + in + case search (letters, 0, 0w0, 0, []) of + SOME m => substitute m + | NONE => raise Fail "no solution" + end diff --git a/exercises/practice/alphametics/.meta/tests.toml b/exercises/practice/alphametics/.meta/tests.toml new file mode 100644 index 0000000..f599b3d --- /dev/null +++ b/exercises/practice/alphametics/.meta/tests.toml @@ -0,0 +1,40 @@ +# This is an auto-generated file. +# +# Regenerating this file via `configlet sync` will: +# - Recreate every `description` key/value pair +# - Recreate every `reimplements` key/value pair, where they exist in problem-specifications +# - Remove any `include = true` key/value pair (an omitted `include` key implies inclusion) +# - Preserve any other key/value pair +# +# As user-added comments (using the # character) will be removed when this file +# is regenerated, comments can be added via a `comment` key. + +[e0c08b07-9028-4d5f-91e1-d178fead8e1a] +description = "puzzle with three letters" + +[a504ee41-cb92-4ec2-9f11-c37e95ab3f25] +description = "solution must have unique value for each letter" + +[4e3b81d2-be7b-4c5c-9a80-cd72bc6d465a] +description = "leading zero solution is invalid" + +[8a3e3168-d1ee-4df7-94c7-b9c54845ac3a] +description = "puzzle with two digits final carry" + +[a9630645-15bd-48b6-a61e-d85c4021cc09] +description = "puzzle with four letters" + +[3d905a86-5a52-4e4e-bf80-8951535791bd] +description = "puzzle with six letters" + +[4febca56-e7b7-4789-97b9-530d09ba95f0] +description = "puzzle with seven letters" + +[12125a75-7284-4f9a-a5fa-191471e0d44f] +description = "puzzle with eight letters" + +[fb05955f-38dc-477a-a0b6-5ef78969fffa] +description = "puzzle with ten letters" + +[9a101e81-9216-472b-b458-b513a7adacf7] +description = "puzzle with ten letters and 199 addends" diff --git a/exercises/practice/alphametics/alphametics.sml b/exercises/practice/alphametics/alphametics.sml new file mode 100644 index 0000000..6c9c8f5 --- /dev/null +++ b/exercises/practice/alphametics/alphametics.sml @@ -0,0 +1,2 @@ +fun solve (puzzle: string): string = + raise Fail "'solve' is not implemented" diff --git a/exercises/practice/alphametics/test.sml b/exercises/practice/alphametics/test.sml new file mode 100644 index 0000000..77404fd --- /dev/null +++ b/exercises/practice/alphametics/test.sml @@ -0,0 +1,42 @@ +(* version 1.0.0 *) + +use "testlib.sml"; +use "alphametics.sml"; + +infixr |> +fun x |> f = f x + +val testsuite = + describe "alphametics" [ + test "puzzle with three letters" + (fn _ => solve "I + BB == ILL" |> Expect.equalTo "1 + 99 == 100"), + + test "solution must have unique value for each letter" + (fn _ => (fn _ => solve "A == B") |> Expect.error (Fail "no solution")), + + test "leading zero solution is invalid" + (fn _ => (fn _ => solve "ACA + DD == BD") |> Expect.error (Fail "no solution")), + + test "puzzle with two digits final carry" + (fn _ => solve "A + A + A + A + A + A + A + A + A + A + A + B == BCC" |> Expect.equalTo "9 + 9 + 9 + 9 + 9 + 9 + 9 + 9 + 9 + 9 + 9 + 1 == 100"), + + test "puzzle with four letters" + (fn _ => solve "AS + A == MOM" |> Expect.equalTo "92 + 9 == 101"), + + test "puzzle with six letters" + (fn _ => solve "NO + NO + TOO == LATE" |> Expect.equalTo "74 + 74 + 944 == 1092"), + + test "puzzle with seven letters" + (fn _ => solve "HE + SEES + THE == LIGHT" |> Expect.equalTo "54 + 9449 + 754 == 10257"), + + test "puzzle with eight letters" + (fn _ => solve "SEND + MORE == MONEY" |> Expect.equalTo "9567 + 1085 == 10652"), + + test "puzzle with ten letters" + (fn _ => solve "AND + A + STRONG + OFFENSE + AS + A + GOOD == DEFENSE" |> Expect.equalTo "503 + 5 + 691208 + 2774064 + 56 + 5 + 8223 == 3474064"), + + test "puzzle with ten letters and 199 addends" + (fn _ => solve "THIS + A + FIRE + THEREFORE + FOR + ALL + HISTORIES + I + TELL + A + TALE + THAT + FALSIFIES + ITS + TITLE + TIS + A + LIE + THE + TALE + OF + THE + LAST + FIRE + HORSES + LATE + AFTER + THE + FIRST + FATHERS + FORESEE + THE + HORRORS + THE + LAST + FREE + TROLL + TERRIFIES + THE + HORSES + OF + FIRE + THE + TROLL + RESTS + AT + THE + HOLE + OF + LOSSES + IT + IS + THERE + THAT + SHE + STORES + ROLES + OF + LEATHERS + AFTER + SHE + SATISFIES + HER + HATE + OFF + THOSE + FEARS + A + TASTE + RISES + AS + SHE + HEARS + THE + LEAST + FAR + HORSE + THOSE + FAST + HORSES + THAT + FIRST + HEAR + THE + TROLL + FLEE + OFF + TO + THE + FOREST + THE + HORSES + THAT + ALERTS + RAISE + THE + STARES + OF + THE + OTHERS + AS + THE + TROLL + ASSAILS + AT + THE + TOTAL + SHIFT + HER + TEETH + TEAR + HOOF + OFF + TORSO + AS + THE + LAST + HORSE + FORFEITS + ITS + LIFE + THE + FIRST + FATHERS + HEAR + OF + THE + HORRORS + THEIR + FEARS + THAT + THE + FIRES + FOR + THEIR + FEASTS + ARREST + AS + THE + FIRST + FATHERS + RESETTLE + THE + LAST + OF + THE + FIRE + HORSES + THE + LAST + TROLL + HARASSES + THE + FOREST + HEART + FREE + AT + LAST + OF + THE + LAST + TROLL + ALL + OFFER + THEIR + FIRE + HEAT + TO + THE + ASSISTERS + FAR + OFF + THE + TROLL + FASTS + ITS + LIFE + SHORTER + AS + STARS + RISE + THE + HORSES + REST + SAFE + AFTER + ALL + SHARE + HOT + FISH + AS + THEIR + AFFILIATES + TAILOR + A + ROOFS + FOR + THEIR + SAFE == FORTRESSES" |> Expect.equalTo "9874 + 1 + 5730 + 980305630 + 563 + 122 + 874963704 + 7 + 9022 + 1 + 9120 + 9819 + 512475704 + 794 + 97920 + 974 + 1 + 270 + 980 + 9120 + 65 + 980 + 2149 + 5730 + 863404 + 2190 + 15903 + 980 + 57349 + 5198034 + 5630400 + 980 + 8633634 + 980 + 2149 + 5300 + 93622 + 903375704 + 980 + 863404 + 65 + 5730 + 980 + 93622 + 30494 + 19 + 980 + 8620 + 65 + 264404 + 79 + 74 + 98030 + 9819 + 480 + 496304 + 36204 + 65 + 20198034 + 15903 + 480 + 419745704 + 803 + 8190 + 655 + 98640 + 50134 + 1 + 91490 + 37404 + 14 + 480 + 80134 + 980 + 20149 + 513 + 86340 + 98640 + 5149 + 863404 + 9819 + 57349 + 8013 + 980 + 93622 + 5200 + 655 + 96 + 980 + 563049 + 980 + 863404 + 9819 + 120394 + 31740 + 980 + 491304 + 65 + 980 + 698034 + 14 + 980 + 93622 + 1441724 + 19 + 980 + 96912 + 48759 + 803 + 90098 + 9013 + 8665 + 655 + 96346 + 14 + 980 + 2149 + 86340 + 56350794 + 794 + 2750 + 980 + 57349 + 5198034 + 8013 + 65 + 980 + 8633634 + 98073 + 50134 + 9819 + 980 + 57304 + 563 + 98073 + 501494 + 133049 + 14 + 980 + 57349 + 5198034 + 30409920 + 980 + 2149 + 65 + 980 + 5730 + 863404 + 980 + 2149 + 93622 + 81314404 + 980 + 563049 + 80139 + 5300 + 19 + 2149 + 65 + 980 + 2149 + 93622 + 122 + 65503 + 98073 + 5730 + 8019 + 96 + 980 + 144749034 + 513 + 655 + 980 + 93622 + 51494 + 794 + 2750 + 4863903 + 14 + 49134 + 3740 + 980 + 863404 + 3049 + 4150 + 15903 + 122 + 48130 + 869 + 5748 + 14 + 98073 + 1557271904 + 917263 + 1 + 36654 + 563 + 98073 + 4150 == 5639304404") + ] + +val _ = Test.run testsuite diff --git a/exercises/practice/alphametics/testlib.sml b/exercises/practice/alphametics/testlib.sml new file mode 100644 index 0000000..0c8370c --- /dev/null +++ b/exercises/practice/alphametics/testlib.sml @@ -0,0 +1,160 @@ +structure Expect = +struct + datatype expectation = Pass | Fail of string * string + + local + fun failEq b a = + Fail ("Expected: " ^ b, "Got: " ^ a) + + fun failExn b a = + Fail ("Expected: " ^ b, "Raised: " ^ a) + + fun exnName (e: exn): string = General.exnName e + in + fun truthy a = + if a + then Pass + else failEq "true" "false" + + fun falsy a = + if a + then failEq "false" "true" + else Pass + + fun equalTo b a = + if a = b + then Pass + else failEq (PolyML.makestring b) (PolyML.makestring a) + + fun nearTo delta b a = + if Real.abs (a - b) <= delta * Real.abs a orelse + Real.abs (a - b) <= delta * Real.abs b + then Pass + else failEq (Real.toString b ^ " +/- " ^ Real.toString delta) (Real.toString a) + + fun anyError f = + ( + f (); + failExn "an exception" "Nothing" + ) handle _ => Pass + + fun error e f = + ( + f (); + failExn (exnName e) "Nothing" + ) handle e' => if exnMessage e' = exnMessage e + then Pass + else failExn (exnMessage e) (exnMessage e') + end +end + +structure TermColor = +struct + datatype color = Red | Green | Yellow | Normal + + fun f Red = "\027[31m" + | f Green = "\027[32m" + | f Yellow = "\027[33m" + | f Normal = "\027[0m" + + fun colorize color s = (f color) ^ s ^ (f Normal) + + val redit = colorize Red + + val greenit = colorize Green + + val yellowit = colorize Yellow +end + +structure Test = +struct + datatype testnode = TestGroup of string * testnode list + | Test of string * (unit -> Expect.expectation) + + local + datatype evaluation = Success of string + | Failure of string * string * string + | Error of string * string + + fun indent n s = (implode (List.tabulate (n, fn _ => #" "))) ^ s + + fun fmt indentlvl ev = + let + val check = TermColor.greenit "\226\156\148 " (* ✔ *) + val cross = TermColor.redit "\226\156\150 " (* ✖ *) + val indentlvl = indentlvl * 2 + in + case ev of + Success descr => indent indentlvl (check ^ descr) + | Failure (descr, exp, got) => + String.concatWith "\n" [indent indentlvl (cross ^ descr), + indent (indentlvl + 2) exp, + indent (indentlvl + 2) got] + | Error (descr, reason) => + String.concatWith "\n" [indent indentlvl (cross ^ descr), + indent (indentlvl + 2) (TermColor.redit reason)] + end + + fun eval (TestGroup _) = raise Fail "Only a 'Test' can be evaluated" + | eval (Test (descr, thunk)) = + ( + case thunk () of + Expect.Pass => ((1, 0, 0), Success descr) + | Expect.Fail (s, s') => ((0, 1, 0), Failure (descr, s, s')) + ) + handle e => ((0, 0, 1), Error (descr, "Unexpected error: " ^ exnMessage e)) + + fun flatten depth testnode = + let + fun sum (x, y, z) (a, b, c) = (x + a, y + b, z + c) + + fun aux (t, (counter, acc)) = + let + val (counter', texts) = flatten (depth + 1) t + in + (sum counter' counter, texts :: acc) + end + in + case testnode of + TestGroup (descr, ts) => + let + val (counter, texts) = foldr aux ((0, 0, 0), []) ts + in + (counter, (indent (depth * 2) descr) :: List.concat texts) + end + | Test _ => + let + val (counter, evaluation) = eval testnode + in + (counter, [fmt depth evaluation]) + end + end + + fun println s = print (s ^ "\n") + in + fun run suite = + let + val ((succeeded, failed, errored), texts) = flatten 0 suite + + val summary = String.concatWith ", " [ + TermColor.greenit ((Int.toString succeeded) ^ " passed"), + TermColor.redit ((Int.toString failed) ^ " failed"), + TermColor.redit ((Int.toString errored) ^ " errored"), + (Int.toString (succeeded + failed + errored)) ^ " total" + ] + + val status = if failed = 0 andalso errored = 0 + then OS.Process.success + else OS.Process.failure + + in + List.app println texts; + println ""; + println ("Tests: " ^ summary); + OS.Process.exit status + end + end +end + +fun describe description tests = Test.TestGroup (description, tests) +fun test description thunk = Test.Test (description, thunk)