Not strictly speaking a one-liner, but Set::IntSpan can produce this kind of output.

Update: And just for grins . . .

#!/usr/local/bin/runhaskell
import Data.List (sort)

a = [45,30,28,27,20,1,2,3,4,29]
sa = sort a

span :: (Num a, Ord a) => [a]-> String
span [] = ""
span xs = find_span (sx,sx) sxs ""
  where
    (sx:sxs) = sort xs -- ensure list is sorted

    show_pair (low,high) | low == high = show low
    show_pair (low,high) | otherwise   = (show low) ++ "-" ++ (show hi
+gh)

    find_span state             []     acc               = (acc ++ sho
+w_pair state)
    find_span state@(low, high) (x:xs) acc | x == high+1 = find_span (
+low,x) xs acc
    find_span state@(low, high) (x:xs) acc | x >  high   = find_span (
+x,x) xs (acc ++ (show_pair state) ++ ",")
[download]

That is super sweet. It does boil down to essentially a one-liner.

#!/usr/bin/perl

use strict;
use warnings;
use Set::IntSpan;

my @list = (1, 2, 3, 6, 9, 10, 13, 22, 20, 19, 15, 21);

my $rl = Set::IntSpan->new( \@list )->run_list();
print "$rl\n";
[download]

I don't know if you consider this an improved version, it is at least a bit different:

my ($min,$max,@newlist);
@list = sort { $a <=> $b } @list;
$min=$max=shift @list;
while (@list) {
  $_= shift @list;
  if (not $_ == ++$max) {
    --$max;
    push @newlist, "$min-$max";
    $min=$max=$_;
  }
}
push @newlist, "$min-$_" if (defined $_);
print join(',',map {s/(\d+)-\1/$1/} @newlist);
[download]

UDPATE: Corrected two bugs, a missing '=' and it didn't print the last value or range.

++! I was kicking myself in the head trying to get some sort of regex | s/// based thing to work. I didn't want to cheat and look at the codegolf page...

Just a something something...

You might like:

use strict;
use warnings;

my @list = sort {$a <=> $b} (1, 2, 3, 6, 9, 10, 13, 22, 20, 19, 15, 21
+);
printf "%s\n", join ",", @list;

my @newList;
my $runLen = 0;

for my $elt (@list, '') {
    if (! $runLen) {
        push @newList, $elt;
        $runLen = 1;
        next;
    }

    if ($elt eq '' || $runLen + $newList[-1] != $elt) {
        push @newList, "-", $runLen + $newList[-1] - 1 if $runLen != 1
+;
        push @newList, ',', $elt if $elt ne '';
        $runLen = 1;
    } else {
        ++$runLen
    }
}

print @newList, "\n";
[download]

Prints:

1,2,3,6,9,10,13,15,19,20,21,22
1-3,6,9-10,13,15,19-22
[download]

I did not want to use neither min nor max, I just used reduce :)

So, please excuse my lengthy and bloated 13-line solution to this problem:

use List::AllUtils qw/reduce/;
my @list = sort {$a <=> $b} (1, 2, 3, 6, 9, 10, 13, 22, 20, 19, 15, 21
+);
print reduce {
    if(my ($sign,$last) = $a =~ /([,-]?)(\d+)$/){
        if( $last+1 == $b ) {
            $a =~ s/[,-]?\d+$// if($sign eq '-');
            $a.= "-$b";
        } else {
            $a.=",$b";
        };
    };
    $a;
}@list;
[download]

The advantage of using reduce is that it allows you to look behind and see what you did before (for example,see the previous number you appended to the string).

The if conditions asks if the number is the next consecutive one so it can replace the high bound of the interval with a newer one,if not it just adds the new number to the list with comma separator.

