X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FRoots%2FSimple.hs;h=d3c10cd8a3dfb95c001aeb5ce244b1bc7f14f7ed;hb=bb7f6082639f8589a851487c02ab396f7f91b927;hp=79750e8d15b9aa2f0091e903b94a17accea9b7b8;hpb=3a03a2bdc233f1504764b21149a13162486fc3bf;p=numerical-analysis.git diff --git a/src/Roots/Simple.hs b/src/Roots/Simple.hs index 79750e8..d3c10cd 100644 --- a/src/Roots/Simple.hs +++ b/src/Roots/Simple.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE RebindableSyntax #-} + -- | The Roots.Simple module contains root-finding algorithms. That -- is, procedures to (numerically) find solutions to the equation, -- @@ -11,8 +13,19 @@ where import Data.List (find) +import Normed + import qualified Roots.Fast as F +import NumericPrelude hiding (abs) +import qualified Algebra.Absolute as Absolute +import Algebra.Absolute (abs) +import qualified Algebra.Additive as Additive +import qualified Algebra.Algebraic as Algebraic +import qualified Algebra.Field as Field +import qualified Algebra.RealField as RealField +import qualified Algebra.RealRing as RealRing + -- | Does the (continuous) function @f@ have a root on the interval -- [a,b]? If f(a) <] 0 and f(b) ]> 0, we know that there's a root in -- [a,b] by the intermediate value theorem. Likewise when f(a) >= 0 @@ -32,7 +45,7 @@ import qualified Roots.Fast as F -- >>> has_root cos (-2) 2 (Just 0.001) -- True -- -has_root :: (Fractional a, Ord a, Ord b, Num b) +has_root :: (RealField.C a, RealRing.C b) => (a -> b) -- ^ The function @f@ -> a -- ^ The \"left\" endpoint, @a@ -> a -- ^ The \"right\" endpoint, @b@ @@ -43,8 +56,6 @@ has_root f a b epsilon = F.has_root f a b epsilon Nothing Nothing - - -- | We are given a function @f@ and an interval [a,b]. The bisection -- method checks finds a root by splitting [a,b] in half repeatedly. -- @@ -64,7 +75,7 @@ has_root f a b epsilon = -- >>> bisect sin (-1) 1 0.001 -- Just 0.0 -- -bisect :: (Fractional a, Ord a, Num b, Ord b) +bisect :: (RealField.C a, RealRing.C b) => (a -> b) -- ^ The function @f@ whose root we seek -> a -- ^ The \"left\" endpoint of the interval, @a@ -> a -- ^ The \"right\" endpoint of the interval, @b@ @@ -74,6 +85,62 @@ bisect f a b epsilon = F.bisect f a b epsilon Nothing Nothing +-- | Find a fixed point of the function @f@ with the search starting +-- at x0. We delegate to the version that returns the number of +-- iterations and simply discard the number of iterations. +-- +fixed_point :: (Normed a, Algebraic.C a, Algebraic.C b, RealField.C b) + => (a -> a) -- ^ The function @f@ to iterate. + -> b -- ^ The tolerance, @epsilon@. + -> a -- ^ The initial value @x0@. + -> a -- ^ The fixed point. +fixed_point f epsilon x0 = + snd $ F.fixed_point_with_iterations f epsilon x0 + + +-- | Return the number of iterations required to find a fixed point of +-- the function @f@ with the search starting at x0 and tolerance +-- @epsilon@. We delegate to the version that returns the number of +-- iterations and simply discard the fixed point. +fixed_point_iteration_count :: (Normed a, + Algebraic.C a, + RealField.C b, + Algebraic.C b) + => (a -> a) -- ^ The function @f@ to iterate. + -> b -- ^ The tolerance, @epsilon@. + -> a -- ^ The initial value @x0@. + -> Int -- ^ The fixed point. +fixed_point_iteration_count f epsilon x0 = + fst $ F.fixed_point_with_iterations f epsilon x0 + + +-- | Returns a list of ratios, +-- +-- ||x^{*} - x_{n+1}|| / ||x^{*} - x_{n}||^{p} +-- +-- of fixed point iterations for the function @f@ with initial guess +-- @x0@ and @p@ some positive power. +-- +-- This is used to determine the rate of convergence. +-- +fixed_point_error_ratios :: (Normed a, + Additive.C a, + RealField.C b, + Algebraic.C b) + => (a -> a) -- ^ The function @f@ to iterate. + -> a -- ^ The initial value @x0@. + -> a -- ^ The true solution, @x_star@. + -> Integer -- ^ The power @p@. + -> [b] -- ^ The resulting sequence of x_{n}. +fixed_point_error_ratios f x0 x_star p = + zipWith (/) en_plus_one en_exp + where + xn = F.fixed_point_iterations f x0 + en = map (\x -> norm (x_star - x)) xn + en_plus_one = tail en + en_exp = map (^p) en + + -- | The sequence x_{n} of values obtained by applying Newton's method -- on the function @f@ and initial guess @x0@. @@ -86,7 +153,7 @@ bisect f a b epsilon = -- >>> tail $ take 4 $ newton_iterations f f' 2 -- [1.6806282722513088,1.4307389882390624,1.2549709561094362] -- -newton_iterations :: (Fractional a, Ord a) +newton_iterations :: (Field.C a) => (a -> a) -- ^ The function @f@ whose root we seek -> (a -> a) -- ^ The derivative of @f@ -> a -- ^ Initial guess, x-naught @@ -98,7 +165,6 @@ newton_iterations f f' x0 = xn - ( (f xn) / (f' xn) ) - -- | Use Newton's method to find a root of @f@ near the initial guess -- @x0@. If your guess is bad, this will recurse forever! -- @@ -122,19 +188,18 @@ newton_iterations f f' x0 = -- >>> abs (f root) < eps -- True -- -newtons_method :: (Fractional a, Ord a) +newtons_method :: (RealField.C a) => (a -> a) -- ^ The function @f@ whose root we seek -> (a -> a) -- ^ The derivative of @f@ -> a -- ^ The tolerance epsilon -> a -- ^ Initial guess, x-naught -> Maybe a -newtons_method f f' epsilon x0 - = find (\x -> abs (f x) < epsilon) x_n +newtons_method f f' epsilon x0 = + find (\x -> abs (f x) < epsilon) x_n where x_n = newton_iterations f f' x0 - -- | Takes a function @f@ of two arguments and repeatedly applies @f@ -- to the previous two values. Returns a list containing all -- generated values, f(x0, x1), f(x1, x2), f(x2, x3)... @@ -156,6 +221,7 @@ iterate2 f x0 x1 = let next = f prev2 prev1 in next : go prev1 next + -- | The sequence x_{n} of values obtained by applying the secant -- method on the function @f@ and initial guesses @x0@, @x1@. -- @@ -172,7 +238,7 @@ iterate2 f x0 x1 = -- >>> take 4 $ secant_iterations f 2 1 -- [2.0,1.0,1.0161290322580645,1.190577768676638] -- -secant_iterations :: (Fractional a, Ord a) +secant_iterations :: (Field.C a) => (a -> a) -- ^ The function @f@ whose root we seek -> a -- ^ Initial guess, x-naught -> a -- ^ Second initial guess, x-one @@ -200,7 +266,7 @@ secant_iterations f x0 x1 = -- >>> abs (f root) < (1/10^9) -- True -- -secant_method :: (Fractional a, Ord a) +secant_method :: (RealField.C a) => (a -> a) -- ^ The function @f@ whose root we seek -> a -- ^ The tolerance epsilon -> a -- ^ Initial guess, x-naught @@ -210,44 +276,3 @@ secant_method f epsilon x0 x1 = find (\x -> abs (f x) < epsilon) x_n where x_n = secant_iterations f x0 x1 - - - -fixed_point_iterations :: (a -> a) -- ^ The function @f@ to iterate. - -> a -- ^ The initial value @x0@. - -> [a] -- ^ The resulting sequence of x_{n}. -fixed_point_iterations f x0 = - iterate f x0 - - --- | Find a fixed point of the function @f@ with the search starting --- at x0. This will find the first element in the chain f(x0), --- f(f(x0)),... such that the magnitude of the difference between it --- and the next element is less than epsilon. --- -fixed_point :: (Num a, Ord a) - => (a -> a) -- ^ The function @f@ to iterate. - -> a -- ^ The tolerance, @epsilon@. - -> a -- ^ The initial value @x0@. - -> a -- ^ The fixed point. -fixed_point f epsilon x0 = - fst winning_pair - where - xn = fixed_point_iterations f x0 - xn_plus_one = tail $ fixed_point_iterations f x0 - - abs_diff v w = - abs (v - w) - - -- The nth entry in this list is the absolute value of x_{n} - - -- x_{n+1}. - differences = zipWith abs_diff xn xn_plus_one - - -- A list of pairs, (xn, |x_{n} - x_{n+1}|). - pairs = zip xn differences - - -- The pair (xn, |x_{n} - x_{n+1}|) with - -- |x_{n} - x_{n+1}| < epsilon. The pattern match on 'Just' is - -- "safe" since the list is infinite. We'll succeed or loop - -- forever. - Just winning_pair = find (\(_, diff) -> diff < epsilon) pairs