diff --git a/Math/ExpPairs.hs b/Math/ExpPairs.hs --- a/Math/ExpPairs.hs +++ b/Math/ExpPairs.hs @@ -14,9 +14,9 @@ A set of useful applications can be found in "Math.ExpPairs.Ivic", "Math.ExpPairs.Kratzel" and "Math.ExpPairs.MenzerNowak". -} + {-# LANGUAGE CPP #-} {-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE TemplateHaskell #-} module Math.ExpPairs ( optimize @@ -50,7 +50,6 @@ import Text.PrettyPrint.Leijen hiding ((<$>), (<>)) import qualified Text.PrettyPrint.Leijen as PP import Text.Printf -import Data.Function.Memoize (deriveMemoizable) import Math.ExpPairs.LinearForm import Math.ExpPairs.Process @@ -116,8 +115,6 @@ optimalPath :: Path } deriving (Show) - -deriveMemoizable ''OptimizeResult instance Pretty OptimizeResult where pretty (OptimizeResult r' ip p) = pretty1 r' PP.<$> diff --git a/Math/ExpPairs/Kratzel.hs b/Math/ExpPairs/Kratzel.hs --- a/Math/ExpPairs/Kratzel.hs +++ b/Math/ExpPairs/Kratzel.hs @@ -25,8 +25,6 @@ -} -{-# LANGUAGE TemplateHaskell #-} - module Math.ExpPairs.Kratzel ( TauabTheorem (..) , tauab @@ -44,10 +42,12 @@ import Data.Maybe import Data.Ratio import Data.Ord (comparing) -import Data.List (minimumBy, sort) +import Data.List (minimumBy, sort, inits, tails) import Text.PrettyPrint.Leijen -import Data.Function.Memoize (memoize, deriveMemoizable) +import qualified Data.Map as M +import qualified Data.Set as S + import Math.ExpPairs import Math.ExpPairs.Ivic @@ -299,12 +299,6 @@ pretty (Combination t1 t2 r) = pretty t1 <+> pretty t2 <+> pretty r -deriveMemoizable ''Theorem -deriveMemoizable ''TauabTheorem -deriveMemoizable ''TauabcTheorem -deriveMemoizable ''TauabcdTheorem -deriveMemoizable ''TauAResult - extractValue :: TauAResult -> Rational extractValue (Node _ o) = toRational $ optimalValue o extractValue (Combination _ _ r1) = r1 @@ -317,12 +311,16 @@ -- | Compute Θ(a1, a2...) for given list [a1, a2...]. tauA :: [Integer] -> TauAResult -tauA = go' . sort +tauA ys = (M.!) cache xs where + xs :: [Integer] + xs = sort ys + fi :: Integer -> Rational fi = fromIntegral - go' = memoize go + keys = S.fromList $ concatMap inits (tails xs) + cache = M.fromSet go keys go :: [Integer] -> TauAResult go [] = Node NoTheorem (simulateOptimize 0) @@ -333,9 +331,7 @@ go as@(a:_) | all (== a) as = Node Ivic $ simulateOptimize $ reverseMOnS 1e-6 (fromIntegral $ length as) / fi a - go as = go608' as - - go608' = memoize go608 + go as = go608 as go608 as = minimum $ mapMaybe f [1 .. length as - 1] where @@ -343,9 +339,9 @@ then Just $ Combination alpha beta ret else Nothing where - alpha = go' $ take q as + alpha = (M.!) cache $ take q as alphaV = extractValue alpha - beta = go' $ drop q as + beta = (M.!) cache $ drop q as betaV = extractValue beta a0 = fi $ head as aq = fi $ as !! q diff --git a/Math/ExpPairs/LinearForm.hs b/Math/ExpPairs/LinearForm.hs --- a/Math/ExpPairs/LinearForm.hs +++ b/Math/ExpPairs/LinearForm.hs @@ -107,7 +107,7 @@ -- |Evaluate a rational form (a*k + b*l + c*m) \/ (a'*k + b'*l + c'*m) -- for given k, l and m. -evalRF :: (Real t, Num t) => (Integer, Integer, Integer) -> RationalForm t -> RationalInf +evalRF :: Real t => (Integer, Integer, Integer) -> RationalForm t -> RationalInf evalRF (k, l, m) (num :/: den) = if denom==0 then InfPlus else Finite (numer / denom) where klm = mapTriple fromInteger (k, l, m) numer = toRational $ evalLF klm num diff --git a/Math/ExpPairs/Matrix3.hs b/Math/ExpPairs/Matrix3.hs --- a/Math/ExpPairs/Matrix3.hs +++ b/Math/ExpPairs/Matrix3.hs @@ -15,7 +15,6 @@ {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TemplateHaskell #-} module Math.ExpPairs.Matrix3 ( Matrix3 (..) @@ -35,7 +34,6 @@ import Data.List (transpose) import GHC.Generics (Generic (..)) import Text.PrettyPrint.Leijen -import Data.Function.Memoize (deriveMemoizable) -- |Matrix of order 3. Instances of 'Num' and 'Fractional' -- are given in terms of the multiplicative group of matrices, @@ -248,7 +246,7 @@ {-# SPECIALIZE makarovMult :: Matrix3 Integer -> Matrix3 Integer -> Matrix3 Integer #-} -- |Compute the determinant of a matrix. -det :: (Num t, Ord t) => Matrix3 t -> t +det :: Num t => Matrix3 t -> t det Matrix3 {..} = a11 * (a22 * a33 - a32 * a23) - a12 * (a21 * a33 - a23 * a31) @@ -306,5 +304,3 @@ a31 * a1 + a32 * a2 + a33 * a3 ) {-# INLINE multCol #-} - -deriveMemoizable ''Matrix3 diff --git a/Math/ExpPairs/Pair.hs b/Math/ExpPairs/Pair.hs --- a/Math/ExpPairs/Pair.hs +++ b/Math/ExpPairs/Pair.hs @@ -14,7 +14,6 @@ -} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -32,7 +31,6 @@ import Data.Ratio import GHC.Generics (Generic (..)) import Text.PrettyPrint.Leijen -import Data.Function.Memoize -- |Vertices of the triangle of initial exponent pairs. data Triangle @@ -66,8 +64,6 @@ -- 'Mix' a b = a * 'Corput16' + b * 'HuxW87b1' + (1-a-b) * 'Hux05' | Mix !t !t deriving (Eq, Ord, Show, Generic) - -deriveMemoizable ''InitPair' -- |Exponent pair built from rational fractions of -- 'Corput16', 'HuxW87b1' and 'Hux05' diff --git a/Math/ExpPairs/PrettyProcess.hs b/Math/ExpPairs/PrettyProcess.hs --- a/Math/ExpPairs/PrettyProcess.hs +++ b/Math/ExpPairs/PrettyProcess.hs @@ -5,7 +5,7 @@ License : GPL-3 Maintainer : andrew.lelechenko@gmail.com Stability : experimental -Portability : TemplateHaskell +Portability : POSIX Transforms sequences of 'Process' into most compact (by the means of typesetting) representation using brackets and powers. E. g., AAAABABABA -> A^4(BA)^3. @@ -13,18 +13,19 @@ This module uses memoization extensively. -} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Math.ExpPairs.PrettyProcess ( prettify, uglify, PrettyProcess) where -import Data.List (minimumBy) +import Data.List (minimumBy, inits, tails) import Data.Ord (comparing) -import Data.Function.Memoize (memoize, deriveMemoizable) import Text.PrettyPrint.Leijen +import qualified Data.Map as M +import qualified Data.Set as S + import Math.ExpPairs.ProcessMatrix -- | Compact representation of the sequence of 'Process'. @@ -36,8 +37,6 @@ data PrettyProcessWithWidth = PPWL { ppwlProcess :: PrettyProcess, ppwlWidth :: Int } -deriveMemoizable ''PrettyProcess - instance Pretty PrettyProcess where pretty = \case Simply xs -> hsep (map (text . show) xs) @@ -94,28 +93,31 @@ -- | Find the most compact representation of the sequence of processes, keeping track of widthess. prettifyP :: [Process] -> PrettyProcessWithWidth -prettifyP = memoize prettify' where +prettifyP ps = (M.!) cache ps + where + keys = S.fromList $ concatMap inits (tails ps) + cache = M.fromSet alg keys -prettify' :: [Process] -> PrettyProcessWithWidth -prettify' = \case - [] -> annotateWithWidth (Simply []) - [A] -> annotateWithWidth (Simply [A]) - [BA] -> annotateWithWidth (Simply [BA]) - xs -> minimumBy (comparing ppwlWidth) yss where - xs'' = case asRepeat xs of - (_, 1) -> annotateWithWidth (Simply xs) - (xs', n) -> annotateWithWidth (Repeat (prettify xs') n) + alg :: [Process] -> PrettyProcessWithWidth + alg = \case + [] -> annotateWithWidth (Simply []) + [A] -> annotateWithWidth (Simply [A]) + [BA] -> annotateWithWidth (Simply [BA]) + xs -> minimumBy (comparing ppwlWidth) yss where + xs'' = case asRepeat xs of + (_, 1) -> annotateWithWidth (Simply xs) + (xs', n) -> annotateWithWidth (Repeat (ppwlProcess $ (M.!) cache xs') n) - yss = xs'' : map f bcs + yss = xs'' : map f bcs - bcs = takeWhile (not . null . snd) $ iterate bcf ([head xs], tail xs) + bcs = takeWhile (not . null . snd) $ iterate bcf ([head xs], tail xs) - bcf (_, []) = error "prettify': unexpected second argument of bcf" - bcf (zs, y:ys) = (zs++[y], ys) + bcf (_, []) = error "prettifyP: unexpected second argument of bcf" + bcf (zs, y:ys) = (zs++[y], ys) - f (bs, cs) = PPWL (Sequence bsP csP) (bsW + csW) where - PPWL bsP bsW = prettifyP bs - PPWL csP csW = prettifyP cs + f (bs, cs) = PPWL (Sequence bsP csP) (bsW + csW) where + PPWL bsP bsW = (M.!) cache bs + PPWL csP csW = (M.!) cache cs -- | Unfold back 'PrettyProcess' into the sequence of 'Process'. uglify :: PrettyProcess -> [Process] diff --git a/Math/ExpPairs/Process.hs b/Math/ExpPairs/Process.hs --- a/Math/ExpPairs/Process.hs +++ b/Math/ExpPairs/Process.hs @@ -5,14 +5,13 @@ License : GPL-3 Maintainer : andrew.lelechenko@gmail.com Stability : experimental -Portability : TemplateHaskell +Portability : POSIX Provides types for sequences of /A/- and /B/-processes of van der Corput. A good account on this topic can be found in /Graham S. W., Kolesnik G. A./ Van Der Corput's Method of Exponential Sums, Cambridge University Press, 1991, especially Ch. 5. -} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TemplateHaskell #-} module Math.ExpPairs.Process ( Process () @@ -26,7 +25,6 @@ import GHC.Generics (Generic) import Data.Monoid import Text.PrettyPrint.Leijen hiding ((<>)) -import Data.Function.Memoize (deriveMemoizable) import Math.ExpPairs.ProcessMatrix import Math.ExpPairs.PrettyProcess @@ -35,8 +33,6 @@ -- transformation, which they define. data Path = Path !ProcessMatrix ![Process] deriving (Eq, Show, Generic) - -deriveMemoizable ''Path instance Monoid Path where mempty = Path mempty mempty diff --git a/Math/ExpPairs/ProcessMatrix.hs b/Math/ExpPairs/ProcessMatrix.hs --- a/Math/ExpPairs/ProcessMatrix.hs +++ b/Math/ExpPairs/ProcessMatrix.hs @@ -5,11 +5,16 @@ License : GPL-3 Maintainer : andrew.lelechenko@gmail.com Stability : experimental -Portability : TemplateHaskell +Portability : POSIX Provides types for sequences of /A/- and /B/-processes of van der Corput. A good account on this topic can be found in /Graham S. W., Kolesnik G. A./ Van Der Corput's Method of Exponential Sums, Cambridge University Press, 1991, especially Ch. 5. -} -{-# LANGUAGE TemplateHaskell, BangPatterns, GeneralizedNewtypeDeriving, CPP, DeriveGeneric #-} + +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + module Math.ExpPairs.ProcessMatrix ( Process (..) , ProcessMatrix () @@ -21,7 +26,6 @@ #if __GLASGOW_HASKELL__ < 710 import Data.Monoid (Monoid, mempty, mappend) #endif -import Data.Function.Memoize (deriveMemoizable) import GHC.Generics (Generic (..)) import Text.PrettyPrint.Leijen @@ -38,13 +42,9 @@ instance Pretty Process where pretty = text . show -deriveMemoizable ''Process - -- | Sequence of processes, represented as a matrix 3x3. newtype ProcessMatrix = ProcessMatrix (Matrix3 Integer) deriving (Eq, Num, Show, Pretty) - -deriveMemoizable ''ProcessMatrix instance Monoid ProcessMatrix where mempty = 1 diff --git a/Math/ExpPairs/RatioInf.hs b/Math/ExpPairs/RatioInf.hs --- a/Math/ExpPairs/RatioInf.hs +++ b/Math/ExpPairs/RatioInf.hs @@ -10,8 +10,6 @@ Provides types and necessary instances for rational numbers, extended with infinite values. Just use 'RationalInf' instead of 'Rational' from "Data.Ratio". -} -{-# LANGUAGE TemplateHaskell #-} - {-# OPTIONS_GHC -fno-warn-orphans #-} module Math.ExpPairs.RatioInf @@ -21,7 +19,6 @@ import Data.Ratio (Ratio, numerator, denominator) import Text.PrettyPrint.Leijen -import Data.Function.Memoize (deriveMemoizable) -- |Extends a rational type with positive and negative -- infinities. @@ -34,9 +31,6 @@ | InfPlus deriving (Eq, Ord, Show) -deriveMemoizable ''Ratio -deriveMemoizable ''RatioInf - -- |Arbitrary-precision rational numbers with positive and negative -- infinities. type RationalInf = RatioInf Integer @@ -132,6 +126,6 @@ instance Integral t => Real (RatioInf t) where toRational (Finite r) = toRational r - toRational InfPlus = error "Cannot map infinity into Rational" - toRational InfMinus = error "Cannot map infinity into Rational" + toRational InfPlus = error "Cannot convert positive infinity into Rational" + toRational InfMinus = error "Cannot convert negative infinity into Rational" {-# SPECIALIZE toRational :: RationalInf -> Rational #-} diff --git a/exp-pairs.cabal b/exp-pairs.cabal --- a/exp-pairs.cabal +++ b/exp-pairs.cabal @@ -1,5 +1,5 @@ name: exp-pairs -version: 0.1.5.0 +version: 0.1.5.1 synopsis: Linear programming over exponent pairs description: Package implements an algorithm to minimize rational objective function over the set of exponent pairs homepage: https://github.com/Bodigrim/exp-pairs @@ -29,10 +29,10 @@ Math.ExpPairs.ProcessMatrix, Math.ExpPairs.RatioInf build-depends: base >=4 && <5, - memoize >=0.1, ghc-prim, wl-pprint >=1.2, - deepseq >=1.3 + deepseq >=1.3, + containers default-language: Haskell2010 ghc-options: -Wall -fno-warn-type-defaults @@ -58,7 +58,6 @@ QuickCheck >=2.4.2, smallcheck >=0.2.1, exp-pairs, - memoize >=0.1, matrix >=0.1, random hs-source-dirs: tests diff --git a/tests/Instances.hs b/tests/Instances.hs --- a/tests/Instances.hs +++ b/tests/Instances.hs @@ -69,7 +69,7 @@ instance (Ord t, Fractional t, Arbitrary t) => Arbitrary (InitPair' t) where arbitrary = f <$> liftM2 (,) arbitrary arbitrary where - f :: (Num t, Ord t, Fractional t) => (Ratio01 t, Ratio01 t) -> InitPair' t + f :: (Ord t, Fractional t) => (Ratio01 t, Ratio01 t) -> InitPair' t f (Ratio01 x, Ratio01 y) | 100*x<5 = Corput01 | 100*x<10 = Corput12 diff --git a/tests/Ivic.hs b/tests/Ivic.hs --- a/tests/Ivic.hs +++ b/tests/Ivic.hs @@ -79,10 +79,15 @@ t = toRational $ reverseMOnS 1e-3 $ optimalValue zs testMOnSReverse2 :: Ratio01 Rational -> Bool -testMOnSReverse2 (Ratio01 s') = s' == 0 || if recip t <= recip s + 1e-3 && recip s <= recip t + 1e-3 then True else trace (show $ fromRational $ recip s - recip t) False where - s = 4 * recip s' - zs = reverseMOnS 1e-3 (Finite s) - t = toRational $ optimalValue $ mOnS $ toRational zs +testMOnSReverse2 (Ratio01 s') + = s' == 0 + || t' == InfPlus || t' == InfMinus + || if recip t <= recip s + 1e-3 && recip s <= recip t + 1e-3 then True else trace (show $ fromRational $ recip s - recip t) False + where + s = 4 * recip s' + zs = reverseMOnS 1e-3 (Finite s) + t' = optimalValue $ mOnS $ toRational zs + t = toRational t' testMBigOnHalfReverse1 :: Positive Rational -> Bool testMBigOnHalfReverse1 (Positive s') = if recip t <= recip s + 2e-3 && recip s <= recip t + 1e-10 then True else trace (show $ fromRational $ recip s - recip t) False where diff --git a/tests/PrettyProcess.hs b/tests/PrettyProcess.hs --- a/tests/PrettyProcess.hs +++ b/tests/PrettyProcess.hs @@ -14,7 +14,8 @@ testSuite :: TestTree testSuite = testGroup "PrettyProcess" - [ adjustOption (\(SC.SmallCheckDepth n) -> SC.SmallCheckDepth (n `min` 13)) $ + [ adjustOption (\(SC.SmallCheckDepth n) -> SC.SmallCheckDepth (n `min` 12)) $ SC.testProperty "uglify . prettify == id" testUglifyPrettify - , QC.testProperty "uglify . prettify == id" testUglifyPrettify + , adjustOption (\(QC.QuickCheckTests n) -> QC.QuickCheckTests (n `div` 2)) $ + QC.testProperty "uglify . prettify == id" testUglifyPrettify ] diff --git a/tests/RatioInf.hs b/tests/RatioInf.hs --- a/tests/RatioInf.hs +++ b/tests/RatioInf.hs @@ -34,10 +34,14 @@ testSuite :: TestTree testSuite = testGroup "RatioInf" - [ SC.testProperty "plus" testPlus - , SC.testProperty "minus" testMinus - , SC.testProperty "multiply" testMultiply - , SC.testProperty "divide" testDivide + [ adjustOption (\(SC.SmallCheckDepth n) -> SC.SmallCheckDepth (n `div` 2)) $ + SC.testProperty "plus" testPlus + , adjustOption (\(SC.SmallCheckDepth n) -> SC.SmallCheckDepth (n `div` 2)) $ + SC.testProperty "minus" testMinus + , adjustOption (\(SC.SmallCheckDepth n) -> SC.SmallCheckDepth (n `div` 2)) $ + SC.testProperty "multiply" testMultiply + , adjustOption (\(SC.SmallCheckDepth n) -> SC.SmallCheckDepth (n `div` 2)) $ + SC.testProperty "divide" testDivide , SC.testProperty "infplus plus" $ testInfPlus InfPlus , SC.testProperty "infplus minus" $ testInfPlus InfMinus , SC.testProperty "infminus plus" $ testInfMinus InfPlus