2
$\begingroup$

I have a nested list like this:

test1 = {{1, 3}, {1, 4}, {1, 7}, {2, 1}, {3, 5}, {4, 1}, {5, 2}, {6, 1}, {7, 6}}

I want to join the lists together depending on if the first element is equal to the last element as to end up with:

test2 = {{1, 3, 3, 5, 5, 2, 2, 1}, {1, 4, 4, 1}, {1, 7, 7, 6, 6, 1}}

Eventually I will want to delete duplicate elements in each list ending up with:

test3 = {{1, 3, 5, 2, 1}, {1, 4, 1}, {1, 7, 6, 1}}

I tried Join with constraints or GatherBy but I cant seem to get it right. Also note that first elements are always unique except if its a 1.

Any help is much appreciated!

Improve this question
$\endgroup$
5
  • $\begingroup$ What's the desired output for {{1, 2}, {2, 3}, {2, 4}, {2, 5}, {4, 2}}? $\endgroup$
    – Szabolcs
    Jul 24, 2015 at 7:37
  • $\begingroup$ The result in your example could also be {{1, 3}, {3, 5}, {5, 2}, {2, 1}, {1, 4}, {4, 1}, {1, 7}, {7, 6}, {6, 1}} in which case there is only one "partition". Please clarify. $\endgroup$
    – Dr. belisarius
    Jul 24, 2015 at 7:50
  • $\begingroup$ BTW the above was found by using FindPostmanTour@Graph[DirectedEdge @@@ test]. I mean, your first test definition. Please don't use the same symbol to refer to different things in your questions as it makes comments much difficult to write (like this one) $\endgroup$
    – Dr. belisarius
    Jul 24, 2015 at 7:52
  • $\begingroup$ thanks! just edited the question. FindPostmanTour@Graph[DirectedEdge @@@ test] seems to be doing what i wanted! Although it outputs "[DirectedEdge]" and not a list but that should be easy to rewrite. Thanks! $\endgroup$
    – Pied
    Jul 24, 2015 at 8:16
  • $\begingroup$ Welcome to Mathematica.SE! I suggest the following: 0) Browse the common pitfalls question 1) As you receive help, try to give it too, by answering questions in your area of expertise. 2) Read the faq! 3) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! $\endgroup$
    – Dr. belisarius
    Jul 24, 2015 at 12:14

3 Answers 3

Reset to default
4
$\begingroup$

Although I'd rather prefer to have a few more test cases at hand, I'm posting this as an answer since you confirmed in your comments that this does what you need.

test = {{1, 3}, {1, 4}, {1, 7}, {2, 1}, {3, 5}, {4, 1}, {5, 2}, {6, 1}, {7, 6}}
par = List @@@ First@FindPostmanTour@Graph[DirectedEdge @@@ test]
(*
{{1, 3}, {3, 5}, {5, 2}, {2, 1}, {1, 4}, {4, 1}, {1, 7}, {7, 6}, {6, 1}}
*)

of course 

DeleteDuplicates@Flatten@par

Deletes your dups

Improve this answer
$\endgroup$
3
  • $\begingroup$ Please note that FindPostmanTour will return an empty list if there is no "postman tour" $\endgroup$
    – Dr. belisarius
    Jul 24, 2015 at 8:37
  • 1
    $\begingroup$ +1, that was my first idea for it, but did not bother commenting/answering - I've got the sinking feeling a "...well, what I really need is for it to also handle these cases..." was there... $\endgroup$
    – ciao
    Jul 24, 2015 at 9:08
  • $\begingroup$ @ciao Yup. That feeling is a spreading disease these times :) $\endgroup$
    – Dr. belisarius
    Jul 24, 2015 at 12:09
1
$\begingroup$

Dirty code which does the job

test = {{1, 3}, {1, 4}, {1, 7}, {2, 1}, {3, 5}, {4, 1}, {5, 2}, {6, 1}, {7, 6}};

UberChain = {};
While[Length[test] > 1, chain = {test[[1]]};
  While[True, If[Last[Last[chain]] == First[First[chain]], Break[],
    AppendTo[chain, Select[test, #[[1]] == Last[Last[chain]] &][[1]]]]];
   Do[test = DeleteCases[test, chain[[i]]], {i, Length[chain]}];
  AppendTo[UberChain, chain]];
FinalUberChain = Map[DeleteDuplicates[Flatten[#]] &, UberChain]

Output:

{{1, 3, 5, 2}, {1, 4}, {1, 7, 6}}

This is a bit different then what you have given, because you said you want to delete duplicates on end and this is result of deleting duplicates (i.e. there can not be two 1's in final solution as it is shown in your last "test").

Code basically looks for element whose first member is same as last member of previous element. When it reaches the starting point, i.e. it would starting repeating it terminates and deletes the found members from the dataset (this is fair point by belisarius, it is not exactly clear what you wanted, but I guess this is what you want, looking at your final result). The procedure is then repeated until there are no more elements in the dataset. I have introduced different variable names (chain -> single list from one starting position, UberChain -> collection of all of these chains, FinalUberChain -> after deleting duplicates) so that things are not always called "test".

Improve this answer
$\endgroup$
2
  • $\begingroup$ I've taken the liberty of adjusting your code. (By the way, Chain is a built-in variable in the units package, so I made it lower case.) $\endgroup$
    – Chris Degnen
    Jul 24, 2015 at 9:33
  • $\begingroup$ A great! Thanks, did not notice Chain problem. Adjusted my description also. $\endgroup$
    – Neven Caplar
    Jul 24, 2015 at 9:46
1
$\begingroup$ 
test1 = {{1, 3}, {1, 4}, {1, 7}, {2, 1}, {3, 5}, {4, 1}, {5, 2}, {6, 1}, {7, 6}};

f[{}] := {};

f[{a_, b_}] := Module[{c},
  c = Cases[test1, {b, _}];
  test1 = DeleteCases[test1, {a, b}, {1}, 1];
  If[c == {}, c,
   test1 = DeleteCases[test1, {b, _}, {1}, 1];
   First@c]];

test2 = {};

While[test1 != {},
 AppendTo[test2, Flatten@FixedPointList[f, First@test1]]];

test2

{{1, 3, 3, 5, 5, 2, 2, 1, 1, 4, 4, 1, 1, 7, 7, 6, 6, 1}}

test3 = test2 //. {a___, b_, b_, c___} :> {a, b, c}

{{1, 3, 5, 2, 1, 4, 1, 7, 6, 1}}

The above result corresponds to the order in which the nodes are visited, i.e.

Graph[First[FindPostmanTour@Graph[DirectedEdge @@@ test1]], 
 VertexLabels -> "Name"]

enter image description here

Improve this answer
$\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.