4
$\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$

3 Answers 3

2
$\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$
1
  • $\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
    Commented Sep 1, 2018 at 18:53
1
$\begingroup$
lis = {"a", "b", "January", "1", "2012", "c", "d", "e", "January", 
  "2", "2012", "f", "September", "4", "2012", "w", "y", "z"}

months = {"January", "February", "March", "April", "May", "June", 
   "July", "August", "September", "October", "Novemeber", "December"};

f[k_List, h_List] := Module[{temp = StringJoin @@ Riffle[k, " "]},
  {DateObject[temp], Sequence @@ h}
  ]

Split[lis, FreeQ[months, #2] &] // Select[Length@# > 2 &] // 
  Map[TakeDrop[#, 3] &] // Map[Apply[f]]

enter image description here

$\endgroup$

Your Answer

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

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