Commits

Sergey Astanin committed 850cffe

Draw plot axes by default.

  • Participants
  • Parent commits a63b19c

Comments (0)

Files changed (1)

 import Control.Monad.ST (ST)
 import Data.Array
 import Data.Array.ST
+import Text.Printf (printf)
 
 type TextPlot = [[Char]]
 
 (.|) :: EditPlot p f => p -> Range -> p
 (.|) = ylim
 
+-- | A type class to access plot dimensions in unform manner across
+-- all plot types.
+class Plot plot => Dimensions plot where
+   getXlim :: plot -> Range
+   getYlim :: plot -> Range
 
 -- | Plot one or more functions (@x -> y@) in Cartesian coordinates.
 data XYPlot = XYPlot {
    xlim plot r = plot { fp'xlim = r }
    ylim plot r = plot { fp'ylim = r }
 
+instance Dimensions XYPlot where
+    getXlim = fp'xlim
+    getYlim = fp'ylim
+
 data ParamFunction = ParamFunction {
       xfun :: Function  -- ^ the first parametrized variable (@t -> x@)
     , yfun :: Function  -- ^ the second parametrized variable (@t -> y@)
    xlim plot r = plot { param'xlim = r }
    ylim plot r = plot { param'ylim = r }
 
+instance Dimensions ParamXYPlot where
+    getXlim = param'xlim
+    getYlim = param'ylim
+
 data PolarFunction = PolarFunction {
       rfun :: Function -- ^ radius as a function of angle @phi@ (@phi -> r@)
     , philim :: (Double,Double) -- ^ range of the angle argument @phi@
    xlim plot r = plot { polar'xlim = r }
    ylim plot r = plot { polar'ylim = r }
 
+instance Dimensions PolarPlot where
+    getXlim = polar'xlim
+    getYlim = polar'ylim
+
 -- | Any kind of of plot.
 class Plot a where
     draw :: PlotConfig -> a -> TextPlot
       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)
+    , c'showAxes :: Bool -- ^ draw axes or not
     } deriving (Show, Eq)
 
--- | Default plot dimensions, suitable for 80x25 terminals.
+-- | Default plot dimensions, suitable for 80x24 terminals.
 defaultConfig :: PlotConfig
-defaultConfig = PlotConfig 60 21 256 True
+defaultConfig = PlotConfig 61 20 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
+    draw (PlotConfig width height _ showAxes) plt =
+      addAxes showAxes 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
+    draw (PlotConfig width height samples showAxes) plt =
+      addAxes showAxes 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
+    draw (PlotConfig width height samples showAxes) plt =
+      addAxes showAxes 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
     width = let ((_,colmin),(_,colmax)) = bounds arr
             in  colmax - colmin + 1
 
+addAxes :: Dimensions plot => Bool -> plot -> TextPlot -> TextPlot
+addAxes False _ txt = txt
+addAxes True p txt = addYAxis (getYlim p) . addXAxis (getXlim p) $ txt
+
+addXAxis :: Range -> TextPlot -> TextPlot
+addXAxis (xmin,xmax) lns  =
+    let w =  maximum . map length $ lns
+        xminLabel = printf "%-g" (toF xmin)
+        xmaxLabel = printf "%g" (toF xmax)
+        axis = "+" ++ replicate (w-2) '-' ++ "+->"
+        padw = w - (length xminLabel + length xmaxLabel)
+        labels = xminLabel ++ replicate padw ' ' ++ xmaxLabel
+    in  lns ++ [axis,labels]
+
+addYAxis :: Range -> TextPlot -> TextPlot
+addYAxis (ymin,ymax) lns =
+    let minLabel = printf "%g" (toF ymin)
+        maxLabel = printf "%g" (toF ymax)
+        lw = max (length minLabel) (length maxLabel) + 1
+        tip = replicate lw ' ' ++ "^"
+        maxL = replicate (lw - length maxLabel - 1) ' ' ++ maxLabel ++ " +"
+        midL = replicate lw ' ' ++ "|"
+        minL = replicate (lw - length minLabel - 1) ' ' ++ minLabel ++ " +"
+        axisL = replicate (lw + 1) ' '
+        n = length lns
+        labels = (tip:maxL:(replicate (n-4) midL)) ++  [minL, axisL, axisL]
+    in  zipWith (++) labels ("":lns)
+
+toF :: Double -> Float
+toF = fromRational . toRational
 
 -- $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 p = emptyXYPlot .+ hat .- (-5,5) .| (-0.125,0.25)
--- > ghci> printPlot p
--- >                                                             
--- >                                                             
--- >                              oo                             
--- >                             o  o                            
--- >                                                             
--- >                            o    o                           
--- >                                                             
--- >                           o      o                          
--- >                                                             
--- >                                                             
--- >                          o        o                         
--- >                                                             
--- >                         o          o                        
--- > oooooooo                                            ooooooo 
--- >         ooooo                                  ooooo        
--- >              oo        o            o        oo             
--- >                o                            o               
--- >                 o     o              o     o                
--- >                  ooooo                ooooo                 
--- >                                                             
--- >                                                             
+-- > 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
+--