Revisions to FindCurvePath for lines (rather than points)

replaced http://mathematica.stackexchange.com/ with https://mathematica.stackexchange.com/

Source Link

edited Apr 13, 2017 at 12:56

1

With the missing piece from How do I "read out" the vertex names on this graph?How do I "read out" the vertex names on this graph? I can self-answer using Nearest and Graph. Please don't let this post discourage answering as I am eager to see other approaches.

Now as a function with at least a little reusability. The second parameter is the search radius.

segOrder[segs_, rad_: 0.0001] := (
   Flatten[segs, 1]
     // Nearest[# -> Automatic, #, {2, rad}] &
     // Cases[{_, _}]
     // Join[#, Partition[Range[2 Length@segs], 2]] &
     // Graph
     // FindPath[#, ## & @@ GraphPeriphery[#]] &
     // First
  )

ListLinePlot[Part[Join @@ dat, segOrder[dat]], Frame -> True]

It works on the set with gaps given a sufficient radius:

ListLinePlot[Part[Join @@ dat2, segOrder[dat2, 0.0001]], Frame -> True]

Extension

Here is my application of this ordering to the sorting (and joining) of longer lines.

lineSort[lines_, r_: 0.0001] :=
  lines[[All, {1, -1}]] ~segOrder~ r ~Partition~ 2 //
    Cases[ {a_, b_} :> lines[[⌈a/2⌉, b - a ;; a - b ;; b - a]] ]

Now I can do things like this:

geo = Import["http://www.rr4w.com/kml/9.kml"];

Cases[geo, Line[x_] :> x, {-4}] // lineSort // Catenate;

Graphics[{
  Thickness[1/150], 
  Line[%, VertexColors -> Array[ColorData["Rainbow"], Length@%, {0, 1}]]
}]

With the missing piece from How do I "read out" the vertex names on this graph? I can self-answer using Nearest and Graph. Please don't let this post discourage answering as I am eager to see other approaches.

Now as a function with at least a little reusability. The second parameter is the search radius.

segOrder[segs_, rad_: 0.0001] := (
   Flatten[segs, 1]
     // Nearest[# -> Automatic, #, {2, rad}] &
     // Cases[{_, _}]
     // Join[#, Partition[Range[2 Length@segs], 2]] &
     // Graph
     // FindPath[#, ## & @@ GraphPeriphery[#]] &
     // First
  )

ListLinePlot[Part[Join @@ dat, segOrder[dat]], Frame -> True]

It works on the set with gaps given a sufficient radius:

ListLinePlot[Part[Join @@ dat2, segOrder[dat2, 0.0001]], Frame -> True]

Extension

Here is my application of this ordering to the sorting (and joining) of longer lines.

lineSort[lines_, r_: 0.0001] :=
  lines[[All, {1, -1}]] ~segOrder~ r ~Partition~ 2 //
    Cases[ {a_, b_} :> lines[[⌈a/2⌉, b - a ;; a - b ;; b - a]] ]

Now I can do things like this:

geo = Import["http://www.rr4w.com/kml/9.kml"];

Cases[geo, Line[x_] :> x, {-4}] // lineSort // Catenate;

Graphics[{
  Thickness[1/150], 
  Line[%, VertexColors -> Array[ColorData["Rainbow"], Length@%, {0, 1}]]
}]

With the missing piece from How do I "read out" the vertex names on this graph? I can self-answer using Nearest and Graph. Please don't let this post discourage answering as I am eager to see other approaches.

Now as a function with at least a little reusability. The second parameter is the search radius.

segOrder[segs_, rad_: 0.0001] := (
   Flatten[segs, 1]
     // Nearest[# -> Automatic, #, {2, rad}] &
     // Cases[{_, _}]
     // Join[#, Partition[Range[2 Length@segs], 2]] &
     // Graph
     // FindPath[#, ## & @@ GraphPeriphery[#]] &
     // First
  )

ListLinePlot[Part[Join @@ dat, segOrder[dat]], Frame -> True]

It works on the set with gaps given a sufficient radius:

ListLinePlot[Part[Join @@ dat2, segOrder[dat2, 0.0001]], Frame -> True]

Extension

Here is my application of this ordering to the sorting (and joining) of longer lines.

lineSort[lines_, r_: 0.0001] :=
  lines[[All, {1, -1}]] ~segOrder~ r ~Partition~ 2 //
    Cases[ {a_, b_} :> lines[[⌈a/2⌉, b - a ;; a - b ;; b - a]] ]

Now I can do things like this:

geo = Import["http://www.rr4w.com/kml/9.kml"];

Cases[geo, Line[x_] :> x, {-4}] // lineSort // Catenate;

Graphics[{
  Thickness[1/150], 
  Line[%, VertexColors -> Array[ColorData["Rainbow"], Length@%, {0, 1}]]
}]

deleted 67 characters in body

Source Link

edited Feb 16, 2017 at 11:45

Mr.Wizard

273.1k
34
595
1.4k

With the missing piece from How do I "read out" the vertex names on this graph?How do I "read out" the vertex names on this graph? I can self-answer using Nearest and Graph. Please don't let this post discourage answering as I am eager to see other approaches.

