Creating a "compressed" string from a sequence of integers

[maurobio]

Dear ALL,

I have a sorted sequence of integers as follows:

1, 2, 3, 4, 5, 7, 9, 10, 11, 13, 15

I want to convert this sequence to a string, with adjacent numbers "compressed" to include only the first and last in the interval between them. So, for the above case I would have a string in the following format:

'1-5 7 9-11 13 15'

Could someone out there give some hints on how to write a function to achieve this? A simple working example (as it is possible that this problem has already been addressed) would be most helpful.

Many thanks in advance!

With warmest regards,

[paweld]

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs,
9.   IntegerList, StrUtils;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     procedure FormCreate(Sender: TObject);
17.   private
18.     function CompressIntegerList(il: TIntegerList): String;
19.   public
20.  
21.   end;
22.  
23. var
24.   Form1: TForm1;
25.  
26. implementation
27.  
28. {$R *.lfm}
29.  
30. { TForm1 }
31.  
32. procedure TForm1.FormCreate(Sender: TObject);
33. var
34.   il: TIntegerList;
35.   ints: String = '24, 1, 19, 20, 2, 33, 18, 3, 21, 22, 23, 31, 32, 35, 4, 5, 7, 9, 10, 11, 13, 15';
36.   sarr: TStringArray;
37.   i, j: Integer;
38. begin
39.   ShowMessage(ints);
40.   il := TIntegerList.Create;
41.   sarr := ints.Split([',', ' '], TStringSplitOptions.ExcludeEmpty);
42.   for i := 0 to High(sarr) do
43.   begin
44.     if TryStrToInt(sarr[i], j) then
45.       il.Add(j);
46.   end;
47.   ShowMessage(CompressIntegerList(il));
48.   il.Free;
49. end;
50.  
51. function TForm1.CompressIntegerList(il: TIntegerList): String;
52. var
53.   i, mini, maxi: Integer;
54. begin
55.   Result := '';
56.   il.Sort;
57.   if il.Count > 0 then
58.   begin
59.     mini := il[0];
60.     maxi := mini;
61.     for i := 1 to il.Count - 1 do
62.     begin
63.       if il[i] = maxi + 1 then
64.         maxi := il[i]
65.       else
66.       begin
67.         Result := Result + ' ' + IntToStr(mini) + IfThen(mini = maxi, '', '-' + IntToStr(maxi));
68.         mini := il[i];
69.         maxi := mini;
70.       end;
71.     end;
72.   end;
73.   Result := Trim(Result) + ' ' + IntToStr(mini) + IfThen(mini = maxi, '', '-' + IntToStr(maxi));
74. end;
75.  
76. end.
77.          

[ASerge]

I have a sorted sequence of integers as follows:
1, 2, 3, 4, 5, 7, 9, 10, 11, 13, 15
I want to convert this sequence to a string, with adjacent numbers "compressed" to include only the first and last in the interval between them. So, for the above case I would have a string in the following format:
'1-5 7 9-11 13 15'

Code: Pascal  [Select][+][-]

1. function CompressIntList(const A: array of SizeInt): string;
2. var
3.   iFrom, iTo: SizeInt;
4.   HighA: SizeInt;
5.   L: TStringList;
6. begin
7.   L := TStringList.Create;
8.   try
9.     L.LineBreak := ' ';
10.     L.TrailingLineBreak := False;
11.     iFrom := Low(A);
12.     HighA := High(A);
13.     while iFrom <= HighA do
14.     begin
15.       iTo := iFrom + 1;
16.       while (iTo <= HighA) and ((A[iTo] - A[iTo - 1]) = 1) do
17.         Inc(iTo);
18.       if (iTo - iFrom) = 1 then
19.         L.Append(Format('%d', [A[iFrom]]))
20.       else
21.         L.Append(Format('%d-%d', [A[iFrom], A[iTo - 1]]));
22.       iFrom := iTo;
23.     end;
24.     Result := L.Text;
25.   finally
26.     L.Free;
27.   end;
28. end;
29.  
30. procedure TForm1.FormCreate(Sender: TObject);
31. begin
32.   Caption := '|' + CompressIntList([1, 2, 3, 4, 5, 7, 9, 10, 11, 13, 15]) + '|';
33. end;

[Bart]

This also compresses [1,2] to '1-2', not wrong, but a compression and IMO less readable than '1 2'.

Bart

[maurobio]

Hi, @paweld, @ASerge, @Bart!

Thank you very much for the fine examples of code!

