Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Re: TIMTOWTDI

by rkg (Hermit)
on Sep 10, 2003 at 10:52 UTC ( #290366=note: print w/replies, xml ) Need Help??


in reply to Re: Re: Re: LCCS time complexity
in thread LCCS time complexity

Thanks, tachyon.

For my application, I needed maximal runs of identical words between two strings. I'm loose about what comprises a word. For example, for my application "hi-res" is the same as "hires", and punctuation and case don't matter. In the spirit of TIMTOWTDI, here's what I scraped together:

# FRAGMENT my $lcs = lcss(standardize($x1), standardize($x2); sub lcss { my ($str1, $str2 ) = @_; my @match = (); my @longest = (); my $i = 0; my $seq1 = [split(/\s+/, $str1)]; my $seq2 = [split (/\s+/, $str2)]; my $sub = sub { @longest = map {$_} @match if (@match >= @longest); @match = (); }; traverse_sequences( $seq1, $seq2, { MATCH => sub {push(@match, $seq1->[$_[0]]);}, DISCARD_A => $sub, DISCARD_B => $sub, }); my $lcs = join(' ', @longest); return $lcs; } # lowercase and remove odd characters sub standardize { my ($text) = @_; return unless $text; $text =~ s/\[.*?\]/ /g; $text =~ s/[.,?"':&()!-]/ /g; $text =~ s/[^\w ]//g; $text =~ s/^\s+//; $text =~ s/\s+$//; $text =~ s/\s+/ /; $text = lc $text; return $text; }
rkg

Replies are listed 'Best First'.
Re: Re: TIMTOWTDI
by tachyon (Chancellor) on Sep 11, 2003 at 02:29 UTC

    Hi, looking at your REs I have a couple of suggestions:

    $text =~ s/\[.*?\]/ /g; # you can lose the .*? by using [^\]]* which save the RE engine ba +cktracking # $text =~ s/\[[^\]]*\]/ /g; $text =~ s/[.,?"':&()!-]/ /g; $text =~ s/[^\w ]//g; # you need a /m to make this match # here # and here # and here # ie this will only match the very begining of the string $text =~ s/^\s+//; # ditto $text =~ s/\s+$//; $text =~ s/\s+/ /;

    cheers

    tachyon

    s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print

      Thanks for the   $text =~ s/\[[^\]]*\]/ /g; tip; that is better. As for the  /m on these
      $text =~ s/^\s+//; $text =~ s/\s+$//;
      I think I'd put the  /m on the third RE
      $text =~ s/\s+/ /m; #yes?
      so taken together the triple REs mean: "remove leading whitespace, trailing whitespace, and make all interior whitespace (even across line breaks) into single spaces".

      Many thanks for the OT-but-useful teaching!

      rkg

        The /m only modifies the match behaviour of ^ and $ letting them match the begining and end of any line rather than entire string. It has no effect on the final RE which just needs a /g to do all interior whitespace.

        cheers

        tachyon

        s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://290366]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (2)
As of 2023-01-30 03:57 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?