haskell - chain up elements with an associative binary operation - haskell

I am an intermediate schemer, but only a haskell beginner. Here is my problem:
Suppose you have an associative binary operation, says (>>=). Is there a polyvariadic function p such that p (>>=) h g f e = h >>= g >>= f >>= e?
I am asking this question because this question says it is possible if the binary operation takes inputs of the same type. I wonder if this can be generalized.
EDIT-1: I try to modify the code in http://okmij.org/ftp/Haskell/vararg-fn.lhs (the section of Variable number of variably typed arguments) with little progress.
EDIT-2: Simplify the code a bit.
{-# LANGUAGE FunctionalDependencies, FlexibleInstances #-}
module Main where
class Lfold f a b | b -> a where
lfold :: (a -> (f a) -> (f a)) -> (f a) -> a -> b
instance Lfold f a (f a) where
lfold op rid x = op x rid
instance Lfold f a b => Lfold f a (a -> b) where
lfold op rid x y = lfold op (op x rid) y
test :: [String]
test = lfold (:) [] "a" "b" "c"
main :: IO ()
main = putStrLn $ show test

Yes, you can create such a function. It is very ugly however, and you will need to explicitly type every argument you are going to pass to make the compiler find the correct instance.
Starting from the polyvariadic function template you linked, I arrived at
{-# LANGUAGE FlexibleInstances, InstanceSigs, MultiParamTypeClasses #-}
class ImplicitChain m a r where
p :: m a -> r
instance Monad m => ImplicitChain m a (m a) where
p :: m a -> m a
p x = x
instance (Monad m, ImplicitChain m b r) => ImplicitChain m a ((a -> m b) -> r) where
p :: m a -> (a -> m b) -> r
p x f = p (x >>= f)
h :: Int -> [Int]
h = replicate 2
g :: Int -> [Int]
g = (:[])
f :: Int -> [Int]
f = flip enumFromTo 2
test :: [Int]
test = p [1::Int] h g f
But you were asking whether we can do more generic, so that the binary operation is an argument as well. Yes:
{-# LANGUAGE FlexibleInstances, InstanceSigs, MultiParamTypeClasses, UndecidableInstances #-}
class ImplicitVariadic a b r where
p :: (a -> b -> a) -> r
instance ImplicitVariadic a b (a -> a) where
p :: (a -> b -> a) -> a -> a
p _ x = x
instance (ImplicitVariadic a b (a -> r)) => ImplicitVariadic a b (a -> b -> r) where
p :: (a -> b -> a) -> a -> b -> r
p f x y = p f (f x y)

You can't (at least, not easily), because you need to know how many arguments you are getting ahead of time. Because all functions in Haskell are automatically curried, every function takes exactly one argument and returns one value. Even a simple binary operator takes one argument (the first operand) and returns a function that takes one argument (the second operand) and returns a result. That is,
a + b == (+) a b
== ((+) a) b
There is no way for your imaginary function p to know from its first argument how many other arguments are going to be given. That is, what should the type of p be?
p :: (a -> a -> a) -> a -- zero arguments?
p :: (a -> a -> a) -> a -> a -- one argument?
p :: (a -> a -> a) -> a -> a -> a -- two arguments?
p :: (a -> a -> a) -> a -> a -> a -> a -- three arguments?
Instead, the best you can do is use a fold, which takes an operation and a list of operands.
foldr (+) 0 [h, g, f, e] == h + g + f + e + 0 -- explicit first argument of 0
foldr1 (+) [h, g, f, e] == h + g + f + e -- assumes a list of at least one value
To see what I mean by "not easily", look at the implementation of printf in the Text.Printf module. Even that is not a good example, because the first argument carries information (the number of placeholders in the format string) that a binary operation alone does not.

Related

Haskell: apply a polymorphic function twice

We can have a polymorphic function f :: a -> b implemented for different pairs of a and b. How can we make
twice :: (a -> b) -> a -> c
twice f x = f (f x)
type check? i.e. how can I write a function which applies a polymorphic function twice?
With Rank2Types we can get a bit closer but not quite there:
{-# LANGUAGE Rank2Types #-}
twice1 :: (forall a. a -> (m a)) -> b -> (m (m b))
twice1 f = f . f
twice2 :: (forall a. m a -> a) -> m (m b) -> b
twice2 f = f . f
so then some polymorphic functions can be applied twice:
\> twice1 (:[]) 1
[[1]]
\> twice2 head [[1]]
1
Can we go further?
The question was asked over Haskell cafe 10 years ago but wasn't quite answered (with type classes it becomes a lot of boilerplate).
{-# LANGUAGE TypeFamilies, RankNTypes, UnicodeSyntax #-}
type family Fundep a :: *
type instance Fundep Bool = Int
type instance Fundep Int = String
...
twice :: ∀ a . (∀ c . c -> Fundep c) -> a -> Fundep (Fundep a)
twice f = f . f
Now, that won't be much use actually because you can't define a (meaningful) polymorphic function that works with any c. One possibility is to toss in a class constraint, like
class Showy a where
type Fundep a :: *
showish :: a -> Fundep a
instance Showy Bool where
type Fundep Bool = Int
showish = fromEnum
instance Showy Int where
type Fundep Int = String
showish = show
twice :: ∀ a b . (Showy a, b ~ Fundep a, Showy b) =>
(∀ c . Showy c => c -> Fundep c) -> a -> Fundep b
twice f = f . f
main = print $ twice showish False
You can't make twice generic enough even in a dependently typed setting, but it's possible with intersection types:
twice :: (a -> b /\ b -> c) -> a -> c
twice f x = f (f x)
Now whenever f :: a -> b and f :: b -> c typecheck, twice will typecheck too.
There is also a beautiful spell in Benjamin Pierce's thesis (I changed the syntax slightly):
self : (A /\ A -> B) -> B
self f = f f
So self-application is typeable with intersection types as well.

foldlWithKey in monad

I'm looking for a function that like foldlWithKey, but encapsulated in a monad.
I would expect it to have type
Monad m => (a -> k -> b -> m a) -> a -> Map k b -> m a
but Hoogle isn't giving me anything with that type.
foldlWithKey is already very close to what you want. If you specialize a to m a you will have something that operates on values encapsulated in a monad.
foldlWithKey :: ( a -> k -> b -> a) -> a -> Map k b -> a
foldlWithKey :: (m a -> k -> b -> m a) -> m a -> Map k b -> m a
{- ^- you don't want these -^ -}
We can get rid of the two m as you don't want with >>= and return.
foldlWithKeyM :: Monad m => (a -> k -> b -> m a) -> a -> Map k b -> m a
foldlWithKeyM f acc = foldlWithKey f' (return acc)
where
f' ma k b = ma >>= \a -> f a k b
#Cirdec's solution certainly works, but it has a possible problem: It nests >>=s deeply leftwards. For many (but not all!) monads, this can give stack blowup similar to when using non-strict foldl. So I'll present a different solution, which nests >>=s rightwards instead. For monads such as IO this should allow the action to be constructed and consumed lazily from the map as it is executed.
This solution is probably a bit trickier, as it uses a right fold to build up the monadic function that will eventually consume the starting value. At least I had some trouble getting the types right.
Except for the key handling, this is essentially the same method as used by Data.Foldable.foldlM.
-- Pragma needed only to give f' a type signature for sanity. Getting it
-- right almost took a piece of mine until I remembered typed holes.
{-# LANGUAGE ScopedTypeVariables #-}
import Data.Map
foldlWithKeyM
:: forall m a k b. Monad m => (a -> k -> b -> m a) -> a -> Map k b -> m a
foldlWithKeyM f start m = foldrWithKey f' return m $ start
where
f' :: k -> b -> (a -> m a) -> (a -> m a)
f' k b a2mb a = f a k b >>= a2mb

Taking monadic functions out of a monad

Haskell has the function join, which "runs" a monadic action which is inside a monad:
join :: Monad m => m (m a) -> m a
join m = m >>= \f -> f
We can write a similar function for monadic functions with one argument:
join1 :: Monad m => m (a -> m b) -> (a -> m b)
join1 m arg1 = m >>= \f -> f arg1
And for two arguments:
join2 :: Monad m => m (a -> b -> m c) -> (a -> b -> m c)
join2 m arg1 arg2 = m >>= \f -> f arg1 arg2
Is it possible to write a general function joinN, that can handle monadic functions with N arguments?
You can do something like this with a fair amount of ugliness if you really desire.
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
import Control.Monad (join, liftM)
class Joinable m z | z -> m where
joins :: m z -> z
instance Monad m => Joinable m (m a) where
joins = join
instance (Monad m, Joinable m z) => Joinable m (r -> z) where
joins m r = joins (liftM ($ r) m)
But, as you can see this relies on some shaky typeclass magic (in particular, the unenviable UndecidableInstances). It is quite possibly better—if ugly looking—to write all of the instances join1...join10 and export them directly. This is the pattern established in the base library as well.
Notably, inference won't work too well under this regime. For instance
λ> joins (return (\a b -> return (a + b))) 1 2
Overlapping instances for Joinable ((->) t0) (t0 -> t0 -> IO t0)
arising from a use of ‘joins’
Matching instances:
instance Monad m => Joinable m (m a)
-- Defined at /Users/tel/tmp/ASD.hs:11:10
instance (Monad m, Joinable m z) => Joinable m (r -> z)
-- Defined at /Users/tel/tmp/ASD.hs:14:10
but if we give an explicit type to our argument
λ> let {q :: IO (Int -> Int -> IO Int); q = return (\a b -> return (a + b))}
then it can still work as we hope
λ> joins q 1 2
3
This arises because with typeclasses alone it becomes quite difficult to indicate whether you want to operate on the monad m in the final return type of the function chain or the monad (->) r that is the function chain itself.
The short answer is no. The slightly longer answer is you could probably define an infix operator.
Take a look at the implementation for liftM: http://hackage.haskell.org/package/base-4.7.0.2/docs/src/Control-Monad.html#liftM
It defines up to liftM5. This is because it's not possible to define liftMN, just like your joinN isn't possible.
But we can take a lesson from Appicative <$> and <*> and define our own infix operator:
> let infixr 1 <~> ; x <~> f = fmap ($ x) f
> :t (<~>)
(<~>) :: Functor f => a -> f (a -> b) -> f b
> let foo x y = Just (x + y)
> let foobar = Just foo
> join $ 1 <~> 2 <~> foobar
Just 3
This is quite reminiscent of a common applicative pattern:
f <$> a1 <*> a2 .. <*> an
join $ a1 <~> a2 .. <~> an <~> f
A single function for every possible N? Not really. Generalizing over functions with different numbers of arguments like this is difficult in Haskell, in part because "number of arguments" is not always well-defined. The following are all valid specializations of id's type:
id :: a -> a
id :: (a -> a) -> a -> a
id :: (a -> a -> a) -> a -> a -> a
...
We'd need some way to get N at the type level, and then do a different thing depending on what N is.
Existing "variadic" functions like printf do this with typeclasses. They establish what N is by induction on ->: they have a "base case" instance for a non-function type like String and a recursive instance for functions:
instance PrintfType String ...
instance (PrintfArg a, PrintfType r) => PrintfType (a -> r) ...
We can (after a lot of thinking :P) use the same approach here, with one caveat: our base case is a bit ugly. We want to start with the normal join, which produces a result of type m a; the problem is that to support any m a, we have to overlap with normal functions. This means that we need to enable a few scary extensions and that we might confuse the type inference system when we actually use our joinN. But, with the right type signatures in place, I believe it should work correctly.
First off, here's the helper class:
class Monad m => JoinN m ma where
joinN :: m ma -> ma
ma will take the relevant function type like a -> m b, a -> b -> m c and so on. I couldn't figure out how to leave m out of the class definition, so right off the bat we need to enable MultiParamTypeClasses.
Next, our base case, which is just normal join:
instance Monad m => JoinN m (m a) where
joinN = join
Finally, we have our recursive case. What we need to do is "peel off" an argument and then implement the function in terms of a smaller joinN. We do this with ap, which is <*> specialized to monads:
instance (Monad m, JoinN m ma) => JoinN m (b -> ma) where
joinN m arg = joinN (m `ap` return arg)
We can read the => in the instance as implication: if we know how to joinN an ma, we also know how to do a b -> ma.
This instance is slightly weird, so it requires FlexibleInstances to work. More troublingly, because our base case (m (m a)) is made up entirely of variables, it actually overlaps with a bunch of other reasonable types. To actually make this work we have to enable OverlappingInstances and IncoherentInstances, which are relatively tricky and bug-prone.
After a bit of cursory testing, it seems to work:
λ> let foo' = do getLine >>= \ x -> return $ \ a b c d -> putStrLn $ a ++ x ++ b ++ x ++ c ++ x ++ d
λ> let join4 m a b c d = m >>= \ f -> f a b c d
λ> join4 foo' "a" "b" "c" "d"
a b c d
λ> joinN foo' "a" "b" "c" "d"
a b c d

What are the steps for deducing this pointfree code?

I was reviewing some code and came across the following gem, which I'd wager is a copy-paste of pointfree output:
(I thought the following would more appropriate than the usual foo/bar for this particular question :P)
import Control.Monad (liftM2)
data Battleship = Battleship { x :: Int
, y :: Int
} deriving Show
placeBattleship :: Int -> Int -> Battleship
placeBattleship x' y' = Battleship { x = x', y = y' }
coordinates :: Battleship -> (Int, Int)
coordinates = liftM2 (,) x y
Would someone be kind enough to explain the steps needed to simplify from: (i) coordinates b = (x b, y b) to: (ii) coordinates = liftM2 (,) x y? In particular, I'm a bit confused as to the use of liftM2 as I wasn't even aware that a monad was lurking in the background.
I know that (i) can also be represented as: coordinates s = (,) (x s) (y s) but I'm not sure where/how to proceed.
P.S. The following is why I suspect it's from pointfree (output is from GHCI and :pl is aliased to pointfree):
λ: :pl coordinates s = (x s, y s)
coordinates = liftM2 (,) x y
This takes advantage of the Monad instance for (->) r, also called the "reader monad". This is the monad of functions from a specific type to a. (Take a look here for motivation on why it exists in the first place.)
To see how it works for various functions, replace m with (r -> in m a. For example, if we just do liftM, we get:
liftM :: (a -> b) -> (m a -> m b)
liftM :: (a -> b) -> ((r -> a) -> (r -> b))
:: (a -> b) -> (r -> a) -> (r -> b) -- simplify parentheses
...which is just function composition. Neat.
We can do the same thing for liftM2:
liftM2 :: (a -> b -> c) -> m a -> m b -> m c
liftM2 :: (a -> b -> c) -> (r -> a) -> (r -> b) -> (r -> c)
So what we see is a way to compose two one-argument functions with a two-argument function. It's a way of generalizing normal function composition to more than one argument. The idea is that we create a function that takes a single r by passing that through both of the one-argument functions, getting two arguments to pass into the two-argument function. So if we have f :: (r -> a), g :: (r -> b) and h :: (a -> b -> c), we produce:
\ r -> h (f r) (h r)
Now, how does this apply to your code? (,) is the two-argument function, and x and y are one-argument functions of the type Battleship -> Int (because that's how field accessors work). With this in mind:
liftM2 (,) x y = \ r -> (,) (x r) (y r)
= \ r -> (x r, y r)
Once you've internalized the idea of multiple function composition like this, point-free code like this becomes quite a bit more readable—no need to use the pointfree tool! In this case, I think the non-pointfree version is still better, but the pointfree one isn't terrible itself.
The monad liftM2 is working over here is the function monad (->) a. This is equivalent to the Reader monad, as you may have seen before.
Recall the definition of liftM2:
liftM2 :: Monad m => (a -> b -> r) -> m a -> m b -> m r
liftM2 f ma mb = do
a <- ma
b <- mb
return $ f a b
So now if we substitute in (,) for f, x for ma, and y for mb, we get
liftM2 (,) x y = do
a <- x
b <- y
return $ (,) a b
Since x, y :: Battleship -> Int which is equivalent to ((->) Battleship) Int, then m ~ (->) Battleship. The function monad is defined as
instance Monad ((->) a) where
return x = const x
m >>= f = \a -> f (m a) a
Essentially what the function monad does is allow you to extract the output from several functions provided they all have the same input. A more clear example might be something like
test = do
a <- (^2)
b <- (^3)
c <- (^4)
d <- show
return (a, b, c, d)
> test 2
(4, 8, 16, "2")
You could easily rewrite
data Battleship = Battleship { x :: Int
, y :: Int
} deriving Show
placeBattleship :: Int -> Int -> Battleship
placeBattleship x y = Battleship x y
coordinates :: Battleship -> (Int, Int)
coordinates (Battleship x y) = (x, y)
It isn't point-free style, but quite simple

Using Typeable to partially apply function at run-time (any time types match)

Generic programming time!
If I have a function:
f :: a1 -> a2 -> a3 -> ... -> an
and a value
v :: aX -- where 1 <= x < n
Without knowing at compile time which of the arguments of f the value v is the right type for (if any), can I partially apply f to v? (using Typeable, Data, TH, or any other trick)
Slightly more solidly, can I construct the function g (below) at run-time? It doesn't actually have to be polymorphic, all my types will be monomorphic!
g :: (a1 -> a2 -> a3 -> a4 -> a5) -> a3 -> (a1 -> a2 -> a4 -> a5)
g f v = \x y z -> f x y v z
I know that, using Typeable (typeRepArgs specifically), v is the 3rd argument of f, but that doesn't mean I have a way to partially apply f.
My code would probably look like:
import Data.Typeable
data Box = forall a. Box (TyRep, a)
mkBox :: Typeable a => a -> Box
mkBox = (typeOf a, a)
g :: Box -> Box -> [Box]
g (Box (ft,f)) (Box (vt,v)) =
let argNums = [n | n <- [1..nrArgs], isNthArg n vt ft]
in map (mkBox . magicApplyFunction f v) argNums
isNthArg :: Int -> TyRep -> TyRep -> Bool
isNthArg n arg func = Just arg == lookup n (zip [1..] (typeRepArgs func))
nrArgs :: TyRep -> Int
nrArgs = (\x -> x - 1) . length . typeRepArgs
Is there anything that can implement the magicApplyFunction?
EDIT: I finally got back to playing with this. The magic apply function is:
buildFunc :: f -> x -> Int -> g
buildFunc f x 0 = unsafeCoerce f x
buildFunc f x i =
let !res = \y -> (buildFunc (unsafeCoerce f y) x (i-1))
in unsafeCoerce res
I'm not going to write the whole solution here for now, but I'm sure this can be done purely with Data.Dynamic and Typeable. The source for dynApply and funResultTy should provide the key elements:
dynApply :: Dynamic -> Dynamic -> Maybe Dynamic
dynApply (Dynamic t1 f) (Dynamic t2 x) =
case funResultTy t1 t2 of
Just t3 -> Just (Dynamic t3 ((unsafeCoerce f) x))
Nothing -> Nothing
funResultTy :: TypeRep -> TypeRep -> Maybe TypeRep
funResultTy trFun trArg
= case splitTyConApp trFun of
(tc, [t1,t2]) | tc == funTc && t1 == trArg -> Just t2
_ -> Nothing
To keep things simple, I'd have type Box = (Dynamic, [Either TypeRep Dynamic]). The latter starts out as a list of typereps of arguments. magicApply would look for the first matching TypeRep in the box and substitute the Dynamic of the value. Then you could have an extract that given a Box to which all arguments have been magicapplied, actually performs the dynApply calls to produce the resulting dynamic result.
Hm.. Typeable only? How about good old OverlappingInstances?
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies,
UndecidableInstances, IncoherentInstances, ScopedTypeVariables #-}
class Magical a b c where
apply :: a -> b -> c
instance (AreEqual a c e, Magical' e (a -> b) c r) => Magical (a -> b) c r where
apply f a = apply' (undefined :: e) f a
class Magical' e a b c where
apply' :: e -> a -> b -> c
instance (r ~ b) => Magical' True (a -> b) a r where
apply' _ f a = f a
instance (Magical b c d, r ~ (a -> d)) => Magical' False (a -> b) c r where
apply' _ f c = \a -> apply (f a) c
data True
data False
class AreEqual a b r
instance (r ~ True) => AreEqual a a r
instance (r ~ False) => AreEqual a b r
test :: Int -> Char -> Bool
test i c = True
t1 = apply test (5::Int)
t2 = apply test 'c'

Resources