Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Overlapping strips

Suppose I have a series of strips of paper placed along an infinite ruler, with start and end points specified by pairs of numbers. I would like to create a list representing the number of layers of paper at points along the ruler.

For example:

strips = 
    {{-27,  20},
     { -2,  -1},
     {-47, -28},
     {-41,  32},
     { 22,  31},
     {  2,  37},
     {-28,  30}, 
     { -7,  39}}

Should output:

-47 -41 -27  -7  -2  -1   2  20  22  30  31  32  37  39
  1   2   3   4   5   4   5   4   5   4   3   2   1   0

What is the most efficient, clean, or terse way to do this, accommodating Real and Rational strip positions?

like image 823
Mr.Wizard Avatar asked Apr 25 '11 22:04

Mr.Wizard


2 Answers

Here's one approach:

Clear[hasPaper,nStrips]
hasPaper[y_, z_] := Piecewise[{{1, x <= z && x >= y}}, 0];
nStrips[y_, strip___] := Total@(hasPaper @@@ strip) /. x -> y

You can get the number of strips at any value.

Table[nStrips[i, strips], {i, Sort@Flatten@strips}]
{1, 2, 3, 3, 3, 4, 5, 5, 5, 5, 5, 5, 4, 3, 2, 1}

Also, plot it

Plot[nStrips[x, strips], {x, Min@Flatten@strips, Max@Flatten@strips}]

enter image description here

like image 168
abcd Avatar answered Oct 11 '22 07:10

abcd


Here is one solution:

In[305]:= 
strips = {{-27, 20}, {-2, -1}, {-47, -28}, {-41, 32}, {22, 31}, {2, 
    37}, {-28, 30}, {-7, 39}};

In[313]:= int = Interval /@ strips;

In[317]:= Thread[{Union[Flatten[strips]], 
  Join[Count[int, x_ /; IntervalMemberQ[x, #]] & /@ (Mean /@ 
      Partition[Union[Flatten[strips]], 2, 1]), {0}]}]

Out[317]= {{-47, 1}, {-41, 2}, {-28, 2}, {-27, 3}, {-7, 4}, {-2, 
  5}, {-1, 4}, {2, 5}, {20, 4}, {22, 5}, {30, 4}, {31, 3}, {32, 
  2}, {37, 1}, {39, 0}}


EDIT Using SplitBy and postprocessing the following code gets the shortest list:
In[329]:= 
strips = {{-27, 20}, {-2, -1}, {-47, -28}, {-41, 32}, {22, 31}, {2, 
    37}, {-28, 30}, {-7, 39}};

In[330]:= int = Interval /@ strips;

In[339]:= 
SplitBy[Thread[{Union[Flatten[strips]], 
    Join[Count[int, x_ /; IntervalMemberQ[x, #]] & /@ (Mean /@ 
        Partition[Union[Flatten[strips]], 2, 1]), {0}]}], 
  Last] /. {b : {{_, co_} ..} :> First[b]}

Out[339]= {{-47, 1}, {-41, 2}, {-27, 3}, {-7, 4}, {-2, 5}, {-1, 
  4}, {2, 5}, {20, 4}, {22, 5}, {30, 4}, {31, 3}, {32, 2}, {37, 
  1}, {39, 0}}
like image 41
Sasha Avatar answered Oct 11 '22 05:10

Sasha