Created
October 18, 2014 21:43
-
-
Save yudetamago/f3ba6b4464a14c0ba52e to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
--module Gold (search, example) where | |
f :: Double -> Double | |
f x = (x - 1.0) * (x - 1.0) | |
golden_ratio :: Double | |
golden_ratio = ( 1 + sqrt(5) ) / 2 | |
data Interval = Interval {lb :: Double, ub :: Double} deriving Show | |
data PointValue2 = PointValue2 {x1 :: Double, f1 ::Double, x2 :: Double, f2 :: Double} deriving Show | |
idp :: Double -> Double -> Double | |
idp lb ub = (ub - lb) / (golden_ratio + 1.0) + lb | |
idp2 :: Double -> Double -> Double | |
idp2 lb ub = (ub - lb) / golden_ratio + lb | |
sub :: PointValue2 -> Interval -> Int -> Interval | |
sub pv val k | |
| k <= 0 = val | |
| f1 pv < f2 pv = let new_x1 = (idp (lb val) (x2 pv)) in sub (PointValue2 new_x1 (f $ new_x1) (x1 pv) (f1 pv)) (Interval (lb val) (x2 pv)) $ k - 1 | |
| otherwise = let new_x2 = (idp2 (x1 pv) (ub val)) in sub (PointValue2 (x2 pv) (f2 pv) new_x2 (f new_x2)) (Interval (x1 pv) (ub val)) $ k - 1 | |
search :: Double -> Double -> Int -> Double | |
search _lb _ub _k = ((lb newval) + (ub newval)) / 2.0 | |
where | |
_x1 = idp _lb _ub | |
_x2 = idp2 _lb _ub | |
_f1 = f _x1 | |
_f2 = f _x2 | |
pv = PointValue2 _x1 _f1 _x2 _f2 | |
val = Interval _lb _ub | |
newval = sub pv val _k | |
--search :: PointValue2 -> Interval -> Int -> Double | |
--search pv val k = ((lb newval) + (ub newval)) / 2.0 | |
-- where newval = sub pv val k | |
example = putStrLn $ unlines $ map show [sub pv val x|x<-[1..30] ] | |
where | |
_lb = -10.0 | |
_ub = 10.0 | |
_x1 = idp _lb _ub | |
_x2 = idp2 _lb _ub | |
_f1 = f _x1 | |
_f2 = f _x2 | |
pv = PointValue2 _x1 _f1 _x2 _f2 | |
val = Interval _lb _ub | |
main = example |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment