haskell saddle-points

assignments/haskell/saddle-points/example.hs

@@ -0,0 +1,61 @@
+module Matrix (saddlePoints) where
+import Data.Array (Ix, Array, assocs, bounds)
+import Data.Monoid (Monoid, mappend, mempty)
+import Data.Maybe (maybeToList)
+import Data.Functor ((<$>))
+import Control.Monad (guard)
+import qualified Data.Set as S
+import qualified Data.Map as M
+
+data Axis a b = Row !a
+              | Col !b
+          deriving (Show, Eq, Ord)
+
+class Extrema a where
+  ecmp :: Ord b => a -> b -> b -> Ordering
+
+data Min = Min deriving (Show)
+data Max = Max deriving (Show)
+
+instance Extrema Min where
+  ecmp _ = compare
+
+instance Extrema Max where
+  ecmp _ = flip compare
+
+data Extremes a b c = Extremes !a !b !c deriving (Show)
+
+instance (Extrema a, Ord b, Monoid c) => Monoid (Extremes a b c) where
+  mempty = undefined
+  mappend a@(Extremes ea xa as) b@(Extremes _ xb bs) = case ecmp ea xa xb of
+    LT -> a
+    EQ -> Extremes ea xa (as `mappend` bs)
+    GT -> b
+
+extrema :: (Ix a, Ix b, Ord c)
+           => Array (a, b) c
+           -> M.Map (Axis a b) ( Extremes Min c (S.Set (a, b))
+                               , Extremes Max c (S.Set (a, b)))
+extrema = M.fromListWith mappend . expand . assocs
+  where expand xs = do
+          (ix@(row, col), x) <- xs
+          let s = S.singleton ix
+          ax <- [Row row, Col col]
+          return (ax, (Extremes Min x s, Extremes Max x s))
+
+-- This is so generic with regard to extrema as it was designed
+-- to find either type of saddle point. The readme for this exercise
+-- at the time had a definition that was inconsistent with the tests.
+saddlePoints :: Array (Int, Int) Int -> [(Int, Int)]
+saddlePoints arr = do
+  let getMin (Extremes Min a as, _) = (a, as)
+      getMax (_, Extremes Max b bs) = (b, bs)
+      fetch f k = maybeToList $ f <$> M.lookup k m
+      ((r0, _c0), (r1, _c1)) = bounds arr
+      m = extrema arr
+  r <- [r0..r1]
+  (rx, rixs) <- fetch getMax (Row r)
+  rix@(_, c) <- S.toList rixs
+  (cx, cixs) <- fetch getMin (Col c)
+  guard $ rx == cx && rix `S.member` cixs
+  return rix

assignments/haskell/saddle-points/saddle-points_test.hs

@@ -0,0 +1,43 @@
+import Test.HUnit (Assertion, (@=?), runTestTT, Test(..))
+import Control.Monad (void)
+import Matrix (saddlePoints)
+import Data.Array (listArray)
+
+testCase :: String -> Assertion -> Test
+testCase label assertion = TestLabel label (TestCase assertion)
+
+main :: IO ()
+main = void $ runTestTT $ TestList
+       [ TestList matrixTests ]
+
+matrixTests :: [Test]
+matrixTests =
+  [ testCase "Example from README" $ do
+    let matrix = listArray ((0, 0), (2, 2))
+                 [ 9, 8, 7
+                 , 5, 3, 2
+                 , 6, 6, 7 ]
+    [(1, 0)] @=? saddlePoints matrix
+  , testCase "no saddle point" $ do
+    let matrix = listArray ((0, 0), (1, 1))
+                 [ 2, 1
+                 , 1, 2 ]
+    [] @=? saddlePoints matrix
+  , testCase "a saddle point" $ do
+    let matrix = listArray ((0, 0), (1, 1))
+                 [ 1, 2
+                 , 3, 4 ]
+    [(0, 1)] @=? saddlePoints matrix
+  , testCase "another saddle point" $ do
+    let matrix = listArray ((0, 0), (2, 4))
+                 [ 18,  3, 39, 19,  91
+                 , 38, 10,  8, 77, 320
+                 ,  3,  4,  8,  6,   7 ]
+    [(2, 2)] @=? saddlePoints matrix
+  , testCase "multiple saddle points" $ do
+    let matrix = listArray ((0, 0), (2, 2))
+                 [ 4, 5, 4
+                 , 3, 5, 5
+                 , 1, 5, 4 ]
+    [(0, 1), (1, 1), (2, 1)] @=? saddlePoints matrix
+  ]

assignments/shared/saddle-points.md

@@ -1,4 +1,4 @@
-So say you've a matrix like so:
+So say you have a matrix like so:
 
 ```plain
     0  1  2
@@ -8,13 +8,15 @@ So say you've a matrix like so:
 2 | 6  6  7
 ```
 
-It's got a saddle point at (1, 0).
+It has a saddle point at (1, 0).
 
-It's called a "saddle point"
-because its neighbors on one axis are bigger than it
-while its neighbors along the other are smaller.
+It's called a "saddle point" because it is greater than or equal to every
+element in its row and the less than or equal to every element in its column.
 
-A matrix may have zero saddle points, or it might have several.
+A matrix may have zero or more saddle points.
 
-Your code should be able to provide the (possibly empty) list of all the saddle
-points for any given matrix.
+Your code should be able to provide the (possibly empty) list of all the
+saddle points for any given matrix.
+
+Note that you may find other definitions of matrix saddle points online, but
+the tests for this exercise follow the above unambiguous definition.

lib/exercism/curriculum/haskell.rb

@@ -12,7 +12,7 @@ def slugs
         accumulate binary-search-tree difference-of-squares hexadecimal
         largest-series-product luhn matrix ocr-numbers octal trinary
         wordy simple-linked-list linked-list nth-prime palindrome-products
-        pascals-triangle pig-latin pythagorean-triplet
+        pascals-triangle pig-latin pythagorean-triplet saddle-points
       )
     end