module Numeric.Probability.Visualize where

import qualified Numeric.Probability.Random as Rnd
import Numeric.Probability.Expectation
    (ToFloat, FromFloat, toFloat, fromFloat, )
import Numeric.Probability.Percentage
    (Dist, RDist, )
import Numeric.Probability.PrintList (asTuple, )

import qualified Numeric.Probability.Distribution as Dist

import Control.Monad (when, )
import Data.List (nub, sort, )


{- TO DO:

* Change function representation in Plot to
    xs :: [Float]
    ys :: [Float]
  and add functions to create this representation from
   functions, distributions, and lists
   (i.e. plotF, plotD, plotL)

-}


-- | global settings for one figure
--
data FigureEnv = FE { FigureEnv -> String
fileName :: String,
                      FigureEnv -> String
title    :: String,
                      FigureEnv -> String
xLabel   :: String,
                      FigureEnv -> String
yLabel   :: String }
                 deriving Int -> FigureEnv -> ShowS
[FigureEnv] -> ShowS
FigureEnv -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FigureEnv] -> ShowS
$cshowList :: [FigureEnv] -> ShowS
show :: FigureEnv -> String
$cshow :: FigureEnv -> String
showsPrec :: Int -> FigureEnv -> ShowS
$cshowsPrec :: Int -> FigureEnv -> ShowS
Show

-- | default settings for figure environment
--
figure :: FigureEnv
figure :: FigureEnv
figure = FE { fileName :: String
fileName = String
"FuSE.R",
              title :: String
title    = String
"Output",
              xLabel :: String
xLabel   = String
"x",
              yLabel :: String
yLabel   = String
"f(x)" }


-- * types to represent settings for individual plots
--
data Color = Black | Blue | Green | Red | Brown | Gray
           | Purple | DarkGray | Cyan | LightGreen | Magenta
           | Orange | Yellow | White | Custom Int Int Int
           deriving Color -> Color -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c== :: Color -> Color -> Bool
Eq

instance Show Color where
  show :: Color -> String
show Color
Black      = String
"\"black\""
  show Color
Blue       = String
"\"blue\""
  show Color
Green      = String
"\"green\""
  show Color
Red        = String
"\"red\""
  show Color
Brown      = String
"\"brown\""
  show Color
Gray       = String
"\"gray\""
  show Color
Purple     = String
"\"purple\""
  show Color
DarkGray   = String
"\"darkgray\""
  show Color
Cyan       = String
"\"cyan\""
  show Color
LightGreen = String
"\"lightgreen\""
  show Color
Magenta    = String
"\"magenta\""
  show Color
Orange     = String
"\"orange\""
  show Color
Yellow     = String
"\"yellow\""
  show Color
White      = String
"\"white\""
  show (Custom Int
r Int
g Int
b) = String
"rgb("forall a. [a] -> [a] -> [a]
++(forall a. Show a => a -> String
show Int
r)forall a. [a] -> [a] -> [a]
++String
", "forall a. [a] -> [a] -> [a]
++(forall a. Show a => a -> String
show Int
g)forall a. [a] -> [a] -> [a]
++String
", "forall a. [a] -> [a] -> [a]
++(forall a. Show a => a -> String
show Int
b)forall a. [a] -> [a] -> [a]
++String
")"

data LineStyle = Solid | Dashed | Dotted | DotDash | LongDash | TwoDash
                 deriving LineStyle -> LineStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineStyle -> LineStyle -> Bool
$c/= :: LineStyle -> LineStyle -> Bool
== :: LineStyle -> LineStyle -> Bool
$c== :: LineStyle -> LineStyle -> Bool
Eq

instance Show LineStyle where
  show :: LineStyle -> String
show LineStyle
Solid    = String
"1"
  show LineStyle
Dashed   = String
"2"
  show LineStyle
Dotted   = String
"3"
  show LineStyle
DotDash  = String
"4"
  show LineStyle
LongDash = String
"5"
  show LineStyle
TwoDash  = String
"6"

type PlotFun = Float -> Float


