Test whether date is in a certain period

Question

I have one table which contains time periods ("start" and "end") and a "type" for every period:

table1 = {{"start", "end", "type"}, 
          {{2013, 8, 10, 8, 5, 0.`}, {2013, 8, 10, 10, 6, 0.`}, "a"}, 
          {{2013, 8, 10, 10, 6, 0.`}, {2013, 8, 10, 10, 50, 0.`}, "b"}, 
          {{2013, 8, 10, 10, 50, 0.`}, {2013, 8, 10, 12, 10, 10.`}, "c"}} 

Now, I have a second table which contains dates:

table2 = {"date", 
          {2013, 8, 10, 11, 5, 0.`}, 
          {2013, 8, 10, 10, 15, 0.`}, 
          {2013, 8, 10, 10, 35, 0.`},
          {2013, 8, 10, 11, 10, 0.`}, 
          {2013, 8, 10, 12, 5, 0.`}} 

What I want to do now, is to test whether a date is within one of the periods and if yes in which period. The result should be a table which shows in which period the date is. For my small example, the table should look like this:

result = {{"date", "coresp. type"}, 
          {{2013, 8, 10, 11, 5, 0.`}, "c"}, 
          {{2013, 8, 10, 10, 15, 0.`}, "b"}, 
          {{2013, 8, 10, 8, 5, 0.`}, "a"}, 
          {{2013, 8, 10, 11, 10, 0.`}, "c"}, 
          {{2013, 8, 10, 12, 5, 0.`}, "c"}, 
          {{2013, 9, 10, 10, 10, 0.`}, "none"}}

Is there an way to create the result table automatically?

Answer 1

I would do it like this, using AbsoluteTime, which is often much faster than alternatives.

Module[{
  intv = Interval /@ Map[AbsoluteTime, table1[[2 ;;, {1, 2}]], {-2}],
  type = table1[[2 ;;, 3]],
  data = Rest[table2],
  out
 },
 out = Pick[type, intv ~IntervalMemberQ~ #] & /@ AbsoluteTime /@ data;
 Join[List /@ data, out /. {} -> {"none"}, 2] ~Prepend~ {"date", "coresp. type"}
]

{{"date", "coresp. type"},
 {{2013, 8, 10, 11, 5, 0.`}, "c"},
 {{2013, 8, 10, 10, 15, 0.`}, "b"},
 {{2013, 8, 10, 10, 35, 0.`}, "b"},
 {{2013, 8, 10, 11, 10, 0.`}, "c"},
 {{2013, 8, 10, 12, 5, 0.`}, "c"}}

---

Comparative Timings

With apologies to Kuba, since I feel that the method that was Accepted is vastly inferior to this one I am compelled to provide support for my position.

I will generate a large set of sample data. I will leave out the header rows in all data for simplicity.

t1big =
  Join[
    Partition[DateList /@ Range[1.43*^9, 3*^9, 3*^7], 2, 1],
    List /@ CharacterRange["A", "z"] ~Drop~ {27, 32},
    2
  ];

t2big = RandomSample[DateList /@ Range[1*^9, 3*^9, 1*^6]];

Length /@ {t1big, t2big}

{52, 2001}

The timing function:

