Split list based on positions contained in another list

Question

The problem

Suppose that after importing several files into my nb (x-y dataset, but this procedure should work also for x-y-z datasets), I end up with a nested list similar to:

file01 = {{0.1, 1}, {0.2, 2}, {0.3, 3}, {0.4, 4}, {0.5, 5}};
file02 = {{0.1, 10}, {0.2, 20}, {0.3, 30}, {0.4, 40}, {0.5, 50}};
file03 = ..;
data = {file01, file02, file03, ..};

The data are x-sorted and unique.

I would like to split each file0i into sublists by comparing its x-values with some ranges contained in a different list, let's say:

ranges = {0.15, 0.25, 0.45};

The list ranges applies to all files, is not empty, sorted and does not exceed the x-values of each file0i-sublist.

The result I'm expecting should be:

splitData[data, ranges]
(*
{
  {
    {{0.1, 1}, {0.2, 2}},
    {{0.2, 2}, {0.3, 3}},
    {{0.3, 3}, {0.4, 4}, {0.5, 5}},
    {{0.5, 5}}
  },
  {
    {{0.1, 1}, {0.2, 2}},
    {{0.2, 2}, {0.3, 3}},
    {{0.3, 3}, {0.4, 4}, {0.5, 5}},
    {{0.5, 5}}
  }
}
*)

I do want the last and the first element of two consecutive sublists to be the same (for later use with ListPlot).

---

My solution

My idea was to develop a procedure that works for a single file0i-sublist and apply it later to all other sublists.

