Pancake sorting with the shortest series of flips, a la brute force, from new Haskeller
dTacitus
I am new Haskeller. After learning Haskell for a week, I started to
like it, and begin to try to code something. Here is one of few. It is
known as "Pancake sorting".
Given stack of pancakes, an algorithm should search all variations for
first series of flips that brings pancakes to sorted. A series shall
be the shortest. I.e. here I'm not interested to implement Pancake
Sorting as that, but finder of the first shortest series.
Code is for GHCi.
<code>
import Data.List
-- i did not find in standard libraries a func that tests whether a
list is sorted.
-- so i implement func myself. i wonder that "issorted1 a = sort a ==
a" is not slower that
-- one below, although issorted1 looks much overhead.
-- would like to know another, much efficient test, if exists.
issorted [x] = True
issorted (x:xs) = x <= head xs && issorted xs
-- flips n upper pancakes over
reversetop n s = (reverse $ take n a) ++ drop n s
-- "exec" executes series of flips dictated by e over stack of
pancakes s
exec e s = foldl reversetop s e
-- "variations" generates variations, like [[1,1],[1,2],[2,1],[2,2]]
variations 0 m = [[]]
variations n m = [(x:xs) | x <- [1..m], xs <- variations (n-1) m]
-- given stack s, func "search"s for the first series to depth n
maximum
search n s = dropWhile (<=1) $ head [x | x <- variations n (length s),
issorted $ exec x s]
-- here dropWhile drops all trivial, identity flips at front, for
readability of output
test = search 10 [3,2,4,6,1,5]
</code>
would like to see how the code looks, if search is being performed not
to a static depth, but depth incrementally, like, search variations of
depth 1, then ones of depth 2, until a series is found. It should be
much efficient than mine.
Thank you,
dTacitus
Mark T.B. Carroll
> I am new Haskeller. After learning Haskell for a week, I started to
> like it, and begin to try to code something. Here is one of few. It is
> known as "Pancake sorting".
> Given stack of pancakes, an algorithm should search all variations for
> first series of flips that brings pancakes to sorted. A series shall
> be the shortest. I.e. here I'm not interested to implement Pancake
> Sorting as that, but finder of the first shortest series.
> Code is for GHCi.
You've picked a good problem. I'm glad you're liking Haskell.
Alas, I don't have chance right now to look in detail, but I can at
least offer a few thoughts.
> -- i did not find in standard libraries a func that tests whether a
> list is sorted.
> -- so i implement func myself. i wonder that "issorted1 a = sort a ==
> a" is not slower that
> -- one below, although issorted1 looks much overhead.
> -- would like to know another, much efficient test, if exists.
> issorted [x] = True
> issorted (x:xs) = x <= head xs && issorted xs
This looks reasonable. I'd like to think it compiles to something that's
linear in time and constant in space. Note that you can extend the
pattern match to get the head of xs, like (x:xs@(h:_)) where h would be
head xs. My natural tendency would have been to write,
isSorted xs = all (uncurry (<=)) (zip xs (tail xs))
but tuples tend to be a bit slow in my experience - yours is probably
better than mine!
> -- flips n upper pancakes over
> reversetop n s = (reverse $ take n a) ++ drop n s
A let and a splitAt might help you here?
> -- "exec" executes series of flips dictated by e over stack of
> pancakes s
> exec e s = foldl reversetop s e
foldl is almost always the wrong thing to do - the first section of
http://www.haskell.org/haskellwiki/Stack_overflow explains why.
> -- "variations" generates variations, like [[1,1],[1,2],[2,1],[2,2]]
> variations 0 m = [[]]
> variations n m = [(x:xs) | x <- [1..m], xs <- variations (n-1) m]
This seems like a nice use of list comprehensions. You might be
interested to know that the list monad lets you write,
variations n m = sequence (replicate n [1..m])
Alas, it being mothers' day in the US, I now have to go do family things
again. I bet someone else will have more interesting things to say
before I get back here.
Mark
Dirk Thierbach
> import Data.List
>
> i wonder that "issorted1 a = sort a == a" is not slower that one
> below,
It definitely is slower.
> would like to know another, much efficient test, if exists.
> issorted [x] = True
> issorted (x:xs) = x <= head xs && issorted xs
You cannot get more efficient in terms of comparisons, but you can avoid
the call to head (which does an error check for the empty list):
issorted [] = True
issorted [x] = True
issorted (x:xs@(y:_)) = x <= y && issorted xs
The @ gives the subpattern (y:_) the name xs.
> -- flips n upper pancakes over
> reversetop n s = (reverse $ take n a) ++ drop n s
BTW, if you want to use foldl below, you have to exchange "n" and "s".
One can actually implement that efficiently in one function, by using
an extra argument to accumulate the reversed front part of a list:
reversetop :: [a] -> Int -> [a]
reversetop xs n = rtop [] xs n where
rtop ys xs 0 = ys ++ xs
rtop ys (x:xs) n = rtop (x:ys) xs (n-1)
If you use "take", "drop", and "reverse", you have to traverse the
first n elements of the list three times. "rtop" does it only once.
> -- "exec" executes series of flips dictated by e over stack of
> pancakes s
> exec e s = foldl reversetop s e
>
> -- "variations" generates variations, like [[1,1],[1,2],[2,1],[2,2]]
> variations 0 m = [[]]
> variations n m = [(x:xs) | x <- [1..m], xs <- variations (n-1) m]
>
> -- given stack s, func "search"s for the first series to depth n
> -- maximum
> search n s = dropWhile (<=1) $ head [x | x <- variations n (length s),
> issorted $ exec x s]
> -- here dropWhile drops all trivial, identity flips at front, for
> -- readability of output
>
> test = search 10 [3,2,4,6,1,5]
>
> </code>
>
> would like to see how the code looks, if search is being performed not
> to a static depth, but depth incrementally, like, search variations of
> depth 1, then ones of depth 2, until a series is found.
So why don't you just assign 1,2,3,... to n?
search s = dropWhile (<=1) $ head
[x | n <- [1..], x <- variations n (length s), issorted $ exec x s]
BTW, if the list comprehensions get to long, I prefer switching to
do-notation instead:
import Control.Monad
search s = dropWhile (<=1) $ head $ do
n <- [1..]
x <- variations n (length s)
guard $ issorted $ exec x s
return x
We could also improve "variations": Flipping a stack of size 1 is
*always* a no-op (not only in the beginning), so we should never
produce that value:
variations :: Int -> Int -> [[Int]]
variations 0 m = [[]]
variations n m = [(x:xs) | x <- [2..m], xs <- variations (n-1) m]
Then we can get rid of the "dropWhile (<=1)".
Doing two flips with the same size directly after each other is also
a no-op, so we try to avoid this:
variations :: Int -> Int -> [[Int]]
variations n m = vars 0 n where
vars y 0 = [[]]
vars y n = [(x:xs) | x <- [2..m], x /= y, xs <- vars x (n-1)]
Runs much faster now :-)
- Dirk
dTacitus
Thanks to Mark for thoughts that get me knowing of other ways of
writing functions, pattern-matching.
I found a way to write algorithm that performs breadth-first search,
which I wanted
<code>
import Data.List
issorted [x] = True
--issorted (x:xs) = x <= head xs && issorted xs
issorted (x:xs@(h:_)) = x <= h && issorted xs
reversetop s n = (reverse $ take n s) ++ drop n s
-- one of other ways of defining is
-- reversetop s n = let pair = splitAt n s in (reverse $ fst pair) ++
snd pair
-- "hasnotDuplElems" tests if a list does not
-- contain same elems consecutively
hasnotDuplElems [] = True
hasnotDuplElems [x] = True
hasnotDuplElems (x:xs@(h:_)) = x /= h && hasnotDuplElems xs
variations 0 m = [[]]
variations n m = [(x:xs) | x <- [1..m], xs <- variations (n-1) m]
-- func proposed by Mark as an alternative like
-- variations n m = sequence (replicate n [1..m])
-- eats lot of memory when search is being performed
-- since breadth-first search can here be implemented,
-- I started to look for some optimizations.
-- "variations2" differs from that above with that
-- starting value of every elem is 2 as we can ignore
-- now 1 which is trivial identity flip.
-- Also with that it filters out those variations, which
-- contain duplicated elems consecutively, for
-- these two elems represent two same flips that
-- don't change stack in result
variations2 0 m = [[]]
variations2 n m = [(x:xs) | x <- [2..m],
xs <- variations2 (n-1) m, hasnotDuplElems (x:xs)]
-- generates [[[]], [[2],[3]], [[2,3],[3,2]], [[2,3,2],[3,2,3]],...],
if m=3
incrvariations2 m = [variations2 n m | n <- [0..]]
-- As Mark pointed out foldl can lead to stack overflow
-- Indeed. But here foldl applies to relatively very small lists.
-- Or we replaces it with foldl' which is stack-overflow safe.
-- And foldl' can be applied to reversetop, because last is "strict
-- binary" func? But works anyway.
-- Inter alia, foldl' is iterative func,
-- but foldl is recursive func? Is it right?
exec e s = foldl' reversetop s e
-- main func, crucial thing for me was finding out that
-- combining "concat" and "incrvariations2" allows to search
-- in breadth-first fashion.
search s = head [x | x <- concat $ incrvariations2 $ length s,
issorted $ exec x s]
-- I was fearing that concatening infinite lists would be infinite
process
-- Vainly. Laziness of Haskell is very cool thing!
test0 = search [1,2,3]
test1 = search [2,1,3,4]
test2 = search [3,2,4,6,1,5]
test3 = search [3,2,4,7,6,1,5]
test4 = search [3,2,8,7,6,1,5,4]
test5 = search [3,2,9,4,7,6,1,5,8]
</code>
dTacitus
dTacitus
and test his proposals. Thanks to Dirk!
dTacitus
Mark T.B. Carroll
(snip)
> reversetop s n = (reverse $ take n s) ++ drop n s
> -- one of other ways of defining is
> -- reversetop s n = let pair = splitAt n s in (reverse $ fst pair) ++
> snd pair
Or maybe, let (first, second) = splitAt n s in (reverse first ++ second)
You can also use this kind of trick in `let' to avoid functions like
fromJust, if you like.
> -- "hasnotDuplElems" tests if a list does not
> -- contain same elems consecutively
> hasnotDuplElems [] = True
> hasnotDuplElems [x] = True
> hasnotDuplElems (x:xs@(h:_)) = x /= h && hasnotDuplElems xs
If you like you can put the first two of these cases together as a
last case matching on _.
> variations 0 m = [[]]
> variations n m = [(x:xs) | x <- [1..m], xs <- variations (n-1) m]
> -- func proposed by Mark as an alternative like
> -- variations n m = sequence (replicate n [1..m])
> -- eats lot of memory when search is being performed
That's very interesting. I wonder why! I shall have to think about that.
> -- Inter alia, foldl' is iterative func,
> -- but foldl is recursive func? Is it right?
You can have a look at their definition - the code in the standard
libraries is very educational! For instance, adapted from others' code
that I have lying around,
foldl f z [] = z
foldl f z (x:xs) =
let z' = f z x
in foldl f z' xs
foldl' f z [] = z
foldl' f z (x:xs) =
let z' = f z x
in z' `seq` foldl' f z' xs
Notice the difference in the last line: what foldl' is doing is it is
forcing some evaluation of the current step before it does the recursive
call. (seq causes some evaluation of its first argument.)
Given your game-search experimentation I should mention section 5 of
http://www.cse.iitb.ac.in/~as/fpcourse/whyfp.ps in case you find it
interesting.
(snip)
> -- Vainly. Laziness of Haskell is very cool thing!
It sometimes needs some taming. (-:
Mark
Dirk Thierbach
> dTacitus <aiva...@inbox.lv> writes:
>> hasnotDuplElems [] = True
>> hasnotDuplElems [x] = True
>> hasnotDuplElems (x:xs@(h:_)) = x /= h && hasnotDuplElems xs
> If you like you can put the first two of these cases together as a
> last case matching on _.
It's a matter of style, but I prefer to explicitely list the base cases,
even if it might be a bit less efficient. In that way, it's easier to
see that the definition is complete, and that the behaviour is actually
correct. (Though in this case, it's actually more efficient to avoid
generating variations with duplicated elements in the first place,
instead of first generating them and throwing them away, so the question
is really moot here :-).
>> -- Inter alia, foldl' is iterative func,
>> -- but foldl is recursive func? Is it right?
No, both are recursive. As Mark has pointed out, if in doubt, look at
the source. It's actually impossible to write iterative functions in
the original sense of the word in Haskell, because there are no loops.
(Of course, tail-recursion is equivalent to iteration, so in this
sense, one can).
> Notice the difference in the last line: what foldl' is doing is it is
> forcing some evaluation of the current step before it does the recursive
> call.
And this is called "strictness". So foldl' is a strict variant of
foldl. BTW, GHC does strictness analysis in the optimization passes,
so it can turn foldl into foldl' automatically when appropriate.
The rule of thumb is that one should use either foldr or foldl' (or let
the compiler turn foldl into foldl'). If you don't do that, the program
might consume space linear in the length of the list when folding over
the list. For long lists, that's a bad thing. That's one of the gotchas
with Haskell everyone runs into sooner or later, especially if the
"foldl" is hidden in the library functions (like "sum" or "product").
See earlier threads in this NG for some examples of this.
- Dirk