trackler 2.2.1.40 → 2.2.1.41

data/tracks/sml/config.json

@@ -236,6 +236,19 @@
 
       ]
     },
+    {
+
+      "uuid": "f7ea4ee6-cd34-4dc9-bd96-abcf940873f0",
+      "slug": "diamond",
+      "core": false,
+      "unlocked_by": null,
+      "difficulty": 1,
+      "topics": [
+        "strings",
+        "lists",
+        "text_formatting"
+      ]
+    },
     {
       "uuid": "225cfd7d-81a3-4a58-b1aa-1de2e40e7a93",
       "slug": "binary",

data/tracks/sml/exercises/anagram/README.md

@@ -6,19 +6,35 @@ Given `"listen"` and a list of candidates like `"enlists" "google"
 "inlets" "banana"` the program should return a list containing
 `"inlets"`.
 
-## Running the tests
+## Loading your exercise implementation in PolyML
 
-Even though there are multiple implementations, we encourage to use Poly/ML.
+```
+$ poly --use {exercise}.sml
+```
+
+Or:
 
 ```
-$ poly -q < test_{ exercise }.sml
+$ poly
+> use "{exercise}.sml";
 ```
 
-If you want to start an interactive session:
+**Note:** You have to replace {exercise}.
+
+## Running the tests
+
 ```
-$ poly --use test_{ exercise }.sml
+$ poly -q --use test.sml
 ```
 
+## Feedback, Issues, Pull Requests
+
+The [exercism/sml](https://github.com/exercism/sml) repository on
+GitHub is the home for all of the Standard ML exercises.
+
+If you have feedback about an exercise, or want to help implementing a new
+one, head over there and create an issue. We'll do our best to help you!
+
 ## Source
 
 Inspired by the Extreme Startup game [https://github.com/rchatley/extreme_startup](https://github.com/rchatley/extreme_startup)

data/tracks/sml/exercises/anagram/anagram.sml

@@ -1,6 +1,2 @@
-(* anagram = fn: string -> string list -> string list
-   given a starting word and a list of candidate words
-   determine which candidate words are anagrams of the starting word
-*)
-fun anagram (word: string) (candidates: string list): string list =
-  raise Fail "'anagram' has not been implemented"
+fun anagrams (candidates: string list, subject: string): string list =
+  raise Fail "'anagrams' is not implemented"

data/tracks/sml/exercises/anagram/example.sml

@@ -1,7 +1,7 @@
 (* Merge two ordered lists using the order lt.
-   Pre: the given lists xs and ys must already be ordered per lt.
-   Runs in O(n) time, where n = |xs| + |ys|. 
-*)
+ * Pre: the given lists xs and ys must already be ordered per lt.
+ * Runs in O(n) time, where n = |xs| + |ys|.
+ *)
 fun merge lt (xs, ys) =
     let fun loop(out, [], []) = List.rev out
           | loop(out, x::xs, []) = loop (x::out, xs, [])
@@ -14,12 +14,12 @@ fun merge lt (xs, ys) =
     end
 
 (* mergesort = fn : ('a * 'a -> bool) -> 'a list -> 'a list
-   given an ordering operation and a list of elements that can be ordered
-   returns them in that ordering 
- 
-   ex: mergesort (op <) [5,4,3,2,1] 
-       => [1, 2, 3, 4, 5] : int list
-*)        
+ * given an ordering operation and a list of elements that can be ordered
+ * returns them in that ordering
+ *
+ * ex: mergesort (op <) [5,4,3,2,1]
+ *     => [1, 2, 3, 4, 5] : int list
+ *)
 fun mergesort lt xs =
     let val merge' = merge lt
         (* splits a list into two semi-equal halves in Linear time *)
@@ -41,18 +41,23 @@ fun mergesort lt xs =
         ms xs
     end
 
-(* anagram = fn: string -> string list -> string list 
-   given a starting word and a list of candidate words 
-   determine which candidate words are anagrams of the starting word
-*) 
-fun anagram word candidates =
-    let val ms'        = mergesort (op <)
-        val sortedWord = ms' (explode word)
-        fun isAnagram word candidate =
-            let val sortedCandidate = ms' (explode candidate)
-            in
-                sortedWord = sortedCandidate
-            end
-    in
-        List.filter (isAnagram word) candidates
-    end
+fun anagrams (candidates, subject) =
+  let
+    fun toLower s = map Char.toLower (explode s)
+
+    val subject' = toLower subject
+
+    val sort = mergesort (op <)
+
+    fun isAnagram a b = sort a = sort b
+
+    fun collect [] = []
+      | collect (s :: ss) =
+          if subject' = toLower s
+          then collect ss
+          else if isAnagram subject' (toLower s)
+               then s :: collect ss
+               else collect ss
+  in
+    collect candidates
+  end

data/tracks/sml/exercises/anagram/test.sml

@@ -1,54 +1,60 @@
+(* version 1.0.1 *)
+
+use "testlib.sml";
 use "anagram.sml";
 
-val test_cases = [
-  {
-    description = "The empty string is not an anagram of anything",
-    input = "",
-    candidates = ["enlists", "google", "inlets", "banana"],
-    expected = []
-  },
-  {
-    description = "A starting word with no candidates returns an empty array",
-    input = "listen",
-    candidates = [],
-    expected = []
-  },
-  {
-    description = "'listen' is an anagram of 'inlets'",
-    input = "listen",
-    candidates = ["enlists", "google", "inlets", "banana"],
-    expected = ["inlets"]
-  },
-  {
-    description = "'hatreds' is an anagram of 'dearths', 'hardest', and 'threads'",
-    input = "hatreds",
-    candidates = ["dearths","hardest","salmon","devilish", "threads"],
-    expected = ["dearths","hardest","threads"]
-  }
-];
-
-fun run_tests _ [] = []
-  | run_tests f (x :: xs) =
-      let
-        fun aux { description, input, candidates, expected } =
-          let
-            val output = f input candidates
-            val is_correct = output = expected
-            val expl = description ^ ": " ^
-              (if is_correct then "PASSED" else "FAILED") ^ "\n"
-          in
-            (print (expl); is_correct)
-          end
-      in
-        (aux x) :: run_tests f xs
-      end
-
-val testResults = run_tests anagram test_cases;
-val passedTests = List.filter (fn x => x) testResults;
-val failedTests = List.filter (fn x => not x) testResults;
-
-if (List.length testResults) = (List.length passedTests)
-then (print "ALL TESTS PASSED")
-else (print (Int.toString (List.length failedTests) ^ " TEST(S) FAILED"));
+infixr |>
+fun x |> f = f x
+
+val testsuite =
+  describe "anagram" [
+    test "no matches"
+      (fn _ => anagrams (["hello", "world", "zombies", "pants"], "diaper") |> Expect.equalTo []),
+
+    test "detects simple anagram"
+      (fn _ => anagrams (["tan", "stand", "at"], "ant") |> Expect.equalTo ["tan"]),
+
+    test "does not detect false positives"
+      (fn _ => anagrams (["eagle"], "galea") |> Expect.equalTo []),
+
+    test "detects two anagrams"
+      (fn _ => anagrams (["stream", "pigeon", "maters"], "master") |> Expect.equalTo ["stream", "maters"]),
+
+    test "does not detect anagram subsets"
+      (fn _ => anagrams (["dog", "goody"], "good") |> Expect.equalTo []),
+
+    test "detects anagram"
+      (fn _ => anagrams (["enlists", "google", "inlets", "banana"], "listen") |> Expect.equalTo ["inlets"]),
+
+    test "detects three anagrams"
+      (fn _ => anagrams (["gallery", "ballerina", "regally", "clergy", "largely", "leading"], "allergy") |> Expect.equalTo ["gallery", "regally", "largely"]),
+
+    test "does not detect identical words"
+      (fn _ => anagrams (["corn", "dark", "Corn", "rank", "CORN", "cron", "park"], "corn") |> Expect.equalTo ["cron"]),
+
+    test "does not detect non-anagrams with identical checksum"
+      (fn _ => anagrams (["last"], "mass") |> Expect.equalTo []),
+
+    test "detects anagrams case-insensitively"
+      (fn _ => anagrams (["cashregister", "Carthorse", "radishes"], "Orchestra") |> Expect.equalTo ["Carthorse"]),
+
+    test "detects anagrams using case-insensitive subject"
+      (fn _ => anagrams (["cashregister", "carthorse", "radishes"], "Orchestra") |> Expect.equalTo ["carthorse"]),
+
+    test "detects anagrams using case-insensitive possible matches"
+      (fn _ => anagrams (["cashregister", "Carthorse", "radishes"], "orchestra") |> Expect.equalTo ["Carthorse"]),
+
+    test "does not detect a word as its own anagram"
+      (fn _ => anagrams (["Banana"], "banana") |> Expect.equalTo []),
+
+    test "does not detect a anagram if the original word is repeated"
+      (fn _ => anagrams (["go Go GO"], "go") |> Expect.equalTo []),
+
+    test "anagrams must use all letters exactly once"
+      (fn _ => anagrams (["patter"], "tapper") |> Expect.equalTo []),
 
+    test "capital word is not own anagram"
+      (fn _ => anagrams (["Banana"], "BANANA") |> Expect.equalTo [])
+  ]
 
+val _ = Test.run testsuite

data/tracks/sml/exercises/anagram/testlib.sml

@@ -0,0 +1,159 @@
+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 b a =
+      if Real.== (a, b)
+      then Pass
+      else failEq (Real.toString b) (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)

data/tracks/sml/exercises/diamond/README.md

@@ -0,0 +1,89 @@
+# Diamond
+
+The diamond kata takes as its input a letter, and outputs it in a diamond 
+shape. Given a letter, it prints a diamond starting with 'A', with the 
+supplied letter at the widest point.
+
+## Requirements
+
+* The first row contains one 'A'.
+* The last row contains one 'A'.
+* All rows, except the first and last, have exactly two identical letters.
+* All rows have as many trailing spaces as leading spaces. (This might be 0).
+* The diamond is horizontally symmetric.
+* The diamond is vertically symmetric.
+* The diamond has a square shape (width equals height).
+* The letters form a diamond shape.
+* The top half has the letters in ascending order.
+* The bottom half has the letters in descending order. 
+* The four corners (containing the spaces) are triangles.
+
+## Examples
+
+In the following examples, spaces are indicated by `·` characters.
+
+Diamond for letter 'A':
+
+```plain
+A
+```
+
+Diamond for letter 'C':
+
+```plain
+··A··
+·B·B·
+C···C
+·B·B·
+··A··
+```
+
+Diamond for letter 'E':
+
+```plain
+····A····
+···B·B···
+··C···C··
+·D·····D·
+E·······E
+·D·····D·
+··C···C··
+···B·B···
+····A····
+```
+
+## Loading your exercise implementation in PolyML
+
+```
+$ poly --use {exercise}.sml
+```
+
+Or:
+
+```
+$ poly
+> use "{exercise}.sml";
+```
+
+**Note:** You have to replace {exercise}.
+
+## Running the tests
+
+```
+$ poly -q --use test.sml
+```
+
+## Feedback, Issues, Pull Requests
+
+The [exercism/sml](https://github.com/exercism/sml) repository on
+GitHub is the home for all of the Standard ML exercises.
+
+If you have feedback about an exercise, or want to help implementing a new
+one, head over there and create an issue. We'll do our best to help you!
+
+## Source
+
+Seb Rose [http://claysnow.co.uk/recycling-tests-in-tdd/](http://claysnow.co.uk/recycling-tests-in-tdd/)
+
+## Submitting Incomplete Solutions
+It's possible to submit an incomplete solution so you can see how others have completed the exercise.

data/tracks/sml/exercises/diamond/diamond.sml

@@ -0,0 +1,2 @@
+fun rows (input: string): string list =
+  raise Fail "'rows' is not implemented"

data/tracks/sml/exercises/diamond/example.sml

@@ -0,0 +1,25 @@
+fun rows (input: string): string list =
+  let
+    fun spaces n = List.tabulate (n, fn _ => #" ")
+
+    fun index c = ord c - ord #"A"
+
+    fun halfRow numcols c = spaces (numcols - index c - 1) @ [c] @ spaces (index c)
+
+    fun mkRow numcols c =
+      let
+        val half = halfRow numcols c
+      in
+        implode (half @ tl (rev half))
+      end
+
+    fun prevLetter c = chr (ord c - 1)
+
+    val c = valOf (Char.fromString input)
+    val numcols = index c + 1
+
+    fun mkRows 0 _ acc = acc @ tl (rev acc)
+      | mkRows i c acc = mkRows (i - 1) (prevLetter c) (mkRow numcols c :: acc)
+  in
+    mkRows numcols c []
+  end

data/tracks/sml/exercises/diamond/test.sml

@@ -0,0 +1,27 @@
+(* version 1.0.0 *)
+
+use "diamond.sml";
+use "testlib.sml";
+
+infixr |>
+fun x |> f = f x
+
+val testsuite =
+  describe "diamond" [
+    test "Degenerate case with a single 'A' row"
+      (fn _ => rows ("A") |> Expect.equalTo ["A"]),
+
+    test "Degenerate case with no row containing 3 distinct groups of spaces"
+      (fn _ => rows ("B") |> Expect.equalTo [" A ", "B B", " A "]),
+
+    test "Smallest non-degenerate case with odd diamond side length"
+      (fn _ => rows ("C") |> Expect.equalTo ["  A  ", " B B ", "C   C", " B B ", "  A  "]),
+
+    test "Smallest non-degenerate case with even diamond side length"
+      (fn _ => rows ("D") |> Expect.equalTo ["   A   ", "  B B  ", " C   C ", "D     D", " C   C ", "  B B  ", "   A   "]),
+
+    test "Largest possible diamond"
+      (fn _ => rows ("Z") |> Expect.equalTo ["                         A                         ", "                        B B                        ", "                       C   C                       ", "                      D     D                      ", "                     E       E                     ", "                    F         F                    ", "                   G           G                   ", "                  H             H                  ", "                 I               I                 ", "                J                 J                ", "               K                   K               ", "              L                     L              ", "             M                       M             ", "            N                         N            ", "           O                           O           ", "          P                             P          ", "         Q                               Q         ", "        R                                 R        ", "       S                                   S       ", "      T                                     T      ", "     U                                       U     ", "    V                                         V    ", "   W                                           W   ", "  X                                             X  ", " Y                                               Y ", "Z                                                 Z", " Y                                               Y ", "  X                                             X  ", "   W                                           W   ", "    V                                         V    ", "     U                                       U     ", "      T                                     T      ", "       S                                   S       ", "        R                                 R        ", "         Q                               Q         ", "          P                             P          ", "           O                           O           ", "            N                         N            ", "             M                       M             ", "              L                     L              ", "               K                   K               ", "                J                 J                ", "                 I               I                 ", "                  H             H                  ", "                   G           G                   ", "                    F         F                    ", "                     E       E                     ", "                      D     D                      ", "                       C   C                       ", "                        B B                        ", "                         A                         "])
+  ]
+
+val _ = Test.run testsuite