3
$\begingroup$

I want to create a gif where a graph is "losing" edges. I have the following code that creates a list of graphs.

eg = {1 <-> 3, 1 <-> 4, 1 <-> 13, 1 <-> 15, 1 <-> 21, 1 <-> 22, 
   1 <-> 30, 2 <-> 3, 2 <-> 7, 2 <-> 8, 2 <-> 9, 2 <-> 15, 2 <-> 25, 
   3 <-> 15, 3 <-> 16, 3 <-> 26, 3 <-> 28, 3 <-> 30, 4 <-> 12, 
   4 <-> 20, 4 <-> 22, 4 <-> 28, 5 <-> 8, 5 <-> 9, 5 <-> 11, 5 <-> 17,
    5 <-> 24, 5 <-> 25, 6 <-> 9, 6 <-> 15, 6 <-> 19, 6 <-> 21, 
   6 <-> 22, 7 <-> 22, 7 <-> 23, 7 <-> 27, 8 <-> 9, 8 <-> 10, 
   8 <-> 15, 8 <-> 22, 8 <-> 28, 9 <-> 11, 9 <-> 18, 10 <-> 13, 
   10 <-> 17, 10 <-> 25, 10 <-> 26, 10 <-> 29, 10 <-> 30, 11 <-> 17, 
   11 <-> 26, 11 <-> 30, 12 <-> 21, 12 <-> 24, 12 <-> 27, 13 <-> 14, 
   14 <-> 22, 15 <-> 21, 15 <-> 26, 15 <-> 30, 16 <-> 22, 17 <-> 22, 
   17 <-> 27, 17 <-> 28, 18 <-> 19, 18 <-> 20, 18 <-> 23, 19 <-> 24, 
   19 <-> 25, 19 <-> 27, 19 <-> 28, 20 <-> 24, 20 <-> 29, 21 <-> 26, 
   22 <-> 28, 24 <-> 25, 24 <-> 28, 25 <-> 29, 25 <-> 30, 27 <-> 29};

re = {};
be = eg;
ES = Join[Table[i -> {Red, Dashed, Thickness[0.001]}, {i, re}], 
   Table[i -> {Blue, Thickness[0.005]}, {i, be}]];
glist = {Graph[eg, EdgeStyle -> ES, VertexSize -> 0.7]};

Do[
 re = Join[re, RandomChoice[be, 1]];
 be = Complement[eg, re];
 ES = Join[Table[i -> {Red, Dashed, Thickness[0.001]}, {i, re}], 
   Table[i -> {Blue, Thickness[0.005]}, {i, be}]];

 AppendTo[glist, Graph[eg, EdgeStyle -> ES, VertexSize -> 0.7]],
 {i, Length[eg]}]

After that I use Animate to animate this.

an = Animate[glist[[i]], {i, 1, Length[glist], 1}, DefaultDuration -> 20, 
 AnimationRepetitions -> 1, AnimationDirection -> Forward]

After that I Export it to gif.

Export["edgeloss.gif", an, "ControlAppearance" -> None]

The problem I have with this is that the gif loops forwards and then backwards and also loses some of the frames. You can see it here: https://pasteboard.co/H9hZK6D.gif

I tried to export the list of graphs but the graph "vibrates" as frames change which is very annoying. You can see it here: https://pasteboard.co/H9hYhec.gif

Is there a way to have all the frames and having the gif only looping forward? Alternatively, can the list be animated without vibration?

$\endgroup$
2
$\begingroup$

Does this work for you? Note that I export glist converted to graphics via Show, not the output of Animate. I set PlotRange manually in order to avoid jiggling.

s = Max[PropertyValue[glist[[1]], VertexSize]];
g = Show[glist[[1]]];
plora = PlotRange /. AbsoluteOptions[g];
plora[[All, 1]] -= 0.25 s;
plora[[All, 2]] += 0.25 s;
Export["edgeloss.gif",
 Map[Rasterize[Show[#, PlotRange -> plora]] &, glist],
 "DisplayDurations" -> .1,
 AnimationRepetitions -> 1
 ]
$\endgroup$
12
  • $\begingroup$ As I said, this has all the frames and loops only forwards, but the graph vibrates for me. Doesn't it do that for you? $\endgroup$ – tst Feb 25 '18 at 14:51
  • $\begingroup$ Nope, it does not vibrate for me... Maybe you can post your GIF in your question. I am not very sure what exactly vibrates in the plots... $\endgroup$ – Henrik Schumacher Feb 25 '18 at 14:57
  • $\begingroup$ I cannot put the gif in my answer, so I have uploaded and given the link. $\endgroup$ – tst Feb 25 '18 at 15:04
  • $\begingroup$ Hm. I see. So the relative positions of the vertices remain fixed. Must have some thing to do with the way PlotRange gets computed. $\endgroup$ – Henrik Schumacher Feb 25 '18 at 15:19
  • 1
    $\begingroup$ @tst You can simply add Bookmarks, see the thread Eliminating the backward play in a SWF export of Manipulate $\endgroup$ – Gvxfjørt Nov 12 '19 at 4:19

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.