timeAvg = 
  Function[func,
    Do[If[# > 0.3, Return[#/5^i]] & @@ Timing@Do[func, {5^i}], {i, 0, 15}],
    HoldFirst];

First Kuba's method:

With[{
   table1 = t1big,
   table2 = t2big
  },
  new = {};
  len = Length@table1;
  Do[
     If[i == len + 1, AppendTo[new, {#, "None"}]; Break[];];
     If[DateDifference[#, table1[[i, 2]]] >= 0 && DateDifference[table1[[i, 1]], #] >= 0, 
      AppendTo[new, {#, table1[[i, 3]]}]; Break[]],
     {i, 1, len + 1}
  ] & /@ table2;
  new
] // timeAvg

80.2

Then mine:

Module[{
   intv = Interval /@ Map[AbsoluteTime, t1big[[All, {1, 2}]], {-2}],
   type = t1big[[All, 3]],
   data = t2big,
   out
  },
  out = Pick[type, intv ~IntervalMemberQ~ #] & /@ AbsoluteTime /@ data;
  Join[List /@ data, out /. {} -> {"none"}, 2]
] // timeAvg

0.03304

So my method is ~2400X faster than Kuba's.

Answer 2

It can be done faster if we know more about those intervals, if they can overlap etc.

But let's make an assumption that there is only one or none date interval matching for each date in table2.

Edit: your result is for different table2 than you showed so let's take what you've taken:

table2 = Rest[result][[ ;; , 1]]

Also, probably there is something built in but meanwhile:

new = {};
len = Length@table1;
Do[
   If[i == len + 1, AppendTo[new, {#, "None"}]; Break[];];
   If[DateDifference[#, table1[[i, 2]]] >= 0 && 
      DateDifference[table1[[i, 1]], #] >= 0
      ,
      AppendTo[new, {#, table1[[i, 3]]}]; Break[]], 
  {i, 1, len + 1}] & /@ table2;

new

{{{2013, 8, 10, 11, 5, 0.}, "c"}, {{2013, 8, 10, 10, 15, 0.}, "b"}, 
  {{2013, 8, 10, 8, 5, 0.}, "a"}, {{2013, 8, 10, 11, 10, 0.}, "c"}, 
  {{2013, 8, 10, 12, 5, 0.}, "c"}, {{2013, 9, 10, 10, 10, 0.}, "None"}}

Answer 3

I make the assumptions, as above, of disjoint intervals and test data belongs to one or no interval.

I note that your original and result test data are not the same. The following is not elegant and I look forward to better solutions. It does work.

(* Strip header *)    
tab1=Drop[table1,1];
(* Define function to map date to number *)
    df[u_] := {10000, 100, 1, 0.01, 0.0001, 0.000001}.u;
(* Use Which to categorize *)
    f[x_] := Which @@ 
       Join[Flatten[{IntervalMemberQ[#[[1]], 
             df[x]], {x, #[[2]]}} & /@ ({Interval[{df@#[[1]], 
                df@#[[2]]}], #[[3]]} & /@ tab1), 
         1], {True, {x, "none"}}];

Applying f/@res to your second test set:

res={{2013, 8, 10, 11, 5, 0.}, {2013, 8, 10, 10, 15, 0.}, {2013, 8, 10, 8,
   5, 0.}, {2013, 8, 10, 11, 10, 0.}, {2013, 8, 10, 12, 5, 0.}, {2013,
   9, 10, 10, 10, 0.}}

yields:

   {
{{2013, 8, 10, 11, 5, 0.},"c"},
{{2013, 8, 10, 10, 15, 0.},"b"},
{{2013, 8, 10, 8, 5, 0.},"a"},
{{2013, 8, 10, 11, 10, 0.},"c"}, 
{{2013, 8, 10, 12, 5, 0.},"c"},
{{2013, 9, 10, 10, 10, 0.},"none"}
}

consistent with the question.

For the original test data:

tab2={{2013, 8, 10, 11, 5, 0.}, {2013, 8, 10, 10, 15, 0.}, {2013, 8, 10, 
  10, 35, 0.}, {2013, 8, 10, 11, 10, 0.}, {2013, 8, 10, 12, 5, 0.}}

yields:

    {
{{2013, 8, 10, 11, 5, 0.}, "c"},
{{2013, 8, 10, 10, 15, 0.},"b"},
{{2013, 8, 10, 10, 35, 0.},"b"},
{{2013, 8, 10, 11, 10, 0.},"c"}, 
{{2013, 8, 10, 12, 5, 0.}, "c"}
}

Answer 4

I just factored it differently, nothing special:

period[dt_, {start_, end_, period_}] := 
  If[DateDifference[start, dt ] > 0 &&   DateDifference[dt, end] > 0, 
     period];
getPeriod[dt_] := 
  First[DeleteCases[period[dt, #] & /@ Rest[table1], Null]];
Table[{date, getPeriod[date]}, {date , Rest[table2]}]

{
 {{2013, 8, 10, 11, 5, 0.}, "c"}, 
 {{2013, 8, 10, 10, 15, 0.}, "b"}, 
 {{2013, 8, 10, 10, 35, 0.}, "b"}, 
 {{2013, 8, 10, 11, 10, 0.}, "c"}, 
 {{2013, 8, 10, 12, 5, 0.}, "c"}
}