3
$\begingroup$

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 ?

Improve this question
$\endgroup$
10
  • $\begingroup$ 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. $\endgroup$
    – ciao
    May 17, 2014 at 9:14
  • $\begingroup$ @rasher. Informations added ! $\endgroup$
    – Doedalos
    May 17, 2014 at 9:54
  • $\begingroup$ 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? $\endgroup$
    – A.G.
    May 18, 2014 at 1:29
  • $\begingroup$ @A.G. I totally rewrite my post. Ask me if you have any other questions. $\endgroup$
    – Doedalos
    May 19, 2014 at 11:55
  • $\begingroup$ 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. $\endgroup$
    – Simon Woods
    May 19, 2014 at 16:03

3 Answers 3

Reset to default
2
$\begingroup$

Note that the following is the 1D analog of my answer to How to remove those rectangle within another rectangle.

You say that you want the positions of included intervals so that you can eliminate them. In that case, you can just use the function Internal`ListMin to return a list with all of the subintervals eliminated. Basically, Internal`ListMin finds maximal elements based on the usual component-wise partial order. For example, if $(x_1, y_1)$ and $(x_2, y_2)$ are two elements, than you want to eliminate $(x_1, y_1)$ if both $x_1\ge x_2$ and $y_1 \le y_2$. Alternatively, you want to eliminate $(x_1, y_1)$ if $x_2 \le x_1$ and $-y_2 \le -y_1$. This is just the usual component-wise order on $(x, -y)$. So, using Internal`ListMin gives:

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

Internal`ListMin[ListT . {{0, 1}, {-1, 0}}] . {{0, -1}, {1, 0}}

{{1, 8}, {8, 14}, {5, 10}, {7, 11}}

Rewriting as a function:

removeSubintervals[pairList_] := Internal`ListMin[pairList . {{0, 1}, {-1, 0}}] . {{0, -1}, {1, 0}}

And coming up with a bigger example:

pList = Table[RandomInteger[1000] {1, 1} + {0, RandomInteger[30]}, {10^5}];

removeSubintervals[pList]; // AbsoluteTiming

{0.313088, Null}

Only .31 seconds for a pair list of length 10^5.

Improve this answer
$\endgroup$
1
$\begingroup$

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"]];
Improve this answer
$\endgroup$
1
  • $\begingroup$ 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] $\endgroup$
    – Doedalos
    May 21, 2014 at 14:12
1
$\begingroup$

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

       ];
Improve this answer
$\endgroup$
4
  • $\begingroup$ 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. $\endgroup$
    – Simon Woods
    May 21, 2014 at 9:01
  • $\begingroup$ Secondly, your GIMQ function may be more succinctly written as GIMQ[{{a_, b_}, {c_, d_}}] := a <= c && b >= d $\endgroup$
    – Simon Woods
    May 21, 2014 at 9:03
  • $\begingroup$ 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? $\endgroup$
    – Simon Woods
    May 21, 2014 at 9:07
  • $\begingroup$ 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. $\endgroup$
    – Doedalos
    May 21, 2014 at 10:25

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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