12

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].

kjo
  • 11,717
  • 1
  • 30
  • 89
  • 1
    What operations do you typically want to do with these lists? – Marius Ladegård Meyer May 17 '17 at 16:11
  • Maybe Tally[list]? – Alucard May 17 '17 at 16:33
  • 1
    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. – jkuczm May 17 '17 at 19:38
  • 1
    Flatten[Tally /@ Split[lcl], 1] – Dr. Wolfgang Hintze May 23 '17 at 20:07
  • @Dr.WolfgangHintze: Interesting idea, but when I time it I find that it is ~2x slower than the more pedestrian-looking {First[#], Length[#]} & /@ Split[lcl]. – kjo May 24 '17 at 12:23
  • 1
    @kjo You are right. I have also noticed the performance drawback. The effect even grows with increasing length of the list. – Dr. Wolfgang Hintze May 25 '17 at 16:14

3 Answers3

6

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];
p = sa["AdjacencyLists"]
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
Mr.Wizard
  • 271,378
  • 34
  • 587
  • 1,371
  • 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 '17 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 '17 at 13:16
  • BTW, I found your https://mathematica.stackexchange.com/questions/83721/what-are-sparsearray-properties-how-and-when-should-they-be-used... Thanks! – kjo May 18 '17 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. – Mr.Wizard May 18 '17 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 '17 at 14:29
4
 {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.

David G. Stork
  • 41,180
  • 3
  • 34
  • 96
3
  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];
  rules = Thread[Rule[uniques, digits]];
  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
webcpu
  • 3,182
  • 12
  • 17