Haskell layout tree - haskell

Recently, I try to sovle the Haskell 99 Problems, the 66th (layout a tree compactly). I successed, but got confused by the solutions here(http://www.haskell.org/haskellwiki/99_questions/Solutions/66).
layout :: Tree a -> Tree (a, Pos)
layout t = t'
where (l, t', r) = layoutAux x1 1 t
x1 = maximum l + 1
layoutAux :: Int -> Int -> Tree a -> ([Int], Tree (a, Pos), [Int])
layoutAux x y Empty = ([], Empty, [])
layoutAux x y (Branch a l r) = (ll', Branch (a, (x,y)) l' r', rr')
where (ll, l', lr) = layoutAux (x-sep) (y+1) l
(rl, r', rr) = layoutAux (x+sep) (y+1) r
sep = maximum (0:zipWith (+) lr rl) `div` 2 + 1
ll' = 0 : overlay (map (+sep) ll) (map (subtract sep) rl)
rr' = 0 : overlay (map (+sep) rr) (map (subtract sep) lr)
-- overlay xs ys = xs padded out to at least the length of ys
-- using any extra elements of ys
overlay :: [a] -> [a] -> [a]
overlay [] ys = ys
overlay xs [] = xs
overlay (x:xs) (y:ys) = x : overlay xs ys
why the caculation of 'x1' and 'sep' don't cause infinit loop?
How they been calculated?

The reason for this to work is non-strict evaluation mode of Haskell rather than strict evaluation that you see in most languages.
In the example you have given, maximum l is possible to calculate because the l returned from layoutAux function doesn't contain any dependency on x1. x1 is used in the t' part of the returned value.
Another simple example to show similar behavior is below code:
hello :: [Int] -> [Int]
hello x = x' where
x' = hello' l x
l = length x'
hello' i lst = map (+i) lst
This will not loop forever because to get the length of a list you don't need to know it's content and that's why the list content dependency on l doesn't cause it to loop forever. Whereas if you had something like maximum instead of length, that would cause it to loop forever as maximum needs to know the content of list and the content depends on the result of maximum.

Related

create a function ved that will only remove the last occurrence of the largest item in the list using recursion

You must use recursion to define rmax2 and you must do so from “scratch”. That is, other than the cons operator, head, tail, and comparisons, you should not use any functions from the Haskell library.
I created a function that removes all instances of the largest item, using list comprehension. How do I remove the last instance of the largest number using recursion?
ved :: Ord a => [a] -> [a]
ved [] =[]
ved as = [ a | a <- as, m /= a ]
where m= maximum as
An easy way to split the problem into two easier subproblems consists in:
get the position index of the rightmost maximum value
write a general purpose function del that eliminates the element of a list at a given position. This does not require an Ord constraint.
If we were permitted to use regular library functions, ved could be written like this:
ved0 :: Ord a => [a] -> [a]
ved0 [] = []
ved0 (x:xs) =
let
(maxVal,maxPos) = maximum (zip (x:xs) [0..])
del k ys = let (ys0,ys1) = splitAt k ys in (ys0 ++ tail ys1)
in
del maxPos (x:xs)
where the pairs produced by zip are lexicographically ordered, thus ensuring the rightmost maximum gets picked.
We need to replace the library functions by manual recursion.
Regarding step 1, that is finding the position of the rightmost maximum, as is commonly done, we can use a recursive stepping function and a wrapper above it.
The recursive step function takes as arguments the whole context of the computation, that is:
current candidate for maximum value, mxv
current rightmost position of maximum value, mxp
current depth into the original list, d
rest of original list, xs
and it returns a pair: (currentMaxValue, currentMaxPos)
-- recursive stepping function:
findMax :: Ord a => a -> Int -> Int -> [a] -> (a, Int)
findMax mxv mxp d [] = (mxv,mxp)
findMax mxv mxp d (x:xs) = if (x >= mxv) then (findMax x d (d+1) xs)
else (findMax mxv mxp (d+1) xs)
-- top wrapper:
lastMaxPos :: Ord a => [a] -> Int
lastMaxPos [] = (-1)
lastMaxPos (x:xs) = snd (findMax x 0 1 xs)
Step 2, eliminating the list element at position k, can be handled in very similar fashion:
-- recursive stepping function:
del1 :: Int -> Int -> [a] -> [a]
del1 k d [] = []
del1 k d (x:xs) = if (d==k) then xs else x : del1 k (d+1) xs
-- top wrapper:
del :: Int -> [a] -> [a]
del k xs = del1 k 0 xs
Putting it all together:
We are now able to write our final recursion-based version of ved. For simplicity, we inline the content of wrapper functions instead of calling them.
-- ensure we're only using authorized functionality:
{-# LANGUAGE NoImplicitPrelude #-}
import Prelude (Ord, Eq, (==), (>=), (+), ($), head, tail,
IO, putStrLn, show, (++)) -- for testing only
ved :: Ord a => [a] -> [a]
ved [] = []
ved (x:xs) =
let
findMax mxv mxp d [] = (mxv,mxp)
findMax mxv mxp d (y:ys) = if (y >= mxv) then (findMax y d (d+1) ys)
else (findMax mxv mxp (d+1) ys)
(maxVal,maxPos) = findMax x 0 1 xs
del1 k d (y:ys) = if (d==k) then ys else y : del1 k (d+1) ys
del1 k d [] = []
in
del1 maxPos 0 (x:xs)
main :: IO ()
main = do
let xs = [1,2,3,7,3,2,1,7,3,5,7,5,4,3]
res = ved xs
putStrLn $ "input=" ++ (show xs) ++ "\n" ++ " res=" ++ (show res)
If you are strictly required to use recursion, you can use 2 helper functions: One to reverse the list and the second to remove the first largest while reversing the reversed list.
This result in a list where the last occurrence of the largest element is removed.
We also use a boolean flag to make sure we don't remove more than one element.
This is ugly code and I really don't like it. A way to make things cleaner would be to move the reversal of the list to a helper function outside of the current function so that there is only one helper function to the main function. Another way is to use the built-in reverse function and use recursion only for the removal.
removeLastLargest :: Ord a => [a] -> [a]
removeLastLargest xs = go (maximum xs) [] xs where
go n xs [] = go' n True [] xs
go n xs (y:ys) = go n (y:xs) ys
go' n f xs [] = xs
go' n f xs (y:ys)
| f && y == n = go' n False xs ys
| otherwise = go' n f (y:xs) ys
Borrowing the implementation of dropWhileEnd from Hackage, we can implement a helper function splitWhileEnd:
splitWhileEnd :: (a -> Bool) -> [a] -> ([a], [a])
splitWhileEnd p = foldr (\x (xs, ys) -> if p x && null xs then ([], x:ys) else (x:xs, ys)) ([],[])
splitWhileEnd splits a list according to a predictor from the end. For example:
ghci> xs = [1,2,3,4,3,2,4,3,2]
ghci> splitWhileEnd (< maximum xs) xs
([1,2,3,4,3,2,4],[3,2])
With this helper function, you can write ven as:
ven :: Ord a => [a] -> [a]
ven xs =
let (x, y) = splitWhileEnd (< maximum xs) xs
in init x ++ y
ghci> ven xs
[1,2,3,4,3,2,3,2]
For your case, you can refactor splitWhileEnd as:
fun p = \x (xs, ys) -> if p x && null xs then ([], x:ys) else (x:xs, ys)
splitWhileEnd' p [] = ([], [])
splitWhileEnd' p (x : xs) = fun p x (splitWhileEnd' p xs)
ven' xs = let (x, y) = splitWhileEnd' (< maximum xs) xs in init x ++ y
If init and ++ are not allowed, you can implement them manually. It's easy!
BTW, I guess this may be your homework for Haskell course. I think it's ridiculous if your teacher gives the limitations. Who is programming from scratch nowadays?
Anyway, you can always work around this kind of limitations by reimplementing the built-in function manually. Good luck!

How to apply a function to a specific element of a list

How can I apply a function to only a single element of a list?
Any suggestion?
Example:
let list = [1,2,3,4,3,6]
function x = x * 2
in ...
I want to apply function only to the first occurance of 3 and stop there.
Output:
List = [1,2,6,4,3,6] -- [1, 2, function 3, 4, 3, 6]
To map or not to map, that is the question.
Better not to map.
Why? Because map id == id anyway, and you only want to map through one element, the first one found to be equal to the argument given.
Thus, split the list in two, change the found element, and glue them all back together. Simple.
See: span :: (a -> Bool) -> [a] -> ([a], [a]).
Write: revappend (xs :: [a]) (ys :: [a]) == append (reverse xs) ys, only efficient.
Or fuse all the pieces together into one function. You can code it directly with manual recursion, or using foldr. Remember,
map f xs = foldr (\x r -> f x : r) [] xs
takeWhile p xs = foldr (\x r -> if p x then x : r else []) [] xs
takeUntil p xs = foldr (\x r -> if p x then [x] else x : r) [] xs
filter p xs = foldr (\x r -> if p x then x : r else r) [] xs
duplicate xs = foldr (\x r -> x : x : r) [] xs
mapFirstThat p f xs = -- ... your function
etc. Although, foldr won't be a direct fit, as you need the combining function of the (\x xs r -> ...) variety. That is known as paramorphism, and can be faked by feeding tails xs to the foldr, instead.
you need to maintain some type of state to indicate the first instance of the value, since map will apply the function to all values.
Perhaps something like this
map (\(b,x) -> if (b) then f x else x) $ markFirst 3 [1,2,3,4,3,6]
and
markFirst :: a -> [a] -> [(Boolean,a)]
markFirst a [] = []
markFirst a (x:xs) | x==a = (True,x): zip (repeat False) xs
| otherwise = (False,x): markFirst a xs
I'm sure there is an easier way, but that's the best I came up with at this time on the day before Thanksgiving.
Here is another approach based on the comment below
> let leftap f (x,y) = f x ++ y
leftap (map (\x -> if(x==3) then f x else x)) $ splitAt 3 [1,2,3,4,3,6]
You can just create a simple function which multiples a number by two:
times_two :: (Num a) => a -> a
times_two x = x * 2
Then simply search for the specified element in the list, and apply times_two to it. Something like this could work:
map_one_element :: (Eq a, Num a) => a -> (a -> a) -> [a] -> [a]
-- base case
map_one_element _ _ [] = []
-- recursive case
map_one_element x f (y:ys)
-- ff element is found, apply f to it and add rest of the list normally
| x == y = f y : ys
-- first occurence hasnt been found, keep recursing
| otherwise = y : map_one_element x f ys
Which works as follows:
*Main> map_one_element 3 times_two [1,2,3,4,3,6]
[1,2,6,4,3,6]

How to partition a list in Haskell?

I want to take a list (or a string) and split it into sub-lists of N elements. How do I do it in Haskell?
Example:
mysteryFunction 2 "abcdefgh"
["ab", "cd", "ef", "gh"]
cabal update
cabal install split
And then use chunksOf from Data.List.Split
Here's one option:
partition :: Int -> [a] -> [[a]]
partition _ [] = []
partition n xs = (take n xs) : (partition n (drop n xs))
And here's a tail recursive version of that function:
partition :: Int -> [a] -> [[a]]
partition n xs = partition' n xs []
where
partition' _ [] acc = reverse acc
partition' n xs acc = partition' n (drop n xs) ((take n xs) : acc)
You could use:
mysteryFunction :: Int -> [a] -> [[a]]
mysteryFunction n list = unfoldr takeList list
where takeList [] = Nothing
takeList l = Just $ splitAt n l
or alternatively:
mysteryFunction :: Int -> [a] -> [[a]]
mysteryFunction n list = unfoldr (\l -> if null l then Nothing else Just $ splitAt n l) list
Note this puts any remaining elements in the last list, for example
mysteryFunction 2 "abcdefg" = ["ab", "cd", "ef", "g"]
import Data.List
import Data.Function
mysteryFunction n = map (map snd) . groupBy ((==) `on` fst) . zip ([0..] >>= replicate n)
... just kidding...
mysteryFunction x "" = []
mysteryFunction x s = take x s : mysteryFunction x (drop x s)
Probably not the elegant solution you had in mind.
There's already
Prelude Data.List> :t either
either :: (a -> c) -> (b -> c) -> Either a b -> c
and
Prelude Data.List> :t maybe
maybe :: b -> (a -> b) -> Maybe a -> b
so there really should be
list :: t -> ([a] -> t) -> [a] -> t
list n _ [] = n
list _ c xs = c xs
as well. With it,
import Data.List (unfoldr)
g n = unfoldr $ list Nothing (Just . splitAt n)
without it,
g n = takeWhile (not.null) . unfoldr (Just . splitAt n)
A fancy answer.
In the answers above you have to use splitAt, which is recursive, too. Let's see how we can build a recursive solution from scratch.
Functor L(X)=1+A*X can map X into a 1 or split it into a pair of A and X, and has List(A) as its minimal fixed point: List(A) can be mapped into 1+A*List(A) and back using a isomorphism; in other words, we have one way to decompose a non-empty list, and only one way to represent a empty list.
Functor F(X)=List(A)+A*X is similar, but the tail of the list is no longer a empty list - "1" - so the functor is able to extract a value A or turn X into a list of As. Then List(A) is its fixed point (but no longer the minimal fixed point), the functor can represent any given list as a List, or as a pair of a element and a list. In effect, any coalgebra can "stop" decomposing the list "at will".
{-# LANGUAGE DeriveFunctor #-}
import Data.Functor.Foldable
data N a x = Z [a] | S a x deriving (Functor)
(which is the same as adding the following trivial instance):
instance Functor (N a) where
fmap f (Z xs) = Z xs
fmap f (S x y) = S x $ f y
Consider the definition of hylomorphism:
hylo :: (f b -> b) -> (c -> f c) -> c -> b
hylo psi phi = psi . fmap (hylo psi phi) . phi
Given a seed value, it uses phi to produce f c, to which fmap applies hylo psi phi recursively, and psi then extracts b from the fmapped structure f b.
A hylomorphism for the pair of (co)algebras for this functor is a splitAt:
splitAt :: Int -> [a] -> ([a],[a])
splitAt n xs = hylo psi phi (n, xs) where
phi (n, []) = Z []
phi (0, xs) = Z xs
phi (n, (x:xs)) = S x (n-1, xs)
This coalgebra extracts a head, as long as there is a head to extract and the counter of extracted elements is not zero. This is because of how the functor was defined: as long as phi produces S x y, hylo will feed y into phi as the next seed; once Z xs is produced, functor no longer applies hylo psi phi to it, and the recursion stops.
At the same time hylo will re-map the structure into a pair of lists:
psi (Z ys) = ([], ys)
psi (S h (t, b)) = (h:t, b)
So now we know how splitAt works. We can extend that to splitList using apomorphism:
splitList :: Int -> [a] -> [[a]]
splitList n xs = apo (hylo psi phi) (n, xs) where
phi (n, []) = Z []
phi (0, xs) = Z xs
phi (n, (x:xs)) = S x (n-1, xs)
psi (Z []) = Cons [] $ Left []
psi (Z ys) = Cons [] $ Right (n, ys)
psi (S h (Cons t b)) = Cons (h:t) b
This time the re-mapping is fitted for use with apomorphism: as long as it is Right, apomorphism will keep using hylo psi phi to produce the next element of the list; if it is Left, it produces the rest of the list in one step (in this case, just finishes off the list with []).

How to have multiple infinite ranges in list comprehensions?

In haskell I have a list comprehension like this:
sq = [(x,y,z) | x <- v, y <- v, z <- v, x*x + y*y == z*z, x < y, y < z]
where v = [1..]
However when I try take 10 sq, it just freezes...
Is there a way to handle multiple infinite ranges?
Thanks
In addition to the other answers explaining the problem, here is an alternative solution, generalized to work with level-monad and stream-monad that lend themselves for searches over infinite search spaces (It is also compatible with the list monad and logict, but those won't play nicely with infinite search spaces, as you already found out):
{-# LANGUAGE MonadComprehensions #-}
module Triples where
import Control.Monad
sq :: MonadPlus m => m (Int, Int, Int)
sq = [(x, y, z) | x <- v, y <- v, z <- v, x*x + y*y == z*z, x < y, y < z]
where v = return 0 `mplus` v >>= (return . (1+))
Now, for a fast breadth first search:
*Triples> :m +Control.Monad.Stream
*Triples Control.Monad.Stream> take 10 $ runStream sq
[(3,4,5),(6,8,10),(5,12,13),(9,12,15),(8,15,17),(12,16,20),(7,24,25),
(15,20,25),(10,24,26),(20,21,29)]
Alternatively:
*Triples> :m +Control.Monad.Levels
*Triples Control.Monad.Levels> take 5 $ bfs sq -- larger memory requirements
[(3,4,5),(6,8,10),(5,12,13),(9,12,15),(8,15,17)]
*Triples Control.Monad.Levels> take 5 $ idfs sq -- constant space, slower, lazy
[(3,4,5),(5,12,13),(6,8,10),(7,24,25),(8,15,17)]
List comprehensions are translated into nested applications of the concatMap function:
concatMap :: (a -> [b]) -> [a] -> [b]
concatMap f xs = concat (map f xs)
concat :: [[a]] -> [a]
concat [] = []
concat (xs:xss) = xs ++ concat xss
-- Shorter definition:
--
-- > concat = foldr (++) []
Your example is equivalent to this:
sq = concatMap (\x -> concatMap (\y -> concatMap (\z -> test x y z) v) v) v
where v = [1..]
test x y z =
if x*x + y*y == z*z
then if x < y
then if y < z
then [(x, y, z)]
else []
else []
else []
This is basically a "nested loops" approach; it'll first try x = 1, y = 1, z = 1, then move on to x = 1, y = 1, z = 2 and so on, until it tries all of the list's elements as values for z; only then can it move on to try combinations with y = 2.
But of course you can see the problem—since the list is infinite, we never run out of values to try for z. So the combination (3, 4, 5) can only occur after infinitely many other combinations, which is why your code loops forever.
To solve this, we need to generate the triples in a smarter way, such that for any possible combination, the generator reaches it after some finite number of steps. Study this code (which handles only pairs, not triples):
-- | Take the Cartesian product of two lists, but in an order that guarantees
-- that all combinations will be tried even if one or both of the lists is
-- infinite:
cartesian :: [a] -> [b] -> [(a, b)]
cartesian [] _ = []
cartesian _ [] = []
cartesian (x:xs) (y:ys) =
[(x, y)] ++ interleave3 vertical horizontal diagonal
where
-- The trick is to split the problem into these four pieces:
--
-- |(x0,y0)| (x0,y1) ... horiz
-- +-------+------------
-- |(x1,y0)| .
-- | . | .
-- | . | .
-- | . | .
-- vert diag
vertical = map (\x -> (x,y)) xs
horizontal = map (\y -> (x,y)) ys
diagonal = cartesian xs ys
interleave3 :: [a] -> [a] -> [a] -> [a]
interleave3 xs ys zs = interleave xs (interleave ys zs)
interleave :: [a] -> [a] -> [a]
interleave xs [] = xs
interleave [] ys = ys
interleave (x:xs) (y:ys) = x : y : interleave xs ys
To understand this code (and fix it if I messed up!) look at this blog entry on how to count infinite sets, and at the fourth diagram in particular—the function is an algorithm based on that "zigzag"!
I just tried a simple version of your sq using this; it finds (3,4,5) almost instantly, but then takes very long to get to any other combination (in GHCI at least). But I think the key lessons to take away from this are:
List comprehensions just don't work well for nested infinite lists.
Don't spend too much time playing around with list comprehensions. Everything that they can do, functions like map, filter and concatMap can do—plus there are many other useful functions in the list library, so concentrate your effort on that.
Your code freeze because yours predicate will never been satisfied.
Why ?
Let's take an example without any predicate to understand.
>>> let v = [1..] in take 10 $ [ (x, y, z) | x <- v, y <- v, z <- v ]
[(1,1,1),(1,1,2),(1,1,3),(1,1,4),(1,1,5),(1,1,6),(1,1,7),(1,1,8),(1,1,9),(1,1,10)]
As you see x and y will always be evaluated to 1 as z will never stop to rise.
Then your predicate can't be.
Any workaround ?
Try "Nested list" comprehension.
>>> [[ fun x y | x <- rangeX, predXY] | y <- rangeY, predY ]
Or parallel list comprehension which can be activated using,
>>> :set -XParallelListComp
lookup on the doc
This is possible, but you'll have to come up with an order in which to generate the numbers. The following generates the numbers you want; note that the x < y test can be replaced by generating only y that are >x and similarly for z (which is determined once x and y are bound):
[(x, y, z) | total <- [1..]
, x <- [1..total-2]
, y <- [x..total-1]
, z <- [total - x - y]
, x*x + y*y == z*z]

What's an efficient way to pluck an element out of a list and return the element, and rest of list in a tuple?

This seems to be a very common operation but I can't find it in hoogle for some reason. Either way, it's an interesting thought exercise. My naive implementation:
pluckL :: [a] -> Int -> Maybe ( a, [a] )
pluckL xs idx = if idx < length xs then Just $ pluck' xs idx else Nothing
where
pluck' l n = let subl = drop n l in ( head subl, rest l n ++ tail subl )
rest l n = reverse $ drop ( length l - n ) $ reverse l
My main gripe is that I'm flipping the list too many times, so I'm looking for a creative way where you can traverse the list once and generate the tuple.
There will never be an efficient way. But there can at least be a pretty way:
pluckL xs i = case splitAt i xs of
(b, v:e) -> Just (v, b ++ e)
_ -> Nothing
You can get by with one fewer reverse and fewer operations on the list if you use an accumulator:
pluckL :: [a] -> Int -> Maybe (a, [a])
pluckL xs idx = pluck xs idx [] where
pluck (x:xs) 0 acc = Just $ ( x, (reverse acc) ++ xs )
pluck (x:xs) i acc = pluck xs (i-1) (x:acc)
pluck [] i acc = Nothing
You can use elem to check if the elem is in the list or not, then depending of the result return Nothing or use delete x to remove x from the list, as follow for example,
pluckL :: Eq a => [a] -> a -> Maybe (a, [a])
pluckL xs0 x =
if (x `elem` xs0)
then Just (x, xs)
else Nothing
where xs = delete x xs0

Resources