# Support for low-complexity (compressible) lists

By "low-complexity list" I mean a list like the following:

lcl = {17, 17, 17, 17, 17,
21, 21, 21, 21, 21, 21, 21, 21,
11, 11, 11, 11, 11, 11, 11}


It contains 20 elements, but only 3 distinct values, and furthermore, these values occur in homogeneous blocks.

More formally, one can represent any list1 with a "run-length encoding". For example:

rle[list_] := Transpose[{First[#], Length[#]} & /@ Split[list]]


...or, if you prefer, this slightly fancier version:

rle[list_, equal_:SameQ, representative_:First] :=
Transpose[{representative[#], Length[#]} & /@ Split[list, equal]]


For the list lcl shown earlier, rle[lcl] is

{{17, 21, 11}, {5, 8, 7}}


For the sake of this discussion, let's define the "compressibility" of a list list as the ratio

Length[list]/Length[Flatten[rle[list]]]


Low-complexity lists are therefore those for which this compressibility measure is substantially greater than 1.

The compressibility of the list lcl shown above is (only) 20/6 = 3.33. In contrast, I need to work with lists whose compressibilities lie in the range $10^4-10^5$.

Q: Does Mathematica provide any support (data structure, functions) for representing such "low-complexity lists" more compactly, while still being able to use them as lists?

If x is a numeric low-complexity list, as here defined, Differences[x] is sparse (even though x isn't). For example, applying Differences to the example above yields

{0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, -10, 0, 0, 0, 0, 0, 0}


That said, I can't think of a way to take advantage of Mathematica's excellent SparseArray in this context.

EDIT:

Just to be clear, I'm asking whether in the vast Mathematica universe there already exists support for this sort of beast. I just don't want to reinvent wheels, especially for something like this, which would be far better implemented at a lower level than "user-space".

By far, the operation I'm most interested in is indexing (i.e. Part), especially complex indexing form, such as indexing with a list of indices, or with ranges (e.g. 1000;;1999).

For simple indexing, I could base a home-grown solution on this sort of thing

FirstPosition[..., i_ /; # < i] &


...where ... is a placeholder for an internal data structure (part of the low-complexity list representation) that holds the positions of the elements that is different from their predecessors.

I'm also interested in Map and friends (Table, Scan, etc.), but much less.

The very beginning of the implementation I alluded to before could be as follows (but this providing full support for Part/alone would require considerably more code, I think).

lcList[l_List] := Module[
{
values
, counts
, pivots
},
(* the rle function is defined earlier in this post *)
{values, counts} = rle[l]
; pivots = 1 + Accumulate @ counts
; lcList[<|"values" -> values,
"pivots" -> pivots,
"ceiling" -> Last @ pivots|>]
]

lcList /: Length[lcList[a_Association]] := a["ceiling"] - 1

lcList /: Part[lcList[a_Association], i_Integer] :=
a["values"][[First@FirstPosition[a["pivots"], j_ /; i < j]]] /;
0 < i < a["ceiling"]


Then, with the list lcl shown at the top of this post,

rleLcl = lcList[lcl]

rleLcl[[#]] & /@ Range[Length[rleLcl]]

{17, 17, 17, 17, 17, 21, 21, 21, 21, 21, 21, 21, 21, 11, 11, 11, 11, 11, 11, 11}


1 Well, not any list, but rather, any list of elements such that, for any two of them, a and b, we have an adequate equality predicate equal[a, b].

• What operations do you typically want to do with these lists? May 17, 2017 at 16:11
• Maybe Tally[list]? May 17, 2017 at 16:33
• I'm not aware of any existing Mathematica implementation of what you're asking. Your lcList seems like a good start. Make sure your arrays are- and stay packed. Searching for appropriate pivots can be compiled. If you need to access parts of same list many times, then maybe storing pivots as some kind of search tree would be justifiable. May 17, 2017 at 19:38
• Flatten[Tally /@ Split[lcl], 1] May 23, 2017 at 20:07
• @kjo You are right. I have also noticed the performance drawback. The effect even grows with increasing length of the list. May 25, 2017 at 16:14

No, I do not believe there is built-in functionality for the data form you describe.

However Interpolation comes close. Here's an example.

in = {17, 17, 17, 17, 17, 21, 21, 21, 21, 21, 21, 21, 21, 11, 11, 11, 11, 11, 11,
11};

sa = SparseArray @ Differences @ Prepend[in, 0];
v = in[[p]]

f = Quiet@*Interpolation[
Join[{p - 1, RotateRight@v}\[Transpose], {{Last@p, Last@v}}],
InterpolationOrder -> 0];

in === Array[f, Length@in]

{1, 6, 14}

{17, 21, 11}

True


So this gives a function f which returns the element of in for a given index.

We can also pull spans from the SparseArray (assigned to sa) like this:

in[[10 ;; 15]]

Accumulate @ sa[[10 ;; 15]] + f[10]

{21, 21, 21, 21, 11, 11}

{21, 21, 21, 21, 11, 11}


For large extractions this is much faster than using the InterpolatingFunction (f). Using the code above but starting with:

SeedRandom[0];
in = Join @@ ConstantArray @@@ RandomInteger[{1, 99}, {5000, 2}];


Then:

(r1 = Accumulate@sa[[100000 ;; 150000]] + f[100000];)   // RepeatedTiming
(r2 = f @ Range[100000, 150000];)                       // RepeatedTiming

r1 === r2

{0.000696, Null}

{0.0527, Null}

True

• I love how you managed to make good use of "discrete integration" (aka Accumulate), thereby exploiting the "discrete differentiation" (aka Differences) aspect of the problem. Beautiful stuff. That said, probably it would be good to point out explicitly in your answer that it works only for lists of numeric scalars. I am unfamiliar with Interpolation and with the "AdjacencyLists" property (for which I have yet to find any official documentation) of SparseArrays, so I'm still digesting your answer, but one detail that bothers me a bit...
– kjo
May 18, 2017 at 13:15
• ...is the 0 sentinel (in SparseArray @ Differences @ Prepend[in, 0]): what happens, for example, when in begins with 0? Is 0 dictated by SparseArray's assumptions/defaults/implementation details? Or could you use, say, First[in] - 1?
– kjo
May 18, 2017 at 13:16
• BTW, I found your mathematica.stackexchange.com/questions/83721/…... Thanks!
– kjo
May 18, 2017 at 13:21
• @kjo Hah, I didn't expect to get an Accept with this, but thanks. You're right, I didn't consider zero appearing anywhere in the input list and I didn't handle it. I'll try to fix that later. The background of a SparseArray can be changed by using its third parameter but that by itself won't fix that problem. May 18, 2017 at 14:04
• After I thought about it some more I realized that the value of the sentinel is orthogonal to the SparseArray background value, because you're using SparseArray on the differences of the original list, not the list itself. Also, I think that using First[in] + c (for some reasonable non-zero constant c) is the way to go for the sentinel.
– kjo
May 18, 2017 at 14:29
 {First[#], Length[#]}& /@
Split[{17, 17, 17, 17, 17, 21, 21, 21, 21, 21, 21, 21, 21, 11, 11, 11, 11, 11, 11, 11}]


(*

{{17, 5}, {21, 8}, {11, 7}}

*)

{First[#], Length[#]}& /@
Split[ {0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, -10, 0, 0, 0, 0, 0, 0}]


(*

{{0, 4}, {4, 1}, {0, 7}, {-10, 1}, {0, 6}}

*)

@J.M. points out that it is simpler to use Split than SplitBy.

• Have you just reinvented Tally? May 17, 2017 at 16:49
• Not if there are multiple sequences having the same value. May 17, 2017 at 17:03
• It's not Tally. Check the second example. May 17, 2017 at 17:04
• Ah yes... if there are multiple sequences having the same value, then Tally is not what the OP seeks. May 17, 2017 at 17:06
• Composition[Through, {First, Length}] /@ Split[list] should also do the trick; no need for SplitBy[]. May 17, 2017 at 17:31
1. Transform unique numbers to digits base n (length of unique numbers)
2. Transform original list to digits base n
3. Construct an integer from the list of it's digits base n

Using integer instead of a list of numbers uses much less memory. (1 : 10)

In:

Clear[xs, ys, number, rules]
ToNumber[xs_] := Module[{uniques, base, digits, rules, number},
uniques  = Union[xs];
base = Length[uniques];
digits = Range[0, base - 1];
number = FromDigits[(xs /. rules), base];
{number, base, Map[Reverse, rules]}
]

xs = RandomChoice[Range[0, 19]*5, 10^2];
{number, base, rules} = ToNumber[xs]

ys = IntegerDigits[number, base] /. rules

(* Test *)
xs == ys

(* Memory *)
xs // ByteCount
number // ByteCount


Out:

{60, 75, 60, 20, 70, 30, 5, 5, 15, 90, 75, 90, 0, 50, 35, 80, 30, 15, \
25, 70, 65, 90, 5, 25, 35, 20, 65, 40, 80, 15, 20, 40, 45, 95, 50, \
70, 55, 35, 5, 70, 10, 90, 55, 85, 25, 25, 95, 90, 85, 20, 80, 55, \
45, 35, 75, 25, 30, 5, 5, 30, 65, 80, 25, 85, 35, 35, 50, 75, 0, 20, \
65, 85, 40, 35, 25, 55, 65, 20, 75, 60, 0, 50, 60, 80, 10, 35, 5, 5, \
5, 75, 60, 65, 25, 10, 10, 30, 25, 55, 90, 90}

{810066090674088052770306597191253060527186521556149860642933055414395\
7285417316417930562947049000100525456920489251180883335404778,
20,
{0 -> 0, 1 -> 5, 2 -> 10, 3 -> 15, 4 -> 20, 5 -> 25, 6 -> 30, 7 -> 35,
8 -> 40, 9 -> 45, 10 -> 50, 11 -> 55, 12 -> 60, 13 -> 65, 14 -> 70,
15 -> 75, 16 -> 80, 17 -> 85, 18 -> 90, 19 -> 95}}

{60, 75, 60, 20, 70, 30, 5, 5, 15, 90, 75, 90, 0, 50, 35, 80, 30, 15, \
25, 70, 65, 90, 5, 25, 35, 20, 65, 40, 80, 15, 20, 40, 45, 95, 50, \
70, 55, 35, 5, 70, 10, 90, 55, 85, 25, 25, 95, 90, 85, 20, 80, 55, \
45, 35, 75, 25, 30, 5, 5, 30, 65, 80, 25, 85, 35, 35, 50, 75, 0, 20, \
65, 85, 40, 35, 25, 55, 65, 20, 75, 60, 0, 50, 60, 80, 10, 35, 5, 5, \
5, 75, 60, 65, 25, 10, 10, 30, 25, 55, 90, 90}

True
936
96