sampling polygons

hgeometry-examples/hgeometry-examples.cabal

@@ -204,6 +204,19 @@ executable hgeometry-geojson
           Paths_hgeometry_examples
   --      Miso.Event.Extra
 
+--------------------------------------------------------------------------------
+-- * Polygon Sampler example
+
+executable hgeometry-sampler
+  import:         setup, miso-setup
+  hs-source-dirs: sampler
+  main-is:        Main.hs
+  other-modules:
+          -- Paths_hgeometry_examples
+  --      Miso.Event.Extra
+
+
+
 --------------------------------------------------------------------------------
 -- * Polyline Drawing
 

hgeometry-examples/sampler/Main.hs

@@ -0,0 +1,49 @@
+{-# LANGUAGE QuasiQuotes #-}
+module Main(main) where
+
+import           Control.Lens
+import           Control.Monad (replicateM)
+import           Data.List.NonEmpty (NonEmpty(..))
+import           Data.Maybe
+import           HGeometry.Point
+import           HGeometry.Polygon.Class
+import           HGeometry.Polygon.Simple
+import           HGeometry.Polygon.Simple.Sample
+import           HGeometry.Transformation
+import           HGeometry.Triangle
+import           Ipe
+import qualified System.File.OsPath as File
+import           System.OsPath
+import           System.Random.Stateful
+--------------------------------------------------------------------------------
+
+type R = Double
+
+targetPolygon :: SimplePolygon (Point 2 R)
+targetPolygon = scaleUniformlyBy 20 $ fromJust $ fromPoints
+  [ Point2 0 0
+  , Point2 1 0
+  , Point2 1 1, Point2 2 1, Point2 2 (-1)
+  , Point2 0 (-1), Point2 0 (-2)
+  , Point2 3 (-2), Point2 3 2, Point2 0 2
+  ]
+
+sampler :: Sampler R (Triangle (Point 2 R))
+sampler = triangleSampler $ targetPolygon :| []
+
+numPoints :: Int
+numPoints = 1000
+
+samples   :: StatefulGen g IO => g -> IO [Point 2 Double]
+samples g = replicateM numPoints (samplePoint sampler g)
+
+main :: IO ()
+main = do
+  pts <- samples globalStdGen
+  let outFp = [osp|foo.ipe|]
+      out   = [ iO $ defIO targetPolygon ]
+               <>
+              [ iO $ defIO p
+              | p <- pts
+              ]
+  writeIpeFile outFp . singlePageFromContent $ out

hgeometry/src/HGeometry/Polygon/Simple/Sample.hs

@@ -1,10 +1,13 @@
 module HGeometry.Polygon.Simple.Sample
   ( samplePolygon
   , samplePolygons
+
+  , Sampler
+  , samplePoint
+  , triangleSampler
   ) where
 
 import           Control.Lens
-import qualified Data.Foldable as F
 import           Data.Foldable1
 import qualified Data.List.NonEmpty as NonEmpty
 import qualified Data.Map as Map
@@ -39,8 +42,8 @@ data Weighted w v = Weighted !w v deriving (Show)
 -- O(n)
 buildSampler    :: (Foldable1 nonEmpty, Num w, Ord w) => nonEmpty (w, v) -> Sampler w v
 buildSampler xs = let Weighted total xs'       = foldr f (Weighted 0 []) xs
-                      f (w,x) (Weighted t acc) = Weighted (w+t) ((w,x):acc)
-                  in Sampler total (Map.fromAscList xs')
+                      f (w,x) (Weighted t acc) = Weighted (w+t) ((t,x):acc)
+                  in Sampler total (Map.fromDescList xs')
 
 -- | Sample a value from the sampler
 --