packages feed

Eq 1.0.2 → 1.1

raw patch · 15 files changed

+827/−42 lines, 15 files

Files

CharArray.hs view
@@ -12,3 +12,9 @@              => a (i,i) Char -> [String] linesOfArray a = map (lineOfArray a) [yMin .. yMax]     where ((_,yMin),(_, yMax)) = bounds a++charArrayToString :: (Enum i, Ix i, IArray a Char)+                  => a (i,i) Char -> String+charArrayToString = concat . reverse +                  . map (++ "\n") . linesOfArray+
Eq.cabal view
@@ -1,5 +1,5 @@ Name:       Eq-Version:    1.0.2+Version:    1.1 Synopsis:   Render math formula in ASCII, and perform some simplifications Build-Type: Simple Category:   Language, Math@@ -60,6 +60,7 @@                  , EqManips.Algorithm.Simplify                  , EqManips.Algorithm.Unification                  , EqManips.Algorithm.Utils+                 , EqManips.Algorithm.StackVM.Stack                  , EqManips.BaseLibrary                  , EqManips.Conf                  , EqManips.Domain@@ -73,6 +74,7 @@                  , EqManips.Preprocessor                  , EqManips.Propreties                  , EqManips.Renderer.Ascii+                 , EqManips.Renderer.Ascii2DGrapher                  , EqManips.Renderer.CharRender                  , EqManips.Renderer.Cpp                  , EqManips.Renderer.EqCode
EqManips/Algorithm/Cleanup.hs view
@@ -74,6 +74,8 @@ mul (BinOp _ OpPow [a, n]) (BinOp _ OpPow [b, m]) | a == b = Left $ a ** (n + m) mul (CInteger 1) x = Left x mul x (CInteger 1) = Left x+mul (UnOp _ OpNegate (CInteger 1)) x = Left $ negate x+mul x (UnOp _ OpNegate (CInteger 1)) = Left $ negate x mul (CFloat 1.0) x = Left x mul x (CFloat 1.0) = Left x mul (CInteger i1) (CInteger i2) = Left . int $ i1 * i2@@ -95,6 +97,7 @@ divide :: BiRuler divide (CInteger 0) _ = Left $ int 0 divide x (CInteger 1) = Left x+divide x (UnOp _ OpNegate (CInteger 1)) = Left $ negate x divide f1@(CInteger i1) f2@(CInteger i2)     | i1 `mod` i2 == 0 = Left . int $ i1 `div` i2     | otherwise = if greatestCommonDenominator > 1@@ -124,6 +127,10 @@ cosinus (CInteger 0) = int 1 cosinus (NumEntity Pi) = int (-1) cosinus (BinOp _ OpDiv [NumEntity Pi, CInteger 6]) = sqrt 3 / int 3+cosinus (BinOp _ OpDiv [UnOp _ OpNegate (NumEntity Pi), CInteger 3]) = Fraction $ 1 % 2+cosinus (BinOp _ OpDiv [UnOp _ OpNegate (NumEntity Pi)+                       ,UnOp _ OpNegate (CInteger 3)]) = Fraction $ 1 % 2+cosinus (BinOp _ OpDiv [NumEntity Pi, UnOp _ OpNegate (CInteger 3)]) = Fraction $ 1 % 2 cosinus (BinOp _ OpMul [NumEntity Pi, CInteger i])     | i `mod` 2 == 0 = int 1     | otherwise = int (-1)
EqManips/Algorithm/EmptyMonad.hs view
@@ -5,13 +5,6 @@ import Control.Applicative import Control.Monad.Identity -instance Applicative Identity where-    pure = return-    f <*> a = do-        f' <- f-        a' <- a-        return $ f' a'- -- | a function to unwrap empty monad, just -- to be able to compose easily. fromEmptyMonad :: Identity a -> a
EqManips/Algorithm/Eval/GenericEval.hs view
@@ -350,7 +350,6 @@ -- | General evaluation/reduction function eval :: EvalFun -> EvalFun eval evaluator (Meta _ m f) = metaEvaluation evaluator m f-eval _ (NumEntity Pi) = return $ CFloat pi eval evaluator (Matrix _ n m mlines) = do     cells <- sequence [mapM evaluator line | line <- mlines]     return $ matrix n m cells
EqManips/Algorithm/Simplify.hs view
@@ -53,7 +53,10 @@  -- | '-' operator simplification subSimplification :: EvalFun -> EvalOp-subSimplification eval (BinOp _ OpMul [a, c]) b+{-subSimplification eval (Variable v) (BinOp _ OpDiv [a, somethingWithV])-}++{- if c == b  then a * c - b = (a-1) * c -}+subSimplification eval first@(BinOp _ OpMul [a, c]) b     | hashOfFormula c == hashOfFormula b          && b == c = do #ifdef _DEBUG
+ EqManips/Algorithm/StackVM/Stack.hs view
@@ -0,0 +1,200 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module EqManips.Algorithm.StackVM.Stack( compileExpression+                                       , evalProgram +                                       , ValueType+                                       ) where++import Control.Applicative+import Data.List( foldl' )++import EqManips.Types+import EqManips.Polynome+import EqManips.Algorithm.Cleanup( cleanupFormulaPrim )++type ValueType = Double++data StackOperand =+      Add | Sub | Mul | Div+    | Pow | Negate | Abs | Sqrt+    | Sin | Sinh | ASin | ASinh+    | Cos | Cosh | ACos | ACosh+    | Tan | Tanh | ATan | ATanh+    | Ln | Log | Exp+    | Ceil | Floor | Frac+    | LoadX+    | LoadY+    | LoadConst ValueType+    deriving Show++type CompiledExpression = [StackOperand]++type MachineWorld = [ValueType]++-- | bla+evalProgram :: CompiledExpression -> ValueType -> ValueType+            -> ValueType+evalProgram program x y = head $ foldl' (evalOperation x y) [] program++-- | Main eval function.+evalOperation :: ValueType -> ValueType -> MachineWorld+              -> StackOperand+              -> MachineWorld+evalOperation _ _ rest (LoadConst v) = v : rest+evalOperation x _ rest LoadX = x : rest+evalOperation _ y rest LoadY = y : rest++evalOperation _ _ (v1:v2:rest) Add = (v2 + v1) : rest+evalOperation _ _ (v1:v2:rest) Sub = (v2 - v1) : rest+evalOperation _ _ (v1:v2:rest) Mul = (v2 * v1) : rest+evalOperation _ _ (v1:v2:rest) Div = (v2 / v1) : rest+evalOperation _ _ (v1:v2:rest) Pow = (v2 ** v1) : rest++evalOperation _ _ (v1:rest) Negate = (-v1) : rest+evalOperation _ _ (v1:rest) Abs = (-v1) : rest+evalOperation _ _ (v1:rest) Sqrt = sqrt v1 : rest+evalOperation _ _ (v1:rest) Sin  = sin  v1 : rest+evalOperation _ _ (v1:rest) Sinh  = sinh  v1 : rest+evalOperation _ _ (v1:rest) ASin  = asin  v1 : rest+evalOperation _ _ (v1:rest) ASinh = asinh v1 : rest+evalOperation _ _ (v1:rest) Cos  = cos  v1 : rest+evalOperation _ _ (v1:rest) Cosh  = cosh  v1 : rest+evalOperation _ _ (v1:rest) ACos  = acos  v1 : rest+evalOperation _ _ (v1:rest) ACosh = acosh v1 : rest+evalOperation _ _ (v1:rest) Tan  = tan  v1 : rest+evalOperation _ _ (v1:rest) Tanh  = tanh  v1 : rest+evalOperation _ _ (v1:rest) ATan  = atan  v1 : rest+evalOperation _ _ (v1:rest) ATanh = atanh v1 : rest+evalOperation _ _ (v1:rest) Ln  = log  v1 : rest+evalOperation _ _ (v1:rest) Log  = (log v1 / log 10) : rest+evalOperation _ _ (v1:rest) Exp = exp v1 : rest++evalOperation _ _ (v1:rest) Ceil = (fromInteger $ ceiling v1) : rest+evalOperation _ _ (v1:rest) Floor = (fromInteger $ floor v1) : rest+evalOperation _ _ (v1:rest) Frac = v' : rest+    where (_, v') = properFraction v1 :: (Int,Double)++evalOperation _ _ [] _ = error "Stack VM : empty stack."+evalOperation _ _ _ _ = error "Stack VM : stack underflow"+++stackOpOfBinop :: BinOperator -> Maybe StackOperand+stackOpOfBinop OpAdd = Just Add  +stackOpOfBinop OpSub = Just Sub +stackOpOfBinop OpMul = Just Mul +stackOpOfBinop OpDiv = Just Div +stackOpOfBinop OpPow = Just Pow +stackOpOfBinop _ = Nothing++stackOpOfUnop :: UnOperator -> StackOperand+stackOpOfUnop OpNegate = Negate +stackOpOfUnop OpAbs = Abs +stackOpOfUnop OpSqrt = Sqrt+stackOpOfUnop OpSin = Sin +stackOpOfUnop OpSinh = Sinh +stackOpOfUnop OpASin = ASin +stackOpOfUnop OpASinh = ASinh+stackOpOfUnop OpCos = Cos +stackOpOfUnop OpCosh = Cosh +stackOpOfUnop OpACos = ACos +stackOpOfUnop OpACosh = ACosh+stackOpOfUnop OpTan = Tan +stackOpOfUnop OpTanh = Tanh +stackOpOfUnop OpATan = ATan +stackOpOfUnop OpATanh = ATanh+stackOpOfUnop OpLn = Ln +stackOpOfUnop OpLog = Log +stackOpOfUnop OpExp = Exp+stackOpOfUnop OpFactorial =+    error "Cannot be compiled"+stackOpOfUnop OpCeil = Ceil +stackOpOfUnop OpFloor = Floor +stackOpOfUnop OpFrac = Frac++-- | Convert a polynome into a formula to provide the minimal+-- formula in term of multiplication need.+convertPolynomeToEvalFormula :: Polynome -> Maybe FormulaPrim+convertPolynomeToEvalFormula (PolyRest c) = Just $ coefToFormula c+convertPolynomeToEvalFormula (Polynome [var] polyCoeffs) +    | var == 'x' || var == 'y' = do+      firstTransfo <- convertPolynomeToEvalFormula firstSub+      (lastCoeff, lastFormu) <-+                 foldl' prefCoeff (Just (firstCoeff, firstTransfo)) restCoeff+      pure . cleanupFormulaPrim $ lastFormu * fvar ** coefToFormula lastCoeff+        where ((firstCoeff,firstSub):restCoeff) = reverse polyCoeffs+              fvar = Variable [var]++              multCoeff :: FormulaPrim -> PolyCoeff -> PolyCoeff -> FormulaPrim+                        -> (PolyCoeff, FormulaPrim)+              multCoeff rez _             0 subFormu = (0        , rez + subFormu)+              multCoeff rez 0         coeff subFormu = (coeff - 1, rez * fcoeff * fvar * subFormu)+                where fcoeff = coefToFormula coeff+              multCoeff rez prevCoeff coeff subFormu =+                  (coeff, (rez * fvar ** thisCoeff + 1) * subFormu)+                where thisCoeff = coefToFormula $ prevCoeff - coeff++              prefCoeff :: Maybe (PolyCoeff, FormulaPrim) -> (PolyCoeff, Polynome)+                        -> Maybe (PolyCoeff, FormulaPrim)+              prefCoeff Nothing                            _ = Nothing+              prefCoeff (Just (prevCoeff, rez)) (coeff, sub) = do+                  multCoeff rez prevCoeff coeff <$> convertPolynomeToEvalFormula sub+              ++convertPolynomeToEvalFormula (Polynome _ _) = Nothing++compileExpression :: FormulaPrim -> Either String CompiledExpression+compileExpression (Poly _ p) =+    maybe (Left "Wrong variable name in expression") compileExpression+          $ convertPolynomeToEvalFormula p++compileExpression (Variable "x") = Right [LoadX]+compileExpression (Variable "y") = Right [LoadY]+compileExpression (NumEntity Pi) = Right [LoadConst pi]+compileExpression (NumEntity _) = +    Left "Can't compile numeric entity"+compileExpression (Variable v) =+    Left $ "Can't compile expression with unbound variable ("+                ++ v ++ ")"+compileExpression (CInteger i) = Right [LoadConst $ fromInteger i]+compileExpression (CFloat f) = Right [LoadConst f]+compileExpression (Fraction f) = Right [LoadConst $ fromRational f]+compileExpression (UnOp _ OpFactorial _) =+    Left "Cannot compile factorial expression"+compileExpression (UnOp _ op sub) =+    (++ [stackOpOfUnop op]) <$> compileExpression sub++compileExpression (BinOp _ op formulas) =+  case stackOpOfBinop op of+    Just stackOp -> case mapM compileExpression formulas of+        Left err -> Left err+        Right [] -> Left "Stack VM : Empty binop"+        Right [x] -> Right x+        Right (x:xs) ->+            Right $ x ++ foldr (\lst acc -> lst ++ (stackOp : acc)) [] xs+    Nothing -> Left "Error non continuous operators used"+compileExpression (App _ _ _) =+    Left "No function call allowed in compiled expression."+compileExpression (Sum _ _ _ _) =+    Left "No sum allowed."+compileExpression (Product _ _ _ _) =+    Left "No product allowed."+compileExpression (Indexes _ _ _) =+    Left "No indexes allowed in compiled exprression."+compileExpression (List _ _) =+    Left "No lists allowed in compiled exprression."+compileExpression (Complex _ _) =+    Left "No complex arithmetic allowed in compiled expression."+compileExpression (Lambda _ _) = +    Left "No lambda allowed in compiled expression."+compileExpression (Matrix _ _ _ _) = +    Left "No matrix allowed in compiled expression."+compileExpression (Truth _) = +    Left "No boolean expression allowed for compilation."+compileExpression (Derivate _ _ _) = +    Left "No derivation allowed in compilation."+compileExpression (Integrate _ _ _ _ _) = +    Left "No integration allowed in compilation."+compileExpression (Block _ _ _) = +    Left "There is some errors in expressions."+compileExpression (Meta _ _ _) =+    Left "No meta operations allowed in compilation."+
EqManips/Algorithm/Unification.hs view
@@ -15,11 +15,6 @@  infix 4 =~= -instance Applicative (State s) where-    pure = return -    a <*> b = -        do { a' <- a; b' <- b; return $ a' b' }-     type UnificationContext a = State [(String, FormulaPrim)] a  -- | Just a little shortcut to be able to write more
EqManips/EvaluationContext.hs view
@@ -17,6 +17,7 @@                                  , printTrace                                  , traceContext  #endif /* _DEBUG */+                                 , emptyContext                                  ) where  import Data.Map (Map)
EqManips/InputParser/MathML.hs view
@@ -57,17 +57,6 @@ simplifyContent :: Content a -> Either String ReducedXmlTree simplifyContent = simplify . elemOfContent -instance Applicative (Either a) where-    pure = Right-    (<*>) (Left a) _ = Left a-    (<*>) (Right _) (Left b) = Left b-    (<*>) (Right f) (Right v) = Right (f v)--instance Monad (Either a) where-    return = Right-    (>>=) (Left a) _ = Left a-    (>>=) (Right v) f = f v- eitherMap :: [Either a b] -> Either a [b] eitherMap [] = Right [] eitherMap lst = foldr mapper (Right []) lst
EqManips/Polynome.hs view
@@ -473,10 +473,12 @@     | otherwise {- v1 == v2 -} =         Polynome v1       {-. map (\lst@((o,_):_) -> (o, foldr1 (+) $ map snd lst))-}-      . map (\lst@((o,_):_) -> (o, sum $ map snd lst))+      . map headSum       . groupBy (\(o1,_) (o2,_) -> o1 == o2) -- Regroup same order together       $ sortBy (\(c1,_) (c2,_) -> compare c1 c2)       [ (degree1 + degree2, c1 * c2) | (degree1, c1) <- coefs1, (degree2, c2) <- coefs2]+        where headSum lst@((o,_):_) = (o, sum $ map snd lst)+              headSum [] = error "Polynome.hs - headSum - error Empty list"  -------------------------------------------------- ----            Division
+ EqManips/Renderer/Ascii2DGrapher.hs view
@@ -0,0 +1,463 @@+-- | 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+
EqManips/Renderer/Cpp.hs view
@@ -23,10 +23,6 @@ convertToCppS :: Formula TreeForm -> ShowS convertToCppS (Formula f) = fst $ runState (cNo f) defaultConf -instance Applicative (State s) where-    pure = return-    (<*>) = ap- defaultConf :: CppConf defaultConf =     CppConf { failures = []
EqManips/Renderer/Mathml.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NewQualifiedOperators #-} module EqManips.Renderer.Mathml( mathmlRender ) where  import EqManips.Types hiding ( matrix )
formulaMain.hs view
@@ -6,6 +6,10 @@ import EqManips.Renderer.Mathml import EqManips.Renderer.RenderConf +import EqManips.Renderer.Ascii2DGrapher++import CharArray+ #ifdef _DEBUG import EqManips.Renderer.Sexpr #endif@@ -19,7 +23,7 @@  import System.Console.GetOpt -import Data.List( find, intersperse )+import Data.List( find, intersperse, foldl' ) import Data.Maybe( fromMaybe )  import qualified Data.Map as Map@@ -45,10 +49,34 @@     | SupportedFunction     | SupportedOperators     | SupportedPreprocLanguages-    deriving Eq +    -- for plotting+    | PlotWidth+    | PlotHeight+    | XBeg+    | XEnd+    | YBeg+    | YEnd+    | XLogScale+    | YLogScale+    | DrawXaxis+    | DrawYaxis+    | Draw0axis++    | NoDrawXLabel+    | NoDrawYLabel++    | XLabelPrecision+    | YLabelPrecision++    | XLabelSpacing+    | YLabelSpacing++    | PlotTitle+    deriving (Eq, Show)+ version :: String-version = "1.0"+version = "1.1"  commonOption :: [OptDescr (Flag, String)] commonOption =@@ -67,6 +95,84 @@                 "Ask for supported languages for the preprocessor"     ] +plotOption :: [OptDescr (Flag, String)]+plotOption =+    [ Option "x" ["xBegin"] (ReqArg ((,) XBeg) "XBEG") "Beginning of plot (x), float"+    , Option ""  ["xe", "xEnd"] (ReqArg ((,) XEnd) "XEND") "End of plot (x), float"+    , Option "y" ["yBegin"] (ReqArg ((,) YBeg) "YBEG") "Beginning of plot (y), float"+    , Option ""  ["ye", "yEnd"] (ReqArg ((,) YEnd) "YEnd") "End of plot (y), float"+    , Option "w" ["width"]  (ReqArg ((,) PlotWidth) "Width") "Plotting width, int"+    , Option "h" ["height"] (ReqArg ((,) PlotHeight) "height") "Plotting height, int"+    , Option "" ["lx", "logwidth"] (NoArg (XLogScale,""))+                  "Plot with a logrithmic scale in x"+    , Option "" ["ly", "logheight"] (NoArg (YLogScale,""))+                  "Plot with a logrithmic scale in y"+    , Option "" ["ax", "xaxis"] (NoArg (DrawXaxis,""))+                  "Draw the X axis on the graph"+    , Option "" ["ay", "yaxis"] (NoArg (DrawYaxis,""))+                  "Draw the Y axis on the graph"+    , Option "" ["a0", "zeroaxis"] (NoArg (Draw0axis,""))+                  "Draw the 0 axis on the graph"+    , Option "" ["nlx", "nolabelx"] (NoArg (NoDrawXLabel,""))+                  "Don't draw label on x Axis"+    , Option "" ["nly", "nolabely"] (NoArg (NoDrawYLabel,""))+                  "Don't draw label on Y Axis"+    , Option "" ["lpx", "xlabelprecision"] +                (ReqArg ((,) XLabelPrecision) "p") +                "Display label on x axis with 'p' decimals"+    , Option "" ["lpy", "ylabelprecision"] +                (ReqArg ((,) YLabelPrecision) "p") +                "Display label on y axis with 'p' decimals"+    , Option "" ["spx", "labelspacingx"]+                (ReqArg ((,) XLabelSpacing) "s")+                "Put a label evry 's' chars on x axis"+    , Option "" ["spy", "labelspacingy"]+                (ReqArg ((,) YLabelSpacing) "s")+                "Put a label evry 's' chars on y axis"+    , Option "t" ["title"]+                (ReqArg ((,) PlotTitle) "t")+                "Add a title t under the graph"+    ]++preparePlotConf :: PlotConf -> (Flag, String) -> PlotConf+preparePlotConf conf (PlotWidth, val) = +    conf { xDim = (xDim conf){ projectionSize = read val } }+preparePlotConf conf (PlotHeight, val) =+    conf { yDim = (yDim conf){ projectionSize = read val }}+preparePlotConf conf (XBeg, val) =+    conf { xDim = (xDim conf){ minVal = read val }}+preparePlotConf conf (XEnd, val) =+    conf { xDim = (xDim conf){ maxVal = read val }}+preparePlotConf conf (YBeg, val) =+    conf { yDim = (yDim conf){ minVal = read val }}+preparePlotConf conf (YEnd, val) =+    conf { yDim = (yDim conf){ maxVal = read val }}+preparePlotConf conf (XLogScale, _) =+    conf { xDim = (xDim conf){ scaling = Logarithmic } }+preparePlotConf conf (YLogScale, _) =+    conf { yDim = (yDim conf){ scaling = Logarithmic } }+preparePlotConf conf (DrawXaxis, _) =+    conf { xDim = (xDim conf){ drawAxis = True } }+preparePlotConf conf (DrawYaxis, _) =+    conf { yDim = (yDim conf){ drawAxis = True } }+preparePlotConf conf (Draw0axis, _) =+    conf { draw0Axis = True }+preparePlotConf conf (NoDrawXLabel, _) =+    conf { xDim = (xDim conf){ labelEvery = Nothing } }+preparePlotConf conf (NoDrawYLabel, _) =+    conf { yDim = (yDim conf){ labelEvery = Nothing } }+preparePlotConf conf (XLabelSpacing, val) =+    conf { xDim = (xDim conf){ labelEvery = Just $ read val} }+preparePlotConf conf (YLabelSpacing, val) =+    conf { yDim = (yDim conf){ labelEvery = Just $ read val} }+preparePlotConf conf (XLabelPrecision, val) =+    conf { xDim = (xDim conf){ labelPrecision = read val} }+preparePlotConf conf (YLabelPrecision, val) =+    conf { yDim = (yDim conf){ labelPrecision = read val} }+preparePlotConf conf (PlotTitle, val) =+    conf { graphTitle = Just val }+preparePlotConf conf _ = conf+ preprocOptions :: [OptDescr (Flag, String)] preprocOptions = commonOption @@ -98,8 +204,8 @@     Io.putStr "==========================================\n\n"     hClose output     return True-     where (opt, left, _) = getOpt Permute formatOption args-           (input, outputFile) = getInputOutput opt left+     where (opt, rest, _) = getOpt Permute formatOption args+           (input, outputFile) = getInputOutput opt rest  -- | Command which just format an equation -- without affecting it's form.@@ -114,8 +220,8 @@                 hClose output                 return True)            formula-     where (opt, left, _) = getOpt Permute formatOption args-           (input, outputFile) = getInputOutput opt left+     where (opt, rest, _) = getOpt Permute formatOption args+           (input, outputFile) = getInputOutput opt rest            conf = defaultRenderConf{ useUnicode = Unicode `lookup` opt /= Nothing }  printErrors :: [(Formula TreeForm, String)] -> IO ()@@ -224,10 +330,33 @@                return . null $ errorList rez)            formulaList -     where (opt, left, _) = getOpt Permute formatOption args-           (input, outputFile) = getInputOutput opt left+     where (opt, rest, _) = getOpt Permute formatOption args+           (input, outputFile) = getInputOutput opt rest            conf = defaultRenderConf{ useUnicode = Unicode `lookup` opt /= Nothing } +plotCommand :: [String] -> IO Bool+plotCommand args = do+    formulaText <- input+    finalFile <- outputFile++    let formulaList = parseProgramm formulaText+    either (parseErrorPrint finalFile)+           (\formulal -> do+               case plot2DExpression plotConf . unTagFormula $ head formulal of+                Left err -> do+                    Io.hPutStr finalFile err+                    hClose finalFile+                    return False++                Right v -> do+                    Io.hPutStr finalFile $ charArrayToString  v+                    return True)+           formulaList+     where (opt, rest, _) = getOpt Permute (commonOption ++ plotOption) args+           plotConf = foldl' preparePlotConf defaultPlotConf +                             opt+           (input, outputFile) = getInputOutput opt rest+ printVer :: IO () printVer =      Io.putStrLn $ "EqManips " ++ version ++ " command list"@@ -308,7 +437,8 @@             , filterCommand mathMlToEqLang', commonOption)     , ("show"       , "Try to retrieve some information about supported options"             , introspect, askingOption)-    -- , ( , )+    , ("plot", "Print an ASCII-art plot of the given function"+            , plotCommand, commonOption ++ plotOption)     ]  reducedCommand :: [(String, [String] -> IO Bool)]