<commit_before>-----------------------------------------------------------------------------
-- Copyright 2010, 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  :  <EMAIL>
-- Stability   :  provisional
-- Portability :  portable (depends on ghc)
--
-----------------------------------------------------------------------------
module Domain.Math.Polynomial.Balance (balanceExercise) where

import Common.Library
import Common.Uniplate
import Common.Utils (fixpoint, safeHead)
import Control.Monad
import Data.Function
import Data.Maybe
import Domain.Math.CleanUp
import Domain.Math.Data.Polynomial
import Domain.Math.Data.Relation
import Domain.Math.Equation.BalanceRules
import Domain.Math.Equation.Views
import Domain.Math.Expr
import Domain.Math.Numeric.Views
import Domain.Math.Polynomial.Examples
import Domain.Math.Polynomial.Views
import Domain.Math.Simplification
import qualified Data.Traversable as T

------------------------------------------------------------
-- Exercise

balanceExercise :: Exercise (Equation Expr)
balanceExercise = makeExercise 
   { exerciseId   = describe "Solve a linear equation using only balance rules." $ 
                    newId "algebra.equations.linear.balance"
   , status       = Provisional
   , parser       = parseEqExpr
   , similarity   = withoutContext ((==) `on` fmap cleanUpExpr)
   , equivalence  = withoutContext (viewEquivalent linearEquationView)
   , isSuitable   = (`belongsTo` linearEquationView)
   , isReady      = solvedRelationWith $ \a -> 
                       a `belongsTo` mixedFractionNormalForm || 
                       a `belongsTo` rationalNormalForm
   , strategy     = linearStrategy
   , ruleOrdering = ruleOrderingWithId [getId removeDivision]
   , navigation   = termNavigator
   , examples     = linearExamples
   }
      
------------------------------------------------------------
-- Strategy

linearStrategy :: LabeledStrategy (Context (Equation Expr))
linearStrategy = cleanUpStrategy (applyTop (fmap cleanUpExpr)) $
   label "Linear Equation" $
       label "Phase 1" (repeatS (
               use collect
           |>  (use distribute <|> use removeDivision)))
   <*> label "Phase 2" (repeatS (
              use varToLeft <|> use conToRight)
          <*> try (use scaleToOne))

------------------------------------------------------------
-- Rules

linbal :: String
linbal = "algebra.equations.linear.balance"
  
-- factor is always positive due to lcm function
removeDivision :: Rule (Equation Expr)
removeDivision = doAfter (fmap distributeLocal) $
   describe "remove division" $ 
   makeRule (linbal, "remove-div") $ useRecognizer isTimesT $
   supply1 "factor" removeDivisionArg timesT 
 where
   removeDivisionArg (lhs :==: rhs) = do
      xs <- match sumView lhs
      ys <- match sumView rhs
      -- also consider parts without variables
      -- (but at least one participant should have a variable)
      zs <- forM (xs ++ ys) $ \a -> do
               (_, list) <- match productView a
               return [ (hasSomeVar a, e) | e <- list ]
      let f (b, e) = do 
             (_, this) <- match (divView >>> second integerView) e
             return (b, this)
          (bs, ns) = unzip (mapMaybe f (concat zs))
      guard (or bs)
      return (fromInteger (foldr1 lcm ns))

varToLeft :: Rule (Equation Expr)
varToLeft = doAfter (fmap collectLocal) $
   makeRule (linbal, "var-left") $ useRecognizer isPlusT $
   supply1 "term" varToLeftArg minusT
 where
    varToLeftArg :: Equation Expr -> Maybe Expr
    varToLeftArg (_ :==: rhs) = do
       (x, a, _) <- matchLin rhs
       guard (a /= 0)
       return (fromRational a * Var x)

conToRight :: Rule (Equation Expr)
conToRight = doAfter (fmap collectLocal) $
   makeRule (linbal, "con-to-right") $ useRecognizer isPlusT $
   supply1 "term" conToRightArg minusT
 where
    conToRightArg :: Equation Expr -> Maybe Expr
    conToRightArg (lhs :==: _) = do
       (_, _, b) <- matchLin lhs
       guard (b /= 0)
       return (fromRational b)

scaleToOne :: Rule (Equation Expr)
scaleToOne = doAfter (fmap distributeLocal) $ 
   makeRule (linbal, "scale-to-one") $ useRecognizer isTimesT $ 
   supply1 "factor" scaleToOneArg divisionT
 where
   scaleToOneArg :: Equation Expr -> Maybe Expr
   scaleToOneArg (lhs :==: rhs) = do
      (_, a1, b1) <- matchLin lhs
      guard (a1 /= 0 && a1 /= 1 && b1 == 0 && hasNoVar rhs)
      return (fromRational a1)
      
collect :: Rule (Equation Expr)
collect = makeSimpleRule (linbal, "collect") $ \old -> do
   let new = fmap collectGlobal old
   guard (old /= new)
   return new
   <commit_msg>kleine tweak linear equation balance strategy<commit_after>-----------------------------------------------------------------------------
