Animation: presenting events that persist in time

Question

I have a list of events that occurred on specific moments in time. In the example below, the three events occurred at 23:09, 23:13 and 23:17. I was able to build an animation that flows from time 23:00 to 0:00 and shows at the right time the event by plotting a disc of a specified magnitude at the specified coordinates.

data = {{{2012, 3, 19, 23, 9}, 44.891, 12.202, 2.6, 2.5, 
   3541187340}, {{2012, 3, 19, 23, 13}, 44.898, 11.258, 6.2, 4.1, 
   3541187580}, {{2012, 3, 19, 23, 17}, 44.186, 11.496, 4.2, 2.2, 
   3541187820}};

Each event is specified by its time of occurrence, x and y coordinates, magnitude 1, magnitude 2, absolute time. First, I specified the start and end time of the animation in absolute time and build a list of times from start to end in steps of one minute:

start = AbsoluteTime[{2012, 3, 19, 23, 0, 0}];
end = AbsoluteTime[{2012, 3, 20, 0, 0, 0}];
time = Table[start + 60*i, {i, 0, (end - start)/60}];

For my convenience I reshuffled my data:

d3 = Table[{data[[i, 6]], data[[i, 2]], data[[i, 3]], data[[i, 4]], 
   data[[i, 5]]}, {i, Length[data]}];

and checked which values in the 'time' list are taken by the time of my events:

doubles = 
 Flatten[Table[Position[time, d3[[All, 1]][[i]]], {i, Length[d3]}]];

Lastly, I inserted my events in the 'time' list:

d4 = ReplacePart[time, 
   Table[doubles[[i]] -> d3[[i]], {i, Length[d3]}]];

I can then generate my frames:

frames = Animate[If[Length[d4[[i]]] > 1,
  Graphics[{
    White,
    Rectangle[{10, 43}, {13, 46}],
    Red, Disk[d4[[i, {3, 2}]], d4[[i, 5]]/10],
    Black, 
    Text[Style[
      DateString[
       DateList[d4[[i, 1]]], {"Day", " ", "MonthNameShort", " ", 
        "Year", "   ", "Hour", ":", "Minute"}], 
      FontFamily -> "Helvetica", FontSize -> 20], {10.8, 45.85}]
    }],
  Graphics[{
    White,
    Rectangle[{10, 43}, {13, 46}],
    Black, 
    Text[Style[
      DateString[
       DateList[d4[[i]]], {"Day", " ", "MonthNameShort", " ", "Year", 
        "   ", "Hour", ":", "Minute"}], FontFamily -> "Helvetica", 
      FontSize -> 20], {10.8, 45.85}]
    }]
  ], {i, Range[Length[d4]]}, AnimationRate -> 20];

Export["animation.gif", frames, "DisplayDurations" -> .03]

However, what I would like to achieve is a more complicated animation: once an event is plotted at the right time I would like to then present it also on subsequent frames, but slowly dimming (decreasing Opacity) for a specified time window. At the end of the animation all events would be thus dimmed and superimposed.

I simplified a lot the example I provided, real data might span over several days and contain hundreds of events.

Answer 1

You could do something like this. Here, duration is the time in seconds it takes for the disk to fade away.

signal[data_, duration_][t_] := Piecewise[{{{}, t < data[[-1]]},
   {{Opacity[1 - (t - data[[-1]])/duration], 
     Disk[data[[{3, 2}]], data[[5]]/10]},
    data[[-1]] <= t < data[[-1]] + duration},
   {{}, t >= data[[-1]] + duration}}]

With[{tmin = AbsoluteTime[{2012, 3, 19, 23, 0}],
   tmax = AbsoluteTime[{2012, 3, 20, 0, 0}],
   duration = 3600},
  tab = Table[Graphics[{
      {White, Rectangle[{10, 43}, {13, 46}]},
      Text[Style[DateString[
         t, {"Day", " ", "MonthNameShort", " ", "Year", "   ", "Hour",
           ":", "Minute"}], FontFamily -> "Helvetica", 
        FontSize -> 20], {10.8, 45.85}],
      {Red, signal[#, duration][t] & /@ data}}],
    {t, tmin, tmax, 60}]];

Export["image.gif", tab, "DisplayDurations" -> .03]

Answer 2

The following is a variation on Heike's answer allowing different colors and durations for different graphics objects:

ClearAll[signal1];
signal1[dta_, duration_, color_][t_] := 
 Piecewise[{{{Lighter[color, (t - dta[[-1]])/duration], Disk[dta[[{3, 2}]], dta[[5]]/10]},  dta[[-1]] <= t < dta[[-1]] + duration}, 
  {{},  t < dta[[-1]] || dta[[-1]] + duration <= t}}]; 
With[{tmin = AbsoluteTime[{2012, 3, 19, 23, 0}],  
      tmax = AbsoluteTime[{2012, 3, 20, 0, 0}]},
frames = Table[ Graphics[{{White, Rectangle[{10, 43}, {13, 46}]}, 
 Text[Style[ DateString[  t, {"Day", " ", "MonthNameShort", " ", "Year", " ", "Hour", 
     ":", "Minute"}], FontFamily -> "Helvetica", FontSize -> 20], {10.8, 45.85}], 
MapThread[{signal1[#1, #2, #3][t]} &, {data, {3600, 2400, 
    900}, {Red, Green, Blue}}]}], {t, tmin, tmax, 60}]];
Export["fadingdisks1.gif", frames, "DisplayDurations" -> .03]

Another variation that ties the disk radii to time:

ClearAll[signal2b];
signal2b[dta_, duration_, color_][t_] := 
 Switch[dta[[-1]] <= t < dta[[-1]] + duration,  
   True, {Lighter[color, (t - dta[[-1]])/duration], 
         Disk[dta[[{3, 2}]], (1 - (t - dta[[-1]])/duration) dta[[5]]/ 10]}, 
   _, {}]; 
With[{tmin = AbsoluteTime[{2012, 3, 19, 23, 0}], 
      tmax = AbsoluteTime[{2012, 3, 20, 0, 0}]}, 
frames = Table[
 Graphics[{{White, Rectangle[{10, 43}, {13, 46}]}, 
   Text[Style[DateString[ t, {"Day", " ", "MonthNameShort", " ", "Year", " ", "Hour", 
     ":", "Minute"}], FontFamily -> "Helvetica", FontSize -> 20], {10.8, 45.85}], 
MapThread[{signal2b[#1, #2, #3][t]} &, {data, {3600, 2400, 
    600}, {Red, Green, Blue}}]}], {t, tmin, tmax, 60}]];
Export["fadingdisks2b.gif", frames, "DisplayDurations" -> .03]

Note: You can also use {color, Opacity[1 - (t - data[[-1]])/duration],...} instead of {Lighter[color, (t - data[[-1]])/duration},...} in definitions of signal1 and signal2b.