Range extraction: Difference between revisions
(→{{header|Emacs Lisp}}: Correction and new version) |
|||
Line 1,321: | Line 1,321: | ||
(defun abcd (a c ls) |
(defun abcd (a c ls) |
||
(if ls |
(if ls (if (= (+ c 1) (car ls) ) |
||
(abcd a (car ls) (cdr ls) ) |
|||
( |
(format "%d-%d,%s" a c (ab (car ls) (cdr ls) ))) |
||
(format "%d-%d,%s" a c (ab (car ls) (cdr ls) ))) |
|||
(format "%d-%d" a c) )) |
(format "%d-%d" a c) )) |
||
Revision as of 08:07, 7 August 2015
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. (The correct answer is:
0-2,4,6-8,11,12,14-25,27-33,35-39
.)
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>
- 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>text rp(...) {
integer i, j; data b; text f;
i = 0; j = 0; while (i < count()) { while (j < count() - 1) { if (__integer($(j + 1)) == __integer($j) + 1) { j += 1; } else { break; } } if (i + 1 < j) { b_form(b, "%s%d-%d", f, $i, $j); f = ","; } else { while (i < j + 1) { b_form(b, "%s%d", f, $i); f = ","; i += 1; } }
j += 1; i = j;
}
return b_string(b);
}
integer main(void) {
o_form("%s\n", 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));
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
- 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;
- 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
);
- OP REPR = (RANGE range)STRING: range repr(range); # # firmly related to UNIRANGE #
- 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 #
- The closest thing Algol68 has to inheritance is the UNION #
MODE UNIRANGELISTS = UNION(UNIRANGELIST, RANGELIST, SCALARLIST);
PROC unirange list repr = (UNIRANGELIST unirange list)STRING: (
- 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: (
- 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 #
- some simple test cases: #
MODE SCALAR = INT; PR READ "Template_Range_extraction_Iterative.a68" PR
- 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 #
- 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
- 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:
- Iterate through three different types of initial arrays - []int, []range and []unirange with gen range, yielding range(lwb,upb)
- Iterate with gen range merge yielding merged range(lwb,upb)
- Iterate with gen unirange merge, merging and yielding a union of int and range
- 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:
- Take a []SCALAR, []RANGE or []URANGE, and generatively yield an unnormalised RANGE ###
FOR key FROM LWB unirange list TO UPB unirange list DO
- 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: (
- Take a []SCALAR, []RANGE or []URANGE , and generatively yield a normalised RANGE ###
UNION(VOID, RANGE) prev range := EMPTY;
- FOR RANGE next range IN # gen range(unirange list, # ) DO #
- (RANGE next range)VOID:
- 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
- OD # );
CASE prev range IN (RANGE last range): yield(last range) ESAC
);
PROC gen unirange merge = (UNIRANGELISTS unirange list, YIELDUNIRANGE yield)VOID: (
- 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: (
- 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;
- FOR UNIRANGE unirange IN # gen unirange merge(unirange list, # ) DO #
- (UNIRANGE unirange)VOID:
out unirange list[upb out unirange list+:=1] := unirange
- 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 that 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>
- 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>
- include <stdlib.h>
size_t rprint(char *s, int *x, int len) {
- define sep (a > s ? "," : "") /* use comma except before first output */
- 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;
- undef sep
- 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:
0-2,4,6-8,11,12,14-25,27-33,35-39
C++
<lang cpp>
- include <iostream>
- include <iterator>
- 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#
<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
C#: Alternate Version
<lang csharp>using System; using System.Collections.Generic; using System.Linq;
namespace RangeExtraction {
internal static class ListExtensions { internal static string ExtractRange(this IEnumerable<int> values) { var list = values.Distinct().OrderBy(_ => _).ToArray(); var ranges = new int[0][].AsEnumerable(); var current = 0; for (var i = 1; ; ++i) { if (i >= list.Length) { ranges = ranges.Concat(new[] { new[] { i != current ? current : i - 1, i - 1 } }); break; } if (list[i] == list[i - 1] + 1) continue; ranges = ranges.Concat(new[] { new[] { current, i - 1 } }); current = i; } return string.Join(",", ranges.Select(r => string.Format(r[0] == r[1] ? "{0}" : "{0}-{1}", list[r[0]], list[r[1]]))); } }
internal class Program { private static readonly IList<int> VALUES = new[] { 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 void Main(string[] args) { var rangestr = VALUES.ExtractRange(); Console.WriteLine("values: {{{0}}}", string.Join(", ", VALUES.Select(_=>_.ToString()))); Console.WriteLine("\r\nranges = \"{0}\"", rangestr); } }
}</lang>
- Output:
values: {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"
COBOL
<lang cobol> IDENTIFICATION DIVISION.
PROGRAM-ID. extract-range-task. DATA DIVISION. WORKING-STORAGE SECTION. 01 data-str PIC X(200) VALUE "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". 01 result PIC X(200). PROCEDURE DIVISION. CALL "extract-range" USING CONTENT data-str, REFERENCE result DISPLAY FUNCTION TRIM(result) GOBACK . END PROGRAM extract-range-task. IDENTIFICATION DIVISION. PROGRAM-ID. extract-range. DATA DIVISION. LOCAL-STORAGE SECTION. COPY "nums-table.cpy". 01 difference PIC 999. 01 rng-begin PIC S999. 01 rng-end PIC S999. 01 num-trailing PIC 999. 01 trailing-comma-pos PIC 999.
LINKAGE SECTION. 01 nums-str PIC X(200). 01 extracted-range PIC X(200). 01 extracted-range-len CONSTANT LENGTH extracted-range.
PROCEDURE DIVISION USING nums-str, extracted-range. CALL "split-nums" USING CONTENT nums-str, ", ", REFERENCE nums-table *> Process the table MOVE nums (1) TO rng-begin PERFORM VARYING nums-idx FROM 2 BY 1 UNTIL num-nums < nums-idx SUBTRACT nums (nums-idx - 1) FROM nums (nums-idx) GIVING difference *> If number is more than one away from the previous one *> end the range and start a new one. IF difference > 1 MOVE nums (nums-idx - 1) TO rng-end CALL "add-next-range" USING CONTENT rng-begin, rng-end, REFERENCE extracted-range MOVE nums (nums-idx) TO rng-begin END-IF END-PERFORM *> Process the last number MOVE nums (num-nums) TO rng-end CALL "add-next-range" USING CONTENT rng-begin, rng-end, REFERENCE extracted-range *> Remove trailing comma. CALL "find-num-trailing-spaces" USING CONTENT extracted-range, REFERENCE num-trailing COMPUTE trailing-comma-pos = extracted-range-len - num-trailing MOVE SPACE TO extracted-range (trailing-comma-pos:1) GOBACK . IDENTIFICATION DIVISION. PROGRAM-ID. split-nums INITIAL. DATA DIVISION. WORKING-STORAGE SECTION. 01 num-len PIC 9. 01 next-num-pos PIC 999. LINKAGE SECTION. 01 str PIC X(200). 01 delim PIC X ANY LENGTH. COPY "nums-table.cpy". PROCEDURE DIVISION USING str, delim, nums-table. INITIALIZE num-nums PERFORM UNTIL str = SPACES INITIALIZE num-len INSPECT str TALLYING num-len FOR CHARACTERS BEFORE delim ADD 1 TO num-nums *> If there are no more instances of delim in the string, *> add the rest of the string to the last element of the *> table. IF num-len = 0 MOVE str TO nums (num-nums) EXIT PERFORM ELSE MOVE str (1:num-len) TO nums (num-nums) ADD 3 TO num-len GIVING next-num-pos MOVE str (next-num-pos:) TO str END-IF END-PERFORM . END PROGRAM split-nums. IDENTIFICATION DIVISION. PROGRAM-ID. add-next-range INITIAL.
DATA DIVISION. WORKING-STORAGE SECTION. 01 num-trailing PIC 999. 01 start-pos PIC 999. 01 range-len PIC 999. 01 begin-edited PIC -ZZ9. 01 end-edited PIC -ZZ9.
LINKAGE SECTION. 01 rng-begin PIC S999. 01 rng-end PIC S999. 01 extracted-range PIC X(200).
01 extracted-range-len CONSTANT LENGTH extracted-range. PROCEDURE DIVISION USING rng-begin, rng-end, extracted-range. CALL "find-num-trailing-spaces" USING CONTENT extracted-range, REFERENCE num-trailing COMPUTE start-pos = extracted-range-len - num-trailing + 1 SUBTRACT rng-begin FROM rng-end GIVING range-len MOVE rng-begin TO begin-edited MOVE rng-end TO end-edited
EVALUATE TRUE WHEN rng-begin = rng-end STRING FUNCTION TRIM(begin-edited), "," INTO extracted-range (start-pos:) WHEN range-len = 1 STRING FUNCTION TRIM(begin-edited), ",", FUNCTION TRIM(end-edited), "," INTO extracted-range (start-pos:) WHEN OTHER STRING FUNCTION TRIM(begin-edited), "-", FUNCTION TRIM(end-edited), "," INTO extracted-range (start-pos:) END-EVALUATE . END PROGRAM add-next-range. IDENTIFICATION DIVISION. PROGRAM-ID. find-num-trailing-spaces. DATA DIVISION. LINKAGE SECTION. 01 str PIC X(200). 01 num-trailing PIC 999. PROCEDURE DIVISION USING str, num-trailing. INITIALIZE num-trailing INSPECT str TALLYING num-trailing FOR TRAILING SPACES . END PROGRAM find-num-trailing-spaces. END PROGRAM extract-range.</lang>
nums-table.cpy: <lang cobol> 01 nums-table.
03 num-nums PIC 999. 03 nums-area. 05 nums PIC S999 OCCURS 1 TO 100 TIMES DEPENDING ON num-nums INDEXED BY nums-idx.</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, std.range;
string rangeExtraction(in int[] items) in {
assert(items.isSorted);
} body {
if (items.empty) return null; auto ranges = [[items[0].text]];
foreach (immutable x, immutable y; items.zip(items[1 .. $])) if (x + 1 == y) ranges[$ - 1] ~= y.text; else ranges ~= [y.text];
return ranges .map!(r => r.length > 2 ? r[0] ~ "-" ~ r.back : r.join(',')) .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]]) data.rangeExtraction.writeln;
}</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])
- value: "0-2,4,6-8,11,12,14-25,27-33,35-39"
</lang>
Eiffel
<lang Eiffel> class RANGE
create make
feature make local extended_range: STRING do extended_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("Extended range: " + extended_range + "%N") print("Extracted range: " + extracted_range(extended_range) + "%N%N") end
feature extracted_range(sequence: STRING): STRING local elements: LIST[STRING] first, curr: STRING subrange_size, index: INTEGER do sequence.replace_substring_all (", ", ",") elements := sequence.split (',') from index := 2 first := elements.at (1) subrange_size := 0 Result := "" until index > elements.count loop curr := elements.at (index) if curr.to_integer - first.to_integer - subrange_size = 1 then subrange_size := subrange_size + 1 else Result.append(first) if (subrange_size <= 1) then Result.append (", ") else Result.append (" - ") end if (subrange_size >= 1) then Result.append ((first.to_integer + subrange_size).out) Result.append (", ") end
first := curr subrange_size := 0 end index := index + 1 end Result.append(first) if (subrange_size <= 1) then Result.append (", ") else Result.append (" - ") end if (subrange_size >= 1) then Result.append ((first.to_integer + subrange_size).out) end end end </lang>
- Output:
Extended 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 Extracted range: 0 - 2, 4, 6 - 8, 11, 12, 14 - 25, 27 - 33, 35 - 39
Elixir
<lang elixir>defmodule RC do def range_extract(list) do max = Enum.max(list) + 2 sorted = Enum.sort([max|list]) canidate_number = hd(sorted) current_number = hd(sorted) extract(tl(sorted), canidate_number, current_number, []) end defp extract([], _, _, range), do: Enum.reverse(range) |> Enum.join(",") defp extract([next|rest], canidate, current, range) when current+1 >= next do extract(rest, canidate, next, range) end defp extract([next|rest], canidate, current, range) when canidate == current do extract(rest, next, next, [to_string(current)|range]) end defp extract([next|rest], canidate, current, range) do seperator = if canidate+1 == current, do: ",", else: "-" str = "#{canidate}#{seperator}#{current}" extract(rest, next, next, [str|range]) end
end
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
] IO.inspect RC.range_extract(list)</lang>
- Output:
"0-2,4,6-8,11,12,14-25,27-33,35-39"
Emacs Lisp
version 1
gnus-range.el
which is part of the Gnus newsreader can collapse numbers to ranges. The stringize here is similar to imap-range-to-message-set
from imap.el
.
<lang Emacs Lisp}>
(require 'gnus-range)
(defun rangext (lst)
(mapconcat (lambda (item) (if (consp item)
(if (= (+ 1 (car item) ) (cdr item) ) (format "%d,%d" (car item) (cdr item) ) (format "%d-%d" (car item) (cdr item) ))
(format "%d" item))) (gnus-compress-sequence lst) ","))
</lang>
version 2
<lang Emacs Lisp}> (setq max-lisp-eval-depth 10000)
(defun ab (a ls)
(if ls (if (= (+ a 1) (car ls) )
(abc a (car ls) (cdr ls) ) (format "%d,%s" a (ab (car ls) (cdr ls) )))
(format "%d" a) ))
(defun abc (a b ls)
(if ls (if (= (+ b 1) (car ls) )
(abcd a (car ls) (cdr ls) ) (format "%d,%d,%s" a b (ab (car ls) (cdr ls) )))
(format "%d,%d" a b) ))
(defun abcd (a c ls)
(if ls (if (= (+ c 1) (car ls) )
(abcd a (car ls) (cdr ls) ) (format "%d-%d,%s" a c (ab (car ls) (cdr ls) )))
(format "%d-%d" a c) ))
(defun rangext (ls)
(if ls (ab (car ls) (cdr ls) ) ""))
</lang> Eval: <lang Emacs Lisp}> (insert (rangext '(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
Erlang
<lang Erlang> -module( range ).
-export( [extraction/1, task/0] ).
extraction( [H | T] ) when is_integer(H) ->
Reversed_extracts = extraction_acc( lists:foldl(fun extraction/2, {H, []}, T) ), string:join( lists:reverse(Reversed_extracts), "," ).
task() ->
io:fwrite( "~p~n", [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])] ).
extraction( N, {Start, Acc} ) when N =:= Start + 1 -> {Start, N, Acc}; extraction( N, {Start, Acc} ) -> {N, extraction_acc( {Start, Acc} )}; extraction( N, {Start, Stop, Acc} ) when N =:= Stop + 1 -> {Start, N, Acc}; extraction( N, {Start, Stop, Acc} ) -> {N, extraction_acc( {Start, Stop, Acc} )}.
extraction_acc( {N, Acc} ) -> [erlang:integer_to_list(N) | Acc]; extraction_acc( {Start, Stop, Acc} ) when Stop > Start + 1 -> [erlang:integer_to_list(Start) ++ "-" ++ erlang:integer_to_list(Stop) | Acc]; extraction_acc( {Start, Stop, Acc} ) -> [erlang:integer_to_list(Stop), erlang:integer_to_list(Start) | Acc]. % Reversed </lang>
- Output:
19> range:task(). "0-2,4,6-8,11,12,14-25,27-33,35-39"
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>
- 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>
jq
<lang kq># Input should be an array def extract:
reduce .[] as $i # state is an array with integers or [start, end] ranges ([]; if length == 0 then [ $i ] else ( .[-1]) as $last | if ($last|type) == "array" then if ($last[1] + 1) == $i then setpath([-1,1]; $i) else . + [ $i ] end elif ($last + 1) == $i then setpath([-1]; [$last, $i]) else . + [ $i ] end end) | map( if type == "number" then tostring elif .[0] == .[1] -1 then "\(.[0]),\(.[1])" # satisfy special requirement else "\(.[0])-\(.[1])" end ) | join(",") ;</lang>
- Command and output:
$ jq -n -f extract_range.jq input.txt "0-2,4,6-8,11,12,14-25,27-33,35-39"
Julia
This is perhaps an idiosyncratic solution. Numbers inside of runs are replaced with Xs, the list is converted into a comma separated string, and then Xs and extra commas are replaced with the range character via a regular expression. <lang Julia> function sprintfrange{T<:Integer}(a::Array{T,1})
len = length(a) 0 < len || return "" dropme = falses(len) dropme[2:end-1] = Bool[a[i-1]==a[i]-1 && a[i+1]==a[i]+1 for i in 2:(len-1)] s = [string(i) for i in a] s[dropme] = "X" s = join(s, ",") replace(s, r",[,X]+,", "-")
end
testa = [ 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("Testing range-style formatting.") println(" ", testa, "\n =>\n ", sprintfrange(testa)) </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
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:
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"
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>
- Output:
0-2,4,6-8,11,12,14-25,27-33,35-39
LiveCode
Inefficient as it takes 2 passes <lang LiveCode>function rangeExtract nums
local prevNum, znums, rangedNums set itemDelimiter to ", " put the first item of nums into prevNum repeat for each item n in nums if n is (prevNum + 1) then put n into prevNum put "#" & n after znums else put n into prevNum put return & n after znums end if end repeat set itemDelimiter to "#" repeat for each line z in znums if z is empty then next repeat switch the number of items of z case 1 put z & "," after rangedNums break case 2 put item 1 of z & "," & item -1 of z & "," after rangedNums break default put item 1 of z & "-" & item -1 of z & "," after rangedNums end switch end repeat return char 1 to -2 of rangedNums --strip off trailing comma
end rangeExtract </lang> Test <lang LiveCode>command testRangeExtract
local numbers put "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" into numbers put rangeExtract(numbers)
end testRangeExtract</lang> Output: <lang LiveCode>0-2,4,6-8,11,12,14-25,27-33,35-39</lang>
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"
MATLAB / Octave
<lang MATLAB>function S=range_extraction(L)
% Range extraction L(end+1) = NaN; S = int2str(L(1)); k = 1; while (k < length(L)-1) if (L(k)+1==L(k+1) && L(k)+2==L(k+2) ) m = 2; while (L(k)+m==L(k+m)) m = m+1; end k = k+m-1; S = [S,'-',int2str(L(k))]; else k = k+1; S = [S,',',int2str(L(k))]; end end
end
disp(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 (Octave):
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
NetRexx
NetRexx Ver. 1
<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
NetRexx Ver. 2
<lang NetRexx>/* NetRexx */ options replace format comments java crossref symbols nobinary
runSample(arg) return
-- ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ -- Compact a list of numbers by reducing ranges method compact(expanded) public static
nums = expanded.changestr(',', ' ').space -- remove possible commas & clean up the string rezult =
RANGE = 0 FIRST = nums.word(1) -- set starting value loop i_ = 2 to nums.words -- each word in the string is a number to examine LOCAL = nums.word(i_) if LOCAL - FIRST - RANGE == 1 then do -- inside a range RANGE = RANGE + 1 end else do -- not inside a range if RANGE \= 0 then do -- we have a range of numbers so collect this and reset rezult = rezult || FIRST || delim(RANGE) || FIRST + RANGE || ',' RANGE = 0 end else do -- just collect this number rezult = rezult || FIRST || ',' end FIRST = LOCAL -- bump new starting value end end i_
if RANGE \= 0 then do -- terminating value is a range rezult = rezult || FIRST || delim(RANGE) || FIRST + RANGE end else do -- terminating value is a single number rezult = rezult || FIRST end
return rezult.space(1, ',') -- format and return result string
-- ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ -- determine if the range delimiter should be a comma or dash method delim(range) private static
if range == 1 then dlm = ',' else dlm = '-' return dlm
-- ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ -- sample driver method runSample(arg) public static
parse arg userInput td = 0 if userInput.words > 0 then do
-- use input from command line td[0] = td[0] + 1; r_ = td[0]; td[r_] = userInput end
else do
-- use canned test data td[0] = td[0] + 1; r_ = td[0]; td[r_] = ' -6, -3, -2, -1, 0, 1, 3, 4, 5, 7, 8, 9, 10, 11, 14, 15, 17, 18, 19, 20' td[0] = td[0] + 1; r_ = td[0]; td[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' td[0] = td[0] + 1; r_ = td[0]; td[r_] = ' -4, -3, -2, 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
loop r_ = 1 to td[0]
say 'Original: ' td[r_].changestr(',', ' ').space(1, ',') say 'Compacted:' compact(td[r_]) say end r_
return </lang>
- Output:
Original: -6,-3,-2,-1,0,1,3,4,5,7,8,9,10,11,14,15,17,18,19,20 Compacted: -6,-3-1,3-5,7-11,14,15,17-20 Original: 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 Compacted: 0-2,4,6-8,11,12,14-25,27-33,35-39 Original: -4,-3,-2,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 Compacted: -4--2,0-2,4,6-8,11,12,14-25,27-33,35-39
Nim
<lang nim>import parseutils, re, strutils
proc extractRange(input: string): string =
var list = input.replace(re"\s+").split(',').map(parseInt) var ranges: seq[string] = @[] var i = 0 while i < list.len: var first = list[i] # first element in the current range var offset = i while True: # skip ahead to the end of the current range if i + 1 >= list.len: # reached end of the list break if list[i + 1] - (i + 1) != first - offset: # next element isn't in the current range break i.inc var last = list[i] # last element in the current range case last - first of 0: ranges.add($first) of 1: ranges.add("$1,$2".format([$first, $last])) else: ranges.add("$1-$2".format([$first, $last])) i.inc return ranges.join(",")
echo("""
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""".extractRange)</lang>
- Output:
0-2, 4, 6-8, 11, 12, 14-25, 27-33, 35-39
Objeck
<lang objeck>class IdentityMatrix {
function : Main(args : String[]) ~ Nil { Compress2Range("-6, -3, -2, -1, 0, 1, 3, 4, 5, 7, 8, 9, 10, 11, 14, 15, 17, 18, 19, 20")->PrintLine(); 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")->PrintLine(); } function : Compress2Range(expanded : String) ~ String { result := ""; nums := expanded->ReplaceAll(" ", "")->Split(","); firstNum := nums[0]->ToInt(); rangeSize := 0; for(i:= 1; i < nums->Size(); i += 1;) { thisNum := nums[i]->ToInt(); if(thisNum - firstNum - rangeSize = 1) { rangeSize += 1; } else{ if(rangeSize <> 0){ result->Append(firstNum); result->Append((rangeSize = 1) ? ",": "-"); result->Append(firstNum+rangeSize); result->Append(","); rangeSize := 0; } else { result->Append(firstNum); result->Append(","); }; firstNum := thisNum; }; }; if(rangeSize <> 0){ result->Append(firstNum); result->Append((rangeSize = 1) ? "," : "-"); result->Append(firstNum + rangeSize); rangeSize := 0; } else { result->Append(firstNum); }; return result; }
} </lang>
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
Objective-C
We can use NSIndexSet
to do this.
However, it only works for non-negative integers.
<lang objc>#import <Foundation/Foundation.h>
NSString *extractRanges(NSArray *nums) {
NSMutableIndexSet *indexSet = [[NSMutableIndexSet alloc] init]; for (NSNumber *n in nums) { if ([n integerValue] < 0) @throw [NSException exceptionWithName:NSInvalidArgumentException reason:@"negative number not supported" userInfo:nil]; [indexSet addIndex:[n unsignedIntegerValue]]; } NSMutableString *s = [[NSMutableString alloc] init]; [indexSet enumerateRangesUsingBlock:^(NSRange range, BOOL *stop) { if (s.length) [s appendString:@","]; if (range.length == 1) [s appendFormat:@"%lu", range.location]; else if (range.length == 2) [s appendFormat:@"%lu,%lu", range.location, range.location+1]; else [s appendFormat:@"%lu-%lu", range.location, range.location+range.length-1]; }]; return s;
}
int main() {
@autoreleasepool {
NSLog(@"%@", 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]));
} return 0;
}</lang>
- Output:
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
ooRexx
<lang ooRexx>/* Rexx */
parse arg userInput call runSample userInput return exit
-- ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ -- Compact a list of numbers by reducing ranges compact: procedure --trace ?r;nop
parse arg expanded nums = expanded~changestr(',', ' ')~space -- remove possible commas & clean up the string rezult =
RANGE = 0 FIRST = nums~word(1) -- set starting value loop i_ = 2 to nums~words -- each word in the string is a number to examine LOCAL = nums~word(i_) if LOCAL - FIRST - RANGE == 1 then do -- inside a range RANGE += 1 end else do -- not inside a range if RANGE \= 0 then do -- we have a range of numbers so collect this and reset rezult = rezult || FIRST || delim(RANGE) || FIRST + RANGE || ',' RANGE = 0 end else do -- just collect this number rezult = rezult || FIRST || ',' end FIRST = LOCAL -- bump new starting value end end i_ if RANGE \= 0 then do -- collect terminating value (a range) rezult = rezult || FIRST || delim(RANGE) || FIRST + RANGE end else do -- collect terminating value (a single number) rezult = rezult || FIRST end
return rezult~space(1, ',') -- format and return result string
-- ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ -- determine if the range delimiter should be a comma or dash delim: procedure
parse arg range . if range == 1 then dlm = ',' else dlm = '-' return dlm
-- ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ -- sample driver runSample: procedure parse arg userInput td. = 0 if userInput~words > 0 then do
td.0 += 1; r_ = td.0; td.r_ = userInput end
else do
td.0 += 1; r_ = td.0; td.r_ = '-6 -3 -2 -1 0 1 3 4 5 7 8 9 10 11 14 15 17 18 19 20' td.0 += 1; r_ = td.0; td.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' td.0 += 1; r_ = td.0; td.r_ = '-4, -3, -2, 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
loop r_ = 1 to td.0
say 'Original: ' td.r_~changestr(',', ' ')~space(1, ',') say 'Compacted:' compact(td.r_) say end r_
return </lang>
- Output:
Original: -6,-3,-2,-1,0,1,3,4,5,7,8,9,10,11,14,15,17,18,19,20 Compacted: -6,-3-1,3-5,7-11,14,15,17-20 Original: 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 Compacted: 0-2,4,6-8,11,12,14-25,27-33,35-39 Original: -4,-3,-2,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 Compacted: -4--2,0-2,4,6-8,11,12,14-25,27-33,35-39
OxygenBasic
<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>
- Output:
0-2,4,6-8,11,12,14-25,27-33,35-39
Pascal
<lang Pascal>program RangeExtraction;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads} cthreads, {$ENDIF}{$ENDIF} SysUtils;
function RangeExtraction(const Seq: array of integer): String; const
SubSeqLen = 3; // minimal length of the range, can be changed.
var
i, j: Integer; Separator: string = ;
begin
Result := ; i := Low(Seq); while i <= High(Seq) do begin j := i; // All subsequent values, starting from i, up to High(Seq) possibly while ((j < High(Seq)) and ((Seq[j+1]-Seq[j]) = 1)) do Inc(j); // is it a range ? if ((j-i) >= (SubSeqLen-1)) then begin Result := Result + Format(Separator+'%d-%d',[Seq[i],Seq[j]]); i := j+1; // Next value to be processed Separator := ','; end else begin // Loop, to process the case SubSeqLen > 3 while i<=j do begin Result := Result + Format(Separator+'%d',[Seq[i]]); Inc(i); // Next value to be processed Separator := ','; end; end; end;
End;
procedure DisplayRange(const Seq: array of integer); var
i: Integer;
begin
Write(Format('[%d', [Seq[Low(Seq)]])); for i := Low(Seq) + 1 to High(Seq) do Write(Format(',%d', [Seq[i]])); WriteLn('] => ' + RangeExtraction(Seq)); WriteLn;
End;
begin
DisplayRange([0]); DisplayRange([0,1]); DisplayRange([0,2]); DisplayRange([0,1,2]); DisplayRange([0,1,2,3]); DisplayRange([0,1,2,3,4,5,6,7]); DisplayRange([0,2,3,4,5,6,7,9]); DisplayRange([0,2,4,6,8,10]); DisplayRange([0,1,2,3,4,5,6,7,9]); DisplayRange([0,1,2,3,4,6,9,10,11,12]);
DisplayRange([ 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]); ReadLn;
end. </lang>
- Output:
[0] => 0 [0,1] => 0,1 [0,2] => 0,2 [0,1,2] => 0-2 [0,1,2,3] => 0-3 [0,1,2,3,4,5,6,7] => 0-7 [0,2,3,4,5,6,7,9] => 0,2-7,9 [0,2,4,6,8,10] => 0,2,4,6,8,10 [0,1,2,3,4,5,6,7,9] => 0-7,9 [0,1,2,3,4,6,9,10,11,12] => 0-4,6,9-12 [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
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;
}
- 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
<lang Perl>use Set::IntSpan; sub rangext { return Set::IntSpan->new(@_) . } # stringized</lang>
<lang Perl>use Set::IntSpan::Fast; sub rangext { return Set::IntSpan::Fast->new(@_)->as_string }</lang>
Set::IntSpan
and Set::IntSpan::Fast
are similar. "Fast" does a binary search for member testing (not part of the task here). Both accept negatives.
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 pli>/* 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:
0-2,4,6-8,11,12,14-25,27-33,35-39
PowerShell
<lang PowerShell> function range-extraction($arr) {
if($arr.Count -gt 2) { $a, $b, $c, $arr = $arr $d = $e = $c if((($a + 1) -eq $b) -and (($b + 1) -eq $c)) { $test = $true while($arr -and $test) { $d = $e $e, $arr = $arr $test = ($d+1) -eq $e } if($test){"$a-$e"} elseif((-not $arr) -and $test){"$a-$d"} elseif(-not $arr){"$a-$d,$e"} else{"$a-$d," + (range-extraction (@($e)+$arr))} } elseif(($b + 1) -eq $c) {"$a," + (range-extraction (@($b, $c)+$arr))} else {"$a,$b," + (range-extraction (@($c)+$arr))} } else { switch($arr.Count) { 0 {""} 1 {"$arr"} 2 {"$($arr[0]),$($arr[1])"} } }
} 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:
0-2,4,6-8,11,12,14-25,27-33,35-39
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>
- 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 = 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
R
<lang rsplus>extract.range = function(v)
{r = c(1, which(diff(v) != 1) + 1, length(v) + 1) # 'r' holds the index of the start of each run of sequential # elements. paste0(collapse = ",", v[head(r, -1)], ifelse(diff(r) == 1, "", paste0( ifelse(diff(r) == 2, ",", "-"), v[r[-1] - 1])))}
print(extract.range(c(
-6, -3, -2, -1, 0, 1, 3, 4, 5, 7, 8, 9, 10, 11, 14, 15, 17, 18, 19, 20)))
print(extract.range(c(
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>
Racket
<lang Racket>
- 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 the two numbers 11 and 12 are not considered a range.
version 1
This REXX version isn't limited to integers. <lang rexx>/*REXX program creates a range extraction from a list of numbers (can be neg.)*/ 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
- =words(old) /*number of integers in the number list*/
new= /*the new list, possibly with ranges. */
do j=1 to #; x=word(old,j) /*obtain Jth number in the old list. */ new=new',' x /*append " " to " new " */ inc=1 /*start with an increment of one (1). */ do k=j+1 to #; y=word(old,k) /*get the Kth number in the number list*/ if y\=x+inc then leave /*is this number not > previous by inc?*/ inc=inc+1; g=y /*increase the range, assign G (good).*/ end /*k*/ if k-1=j | g=x+1 then iterate /*Is the range=0|1? Then keep truckin'*/ new=new'-'g; j=k-1 /*indicate a range of #s; change index*/ end /*j*/
new=space(substr(new, 2), 0) /*elide leading comma, also all blanks.*/ say 'old:' old /*display the old range of numbers. */ say 'new:' new /* " " new list " " */
/*stick a fork in it, we're all 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>/*REXX program creates a range extraction from a list of numbers (can be neg.)*/ 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
- =words(old); j=0 /*number of integers in the number list*/
new= /*the new list, possibly with ranges. */
do while j<#; j=j+1; x=word(old,j) /*get the Jth number in the number list*/ new=new',' x /*append " " to " new " */ inc=1 /*start with an increment of one (1). */ do k=j+1 to #; y=word(old,k) /*get the Kth number in the number list*/ if y\=x+inc then leave /*is this number not > previous by inc?*/ inc=inc+1; g=y /*increase the range, assign G (good).*/ end /*k*/ if k-1=j | g=x+1 then iterate /*Is the range=0|1? Then keep truckin'*/ new=new'-'g; j=k-1 /*indicate a range of numbers; change J*/ end /*while*/
new=space(substr(new, 2), 0) /*elide leading comma, also all blanks.*/ say 'old:' old /*display the old range of numbers. */ say 'new:' new /* " " new list " " */
/*stick a fork in it, we're all done. */</lang>
output is the same as the 1st REXX version.
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)
# pad the list with a big value, so that the last loop iteration will # append something to the range sorted, range = l.sort.concat([Float::MAX]), [] canidate_number = sorted.first
# enumerate over the sorted list in pairs of current number and next by index sorted.each_cons(2) do |current_number, next_number| # if there is a gap between the current element and its next by index if current_number.succ < next_number # if current element is our first or our next by index if canidate_number == current_number # put the first element or next by index into our range as a string range << canidate_number.to_s else # if current element is not the same as the first or next # add [first or next, first or next equals current add , else -, current] seperator = canidate_number.succ == current_number ? "," : "-" range << "%d%s%d" % [canidate_number, seperator, current_number] end # make the first element the next element canidate_number = next_number 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
<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>
- Output:
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
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
}
- 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
<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
- 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
- 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
VBScript
<lang vb>Function Range_Extraction(list) num = Split(list,",") For i = 0 To UBound(num) startnum = CInt(num(i)) sum = startnum Do While i <= UBound(num) If sum = CInt(num(i)) Then If i = UBound(num) Then If startnum <> CInt(num(i)) Then If startnum + 1 = CInt(num(i)) Then Range_Extraction = Range_Extraction & startnum & "," & num(i) & "," Else Range_Extraction = Range_Extraction & startnum & "-" & num(i) & "," End If Else Range_Extraction = Range_Extraction & startnum & "," End If
Exit Do
Else i = i + 1 sum = sum + 1 End If Else If startnum = CInt(num(i-1)) Then Range_Extraction = Range_Extraction & startnum & "," Else If startnum + 1 = CInt(num(i-1)) Then Range_Extraction = Range_Extraction & startnum & "," & num(i-1) & "," Else Range_Extraction = Range_Extraction & startnum & "-" & num(i-1) & "," End If End If i = i - 1 Exit Do End If Loop Next Range_Extraction = Left(Range_Extraction,Len(Range_Extraction)-1) End Function
WScript.StdOut.Write 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:
0-2,4,6-8,11,12,14-25,27-33,35-39
zkl
<lang zkl>fcn range(ns){
fcn(w){ if (w.atEnd) return(Void.Stop); a:=b:=w.next(); n:=0; while(b+1 == (c:=w.peekN(n))){ n+=1; b=c } if(n>1){do(n){w.next()}; return("%d-%d".fmt(a,b)); } a } : (0).pump(*,List,_.fp(ns.walker().tweak(Void,Void))).concat(",");
}</lang> The trick here is to use a modified iterator, one that can look past the end of the sequence without puking. The function gathers three or more successive ints (saved as a "a-b" string list element) or just returns the first one (as a number) if it can't. The resulting list is converted to strings separated by commas. <lang zkl>var ns=T(-6,-3,-2,-1,0,1,3,4,5,7,8,9,10,11,14,15,17,18,19,20); range(ns).println();
ns=T(
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(ns).println();
range([1..100]).println();</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 1-100
- Programming Tasks
- Solutions by Programming Task
- Ada
- Aime
- ALGOL 68
- AutoHotkey
- AWK
- BBC BASIC
- Bracmat
- C
- C++
- C sharp
- Csharp examples needing attention
- Examples needing attention
- COBOL
- Common Lisp
- D
- DWScript
- E
- Eiffel
- Elixir
- Emacs Lisp
- Erlang
- Euphoria
- F Sharp
- Forth
- Go
- Groovy
- Haskell
- Icon
- Unicon
- J
- Java
- JavaScript
- Jq
- Julia
- K
- Liberty BASIC
- LiveCode
- Mathematica
- MATLAB
- Octave
- MUMPS
- NetRexx
- Nim
- Objeck
- Oberon-2
- Objective-C
- OCaml
- OoRexx
- OxygenBasic
- OxygenBasic examples needing attention
- Oz
- Pascal
- Perl
- Set::IntSpan
- Set::IntSpan::Fast
- Perl 6
- PicoLisp
- PL/I
- PowerShell
- Prolog
- PureBasic
- Python
- Qi
- R
- Racket
- REXX
- Ruby
- Scala
- Scheme
- Seed7
- SNOBOL4
- Tcl
- TUSCRIPT
- UNIX Shell
- Ursala
- VBA
- VBScript
- Zkl