-- Copyright 2010, 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  :  <EMAIL>
-- Stability   :  provisional
-- Portability :  portable (depends on ghc)
--
-----------------------------------------------------------------------------
module Domain.Math.Polynomial.Balance (balanceExercise) where

import Common.Library
import Common.Uniplate
import Common.Utils (fixpoint, safeHead)
import Control.Monad
import Data.Function
import Data.Maybe
import Domain.Math.CleanUp
import Domain.Math.Data.Polynomial
import Domain.Math.Data.Relation
import Domain.Math.Equation.BalanceRules
import Domain.Math.Equation.Views
import Domain.Math.Expr
import Domain.Math.Numeric.Views
import Domain.Math.Polynomial.Examples
import Domain.Math.Polynomial.Views
import Domain.Math.Simplification
import qualified Data.Traversable as T

------------------------------------------------------------
-- Exercise

balanceExercise :: Exercise (Equation Expr)
balanceExercise = makeExercise 
   { exerciseId   = describe "Solve a linear equation using only balance rules." $ 
                    newId "algebra.equations.linear.balance"
   , status       = Provisional
   , parser       = parseEqExpr
   , similarity   = withoutContext ((==) `on` fmap cleanUpExpr)
   , equivalence  = withoutContext (viewEquivalent linearEquationView)
   , isSuitable   = (`belongsTo` linearEquationView)
   , isReady      = solvedRelationWith $ \a -> 
                       a `belongsTo` mixedFractionNormalForm || 
                       a `belongsTo` rationalNormalForm
   , strategy     = linearStrategy
   , ruleOrdering = ruleOrderingWithId [getId removeDivision]
   , navigation   = termNavigator
   , examples     = linearExamples
   }
      
------------------------------------------------------------
-- Strategy

linearStrategy :: LabeledStrategy (Context (Equation Expr))
linearStrategy = cleanUpStrategy (applyTop (fmap cleanUpExpr)) $
   label "Linear Equation" $
       label "Phase 1" (repeatS (
               use collect
           |>  (use distribute <|> use removeDivision)))
   <*> label "Phase 2" (repeatS (
              use varToLeft <|> use conToRight)
          <*> try (use scaleToOne))

------------------------------------------------------------
-- Rules

linbal :: String
linbal = "algebra.equations.linear.balance"
  
-- factor is always positive due to lcm function
removeDivision :: Rule (Equation Expr)
removeDivision =
   describe "remove division" $ 
   makeRule (linbal, "remove-div") $ useRecognizer isTimesT $
   supply1 "factor" removeDivisionArg timesT 
 where
   removeDivisionArg (lhs :==: rhs) = do
      xs <- match sumView lhs
      ys <- match sumView rhs
      -- also consider parts without variables
      -- (but at least one participant should have a variable)
      zs <- forM (xs ++ ys) $ \a -> do
               (_, list) <- match productView a
               return [ (hasSomeVar a, e) | e <- list ]
      let f (b, e) = do 
             (_, this) <- match (divView >>> second integerView) e
             return (b, this)
          (bs, ns) = unzip (mapMaybe f (concat zs))
      guard (or bs)
      return (fromInteger (foldr1 lcm ns))

varToLeft :: Rule (Equation Expr)
varToLeft = doAfter (fmap collectLocal) $
   makeRule (linbal, "var-left") $ useRecognizer isPlusT $
   supply1 "term" varToLeftArg minusT
 where
    varToLeftArg :: Equation Expr -> Maybe Expr
    varToLeftArg (_ :==: rhs) = do
       (x, a, _) <- matchLin rhs
       guard (a /= 0)
       return (fromRational a .*. Var x)

conToRight :: Rule (Equation Expr)
conToRight = doAfter (fmap collectLocal) $
   makeRule (linbal, "con-to-right") $ useRecognizer isPlusT $
   supply1 "term" conToRightArg minusT
 where
    conToRightArg :: Equation Expr -> Maybe Expr
    conToRightArg (lhs :==: _) = do
       (_, _, b) <- matchLin lhs
       guard (b /= 0)
       return (fromRational b)

scaleToOne :: Rule (Equation Expr)
scaleToOne = doAfter (fmap distributeLocal) $ 
   makeRule (linbal, "scale-to-one") $ useRecognizer isTimesT $ 
   supply1 "factor" scaleToOneArg divisionT
 where
   scaleToOneArg :: Equation Expr -> Maybe Expr
   scaleToOneArg (lhs :==: rhs) = do
      (_, a1, b1) <- matchLin lhs
      guard (a1 /= 0 && a1 /= 1 && b1 == 0 && hasNoVar rhs)
      return (fromRational a1)
      
collect :: Rule (Equation Expr)
collect = makeSimpleRule (linbal, "collect") $ \old -> do
   let new = fmap collectGlobal old
   guard (old /= new)
   return new
   
{'fraction_non_alphanumeric': 0.17741769016410364, 'fraction_numerical': 0.00454123232531737, 'mean_word_length': 2.1077613855035278, 'pattern_counts': {'":': 0, '<': 31, '<?xml version=': 0, '>': 33, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5434531', 'n_tokens_mistral': 2826, 'n_tokens_neox': 2676, 'n_words': 830}