diff --git a/AERN-Real.cabal b/AERN-Real.cabal --- a/AERN-Real.cabal +++ b/AERN-Real.cabal @@ -1,5 +1,5 @@ Name: AERN-Real -Version: 0.9.3.1 +Version: 0.9.4 Cabal-Version: >= 1.2 Build-Type: Simple License: BSD3 @@ -47,7 +47,7 @@ and simple numerical integration. Extra-source-files: - HISTORY tests/Test1.hs + ChangeLog tests/Test1.hs Flag containers-in-base Default: False @@ -71,6 +71,7 @@ Data.Number.ER.Real.Base, Data.Number.ER.Real.Arithmetic.Elementary, Data.Number.ER.Real.Arithmetic.Integration, + Data.Number.ER.Real.Arithmetic.LinearSolver, Data.Number.ER.Real.Arithmetic.Taylor, Data.Number.ER.Real.Arithmetic.Newton, Data.Number.ER.Real.Approx.Sequence, diff --git a/ChangeLog b/ChangeLog new file mode 100644 --- /dev/null +++ b/ChangeLog @@ -0,0 +1,23 @@ +0.9.4: + * fixed buggy formatting of floating point numbers + * added a simple although inefficient linear solver + +0.9.3.1: 12 July 2008 + * fixed email in cabal maintainer field + +0.9.3: 12 July 2008 + * Fixed Data.Number.ER.Real so that it is usable as a single import + for the library and its documentation links are more useful. + * Added a module with some tests, which can also serve as an example. + * Improved formatting of floating point numbers. + +0.9.2: 11 July 2008 + * declared dependency on haskell98 in cabal file (thanks to Don Stewart) + +0.9.1: 11 July 2008 + * fixed licence specification within modules + +0.9.0: 11 July 2008 + * initial release of AERN-Real + + diff --git a/HISTORY b/HISTORY deleted file mode 100644 --- a/HISTORY +++ /dev/null @@ -1,19 +0,0 @@ -0.9.3.1: 12 July 2008 - * fixed email in cabal maintainer field - -0.9.3: 12 July 2008 - * Fixed Data.Number.ER.Real so that it is usable as a single import - for the library and its documentation links are more useful. - * Added a module with some tests, which can also serve as an example. - * Improved formatting of floating point numbers. - -0.9.2: 11 July 2008 - * declared dependency on haskell98 in cabal file (thanks to Don Stewart) - -0.9.1: 11 July 2008 - * fixed licence specification within modules - -0.9.0: 11 July 2008 - * initial release of AERN-Real - - diff --git a/src/Data/Number/ER/BasicTypes.hs b/src/Data/Number/ER/BasicTypes.hs --- a/src/Data/Number/ER/BasicTypes.hs +++ b/src/Data/Number/ER/BasicTypes.hs @@ -82,11 +82,4 @@ A many-dimensional point or interval. -} type Box ira = Map.Map VarID ira - -{-| using 'defaultVar' -} -unaryDom :: ira -> Box ira -unaryDom r = Map.singleton defaultVar r - -noinfoDom :: Box ira -noinfoDom = Map.empty diff --git a/src/Data/Number/ER/Real/Arithmetic/LinearSolver.hs b/src/Data/Number/ER/Real/Arithmetic/LinearSolver.hs new file mode 100644 --- /dev/null +++ b/src/Data/Number/ER/Real/Arithmetic/LinearSolver.hs @@ -0,0 +1,118 @@ +{-| + Module : Data.Number.ER.Real.LinearSolver + Description : arbitrary precision piece-wise something function enclosures + Copyright : (c) Jan Duracz, Michal Konecny + License : BSD3 + + Maintainer : mik@konecny.aow.cz + Stability : experimental + Portability : portable + + A simple validated solver for systems of linear equations with + interval coefficients. It uses a naive splitting approach and is + therefore very slow. +-} +module Data.Number.ER.Real.Arithmetic.LinearSolver +( + linearSolver +) +where + +import qualified Data.Number.ER.Real.Approx as RA +import Data.Number.ER.BasicTypes + +import Data.List +import Data.Maybe +import qualified Data.Map as Map + +{- +import Data.Number.ER.Real.DefaultRepr + +eq1 :: (Box IRA, IRA) +eq1 = (mkBox [1,2,1], 2) +eq2 = (mkBox [2,4,2], 4) +eq3 = (mkBox [2,4,4], 5) +eqs = [eq1,eq2,eq3] + +box = mkBox $ replicate 3 $ (-1)RA.\/1 +x1 = (-13/16)RA.\/(-3/4) :: IRA +x2 = (5/16)RA.\/(3/8) :: IRA +tol = 2^^(-20) :: IRA + +mkBox :: [IRA] -> Box IRA +mkBox iras = Map.fromList $ zip [1..] iras +-} + +linearSolver :: + (RA.ERIntApprox ira) => + [(Map.Map VarID ira, ira)] + {-^ the equations; + each equation has coefficients of linear terms + + constant term -} -> + Box ira {-^ the domain of the variables -} -> + ira {-^ an upper bound on the size of an acceptable solution box -} -> + Maybe (Box ira) + {-^ + A box containing at least one solution within the domain; + Nothing if there is no solution. + -} +linearSolver eqns domBox tolerance = + linearSolver' eqns [domBox] tolerance + +linearSolver' eqns [] tolerance = + Nothing +linearSolver' eqns (b:bs) tolerance + | not $ evalEqns b eqns = -- no solutions in the box + linearSolver' eqns bs tolerance + | width (b Map.! (widestVar b)) < tolerance = + Just b + | otherwise = + linearSolver' eqns (splitBox b ++ bs) tolerance + +evalEqns box eqns = + and $ map (evalEqn box) eqns + +{-| + returns true iff there exists a solution to the equation in the box +-} +evalEqn box (expr,cons) = + cons `RA.refines` (evalExpr expr box) + where + evalExpr expr box = Map.fold (+) 0 $ Map.unionWith (*) expr box + +{-| + returns the list of (two) boxes resulting from splitting the widest edge + of the box in half +-} +splitBox box = + [Map.insert k (iLg RA.\/ iMg) box, Map.insert k (iMg RA.\/ iRg) box] + where + iMg = (iLg+iRg)/2 + iLg = incrementGranularity iL + iRg = incrementGranularity iR + (iL,iR) = RA.bounds i + i = box Map.! k + k = widestVar box + incrementGranularity x = + RA.setMinGranularity (RA.getGranularity x + 1) x + +widestVar box = + fst $ maxm (head widthMap) $ tail widthMap + where + widthMap = + Map.assocs $ Map.map width box + maxm m [] = m + maxm m (x:xs) = + if mW < xW then + maxm x xs + else + maxm m xs + where + mW = snd m + xW = snd x + +width i = + snd $ RA.bounds (iR-iL) + where + (iL,iR) = RA.bounds i + diff --git a/src/Data/Number/ER/Real/Base/Float.hs b/src/Data/Number/ER/Real/Base/Float.hs --- a/src/Data/Number/ER/Real/Base/Float.hs +++ b/src/Data/Number/ER/Real/Base/Float.hs @@ -213,41 +213,46 @@ maybeGran gr | showGran = "{g=" ++ show gr ++ "}" | otherwise = "" + showPM Plus = "" + showPM Minus = "-" showERF (ERFloatNaN gr) = "NaN" ++ (maybeGran gr) - showERF (ERFloatZero gr pm) = show pm ++ "0" ++ (maybeGran gr) - showERF (ERFloatInfty gr pm) = show pm ++ "oo" ++ (maybeGran gr) + showERF (ERFloatZero gr pm) = showPM pm ++ "0.0" ++ (maybeGran gr) + showERF (ERFloatInfty gr pm) = showPM pm ++ "oo" ++ (maybeGran gr) showERF f@(ERFloat gr s m e) = decimal ++ (maybeGran gr) ++ maybeComps where maybeComps | showComponents = "{val="++ show (s,m,e) ++ "}" | otherwise = "" - decimal = - (case s of Plus -> ""; Minus -> "-") + decimal = + showPM s ++ show digit1 ++ "." ++ (concat $ map show $ take numDigits digits) ++ (if dexp == 0 then "" else "e" ++ show dexp) - dexp = dexpBound - zerosCount - digit1 : digits = - drop zerosCount preDigits + (dexp, digit1 : digits) + | noLeadingZerosDexp == -1 = + (0, 0 : noLeadingZeroDigits) + | otherwise = + (noLeadingZerosDexp, noLeadingZeroDigits) + noLeadingZerosDexp = dexpBound - zerosCount + (zerosCount, noLeadingZeroDigits) = + stripCountZeros 0 preDigits + stripCountZeros prevZeros ds@(d : dsRest) + | d == 0 = stripCountZeros (prevZeros + 1) dsRest + | otherwise = (prevZeros, ds) dexpBound -- upper bound of dexp: f/10^dexpBound < 1 - | e > 0 = intLog 10 (2^e) - | e <= 0 = 2 - (intLog 10 (2^(-e))) - (zerosCount, preDigits) = - getDigits 0 $ (abs $ setERFloatGranularity gran f) / (ten ^^ dexpBound) + | e >= 0 = intLog 10 (2^e) + | e < 0 = 2 - (intLog 10 (2^(-e))) + preDigits = + getDigits $ (abs $ setERFloatGranularity gran f) / (ten ^^ dexpBound) ten = setERFloatGranularity gran 10 gran = 10 + (max (4 * numDigits) gr) - getDigits prevZeros ff - | digit > 0 = (prevZeros, digit : digits) - | zerosCount == 1 = (0, (digit : digits)) - | otherwise = (zerosCount, digit : digits) + getDigits ff = + digit : digits where digit :: Integer digit = truncate ff - (zerosCount, digits) = - getDigits zerosNow ((ff - (fromInteger digit)) * ten) - zerosNow - | digit == 0 = prevZeros + 1 - | otherwise = 0 + digits = + getDigits ((ff - (fromInteger digit)) * ten) {-