{-|
Module      : Reanimate.Builtin.TernaryPlot
Copyright   : Written by David Himmelstrup
License     : Unlicense
Maintainer  : lemmih@gmail.com
Stability   : experimental
Portability : POSIX

Implementation of ternary plots: <https://en.wikipedia.org/wiki/Ternary_plot>

-}
module Reanimate.Builtin.TernaryPlot
  ( ACoord
  , BCoord
  , CCoord
  , ternaryPlot
  -- , atCenter
  -- , radius
  , toCartesianCoords
  , toOffsetCartesianCoords
  , fromCartesianCoords
  ) where

import           Codec.Picture    (PixelRGBA8 (..), generateImage)
import           Graphics.SvgTree (Tree)
import           Reanimate.Raster (embedImage)
import           Reanimate.Svg    (flipYAxis, scaleToWidth, translate)

-- a+b+c=1
-- | Left-most coordinate.
type ACoord = Double
-- | Top-most coordinate.
type BCoord = Double
-- | Right-most coordinate.
type CCoord = Double

-- | Creates a centered ternary plot with a width of 5.
--
--   Example:
--
-- @
-- 'ternaryPlot' 100 $ \\aCoord bCoord cCoord -> 'Codec.Picture.Types.promotePixel' $
--   let red   = round $ aCoord*255
--       green = round $ bCoord*255
--       blue  = round $ cCoord*255
--   in PixelRGB8 red green blue
-- @
--
--   <<docs/gifs/doc_ternaryPlot.gif>>
ternaryPlot :: Int -- ^ Pixels in the X-axis. More pixels => higher quality.
            -> (ACoord -> BCoord -> CCoord -> PixelRGBA8)
            -- ^ a+b+c=1. A=1 is the left-most position,
            --   B=1 is the top-most position, and
            --   C=1 is the right-most position.
            -> Tree
ternaryPlot :: Int -> (ACoord -> ACoord -> ACoord -> PixelRGBA8) -> Tree
ternaryPlot Int
density ACoord -> ACoord -> ACoord -> PixelRGBA8
fn =
    ACoord -> Tree -> Tree
scaleToWidth ACoord
stdWidth (Tree -> Tree) -> Tree -> Tree
forall a b. (a -> b) -> a -> b
$
    ACoord -> ACoord -> Tree -> Tree
translate (-ACoord
cX) (-ACoord
cY) (Tree -> Tree) -> Tree -> Tree
forall a b. (a -> b) -> a -> b
$
    ACoord -> Tree -> Tree
scaleToWidth ACoord
1 (Tree -> Tree) -> Tree -> Tree
forall a b. (a -> b) -> a -> b
$
    Tree -> Tree
flipYAxis (Tree -> Tree) -> Tree -> Tree
forall a b. (a -> b) -> a -> b
$
    ACoord -> ACoord -> Tree -> Tree
translate (Int -> ACoord
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
densityACoord -> ACoord -> ACoord
forall a. Fractional a => a -> a -> a
/ACoord
2) (-Int -> ACoord
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
heightACoord -> ACoord -> ACoord
forall a. Fractional a => a -> a -> a
/ACoord
2) (Tree -> Tree) -> Tree -> Tree
forall a b. (a -> b) -> a -> b
$
    Image PixelRGBA8 -> Tree
forall a. PngSavable a => Image a -> Tree
embedImage (Image PixelRGBA8 -> Tree) -> Image PixelRGBA8 -> Tree
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> PixelRGBA8) -> Int -> Int -> Image PixelRGBA8
forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
generateImage Int -> Int -> PixelRGBA8
forall a a. (Integral a, Integral a) => a -> a -> PixelRGBA8
gen Int
density Int
height
  where
    stdWidth :: ACoord
stdWidth = ACoord
5
    (ACoord
cX, ACoord
cY) = ACoord -> ACoord -> (ACoord, ACoord)
toCartesianCoords (ACoord
1ACoord -> ACoord -> ACoord
forall a. Fractional a => a -> a -> a
/ACoord
3) (ACoord
1ACoord -> ACoord -> ACoord
forall a. Fractional a => a -> a -> a
/ACoord
3)
    height :: Int
height = ACoord -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Int -> ACoord
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
density ACoord -> ACoord -> ACoord
forall a. Num a => a -> a -> a
* (ACoord -> ACoord
forall a. Floating a => a -> a
sqrt ACoord
3 ACoord -> ACoord -> ACoord
forall a. Fractional a => a -> a -> a
/ ACoord
2) :: Double)
    gen :: a -> a -> PixelRGBA8
gen a
x a
y =
      let
          x' :: ACoord
x' = (a -> ACoord
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x ACoord -> ACoord -> ACoord
forall a. Fractional a => a -> a -> a
/ Int -> ACoord
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
density)
          y' :: ACoord
y' = (a -> ACoord
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y ACoord -> ACoord -> ACoord
forall a. Fractional a => a -> a -> a
/ Int -> ACoord
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
density)
          aCoord :: ACoord
aCoord = (ACoord
x'ACoord -> ACoord -> ACoord
forall a. Num a => a -> a -> a
*ACoord
2ACoord -> ACoord -> ACoord
forall a. Num a => a -> a -> a
-ACoord
bCoord)ACoord -> ACoord -> ACoord
forall a. Fractional a => a -> a -> a
/ACoord
2
          bCoord :: ACoord
