Re: Number of interval Intersections for a large number of

*To*: mathgroup at smc.vnet.net*Subject*: [mg81832] Re: Number of interval Intersections for a large number of*From*: Ray Koopman <koopman at sfu.ca>*Date*: Thu, 4 Oct 2007 04:29:57 -0400 (EDT)*References*: <fdt3r8$s2i$1@smc.vnet.net>

On Oct 2, 2:43 am, P_ter <peter_van_summe... at yahoo.co.uk> wrote: > It seems I was not clear enough in my problem. > I have a few thousand intervals {e1,e2,...} each of which is like {begin,end} > The elements e are ordered according to their begin value. > Some intervals do not intersect. But it also can be like this (the points are only for making a clear drawing): > .......<------> > ...<-------------------> > <------------------> > So, in this case the first interval can be partioned : > in a part which has no intersection with the other two, > in a part which intersects twice, > in a part which intersects three times, > in a part which intersects two times. > For each interval I make a Block[x] = UnitStep[x-beginvalue]-UnitStep[x-endvalue] > I sum all the Blocks to one function and ask Reduce to find me a solution for those parts of intervals which intersects only three times: Reduce[SumOfBlocks[x]==3,x]. > Because it is a sum of UnitSteps and where there are three times an intersection, the value is 3. > And so on for 1,2,4,5,etc. > It is a safe way to do it, but not so fast. Are there other algorithms? Where can I find them? Here's a slightly simpler way to do it. Generate some intervals. In[1]:= t = Sort[Sort/@Table[Random[],{n = 10},{2}]]*(max = 100) Out[1]= {{2.91777,91.5483},{6.76612,16.9744},{10.6363,48.1385}, {14.2374,41.9963},{14.4536,73.1989},{17.7657,19.4148}, {20.027,32.2291},{28.9051,29.0713},{50.0155,67.9657}, {65.3366,78.6108}} In[2]:= Show[Graphics[MapThread[Line@Transpose@{#1,{#2,#2}}&,{t,Range@n}]]]; Get the overlaps. In[3]:= {p,q} = {Partition[ Join[{0},#[[All,1]],{max}], 2, 1], FoldList[ Plus, 0, #[[All,2]]]}& @ Sort@Flatten[Transpose@{#,{1,-1}}&/@t, 1] r = {#,Pick[p,q,#]}& /@ Range[0,Max@q] Out[3]= {{{0,2.91777},{2.91777,6.76612},{6.76612,10.6363}, {10.6363,14.2374},{14.2374,14.4536}, {14.4536,16.9744},{16.9744,17.7657}, {17.7657,19.4148},{19.4148,20.027}, {20.027,28.9051},{28.9051,29.0713}, {29.0713,32.2291},{32.2291,41.9963}, {41.9963,48.1385},{48.1385,50.0155}, {50.0155,65.3366},{65.3366,67.9657}, {67.9657,73.1989},{73.1989,78.6108}, {78.6108,91.5483},{91.5483,100}}, {0,1,2,3,4,5,4,5,4,5,6,5,4,3,2,3,4,3,2,1,0}} Out[4]= {{0,{{0,2.91777},{91.5483,100}}}, {1,{{2.91777,6.76612},{78.6108,91.5483}}}, {2,{{6.76612,10.6363},{48.1385,50.0155},{73.1989,78.6108}}}, {3,{{10.6363,14.2374},{41.9963,48.1385},{50.0155,65.3366}, {67.9657,73.1989}}}, {4,{{14.2374,14.4536},{16.9744,17.7657},{19.4148,20.027}, {32.2291,41.9963},{65.3366,67.9657}}}, {5,{{14.4536,16.9744},{17.7657,19.4148},{20.027,28.9051}, {29.0713,32.2291}}}, {6,{{28.9051,29.0713}}}} In[5]:= Show[Graphics[MapThread[Line@Transpose@{#1,{#2,#2}}&,{p,q}]]]; If you don't want all of r at once, Pick[p,q,x] will give a list of the intervals whose overlap depth is x.