I'm trying to generate a truth table for a given boolean expression. I could do this with creating a new Datatype BoolExpr, but I want to do it with an anonymous function. It's supposed to work like this:
> tTable (\x y -> not (x || y))
output:
F F | T
F T | F
T F | F
T T | F
My approach:
tbl p = [(uncurry p) tuple | tuple <- allval]
where allval=[(x,y) | x <- [False,True], y <- [False,True]]
This works, but only for 2 Arguments. I want to do it for any number of Arguments. So I figured I would make a function that takes the Arguments from a List:
argsFromList f [] = f
argsFromList f (x:xs) = argsFromList (f x) xs
This does not work:
Occurs check: cannot construct the infinite type: t = t1 -> t
Expected type: t -> [t1] -> t1 -> t
Inferred type: (t1 -> t) -> [t1] -> t1 -> t
In the expression: argsFromList (f x) xs
I don't understand what the problem is here.
I would be very grateful if anyone could point me into the right direction or post a link that does.
If you want to build a truth table for boolean functions with an arbitrary number of arguments, you're creating a function that must work for multiple types, so you'll have to use type classes:
{-# LANGUAGE FlexibleInstances #-}
class TruthTable a where
truthTable :: a -> [([Bool], Bool)]
instance TruthTable Bool where
truthTable b = [([], b)]
instance TruthTable a => TruthTable (Bool -> a) where
truthTable f = [ (True : inps, out) | (inps, out) <- truthTable (f True)] ++
[ (False : inps, out) | (inps, out) <- truthTable (f False)]
For example:
*Main> mapM_ print $ truthTable (&&)
([True,True],True)
([True,False],False)
([False,True],False)
([False,False],False)
The problem here is that you're trying to call a function recursively with a different type for the recursive step. Consider the definition:
argsFromList f [] = f
argsFromList f (x:xs) = argsFromList (f x) xs
Let's try to infer the type ourselves. We can immediately see that the first argument f should be a function of at least one argument, the second argument (x:xs) is a list, and the list elements should be the same type as the first argument of f. In the first case the argument f is returned, so the final return type must be the same as the first argument. So we start with this:
argsFromList :: (a -> ?) -> [a] -> (a -> ?)
To find the unknown type ?, we can look at the second case, which consists of a recursive call. The argument xs is the same list type, and the argument (f x) has type ?. Since it's being used as the first argument in the recursive call, which has type (a -> ?), we can now conclude that ? is the same type as (a -> ?) which is therefore the same type as (a -> (a -> ?)) which is therefore the same type as (a -> (a -> (a -> ?))) which is... oops.
That would be the "infinite type", of course.
If you want to do this with functions that use a variable number of arguments of a single type, you'll probably want to use functions that take a list of values rather than individual arguments. Otherwise, you'll have to either write each version individually or use some arcane tricks involving advanced language features, neither of which is appealing in a simple case like this.
What you're asking for is not at all trivial. Haskell doesn't make it easy to deal with functions that apply functions with variable numbers of arguments. For example, the zip functions from Data.List come in separate variants for different numbers of arguments (zip, zip3, zip4, ...). Likewise, in Control.Monad there's liftM, liftM2, liftM3, ...
Basically, the most general type you can assign to a function with an unknown number of arguments is a -> b; a one-place truth function is Bool -> Bool (a = Bool, b = Bool), a two-place truth function is Bool -> (Bool -> Bool) (a = Bool, b = Bool -> Bool), three-place is Bool -> (Bool -> (Bool -> Bool)) (a = Bool, b = Bool -> (Bool -> Bool)), and so on. But there is no easy way you can look at the function you've been passed in to know what's the type on the right of the initial arrow.
One type of solution that can be made to work involves using type classes to define separate instances of the truth-table maker function for each argument function type. Sjoerd Visscher's answer in this thread is doing that for all function sizes by using a recursive instance definition (notice the recursive TruthTable a => TruthTable (Bool -> a) declaration). There may be other solutions that could be constructed using the Applicative type class.
Related
In a course I am following about Haskell, I am learning about type declaration. Currently, it is discussing abbreviations, something I am confused about, and that I cannot find the information I am looking for online.
It gives the following example:
type Pair a = (a, a)
along with a snippet of text: Abbreviations - new name for existing types
I have seen an example on the documentation that closely resembles the code above:
type Name = String
but from that I still cannot make sense of the above example.
I am struggling to understand what it is trying to explain, so can someone else make sense of it for me and give simple example of its usage in a program?
This is a type alias [Haskell wiki]. It is used to often give a name to more complicated types.
For example if you define a function:
sum2 :: Pair Int -> Int
sum2 (x, y) = x + y
then behind the curtains, this is thus resolved to:
sum2 :: (Int, Int) -> Int
sum2 (x, y) = x + y
Type aliases are often used to
to give a special structure a more convenient name;
to shorten complicated types; and
to make it easy to switch from type.
For example a String is defined as:
type String = [Char]
A String is thus simply a list of Characters. But a signature with String focuses on the fact that it works with textual data.
Type aliases are often used to abstract away complexity of a type. For example we can define a type Operator:
type Operator a = a -> a -> a
This is thus an alias for a function that maps two parameters of type a to a value of type a. This is interesting if we later want to create functions that work with this operator. For example:
maxOperator :: Ord a => Operator a -> Operator a -> Operator a
maxOperator f g x y = max (f x y) (g x y)
This is more likely more readable than:
maxOperator :: Ord a => (a -> a -> a) -> (a -> a -> a) -> (a -> a -> a)
maxOperator f g x y = max (f x y) (g x y)
and it definitely is more readable if we would later use Operator (Operator a), which thus resolves to (a -> a -> a) -> (a -> a -> a) -> a -> a -> a.
Finally types are sometimes used if it is not yet completely clear what type you will use. If you are for example implementing a package and you have not yet decided to work with Floats or Doubles, you can define a type alias:
type Scalar = Float
If you then later change your mind, you can rewrite it to type Scalar = Double, and all places where you used Scalar will now resolve to Double.
When you write a statement with the type keyword, you are defining a type synonym. Thus in the following example, the type Pair Int and the type (Int, Int) are exactly the same type and can be used interchangeably:
type Pair a = (a, a)
myPair :: Pair Int
myPair = (1, 2)
sumPair :: Num a => Pair a -> a
sumPair = uncurry (+)
This example works even though the type of uncurry specifies a two-tuple instead of a Pair because a Pair is a two-tuple.
This contrasts with the similar declaration newtype, which defines a wrapper around another type. In the following example, the types Pair Int and (Int, Int) are distinct at compile-time and cannot be used interchangeably:
newtype Pair a = Pair { unpair :: (a, a) }
myPair :: Pair Int
myPair = Pair (1, 2)
sumPair :: Num a => Pair a -> a
sumPair = uncurry (+) . unpair
It is necessary in the second example to call Pair to wrap the two-tuple into a pair before assigning it to myPair and unpair to unwrap the pair into a standard two-tuple before we can use uncurry because Pair Int and (Int, Int) are treated as distinct types.
I'm trying to understand some code and I'm getting myself tangled fairly well. Please help me to understand my logic, or lack thereof ...
To start:
*Main> :t fmap
fmap :: Functor f => (a -> b) -> f a -> f b
If I just want f a to be a function that takes one parameter, it's okay and makes sense:
*Main> :t \f -> fmap f (undefined :: String -> Int)
\f -> fmap f (undefined :: String -> Int) :: (Int -> b) -> String -> b
I can pass in a String in the second param, which generates an Int, and then use the function in the first param to generate the b.
Now, I want f a to be a function that takes two parameters, so I substitute that in:
*Main> :t \f -> fmap f (undefined :: String -> Int -> Bool)
\f -> fmap f (undefined :: String -> Int -> Bool)
:: ((Int -> Bool) -> b) -> String -> b
At this point, I'm confused. I already provided the function that converts from the String and the Int into the Bool. How can I now provide another function that takes a Int -> Bool to convert into a b? Is this non-sensical or am I not reading this right?
Or maybe this is a case of a functor within a functor and more needs to be done to make this make sense? In which case, what?
There is actually no such thing as a function with two parameters in Haskell. Every function has exactly one parameter.
In particular, String -> Int -> Bool is a function which accepts one String parameter. (Of course, knowing that the result is again a function you are able to use it as if it were a function with two parameters.) So if you want to unify this with f a, you need
f ~ (String->)
a ~ Int->Bool
Indeed Int->Bool can itself be interpreted as a functor-application†
f ~ (String->)
g ~ (Int->)
b ~ Bool
so that String->Int->Bool ~ f (g b); thus
\f -> fmap (fmap f) (undefined :: String -> Int -> Bool)
:: (Bool -> b) -> String -> Int -> b
I don't think the function family of functors is really a good example for grasping properties of functors/applicatives/monads. List and maybes are generally much less confusing; instead of the plain function functor the equivalent Reader is preferred when you need that functionality (pun not intended).
Regarding your original expression, that is actually not meaningless. If we translate it to a tamer functor, we could for instance write
> fmap ($2) [(>1), (>2), (>3)]
[True, False, False]
Much the same thing can be done with the function functor:
> fmap ($2) (<) 1
True
> fmap ($2) (<) 2
False
> fmap ($2) (<) 3
False
Of course that example is a bit too simple to be useful, but you can also implement nontrivial ones.
†Note that f and g are actually not the same functor. We tend to call them both “the function functor”, but really you get a different functor for every partial application of the (->) constructor. That means, you can't in any way unify the two layers, even though there's a Monad (a->) instance.
I'm studying for an exam about Haskell. I don't understand how I determine the type of a function. The function is:
func [] f = 16
func (h : t) f = (f h) + (func t f)
My guess is that the first line has this types: empty list -> a -> a where a has to be a numeric type. In Haskell notation Num a => [] -> a -> a and the second line has this types: [a]-> a -> ? What does it return? Maybe (a, a) because (f h) is a tuple. What about (func t f), is a or? And how do I mix both lines together?
func [] f = 16
This line defines a function func, accepting a list and f, and returning 16. The type could be written as Num a => [b] -> c -> a.
func (h : t) f = (f h) + (func t f)
This line restricts f type to Num a => b -> a, because:
f should accept an element from the list
f ... should return a value, which could be added to result of func ...
So, the type of func is:
Num a => [b] -> (b -> a) -> a
One (easy) way to find out about such problems is to write it in a file and load it into ghci and issue the command :t func, which is nice while preparing for an exam but not applicable during it - so I will walk you through the hints that can be found.
As #soon gave a perfectly valid answer - I will only add a few hints you might use in the future:
determine the number of arguments (this might be a bit difficult if the function is written in pointfree style, i.e. func x = const x could be written as func = const.
so in this case we get two arguments and one result so we can write the signature as
func :: ? -> ? -> ?
Look for results (in this case 16) and determine its type
you already noticed that 16 is something numerical - thus
func :: Num a => ? -> ? -> a
looks as a good starting point.
Look for type constructors that help you identify ADTs or type/newtypes in your function.
Now in the first and second case we have two hints that the first argument is of type list ([] and the constructor (:)) gives us this info. As we have no information about the contents of the list we have to assign a different type variable for them - b.
func :: Num a => [b] -> ? -> a
identify functions used to determine the rest or get more specialized types for the stuff you already found out
here we have 2 informations one is the (+) operator, and (f h) - as the whitespace character in haskell means function applicaton we get h's type has to be the domain of the function f and as the result of f h is used with (+) :: Num a => a -> a -> a (Note that both arguments must have the same type, as well as the result) and the result of func t f (which is a) we get the target type of f and therefore f :: b -> a
composing this we get
func :: Num a => [b] -> (type-of-f) -> a
func :: Num a => [b] -> (b -> a) -> a
I'm trying to create a function that gets a variadic function as an argument, i.e.
func :: (a -> ... -> a) -> a
how can I accomplish this?
I've read about polyvariadic functions and I'm sure that Oleg already did it, however I'm lost trying to apply the pattern on a function with a variadic function as an argument. Especially Olegs approach seems to work with glasgow extensions only and I want the solution to work in pure Haskell 98 (like Text.Printf does).
The reason that I ask is that I'm trying to build a function which takes a boolean function as an argument and checks whether it is a tautology, i.e.
isTautology :: (Bool -> ... -> Bool) -> Bool
so that one could type:
isTautology (\x -> x && not x)
isTautology (\x y -> x && y || not y)
My problem is that I keep reading about the trick was to make the return type a type variable (so that it can be the result or another function), but my return type is fixed (Bool).
The trick is to make a type class for which you will define an instance for functions, and an instance for the return type. The fact that it's a Bool is not a problem at all.
We're trying to write a function which takes a variadic argument and returns a Bool, so we'll define a type class with such a function.
class Stmt a where
tautology :: a -> Bool
Next, we define an instance for the return type of the variadic function. In this case, that's Bool.
-- A Bool is a tautology if it's True.
instance Stmt Bool where
tautology = id
The key part is the next instance for functions that take a Bool argument, and whose return type is some type from our class. That way, this instance will be applied multiple times if a function takes multiple arguments.
-- A function is a tautology if it always returns a tautology.
instance Stmt b => Stmt (Bool -> b) where
tautology f = tautology (f True) && tautology (f False)
Writing it this way requires FlexibleInstances because of the Bool in the second instance head. To do the same with pure Haskell 98, we'll need to use a suitably-constrained type variable instead. We can for example use Bounded and Enum (there are instances for both for Bool), or you can make your own class that will let you construct the appropriate inputs.
instance (Enum a, Bounded a, Stmt b) => Stmt (a -> b) where
tautology f = all (tautology . f) [minBound .. maxBound]
And we're done. Let's try it out:
> tautology $ \x y -> (not x && not y) == not (x && y)
False
> tautology $ \x y -> (not x && not y) == not (x || y)
True
I want to create a function apply that takes a function with an arbitrary amount of arguments as well as a list of integers, and returns the result of the function (Where each integer in the list is an argument in order.
I was thinking something like:
apply :: ([Int] -> Int) -> [Int] -> Int
apply f x:xs = apply (f x) xs
apply f [] = f
But I know this won't work because the type signature is wrong - the function doesn't take a list of ints, it just takes some amount of int arguments.
Additionally, when I get to the base case the f argument to apply should actually be an integer, violating the type signature anyway.
Does anyone know how to deal with this sort of problem?
I want to create a function apply that takes a function with an arbitrary amount of arguments as well as a list of integers,
Why do you want to do this? Perhaps your argument structure should be passed as a data structure, but so far you've over constrained the problem to ensure it won't produce an idiomatic Haskell solution.
You can do it with some fancy type classes
{-# LANGUAGE FlexibleInstances #-}
-- for ApplyType (Int -> r)
class ApplyType t where
apply :: t -> [Int] -> Int
instance ApplyType Int where
apply f _ = f
instance (ApplyType r) => ApplyType (Int -> r) where
apply f (x:xs) = apply (f x) xs
main :: IO ()
main = do print $ apply ((+) :: Int->Int->Int) [1, 2]
print $ apply ((\x y z w -> x*y - z`div`w) :: Int->Int->Int->Int->Int) [3,5,8,2]