Safe Haskell | None |
---|---|
Language | Haskell98 |
- type Function = Double -> Double
- type Range = (Double, Double)
- class Plot a
- class Plot plot => EditPlot plot function | plot -> function where
- (.+) :: EditPlot p f => p -> f -> p
- (.-) :: EditPlot p f => p -> Range -> p
- (.|) :: EditPlot p f => p -> Range -> p
- data XYPlot = XYPlot {}
- emptyXYPlot :: XYPlot
- data ParamXYPlot = ParamXYPlot {}
- data ParamFunction = ParamFunction {}
- emptyParamXYPlot :: ParamXYPlot
- data PolarPlot = PolarPlot {}
- data PolarFunction = PolarFunction {}
- emptyPolarPlot :: PolarPlot
- data PlotConfig = PlotConfig {}
- defaultConfig :: PlotConfig
- plot :: Plot p => p -> String
- plotWithConfig :: Plot p => PlotConfig -> p -> String
- printPlot :: Plot p => p -> IO ()
Data types
Any kind of of plot.
draw
class Plot plot => EditPlot plot function | plot -> function where Source
A type class with functional dependency to allow the same editing operations across all plot types.
(.+) :: EditPlot p f => p -> f -> p Source
Shortcut to thenPlot
. Mnemonics: plus to add another function.
(.-) :: EditPlot p f => p -> Range -> p Source
Shortcut to xlim
. Mnemonics: horizontal bar followed by horizontal range.
(.|) :: EditPlot p f => p -> Range -> p Source
Shortcut to ylim
. Mnemonics: vertical bar followed by vertical range.
Plot types
Plot one or more functions (x -> y
) in Cartesian coordinates.
A default empty XYPlot
with bounds of a unit square.
data ParamXYPlot Source
Plot one or more parametric functions in Cartesian coordiantes.
ParamXYPlot | |
|
emptyParamXYPlot :: ParamXYPlot Source
A default empty ParamXYPlot
Plot one or more functions in polar coordinates.
PolarPlot | |
|
emptyPolarPlot :: PolarPlot Source
A default empty PolarPlot
Screen representation
defaultConfig :: PlotConfig Source
Default plot dimensions, suitable for 80x24 terminals.
Output
plotWithConfig :: Plot p => PlotConfig -> p -> String Source
Convert a plot to multiline String
with custom configuration
Example
Plot a mexican hat wavelet function:
ghci> let hat t = 0.5*(1-t**2)*exp(-0.5*t**2)/(sqrt (3*(sqrt pi))) ghci> let plot = emptyXYPlot .+ hat .- (-5,5) .| (-0.125,0.25) ghci> printPlot plot ^ 0.25 + | | ooo | o o | | o o | | | o o | | o o | | |oooooooooooo o o ooooooooooo | oo oo | oo o o oo | o o o o | ooo o o ooo | o o -0.125 + +-----------------------------------------------------------+-> -5.0 5.0
A parametric plot:
ghci> let circle = ParamFunction sin cos (0,2*pi) ghci> let paramplot = emptyParamXYPlot `thenPlot` circle `xlim` (-1.1,1.1) `ylim` (-1.1,1.1) ghci> printPlot paramplot ^ 1.1 + | ooooooooooooooooooooo | ooooooo ooooooo | oooo oooo | ooo ooo | ooo ooo | oo oo | o o | o o | o o | o o | o o | o o | oo oo | oo oo | ooo ooo | ooooo ooooo | ooooo ooooo | ooooooooooooooooooooo -1.1 + +-----------------------------------------------------------+-> -1.1 1.1