Now as a function with at least a little reusability. The second parameter is the search radius.

segOrder[segs_, rad_: 0.0001] := (
   Flatten[segs, 1]
     // Nearest[# -> Automatic, #, {2, rad}] &
     // Cases[{_, _}]
     // Join[#, Partition[Range[2 Length@segs], 2]] &
     // Graph
     // FindPath[#, ## & @@ GraphPeriphery[#]] &
     // First
  )

ListLinePlot[Part[Join @@ dat, segOrder[dat]], Frame -> True]

It works on the set with gaps given a sufficient radius:

ListLinePlot[Part[Join @@ dat2, segOrder[dat2, 0.0001]], Frame -> True]

Extension

Here is my application of this ordering to the sorting (and joining) of longer lines.

lineSort[lines_, r_: 0.0001] :=
  lines[[All, {1, -1}]] ~segOrder~ r ~Partition~ 2 //
    Cases[ {a_, b_} :> lines[[⌈a/2⌉, b - a ;; a - b ;; b - a]] ]

Now I can do things like this:

geo = Import["http://www.rr4w.com/kml/9.kml"];

Cases[geo, Line[x_] :> x, {-4}] // lineSort // Catenate;

Graphics[{
  Thickness[1/150], 
  Line[%, VertexColors -> Array[ColorData["Rainbow"], Length@%, {0, 1}]]
}]

With the missing piece from How do I "read out" the vertex names on this graph? I can self-answer using Nearest and Graph. Please don't let this post discourage answering as I am eager to see other approaches.

Now as a function with at least a little reusability. The second parameter is the search radius.

segOrder[segs_, rad_: 0.0001] := (
   Flatten[segs, 1]
     // Nearest[# -> Automatic, #, {2, rad}] &
     // Cases[{_, _}]
     // Join[#, Partition[Range[2 Length@segs], 2]] &
     // Graph
     // FindPath[#, ## & @@ GraphPeriphery[#]] &
     // First
  )

ListLinePlot[Part[Join @@ dat, segOrder[dat]], Frame -> True]

It works on the set with gaps given a sufficient radius:

ListLinePlot[Part[Join @@ dat2, segOrder[dat2, 0.0001]], Frame -> True]

Extension

Here is my application of this ordering to the sorting (and joining) of longer lines.

lineSort[lines_, r_: 0.0001] :=
  lines[[All, {1, -1}]] ~segOrder~ r ~Partition~ 2 //
    Cases[ {a_, b_} :> lines[[⌈a/2⌉, b - a ;; a - b ;; b - a]] ]

Now I can do things like this:

geo = Import["http://www.rr4w.com/kml/9.kml"];

Cases[geo, Line[x_] :> x, {-4}] // lineSort // Catenate;

Graphics[{
  Thickness[1/150], 
  Line[%, VertexColors -> Array[ColorData["Rainbow"], Length@%, {0, 1}]]
}]

With the missing piece from How do I "read out" the vertex names on this graph? I can self-answer using Nearest and Graph. Please don't let this post discourage answering as I am eager to see other approaches.

Now as a function with at least a little reusability. The second parameter is the search radius.

segOrder[segs_, rad_: 0.0001] := (
   Flatten[segs, 1]
     // Nearest[# -> Automatic, #, {2, rad}] &
     // Cases[{_, _}]
     // Join[#, Partition[Range[2 Length@segs], 2]] &
     // Graph
     // FindPath[#, ## & @@ GraphPeriphery[#]] &
     // First
  )

ListLinePlot[Part[Join @@ dat, segOrder[dat]], Frame -> True]

It works on the set with gaps given a sufficient radius:

ListLinePlot[Part[Join @@ dat2, segOrder[dat2, 0.0001]], Frame -> True]

Extension

Here is my application of this ordering to the sorting (and joining) of longer lines.

lineSort[lines_, r_: 0.0001] :=
  lines[[All, {1, -1}]] ~segOrder~ r ~Partition~ 2 //
    Cases[ {a_, b_} :> lines[[⌈a/2⌉, b - a ;; a - b ;; b - a]] ]

Now I can do things like this:

geo = Import["http://www.rr4w.com/kml/9.kml"];

Cases[geo, Line[x_] :> x, {-4}] // lineSort // Catenate;

Graphics[{
  Thickness[1/150], 
  Line[%, VertexColors -> Array[ColorData["Rainbow"], Length@%, {0, 1}]]
}]

correct names

Source Link

edited Jan 26, 2017 at 11:44

Mr.Wizard

273.1k
34
595
1.4k

With the missing piece from How do I "read out" the vertex names on this graph? I can self-answer using Nearest and Graph. Please don't let this post discourage answering as I am eager to see other approaches.

Now as a function with at least a little reusability. The second parameter is the search radius.

segOrder[segs_, rad_: 0.0001] := (
   Flatten[segs, 1]
     // Nearest[# -> Automatic, #, {2, rad}] &
     // Cases[{_, _}]
     // Join[#, Partition[Range[2 Length@segs], 2]] &
     // Graph
     // FindPath[#, ## & @@ GraphPeriphery[#]] &
     // First
  )

