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 #-}
  4. {-# LANGUAGE GADTs #-}
  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. OK, I Understand
Top