Commits

Sergey Astanin committed 98dedf0

Replace with more reable Array-based implementation.

* rename *Plot types for consistency, rename Draw class to Plot
* separate representation (PlotConfig) from contents (*Plot)
* use the same drawing function for all Plot instances (markPoints)
* simpler automatically derivable Show instances
* use type synonyms (Range, Function) for brevity and readability
* temporary remove insert* functions
* alternating symbols for different functions
* defaults optimized for 80x25 screen

Comments (0)

Files changed (2)

+{-# LANGUAGE TypeSynonymInstances #-}
 --
 -- Copyright (c) William Tennien Murphy 2011
 --
 
 module TextPlot
-(
--- * Types
-Plot(..)
-,emptyPlot
-,PlotParam(..)
-,emptyParamPlot
-,PlotPolar(..)
-,emptyPolarPlot
-,Draw()
--- * Plot functions
-,insertF
-,insertParam
-,insertPolar
--- * Output
-,printPlot
-,drawPlot
-) where
-import Data.List
-import System.IO
+    ( -- * Types
+      Function
+    , Range
+    , XYPlot(..), emptyXYPlot
+    , ParamXYPlot(..), ParamFunction(..), emptyParamXYPlot
+    , PolarPlot(..), PolarFunction(..), emptyPolarPlot
+    -- * Ploting (how to plot)
+    , PlotConfig(..), defaultConfig, Plot()
+    -- * Output
+    , plot
+    , plotWithConfig
+    , printPlot
+    ) where
+
+import Control.Monad (forM_, when)
+import Control.Monad.ST (ST)
+import Data.Array
+import Data.Array.ST
 
 type TextPlot = [[Char]]
 
+-- | Range of values @(from, to)@.
+type Range = (Double, Double)
+
 -- some reasonable default values
-def_width = 60
-def_height = 21
-def_xrange = (0.0, 1.0)
-def_yrange = (0.0, 1.0)
-
--- | Specifies a set of functions to be graphed in Cartesian coordinates
-data Plot = Plot {xminOf :: Double, -- ^ left x-bound of the graph
-                                  xmaxOf :: Double, -- ^ right x-bound of the graph
-                                  xDensityOf :: Int, -- ^ number of characters along the x-axis
-                                  yminOf :: Double,  -- ^ left y-bound of the graph
-                                  ymaxOf :: Double, --  right y-bound of the graph
-                                  yDensityOf :: Int, -- ^ number of characters along the y-axis
-                                  functionsOf :: [(Double -> Double)] -- ^ a list of functions of the form y = f(x)
-                                  }
-
--- | A default empty 'Plot'
-emptyPlot :: Plot
-emptyPlot = Plot (fst def_xrange) (snd def_xrange) def_width
-                 (fst def_yrange) (snd def_yrange) def_height []
-
-instance Show Plot where
-        show plot = "Bounds: " ++ xmin ++ " < x < " ++ xmax ++ "\n" ++
-                                "        " ++ ymin ++ " < y < " ++ ymax ++ "\n" ++
-                                "X-axis Precision: " ++ xden ++ "\n" ++
-                                "Y-axis Precision: " ++ yden ++ "\n" ++
-                                "Functions Plotted: " ++ lenf
-                                where xmin = show . xminOf $ plot
-                                      xmax = show . xmaxOf $ plot
-                                      xden = show . xDensityOf $ plot
-                                      ymin = show . yminOf $ plot
-                                      ymax = show . ymaxOf $ plot
-                                      yden = show . yDensityOf $ plot
-                                      lenf = show . length . functionsOf $ plot
-
-
--- | Specifies a set of parametric functions to be graphed in Cartesian coordinates
-data PlotParam = PlotParam {pxminOf :: Double, -- ^ left x-bound of the graph
-                                                        pxmaxOf :: Double, -- ^ right x-bound of the graph
-                                                        pxDensityOf :: Int, -- ^ number of characters along the x-axis
-                                                        pyminOf :: Double, -- ^ left y-bound of the graph
-                                                        pymaxOf :: Double, --  right y-bound of the graph
-                                                        pyDensityOf :: Int, -- ^ number of characters along the y-axis
-                                                        pfunctionsOf :: [(Double -> (Double,Double),Double,Double,Int)]
-                                                        }
-
--- | A default empty 'PlotParam'
-emptyParamPlot :: PlotParam
-emptyParamPlot = PlotParam (fst def_xrange) (snd def_xrange) def_width
-                           (fst def_yrange) (snd def_yrange) def_height []
-
-
-instance Show PlotParam where
-        show plot = "Bounds: " ++ xmin ++ " < x < " ++ xmax ++ "\n" ++
-                                "        " ++ ymin ++ " < y < " ++ ymax ++ "\n" ++
-                                "X-axis Precision: " ++ xden ++ "\n" ++
-                                "Y-axis Precision: " ++ yden ++ "\n" ++
-                                "Functions Plotted: " ++ lenf
-                                where xmin = show . pxminOf $ plot
-                                      xmax = show . pxmaxOf $ plot
-                                      xden = show . pxDensityOf $ plot
-                                      ymin = show . pyminOf $ plot
-                                      ymax = show . pymaxOf $ plot
-                                      yden = show . pyDensityOf $ plot
-                                      lenf = show . length . pfunctionsOf $ plot
-
-
--- | Specifies a set of functions to be graphed in polar coordinates
-data PlotPolar = PlotPolar {plxminOf :: Double, -- ^ left x-bound of the graph
-                                                        plxmaxOf :: Double, -- ^ right x-bound of the graph
-                                                        plxDensityOf :: Int, -- ^ number of characters along the x-axis
-                                                        plyminOf :: Double, -- ^ left y-bound of the graph
-                                                        plymaxOf :: Double, --  right y-bound of the graph
-                                                        plyDensityOf :: Int, -- ^ number of characters along the y-axis
-                                                        plfunctionsOf :: [(Double -> Double,Double,Double,Int)] -- ^ a list of functions of the form r = f(theta)
-                                                        }
-
--- | A default empty 'PlotPolar'
-emptyPolarPlot :: PlotPolar
-emptyPolarPlot = PlotPolar (fst def_xrange) (snd def_xrange) def_width
-                           (fst def_yrange) (snd def_yrange) def_height []
-
-instance Show PlotPolar where
-        show plot = "Bounds: " ++ xmin ++ " < x < " ++ xmax ++ "\n" ++
-                                "        " ++ ymin ++ " < y < " ++ ymax ++ "\n" ++
-                                "X-axis Precision: " ++ xden ++ "\n" ++
-                                "Y-axis Precision: " ++ yden ++ "\n" ++
-                                "Functions Plotted: " ++ lenf
-                                where xmin = show . plxminOf $ plot
-                                      xmax = show . plxmaxOf $ plot
-                                      xden = show . plxDensityOf $ plot
-                                      ymin = show . plyminOf $ plot
-                                      ymax = show . plymaxOf $ plot
-                                      yden = show . plyDensityOf $ plot
-                                      lenf = show . length . plfunctionsOf $ plot
-
--- | adds a function to a @Plot@
-insertF :: (Double -> Double) -> Plot -> Plot
-insertF f plot = plot {functionsOf = f:(functionsOf plot)}
-
--- | adds a function to a @PlotParam@
-insertParam :: ((Double -> (Double,Double)),Double,Double,Int) -> PlotParam -> PlotParam
-insertParam f plot = plot {pfunctionsOf = f:(pfunctionsOf plot)}
-
--- | adds a function to a @PlotPolar@
-insertPolar :: ((Double -> Double),Double,Double,Int) -> PlotPolar -> PlotPolar
-insertPolar f plot = plot {plfunctionsOf = f:(plfunctionsOf plot)}
+defaultXrange :: Range
+defaultXrange = (0.0, 1.0)
+defaultYrange :: Range
+defaultYrange = (0.0, 1.0)
+
+-- | A function of one variable (@x -> y@).
+type Function = Double -> Double
+instance Show Function where show = const "<function::Double->Double>"
+
+-- | Plot one or more functions (@x -> y@) in Cartesian coordinates.
+data XYPlot = XYPlot {
+      fp'xlim :: Range -- ^ limits of the abscissa (x) axis
+    , fp'ylim :: Range -- ^ limits of the ordinate (y) axis
+    , fp'functions :: [Function] -- ^ functions to plot
+    } deriving Show
+
+-- | A default empty 'XYPlot' with bounds of a unit square.
+emptyXYPlot :: XYPlot
+emptyXYPlot = XYPlot defaultXrange defaultYrange []
+
+data ParamFunction = ParamFunction {
+      xfun :: Function  -- ^ the first parametrized variable (@t -> x@)
+    , yfun :: Function  -- ^ the second parametrized variable (@t -> y@)
+    , tlim :: Range  -- ^ range of the free parameter @t@
+    } deriving Show
+
+-- | Plot one or more parametric functions in Cartesian coordiantes.
+data ParamXYPlot = ParamXYPlot {
+      param'xlim :: Range -- ^ limits of the abscissa (x) axis
+    , param'ylim :: Range -- ^ limits of the ordinate (y) axis
+    , param'functions :: [ParamFunction] -- ^ functions to plot
+    } deriving Show
+
+-- | A default empty 'ParamXYPlot'
+emptyParamXYPlot :: ParamXYPlot
+emptyParamXYPlot = ParamXYPlot defaultXrange defaultYrange []
+
+data PolarFunction = PolarFunction {
+      rfun :: Function -- ^ radius as a function of angle @phi@ (@phi -> r@)
+    , philim :: (Double,Double) -- ^ range of the angle argument @phi@
+    }  deriving Show
+
+-- | Plot one or more functions in polar coordinates.
+data PolarPlot = PolarPlot {
+      polar'xlim :: Range -- ^ limits of the abscissa (x) axis
+    , polar'ylim :: Range -- ^ limits of the ordinate (y) axis
+    , polar'functions :: [PolarFunction] -- ^ functions to plot
+    } deriving Show
+
+-- | A default empty 'PolarPlot'
+emptyPolarPlot :: PolarPlot
+emptyPolarPlot = PolarPlot defaultXrange defaultYrange []
 
 -- | Anything that can be plotted.
-class Draw a where
-        draw :: a -> TextPlot
-
-instance Draw Plot where
-        draw plot = transpose . subDraw $ (xminOf plot)
-                where row = replicate (yDensityOf plot) ' '
-                      xmax = xmaxOf plot
-                      xIncr = (xmaxOf plot - xminOf plot) / (fromIntegral (xDensityOf plot) - 1)
-                      yIncr = (ymaxOf plot - yminOf plot) / (fromIntegral (yDensityOf plot) - 1)
-                      fs = [ (\x -> round $ (f x - yminOf plot) / yIncr) | f <- functionsOf plot]
-                      subDraw x
-                        | x > xmax = []
-                        | otherwise = reverse (replaces (map (\f -> f x) fs) '*' row) : subDraw (x + xIncr)
-
-instance Draw PlotParam where
-        draw plot = transpose . subDraw 0 $ points
-                where row = replicate (pyDensityOf plot) ' '
-                      xIncr  = (pxmaxOf plot - pxminOf plot) / (fromIntegral (pxDensityOf plot) - 1)
-                      yIncr  = (pymaxOf plot - pyminOf plot) / (fromIntegral (pyDensityOf plot) - 1)
-                      points = concat $ map each (pfunctionsOf plot)
-                                where each (f,tmin,tmax,tden) = [adjust (f t) | t <- [tmin,(tmin + tIncr)..tmax]]
-                                        where adjust (x,y) = (round $ (x - pxminOf plot) / xIncr, round $ (y - pyminOf plot) / yIncr)
-                                              tIncr = (tmax - tmin) / (fromIntegral tden - 1)
-                      subDraw x fs
-                        | x >= pxDensityOf plot = []
-                        | otherwise = reverse (replaces (fst $ rowPoints) '*' row) : subDraw (x + 1) (snd $ rowPoints)
-                                where rowPoints = foldl (\(toUse,rest) (a,b) -> if a == x then (b:toUse,rest) else (toUse,(a,b):rest)) ([],[]) fs
-
-
-instance Draw PlotPolar where
-        draw plot = transpose . subDraw 0 $ points
-                where row = replicate (plyDensityOf plot) ' '
-                      xIncr  = (plxmaxOf plot - plxminOf plot) / (fromIntegral (plxDensityOf plot) - 1)
-                      yIncr  = (plymaxOf plot - plyminOf plot) / (fromIntegral (plyDensityOf plot) - 1)
-                      points = concat $ map each (plfunctionsOf plot)
-                                where each (f,tmin,tmax,tden) = [adjust (t,(f t)) | t <- [tmin,(tmin + tIncr)..tmax]]
-                                        where adjust (th,r) = (round $ (x - plxminOf plot) / xIncr, round $ (y - plyminOf plot) / yIncr)
-                                                        where x = r*cos th
-                                                              y = r*sin th
-                                              tIncr = (tmax - tmin) / (fromIntegral tden - 1)
-                      subDraw x fs
-                        | x >= plxDensityOf plot = []
-                        | otherwise = reverse (replaces (fst $ rowPoints) '*' row) : subDraw (x + 1) (snd $ rowPoints)
-                                where rowPoints = foldl (\(toUse,rest) (a,b) -> if a == x then (b:toUse,rest) else (toUse,(a,b):rest)) ([],[]) fs
-
--- | prints a plot
-printPlot :: Draw plot => plot -> IO()
-printPlot = putStr . drawPlot
-
--- | converts a plot to a multiline 'String'
-drawPlot :: Draw plot => plot -> String
-drawPlot = unlines . draw
-
---Utilities
-replace :: Int -> a -> [a] -> [a]
-replace n char xs = if 0 <= n && n <= length xs - 1 then (take n xs) ++ [char] ++ back else xs
-        where back = reverse . take (length xs - 1 - n) . reverse $ xs
-
-replaces :: [Int] -> a -> [a] -> [a]
-replaces indices char original = subReplaces indices original
-        where subReplaces (n:ns) xs = subReplaces ns $ replace n char xs
-              subReplaces [] xs = xs
-
-replace2D :: Int -> Int -> a -> [[a]] -> [[a]]
-replace2D x y char xs = replace x (replace y char $ xs !! x) xs
+class Plot a where
+    draw :: PlotConfig -> a -> TextPlot
+
+data PlotConfig = PlotConfig {
+      c'width :: Int     -- ^ plot width in characters
+    , c'height :: Int    -- ^ plot height in characters
+    , c'samples :: Int   -- ^ samples per line
+    , c'showAxes :: Bool -- ^ draw axes or not (TODO)
+    } deriving (Show, Eq)
+
+-- | Default plot dimensions, suitable for 80x25 terminals.
+defaultConfig :: PlotConfig
+defaultConfig = PlotConfig 60 21 256 True
+
+instance Plot XYPlot where
+    draw (PlotConfig width height _ _) plt = fromArray $ runSTArray $ do
+      arr <- createArray width height
+      let xrange@(xmin,xmax) = fp'xlim plt
+      let yrange = fp'ylim plt
+      let dx = (xmax-xmin)/(fromIntegral width - 1)
+      let xs = [ xmin + (fromIntegral c)*dx | c <- [0..width-1] ]
+      forM_ (reverse (zip (fp'functions plt) symbols)) $
+                \(f, sym) -> markPoints xrange yrange arr sym xs (map f xs)
+      return arr
+
+instance Plot ParamXYPlot where
+    draw (PlotConfig width height samples _) plt = fromArray $ runSTArray $ do
+      arr <- createArray width height
+      let xrange = param'xlim plt
+      let yrange = param'ylim plt
+      let fns = param'functions plt
+      forM_ (reverse (zip fns symbols)) $
+            \(f, sym) -> do
+              let (tmin,tmax) = tlim f
+              let dt = (tmax-tmin)/(fromIntegral samples - 1)
+              let ts = [ (fromIntegral t)*dt | t <- [0..samples-1] ]
+              let xs = map (xfun f) ts
+              let ys = map (yfun f) ts
+              markPoints xrange yrange arr sym xs ys
+      return arr
+
+instance Plot PolarPlot where
+    draw (PlotConfig width height samples _) plt = fromArray $ runSTArray $ do
+      arr <- createArray width height
+      let xrange = polar'xlim plt
+      let yrange = polar'ylim plt
+      let fns = polar'functions plt
+      forM_ (reverse (zip fns symbols)) $
+            \(f, sym) -> do
+              let (phimin, phimax) = philim f
+              let dphi = (phimax-phimin)/(fromIntegral samples - 1)
+              let phis = [ (fromIntegral t)*dphi | t <- [0..samples-1] ]
+              let rs = map (rfun f) phis
+              let toCartesian (r,phi) = (r*cos phi, r*sin phi)
+              let (xs,ys) = unzip . map toCartesian $ zip rs phis
+              markPoints xrange yrange arr sym xs ys
+      return arr
+
+-- | Convert a plot to a multiline 'String' with default configuration
+plot :: Plot p => p -> String
+plot = plotWithConfig defaultConfig
+
+-- | Convert a plot to multiline 'String' with custom configuration
+plotWithConfig :: Plot p => PlotConfig -> p -> String
+plotWithConfig config = unlines . draw config
+
+-- | Print a plot with default configuration
+printPlot :: Plot p => p -> IO()
+printPlot = putStr . plot
+
+
+{--------------------- backend array operations ---------------------------}
+
+
+-- | Symbols to use for different plots.
+symbols :: String
+symbols = cycle "ox+#*@-"
+
+-- | Create an 'STArray' of given screen dimensions
+createArray :: Int -> Int -> ST s (STArray s (Int,Int) Char)
+createArray width height = do
+  let screenDims = ((0,0),(height-1,width-1))
+  newArray screenDims ' ' :: ST s (STArray s (Int,Int) Char)
+
+-- | Mark (x,y) points in a two-dimensional array of 'Char'
+markPoints :: Range    -- ^ @x@ range
+           -> Range    -- ^ @y@ range
+           -> STArray s (Int,Int) Char -- ^ an array we operate on
+           -> Char     -- ^ mark symbol
+           -> [Double] -- ^ @xs@
+           -> [Double] -- ^ @ys@
+           -> ST s (STArray s (Int,Int) Char)
+markPoints (xmin,xmax) (ymin,ymax) arr sym xs ys = do
+  ((rmin,cmin),(rmax,cmax)) <- getBounds arr
+  let width = cmax-cmin+1
+  let height = rmax-rmin+1
+  let w = fromIntegral width
+  let h = fromIntegral height
+  let dx = (xmax-xmin)/(w-1)  -- larger dx, dy steps to guarantee that
+  let dy = (ymax-ymin)/(h-1)  -- max values stay within plot bounds
+  let cols = [ round$(x-xmin)/dx | x <- xs ]
+  let rows = [ round$(h-1-(y-ymin)/dy) | y <- ys ]
+  forM_ (zip cols rows) $ \(c, r) ->
+      when (r >= rmin && r <= rmax && c >= cmin && c < cmax) $
+           writeArray arr (r,c) sym
+  return arr
+
+-- | Convert a two dimensional array to a list of lists
+fromArray :: Array (Int,Int) a -> [[a]]
+fromArray arr = splitEvery width (elems arr)
+  where
+    splitEvery :: Int -> [a] -> [[a]]
+    splitEvery _ [] = []
+    splitEvery n xs = (take n xs) : splitEvery n (drop n xs)
+    width :: Int
+    width = let ((_,colmin),(_,colmax)) = bounds arr
+            in  colmax - colmin + 1
 Cabal-Version:       >= 1.2
 
 library
-  GHC-options:     -Wall
+  GHC-options:     -Wall -fno-warn-orphans
   Exposed-Modules: TextPlot
   Build-Depends:   base >= 2.0 && < 5
+                 , array