-- | settings for individual plots
--
data Plot = Plot { Plot -> [Float]
ys        :: [Float],
                   Plot -> [Float]
xs        :: [Float],
                   Plot -> Color
color     :: Color,
                   Plot -> LineStyle
lineStyle :: LineStyle,
                   Plot -> Int
lineWidth :: Int,
                   Plot -> String
label     :: String }

{-
instance Show Plot where
  show _ = "Individual plots cannot be printed.\nPlease use plots \
            \ as arguments to the fig function."
-}


-- | default plotting environment
--
plot :: Plot
plot :: Plot
plot = Plot { ys :: [Float]
ys        = [Float
0],
              xs :: [Float]
xs        = [Float
0],
              color :: Color
color     = Color
Black,
              lineStyle :: LineStyle
lineStyle = LineStyle
Solid,
              lineWidth :: Int
lineWidth = Int
1,
              label :: String
label     = String
"" }

colors :: [Color]
colors :: [Color]
colors = [Color
Blue,Color
Green,Color
Red,Color
Purple,Color
Black,Color
Orange,Color
Brown,Color
Yellow]

setColor :: Plot -> Color -> Plot
setColor :: Plot -> Color -> Plot
setColor Plot
p Color
c = Plot
p{color :: Color
color=Color
c}

autoColor :: [Plot] -> [Plot]
autoColor :: [Plot] -> [Plot]
autoColor [Plot]
ps | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Plot]
ps forall a. Ord a => a -> a -> Bool
<= Int
n = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Plot -> Color -> Plot
setColor [Plot]
ps [Color]
colors
             | Bool
otherwise      = forall a. HasCallStack => String -> a
error (String
"autoColor works for no more than "forall a. [a] -> [a] -> [a]
++
                                       forall a. Show a => a -> String
show Int
nforall a. [a] -> [a] -> [a]
++String
" plots.")
                                where n :: Int
n=forall (t :: * -> *) a. Foldable t => t a -> Int
length [Color]
colors

