Aelve Codesearch

grep over package repositories
Please provide a string to search for.
3+ characters are required.
Index updated about an hour ago

total matches: more than 1000

Advise-me-0.1
30 matches
src/Domain/Math/Equation/CoverUpRules.hs
   return (a, b) `mplus` return (b, a)

flipOp :: Monad m => m (a, a) -> m (a, a)
flipOp = fmap (\(x, y) -> (y, x))

isNat :: MonadPlus m => Expr -> m Integer
isNat (Nat n) = return n
isNat _       = mzero

            
src/Domain/Math/Numeric/Generators.hs
ratioExprGen n = fromRational <$> ratioGen n (n `div` 4)

ratioExprGenNonZero :: Int -> Gen Expr
ratioExprGenNonZero n = fmap fromRational $ nonZero $ ratioGen n (n `div` 4)

nonZero :: (Eq a,Num a) => Gen a -> Gen a
nonZero = fmap (\a -> if a==0 then 1 else a)

numSymbols :: [(Symbol, Maybe Int)]
numSymbols = (negateSymbol, Just 1)
           : zip [plusSymbol, timesSymbol, minusSymbol] (repeat (Just 2))


            
src/Domain/Math/Numeric/Rules.hs
fractionPlusScale :: Rule Expr -- also minus
fractionPlusScale = makeRule (alg, "fraction-plus-scale") $ \expr -> do
   (e1, e2) <- matchM plusView expr
   (a, b)   <- matchM fractionForm e1 <|> fmap (\n -> (n, 1)) (matchM integerNF e1)
   (c, d)   <- matchM fractionForm e2 <|> fmap (\n -> (n, 1)) (matchM integerNF e2)
   guard (b /= 0 && d /= 0 && b /= d)
   let bd  = lcm b d
       e1n = build fractionForm (a * (bd `div` b), bd)
       e2n = build fractionForm (c * (bd `div` d), bd)
   [ build plusView (e1n, e2) | b /= bd ] ++ [

            
src/Domain/Math/Numeric/Rules.hs
fractionTimes = makeRule (alg, "fraction-times") f
 where
   f (e1 :*: e2) = do
      (a, b)   <- matchM fractionForm e1 <|> fmap (\n -> (n, 1)) (matchM integerNF e1)
      (c, d)   <- matchM fractionForm e2 <|> fmap (\n -> (n, 1)) (matchM integerNF e2)
      return (build fractionForm (a*c, b*d))
   f _ = Nothing

fractionTimesCancelNomDen :: Rule Expr
fractionTimesCancelNomDen = makeRule (alg, "fraction-times-cancel-denominator-nominator") f

            
src/Domain/Math/Numeric/Rules.hs
fractionTimesCancelNomDen = makeRule (alg, "fraction-times-cancel-denominator-nominator") f
 where
   f (e1 :*: e2) = do
      (a, b)   <- matchM fractionForm e1 <|> fmap (\n -> (n, 1)) (matchM integerNF e1)
      (c, d)   <- matchM fractionForm e2 <|> fmap (\n -> (n, 1)) (matchM integerNF e2)
      guard (a==d)
      return (build fractionForm (c, b))
   f _ = Nothing

fractionTimesCancelDenNom :: Rule Expr

            
src/Domain/Math/Numeric/Rules.hs
fractionTimesCancelDenNom = makeRule (alg, "fraction-times-cancel-nominator-denominator") f
 where
   f (e1 :*: e2) = do
      (a, b)   <- matchM fractionForm e1 <|> fmap (\n -> (n, 1)) (matchM integerNF e1)
      (c, d)   <- matchM fractionForm e2 <|> fmap (\n -> (n, 1)) (matchM integerNF e2)
      guard (b==c)
      return (build fractionForm (a, d))
   f _ = Nothing

            
src/Domain/Math/Polynomial/Balance.hs
   , extraRules    = map use buggyBalanceRules ++ map use buggyBalanceExprRules
   , ruleOrdering  = ruleOrderingWith (balanceOrder ++ buggyPriority)
   , navigation    = termNavigator
   , examples      = fmap singleton linearExamples
                     <> forTesting (random (liftM2 (\a b -> singleton (a :==: b)) (sized linearGen) (sized linearGen)))
   }

balanceOrder :: [Id]
balanceOrder =

            
src/Domain/Math/Polynomial/Balance.hs

-- factor is always positive due to lcm function
removeDivision :: Rule (Equation Expr)
removeDivision = doAfter (fmap distributeTimes) $
   describe "remove division" $
   ruleTrans (linbal, "remove-div") $
   inputWith removeDivisionArg timesRule
 where
   removeDivisionArg = makeTrans $ \(lhs :==: rhs) -> do

            
src/Domain/Math/Polynomial/Balance.hs
      return (fromRational (1/r)*a)

divideCommonFactor :: Rule (Equation Expr)
divideCommonFactor = doAfter (fmap distributeDiv) $
   describe "divide by common factor" $
   ruleTrans (linbal, "smart-div") $
   inputWith (transMaybe getArg) divisionRule
 where
   getArg (lhs :==: rhs)

            
