3
$\begingroup$

I have a list of strings. Interspersed in the list are long forms of dates, followed by data pertaining to that date, succeeded by another date, which is in turn succeeded by more data. An example might make this more easily understood.

lis = {"a","b","January","1","2012","c","d","e","January","2","2012","f",
  "September","4","2012","w","y","z"}

I would like to have the dates transferred into DateObjects as follows:

res = {DateObject[{2012,1,1}],"c","d","e"}, 
   {DateObject[{2012,1,2}],"f"}, 
   {DateObject[{2012,9,4}],"w","y","z"}
$\endgroup$
1
$\begingroup$

Alternative:

months = Alternatives @@ {"January", "February", "March", "April", 
    "May", "June", "July", "August", "September", "October", 
    "Novemeber", "December"};
days = Alternatives @@ Map[ToString, Range[31]];
years = Alternatives @@ Map[ToString, Range[3000]];
toDateObject[{m_, d_, y_}] := DateObject@DateString@StringRiffle[{m, d, y}, "/"]

SequenceSplit[
 list,
 {m : months, d : days, y : years, rest : Except[months] ..} :> {toDateObject[{m, d, y}], rest}
 ]

Mathematica graphics

Possibly followed by DeleteCases[sequences, {__String}] to remove the first list without a date object in it.

$\endgroup$
2
$\begingroup$

Update: If dates are always in consecutive strings (month followed by day followed by year) in your list, a much faster alternative is possible using Split:

ClearAll[reShape, f1 , f2]
monthnames = Alternatives @@ (DateString[#, "MonthName"] & /@ Thread[{2018, Range@12}]) ;
reShape [{a : monthnames, b_, c_, d___}] := {DateObject[DateString[{a,"/",b,"/",c}]], d}
reShape [_] := Nothing

f1 = reShape /@ Split[#, Not @ MatchQ[#2, monthnames]&]&; 

f1 @lis

enter image description here

For lis in OP, this is faster than

f2 = DeleteCases[SequenceSplit[#, {m : months,  d : days, y : years , 
       rest : Except[months] ..} :> {toDateObject[{m, d, y}], 
       rest} ], {__String}]  &; (* from C.E.'s answer *)

r1 = f1 @ lis;// RepeatedTiming // First

0.0030

r2 = f2 @ lis ;// RepeatedTiming  // First

0.0046

r1 == r2

True

For longer lists the difference is more significant:

lis2 = Join @@ RandomSample[ConstantArray[lis, 50]];
r1 = f1 @ lis2; // RepeatedTiming // First

0.152

r2 = f2 @ lis2; // RepeatedTiming  // First

4.52

r1 == r2 

True

Also, a small modification in f2 doubles the speed:

ClearAll[f3]
f3 = DeleteCases[SequenceSplit[#, {m : months, d_, y_ , rest : Except[months] ..} :> 
  {toDateObject[{m, d, y}], rest} ], {__String}]  &;  

r3 = f3 @ lis2 ; // RepeatedTiming // First

2.11

r3 == r1

True

Original answer:

Using SequenceSplit and Internal`PossibleDateQ:

dQ = Internal`PossibleDateQ;
SequenceSplit[lis[[1 + LengthWhile[lis, Not @ dQ @ # &] ;;]], 
 {a_?dQ, b_, c_?dQ, d:Except[_?dQ] ..} :> {DateObject@DateString[{a, "/", b, "/", c}], d}]

{{DateObject[{2012, 1, 1}, "Day", "Gregorian", -7.], "c", "d", "e"}, {DateObject[{2012, 1, 2}, "Day", "Gregorian", -7.], "f"}, {DateObject[{2012, 9, 4}, "Day", "Gregorian", -7.], "w", "y", "z"}}

Alternatively,

DeleteCases[SequenceSplit[lis, {a_?dQ, b_, c_?dQ,  d : Except[_?dQ] ..} :> 
  {DateObject @ DateString[{a, "/", b, "/", c}], d}], {__String}]  

or

{DateObject @ DateString[Riffle[lis[[# ;; # + 2]], "/"]], 
  ## & @@ lis[[# + 3 ;; #2 - 1]] } & @@@ 
    Partition[Append[Flatten[Position[lis, _?dQ]][[;; ;; 2]], 1 + Length @ lis], 2, 1] 

same result

$\endgroup$
  • $\begingroup$ Yes, my data set has several thousand elements and the modifications suggested by kglr have helped speed things up greatly. Thank you! $\endgroup$ – Suite401 Sep 1 '18 at 18:53

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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