We don't bite newbies here... much PerlMonks

### Humanized lists of numbers

by gryphon (Abbot)
 on Jun 23, 2001 at 01:17 UTC 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.

Replies are listed 'Best First'.
Re: Humanized lists of numbers
by japhy (Canon) on Jun 23, 2001 at 01:32 UTC
I wrote a regex for Perl 5.6 that does this. It can be modified easily for letters:
```sub list2range {
local \$_ = join ',' => @_;
s/(\w+)(?:,((??{''.++(my\$x=\$+)})))+/\$1-\$+/g;
return \$_;
}

japhy -- Perl and Regex Hacker
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 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 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 = @_;

my @range = (\$array[0], \$array[0]);
shift @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++;

push @human,
\$range[1] eq \$range[0]  ?  \$range[0] :
\$range[1] eq \$next      ?  @range    :
"\$range[0]\$range_separator\$range
+[1]";

@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.
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

Create A New User
Node Status?
node history
Node Type: perlquestion [id://90870]
Approved by root
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (5)
As of 2018-06-21 15:01 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
Should cpanminus be part of the standard Perl release?

Results (118 votes). Check out past polls.

Notices?