src/Domain/Math/Polynomial/Balance.hs
varLeftPlus  = varLeft False (linbal, "var-left-plus")

varLeft :: IsId a => Bool -> a -> Rule (Equation Expr)
varLeft useMinus rid = doAfter (fmap collectLocal) $
   ruleTrans rid $
   inputWith varLeftArg (if useMinus then minusRule else plusRule)
 where
    varLeftArg = transMaybe $ \(lhs :==: rhs) -> do
       guard (hasSomeVar lhs)

            
src/Domain/Math/Polynomial/Balance.hs
conRightPlus  = conRight False (linbal, "con-right-plus")

conRight :: IsId a => Bool -> a -> Rule (Equation Expr)
conRight useMinus rid = doAfter (fmap collectLocal) $
   ruleTrans rid $
   inputWith conRightArg (if useMinus then minusRule else plusRule)
 where
    conRightArg = transMaybe $ \(lhs :==: _) -> do
       guard (hasSomeVar lhs)

            
src/Domain/Math/Polynomial/Balance.hs
   flipView = makeView (Just . flipSides) flipSides

scaleToOne :: Rule (Equation Expr)
scaleToOne = doAfter (fmap distributeDiv) $
   ruleTrans (linbal, "scale-to-one") $
   inputWith scaleToOneArg divisionRule
 where
   scaleToOneArg = transMaybe $ \(lhs :==: rhs) -> f lhs rhs `mplus` f rhs lhs


            
src/Domain/Math/Polynomial/Balance.hs
collect :: Rule (Equation Expr)
collect = makeRule (linbal, "collect") $
   -- don't use this rule just for cleaning up
   checkForChange (Just . fmap collectGlobal) . fmap cleanerExpr

distribute :: Rule (Equation Expr)
distribute = makeRule (linbal, "distribute") $ checkForChange $
   Just . fmap (fixpoint f)
 where
   f (a :*: (b :+: c))  = f (a*b + a*c)
   f (a :*: (b :-: c))  = f (a*b - a*c)
   f ((a :+: b) :*: c)  = f (a*c + b*c)
   f ((a :-: b) :*: c)  = f (a*c - b*c)

            
src/Domain/Math/Polynomial/BalanceUtils.hs
import Ideas.Utils.Uniplate

eqView :: View (WithBool (Equation Expr)) (WithBool (String, Rational))
eqView = makeView (either (Just . fromBool) f . fromWithBool) (fmap g)
 where
   f (lhs :==: rhs) = do
      (s, p) <- match (polyViewWith rationalApproxView) (lhs-rhs)
      case degree p of
         0 -> Just $ fromBool $ coefficient 0 p == 0

            
src/Domain/Math/Polynomial/BalanceUtils.hs
-- Strategy

cleaner :: WithBool (Equation Expr) -> WithBool (Equation Expr)
cleaner = fmap (fmap cleanerExpr)

cleanerExpr :: Expr -> Expr
cleanerExpr = transform f -- no fixpoint is needed
 where
   f (a :/: Nat 1) = f a

            
src/Domain/Math/Polynomial/BalanceUtils.hs
distributeDiv :: Expr -> Expr
distributeDiv expr = fromMaybe expr $ do
   (a, r) <- match (divView >>> second rationalView) expr
   return $ simplifyWith (fmap (`divide` r)) simpleSumView a
 where
   divide x r = fromMaybe (x/fromRational r) $ do
      (y, z) <- match (timesView >>> first rationalView) x
      new    <- y `safeDiv` r
      return (fromRational new * z)

            
src/Domain/Math/Polynomial/BalanceUtils.hs
   (r, a) <- match (timesView >>> first rationalView) expr
              `mplus`
             match (timesView >>> second rationalView >>> toView swapView) expr
   return $ simplifyWith (fmap (times r)) simpleSumView a
 where
   times r x = fromMaybe (fromRational r*x) $ do
      (a, b) <- match (divView >>> second rationalView) x
      guard (b /= 0)
      return (fromRational (r/b) * a)

            
src/Domain/Math/Polynomial/BuggyRules.hs

-- Redundant function; should come from exercise
myEq :: Equation Expr -> Equation Expr -> Bool
myEq = let eqR f x y = fmap f x == fmap f y in eqR (acExpr . cleanUpExpr)

---------------------------------------------------------
-- Quadratic and Higher-Degree Polynomials

buggyQuadratic :: IsTerm a => [Rule (Context a)]

            
src/Domain/Math/Polynomial/RationalRules.hs
turnIntoFraction :: Rule Expr
turnIntoFraction = liftView plusView $
   makeRule (ratId, "to-rational") $ \(a, b) ->
      fmap (\c -> (c, b)) (f a b) <|>
      fmap (\c -> (a, c)) (f b a)
 where
   f a b = do
      guard (not (a `belongsTo` divView))
      (_, e) <- match divView b
      return $ build divView (a*e, e)

            
