Range extraction

From Rosetta Code
Revision as of 04:03, 8 May 2013 by rosettacode>Paddy3118 (→‎{{header|Python}}: Hopefully strikes a balance between the three replaced versions w.r.t wanting/not wanting if/else expressions and needing access to a non-string version of the ranges and separates the range extraction from its printing.)
Task
Range extraction
You are encouraged to solve this task according to the task description, using any language you may know.

A format for expressing an ordered list of integers is to use a comma separated list of either

  • individual integers
  • Or a range of integers denoted by the starting integer separated from the end integer in the range by a dash, '-'. (The range includes all integers in the interval including both endpoints)
  • The range syntax is to be used only for, and for every range that expands to more than two values.

Example
The list of integers:

-6, -3, -2, -1, 0, 1, 3, 4, 5, 7, 8, 9, 10, 11, 14, 15, 17, 18, 19, 20

Is accurately expressed by the range expression:

-6,-3-1,3-5,7-11,14,15,17-20

(And vice-versa).

The task

  • Create a function that takes a list of integers in increasing order and returns a correctly formatted string in the range format.
  • Use the function to compute and print the range formatted version of the following ordered list of integers:
    0,  1,  2,  4,  6,  7,  8, 11, 12, 14,
   15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
   25, 27, 28, 29, 30, 31, 32, 33, 35, 36,
   37, 38, 39
  • Show the output of your program.

C.f. Range expansion

Ada

The provided solutions return an empty string, if the Sequence of integers is empty. Ranges with negative bounds are represented as -9--4, as the task requires. For real-life applications it is better to use the notation -9..-4.

Iterative Solution

Since we don't know in advance how long the output will be, the iterative solution uses Unbounded_Strings.

<lang Ada>with Ada.Text_IO; use Ada.Text_IO; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with Ada.Strings.Fixed; use Ada.Strings.Fixed;

