Mathematica 9 is now available
Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2007

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Number of interval Intersections for a large number of

  • To: mathgroup at smc.vnet.net
  • Subject: [mg81765] Re: Number of interval Intersections for a large number of
  • From: Ray Koopman <koopman at sfu.ca>
  • Date: Wed, 3 Oct 2007 02:28:21 -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?

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]:=
{u,v} = Transpose@Sort@Flatten[Transpose@{#,{1,-1}}&/@t,1];
w = Transpose@{Partition[Join[{0},u,{max}],2,1],FoldList[Plus,0,v]}
m = Max[Last/@w]
Table[{i,First/@Select[w,#[[2]]==i&]},{i,0,m}]

Out[4]=
{{{0,2.91777},0},{{2.91777,6.76612},1},{{6.76612,10.6363},2},
 {{10.6363,14.2374},3},{{14.2374,14.4536},4},{{14.4536,16.9744},5},
 {{16.9744,17.7657},4},{{17.7657,19.4148},5},{{19.4148,20.027},4},
 {{20.027,28.9051},5},{{28.9051,29.0713},6},{{29.0713,32.2291},5},
 {{32.2291,41.9963},4},{{41.9963,48.1385},3},{{48.1385,50.0155},2},
 {{50.0155,65.3366},3},{{65.3366,67.9657},4},{{67.9657,73.1989},3},
 {{73.1989,78.6108},2},{{78.6108,91.5483},1},{{91.5483,100},0}}

Out[5]=
6

Out[6]=
{{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[7]:=
Show[Graphics[Line@Transpose@{#1,{#2,#2}}&@@@w]];



  • Prev by Date: Re: Re: Palette Size
  • Next by Date: Re: Re: Number of interval Intersections for a large number
  • Previous by thread: Re: Number of interval Intersections for a large number of
  • Next by thread: Re: Number of interval Intersections for a large number of