Skip to main content
Commonmark migration
Source Link

For the sake of general,such as the line include not only $2$ points,the every line maybe is a mess order(include first one),I make some adjust like following.Maybe too long,but powerful. ###If you have a gap data like dat2 We

If you have a gap data like dat2

We can convert it into non-gap data first by ConnectComponentPoints

ConnectComponentPoints[p_] := Module[{f, var1, var2, nearePoint, graph}, f = Nearest /@ Most[p]; var2 = Drop[p, #] & /@ Range[Length[p] - 1]; var1 = MapThread[Catenate /@ # /@ #2 &, {f, var2}]; nearePoint = Catenate[ Map[First[MinimalBy[#, EuclideanDistance @@ # &]] &, Flatten[{var1, var2}, List /@ {2, 3, 4, 1, 5}], {2}]]; graph = CompleteGraph[Length[p], EdgeWeight -> EuclideanDistance @@@ nearePoint]; Join[p, nearePoint[[EdgeIndex[graph, #] & /@ EdgeList[FindSpanningTree[graph]]]]]] ListLinePlot[ConnectComponentPoints[dat2]] 

http://o8aucf9ny.bkt.clouddn.com/2017-02-18-20-30-50.png

###If you have a non-gap data like dat:

If you have a non-gap data like dat:

ConnectLines[dat_] := Module[{g = SimpleGraph[RelationGraph[IntersectingQ, dat], VertexLabels -> "Index"], path}, path = FindShortestPath[g, Sequence @@ GraphPeriphery[g]]; Append[First /@ #, #[[-1, -1]]] &[ FoldPairList[(Transpose[ DeleteDuplicates[ SortBy[Tuples[{##}], N[EuclideanDistance @@ #] &], ContainsAny]] // {Reverse[#], #2} & @@ # &) &, First[path], Rest[path], Identity]]] newdat = ConnectLines[dat]; ListLinePlot[Join @@ newdat, Frame -> True] Graphics[Arrow@newdat, Frame -> True] 

http://o8aucf9ny.bkt.clouddn.com/2017-02-18-20-28-53.png

For the sake of general,such as the line include not only $2$ points,the every line maybe is a mess order(include first one),I make some adjust like following.Maybe too long,but powerful. ###If you have a gap data like dat2 We can convert it into non-gap data first by ConnectComponentPoints

ConnectComponentPoints[p_] := Module[{f, var1, var2, nearePoint, graph}, f = Nearest /@ Most[p]; var2 = Drop[p, #] & /@ Range[Length[p] - 1]; var1 = MapThread[Catenate /@ # /@ #2 &, {f, var2}]; nearePoint = Catenate[ Map[First[MinimalBy[#, EuclideanDistance @@ # &]] &, Flatten[{var1, var2}, List /@ {2, 3, 4, 1, 5}], {2}]]; graph = CompleteGraph[Length[p], EdgeWeight -> EuclideanDistance @@@ nearePoint]; Join[p, nearePoint[[EdgeIndex[graph, #] & /@ EdgeList[FindSpanningTree[graph]]]]]] ListLinePlot[ConnectComponentPoints[dat2]] 

http://o8aucf9ny.bkt.clouddn.com/2017-02-18-20-30-50.png

###If you have a non-gap data like dat:

ConnectLines[dat_] := Module[{g = SimpleGraph[RelationGraph[IntersectingQ, dat], VertexLabels -> "Index"], path}, path = FindShortestPath[g, Sequence @@ GraphPeriphery[g]]; Append[First /@ #, #[[-1, -1]]] &[ FoldPairList[(Transpose[ DeleteDuplicates[ SortBy[Tuples[{##}], N[EuclideanDistance @@ #] &], ContainsAny]] // {Reverse[#], #2} & @@ # &) &, First[path], Rest[path], Identity]]] newdat = ConnectLines[dat]; ListLinePlot[Join @@ newdat, Frame -> True] Graphics[Arrow@newdat, Frame -> True] 

http://o8aucf9ny.bkt.clouddn.com/2017-02-18-20-28-53.png

For the sake of general,such as the line include not only $2$ points,the every line maybe is a mess order(include first one),I make some adjust like following.Maybe too long,but powerful.

If you have a gap data like dat2

We can convert it into non-gap data first by ConnectComponentPoints

ConnectComponentPoints[p_] := Module[{f, var1, var2, nearePoint, graph}, f = Nearest /@ Most[p]; var2 = Drop[p, #] & /@ Range[Length[p] - 1]; var1 = MapThread[Catenate /@ # /@ #2 &, {f, var2}]; nearePoint = Catenate[ Map[First[MinimalBy[#, EuclideanDistance @@ # &]] &, Flatten[{var1, var2}, List /@ {2, 3, 4, 1, 5}], {2}]]; graph = CompleteGraph[Length[p], EdgeWeight -> EuclideanDistance @@@ nearePoint]; Join[p, nearePoint[[EdgeIndex[graph, #] & /@ EdgeList[FindSpanningTree[graph]]]]]] ListLinePlot[ConnectComponentPoints[dat2]] 

http://o8aucf9ny.bkt.clouddn.com/2017-02-18-20-30-50.png

If you have a non-gap data like dat:

ConnectLines[dat_] := Module[{g = SimpleGraph[RelationGraph[IntersectingQ, dat], VertexLabels -> "Index"], path}, path = FindShortestPath[g, Sequence @@ GraphPeriphery[g]]; Append[First /@ #, #[[-1, -1]]] &[ FoldPairList[(Transpose[ DeleteDuplicates[ SortBy[Tuples[{##}], N[EuclideanDistance @@ #] &], ContainsAny]] // {Reverse[#], #2} & @@ # &) &, First[path], Rest[path], Identity]]] newdat = ConnectLines[dat]; ListLinePlot[Join @@ newdat, Frame -> True] Graphics[Arrow@newdat, Frame -> True] 

http://o8aucf9ny.bkt.clouddn.com/2017-02-18-20-28-53.png

deleted 163 characters in body
Source Link
yode
  • 27.8k
  • 4
  • 69
  • 183

For the sake of general,such as the line include not only $2$ points,the every line maybe is a mess order(include first one),I make some adjust like following.Maybe too long,but powerful. ###If you have a gap data like dat2 We can convert it into non-gap data first by ConnectComponentPoints

ConnectComponentPoints[p_] := Module[{f, var1, var2, nearePoint, graph}, f = Nearest /@ Most[p]; var2 = Drop[p, #] & /@ Range[Length[p] - 1]; var1 = MapThread[Catenate /@ # /@ #2 &, {f, var2}]; nearePoint = Catenate[ Map[First[MinimalBy[#, EuclideanDistance @@ # &]] &, Flatten[{var1, var2}, List /@ {2, 3, 4, 1, 5}], {2}]]; graph = CompleteGraph[Length[p], EdgeWeight -> EuclideanDistance @@@ nearePoint]; Join[p, nearePoint[[EdgeIndex[graph, #] & /@ EdgeList[FindSpanningTree[graph]]]]]] ListLinePlot[ConnectComponentPoints[dat2]] 

http://o8aucf9ny.bkt.clouddn.com/2017-02-18-20-30-50.png

###If you have a non-gap data like dat:

ConnectLines[dat_] := Module[{g = SimpleGraph[RelationGraph[IntersectingQ, dat], VertexLabels -> "Index"], path}, path = FindShortestPath[g, Sequence @@ GraphPeriphery[g]]; Append[First /@ #, #[[-1, -1]]] &[ FoldPairList[ MapAt[Reverse, (Transpose[ Reap[Nest[  MapThread[DeleteDuplicates[   DeleteCases, SortBy[Tuples[{###}],  N[EuclideanDistance @@ #] &], Sow[First[   MinimalBy[Transpose[{FirstContainsAny]] /@ Nearest @@/ #{Reverse[#], Last[#]#2}],  N[EuclideanDistance& @@ #]# &]]]}]&) &, {##}First[path], Length[#]]][[2,   1]]], {1}] &, First[path], Rest[path], Identity]]] newdat = ConnectLines[dat]; ListLinePlot[Join @@ newdat, Frame -> True] Graphics[Arrow@newdat, Frame -> True] 

http://o8aucf9ny.bkt.clouddn.com/2017-02-18-20-28-53.png

For the sake of general,such as the line include not only $2$ points,the every line maybe is a mess order(include first one),I make some adjust like following.Maybe too long,but powerful. ###If you have a gap data like dat2 We can convert it into non-gap data first by ConnectComponentPoints

ConnectComponentPoints[p_] := Module[{f, var1, var2, nearePoint, graph}, f = Nearest /@ Most[p]; var2 = Drop[p, #] & /@ Range[Length[p] - 1]; var1 = MapThread[Catenate /@ # /@ #2 &, {f, var2}]; nearePoint = Catenate[ Map[First[MinimalBy[#, EuclideanDistance @@ # &]] &, Flatten[{var1, var2}, List /@ {2, 3, 4, 1, 5}], {2}]]; graph = CompleteGraph[Length[p], EdgeWeight -> EuclideanDistance @@@ nearePoint]; Join[p, nearePoint[[EdgeIndex[graph, #] & /@ EdgeList[FindSpanningTree[graph]]]]]] ListLinePlot[ConnectComponentPoints[dat2]] 

http://o8aucf9ny.bkt.clouddn.com/2017-02-18-20-30-50.png

###If you have a non-gap data like dat:

ConnectLines[dat_] := Module[{g = SimpleGraph[RelationGraph[IntersectingQ, dat], VertexLabels -> "Index"], path}, path = FindShortestPath[g, Sequence @@ GraphPeriphery[g]]; Append[First /@ #, #[[-1, -1]]] &[ FoldPairList[ MapAt[Reverse, Transpose[ Reap[Nest[  MapThread[   DeleteCases, {#,  Sow[First[   MinimalBy[Transpose[{First /@ Nearest @@ #, Last[#]}],  N[EuclideanDistance @@ #] &]]]}] &, {##}, Length[#]]][[2,   1]]], {1}] &, First[path], Rest[path], Identity]]] newdat = ConnectLines[dat]; ListLinePlot[Join @@ newdat, Frame -> True] Graphics[Arrow@newdat, Frame -> True] 

http://o8aucf9ny.bkt.clouddn.com/2017-02-18-20-28-53.png

For the sake of general,such as the line include not only $2$ points,the every line maybe is a mess order(include first one),I make some adjust like following.Maybe too long,but powerful. ###If you have a gap data like dat2 We can convert it into non-gap data first by ConnectComponentPoints

ConnectComponentPoints[p_] := Module[{f, var1, var2, nearePoint, graph}, f = Nearest /@ Most[p]; var2 = Drop[p, #] & /@ Range[Length[p] - 1]; var1 = MapThread[Catenate /@ # /@ #2 &, {f, var2}]; nearePoint = Catenate[ Map[First[MinimalBy[#, EuclideanDistance @@ # &]] &, Flatten[{var1, var2}, List /@ {2, 3, 4, 1, 5}], {2}]]; graph = CompleteGraph[Length[p], EdgeWeight -> EuclideanDistance @@@ nearePoint]; Join[p, nearePoint[[EdgeIndex[graph, #] & /@ EdgeList[FindSpanningTree[graph]]]]]] ListLinePlot[ConnectComponentPoints[dat2]] 

http://o8aucf9ny.bkt.clouddn.com/2017-02-18-20-30-50.png

###If you have a non-gap data like dat:

ConnectLines[dat_] := Module[{g = SimpleGraph[RelationGraph[IntersectingQ, dat], VertexLabels -> "Index"], path}, path = FindShortestPath[g, Sequence @@ GraphPeriphery[g]]; Append[First /@ #, #[[-1, -1]]] &[ FoldPairList[(Transpose[ DeleteDuplicates[ SortBy[Tuples[{##}], N[EuclideanDistance @@ #] &], ContainsAny]] // {Reverse[#], #2} & @@ # &) &, First[path], Rest[path], Identity]]] newdat = ConnectLines[dat]; ListLinePlot[Join @@ newdat, Frame -> True] Graphics[Arrow@newdat, Frame -> True] 

http://o8aucf9ny.bkt.clouddn.com/2017-02-18-20-28-53.png

added 3 characters in body
Source Link
yode
  • 27.8k
  • 4
  • 69
  • 183

For the sake of general,such as the line include not only $2$ points,the every line maybe is a mess order(include first one),I make some adjust like following.Maybe too long,but powerful. ###If you have a gap data like dat2 We can convert it into non-gap data first by ConnectComponentPoints

ConnectComponentPoints[p_] := Module[{f, var1, var2, nearePoint, graph}, f = Nearest /@ Most[p]; var2 = Drop[p, #] & /@ Range[Length[p] - 1]; var1 = MapThread[Catenate /@ # /@ #2 &, {f, var2}]; nearePoint = Catenate[ Map[First[MinimalBy[#, EuclideanDistance @@ # &]] &, Flatten[{var1, var2}, List /@ {2, 3, 4, 1, 5}], {2}]]; graph = CompleteGraph[Length[p], EdgeWeight -> EuclideanDistance @@@ nearePoint]; Join[p, nearePoint[[EdgeIndex[graph, #] & /@ EdgeList[FindSpanningTree[graph]]]]]] ListLinePlot[ConnectComponentPoints[dat2]] 

http://o8aucf9ny.bkt.clouddn.com/2017-02-18-20-30-50.png

###If you have a non-gap data like dat:

ConnectLines[dat_] := Module[{g = SimpleGraph[RelationGraph[IntersectingQ, dat], VertexLabels -> "Index"], path}, path = FindShortestPath[g, Sequence @@ GraphPeriphery[g]]; Append[First /@ #, #[[-1, -1]]] &[ FoldPairList[ MapAt[Reverse, Transpose[ Reap[Nest[ MapThread[ DeleteCases, {#, Sow[First[ MinimalBy[Transpose[{First /@ Nearest @@ #, Last[#]}], EuclideanDistanceN[EuclideanDistance @@ ##] &]]]}] &, {##}, Length[#]]][[2, 1]]], {1}] &, First[path], Rest[path], Identity]]] newdat = ConnectLines[dat]; ListLinePlot[Join @@ newdat, Frame -> True] Graphics[Arrow@newdat, Frame -> True] 

http://o8aucf9ny.bkt.clouddn.com/2017-02-18-20-28-53.png

For the sake of general,such as the line include not only $2$ points,the every line maybe is a mess order(include first one),I make some adjust like following.Maybe too long,but powerful. ###If you have a gap data like dat2 We can convert it into non-gap data first by ConnectComponentPoints

ConnectComponentPoints[p_] := Module[{f, var1, var2, nearePoint, graph}, f = Nearest /@ Most[p]; var2 = Drop[p, #] & /@ Range[Length[p] - 1]; var1 = MapThread[Catenate /@ # /@ #2 &, {f, var2}]; nearePoint = Catenate[ Map[First[MinimalBy[#, EuclideanDistance @@ # &]] &, Flatten[{var1, var2}, List /@ {2, 3, 4, 1, 5}], {2}]]; graph = CompleteGraph[Length[p], EdgeWeight -> EuclideanDistance @@@ nearePoint]; Join[p, nearePoint[[EdgeIndex[graph, #] & /@ EdgeList[FindSpanningTree[graph]]]]]] ListLinePlot[ConnectComponentPoints[dat2]] 

http://o8aucf9ny.bkt.clouddn.com/2017-02-18-20-30-50.png

###If you have a non-gap data like dat:

ConnectLines[dat_] := Module[{g = SimpleGraph[RelationGraph[IntersectingQ, dat], VertexLabels -> "Index"], path}, path = FindShortestPath[g, Sequence @@ GraphPeriphery[g]]; Append[First /@ #, #[[-1, -1]]] &[ FoldPairList[ MapAt[Reverse, Transpose[ Reap[Nest[ MapThread[ DeleteCases, {#, Sow[First[ MinimalBy[Transpose[{First /@ Nearest @@ #, Last[#]}], EuclideanDistance @@ # &]]]}] &, {##}, Length[#]]][[2, 1]]], {1}] &, First[path], Rest[path], Identity]]] newdat = ConnectLines[dat]; ListLinePlot[Join @@ newdat, Frame -> True] Graphics[Arrow@newdat, Frame -> True] 

http://o8aucf9ny.bkt.clouddn.com/2017-02-18-20-28-53.png

For the sake of general,such as the line include not only $2$ points,the every line maybe is a mess order(include first one),I make some adjust like following.Maybe too long,but powerful. ###If you have a gap data like dat2 We can convert it into non-gap data first by ConnectComponentPoints

ConnectComponentPoints[p_] := Module[{f, var1, var2, nearePoint, graph}, f = Nearest /@ Most[p]; var2 = Drop[p, #] & /@ Range[Length[p] - 1]; var1 = MapThread[Catenate /@ # /@ #2 &, {f, var2}]; nearePoint = Catenate[ Map[First[MinimalBy[#, EuclideanDistance @@ # &]] &, Flatten[{var1, var2}, List /@ {2, 3, 4, 1, 5}], {2}]]; graph = CompleteGraph[Length[p], EdgeWeight -> EuclideanDistance @@@ nearePoint]; Join[p, nearePoint[[EdgeIndex[graph, #] & /@ EdgeList[FindSpanningTree[graph]]]]]] ListLinePlot[ConnectComponentPoints[dat2]] 

http://o8aucf9ny.bkt.clouddn.com/2017-02-18-20-30-50.png

###If you have a non-gap data like dat:

ConnectLines[dat_] := Module[{g = SimpleGraph[RelationGraph[IntersectingQ, dat], VertexLabels -> "Index"], path}, path = FindShortestPath[g, Sequence @@ GraphPeriphery[g]]; Append[First /@ #, #[[-1, -1]]] &[ FoldPairList[ MapAt[Reverse, Transpose[ Reap[Nest[ MapThread[ DeleteCases, {#, Sow[First[ MinimalBy[Transpose[{First /@ Nearest @@ #, Last[#]}], N[EuclideanDistance @@ #] &]]]}] &, {##}, Length[#]]][[2, 1]]], {1}] &, First[path], Rest[path], Identity]]] newdat = ConnectLines[dat]; ListLinePlot[Join @@ newdat, Frame -> True] Graphics[Arrow@newdat, Frame -> True] 

http://o8aucf9ny.bkt.clouddn.com/2017-02-18-20-28-53.png

added 1090 characters in body
Source Link
yode
  • 27.8k
  • 4
  • 69
  • 183
Loading
Source Link
yode
  • 27.8k
  • 4
  • 69
  • 183
Loading