OldViews.hs

-----------------------------------------------------------------------------
-- Copyright 2015, Open Universiteit Nederland. This file is distributed
-- under the terms of the GNU General Public License. For more information,
-- see the file "LICENSE.txt", which is included in the distribution.
-----------------------------------------------------------------------------
-- |
-- Maintainer  :  alex.gerdes@ou.nl
-- Stability   :  provisional
-- Portability :  portable (depends on ghc)
--
-----------------------------------------------------------------------------
--  $Id: OldViews.hs 7527 2015-04-08 07:58:06Z bastiaan $

module Domain.Math.Power.OldViews
   ( powerFactorView, powerFactorViewForWith, powerFactorViewWith
   ) where

import Control.Monad
import Domain.Math.Expr hiding ( (^) )
import Ideas.Common.Rewriting
import Ideas.Common.View

powerFactorView :: View Expr (String, Expr, Int)
powerFactorView = powerFactorViewWith identity

powerFactorViewWith :: Num a => View Expr a -> View Expr (String, a, Int)
powerFactorViewWith v = makeView f g
 where
   f expr = do
      pv <- selectVar expr
      (e, n) <- match (powerFactorViewForWith pv v) expr
      return (pv, e, n)
   g (pv, e, n) = build (powerFactorViewForWith pv v) (e, n)

powerFactorViewForWith :: Num a => String -> View Expr a -> View Expr (a, Int)
powerFactorViewForWith pv v = makeView f g
 where
   f expr =
      case expr of
         Var s | pv == s -> Just (1, 1)
         Negate e -> do
            (a, b) <- f e
            return (negate a, b)
         e1 :*: e2 -> do
            (a1, b1) <- f e1
            (a2, b2) <- f e2
            return (a1*a2, b1+b2)
         Sym s [e1, Nat n]
            | isPowerSymbol s -> do
                 (a1, b1) <- f e1
                 a <- match v (build v a1 ^ toInteger n)
                 return (a, b1 * fromInteger n)
         _ -> do
            guard (withoutVar pv expr)
            a <- match v expr
            return (a, 0)

   g (a, b) = build v a .*. (Var pv .^. fromIntegral b)