I have had a problem with @paweld code because my version of Lazarus could not find the TIntegerList type (but according to this post (https://forum.lazarus.freepascal.org/index.php?topic=14152.0) it has been around for a long time).

I could run @ASerge code, but @Bart has a point: it may happen that in my application (where such "compressed" strings of numbers will be generated and passed to a third-party program) a "pseudo-interval" like "1-2" will be misinterpreted like an error.

Furthermore, I am now preferring to pass the numbers to the compression function as a single string of numeric values delimited by a space (for example, '1 2 3 4 5 7 9 10 11 13 15'). I am implementing some modifications to @ASerge code for that.

With warmest regards,

[maurobio]

Hi, wizards!

Here is my version of the "compressing numbers" function with a test console mode program:

Code: Pascal  [Select][+][-]

1. program Compress;
2.  
3. {$APPTYPE CONSOLE}
4. {$mode objfpc}{$H+}
5.  
6. uses
7.     Classes, SysUtils, StrUtils, fgl;
8.  
9. function CompressNumbers(const Numbers: string): string;
10. var
11.   iFrom, iTo: SizeInt;
12.   HighA: SizeInt;
13.   L: TStringList;
14.   A: array of Integer;
15.   I: Integer;
16.   S: string;
17.   N, M: integer;
18. begin
19.   M := WordCount(Numbers, StdWordDelims);
20.   //WriteLn(M);
21.   SetLength(A, M);
22.   for I := 0 to M do
23.   begin
24.         S := ExtractWord(I, Numbers, [' ']);
25.         if S <> '' then
26.         begin
27.             N := StrToInt(S);
28.                 if N > 0 then
29.                         A[I] := N;
30.         end;   
31.   end;
32.  
33.   //for i := Low(A) to High(A) do
34.   //    Write(A[i], ' ');
35.   //WriteLn;   
36.    
37.   L := TStringList.Create;
38.   try
39.     L.LineBreak := ' ';
40.     L.TrailingLineBreak := False;
41.     iFrom := Low(A);
42.     HighA := High(A);
43.     while iFrom <= HighA do
44.     begin
45.       iTo := iFrom + 1;
46.       while (iTo <= HighA) and ((A[iTo] - A[iTo - 1]) = 1) do
47.         Inc(iTo);
48.       if (iTo - iFrom) = 1 then
49.         L.Append(Format('%d', [A[iFrom]]))
50.       else
51.         L.Append(Format('%d-%d', [A[iFrom], A[iTo - 1]]));
52.       iFrom := iTo;
53.     end;
54.     Result := L.Text;
55.   finally
56.     L.Free;
57.   end;
58. end;
59.  
60. begin
61.   WriteLn(CompressNumbers('1 2 3 4 5 7 9 10 11 13 15'));
62. end.

I cannot however understand why the sequence of numbers is starting with 0 instead of with 1 as it should!

Any hints?

With warmest regards.

[maurobio]

Hi!

Combining the code by @paweld and @ASerge, I have the modified program working now:

Code: Pascal  [Select][+][-]

1. program Compress;
2.  
3. {$APPTYPE CONSOLE}
4. {$mode objfpc}{$H+}
5.  
6. uses
7.     Classes, SysUtils, StrUtils;
8.  
9. function CompressNumbers(const Numbers: string): string;
10. var
11.   iFrom, iTo: SizeInt;
12.   HighA: SizeInt;
13.   L: TStringList;
14.   A: array of Integer;
15.   I, J: Integer;
16.   S: TStringArray;
17. begin
18.   S := Numbers.Split([' '], TStringSplitOptions.ExcludeEmpty);
19.   SetLength(A, Length(S));
20.   for I := 0 to High(S) do
21.     if TryStrToInt(S[I], J) then
22.       A[I] := J;
23.   L := TStringList.Create;
24.   try
25.     L.LineBreak := ' ';
26.     L.TrailingLineBreak := False;
27.     iFrom := Low(A);
28.     HighA := High(A);
29.     while iFrom <= HighA do
30.     begin
31.       iTo := iFrom + 1;
32.       while (iTo <= HighA) and ((A[iTo] - A[iTo - 1]) = 1) do
33.         Inc(iTo);
34.       if (iTo - iFrom) = 1 then
35.         L.Append(Format('%d', [A[iFrom]]))
36.       else
37.         L.Append(Format('%d-%d', [A[iFrom], A[iTo - 1]]));
38.       iFrom := iTo;
39.     end;
40.     Result := L.Text;
41.   finally
42.     L.Free;
43.   end;
44. end;
45.  
46. begin
47.   WriteLn(CompressNumbers('1 2 3 4 5 7 9 10 11 13 15'));
48. end.

It still has the potential 'bug' pointed out by @Bart, but I will test with the third-party program to see if a 'pseudo-interval' like '1-2' is really a problem.

With warmest regards,

[paweld]

You can create an IntegerList using fgl. i used Map because it has sorting and duplicate control without additional code.   
with this solution you can pass unsorted strings containing numbers

Code: Pascal  [Select][+][-]

1. program Compress;
2.  
3. {$APPTYPE CONSOLE}
4. {$mode objfpc}{$H+}
5.  
6. uses
7.   Classes, SysUtils, StrUtils, fgl;
8.  
9.   function CompressNumbers(const Numbers: string): string;
10.   type
11.     TIntegerList = specialize TFPGMap<Integer, Boolean>;
12.   var
13.     iFrom, iTo: SizeInt;
14.     il: TIntegerList;
15.     L: TStringList;
16.     S: TStringArray;
17.     I, N: integer;
18.   begin
19.     il := TIntegerList.Create;
20.     il.Duplicates := dupIgnore;
21.     il.Sorted := True;
22.     S := Numbers.Split([' '], TStringSplitOptions.ExcludeEmpty);
23.     for I := 0 to High(S) do
24.     begin
25.       if TryStrToInt(S[I], N) and (N > 0) then
26.         il.Add(N);
27.     end;
28.  
29.     L := TStringList.Create;
30.     try
31.       L.LineBreak := ' ';
32.       L.TrailingLineBreak := False;
33.       iFrom := 0;
34.       while iFrom < il.Count do
35.       begin
36.         iTo := iFrom + 1;
37.         while (iTo < il.Count) and (il.Keys[iTo] - il.Keys[iTo - 1] = 1) do
38.           Inc(iTo);
39.         if (iTo - iFrom) = 1 then
40.           L.Append(Format('%d', [il.Keys[iFrom]]))
41.         else
42.           L.Append(Format('%d%s%d', [il.Keys[iFrom],
43.             IfThen((il.Keys[iTo - 1] - il.Keys[iFrom]) = 1, ' ', '-'), il.Keys[iTo - 1]]));
44.         iFrom := iTo;
45.       end;
46.       Result := L.Text;
47.     finally
48.       L.Free;
49.     end;
50.   end;
51.  
52. begin
53.   WriteLn(CompressNumbers('1 32 8 20 22 23 24 25 1 1 5 2 3 4 5 7 9 10 11 13 15 16 18'));
54.   readln;
55. end.

[Bart]

It still has the potential 'bug' pointed out by @Bart, but I will test with the third-party program to see if a 'pseudo-interval' like '1-2' is really a problem.

Easily solved by adapting the code from maurobio:

Code: Pascal  [Select][+][-]

1. function CompressIntList(const A: array of SizeInt): string;
2. var
3.   iFrom, iTo: SizeInt;
4.   HighA: SizeInt;
5.   L: TStringList;
6. begin
7.   L := TStringList.Create;
8.   try
9.     L.LineBreak := ' ';
10.     L.TrailingLineBreak := False;
11.     iFrom := Low(A);
12.     HighA := High(A);
13.     while iFrom <= HighA do
14.     begin
15.       iTo := iFrom + 1;
16.       while (iTo <= HighA) and ((A[iTo] - A[iTo - 1]) = 1) do
17.         Inc(iTo);
18.       if (iTo - iFrom) = 1 then
19.         L.Append(Format('%d', [A[iFrom]]))
20.       else
21.       begin
22.         if (iTo - iFrom) = 2 then
23.           L.Append(Format('%d %d', [A[iFrom], A[iTo - 1]]))
24.         else
25.           L.Append(Format('%d-%d', [A[iFrom], A[iTo - 1]]));
26.       end;
27.       iFrom := iTo;
28.     end;
29.     Result := L.Text;
30.   finally
31.     L.Free;
32.   end;
33. end;

[1, 2, 3, 4, 5, 7, 9, 10, 11, 13, 15, 16, 20] now gives "1-5 7 9-11 13 15 16 20"

Bart

[maurobio]

Hi, wizards!!!

Both versions of the code now seem to work fine.

Concerning the TIntegerList in @paweld code, I had declared the fgl unit in my test program, but forgot to declare the proper type! 

Thanks *a lot* to you all!

With warmest regards,