mat = {{1, 5, 2, 6}, {4, 3, 4, 1}, {0, 1, 4, 0}, {2, 1, 3, 4}}; vertices = {"A", "B", "C", "D"}; vc = Thread[vertices -> GraphEmbedding[GridGraph[{2, 2}]]]; t = .25; Row[MapThread[grapH[## & @@ #][.25, "A", VertexShapeFunction -> "Name", VertexCoordinates -> vc, ImageSize -> {400, 400}, EdgeStyle -> #2, PlotLabel -> Grid[{{"mat", "direction", "threshold", "starting\nnode"}, {MatrixForm[First@#], #[[2]], t, "A"}}, Dividers -> All]] &, {{{mat, "Column"}, {Transpose@mat, "Row"}}, {Blue, Red}}]] mat = {{1, 5, 2, 6}, {4, 3, 4, 1}, {0, 1, 4, 0}, {2, 1, 3, 4}}; vertices = {"A", "B", "C", "D"}; vc = Thread[vertices -> GraphEmbedding[GridGraph[{2, 2}]]]; Row[MapThread[grapH[## & @@ #][.25, "A", VertexShapeFunction -> "Name", VertexCoordinates -> vc, ImageSize -> {400, 400}, EdgeStyle -> #2, PlotLabel -> Grid[{{"mat", "direction", "threshold", "starting\nnode"}, {MatrixForm[First@#], #[[2]], t, "A"}}, Dividers -> All]] &, {{{mat, "Column"}, {Transpose@mat, "Row"}}, {Blue, Red}}]] mat = {{1, 5, 2, 6}, {4, 3, 4, 1}, {0, 1, 4, 0}, {2, 1, 3, 4}}; vertices = {"A", "B", "C", "D"}; vc = Thread[vertices -> GraphEmbedding[GridGraph[{2, 2}]]]; t = .25; Row[MapThread[grapH[## & @@ #][.25, "A", VertexShapeFunction -> "Name", VertexCoordinates -> vc, ImageSize -> {400, 400}, EdgeStyle -> #2, PlotLabel -> Grid[{{"mat", "direction", "threshold", "starting\nnode"}, {MatrixForm[First@#], #[[2]], t, "A"}}, Dividers -> All]] &, {{{mat, "Column"}, {Transpose@mat, "Row"}}, {Blue, Red}}]] mat = {{1, 5, 2, 6}, {4, 3, 4, 1}, {0, 1, 4, 0}, {2, 1, 3, 4}}; vertices = {"A", "B", "C", "D"}; vc = Thread[vertices -> GraphEmbedding[GridGraph[{2, 2}]]]; Row[MapThread[grapH[## & @@ #][.25, "A", VertexShapeFunction -> "Name", VertexCoordinates -> vc, ImageSize -> {400, 400}, EdgeStyle -> #2, PlotLabel -> Grid[{{"mat", "direction", "threshold", "starting\nnode"}, {MatrixForm[First@#], #[[2]], t, "A"}}, Dividers -> All]] &, {{{mat, "Column"}, {Transpose@mat, "Row"}}, {Blue, Red}}]] vc = Thread[vertices -> GraphEmbedding[GridGraph[{2, 2}]]]; Row[MapThread[grapH[## & @@ #][.25, "A", VertexShapeFunction -> "Name", VertexCoordinates -> vc, ImageSize -> {400, 400}, EdgeStyle -> #2, PlotLabel -> Grid[{{"mat", "direction", "threshold", "starting\nnode"}, {MatrixForm[First@#], #[[2]], t, "A"}}, Dividers -> All]] &, {{{mat, "Column"}, {Transpose@mat, "Row"}}, {Blue, Red}}]] mat = {{1, 5, 2, 6}, {4, 3, 4, 1}, {0, 1, 4, 0}, {2, 1, 3, 4}}; vertices = {"A", "B", "C", "D"}; vc = Thread[vertices -> GraphEmbedding[GridGraph[{2, 2}]]]; Row[MapThread[grapH[## & @@ #][.25, "A", VertexShapeFunction -> "Name", VertexCoordinates -> vc, ImageSize -> {400, 400}, EdgeStyle -> #2, PlotLabel -> Grid[{{"mat", "direction", "threshold", "starting\nnode"}, {MatrixForm[First@#], #[[2]], t, "A"}}, Dividers -> All]] &, {{{mat, "Column"}, {Transpose@mat, "Row"}}, {Blue, Red}}]] Update:
ClearAll[grapH, combinedGraph] grapH[mat_, dir_: "Column"][t_, v_, opts : OptionsPattern[Graph]] := Module[{vertices = CharacterRange["A", "Z"][[;; Length@mat]], comp = dir /. {"Column" -> VertexInComponent, "Row" -> VertexOutComponent}, gf = dir /. {"Column" -> AdjacencyGraph, "Row" -> ReverseGraph@*AdjacencyGraph}, g}, g = gf[vertices, Transpose[UnitStep[Normalize[#, Total] - t] & /@ Transpose[mat]]]; Subgraph[g, comp[g, v], opts]]; combinedGraph[mat_, t_, v_, opts : OptionsPattern[Graph]] := Module[{el = EdgeList /@ {grapH[Transpose@mat, "Row"][t, v], grapH[mat][t, v]}, complement, intersection}, complement = Complement @@ el; intersection = Intersection @@ el; SetProperty[EdgeAdd[grapH[mat][t, v], complement], {EdgeStyle -> {_ :> Blue, Alternatives @@ intersection -> Dashed, Alternatives @@ complement -> Red}, opts}]] Examples:
vc = Thread[vertices -> GraphEmbedding[GridGraph[{2, 2}]]]; Row[MapThread[grapH[## & @@ #][.25, "A", VertexShapeFunction -> "Name", VertexCoordinates -> vc, ImageSize -> {400, 400}, EdgeStyle -> #2, PlotLabel -> Grid[{{"mat", "direction", "threshold", "starting\nnode"}, {MatrixForm[First@#], #[[2]], t, "A"}}, Dividers -> All]] &, {{{mat, "Column"}, {Transpose@mat, "Row"}}, {Blue, Red}}]] Row[MapThread[grapH[## & @@ #][.25, "C", VertexShapeFunction -> "Name", VertexCoordinates -> vc, ImageSize -> {400, 400}, EdgeStyle -> #2, PlotLabel -> Grid[{{"mat", "direction", "threshold", "starting\nnode"}, {MatrixForm[First@#], #[[2]], t, "C"}}, Dividers -> All]] &, {{{mat, "Column"}, {Transpose@mat, "Row"}}, {Blue, Red}}]] Row[combinedGraph[mat, .25, #, VertexShapeFunction -> "Name", VertexCoordinates -> vc, PlotLabel -> Grid[{{"threshold : ", .25}, {"starting node: ", #}}], ImageSize -> 200] & /@ {"A", "B", "C", "D"}] Original answer:
Update:
ClearAll[grapH, combinedGraph] grapH[mat_, dir_: "Column"][t_, v_, opts : OptionsPattern[Graph]] := Module[{vertices = CharacterRange["A", "Z"][[;; Length@mat]], comp = dir /. {"Column" -> VertexInComponent, "Row" -> VertexOutComponent}, gf = dir /. {"Column" -> AdjacencyGraph, "Row" -> ReverseGraph@*AdjacencyGraph}, g}, g = gf[vertices, Transpose[UnitStep[Normalize[#, Total] - t] & /@ Transpose[mat]]]; Subgraph[g, comp[g, v], opts]]; combinedGraph[mat_, t_, v_, opts : OptionsPattern[Graph]] := Module[{el = EdgeList /@ {grapH[Transpose@mat, "Row"][t, v], grapH[mat][t, v]}, complement, intersection}, complement = Complement @@ el; intersection = Intersection @@ el; SetProperty[EdgeAdd[grapH[mat][t, v], complement], {EdgeStyle -> {_ :> Blue, Alternatives @@ intersection -> Dashed, Alternatives @@ complement -> Red}, opts}]] Examples:
vc = Thread[vertices -> GraphEmbedding[GridGraph[{2, 2}]]]; Row[MapThread[grapH[## & @@ #][.25, "A", VertexShapeFunction -> "Name", VertexCoordinates -> vc, ImageSize -> {400, 400}, EdgeStyle -> #2, PlotLabel -> Grid[{{"mat", "direction", "threshold", "starting\nnode"}, {MatrixForm[First@#], #[[2]], t, "A"}}, Dividers -> All]] &, {{{mat, "Column"}, {Transpose@mat, "Row"}}, {Blue, Red}}]] Row[MapThread[grapH[## & @@ #][.25, "C", VertexShapeFunction -> "Name", VertexCoordinates -> vc, ImageSize -> {400, 400}, EdgeStyle -> #2, PlotLabel -> Grid[{{"mat", "direction", "threshold", "starting\nnode"}, {MatrixForm[First@#], #[[2]], t, "C"}}, Dividers -> All]] &, {{{mat, "Column"}, {Transpose@mat, "Row"}}, {Blue, Red}}]] Row[combinedGraph[mat, .25, #, VertexShapeFunction -> "Name", VertexCoordinates -> vc, PlotLabel -> Grid[{{"threshold : ", .25}, {"starting node: ", #}}], ImageSize -> 200] & /@ {"A", "B", "C", "D"}] Original answer:
lang-mma