src/Domain/Math/Polynomial/RationalRules.hs
 where
   f  = pushNotWith (Logic.Var . notRelation) . Not
   eq = expr :==: 0
   xs = fmap (build equationView . fmap cleanUpExpr) $
        case match higherDegreeEquationsView (singleton eq) of
           Just ys -> build orListView (coverUpOrs (build higherDegreeEquationsView ys))
           Nothing -> Logic.Var (coverUp eq)

            
src/Domain/Math/Polynomial/Rules.hs

   -- high exponents first, non power-factor terms at the end
   sorted = simplifyWith (sortBy (comparing toPF)) sumView
   toPF   = fmap (negate . thd3) . match powerFactorView

ruleApproximate :: Rule (Relation Expr)
ruleApproximate = describe "Approximate irrational number" $
   makeRule (quadreq, "approx") $ \relation -> do
      lhs :==: rhs <- match equationView relation

            
src/Domain/Math/Polynomial/Rules.hs
-- Rewrite Rules

varToLeft :: Rule (Relation Expr)
varToLeft = doAfter (fmap collectLikeTerms) $
   describe "variable to left" $
   ruleTrans (lineq, "var-left") $
   inputWith arg minusRule 
 where
   arg = transMaybe $ \eq -> do

            
src/Domain/Math/Polynomial/Rules.hs

-- factor is always positive due to lcm function
removeDivision :: Rule (Relation Expr)
removeDivision = doAfter (fmap (collectLikeTerms . distributeAll)) $
   describe "remove division" $
   ruleTrans (lineq, "remove-div") $
   inputWith arg timesRule 
 where
   arg = transMaybe $ \eq -> do

            
src/Domain/Math/Polynomial/Rules.hs
distributeTimes :: Rule Expr
distributeTimes = describe "distribution multiplication" $
   makeRule (lineq, "distr-times") $
      fmap collectLikeTerms . distribution

distributeDivisionMulti :: IsTerm a => Rule (Context a)
distributeDivisionMulti = describe "distribution division" $
   makeRule (quadreq, "distr-div") $ apply $ repeat1 $
      somewhere (use (makeRule () distributeDivisionT))

            
src/Domain/Math/Polynomial/Rules.hs
   g (a, r) = build v a :==: build rationalView r

bothSidesView :: View a b -> View (Equation a) (Equation b)
bothSidesView v = makeView f (fmap (build v))
 where
   f (lhs :==: rhs) = (:==:) <$> match v lhs <*> match v rhs

findFactor :: Monad m => [Rational] -> m Rational
findFactor rs

            
src/Domain/Math/Polynomial/Views.hs
            p <- f a
            d <- match rationalApproxView b
            guard (d /= 0)
            return (fmap (/fromRational d) p)
         Sym s [a, n] | isPowerSymbol s ->
            (Prelude.^) <$> f a <*> matchNat n
         _ -> do
            guard (withoutVar pv expr)
            return (con expr)

            
src/Domain/Math/Polynomial/Views.hs
linearEquationView = linearEquationViewWith rationalApproxView

quadraticEquationsView:: View (OrList (Equation Expr)) (OrList (String, SQ.SquareRoot Rational))
quadraticEquationsView = makeView f (fmap g)
 where
   f = fmap (simplify orSetView . foldMap id)
          . mapM (match quadraticEquationView)

   g (x, a) = Var x :==: build (squareRootViewWith rationalApproxView) a

quadraticEquationView :: View (Equation Expr) (OrList (String, SQ.SquareRoot Rational))

            
src/Domain/Math/Polynomial/Views.hs
   f (lhs :==: rhs) = do
      (s, p) <- match (polyViewWith (squareRootViewWith rationalApproxView)) (lhs - rhs)
      guard (degree p <= 2)
      fmap (fmap ((,) s)) $
         case fromPolynomial p of
            [a, b, c] -> do
               discr <- SQ.fromSquareRoot (b*b - SQ.scale 4 (a*c))
               let sdiscr = SQ.sqrtRational discr
                   twoA   = SQ.scale 2 a

            
src/Domain/Math/Polynomial/Views.hs
      make (x, a) = Var x .-. build (squareRootViewWith rationalApproxView) a

higherDegreeEquationsView :: View (OrList (Equation Expr)) (OrList Expr)
higherDegreeEquationsView = f <-> fmap (:==: 0)
 where
   f    = simplify orSetView . foldMap make . coverUpOrs
   make = toOrList . filter (not . hasNegSqrt)
        . map (cleanUpExpr . distr) . normHDE . sub
   sub (a :==: b) = a-b

            
src/Domain/Math/Power/Rules.hs
calcPlainRoot :: Rule Expr
calcPlainRoot = makeRule (power, "root") $ \expr -> do
   (n, x) <- matchM (rootView >>> (integerView *** integerView)) expr
   fmap fromInteger (takeRoot n x)

-- | [root n x, ... ]
-- BHR: not used. Better to turn this into OrList (Relation Expr)
{-
calcRoot :: Rule (OrList Expr)