A small puzzle: inTwain as function of foldr

Bonjour café, A small puzzle: Consider the function inTwain that splits a list of even length evenly into two sublists:
inTwain "Hello world!" ("Hello ","world!")
Is it possible to implement inTwain such that the recursion is done by one of the standard list folds? Is there a general way to tell if a problem can be expressed as a fold? Thank you, Martijn.

Martijn van Steenbergen wrote:
Consider the function inTwain that splits a list of even length evenly into two sublists:
inTwain "Hello world!" ("Hello ","world!")
Is it possible to implement inTwain such that the recursion is done by one of the standard list folds?
Does this help? http://www.brics.dk/RS/02/12/BRICS-RS-02-12.pdf Ganesh =============================================================================== Please access the attached hyperlink for an important electronic communications disclaimer: http://www.credit-suisse.com/legal/en/disclaimer_email_ib.html ===============================================================================

On Jun 4, 2009, at 4:32 PM, Sittampalam, Ganesh wrote:
Martijn van Steenbergen wrote:
Consider the function inTwain that splits a list of even length evenly into two sublists:
inTwain "Hello world!" ("Hello ","world!")
Is it possible to implement inTwain such that the recursion is done by one of the standard list folds?
Does this help? http://www.brics.dk/RS/02/12/BRICS-RS-02-12.pdf
Ganesh
And maybe this helps: http://www.springerlink.com/content/h1547h551422462u/ -- Sebastiaan Visser

Sittampalam, Ganesh wrote:
Does this help? http://www.brics.dk/RS/02/12/BRICS-RS-02-12.pdf
I think so! Thanks, got something more to read now. :-) Martijn.

On Thu, Jun 4, 2009 at 4:22 PM, Martijn van Steenbergen
Bonjour café,
A small puzzle:
Consider the function inTwain that splits a list of even length evenly into two sublists:
inTwain "Hello world!" ("Hello ","world!")
Is it possible to implement inTwain such that the recursion is done by one of the standard list folds?
I don't think it is without a length before at least. On the other hand if your specification is just "splits a list of even length evenly into two sublists", you can contrive something with a simple foldr : inTwain = foldr (\x ~(xs,ys) -> (ys, x:xs)) ([],[]) -- Jedaï

Possible, yes. Efficient, not really.
inTwain = foldr (\x (ls, rs) -> if length ls == length rs then (x:ls, rs) else (x:(init ls), (last ls):rs)) ([], [])
I have a hunch that everything that reduces a list to a fixed-size
data structure can be expressed as a fold, simply by carrying around
as much intermediate state as necessary. But I'm too lazy and
inexperienced to prove this.
Thomas
On Thu, Jun 4, 2009 at 16:22, Martijn van
Steenbergen
Bonjour café,
A small puzzle:
Consider the function inTwain that splits a list of even length evenly into two sublists:
inTwain "Hello world!" ("Hello ","world!")
Is it possible to implement inTwain such that the recursion is done by one of the standard list folds?
Is there a general way to tell if a problem can be expressed as a fold?
Thank you,
Martijn. _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Thomas ten Cate wrote:
Possible, yes.
Efficient, not really.
inTwain = foldr (\x (ls, rs) -> if length ls == length rs then (x:ls, rs) else (x:(init ls), (last ls):rs)) ([], [])
But this uses length and init and last all of which are recursive functions. I consider that cheating: only foldr may do the recursion. Martijn.

Martijn van Steenbergen
inTwain = foldr (\x (ls, rs) -> if length ls == length rs then (x:ls, rs) else (x:(init ls), (last ls):rs)) ([], [])
But this uses length and init and last all of which are recursive functions. I consider that cheating: only foldr may do the recursion.
inTwain = foldr (\x (ls, rs) -> if foldr (const (+1)) 0 ls = ... ? :-) -k -- If I haven't seen further, it is by standing in the footprints of giants

