The Belgian Snake Was: Re: Programming Nostalgia II 
Author Message
 The Belgian Snake Was: Re: Programming Nostalgia II

Jaebear,  This is a fun little challenge.

Edwin,  a very concise solution, but who besides you can describe
how it works; and how long will it take them to understand it.

Here's my solution, in the Haskell language:  
\begin{code}
module Main where
import System
main =  do
           ~ [f] <- getArgs
           s <- readFile f
           putStr (snakeCall s)

--to test snake:
--     snake 4 8 "abcd"
--     snake 3 1 "abcdefghij"
snake  l d ""  = "\n"
snake  l d string =
     snakeGuts l d False stringPadded             --add dir flag
     where stringPadded = string ++ stringPadded  --and pad the string out

--this is the guts of the Belgian Snake algorithm
snakeGuts 0 _ _ _ = "\n"
snakeGuts  _ 0 _ _ = "\n"
snakeGuts l d rev str = (if rev then reverse else id) (take l str)
               ++ "\n" ++
               snakeGuts l (d-1) (not rev) (drop l str)

snakeCall fc  = snake l d s
     where l = atoi (t!!0)
           d = atoi (t!!1)
           s =       t!!2
           t = words fc    

atoi s    = foldl (\a d -> 10*a+d) 0 (map toDigit s)
toDigit d = ord d - ord '0'
\end{code}

I'm invite more expert fp'ers to improve upon this code.

John

Quote:

>>Anyways, I am going to post the challenge here, and I would like
>>feedback as to whether you think it is too difficult, too easy (for
>>a beginning level programmer who *might* have a little knowledge of
>>programming), and if it is an appropriate puzzle.
>>THE BELGIAN SNAKE

>>The object of this puzzle is to construct a coiling snake from
>>a given string of characters (ie. ABCDE).  The snake winds back
>>and forth in a manner like this:

>>ABCDEABC
>>AEDCBAED
>>BCDEABCD
>>BAEDCBAE

>>The number of characters on a line and number of lines is given in a file
>>with the given string.
>>The file would have the structure:

>>----------------------
>>8
>>4
>>ABCDE

>Is it OK if you read the file from standard input?

>#include <stdio.h>
>#include <string.h>

>int i,f,l,h,w;
>char s[2000];
>main()
>{
>    scanf("%d %d %s",&w,&h,s);l=strlen(s);
>    while(i<h*w){
>        putchar(s[(i-f+f*(w-2*(i%w)))%l]);
>        printf(++i%w ? "" : (f=1-f,"\n"));
>    }
>}



Sun, 21 Jan 2001 03:00:00 GMT  
 The Belgian Snake Was: Re: Programming Nostalgia II

Quote:

> Jaebear,  This is a fun little challenge.

> Edwin,  a very concise solution, but who besides you can describe
> how it works; and how long will it take them to understand it.

> Here's my solution, in the Haskell language:  
> \begin{code}
> module Main where
> import System
> main =  do
>            ~ [f] <- getArgs
>            s <- readFile f
>       putStr (snakeCall s)

> --to test snake:
> --     snake 4 8 "abcd"
> --     snake 3 1 "abcdefghij"
> snake  l d ""  = "\n"
> snake  l d string =
>      snakeGuts l d False stringPadded             --add dir flag
>      where stringPadded = string ++ stringPadded  --and pad the string out

> --this is the guts of the Belgian Snake algorithm
> snakeGuts 0 _ _ _ = "\n"
> snakeGuts  _ 0 _ _ = "\n"
> snakeGuts l d rev str = (if rev then reverse else id) (take l str)
>                ++ "\n" ++
>                snakeGuts l (d-1) (not rev) (drop l str)

> snakeCall fc  = snake l d s
>      where l = atoi (t!!0)
>            d = atoi (t!!1)
>            s =       t!!2
>            t = words fc    

