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.

$\endgroup$
  • $\begingroup$ Would you mind describing in plain English the logic for how these "chains" are built? $\endgroup$ – Mr.Wizard Feb 20 '15 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$ – Manuel --Moe-- G Feb 20 '15 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$ – Manuel --Moe-- G Feb 20 '15 at 20:36
  • $\begingroup$ @Mr.Wizard or do you mean the sample data? $\endgroup$ – Manuel --Moe-- G Feb 20 '15 at 20:36
  • $\begingroup$ I only meant what you wrote. So you want to find all of the connected components of Graph[chainParts]? $\endgroup$ – Mr.Wizard Feb 20 '15 at 20:51
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?

$\endgroup$
  • 1
    $\begingroup$ Amazing! All the graph facilities in MMA boggle my mind, thank goodness there are people like you! $\endgroup$ – Manuel --Moe-- G Feb 20 '15 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$ – Mr.Wizard Feb 21 '15 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

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.