Monster group graph

Mg={
(* Monster *)
Column[{"M","(Subscript[F, 1])"},Center],
(* Leech-Conway *)
"(Subscript[Co, 1])","(Subscript[Co, 2])","(Subscript[Co, 3])",
(* Leech-Other *)
"McL",Column[{"Suz","(Subscript[F, 3-])"},Center],"HS",Column[{"HJ","(Subscript[J, 2])"},Center],
(* Other-Fischer *)
Column[{"(Subscript[Fi, 24])","(Subscript[F, 3+])"},Center],"(Subscript[Fi, 23])","(Subscript[Fi, 22])",
(* Other *)
Column[{"B","(Subscript[F, 2+])"},Center],Column[{"HN","(Subscript[F, 5+])"},Center],Column[{"He","(Subscript[F, 7+])"},Center],Column[{"Th","(Subscript[F, 3 | 3])"},Center],
(* Mathieu *)
"(Subscript[M, 24])","(Subscript[M, 23])","(Subscript[M, 22])","(Subscript[M, 12])","(Subscript[M, 11])",
(* Pariahs-Janko *)
"(Subscript[J, 1])",Column[{"HJM","(Subscript[J, 3])"},Center],"(Subscript[J, 4])",
(* Pariahs-Other *)
"ON","Ly","Ru","T"};
MgLength=Length@%
Transpose[{#,Mg[[#]]}&/@Range@MgLength]

MgRules={
(* Monster *)
{1,{2,9,12}},
(* Leech-Conway *)
{2,{3,4,6,16}},
{3,{5,7,17}},
{4,{5,7,17,19}},
(* Leech-Other *)
{5,{18,20}},
{6,{8,19}},
{7,{18,20}},
(* Other-Fischer *)
{9,{10,14,16}},
{10,{11,17}},
{11,{18,19(*),27**)}},
(* Other *)
{12,{3,10,13,15}},
{13,{7,19}},
(* Mathieu *)
{16,{17,19}},
{17,{18,20}},
{19,{20}},
(* Pariahs-Janko *)
{22,{22}},{23,{16}},
(* Pariahs-Other *)
{24,{20,21}},
{25,{5}},
{26,{27}},
{11,{27}}
};
Length@%

vertexStyles={(*)#->Directive[**)Which[
(* Monster *)
#==1,Blue,
(* Leech *)
#>1&&#<9,Darker@Green,
(* Other *)
#>8&&#<16,Blue,
(* Mathieu *)
#>15&&#<21,Red,
(* Pariahs *)
#>20&&#<27,Black,
#==27,Lighter@Lighter@Blue]}&/@Range@MgLength;

assgn=Flatten[Table[
Graphics[{EdgeForm[Directive[Thick,Sequence@@vertexStyles[[#[[1]]]]]],White,Disk[],
Text@Style[Mg[[#[[1]]]],{vertexStyles[[#[[1]]]],Medium}]},ImageSize->40]->
Graphics[{EdgeForm[Directive[Thick,Sequence@@vertexStyles[[i]]]],White,Disk[],
Text@Style[Mg[[i]],{vertexStyles[[i]],Medium}]},ImageSize->40],
{i,#[[2]]}]&/@MgRules]

vertCoords={
1->{3.8688771941497153, -0.8688771941497153},2->{3.8688771941497153, -2.8688771941497153},9->{6.868877194149715, -1.8688771941497153},12->{2.8688771941497153, -1.8688771941497153},3->{2.8688771941497153, -3.8688771941497153},4->{3.8688771941497153, -3.8688771941497153},6->{4.868877194149715, -3.8688771941497153},16->{5.868877194149715, -3.8688771941497153},5->{1.8688771941497153, -4.868877194149715},7->{2.8688771941497153, -4.868877194149715},17->{5.868877194149715, -4.868877194149715},19->{4.868877194149715, -4.868877194149715},18->{5.868877194149715`,-5.868877194149715`},20->{4.868877194149715`,-5.868877194149715`},8->{3.8688771941497153, -4.868877194149715},10->{6.868877194149715, -2.8688771941497153},14->{7.868877194149715, -2.8688771941497153},11->{6.868877194149715, -3.8688771941497153},13->{1.8688771941497153, -3.8688771941497153},15->{1.8688771941497153, -2.8688771941497153},22->{1.8688771941497153`,-5.868877194149715`},23->{5.868877194149715, -2.8688771941497153},24->{0.8688771941497153, -4.868877194149715},21->{0.8688771941497153, -5.868877194149715},25->{0.8688771941497153, -3.8688771941497153},26->{7.868877194149715, -3.8688771941497153},27->{7.868877194149715, -4.8688771941497153}};
vertCoords2=vertCoords[[All,2]];

inches=5;

LayeredGraphPlot[assgn,
VertexCoordinates->vertCoords2,
GraphLayout->{
"VertexLayout"->"LayeredDigraphEmbedding",
"EdgeLayout"->(*)"DividedEdgeBundling"**)"StraightLine",
"PackingLayout"->"LayeredLeft"(*)"ClosestPacking"(**)"NestedGrid"**)},
VertexLabels->Placed[Automatic,Center],
DirectedEdges->True,VertexSize-> .3,EdgeShapeFunction->{{"CarvedArrow","ArrowSize"->.02}},
ImageSize->1.25imageSize]

GraphPlot[assgn,
VertexCoordinates->vertCoords2,
VertexLabels->Placed[Automatic,Center],
DirectedEdges->True,VertexSize-> .1,EdgeShapeFunction->{{"CarvedArrow","ArrowSize"->.02}},
ImageSize->1.25imageSize]