sub collapse_seq {
    return () if !@_;

    my @list = sort { $a <=> $b } @_;
    my @seqs = [ (shift(@list)) x 2 ];

    for ( @list ) {
        if ($seqs[-1][1] + 1 == $_ ) {
            $seqs[-1][1] = $_;
        } else {
            push @seqs, [ $_, $_ ];
        }
    }

    return
        map { $_->[0] == $_->[1] ? $->[0] : "$->[0]-$->[1]" }
        @seqs;
}
[download]

Anyway, few hints:

• when sorting, don't add standard sorting method ({ $a <=> $b }), just sort @list will suffice
• why are you sorting already sorted list?
• you don't really need printf in your case, simple print will be better
• for instead of foreach (4 letters shorter solution)
• don't waste letters for use strict or use warning or my ...

sort uses cmp, not <=> (the spaceship operator) by default. Consider:

my @list = (1, 2, 3, 6, 9, 10, 13, 22, 20, 19, 15, 21);

printf "<=>: %s\n", join ",", sort { $a <=> $b } @list;
printf "cmp: %s\n", join ",", sort { $a cmp $b } @list;
printf "   : %s\n", join ",", sort @list;
[download]

Prints:

<=>: 1,2,3,6,9,10,13,15,19,20,21,22
cmp: 1,10,13,15,19,2,20,21,22,3,6,9
   : 1,10,13,15,19,2,20,21,22,3,6,9
[download]

printf avoids the need to add a new line to the end of the parameter list after the join. In the OP's code printf seems to me to be more appropriate than print.

Always use strictures (use strict; use warnings; - see The strictures, according to Seuss).

---

True laziness is hard work

Ups, you are right about sorting, corrected. And the rest depends on whether it is really golfing problem (print better) or normal task/job (I would discuss here if really printf is better in place where only new line 'must be achieved'. I prefer print with -l switch, but then of course the loop must be rewriten. And if it is perl 5.10, then we can even advice perlfunc-> say() without rewriting loop)

not ugly != golf

Cool didn't know about this challenge, to bad the examples are not available for viewing that would have given me an endless number of solutions.

In 1993, I wrote some code to parse a C header file with a bunch of numerical token values in #define statements. Then print them out in this series manner, in order to find holes and duplicates. Amazingly, I was able to dig that code up and adapt it for this problem.

Ignore my overuse of printf and the unused flag to turn on hex vs decimal printing. This reflects some of my earliest perl coding, and it's pretty obvious that I'm a C programmer by trade.

#!/usr/bin/perl

use strict;
use warnings;
use diagnostics;
use List::Util qw(min);

my $opt_x = 0;  # Original code allows hex or decimal

my @list = (1, 2, 3, 6, 9, 10, 13, 22, 20, 19, 15, 21);

my %Count;
$Count{$_}++ foreach @list;

my $number;

foreach $number (sort numerically keys(%Count))
{
    my $count = $Count{$number};

    if ($count > 1)
    {
        printf "Token value %d occurs %d times.\n",
                $number, $count if (!$opt_x);
        printf "Token value 0x%x occurs %d times.\n",
                $number, $count if ( $opt_x);
    }
}

# Print a list of the form:
# 100,102,104,108-110,112-115,119

my $expected = min(@list);
my $in_list=0;
my $list_start=0;
my $comma="";

foreach $number (sort numerically keys(%Count))
{
    if (($number == $expected) && ($in_list))
    {
        # Accumulate list
        $in_list++;
    }
    elsif (($number == $expected) && ($in_list == 0))
    {
        $list_start=$number;
        $in_list = 1;
    }
    elsif ($in_list > 1)        # not expected
    {
        printf "%s%d-%d",
                $comma, $list_start, $expected-1
                if (!$opt_x);
        printf "%s0x%x-0x%x",
                $comma, $list_start, $expected-1
                if ( $opt_x);
        $comma = ",";
        $list_start = $number;
        $in_list = 1;
    }
    else        # in_list == 1 and not expected
    {
        printf "%s%d",   $comma, $list_start if (!$opt_x);
        printf "%s0x%x", $comma, $list_start if ( $opt_x);
        $comma = ",";
        $list_start = $number;
        $in_list = 1;
    }

    $expected = $number + 1;
}

