• API
• FAQ
• Tools
• Archive
SHARE
TWEET # multiplicable tdct  Nov 17th, 2019 123 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
2. {-# LANGUAGE FlexibleInstances #-}
3. {-# LANGUAGE UndecidableInstances #-}
5. {-# LANGUAGE BangPatterns #-}
6. {-# LANGUAGE ScopedTypeVariables #-}
7.
8.
9. import Text.Printf (printf)
10. import System.CPUTime (getCPUTime)
11.
12. class Multiplicable a where
13.     one  :: a
14.     (×)  :: a -> a -> a
15.
16. {-# INLINABLE pow #-}
17. {-# SPECIALIZE pow :: Integer -> Integer -> Integer #-}
18. pow :: forall a. (Multiplicable a) => a -> Integer ->  a
19. pow _ 0 = one
20. pow m 1 = m
21. pow m n = let
22.     k = m × m
23.     f :: Integer -> [a] -> (a, Integer) -> a
24.     f _ _ (v,0) = v
25.     f n (e:es) (v,r)
26.         | r - u >= 0 = f u (w:e:es) (v × w, r - u) -- double
27.         | r - n >= 0 = f n (e:es) (v × e, r - n) -- stay
28.         | otherwise = f (n `div` 2) es (v, r) -- half
29.         where u = n * 2
30.               w = e × e
31.     in f 2 [k, m] (k, n - 2)
32.
33. -- Tests
34. time :: a -> IO ()
35. time a = do
36.     start <- getCPUTime
37.     let !r = a
38.     end <- getCPUTime
39.     let diff = fromIntegral (end - start) / (10^12)
40.     printf "Computation time: %0.3f sec\n" (diff :: Double)
41.     return ()
42.
43. instance {-# OVERLAPPABLE #-}(Num a) => Multiplicable a where
44.     one  = 1
45.     (×)  = (*)
46.
47. -- test with matrixes
48. data Matrix a where
49.     Matrix :: (Num a) => (a, a, a, a) -> Matrix a
50.
51. instance {-# INCOHERENT #-}(Num a) => Multiplicable (Matrix a) where
52.     one  = Matrix (1, 0, 0, 1)
53.     (×) (Matrix (a1, a2, a3, a4)) (Matrix (b1, b2, b3, b4)) = let
54.         r1 = a1 * b1 + a2 * b3
55.         r2 = a1 * b2 + a2 * b4
56.         r3 = a3 * b1 + a4 * b3
57.         r4 = a3 * b2 + a4 * b4
58.         in Matrix (r1, r2, r3, r4)
59.
60. -- matrix powered fibonacci solver
61. fib :: Integer -> Integer
62. fib 0 = 0
63. fib 1 = 1
64. fib n = r1 + r2 where
65.     (Matrix (r1, r2, _, _)) = pow (Matrix (1,1,1,0)) (n - 2)
66.
67. -- clasical tail recursive fibonacci solver
68. fib' :: Integer -> Integer
69. fib' = f 0 1  where
70.     f a _ 0 = a
71.     f a b n = f b (a + b) (n - 1)
72.
73. main :: IO()
74. main = do
75.     putStr "fib 10^6\t"
76.     time (fib \$ 10^6)
77.     putStr "fib' 10^6\t"
78.     time (fib' \$ 10^6)
79.    putStr "pow 2 . (pow 10) \$ 9\t"
80.    time (pow 2  . pow 10  \$ 9)
81.    putStr "2^10^9\t"
82.    time (2^10^9)
83.    putStrLn ""
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.
Top