-- | This module implement an ASCII Art graph plotter, -- using subdivision to provide good looking ascii graph. module EqManips.Renderer.Ascii2DGrapher( -- * Plotting configuration PlotConf( .. ) , ScalingType( .. ) , Dimension( .. ) , defaultPlotConf -- * Da Ploting LAUNCHER !! , plot2DExpression ) where import Data.Array.Unboxed import Text.Printf import EqManips.Types import qualified EqManips.Algorithm.StackVM.Stack as VM -- | Alias in case I want to change in the future. type ValueType = Double -- | (Begin, End), all inclusive type PlotRange = (ValueType, ValueType) data ScalingType = Linear | Logarithmic deriving Show data Dimension = Dimension { minVal :: ValueType , maxVal :: ValueType , projectionSize :: Int , scaling :: ScalingType , drawAxis :: Bool , labelPrecision :: Int , labelEvery :: Maybe Int } deriving Show data PlotConf = PlotConf { xDim :: Dimension , yDim :: Dimension , draw0Axis :: Bool , graphTitle :: Maybe String } deriving Show defaultPlotConf :: PlotConf defaultPlotConf = PlotConf { xDim = Dimension { minVal = 0.0 , maxVal = 10.0 , projectionSize = 50 , scaling = Linear , drawAxis = False , labelPrecision = 4 , labelEvery = Just 7 } , yDim = Dimension { minVal = -5.0 , maxVal = 5.0 , projectionSize = 30 , scaling = Linear , drawAxis = False , labelPrecision = 4 , labelEvery = Just 4 } , draw0Axis = False , graphTitle = Nothing } doubleShow :: Dimension -> ValueType -> String doubleShow dim = printf "%.*f" (labelPrecision dim) dimensionRange :: Dimension -> PlotRange dimensionRange dim = (minVal dim, maxVal dim) canvasSize :: PlotConf -> (Int, Int) canvasSize conf = ( projectionSize $ xDim conf , projectionSize $ yDim conf) -- | Translate a list of write on the x (width) axis with -- a given amount. Perform no operation if translation amount -- is 0. translateX :: Int -> [((Int, Int), Char)] -> [((Int, Int), Char)] translateX 0 lst = lst translateX i lst = [ ((x + i, y), c) | ((x,y), c) <- lst ] -- | Same thing as 'translateX' but with the y (height) axis. translateY :: Int -> [((Int, Int), Char)] -> [((Int, Int), Char)] translateY 0 lst = lst translateY i lst = [ ((x, y + i), c) | ((x,y), c) <- lst ] -- | Add some vertical labels addYAxisLabel :: Dimension -> ValSuccessor -> CharCanvas -> CharCanvas addYAxisLabel dim successor rez@(((xPos, shiftHeight), adds), vals) = case (drawAxis dim, labelEvery dim) of (_, Nothing) -> rez (False, _) -> rez (True, Just size) -> (((xShift, shiftHeight), adds), vals' ++ draw shiftHeight (minVal dim)) where maxHeight = projectionSize dim + shiftHeight xShift = max 8 xPos vals' = translateX (xShift - xPos) vals apply val 0 = val apply val times = apply (successor val) $ times - 1 draw y yVal | y >= maxHeight = [] | otherwise = let indicator = ((xShift - 1, y), '+') future = draw (y + size) (apply yVal size) in indicator : [((xP, y), c) | (xP, c) <- zip [0.. xShift - 2] $ doubleShow dim yVal] ++ future -- | Represent a tuple of canvas extension and a list -- of characters. It's ((leftAdd, bottomAdd), (rightAdd, topAdd)) type CharCanvas = (((Int,Int),(Int,Int)), [((Int,Int), Char)]) addXAxisLabel :: Dimension -> ValSuccessor -> CharCanvas -> CharCanvas addXAxisLabel dim successor rez@(((shiftWidth, yPos), (addX, addY)), vals) = case (drawAxis dim, labelEvery dim) of (_, Nothing) -> rez (False, _) -> rez (True, Just size) -> (((shiftWidth, yPos) ,(rightShift, addY) ), vals ++ draw shiftWidth (minVal dim)) where maxWidth = projectionSize dim + shiftWidth apply val 0 = val apply val times = apply (successor val) $ times - 1 rightShift = max addX $ size - (projectionSize dim `rem` size) draw x xVal | x >= maxWidth = [] | otherwise = let indicator = ((x - 1,1), '|') future = draw (x + size) (apply xVal size) in indicator : [((xPos, 0), c) | (xPos, c) <- zip [x - 1.. x + size - 3] $ doubleShow dim xVal] ++ future addTitle :: PlotConf -> Maybe String -> CharCanvas -> CharCanvas addTitle _ Nothing a = a addTitle conf (Just t) (((shiftWidth, shiftHeight), adds), vals) = (((shiftWidth, shiftHeight + 2), adds), toAdd ++ translateY 2 vals) where begin = (projectionSize (xDim conf) - length t) `div` 2 toAdd = [((x,0), c) | (x,c) <- zip [begin ..] t] add0Axis :: PlotConf -> Scaler -> CharCanvas -> CharCanvas add0Axis conf scaler original@(((shiftWidth, shiftHeight), adds), vals) = if y < 0 then original else ( ((wShift, shiftHeight), adds) , ((wShift - nominalShift + 1, y), '0') : line ++ translateX valShift vals) where w = projectionSize $ xDim conf h = projectionSize $ yDim conf y = scaler 0 line = if y >= 0 && y < h then [((x, y), '-') | x <- [wShift .. wShift + (w - 1)]] else [] nominalShift = 4 wShift = max nominalShift shiftWidth valShift = if shiftWidth >= nominalShift then shiftWidth - wShift else wShift - shiftWidth addYAxis :: PlotConf -> Scaler -> CharCanvas -> CharCanvas addYAxis conf _scaler (((shiftWidth, shiftHeight), adds), vals) = ( ((wShift, shiftHeight), adds) , line ++ translateX valShift vals) where h = projectionSize $ yDim conf x = nominalShift - 1 line = [((x, y), '|') | y <- [shiftHeight .. shiftHeight + (h - 1)]] nominalShift = 4 wShift = max nominalShift shiftWidth valShift = if shiftWidth >= nominalShift then shiftWidth - wShift else wShift - shiftWidth addXaxis :: PlotConf -> Scaler -> CharCanvas -> CharCanvas addXaxis conf _ (((shiftWidth, shiftHeight), adds), vals) = ( ((shiftWidth, hShift), adds) , line ++ translateY valShift vals) where line = [((x, hShift - 1), '_') | x <- [shiftWidth ..(w - 1) + shiftWidth]] w = projectionSize $ xDim conf nominalShift = 2 hShift = max nominalShift shiftHeight valShift = hShift - shiftHeight -- | Equivalent of 'when' but non-monadic. doWhen :: Bool -> (a -> a) -> a -> a doWhen False _ a = a doWhen True f a = f a -- | Function in charge of adding all the plot axis -- to the generated character stream addAxis :: PlotConf -> (Scaler, Scaler) -> (ValSuccessor, ValSuccessor) -> [((Int, Int), Char)] -> CharCanvas addAxis conf (widthScaler, heightScaler) (xSucc, ySucc) a = doWhen (graphTitle conf /= Nothing) (addTitle conf $ graphTitle conf) . doWhen (labelEvery (yDim conf) /= Nothing) (addYAxisLabel (yDim conf) ySucc) . doWhen (drawAxis $ yDim conf) (addYAxis conf heightScaler) . doWhen (labelEvery (xDim conf) /= Nothing) (addXAxisLabel (xDim conf) xSucc) . doWhen (drawAxis $ xDim conf) (addXaxis conf widthScaler) . doWhen (draw0Axis conf) (add0Axis conf heightScaler) $ (((0,0), (0,0)), a) -- | User function to start a plot. Handle all the scary -- configuration before starting the plot. plot2DExpression :: PlotConf -> FormulaPrim -> Either String (UArray (Int, Int) Char) plot2DExpression conf formula = case VM.compileExpression formula of Left err -> Left err Right prog -> let successor = widthSuccessor $ xDim conf (_,ySuccessor) = widthSuccessor $ yDim conf yScaler = sizeMapper $ yDim conf xScaler = sizeMapper $ xDim conf (xBegin, xEnd) = dimensionRange $ xDim conf size@(w, h) = canvasSize conf graph = plot2D size xEnd (flip (VM.evalProgram prog) 0) successor xScaler yScaler xBegin (((shiftX, shiftY), (addX, addY)), graph') = addAxis conf (xScaler, yScaler) (snd successor, ySuccessor) graph in Right $ accumArray (\_ e -> e) ' ' ((0, 0) ,(w + shiftX + addX - 1, h + shiftY + addY - 1)) $ [v | v@((x,_),_) <- graph', x < w + shiftX + addX, x >= 0] -- | This type is a transformation from function -- result to screen space. type Scaler = ValueType -> Int -- | Function used to find the next \'x\' element -- to be plotted. type ValSuccessor = ValueType -> ValueType -- | Equivalent of the 'succ' function of the -- 'Enum' class, with a linear scale. widthSuccessor :: Dimension -> (ValSuccessor, ValSuccessor) widthSuccessor dim = case (scaling dim, minVal dim > 0) of (Linear, _) -> (\v -> v - addVal, \v -> v + addVal) where addVal = (vMax - vMin) / toEnum (projectionSize dim - 2) (vMin, vMax) = dimensionRange dim (Logarithmic, True) -> (\v -> v / mulVal,\v -> v * mulVal) where mulVal = (vMax / vMin) ** (1.0 / toEnum (projectionSize dim - 1)) (vMin, vMax) = dimensionRange dim (Logarithmic, False) -> (\v -> vPrev (v + vAdd) - vAdd ,\v -> vNext (v + vAdd) - vAdd) where (vMin, vMax) = dimensionRange dim bigpsilon = 0.1 vAdd = 0.1 + negate vMin (vPrev, vNext) = widthSuccessor $ dim { minVal = bigpsilon , maxVal = vMax - vMin + bigpsilon} -- | How to map the height value onto the screen, -- by taking tinto action the 'canvas' size sizeMapper :: Dimension -> (ValueType -> Int) sizeMapper dim = let (vMin, vMax) = dimensionRange dim fullSize = projectionSize dim in case (scaling dim, vMin > 0) of (Linear, _) -> \val -> truncate $ (val - vMin) * scaler where scaler = toEnum fullSize / (vMax - vMin + 1) (Logarithmic, True) -> \val -> truncate $ (log val - vMin') * scaler where (vMin', vMax') = (log vMin, log vMax) scaler = toEnum fullSize / (abs (vMax' - vMin') + 1) (Logarithmic, False) -> \val -> truncate $ (log $ val - vMin') * scaler where (vMin', vMax') = (log 0.1, log $ vMax - vMin) scaler = toEnum fullSize / (abs (vMax' - vMin') + 1) -- | Describe the action that the plotter must -- accomplish in order to draw a function data DrawAction = ActionStop -- ^ Stop the ploting/subdivision for this value | SubdivideBoth Char -- ^ Halve the x interval and continue plotting, on both ends | SubdivideUpper Char -- ^ Halve and continue only on the upper part. | SubdivideLower Char -- ^ Halve and continue only on the lower part. | SubdivideIgnore -- ^ Halve and continue both ends but don't write any char. | Continue Char -- ^ Continue with the current interval, adn write a char. neighbour :: ValueType -> ValueType -> Bool neighbour y1 y2 = abs (y1 - y2) < 0.05 -- | Given a successor function given as parameter, -- it will return a successor function going half -- as far as the previous one. Work with backward -- functions to. rangeSplitter :: ValSuccessor -> ValSuccessor rangeSplitter f x = x + (f x - x) / 2 -- | As side is inversed when drawing backward, -- this function help to choose a representation -- given the current direction and a 'Forward' -- assention or 'Backward' descent. sideChar :: Direction -- ^ Current drawing direction -> Direction -- ^ Assention or descent -> Char sideChar Forward Forward = '/' sideChar Forward Backward = '\\' sideChar Backward a = sideChar Forward $ inverseDirection a -- | Given two samples, give an Ascii representation -- and information to the plotter on how to continue -- the drawing. charOf :: Direction -- ^ Current plotting direction -> Int -- ^ Canvas height -> Int -- ^ Absciss in canvas space of the previous value. -> (ValueType, Int) -- ^ Value and canvas position of the current value. -> (ValueType, Int) -- ^ Value and canvas position of the current value. -> DrawAction -- ^ What to do next charOf direction height screenPrev (y1, screenY1) (y2, screenY2) | isNaN y1 = ActionStop | isInfinite y1 && screenY1 >= 0 && screenY1 < height = SubdivideBoth '|' | isInfinite y1 = SubdivideIgnore -- We are out of the drawing box, stop -- the drawing for the current value of x | screenY1 >= height || screenY1 < 0 = ActionStop -- The two values are in a different cell, -- we need to refine the values. | abs (screenY1 - screenY2) > 1 && abs (screenY1 - screenPrev) > 1 = SubdivideBoth '|' | abs (screenY1 - screenY2) > 1 = SubdivideUpper '|' | abs (screenY1 - screenPrev) > 1 = SubdivideLower '|' -- If values are sufisently near, draw a flat -- line and continue | neighbour y1 y2 = Continue '-' -- We are ascending, but not enough to subdivide, -- continue to the next x | y1 < y2 = Continue $ sideChar direction Forward -- Descending... | y1 > y2 = Continue $ sideChar direction Backward -- y1 more or less equal y2 | otherwise = Continue '-' -- | Happy float epsilon :: ValueType epsilon = 0.00000000000001 -- | Type used when plotting, to inform -- the subdivision direction. data Direction = Forward | Backward deriving Eq -- | Inverse the direction, equivalent of -- 'not', but for 'Direction' inverseDirection :: Direction -> Direction inverseDirection Forward = Backward inverseDirection Backward = Forward -- | The real plotting function, calling it is rather complex, -- due to the number of thing to take into account, favor the use -- of a more high level function like 'plot2DExpression' plot2D :: (Int, Int) -- ^ Size of the canvas in number of cells -> ValueType -- ^ End value for x -> (ValueType -> ValueType) -- ^ The function to be evaluated -> (ValSuccessor, ValSuccessor) -- ^ x Successor function, backward, forward, -> Scaler -- ^ Function to translate xVal to canvas position -> Scaler -- ^ Function to translate (f xVal) to canvas position -> ValueType -- ^ The \'current\' ploted value, xBegin for first call -> [((Int, Int),Char)] -- ^ Woohoo, the result, to be stored in an array plot2D (_width, height) xStop f widthSucc xPlot yPlot xInit = subPlot widthSucc (xInit - epsilon, xStop) Forward 0 xInit where subPlot successors@(xPrev, xSucc) interval@(xBegin, xEnd) direction prevScreen x | direction == Forward && (x <= xBegin || x >= xEnd) = [] | direction == Backward && (x <= xEnd || x >= xBegin) = [] | otherwise = let val = f x xNext = if direction == Forward then xSucc x else xPrev x screenY = yPlot val midPoint = (x + xNext) / 2 halfSuccessors@(halfPrev, halfSucc) = (rangeSplitter $ rangeSplitter xPrev ,rangeSplitter $ rangeSplitter xSucc) (subPrev, subSucc) = if direction == Forward then (halfPrev, halfSucc) else (halfSucc, halfPrev) midInfo = yPlot $ f midPoint lowerRange = subPlot halfSuccessors (midPoint, xBegin) (inverseDirection direction) midInfo $ subPrev midPoint upperRange = subPlot halfSuccessors (midPoint, xNext) direction midInfo $ subSucc midPoint midChar = if midInfo > 0 && midInfo < height then [((xPlot midPoint, midInfo), '|')] else [] future = subPlot successors interval direction screenY xNext in case charOf direction height prevScreen (val, screenY) (f xNext, yPlot $ f xNext) of ActionStop -> future Continue c -> ((xPlot x, screenY), c) : future SubdivideLower c -> lowerRange ++ midChar ++ ((xPlot x, screenY),c) : future SubdivideUpper c -> upperRange ++ midChar ++ ((xPlot x, screenY),c) : future SubdivideBoth c -> lowerRange ++ upperRange ++ midChar ++ ((xPlot x, screenY),c) : future SubdivideIgnore -> lowerRange ++ upperRange ++ midChar ++ future