if ($in_list > 1)       # Terminate
{
    printf "%s%d-%d",
            $comma, $list_start, $expected-1
            if (!$opt_x);
    printf "%s0x%x-0x%x",
            $comma, $list_start, $expected-1
            if ( $opt_x);
}
elsif ($in_list)
{
    printf "%s%d",   $comma, $list_start if (!$opt_x);
    printf "%s0x%x", $comma, $list_start if ( $opt_x);
}
else
{
    printf "%s%d",   $comma, $number if (!$opt_x);
    printf "%s0x%x", $comma, $number if ( $opt_x);
}
print "\n";


sub numerically { return $a <=> $b; }

exit 0;
[download]

Here's my solution; a golfed, obfuscated subroutine that works even if the input is unsorted or contains duplicates (unlike the apparent input from http://codegolf.com/home-on-the-range, if I'm reading it correctly):

my @numbers = qw( 22 19 8 22 4 2 8 12 5 6 21 23 1 );

print  "Input(@numbers)\n";
printf "Output(%s)\n", numbers_to_ranges(@numbers);

sub numbers_to_ranges {
 map$x[$_]=$_,@_;$_="@x";s@^ +@@;s*(\d+)( (\d+))+*\1-\3*g;s- +-, -g;$_
}

__END__

[Results]
Input(22 19 8 22 4 2 8 12 5 6 21 23 1)
Output(1-2, 4-6, 8, 12, 19, 21-23
[download]

A slightly shorter version

use strict;
use warnings;

my @list = sort {$a <=> $b} (1, 2, 3, 6, 9, 10, 13, 22, 20, 19, 15, 21
+);
printf "%s\n", join(",", @list);

my @newList;
my ($min, $max);
for(@list, undef) {
  if(! defined($min)) { $min = $max = $_; }
  elsif(defined($_) && $_ == ($max + 1)) { $max++ }
  else {
    if($min == $max) { push @newList, ($min, $_) }
    else { push @newList, ("$min-$max", $_) }
    $min = $max = undef;
  }
}
pop @newList;

printf "%s\n", join(",", @newList);
[download]

The prev. didn't work so well for certain ranges

use strict;
use warnings;

my @list = sort {$a <=> $b} (1, 2, 3, 5, 9, 10, 13, 22, 20, 19, 15, 21
+, 33);
printf "%s\n", join(",", @list);

my @newList;
my $min = my $max = shift @list;
for(@list, -1) {
  if($_ == ($max + 1)) { $max++ }
  else {
    if($min == $max) { push @newList, $min }
    else { push @newList, "$min-$max" }
    $min = $max = $_;
  }
}

printf "%s\n", join(",", @newList);
[download]

Number::Range will do approximately what you want, you'll just need to reformat the results a bit:

$ perl -MNumber::Range -e '
  $r = Number::Range->new(5, 1..4, 7..10);
  print scalar($r->range())
'
1..5,7..10
[download]

$_ = join ',', sort{$a<=>$b}
  (1, 2, 3, 6, 9, 10, 13, 22, 20, 19, 15, 21);
s/((\d+),)/$2 + 1 == $' ? "$2-" : $1/ge; s/(\d+-)[-\d]+-(\d+)/$1$2/g;
$_; # the answer
[download]

Why did you post anonymously ? Maybe you would find this interesting. Especially the 10th paragraph.

$_ = join ",", sort {$a <=> $b} 1, 2, 3, 6, 9, 10, 13, 22, 20, 19, 15,
+ 21;
1 while s/(-?)(\b[0-9]+),([0-9]+\b)(?(?{$3==1+$2})|(*FAIL))/$1?"-$3":"
+$2-$3"/e;
say;
[download]