2
$\begingroup$

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.

Improve this question
$\endgroup$
6
  • $\begingroup$ Would you mind describing in plain English the logic for how these "chains" are built? $\endgroup$ Commented Feb 20, 2015 at 20:30
  • $\begingroup$ 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 $\endgroup$ Commented Feb 20, 2015 at 20:33
  • $\begingroup$ 4) pairs that are not "ready" to be part of an append get queued for the next pass, or the next, etc $\endgroup$ Commented Feb 20, 2015 at 20:36
  • $\begingroup$ @Mr.Wizard or do you mean the sample data? $\endgroup$ Commented Feb 20, 2015 at 20:36
  • $\begingroup$ I only meant what you wrote. So you want to find all of the connected components of Graph[chainParts]? $\endgroup$ Commented Feb 20, 2015 at 20:51

2 Answers 2

Reset to default
2
$\begingroup$

I think this is what you want:

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

See: How to find all vertices reachable from a start vertex following directed edges?

Improve this answer
$\endgroup$
2
  • 1
    $\begingroup$ Amazing! All the graph facilities in MMA boggle my mind, thank goodness there are people like you! $\endgroup$ Commented Feb 20, 2015 at 23:07
  • 1
    $\begingroup$ @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. $\endgroup$ Commented Feb 21, 2015 at 16:49
2
$\begingroup$

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]], VertexLabels -> Thread[N[Range@Length@partNames] -> partNames], GraphLayout -> "LayeredDigraphEmbedding", ImageSize -> Medium, ImagePadding->Full]

Mathematica graphics

Improve this answer
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.