> atoi s    = foldl (\a d -> 10*a+d) 0 (map toDigit s)
> toDigit d = ord d - ord '0'
> \end{code}

> I'm invite more expert fp'ers to improve upon this code.

This is far to readable.  :-)  Here's a less readable version.
(Too bad Haskell doesn't have mapOdd.)

import Maybe
main = interact $ \ f ->
        let [l, d, s] = words f
        in  (unlines . take (read d) . mapOdd reverse . snd . unfoldr (Just . splitAt (read l)) . cycle) s

mapOdd f (x:x':xs) = x : f x' : mapOdd f xs

        -- Lennart

Silly extra line because my post program doesn't want me to include more text
than I post.



Sun, 21 Jan 2001 03:00:00 GMT  
 The Belgian Snake Was: Re: Programming Nostalgia II
: >>Anyways, I am going to post the challenge here, and I would like
: >>feedback as to whether you think it is too difficult, too easy (for
: >>a beginning level programmer who *might* have a little knowledge of
: >>programming), and if it is an appropriate puzzle.
: >>THE BELGIAN SNAKE
: >>
: >>The object of this puzzle is to construct a coiling snake from
: >>a given string of characters (ie. ABCDE).  The snake winds back
: >>and forth in a manner like this:
: >>
: >>ABCDEABC
: >>AEDCBAED
: >>BCDEABCD
: >>BAEDCBAE
: >
: >>The number of characters on a line and number of lines is given in a file
: >>with the given string.
: >>The file would have the structure:
: >>
: >>----------------------
: >>8
: >>4
: >>ABCDE

For a more amu{*filter*}t, a program to unwind a snake given an input such as:
4
4
abcd
hgfe
ijkl
ponm

#include <stdio.h>
char buf[1000];
int p,w,h,c;
int main()
{
        for(scanf("%d\n%d\n",&w,&h);c=getchar(),p<(w*h);c!='\n'?(buf[(p/w)&1?-1+p+w-2*(p%w):p]=c),p++:0);
        printf("%s\n",buf);
        return(0);

Quote:
}

--
Martin Young, working for SGS-Thomson   \O    O   \O    O
   at 1000 Aztec West, Almondsbury,     //\  /\\  //\  /\\   ,^O
 Bristol, BS32 4SQ. +44 145 461 1523   / |  / \  / |  //    // `   \\__|O



Tue, 23 Jan 2001 03:00:00 GMT  
 The Belgian Snake Was: Re: Programming Nostalgia II
Quote:
>import Maybe
>main = interact $ \ f ->
> let [l, d, s] = words f
> in  (unlines . take (read d) . mapOdd reverse . snd . unfoldr (Just .

splitAt (read l)) . cycle) s

Quote:

>mapOdd f (x:x':xs) = x : f x' : mapOdd f xs

Being a Clean programmer, I lack any experience with unfoldr, unlines, and
cycle. It is quite clear what you're trying to do, however, so I tried to
trace it. I deduced that the unfoldr call must generate an infinite list of
wormy lines, before the odd ones are reversed. I asked myself, "Hmm.. how
does it do that?" So I searched haskell.org's site for the definition of
unfoldr. http://haskell.cs.yale.edu/libs/maybe.html

Strangely enough, the type of unfoldr at the top of the page, (a -> Maybe
(b, a)) -> a -> (a,[b]), does not match the type at the bottom of the page
(next to the implementation), ([a] -> Maybe ([a], a)) -> [a] -> ([a],[a]).
Ignoring this little detail, I tried to trace the code with your parameters
and quickly got confused beyond all hell. Unless I was mistaken I was
getting all kinds of infinitely recursive junk.
    Assuming I was in error, I translated both your code and the library
code to Clean and found that your code didn't typecheck. Assuming I once
again made an error, I copy/pasted your code into Hugs, and lo! the same
type error:

*** expression     : unfoldr (Just . splitAt (read l))
*** term           : Just . splitAt (read l)
*** type           : [a] -> Maybe ([a],[a])
*** does not match : [[a]] -> Maybe ([[a]],[a])
*** because        : unification would give infinite type

At this point, I just tried to express snd. unfoldr (Just . splitAt (read
l)) as my own little function splice l:

splice l xs = [fst split: splice l (snd split)]
 where split = (splitAt l xs)

Well, that worked. But I realized that splice seems to have a pretty common
recursive pattern. This must be the unfoldr pattern! Thinking about it more,
I decided to write my own version of unfoldr:

unfoldr f x =
 case f x of
  Just (b, x`) -> let (a, bs) = unfoldr f x` in (a, [b:bs])
  Nothing -> (x, [])

I hadn't had breakfast yet, so I decided that rather than try and figure out
the type of this function, I'll save myself the time and let the Clean
compiler infer it for me. Amazingly enough, it was unfoldr :: (a -> Maybe
(b, a)) a -> (a,[b]). This, as you may recall, is one of the type signatures
for unfoldr on the above URL.
    Now that I've finished with my amusing anecdote, what the hell is going
on? Why are there conflicting types (yes, they're conflicting) in the
Haskell Library Report? How come the standard version of unfoldr appears to
make no sense and not work? What's the deal?

PS: your code is more readable than the original Haskell solution. It
reflects the most obvious way to solve the problem.



Tue, 23 Jan 2001 03:00:00 GMT  
 The Belgian Snake Was: Re: Programming Nostalgia II
Well!  Looks like you've found a bug in our Maybe module!  The
`official' unfoldr is the one in the body of Maybe - the signature in
the box is incorrect.  We'll fix this in the next release of the
library report.  Sorry about the confusion.

   John



Tue, 23 Jan 2001 03:00:00 GMT  
 The Belgian Snake Was: Re: Programming Nostalgia II

Quote:

>Well!  Looks like you've found a bug in our Maybe module!  The
>`official' unfoldr is the one in the body of Maybe - the signature in
>the box is incorrect.  We'll fix this in the next release of the
>library report.  Sorry about the confusion.

As explained in my previous posting, it is my belief that the signature *in
the box* is the correct one. The implementation of "the `official'" unfoldr
appears to me as erroneous; I don't understand how it works. Moreover, it
doesn't work with the original code supplied in the posting to which I
replied. I wrote something different that makes more sense to me and works
with the previous author's code. Finally what you claim to be the correct
type signature I believe is incorrect given what unfoldr is supposed to do:

Quote:
> unfoldr f' (foldr f z xs) == (z,xs)
> if the following holds:
> f' (f x y) = Just (x,y)
> f' z       = Nothing
> unfoldr :: ([a] -> Maybe ([a], a)) -> [a] -> ([a],[a])

This doesn't jive with the above . The first parameter of unfoldr should (at
its strictest) be of type a -> Maybe (a, a) [see example 1]. And the range
of unfoldr f xs should be (a, [a]), since 'z' is of type a (see above)!

example 1:

Using Haskore, if we want to unfoldr something created (folded) with line
(where line [a, b, c]  = (a :+: b :+: c) (yeah, I'm fiddling with the
details for simplicity), we'd use:

unfoldr f xs
where f (a :+: b) = Just (a, b)

Thus, f :: Music -> Maybe (Music, Music)
This matches a -> Maybe (a, a), but not ([a] -> Maybe ([a], a)).

I think you should change the implementation of unfoldr rather than
homogenize its type the library report.



Wed, 24 Jan 2001 03:00:00 GMT  
 The Belgian Snake Was: Re: Programming Nostalgia II
In K:


Reverse the odd-numbered rows of y reshape x.

  bs["abcde"]4 8
("abcdeabc"
 "aedcbaed"
 "bcdeabcd"
 "baedcbae")

Another solution:


Apply the alternating function-vector (return;reverse;...) to
corresponding rows of y reshape x.

K can be downloaded at www.kx.com.

sa



Sat, 27 Jan 2001 03:00:00 GMT  
 The Belgian Snake Was: Re: Programming Nostalgia II
An slightly more challenging version:  coil a snake within a box of size
n x n.

abcdefgh
5

 . . . .
 g h . .
 f a b .
 e d c .
 . . . .

i.e.,

0 0 0 0 0
0 7 8 0 0
0 6 1 2 0
0 5 4 3 0
0 0 0 0 0



Sat, 27 Jan 2001 03:00:00 GMT  
 The Belgian Snake Was: Re: Programming Nostalgia II

Quote:
>This is far to readable.  :-)  Here's a less readable version.
>(Too bad Haskell doesn't have mapOdd.)

>import Maybe
>main = interact $ \ f ->
>    let [l, d, s] = words f
>    in  (unlines . take (read d) . mapOdd reverse . snd . unfoldr (Just . splitAt (read l)) . cycle) s

>mapOdd f (x:x':xs) = x : f x' : mapOdd f xs

This doesn't type check in hugs1.4; what's going on?

John



Sat, 27 Jan 2001 03:00:00 GMT  
 The Belgian Snake Was: Re: Programming Nostalgia II

A K solution to the snake in a box problem:

  coil"abcdefghijklmnopqr"
("mnopq"
 "lcder"
 "kbaf "
 "jihg ")

coil:{*(0<#*|:)wrap/(1 1#x;1_ x)}
wrap:{n:#*x;(|+x,,|n#y,n#" ";n _ y)}.

Not quite as bad as it seems.  Here's a keyword version:

coil is:  first (0<count last) while wrap (1 1 reshape x;1 drop x)

wrap is:
  n is count first x
  (reverse transpose x join enlist reverse n take y join n take " ";n
drop y)

coil applies wrap while there's still some snake left.  The arguments to
wrap are primed as the 1 by 1 coil (,,"a") and the 1 drop
("bcdefghijklmnopqr").

wrap appends a length of snake to its first argument (the current state
of the coil), and returns a list whose first item is the next state of
the coil, and whose second is the input snake minus the appended bit.

sa



Sat, 27 Jan 2001 03:00:00 GMT  
 The Belgian Snake Was: Re: Programming Nostalgia II

Bless you!

~kzm
--
If I haven't seen further, it is by standing in the footprints of giants



Sun, 28 Jan 2001 03:00:00 GMT  
 The Belgian Snake Was: Re: Programming Nostalgia II

Quote:


> Reverse the odd-numbered rows of y reshape x.

>   bs["abcde"]4 8
> ("abcdeabc"
>  "aedcbaed"
>  "bcdeabcd"
>  "baedcbae")

A minor quibble:
This doesn't do what the original program did.  You are
supposed to take the arguments from the command line and
print the result formatted on stdout.

--

        -- Lennart Augustsson
[This non-signature is unintentionally not left unblank.]



Sun, 28 Jan 2001 03:00:00 GMT  
 The Belgian Snake Was: Re: Programming Nostalgia II
Lennart says:  [the original problem was] to take the arguments from the
command line and print the result formatted on stdout.

I thought the original problem was to take the arguments from a file.

If so, then my solution becomes:

 `0:bs . 1:`snake
abcdeabc
aebcbaed
bcdeabcd
baedcbae

where 1: `snake reads the list ("abcde";4 8) from the file `snake, and
`0: prints the result to the console.

To take the arguments from the command line (hardly ever done in K):

`0:bs .. 0:`

It's just IO.

sa



Sun, 28 Jan 2001 03:00:00 GMT  
 The Belgian Snake Was: Re: Programming Nostalgia II
Ketil says:  Bless you!

"!bless you" to process in one pass.

sa



Sun, 28 Jan 2001 03:00:00 GMT  
 The Belgian Snake Was: Re: Programming Nostalgia II

Quote:

> An slightly more challenging version:  coil a snake within a box of size
> n x n.

> abcdefgh
> 5

>  . . . .
>  g h . .
>  f a b .
>  e d c .
>  . . . .

I tried this over the weekend but though the problem was to produce :-

Quote:
>  . . . .
>  . b c .
>  . a d .
>  g f e .
>  . . . .

so that is what the following Haskell (or more correctly Hugs) code does :-

Quote:
>module Snake where
>import Array
>import IO

>dup x = (x, x)
>phasePair :: [a] -> [(a, a)]
>phasePair w = zip sw sw'
> where
>  sw = cycle w
>  sw' = drop ((length w)-1) sw
>unpair :: [(a, a)] -> [a]
>unpair = foldr up []
> where
>  up (a, b) z = a:b:z
>addPair :: (Num a) => (a, a) -> (a, a) -> (a, a)
>addPair (a, b) (c, d) = (a+c, b+d)
>snakeCoords :: Int  -> [Int] -> [(Int, Int)]
>snakeCoords d w = scanl addPair center deltas
> where
>  center = dup (div d 2)
>  inds = ((0:) . unpair . uncurry zip . dup) [1..]
>  coords = (dup 0):(phasePair w)
>  deltas = concatMap (uncurry replicate) (zip inds coords)
>square :: Int -> a -> Array (Int, Int) a
>square d v = array bs [((x, y), v) | x <- range vr, y <- range vr ]
>  where
>    bs = (dup 1, dup d)
>    vr = (1, d)
>snake :: Int -> a -> [a] -> Array (Int, Int) a
>snake d z p = (square d z)//(zip (snakeCoords d w) p)
> where
>   w = [0, 1,  0, -1]
>matrix2lists :: Ix a => Array (a, a) b -> [[b]]
>matrix2lists b = [ [ b!(x, y) | x <- range (lx, ux)] | y <- range (ly, uy)]
>  where
>    ((lx, ly), (ux, uy)) = bounds b
>ppSnake d p = pp (snake d '.' p)
> where
>   pp = putStr . unlines . matrix2lists

For example :-

Snake> ppSnake 8 "abcdefghijklmnopqr"
........
..jklm..
..ibcn..
..hado..
..gfep..
....rq..
........
........

It should only involve a change to one line to get it to produce the
output you want.  Similarly a change to the same line produces output
like :-

Snake> ppSnake 10 "abcdefghijklmnopqr"
..j.k.l.m.
..........
..i.b.c.n.
..........
..h.a.d.o.
..........
..g.f.e.p.
..........
......r.q.
..........

or :-

Snake> ppSnake 32 "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
................................
................................
................................
................................
................................
................................
.......zABCDE...................
.......y......F.................
.......x........G...............
.......w..........H.............
.......v............I...........
.......u..............J.........
........................K.......
........t.......................
...............bc........L......
.........s.....a..d.............
....................e.....M.....
..........r.....................
.....................f.....N....
...........q....................
.............p........g.....O...
...............o......h.........
.................n....i......P..
...................mlkj.........
..............................Q.
..............................R.
..............................S.
..............................T.
..............................U.
..............................V.
..............................W.
............................ZYX.

I'm sure that with some more thought that the above code could be
improved -- my Haskell is very rusty.



Fri, 02 Feb 2001 03:00:00 GMT  
 
 [ 15 post ] 

 Relevant Pages 

1. The Belgian Snake Was: Re: Programming Nostalgia II

2. Announcement: Python Programming: Taming the Snake.

3. Software Developer II - Dallas 7/7/98 10:15:19 AM

4. Belgian Clarion programmers wanted

5. Belgian Smalltalk Users Group Meeting

6. Nostalgia - Free APL

7. Nostalgia/Content of this newsgroup

8. Nostalgia (again)

9. More nostalgia ..

10. 360 Nostalgia - Commercial Computing Museum WWW.

11. New Product or Instant Nostalgia?

12. 6502 nostalgia

 

 
Powered by phpBB® Forum Software