Ploting a parallel graph for an animation

Question

I am sorry that my attempt to obtain a fully functional plot as I want failed badly because I am not able to integrate the features to the graph.

Here is my simple code:

GraphPlot[{1 -> 11, 2 -> 11, 3 -> 11, 4 -> 11, 5 -> 11, 6 -> 11, 
7 -> 11, 8 -> 11, 9 -> 11, 10 -> 11}, DirectedEdges -> True, 
VertexLabeling -> True, PlotStyle -> Directive[PointSize[0.03], Red],
VertexRenderingFunction -> Function[{p, l}, {Blue, Point[p]}]]

What I want is as follows:

1. First there are only the nodes (no edges) and the middle node is "black"

   GraphPlot[{1 -> 11, 2 -> 11, 3 -> 11, 4 -> 11, 5 -> 11, 6 -> 11, 
   7 -> 11, 8 -> 11, 9 -> 11, 10 -> 11}, DirectedEdges -> True, 
   VertexLabeling -> True, PlotStyle -> Directive[PointSize[0.03], Red],
   VertexRenderingFunction -> Function[{p, l}, {Blue, Point[p]}], 
   EdgeRenderingFunction -> None]
   

here I dont know how to change the color of only the middle node. The rest is okay.

2. Then all the nodes make an observation: it means the nodes will have labels marked with $y_i$, $i=1,...10$

I can do this only manually and here is an uncomplete example

3. Edges appear and and nodes transfer the decisions $u_i$, $i=1,...10$

   GraphPlot[{1 -> 11, 2 -> 11, 3 -> 11, 4 -> 11, 5 -> 11, 6 -> 11, 7 -> 11, 8 -> 11, 9 -> 11, 10 -> 11}, DirectedEdges -> True, VertexLabeling -> True, PlotStyle -> Directive[PointSize[0.03], Red], VertexRenderingFunction -> Function[{p, l}, {Blue, Point[p]}]]

4. All edges and $u_i$, $i=1,...10$ disappear and the middle node outputs $u_0$

Again I can do this manually:

Is there a way to automate this process? Except for the color of the middle point (which I want it to be black), I can do the rest manually as well. However The figure sizes must be "the same" so that I can make a sort of short animation in a latex beamer presentation.

How can arrange the size of the plots in mathematica?

Answer 1

grF[n_Integer, t_, opts : OptionsPattern[Graph]] := 
 Module[{vcoords = Join[{Sin[#], Cos[#]} & /@ 
      Range[-\[Pi]/n, 2 (n - 1) \[Pi]/n, 2 \[Pi]/n], {{0, 0}}], 
   vertices = Join[Property[#, {VertexStyle -> Blue, VertexSize -> Medium}] & /@
       Range[n], {Property[n + 1, {VertexStyle -> Black, VertexSize -> Large}]}, 
     Property[Subscript[ToString@y, 
         ToString[# - n - 1]], {VertexShapeFunction -> None}] & /@ 
      Range[n + 2, 2 n + 1], {Property[Subscript[ToString@u, 
        ToString[0]], {VertexShapeFunction -> None}]}], 
   edges = Join[Property[# -> n + 1, 
               {EdgeShapeFunction -> ({Arrowheads[{{.03, 2/3}}], 
                 If[t == 2, Opacity@1, Opacity@0], Arrow[#, {0, .1}]} &), 
                EdgeLabels -> Placed[Style[Subscript["u", ToString[#]], Bold, 16, 
                  If[t == 2, Opacity@1, Opacity@0], Italic, 
                  Background -> White], {1/3, {1/2, 1/2}}], 
                EdgeStyle -> If[t == 2, Directive[Opacity[1], Red], 
                       Directive[Opacity[.0], Red]]}] & /@ Range[n], 
               Property[Subscript[ToString@y, ToString[# - n - 1]] -> # - n - 1, 
                 {EdgeShapeFunction -> ({Arrowheads[{{.03, 1.}}], 
                    If[t == 1, Opacity@1, Opacity@0], Arrow[#, {.1, .1}]} &),
                  EdgeLabels -> Placed[Style[Subscript["y", ToString[# - n - 1]], 
                     Bold, 16, If[t == 1, Opacity@1, Opacity@0], Italic], "Start"], 
                  EdgeStyle -> If[t == 1, Directive[Opacity[1], Black], 
                   Directive[Opacity[0], Black]]}] & /@ Range[n + 2, 2 n + 1], 
               {Property[ n + 1 -> Subscript[ToString@u, ToString[0]],
                {EdgeShapeFunction -> ({Arrowheads[{{.03, 1.}}], 
                   If[t >= 3, Opacity@1, Opacity@0], Arrow[#, {.0, .2}]} &), 
                 EdgeLabels -> Placed[Style[Subscript["u", ToString[0]], Bold, 16, 
                   Italic, If[t >= 3, Opacity@1, Opacity@0], 
                   Background -> White], {3/4, {1/2, 1/2}}], 
                 EdgeStyle -> If[t >= 3, Directive[Opacity[1], Black], 
                    Directive[Opacity[0], Black]]}]}]}, 
  Graph[vertices, edges, 
   VertexCoordinates -> Join[vcoords, 1.4 Most@vcoords, {{0, -.5} + Last@vcoords}], 
   ImagePadding -> 45, opts]]

 Dynamic@With[{t = Clock[{0, 4, 1}, 5, 2]}, grF[10, t, ImageSize -> 400]]

Answer 2

Graph[Join[
 Table[Labeled[i, Subscript["y", ToString[i]]], {i, 1, 10}], 
 {Labeled[Style[11, Black], Subscript["y", ToString[11]]]}],
 Table[Rule[i, 11], {i, 10}],
 DirectedEdges -> True, 
 VertexStyle -> Blue,
 EdgeStyle -> Red,
 EdgeShapeFunction -> ({Red, Line[#1], Arrowheads[{0, .05}], 
     Arrow[#1, {0, .5}]} &), 
 VertexCoordinates -> (Join[
    Table[{Cos[θ], Sin[θ]}, {θ, 0, 1.8 π, .2 π}], {{0., 0.}}])]