I'm trying to parse an input from user into my datatype:
type Var = String
data FProp = V Var
| No FProp
| Y FProp FProp
| O FProp FProp
| Si FProp FProp
| Sii FProp FProp deriving Read
using this function, by pattern matching:
f:: [String] -> FProp
f("(":"S":"i":"(":xs) = (Si (let x = fst (span (/= ")") xs) in f x) (let y = snd (span (/= ")") xs) in f y))
f("(":"Y":"(":xs) = (Y (let x = fst (span (/= ")") xs) in f x) (let y = snd (span (/= ")") xs) in f y))
f("(":"S":"i":"i":"(":xs) = (Sii (let x = fst (span (/= ")") xs) in f x) (let y = snd (span (/= ")") xs) in f y))
f("(":"O":"(":xs) = (O (let x = fst (span (/= ")") xs) in f x) (let y = snd (span (/= ")") xs) in f y))
f("(":"N":"O":"(":xs) = (No (f xs))
f ("(":"V":"(":xs) = (V(head xs))
The input would look like: "(Si (V(q)) (No (V(p))))" (equivalent to the formula: q -> ¬p).
It seemed like everything went fine, when I got this error: Non-exhaustive patterns in function f
¿Can I get some help in order to solve this?
I think it might have to do with the way I defined the last recursive case (the one for V).
The function you implemented is partial, not all cases are covered. You need to add a catch-all case and return an error.
To be able to do that, the function should return a type that allows modelling parsing failures (like Either Error FProp).
In my opinion you can create a much better parser with the parsec library. There are also many great tutorials you might want to investigate.
Related
The Haskell book Haskell Programming from First Principles has an exercise which asks me to instance Applicative on the datatype List:
data List a =
Nil
| Cons a (List a)
deriving (Eq, Show)
instance Functor List where
fmap _ Nil = Nil
fmap f (Cons x xs) = Cons (f x) (fmap f xs)
instance Applicative List where
pure x = Cons x Nil
Nil <*> _ = Nil
_ <*> Nil = Nil
Cons f fs <*> Cons x xs = Cons (f x) ((fmap f xs) <> (fs <*> xs))
I wrote the above code and found I must first instance Semigroup to let the <> operator work.
Can this be implemented without instance Semigroup first?
Yes. You here use the (<>) function in your definition:
instance Applicative List where
pure x = Cons x Nil
Nil <*> _ = Nil
_ <*> Nil = Nil
Cons f fs <*> Cons x xs = Cons (f x) ((fmap f xs) <> (fs <*> xs))
-- ^ call to the (<>) function
so you can replace this with a call to another function:
instance Applicative List where
pure x = Cons x Nil
Nil <*> _ = Nil
_ <*> Nil = Nil
Cons f fs <*> Cons x xs = Cons (f x) (append (fmap f xs) (fs <*> xs))
where append = ...
Note however that here you probably have implement a different function than the one you intend here. Here you implemented a function that for two lists [f1, f2, f3] and [x1, x2, x3, x4], will calculate a list with the "upper triangle" of the matrix of fs and xs, so this will result in [f1 x1, f1 x2, f1 x3, f1 x4, f2 x2, f2 x3, f2 x4, f3 x3, f3 x4]. Note that here f2 x1, f3 x1 and f3 x2 are missing.
Well you use something called <> and Haskell knows that this thing (specifically the definition of <> that you have imported as you haven’t defined the operator anywhere) requires a semigroup. The solution is to use a different name or define it locally:
Cons f fs <*> xs = (f <$> xs) <> (fs <*> xs)
where xs <> Nil = xs
Nil <> xs = xs
Cons x xs <> ys = Cons x (xs <> ys)
I'm playing with Difference list data type in Haskell: http://hackage.haskell.org/package/dlist-0.8.0.2/docs/Data-DList.html
And I see from package description that head function runs in O(n) time.
I wonder, why it happens? From first glance it looks like head should work O(1) time in most reasonable cases. But to argue about time-complexity we should define what this n stands for? Is it number of elements or number of lists?
Let's expand some definitions to figure out how head works.
First I have x = [1,2] and y = [3,4]. Then I convert them to DList and obtain x' = DList (x++) and y' = DList (y++). After that I append them:
z = x' <> y' = DList $ \zs -> x ++ (y ++ zs)
Now to the head function. It is defined as
-- | /O(n)/. Return the head of the dlist
head :: DList a -> a
head = list (error "Data.DList.head: empty dlist") const
Where list is:
-- | /O(n)/. List elimination for dlists
list :: b -> (a -> DList a -> b) -> DList a -> b
list nill consit dl =
case toList dl of
[] -> nill
(x : xs) -> consit x (fromList xs)
So you can say it is obvious why head runs O(n) time: is uses list function which runs O(n) time. But let's do some equational reasoning:
head z
= list (error "Data.DList.head: empty dlist") const z
= case toList z of
[] -> error "Data.DList.head: empty dlist"
(x : xs) -> const x (fromList xs)
= case (toList $ DList $ \zs -> x ++ (y ++ zs)) of
[] -> error "Data.DList.head: empty dlist"
(x : xs) -> const x (fromList xs)
= case (x ++ (y ++ [])) of
[] -> error "Data.DList.head: empty dlist"
(x : xs) -> const x (fromList xs)
= case ((1:2:[]) ++ (y ++ [])) of
[] -> error "Data.DList.head: empty dlist"
(x : xs) -> const x (fromList xs)
= case (1:((2:[]) ++ (y ++ []))) of
[] -> error "Data.DList.head: empty dlist"
(x : xs) -> const x (fromList xs)
= (1 : ((2:[]) ++ (y ++ []))) -> const 1 (fromList (2:[]) ++ (y ++ []))
= 1
So it looks like head won't evaluate whole list to take just first element and will work in O(1) unless there no empty lists. Is this really true and description of function just tells about worst possible case?
I'm trying to define primitive recursion in term of foldr, as explained in A tutorial on the universality and expressiveness on fold chapter 4.1.
Here is first attempt at it
simpleRecursive f v xs = fst $ foldr g (v,[]) xs
where
g x (acc, xs) = (f x xs acc,x:xs)
However, above definition does not halt for head $ simpleRecursive (\x xs acc -> x:xs) [] [1..]
Below is definition that halt
simpleRecursive f v xs = fst $ foldr g (v,[]) xs
where
g x r = let (acc,xs) = r
in (f x xs acc,x:xs)
Given almost similar definition but different result, why does it differ? Does it have to do with how Haskell pattern match?
The crucial difference between the two functions is that in
g x r = let (acc, xs) = r
in (f x xs acc, x:xs)
The pattern match on the tuple constructor is irrefutable, whereas in
g x (acc, xs) = (f x xs acc, x:xs)
it is not. In other words, the first definition of g is equivalent to
g x ~(acc, xs) = (f x xs acc, x:xs)
I have this language AST
data ExprF r = Const Int
| Var String
| Lambda String r
| EList [r]
| Apply r r
deriving ( Show, Eq, Ord, Functor, Foldable )
And I want to convert it to string
toString = cata $ \case
Const x -> show x
Var x -> x
EList x -> unwords x
Lambda x y -> unwords [x, "=>", y]
Apply x y -> unwords [x, "(", y, ")"]
But when lambda is used in Apply I need the parentheses
(x => x)(1)
but I cannot match inner structure with cata
toString :: Fix ExprF -> String
toString = cata $ \case
Const x -> show x
Var x -> x
Lambda x y -> unwords [x, "=>", y]
Apply (Lambda{}) y -> unwords ["(", x, ")", "(", y, ")"]
Apply x y -> unwords [x, "(", y, ")"]
Is there any better solution than para?
toString2 :: Fix ExprF -> String
toString2 = para $ \case
Const x -> show x
Var x -> x
Lambda x (_,y) -> unwords [x, "=>", y]
EList x -> unwords (snd <$> x)
Apply ((Fix Lambda {}),x) (_,y) -> unwords ["(", x, ")", "(", y, ")"]
Apply (_,x) (_,y) -> unwords [x, "(", y, ")"]
It looks uglier. Even it is needed only in one place I need to remove fst tuple parameters everywhere and I guess it will be slower.
As #chi, #DanielWagner and I pointed out in the comments, the way to do this sort of pretty-printing-with-parenthesisation in a structurally recursive manner is "the showsPrec approach".
The big idea is not to fold up the syntax tree into a String, but into a function Bool -> String. This gives us a degree of context-sensitivity in the fold: we'll use that extra Bool parameter to keep track of whether we're currently in the context of the left-hand side of an application.
parens x = "(" ++ x ++ ")"
ppAlg :: ExprF (Bool -> String) -> (Bool -> String)
ppAlg (Const x) isBeingApplied = show x
ppAlg (Var x) isBeingApplied = x
ppAlg (Lambda name body) isBeingApplied = p ("\\" ++ name ++ " -> " ++ body False)
where p = if isBeingApplied then parens else id
ppAlg (EList es) isBeingApplied = unwords (sequenceA es False)
ppAlg (Apply fun arg) isBeingApplied = fun True ++ " " ++ arg False
We pass values of isBeingApplied down the recursive calls depending on where we are in the syntax tree right now. Note that the only place we're passing down True is as an argument to fun in the body of the Apply case. Then, in the Lambda case, we inspect that argument. If the current term is the left-hand part of an application we parenthesise the lambda; if not we don't.
At the top level, having folded up the whole tree into a function Bool -> String, we pass it an argument of False - we're not currently in the context of an application - to get a String out.
pp :: Expr -> String
pp ex = cata ppAlg ex False
ghci> pp $ app (lam "x" (var "x")) (cnst 2)
"(\\x -> x) 2"
By replacing the Bool with an Int, this approach can be generalised to parenthesising operators with arbitrary precedences, as covered in #DanielWagner's linked answer.
One solution is to use the {-# LANGUAGE PatternSynonyms #-} extension and define unidirectional patterns like:
pattern Apply' r1 r2 <- Apply (_,r1) (_,r2)
that you could then use in your definitions like this:
toString2 :: Fix ExprF -> String
toString2 = para $ \case
Const x -> show x
Var x -> x
Lambda x (_,y) -> unwords [x, "=>", y]
EList x -> unwords (snd <$> x)
Apply ((Fix Lambda {}),x) (_,y) -> unwords ["(", x, ")", "(", y, ")"]
Apply' x y -> unwords [x, "(", y, ")"]
Since ExprF is a Functor, another option would be simply to write:
toString2' :: Fix ExprF -> String
toString2' = para $ \case
Apply ((Fix Lambda {}),x) (_,y) -> unwords ["(", x, ")", "(", y, ")"]
other -> case fmap snd other of
Const x -> show x
Var x -> x
Lambda x y -> unwords [x, "=>", y]
Apply x y -> unwords [x, "(", y, ")"]
With the pattern synonym, and compiling with -Wall, I'm having trouble convincing the exhaustivity checker that the pattern matches are exhaustive.
How about straight recursion for the missing case :
toString :: Fix ExprF -> String
toString (Fix (Apply (Fix (Lambda _ x)) y)) = "(" ++ toString x ++ ")(" ++ toString y ++ ")"
toString z = (cata $ \case
Const x -> show x
Var x -> x
EList x -> unwords x
Lambda x y -> unwords [x, "=>", y]
Apply x y -> unwords [x, "(", y, ")"]) z
I have the following code, which I would like to optimize.
I'm particularly unhappy with nub :
deep (Op o x) = [f (Op o x)] ++ map (\y->(Op o y)) (sf x)
deep x = [x]
sf [x] = [[f x]]
sf (x:xs) = map (\y->(y:xs)) (deep x) ++ map (x:) (sf xs)
eqlst l
| l == ll = l
| otherwise = eqlst ll
where ll = nub $ l ++ (concat $ map deep l)
For a full understanding of this, I provide all my code, which is not so long:
module Nat ( Nat, Operator(Add, Mul), Exp(Const, Name, Op), toNat, fromNat) where
import Data.List(nub)
newtype Nat = Nat Integer deriving (Eq, Show, Ord)
toNat :: Integer -> Nat
toNat x | x <= 0 = error "Natural numbers should be positive."
| otherwise = Nat x
fromNat :: Nat -> Integer
fromNat (Nat n) = n
instance Num Nat where
fromInteger = toNat
x + y = toNat (fromNat x + fromNat y)
x - y = toNat (fromNat x - fromNat y)
x * y = toNat (fromNat x * fromNat y)
abs x = x
signum x = 1
data Operator = Add | Sub | Mul
deriving (Eq, Show, Ord)
data Exp = Const Nat | Name { name::String } | Op{ op::Operator, kids::[Exp] }
deriving (Eq, Ord)
precedence :: Exp -> Integer
precedence (Const x) = 10
precedence (Name x) = 10
precedence (Op Add x) = 6
precedence (Op Sub x) = 6
precedence (Op Mul x) = 7
instance Show Exp where
show Op { op = Add, kids = [x, y] } =
let left = if precedence x <= 6 then "(" ++ show x ++ ")" else show x in
let right = if precedence y <= 6 then "(" ++ show y ++ ")" else show y in
left ++ "+" ++ right
show Op { op = Sub, kids = [x, y] } =
let left = if precedence x <= 6 then "(" ++ show x ++ ")" else show x in
let right = if precedence y <= 6 then "(" ++ show y ++ ")" else show y in
left ++ "-" ++ right
show Op { op = Mul, kids = [x, y] } =
let left = if precedence x <= 7 then "(" ++ show x ++ ")" else show x in
let right = if precedence y <= 7 then "(" ++ show y ++ ")" else show y in
left ++ "∙" ++ right
show (Const (Nat x)) = show x
show (Name x) = x
show x = "wat"
instance Num Exp where
fromInteger = Const . toNat
(Const x) + (Const y) = Const (x+y)
x + y = simplify $ Op { op = Add, kids = [x, y] }
(Const x) - (Const y) = Const (x-y)
x - y = simplify $ Op { op = Sub, kids = [x, y] }
(Const x) * (Const y) = Const (x*y)
x * y = simplify $ Op { op = Mul, kids = [x, y] }
abs x = x
signum x = 1
simplify :: Exp -> Exp
simplify (Op Mul [x,1]) = x
simplify (Op Mul [1,x]) = x
simplify (Op Sub [x,y])
| x == y = 0
| otherwise = (Op Sub [x,y])
simplify x = x
f (Op Add [x,y]) = y+x
f (Op Sub [x,y]) = y-x
f (Op Mul [x,y]) = y*x
f x = x
deep (Op o x) = [f (Op o x)] ++ map (\y->(Op o y)) (sf x)
deep x = [x]
sf [x] = [[f x]]
sf (x:xs) = map (\y->(y:xs)) (deep x) ++ map (x:) (sf xs)
eqlst l
| l == ll = l
| otherwise = eqlst ll
where ll = nub $ l ++ (concat $ map deep l)
eq x = eqlst [x]
main = do
let x = Name "x";y = Name "x";z = Name "z";w = Name "w";q = Name "q"
let g = (x+y+(z+w)+q)+(x+y+(z+w)+q)+(x+y+(z+w)+q)+(x+y+(z+w)+q)
putStr $ unlines $ map show $ eq g
I also have a side question, about the function deep and sf that are using f::Exp->Exp. In the end, f should probably be f::[Exp]->[Exp].
Right now, f only performs one kind of transformation. In the end, I would like it to perform many kinds of transformations, for example :
a+b->b+a, (a+b)+c->a+(b+c), etc.
The function nub is inefficient since it only uses an Eq constraint and therefore has to compare every nondiscarded pair of elements. Using the more efficient Data.Set, which is based internally on sorted trees, should improve on this:
import qualified Data.Set as S
eqset s
| s == ss = s
| otherwise = eqset ss
where ss = S.unions $ s : map (S.fromList . deep) (S.toList s)
eqlst = S.toList . eqset . S.fromList