Aelve Codesearch

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

total matches: more than 1000

Advise-me-0.1
24 matches
src/Domain/Math/Power/Rules.hs
calcRoot = makeRule (power, "root") $
   oneDisjunct $ \expr -> do
      (n, x) <- match (rootView >>> (integerView *** integerView)) expr
      y      <- fmap fromInteger $ lookup n $ map swap $ PF.allPowers (abs x)
      let ys | x > 0 && even n = [y, negate y]
             | x > 0 && odd  n = [y]
             | x < 0 && odd  n = [negate y]
             | otherwise       = []
      roots  <- toMaybe (not. null) ys

            
src/Domain/Math/Power/Utils.hs

sortExpr :: Expr -> Expr
sortExpr = transform $ simplifyWith (sort . map sortProd) sumView
  where sortProd = simplifyWith (fmap sort) productView

sortEquation :: Equation Expr -> Equation Expr
sortEquation (x :==: y) = if x < y then eq else flipSides eq
  where eq = sortExpr x :==: sortExpr y


            
src/Domain/Math/Power/Views.hs
consPowerView :: View Expr (Expr, (Expr, Expr))
consPowerView = makeView f g
 where
   f (Negate a) = fmap (first Negate) (f a)
   f (a :*: b)  = fmap ((,) a) (match powerView b)
   f expr       = f (1 :*: expr)
   g = build (timesView >>> second powerView)

unitPowerViewWith :: View Expr a -> View Expr (Expr, (a, Expr))
unitPowerViewWith v = makeView f g

            
src/Domain/Math/Power/Views.hs
unitPowerViewWith v = makeView f g
 where
   mv = powerViewWith v identity
   f (Negate a) = fmap (first Negate) (f a)
   f (a :*: b)  = do
         x <- match mv b
         return (a, x)
       `mplus` do
         x <- match v b

            
src/Domain/Math/Simplification.hs
   simplifyWith cfg = changeInContext $ simplifyWith cfg

instance Simplify a => Simplify (Equation a) where
   simplifyWith cfg = fmap $ simplifyWith cfg

instance Simplify a => Simplify (Relation a) where
   simplifyWith cfg = fmap $ simplifyWith cfg

instance Simplify a => Simplify [a] where
   simplifyWith cfg = fmap $ simplifyWith cfg

instance Simplify Expr where
   simplifyWith cfg = let optional p f = if p then f else id in
       optional (withSmartConstructors cfg)  (transform smart)
     . optional (withMergeAlike cfg)         mergeAlike

            
src/Domain/Math/Simplification.hs

instance (Simplify a, IsTerm a) => IsTerm (Simplified a) where
   toTerm (S x) = toTerm x
   fromTerm     = fmap simplified . fromTerm

instance (Reference a, Simplify a) => Reference (Simplified a)

simplified :: Simplify a => a -> Simplified a
simplified = S . simplify

            
src/Domain/Math/SquareRoot/Views.hs
         Nat a    -> Just (fromIntegral a)
         a :+: b  -> (+) <$> f a <*> f b
         a :-: b  -> (-) <$> f a <*> f b
         Negate a -> fmap negate (f a)
         a :*: b  -> (*) <$> f a <*> f b
         a :/: b  -> join $ safeDiv <$> f a <*> f b
         Sqrt a   -> fmap sqrtRational (match rationalView a)
         Sym s [a, b] | isPowerSymbol s ->
            power <$> f a <*> match integerView b
         _ -> fmap con (match v expr)

   power a n
      | n >= 0    = a ^ n
      | otherwise = 1 / (a ^ abs n)


            
src/Recognize/Model/Connectives.hs

-- | Negate the results of the predicate within a constraint.
negateConstraint :: Constraint EvBuilder [Attribute] -> Constraint EvBuilder [Attribute]
negateConstraint c = Constraint $ \xs -> fmap R.negate (getResult c xs)

-- Or for constraints
(<||>) :: Constraint EvBuilder [Attribute] -> Constraint EvBuilder [Attribute] -> Constraint EvBuilder [Attribute]
c1 <||> c2 = Constraint $ \xs -> do
  r1 <- getResult c1 xs

            
src/Recognize/Model/EvidenceBuilder.hs
   }

instance Functor EvBuilder where
  fmap f m = pure f <*> m

instance Applicative EvBuilder where
  pure = return
  (<*>) = ap


            
src/Recognize/Parsing/MathLexer.hs