procedure Range_Extraction is

  type Sequence is array (Positive range <>) of Integer;
  function Image (S : Sequence) return String is
     Result : Unbounded_String;
     From   : Integer;
     procedure Flush (To : Integer) is
     begin
        if Length (Result) > 0 then
           Append (Result, ',');
        end if;
        Append (Result, Trim (Integer'Image (From), Ada.Strings.Left));
        if From < To then
           if From+1 = To then
              Append (Result, ',');
           else
              Append (Result, '-');
           end if;
           Append (Result, Trim (Integer'Image (To), Ada.Strings.Left));
        end if;
     end Flush;
  begin
     if S'Length > 0 then
        From := S (S'First);
        for I in S'First + 1..S'Last loop
           if S (I - 1) + 1 /= S (I) then
              Flush (S (I - 1));
              From := S (I);
           end if;
        end loop;
        Flush (S (S'Last));
     end if;
     return To_String (Result);
  end Image;

begin

  Put_Line
    (  Image
         (  (  0,  1,  2,  4,  6,  7,  8, 11, 12, 14,
               15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
               25, 27, 28, 29, 30, 31, 32, 33, 35, 36,
               37, 38, 39
            )  )  );

end Range_Extraction;</lang>


Recursive Solution

The recursive solution avoids the usage of unbounded strings.

<lang Ada>with Ada.Text_IO, Ada.Strings.Fixed;

procedure Range_Extract is

  type Sequence is array (Positive range <>) of Integer;
  function Img(I: Integer) return String is -- the image of an Integer
  begin
     return
       Ada.Strings.Fixed.Trim(Integer'Image(I), Ada.Strings.Left);
  end Img;
  function Img(S: Sequence) return String is -- the image of a Sequence
     function X(S : Sequence) return String is -- recursive eXtract
        Idx: Positive := S'First;
     begin
        if S'Length = 0 then return
          ""; -- return nothing if Sequence is empty
        else
           while Idx < S'Last and then S(Idx+1) = S(Idx) + 1 loop
              Idx := Idx + 1;
           end loop;
           if Idx = S'First then return
             "," & Img(S(Idx)) & X(S(Idx+1 .. S'Last));
           elsif Idx = S'First+1 then return
             "," & Img(S(S'First)) & ',' & Img(S(Idx)) & X(S(Idx+1 .. S'Last));
           else return
             "," & Img(S(S'First)) & '-' & Img(S(Idx)) & X(S(Idx+1 .. S'Last));
           end if;
        end if;
     end X;
  begin -- function Img(S: Sequence) return String
     if S'Length = 0 then return
       "";
     else return
       Img(S(S'First)) & X(S(S'First+1 .. S'Last));
     end if;
  end Img;

begin -- main

  Ada.Text_IO.Put_Line(Img( ( 0,  1,  2,  4,  6,  7,  8, 11, 12, 14, 15, 16,
                              17, 18, 19, 20, 21, 22, 23, 24, 25, 27, 28, 29,
                              30, 31, 32, 33, 35, 36, 37, 38, 39) ));

end Range_Extract;</lang>

Sample output

The sample output is exactly the same, for both solutions:

0-2,4,6-8,11,12,14-25,27-33,35-39

Aime

<lang aime>void fs(integer &s, data b) {

   if (s) {

b_append(b, ',');

   }
   s = 1;

}

text rp(...) {

   integer f, i, j;
   data b;
   f = 0;
   i = 0;
   j = 0;
   while (i < count()) {

while (j < count() - 1) { if (__integer(lead(j + 1)) == __integer(lead(j)) + 1) { j += 1; } else { break; } } if (i + 1 < j) { fs(f, b); b_suffix(b, itoa(lead(i))); b_append(b, '-'); b_suffix(b, itoa(lead(j))); } else { while (i < j + 1) { fs(f, b); b_suffix(b, itoa(lead(i))); i += 1; } } j += 1; i = j;

   }
   return b_string(b);

}

integer main(void) {

   o_text(rp(0, 1, 2, 4, 6, 7, 8, 11, 12, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24,

25, 27, 28, 29, 30, 31, 32, 33, 35, 36, 37, 38, 39));

   o_byte('\n');
   return 0;

}</lang>

Output
0-2,4,6-8,11,12,14-25,27-33,35-39

ALGOL 68

Note: The following Iterative code specimen is the "unrolled" version of the Generative code specimen below. Together they provided as a comparison of the two different methods.

Iterative

Works with: ALGOL 68 version Revision 1 - one minor extension to language used - PRAGMA READ, similar to C's #include directive.
Works with: ALGOL 68G version Any - tested with release algol68g-2.3.2.
  • The closest concept that Algol 68 has to duck typing is the tagged union. This is used to define mode urange = union(int, struct(int lwb, upb)). If duck typing was available it could reduced the size of the code specimen, but would have lost some of Algol 68's strong type data security.

File: Template_Range_extraction_Base.a68 <lang algol68>###

 REQUIRES(MODE SCALAR, OP(SCALAR,SCALAR)BOOL =, OP(SCALAR,SCALAR)SCALAR +);

MODE SCALARLIST = FLEX[0]SCALAR; MODE YIELDINT = PROC(SCALAR)VOID;

  1. Declarations for manipulating lists of range pairs [lwb:upb] #

MODE RANGE = STRUCT(SCALAR lwb, upb); MODE RANGELIST = FLEX[0]RANGE; MODE YIELDRANGE = PROC(RANGE)VOID;

PROC range repr = (RANGE range)STRING: (

 STRING lwb := whole(lwb OF range,0);
 IF lwb OF range = upb OF range THEN
   lwb
 ELSE
   # "["+lwb+":"+whole(upb OF range,0)+"]"  #
   lwb+"-"+whole(upb OF range,0)
 FI

);

  1. OP REPR = (RANGE range)STRING: range repr(range); # # firmly related to UNIRANGE #
  1. Declarations for manipulating lists containing pairs AND lone INTs #

MODE UNIRANGE = UNION(SCALAR, RANGE); MODE UNIRANGELIST = FLEX[0]UNIRANGE; MODE YIELDUNIRANGE = PROC(UNIRANGE)VOID;

PROC unirange repr = (UNIRANGE unirange)STRING:

 CASE unirange IN
   (RANGE range): range repr(range),
   (SCALAR scalar): whole(scalar,0)
 ESAC;

OP (UNIRANGE)STRING REPR = unirange repr; # alias #

  1. The closest thing Algol68 has to inheritance is the UNION #

MODE UNIRANGELISTS = UNION(UNIRANGELIST, RANGELIST, SCALARLIST);

PROC unirange list repr = (UNIRANGELIST unirange list)STRING: (

      1. Produce a STRING representation of a UNIRANGELIST ###
 STRING out # := "("#, sep := "";
 FOR key FROM LWB unirange list TO UPB unirange list DO
   out +:= sep + REPR unirange list[key];
   sep := "," # +" " #
 OD;
 out # +")" #

);

OP (UNIRANGELIST)STRING REPR = unirange list repr; # alias #</lang>File: Template_Range_extraction_Iterative.a68 <lang algol68>###

 REQUIRES(MODE SCALAR, OP(SCALAR,SCALAR)BOOL =, OP(SCALAR,SCALAR)SCALAR +);

PR READ "Template_Range_extraction_Base.a68" PR

OP (UNIRANGELISTS)UNIRANGELIST INITUNIRANGE = init unirange list; # alias #

PROC init unirange list = (UNIRANGELISTS unirange list)UNIRANGELIST: (

      1. Take a []SCALAR, []RANGE or []UNIRANGE, and return a normalised []UNIRANGE ###
 INT len = UPB unirange list-LWB unirange list+1;
 [LWB unirange list: LWB unirange list+len*2]UNIRANGE out unirange list;
 SCALAR upb out unirange list := LWB out unirange list - 1;
 UNION(VOID, RANGE) prev range := EMPTY;
 PROC out unirange list append = (RANGE value)VOID:(
   IF lwb OF value = upb OF value THEN
     out unirange list[upb out unirange list+:=1] := lwb OF value
   ELIF lwb OF value + 1 = upb OF value THEN
     out unirange list[upb out unirange list+:=1] := lwb OF value;
     out unirange list[upb out unirange list+:=1] := upb OF value
   ELSE
     out unirange list[upb out unirange list+:=1] := value
   FI
 );
 FOR key FROM LWB unirange list TO UPB unirange list DO
   UNIRANGE value = CASE unirange list IN
                      (SCALARLIST list):list[key],
                      (RANGELIST list):list[key],
                      (UNIRANGELIST list):list[key]
                    ESAC;
   RANGE next range := CASE value IN
       (RANGE range): range,
       (SCALAR value): RANGE(value, value)
     ESAC;
   prev range :=
     CASE prev range IN
       (VOID): next range,
       (RANGE prev range):
         IF upb OF prev range + 1 = lwb OF next range THEN
           RANGE(lwb OF prev range, upb OF next range) # merge the range #
         ELSE
           out unirange list append(prev range);
           next range
         FI
       OUT SKIP
     ESAC
 OD;
 CASE prev range IN
   (RANGE last range): out unirange list append(last range)
 ESAC;
 out unirange list[:upb out unirange list]

);</lang>File: test_Range_extraction_Integer.a68<lang algol68>#!/usr/local/bin/a68g --script #

  1. some simple test cases: #

MODE SCALAR = INT; PR READ "Template_Range_extraction_Iterative.a68" PR

  1. PR READ "Template_Range_extraction_Generative.a68" PR#

MODE RANGEINT = UNIRANGE;

test: BEGIN

 []INT int list = ( # unnormalised #
   0,  1,  2,  4,  6,  7,  8, 11, 12, 14,
   15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
   25, 27, 28, 29, 30, 31, 32, 33, 35, 36,
   37, 38, 39);
 []RANGE range list = ( # unnormalised #
   (0,0),  (1,1),  (2,2),  (4,4),  (6,6),  (7,7),  (8,8), (11,11), (12,12), (14,14),
   (15,15), (16,16), (17,17), (18,18), (19,19), (20,20), (21,21), (22,22), (23,23), (24,24),
   (25,25), (27,27), (28,28), (29,29), (30,30), (31,31), (32,32), (33,33), (35,35), (36,36),
   (37,37), (38,38), (39,39));
 []RANGEINT list a = ( # unnormalised #
   RANGE(0,2), 4, RANGE(6,8), RANGE(11,12), 
   RANGE(14,25), RANGE(27,33), RANGE(35,39));
 []RANGEINT list b = ( # unnormalised #
   0,  1,  2,  4,  6,  7,  8, 11, 12, 14,
   15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
   25, 27, 28, 29, 30, 31, 32, 33, 35, 36,
   37, 38, 39);
 []RANGEINT list c = INITUNIRANGE(list b); # normalised #
  1. compare manipulation of various types of argument lists #
 printf(($gl$,
   REPR INITUNIRANGE int list,
   REPR INITUNIRANGE range list,
   REPR INITUNIRANGE list a,
   REPR INITUNIRANGE list b,
   REPR list c
 ))

END</lang> Output:

0-2,4,6-8,11,12,14-25,27-33,35-39
0-2,4,6-8,11,12,14-25,27-33,35-39
0-2,4,6-8,11,12,14-25,27-33,35-39
0-2,4,6-8,11,12,14-25,27-33,35-39
0-2,4,6-8,11,12,14-25,27-33,35-39

Generative

Works with: ALGOL 68 version Revision 1 - one minor extension to language used - PRAGMA READ, similar to C's #include directive.
Works with: ALGOL 68G version Any - tested with release algol68g-2.3.2.
  • The following code a set of helper functions/generators that can be used to manipulate a lists of ranges. They can manipulate either arrays or iterator. And they can handle data of type int or range and both these types unioned.

These chained iterators do the following steps:

  1. Iterate through three different types of initial arrays - []int, []range and []unirange with gen range, yielding range(lwb,upb)
  2. Iterate with gen range merge yielding merged range(lwb,upb)
  3. Iterate with gen unirange merge, merging and yielding a union of int and range
  4. Finally iterate with unirange list init exiting with an array of union of int and range.

File: Template_Range_extraction_Generative.a68 <lang algol68>###

 REQUIRES(MODE SCALAR, OP(SCALAR,SCALAR)BOOL =, OP(SCALAR,SCALAR)SCALAR +);

PR READ "Template_Range_extraction_Base.a68" PR

PROC gen range = (UNIRANGELISTS unirange list, YIELDRANGE yield range)VOID:

      1. Take a []SCALAR, []RANGE or []URANGE, and generatively yield an unnormalised RANGE ###
 FOR key FROM LWB unirange list TO UPB unirange list DO
  1. Note: Algol 68RS cannot handle LWB and UPB of a UNION in the following: #
   UNIRANGE value = CASE unirange list IN
                      (SCALARLIST list):list[key],
                      (RANGELIST list):list[key],
                      (UNIRANGELIST list):list[key]
                    ESAC;
   yield range(
     CASE value IN
       (RANGE range): range,
       (SCALAR value): (value, value)
     ESAC
   )
 OD;

PROC gen range merge = (UNIRANGELISTS unirange list, YIELDRANGE yield)VOID: (

      1. Take a []SCALAR, []RANGE or []URANGE , and generatively yield a normalised RANGE ###
 UNION(VOID, RANGE) prev range := EMPTY;
  1. FOR RANGE next range IN # gen range(unirange list, # ) DO #
    1. (RANGE next range)VOID:
  2. if the ranges cannot be merge, then yield 1st, and return 2nd #
   prev range :=
     CASE prev range IN
       (VOID): next range,
       (RANGE prev range):
         IF upb OF prev range + 1 = lwb OF next range THEN
           RANGE(lwb OF prev range, upb OF next range) # merge the range #
         ELSE
           #IF lwb OF prev range <= upb OF prev range THEN#
             yield(prev range);
           #FI;#
           next range
         FI
       OUT SKIP
     ESAC
  1. OD # );
 CASE prev range IN (RANGE last range): yield(last range) ESAC

);

PROC gen unirange merge = (UNIRANGELISTS unirange list, YIELDUNIRANGE yield)VOID: (

      1. Take a []SCALAR, []RANGE or []UNIRANGE and generatively yield a normalised UNIRANGE ###
 PROC unpack = (RANGE value)VOID:(
   IF lwb OF value = upb OF value THEN
     yield(lwb OF value)
   ELIF lwb OF value + 1 = upb OF value THEN
     yield(lwb OF value);
     yield(upb OF value)
   ELSE
     yield(value)
   FI
 );
 gen range merge(unirange list, unpack)

);

PROC unirange list init = (UNIRANGELISTS unirange list)UNIRANGELIST: (

      1. Take a []SCALAR, []RANGE or []UNIRANGE and return a static []UNIRANGE ###
 INT len = UPB unirange list - LWB unirange list + 1;
 [LWB unirange list: LWB unirange list + len * 2]UNIRANGE out unirange list; # estimate #
 SCALAR upb out unirange list := LWB out unirange list - 1;
  1. FOR UNIRANGE unirange IN # gen unirange merge(unirange list, # ) DO #
    1. (UNIRANGE unirange)VOID:
   out unirange list[upb out unirange list+:=1] := unirange
  1. OD # );
 out unirange list[:upb out unirange list]

);

OP (UNIRANGELISTS)UNIRANGELIST INITUNIRANGE = unirange list init; # alias #</lang> Output:

0-2,4,6-8,11,12,14-25,27-33,35-39
0-2,4,6-8,11,12,14-25,27-33,35-39
0-2,4,6-8,11,12,14-25,27-33,35-39
0-2,4,6-8,11,12,14-25,27-33,35-39
0-2,4,6-8,11,12,14-25,27-33,35-39

AutoHotkey

<lang AutoHotkey>msgbox % extract("0,1,2,4,6,7,8,11,12,14,15,16,17,18,19,20,21,22,23,24,25,27,28,29,30,31,32,33,35,36,37,38,39")

extract( list ) {

   loop, parse, list, `,, %A_Tab%%A_Space%`r`n
   {
       if (A_LoopField+0 != p+1)
           ret .= (f!=p ? (p>f+1 ? "-" : ",") p : "") "," f := A_LoopField
       p := A_LoopField
   }
   return SubStr(ret (f!=p ? (p>f+1 ? "-" : ",") p : ""), 2)

}</lang>

Output:

---------------------------
Range extraction.ahk
---------------------------
0-2,4,6-8,11,12,14-25,27-33,35-39
---------------------------
OK   
---------------------------

AWK

AWK is a primitive bird the prefers global scope for arrays.

Local variables for functions are declared in the parameters and, by convention, separated from the expected ones by extra space.

<lang awk>#!/usr/bin/awk -f

BEGIN {

   delete sequence
   delete range
   seqStr = "0,1,2,4,6,7,8,11,12,14,15,16,17,18,19,20,21,22,23,24,"
   seqStr = seqStr "25,27,28,29,30,31,32,33,35,36,37,38,39"
   print "Sequence: " seqStr
   fillSequence(seqStr)
   rangeExtract()
   showRange()
   exit

}

function rangeExtract( runStart, runLen) {

   delete range
   runStart = 1
   while(runStart <= length(sequence)) {
       runLen = getSeqRunLen(runStart)
       addRange(runStart, runLen)
       runStart += runLen
   }

}

function getSeqRunLen(startPos, pos) {

   for (pos = startPos; pos < length(sequence); pos++) {
       if (sequence[pos] + 1 != sequence[pos + 1]) break;
   }
   return pos - startPos + 1;

}

function addRange(startPos, len, str) {

   if (len == 1) str = sequence[startPos]
   else if (len == 2) str = sequence[startPos] "," sequence[startPos + 1]
   else str = sequence[startPos] "-" sequence[startPos + len - 1]
   range[length(range) + 1] = str

}

function showRange( r) {

   printf "  Ranges: "
   for (r = 1; r <= length(range); r++) {
       if (r > 1) printf ","
       printf range[r]
   }
   printf "\n"

}

function fillSequence(seqStr, n, s) {

   n = split(seqStr,a,/[,]+/)
   for (s = 1; s <= n; s++) {
       sequence[s] = a[s]
   }

}</lang>

Sample output:

Sequence: 0,1,2,4,6,7,8,11,12,14,15,16,17,18,19,20,21,22,23,24,25,27,28,29,30,31,32,33,35,36,37,38,39
  Ranges: 0-2,4,6-8,11,12,14-25,27-33,35-39

BBC BASIC

<lang bbcbasic> range$ = " 0, 1, 2, 4, 6, 7, 8, 11, 12, 14, " + \

     \        "15, 16, 17, 18, 19, 20, 21, 22, 23, 24, " + \
     \        "25, 27, 28, 29, 30, 31, 32, 33, 35, 36, " + \
     \        "37, 38, 39"
     PRINT FNrangeextract(range$)
     END
     
     DEF FNrangeextract(r$)
     LOCAL f%, i%, r%, t%, t$
     f% = VAL(r$)
     REPEAT
       i% = INSTR(r$, ",", i%+1)
       t% = VALMID$(r$, i%+1)
       IF t% = f% + r% + 1 THEN
         r% += 1
       ELSE
         CASE r% OF
           WHEN 0: t$ += STR$(f%) + ","
           WHEN 1: t$ += STR$(f%) + "," + STR$(f% + r%) + ","
           OTHERWISE: t$ += STR$(f%) + "-" + STR$(f% + r%) + ","
         ENDCASE
         r% = 0
         f% = t%
       ENDIF
     UNTIL i% = 0
     = LEFT$(t$)</lang>

Output:

0-2,4,6-8,11,12,14-25,27-33,35-39

Bracmat

<lang bracmat> ( rangeExtract

 =     accumulator firstInRange nextInRange
     , accumulate fasten rangePattern
   .   ( accumulate
       =     !accumulator
             (!accumulator:|?&",")
             !firstInRange
             (   !firstInRange+1:<>!nextInRange
               &   ( !firstInRange+2:!nextInRange&","
                   | "-"
                   )
                   -1+!nextInRange
             | 
             )
         : ?accumulator
       )
     & ( fasten
       = [%( !accumulate
           & (!sjt:?firstInRange)+1:?nextInRange
           )
       )
     & ( rangePattern
       =   ( 
           |   ?
               ( !nextInRange
               & 1+!nextInRange:?nextInRange
               )
           )
           ( &!accumulate
           | (#<>!nextInRange:!fasten) !rangePattern
           )
       )
     & :?accumulator:?firstInRange
     & !arg:(|#!fasten !rangePattern)
     & str$!accumulator
 )

& ( test

 =   L A
   .   put$(!arg " ==>\n",LIN)
     & (   !arg:(?,?)
         & whl'(!arg:(?A,?arg)&(!A,!L):?L)
         & whl'(!L:(?A,?L)&!A !arg:?arg)
       | 
       )
     & out$(rangeExtract$!arg)
 )

& test

 $ (0,  1,  2,  4,  6,  7,  8, 11, 12, 14,
   15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
   25, 27, 28, 29, 30, 31, 32, 33, 35, 36,
   37, 38, 39)</lang>

Output:

(0,1,2,4,6,7,8,11,12,14,15,16,17,18,19,20,21,22,23,24,25,27,28,29,30,31,32,33,35,36,37,38,39)  ==>
0-2,4,6-8,11,12,14-25,27-33,35-39

C

Using the fine tradition of snprintf, rprint is not responsible for allocating output buffer. It prints the range only if supplied a non-null pointer, but always returns the output length sans the terminating null, so caller can allocate buffer. <lang c>#include <stdio.h>

  1. include <stdlib.h>

size_t rprint(char *s, int *x, int len) {

  1. define sep (a > s ? "," : "") /* use comma except before first output */
  2. define ol (s ? 100 : 0) /* print only if not testing for length */

int i, j; char *a = s; for (i = j = 0; i < len; i = ++j) { for (; j < len - 1 && x[j + 1] == x[j] + 1; j++);

if (i + 1 < j) a += snprintf(s?a:s, ol, "%s%d-%d", sep, x[i], x[j]); else while (i <= j) a += snprintf(s?a:s, ol, "%s%d", sep, x[i++]); } return a - s;

  1. undef sep
  2. undef ol

}

int main() { int x[] = { 0, 1, 2, 4, 6, 7, 8, 11, 12, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 27, 28, 29, 30, 31, 32, 33, 35, 36, 37, 38, 39 };

char *s = malloc(rprint(0, x, sizeof(x) / sizeof(int)) + 1); rprint(s, x, sizeof(x) / sizeof(int)); printf("%s\n", s);

return 0; }</lang>output<lang>0-2,4,6-8,11,12,14-25,27-33,35-39</lang>

C++

<lang cpp>

  1. include <iostream>
  2. include <iterator>
  3. include <cstddef>

template<typename InIter>

void extract_ranges(InIter begin, InIter end, std::ostream& os)

{

 if (begin == end)
   return;
 int current = *begin++;
 os << current;
 int count = 1;
 while (begin != end)
 {
   int next = *begin++;
   if (next == current+1)
     ++count;
   else
   {
     if (count > 2)
       os << '-';
     else
       os << ',';
     if (count > 1)
       os << current << ',';
     os << next;
     count = 1;
   }
   current = next;
 }
 if (count > 1)
   os << (count > 2? '-' : ',') << current;

}

template<typename T, std::size_t n>

T* end(T (&array)[n])

{

 return array+n;

}

int main() {

 int data[] = { 0,  1,  2,  4,  6,  7,  8, 11, 12, 14,
                15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
                25, 27, 28, 29, 30, 31, 32, 33, 35, 36,
                37, 38, 39 };
 extract_ranges(data, end(data), std::cout);
 std::cout << std::endl;

} </lang> Output:

0-2,4,6-8,11,12,14-25,27-33,35-39

C#

Made a fix to this very idiosyncratic code. <lang csharp>using System; using System.Collections.Generic; using System.Linq;

class RangeExtraction {

   static void Main()
   {
       const string testString = "0,  1,  2,  4,  6,  7,  8, 11, 12, 14,15, 16, 17, 18, 19, 20, 21, 22, 23, 24,25, 27, 28, 29, 30, 31, 32, 33, 35, 36,37, 38, 39";
       var result = String.Join(",", RangesToStrings(GetRanges(testString)));
       Console.Out.WriteLine(result);
   }
   public static IEnumerable<IEnumerable<int>> GetRanges(string testString)
   {
       var numbers = testString.Split(new[] { ',' }).Select(x => Convert.ToInt32(x));
       var current = new List<int>();
       foreach (var n in numbers)
       {
           if (current.Count == 0)
           {
               current.Add(n);
           }
           else
           {
               if (current.Max() + 1 == n)
               {
                   current.Add(n);
               }
               else
               {
                   yield return current;
                   current = new List<int> { n };
               }
           }
       }
       yield return current;
   }
   public static IEnumerable<string> RangesToStrings(IEnumerable<IEnumerable<int>> ranges)
   {
       foreach (var range in ranges)
       {
           if (range.Count() == 1)
           {
               yield return range.Single().ToString();
           }
           else if (range.Count() == 2)
           {
               yield return range.Min() + "," + range.Max();
           }
           else
           {
               yield return range.Min() + "-" + range.Max();
           }
       }
   }

} </lang>

Output:

0-2,4,6-8,11,12,14-25,27-33,35-39

Common Lisp

<lang lisp>(defun format-with-ranges (list)

 (unless list (return ""))
 (with-output-to-string (s)
   (let ((current (first list))
         (list    (rest list))
         (count   1))
     (princ current s)
     (dolist (next list)
       (if (= next (1+ current))
           (incf count)
           (progn (princ (if (> count 2) "-" ",") s)
                  (when (> count 1)
                    (princ current s)
                    (princ "," s))
                  (princ next s)
                  (setf count 1)))
       (setf current next))
     (when (> count 1)
       (princ (if (> count 2) "-" ",") s)
       (princ current s)))))

CL-USER> (format-with-ranges (list 0 1 2 4 6 7 8 11 12 14

                                  15 16 17 18 19 20 21 22 23 24
                                  25 27 28 29 30 31 32 33 35 36
                                  37 38 39))

"0-2,4,6-8,11,12,14-25,27-33,35-39" </lang>

D

<lang d>import std.stdio, std.conv, std.string, std.algorithm;

string extractRanges(in int[] items) in {

   assert(items.isSorted());

} body {

   string[] ranges;
   for (size_t i = 0; i < items.length; i++) {
       immutable low = items[i];
       while (i < (items.length - 1) && (items[i] + 1) == items[i + 1])
           i++;
       immutable hi = items[i];
       if (hi - low >= 2)
           ranges ~= text(low, '-', hi);
       else if (hi - low == 1)
           ranges ~= text(low, ',', hi);
       else
           ranges ~= text(low);
   }
   return ranges.join(",");

}

void main() {

   foreach (data; [[-8, -7, -6, -3, -2, -1, 0, 1, 3, 4, 5, 7, 8, 9,
                    10, 11, 14, 15, 17, 18, 19, 20],
                   [0, 0, 0, 1, 1],
                   [0, 1, 2, 4, 6, 7, 8, 11, 12, 14, 15, 16, 17, 18,
                    19, 20, 21, 22, 23, 24, 25, 27, 28, 29, 30, 31,
                    32, 33, 35, 36, 37, 38, 39]])
       writeln(extractRanges(data));

}</lang>

Output:
-8--6,-3-1,3-5,7-11,14,15,17-20
0,0,0,1,1
0-2,4,6-8,11,12,14-25,27-33,35-39

DWScript

<lang delphi>procedure ExtractRanges(const values : array of Integer); begin

  var i:=0;
  while i<values.Length do begin
     if i>0 then
        Print(',');
     Print(values[i]);
     var j:=i+1;
     while (j<values.Length) and (values[j]=values[j-1]+1) do
        Inc(j);
     Dec(j);
     if j>i then begin
        if j=i+1 then
           Print(',')
        else Print('-');
        Print(values[j]);
     end;
     i:=j+1;
  end;

end;

ExtractRanges([ 0, 1, 2, 4, 6, 7, 8, 11, 12, 14,

              15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
              25, 27, 28, 29, 30, 31, 32, 33, 35, 36,
              37, 38, 39]);</lang>

Output:

0-2,4,6-8,11,12,14-25,27-33,35-39

E

Cheeky solution: relying on the standard library for finding ranges, and just formatting them ourselves.

<lang e>def rex(numbers :List[int]) {

   var region := 0..!0
   for n in numbers { region |= n..n }
   var ranges := []
   for interval in region.getSimpleRegions() { 
       def a := interval.getOptStart()
       def b := interval.getOptBound() - 1
       ranges with= if (b > a + 1) {
                        `$a-$b`
                    } else if (b <=> a + 1) {
                        `$a,$b`
                    } else { # b <=> a
                        `$a`
                    }
   }
   return ",".rjoin(ranges)

}</lang>

<lang e>? rex([ > 0, 1, 2, 4, 6, 7, 8, 11, 12, 14, > 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, > 25, 27, 28, 29, 30, 31, 32, 33, 35, 36, > 37, 38, 39])

  1. value: "0-2,4,6-8,11,12,14-25,27-33,35-39"

</lang>

Euphoria

<lang euphoria>function extract_ranges(sequence s)

   integer first
   sequence out
   out = ""
   if length(s) = 0 then
       return out
   end if
   first = 1
   for i = 2 to length(s) do
       if s[i] != s[i-1]+1 then
           if first = i-1 then
               out &= sprintf("%d,", s[first])
           elsif first = i-2 then
               out &= sprintf("%d,%d,", {s[first],s[i-1]})
           else
               out &= sprintf("%d-%d,", {s[first],s[i-1]})
           end if
           first = i
       end if
   end for
   if first = length(s) then
       out &= sprintf("%d", s[first])
   elsif first = length(s)-1 then
       out &= sprintf("%d,%d", {s[first],s[$]})
   else
       out &= sprintf("%d-%d", {s[first],s[$]})
   end if
   return out

end function

puts(1, extract_ranges({0, 1, 2, 4, 6, 7, 8, 11, 12, 14, 15, 16, 17, 18, 19,

   20, 21, 22, 23, 24, 25, 27, 28, 29, 30, 31, 32, 33, 35, 36, 37, 38, 39}))</lang>

Output:

0-2,4,6-8,11,12,14-25,27-33,35-39

F#

<lang fsharp>let extractRanges = function

 | []    -> Seq.empty
 | x::xr ->
     let rec loop ys first last = seq {
       match ys with
       | y::yr when y = last + 1 -> yield! loop yr first y  // add to current range
       | y::yr                   -> yield (first, last)     // finish current range
                                    yield! loop yr y y      //  and start next
       | []                      -> yield (first, last) }   // finish final range
     loop xr x x


let rangeToString (s,e) =

 match e-s with
 | 0 -> sprintf "%d" s
 | 1 -> sprintf "%d,%d" s e
 | _ -> sprintf "%d-%d" s e


let extract = extractRanges >> Seq.map rangeToString >> String.concat ","


printfn "%s" (extract [ 0; 1; 2; 4; 6; 7; 8; 11; 12; 14; 15; 16; 17; 18; 19; 20; 21;

                       22; 23; 24; 25; 27; 28; 29; 30; 31; 32; 33; 35; 36; 37; 38; 39 ])</lang>

Output:

0-2,4,6-8,11,12,14-25,27-33,35-39

Forth

<lang forth>create values here

   0 ,  1 ,  2 ,  4 ,  6 ,  7 ,  8 , 11 , 12 , 14 ,
  15 , 16 , 17 , 18 , 19 , 20 , 21 , 22 , 23 , 24 ,
  25 , 27 , 28 , 29 , 30 , 31 , 32 , 33 , 35 , 36 ,
  37 , 38 , 39 ,

here swap - 1 cells / constant /values

clip 1- swap cell+ swap ; \ reduce array
.range2 0 .r ." -" 0 .r ; \ difference two or more
.range1 0 .r ." , " 0 .r ; \ difference one
.range0 drop 0 .r ; \ no difference
                                      \ select printing routine

create .range ' .range0 , ' .range1 , ' .range2 ,

 does> >r over over - 2 min cells r> + @ execute ;
.ranges ( a n --)
 over @ dup >r >r                     \ setup first value
 begin
   clip dup                           \ check length array
 while
   over @ dup r@ 1+ =                 \ check if range breaks
   if r> drop >r else r> r> .range ." , " dup >r >r then
 repeat 2drop r> r> .range cr         \ print last range

values /values .ranges</lang>

Output:

0-2, 4, 6-8, 11, 12, 14-25, 27-33, 35-39

Go

<lang go>package main

import (

   "errors"
   "fmt"
   "strconv"
   "strings"

)

func main() {

   rf, err := rangeFormat([]int{
       0, 1, 2, 4, 6, 7, 8, 11, 12, 14,
       15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
       25, 27, 28, 29, 30, 31, 32, 33, 35, 36,
       37, 38, 39,
   })
   if err != nil {
       fmt.Println(err)
       return
   }
   fmt.Println("range format:", rf)

}

func rangeFormat(a []int) (string, error) {

   if len(a) == 0 {
       return "", nil
   }
   var parts []string
   for n1 := 0; ; {
       n2 := n1 + 1
       for n2 < len(a) && a[n2] == a[n2-1]+1 {
           n2++
       }
       s := strconv.Itoa(a[n1])
       if n2 == n1+2 {
           s += "," + strconv.Itoa(a[n2-1])
       } else if n2 > n1+2 {
           s += "-" + strconv.Itoa(a[n2-1])
       }
       parts = append(parts, s)
       if n2 == len(a) {
           break
       }
       if a[n2] == a[n2-1] {
           return "", errors.New(fmt.Sprintf(
               "sequence repeats value %d", a[n2]))
       }
       if a[n2] < a[n2-1] {
           return "", errors.New(fmt.Sprintf(
               "sequence not ordered: %d < %d", a[n2], a[n2-1]))
       }
       n1 = n2
   }
   return strings.Join(parts, ","), nil

}</lang> Output:

range format: 0-2,4,6-8,11,12,14-25,27-33,35-39

Groovy

Ad Hoc Solution: <lang groovy>def range = { s, e -> s == e ? "${s}," : s == e - 1 ? "${s},${e}," : "${s}-${e}," }

def compressList = { list ->

   def sb, start, end
   (sb, start, end) = [<<, list[0], list[0]]
   for (i in list[1..-1]) {
       (sb, start, end) = i == end + 1 ? [sb, start, i] : [sb << range(start, end), i, i]
   }
   (sb << range(start, end))[0..-2].toString()

}

def compressRanges = { expanded -> compressList(Eval.me('[' + expanded + ']')) }</lang>

Test: <lang groovy>def s =

   0,  1,  2,  4,  6,  7,  8, 11, 12, 14,
  15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
  25, 27, 28, 29, 30, 31, 32, 33, 35, 36,
  37, 38, 39

println (compressRanges(s))</lang>

Output:

0-2,4,6-8,11,12,14-25,27-33,35-39

Haskell

<lang haskell>import Data.List (intercalate)

extractRange :: [Int] -> String extractRange = intercalate "," . f

 where f :: [Int] -> [String]
       f (x1 : x2 : x3 : xs) | x1 + 1 == x2 && x2 + 1 == x3
            = (show x1 ++ '-' : show xn) : f xs'
         where (xn, xs') = g (x3 + 1) xs
               g a (n : ns) | a == n    = g (a + 1) ns
                            | otherwise = (a - 1, n : ns)
               g a []                   = (a - 1, [])
       f (x : xs)            = show x : f xs
       f []                  = []</lang>

<lang text>> extractRange $ [0..2] ++ 4 : [6..8] ++ 11 : 12 : [14..25] ++ [27..33] ++ [35..39] "0-2,4,6-8,11,12,14-25,27-33,35-39"</lang>

Icon and Unicon

<lang Icon>procedure main()

  R := [  0,  1,  2,  4,  6,  7,  8, 11, 12, 14, 
         15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 
         25, 27, 28, 29, 30, 31, 32, 33, 35, 36, 
         37, 38, 39 ]
  write("Input list      := ",list2string(R))
  write("Extracted sting := ",s := range_extract(R)  | "FAILED")

end

procedure range_extract(R) #: return string/range representation of a list of unique integers local s,sep,low,high,x

  every if integer(x:= !R) ~= x then fail                  # ensure all are integers, 
  R := sort(set(R))                                        # unique, and sorted
  s := sep := ""
  while s ||:= sep || ( low := high := get(R) ) do {       # lower bound of range
     sep := ","
     while high := ( R[1] = high + 1 ) do get(R)           # find the end of range
     if high > low+1 then s ||:= "-" || high               # - record range of 3+
     else if high = low+1 then push(R,high)                # - range of 2, high becomes new low
     }
  return s

end

procedure list2string(L) #: helper to convert list to string local s

  every (s := "[ ") ||:= !L || " "
  return s || "]"

end</lang> Sample output:

Input list      := [ 0 1 2 4 6 7 8 11 12 14 15 16 17 18 19 20 21 22 23 24 25 27
28 29 30 31 32 33 35 36 37 38 39 ]
Extracted sting := 0-2,4,6-8,11,12,14-25,27-33,35-39

J

<lang j>require 'strings' fmt=: [: ;@(8!:0) [`]`({. ; (',-' {~ 2 < #) ; {:)@.(2 <. #) group=: <@fmt;.1~ 1 ~: 0 , 2 -~/\ ] extractRange=: ',' joinstring group</lang>

Example use:

<lang j> extractRange 0 1 2 4 6 7 8 11 12 14 15 16 17 18 19 20 21 22 23 24 25 27 28 29 30 31 32 33 35 36 37 38 39 0-2,4,6-8,11,12,14-25,27-33,35-39</lang>

Other examples:

<lang J> extractRange i.101 0-100</lang>

The first 101 non-negative integers

<lang J>

  extractRange (-. p:) i.101

0,1,4,6,8-10,12,14-16,18,20-22,24-28,30,32-36,38-40,42,44-46,48-52,54-58,60,62-66,68-70,72,74-78,80-82,84-88,90-96,98-100</lang>

Excluding those which are prime

<lang J>

  extractRange 2}. (-. p:) i.101

4,6,8-10,12,14-16,18,20-22,24-28,30,32-36,38-40,42,44-46,48-52,54-58,60,62-66,68-70,72,74-78,80-82,84-88,90-96,98-100</lang>

Also excluding the first two non-negative integers (which are neither prime nor the product of non-empty lists of primes).

Java

<lang java>public class Range{ public static void main(String[] args){ System.out.println(compress2Range("-6, -3, -2, -1, 0, 1, 3, 4, 5, 7," + " 8, 9, 10, 11, 14, 15, 17, 18, 19, 20"));

       System.out.println(compress2Range(
               "0,  1,  2,  4,  6,  7,  8, 11, 12, 14, " +
               "15, 16, 17, 18, 19, 20, 21, 22, 23, 24," +
               "25, 27, 28, 29, 30, 31, 32, 33, 35, 36," +
               "37, 38, 39"));
   }

   private static String compress2Range(String expanded){
       StringBuilder result = new StringBuilder();
       String[] nums = expanded.replace(" ", "").split(",");
       int firstNum = Integer.parseInt(nums[0]);
       int rangeSize = 0;
       for(int i = 1; i < nums.length; i++){
           int thisNum = Integer.parseInt(nums[i]);
           if(thisNum - firstNum - rangeSize == 1){
               rangeSize++;
           }else{
               if(rangeSize != 0){
                   result.append(firstNum).append((rangeSize == 1) ? ",": "-")
                           .append(firstNum+rangeSize).append(",");
                   rangeSize = 0;
               }else{
                   result.append(firstNum).append(",");
               }
               firstNum = thisNum;
           }
       }
       if(rangeSize != 0){
           result.append(firstNum).append((rangeSize == 1) ? "," : "-").
                   append(firstNum + rangeSize);
           rangeSize = 0;
       } else {
           result.append(firstNum);
       }
       return result.toString();
   }

}</lang> Output:

-6,-3-1,3-5,7-11,14,15,17-20
0-2,4,6-8,11,12,14-25,27-33,35-39

JavaScript

<lang javascript>function rangeExtraction(list) {

 var len = list.length;
 var out = [];
 var i, j;
 for (i = 0; i < len; i = j + 1) {
   // beginning of range or single
   out.push(list[i]);
   
   // find end of range
   for (var j = i + 1; j < len && list[j] == list[j-1] + 1; j++);
   j--;
   
   if (i == j) {
     // single number
     out.push(",");
   } else if (i + 1 == j) {
     // two numbers
     out.push(",", list[j], ",");
   } else { 
     // range
     out.push("-", list[j], ",");
   }
 }
 out.pop(); // remove trailing comma
 return out.join("");

}

// using print function as supplied by Rhino standalone print(rangeExtraction([

 0,  1,  2,  4,  6,  7,  8, 11, 12, 14,
 15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
 25, 27, 28, 29, 30, 31, 32, 33, 35, 36,
 37, 38, 39

]));</lang>

K

<lang k>grp : {(&~1=0,-':x)_ x} fmt : {:[1=#s:$x;s;(*s),:[3>#s;",";"-"],*|s]} erng: {{x,",",y}/,//'fmt'grp x}</lang>

Example: <lang k> erng 0 1 2 4 6 7 8 11 12 14 15 16 17 18 19 20 21 22 23 24 25 27 28 29 30 31 32 33 35 36 37 38 39 "0-2,4,6-8,11,12,14-25,27-33,35-39"</lang>

Liberty BASIC

<lang lb> s$ = "0, 1, 2, 4, 6, 7, 8, 11, 12, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24," + _

    "25, 27, 28, 29, 30, 31, 32, 33, 35, 36, 37, 38, 39"

print ExtractRange$( s$) end

function ExtractRange$( range$)

   n = 1
   count = ItemCount( range$, ",")
   while n <= count
       startValue = val( word$( range$, n, ","))
       m = n + 1
       while m <= count
           nextValue = val( word$( range$, m, ","))
           if nextValue - startValue <> m - n then exit while
           m = m + 1
       wend
       if m - n > 2 then
           ExtractRange$ = ExtractRange$ + str$( startValue) + "-" + str$( startValue + m - n - 1) + ","
       else
           for i = n to m - 1
               ExtractRange$ = ExtractRange$ + str$( startValue + i - n) + ","
           next i
       end if
       n = m
   wend
   ExtractRange$ = left$( ExtractRange$, len( ExtractRange$) - 1)

end function

function ItemCount( list$, separator$)

   while word$( list$, ItemCount + 1, separator$) <> ""
       ItemCount = ItemCount + 1
   wend

end function </lang> Sample output:- 0-2,4,6-8,11,12,14-25,27-33,35-39

Mathematica

<lang Mathematica> rangeExtract[data_List] := ToString[Row[

                              Riffle[
                                 Flatten[Split[Sort[data], #2 - #1 == 1 &] /. {a_Integer, __, b_} :> Row[{a, "-", b}]],
                                    ","]
                                    ]];

</lang>

Example:

rangeExtract[{0,1,2,4,6,7,8,11,12,14,15,16,17,18,19,20,21,22,23,24,25,27,28,29,30,31,32,33,35,36,37,38,39}]

"0-2,4,6-8,11,12,14-25,27-33,35-39"

MUMPS

<lang MUMPS>RANGCONT(X) ;Integer range contraction

NEW Y,I,CONT,NOTFIRST,CURR,PREV,NEXT,SEQ SET Y="",SEQ=0,PREV="",CONT=0
FOR I=1:1:$LENGTH(X,",") DO
.SET NOTFIRST=$LENGTH(Y),CURR=$PIECE(X,",",I),NEXT=$PIECE(X,",",I+1)
.FOR  Q:$EXTRACT(CURR)'=" "  S CURR=$EXTRACT(CURR,2,$LENGTH(CURR))  ;clean up leading spaces
.S SEQ=((CURR-1)=PREV)&((CURR+1)=NEXT)
.IF 'NOTFIRST SET Y=CURR
.IF NOTFIRST DO
..;Order matters due to flags
..IF CONT&SEQ ;Do nothing
..IF 'CONT&'SEQ SET Y=Y_","_CURR
..IF CONT&'SEQ SET Y=Y_CURR,CONT=0
..IF 'CONT&SEQ SET Y=Y_"-",CONT=1
.SET PREV=CURR
IF CONT SET Y=Y_PREV
K I,CONT,NOTFIRST,CURR,PREV,NEXT,SEQ
QUIT Y</lang>

Example:

USER>SET S="0,1,2,4,6,7,8,11,12,14,15,16,17,18,19,20,21,22,23,24,25,27,28,29,30,31,32,33,35,36,37,38,39"
 
USER>W $$RANGCONT^ROSETTA(S)
0-2,4,6-8,11,12,14-25,27-33,35-39

Oberon-2

Oxford Oberon-2 <lang oberon2> MODULE RangeExtraction; IMPORT Out;

PROCEDURE Range(s: ARRAY OF INTEGER); VAR i,j: INTEGER;

PROCEDURE Emit(sep: CHAR); BEGIN IF i > 2 THEN Out.Int(s[j],3);Out.Char('-');Out.Int(s[j + i - 1],3);Out.Char(sep); INC(j,i) ELSE Out.Int(s[j],3);Out.Char(sep); INC(j) END; END Emit;

BEGIN j := 0;i := -1; LOOP INC(i); IF j + i >= LEN(s) THEN Emit(0AX); EXIT ELSIF s[j + i] # (s[j] + i) THEN Emit(','); i := 0; END END END Range;

VAR seq0: ARRAY 33 OF INTEGER; seq1: ARRAY 20 OF INTEGER; BEGIN seq0[0] := 0; seq0[1] := 1; seq0[2] := 2; seq0[3] := 4; seq0[4] := 6; seq0[5] := 7; seq0[6] := 8; seq0[7] := 11; seq0[8] := 12; seq0[9] := 14; seq0[10] := 15; seq0[11] := 16; seq0[12] := 17; seq0[13] := 18; seq0[14] := 19; seq0[15] := 20; seq0[16] := 21; seq0[17] := 22; seq0[18] := 23; seq0[19] := 24; seq0[20] := 25; seq0[21] := 27; seq0[22] := 28; seq0[23] := 29; seq0[24] := 30; seq0[25] := 31; seq0[26] := 32; seq0[27] := 33; seq0[28] := 35; seq0[29] := 36; seq0[30] := 37; seq0[31] := 38; seq0[32] := 39; Range(seq0); seq1[0] := -6; seq1[1] := -3; seq1[2] := -2; seq1[3] := -1; seq1[4] := 0; seq1[5] := 1; seq1[6] := 3; seq1[7] := 4; seq1[8] := 5; seq1[9] := 7; seq1[10] := 8; seq1[11] := 9; seq1[12] := 10; seq1[13] := 11; seq1[14] := 14; seq1[15] := 15; seq1[16] := 17; seq1[17] := 18; seq1[18] := 19; seq1[19] := 20; Range(seq1) END RangeExtraction. </lang> Output:

  0-  2,  4,  6-  8, 11, 12, 14- 25, 27- 33, 35- 39
 -6, -3-  1,  3-  5,  7- 11, 14, 15, 17- 20

NetRexx

<lang netrexx>/*NetRexx program to test range extraction. ***************************

  • 07.08.2012 Walter Pachl derived from my Rexx Version
  • Changes: line continuation in aaa assignment changed
  • 1e99 -> 999999999
  • Do -> Loop
  • words(aaa) -> aaa.words()
  • word(aaa,i) -> aaa.word(i)
                                                                                                                                            • /

Say 'NetRexx program derived from Rexx' aaa='0 1 2 4 6 7 8 11 12 14 15 16 17 18 19 20 21 22 23 24 25 27 28 29' aaa=aaa' 30 31 32 33 35 36 37 38 39' say 'old='aaa; aaa=aaa 999999999 /* artificial number at the end */ i=0 /* initialize index */ ol= /* initialize output string */ comma= /* will become a ',' lateron */ inrange=0 Loop While i<=aaa.words /* loop for all numbers */

 i=i+1                             /* index of next number          */
 n=aaa.word(i)                     /* the now current number        */
 If n=999999999 Then Leave         /* we are at the end             */
 If inrange Then Do                /* range was opened              */
   If aaa.word(i+1)<>n+1 Then Do   /* following word not in range   */
     ol=ol||n                      /* so this number is the end     */
     inrange=0                     /* and the range is over         */
     End                           /* else ignore current number    */
   End
 Else Do                           /* not in a range                */
   ol=ol||comma||n                 /* add number (with comma)       */
   comma=','                       /* to the output string          */
   If aaa.word(i+2)=n+2 Then Do    /* if the nr after the next fits */
     inrange=1                     /* open a range                  */
     ol=ol'-'                      /* append the range connector    */
     End
   End
 End

Say 'new='ol</lang> Output

NetRexx program derived from Rexx
old=0 1 2 4 6 7 8 11 12 14 15 16 17 18 19 20 21 22 23 24 25 27 28 29 30 31 32 33 35 36 37 38 39
new=0-2,4,6-8,11,12,14-25,27-33,35-39                   

OCaml

<lang ocaml>let range_extract = function

 | [] -> []
 | x::xs ->
   let f (i,j,ret) k =
     if k = succ j then (i,k,ret) else (k,k,(i,j)::ret) in
   let (m,n,ret) = List.fold_left f (x,x,[]) xs in
   List.rev ((m,n)::ret)

let string_of_range rng =

 let str (a,b) =
   if a = b then string_of_int a
   else Printf.sprintf "%d%c%d" a (if b = succ a then ',' else '-') b in
 String.concat "," (List.map str rng)

let () =

 let li =
   [ 0; 1; 2; 4; 6; 7; 8; 11; 12; 14; 15; 16; 17; 18; 19; 20; 21;
     22; 23; 24; 25; 27; 28; 29; 30; 31; 32; 33; 35; 36; 37; 38; 39 ]
 in
 let rng = range_extract li in
 print_endline(string_of_range rng)</lang>

Output

0-2,4,6-8,11,12,14-25,27-33,35-39

OxygenBasic

This example does not show the output mentioned in the task description on this page (or a page linked to from here). Please ensure that it meets all task requirements and remove this message.
Note that phrases in task descriptions such as "print and display" and "print and show" for example, indicate that (reasonable length) output be a part of a language's solution.


<lang oxygenbasic>

  dim sys ints(100)
  ints=>
  0,  1,  2,  4,  6,  7,  8, 11, 12, 14,
  15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
  25, 27, 28, 29, 30, 31, 32, 33, 35, 36,
  37, 38, 39
 function ShowRange(sys*i) as string
 '==================================
 pr=""
 n=0
 e=0
 j=0
 k=-1
 do
   j++
   n=i(j)
   e=i(j+1)
   if e<j then
     exit do
   end if
   if e=n+1 and i(j+2)=n+2 then 'LOOKAHEAD
     if k=-1 then k=n
   else
     if k>=0 then
       pr+=k "-" i(j+1) ", " 'RANGE OF VALUES
       j++
       k=-1
     else
       pr+=n ", " 'SINGLE VALUES
     end if
   end if
 end do
 return left pr, len(pr)-2
 end function


 print ShowRange ints

</lang>

Oz

<lang oz>declare

 fun {Extract Xs}
    {CommaSeparated
     {Map {ExtractRanges Xs} RangeToString}}
 end
 fun {ExtractRanges Xs}
    fun {Loop Ys Start End}
       case Ys
       of Y|Yr andthen Y == End+1 then {Loop Yr Start Y}
       [] Y|Yr                    then Start#End|{Loop Yr Y Y} 
       [] nil                     then [Start#End]
       end
    end
 in
    case Xs
    of X|Xr then {Loop Xr X X}
    [] nil then nil
    end
 end
 
 fun {RangeToString S#E}
    if E-S >= 2 then
       {VirtualString.toString S#"-"#E}
    else
       {CommaSeparated
        {Map {List.number S E 1} Int.toString}}
    end
 end
 fun {CommaSeparated Xs}
    {Flatten {Intersperse "," Xs}}
 end
  
 fun {Intersperse Sep Xs}
    case Xs of X|Y|Xr then
       X|Sep|{Intersperse Sep Y|Xr}
    else
       Xs
    end
 end

in

 {System.showInfo
  {Extract [ 0 1 2 4 6 7 8 11 12 14
             15 16 17 18 19 20 21 22 23 24
             25 27 28 29 30 31 32 33 35 36
             37 38 39 ]}}</lang>

Sample output: <lang oz>0-2,4,6-8,11,12,14-25,27-33,35-39</lang>

Perl

Using regexes. Also handles +/- and negative integer ranges.

<lang Perl>sub rangext {

   my $str = join ' ', @_;
   1 while $str =~ s{([+-]?\d+) ([+-]?\d+)}
       {$1.(abs($2 - $1) == 1 ? '~' : ',').$2}eg; # abs for neg ranges
   $str =~ s/(\d+)~(?:[+-]?\d+~)+([+-]?\d+)/$1-$2/g;
   $str =~ tr/~/,/;
   return $str;

}

  1. Test and display

my @test = qw(0 1 2 4 6 7 8 11 12 14,

            15 16 17 18 19 20 21 22 23 24,
            25 27 28 29 30 31 32 33 35 36,
            37 38 39);

print rangext(@test), "\n";</lang>

Output:

0-2,4,6-8,11,12,14-25,27-33,35-39

Perl 6

<lang Perl6>sub range-extraction (*@ints) {

   my $prev = NaN;
   my @ranges;
   for @ints -> $int {
       if $int == $prev + 1 {
           @ranges[*-1].push: $int;
       }
       else {
           @ranges.push: [$int];
       }
       $prev = $int;
   }
   join ',', @ranges.map: -> @r { @r > 2 ?? "@r[0]-@r[*-1]" !! @r }

}

say range-extraction

   -6, -3, -2, -1, 0, 1, 3, 4, 5, 7, 8, 9, 10, 11, 14, 15, 17, 18, 19, 20;

say range-extraction

   0,  1,  2,  4,  6,  7,  8, 11, 12, 14,
   15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
   25, 27, 28, 29, 30, 31, 32, 33, 35, 36,
   37, 38, 39;</lang>

Output:

-6,-3-1,3-5,7-11,14,15,17-20
0-2,4,6-8,11,12,14-25,27-33,35-39

PicoLisp

<lang PicoLisp>(de rangeextract (Lst)

  (glue ","
     (make
        (while Lst
           (let (N (pop 'Lst)  M N)
              (while (= (inc M) (car Lst))
                 (setq M (pop 'Lst)) )
              (cond
                 ((= N M) (link N))
                 ((= (inc N) M) (link N M))
                 (T (link (list N '- M))) ) ) ) ) ) )</lang>

Output:

: (rangeextract
   (0 1 2 4 6 7 8 11 12 14 15 16 17 18 19 20 21 22
      23 24 25 27 28 29 30 31 32 33 35 36 37 38 39 ) )

-> "0-2,4,6-8,11,12,14-25,27-33,35-39"

PL/I

<lang PL/I> /* Modified 19 November 2011 to meet requirement that there be at */ /* least 3 items in a run. */ range_extraction: /* 17 August 2010 */

  procedure options (main);
  declare (c, d) character (1);
  declare (old, new, initial) fixed binary (31);
  declare in file;
  declare out file output;
  open file (in)  title ('/range2.dat,type(text),recsize(80)' );
  open file (out) output title ('/range2.out,type(text),recsize(70)');
  c = ' '; d = ',';
  get file (in) list (old);
  do forever;
     initial = old;
     on endfile (in) begin;
        put file (out) edit (c, trim(old)) (a);
        stop;
     end;
     get file (in) list (new);
     if new = old+1 then
        do; /* we have a run. */
           on endfile (in) begin;
              if old > initial+1 then d = '-';
                 put file (out) edit (c, trim(initial), d, trim(old) ) (a);
              stop;
           end;
           do while (new = old+1);
              old = new;
              get file (in) list (new);
           end;
           /* At this point, old holds the last in a run;           */
           /* initial holds the first in a run.                     */
           /* if there are only two members in a run, don't use the */
           /* range notation.                                       */
           if old > initial+1 then d = '-';
              put file (out) edit (c, trim(initial), d, trim(old) ) (a);
           old = new;
        end;
     else /* we have an isolated value. */
        do;
           put file (out) edit (c, trim(old)) (a);
           old = new;
        end;
     c, d = ',';
  end;

end range_extraction; </lang> OUTPUT 17/8/2010: <lang>

0-2,4,6-8,11-12,14-25,27-33,35-39

</lang> OUTPUT 19/11/2011: <lang>

0-2,4,6-8,11,12,14-25,27-33,35-39

</lang>

Prolog

Works with SWI-Prolog and library clpfd.
The code uses three predicates extract_Range/2, study_Range/2 and pack_Range/2.
Every predicate works in both directions arg1 towards arg2 and arg2 towards arg1, so that Range extraction and Range expansion work with the same predicates but in reverse order. <lang Prolog>range_extract :- L = [0, 1, 2, 4, 6, 7, 8, 11, 12, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 27, 28, 29, 30, 31, 32, 33, 35, 36, 37, 38, 39] , writeln(L), pack_Range(L, LP), maplist(study_Range, R, LP), extract_Range(LA, R), atom_chars(A, LA), writeln(A).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % extract_Range(?In, ?Out) % In  : '-6,-3--1,3-5,7-11,14,15,17-20' => % Out : [-6], [-3--1], [3-5],[7-11], [14],[15], [17-20] % extract_Range([], []).


extract_Range(X , [Range | Y1]) :- get_Range(X, U-U, Range, X1), extract_Range(X1, Y1).


get_Range([], Range-[], Range, []). get_Range([','|B], Range-[], Range, B) :- !.

get_Range([A | B], EC, Range, R) :- append_dl(EC, [A | U]-U, NEC), get_Range(B, NEC, Range, R).


append_dl(X-Y, Y-Z, X-Z).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % study Range(?In, ?Out) % In  : [-6] % Out : [-6,-6] % % In  : [-3--1] % Out : [-3, -1] % study_Range(Range1, [Deb, Deb]) :-

      catch(number_chars(Deb, Range1), Deb, false).

study_Range(Range1, [Deb, Fin]) :-

      append(A, ['-'|B], Range1),
      A \= [],
      number_chars(Deb, A),
      number_chars(Fin, B).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %

- use_module(library(clpfd)).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % Pack Range(?In, ?Out) % In  : -6, % Out : [-6] % % In  : -3, -2,-1 % Out : [-3,-1] % pack_Range([],[]).

pack_Range([X|Rest],[[X | V]|Packed]):-

   run(X,Rest, [X|V], RRest),
   pack_Range(RRest,Packed).


run(Fin,[Other|RRest], [Deb, Fin],[Other|RRest]):- Fin #\= Deb, Fin #\= Deb + 1, Other #\= Fin+1.

run(Fin,[],[_Var, Fin],[]).

run(Var,[Var1|LRest],[Deb, Fin], RRest):- Fin #\= Deb, Fin #\= Deb + 1, Var1 #= Var + 1, run(Var1,LRest,[Deb, Fin], RRest).

run(Val,[Other|RRest], [Val, Val],[Other|RRest]). </lang>

OutPut :

?- range_extract.
[0,1,2,4,6,7,8,11,12,14,15,16,17,18,19,20,21,22,23,24,25,27,28,29,30,31,32,33,35,36,37,38,39]
0-2,4,6-8,11,12,14-25,27-33,35-39
true

PureBasic

Even though the example integer list only includes ascending ranges this code will also handles descending ranges. <lang PureBasic>DataSection

 Data.i  33 ;count of elements to be read
 Data.i  0,  1,  2,  4,  6,  7,  8, 11, 12, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24
 Data.i  25, 27, 28, 29, 30, 31, 32, 33, 35, 36, 37, 38, 39

EndDataSection

NewList values()

setup list

Define elementCount, i Read.i elementCount For i = 1 To elementCount

 AddElement(values()): Read.i values()

Next

Procedure.s rangeExtract(List values())

 Protected listSize = ListSize(values()) - 1
 Protected rangeMarker, rangeStart, rangeIncrement, retraceSteps, rangeSize, endOfRange, output.s, sub.s
 
 ForEach values()
   rangeStart = values(): 
   sub = Str(rangeStart)
   If NextElement(values())
     retraceSteps = 1
     rangeIncrement = values() - rangeStart
     If rangeIncrement = 1 Or rangeIncrement = -1
       ;found start of possible range
       If ListIndex(values()) <> listSize
         retraceSteps = 2
         rangeSize = 2
         endOfRange = #False
         rangeMarker = values()
         While NextElement(values())
           If values() - rangeMarker <> rangeIncrement
             endOfRange = #True
             Break
           EndIf
           rangeSize + 1
           rangeMarker = values()
         Wend
         
         If rangeSize > 2
           sub = Str(rangeStart) + "-" + Str(rangeMarker)
           If Not endOfRange
             retraceSteps = 0 ;at end of list
           Else
             retraceSteps = 1
           EndIf 
         EndIf
       EndIf 
     EndIf
     
     ;return to the value before look-aheads
     While retraceSteps > 0
       PreviousElement(values()): retraceSteps - 1
     Wend 
   EndIf
   
   output + sub + "," 
 Next
 
 ProcedureReturn RTrim(output, ",")

EndProcedure

If OpenConsole()

 PrintN(rangeExtract(values()))
 
 Print(#CRLF$ + #CRLF$ + "Press ENTER to exit")
 Input()
 CloseConsole()

EndIf</lang> Sample output:

0-2,4,6-8,11,12,14-25,27-33,35-39

Python

<lang python>def range_extract(lst):

   'Yield 2-tuple ranges or 1-tuple single elements from list of increasing ints'
   lenlst = len(lst)
   i, ranges = 0, []
   while i< lenlst:
       low = lst[i]
       while i <lenlst-1 and lst[i]+1 == lst[i+1]: i +=1
       hi = lst[i]
       if   hi - low >= 2:
           yield (low, hi)
       elif hi - low == 1:
           yield (low,)
           yield (hi,)
       else:
           yield (low,)
       i += 1

def printr(ranges):

   print( ','.join( (('%i-%i' % r) if len(r) == 2 else '%i' % r)
                    for r in ranges ) )

if __name__ == '__main__':

   for lst in [[-8, -7, -6, -3, -2, -1, 0, 1, 3, 4, 5, 7,
                8, 9, 10, 11, 14, 15, 17, 18, 19, 20],
               [0, 1, 2, 4, 6, 7, 8, 11, 12, 14, 15, 16, 17, 18, 19, 20, 21, 22,
                23, 24, 25, 27, 28, 29, 30, 31, 32, 33, 35, 36, 37, 38, 39]]:
       #print(list(range_extract(lst)))
       printr(range_extract(lst))</lang>
Output:
-8--6,-3-1,3-5,7-11,14,15,17-20
0-2,4,6-8,11,12,14-25,27-33,35-39

Output if the printr(...) statement is commented-out instead of the print(...) statement directly above it.
This shows the tuples yielded by generator function range_extract.

[(-8, -6), (-3, 1), (3, 5), (7, 11), (14,), (15,), (17, 20)]
[(0, 2), (4,), (6, 8), (11,), (12,), (14, 25), (27, 33), (35, 39)]

Qi

<lang qi> (define make-range

 Start Start -> ["," Start]
 Start End   -> ["," Start "," End] where (= End (+ Start 1))
 Start End   -> ["," Start "-" End])

(define range-extract-0

 Start End []     -> (make-range Start End)
 Start End [A|As] -> (range-extract-0 Start A As) where (= (+ 1 End) A)
 Start End [A|As] -> (append (make-range Start End) (range-extract-0 A A As)))

(define range-extract

 [A |As] -> (FORMAT NIL "~{~a~}" (tail (range-extract-0 A A As))))

(range-extract [ 0 1 2 4 6 7 8 11 12 14

               15 16 17 18 19 20 21 22 23 24
               25 27 28 29 30 31 32 33 35 36
               37 38 39])

</lang>

Output:

0-2,4,6-8,11,12,14-25,27-33,35-39

Racket

<lang Racket>

  1. lang racket

(define (list->ranges xs)

 (define (R lo hi)
   (if (= lo hi) (~a lo) (~a lo (if (= 1 (- hi lo)) "," "-") hi)))
 (let loop ([xs xs] [lo #f] [hi #f] [r '()])
   (cond [(null? xs) (string-join (reverse (if lo (cons (R lo hi) r) r)) ",")]
         [(not hi) (loop (cdr xs) (car xs) (car xs) r)]
         [(= 1 (- (car xs) hi)) (loop (cdr xs) lo (car xs) r)]
         [else (loop xs #f #f (cons (R lo hi) r))])))

(list->ranges '(0 1 2 4 6 7 8 11 12 14 15 16 17 18 19 20 21 22 23

               24 25 27 28 29 30 31 32 33 35 36 37 38 39))
-> "0-2,4,6-8,11,12,14-25,27-33,35-39"

</lang>

REXX

Note that   11 and 12   are not considered a range.

version 1

This REXX version isn't limited to integers. <lang>/*REXX program creates a range extraction from a list of integers. */ old=0 1 2 4 6 7 8 11 12 14 15 16 17 18 19 20 21 22 23 24 25 27 28 29 30 31 32 33 35 36 37 38 39 w=words(old) /*number of integers in the list.*/ new= /*new list (maybe with ranges). */

    do j=1  to w;       x=word(old,j) /*get the Jth number in the list.*/
    new=new',' x                      /*append  Jth number to new list.*/
    inc=1;     g=                     /*start with an increment of one.*/
        do k=j+1  to w; y=word(old,k) /*get the Kth number in the list.*/
        if y\=x+inc     then leave    /*is this number ¬> prev by inc ?*/
        inc=inc+1;      g=y           /*increase range, assign g (good)*/
        end   /*k*/
    if k-1=j | g=x+1   then iterate   /*range= 0|1?  Then keep truckin'*/
    new=new'-'g                       /*indicate a range of numbers.   */
    j  =k-1                           /*changing the  J  DO loop index.*/
    end     /*j*/

new=space(substr(new, 2), 0) /*elide leading comma, all blanks*/ say 'old:' old /*show the old range of numbers. */ say 'new:' new /*display new list of numbers. */

                                      /*stick a fork in it, we're done.*/</lang>

output

old: 0 1 2 4 6 7 8 11 12 14 15 16 17 18 19 20 21 22 23 24 25 27 28 29 30 31 32 33 35 36 37 38 39
new: 0-2,4,6-8,11,12,14-25,27-33,35-39

version 1a

The REXX version is the same as above, but doesn't modify a DO loop's index (j). <lang>/*REXX program creates a range extraction from a list of integers. */ old=0 1 2 4 6 7 8 11 12 14 15 16 17 18 19 20 21 22 23 24 25 27 28 29 30 31 32 33 35 36 37 38 39 w=words(old); j=0 /*number of integers in the list.*/ new= /*new list (maybe with ranges). */

   do while j<w; j=j+1; x=word(old,j) /*get the Jth number in the list.*/
   new=new',' x                       /*append  Jth number to new list.*/
   inc=1;     g=                      /*start with an increment of one.*/
       do k=j+1  to w; y=word(old,k)  /*get the Kth number in the list.*/
       if y\=x+inc     then leave     /*is this number ¬> prev by inc ?*/
       inc=inc+1;      g=y            /*increase range, assign g (good)*/
       end   /*k*/
   if k-1=j | g=x+1   then iterate    /*range= 0|1?  Then keep truckin'*/
   new=new'-'g                        /*indicate a range of numbers.   */
   j  =k-1                            /*which number to examine next.  */
   end     /*while*/

new=space(substr(new, 2), 0) /*elide leading comma, all blanks*/ say 'old:' old /*show the old range of numbers. */ say 'new:' new /*display new list of numbers. */

                                      /*stick a fork in it, we're done.*/</lang>

output is the same as above.

version 2

Somewhat simplified !?! <lang rexx>/*REXX program to test range extraction. ******************************

  • 07.08.2012 Walter Pachl
                                                                                                                                            • /

aaa='0 1 2 4 6 7 8 11 12 14 15 16 17 18 19 20 21 22 23 24 25 27 28 29',

   '30 31 32 33 35 36 37 38 39'

say 'old='aaa; aaa=aaa 1e99 /* artificial number at the end */ i=0 /* initialize index */ ol= /* initialize output string */ comma= /* will become a ',' lateron */ inrange=0 Do While i<=words(aaa) /* loop for all numbers */

 i=i+1                             /* index of next number          */
 n=word(aaa,i)                     /* the now current number        */
 If n=1e99 Then Leave              /* we are at the end             */
 If inrange Then Do                /* range was opened              */
   If word(aaa,i+1)<>n+1 Then Do   /* following word not in range   */
     ol=ol||n                      /* so this number is the end     */
     inrange=0                     /* and the range is over         */
     End                           /* else ignore current number    */
   End
 Else Do                           /* not in a range                */
   ol=ol||comma||n                 /* add number (with comma)       */
   comma=','                       /* to the output string          */
   If word(aaa,i+2)=n+2 Then Do    /* if the nr after the next fits */
     inrange=1                     /* open a range                  */
     ol=ol'-'                      /* append the range connector    */
     End
   End
 End

Say 'new='ol </lang> Output is the same as above.

Ruby

<lang ruby>def range_extract(l)

 sorted = l.sort
 range = []
 start = sorted.first
 # pad the list with a big value, so that the last loop iteration will 
 # appended something to the range
 sorted.concat([Float::MAX]).each_cons(2) do |prev,n|
   if prev.succ < n
     if start == prev
       range << start.to_s
     else
       range << "%d%s%d" % [start, (start.succ == prev ? "," : "-"), prev]
     end
     start = n
   end
 end
 range.join(',')

end

lst = [

   0,  1,  2,  4,  6,  7,  8, 11, 12, 14,
  15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
  25, 27, 28, 29, 30, 31, 32, 33, 35, 36,
  37, 38, 39

]

p rng = range_extract(lst)</lang>

output:

"0-2,4,6-8,11,12,14-25,27-33,35-39"

Scala

<lang scala>object Range {

  def spanRange(ls:List[Int])={
    var last=ls.head
    ls span {x => val b=x<=last+1; last=x; b}
  }
  def toRangeList(ls:List[Int]):List[List[Int]]=ls match {
     case Nil => List()
     case _ => spanRange(ls) match {
        case (range, Nil) => List(range)
        case (range, rest) => range :: toRangeList(rest)
     }
  }
  def toRangeString(ls:List[List[Int]])=ls map {r=>
     if(r.size<3) r mkString ","
     else r.head + "-" + r.last
  } mkString ","
  def main(args: Array[String]): Unit = {
     var l=List(0, 1, 2, 4, 6, 7, 8, 11, 12, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25,
                27, 28, 29, 30, 31, 32, 33, 35, 36, 37, 38, 39)
     println(toRangeString(toRangeList(l)))
  }

}</lang>

Output:

0-2,4,6-8,11,12,14-25,27-33,35-39

Scheme

Translation of: Qi

<lang scheme> (define (make-range start end)

 (cond ((= start end)
        `("," ,start))
       ((= end (+ start 1))
        `("," ,start "," ,end))
       (else
        `("," ,start "-" ,end))))

(define (range-extract-0 start end a)

 (cond ((null? a)
        (make-range start end))
       ((= (+ 1 end) (car a))
        (range-extract-0 start (car a) (cdr a)))
       (else
        (append (make-range start end)
                (range-extract-0 (car a) (car a) (cdr a))))))

(define (range-extract a)

 (apply string-append (map (lambda (x)
                             (if (number? x)
                                 (number->string x)
                                 x))
                           (cdr (range-extract-0 (car a) (car a) (cdr a))))))

(range-extract '( 0 1 2 4 6 7 8 11 12 14

                15 16 17 18 19 20 21 22 23 24
                25 27 28 29 30 31 32 33 35 36
                37 38 39))

</lang>

Outputs:

0-2,4,6-8,11,12,14-25,27-33,35-39

Seed7

<lang seed7>$ include "seed7_05.s7i";

const func string: rangeExtraction (in array integer: numbers) is func

 result
   var string: rangeStri is "";
 local
   var integer: index is 1;
   var integer: index2 is 1;
 begin
   while index <= length(numbers) do
     while index2 <= pred(length(numbers)) and numbers[succ(index2)] = succ(numbers[index2]) do
       incr(index2);
     end while;
     if succ(index) < index2 then
       rangeStri &:= "," <& numbers[index] <& "-" <& numbers[index2];
     else
       while index <= index2 do
         rangeStri &:= "," <& numbers[index];
         incr(index);

end while;

     end if;
     incr(index2);
     index := index2;
   end while;
   rangeStri := rangeStri[2 ..];
 end func;

const proc: main is func

 begin
   writeln(rangeExtraction([] (0, 1, 2, 4, 6, 7, 8, 11, 12, 14, 15, 16, 17, 18, 19,
       20, 21, 22, 23, 24, 25, 27, 28, 29, 30, 31, 32, 33, 35, 36, 37, 38, 39)));
 end func;</lang>

Output:

0-2,4,6-8,11,12,14-25,27-33,35-39

SNOBOL4

Translation of: Perl
Works with: Macro Spitbol
Works with: CSnobol

Handles +/- and negative ranges.

<lang SNOBOL4>* # Absolute value

       define('abs(n)') :(abs_end)

abs abs = ~(abs = lt(n,0) -n) n :(return) abs_end

       define('rangext(str)d1,d2') :(rangext_end)

rangext num = ('+' | '-' | ) span('0123456789') rxt1 str ',' span(' ') = ' ' :s(rxt1) rxt2 str num . d1 ' ' num . d2 = + d1 ('~,' ? *eq(abs(d2 - d1),1) '~' | ',') d2 :s(rxt2) rxt3 str ('~' | '-') num '~' = '-' :s(rxt3) rxt4 str '~' = ',' :s(rxt4)

       rangext = str :(return)

rangext_end

  • # Test and display
       test =  '0,  1,  2,  4,  6,  7,  8, 11, 12, 14, '

+ '15, 16, 17, 18, 19, 20, 21, 22, 23, 24, ' + '25, 27, 28, 29, 30, 31, 32, 33, 35, 36, ' + '37, 38, 39'

       output = rangext(test)

end</lang>

Output:

0-2,4,6-8,11,12,14-25,27-33,35-39

Tcl

<lang tcl>proc rangeExtract list {

   set result [lindex $list 0]
   set first [set last [lindex $list 0]]
   foreach term [lrange $list 1 end] {

if {$term == $last+1} { set last $term continue } if {$last > $first} { append result [expr {$last == $first+1 ? "," : "-"}] $last } append result "," $term set first [set last $term]

   }
   if {$last == $first+1} {

append result "," $last

   } elseif {$last > $first} {

append result "-" $last

   }
   return $result

}

  1. Commas already removed so it is a natural Tcl list

puts [rangeExtract {

   0 1 2 4 6 7 8 11 12 14
   15 16 17 18 19 20 21 22 23 24
   25 27 28 29 30 31 32 33 35 36
   37 38 39

}]</lang> Output:

0-2,4,6-8,11,12,14-25,27-33,35-39

TUSCRIPT

TUSCRIPT has a built-in routine "COMBINE" that combines a range of integers by a dash '-'. It is possible to differ between every range that expands more than two values (6-8), and every range that expands less than two values (11,12 are not combined). <lang tuscript> $$ MODE TUSCRIPT MODE DATA $$ numbers=* 0, 1, 2, 4, 6, 7, 8, 11, 12, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 27, 28, 29, 30, 31, 32, 33, 35, 36, 37, 38, 39 $$ MODE TUSCRIPT numbers=EXCHANGE (numbers,":,><<> :':") unrangednrs=JOIN (numbers,"") rangednrs=COMBINE (unrangednrs,"") rangednrs=EXCHANGE (rangednrs,":':,:") PRINT rangednrs </lang> Output:

0-2,4,6-8,11,12,14-25,27-33,35-39

Solution without COMBINE <lang tuscript> $$ MODE TUSCRIPT MODE DATA $$ numbers=* 0, 1, 2, 4, 6, 7, 8, 11, 12, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 27, 28, 29, 30, 31, 32, 33, 35, 36, 37, 38, 39 $$ MODE TUSCRIPT numbers=EXCHANGE (numbers,":,><<> :':") unrangednrs=JOIN (numbers,"")

help = APPEND (unrangednrs, "999999999") rest = REMOVE (help, 1, n_1) n_2 = n_1, n_3= n_2 + 1,rangednrs= "" LOOP n= rest

IF (n!=n_3)  THEN
   rangednrs = APPEND (rangednrs, n_1)
   IF (n_1!=n_2) THEN
   range=n_1+1
     IF (range==n_2) THEN
     rangednrs = APPEND (rangednrs,n_2)
     ELSE
     rangednrs = CONCAT (rangednrs, "-", n_2)
     ENDIF
   ENDIF
   n_1 = n
ENDIF
n_2 = n, n_3 = n_2 + 1

ENDLOOP rangednrs=EXCHANGE (rangednrs,":':,:") PRINT rangednrs


</lang> Output:

0-2,4,6-8,11,12,14-25,27-33,35-39

UNIX Shell

Works with: bash

<lang bash>#!/usr/bin/bash

range_contract () (

   add_range () {
       case $(( current - range_start )) in
           0) ranges+=( $range_start )          ;;
           1) ranges+=( $range_start $current ) ;;
           *) ranges+=("$range_start-$current") ;;
       esac
   }
   ranges=()
   range_start=$1
   current=$1
   shift
   for number; do
       if (( number > current+1 )); then
           add_range
           range_start=$number
       fi
       current=$number
   done
   add_range
   x="${ranges[@]}"
   echo ${x// /,}

)

range_contract 0 1 2 4 6 7 8 11 12 14 15 16 17 18 19 20 21 22 23 24 25 27 28 29 30 31 32 33 35 36 37 38 39</lang>

Output:
0-2,4,6-8,11,12,14-25,27-33,35-39

Ursala

<lang Ursala>#import std

  1. import int

x = <0,1,2,4,6,7,8,11,12,14,15,16,17,18,19,20,21,22,23,24,25,27,28,29,30,31,32,33,35,36,37,38,39>

f = mat`,+ ==?(~&l,^|T/~& :/`-)*bhPS+ %zP~~hzX*titZBPiNCSiNCQSL+ rlc ^|E/~& predecessor

  1. show+

t = <f x></lang>

output:

0-2,4,6-8,11,12,14-25,27-33,35-39

VBA

<lang vb> Public Function RangeExtraction(AList) As String 'AList is a variant that is an array, assumed filled with numbers in ascending order Const RangeDelim = "-" 'range delimiter Dim result As String Dim InRange As Boolean Dim Posn, ub, lb, rangestart, rangelen As Integer

result = "" 'find dimensions of AList ub = UBound(AList) lb = LBound(AList) Posn = lb While Posn < ub

 rangestart = Posn
 rangelen = 0
 InRange = True
 'try to extend the range
 While InRange
   rangelen = rangelen + 1
   If Posn = ub Then
     InRange = False
   Else
     InRange = (AList(Posn + 1) = AList(Posn) + 1)
     Posn = Posn + 1
   End If
 Wend
 If rangelen > 2 Then 'output the range if it has more than 2 elements
   result = result & "," & Format$(AList(rangestart)) & RangeDelim & Format$(AList(rangestart + rangelen - 1))
 Else 'output the separate elements
   For i = rangestart To rangestart + rangelen - 1
     result = result & "," & Format$(AList(i))
   Next
 End If
 Posn = rangestart + rangelen

Wend RangeExtraction = Mid$(result, 2) 'get rid of first comma! End Function


Public Sub RangeTest() 'test function RangeExtraction 'first test with a Variant array Dim MyList As Variant MyList = Array(0, 1, 2, 4, 6, 7, 8, 11, 12, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 27, 28, 29, 30, 31, 32, 33, 35, 36, 37, 38, 39) Debug.Print "a) "; RangeExtraction(MyList)

'next test with an array of integers Dim MyOtherList(1 To 20) As Integer MyOtherList(1) = -6 MyOtherList(2) = -3 MyOtherList(3) = -2 MyOtherList(4) = -1 MyOtherList(5) = 0 MyOtherList(6) = 1 MyOtherList(7) = 3 MyOtherList(8) = 4 MyOtherList(9) = 5 MyOtherList(10) = 7 MyOtherList(11) = 8 MyOtherList(12) = 9 MyOtherList(13) = 10 MyOtherList(14) = 11 MyOtherList(15) = 14 MyOtherList(16) = 15 MyOtherList(17) = 17 MyOtherList(18) = 18 MyOtherList(19) = 19 MyOtherList(20) = 20 Debug.Print "b) "; RangeExtraction(MyOtherList) End Sub </lang>

Output:

RangeTest
a) 0-2,4,6-8,11,12,14-25,27-33,35-39
b) -6,-3-1,3-5,7-11,14,15,17-20