module Data.Function.HT.Private where import Data.List (genericReplicate, ) {- | Compositional power of a function, i.e. apply the function @n@ times to a value. It is rather the same as @iter@ in Simon Thompson: \"The Craft of Functional Programming\", page 172 -} {-# INLINE nest #-} nest, nest1, nest2 :: Int -> (a -> a) -> a -> a nest 0 _ x = x nest n f x = f (nest (n-1) f x) nest1 n f = foldr (.) id (replicate n f) nest2 n f x = iterate f x !! n propNest :: (Eq a) => Int -> (a -> a) -> a -> Bool propNest n f x = nest n f x == nest1 n f x {- | @powerAssociative@ is an auxiliary function that, for an associative operation @op@, computes the same value as @powerAssociative op a0 a n = foldr op a0 (genericReplicate n a)@ but applies "op" O(log n) times and works for large n. -} {-# INLINE powerAssociative #-} {-# INLINE powerAssociative1 #-} powerAssociative, powerAssociative1 :: (a -> a -> a) -> a -> a -> Integer -> a powerAssociative _ a0 _ 0 = a0 powerAssociative op a0 a n = powerAssociative op (if even n then a0 else (op a0 a)) (op a a) (div n 2) powerAssociative1 op a0 a n = foldr op a0 (genericReplicate n a) infixl 0 $% {- | Flipped version of '($)'. It was discussed as (&) in http://www.haskell.org/pipermail/libraries/2012-November/018832.html I am not sure, that we need it. It is not exported for now. -} ($%) :: a -> (a -> b) -> b ($%) = flip ($)