-- | remove unwanted characters from the end
shorten :: String -> Maybe String
shorten = fmap reverse . rec . reverse
 where
   rec []  = Nothing
   rec (x:xs)
      | isSpace x = rec xs
      | x `elem` "+*<=>-–/:([{^.," = rec xs

            
src/Recognize/Parsing/Parser.hs
      return [(a, st, ss)]

instance Monad m => Functor (ParserT st s m) where
  fmap f p = return f <*> p

instance Monad m => Applicative (ParserT st s m) where
   pure a  = PT $ \st ss -> return [(a, st, ss)]
   p <*> q = bind ($) p (const q)


            
src/Recognize/Parsing/Parser.hs
bind :: Monad m => (a -> b -> c) -> ParserT st s m a -> (a -> ParserT st s m b) -> ParserT st s m c
bind mk p f = PT $ \st ss -> do
   xs <- runParserT p st ss
   fmap concat $ forM xs $ \(a, st2, ss2) -> do
      ys <- runParserT (f a) st2 ss2
      return [ (mk a b, st3, rest) | (b, st3, rest) <- ys]

------------------------------------------------------------------------------
-- Parser and instances

            
src/Recognize/Parsing/Parser.hs
type Parser s = ParserT () s Identity

runParser :: Parser s a -> [s] -> Maybe a
runParser p = fmap fst3 . listToMaybe . runIdentity . runParserT p ()

            
src/Recognize/Strategy/Rules.hs
-- >>> 2 * 2 + 4 * a = 8
-- >>> 2 + 2 * a = 4
removeTimes :: Rule (Relation Expr)
removeTimes = doAfter (fmap (collectLikeTerms . distributeAll)) $
   describe "remove times" $
   ruleTrans ("linear", "remove-times") $
   inputWith arg timesDivisionRule
 where
  -- Use transList to allow removal of factor from different variables

            
src/Recognize/Strategy/Rules.hs
            Nothing -> (r, e)

timesDivisionRule :: Functor f => ParamTrans Expr (f Expr)
timesDivisionRule = parameter1 factorRef $ \a -> unlessZero a . fmap (\b -> b :*: (1 :/: a))

unlessZero :: Expr -> a -> Maybe a
unlessZero e a = do
   r <- matchM rationalView e
   guard (r /= 0)

            
src/Recognize/Strategy/Views.hs
approxRelView :: Functor f => View (f Expr) (f Expr)
approxRelView = makeView f g
  where
    f rel = return $ fmap (nf4 1) rel
    g = id

-- | Views all relation types as an equality relation
relEqualityView :: View (Relation Expr) (Relation Expr)
relEqualityView = makeView f g

            
src/Task/MakingASquare.hs
--These steps have to be parsed so that the hyp step cannot be detected twice. First see if both have been completed: if not, see
--if one of them has been completed.
pAlgebraic :: InterpretationParser (Approach,[Step])
pAlgebraic = fmap ((,) Algebraic) $
   do {x <- hyp True;  y <- bigsq; _ <- many' skip; return [x,y]} |>
   do {y <- bigsq;     _ <- many' skip; return [y]} |>
   do {x <- hyp False; _ <- many' skip; return [x]}
   --
   where

            
src/Task/Matryoshka/Recognizer.hs
removeUnit :: MathParserOutput -> MathParserOutput
removeUnit (MathParserOutput mpo che) = MathParserOutput (map math mpo) che
  where
    math (M t eth) = M t $ fmap (transform expr) eth
    expr e = case e of
      (a :*: Var "cm") -> a
      _ -> e

-- If a student at least once writes a*b% and we beyond that encounter more

            
src/Task/Matryoshka/Recognizer.hs
  where
    findPercentage [] = Nothing
    findPercentage (m:ms) = msum [findPercentage' m, findPercentage ms]
    findPercentage' (M _ eth) = join $ either (const Nothing) Just $ fmap (para (\e' rs ->
      let mb = case e' of
                (_ :*: b :/: 100) -> Just b
                _ -> Nothing
      in msum (mb : rs))) eth
    modMaths mp = map (modMath mp)

            
src/Task/Matryoshka/Recognizer.hs
                _ -> Nothing
      in msum (mb : rs))) eth
    modMaths mp = map (modMath mp)
    modMath mp (M t eth) = M t $ fmap (modExpr mp) eth
    modExpr Nothing e = e
    modExpr mp@(Just p) e
      | hasExpr 100 e = e
      | otherwise = case (e, getFunction e) of
          (a :*: b,_)

            
