-- shall this also export Graph.Type, set plotType and so on?
module Graphics.Gnuplot.Plot.TwoDimensional (
   T,

   list,
   function,
   functions,
   functionsWithLineSpec,
   parameterFunction,

   listFromFile,
   pathFromFile,

   linearScale,
   functionToGraph,
   ) where

import qualified Graphics.Gnuplot.Private.Graph2DType as Type
import qualified Graphics.Gnuplot.Private.Graph2D as Graph
import qualified Graphics.Gnuplot.Private.Plot    as Plot
import qualified Graphics.Gnuplot.Private.LineSpecification as LineSpec
import qualified Graphics.Gnuplot.Value.ColumnSet as Col
import qualified Graphics.Gnuplot.Value.Tuple as Tuple
import qualified Graphics.Gnuplot.Value.Atom  as Atom

import Graphics.Gnuplot.Utility
   (functionToGraph, linearScale, assembleCells, )

import qualified Data.List.Match as Match
import qualified Data.List.HT as ListHT


{- |
Plots can be assembled using 'mappend' or 'mconcat'.
You can alter attributes of embedded graphs using 'fmap'.
-}
type T x y = Plot.T (Graph.T x y)


-- * computed plots

{- |
> list Type.listLines (take 30 (let fibs = 0 : 1 : zipWith (+) fibs (tail fibs) in fibs))
> list Type.lines (take 30 (let fibs0 = 0 : fibs1; fibs1 = 1 : zipWith (+) fibs0 fibs1 in zip fibs0 fibs1))
-}
list ::
   (Atom.C x, Atom.C y, Tuple.C a) =>
   Type.T x y a -> [a] -> T x y
list :: T x y a -> [a] -> T x y
list T x y a
typ [a]
ps =
   String -> [T x y] -> T x y
forall graph. String -> [graph] -> T graph
Plot.withUniqueFile
      ([[ShowS]] -> String
assembleCells ((a -> [ShowS]) -> [a] -> [[ShowS]]
forall a b. (a -> b) -> [a] -> [b]
map a -> [ShowS]
forall a. C a => a -> [ShowS]
Tuple.text [a]
ps))
      [T x y a -> Columns -> T x y
forall x y a. T x y a -> Columns -> T x y
Graph.deflt T x y a
typ
         [Int
1 .. case T x y a -> ColumnCount a
forall a x y. C a => T x y a -> ColumnCount a
Type.tupleSize T x y a
typ of Tuple.ColumnCount Int
n -> Int
n]]

{- |
> function Type.line (linearScale 1000 (-10,10)) sin
-}
function ::
   (Atom.C x, Atom.C y,
    Tuple.C a, Tuple.C b) =>
   Type.T x y (a,b) -> [a] -> (a -> b) -> T x y
function :: T x y (a, b) -> [a] -> (a -> b) -> T x y
function T x y (a, b)
typ [a]
args a -> b
f =
   T x y (a, b) -> [(a, b)] -> T x y
forall x y a. (C x, C y, C a) => T x y a -> [a] -> T x y
list T x y (a, b)
typ ([a] -> (a -> b) -> [(a, b)]
forall x y. [x] -> (x -> y) -> [(x, y)]
functionToGraph [a]
args a -> b
f)

{- |
> functions Type.line (linearScale 1000 (-10,10)) [sin, cos]
-}
functions ::
   (Atom.C x, Atom.C y,
    Tuple.C a, Tuple.C b) =>
   Type.T x y (a,b) -> [a] -> [a -> b] -> T x y
functions :: T x y (a, b) -> [a] -> [a -> b] -> T x y
functions T x y (a, b)
typ [a]
args =
   T x y (a, b) -> [a] -> [(T, a -> b)] -> T x y
forall x y a b.
(C x, C y, C a, C b) =>
T x y (a, b) -> [a] -> [(T, a -> b)] -> T x y
functionsWithLineSpec T x y (a, b)
typ [a]
args ([(T, a -> b)] -> T x y)
-> ([a -> b] -> [(T, a -> b)]) -> [a -> b] -> T x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> b) -> (T, a -> b)) -> [a -> b] -> [(T, a -> b)]
forall a b. (a -> b) -> [a] -> [b]
map ((,) T
LineSpec.deflt)

{- |
> functionsWithLineSpec Type.line (linearScale 1000 (-10,10)) $
>    map (mapFst (flip LineSpec.title LineSpec.deflt)) [("sin", sin), ("cos", cos)]
-}
functionsWithLineSpec ::
   (Atom.C x, Atom.C y,
    Tuple.C a, Tuple.C b) =>
   Type.T x y (a,b) -> [a] -> [(LineSpec.T, a -> b)] -> T x y
functionsWithLineSpec :: T x y (a, b) -> [a] -> [(T, a -> b)] -> T x y
functionsWithLineSpec T x y (a, b)
typ [a]
args [(T, a -> b)]
fs =
   let dat :: [(a, [b])]
dat = (a -> (a, [b])) -> [a] -> [(a, [b])]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> (a
x, ((T, a -> b) -> b) -> [(T, a -> b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
x) ((a -> b) -> b) -> ((T, a -> b) -> a -> b) -> (T, a -> b) -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T, a -> b) -> a -> b
forall a b. (a, b) -> b
snd) [(T, a -> b)]
fs)) [a]
args
       mapType :: (a -> b) -> Type.T x y a -> Type.T x y b
       mapType :: (a -> b) -> T x y a -> T x y b
