[...] it needs to traverse the entire list before it can start assembling
the result.
To avoid that, so the result can be assembled from the start of the
list,
you need to make the pattern match on the second argument lazy,
f (x,y) ~(xs,ys) = (x:xs,y:ys)
or
f (x,y) p = (x : fst p, y : snd p)
Now
f (x,y) (f (x1,y1) ([],[]))
~> let (xs,ys) = f (x1,y1) ([],[]) in (x:xs, y:ys)
This makes sense. I didn't realize Haskell was doing this. Of course, that could be a downside to evaluating by
hand on paper, where you often 'think lazily.' I assumed Haskell evaluated the expression in a similar way to
your 'let ...' clause.
>
> *last* :: [a] -> a
> last xs = head $ foldr f [] xs
> where f :: a -> [a] -> [a]
> f x [] = [x]
> f x ys = ys ++ [x]
last xs = head (reverse xs), yes, it's correct, but not very pretty.
And not very efficient since it builds a left-associated nest of (++)
applications and needs to pattern match to decide which branch to take.
last (1:2:3:4:[])
~> head $ foldr f [] (1:2:3:4:[])
~> head $ f 1 (f 2 (f 3 (f 4 [])))
~> head $ f 1 (f 2 (f 3 [4]))
~> head $ f 1 (f 2 ([4] ++ [3]))
~> head $ f 1 (([4] ++ [3]) ++ [2])
~> head $ ((([4] ++ [3]) ++ [2]) ++ [1]
a) in the second branch of f, you don't actually need to concatenate,
f x [] = [x]
f _ ys = ys
works too, but is faster.
b) you can get much faster by delaying the pattern match,
f x ys = (case ys of { [] -> x; y:_ -> y }) : []
Yes, nesting each element inside (++) operators was an oversight on my part. Your solution (a) is much cleaner, since
head $ foldr f [] (1:2:3:[])
~> head $ f 1 (f 2 (f 3 []))
~> head $ f 1 (f 2 (3:[]))
~> head $ f 1 (3:[])
~> head $ (3:[])
I'm confused about (b), however. I was under the
impression that the pattern match
f P1 ... P1N = E1
f P2 ... P2N = E2
is
semantically equivalent to
f x1 ... xn = case (x1, ..., xn) of { P1 ... P1n -> E1; P2 ... P2n -> E2}.
Of course, "semantically equivalent" doesn't mean "as efficient." I don't understand whether the move from matching against
'_ ys' to y:_ is supposed to make the definition of f more efficient to compute, or whether the use of case expressions is
supposed to.
>
> *init* :: [a] -> [a]
> init xs = tail $ foldr f [] xs
> where f :: a -> [a] -> [a]
> f x [] = [x]
> f x (y:xs) = y : x : xs
Correct too, but again not very efficient since it has to find the last
element and bubble it to the front.
Much faster:
:
import Data.Maybe (fromMaybe)
init' :: [a] -> [a]
init' = fromMaybe (error "init': empty list") . foldr f Nothing
where
f x mb = Just $ case mb of
Just xs -> x:xs
Nothing -> []
By delaying the pattern match on the Maybe until after the constructor is
applied, we can start building the output with minimal delay (we only need
to look whether there's a next list element to decide whether to cons it to
the front or not).
I'm not sure what you mean by "applying the constructor [Just]," or which function
you are forcing to evaluate (after 'applying the constructor'). Obviously, I need to
learn more about Haskell's monads and type constructors.
> (2) Is there a way to eliminate the
> post-processing of the lists (i.e., *head* in *last* and *tail* in
> *init*)?
Not in a clean way.
Let us consider last first.
Suppose we had
last xs = foldr f z xs
without post-processing.
Since foldr f z [] = z and last [] = error "Prelude.last: empty list",
we must have z = error "...".
Now last (... x:[]) = x and
foldr f z (... x:[]) = ... (f x z)
So f x y = y if y is not error "..." and f x (error "...") = x, that means
f would have to find out whether its second argument is a specific error
and return its first argument in that case, otherwise its second argument.
It's possible to do that, but very unclean.
That's helpful. I was trying to name a list at a particular stage of construction, and it
failed for just this reason.