# Efficiently or Elegantly construct linear graph list from vertex pairs

I am processing MRP data, with BOM relations as pairs of part number strings. I want to construct lists that represent the linear graphs defined by these pairs.

Here is some code to generate random sample data, with real-world distribution of lengths of linear graphs:

SeedRandom[1234];

chainLengths = Round /@ RandomVariate[ParetoDistribution[2., 8.], 300];

chainStrings = RandomSample[DictionaryLookup["s" ~~ ___], Total[chainLengths]];

chains = Block[
{cs = chainStrings},
Reap[
Do[
Sow[cs[[\;\;c]]]; (*remove backslashes, triggers unwanted formatting*)
cs=cs[[c+1;;]];
Null,
{c, chainLengths}
]
][[2, 1]]
];

chainStrings === Flatten[chains]

Out[]= True

Histogram[Length /@ chains]

chainParts = Reap[
Do[
Sow[#[[1]] -> #[[2]]] & /@ Partition[c, 2, 1],
{c, chains}
]
][[2, 1]];
chainParts = RandomSample[chainParts, Length[chainParts]];


And here is my code to construct the linear graph lists from the pair data (fail-fast sanity assertions commented out):

buildChains = Block[
{a, f, p, currentPass, nextPass, fatalError0,},
(*fatalError0::fatalReport="buildChains fatalError0: 1";
fatalError0[msg_]:=(
Message[fatalError0::fatalReport,ToString[msg]];
Abort[]
);*)
a = {#} & /@ Complement[
First /@ chainParts, Last /@ chainParts];
currentPass = chainParts;
nextPass = {};
While[Length[currentPass] >= 1,
Do[
f = r[[1]];
p = Position[a, {___, f}];
If[p === {}, AppendTo[nextPass, r]; Continue[]];
(*If[{Length[p],Depth[p],LeafCount[p]}=!={1,3,3},
fatalError0[{"{Length[p],Depth[p],LeafCount[p]}=!={1,3,3}",p}]
];*)
p = p[[1, 1]];
a[[p]] = Append[a[[p]], r[[2]]],
{r, currentPass}
];
(*If[currentPass===nextPass,
Print[a];
Print[nextPass];
fatalError0[{"currentPass===nextPass",a,nextPass}]
];*)
currentPass = nextPass;
nextPass = {}
];
a
];

Sort[chains] === Sort[buildChains]

Out[]= True


Is there a simpler way to do this with MMA graph functionality? Or more efficient/elegant MMA code, regardless? I imagine the complexity is poor using Position for a linear search.

• Would you mind describing in plain English the logic for how these "chains" are built? Feb 20, 2015 at 20:30
• 1) find heads in pairs that cannot be another's tail 2) pair by pair, use Position to find correct list 3) append to that list Feb 20, 2015 at 20:33
• 4) pairs that are not "ready" to be part of an append get queued for the next pass, or the next, etc Feb 20, 2015 at 20:36
• @Mr.Wizard or do you mean the sample data? Feb 20, 2015 at 20:36
• I only meant what you wrote. So you want to find all of the connected components of Graph[chainParts]? Feb 20, 2015 at 20:51

I think this is what you want:

g = Graph[chainParts];

test = VertexOutComponent[g, #] & /@
Complement[Keys @ chainParts, Values @ chainParts];

Sort[chains] === Sort[test]

True

• Amazing! All the graph facilities in MMA boggle my mind, thank goodness there are people like you! Feb 20, 2015 at 23:07
• @Manuel I'm glad I could help. :-) Make sure to vote for Meng Lu's answer to the linked question as I learned this from him. Feb 21, 2015 at 16:49

Assuming standard BOM structures from MRP Systems.

boms = {{"Head", "Component", "Qty"}, {1., 2., 10.}, {1., 3.,
20.}, {1., 4., 30.}, {2., 5., 10.}, {2., 6., 20.}, {2., 7.,
30.}, {7., 8., 40.}, {8., 9., 50.}, {9., 10., 60.}, {9., 11.,
70.}};
partNames = {"Gun", "Body", "Barrel", "Silencer", "Stock", "Lock",
"Trigger Kit", "Gizmo A", "Spring", "Cam", "Chunche"}
titles = First@boms; boms = Rest@boms;
TreeGraph[DirectedEdge[#[[1]], #[[2]]] & /@ boms,
EdgeWeight -> boms[[All, 3]],