# Group list elements in sequence

Suppose we have the following list:

list1={1,2,4,6,8,9,10,14,15,17,21,22,72,76,80,96,106,116,117}


Actually the real list has about 100K elements. What I want to do is group elements in sublists in sequence so I have:

list11={{1,2},{4,6,8},{9,10},{14,15},{17},{21,22},{72,76,80},{96,106,116},{117}}


My final goal is to create a list with strings like:

(* {1to2,4to6by2,9to10,14to15,17,21to22,72to80by4,96to116by10} *)


The code to generate the simple sequence (1to2, XtoY...) is like this:

gruposAgrupaTo[list_] :=
Module[
{lst1, lst2},
lst1 = Join[BinLists[lst], {{}}];
lst2 = Flatten[Position[lst1, {}]];
Return[
DeleteCases[
Table[
Flatten[lst1[[lst2[[i]] + 1 ;; lst2[[i + 1]] - 1]]], {i, 1,
Length[lst2] - 1}], {}]
];
]

list1=Sort[DeleteDuplicates[RandomInteger[{1, 100000}, 100000]]]
(* {4, 5, 6, 7, 9, 10, 13, 14, 15, 16, 18, 19, 20, 21, 23, 26, 27, 29, 30, 31, 32, 34, 35, 37, 38, 39, 40, 44,...*)

gruposAgrupaTo[list1]
(* {{4, 5, 6, 7}, {9, 10}, {13, 14, 15, 16}, {18, 19, 20, 21}, {23}, {26,   27}, {29, 30, 31, 32},....*)


Any clue how to include the code to generate the multiple sequence (72to80by4, XtoYbyZ...)?

-
So to be clear: this algorithm needs to have a way to on the fly recognize a subsequence by its pattern (without knowing the pattern a priori), recognize when that subsequence ends, and then split that subsequence off into its own list... That sounds hard. Are the subsequences always arithmetic sequences? That would make this easier I imagine. – march Mar 12 at 21:16
That is correct. At least, all numbers are positive integers. – LeoRon7 Mar 12 at 21:19
As @march said, this sounds very hard. Are you positive that you need to do this? Could you expand on why you need these sublists and what you are going to do with them in your application? – MarcoB Mar 12 at 21:22
I am creating a file that is going to be used in finite element analysis. The list is the group of nodes numbers and element numbers, so I can divide the model. As the model has many parts, and some superpose others, the list can get really huge and I can´t handle the file. The solver can read nodes and lists like this: XtoY.... XtoYbyZ, which reduces dramatically the size of the file. – LeoRon7 Mar 12 at 21:29
Why 17 isn't with 21? – Kuba Mar 12 at 21:56

ClearAll[foo];

(* "... At least, all numbers are positive integers..."*)
foo[list_] := Module[{d = .5, bar},
bar[a_, b_] := Which[
d == .5, d = #; True,
d == #, True,
True, d = .5; False
] &[b - a];

Split[list, bar]
]

foo @ list1

 {{1, 2}, {4, 6, 8}, {9, 10}, {14, 15}, {17, 21}, {22, 72}, {76, 80},
{96, 106, 116}, {117}}

-
Applying my code with only continuous sequences to a 100K random list , I get 23328 elements. Using Kuba´s code, I get 20041!!! I wonder what is the lower limit for compression.... – LeoRon7 Mar 12 at 22:53
Compression Sumary (based on 100K list): Kuba: 20041; LeoRon7: 23328; MarcB: 33999. – LeoRon7 Mar 12 at 23:02
@LeoRon7 Now I get what's the point. Well I'm not an expert but that seems like a problem that should have more general solution. – Kuba Mar 12 at 23:11

You can define a function such as

create[{f_}] := ToString[f];

create[{f_, l_}] := ToString[f] <> "to" <> ToString[l];

create[{f_, e_, l_}] :=
With[{by = l - e}, ToString[f] <> "to" <> ToString[l] <> "by" <> ToString[by]]

create[{f_, seq__, e_, l_}] := create[{f, e, l}]


And then do

create /@ list11

(* "1to2", "4to8by2", "9to10", "14to15", "17",
"21to22", "72to80by4", "96to116by10", "117" *)

-
This code is ok, but the challenge is to generate "list11"!!! – LeoRon7 Mar 12 at 22:05
Ok, I thought your question was how to "to generate the multiple sequence". – Xavier Mar 12 at 22:07
Xavier, the sub lists can have any number of elements... So I guess this code will only work for constant length sub lists.... – LeoRon7 Mar 12 at 22:41
@LeoRon7 Yes, you're right, I overlooked that. See the update. – Xavier Mar 12 at 22:46

Since you really are just seeking simplification of your input list, perhaps this could help:

list1 = {1, 2, 4, 6, 8, 9, 10, 14, 15, 17, 21, 22, 72, 76, 80, 96, 106, 116, 117};

Clear[difflist]
difflist[list_?VectorQ] := Module[
{diffrules},
SplitBy[diffrules, #[[2]] &] [[All, All, 1]]
]

difflist[list1]

(* Out:
{{1}, {2}, {4, 6, 8}, {9, 10}, {14}, {15}, {17}, {21}, {22}, {72},
{76, 80}, {96}, {106, 116}, {117}}
*)


You can then apply Xavier's conversion function to the generated list.

Hopefully your real input will include longer runs with constant difference, and therefore generate more "compression".

-

May be a bit far from beautiful and optimal, but my aim was to catch {72,76,80}, and also {2,4,6,8}.

So with

list1 = {1, 2, 4, 6, 8, 9, 10, 14, 15, 17, 21, 22, 72, 76, 80, 96, 106, 116, 117};


Prepare data:

list = Flatten[
Values @ Merge[#, DeleteDuplicates@Flatten[#] &] & /@
SplitBy[Thread[(#2 - #1) & @@@ Partition[list1, 2, 1] ->
Partition[list1, 2, 1]], First], 1]


Get:

{{1, 2}, {2, 4, 6, 8}, {8, 9, 10}, {10, 14}, {14, 15}, {15, 17}, {17, 21}, {21, 22}, {22, 72}, {72, 76, 80}, {80, 96}, {96, 106, 116}, {116, 117}}

Procedure:

Clear[foo];
foo[list_List] := Module[{i = 1, lst = list}, While[i < Length[lst],
If[Length @ lst[[i]] < Length @ lst[[i + 1]],
lst[[i]] = Most @ lst[[i]],
lst[[i + 1]] = Rest @ lst[[i + 1]]];
i++] ; lst = DeleteCases[lst, {}];
lst
]


Usage:

foo[list]


Result (as @Kuba wanted, {17, 21} live together :):

{{1}, {2, 4, 6, 8}, {9, 10}, {14, 15}, {17, 21}, {22}, {72, 76, 80}, {96, 106, 116}, {117}}

-
garej's code leads to the same number of elements as Kuba´s code: 20041.Kuda´s code is almost 10x faster. – LeoRon7 Mar 14 at 12:20
@LeoRon7, Kuba's code returns {22,72}. Is it fine? I would recommend to cook another sample. – garej Mar 14 at 20:15