I am having trouble completing a task where I am to create a function that uses a generalised fold function to evaluate a boolean AST. I will show you some examples to illustrate.
First, an example of what I want, but for an AST that sums integers:
data Expr = Val Int | Add Expr Expr deriving Show
folde :: (Int -> a) -> (a -> a -> a) -> Expr -> a
folde f g (Val x) = f x
folde f g (Add x y) = g (folde f g x) (folde f g y)
eval :: Expr -> Int
eval expr = folde (\x -> x) (\x y -> x + y) expr
This works fine.
Now for the boolean AST, and the folding function:
data Bexp = T | F | And Bexp Bexp | Or Bexp Bexp deriving (Ord, Eq)
foldb :: a -> a -> (a -> a -> a) -> (a -> a -> a) -> Bexp -> a
foldb t f a o T = t
foldb t f a o F = f
foldb t f a o (And x y) = a (foldb t f a o x) (foldb t f a o y)
foldb t f a o (Or x y) = o (foldb t f a o x) (foldb t f a o y)
What I am having trouble with, is creating a function that does the same as the eval function does for the simple AST above, that is, using the foldb function with some lambdas to evaluate whether the Bexp expression is either T or F.
I don't understand why this function doesn't work:
evb :: Bexp -> Bool
evb bexp = foldb (\_ -> True) (\_ -> False) (\x y -> x == T && y == T) (\x y -> x == T || y == T) bexp
GHCi doesn't even wanna to compile it because of type error.
Thanks in advance.
The code does't compile for few reasons.
-- Observe type signatures.
foldb :: a -> a -> (a -> a -> a) -> (a -> a -> a) -> Bexp -> a
evb bexp = foldb (\_ -> True) (\_ -> False) (\x y -> x == T && y == T) (\x y -> x == T || y == T) bexp
If foldb takes its first argument as a Function x -> Bool then from the type signature of foldb a is of type function but observe this (\x y -> x == T && y == T) here you used a as Bexp, which don't match at all.
a = Bexp from (\x y -> x == T && y == T)
a = x -> Bool from (\_ -> True)
And also the return type of evb is Bool, but from your argument passing to foldb a can be 2 things & the compiler is confused to pick the right type.
If we want to use foldb to produce a Bool at the very end, we need to choose a = Bool in its type. So, we are now using
foldb :: Bool
-> Bool
-> (Bool -> Bool -> Bool)
-> (Bool -> Bool -> Bool)
-> Bexp
-> Bool
Hence, foldb (\_->True) (\_->False) ... is wrong since the first two arguments must be booleans, not functions. We need something like foldb True False ....
The next two parameters must be boolean binary operators like \x y -> x && y, which can be written as (&&) for short.
We finally get:
evb :: Bexp -> Bool
evb bexp = foldb True False (&&) (||)
Related
module Luhn (isValid) where
import qualified Data.Char as C
isAsciiAlpha :: Char -> Bool
isAsciiAlpha = C.isAsciiLower || C.isAsciiUpper
isValid :: String -> Bool
isValid n
| any ((isAsciiAlpha || C.isSpace) . not) n = False
| otherwise = ys > 1 && sum xxs `mod` 10 == 0
where
xs = reverse [c | c <- n, isAsciiAlpha c]
ys = length xs
zs = zip xs (cycle [1, 2])
xxs = [convert x y | (x, y) <- zs]
convert :: Char -> Int -> Int
convert c mul =
do
let n = C.digitToInt c
case () of
_
| mul == 2 && (n > 4) -> n * mul - 9
| otherwise -> n * mul
I'm struggling with this line: any ((isAsciiAlpha || C.isSpace) . not) n = False. What I want is pretty obvious; find if any of the characters is something other than an ASCII alphabet or a space.
In spite of trying various syntaxes, I keep getting compilation error on this line, something like
• Couldn't match expected type ‘Bool’
with actual type ‘Char -> Bool’
You can not use (||) :: Bool -> Bool -> Bool on two functions: the parameters should be both Bools. What you can do is construct a function that maps a character c on isAsciiAlpha c || C.isSpace c, so \c -> isAsciiAlpha c || C.isSpace c, or you can use liftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c with liftA2 (||) isAsciiAlpha C.isSpace. The not :: Bool -> Bool should also be applied on the result of the function, so:
import Control.Applicative(liftA2)
isAsciiAlpha :: Char -> Bool
isAsciiAlpha = liftA2 (||) C.isAsciiLower C.isAsciiUpper
isValid :: String -> Bool
isValid n
| any (not . liftA2 (||) isAsciiAlpha C.isSpace) n = False
| otherwise = ys > 1 && sum xxs `mod` 10 == 0
where -- …
You can also make use of (<||>) :: Applicative a => a Bool -> a Bool -> a Bool or its shortcircuitng version (||^) :: Monad m => m Bool -> m Bool -> m Bool of the protolude package.
I am new in haskell, i am trying right now to implement "elem" with a "foldl any" in Haskell, but it won't work.
My any :
any' p = foldl' (\y x -> p x || y) False
and this is my elem :
elem' y = foldl' (\z x -> x==y || z) False
my first try was this :
elemfa p y = not (any' (\x -> not (p x)) y)
but i am getting an error everytime
Your elemfa :: Foldable f => (a -> Bool) -> f a -> Bool makes use of any'''', but that function does not exists. If you rewrite this to:
elemfa :: Foldable f => (a -> Bool) -> f a -> Bool
elemfa p y = not (any' (\x -> not (p x)) y)
You can make it more clean with:
elemfa :: Foldable f => (a -> Bool) -> f a -> Bool
elemfa p = not . any' (not . p)
It will at least produce output. This function will check if all elements satisfy the given predicate.
That being said, it is not ideal to use a foldl here for any, elem and elemfa, since that means it will keep iterating over the list, even if it found an element that satisfies the predicate. If you thus work on an infinite list, it will not return True, even if it found an element:
Prelude Data.List> elem' 1 (1 : repeat 2)
… keeps looking …
Here foldr :: Foldable f => (a -> b -> b) -> b -> f a -> b can be used to stop searching once the element has been found, for example:
any' :: Foldable f => (a -> Bool) -> f a -> Bool
any' p = foldr (\x -> (p x ||)) False
elem' :: (Foldable f, Eq a) => a -> f a -> Bool
elem' x = any' (x==)
all' :: Foldable f => (a -> Bool) -> f a -> Bool
all' p = not . any (not . p)
Let's say we have the following code representing binary trees where decodeInt searches the tree for an integer:
import Text.Show.Functions
data BinTree a b = Leaf b | Node a (BinTree a b) (BinTree a b) deriving Show
example :: BinTree (Int -> Bool) Char
example = Node (\x -> x > 4) (Node (\x -> x * x == x) (Leaf 'g') (Node (\x -> x == 0)
(Leaf 'u') (Leaf 'l'))) (Node (\x -> x >= 7) (Leaf 'f') (Leaf 'i'))
countInnerNodes :: BinTree a b -> Int
countInnerNodes (Node a b c) = 1 + countInnerNodes b + countInnerNodes c
countInnerNodes (Leaf x) = 0
decodeInt :: BinTree (Int -> Bool) b -> Int -> b
decodeInt (Leaf b) p = b
decodeInt (Node x y z) p = if (x(p) == True) then decodeInt z p else decodeInt y p
decode :: BinTree (Int -> Bool) b -> [Int] -> String
decode x [] = "empty list"
decode x xs = ??????
How can I use map to get a result like this when calling decode?
decode Tree [1,2,3,4]
= [decodeInt Tree (1), decodeInt Tree (2),
decodeInt Tree (3), decodeInt Tree (4)]
/edit: Followup
Let's also say we would like to create a function like the following
mapTree (\x -> ’e’) example
mapTree should return a BinTree just like example with the only difference being that the Char of every Leaf has been replaced with an 'e'. How do I accomplish that? I've started Haskell yesterday so I'm quite new to functional programming.
decodeInt :: BinTree (Int -> Bool) b -> Int -> b, so assuming t :: BinTree (Int -> Bool) b, then decodeInt t :: Int -> b. You map that function over your list of Ints.
decode t xs = let y = map (decodeInt t) xs
in ...
You'll still have to figure out how to convert y to the String value that decode is expected to return.
A bit too late but maybe this helps :
decode :: BinTree (Int -> Bool) b -> [Int] -> [b]
decode _ [] = []
decode x (y:ys) = decodeInt x y .... maybe you have an idea how to continue here ;)
I recently learned a bit about F-algebras:
https://www.fpcomplete.com/user/bartosz/understanding-algebras.
I wanted to lift this functionality to more advanced types (indexed and higher-kinded).
Furthermore, I checked "Giving Haskell a Promotion" (http://research.microsoft.com/en-us/people/dimitris/fc-kind-poly.pdf), which was very helpful because it gave names to my own vague "inventions".
However, I cannot seem to create a unified approach that works for all shapes.
Algebras need some "carrier type", but the structure we're traversing expects a certain shape (itself, applied recursively), so I came up with a "Dummy" container that can carry any type, but is shaped as expected. I then use a type family to couple these.
This approach seems to work, leading to a fairly generic signature for my 'cata' function.
However, the other things I use (Mu, Algebra) still need separate versions for each shape, just for passing a bunch of type variables around. I was hoping something like PolyKinds could help (which I use successfully to shape the dummy type), but it seems it is only meant to work the other way around.
As IFunctor1 and IFunctor2 do not have extra variables, I tried to unify them by attaching (via type family) the index-preserving-function type, but this seems not allowed because of the existential quantification, so I'm left with multiple versions there too.
Is there any way to unify these 2 cases? Did I overlook some tricks, or is this just a limitation for now?
Are there other things that can be simplified?
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Cata where
-- 'Fix' for indexed types (1 index)
newtype Mu1 f a = Roll1 { unRoll1 :: f (Mu1 f) a }
deriving instance Show (f (Mu1 f) a) => Show (Mu1 f a)
-- 'Fix' for indexed types (2 index)
newtype Mu2 f a b = Roll2 { unRoll2 :: f (Mu2 f) a b }
deriving instance Show (f (Mu2 f) a b) => Show (Mu2 f a b)
-- index-preserving function (1 index)
type s :-> t = forall i. s i -> t i
-- index-preserving function (2 index)
type s :--> t = forall i j. s i j -> t i j
-- indexed functor (1 index)
class IFunctor1 f where
imap1 :: (s :-> t) -> (f s :-> f t)
-- indexed functor (2 index)
class IFunctor2 f where
imap2 :: (s :--> t) -> (f s :--> f t)
-- dummy container type to store a solid result type
-- the shape should follow an indexed type
type family Dummy (x :: i -> k) :: * -> k
type Algebra1 f a = forall t. f ((Dummy f) a) t -> (Dummy f) a t
type Algebra2 f a = forall s t. f ((Dummy f) a) s t -> (Dummy f) a s t
cata1 :: IFunctor1 f => Algebra1 f a -> Mu1 f t -> (Dummy f) a t
cata1 alg = alg . imap1 (cata1 alg) . unRoll1
cata2 :: IFunctor2 f => Algebra2 f a -> Mu2 f s t -> (Dummy f) a s t
cata2 alg = alg . imap2 (cata2 alg) . unRoll2
And 2 example structures to work with:
ExprF1 seems like a normal useful thing, attaching an embedded type to an object language.
ExprF2 is contrived (extra argument which happens to be lifted (DataKinds) as well), just to find out if the "generic" cata2 is able to handle these shapes.
-- our indexed type, which we want to use in an F-algebra (1 index)
data ExprF1 f t where
ConstI1 :: Int -> ExprF1 f Int
ConstB1 :: Bool -> ExprF1 f Bool
Add1 :: f Int -> f Int -> ExprF1 f Int
Mul1 :: f Int -> f Int -> ExprF1 f Int
If1 :: f Bool -> f t -> f t -> ExprF1 f t
deriving instance (Show (f t), Show (f Bool)) => Show (ExprF1 f t)
-- our indexed type, which we want to use in an F-algebra (2 index)
data ExprF2 f s t where
ConstI2 :: Int -> ExprF2 f Int True
ConstB2 :: Bool -> ExprF2 f Bool True
Add2 :: f Int True -> f Int True -> ExprF2 f Int True
Mul2 :: f Int True -> f Int True -> ExprF2 f Int True
If2 :: f Bool True -> f t True -> f t True -> ExprF2 f t True
deriving instance (Show (f s t), Show (f Bool t)) => Show (ExprF2 f s t)
-- mapper for f-algebra (1 index)
instance IFunctor1 ExprF1 where
imap1 _ (ConstI1 x) = ConstI1 x
imap1 _ (ConstB1 x) = ConstB1 x
imap1 eval (x `Add1` y) = eval x `Add1` eval y
imap1 eval (x `Mul1` y) = eval x `Mul1` eval y
imap1 eval (If1 p t e) = If1 (eval p) (eval t) (eval e)
-- mapper for f-algebra (2 index)
instance IFunctor2 ExprF2 where
imap2 _ (ConstI2 x) = ConstI2 x
imap2 _ (ConstB2 x) = ConstB2 x
imap2 eval (x `Add2` y) = eval x `Add2` eval y
imap2 eval (x `Mul2` y) = eval x `Mul2` eval y
imap2 eval (If2 p t e) = If2 (eval p) (eval t) (eval e)
-- turned into a nested expression
type Expr1 = Mu1 ExprF1
-- turned into a nested expression
type Expr2 = Mu2 ExprF2
-- dummy containers
newtype X1 x y = X1 x deriving Show
newtype X2 x y z = X2 x deriving Show
type instance Dummy ExprF1 = X1
type instance Dummy ExprF2 = X2
-- a simple example agebra that evaluates the expression
-- turning bools into 0/1
alg1 :: Algebra1 ExprF1 Int
alg1 (ConstI1 x) = X1 x
alg1 (ConstB1 False) = X1 0
alg1 (ConstB1 True) = X1 1
alg1 ((X1 x) `Add1` (X1 y)) = X1 $ x + y
alg1 ((X1 x) `Mul1` (X1 y)) = X1 $ x * y
alg1 (If1 (X1 0) _ (X1 e)) = X1 e
alg1 (If1 _ (X1 t) _) = X1 t
alg2 :: Algebra2 ExprF2 Int
alg2 (ConstI2 x) = X2 x
alg2 (ConstB2 False) = X2 0
alg2 (ConstB2 True) = X2 1
alg2 ((X2 x) `Add2` (X2 y)) = X2 $ x + y
alg2 ((X2 x) `Mul2` (X2 y)) = X2 $ x * y
alg2 (If2 (X2 0) _ (X2 e)) = X2 e
alg2 (If2 _ (X2 t) _) = X2 t
-- simple helpers for construction
ci1 :: Int -> Expr1 Int
ci1 = Roll1 . ConstI1
cb1 :: Bool -> Expr1 Bool
cb1 = Roll1 . ConstB1
if1 :: Expr1 Bool -> Expr1 a -> Expr1 a -> Expr1 a
if1 p t e = Roll1 $ If1 p t e
add1 :: Expr1 Int -> Expr1 Int -> Expr1 Int
add1 x y = Roll1 $ Add1 x y
mul1 :: Expr1 Int -> Expr1 Int -> Expr1 Int
mul1 x y = Roll1 $ Mul1 x y
ci2 :: Int -> Expr2 Int True
ci2 = Roll2 . ConstI2
cb2 :: Bool -> Expr2 Bool True
cb2 = Roll2 . ConstB2
if2 :: Expr2 Bool True -> Expr2 a True-> Expr2 a True -> Expr2 a True
if2 p t e = Roll2 $ If2 p t e
add2 :: Expr2 Int True -> Expr2 Int True -> Expr2 Int True
add2 x y = Roll2 $ Add2 x y
mul2 :: Expr2 Int True -> Expr2 Int True -> Expr2 Int True
mul2 x y = Roll2 $ Mul2 x y
-- test case
test1 :: Expr1 Int
test1 = if1 (cb1 True)
(ci1 3 `mul1` ci1 4 `add1` ci1 5)
(ci1 2)
test2 :: Expr2 Int True
test2 = if2 (cb2 True)
(ci2 3 `mul2` ci2 4 `add2` ci2 5)
(ci2 2)
main :: IO ()
main = let (X1 x1) = cata1 alg1 test1
(X2 x2) = cata2 alg2 test2
in do print x1
print x2
Output:
17
17
I wrote a talk on this topic called "Slicing It" in 2009. It certainly points to the work by my Strathclyde colleagues, Johann and Ghani, on initial algebra semantics for GADTs. I used the notation which SHE provides for writing data-indexed types, but that has pleasingly been superseded by the "promotion" story.
The key point of the talk is, as per my comment, to be systematic about using exactly one index, but to exploit the fact that its kind can vary.
So indeed, we have (using my current preferred "Goscinny and Uderzo" names)
type s :-> t = forall i. s i -> t i
class FunctorIx f where
mapIx :: (s :-> t) -> (f s :-> f t)
Now you can show FunctorIx is closed under fixpoints. The key is to combine two indexed sets into a one that offers a choice of index.
data Case (f :: i -> *) (g :: j -> *) (b :: Either i j) :: * where
L :: f i -> Case f g (Left i)
R :: g j -> Case f g (Right j)
(<?>) :: (f :-> f') -> (g :-> g') -> Case f g :-> Case f' g'
(f <?> g) (L x) = L (f x)
(f <?> g) (R x) = R (g x)
Now we can now take fixpoints of functors whose "contained elements" stand for either "payload" or "recursive substructures".
data MuIx (f :: (Either i j -> *) -> j -> *) :: (i -> *) -> j -> * where
InIx :: f (Case x (MuIx f x)) j -> MuIx f x j
As a result, we can mapIx over "payload"...
instance FunctorIx f => FunctorIx (MuIx f) where
mapIx f (InIx xs) = InIx (mapIx (f <?> mapIx f) xs)
...or write a catamorphism over the "recursive substructures"...
foldIx :: FunctorIx f => (f (Case x t) :-> t) -> MuIx f x :-> t
foldIx f (InIx xs) = f (mapIx (id <?> foldIx f) xs)
...or both at once.
mapFoldIx :: FunctorIx f => (x :-> y) -> (f (Case y t) :-> t) -> MuIx f x :-> t
mapFoldIx e f (InIx xs) = f (mapIx (e <?> mapFoldIx e f) xs)
The joy of FunctorIx is that it has such splendid closure properties, thanks to the ability to vary the indexing kinds. MuIx allows for notions of payload, and can be iterated. There is thus an incentive to work with structured indices rather than multiple indices.
If I understand it properly, this is precisely the problem tackled by Johann and Ghani's "Initial Algebra Semantics is Enough!"
https://personal.cis.strath.ac.uk/neil.ghani/papers/ghani-tlca07.pdf
See in particular their hfold
Edit: For the GADT case, see their later paper "Foundations for Structured Programming using GADTs". Note that they encounter an obstacle that can be resolved using PolyKinds, which we now have: http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.111.2948
This blog post may also be of interest: http://www.timphilipwilliams.com/posts/2013-01-16-fixing-gadts.html
I'm currently having Haskell for university. Given the following haskell code:
true::t -> t1 -> t
true = (\x y -> x)
false::t -> t1 -> t1
false = (\x y -> y)
-- Implication
(==>) = (\x y -> x y true)
The task is to determine the type of the function (==>).
GHCi says it is (==>) :: (t1 -> (t2 -> t3 -> t2) -> t) -> t1 -> t.
I can see that the evaluation order is the following (as the type stays the same):
(==>) = (\x y -> (x y) true)
So the function true ist argument to (x y).
Can anyone explain why the result type t is bound to the result of the first argument and in which way GHCi determines the type of (==>)?
First, to give a better overview,
type True t f = t -> f -> t
type False t f = t -> f -> f
Let's call the result of the implication r, then we have, in \x y -> x y true :: r, that
x y :: True t f -> r
so x :: y -> True t f -> r, and thus
(==>) :: (y -> True t f -> r) -> y -> r
which, expanding True again, is
(==>) :: (y -> (t->f->t) -> r) -> y -> r