Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

comment on

( [id://3333] : superdoc . print w/replies, xml ) Need Help??
"Can this be streamlined any more?"

Short answer: certainly. Longer answer: read on ...

Firstly, two things you should stop doing:

  • The syntax for an if statement has no terminal semicolon; an if statement modifier may have a terminal semicolon. So, write "if (CONDITION) BLOCK" or "... if CONDITION;". The statement may be extended with else and elsif blocks (which don't have terminal semicolons either). See perlsyn for full details.
  • Do not call subroutines with a leading '&' unless you know exactly what it does and why you are doing it. A leading '&' was the normal way to call subroutines in Perl4 (and earlier); it is not normal for Perl5. See perlsub for more on this.

When you find yourself writing $var1, $var2, ..., $varN, you're probably doing something wrong, or at least doing something suboptimal which can be greatly improved: often with arrays or hashes. What happens when you want to add a new language, or discontinue supporting an existing one: as it stands, you'll have to engage in a major rewriting exercise.

Instead of returning arrays from subroutines, consider returning arrayrefs. With 30,000+ rows, each "my @array = &getTableFC(...)" statement is potentially passing a megabyte or more of data; and arrayref is a single, scalar value.

I assume that you're trying to trim leading and trailing whitespace with "s/^\s+|\s+$//". That won't work. There are a variety of ways you could do this; one would be to add a /g modifier:

$ perl -e 'my $x = " X "; $x =~ s/^\s+|\s+$//; print "|$x|";' |X | $ perl -e 'my $x = " X "; $x =~ s/^\s+|\s+$//g; print "|$x|";' |X|

Perl's string handling functions and operators are almost always measurably faster than a regex achieving the same functionality. I see no reason to use any regexes in your code. I'd recommend using index().

I've rewritten your code, taking all of the above into account. First some notes:

  • I've no idea where your base data comes from. Presumably a disk file, a database, or whatever. I've just written a GET_DATA routine to simulate this.
  • I don't know how your users supply queries. I used the one from your OP, and added a second, in @user_tests. I loop through these to simulate multiple queries.
  • I've only used some of your data: "Main", "Comp. 1", and "Comp. 3". I've given them more meaningful names: "ref_lang", "Lang A", and "Lang Q", respectively. This was mainly to show that the code is not bound to any specific number of languages; not wanting to copy-paste all five of your languages was also a factor.
  • I've pared down processComparison() to a bare minimum; even with a couple of helper routines, it's still substantially smaller than the original.
  • The "# For demo" code equates to your "#DO CODE TO FORMAT ...". I didn't know what you wanted here, so I've just output the data.

Here's the code:

#!/usr/bin/env perl use strict; use warnings; sub GET_DATA (); my @user_tests = ( { ref_lang => { match => 1, strings => ['hollow log', 'fence'], +}, 'Lang A' => { match => 1, strings => ['jumped'], }, 'Lang Q' => { match => 0, strings => ['red fox'], }, }, { ref_lang => { match => 1, strings => ['tree', 'fence'], }, 'Lang A' => { match => 1, strings => ['tree', 'doe'], }, 'Lang Q' => { match => 0, strings => ['gray fox'], }, }, ); for my $i (0 .. $#user_tests) { processComparison(GET_DATA, $user_tests[$i], $i); } sub processComparison { my ($data, $test, $index) = @_; my %results; for my $lang (keys %$test) { $results{$lang} = check_match($data->{$lang}, $test->{$lang}); } # For demo use Data::Dump; print "User Test Index $index:\n"; dd $test; print "Results:\n"; dd \%results; print '-' x 60, "\n"; return; } sub check_match { my ($data, $test) = @_; my @results; DATUM: for my $i (0 .. $#$data) { STRING: for my $string (@{$test->{strings}}) { next STRING unless match_ok( $test->{match}, index $data->[$i], $string ); push @results, $i + 1; next DATUM; } } return \@results; } sub match_ok { my ($match, $index) = @_; return $match ? $index > -1 : $index == -1; } sub GET_DATA () { return { ref_lang => [ 'The red fox jumped over the hollow log.', 'The tall tree towered over the animals.', 'The tawny deer jumped over the fence.', ], 'Lang A' => [ 'The vixen jumped over the brown log.', 'The tree swayed smartly in the field.', 'The doe jumped over the barrier.', ], 'Lang Q' => [ 'The gray fox jumped over the big log.', 'The tall tree grew in the field.', 'The red deer cleared the tall fence.', ], }; }

That outputs:

User Test Index 0: { "Lang A" => { match => 1, strings => ["jumped"] }, "Lang Q" => { match => 0, strings => ["red fox"] }, "ref_lang" => { match => 1, strings => ["hollow log", "fence"] }, } Results: { "Lang A" => [1, 3], "Lang Q" => [1, 2, 3], "ref_lang" => [1, 3] } ------------------------------------------------------------ User Test Index 1: { "Lang A" => { match => 1, strings => ["tree", "doe"] }, "Lang Q" => { match => 0, strings => ["gray fox"] }, "ref_lang" => { match => 1, strings => ["tree", "fence"] }, } Results: { "Lang A" => [2, 3], "Lang Q" => [2, 3], "ref_lang" => [2, 3] } ------------------------------------------------------------

I didn't know how "the other columns are merely for comparison purposes" was supposed to work; i.e. in terms of what activities you had in mind. So, you have the data; adapt to your needs.

— Ken


In reply to Re: Efficient regex search on array table by kcott
in thread Efficient regex search on array table by Polyglot

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.