Hey,
nehmen wir an, deine Paare definieren die Kanten in einem Graph
edges = {{2, 4}, {8, 2}, {5, 8}, {7, 5}, {9, 7}, {1, 9}, {4, 1}};
g = Graph[DirectedEdge @@@ edges]
dann sieht man dein chainIt[]-Problem ziemlich schnell aus einer
anderen Perspektive: Einen sogenannten Hamiltonkreis des Graphen g
finden.
FindHamiltonianCycle[g]
(*
{{DirectedEdge[2, 4],
DirectedEdge[4, 1],
DirectedEdge[1, 9],
DirectedEdge[9, 7],
DirectedEdge[7, 5],
DirectedEdge[5, 8],
DirectedEdge[8, 2]
}}
*)
Das Hamiltonkreis-Problem ist NP-vollständig. Ich glaube also nicht,
dass sich ein allgemeines chainIt[] mit Hilfe von SortBy implementieren
lässt.
Cheers
Patrick
On So, 2019-11-10 at 10:20 +0100, Susanne & Udo Krause via demug wrote:
> Sali zusammen,
>
> aus der Liste von Paaren edges
>
> In[28]:= edges
>
> Out[28]= {{2, 4}, {8, 2}, {5, 8}, {7, 5}, {9, 7}, {1, 9}, {4, 1}}
>
> In[43]:= chainIt[edges]
>
> Out[43]= {{2, 4}, {4, 1}, {1, 9}, {9, 7}, {7, 5}, {5, 8}, {8, 2}}
>
>
> soll die verkettete List l[[n-1, 2]] = l[[n,1]] werden, wie im
> Beispiel
> zu sehen. Die Funktion chainIt[] ist prozedural
>
>
> Clear[chainIt]
> chainIt[l_List?ArrayQ] := l /; Length[l] == 1
> chainIt[l_List?ArrayQ] := Block[{r = {l[[1]]}, l0 = Rest[l], x},
> If[Length[Complement @@ Transpose[l]] != 0,
> Print["Cannot chain these pairs: ", l];
> Return[$Failed]
> ];
> While[Length[l0] > 0,
> x = Select[l0, #[[1]] == Last[r][[2]] &];
> If[Length[x] > 1,
> Print["Second element ", Last[r][[2]], " not unique in first
> entries. Bye."];
> Return[$Failed]
> ];
> r = Join[r, x];
> l0 = Complement[l0, x]
> ];
> r
> ] /; Dimensions[l][[-1]] == 2 && Length[l] > 1
>
>
> es sollte mit SortBy[] gehen, aber wie? Dieses Ergebnis ist
> unverständlich:
>
>
> In[60]:= Clear[fct]
> fct[l1_List, l2_List] := If[l1[[2]] == l2[[1]], True, False]
> SortBy[edges, # &, fct]
>
> Out[60]= {{2, 4}, {4, 1}, {1, 9}, {9, 7}, {8, 2}, {7, 5}, {5, 8}}
>
> {8,2} steht falsch drin ... es gehört an das Ende der Ergebnisliste.
>
>
> Sieht jemand ein funktionales chainIt[] und mag es mitteilen?
>
>
> grüsse
>
> Udo.
>
> _______________________________________________
> DMUG Deutschsprachiges Mathematica-Forum demug@XXXXXXX.ch
> http://www.mathematica.ch/mailman/listinfo/demug
> Archiv: http://www.mathematica.ch/archiv.html
signature.asc
Description: This is a digitally signed message part
_______________________________________________ DMUG Deutschsprachiges Mathematica-Forum demug@XXXXXXX.ch http://www.mathematica.ch/mailman/listinfo/demug Archiv: http://www.mathematica.ch/archiv.html