-- | create a plot from a distribution
--
plotD :: ToFloat a => Dist a -> Plot
--plotD d = plot{ys = map (\x->(dp $ prob' x d')) (extract d'),
--		xs = extract d'}
plotD :: forall a. ToFloat a => Dist a -> Plot
plotD Dist a
d =
   let ([Float]
tfl, [Float]
pdl) =
          forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall a prob. Ord a => [(a, prob)] -> [(a, prob)]
Dist.sortElem forall a b. (a -> b) -> a -> b
$
          forall prob a. (Num prob, Ord a) => [(a, prob)] -> [(a, prob)]
Dist.norm' (forall a b. (a -> b) -> [a] -> [b]
map (\(a
x,T
p) -> (forall a. ToFloat a => a -> Float
toFloat a
x, forall a. ToFloat a => a -> Float
toFloat T
p)) (forall prob a. T prob a -> [(a, prob)]
Dist.decons Dist a
d))
   in  Plot
plot{xs :: [Float]
xs = [Float]
tfl, ys :: [Float]
ys = [Float]
pdl}


plotRD :: ToFloat a => RDist a -> IO Plot
plotRD :: forall a. ToFloat a => RDist a -> IO Plot
plotRD RDist a
a = forall a. T a -> IO a
Rnd.run (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToFloat a => Dist a -> Plot
plotD RDist a
a)

-- | create a plot from a function
--
plotF :: (FromFloat a,ToFloat b) => (Float,Float,Float) -> (a -> b) -> Plot
plotF :: forall a b.
(FromFloat a, ToFloat b) =>
(Float, Float, Float) -> (a -> b) -> Plot
plotF (Float, Float, Float)
xd a -> b
g = Plot
plot{ys :: [Float]
ys = forall a b. (a -> b) -> [a] -> [b]
map (\Float
x->forall a. ToFloat a => a -> Float
toFloat (a -> b
g (forall a. FromFloat a => Float -> a
fromFloat Float
x))) (forall {c}. (Ord c, Num c) => (c, c, c) -> [c]
xvals (Float, Float, Float)
xd),xs :: [Float]
xs = forall {c}. (Ord c, Num c) => (c, c, c) -> [c]
xvals (Float, Float, Float)
xd}
                  where xvals :: (c, c, c) -> [c]
xvals (c
a,c
b,c
d) =
                           if c
a forall a. Ord a => a -> a -> Bool
> c
b then [] else c
aforall a. a -> [a] -> [a]
:(c, c, c) -> [c]
xvals (c
aforall a. Num a => a -> a -> a
+c
d,c
b,c
d)

-- | create a plot from a list
--
plotL  :: ToFloat a => [a] -> Plot
plotL :: forall a. ToFloat a => [a] -> Plot
plotL [a]
vs = Plot
plot{ys :: [Float]
ys = forall a b. (a -> b) -> [a] -> [b]
map forall a. ToFloat a => a -> Float
toFloat [a]
vs, xs :: [Float]
xs = forall a b. (a -> b) -> [a] -> [b]
map forall a. ToFloat a => a -> Float
toFloat [Int
1..forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
vs]}


plotRL :: ToFloat a => Rnd.T [a] -> IO Plot
plotRL :: forall a. ToFloat a => T [a] -> IO Plot
plotRL T [a]
a = forall a. T a -> IO a
Rnd.run (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToFloat a => [a] -> Plot
plotL T [a]
a)


--yls :: ToFloat a => [a] -> [Plot] -> [[Float]]
--yls xs (p:ps) = [f p (toFloat v) | v <- xs ]:yls xs ps
--yls _  []     = []

yls :: [Float] -> Plot -> Plot
yls :: [Float] -> Plot -> Plot
yls [Float]
xl Plot
p = Plot
p{xs :: [Float]
xs=[Float]
x', ys :: [Float]
ys=[Float]
y'}
	where 	t :: [(Float, Float)]
t = forall a b. [a] -> [b] -> [(a, b)]
zip (Plot -> [Float]
xs Plot
p) (Plot -> [Float]
ys Plot
p)
		t' :: [(Float, Float)]
t' = [Float] -> [(Float, Float)] -> [(Float, Float)]
metaTuple [Float]
xl [(Float, Float)]
t
		([Float]
x', [Float]
y') = forall a b. [(a, b)] -> ([a], [b])
unzip [(Float, Float)]
t'

metaTuple :: [Float] -> [(Float,Float)] -> [(Float,Float)]
metaTuple :: [Float] -> [(Float, Float)] -> [(Float, Float)]
metaTuple (Float
x:[Float]
xl) ((Float
p,Float
v):[(Float, Float)]
px) | Float
p forall a. Eq a => a -> a -> Bool
== Float
x = (Float
p,Float
v)forall a. a -> [a] -> [a]
:([Float] -> [(Float, Float)] -> [(Float, Float)]
metaTuple [Float]
xl [(Float, Float)]
px)
metaTuple (Float
x:[Float]
xl) p' :: [(Float, Float)]
p'@( (Float
p,Float
_):[(Float, Float)]
_ ) | Float
p forall a. Ord a => a -> a -> Bool
> Float
x = (Float
x,Float
0)forall a. a -> [a] -> [a]
:([Float] -> [(Float, Float)] -> [(Float, Float)]
metaTuple [Float]
xl [(Float, Float)]
p')
metaTuple [Float]
x [] = forall a b. (a -> b) -> [a] -> [b]
map (\Float
v->(Float
v,Float
0)) [Float]
x
metaTuple [Float]
x [(Float, Float)]
y = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ (forall a. Show a => a -> String
show [Float]
x)forall a. [a] -> [a] -> [a]
++(forall a. Show a => a -> String
show [(Float, Float)]
y)

-- | we want to increase the bounds absolutely, account for negative numbers
--
incr, decr :: (Ord a, Fractional a) => a -> a
incr :: forall a. (Ord a, Fractional a) => a -> a
incr a
x =
   if a
x forall a. Ord a => a -> a -> Bool
> a
0
     then a
x forall a. Num a => a -> a -> a
* a
1.05
     else a
x forall a. Num a => a -> a -> a
* a
0.95

decr :: forall a. (Ord a, Fractional a) => a -> a
decr a
x =
   if a
x forall a. Ord a => a -> a -> Bool
> a
0
     then a
x forall a. Num a => a -> a -> a
* a
0.95
     else a
x forall a. Num a => a -> a -> a
* a
1.05

-- | Visualization output
--
type Vis = IO ()


-- * creating figures
--
fig :: [Plot] -> Vis
fig :: [Plot] -> Vis
fig = FigureEnv -> [Plot] -> Vis
figP FigureEnv
figure

figP :: FigureEnv -> [Plot] -> Vis
figP :: FigureEnv -> [Plot] -> Vis
figP FigureEnv
fe [Plot]
ps = do let xl :: [Float]
xl = forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Plot -> [Float]
xs [Plot]
ps
                let minx :: Float
minx = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Float]
xl
--                let maxx = maximum xl
                let n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Float]
