I created this destructive insertion to tries:
(* ins: char list * (char trie) ref list -> (char trie) ref list *)
fun ins ([], t) = t#[ref Empty]
| ins (x::xs, []) = [ref (Node (x, ins (xs, [])))]
| ins (x::xs, h::tl) =
case !h of
Node (c, lis) =>
if c = x then
(h := Node (c, ins (xs, lis)); h::tl)
else
h::ins (x::xs, tl)
| Empty => h::ins(x::xs, tl)
And I was trying to make it normal insert without references but I keep getting error.
(* ins: char list * (char trie) list -> (char trie) list *)
fun ins ([], t) = t#Empty
| ins (x::xs, []) = (Node (x, ins (xs, [])))
| ins (x::xs, h::tl) =
case h of
Node (c, lis) =>
if c = x then
(h = Node (c, ins (xs, lis)); h::tl)
else
h::ins (x::xs, tl)
| Empty = h::ins(x::xs, tl)
It would help if you provided the datatype definition that Empty and Node come from and error messages.
This is what I assume the datatype definition is for the first function:
datatype 'a trie = Empty | Node of 'a * 'a trie ref list
For the second:
datatype 'a trie = Empty | Node of 'a * 'a trie list
There are several issues with your second function:
The first clause (ns ([], t) = t#Empty) tries to append t to Empty, where t has type list but Empty has type 'a trie'. You should change that to ns ([], t) = t#[Empty] to match the destructive version, so that it typechecks.
The clauses in case use a "fat arrow" not an equals sign. Replace | Empty = h::ins(x::xs, tl) with this | Empty => h::ins(x::xs, tl).
Finally, this is not valid SML:
if c = x then
(h = Node (c, ins (xs, lis)); h::tl)
The parenthesized expression is a sequence which is only for imperative code. The variable h isn't a reference so you can't assign to it like that. Instead, you should use a let to introduce a local variable.
if c = x then
(let val h = Node (c, ins (xs, lis)) in h::tl end)
else
Here's the final function. This compiles but I didn't test it carefully so I don't know if there's another error with it:
fun ins ([], t) = t#[Empty]
| ins (x::xs, []) = [Node (x, ins (xs, []))]
| ins (x::xs, h::tl) =
case h of
Node (c, lis) =>
if c = x then
(let val h = Node (c, ins (xs, lis)) in h::tl end)
else
h::ins (x::xs, tl)
| Empty => h::ins(x::xs, tl)
if c = x then
(h = Node (c, ins (xs, lis)); h::tl)
if c = x then
(let val h = Node (c, ins (xs, lis)) in h::tl end)
else
Related
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'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.
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
I am new to Haskell.
I have this code (my solution to one of the exercise from Ninety-Nine Haskell Problems)
data Structure a = Single a | Multiple (a, Int) deriving (Show)
encodeM ::(Eq a)=> [a]->[Structure a]
encodeM l = map(\x -> (let size = length x
--h = head x
in if size>1 then Multiple ( head x, size) else Single (head x)
)
) $ group l
When I uncomment "-h = head x" I get: "parse error on input `='"
But
xxx l= let size = length l
h = head l
in size
works fine, why it doesn't compile when I use "let" with multiple statement inside the lambda?
I have tried to replace let by where
encodeM2 ::(Eq a)=> [a]->[Structure a]
encodeM2 l = map(\x->if si>1 then Multiple ( head x, si) else Single (head x)
where si = length x)
but it doesn't compile as well, whats wrong with it?
This is your code properly indented: (note how the let bindings align vertically)
encodeM :: Eq a => [a] -> [Structure a]
encodeM l = map (\x -> let size = length x
h = head x in
if size > 1
then Multiple (h, size)
else Single h) $
group l
This is your code readable:
encodeM :: Eq a => [a] -> [Structure a]
encodeM = map runLength . group
where
runLength x =
let size = length x
h = head x in
if size > 1
then Multiple (h, size)
else Single h
This is your code idiomatic:
encodeM :: Eq a => [a] -> [Structure a]
encodeM = map runLength . group
where
runLength [x] = Single x
runLength xs = Multiple (head xs, length xs)
I prefer to use pattern matching to if/then/else, so your code becomes:
encodeM :: (Eq a) => [a] -> [Structure a]
encodeM lst = map fun $ group lst
where
fun [x] = Single x
fun l = Multiple (head l, length l)
In Haskell whitespace matters.
Align assignemnts in your let. And you can't use where in lambda.
I'd like to rewrite such function into F#:
zipWith' :: (a -> b -> c) -> (a -> c) -> (b -> c) -> [a] -> [b] -> [c]
zipWith' _ _ h [] bs = h `map` bs
zipWith' _ g _ as [] = g `map` as
zipWith' f g h (a:as) (b:bs) = f a b:zipWith f g h as bs
My first attempt was:
let inline private map2' (xs : seq<'T>) (ys : seq<'U>) (f : 'T -> 'U -> 'S) (g : 'T -> 'S) (h : 'U -> 'S) =
let xenum = xs.GetEnumerator()
let yenum = ys.GetEnumerator()
seq {
let rec rest (zenum : IEnumerator<'A>) (i : 'A -> 'S) =
seq {
yield i(zenum.Current)
if zenum.MoveNext() then yield! (rest zenum i) else zenum.Dispose()
}
let rec merge () =
seq {
if xenum.MoveNext()
then
if yenum.MoveNext()
then yield (f xenum.Current yenum.Current); yield! (merge ())
else yenum.Dispose(); yield! (rest xenum g)
else
xenum.Dispose()
if yenum.MoveNext()
then yield! (rest yenum h)
else yenum.Dispose()
}
yield! (merge ())
}
However it can hardly be considered idiomatic. I heard about LazyList but I cannot find it anywhere.
As Brian mentioned, F# provides a usual Haskell-style lazy list in the PowerPack, so you can use that. Unfortunately, there is no good way to express this kind of thing using standard F# sequence expressions, because they can only express computations that read data from a single sequence using for (in your case, you'd need to read from multiple sequences).
However, it is possible to write a computation (similar to seq { .. }) for working with IEnumerator<T> - it is an imperative computation that modifies the enumerator behind the scenes, but it can be used for encoding patterns when seq isn't good enough. I'm planing to blog about it, but in the meantime, you can get it here (the code also includes the solution to your problem).
Then you can write this:
// Zip using specified functions for sequences
let zipWithFun f g h (a:seq<_>) (b:seq<_>) =
// Local helper function that works with iterators (xs and ys)
let rec zipWithFunE xs ys = iter {
// Try to get first element from both iterators (mutates the iterators!)
let! x = xs
let! y = ys
match x, y with
| Some(x), Some(y) ->
// If both produced value, then combine values using 'f' & continue
yield f (x, y)
yield! zipWithFunE xs ys
// If only one produced value, yield the value and then return the
// remaining values projected using one of the functions
| Some(rest), _ ->
yield g rest
yield! ys |> Enumerator.map g
| _, Some(rest) ->
yield g rest
yield! ys |> Enumerator.map g
| _ -> () }
// Construct a 'seq' value from a function that processes enumerators
Enumerator.toSeq (fun () ->
zipE (a.GetEnumerator()) (b.GetEnumerator()))
The core part of the code pretty much copies the structure of the original Haskell solution, which makes this approach very attractive, but you can still use sequences directly, without copying data to some other data structure.
LazyList is in the F# PowerPack. You probably need it to write this more elegantly. Given how good your first-try code looks, I expect you'll have no trouble authoring the LazyList version.
I suggest :
let forever xs =
Seq.append (Seq.map Some xs) (Seq.initInfinite (fun _ -> None))
let zipWith f g h xs ys =
Seq.zip (forever xs) (forever ys)
|> Seq.takeWhile (fun (x, y) -> Option.isSome x || Option.isSome y)
|> Seq.map ( function
| (Some x, Some y) -> f x y
| (Some x, None ) -> g x
| (None , Some y) -> h y
| _ -> failwith "quite unexpected !" )