Beefy Boxes and Bandwidth Generously Provided by pair Networks Bob
Do you know where your variables are?
 
PerlMonks  

Humanized lists of numbers

by gryphon (Abbot)
on Jun 23, 2001 at 01:17 UTC ( #90870=perlquestion: print w/ replies, xml ) Need Help??
gryphon has asked for the wisdom of the Perl Monks concerning the following question:

Greetings all,

In working with a series of numbers representing page numbers of a manual, I found that I prefered to read something like, "1-3, 5, 7-9, 11" instead of "1, 2, 3, 5, 7, 8, 9, 11" most of the time. So I immediately set out to make a Perl-thing to do just that. However, as most things I write, the first version works, but isn't the most efficient code around:

use strict; my @array = (1, 2, 3, 5, 7, 8, 9, 11, 14); my @new_array; # If it works: @new_array = ('1-3', 5, '7-9', 11, 14); my $x = 0; my $y = 0; while ($x <= $#array) { $new_array[$y] = $array[$x]; if ($array[$x] + 1 == $array[$x+1]) { while ($array[$x] + 1 == $array[$x+1]) { $x++ } $new_array[$y] .= "-$array[$x]"; } $x++; $y++; } print join(', ', @new_array), "\n";

As far as I've tested this, it seems to work. However, I'd like it to be better in two very important ways. First, there's got to be a simpler, faster way to do this. Second, is there an easy way to handle letters? For example, the "A, C-F, L..." sort of thing. Thanks in advance for your help.

-gryphon

Comment on Humanized lists of numbers
Download Code
Re: Humanized lists of numbers
by japhy (Canon) on Jun 23, 2001 at 01:32 UTC
Re: Humanized lists of numbers
by gryphon (Abbot) on Jun 23, 2001 at 01:40 UTC

    After some thought, I'd like to modify the if to this:

    if (($array[$x] + 1 == $array[$x+1]) && ($array[$x] + 2 == $array[$x+2])) {

    That way you don't end up with display-length sub-lists like "1-2, 4-5" in lists. Again, I'm sure there's a better way, but...

Re: Humanized lists of numbers
by clintp (Curate) on Jun 23, 2001 at 06:54 UTC
    May not be better, faster or stronger. Just a different way to do it. Works w/numbers, letters, and -- as an added bonus -- with strings like aa, ab, ac, ad, af reduced to "aa-ad,af".
    sub human { my %h; @h{@_}=@_; $_=join(',',map { $h{$_}?$_:"*" } $_[0]..$_[-1]); s/(\w+),(\w+,)*(\w+)/$1-$3/g; s/,(\*,)+/,/g; split(","); }
    I'm sure this can be golfed quite a bit, but I'm tired.
Re: Humanized lists of numbers
by bikeNomad (Priest) on Jun 23, 2001 at 07:29 UTC
    Another solution that works with letter ranges as well, without using any regexes:

    #!/usr/bin/perl -w use strict; sub human { my (@r, $g, $s, $l); while (@_) { $l = $g = $s = shift; $l = shift while (++$g eq ($_[0] || '')); push(@r, $s eq $l ? $s : "$s-$l"); } @r; } print join(", ", human(1..12, 14..21, 'aa'..'af', 'zz'..'aaf')), "\n"; print join(", ", human(1, 2, 3, 5, 7, 8, 9, 11, 14)), "\n";

    Output is:

    1-12, 14-21, aa-af, zz-aaf 1-3, 5, 7-9, 11, 14

    update: made work with solo items (thanks CharlesClarkson!)

      That's not working for the original list: print join(", ", human(1, 2, 3, 5, 7, 8, 9, 11, 14)), "\n";
      prints:1-3, 5-3, 7-9, 11-9, 14-9

Re: Humanized lists of numbers
by CharlesClarkson (Curate) on Jun 24, 2001 at 23:18 UTC

    Perhaps I have too much time on my hands. This sub allows you to change the separators and handles mixed letters and numbers, 0 and negative numbers. Can be called in scalar or list context.

    #!/usr/bin/perl use strict; use warnings; sub human { # range separator defaults to '-' my $range_separator = '-'; # last item separator defaults '' my $last_item_separator = ''; # list separator for scalar context my $list_separator = ', '; if (ref $_[0] eq 'ARRAY') { my $format = shift; $range_separator = $$format[0] if $$format[0]; $last_item_separator = $$format[1] if $$format[1]; $list_separator = $$format[2] if $$format[2]; } # get list; my @array = @_; # load first range my @range = ($array[0], $array[0]); shift @array; # the human readable array my @human; # last item is a dummy, should be less than $array[-1] foreach my $to (@array, $range[0]) { # use autoincrement to get next item my $next = $range[1]; $next++; if ($next eq $to) { # increase range $range[1]++; next; } # use autoincrement to get next item (for testing below) $next = $range[0]; $next++; # add current range to human readable array push @human, $range[1] eq $range[0] ? $range[0] : $range[1] eq $next ? @range : "$range[0]$range_separator$range +[1]"; # load next range @range = ($to, $to); } unless ($last_item_separator eq '') { my $last_item = pop @human; push @human, "$last_item_separator$last_item"; } return wantarray ? @human : join $list_separator, @human; } my @array = (1, 2, 3, 5, 7, 8, 9, 11, 14); print 'Read chapters: ', scalar human(@array), " before friday.\n"; print "Read these chapters by friday:\n", scalar human([' through ', ' +and ', "\n"], @array), "\n\n"; print 'Read pages: ', (join ', ', human(@array)), ".\n\n"; print join(', ', human(0, 2 .. 4, 6, 7, 9, 11 .. 14, 17 .. 19)), "\n"; print join(', ', human(1 .. 19)), "\n"; print scalar human(1 .. 19), "\n\n"; print "Mixed:\n"; @array = (0, 2 .. 4, 6, 7, 9, 'A' .. 'F', 11 .. 14, 'G', 17 .. 20); print join(', ', human([' to '], @array)), "\n"; print scalar human(['-', '& '], @array), "\n\n"; print join(', ', human('aa' .. 'ba', -100 .. 4)), "\n"; print scalar human([' - ', undef, ' and '], 'aa' .. 'ba', '-100' .. 4) +, "\n\n"; __END__
    prints:
    Read chapters: 1-3, 5, 7-9, 11, 14 before friday. Read these chapters by friday: 1 through 3 5 7 through 9 11 and 14 Read pages: 1-3, 5, 7-9, 11, 14. 0, 2-4, 6, 7, 9, 11-14, 17-19 1-19 1-19 Mixed: 0, 2 to 4, 6, 7, 9, A to F, 11 to 14, G, 17 to 20 0, 2-4, 6, 7, 9, A-F, 11-14, G, & 17-20 aa-ba, -100-4 aa - ba and -100 - 4

    HTH,
    Charles K. Clarkson

    Yep, way too much time

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (14)
As of 2014-04-23 11:07 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (541 votes), past polls