ActivationZigzag.hs

module Moonlight.Planar.Example.ActivationZigzag
  ( ActivationZigzagExampleError (..)
  , squareLoopAcrossDepths
  ) where

import Data.Bifunctor (first)
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NonEmpty
import Data.Vector qualified as Vector
import Moonlight.Homology.Chain (HomologicalDegree (..))
import Moonlight.Planar.Point (Point (..))
import Moonlight.Planar.Scalar (RadiusSquaredError, mkRadiusSquared)
import Moonlight.Planar.Zigzag
  ( ActivationInterval
  , ActivationPoint (..)
  , ActivationSlice (..)
  , ActivationZigzagError
  , ZigzagInterval (..)
  , activationAlphaPersistence
  )

data ActivationZigzagExampleError
  = ActivationRadiusFailed !RadiusSquaredError
  | ActivationPersistenceFailed !(ActivationZigzagError Int String)
  deriving stock (Eq, Show)

-- | Observe a square before its boundary appears, while it carries one loop,
-- and after its two Delaunay faces fill that loop.  The returned interval uses
-- the expanded observation/union stages rather than pretending the slices are
-- a monotone filtration.
squareLoopAcrossDepths :: Either ActivationZigzagExampleError [ActivationInterval Int]
squareLoopAcrossDepths = do
  let depths :: NonEmpty Int
      depths = 0 :| [1, 2]
  thresholds <-
    traverse
      (first ActivationRadiusFailed . mkRadiusSquared . fromIntegral)
      depths
  intervals <-
    first ActivationPersistenceFailed
      ( activationAlphaPersistence
          ( NonEmpty.zipWith
              (\depthValue threshold -> ActivationSlice depthValue threshold squarePoints)
              depths
              thresholds
          )
      )
  pure (filter ((== HomologicalDegree 1) . zigzagIntervalDegree) intervals)

squarePoints :: Vector.Vector (ActivationPoint String)
squarePoints =
  Vector.fromList
    [ ActivationPoint "south-west" (Point (-1) (-1))
    , ActivationPoint "south-east" (Point 1 (-1))
    , ActivationPoint "north-east" (Point 1 1)
    , ActivationPoint "north-west" (Point (-1) 1)
    ]