From: [EMAIL PROTECTED]
[mailto:[EMAIL PROTECTED] On Behalf Of
[EMAIL PROTECTED]
Sent: 30 August 2006 14:52
To: [email protected]
Subject: A pseudo-switch optimizing puzzler
> Gurus,
>
> I've got a sub that uses a pseudo-switch for "loop" to assign values
to its return variable based on the value > of its passed in arguments.
The sub is called from a loop and each possible value of the selector
variable,
> $row, is guaranteed to be hit once and only once. The values run from
zero through 93.
>
> The puzzle I have is this: do I have the best ordering of the
selections in terms of minimizing the number of
> tests to go through over the life of the calling loop? I did find one
change that decreased the total of tests > by almost 20, and this led me
to pondering whether I could cut the test count even further by some
> rearrangement of the selections. Any suggestions? I've thought of
testthis/testthese, but which such a
> haystack of possible arrangements, that seemed like WAY too much
searching for the (admittedly insignificant)
> needle--not quite worth the candle.
>
> I'm hoping someone's worked with something like this and can share
his/her experience with me.
>
> Here's the code:
>
> sub translate_reg_value
> {
> my ($row, $regval) = @_;
>
> my $out = q{};
>
> for ($row) {
>
/^(?:5|6|19|20|21|22|35|36|37|41|42|43|49|50|53|55|56|57|59|60|65|66|67|
68|69|71|73|83)$/o && do {
> # do something to $out involving $regval
> last;
> };
>
/^(?:11|12|13|14|18|24|28|40|48|51|52|54|61|62|63|64|70|72|78|80|82|84|8
6|87|91|92|93)$/o && do {
> # do something to $out involving $regval
> last;
> };
> /^(?:0|2|7|8|9|23|27)$/o && do {
> # do something to $out involving $regval
> last;
> };
> /^(?:38|39|45|46|47|79|85)$/o && do {
> # do something to $out involving $regval
> last;
> };
> /^(?:29|30|31|32|33|34)$/o && do {
> # do something to $out involving $regval
> last;
> };
> /^(?:74|75|76|77)$/o && do {
> # do something to $out involving $regval
> last;
> };
> /^(?:88|89|90)$/o && do {
> # do something to $out involving $regval
> last;
> };
> /^(?:25|26)$/o && do {
> # do something to $out involving $regval
> last;
> };
> /^(?:1)$/o && do {
> # do something to $out involving $regval
> last;
> };
> /^(?:3)$/o && do {
> # do something to $out involving $regval
> last;
> };
> /^(?:4)$/o && do {
> # do something to $out involving $regval
> last;
> };
> /^(?:10)$/o && do {
> # do something to $out involving $regval
> last;
> };
> /^(?:15)$/o && do {
> # do something to $out involving $regval
> last;
> };
> /^(?:44)$/o && do {
> # do something to $out involving $regval
> last;
> };
> /^(?:58)$/o && do {
> # do something to $out involving $regval
> last;
> };
> /^(?:81)$/o && do {
> # do something to $out involving $regval
> last;
> };
> } # end for ($row)
>
> return( $out );
> }
Its not entirely clear what you mean, especially by "testthis/testthese"
(?), but it sounds a lot like "please help me optimise this code". So,
taking dire warnings against premature optimsation as read....
I don't know about you, but this screams "array lookup" in big neon
letters to me. I which case, your sub looks something like:
sub translate_reg_value {
my ($row, $regval) = @_;
my $dostuff = $dostuffarray[$row];
return $dostuff->($regval) if defined $dostuff;
warn "translate_reg_value: row $row undefined\n";
}
Not many tests there. Of course you have to initialise @dostuffarray,
but then optimisation us often about making trade-offs. But for
completeness, one way to do it, based on cut&paste&edit of your code
might look something like:
my $s1 = sub { return "sub1-$_[0]"; };
my $s2 = sub { return "sub2-$_[0]"; };
my $s3 = sub { return "sub3-$_[0]"; };
my $s4 = sub { return "sub4-$_[0]"; };
my $s5 = sub { return "sub5-$_[0]"; };
my $s6 = sub { return "sub6-$_[0]"; };
my $s7 = sub { return "sub7-$_[0]"; };
my $s8 = sub { return "sub8-$_[0]"; };
my $s9 = sub { return "sub9-$_[0]"; };
my $s10 = sub { return "sub10-$_[0]"; };
my $s11 = sub { return "sub11-$_[0]"; };
my $s12 = sub { return "sub12-$_[0]"; };
my $s13 = sub { return "sub13-$_[0]"; };
my $s14 = sub { return "sub14-$_[0]"; };
my $s15 = sub { return "sub15-$_[0]"; };
my $s16 = sub { return "sub16-$_[0]"; };
my @dostuffarray;
$dostuffarray[$_] = $s1 for
(5,6,19,20..22,35..37,41..43,49,50,53,55..57,59,60,65..69,71,73,83);
$dostuffarray[$_] = $s2 for
(11..14,18,24,28,40,48,51,52,54,61..64,70,72,78,80,82,84,86,87,91..93);
$dostuffarray[$_] = $s3 for (0,2,7,8,9,23,27);
$dostuffarray[$_] = $s4 for (38,39,45,46,47,79,85);
$dostuffarray[$_] = $s5 for (29,30,31,32,33,34);
$dostuffarray[$_] = $s6 for (74,75,76,77);
$dostuffarray[$_] = $s7 for (88,89,90);
$dostuffarray[$_] = $s8 for (25,26);
$dostuffarray[1] = $s9;
$dostuffarray[3] = $s10;
$dostuffarray[4] = $s11;
$dostuffarray[10] = $s12;
$dostuffarray[15] = $s13;
$dostuffarray[44] = $s14;
$dostuffarray[58] = $s15;
$dostuffarray[81] = $s16;
I'll just finish with the first rule of optimisation, which is "Don't do
it yet". Which is followed by the second rule which goes "I said, don't
do it yet".
HTH
--
Brian Raven
=================================
Atos Euronext Market Solutions Disclaimer
=================================
The information contained in this e-mail is confidential and solely for the
intended addressee(s). Unauthorised reproduction, disclosure, modification,
and/or distribution of this email may be unlawful.
If you have received this email in error, please notify the sender immediately
and delete it from your system. The views expressed in this message do not
necessarily reflect those of Atos Euronext Market Solutions.
L'information contenue dans cet e-mail est confidentielle et uniquement
destinee a la (aux) personnes a laquelle (auxquelle(s)) elle est adressee.
Toute copie, publication ou diffusion de cet email est interdite. Si cet e-mail
vous parvient par erreur, nous vous prions de bien vouloir prevenir
l'expediteur immediatement et d'effacer le e-mail et annexes jointes de votre
systeme. Le contenu de ce message electronique ne represente pas necessairement
la position ou le point de vue d'Atos Euronext Market Solutions.
_______________________________________________
ActivePerl mailing list
[email protected]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