1. Find the first position at which the x-values of one file0i-sublist exceed the different values of ranges.

   Clear@findPositionSingleList;
   findPositionSingleList::usage = 
     "findPositionSingleList[ranges][list] finds the positions in
     list={{x1,y1},{x2,y2},..} where its x-element exceeds for the
     first time the values of ranges={X1,X2,..}. `list` can be a list
     of {x,y,z} values too.
     Example: findPositionSingleList[{1,5}][{{1,3},{2,4},{3,5},{6,7}}] = {2,4}";
   
   findPositionSingleList[ranges_List][list_List] := 
     Flatten@Outer[FirstPosition[x_ /; x > #1][#2] &, 
        ranges, {list[[All, 1]]}, 1] /. {x_} -> x;
   

   For example:

   findPositionSingleList[ranges][file01]
   (*{2, 3, 5}*)
   

   I was unable to get rid of the extra curly braces {list[[All, 1]]} in the function findPositionSingleList in order to make Outer work properly.

2. Split a single file0i-sublist using the positions calculated with findPositionSingleList:

     Clear@splitSingleList;
     splitSingleList::usage = 
       "splitSingleList[list_List,positions_List] = split `list` into
       sublists at the positions contained in positions.
       Example: splitList[{a,b,c,d,e,f,g,h},{2,3}] =
                {{a,b},{b,c},{c,d,e,f,g,h}}";
   
     splitSingleList[list_List, position_List] := Block[
       {iter},
       iter[l_List, pos_List, acc_: {}] :=
        If[Length@pos == 1,
         Join[acc, {l[[First@pos ;; -1]]}],
         iter[l, Rest@pos, Join[acc, {l[[pos[[1]] ;; pos[[2]]]]}]]
         ];
       Join[{list[[1 ;; First@position]]},
        iter[list, position] ]
       ]
   

3. Now I can combine the two functions:

     Clear@splitDataSingleList;
     splitDataSingleList[ranges_List][list_List] := 
      splitSingleList[#1, findPositionSingleList[#2][#1]] & @@ {list, ranges}
   

   When evaluated I get:

     splitDataSingleList[ranges][file01]
     (*
     {
       {{0.1, 1}, {0.2, 2}},
       {{0.2, 2}, {0.3, 3}},
       {{0.3, 3}, {0.4, 4}, {0.5, 5}},
       {{0.5, 5}}
     }
     *)
   

4. I can now easily extend the procedure over all sublists:

     Clear@splitData
     splitData[data_List, ranges_List] := splitDataSingleList[ranges] /@ data
         (*
         {
           {
             {{0.1, 1}, {0.2, 2}},
             {{0.2, 2}, {0.3, 3}},
             {{0.3, 3}, {0.4, 4}, {0.5, 5}},
             {{0.5, 5}}
           },
           {
             {{0.1, 1}, {0.2, 2}},
             {{0.2, 2}, {0.3, 3}},
             {{0.3, 3}, {0.4, 4}, {0.5, 5}},
             {{0.5, 5}}
           }
         }
         *)
   

---

My question

The procedure does what I want (I couldn't spot any side effects until now), but I was wondering if there's something that I can do to improve my code style (new built-in functions? better pattern-matching? maybe use Fold instead of the recursive function?).

Cheers.

Answer 1

Your approach is good, but you didn't find the simplest implementation. Here is another way:

ranges = {0.15, 0.25, 0.45, 0.5};

split[list_, cutoff_] := TakeDrop[list, LengthWhile[list, First[#] <= cutoff &]]
append[{list1_, list2_}] := Append[list1, First[list2]]
append[{list1_, {}}] := list1

FoldPairList[split, file01, ranges, append]
(*
{{{0.1, 1}, {0.2, 2}}, {{0.2, 2}, {0.3, 3}}, {{0.3, 3}, {0.4, 4}, {0.5, 5}}, {{0.5, 5}}}
*)

I added the largest x value to ranges, you can find it by using Max on the list of values if you don't know it.

Answer 2

Superseding my earlier answer I think I have a very pleasing solution using Sow and Reap.

No need for Partition or Cases in this code. This is not quite as fast however.

split2[r_List, p_: 1][a_List] :=
  Module[{i = 1, rr = Append[r, ∞]},
    a
     // Scan[Sow[#, i] || #[[p]] <= rr[[i]] || Sow[#, ++i] &]
     // Reap
     // Last
  ]

---

In version 10.1.0 I have neither TakeDrop nor FoldPairList so here is a method with Split.

split[r_List, p_: 1][a_List] :=
  Module[{i = 1, rr = Append[r, ∞]},
    Split[a, #2[[p]] <= rr[[i]] || i++ &]
     // Partition[#, 2, 1, 1, {}] &
     // Cases[{{x__}, {y_, ___}} | {{x___}} :> {x, y}]
  ]

Test:

file01 = {{0.1, 1}, {0.2, 2}, {0.3, 3}, {0.4, 4}, {0.5, 5}};
file02 = {{0.1, 10}, {0.2, 20}, {0.3, 30}, {0.4, 40}, {0.5, 50}};
ranges = {0.15, 0.25, 0.45};

split[ranges] /@ {file01, file02}

{
 {
  {{0.1, 1}, {0.2, 2}},
  {{0.2, 2}, {0.3, 3}},
  {{0.3, 3}, {0.4, 4}, {0.5, 5}},
  {{0.5, 5}}
 },
 {
  {{0.1, 10}, {0.2, 20}},
  {{0.2, 20}, {0.3, 30}},
  {{0.3, 30}, {0.4, 40}, {0.5, 50}},
  {{0.5, 50}}
 }
}

Are all lists to be split exactly the same? If so it will be faster to generate indexes for one and apply it to all, rather than splitting each list separately.

Answer 3

Processing the output of BinLists with appropriate bin specifications:

ClearAll[f]
f[r_] := With[{bl = BinLists[#, {Flatten@{-∞, r, ∞}}, {{-∞, ∞}}][[All, 1]]}, 
   Append[BlockMap[Join[#[[1]], {#[[2, 1]]}] &, bl, 2, 1], bl[[-1]]]] &;

Examples:

 file01 = {{0.1, 1}, {0.2, 2}, {0.3, 3}, {0.4, 4}, {0.5, 5}};
 file02 = {{0.1, 10}, {0.2, 20}, {0.3, 30}, {0.4, 40}, {0.5, 50}};
 ranges = {0.15, 0.25, 0.45}; 

 f[ranges]/@ {file01, file02}

{  
   {  
    {{0.1, 1}, {0.2, 2}},  
    {{0.2, 2}, {0.3, 3}},  
    {{0.3, 3}, {0.4, 4}, {0.5, 5}},  
    {{0.5, 5}}  
   },  
   {  
    {{0.1, 10}, {0.2, 20}},  
    {{0.2, 20}, {0.3, 30}},  
    {{0.3, 30}, {0.4, 40}, {0.5, 50}},  
    {{0.5, 50}}  
   }  
 }

For 9th and earlier versions you can use Developer`PartitionMap instead of BlockMap.