DcelBench.hs

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NumericUnderscores #-}

-- | Read-side traversal over a finished mesh: ordered line intersection and the
-- circle shape query. Construction here is fixture cost, not the subject.
module Moonlight.Triangulation.DcelBench (benchmarks) where

import BenchSupport (randomPoints, requireRight, timedValue)
import Control.DeepSeq (force)
import Control.Exception (evaluate)
import qualified Data.Vector as V
import Moonlight.Triangulation
import Moonlight.Triangulation.FloodFillIterator (edgesInCircle)
import Moonlight.Triangulation.IntersectionIterator (lineIntersections)

benchmarks :: IO ()
benchmarks = benchmarkQueries 20_000 10_000

benchmarkQueries :: Int -> Int -> IO ()
benchmarkQueries pointCount queryCount = do
  built <- requireRight (delaunay unitElementDefaults (V.fromList (randomPoints 0xbf58476d1ce4e5b9 pointCount)))
  circleEdges <- requireRight (edgesInCircle (buildTriangulation built) (Point 0 0) 0.25)
  queries <-
    requireRight
      (traverse mkQueryPoint (V.fromList (take (2 * queryCount) (randomPoints 0x632be59bd9b4e019 (2 * queryCount)))))
  let triangulation = buildTriangulation built
      total = V.ifoldl' (lineCount triangulation queries queryCount) 0 (V.take queryCount queries)
      shapeTotal = length circleEdges
  _ <- timedValue "line-and-shape-queries" (evaluate (force (total, shapeTotal)))
  pure ()
 where
  lineCount
    :: DelaunayTriangulation (Point)
    -> V.Vector (QueryPoint)
    -> Int
    -> Int
    -> Int
    -> QueryPoint
    -> Int
  lineCount triangulation queries stride !accumulator index from =
    accumulator + length (lineIntersections triangulation from (queries V.! (index + stride)))