xl
                let ys' :: [[Float]]
ys' = forall a b. (a -> b) -> [a] -> [b]
map Plot -> [Float]
ys (forall a b. (a -> b) -> [a] -> [b]
map ([Float] -> Plot -> Plot
yls [Float]
xl) [Plot]
ps) -- yls xl ps
                let miny :: Float
miny = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [[Float]]
ys')
                let maxy :: Float
maxy = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [[Float]]
ys')
                let out0' :: String -> Vis
out0' = String -> String -> Vis
out0 (FigureEnv -> String
fileName FigureEnv
fe)
                let out1' :: String -> Vis
out1' = String -> String -> Vis
out1 (FigureEnv -> String
fileName FigureEnv
fe)
                String -> Vis
out0' (String
"x <- "forall a. [a] -> [a] -> [a]
++(forall a. Show a => [a] -> String
vec [Float]
xl))
                String -> Vis
out1' (String
"y <- "forall a. [a] -> [a] -> [a]
++(forall a. Show a => [a] -> String
vec forall a b. (a -> b) -> a -> b
$ (forall a. (Ord a, Fractional a) => a -> a
decr Float
miny)forall a. a -> [a] -> [a]
:(forall a. Int -> a -> [a]
replicate (Int
nforall a. Num a => a -> a -> a
-Int
1) (forall a. (Ord a, Fractional a) => a -> a
incr Float
maxy))))
                String -> Vis
out1' (String
"plot(x,y,type=\"n\",main=\""forall a. [a] -> [a] -> [a]
++
                        FigureEnv -> String
title  FigureEnv
feforall a. [a] -> [a] -> [a]
++String
"\",xlab=\""forall a. [a] -> [a] -> [a]
++
                        FigureEnv -> String
xLabel FigureEnv
feforall a. [a] -> [a] -> [a]
++String
"\",ylab=\""forall a. [a] -> [a] -> [a]
++
                        FigureEnv -> String
yLabel FigureEnv
feforall a. [a] -> [a] -> [a]
++String
"\")")
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> Vis
out1' (forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 forall a. ToFloat a => Int -> Plot -> [a] -> String
drawy [Int
1 ..] [Plot]
ps [[Float]]
ys')
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Plot -> String
label [Plot]
ps) forall a b. (a -> b) -> a -> b
$
                  String -> Vis
out1' forall a b. (a -> b) -> a -> b
$ Float -> Float -> [Plot] -> String
legend (forall a. (Ord a, Fractional a) => a -> a
incr Float
minx) Float
maxy [Plot]
ps
                String -> Vis
out1' (String
"dev2bitmap(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (FigureEnv -> String
fileName FigureEnv
fe forall a. [a] -> [a] -> [a]
++ String
".pdf") forall a. [a] -> [a] -> [a]
++
                       String
", type=\"pdfwrite\")")


{-
define:
  * autoLabel
  * showParams
-}

showParams :: Show a => [a] -> [String] -> String
showParams :: forall a. Show a => [a] -> [String] -> String
showParams [a]
xs0 [String]
ss =
   forall a. (a -> String) -> [a] -> String
asTuple forall a. a -> a
id (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\a
x String
s-> forall a. Show a => a -> String
show a
xforall a. [a] -> [a] -> [a]
++String
":"forall a. [a] -> [a] -> [a]
++String
s) [a]
xs0 [String]
ss)

