Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I have a list of intervall.
Some of these intervals are disjoint, some are overlapped and some are included in others. To leave no ambiguity about my explanation, you can see the following examples:

{1, 2} and {3, 4} are disjointed.
{1, 3} and {2, 4} are overlaped.
{2,3} are included in {1,4}.

I would like to identify any intervals in a list that are completely included in others.
For example:

{2,3} are included in {1,4}
{2,4} are included in {1,4}
{1,3} are included in {1,4}
ect ..


Objectives


The goal is to get the list of positions of all intervals that are included in others in order to eliminate them. It's important to notice here that the list to study is always sorted.

Example of list :

ListT = {{1, 8}, {2, 8}, {3, 8}, {4, 8}, {5, 10}, {6, 10}, {7, 11}, {8, 14}};

I already write an algorithm that I find too slow. It is unnecessary to expose here. So I write the followings algorithm :

Supone[x_] := If[x > 1, True, False];

Tentative1[ListT] :=
  Block[
        {Step2T1, Step3T1, Step4T1, Step5T1, Step6T1,Res},

         Step2T1 = Map[Interval[#] &, ListT];

         Step3T1 = Table[
                         IntervalMemberQ[Step2T1[[i]], Step2T1[[j]]],
                         {i, 1, Length@Step2T1, 1},
                         {j, 1, Length@Step2T1, 1}
                        ];

         Step4T1 = DeleteCases[Step3T1, False, Infinity];

         Step5T1 = Map[Count[#, True] &, Step4T1];

         Step6T1 = Position[Step5T1, _?Supone];

         Res = (Flatten@Step6T1) + 1

       ];

Tentative2[ListT_] :=
  Block[
        {Step2T2, Step3T2, Step4T2, Step5T2, Step6T2, Res},

         Step2T2 = Map[Interval[#] &, ListT];

         Step3T2 = Outer[IntervalMemberQ, Step2T2, Step2T2];

         Step4T2 = DeleteCases[Step3T2, False, Infinity];

         Step5T2 = Map[Count[#, True] &, Step4T2];

         Step6T2 = Position[Step5T2, _?Supone];

         Res = (Flatten@Step6T2) + 1;

       ];

Tentative3[ListT_] :=
  Block[
        {Step2T3, Step3T3, Step4T3, Step5T3, Step6T3,Res},

        Step2T3 =  Map[Interval[#] &, ListT];

        Step3T3 = Intersection[Step2T3,IntervalIntersection @@@ Subsets[Step2T3, {2}]];

        Step4T3 = Map[Position[Step2T3, #] &, Step3T3];

        Res = Flatten@Step4T3

       ];

IMQ[x_, y_] :=
  Block[
        {Memo, Res}, 
        If[
           x[[1]] <= y[[1]],       
           If[x[[1]] <= y[[1]] && x[[2]] >= y[[2]], Memo = True, Memo = False];,
           Memo = False;
          ];
         Res = Memo
       ];

FBS =
  Compile[
          {{List, _Real, 2}, {Interv, _Real, 1}},
          Module[
                 {i, j, st, end, xmin, xmax, Restr, Testlog},
                 xmin = Interv[[1]];
                 xmax = Interv[[-1]];
                 st = List[[All, 1]];
                 end = List[[All, 2]];
                 i = 1; While[end[[i]] < xmax, i++];
                 j = 1; While[end[[-j]] > xmax, j++];
                 Restr = List[[i ;; -j]];
                 Testlog = Count[Map[IMQ[#, Interv] &, Restr], True];
                 If[Testlog > 1, 1, -1]
                ],
            Parallelization -> True,
            "RuntimeOptions" -> "Speed"
          ];

Tentative4[ListT_] :=
  Block[
        {Step2T4, Step3T4, Step4T4, Step5T4, Step6T4, Res},

         Step2T4 = ListT;

         Step3T4 = Position[Map[FBS[Step2T4, #] &, Step2T4], 1];

         Res = Flatten@Step3T4
       ];

Tentative5[ListT_] :=
  Block[
        {Step2T5, Step3T5, Step4T5, Step5T5, Step6T5, Res},

         Step2T5 = ListT;
         Step3T5 =
              Module[
                     {a, b},
                     {a, b} =Transpose[Outer[Plus, -Step2T5, Step2T5, 1], {2,3,1}];
                     SparseArray[Total[UnitStep[a] UnitStep[-b]] -1]["AdjacencyLists"]
                    ]
              ];

Tentative6[ListT_] :=
  Block[
         {Step2T6, Step3T6, Step4T6, Step5T6, Step6T6, Res},

         Step2T6 = ListT;
         Step3T6 = Pick[
                         Range@Length@Step2T6,
                         Map[MemberQ[Step2T6, {x_, y_} /; x <= #[[1]] && y >= #[[2]] && ! (x == #[[1]] && y == #[[2]])] &, Step2T6]
                       ]
            ]; 

GIMQ[x_, y_] :=
  Block[
        {Memo, Res},
              If[
                 x[[1]] <= y[[1]],

                 If[x[[1]] <= y[[1]] && x[[2]] >= y[[2]], Memo = True, Memo = False];,

                 If[y[[1]] <= x[[1]] && y[[2]] >=  x[[2]], Memo = True, Memo = False];
                ];
              Res = Memo
            ];

LIP[List_, i_] :=
  Module[
         {j, Res},
          j = i - 1;
          If[ 
             j!= 0,
             If[ GIMQ[List[[i]], List[[j]]] == True, Res = 1;, Res = -1;],
             Res = -1;
            ];
           Res
        ];  

Tentative7[ListT] :=
  Block[
        {Step2T7, Step3T7, Step4T7, Step5T7, Step6T7, Res},

         Step2T7 = ListT
         Step3T7 = Position[Map[LIP[Step2T7, #] &, Range[1, Length@Step2T7, 1]], 1];
         Res = Flatten@Step3T7

       ];

Tentative8[ListT] :=
  Block[
        {Step2T8, Step3T8, Step4T8, Step5T8, Step6T8, Res},

         Step2T8 = ListT
         Step3T8 = Pick[
                        Range[2,Length@Step2T8],
                        IntervalMemberQ@@@Partition[Interval/@Step28,2,1]
                       ]

       ];


Timing


With : Length@List = 2000

Tentative1[List, Integer] -> 10.15 seconds (Personal n°1)
Tentative2[List, Integer] -> 6.46 seconds (Rasher's n°1)
Tentative3[List, Integer] -> 3.34 seconds (Rasher's n°2)
Tentative4[List, Integer] -> 5.42 seconds (Personal n°2)
Tentative5[List, Integer] -> 7.72 seconds (Simon Woods n°1)
Tentative6[List, Integer] -> 6,48 seconds (Rasher's n°3)
Tentative7[List, Integer] -> 0.48 seconds (Personal n°3)
Tentative7[List, Integer] -> 0.45 seconds (Simon Woods n°2)


Benchmark


For ListT = {{1, 8}, {2, 8}, {3, 8}, {4, 8}, {5, 10}, {6, 10}, {7, 11}, {8, 14}};
The result is : {2, 3, 4, 6}
So we can read this as : {2, 8}, {3, 8}, {4, 8} and {6, 10} are included in other intervals. Which ? We don't care... The objective is to obtain theirs positions.

The subject remains open. I'm interested in any solution that would be faster than the current one. Additional questions:
- Is it possible to use Compile on LIP ? How ?
- What's the better ? use of Block or use of Module ?

share|improve this question
    
You question is quite unclear. What is it exactly you want? Is it something like given a list of intervals, return a list of those completely contained in some other interval in the list? If so, something like Intersection[list, IntervalIntersection @@@ Subsets[list, {2}]] might serve your needs. If you want a "True/False" table like your first example, something like Outer[IntervalMemberQ, list, list] should be quite quick. –  rasher May 17 at 9:14
    
@rasher. Informations added ! –  Doedalos May 17 at 9:54
    
Still not clear to me. My best guess so far is that you want (1) to pick from your original list (call it $L1$) of interval all the intervals that are included in at lest one other interval in $L1$. Call the resulting (sub-)list $L2$. Then test whether the union of all intervals in $L2$ is itself an interval. Is that it? –  A.G. May 18 at 1:29
    
@A.G. I totally rewrite my post. Ask me if you have any other questions. –  Doedalos May 19 at 11:55
    
It is still not clear. Please could you include what the result should be for your example ListT and check that the posted code actually generates that result. –  Simon Woods May 19 at 16:03

2 Answers 2

Best known optimisation :

For a specific list :

Tentative8[ListT] :=
  Block[
        {Step2T8, Step3T8, Step4T8, Step5T8, Step6T8, Res},

         Step2T8 = ListT
         Step3T8 = Pick[
                        Range[2,Length@Step2T8],
                        IntervalMemberQ@@@Partition[Interval/@Step28,2,1]
                       ]

       ];

For a global list :

Tentative3[ListT_] :=
  Block[
        {Step2T3, Step3T3, Step4T3, Step5T3, Step6T3,Res},

        Step2T3 =  Map[Interval[#] &, ListT];

        Step3T3 = Intersection[Step2T3,IntervalIntersection @@@ Subsets[Step2T3, {2}]];

        Step4T3 = Map[Position[Step2T3, #] &, Step3T3];

        Res = Flatten@Step4T3

       ];
share|improve this answer
    
A couple of points - firstly please be aware that List is a terrible choice of variable name (as you used in LIP) because it is the symbol used by Mathematica as the head of lists. While it doesn't cause any problem here, it is generally good practice to avoid using built-in symbol names for your own variables. –  Simon Woods May 21 at 9:01
    
Secondly, your GIMQ function may be more succinctly written as GIMQ[{{a_, b_}, {c_, d_}}] := a <= c && b >= d –  Simon Woods May 21 at 9:03
    
Finally, I note that this solution relies on checking interval intersections only between adjacent list elements. So for example Tentative7[{{1, 10}, {2, 4}, {6, 8}}] returns {2} instead of {2, 3}. Is this the intended behaviour? –  Simon Woods May 21 at 9:07
    
Firstly thank you for the 2 advices/improvements in your comments. Then according to your example, it is better for me that Tentative7 [{{1, 10}, {2, 4}, {6, 8}}] returns {2,3} instead of {2}. But in my case, it is impossible that the data I have to be treated have this configuration. In fact, I always have {{1, 10}, {2, 4}, {3, 4}} instead of {{1, 10}, {2, 4}, {6, 8}} for example. I did not realize this when I started looking for a solution. –  Doedalos May 21 at 10:25

Update

With the added information that it is sufficient to test each interval only against the preceding one, this will be fairly fast:

Pick[Range[2, Length@ListT], IntervalMemberQ @@@ Partition[Interval /@ ListT, 2, 1]]

Original

This version tests every interval against every other:

result = Module[{a, b},
    {a, b} = Transpose[Outer[Plus, -ListT, ListT, 1], {2, 3, 1}];
    SparseArray[Total[UnitStep[a] UnitStep[-b]] - 1]["AdjacencyLists"]];
share|improve this answer
    
Finally your solution is slightly faster than mine. I also tried to use ToPackedArray. I noticed no improvement in execution time. Code used : Needs [Developer '] NewListT = Developer'ToPackageArray [ListT] –  Doedalos May 21 at 14:12

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.