TriangulateMonotoneSpec.hs

module Algorithms.Geometry.PolygonTriangulation.TriangulateMonotoneSpec where

import           Algorithms.Geometry.PolygonTriangulation.TriangulateMonotone
import           Control.Lens
import           Data.Ext
import           Data.Geometry
import           Data.Geometry.Ipe
import           Data.Geometry.Polygon
import qualified Data.List.NonEmpty as NonEmpty
import           Data.Maybe
import qualified Data.Set as Set
import           Data.Vinyl
import           Test.Hspec
import           Util


spec :: Spec
spec = do testCases "test/Algorithms/Geometry/PolygonTriangulation/monotone.ipe"
          testCases "test/Algorithms/Geometry/PolygonTriangulation/simplepolygon6.ipe"

testCases    :: FilePath -> Spec
testCases fp = (runIO $ readInput fp) >>= \case
    Left e    -> it "reading TriangulateMonotone file" $
                   expectationFailure $ "Failed to read ipe file " ++ show e
    Right tcs -> mapM_ toSpec tcs


data TestCase r = TestCase { _polygon  :: MonotonePolygon () r :+ IpeColor r
                           , _solution :: [LineSegment 2 () r]
                           }
                  deriving (Show,Eq)


toSpec                            :: (Num r, Ord r, Show r) => TestCase r -> Spec
toSpec (TestCase (poly :+ c) sol) =
    describe ("testing polygions of color " ++ show c) $ do
      it "comparing with manual solution" $
        (naiveSet $ computeDiagonals poly) `shouldBe` naiveSet sol
  where
    naiveSet = NaiveSet . map S

newtype S p r = S (LineSegment 2 p r) deriving (Show)

instance (Eq p, Eq r) => Eq (S p r) where
  (S s) == (S y) =  (s^.start == y^.start && s^.end == y^.end)
                 || (s^.start == y^.end   && s^.end == y^.start)



-- | Point sets per color, Crosses form the solution
readInput    :: FilePath -> IO (Either ConversionError [TestCase Rational])
readInput fp = fmap f <$> readSinglePageFile fp
  where
    f page = [ TestCase pg (solutionOf pg segs)
             | pg <- map g polies
             ]
      where
        g x@(pg :+ _) = toCounterClockWiseOrder pg :+ lookupColor x

        polies = page^..content.traverse._withAttrs _IpePath _asSimplePolygon
        segs   = page^..content.traverse._withAttrs _IpePath _asLineSegment

        solutionOf (_ :+ c) = map (^.core) . filter ((== c) . lookupColor)


        -- -- | Crosses form a solution
        -- isInSolution s = s^.core.symbolName == "mark/cross(sx)"

        -- right = either (const Nothing) Just
        -- solutionOf = right . fromList . map (^.core.symbolPoint) . filter isInSolution

lookupColor           :: i :+ IpeAttributes Path r -> IpeColor r
lookupColor (_ :+ ats) = fromMaybe (IpeColor $ Named "black") $ lookupAttr SStroke ats