I want to use Monad comprehensions in Coq.
Since I thought it is very difficult for me to implement notations which needs MonadPlus such as [ x | x <- m, x < 4 ], I didn't try to implement such notations.
I therefore wrote following code.
Notation "[ e | x <- m1 , .. , y <- m2 ]"
:= (m1 >>= (fun x => .. (m2 >>= (fun y => e)) ..))
(x closed binder, y closed binder).
However, it didn't work and I got this error.
Error: m1 is expected to occur in binding position in the right-hand side.
I think Coq interpreted "[ m | x <- m1 , .. , y <- m2 ]" (Coq code) as "[ m | x <- ( m1 , .. , y ) <- m2 ]" (pseudo-code).
But I don't have solutions for this problem. Any help would be appreciated.
I don't know if such a thing is possible with Notations only. The closest I can get is something where instead of writing [ e | x <- mx , ... , y <- my ] one has to write [ x <- mx , ... , y <- my | e ].
You can do it like so:
Require Import List.
Fixpoint join {a : Type} (xss : list (list a)) : list a :=
match xss with
| nil => nil
| (cons xs xss) => xs ++ join xss
end.
Definition bind {a b : Type} (xs : list a) (f : a -> list b) : list b :=
join (map f xs).
Notation "[ e" := e (at level 3).
Notation "x '<-' mx '|' e ']'" := (bind mx (fun x => cons e nil))
(at level 2).
Notation "x '<-' mx ',' f" := (bind mx (fun x => f))
(right associativity, at level 2).
And you can now write things like this:
Goal forall xs ys, { zs | zs = [ x <- xs, y <- map (plus x) ys | y - x ] }.
However the desugared version looks awful and the goals are pretty hard to read. If it's only for programming though, it's pretty much okay. You can even throw in some extra notations like the one for ranges:
Fixpoint range0 (n : nat) : list nat :=
match n with
| O => cons O nil
| S m => cons n (range0 m)
end.
Definition range (m n : nat) : list nat := map (plus m) (rev (range0 (n - m))).
Notation "m -- n ']'" := (range m n) (at level 2).
Which lets you write things like:
Goal { xs | xs = [ x <- [ 1 -- 3 ]
, y <- [ 1 -- x ]
| x + y ] }.
Related
I have some understanding of list comprehension. I understand that the expression:
[x * x | x <- [1..10]]
should output [1,4,9,16,25,36,49,64,81,100]
and that the effect of that expression is the same as:
map power [1..10]
power x = x * x
Now, I have to find out the other method (just like the above) for the following function:
[(x,y+z) | x <- [1..10], y <- [1..x], z <- [1..y]]
I can't figure it out by myself without errors, please help me
The Haskell Report tells us how to translate list comprehensions:
[ e | True ] = [e]
[ e | q ] = [ e | q, True ]
[ e | b, Q ] = if b then [ e | Q ] else []
[ e | p <- l, Q ] = let ok p = [ e | Q ]
ok _ = []
in concatMap ok l
[ e | let decls, Q ] = let decls in [ e | Q ]
Since your list comprehension only uses irrefutable patterns (that is, patterns that never fail), the fourth clause above simplifies somewhat:
[ e | p <- l, Q ] = concatMap (\p -> [ e | Q ]) l
I'll use this version for concision, but a true derivation should use the definition from the Report. (Homework: try the real translation, and check that you get the "same thing" in the end.) Let's try it, shall we?
[(x,y+z) | x <- [1..10], y <- [1..x], z <- [1..y]]
= concatMap (\x -> [(x,y+z) | y <- [1..x], z <- [1..y]] [1..10]
= concatMap (\x -> concatMap (\y -> [(x,y+z) | z <- [1..y]]) [1..x]) [1..10]
= concatMap (\x -> concatMap (\y -> [(x,y+z) | z <- [1..y], True]) [1..x]) [1..10]
= concatMap (\x -> concatMap (\y -> concatMap (\z -> [(x,y+z) | True]) [1..y]) [1..x]) [1..10]
= concatMap (\x -> concatMap (\y -> concatMap (\z -> [(x,y+z)]) [1..y]) [1..x]) [1..10]
And we're finally at a version that has no list comprehensions.
If you're comfortable with monads, then you can also gain insight into the behavior of this expression by observing that concatMap is a flipped version of the list's (>>=) function; moreover, [e] is like the list's return e. So, rewriting with monad operators:
= [1..10] >>= \x ->
[1..x] >>= \y ->
[1..y] >>= \z ->
return (x,y+z)
[(x,y+z) | x <- [1..10], y <- [1..x], z <- [1..y]]
is the same as
concatMap
(\x -> [(x,y+z) | y <- [1..x], z <- [1..y]])
[1..10]
You can extract the y and z variables out of the list comprehension similarly. (But you must do it in order from left to right: so y next and z last.)
concatMap is a function defined in the Prelude:
concatMap :: (a -> [b]) -> [a] -> [b]
concatMap f = concat . map f
You can transform this into do-notation:
foo = do x <- [1..10]
y <- [1..x]
z <- [1..y]
return (x, y+z)
This works because list is a monad. The do-notation itself is just syntactic sugar for a monadic calculation. Following the desugaring rules (described here under "Desugaring of do blocks") you end up with:
[1..10] >>= (\x -> [1..x] >>= (\y -> [1..y] >>= (\z -> [(x,y+z)])))
The operator >>= is defined in Control.Monad, and is equivalent to a concatMap with flipped arguments for lists. return t is just [t] in case of lists.
I am trying to write a function that performs capture-avoiding substitution in Lambda calculus. The code compiles but does not spit out the correct answer. I've written what I expect the code to do, is my comprehension correct?
For example, I should get the following output for this input (numeral 0 is the Church numeral 0)
*Main> substitute "b" (numeral 0) example -- \a. \x. ((\y. a) x) b
\c. \a. (\a. c) a (\f. \x. x)
-- The incorrect result I actually got
\c. \c. (\f. \x. x) (x (\b. a))
NB \y is renamed to \a due to the substitution (\y.a)[N/b] (I think I have this covered in the code I have written, but please let me know if I am wrong.)
import Data.Char
import Data.List
type Var = String
data Term =
Variable Var
| Lambda Var Term
| Apply Term Term
-- deriving Show
instance Show Term where
show = pretty
example :: Term -- \a. \x. ((\y. a) x) b
example = Lambda "a"
(Lambda "x" (Apply (Apply (Lambda "y" (Variable "a"))
(Variable "x"))
(Variable "b")))
pretty :: Term -> String
pretty = f 0
where
f i (Variable x) = x
f i (Lambda x m) = if i /= 0 then "(" ++ s ++ ")" else s
where s = "\\" ++ x ++ ". " ++ f 0 m
f i (Apply n m) = if i == 2 then "(" ++ s ++ ")" else s
where s = f 1 n ++ " " ++ f 2 m
substitute :: Var -> Term -> Term -> Term
substitute x n (Variable y)
--if y = x, then leave n alone
| y == x = n
-- otherwise change to y
| otherwise = Variable y
substitute x n (Lambda y m)
--(\y.M)[N/x] = \y.M if y = x
| y == x = Lambda y m
--otherwise \z.(M[z/y][N/x]), where `z` is a fresh variable name
--generated by the `fresh` function, `z` must not be used in M or N,
--and `z` cannot be equal `x`. The `used` function checks if a
--variable name has been used in `Lambda y m`
| otherwise = Lambda newZ newM
where newZ = fresh(used(Lambda y m))
newM = substitute x n m
substitute x n (Apply m2 m1) = Apply newM2 newM1
where newM1 = substitute x n m2
newM2 = substitute x n m1
used :: Term -> [Var]
used (Variable n) = [n]
used (Lambda n t) = merge [n] (used t)
used (Apply t1 t2) = merge (used t1) (used t2)
variables :: [Var]
variables = [l:[] | l <- ['a'..'z']] ++
[l:show x | x <- [1..], l <- ['a'..'z']]
filterFreshVariables :: [Var] -> [Var] -> [Var]
filterFreshVariables lst = filter ( `notElem` lst)
fresh :: [Var] -> Var
fresh lst = head (filterFreshVariables lst variables)
recursiveNumeral :: Int -> Term
recursiveNumeral i
| i == 0 = Variable "x"
| i > 0 = Apply(Variable "f")(recursiveNumeral(i-1))
numeral :: Int -> Term
numeral i = Lambda "f" (Lambda "x" (recursiveNumeral i))
merge :: Ord a => [a] -> [a] -> [a]
merge (x : xs) (y : ys)
| x < y = x : merge xs (y : ys)
| otherwise = y : merge (x : xs) ys
merge xs [] = xs
merge [] ys = ys
This part in substitute x n (Lambda y m) is not correct:
the comment says "z must not be used in M or N", but there is nothing preventing that. newZ could be a variable in n, which leads to a problematic capture
the substitution z/y has not been done
| otherwise = Lambda newZ newM
where newZ = fresh(used(Lambda y m))
newM = substitute x n m
Fix:
"z must not be used in M or N":
newZ = fresh(used m `merge` used n)
"M[z/y][N/x]":
newM = substitute x n (substitute y (Variable newZ) m)
Put together:
| otherwise = Lambda newZ newM
where
newZ = fresh(used m `merge` used n)
newM = substitute x n (substitute y (Variable newZ) m)
Note that refreshing all bindings as done above makes it difficult to understand the result and to debug substitution. Actually y only needs to be refreshed if y is in n. Otherwise you can keep y, adding this clause:
| y `notElem` used n = Lambda y (substitute x n m)
Another idea would be to modify fresh to pick a name similar to the old one, e.g., by appending numbers until one doesn't clash.
There is still a bug I missed: newZ should also not be equal to x (the variable originally being substituted).
-- substitute [a -> \f. \x. x] in (\g. g), should be (\g. g)
ghci> substitute "a" (numeral 0) (Lambda "g" (Variable "g"))
\a. \g. \x. x
Two ways to address this:
add x to the set of variables to exclude newZ from:
newZ = fresh ([x] `merge` used m `merge` used n)
if you think about it, this bug only manifests itself when x is not in m, in which case there is nothing to substitute, so another way is to add one more branch skipping the work:
| x `notElem` used m = Lambda y m
Put together:
substitute x n (Lambda y m)
--(\y.M)[N/x] = \y.M if y = x
| y == x = Lambda y m
| x `notElem` used m = Lambda y m
| y `notElem` used n = Lambda y (substitute x n m)
| otherwise = Lambda newZ newM
where newZ = fresh(used m `merge` used n)
newM = substitute x n (substitute y (Variable newZ) m)
Output
ghci> example
\a. \x. (\y. a) x b
ghci> numeral 0
\f. \x. x
ghci> substitute "b" (numeral 0) example
\a. \c. (\y. a) c (\f. \x. x)
Note: I haven't tried to prove this code correct (exercise for the reader: define "correct"), there may still be bugs I missed. There must be some course about lambda calculus that has all the details and pitfalls but I haven't bothered to look.
I need to develop my own filter function similar to how filter works in Haskell but by using list comprehension and a predicate. So I would put lcFilter (>3) [1,2,3,4,5,6,10,444,3] in ghci and it would print all numbers greater than 3.
My code is based on a recursion example which I'm good at but I can't seem to convert to list comprehension. It seams no matter what I put in [x | x<-xs, p] it always throws a compiler error. I know the p part is wrong. I've tried ==p, xs==p and just about everything else I could think of. This makes me think some other part might be wrong but I'm really not sure.
Here is the code for my function lcFilter. I'm not sure if some or all of it is wrong so I'm posting the whole thing.
lcFilter :: (a -> Bool) -> [a] -> [a]
lcFilter _ [] = []
lcFilter p (x:xs) = [x | x<-xs, p]
If I type lcFilter (>3) [1,2,3,4,5] it should print [4,5] just like the standard Haskell filter function.
It is as simple as
[x | x <- xs, p x]
Since p :: a -> Bool, and xs :: [a], to get a Boolean we need to apply the function to an argument; and by the list comprehension semantics we have x :: a.
The application rule of type inference is
x :: a
p :: a -> b
---------------
p x :: b
And you don't need the pattern matching, list comprehension will take care of that.
So overall, it is
lcFilter :: (a -> Bool) -> [a] -> [a]
lcFilter p xs = [x | x <- xs, p]
List comprehensions are fun. One rule they follow is
[ ... | x <- (xs ++ ys), .... ] ===
[ ... | x <- xs, .... ] ++ [ ... | x <- ys , .... ]
As a consequence, we also have
[ ... | x <- ([y] ++ ys), .... ] ===
[ ... | x <- [y], .... ] ++ [ ... | x <- ys , .... ] ===
[ ...{x/y} | ....{x/y} ] ++ [ ... | x <- ys , .... ]
where {x/y} means "replace x by y throughout". Thus, a list [a,b,...,n] is transformed by your definition into
[ a, b, ..., n ] ===>
[ a | p a] ++ [b | p b] ++ ... ++ [n | p n ]
This can be further understood in terms of / serve as a nice illustration to / the concepts of monads, or of monoids, but we'll leave that for another day. :)
Structured Graph encoding in Parametric Higher Order Abstract Syntax (PHOAS)
I'm reading the paper
"Functional Programming with Structured Graphs" by Olivera and Cook
(Slides,
draft paper.)
proposing an elegant solution to encode sharing and cycles in graph-like structures using recursive bindings in PHOAS.
The AST (stream example)
For example, streams with back edges can be encoded as :
-- 'x' is the element type, 'b' is the PHOAS's abstract variable:
data PS0 x b = Var0 b
| Mu0 (b -> PS0 x b) -- recursive binder
| Cons0 x (PS0 x b)
-- Closed terms:
newtype Stream0 x = Stream0 { runS0 :: forall b. PS0 x b }
-- Example : [0, 1, 2, 1, 2, 1, 2, ...
exPS0 = Stream0 $ Cons0 0 (Mu0 $ \x -> Cons0 1 (Cons0 2 $ Var0 x))
Folding (to list)
The AST can be folded into list without taking account of the cycles:
toListPS0 :: Stream0 x -> [x]
toListPS0 = go . runS0
where
go (Var0 x) = x
go (Mu0 h) = go . h $ [] -- nil
go (Cons0 x xs) = x : go xs
-- toListPS0 exPS0 == [0, 1, 2]
Or produce an infinite list, by taking the fix-point of recursive binders:
toListRecPS0 :: Stream0 x -> [x]
toListRecPS0 = go . runS0
where
go (Var0 x) = x
go (Mu0 h) = fix $ go . h -- fixpoint
go (Cons0 x xs) = x : go xs
-- toListRecPS0 exPS0 == [0, 1, 2, 1, 2, 1, 2, ...
Quasi-monadic join
The authors note that the encoding is a quasi-monad, having both join and return, but not fmap.
returnPS0 :: b -> PS0 x b
returnPS0 = Var0
joinPS0 :: PS0 x (PS0 x b) -> PS0 x b
joinPS0 (Var0 b) = b
joinPS0 (Mu0 h) = Mu0 $ joinPS0 . h . Var0
joinPS0 (Cons0 x xs) = Cons0 x $ joinPS0 xs
This can be used to unroll one level of recursive binding:
unrollPS0 :: Stream0 x -> Stream0 x
unrollPS0 s = Stream0 $ joinPS0 . go $ runS0 s
where
go (Mu0 g) = g . joinPS0 . Mu0 $ g
go (Cons0 x xs) = Cons0 x $ go xs
go e = e
-- toListPS0 . unrollPS0 $ exPS0 == [0, 1, 2, 1, 2]
PHOAS For Free
This reminded me the excellent article by Edward Kmett on FPComplete:
PHOAS For Free.
The idea is to make the AST a profunctor, separating negative and positive occurrence of PHOAS's variable.
The "fixpoint with place-order" of a functor is represented with a free-monad-like AST
(Fegaras and Sheard):
data Rec p a b = Place b
| Roll (p a (Rec p a b))
Provided that p is a profunctor (or that p a is a functor), Rec p a is a monad (and a functor !).
The stream AST can be encoded with the non-recursive functor PSF :
data PSF x a b = MuF (a -> b)
| ConsF x b
-- Type and pattern synonyms:
type PS1 x = Rec (PSF x)
pattern Var1 x = Place x
pattern Mu1 h = Roll (MuF h)
pattern Cons1 x xs = Roll (ConsF x xs)
-- Closed terms:
newtype Stream1 x = Stream1 { runS1 :: forall b. PS1 x b b }
-- Example : [0, 1, 2, 1, 2, 1, 2, ...
exPS1 = Stream1 $ Cons1 0 (Mu1 $ \x -> Cons1 1 (Cons1 2 (Var1 x)))
The problem
The join from the Rec monad instance is different than the original joinPS1 from the paper !
A literate translation of joinPS0 using the pattern synonyms is:
joinPS1 :: PS1 x (PS1 x b b) (PS1 x b b) -> PS1 x b b
joinPS1 (Var1 b) = b
joinPS1 (Mu1 h) = Mu1 $ joinPS1 . h . Var1 -- Var1 affects the negative occurrences
joinPS1 (Cons1 x xs) = Cons1 x $ joinPS1 xs
Whereas, inlining (>>=) and fmap in (>>= id) give us :
joinFreePSF :: PS1 x a (PS1 x a b) -> PS1 x a b
joinFreePSF (Var1 b) = b
joinFreePSF (Mu1 h) = Mu1 $ joinFreePSF . h -- No Var1 !
joinFreePSF (Cons1 x xs) = Cons1 x $ joinFreePSF xs
So my question is, why this difference?
The problem is that operations like unrollPS1 requires a join that "smash" both the positive and negative occurrences of the monad (like in the joinPS1 type).
I think it's related to the recursive nature of the binders. I tried to rewrite unrollPS1 by working with the types, but I'm not sure to have a full understanding of what is going on at the value level.
Remark
A fully general type of joinPS1 (inferred by the compiler) is
joinPS1 :: PS1 x (PS1 x' a a') (PS1 x a' b) -> PS1 x a' b
It can be specialized with a' ~ a ~ b and x' ~ x.
PS:
I don't try to achieve anything specific, it's more a matter of curiosity, like trying to connect the dots.
The full code with all the instances is
available here (gist).
You can actually easily reconstruct the Olivera and Cook join from my "profunctor HOAS" free monad join:
joinPS1 = join . lmap Var
Their version does the only thing it can do in their type.
There they have to keep the a = b, so it does so by introducing a Var. Here we can just put it on separately. It isn't required for the monad, and shouldn't be done for all cases.
The need to keep a and b in sync is why theirs can only be a "pseudo-monad" and why profunctor HOAS lets you actually have a real monad.
Here is my code to solve the fractional knapsack problem, input to knap should be in the form
[("label 1", value, weight), ("label 2", value, weight), ...]
And output should be in the form
[("label 1", value, solution_weight), ("label 2", value, solution_weight), ...]
Code:
import Data.List {- Need for the sortBy function -}
{- Input "how much can the knapsack hole <- x" "Possible items in sack [(label, value, weight), ...] <- y" -}
{-knap x [([Char], Integer, Integer), ... ] = -}
knap x [] = []
knap x y = if length y == 1
then
if x > last3 (head y)
then y
else [(frst3 (head y), scnd3 (head y), x)]
else
knap2 x y []
{- x is the knap max, y is the sorted frac list, z is the solution list -}
knap2 x y z = if x == 0
then z
else
if thrd4 (head y) > x
then [((frst4 (head y)), (scnd4 (head y)), x)]
else knap2 (x-(thrd4 (head y))) (tail y) (z++[((frst4 (head y)), (scnd4 (head y)), (thrd4 (head y)))])
{- take a list of labels, values, and weights and return list of labels and fractions -}
fraclist :: (Fractional t1) => [(t, t1, t1)] -> [(t, t1, t1, t1)]
fraclist xs = [(x, y, z, y/z) | (x, y, z) <- xs]
{- Sort the list -}
sortList x = sortBy comparator x
where comparator (_,_,_,d) (_,_,_,h) = if d > h then LT else GT
{- helper func to get values from tuples -}
frst3 (a,b,c) = a
scnd3 (a,b,c) = b
last3 (a,b,c) = c
frst4 (a,b,c,d) = a
scnd4 (a,b,c,d) = b
thrd4 (a,b,c,d) = c
last4 (a,b,c,d) = d
Here is the error I am getting
Couldn't match expected type `(t1, t0, t2, t3)'
with actual type `(t1, t0, t2)'
Expected type: [(t1, t0, t2, t3)]
Actual type: [(t1, t0, t2)]
In the second argument of `knap2', namely `y'
In the expression: knap2 x y []
I am not quite sure what else I can do. before I sit here and bang my head on the wall for an hour maybe someone could point out an obvious mistake if there are any?
I can't tell how the four-tuples in knap2 and the three-tuples in knap are supposed to fit together but you'll have a much clearer view of the matter if you pattern match and drop head, tail,thrd4, thirteenth17 etc
knap _ [] = []
knap x [(a,b,c)] = if x > c then [(a,b,c)] else [(a, b, x)]
knap x abcs = knap2 x abcs []
knap2 0 abcs z = z
knap2 x abcs z = undefined -- not sure how to do this
-- but this makes sense, it seems:
knap3 0 _ zs = zs
knap3 _ [] _ = []
knap3 x ((a,b,c,d):abcds) zs =
if c > x then [(a, b, x)]
else knap3 (x - c) abcds (zs ++ [(a, b, c)])
or something like that. Instead of writing if length y == 1 you can pattern match on the singleton case; instead of using an equality test, if x == 0 you can pattern match on the 0 case, distinguishing it from other cases.
Edit, I messed up, redo:
You can see that the error is in the argument y used in knap2 x y []. It is a triple (the actual type), but knap2 expects it to be a quadruple.