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


Here is what I start with:
Less than $10,000
$10,000 to less than $20,000
$20,000 to less than $30,000
$30,000 to less than $40,000
$40,000 to less than $50,000
$50,000 to less than $60,000
$60,000 to less than $70,000
$70,000 to less than $80,000
$80,000 to less than $90,000
$90,000 to less than $100,000
$100,000 to less than $125,000
$125,000 to less than $150,000
$150,000 or higher

I can get close to what I need... this is what I CAN GET:
(10) Less than $10,000 ;fac=10
(15) $10,000 to less than $20,000 ;fac=15
(25) $20,000 to less than $30,000 ;fac=25
(35) $30,000 to less than $40,000 ;fac=35
(45) $40,000 to less than $50,000 ;fac=45
(55) $50,000 to less than $60,000 ;fac=55
(65) $60,000 to less than $70,000 ;fac=65
(75) $70,000 to less than $80,000 ;fac=75
(85) $80,000 to less than $90,000 ;fac=85
(95) $90,000 to less than $100,000 ;fac=95
(112.5) $100,000 to less than $125,000 ;fac=112.5
(137.5) $125,000 to less than $150,000 ;fac=137.5
(150) $150,000 or higher ;fac=150

This is what I NEED:... I need to pad the beginning numbers to the widest length of the determined midpoint AND if there's a decimal, I need to make them ALL decimals, right justified.
( 10.0) Less than $10,000 ;fac=10
( 15.0) $10,000 to less than $20,000 ;fac=15
( 25.0) $20,000 to less than $30,000 ;fac=25
( 35.0) $30,000 to less than $40,000 ;fac=35
( 45.0) $40,000 to less than $50,000 ;fac=45
( 55.0) $50,000 to less than $60,000 ;fac=55
( 65.0) $60,000 to less than $70,000 ;fac=65
( 75.0) $70,000 to less than $80,000 ;fac=75
( 85.0) $80,000 to less than $90,000 ;fac=85
( 95.0) $90,000 to less than $100,000 ;fac=95
(112.5) $100,000 to less than $125,000 ;fac=112.5
(137.5) $125,000 to less than $150,000 ;fac=137.5
(150.0) $150,000 or higher ;fac=150

I am calling the code (named cfacr) while in the file, and can not have it be an external file. It's called while in the vi editor:
:1,13 ! cfacr

I'm getting stuck on how I can determine the number of leading spaces and the decimal placement since that has to be determined AFTER the perl script runs.
Any suggestions?

Replies are listed 'Best First'.
Re: Info based on total changes
by ww (Archbishop) on Jun 20, 2012 at 18:22 UTC
    As posted, /me wants to know what is the Perl nexus? You seem to be saying you have a vi question since the perl script ( cfacr.pl ? )is done before you can work out the spacing: is that true, or would you like to post some code that shows why this is a SOPW question?

    Update for clarity and order: Maybe you should re-write the "script" to count digits in your dollar amounts, if they're available to you in the form you show. </update>

    OTOH, and w_a_a_ a _ y out in a WAG: have you considered such operators as reverse which might be useful to bring you to largest $number first, after which spacing and decimal alignment is, at least, possible.

    Alternately, tell us where the "fac" values come from. Your sample data suggests they are nothing more or less than shortened forms of your $. That suggests, to /me, that you might count the digits before the decimal (or missing decimal) to determine you alignment needs. and if the fac values come from some representation of the $numbers, work the problem from the $numbers.

    Or, perhaps working on clarity of exposition (and precision and completeness) might suggest other ways to do business.

      the numbers in parenthesis are the midpoint (if 2 numbers are present in the string). The fac= is a duplicate of that midpoint. If there's only 1 number in the string, then that one number is used for both the number in parenthesis as well as the fac= number.
      while (<>) { chop; if ($_ =~/(.*)/) { $string = $1; $string =~ s/,000//g; $string =~ s/,//g; @numbers= $string =~ /(\d+)/g; $f= $numbers[0]; $s= $numbers[1]; $isf9 = substr($f,-3); if ($isf9 =~/999/) {$f=$f + 1;} $iss9 = substr($s,-3); if ($iss9 =~/999/) {$s=$s + 1;} $f =~ s/000//g; $s =~ s/000//g; #print join (" ",@numbers); if ($f>0 && $s>0){ $fac = (($s-$f)/2)+$f;} if ($f>0 && $s<1){ $fac = $f;} if ($fac>0) { $_ =~ s/^/($fac) /; $_ =~ s/$/;fac=$fac/; } } print "$_\n"; }
        1. I missed the significance of the $fac value. my bad!
        2. You told us you "start with" the $fac values. Now you show that's not the case. Your bad!
        3. Since you are calculating that, you have all the data points needed to solve your alignment problem.
        4. chop does NOT do what you appear to think it does. See the docs for chop and chomp, the latter of which more reliably removes a trailing newline (as opposed to discards the final entity on a line).
        5. The regex matches in your initial test, above, if ($_ =~/(.*)/) {...}? matches anything or nothing (ie, is useless or 'ALWAYS true-for-any-non-blank-line'): the dot means any character (alpha, digit, punct, or whitespace (except \n and the * quantifier means "none" or "any-quant-more-than-none" (see perlre).
        6. Var names such as $f, $s may be 'meaningful' to you, today... but they're apt to give grief, agitta and annoyance to some future you - or to the homicidal maniac who knows where you live and who may have to take over maintenance someday. Name vars with names or obvious and unambiguous abbreviations. They'll save you g,a and a.

        So, bottom line, I'm not giving you the code to solve your alignment problem; you'll learn more by solving that yourself, with the info you now have in hand, than by getting an algorithm spelled out or by copying code. But before you tackle that one, read the cited regex doc, and probably the tuts here. (Yes, they're directly relevant to one approach.)

Re: Info based on total changes
by Anonymous Monk on Jun 26, 2012 at 00:39 UTC
    This worked with the sample data. It uses strict and warnings. There are 5 additional lines and changes to 4 lines. Otherwise, the code is the same as yours. Not saying there may be better ways.  :-)
    #!/usr/bin/perl use strict; use warnings; my @data; # new addition my $max = 0; # new addition while (<DATA>) { chomp; # new change next unless /\S/; # new change my $string = $_; # new change $string =~ s/,000//g; $string =~ s/,//g; my @numbers= $string =~ /(\d+)/g; my $f= $numbers[0]; my $s= $numbers[1] || 0; # new change my $isf9 = substr($f,-3); if ($isf9 =~/999/) {$f=$f + 1;} my $iss9 = substr($s,-3); if ($iss9 =~/999/) {$s=$s + 1;} $f =~ s/000//g; $s =~ s/000//g; my $fac; if ($f>0 && $s>0){ $fac = (($s-$f)/2)+$f;} if ($f>0 && $s<1){ $fac = $f;} if ($fac>0) { my $length = length($fac); # new addition $max = $length if $length > $max; # new addition $_ =~ s/^/($fac) /; $_ =~ s/$/;fac=$fac/; } push @data, $_; } # new addition print map {s/\((.+?)\)/ sprintf "(%$max.1f)", $1/e; "$_\n"} @data; __DATA__ Less than $10,000 $10,000 to less than $20,000 $20,000 to less than $30,000 $30,000 to less than $40,000 $40,000 to less than $50,000 $50,000 to less than $60,000 $60,000 to less than $70,000 $70,000 to less than $80,000 $80,000 to less than $90,000 $90,000 to less than $100,000 $100,000 to less than $125,000 $125,000 to less than $150,000 $150,000 or higher