src/Task/Pattern/Recognizer.hs
modifyInput :: MathParserOutput -> MathParserOutput
modifyInput (MathParserOutput mpo che) = MathParserOutput (map math mpo) che
  where
    math (M t ethe) = M t $ fmap remVar ethe
    -- For this exercise we wish to remove expressions such as 15*th, which could have been written as 15th
    -- We are fairly certain that in this exercise the variables in singular expressions such as the one above
    -- are meaningless and may be removed. If this appears not the be the case, then this function should be removed.
    remVar (e :*: Var _) = e
    remVar e = e

            
src/Task/TheatreRate/Recognizer.hs
modifyInput :: MathParserOutput -> MathParserOutput
modifyInput (MathParserOutput mpo che) = MathParserOutput (map math mpo) che
  where
    math (M t ethe) = M t $ fmap (transform exprDiv . transform expr) ethe
    expr e = case e of
      (Var "r" :*: 1) -> Var "r1"
      (Var "r" :*: 2) -> Var "r2"
      (Var "R" :*: 1) -> Var "R1"
      (Var "R" :*: 2) -> Var "R2"

            
src/Util/Cache.hs
showCache :: IO String
showCache = do
   xs <- readIORef register 
   fmap unlines $ forM xs $ \c -> do 
      n <- readIORef (counter c)
      m <- readIORef (cache c)
      let sz   = M.size m
          line = replicate 50 '-'
          f (a, b) = showKey c a ++ ": " ++ showValue c b

            
src/Util/Expr.hs

-- helper
mIf :: Applicative m => m Bool -> m a -> m a -> m a
mIf = (flip . fmap flip) (liftA3 bool)

            
Agata-0.2.1.1
6 matches
Test/Agata/Common.hs

type Improving a = StateT (Int, Int, [Int]) Gen a
currentDimension :: Improving (Dimension a)
currentDimension = return `fmap` getLevel where
  getLevel :: Improving Int
  getLevel = gets $ \(l,r,ss) -> l
request :: Improving ()
request = modify $ \(l,r,ss) -> (l,r+1,ss)
acquire :: Improving Int

            
Test/AgataTH.hs
echoAgata s n =  agatath (derive  n) >>= (\r -> return [FunD (mkName s) [Clause [] (NormalB $ LitE $ StringL r)  []]]) . dump

agatath :: Derivation -> Q [Dec]
agatath der@(Derivation ts ss) = fmap concat $ mapM deriveAgata ts where
  isSet o = o `Set.member` ss
  deriveAgata n = do
    i@(TyConI d)  <-  reify n
  
    nns <- replicateM (length $ dParams d) (newName "a")

            
Test/AgataTH.hs
    nns <- replicateM (length $ dParams d) (newName "a")
    nns1 <- replicateM (length $ dParams d) (newName "b") -- >>= mapM unVarBndr
    let vs = map VarT nns
    expanded <- fmap reTuple $ expand n nns1

    m@[InstanceD [] (AppT (ConT cBuildable_) _) [ValD (VarP improve_) _ _,ValD (VarP build_) _ _,ValD (VarP dimension_) (NormalB (SigE (AppE rerelate_ _) (AppT tDimension_ _))) []]] <-
       [d| instance Buildable T1 where
             improve = undefined
             build = undefined

            
Test/AgataTH.hs
       |]

    impbody <- mapM impClause (dConsts d)
    buildbody <- fmap NormalB $ bldClauses (dConsts d) -- mapM (bldClause t) (dConsts d) >>= return . NormalB . ListE

    allTypesT_t <- fmap (nub . concat) $ mapM (recs n . cFields) (dConsts d)
  
  
    let 
      isRecursive = Mut `elem` allTypesT_t
      dimplus = InfixE (Just $ VarE dimension_)  (VarE $ mkName "+") (Just (LitE (IntegerL 1)))

            
Test/AgataTH.hs


contains :: Type -> Name -> Q Bool
contains t n = fmap (Set.member n) $ allTypesT t

flat :: Type -> (Type,[Type])
flat = flat' where
  flat' (AppT t1 t2) = case flat' t1 of
    (t,ts) -> (t,ts++[t2])

            
Test/AgataTH.hs


expand :: Name -> [Name] -> Q Type
expand n0 ns = fmap simplify $ applic [] (getType n0 ns) where
  applic :: [(Type,[Type])] -> Type -> Q Type
  applic nts t0 = do
    b <- t0 `contains` n0
    if not b then return t0 else case flat t0 of
      (TupleT _,ts) -> fmap toTuple $ mapM (applic nts) ts