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 Int -> Species -> ShowS
[Species] -> ShowS
Species -> String
(Int -> Species -> ShowS)
-> (Species -> String) -> ([Species] -> ShowS) -> Show Species
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Species] -> ShowS
$cshowList :: [Species] -> ShowS
show :: Species -> String
$cshow :: Species -> String
showsPrec :: Int -> Species -> ShowS
$cshowsPrec :: Int -> Species -> ShowS
Show

data Measurements = Measurements {Measurements -> V4 Float
getMeasurements :: V4 Float}
  deriving Int -> Measurements -> ShowS
[Measurements] -> ShowS
Measurements -> String
(Int -> Measurements -> ShowS)
-> (Measurements -> String)
-> ([Measurements] -> ShowS)
-> Show Measurements
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Measurements] -> ShowS
$cshowList :: [Measurements] -> ShowS
show :: Measurements -> String
$cshow :: Measurements -> String
showsPrec :: Int -> Measurements -> ShowS
$cshowsPrec :: Int -> Measurements -> ShowS
Show


data Flower = Flower {Flower -> Species
species :: Species, Flower -> Measurements
measurements :: Measurements}
  deriving Int -> Flower -> ShowS
[Flower] -> ShowS
Flower -> String
(Int -> Flower -> ShowS)
-> (Flower -> String) -> ([Flower] -> ShowS) -> Show Flower
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flower] -> ShowS
$cshowList :: [Flower] -> ShowS
show :: Flower -> String
$cshow :: Flower -> String
showsPrec :: Int -> Flower -> ShowS
$cshowsPrec :: Int -> Flower -> ShowS
Show

measurementDistance :: Measurements -> Measurements -> Float
measurementDistance :: Measurements -> Measurements -> Float
measurementDistance (Measurements xs :: V4 Float
xs) (Measurements ys :: V4 Float
ys) = V4 Float -> Float
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (V4 Float -> Float) -> (V4 Float -> V4 Float) -> V4 Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V4 Float -> V4 Float
forall a. Num a => a -> a
abs (V4 Float -> Float) -> V4 Float -> Float
forall a b. (a -> b) -> a -> b
$  V4 Float
xs V4 Float -> V4 Float -> V4 Float
forall a. Num a => a -> a -> a
- V4 Float
ys

classify :: Foldable f => f Flower -> Measurements -> Flower
classify :: f Flower -> Measurements -> Flower
classify flowers :: f Flower
flowers m :: Measurements
m =
    let Flower species :: Species
species _ = (Flower -> Flower -> Ordering) -> f Flower -> Flower
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy ((Flower -> Float) -> Flower -> Flower -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Measurements -> Measurements -> Float
measurementDistance Measurements
m (Measurements -> Float)
-> (Flower -> Measurements) -> Flower -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flower -> Measurements
measurements)) f Flower
flowers
     in Species -> Measurements -> Flower
Flower Species
species Measurements
m

aggregate :: Kaleidoscope' Measurements Float
aggregate :: p Float Float -> p Measurements Measurements
aggregate = (Measurements -> V4 Float)
-> (V4 Float -> Measurements)
-> Iso Measurements Measurements (V4 Float) (V4 Float)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Measurements -> V4 Float
getMeasurements V4 Float -> Measurements
Measurements (p (V4 Float) (V4 Float) -> p Measurements Measurements)
-> (p Float Float -> p (V4 Float) (V4 Float))
-> p Float Float
-> p Measurements Measurements
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p Float Float -> p (V4 Float) (V4 Float)
forall (p :: * -> * -> *) (f :: * -> *) a b.
(Reflector p, Applicative f) =>
p a b -> p (f a) (f b)
reflected

measureNearest :: AlgebraicLens' Flower Measurements
measureNearest :: p Measurements Measurements -> p Flower Flower
measureNearest = (Flower -> Measurements)
-> ([Flower] -> Measurements -> Flower)
-> p Measurements Measurements
-> p Flower Flower
forall (p :: * -> * -> *) s a b t.
MStrong p =>
(s -> a) -> ([s] -> b -> t) -> Optic p s t a b
listLens Flower -> Measurements
measurements [Flower] -> Measurements -> Flower
forall (f :: * -> *).
Foldable f =>
f Flower -> Measurements -> Flower
classify

flower1 :: Flower
flower1 :: Flower
flower1 = Species -> Measurements -> Flower
Flower Species
Versicolor (V4 Float -> Measurements
Measurements (Float -> Float -> Float -> Float -> V4 Float
forall a. a -> a -> a -> a -> V4 a
V4 2 3 4 2))

flower2 :: Flower
flower2 :: Flower
flower2 = Species -> Measurements -> Flower
Flower Species
Setosa (V4 Float -> Measurements
Measurements (Float -> Float -> Float -> Float -> V4 Float
forall a. a -> a -> a -> a -> V4 a
V4 5 4 3 2.5))

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

mean :: [Float] -> Float
mean :: [Float] -> Float
mean [] =  0
mean xs :: [Float]
xs = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Float]
xs Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Float]
xs)

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

aggOnIndex :: (s -> a) -> AlgebraicLens s b a b
aggOnIndex :: (s -> a) -> AlgebraicLens s b a b
aggOnIndex f :: s -> a
f = (s -> a) -> ([s] -> b -> b) -> Optic p s b a b
forall (p :: * -> * -> *) s a b t.
MStrong p =>
(s -> a) -> ([s] -> b -> t) -> Optic p s t a b
listLens s -> a
f ((b -> [s] -> b) -> [s] -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> [s] -> b
forall a b. a -> b -> a
const)

test :: IO ()
test :: IO ()
test = do
    () -> IO ()
forall a. Show a => a -> IO ()
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