ListLinePlot[Part[Join @@ dat, order[dat]]segOrder[dat]], Frame -> True]

It works on the set with gaps given a sufficient radius:

ListLinePlot[Part[Join @@ dat2, order[dat2segOrder[dat2, 0.0001]], Frame -> True]

Extension

Here is my application of this ordering to the sorting (and joining) of longer lines.

lineSort[lines_, r_: 0.0001] :=
  lines[[All, {1, -1}]] ~segOrder~ r ~Partition~ 2 //
    Cases[ {a_, b_} :> lines[[⌈a/2⌉, b - a ;; a - b ;; b - a]] ]

Now I can do things like this:

geo = Import["http://www.rr4w.com/kml/9.kml"];

Cases[geo, Line[x_] :> x, {-4}] // lineSort // Catenate;

Graphics[{
  Thickness[1/150], 
  Line[%, VertexColors -> Array[ColorData["Rainbow"], Length@%, {0, 1}]]
}]

With the missing piece from How do I "read out" the vertex names on this graph? I can self-answer using Nearest and Graph. Please don't let this post discourage answering as I am eager to see other approaches.

Now as a function with at least a little reusability. The second parameter is the search radius.

segOrder[segs_, rad_: 0.0001] := (
   Flatten[segs, 1]
     // Nearest[# -> Automatic, #, {2, rad}] &
     // Cases[{_, _}]
     // Join[#, Partition[Range[2 Length@segs], 2]] &
     // Graph
     // FindPath[#, ## & @@ GraphPeriphery[#]] &
     // First
  )

ListLinePlot[Part[Join @@ dat, order[dat]], Frame -> True]

It works on the set with gaps given a sufficient radius:

ListLinePlot[Part[Join @@ dat2, order[dat2, 0.0001]], Frame -> True]

Extension

Here is my application of this ordering to the sorting (and joining) of longer lines.

lineSort[lines_, r_: 0.0001] :=
  lines[[All, {1, -1}]] ~segOrder~ r ~Partition~ 2 //
    Cases[ {a_, b_} :> lines[[⌈a/2⌉, b - a ;; a - b ;; b - a]] ]

Now I can do things like this:

geo = Import["http://www.rr4w.com/kml/9.kml"];

Cases[geo, Line[x_] :> x, {-4}] // lineSort // Catenate;

Graphics[{
  Thickness[1/150], 
  Line[%, VertexColors -> Array[ColorData["Rainbow"], Length@%, {0, 1}]]
}]

With the missing piece from How do I "read out" the vertex names on this graph? I can self-answer using Nearest and Graph. Please don't let this post discourage answering as I am eager to see other approaches.

Now as a function with at least a little reusability. The second parameter is the search radius.

segOrder[segs_, rad_: 0.0001] := (
   Flatten[segs, 1]
     // Nearest[# -> Automatic, #, {2, rad}] &
     // Cases[{_, _}]
     // Join[#, Partition[Range[2 Length@segs], 2]] &
     // Graph
     // FindPath[#, ## & @@ GraphPeriphery[#]] &
     // First
  )

ListLinePlot[Part[Join @@ dat, segOrder[dat]], Frame -> True]

It works on the set with gaps given a sufficient radius:

ListLinePlot[Part[Join @@ dat2, segOrder[dat2, 0.0001]], Frame -> True]

Extension

Here is my application of this ordering to the sorting (and joining) of longer lines.

lineSort[lines_, r_: 0.0001] :=
  lines[[All, {1, -1}]] ~segOrder~ r ~Partition~ 2 //
    Cases[ {a_, b_} :> lines[[⌈a/2⌉, b - a ;; a - b ;; b - a]] ]

Now I can do things like this:

geo = Import["http://www.rr4w.com/kml/9.kml"];

Cases[geo, Line[x_] :> x, {-4}] // lineSort // Catenate;

Graphics[{
  Thickness[1/150], 
  Line[%, VertexColors -> Array[ColorData["Rainbow"], Length@%, {0, 1}]]
}]

added 396 characters in body

Source Link

edited Jan 26, 2017 at 10:57

Mr.Wizard

273.1k
34
595
1.4k

Loading

needs more infix :o)

Source Link

edited Jan 25, 2017 at 21:32

Mr.Wizard

273.1k
34
595
1.4k

Loading

correct errors, refine code

Source Link

edited Jan 25, 2017 at 20:56

Mr.Wizard

273.1k
34
595
1.4k

Loading

added 103 characters in body

Source Link

edited Jan 25, 2017 at 20:23

Mr.Wizard

273.1k
34
595
1.4k

Loading

added 103 characters in body

Source Link

edited Jan 25, 2017 at 20:16

Mr.Wizard

273.1k
34
595
1.4k

Loading

Source Link

created Jan 25, 2017 at 20:09

Mr.Wizard

273.1k
34
595
1.4k

Loading

Stack Exchange Network

Return to Answer

Extension

Extension

Extension

Extension

Extension

Extension

Extension

Extension

Extension