HollyKing has asked for the wisdom of the Perl Monks concerning the following question:

Ok, be gentle, this is my first attempt at a post. I do want to learn so constructive criticism will be gladly accepted, but pointless flames will be suitably ignored. Also, this is a homework question, but I've already turned in the assignment. I'm asking to improve my skills.

First, the assignment. How would you print the first and last word of every line of input? Create a script which does that and a file to test your program on. Define a word as any sequence of \w characters. Note that the first and last word do NOT have to begin and/or end the line. There may be leading or trailing spaces or punctuation marks. These can be indicated by \W. Assume a line has at least 2 words.

So here is what I came up with for the assignment.

#!perl -w
use strict;

while (<>) {
    if (/^\W*(\w+)(\W+\w*\W*)+(\w+)\W+$/) {
    print "$1 $3\n";
    }
}

[download]

Sure, this does what the assignment asked, but I don't like it. I was hoping for some pointers on how to handle matching and ignoring the words and characters inbetween the first and last words.

Owl looked at him, and wondered whether to push him off the tree; but, feeling that he could always do it afterwards, he tried once more to find out what they were talking about.

Replies are listed 'Best First'.
(MeowChow) Re: Matching Words
by MeowChow (Vicar) on May 23, 2002 at 06:15 UTC
    Pick your poison:
      
    perl -pe 's/\W*(\w+).*\W(\w+)\W*/$1 $2/'
perl -ple '/(\w+).*(\b\w+)/;$_="$1 $2"'
perl -ple '$_=join$",/(\w+).*(\b\w+)/'
perl -ple '$_="@{[(/\w+/g)[0,-1]]}"'
perl -ple '$_=join$",(/\w+/g)[0,-1]'
perl -ple '@w=/\w+/g;$_="@w[0,-1]"'
perl -pe '@w=/\w+/g;s/.*/@w[0,-1]/'

# my personal favorite
cat -n|perl -plaF\\W+ -e '$_="@F[2,-1]"'

    [download]
       MeowChow                                   
               s aamecha.s a..a\u$&owag.print
[reply]
[d/l]
(jeffa) Re: Matching Words
by jeffa (Bishop) on May 23, 2002 at 06:26 UTC
    How about: 
    while (<>) {
  s/^\s*//;
  printf("%s %s\n",map{s/\W\B//;s/\B\W//;$_}(split(/\s+/,$_))[0,-1]);
}

    [download]
    UPDATE - had to add line to remove leading space ... tsk tsk

    jeffa

    L-LL-L--L-LL-L--L-LL-L--
-R--R-RR-R--R-RR-R--R-RR
B--B--B--B--B--B--B--B--
H---H---H---H---H---H---
(the triplet paradiddle with high-hat)
[reply]
[d/l]
Re: Matching Words
by Zaxo (Archbishop) on May 23, 2002 at 06:28 UTC

    How about this?

    #!perl -w
use strict;
while (<>) {
    my @words = split /\W+/;
    pop  @words if $words[-1] eq '';
#    pop  @words unless $words[-1];
    shift @words if $words[0] eq '';
#    shift @words unless $words[0];
    print $words[0], ' ', $words[-1], $/;
}

    [download]
    The pop and shift are needed because split leaves empty elements at the ends if nonword characters are there.

    A couple of comments on your code. I think you mean \W*$/ at the right of your regex. Also, you can use a (?:\W+\w*\W*)+ to get grouping without capture.

    Update: I sure like MeowChow's array slice in print:

        print "@words[0,-1]$/";

    [download]

    Update 2: A palpable hit, ++tadman. Corrected.

    After Compline,
    Zaxo

[reply]
[d/l]
[select]
      In:
      0 donuts are in the drawer on the left
      Out:
      donuts left
      If zero were true, then black would be white, and you would likely be killed by a bus when using a zebra crossing. Or so I have heard.

      New riff based on MeowChow's direction:
      perl -ple '$_="@{[/\w+/g]}[0,-1]"'
      Homework, Golf, what's the difference?
[reply]
[d/l]
[select]
        Homework, Golf, what's the difference?

        The teacher's ability to comprehend the answer, I would guess :-)

        ps. nice stroke. 

           MeowChow                                   
               s aamecha.s a..a\u$&owag.print
[reply]

      Ahh, yes it should be \W*$ at the end.

      Owl looked at him, and wondered whether to push him off the tree; but, feeling that he could always do it afterwards, he tried once more to find out what they were talking about.

[reply]

Back to Seekers of Perl Wisdom