Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

Trying to streamline repetitive code....

by fiddler42 (Beadle)
on Oct 29, 2009 at 01:10 UTC ( #803848=perlquestion: print w/replies, xml ) Need Help??

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

Kind Folk,

I am trying to clean up some very bloated code, and the section below is repeated in 7 other locations, but the only difference from one section to the next is the M8 pattern. So in another section, for example, all references to M8 are replaced with M7. And in another section all references to M8 are replaced with M6, and so on.

In the end, I would like this one section of code to be able to sweep through M1, M2, M3, M4, M5, M6, M7, and M8, but I really don't want to put a variable name in a variable name because, well, according to other postings that would make me an idiot.

So what is the most efficient way to exercise this code with the said M1, M2, etc. patterns in the variable names?

Any suggestions would be much appreciated!

Regards,

-Fiddler42

##### Start metal8 section... @M8TrackSummary = split (/\s+/,$M8TrackLocations); $M8GCellWidth = $M8TrackSummary[$#M8TrackSummary] - $M8TrackSummary[0] +; if (($M8StrapLocations[1] =~ /^0$/) && ($M8StrapWidths[1] =~ /^0$/)) { for ($y = $M8TrackSummary[0]; $y <= $NewBlockUY; $y = $y + $M8GCel +lWidth) { for ($m = 1; $m <= $#M8TrackSummary; $m++) { $M8CurrentTrackLoc = sprintf ("%0.3f", $M8TrackSummary[$m] + + $y); push (@AvailableM8TrackLocations, $M8CurrentTrackLoc); } } $NumAvailableM8Tracks = @AvailableM8TrackLocations; } else { $M8StrapSeries1Width = $M8StrapWidths[1]; @M8StrapSeries1Summary = split (/\s+/,$M8StrapLocations[1]); $M8StrapSeries1StartY = $M8StrapSeries1Summary[0]; $M8StrapSeries1PitchY = $M8StrapSeries1Summary[1]; $M8StrapSeries1StepY = $M8StrapSeries1Summary[2]; for ($y = $M8TrackSummary[0]; $y <= $NewBlockUY; $y = $y + $M8GCel +lWidth) { for ($m = 1; $m <= $#M8TrackSummary; $m++) { $M8CurrentTrackLoc = sprintf ("%0.3f", $M8TrackSummary[$m] + + $y); $NumM8Tracks++; for ($M8StrapSeries1Y = $M8StrapSeries1StartY; $M8StrapSer +ies1Y <= $NewBlockUY; $M8StrapSeries1Y = $M8StrapSeries1Y + $M8StrapS +eries1StepY) { if (($M8CurrentTrackLoc >= ($M8StrapSeries1Y - ($M8Str +apSeries1Width/2) - $M8Pitch)) && ($M8CurrentTrackLoc <= ($M8StrapSer +ies1Y + ($M8StrapSeries1Width/2) + $M8Pitch))) {push (@UnavailableM8T +rackLocations, $M8CurrentTrackLoc);} if (($M8CurrentTrackLoc >= ($M8StrapSeries1Y - ($M8Str +apSeries1Width/2) - $M8Pitch + $M8StrapSeries1PitchY)) && ($M8Current +TrackLoc <= ($M8StrapSeries1Y + ($M8StrapSeries1Width/2) + $M8Pitch + + $M8StrapSeries1PitchY))) {push (@UnavailableM8TrackLocations, $M8Cur +rentTrackLoc);} } } } $NumUnavailableM8Tracks = @UnavailableM8TrackLocations; $NumAvailableM8Tracks = $NumM8Tracks - $NumUnavailableM8Tracks; if ($NumUnavailableM8Tracks == 1) { print ("1 M8 track is blocked by a p/g strap.\n"); } elsif ($NumUnavailableM8Tracks > 1) { print ("$NumUnavailableM8Tracks M8 tracks are blocked by M8 p/ +g straps.\n"); } print ("$NumAvailableM8Tracks M8 tracks are available for M8 pin s +napping.\n"); for ($y = $M8TrackSummary[0]; $y <= $NewBlockUY; $y = $y + $M8GCel +lWidth) { for ($m = 1; $m <= $#M8TrackSummary; $m++) { $M8CurrentTrackLoc = sprintf ("%0.3f", $M8TrackSummary[$m] + + $y); $SkipM8Track = 0; foreach $UnavailableM8Track (@UnavailableM8TrackLocations) + { if ($M8CurrentTrackLoc == $UnavailableM8Track) { $SkipM8Track = 1; last; } } if ($SkipM8Track == 0) {push (@AvailableM8TrackLocations, +$M8CurrentTrackLoc);} } } } my @M8PinContentSorted = sort { $M8PinContentHash{$a} <=> $M8PinConten +tHash{$b} } keys %M8PinContentHash; $NumM8Pins = @M8PinContentSorted; if ($NumM8Pins == 0) { print ("No pins on layer M8.\n"); } elsif ($NumM8Pins == 1) { print ("1 pin on layer M8.\n"); if ($NumM8Pins > $NumAvailableM8Tracks) {die ("There are more M8 p +ins than available M8 tracks!\n");} } elsif ($NumM8Pins > 1) { print ("$NumM8Pins pins on layer M8.\n"); if ($NumM8Pins > $NumAvailableM8Tracks) {die ("There are more M8 p +ins than available M8 tracks!\n");} } if ($DebugMode == 1) { foreach $Entry (@M8PinContentSorted) { @EntryAL = split (/\s+/,$Entry); $PinName = $EntryAL[0]; print DEBUG ("$PinName\n"); } } foreach $M8Pin (@M8PinContentSorted) { @M8PinDetails = split (/\s+/,$M8Pin); $M8PinName = $M8PinDetails[0]; $M8OwnerPort = $M8PinDetails[1]; $M8LayerName = $M8PinDetails[2]; $M8LX = $M8PinDetails[3]; $M8LY = $M8PinDetails[4]; $M8UX = $M8PinDetails[5]; $M8UY = $M8PinDetails[6]; $M8Width = abs ($M8UY - $M8LY); #$M8Height = abs ($M8UX - $M8LX); $M8AccessDirection = $M8PinDetails[7]; $M8Direction = $M8PinDetails[8]; $c = 0; foreach $M8Track (@AvailableM8TrackLocations) { if ($M8Track >= $M8LY) { $M8Intervals = int ($M8Width/$M8Pitch); if ($M8Intervals < 1) { $NewM8LY = sprintf ("%0.3f", $M8Track - ($M8Width/2)); $NewM8UY = sprintf ("%0.3f", $M8Track + ($M8Width/2)); splice (@AvailableM8TrackLocations, $c, 1); } else { $M8SpliceWidth = $M8Intervals + 2; splice (@AvailableM8TrackLocations, $c, $M8SpliceWidth +); if (exists $AvailableM8TrackLocations[$c]) { $NewM8LY = sprintf ("%0.3f", $AvailableM8TrackLoca +tions[$c] - ($M8Width/2)); $NewM8UY = sprintf ("%0.3f", $AvailableM8TrackLoca +tions[$c] + ($M8Width/2)); } else { print ("ERROR: Problem processing pin $M8PinName!\ +n"); } } print OUT ("create_terminal \\\n"); print OUT ("-name {$M8PinName} \\\n"); print OUT ("-port $M8OwnerPort \\\n"); print OUT ("-layer $M8LayerName \\\n"); print OUT ("-bounding_box {{$M8LX $NewM8LY} {$M8UX $NewM8U +Y}}\n\n"); print OUT ("set obj [get_terminal {\"$M8PinName\"}]\n"); print OUT ("set_attribute -quiet \$obj layer $M8LayerName +\n"); print OUT ("set_attribute -quiet \$obj owner_port $M8Owne +rPort\n"); print OUT ("set_attribute -quiet \$obj bbox {{$M8LX $NewM8 +LY} {$M8UX $NewM8UY}}\n"); print OUT ("set_attribute -quiet \$obj status Placed\n"); print OUT ("set_attribute -quiet \$obj access_direction $M +8AccessDirection\n"); print OUT ("set_attribute -quiet \$obj direction $M8Direct +ion\n"); print OUT ("set_attribute -quiet \$obj eeq_class 0\n\n"); last; } $c++; } } ##### End metal8 section...

Replies are listed 'Best First'.
Re: Trying to streamline repetitive code....
by kyle (Abbot) on Oct 29, 2009 at 03:26 UTC

    That's quite a Wall of Text. I'm guessing this doesn't run under strict.

    Anyway, I wrote this just for fun:

    use strict; use warnings; use 5.010; my $m8 = m8_text(); eval "no strict;sub { $m8 }"; die $@ if $@; for ($m8) { s{(\@|\$\#)(?!M8PinContentSorted)(\w*M8\w+)}{${1}{\$M->{$2}}}g; s{\$(?!M8PinContentSorted)(\w*M8\w+)\[}{\${\$M->{$1}}\[}g; s{(?<!foreach )\$(?!M8PinContentSorted)(\w*M8\w+)}{\$M->{$1}}g; } eval "no strict;sub { $m8 }"; die $@ if $@; say $m8;

    The m8_text() sub returns the text from your node verbatim. I do a few replacements on it, and I confirm before and after that it compiles with eval.

    So you can paste the results into a sub like this:

    sub node_803848 { my ( $M, $name ) = @_; # wall of text }

    Call the sub like node_803848( $big_m{$name}, $name ) with $name set to "M8", for example.

    At that point, you need %big_m to have a hash ref for each of your M1–M8, and each of those hashes has an entry for each *M8* variable in the original. There appear to be no hashes in there, so it's all scalars and arrays that you could initialize like so:

    my %big_m; $big_m{M8}{M8TrackSummary} = []; # array ref $big_m{M8}{M8CurrentTrackLoc} = undef;

    Of course, I haven't tried to run this, but if it works, the result could run under strict with a few more changes. Each use of foreach needs a my. There are places where "M8" appears in string literals, and that needs to be $name.

    If I had this in front of me, I'd be strongly tempted to rewrite it all, but I don't have time for that here and now. Instead, I wrote the cheap and evil solution you see above. I don't actually recommend it, but it might get you started.

    Good luck.

Re: Trying to streamline repetitive code....
by roboticus (Chancellor) on Oct 29, 2009 at 12:06 UTC
    fiddler42:

    In a recent node (Re: Uploading pictures - displays only 2 of 12) I helped someone factor a chunk of code with the same problem.

    In the end, I would like this one section of code to be able to sweep through M1, M2, M3, M4, M5, M6, M7, and M8, but I really don't want to put a variable name in a variable name because, well, according to other postings that would make me an idiot.

    You're obviously not an idiot, as you know enough to ask the question! Using a hash is the better way to change the variable you use between iterations of code. It's a little tricky to fix it in one shot, so first run your program to get a "reference output" and save the output to a file. Then, after making each change, you can verify that the code still works by running again with the same parameters and checking the output with diff.

    I think the first thing you want is to figure out what variable you want to use to sweep through your M1..M8 variables. For this post, I'm going to use $Mx. Then I'd change all variable names in the form $M8foo to $foo{$Mx} and declare the appropriate hashes, e.g. %foo. Do the same thing for the arrays & such. Assuming you're using warnings and strict, you can then fix the syntax errors that crop up. Once you get that section working, you can comment out the M1..M7 chunks, and surround the former M8 section with:

    for $Mx qw(M1 M2 M3 M4 M5 M6 M7 M8) { ... $PinName{$Mx} = ...; $LayerName{$Mx} = ...; ... }

    There are further simplifications you can make. Most (all?) of the variables containing M8 could be subkeys of a common hash, say %Tracks (or whatever name would have the most meaning in your application). Thus $M8PinName becomes $Tracks{$Mx}{PinName}, $NewM8UY becomes $Tracks{$Mx}{NewUY}, etc.

    After doing that, then you'll find that $Tracks{$Mx} could be a bit repetitious, so you could modify your outer loop to something like:

    for $Mx qw(M1 M2 M3 M4 M5 M6 M7 M8) { my $cur = $Tracks{$Mx}; ... $$cur{PinName} = ...; $$cur{LayerName} = ...; ... }

    Take it a bit at a time, and it should clean up nicely. Let us know what you simplify it to, and we can make further suggestions.

    ...roboticus

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://803848]
Approved by GrandFather
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others scrutinizing the Monastery: (3)
As of 2021-05-06 03:50 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Perl 7 will be out ...





    Results (69 votes). Check out past polls.

    Notices?