legend :: Float -> Float -> [Plot] -> String
legend :: Float -> Float -> [Plot] -> String
legend Float
x Float
y [Plot]
ps = String
"legend("forall a. [a] -> [a] -> [a]
++(forall a. Show a => a -> String
show Float
x)forall a. [a] -> [a] -> [a]
++String
", "forall a. [a] -> [a] -> [a]
++(forall a. Show a => a -> String
show Float
y)forall a. [a] -> [a] -> [a]
++String
","forall a. [a] -> [a] -> [a]
++
                String
"lty="forall a. [a] -> [a] -> [a]
++forall a. Show a => [a] -> String
vec (forall a b. (a -> b) -> [a] -> [b]
map Plot -> LineStyle
lineStyle [Plot]
ps)forall a. [a] -> [a] -> [a]
++String
","forall a. [a] -> [a] -> [a]
++
                String
"col="forall a. [a] -> [a] -> [a]
++forall a. Show a => [a] -> String
vec (forall a b. (a -> b) -> [a] -> [b]
map Plot -> Color
color [Plot]
ps)forall a. [a] -> [a] -> [a]
++String
","forall a. [a] -> [a] -> [a]
++
                String
"lwd="forall a. [a] -> [a] -> [a]
++forall a. Show a => [a] -> String
vec (forall a b. (a -> b) -> [a] -> [b]
map Plot -> Int
lineWidth [Plot]
ps)forall a. [a] -> [a] -> [a]
++String
","forall a. [a] -> [a] -> [a]
++
                String
"legend="forall a. [a] -> [a] -> [a]
++forall a. Show a => [a] -> String
vec (forall a b. (a -> b) -> [a] -> [b]
map Plot -> String
label [Plot]
ps)forall a. [a] -> [a] -> [a]
++String
")"

drawy :: ToFloat a => Int -> Plot -> [a] -> String
drawy :: forall a. ToFloat a => Int -> Plot -> [a] -> String
drawy Int
yn Plot
p [a]
fl = String
"y"forall a. [a] -> [a] -> [a]
++(forall a. Show a => a -> String
show Int
yn)forall a. [a] -> [a] -> [a]
++String
" <- "forall a. [a] -> [a] -> [a]
++(forall a. Show a => [a] -> String
vec (forall a b. (a -> b) -> [a] -> [b]
map forall a. ToFloat a => a -> Float
toFloat [a]
fl))forall a. [a] -> [a] -> [a]
++String
"\n"forall a. [a] -> [a] -> [a]
++
                String
"lines(x,y"forall a. [a] -> [a] -> [a]
++(forall a. Show a => a -> String
show Int
yn)forall a. [a] -> [a] -> [a]
++String
",col="forall a. [a] -> [a] -> [a]
++(forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Plot -> Color
color Plot
p)forall a. [a] -> [a] -> [a]
++String
","forall a. [a] -> [a] -> [a]
++
                String
"lty="forall a. [a] -> [a] -> [a]
++(forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Plot -> LineStyle
lineStyle Plot
p)forall a. [a] -> [a] -> [a]
++String
",lwd="forall a. [a] -> [a] -> [a]
++(forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Plot -> Int
lineWidth Plot
p)forall a. [a] -> [a] -> [a]
++String
")"


vec :: Show a => [a] -> String
vec :: forall a. Show a => [a] -> String
vec [a]
xs0 = String
"c"forall a. [a] -> [a] -> [a]
++forall a. (a -> String) -> [a] -> String
asTuple forall a. Show a => a -> String
show [a]
xs0

out0 :: FilePath -> String -> IO ()
out0 :: String -> String -> Vis
out0 String
f String
s = String -> String -> Vis
writeFile String
f (String
sforall a. [a] -> [a] -> [a]
++String
"\n")

out1 :: FilePath -> String -> IO ()
out1 :: String -> String -> Vis
out1 String
f String
s = String -> String -> Vis
appendFile String
f (String
sforall a. [a] -> [a] -> [a]
++String
"\n")