Scrap.hs

module Examples.Scrap where

import Linear
import Proton
import Data.Ord
import Data.List
import Data.Profunctor.Distributing
import Proton.Algebraic
import Data.Profunctor.Closed
import Data.Profunctor.Rep
import Debug.Trace
import qualified Data.Map as M
import Data.Distributive
import Control.Applicative
import Data.Functor.Identity
import Data.Profunctor.Reflector

data Species = Setosa | Versicolor | Virginica
  deriving Show

data Measurements = Measurements {getMeasurements :: V4 Float}
  deriving Show


data Flower = Flower {species :: Species, measurements :: Measurements}
  deriving Show

measurementDistance :: Measurements -> Measurements -> Float
measurementDistance (Measurements xs) (Measurements ys) = sum . abs $  xs - ys

classify :: Foldable f => f Flower -> Measurements -> Flower
classify flowers m =
    let Flower species _ = minimumBy (comparing (measurementDistance m . measurements)) flowers
     in Flower species m

aggregate :: Kaleidoscope' Measurements Float
aggregate = iso getMeasurements Measurements . reflected

measureNearest :: AlgebraicLens' Flower Measurements
measureNearest = listLens measurements classify

flower1 :: Flower
flower1 = Flower Versicolor (Measurements (V4 2 3 4 2))

flower2 :: Flower
flower2 = Flower Setosa (Measurements (V4 5 4 3 2.5))

flowers :: [Flower]
flowers = [flower1, flower2, flower1]

mean :: [Float] -> Float
mean [] =  0
mean xs = sum xs / fromIntegral (length xs)

-- compVectors :: (Applicative f) => AlgebraicLens Int (f Int) Int (f Int)
-- compVectors = algebraic pure _ (liftA2 (+))

aggOnIndex :: (s -> a) -> AlgebraicLens s b a b
aggOnIndex f = listLens f (flip const)

test :: IO ()
test = do
    print ()
    -- We can use a list-lens as a setter over a single element
    -- print $ flower1 & measureNearest . aggregate %~ negate

    -- -- We can explicitly compare to a specific result
    -- print $ Measurements [5, 4, 3, 1] & flowers ?. measureNearest
    -- print $ Measurements [5, 4, 3, 1] & measureNearest .* flowers

    -- -- We can provide an aggregator explicitly
    -- print $ mean & (flowers >- measureNearest . aggregate)
    -- print $ flowers & (measureNearest . aggregate *% mean)
    -- print $ flowers & measureNearest . aggregate *% maximum . traceShowId
    -- print . sequenceA $ [V2 1 2, V2 10 20, V2 100 200] & distribute' . compVectors *% const [2, 3, 4]
    -- print $ flower1 & measureNearest . aggregate %~ (+10)
    -- print $ flower1 ^. measureNearest . aggregate
    -- print $ [[1, 2, 3], [3, 4, 5]] & convolving *% mean