"Can this be streamlined any more?"
Short answer: certainly. Longer answer: read on ...
Firstly, two things you should stop doing:
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:
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
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |