Difference between revisions of "User:PaoloMartini"
Jump to navigation
Jump to search
PaoloMartini (talk | contribs) (Fixed test2) |
PaoloMartini (talk | contribs) ((W a) and TOC) |
||
Line 1: | Line 1: | ||
+ | {{TOC}} |
||
+ | |||
+ | == Points-free contest == |
||
+ | |||
<pre> |
<pre> |
||
\a b c -> a + (b*c) |
\a b c -> a + (b*c) |
||
Line 17: | Line 21: | ||
</pre> |
</pre> |
||
− | Experimenting with variadic functions |
+ | == Experimenting with variadic functions == |
+ | |||
+ | === First revision (W (a -> a)) === |
||
<haskell> |
<haskell> |
||
Line 73: | Line 79: | ||
test4 = zipWith (==) [foldl1 (^) [2..3], foldl1 (*) [1..10], foldl1 (+) [1..100]] test3 |
test4 = zipWith (==) [foldl1 (^) [2..3], foldl1 (*) [1..10], foldl1 (+) [1..100]] test3 |
||
+ | </haskell> |
||
+ | |||
+ | === No more incoherent instances ((W a) and QuickCheck)=== |
||
+ | |||
+ | <haskell> |
||
+ | {-# OPTIONS_GHC -fglasgow-exts #-} |
||
+ | module Apply |
||
+ | where |
||
+ | |||
+ | import Test.QuickCheck |
||
+ | |||
+ | data W a = W { reify :: a } deriving Show -- wrapper |
||
+ | |||
+ | class Apply a r | r -> a where |
||
+ | apply :: (a -> a -> a) -> a -> a -> r |
||
+ | |||
+ | instance Apply a (W a) where |
||
+ | apply f x y = W (f x y) |
||
+ | |||
+ | instance Apply a r => Apply a (a -> r) where |
||
+ | apply f x y z = apply f (f x y) z |
||
+ | |||
+ | -- test |
||
+ | |||
+ | plus_prop = quickCheck p2 >> quickCheck p3 >> quickCheck p4 |
||
+ | |||
+ | where p2 :: Int -> Int -> Bool |
||
+ | p3 :: Int -> Int -> Int -> Bool |
||
+ | p4 :: Int -> Int -> Int -> Int -> Bool |
||
+ | |||
+ | p2 x y = (reify $ apply (+) x y) == x + y |
||
+ | p3 x y z = (reify $ apply (+) x y z) == x + y + z |
||
+ | p4 x y z w = (reify $ apply (+) x y z w) == x + y + z + w |
||
</haskell> |
</haskell> |
Revision as of 10:34, 17 July 2006
Points-free contest
\a b c -> a + (b*c) \a b c -> (+) a ((*) b c) \a b -> ((+) a) . ((*) b) \a -> (((+) a) .) . (*) \a -> (.) ((+ a) .) (*) \a -> (flip (.)) (*) ((+ a) .) \a -> (flip (.)) (*) (((.) (+ a)) (flip (.)) (*) . ((.) . (+)) <xerox> I think I deserve an award for that reduction. <dons> xerox reaches PointFree Hacker, Level 7.
<xerox> f . g . h = (\x -> f . x . h) g = (\x -> f . (x . h)) g = (\x -> (f .) ((.) x h)) g = ((f .) . (. h)) g
Experimenting with variadic functions
First revision (W (a -> a))
{-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances #-}
module VarArg
where
data W a = W { unW :: a } deriving Show
-- `c' is:
--
-- c f x = (f x)
-- c f x y = c (f x) y
--
class C a r | r -> a where
c :: (a -> a -> a) -> a -> r
instance C a (W (a -> a)) where
c f x = W (\y -> f x y)
r :: Int -> W (Int -> Int) -> Int
r x = ($ x) . unW
instance C a r => C a (a -> r) where
c f x y = c f (f x y)
test1 = let t1 = c (+) 1
t2 = c (+) 1 2
t3 = c (+) 1 2 3
t4 = c (+) 1 2 3 4
in map (r 0) [t1,t2,t3,t4]
test2 = zipWith (==) [1, 1+2, sum [1,2,3], foldr (+) 0 [1,2,3,4]] test1
-- `d' is:
--
-- d f [ ] = f
-- d f (x:xs) = d (f x) xs
--
-- ..for which `c' is the only valid `f'.
--
class D a r | r -> a where
d :: (forall r. (C a r) => a -> r) -> [a] -> r
instance C a (W (a -> a)) => D a (W (a -> a)) where
d f (x:[]) = f x
d f (x:xs) = d (f x) xs
test3 = let t1 = d (c (^)) [2..3]
t2 = d (c (*)) [2..10]
t3 = d (c (+)) [2..100]
in map (r 1) [t1,t2,t3]
test4 = zipWith (==) [foldl1 (^) [2..3], foldl1 (*) [1..10], foldl1 (+) [1..100]] test3
No more incoherent instances ((W a) and QuickCheck)
{-# OPTIONS_GHC -fglasgow-exts #-}
module Apply
where
import Test.QuickCheck
data W a = W { reify :: a } deriving Show -- wrapper
class Apply a r | r -> a where
apply :: (a -> a -> a) -> a -> a -> r
instance Apply a (W a) where
apply f x y = W (f x y)
instance Apply a r => Apply a (a -> r) where
apply f x y z = apply f (f x y) z
-- test
plus_prop = quickCheck p2 >> quickCheck p3 >> quickCheck p4
where p2 :: Int -> Int -> Bool
p3 :: Int -> Int -> Int -> Bool
p4 :: Int -> Int -> Int -> Int -> Bool
p2 x y = (reify $ apply (+) x y) == x + y
p3 x y z = (reify $ apply (+) x y z) == x + y + z
p4 x y z w = (reify $ apply (+) x y z w) == x + y + z + w