slightly faster & now with a cli

README.md

@@ -1,7 +1,7 @@
 # image-triangles
 ### examples
-![Sierra mountians original](examples/sierra.jpg)
-![Sierra mountians post-filter](examples/sierra-result.svg)
+![Sierra mountains original](examples/sierra.jpg)
+![Sierra mountains post-filter](examples/sierra-result.svg)
 ![Dog original](examples/luna.jpeg)
 ![Dog post-filter](examples/luna-result.svg)
 
@@ -11,6 +11,5 @@ install [cabal & ghc](https://www.haskell.org/ghcup/) if you don't have them.
 
 ```
 cabal update
-# change input file name in Main.hs line 95-ish
-cabal run image-triangles -- -o output.svg --height 1000 --width 1000
+cabal run image-triangles -- --cornerCount 800 --input examples/sierra.jpg --output output.svg
 ```

image-triangles.cabal

@@ -63,7 +63,9 @@ executable image-triangles
                        MultiParamTypeClasses,
                        OverloadedLabels,
                        TypeFamilies,
+                       TypeOperators,
                        TupleSections,
+                       DeriveGeneric,
                        UndecidableInstances,
                        RecursiveDo,
                        RecordWildCards,
@@ -83,6 +85,7 @@ executable image-triangles
                      , linear
                      , vector
                      , containers
+                     , optparse-generic
 
 
   -- Directories containing source files.

src/Main.hs

@@ -18,7 +18,9 @@ import qualified Debug.Trace as DT
 import qualified System.Environment as Env
 import qualified Data.Map as M
 import qualified Data.Set as S
+import Diagrams.Backend.SVG
 import Triangles (getTriangleAverageRGB)
+import Options.Generic
 import qualified Data.Colour.SRGB as CL
 
 data Options = Options {
@@ -68,35 +70,36 @@ scalePointToImage (ymax, xmax) p = round <$> (p2 (fromIntegral xmax, fromIntegra
 -- derive Generic (RGB Double)
 
 -- genImage :: String -> IO (Diagram B)
-genImage :: FilePath -> IO (QDiagram SVG V2 Double Any)
-genImage name = do
-    let (Options {..}) = defaultOpts
-    gen' <- maybe getStdGen pure gen
-    print gen'
-    image <- Img.readImageRGB VU name
-    let img' = convImage image
-    let dimensions = (rows image, cols image)
-    let triangles =  S.toList . Tri.findTriangles . Tri.toPlanarGraph . take 1000 . map p2 $ corners ++ Tri.randomPoints gen'
-    let triColors =  map (getTriangleAverageRGB img' dimensions . S.map (scalePointToImage dimensions)) $ triangles
-    pure $ reflectY . mconcat $ withStrategy (parListChunk 1000 rseq) $ zipWith Ren.placeTri triangles triColors
+-- genImage :: FilePath -> IO (QDiagram SVG V2 Double Any)
+genImage image gen cornerCount = reflectY . mconcat $ withStrategy (parListChunk 1000 rseq) $ zipWith Ren.placeTri triangles triColors
+  where
+    img' = convImage image
+    dimensions = (rows image, cols image)
+    triangles = S.toList . Tri.findTriangles . Tri.toPlanarGraph . take cornerCount . map p2 $ corners ++ Tri.randomPoints gen
+    triColors = map (getTriangleAverageRGB img' dimensions . S.map (scalePointToImage dimensions)) $ triangles
 
     -- let progressList =  withStrategy (parListChunk 500 rdeepseq) . map (/ (fromIntegral numTriangles)) $ [0.0 .. (fromIntegral numTriangles)]
     -- return $ center . reflectY . mconcat $ zipWith (renderTri img' dimensions) (genList gen'') progressList
 
 
+toDimensionVector image = Diagrams.Prelude.dims $  p2 (fromIntegral $ rows image, fromIntegral $ cols image) .-. p2 (0.0, 0.0)
 
+name = "examples/sierra.jpg"
+
+data CLIOptions = CLIOptions {
+  input :: FilePath,
+  output :: FilePath,
+  cornerCount :: Int
+                       } deriving Generic
+
+instance ParseRecord CLIOptions
 
 main :: IO ()
 main = do
-  gen <- getStdGen
-  -- let diagram :: (QDiagram SVG V2 Double Any) = mconcat . map (strokeLocTrail . uncurry Tri.toLocatedTrail) . Tri.toPlanarGraph . take 40 . map p2 $ corners ++ Tri.randomPoints gen
-  -- let diagram = mconcat . map Ren.toLine . Tri.toPlanarGraph $ [(0,0), (1,2), (0,1), (1,0)]
-  -- let diagram :: (QDiagram SVG V2 Double Any) = mconcat . map Ren.placeTri . S.toList . Tri.findTriangles . Tri.toPlanarGraph . take 15 . map p2 $ corners ++ Tri.randomPoints gen
-  diagram <- genImage "sierra.jpg"
-  mainWith diagram
-
--- cmdArgs <- Env.getArgs
--- case cmdArgs of
---   ["http"] -> putStrLn "here"
---   _ -> mainWith genImage
--- putStrLn "done"
+  CLIOptions{..} <- getRecord "image options"
+  let (Options {gen = gen}) = defaultOpts
+  gen' <- maybe getStdGen pure gen
+  print gen'
+  image <- Img.readImageRGB VU input
+  let diagram = genImage image gen' cornerCount
+  renderSVG output (toDimensionVector image) diagram

src/Triangles.hs

@@ -54,8 +54,9 @@ randomPoints = randomRs ((0,0), (1, 1))
 -- toPlanarGraph :: (V a ~ V2, TrailLike a) => [Point V2 (N a)] -> [(Point P2 Double, Point P2 Double)]
 toPlanarGraph :: (Floating b, Ord b) => [Point V2 b] -> [(Point V2 b, Point V2 b)]
 toPlanarGraph points = -- map (uncurry toLocatedTrail) .
-  removeIntersections . sortOn (uncurry distanceA) . filter (uncurry (/=)) $ (,) <$> points <*> points
+  removeIntersections . take ((numPoints * numPoints) `div` 3) . sortOn (uncurry distanceA) . filter (uncurry (/=)) $ (,) <$> points <*> points
   where
+    numPoints = length points
 
     removeIntersections = foldl' addIfNoIntersection []
 
@@ -73,7 +74,7 @@ findTriangles :: Ord b => [(b, b)] -> S.Set (S.Set b)
 findTriangles edges = S.unions . S.map threeCyclesOf . M.keysSet $ adjacencyMap
   where
 
-    threeCyclesOf node = S.unions
+    threeCyclesOf node = S.filter ((==) 3 . S.size) . S.unions
       . S.map (\x -> S.map (\y ->  S.fromList [node, x, y]) $ S.delete node . S.intersection originalNodeNeighbors . (M.!) adjacencyMap $ x) $ originalNodeNeighbors
       where
         originalNodeNeighbors = fromMaybe S.empty (adjacencyMap M.!? node)
@@ -244,7 +245,7 @@ getTriangleAverageRGB image (y', x') triangle = blendEqually pixels
     where
 
         pixels :: [Pixel_]
-        pixels = catMaybes . map index' $ points
+        pixels = mapMaybe index' points
 
         points :: [(Int, Int)]
         points = getPointsInTriangle image triangle