Martijn van Steenbergen
But this uses length and init and last all of which are recursive functions. I consider that cheating: only foldr may do the recursion.
I think the key is to pick your intermediate data-structure wisely. A pair of queues would be my choice. You don't need to calculate any lengths, just keep a parity bit for how far you have already come. Code is below, including a very simple implementation of queues - I'm sure there are better ones out there.
import Data.List (foldl')
-- inTwain divides a list of even length into two sections of equal length, -- using a single recursive traversal (fold) of the input. -- Intermediate values are a pair of FIFO queues, keeping a parity state -- to ensure the queues are of nearly equal length. inTwain :: [a] -> ([a],[a]) inTwain = unTwo . foldl' redistrib emptyTwo where redistrib (Two Even begin end) v = Two Odd begin (enQ v end) redistrib (Two Odd begin end) v = Two Even (enQ e begin) (enQ v es) where (e,es) = deQ end
-- The intermediate data structures needed. data Parity = Odd | Even data Two a = Two Parity (Queue a) (Queue a) data Queue a = Q [a] [a]
emptyTwo = Two Even emptyQ emptyQ emptyQ = Q [] []
unTwo :: Two a -> ([a],[a]) unTwo (Two _ begin end) = (unQ begin, unQ end)
-- A very simple implementation of FIFO queues. enQ :: a -> Queue a -> Queue a deQ :: Queue a -> (a, Queue a) unQ :: Queue a -> [a] enQ v (Q begin end) = Q begin (v:end) deQ (Q (v:vs) end) = (v, Q vs end) deQ (Q [] []) = error ("deQ []") deQ (Q [] end) = deQ (Q (reverse end) []) unQ (Q begin end) = begin ++ reverse end
Regards, Malcolm

Hi all, Malcom Wallace wrote:
Martijn van Steenbergen
wrote: But this uses length and init and last all of which are recursive functions. I consider that cheating: only foldr may do the recursion.
I think the key is to pick your intermediate data-structure wisely. A pair of queues would be my choice.
unQ (Q begin end) = begin ++ reverse end This might be cheating too? This solution recurses over the input only once, but then you need to recurse over the queue to convert it to a
I think this is the essentially the same solution as the difference-list solution I posted before -- same approach, different datastructures. list. The difference list solution manages to only recurse once, I think. Here's the same solution I posted, with all the difference-list operations inlined:
import Control.Arrow
start = (Nothing, (id, id))
iter (Nothing, (r1, r2)) x = (Just x, (r1, r2)) iter (Just y, (r1, r2)) x = case r2 [] of [] -> (Nothing, (\t -> y:t, \t -> x:t)) r:_ -> let r1' = \t -> r1 (r : t) r2' = \t -> tail (r2 (y:x:t)) in (Nothing, (r1', r2'))
inTwain :: [a] -> ([a], [a]) inTwain = (($[]) *** ($[])) . snd . foldl iter start As you can see, it's building up nested lambdas, adding a new lambda to r1 and r2 on each iteration of the fold. And, on each iteration, it's also applying the function it's built. Basically, it's using the program stack as it's intermediate datastructure. Ugly and inefficient yes, but recursion-free as far as I can see.
Thanks, -Brian P.S. The "walk the list at 2 speeds" trick is very slick. _________________________________________________________________ Windows Live™: Keep your life in sync. http://windowslive.com/explore?ocid=TXT_TAGLM_WL_BR_life_in_synch_062009

How about the following, using difference lists?
import Control.Arrow import qualified Data.DList as D
start = (Nothing, (D.empty, D.empty))
iter (Nothing, (r1, r2)) x = (Just x, (r1, r2)) iter (Just y, (r1, m)) x = D.list (Nothing, (D.singleton y, D.singleton x)) (\r r2 -> let r2' = D.snoc (D.snoc r2 y) x in (Nothing, (D.snoc r1 r, r2'))) m
inTwain :: [a] -> ([a], [a]) inTwain = (D.toList *** D.toList) . snd . foldl iter start
There's no recursion besides the fold. Though using difference lists might be cheating, depending on your definition of cheating :) -Brian
Bonjour café,
A small puzzle:
Consider the function inTwain that splits a list of even length evenly into two sublists:
inTwain "Hello world!" ("Hello ","world!")
Is it possible to implement inTwain such that the recursion is done by one of the standard list folds?
Is there a general way to tell if a problem can be expressed as a fold?
Thank you,
Martijn. _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
_________________________________________________________________ Windows Live™: Keep your life in sync. http://windowslive.com/explore?ocid=TXT_TAGLM_WL_BR_life_in_synch_062009

The linked paper appears to show the right style. This appears to satisfy the conditions, however: inTwain as = let (x,y,_) = foldr (\a (r,s,t) -> case (t) of {b:(b':bs) -> (r,a:s,bs); _ -> (a:r,s,t)}) ([],[],as) as in (x,y) In the case of a list of odd length, the first half is given the extra element. On Thu, Jun 4, 2009 at 8:22 AM, Martijn van Steenbergen < martijn@van.steenbergen.nl> wrote:
Bonjour café,
A small puzzle:
Consider the function inTwain that splits a list of even length evenly into two sublists:
inTwain "Hello world!" ("Hello ","world!")
Is it possible to implement inTwain such that the recursion is done by one of the standard list folds?
Is there a general way to tell if a problem can be expressed as a fold?
Thank you,
Martijn. _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Geoffrey Marchant wrote:
The linked paper appears to show the right style.
This appears to satisfy the conditions, however:
inTwain as = let (x,y,_) = foldr (\a (r,s,t) -> case (t) of {b:(b':bs) -> (r,a:s,bs); _ -> (a:r,s,t)}) ([],[],as) as in (x,y)
This one is very interesting. Thanks. :-) It took a while to see what is going on. I'm not too happy with the whole list as part of the initial state. That feels like cheating to me--although I obviously failed to specify this in my original question. Trying to understand morphisms: does that make this a paramorphism rather than a catamorphism? Martijn.

Martijn van Steenbergen
inTwain as = let (x,y,_) = foldr (\a (r,s,t) -> case (t) of {b:(b':bs) -> (r,a:s,bs); _ -> (a:r,s,t)}) ([],[],as) as in (x,y)
This one is very interesting.
Yes, neat.
I'm not too happy with the whole list as part of the initial state. That feels like cheating to me--although I obviously failed to specify this in my original question.
Can you avoid it? If you only allow one traversal of the input (and I think the above might qualify as two, albeit simultaneous), how do you know when you're halfway through? I seem to remember one example case that regular languages can't solve is a^nb^n -- is this for the same (or a related) reason? -k -- If I haven't seen further, it is by standing in the footprints of giants
participants (9)
-
Brian Bloniarz
-
Chaddaï Fouché
-
Geoffrey Marchant
-
Ketil Malde
-
Malcolm Wallace
-
Martijn van Steenbergen
-
Sebastiaan Visser
-
Sittampalam, Ganesh
-
Thomas ten Cate