I have a Mathematica script, called FHJ, with four main arguments: vertices, edges, weights of edges, groups of vertices, which produces a graph with vertice labels given in the list vertices, coloured and shaped differently, according to specified groups, and edges labels given in weights. A last optional argument specifies the size of vertices.
FHJ[comp_List, edges_List, rates_List, groups_List : {},ver_:.45] := Module[{colorList, shapeList, vertexColors, options, vertexShapes, defaultColor = Yellow}, colorList = {Green, Red, Yellow, Purple, Orange}; shapeList = {"Square", "Circle", "ConcaveHexagon", "Triangle", "Hexagon", "Pentagon", "Star"}; vertexColors = Join[Flatten[ MapIndexed[Thread[#1 -> colorList[[#2[[1]]]]] &, groups]], # -> defaultColor & /@ Complement[comp, Flatten[groups]]]; vertexShapes = Flatten[MapIndexed[Thread[#1 -> shapeList[[#2[[1]]]]] &, groups]]; options = {VertexShapeFunction -> vertexShapes, VertexStyle -> vertexColors, VertexSize->ver, VertexLabels -> {_ -> Placed[Automatic, Center]}, EdgeStyle -> {{Black, Thick}}, PerformanceGoal -> "Quality", EdgeLabels -> Thread[edges -> rates], EdgeLabelStyle -> Directive[Black, Bold, Background -> White]}; LayeredGraphPlot[edges(*, Right*), options]];See for example the output of
vert={"B","A",2 "A"+"B","A"+2 "B"};edg={"B"->"A",2 "A"+"B"->"A"+2 "B"};wei={Subscript[k, 1] Subscript[x, B],Subscript[k, 2] \!\(\*SubsuperscriptBox[\(x\), \(A\), \(2\)]\) Subscript[x, B]};FHJ[vert,edg,wei,{{"A","B"}},.35]Now in the case when, like above, the vertices are formal sums of two letters, I would like a numerical conversion of the vert tovertn={{0,1},{1,0},{2,1},{1,2}} (this should be done maybe in a separate script) and then a modification of the FHJ graph so that its vertices are represented at the vectors given in vertn (maybe giving up centering)
I have managed to get the 2 scripts, but only if I impose the letters to be "A","B" (that's OK), and if I change the inputs instead of 2"A" +"B" to "2 A + B" (and I'm only able to convert between the inputs by manual tweaking). Here are the two scripts:
convNum[vertices_List] := Module[ {basis, processTerm, parseVertex}, (* Define basis vectors for A and B *) basis = Association[{"A" -> {1, 0}, "B" -> {0, 1}}]; (* Function to process each term and convert to vector *) processTerm[term_] := Module[{coef, letter}, (* Extract coefficient and letter, default coefficient is 1 if missing *) {coef, letter} = StringCases[term, {a : DigitCharacter .. ~~ " " ~~ l : ("A" | "B") :> {ToExpression[a], l}, l : ("A" | "B") :> {1, l}}][[1]]; coef * basis[letter] ]; (* Parse each vertex string into terms and sum the resulting vectors *) parseVertex[vertex_String] := Total[processTerm /@ StringSplit[vertex, " +"]]; (* Apply the conversion to the entire list of vertices *) parseVertex /@ vertices]FHJn[comp_List, edges_List, rates_List, groups_List : {}, ver_ : .20] := Module[{colorList, shapeList, vertn,vertexColors, options, vertexShapes, defaultColor = Yellow}, vert=comp; vertn = convNum[comp]; (* Color and shape lists *) colorList = {Green, Red, Yellow, Purple, Orange}; shapeList = {"Square", "Circle", "ConcaveHexagon", "Triangle", "Hexagon", "Pentagon", "Star"}; (* Assign colors and shapes to vertices based on groups *) vertexColors = Join[ Flatten[MapIndexed[Thread[#1 -> colorList[[#2[[1]]]]] &, groups]], # -> defaultColor & /@ Complement[comp, Flatten[groups]] ]; vertexShapes = Flatten[MapIndexed[Thread[#1 -> shapeList[[#2[[1]]]]] &, groups]]; (* Ensure that comp and vertn have the same length and can be threaded *) If[Length[vert] =!= Length[vertn], Print["Error: Length of vertices (comp) and coordinates (vertn) must be the same."]; Return[$Failed] ]; (* Define graph options with provided vertex positions *) options = { VertexCoordinates -> Thread[comp -> vertn], (* Use provided vertex coordinates *) VertexShapeFunction -> vertexShapes, VertexStyle -> vertexColors, VertexSize -> ver, VertexLabels -> Placed[Automatic, Center], EdgeStyle -> {{Black, Thick}}, PerformanceGoal -> "Quality", EdgeLabels -> Thread[edges -> rates], EdgeLabelStyle -> Directive[Black, Bold, Background -> White] }; (* Plot the graph using provided vertex positions *) Graph[comp, edges, options] ](* Example usage *)vert = {"B", "A", "2 A + B", "A + 2 B"};vertn = convNum[vert]edg = {"B" -> "A", "2 A + B" -> "A + 2 B"};wei = {k1, k2};FHJn[vert, edg, wei, {{"A", "B"}}, .20]