bCoord = ACoord
y' ACoord -> ACoord -> ACoord
forall a. Fractional a => a -> a -> a
/ (ACoord -> ACoord
forall a. Floating a => a -> a
sqrt ACoord
3 ACoord -> ACoord -> ACoord
forall a. Fractional a => a -> a -> a
/ ACoord
2)
          cCoord :: ACoord
cCoord = ACoord
1 ACoord -> ACoord -> ACoord
forall a. Num a => a -> a -> a
- ACoord
aCoord ACoord -> ACoord -> ACoord
forall a. Num a => a -> a -> a
- ACoord
bCoord
      in if ACoord
aCoord ACoord -> ACoord -> ACoord
forall a. Num a => a -> a -> a
+ ACoord
bCoord ACoord -> ACoord -> Bool
forall a. Ord a => a -> a -> Bool
> ACoord
1 Bool -> Bool -> Bool
|| ACoord
aCoord ACoord -> ACoord -> Bool
forall a. Ord a => a -> a -> Bool
< ACoord
0 Bool -> Bool -> Bool
|| ACoord
bCoord ACoord -> ACoord -> Bool
forall a. Ord a => a -> a -> Bool
< ACoord
0 Bool -> Bool -> Bool
|| ACoord
cCoord ACoord -> ACoord -> Bool
forall a. Ord a => a -> a -> Bool
< ACoord
0
        then Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 Pixel8
0 Pixel8
0 Pixel8
0 Pixel8
0
        else ACoord -> ACoord -> ACoord -> PixelRGBA8
fn ACoord
aCoord ACoord
bCoord ACoord
cCoord

-- atCenter :: Double -> Tree -> Tree
-- atCenter stdWidth = translate (-cX*stdWidth) (-cY*stdWidth)
--   where
--     (cX, cY) = toCartesianCoords (1/3) (1/3)

-- radius :: Double
-- radius = sqrt (cX*cX + cY*cY)
--   where
--     (cX, cY) = toCartesianCoords (1/3) (1/3)

-- | Compute the XY coordinates from ternary coordinates.
--   Note that @CCoord@ is given because @a+b+c=1@.
toCartesianCoords :: ACoord -> BCoord -> (Double, Double)
toCartesianCoords :: ACoord -> ACoord -> (ACoord, ACoord)
toCartesianCoords ACoord
a ACoord
b = (ACoord
x, ACoord
y)
  where
    x :: ACoord
x = (ACoord
aACoord -> ACoord -> ACoord
forall a. Num a => a -> a -> a
+ACoord
2ACoord -> ACoord -> ACoord
forall a. Num a => a -> a -> a
*ACoord
b)ACoord -> ACoord -> ACoord
forall a. Fractional a => a -> a -> a
/ACoord
2
    y :: ACoord
y = (ACoord -> ACoord
forall a. Floating a => a -> a
sqrt ACoord
3 ACoord -> ACoord -> ACoord
forall a. Fractional a => a -> a -> a
/ ACoord
2) ACoord -> ACoord -> ACoord
forall a. Num a => a -> a -> a
* ACoord
a

-- | Compute the XY coordinates relative from the center of the
--   ternary plot.
--   Note that @CCoord@ is given because @a+b+c=1@.
toOffsetCartesianCoords :: ACoord -> BCoord -> (Double, Double)
toOffsetCartesianCoords :: ACoord -> ACoord -> (ACoord, ACoord)
toOffsetCartesianCoords ACoord
a ACoord
b =
    (ACoord
txACoord -> ACoord -> ACoord
forall a. Num a => a -> a -> a
-ACoord
zx, ACoord
tyACoord -> ACoord -> ACoord
forall a. Num a => a -> a -> a
-ACoord
zy)
  where
    (ACoord
zx,ACoord
zy) = ACoord -> ACoord -> (ACoord, ACoord)
toCartesianCoords (ACoord
1ACoord -> ACoord -> ACoord
forall a. Fractional a => a -> a -> a
/ACoord
3) (ACoord
1ACoord -> ACoord -> ACoord
forall a. Fractional a => a -> a -> a
/ACoord
3)
    (ACoord
tx,ACoord
ty) = ACoord -> ACoord -> (ACoord, ACoord)
toCartesianCoords ACoord
a ACoord
b

-- | Compute ternary coordinates from XY coordinates.
fromCartesianCoords :: Double -> Double -> (ACoord, BCoord, CCoord)
fromCartesianCoords :: ACoord -> ACoord -> (ACoord, ACoord, ACoord)
fromCartesianCoords ACoord
x ACoord
y = (ACoord
a,ACoord
b,ACoord
1ACoord -> ACoord -> ACoord
forall a. Num a => a -> a -> a
-ACoord
aACoord -> ACoord -> ACoord
forall a. Num a => a -> a -> a
-ACoord
b)
  where
    a :: ACoord
a = (ACoord
xACoord -> ACoord -> ACoord
forall a. Num a => a -> a -> a
*ACoord
2ACoord -> ACoord -> ACoord
forall a. Num a => a -> a -> a
-ACoord
b)ACoord -> ACoord -> ACoord
forall a. Fractional a => a -> a -> a
/ACoord
2
    b :: ACoord
b = ACoord
y ACoord -> ACoord -> ACoord
forall a. Fractional a => a -> a -> a
/ (ACoord -> ACoord
forall a. Floating a => a -> a
sqrt ACoord
3 ACoord -> ACoord -> ACoord
forall a. Fractional a => a -> a -> a
/ ACoord
2)