Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

99 Problems in Perl6

by Ovid (Cardinal)
on Dec 15, 2006 at 20:29 UTC ( #590113=perlmeditation: print w/ replies, xml ) Need Help??

I recently stumbled across 99 Lisp Problems (which was originally 99 Prolog Problems). It looked like fun, so I started answering those problems in Perl 6. This has shown me that I don't know Perl 6 nearly as well as I would like. However, here are my first 9 answers:

#!/usr/bin/pugs use v6-alpha; #P01 (*) Find the last box of a list. # Example: # * (my-last '(a b c d)) # (D) <a b c d>[-1].say; #P02 (*) Find the last but one box of a list. # Example: # * (my-but-last '(a b c d)) # (C D) <a b c d>[-2, -1].perl.say; #P03 (*) Find the K'th element of a list. # The first element in the list is number 1. # Example: # * (element-at '(a b c d e) 3) # C <a b c d>[2].perl.say; #P04 (*) Find the number of elements of a list. <a b c d>.elems.say; #P05 (*) Reverse a list. <a b c d>.reverse.perl.say; #P06 (*) Find out whether a list is a palindrome. # A palindrome can be read forward or backward; e.g. (x a m a x). for [<a b c b a>], [<a b c b c a>] -> $array { if $array.reverse ~~ $array { say $array.perl ~ " is a palindrome"; } else { say $array.perl ~ " is not a palindrome"; } } #P07 (**) Flatten a nested list structure. # Transform a list, possibly holding lists as elements into a `flat +' list by # replacing each list with its elements (recursively). # courtesy of Wim Vanderbauwhede from the perl6-users list my $flatten = -> $x { $x.isa(Array) ?? ( map $flatten, $x ) !! $x }; my @flattened = map $flatten, ('a', ['b', ['c', 'd', 'e']]); @flattened.perl.say; #P08 (**) Eliminate consecutive duplicates of list elements. # If a list contains repeated elements they should be replaced with + a single # copy of the element. The order of the elements should not be chan +ged. # Example: # * (compress '(a a a a b c c a a d e e e e)) # (a b c a d E) my $compress = do { my $previous; $compress = sub ($x) { if $x ne $previous { $previous = $x; return $x; } else { return; } }; } my @compressed = map $compress, <a a a a b c c a a d e e e e>; @compressed.perl.say; #P09 (**) Pack consecutive duplicates of list elements into sublists. # If a list contains repeated elements they should be placed in sep +arate sublists. # # Example: # * (pack '(a a a a b c c a a d e e e e)) # ((A A A A) (B) (C C) (A A) (D) (E E E E)) my @packed; { my @sublist; my $previous; for <a a a a b c c a a d e e e e> -> $x { if $x eq $previous { @sublist.push($x); next; } $previous = $x; if @sublist { @packed.push([@sublist]); @sublist = $x; } } @packed.push([@sublist]); } @packed.perl.say;

Needless to say, I have a lot more work to do, but feel free to tackle them. You should probably read the latest Perl6 docs.

All of the above examples run under the latest version of Pugs.

Hint for problem 10: it's very, very close to problem 9.

Problem 10: Run-length encoding of a list.
Use the result of problem P09 to implement the so-called run-length encoding data compression method. Consecutive duplicates of elements are encoded as lists (N E) where N is the number of duplicates of the element E.

Example:
* (encode '(a a a a b c c a a d e e e e))
((4 A) (1 B) (2 C) (2 A) (1 D)(4 E))

Update: Swapped POD for comments to make it shorter and easier to read. Also, if you struggle with a problem, try writing it in Perl 5 first.

Cheers,
Ovid

New address of my CGI Course.

Comment on 99 Problems in Perl6
Download Code
Re: 99 Problems in Perl6
by Juerd (Abbot) on Dec 15, 2006 at 20:56 UTC

      Well, to be honest, I should write tests instead, but this was a quick start to just show the answers. By doing it this way, we don't have to worry about explaining "this is how you test code", but I suppose it would be better that way.

      Cheers,
      Ovid

      New address of my CGI Course.

Re: 99 Problems in Perl6 (Lisp, Prolog, Haskell)
by Ovid (Cardinal) on Dec 15, 2006 at 21:57 UTC

    How embarrassing. My first version of problem 9 (packing lists into sublists) had a bug. Here's a cleaner version which actually works. I know the bug in problem 9. Can you spot it?

    sub pack (@array) returns Array { my @unpacked = @array; my (@list, @packed); while @unpacked { @list.push(@unpacked.shift) while !@list || @list[0] eq @unpac +ked[0]; @packed.push([@list]); @list = (); } return @packed; } pack(<a a a a b c c a a d e e e e>).perl.say;

    And for the Lisp weenies who claim Lisp is so much better, here's one way to do it in Lisp (can you make it shorter?):

    (defun pack (lista) (if (eql lista nil) nil (cons (pega lista) (pack (tira lista))) ) ) (defun pega (lista) (cond ((eql lista nil) nil) ((eql (cdr lista) nil) lista) ((equal (car lista) (cadr lista)) (cons (car lista) (pega (cdr lista)))) (t (list (car lista))) ) ) (defun tira (lista) (cond ((eql lista nil) nil) ((eql (cdr lista) nil) nil) ((equal (car lista) (cadr lista)) (tira (cdr lista))) (t (cdr lista)) ) )

    But the Prolog folks still have a neat solution:

    pack([],[]). pack([X|Xs],[Z|Zs]) :- transfer(X,Xs,Ys,Z), pack(Ys,Zs). transfer(X,[],[],[X]). transfer(X,[Y|Ys],[Y|Ys],[X]) :- X \= Y. transfer(X,[X|Xs],Ys,[X|Zs]) :- transfer(X,Xs,Ys,Zs).

    And Haskell still makes us all look like chumps:

    group (x:xs) = let (first,rest) = span (==x) xs in (x:first) : group rest group [] = []

    Cheers,
    Ovid

    New address of my CGI Course.

      Here's a prettier way to write the Perl 6 solution:
      sub group (*@array is copy) { gather { while @array { take [ gather { my $h = shift @array; take $h; while @array and $h eq @array[0] { take shift @array; } } ]; } } }
      It would be slightly prettier if take could harvest a value en passant.

        Sweet!

        Why do you flatten the array? I played with that in Pugs and the asterisk seems superfluous. It seems like one is copy the elements and the other is copying the array. I thought that maybe your version would avoid aliasing problems, but even in checking that, I'm not seeing it happening.

        sub group (@array is copy) { # didn't flatten gather { while @array { take [ gather { my $h = shift @array; take $h; while @array and $h eq @array[0] { take shift @array; } } ]; } } }

        Cheers,
        Ovid

        New address of my CGI Course.

      atoku says: Lisp deserves better code :) Below is just an example of a possible better way ;) just 6 lines.
      (defun pick-new (lst el) (if (eql (car (car lst)) el) (cons (cons el (car lst)) (cdr lst)) (cons (list el) lst))) (defun pack (lst) (reverse (reduce #'pick-new lst :initial-value nil)))
      Winston Smith says: Here is a variation on Atokuís elegant lisp solution. Note the unification of cases made possible by the side-effect of pop.
      (defun pick-new (lst el) (cons (cons el (when (equal el (caar lst)) (pop lst))) lst)) (defun pack (lst) (reverse (reduce #'pick-new lst :initial-value nil)))
      Here are three solutions in lisp that donít require auxiliary functions.
      ;;With loop: (defun pack(lst &optional groups) (loop for el in lst for first-group = (when (equal el (caar groups)) (pop groups)) do (push (cons el first-group) groups)) (reverse groups)) ;;With recursion: (defun pack(lst &optional groups) (if (not lst) (reverse groups) (let* ((el (pop lst)) (first-group (when (equal el (caar groups)) (pop groups)) +)) (pack lst (cons (cons el first-group) groups))))) ;;With no mercy: (defun pack(lst &optional g) (if (not lst) (reverse g) (pack (cdr lst) (cons (cons (car lst) (when (equal (car lst) (ca +ar g)) (pop g))) g)))))
Re: 99 Problems in Perl6
by gaal (Parson) on Dec 15, 2006 at 22:15 UTC
    In #8, you have a superfluous assignment of the closure. Instead of

    my $compress = do { my $previous; $compress = sub ($x) { ... } };

    You could just arrange for the sub definition to be the last evaluated thing inside the do. (This is really no different from Perl 5, except for the formal parameter.)

    my $compress = do { my $previous; sub ($x) { ... } }; # or perhaps, my $compress; { my $previous; $compress = sub ($x) { ... } }

      On second thought, the only reason you have a closure here at all is to preserve state between calls. Use a state variable then, and the more normal function definition syntax.

      sub compress ($x) { state $previous; if $x ne $previous { return $x; } else { return; } }
      Update: I think the if is way too long, but can't remember if there's a context-safe way to return nothing in Perl 6 (that isn't "fail"), to golf out the "return" and say something like return $x ne $previous ?? $x !! $NOTHING_AT_ALL;. In the current application () is probably safe.

        You know, we're getting pretty close to the terseness of Haskell, but (I think) it's still rather readable:

        my $compress = sub ($x) { state $previous; $x ne $previous ?? $previous = $x !! return; }

        And in Haskell:

        compress :: Eq a => [a] -> [a] compress = map head . group

        Update: as concise, but less "golfy":

        my $compress = sub ($x) { state $previous; return $x ne $previous ?? $previous = $x !! (); }

        Cheers,
        Ovid

        New address of my CGI Course.

      Good points, thank you. I suppose if I really want to confuse people (again, pretty darned close to Perl 5):

      my $compress = do { my $previous; sub ($x) { $x ne $previous ?? $previous = $x !! return; }; }

      That works just fine, but it might give someone pause :) Of course, I wouldn't write it like that for production.

      Cheers,
      Ovid

      New address of my CGI Course.

        I thought I read recently that in Perl 6, this:

        ... ?? $previous = $x !! ...;

        would be a syntax error. You need parens (I think Pugs lets you get away with this for now but that will get fixed eventually).

        - tye        

      Couldn't that be done easier with take/gather?

      my @in = <a a a a b c c a a d e e e e>; my @out = gather { for @in -> $i { state $last; take $i if $i ne $last; $last = $i; }}; say @out;

      ___________
      Eric Hodges
        TIMTOWTDI of course, but syntax updates to gather since the OP allow you to write it as:

        my @in = <a a a a b c c a a d e e e e>; say gather for @in -> $i { state $last; $last = take $i if $i ne $last; };
Re: 99 Problems in Perl6
by jdporter (Canon) on Dec 15, 2006 at 22:31 UTC
    @flattened.perl.say;

    What is this .perl method? Needless to .say, it's not easy to search for.

    We're building the house of the future together.

      It's kind of like a poor man's Data::Dumper. For example, if you want to see all of your environment variables, you can use this:

      %*ENV.perl.say;

      That will represent %*ENV (remember that the '*' twigil means it's global) in a way that's legal Perl6 code. I use it because it makes complex data structures much easier to read. I don't know if it's possible to customize the output, though. Right now it's all one one line.

      You can still do this:

      %*ENV.say;

      You won't find the output as legible, though.

      And while we're on the topic of environment variables, use the '+' twigil to read them. What to see the 'HOME' environment variable?

      $+HOME.say

      Update: the one thing I really want is for reflection to be added to Pugs so I can query an object for its methods. That will be a huge productivity boost so we can see exactly what we can play with.

      Cheers,
      Ovid

      New address of my CGI Course.

      What Ovid said. There's also a .yaml method that does the YAML::Syck::Dump equivalent. The round trip is also analogous:

      eval $obj.perl; eval $obj.yaml :lang<yaml>; # though this syntax is unspecced and +may change.
      From S02:
      To get a Perlish representation of any object, use the .perl method. Like the Data::Dumper module in Perl 5, the .perl method will put quotes around strings, square brackets around list values, curlies around hash values, constructors around objects, etc., so that Perl can evaluate the result back to the same object.
As Jay-Z says
by perrin (Chancellor) on Dec 16, 2006 at 00:06 UTC
    "If you're having perl problems I feel bad for you son,
    I got 99 problems but Perl 6 ain't one"

    Sorry, I couldn't resist.

Re: 99 Problems in Perl6
by Util (Priest) on Dec 17, 2006 at 01:09 UTC

    Here are my solutions to Problem 9. The first is concise and looks fairly efficient. The second is less straightforward; I wanted to solve it with one big map, in the hopes of allowing it to work lazily. I don't know how to tell if I succeeded, though.

    Code tested in Pugs:

    sub p09_group_Util_1 (*@list) { my @ret; for @list -> $val { push @ret, [] if !@ret or $val !~~ @ret[-1][-1]; push @ret[-1], $val; } return @ret; } sub p09_group_Util_2 (*@list) { my @tmp; return map -> $index, $val { my @ret; if !@tmp or $val !~~ @tmp[-1] { @ret = [ @tmp ] if @tmp; undefine @tmp; } push @tmp, $val; push @ret, [ @tmp ] if @tmp and $index == @list.end; @ret; # May contain 0, 1, or 2 arrayrefs. }, @list.kv; } my @data = <a a a a b c c a a d e e e e>; say '9.1 ', p09_group_Util_1(@data).perl; say '9.2 ', p09_group_Util_2(@data).perl; # When dumped via .perl, Util_1 is wrapped in [], and Util_2 in (). # When dumped via .yaml, Util_1 and Util_2 are identical. Bug?
    Output:
    9.1 [["a", "a", "a", "a"], ["b",], ["c", "c"], ["a", "a"], ["d",], ["e +", "e", "e", "e"]] 9.2 (["a", "a", "a", "a"], ["b",], ["c", "c"], ["a", "a"], ["d",], ["e +", "e", "e", "e"])

Re: 99 Problems in Perl6
by BrowserUk (Pope) on Dec 17, 2006 at 12:22 UTC

    Seems that most of the Perl 6 solutions (never mind the hidious lisp concoctions:) are much clumsier than a fairly obvious Perl 5 solution?

    Updated: To correctly handle a null list per TimToady's correction below.

    sub p09{ @_?reduce{$a->[-1][0]eq$b?push@{$a->[-1]},$b:push@{$a},[$b];$a;}[[shif +t]],@_:() }

    which could almost certainly be golfed further, but for the queasy, expands out to a relatively clean:

    use List::Util qw[ reduce ]; sub p09 { @_ ? reduce{ $a->[-1][0] eq $b ? push @{ $a->[ -1 ] }, $b : push @{ $a }, [ $b ]; $a; } [[shift]], @_ :() }

    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
      Minor quibble: that would appear to generate a different result when you feed it the null list.

        Good catch++. Updated.


        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://590113]
Approved by Joost
Front-paged by madbombX
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others scrutinizing the Monastery: (6)
As of 2014-09-18 10:22 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (111 votes), past polls