Guest User

Untitled

a guest
Aug 14th, 2018
90
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.52 KB | None | 0 0
  1. Fixed point combinator in Haskell
  2. fix f = f (fix f)
  3.  
  4. fix (x->x*x) 0
  5.  
  6. fix f x | f x == f (f x) = f x
  7. | otherwise = fix f (f x)
  8.  
  9. (x -> x * x) ⊥ = ⊥
  10.  
  11. Prelude> fix (x->x*x) 0
  12.  
  13. <interactive>:1:11:
  14. No instance for (Num (a0 -> t0))
  15. arising from a use of `*'
  16. Possible fix: add an instance declaration for (Num (a0 -> t0))
  17. In the expression: x * x
  18. In the first argument of `fix', namely `( x -> x * x)'
  19. In the expression: fix ( x -> x * x) 0
  20.  
  21. f x = if x == 0 then 1 else x * f (x-1)
  22.  
  23. f = fix (f' x -> if x == 0 then 1 else x * f' (x-1))
  24.  
  25. fix (x->x*x) 0
  26.  
  27. let x = x*x in x 0
  28.  
  29. sqrt' :: Double -> Double
  30. sqrt' x = sqrtIter 1.0
  31. where sqrtIter guess | isGoodEnough guess = guess
  32. | otherwise = sqrtIter (improve guess)
  33. improve guess = (guess + x / guess) / 2
  34. isGoodEnough guess = abs (guess * guess - x) < 0.001
  35.  
  36. myFix :: (a -> a) -- "improve" the guess
  37. -> (a -> Bool) -- determine if a guess is "good enough"
  38. -> a -- starting guess
  39. -> a
  40. fixApprox improve isGoodEnough startGuess = iter startGuess
  41. where iter guess | isGoodEnough guess = guess
  42. | otherwise = iter (improve guess)
  43.  
  44. sqrt'' :: Double -> Double
  45. sqrt'' x = myFix improve isGoodEnough 1.0
  46. where improve guess = (guess + x / guess) / 2
  47. isGoodEnough guess = abs (guess * guess - x) < 0.001
  48.  
  49. primeAfter :: Int -> Int
  50. primeAfter n = myFix improve isPrime (succ n)
  51. where improve = succ
  52. isPrime x = null [z | z <- [2..pred x], x `rem` z == 0]
  53.  
  54. myFix f x | f x == f (f x) = f x
  55. | otherwise = myFix f (f x)
  56.  
  57. addG f a b =
  58. if a == 0 then
  59. b
  60. else
  61. f (a - 1) (b + 1)
  62.  
  63. add = fix addG -- Works as expected.
  64. -- addM = myFix addG (Compile error)
  65.  
  66. *Main> take 8 $ iterate (^2) (0.0 ::Float)
  67. [0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0]
  68. *Main> take 8 $ iterate (^2) (0.001 ::Float)
  69. [1.0e-3,1.0000001e-6,1.0000002e-12,1.0000004e-24,0.0,0.0,0.0,0.0]
  70.  
  71. *Main> take 8 $ iterate (^2) (0.999 ::Float)
  72. [0.999,0.99800104,0.9960061,0.9920281,0.9841198,0.96849173,0.93797624,0.8797994]
  73. *Main> take 8 $ iterate (^2) (1.0 ::Float)
  74. [1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0]
  75. *Main> take 8 $ iterate (^2) (1.001 ::Float)
  76. [1.001,1.002001,1.0040061,1.0080284,1.0161213,1.0325024,1.0660613,1.1364866]
  77.  
  78. fixed f from = snd . head
  79. . until ((< 1e-16).abs.uncurry (-).head) tail
  80. $ _S zip tail history
  81. where history = iterate f from
  82. _S f g x = f x (g x)
  83.  
  84. *Main> fixed (^2) (0.999 :: Float)
  85. 0.0
Add Comment
Please, Sign In to add comment