Consider the following type:
data LTree a = Leaf a | Fork (LTree a) (LTree a)
build :: [(a,Int)] -> LTree a
build l = fst (buildaccum 0 l)e
I have a list and want to build a tree
buildaccum :: Int -> [(a,Int)] -> (LTree a, [(a,Int)])
buildaccum n l#((a,b):t) |n==b = (Leaf a,t)
|n<b = (Fork e d, l2)
where (e,l1) = buildaccum (n+1) l
(d,l2) = buildaccum (n+2) l1
In ghci, I get the following error:
Couldn't match expected type (LTree a, [(a, Int)])' with actual type LTree a'
Can you spot the error, please?
buildAccum must return a pair type (LTree a, [(a, Int)]), but in your first guarded statement you return a raw LTree a: Leaf a.
Related
I am new to Haskell and I want to extract the maximum element from a given List so that I end up with the maximum element x and the remaining list xs (not containing x). It can be assumed that the elements of the list are unique.
The type of function I want to implement is somewhat like this:
maxElement :: (Ord b) => (a -> b) -> [a] -> (a, [a])
Notably, the first argument is a function that turns an element into a comparable form. Also, this function is non-total as it would fail given an empty List.
My current approach fails to keep the elements in the remainder list in place, meaning given [5, 2, 4, 6] it returns (6, [2, 4, 5]) instead of (6, [5, 2, 4]). Furthermore, it feels like there should be a nicer looking solution.
compareElement :: (Ord b) => (a -> b) -> a -> (b, (a, [a])) -> (b, (a, [a]))
compareElement p x (s, (t, ts))
| s' > s = (s', (x, t:ts))
| otherwise = (s, (t, x:ts))
where s' = p x
maxElement :: (Ord b) => (a -> b) -> [a] -> (a, [a])
maxElement p (t:ts) = snd . foldr (compareElement p) (p t, (t, [])) $ ts
UPDATE
Thanks to the help of the answer of #Ismor and the comment #chi I've updated my implementation and I feel happy with the result.
maxElement :: (Ord b) => (a -> b) -> [a] -> Maybe (b, a, [a], [a])
maxElement p =
let
f x Nothing = Just (p x, x, [], [x])
f x (Just (s, m, xs, ys))
| s' > s = Just (s', x, ys, x:ys)
| otherwise = Just (s, m, x:xs, x:ys)
where s' = p x
in
foldr f Nothing
The result is either Nothing when the given list is empty or Maybe (_, x, xs, _). I could write another "wrapper" function with the originally intended type and call maxElement under the hood, but I believe this also ok.
This answer is more of a personal advise than a proper answer. As a rule of thumb, whenever you find yourself trying to write a loop with an accumulator (as in this case), try to write it in this form
foldr updateAccumulator initialAccumulator --use foldl' if it is better for your use case`
then, follow the types to complete It as shown below
Step 1
Write undefined where needed. You know the function should look like this
maxElement :: (Ord b) => (a -> b) -> [a] -> (a, [a])
maxElement f xs = foldr updateAccumulator initalAccumulator xs
where
updateAccumulator = undefined
initialAccumulator = undefined
Step 2
"Chase the type". Meaning that using the type of maxElement and foldr you can
deduce the types of updateAccumulator and initialAccumulator. Try to reduce polymorphism as much as you can. In this case:
You know foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b
You know your Foldable is [] so It'd be easier to substitute
Hence foldr :: (a -> b -> b) -> b -> [a] -> b
Because you want foldr to produce (a, [a]) you know b ~ (a, [a])
etc... keep going until you know what types your functions have. You can use ghc typed holes in this process, which is a very nice feature
maxElement :: (Ord b) => (a -> b) -> [a] -> (a, [a])
maxElement f xs = foldr updateAccumulator initalAccumulator xs
where
-- Notice that you need to enable an extension to write type signature in where clause
-- updateAccumulator :: a -> (a, [a]) -> (a, [a])
updateAccumulator newElement (currentMax, currentList) = undefined
-- initialAccumulator :: (a, [a])
initialAccumulator = undefined
Step 3
Now, writing down the function should be easier. Below I leave some incomplete parts for you to fill
maxElement :: (Ord b) => (a -> b) -> [a] -> (a, [a])
maxElement f xs = foldr updateAccumulator initalAccumulator xs
where
-- updateAccumulator :: a -> (a, [a]) -> (a, [a])
updateAccumulator newElement (currentMax, currentList) =
if f newElement > f currentMax
then undefined -- How does the accumulator should look when the new element is bigger than the previous maximum?
else undefined
-- initialAccumulator :: (a, [a])
initialAccumulator = undefined -- Tricky!, what does happen if xs is empty?
Hope this clarifies some doubts, and understand I don't give you a complete answer.
I don't know if you were trying to avoid using certain library functions, but Data.List has a maximumBy and deleteBy that do exactly what you want:
import Data.Function (on)
import Data.List (deleteBy, maximumBy)
import Data.Ord (comparing)
maxElement :: (Ord b) => (a -> b) -> [a] -> (a, [a])
maxElement f xs = (max, remaining) where
max = maximumBy (comparing f) xs
remaining = deleteBy ((==) `on` f) max xs
Thanks to the help of the answer of #Ismor and the comment #chi I've updated my implementation and I feel happy with the result.
maxElement :: (Ord b) => (a -> b) -> [a] -> Maybe (b, a, [a], [a])
maxElement p =
let
f x Nothing = Just (p x, x, [], [x])
f x (Just (s, m, xs, ys))
| s' > s = Just (s', x, ys, x:ys)
| otherwise = Just (s, m, x:xs, x:ys)
where s' = p x
in
foldr f Nothing
The result is either Nothing when the given list is empty or Maybe (_, x, xs, _). I could write another "wrapper" function with the originally intended type and call maxElement under the hood, but I believe this is also ok.
Construct the list of all the "zippers" over the input list, then take the maximumBy (comparing (\(_,x,_) -> foo x)) of it, where foo is your Ord b => a -> b function, then reverse-append the first half to the second and put it in a tuple together with the middle element.
A zipper over a list xs is a triple (revpx, x, suffx) where xs == reverse revpx ++ [x] ++ suffx:
> :t comparing (\(_,x,_) -> x)
comparing (\(_,x,_) -> x)
:: Ord a => (t, a, t1) -> (t, a, t1) -> Ordering
Constructing the zippers list is an elementary exercise (see the function picks3 there).
About your edited solution, it can be coded as a foldr over the tails so it's a bit clearer what's going on there:
maxElement :: (Ord b) => (a -> b) -> [a] -> Maybe (b, a, [a])
maxElement p [] = Nothing
maxElement p xs = Just $ foldr f undefined (tails xs)
where
f [x] _ = (p x, x, [])
f (x:xs) (b, m, ys)
| b' > b = (b', x, xs) -- switch over
| otherwise = (b, m, x:ys)
where b' = p x
It's also a bit cleaner as it doesn't return the input list's copy for no apparent reason, as your version did since it used it for internal purposes.
Both ways are in fact emulating a paramorphism.
The map function returns a list constructed by applying a function (the first argument) to all items in a list passed as the second argument.
I'm trying to figure out what this would look like if displayed in Lambda Calculus notation. Can anyone give an example?
Since this is tagged haskell I'll write the answer in Haskell, but building everything on functions like you would in lambda calculus. This generally incurs carrying around an extra type parameter r for the continuation-passing style.
Lists are usually can be encoded as deconstruction-matchers: (this is Scott encoding, as the comments inform me)
newtype List r a = List { deconstructList
:: r -- ^ `Nil` case
-> (a -> List r a -> r) -- ^ `Cons` case
-> r -- ^ result
}
Now we want to give this a Functor instance. As with other problems, you can let the compiler guide you:
instance Functor (List r) where
fmap f (List l) = List _
This will prompt
LambdaList.hs:8:26: error:
• Found hole: _ :: r -> (b -> List r b -> r) -> r
Where: ‘b’ is a rigid type variable bound by
the type signature for:
fmap :: forall a b. (a -> b) -> List r a -> List r b
at LambdaList.hs:8:3-6
‘r’ is a rigid type variable bound by
the instance declaration
at LambdaList.hs:7:10-25
• In the first argument of ‘List’, namely ‘_’
In the expression: List _
In an equation for ‘fmap’: fmap f (List l) = List _
• Relevant bindings include
l :: r -> (a -> List r a -> r) -> r (bound at LambdaList.hs:8:16)
f :: a -> b (bound at LambdaList.hs:8:8)
fmap :: (a -> b) -> List r a -> List r b
(bound at LambdaList.hs:8:3)
Valid hole fits include
const :: forall a b. a -> b -> a
with const #r #(b -> List r b -> r)
(imported from ‘Prelude’ at LambdaList.hs:1:1
(and originally defined in ‘GHC.Base’))
return :: forall (m :: * -> *) a. Monad m => a -> m a
with return #((->) (b -> List r b -> r)) #r
(imported from ‘Prelude’ at LambdaList.hs:1:1
(and originally defined in ‘GHC.Base’))
pure :: forall (f :: * -> *) a. Applicative f => a -> f a
with pure #((->) (b -> List r b -> r)) #r
(imported from ‘Prelude’ at LambdaList.hs:1:1
(and originally defined in ‘GHC.Base’))
|
8 | fmap f (List l) = List _
| ^
So we're supposed to define a function; well then it's probably a good idea to start with lambda-binding some arguments:
instance Functor (List r) where
fmap f (List l) = List $ \nilCs consCs -> _
LambdaList.hs:8:45: error:
• Found hole: _ :: r
Where: ‘r’ is a rigid type variable bound by
the instance declaration
at LambdaList.hs:7:10-25
• In the expression: _
In the second argument of ‘($)’, namely ‘\ nilCs consCs -> _’
In the expression: List $ \ nilCs consCs -> _
• Relevant bindings include
consCs :: b -> List r b -> r (bound at LambdaList.hs:8:35)
nilCs :: r (bound at LambdaList.hs:8:29)
l :: r -> (a -> List r a -> r) -> r (bound at LambdaList.hs:8:16)
f :: a -> b (bound at LambdaList.hs:8:8)
fmap :: (a -> b) -> List r a -> List r b
(bound at LambdaList.hs:8:3)
Valid hole fits include nilCs :: r (bound at LambdaList.hs:8:29)
The CPS-result should still come from the original list, so we need to use that at this point – with args still TBD, but the nil case won't change so we can right away pass that too:
instance Functor (List r) where
fmap f (List l) = List $ \nilCs consCs -> l nilCs _
LambdaList.hs:8:53: error:
• Found hole: _ :: a -> List r a -> r
Where: ‘a’ is a rigid type variable bound by
the type signature for:
fmap :: forall a b. (a -> b) -> List r a -> List r b
at LambdaList.hs:8:3-6
‘r’ is a rigid type variable bound by
the instance declaration
at LambdaList.hs:7:10-25
• In the second argument of ‘l’, namely ‘_’
In the expression: l nilCs _
In the second argument of ‘($)’, namely
‘\ nilCs consCs -> l nilCs _’
• Relevant bindings include
consCs :: b -> List r b -> r (bound at LambdaList.hs:8:35)
nilCs :: r (bound at LambdaList.hs:8:29)
l :: r -> (a -> List r a -> r) -> r (bound at LambdaList.hs:8:16)
f :: a -> b (bound at LambdaList.hs:8:8)
fmap :: (a -> b) -> List r a -> List r b
(bound at LambdaList.hs:8:3)
So it's again function-time, i.e. bind some arguments:
instance Functor (List r) where
fmap f (List l) = List
$ \nilCs consCs -> l nilCs $ \lHead lTail -> _
LambdaList.hs:9:51: error:
• Found hole: _ :: r
Where: ‘r’ is a rigid type variable bound by
the instance declaration
at LambdaList.hs:7:10-25
• In the expression: _
In the second argument of ‘($)’, namely ‘\ lHead lTail -> _’
In the expression: l nilCs $ \ lHead lTail -> _
• Relevant bindings include
lTail :: List r a (bound at LambdaList.hs:9:42)
lHead :: a (bound at LambdaList.hs:9:36)
consCs :: b -> List r b -> r (bound at LambdaList.hs:9:15)
nilCs :: r (bound at LambdaList.hs:9:9)
l :: r -> (a -> List r a -> r) -> r (bound at LambdaList.hs:8:16)
f :: a -> b (bound at LambdaList.hs:8:8)
(Some bindings suppressed; use -fmax-relevant-binds=N or -fno-max-relevant-binds)
Valid hole fits include nilCs :: r (bound at LambdaList.hs:9:9)
At this point we have a lot in scope that could conceivably be used, but a good rule of thumb is that we should probably use all of them at least once, so let's bring in consCs, with two TBD arguments:
instance Functor (List r) where
fmap f (List l) = List
$ \nilCs consCs -> l nilCs $ \lHead lTail -> consCs _ _
LambdaList.hs:9:58: error:
• Found hole: _ :: b
Where: ‘b’ is a rigid type variable bound by
the type signature for:
fmap :: forall a b. (a -> b) -> List r a -> List r b
at LambdaList.hs:8:3-6
• In the first argument of ‘consCs’, namely ‘_’
In the expression: consCs _ _
In the second argument of ‘($)’, namely
‘\ lHead lTail -> consCs _ _’
• Relevant bindings include
lTail :: List r a (bound at LambdaList.hs:9:42)
lHead :: a (bound at LambdaList.hs:9:36)
consCs :: b -> List r b -> r (bound at LambdaList.hs:9:15)
nilCs :: r (bound at LambdaList.hs:9:9)
l :: r -> (a -> List r a -> r) -> r (bound at LambdaList.hs:8:16)
f :: a -> b (bound at LambdaList.hs:8:8)
(Some bindings suppressed; use -fmax-relevant-binds=N or -fno-max-relevant-binds)
Ok, there's only one way to obtain a b value: using f, which needs an a as its argument, for which we have exactly one, namely lHead:
instance Functor (List r) where
fmap f (List l) = List
$ \nilCs consCs -> l nilCs
$ \lHead lTail -> consCs (f lHead) _
LambdaList.hs:9:60: error:
• Found hole: _ :: List r b
Where: ‘b’ is a rigid type variable bound by
the type signature for:
fmap :: forall a b. (a -> b) -> List r a -> List r b
at LambdaList.hs:8:3-6
‘r’ is a rigid type variable bound by
the instance declaration
at LambdaList.hs:7:10-25
• In the second argument of ‘consCs’, namely ‘_’
In the expression: consCs _ _
In the second argument of ‘($)’, namely
‘\ lHead lTail -> consCs _ _’
• Relevant bindings include
lTail :: List r a (bound at LambdaList.hs:9:42)
lHead :: a (bound at LambdaList.hs:9:36)
consCs :: b -> List r b -> r (bound at LambdaList.hs:9:15)
nilCs :: r (bound at LambdaList.hs:9:9)
l :: r -> (a -> List r a -> r) -> r (bound at LambdaList.hs:8:16)
f :: a -> b (bound at LambdaList.hs:8:8)
(Some bindings suppressed; use -fmax-relevant-binds=N or -fno-max-relevant-binds)
Here we have a bit of a problem: no List r b is in scope or in the result of any of the bindings. However, what does yield a List r b is the function we're just defining here: fmap f. In standard lambda calculus you can't actually recursively call a definition (you need to use a fixpoint combinator to emulate it), but I'll ignore this here. This is a valid Haskell solution:
instance Functor (List r) where
fmap f (List l) = List
$ \nilCs consCs -> l nilCs
$ \lHead lTail -> consCs (f lHead) (fmap f lTail)
Or written in lambda style (erasing the List newtype constructor),
map = \f l ν ζ ⟼ l ν (\h t ⟼ ζ (f h) (map f t))
So I've been doing this program which receives a function f, a number a and a list b and it should return a list [a, f(a,b), f(f(a,b),b, ..] iterating through the list b and using recursion. Do you guys know how I can optimize my code?
calculate :: (a -> b -> a) -> a -> [b] -> [a]
help :: (a -> b -> a) -> a -> [b] -> [a]
help f a (x:xs) = (f a x) : (calculate f (f a x) xs)
help f a [] = []
calculate f a b = a : (help f a b)
calculate f a b = tail . concatMap (replicate 2) . scanl f a $ b.
The replicate bit is probably in error. If so, then simply calculate = scanl.
This translates the code, as the "[a, f(a,b), f(f(a,b),b, ..]" from the text contradicts it (and it contradicts the text itself, which talks of "iterating through the list b").
So basically I have a list of tuples [(a,b)], from which i have to do some filtering. One job is to remove inverted duplicates such that if (a,b) and (b,a) exist in the list, I only take one instance of them. But the list comprehension has not been very helpful. How to go about this in an efficient manner?
Thanks
Perhaps an efficient way to do so (O(n log(n))) would be to track the tuples (and their reverses) already added, using Set:
import qualified Data.Set as Set
removeDups' :: Ord a => [(a, a)] -> Set.Set (a, a) -> [(a, a)]
removeDups' [] _ = []
removeDups' ((a, b):tl) s | (a, b) `Set.member` s = removeDups' tl s
removeDups' ((a, b):tl) s | (b, a) `Set.member` s = removeDups' tl s
removeDups' ((a, b):tl) s = ((a, b):rest) where
s' = Set.insert (a, b) s
rest = removeDups' tl s'
removeDups :: Ord a => [(a, a)] -> [(a, a)]
removeDups l = removeDups' l (Set.fromList [])
The function removeDups calls the auxiliary function removeDups' with the list, and an empty set. For each pair, if it or its inverse are in the set, it is passed; otherwise, both it and its inverses are added, and the tail is processed. \
The complexity is O(n log(n)), as the size of the set is at most linear in n, at each step.
Example
...
main = do
putStrLn $ show $ removeDups [(1, 2), (1, 3), (2, 1)]
and
$ ghc ord.hs && ./ord
[1 of 1] Compiling Main ( ord.hs, ord.o )
Linking ord ...
[(1,2),(1,3)]
You can filter them using your own function:
checkEqTuple :: (a, b) -> (a, b) -> Bool
checkEqTuple (x, y) (x', y') | (x==y' && y == x') = True
| (x==x' && y == y') = True
| otherwise = False
then use nubBy
Prelude Data.List> nubBy checkEqTuple [(1,2), (2,1)]
[(1,2)]
I feel like I'm repeating myself a bit, but that's okay. None of this code had been tested or even compiled, so there may be bugs. Suppose we can impose an Ord constraint for efficiency. I'll start with a limited implementation of sets of pairs.
import qualified Data.Set as S
import qualified Data.Map.Strict as M
newtype PairSet a b =
PS (M.Map a (S.Set b))
empty :: PairSet a b
empty = PS M.empty
insert :: (Ord a, Ord b)
=> (a, b) -> PairSet a b -> PairSet a b
insert (a, b) (PS m) = PS $ M.insertWith S.union a (S.singleton b) m
member :: (Ord a, Ord b)
=> (a, b) -> PairSet a b -> Bool
member (a, b) (PS m) =
case M.lookup a m of
Nothing -> False
Just s -> S.member b s
Now we just need to keep track of which pairs we've seen.
order :: Ord a => (a, a) -> (a, a)
order p#(a, b)
| a <= b = p
| otherwise = (b, a)
nubSwaps :: Ord a => [(a,a)] -> [(a,a)]
nubSwaps xs = foldr go (`seq` []) xs empty where
go p r s
| member op s = r s
| otherwise = p : r (insert op s)
where op = order p
If a and b are ordered and compareable, you could just do this:
[(a,b) | (a,b) <- yourList, a<=b]
Consider the following type:
data LTree a = Leaf a | Fork (LTree a) (LTree a)
Now consider the following function that lists the leaves of a tree, together with its depth
tolistdepth :: LTree a -> [(a,Int)]
tolistdepth (Leaf x) = [(x,0)]
tolistdepth (Fork e d) = map (\(x,n) -> (x,n+1)) (tolistdepth e ++ tolistdepth d)
I need help defining the following function
build :: [(a, Int)] -> LTree a
that calculates the inverse of the first function so that
build (tolistdepth a) = a
I don't even know where to start :)
I have managed to do the following:
build :: [(a, Int)] -> LTree a
build xs = let ys= map (\(x, n) -> (Leaf x, n)) xs
in SOMETHING iterateUntil SOMETHING (buildAssist ys)
buildAssist :: [(LTree a, Int)] -> [(LTree a, Int)]
buildAssist [] = []
buildAssist [x] = [x]
buildAssist (x#(t1, n1):y#(t2, n2):xs) = if n1 == n2 then ((Fork t1 t2), n1 - 1):buildAssist xs
else x:(buildAssist (y:xs))
This way, I think I have dealt with when to fork.
Now, how do I use buildAssist in my original function (if buildAssist is of any use of course)?
I believe I have figured it out.
Please let me know if this works:
build :: [(a,Int)] -> LTree a
build l = fst (buildaccum 0 l)
buildaccum :: Int -> [(a,Int)] -> (LTree a, [(a,Int)])
buildaccum n l#((a,b):t) |n==b = (Leaf a,t)
|n<b = (Fork e d, l2)
where (e,l1) = buildaccum (n+1) l
(d,l2) = buildaccum (n+2) l1
I'll give you a hint which demonstrates a helpful technique when parsing lists.
What really is at work here is a function like this:
build' :: [(a,Int)] -> (LTree a, [(a,Int)])
That is, build' returns a LTree a and the rest of the input list it has not yet consumed.
In this form the definition of build' goes something like this:
build' [] = error "oops - bad input list"
build' ((a,n):xs) =
if we are at a leaf node, return (LTree a, xs)
if we decide we need to fork, then return (Fork e f,zs)
where
(e,ys) = build' ((a,n):xs) -- parse the left branch
(f,zs) = build' ys -- parse the right branch
Note this is just pseudo-code, and there are important details missing which I am leaving as an exercise.
The interesting part is how the remaining input list is determined in the Fork case.
ys is the remaining input after parsing the left branch, and this is fed as input to build' to get the right branch, and the remaining input of that call to build' (zs) is returned as the remaining input from the original build' call.
Update:
To iterate a function f with starting value x until a certain condition p, follow this formula:
iterateUntil p f x = if p x then x else iterateUntil p f (f x)