Add 'users/glittershark/xanthous/' from commit '53b56744f4335c038724a1bcffc27a7eb8cf6a6d' r/978

git-subtree-dir: users/glittershark/xanthous
git-subtree-mainline: 91f53f02d8479303910abfd3f3690d3ef27e6c4b
git-subtree-split: 53b56744f4335c038724a1bcffc27a7eb8cf6a6d

3 files changed, 122 insertions, 0 deletions

diff --git a/users/glittershark/xanthous/test/Xanthous/Util/GraphSpec.hs b/users/glittershark/xanthous/test/Xanthous/Util/GraphSpec.hs
new file mode 100644
index 000000000000..35ff090b28b9
--- /dev/null
+++ b/users/glittershark/xanthous/test/Xanthous/Util/GraphSpec.hs
@@ -0,0 +1,39 @@
+module Xanthous.Util.GraphSpec (main, test) where
+--------------------------------------------------------------------------------
+import Test.Prelude
+--------------------------------------------------------------------------------
+import Xanthous.Util.Graph
+import Data.Graph.Inductive.Basic
+import Data.Graph.Inductive.Graph (labNodes, size, order)
+import Data.Graph.Inductive.PatriciaTree
+import Data.Graph.Inductive.Arbitrary
+--------------------------------------------------------------------------------
+
+main :: IO ()
+main = defaultMain test
+
+test :: TestTree
+test = testGroup "Xanthous.Util.Graph"
+  [ testGroup "mstSubGraph"
+    [ testProperty "always produces a subgraph"
+        $ \(CG _ (graph :: Gr Int Int)) ->
+          let msg = mstSubGraph $ undir graph
+          in counterexample (show msg)
+            $ msg `isSubGraphOf` undir graph
+    , testProperty "returns a graph with the same nodes"
+        $ \(CG _ (graph :: Gr Int Int)) ->
+          let msg = mstSubGraph graph
+          in counterexample (show msg)
+            $ labNodes msg === labNodes graph
+    , testProperty "has nodes - 1 edges"
+        $ \(CG _ (graph :: Gr Int Int)) ->
+          order graph > 1 ==>
+          let msg = mstSubGraph graph
+          in counterexample (show msg)
+            $ size msg === order graph - 1
+    , testProperty "always produces a simple graph"
+        $ \(CG _ (graph :: Gr Int Int)) ->
+          let msg = mstSubGraph graph
+          in counterexample (show msg) $ isSimple msg
+    ]
+  ]
diff --git a/users/glittershark/xanthous/test/Xanthous/Util/GraphicsSpec.hs b/users/glittershark/xanthous/test/Xanthous/Util/GraphicsSpec.hs
new file mode 100644
index 000000000000..ff99d1073840
--- /dev/null
+++ b/users/glittershark/xanthous/test/Xanthous/Util/GraphicsSpec.hs
@@ -0,0 +1,65 @@
+module Xanthous.Util.GraphicsSpec (main, test) where
+--------------------------------------------------------------------------------
+import Test.Prelude hiding (head)
+--------------------------------------------------------------------------------
+import Xanthous.Util.Graphics
+import Xanthous.Util
+import Data.List (head)
+import Data.Set (isSubsetOf)
+--------------------------------------------------------------------------------
+
+main :: IO ()
+main = defaultMain test
+
+test :: TestTree
+test = testGroup "Xanthous.Util.Graphics"
+  [ testGroup "circle"
+    [ testCase "radius 1, origin 2,2"
+      {-
+        |   | 0 | 1 | 2 | 3 |
+        |---+---+---+---+---|
+        | 0 |   |   |   |   |
+        | 1 |   |   | x |   |
+        | 2 |   | x |   | x |
+        | 3 |   |   | x |   |
+      -}
+      $ (sort . unique @[] @[_]) (circle @Int (2, 2) 1)
+      @?= [ (1, 2)
+          , (2, 1), (2, 3)
+          , (3, 2)
+          ]
+    , testCase "radius 12, origin 0"
+      $ (sort . unique @[] @[_]) (circle @Int (0, 0) 12)
+      @?= [ (-12,-4),(-12,-3),(-12,-2),(-12,-1),(-12,0),(-12,1),(-12,2)
+          , (-12,3),(-12,4),(-11,-6),(-11,-5),(-11,5),(-11,6),(-10,-7),(-10,7)
+          , (-9,-9),(-9,-8),(-9,8),(-9,9),(-8,-9),(-8,9),(-7,-10),(-7,10)
+          , (-6,-11),(-6,11),(-5,-11),(-5 ,11),(-4,-12),(-4,12),(-3,-12),(-3,12)
+          , (-2,-12),(-2,12),(-1,-12),(-1,12),(0,-12),(0,12),(1,-12),(1,12)
+          , (2,-12),(2,12),(3,-12),(3,12),(4,-12),(4,12),(5,-11),(5 ,11),(6,-11)
+          , (6,11),(7,-10),(7,10),(8,-9),(8,9),(9,-9),(9,-8),(9,8),(9,9),(10,-7)
+          , (10,7),(11,-6),(11,-5),(11,5),(11,6),(12,-4),(12,-3),(12,-2),(12,-1)
+          , (12,0), (12,1),(12,2),(12,3),(12,4)
+          ]
+
+    ]
+  , testGroup "filledCircle"
+    [ testProperty "is a superset of circle" $ \center radius ->
+        let circ = circle @Int center radius
+            filledCirc = filledCircle center radius
+        in counterexample ( "circle: " <> show circ
+                           <> "\nfilledCircle: " <> show filledCirc)
+          $ setFromList circ `isSubsetOf` setFromList filledCirc
+    -- TODO later
+    -- , testProperty "is always contiguous" $ \center radius ->
+    --     let filledCirc = filledCircle center radius
+    --     in counterexample (renderBooleanGraphics filledCirc) $
+    ]
+  , testGroup "line"
+    [ testProperty "starts and ends at the start and end points" $ \start end ->
+        let ℓ = line @Int start end
+        in counterexample ("line: " <> show ℓ)
+        $ length ℓ > 2 ==> (head ℓ === start) .&&. (head (reverse ℓ) === end)
+    ]
+  ]
+
+--------------------------------------------------------------------------------
diff --git a/users/glittershark/xanthous/test/Xanthous/Util/InflectionSpec.hs b/users/glittershark/xanthous/test/Xanthous/Util/InflectionSpec.hs
new file mode 100644
index 000000000000..fad841043152
--- /dev/null
+++ b/users/glittershark/xanthous/test/Xanthous/Util/InflectionSpec.hs
@@ -0,0 +1,18 @@
+module Xanthous.Util.InflectionSpec (main, test) where
+
+import Test.Prelude
+import Xanthous.Util.Inflection
+
+main :: IO ()
+main = defaultMain test
+
+test :: TestTree
+test = testGroup "Xanthous.Util.Inflection"
+  [ testGroup "toSentence"
+    [ testCase "empty"  $ toSentence [] @?= ""
+    , testCase "single" $ toSentence ["x"] @?= "x"
+    , testCase "two"    $ toSentence ["x", "y"] @?= "x and y"
+    , testCase "three"  $ toSentence ["x", "y", "z"] @?= "x, y, and z"
+    , testCase "four"   $ toSentence ["x", "y", "z", "w"] @?= "x, y, z, and w"
+    ]
+  ]