mapType a -> b
_ (Type.Cons String
str) = String -> T x y b
forall x y a. String -> T x y a
Type.Cons String
str
       Tuple.ColumnCount Int
na = T x y a -> ColumnCount a
forall a x y. C a => T x y a -> ColumnCount a
Type.tupleSize (T x y a -> ColumnCount a) -> T x y a -> ColumnCount a
forall a b. (a -> b) -> a -> b
$ ((a, b) -> a) -> T x y (a, b) -> T x y a
forall a b x y. (a -> b) -> T x y a -> T x y b
mapType (a, b) -> a
forall a b. (a, b) -> a
fst T x y (a, b)
typ
       Tuple.ColumnCount Int
nb = T x y b -> ColumnCount b
forall a x y. C a => T x y a -> ColumnCount a
Type.tupleSize (T x y b -> ColumnCount b) -> T x y b -> ColumnCount b
forall a b. (a -> b) -> a -> b
$ ((a, b) -> b) -> T x y (a, b) -> T x y b
forall a b x y. (a -> b) -> T x y a -> T x y b
mapType (a, b) -> b
forall a b. (a, b) -> b
snd T x y (a, b)
typ
   in  String -> [T x y] -> T x y
forall graph. String -> [graph] -> T graph
Plot.withUniqueFile
          ([[ShowS]] -> String
assembleCells
              (((a, [b]) -> [ShowS]) -> [(a, [b])] -> [[ShowS]]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
a,[b]
b) -> a -> [ShowS]
forall a. C a => a -> [ShowS]
Tuple.text a
a [ShowS] -> [ShowS] -> [ShowS]
forall a. [a] -> [a] -> [a]
++ (b -> [ShowS]) -> [b] -> [ShowS]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap b -> [ShowS]
forall a. C a => a -> [ShowS]
Tuple.text [b]
b) [(a, [b])]
dat))
          ([(T, a -> b)] -> [T x y] -> [T x y]
forall b a. [b] -> [a] -> [a]
Match.take [(T, a -> b)]
fs ([T x y] -> [T x y]) -> [T x y] -> [T x y]
forall a b. (a -> b) -> a -> b
$
           ((T, a -> b) -> Columns -> T x y)
-> [(T, a -> b)] -> [Columns] -> [T x y]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
              (\(T
lineSpec,a -> b
_f) Columns
ns ->
                 T -> T x y -> T x y
forall x y. T -> T x y -> T x y
Graph.lineSpec T
lineSpec (T x y -> T x y) -> T x y -> T x y
forall a b. (a -> b) -> a -> b
$ T x y (a, b) -> Columns -> T x y
forall x y a. T x y a -> Columns -> T x y
Graph.deflt T x y (a, b)
typ ([Int
1..Int
na] Columns -> Columns -> Columns
forall a. [a] -> [a] -> [a]
++ Columns
ns))
              [(T, a -> b)]
fs ([Columns] -> [T x y]) -> [Columns] -> [T x y]
forall a b. (a -> b) -> a -> b
$
           Int -> Columns -> [Columns]
forall a. Int -> [a] -> [[a]]
ListHT.sliceVertical Int
nb [(Int
naInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)..])


{- |
> parameterFunction Type.line (linearScale 1000 (0,2*pi)) (\t -> (sin (2*t), cos t))
-}
parameterFunction ::
   (Atom.C x, Atom.C y,
    Tuple.C a) =>
   Type.T x y a -> [t] -> (t -> a) -> T x y
parameterFunction :: T x y a -> [t] -> (t -> a) -> T x y
parameterFunction T x y a
typ [t]
args t -> a
f = T x y a -> [a] -> T x y
forall x y a. (C x, C y, C a) => T x y a -> [a] -> T x y
list T x y a
typ ((t -> a) -> [t] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map t -> a
f [t]
args)



-- * plot stored data

fromFile ::
   (Atom.C x, Atom.C y) =>
   Type.T x y a -> FilePath -> Col.T a -> T x y
fromFile :: T x y a -> String -> T a -> T x y
fromFile T x y a
typ String
filename (Col.Cons Columns
cs) =
   String -> [T x y] -> T x y
forall graph. String -> [graph] -> T graph
Plot.fromGraphs String
filename [T x y a -> Columns -> T x y
forall x y a. T x y a -> Columns -> T x y
Graph.deflt T x y a
typ Columns
cs]

listFromFile ::
   (Atom.C i, Atom.C y) =>
   Type.T i y y -> FilePath -> Int -> T i y
listFromFile :: T i y y -> String -> Int -> T i y
listFromFile T i y y
typ String
filename Int
column =
   T i y y -> String -> T y -> T i y
forall x y a. (C x, C y) => T x y a -> String -> T a -> T x y
fromFile T i y y
typ String
filename (Int -> T y
forall a. C a => Int -> T a
Col.atom Int
column)

pathFromFile ::
   (Atom.C x, Atom.C y) =>
   Type.T x y (x,y) -> FilePath -> Int -> Int -> T x y
pathFromFile :: T x y (x, y) -> String -> Int -> Int -> T x y
pathFromFile T x y (x, y)
typ String
filename Int
columnX Int
columnY =
   T x y (x, y) -> String -> T (x, y) -> T x y
forall x y a. (C x, C y) => T x y a -> String -> T a -> T x y
fromFile T x y (x, y)
typ String
filename (T x -> T y -> T (x, y)
forall a b. T a -> T b -> T (a, b)
Col.pair (Int -> T x
forall a. C a => Int -> T a
Col.atom Int
columnX) (Int -> T y
forall a. C a => Int -> T a
Col.atom Int
columnY))