hgeometry-0.6.0.0: examples/Demo/MinDisk.hs
{-# LANGUAGE ScopedTypeVariables #-}
module Demo.MinDisk where
import Algorithms.Geometry.SmallestEnclosingBall.RandomizedIncrementalConstruction
import Algorithms.Geometry.SmallestEnclosingBall.Types
import Control.Applicative
import Control.Lens
import Data.Data
import Data.Ext
import qualified Data.Foldable as F
import Data.Geometry
import Data.Geometry.Ball
import Data.Geometry.Ipe
import Data.Geometry.Ipe.Types
import Data.Geometry.Line
import Data.Geometry.PolyLine
import Data.Maybe
import Data.Semigroup
import Data.Seq2
import qualified Data.Traversable as Tr
import Data.Vinyl
import Options.Applicative
import System.Environment (getArgs)
import System.Random
--------------------------------------------------------------------------------
newtype Options = Options { inPath :: FilePath }
deriving Data
options :: ParserInfo Options
options = info (helper <*> parser)
( progDesc "Given an ipe file with a set of points, computes the smallest enclosing disk of the points."
<> header "MinDisk - Computes the smallest enclosing disk of a set of points"
)
where
parser = Options
<$> strOption (help "Input File (in ipe7 xml format)")
--------------------------------------------------------------------------------
diskResult :: Floating r => IpeOut (DiskResult p r) (IpeObject r)
diskResult = IpeOut f
where
f (DiskResult d pts) = asIpeGroup (asIpeObject d mempty : (F.toList . fmap g $ pts))
g p = asIpeObject (p^.core) mempty
mainWith :: Options -> IO ()
mainWith (Options fp) = do
ep <- readSinglePageFile fp
gen <- getStdGen
case ep of
Left err -> print err
Right (ipeP :: IpePage Double) ->
case map ext $ ipeP^..content.Tr.traverse._IpeUse.core.symbolPoint of
pts@(_:_:_) -> do
let res = smallestEnclosingDisk gen pts
printAsIpeSelection . asIpe diskResult $ res
_ -> putStrLn "Not enough points!"
-- polies = ipeP^..content.Tr.traverse._IpePath.core._asPolyLine
-- print pls
-- mapM_ (print . (^.enclosingDisk) . minDisk' gen) polies
-- mapM_ (printAsIpeSelection . asIpe diskResult . minDisk' gen) polies
minDisk' :: RandomGen g => g -> PolyLine 2 () Double -> DiskResult () Double
minDisk' = minDisk
minDisk :: (Ord r, Fractional r, RandomGen g) => g -> PolyLine 2 () r -> DiskResult () r
minDisk gen pl = smallestEnclosingDisk gen (F.toList $ pl^.points)