countdown-numbers-game (empty) → 0.0
raw patch · 9 files changed
+615/−0 lines, 9 filesdep +QuickCheckdep +basedep +doctest-exitcode-stdiosetup-changed
Dependencies added: QuickCheck, base, doctest-exitcode-stdio, doctest-lib, non-empty, optparse-applicative, utility-ht
Files
- LICENSE +30/−0
- Makefile +7/−0
- Setup.hs +2/−0
- countdown-numbers-game.cabal +78/−0
- src/Main.hs +27/−0
- src/Solve.hs +188/−0
- test/Test/Solve.hs +81/−0
- test/Test/Utility.hs +192/−0
- test/TestMain.hs +10/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2025, Henning Thielemann++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Henning Thielemann nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Makefile view
@@ -0,0 +1,7 @@+run-test: update-test+ runhaskell Setup configure --user --enable-tests+ runhaskell Setup build+ runhaskell Setup test countdown-numbers-test --show-details=streaming++update-test:+ doctest-extract-0.1 -i src/ -o test/ --executable-main=TestMain.hs Solve
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ countdown-numbers-game.cabal view
@@ -0,0 +1,78 @@+Name: countdown-numbers-game+Version: 0.0+Synopsis: Solve problems from the number round of the Countdown game show+Description:+ Solver for the numbers round of the Countdown game show:+ .+ * <https://en.wikipedia.org/wiki/Countdown_(game_show)>+ .+ * <https://www.youtube.com/watch?v=pfa3MHLLSWI>+ .+ That is, given six numbers and a target number,+ find an arithmetical expression containing exactly those six numbers+ that yields the target number.+ The solver however is neither limited to a certain number of operands+ nor to a certain magnitude of numbers+ nor to uniqueness of the operands.+ Please note, that the solver also emits solutions+ where not all of the given operands are used.+ .+ Example:+ .+ > $ countdown-numbers-solve 23 42 3 4 5 --result 777+ > (23*3+5)*42/4+ .+ The solver employs a brute-force search,+ but ensures that expressions are unique up to commutativity and associativity.+ It determines all solutions of a problem within seconds.+Homepage: https://hub.darcs.net/thielema/countdown-numbers-game+License: BSD3+License-File: LICENSE+Author: Henning Thielemann+Maintainer: haskell@henning-thielemann.de+Category: Math+Build-Type: Simple+Cabal-Version: >=1.10++Extra-Source-Files:+ Makefile++Source-Repository this+ Tag: 0.0+ Type: darcs+ Location: https://hub.darcs.net/thielema/countdown-numbers-game++Source-Repository head+ Type: darcs+ Location: https://hub.darcs.net/thielema/countdown-numbers-game++Executable countdown-numbers-solve+ Build-Depends:+ optparse-applicative >=0.11 && <0.19,+ non-empty >=0.3.2 && <0.4,+ utility-ht >=0.0.11 && <0.1,+ base >=4.5 && <5+ Default-Language: Haskell2010+ GHC-Options: -Wall+ Hs-Source-Dirs: src+ Main-is: Main.hs+ Other-Modules: Solve++Test-Suite countdown-numbers-test+ Type: exitcode-stdio-1.0+ Build-Depends:+ doctest-exitcode-stdio >=0.0 && <0.1,+ doctest-lib >=0.1 && <0.2,+ -- 2.8 for 'shuffle'+ QuickCheck >=2.8 && <3,+ non-empty >=0.3.2 && <0.4,+ utility-ht >=0.0.11 && <0.1,+ base >=4.5 && <5+ Default-Language: Haskell2010+ GHC-Options: -Wall+ Hs-Source-Dirs: src, test+ Main-is: TestMain.hs+ Other-Modules:+ Test.Solve+ Test.Utility+ Solve
+ src/Main.hs view
@@ -0,0 +1,27 @@+module Main where++import qualified Solve++import qualified Options.Applicative as OP++++options :: OP.Parser ([Integer], Integer)+options =+ OP.liftA2 (,)+ (OP.many $+ OP.argument OP.auto+ (OP.help "given operand" <> OP.metavar "INTEGER"))+ (OP.option OP.auto+ (OP.help "wanted result" <> OP.long "result" <> OP.metavar "INTEGER"))++description :: OP.InfoMod a+description =+ OP.fullDesc+ <>+ OP.progDesc "Solve problems from the number round of the Countdown game show"++main :: IO ()+main = do+ problem <- OP.execParser $ OP.info (OP.helper <*> options) description+ mapM_ (putStrLn . Solve.format) $ Solve.run problem
+ src/Solve.hs view
@@ -0,0 +1,188 @@+module Solve where++import qualified Data.NonEmpty as NonEmpty+import qualified Data.List.HT as ListHT+import qualified Data.List as List+import Data.NonEmpty ((!:))+import Data.Traversable (traverse)+import Data.Tuple.HT (mapPair, mapFst)++import Control.Monad (liftM2, guard, mfilter)++{- $setup+>>> import qualified Solve+>>> import qualified Data.List as List+>>> import Data.Eq.HT (equating)+>>> import Control.Functor.HT (void)+>>> import Test.Utility+>>> (solve, genOperands, genResult, genEquation,+>>> normalizeSubExpr, normalizeSum)+>>> import qualified Test.QuickCheck as QC+-}+++type NEList = NonEmpty.T []++{- |+The 'Ord' instance is needed for normalization in the tests+but does not refer to the value of the expression.+In order to prevent accidental use of '==' or '<'+we would have to implement those functions manually,+which is possible but a bit cumbersome.+-}+data SubExpr a = Number Integer | SubExpr a+ deriving (Eq, Ord, Show)+data Sum =+ Sum {positive :: NEList (SubExpr Product), negative :: [SubExpr Product]}+ deriving (Eq, Ord, Show)+data Product =+ Product {normal :: NEList (SubExpr Sum), reciprocal :: [SubExpr Sum]}+ deriving (Eq, Ord, Show)+++split :: [a] -> [([a],[a])]+split =+ map (mapPair (map fst, map fst) . List.partition snd) .+ sequence . flip (ListHT.outerProduct (,)) [True, False]++neSplit :: NEList a -> [(NEList a, [a])]+neSplit (NonEmpty.Cons x xs) =+ map (mapFst (NonEmpty.Cons x)) $ split xs++splitMultiOrdered :: [a] -> [[NEList a]]+splitMultiOrdered [] = return []+splitMultiOrdered (x:xs) = do+ (ys,zs) <- neSplit (x!:xs)+ map (ys:) $ splitMultiOrdered zs++neSplitMultiOrdered :: [a] -> [(NEList (NEList a), [a])]+neSplitMultiOrdered xs = do+ (us,w,ws) <- ListHT.splitEverywhere xs+ (ys,zs) <- neSplit (w!:ws)+ map (mapPair (NonEmpty.cons ys, (us++))) $+ ([], zs) : map (mapFst NonEmpty.flatten) (neSplitMultiOrdered zs)+++subExprsFromSet :: (NEList Integer -> [a]) -> NEList Integer -> [SubExpr a]+subExprsFromSet f xt@(NonEmpty.Cons x xs) =+ if null xs then [Number x] else map SubExpr $ f xt++topExprsFromSet :: [Integer] -> [SubExpr Sum]+topExprsFromSet xs = do+ y:ys <- fmap fst $ split xs+ flip subExprsFromSet (y!:ys) $ \yt ->+ exprsFromSet yt ++ map topProduct (exprsFromSet yt)++topProduct :: SubExpr Product -> Sum+topProduct zs = Sum (NonEmpty.singleton zs) []++anyExprsFromSet ::+ (Expression a) =>+ (NEList (SubExpr a) -> [SubExpr a] -> expr) ->+ NEList Integer -> [expr]+anyExprsFromSet cons xs = do+ (lhs,rs) <- neSplitMultiOrdered $ NonEmpty.flatten xs+ rhs <- splitMultiOrdered rs+ guard $ not $ null (NonEmpty.tail lhs) && null rhs+ liftM2 cons+ (traverse exprsFromSet lhs)+ (traverse exprsFromSet rhs)+++class Expression expr where+ exprsFromSet :: NEList Integer -> [expr]+ format :: expr-> String+ eval :: expr -> Maybe Integer++instance (Expression a) => Expression (SubExpr a) where+ exprsFromSet = subExprsFromSet exprsFromSet+ format = formatSubExpr format+ eval (Number k) = Just k+ eval (SubExpr expr) = eval expr++instance Expression Sum where+ exprsFromSet = anyExprsFromSet Sum+ format (Sum pos neg) =+ let NonEmpty.Cons p ps = fmap format pos+ ns = map format neg+ in p ++ concatMap ("+"++) ps ++ concatMap ("-"++) ns+ eval (Sum pos neg) =+ mfilter (>=0) $+ liftM2 (-)+ (fmap NonEmpty.sum $ traverse eval pos)+ (fmap sum $ mapM eval neg)++instance Expression Product where+ exprsFromSet = anyExprsFromSet Product+ format (Product norm rec) =+ let NonEmpty.Cons n ns =+ fmap (formatSubExpr (addParen.format)) norm+ rs = map (formatSubExpr (addParen.format)) rec+ in n ++ concatMap ("*"++) ns ++ concatMap ("/"++) rs+ eval (Product norm rec) = do+ denom <- fmap product $ mapM eval rec+ guard $ denom/=0+ (q,r) <- fmap (flip divMod denom . NonEmpty.product) $ traverse eval norm+ guard $ r==0+ return q++formatSubExpr :: (a -> String) -> SubExpr a -> String+formatSubExpr _fmt (Number k) = show k+formatSubExpr fmt (SubExpr expr) = fmt expr++addParen :: String -> String+addParen str = "("++str++")"+++{- |+>>> solve [25, 50, 75, 100, 3, 6] 952+25+6*75*(3+100)/50+(3*75*(6+100)-50)/25++>>> solve [75, 50, 2, 3, 8, 7] 812+50+(2+75)*(3+7)-8+2*7*(8+50)+...+50*(7+75)/(2+3)-8+(3+(2+75)/7)*(8+50)++>>> solve [100, 75, 50, 10, 5, 1] 102+1+100+5*10/50+1+100+50/5/10+...+(100+50/(75-5*10))/1+(100+(5+75)/(50-10))/1+(100+(75-5-50)/10)/1+++prop> :{+ QC.forAll genOperands $ \xs ->+ QC.forAll (genResult xs) $ \x ->+ not $ null $ Solve.run (xs,x)+:}++prop> :{+ QC.forAll genOperands $ \xs ->+ QC.forAll (genResult xs) $ \x ->+ QC.forAll (QC.shuffle xs) $ \xs1 ->+ void (Solve.run (xs,x)) == void (Solve.run (xs1,x))+:}++prop> :{+ QC.forAll genOperands $ \xs ->+ QC.forAll (genResult xs) $ \x ->+ QC.forAll (QC.shuffle xs) $ \xs1 ->+ equating (List.sort . map (normalizeSubExpr normalizeSum))+ (Solve.run (xs,x)) (Solve.run (xs1,x))+:}++prop> :{+ QC.forAll genOperands $ \xs ->+ QC.forAll (genEquation xs) $ \(expr,x) ->+ elem expr $+ List.sort $ map (normalizeSubExpr normalizeSum) $ Solve.run (xs,x)+:}+-}+run :: ([Integer], Integer) -> [SubExpr Sum]+run (operands, result) =+ filter ((Just result ==) . Solve.eval) $ Solve.topExprsFromSet operands
+ test/Test/Solve.hs view
@@ -0,0 +1,81 @@+-- Do not edit! Automatically created with doctest-extract from src/Solve.hs+{-# LINE 12 "src/Solve.hs" #-}++module Test.Solve where++import Test.DocTest.Base+import qualified Test.DocTest.Driver as DocTest++{-# LINE 13 "src/Solve.hs" #-}+import qualified Solve+import qualified Data.List as List+import Data.Eq.HT (equating)+import Control.Functor.HT (void)+import Test.Utility+ (solve, genOperands, genResult, genEquation,+ normalizeSubExpr, normalizeSum)+import qualified Test.QuickCheck as QC++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Solve:138: "+{-# LINE 138 "src/Solve.hs" #-}+ DocTest.example(+{-# LINE 138 "src/Solve.hs" #-}+ solve [25, 50, 75, 100, 3, 6] 952+ )+ [ExpectedLine [LineChunk "25+6*75*(3+100)/50"],ExpectedLine [LineChunk "(3*75*(6+100)-50)/25"]]+ DocTest.printPrefix "Solve:142: "+{-# LINE 142 "src/Solve.hs" #-}+ DocTest.example(+{-# LINE 142 "src/Solve.hs" #-}+ solve [75, 50, 2, 3, 8, 7] 812+ )+ [ExpectedLine [LineChunk "50+(2+75)*(3+7)-8"],ExpectedLine [LineChunk "2*7*(8+50)"],WildCardLine,ExpectedLine [LineChunk "50*(7+75)/(2+3)-8"],ExpectedLine [LineChunk "(3+(2+75)/7)*(8+50)"]]+ DocTest.printPrefix "Solve:149: "+{-# LINE 149 "src/Solve.hs" #-}+ DocTest.example(+{-# LINE 149 "src/Solve.hs" #-}+ solve [100, 75, 50, 10, 5, 1] 102+ )+ [ExpectedLine [LineChunk "1+100+5*10/50"],ExpectedLine [LineChunk "1+100+50/5/10"],WildCardLine,ExpectedLine [LineChunk "(100+50/(75-5*10))/1"],ExpectedLine [LineChunk "(100+(5+75)/(50-10))/1"],ExpectedLine [LineChunk "(100+(75-5-50)/10)/1"]]+ DocTest.printPrefix "Solve:158: "+{-# LINE 158 "src/Solve.hs" #-}+ DocTest.property(+{-# LINE 158 "src/Solve.hs" #-}+ + QC.forAll genOperands $ \xs ->+ QC.forAll (genResult xs) $ \x ->+ not $ null $ Solve.run (xs,x)+ )+ DocTest.printPrefix "Solve:164: "+{-# LINE 164 "src/Solve.hs" #-}+ DocTest.property(+{-# LINE 164 "src/Solve.hs" #-}+ + QC.forAll genOperands $ \xs ->+ QC.forAll (genResult xs) $ \x ->+ QC.forAll (QC.shuffle xs) $ \xs1 ->+ void (Solve.run (xs,x)) == void (Solve.run (xs1,x))+ )+ DocTest.printPrefix "Solve:171: "+{-# LINE 171 "src/Solve.hs" #-}+ DocTest.property(+{-# LINE 171 "src/Solve.hs" #-}+ + QC.forAll genOperands $ \xs ->+ QC.forAll (genResult xs) $ \x ->+ QC.forAll (QC.shuffle xs) $ \xs1 ->+ equating (List.sort . map (normalizeSubExpr normalizeSum))+ (Solve.run (xs,x)) (Solve.run (xs1,x))+ )+ DocTest.printPrefix "Solve:179: "+{-# LINE 179 "src/Solve.hs" #-}+ DocTest.property(+{-# LINE 179 "src/Solve.hs" #-}+ + QC.forAll genOperands $ \xs ->+ QC.forAll (genEquation xs) $ \(expr,x) ->+ elem expr $+ List.sort $ map (normalizeSubExpr normalizeSum) $ Solve.run (xs,x)+ )
+ test/Test/Utility.hs view
@@ -0,0 +1,192 @@+module Test.Utility where++import qualified Solve++import qualified Data.NonEmpty.Class as NonEmptyC+import qualified Data.NonEmpty as NonEmpty+import qualified Data.List.HT as ListHT+import qualified Data.List as List+import Data.NonEmpty ((!:))+import Data.Tuple.Strict (zipWithPair)+import Data.Tuple.HT (mapPair)++import Control.Monad (guard)+import Control.Applicative ((<$>))++import qualified Test.QuickCheck as QC+++newtype FormatMany a = FormatMany [a]++instance (Solve.Expression a) => Show (FormatMany a) where+ show (FormatMany xs) = unlines $ map Solve.format xs++solve :: [Integer] -> Integer -> FormatMany (Solve.SubExpr Solve.Sum)+solve =+ curry $+ FormatMany . List.sort . map (normalizeSubExpr normalizeSum) . Solve.run++++type List1 = NonEmpty.T []+type List2 = NonEmpty.T List1++genResult :: [Integer] -> QC.Gen Integer+genResult xs0 =+ maybe (return 0) genResultNE $ NonEmpty.fetch xs0++genResultNE :: List1 Integer -> QC.Gen Integer+genResultNE (NonEmpty.Cons x0 xs0) =+ case NonEmpty.fetch xs0 of+ Nothing -> return x0+ Just xs1 -> do+ (ys,zs) <- genSplit $ x0!:xs1+ y <- genResultNE ys+ z <- genResultNE zs+ QC.elements $+ (y+z) :+ (y*z) :+ abs (y-z) :+ (let a = max y z; b = min y z in+ if b/=0 && mod a b == 0 then [div a b] else [])++genEquation :: [Integer] -> QC.Gen (Solve.SubExpr Solve.Sum, Integer)+genEquation xs0 =+ maybe (return (Solve.Number 0, 0)) genEquationNE $ NonEmpty.fetch xs0++genEquationNE :: List1 Integer -> QC.Gen (Solve.SubExpr Solve.Sum, Integer)+genEquationNE (NonEmpty.Cons x0 xs0) =+ case NonEmpty.fetch xs0 of+ Nothing -> return (Solve.Number x0, x0)+ Just xs1 -> do+ (ys,zs) <- genSplit $ x0!:xs1+ y <- genEquationNE ys+ z <- genEquationNE zs+ QC.elements $+ zipWithPair (addExpr, (+)) y z :+ zipWithPair (mulExpr, (*)) y z :+ (if snd y >= snd z+ then zipWithPair (subExpr, (-)) y z+ else zipWithPair (subExpr, (-)) z y) :+ (if snd y >= snd z then divEqu y z else divEqu z y)++addExpr ::+ Solve.SubExpr Solve.Sum -> Solve.SubExpr Solve.Sum -> Solve.SubExpr Solve.Sum+addExpr a b =+ case (sumFromSubExpr a, sumFromSubExpr b) of+ (Solve.Sum posA negA, Solve.Sum posB negB) ->+ Solve.SubExpr $+ Solve.Sum (mergeByNE (<) posA posB) (ListHT.mergeBy (<) negA negB)++subExpr ::+ Solve.SubExpr Solve.Sum -> Solve.SubExpr Solve.Sum -> Solve.SubExpr Solve.Sum+subExpr a b =+ case (sumFromSubExpr a, sumFromSubExpr b) of+ (Solve.Sum posA negA, Solve.Sum posB negB) ->+ Solve.SubExpr $+ Solve.Sum+ (mergyLeftByNE (<) posA negB) + (ListHT.mergeBy (<) negA $ NonEmpty.flatten posB)++sumFromSubExpr :: Solve.SubExpr Solve.Sum -> Solve.Sum+sumFromSubExpr (Solve.SubExpr a) = a+sumFromSubExpr (Solve.Number a) =+ Solve.Sum (NonEmpty.singleton $ Solve.Number a) []++mulExpr ::+ Solve.SubExpr Solve.Sum -> Solve.SubExpr Solve.Sum -> Solve.SubExpr Solve.Sum+mulExpr a b =+ case (productFromSubExpr a, productFromSubExpr b) of+ (Solve.Product normA recA, Solve.Product normB recB) ->+ Solve.SubExpr $ singletonSum $+ Solve.SubExpr $+ Solve.Product+ (mergeByNE (<) normA normB)+ (ListHT.mergeBy (<) recA recB)+++divEqu ::+ (Solve.SubExpr Solve.Sum, Integer) ->+ (Solve.SubExpr Solve.Sum, Integer) ->+ [(Solve.SubExpr Solve.Sum, Integer)]+divEqu (exprA,resA) (exprB,resB) =+ guard (resB/=0 && mod resA resB == 0) >>+ [(divExpr exprA exprB, div resA resB)]++divExpr ::+ Solve.SubExpr Solve.Sum -> Solve.SubExpr Solve.Sum -> Solve.SubExpr Solve.Sum+divExpr a b =+ case (productFromSubExpr a, productFromSubExpr b) of+ (Solve.Product normA recA, Solve.Product normB recB) ->+ Solve.SubExpr $ singletonSum $+ Solve.SubExpr $+ Solve.Product+ (mergyLeftByNE (<) normA recB)+ (ListHT.mergeBy (<) recA $ NonEmpty.flatten normB)++productFromSubExpr :: Solve.SubExpr Solve.Sum -> Solve.Product+productFromSubExpr (Solve.Number a) = singletonProduct $ Solve.Number a+productFromSubExpr (Solve.SubExpr (Solve.Sum (NonEmpty.Cons expr []) [])) =+ case expr of+ Solve.SubExpr a -> a+ Solve.Number a -> singletonProduct $ Solve.Number a+productFromSubExpr a = singletonProduct a++singletonSum :: Solve.SubExpr Solve.Product -> Solve.Sum+singletonSum a = Solve.Sum (NonEmpty.singleton a) []++singletonProduct :: Solve.SubExpr Solve.Sum -> Solve.Product+singletonProduct a = Solve.Product (NonEmpty.singleton a) []++mergeByNE ::+ (a -> a -> Bool) -> NonEmpty.T [] a -> NonEmpty.T [] a -> NonEmpty.T [] a+mergeByNE lt (NonEmpty.Cons x xs) (NonEmpty.Cons y ys) =+ if lt x y+ then NonEmpty.Cons x $ ListHT.mergeBy lt xs (y:ys)+ else NonEmpty.Cons y $ ListHT.mergeBy lt (x:xs) ys++mergyLeftByNE ::+ (a -> a -> Bool) -> NonEmpty.T [] a -> [a] -> NonEmpty.T [] a+mergyLeftByNE lt xt@(NonEmpty.Cons x xs) yt =+ case yt of+ [] -> xt+ y:ys ->+ if lt x y+ then NonEmpty.Cons x $ ListHT.mergeBy lt xs (y:ys)+ else NonEmpty.Cons y $ ListHT.mergeBy lt (x:xs) ys++genSplit :: List2 a -> QC.Gen (List1 a, List1 a)+genSplit xs0 = do+ (x1,xs1) <-+ QC.elements $+ NonEmpty.flatten $ NonEmpty.flatten $ NonEmpty.removeEach xs0+ (x2,xs2) <- QC.elements $ NonEmpty.flatten $ NonEmpty.removeEach xs1+ (xsA,xsB) <-+ fmap (mapPair (map fst, map fst) . ListHT.partition snd) $+ mapM (\x -> (,) x <$> QC.arbitrary) xs2+ return (x1!:xsA, x2!:xsB)++genOperands :: QC.Gen [Integer]+genOperands =+ take 5 . map QC.getNonNegative . QC.getNonEmpty <$> QC.arbitrary++++normalizeSubExpr ::+ (a -> a) -> Solve.SubExpr a -> Solve.SubExpr a+normalizeSubExpr normalize expr =+ case expr of+ Solve.Number k -> Solve.Number k+ Solve.SubExpr a -> Solve.SubExpr $ normalize a++normalizeSum :: Solve.Sum -> Solve.Sum+normalizeSum (Solve.Sum pos neg) =+ Solve.Sum+ (NonEmptyC.sort $ fmap (normalizeSubExpr normalizeProduct) pos)+ (List.sort $ map (normalizeSubExpr normalizeProduct) neg)++normalizeProduct :: Solve.Product -> Solve.Product+normalizeProduct (Solve.Product norm rec) =+ Solve.Product+ (NonEmptyC.sort $ fmap (normalizeSubExpr normalizeSum) norm)+ (List.sort $ map (normalizeSubExpr normalizeSum) rec)
+ test/TestMain.hs view
@@ -0,0 +1,10 @@+-- Do not edit! Automatically created with doctest-extract.+module Main where++import qualified Test.Solve++import qualified Test.DocTest.Driver as DocTest++main :: IO ()+main = DocTest.run $ do+ Test.Solve.test