Return to Answer

added 30 characters in body

edited Mar 4, 2014 at 3:13

116.8k
13
208
466

getOneCluster[pts_List, maxDist_?NumericQ] :=(*Returns a cluster*) Module[{f}, f = Nearest[pts]; FixedPoint[Union@Flatten[f[#, {Infinity, maxDist}] & /@ #, 1] &, {First@pts}]] clusters[data_] := Module[{f, dist},(*Some Characteristic Distance, assuming no isolated points*) f = Nearest[data]; dist = 3 Max[EuclideanDistance[Last@f[#, 2], #] & /@ data]; Flatten[ Reap[NestWhile[Complement[#, Sow@getOneCluster[#, dist]] &, data, # != {} &]][[2]], 1]] p1 = ParametricPlot3D[ Evaluate[{x[t], y[t], p2[t]} /. sol2], {t, 0, tfin}, MeshFunctions -> {#1 &}, Mesh -> {{0}}, PlotStyle -> None, MeshStyle -> Red]; gc = Cases[p1, GraphicsComplex[__], Infinity]; data = First[(Normal@gc)[[1, 2, 1, 2 ;;]] /. Point -> Sequence][[All, 2 ;;]]; clusters[data]; Show[ListPlot@clusters@data, ListLinePlot[#[[FindCurvePath[#][[1]]]] & /@ clusters[data]]clusters[data]]]

Mathematica graphics

getOneCluster[pts_List, maxDist_?NumericQ] :=(*Returns a cluster*) Module[{f}, f = Nearest[pts]; FixedPoint[Union@Flatten[f[#, {Infinity, maxDist}] & /@ #, 1] &, {First@pts}]] clusters[data_] := Module[{f, dist},(*Some Characteristic Distance, assuming no isolated points*) f = Nearest[data]; dist = 3 Max[EuclideanDistance[Last@f[#, 2], #] & /@ data]; Flatten[ Reap[NestWhile[Complement[#, Sow@getOneCluster[#, dist]] &, data, # != {} &]][[2]], 1]] p1 = ParametricPlot3D[ Evaluate[{x[t], y[t], p2[t]} /. sol2], {t, 0, tfin}, MeshFunctions -> {#1 &}, Mesh -> {{0}}, PlotStyle -> None, MeshStyle -> Red]; gc = Cases[p1, GraphicsComplex[__], Infinity]; data = First[(Normal@gc)[[1, 2, 1, 2 ;;]] /. Point -> Sequence][[All, 2 ;;]]; clusters[data]; ListLinePlot[#[[FindCurvePath[#][[1]]]] & /@ clusters[data]]

Mathematica graphics

getOneCluster[pts_List, maxDist_?NumericQ] :=(*Returns a cluster*) Module[{f}, f = Nearest[pts]; FixedPoint[Union@Flatten[f[#, {Infinity, maxDist}] & /@ #, 1] &, {First@pts}]] clusters[data_] := Module[{f, dist},(*Some Characteristic Distance, assuming no isolated points*) f = Nearest[data]; dist = 3 Max[EuclideanDistance[Last@f[#, 2], #] & /@ data]; Flatten[ Reap[NestWhile[Complement[#, Sow@getOneCluster[#, dist]] &, data, # != {} &]][[2]], 1]] p1 = ParametricPlot3D[ Evaluate[{x[t], y[t], p2[t]} /. sol2], {t, 0, tfin}, MeshFunctions -> {#1 &}, Mesh -> {{0}}, PlotStyle -> None, MeshStyle -> Red]; gc = Cases[p1, GraphicsComplex[__], Infinity]; data = First[(Normal@gc)[[1, 2, 1, 2 ;;]] /. Point -> Sequence][[All, 2 ;;]]; clusters[data]; Show[ListPlot@clusters@data, ListLinePlot[#[[FindCurvePath[#][[1]]]] & /@ clusters[data]]]

Mathematica graphics

Source Link

answered Mar 4, 2014 at 3:05

Dr. belisarius

116.8k
13
208
466

getOneCluster[pts_List, maxDist_?NumericQ] :=(*Returns a cluster*) Module[{f}, f = Nearest[pts]; FixedPoint[Union@Flatten[f[#, {Infinity, maxDist}] & /@ #, 1] &, {First@pts}]] clusters[data_] := Module[{f, dist},(*Some Characteristic Distance, assuming no isolated points*) f = Nearest[data]; dist = 3 Max[EuclideanDistance[Last@f[#, 2], #] & /@ data]; Flatten[ Reap[NestWhile[Complement[#, Sow@getOneCluster[#, dist]] &, data, # != {} &]][[2]], 1]] p1 = ParametricPlot3D[ Evaluate[{x[t], y[t], p2[t]} /. sol2], {t, 0, tfin}, MeshFunctions -> {#1 &}, Mesh -> {{0}}, PlotStyle -> None, MeshStyle -> Red]; gc = Cases[p1, GraphicsComplex[__], Infinity]; data = First[(Normal@gc)[[1, 2, 1, 2 ;;]] /. Point -> Sequence][[All, 2 ;;]]; clusters[data]; ListLinePlot[#[[FindCurvePath[#][[1]]]] & /@ clusters[data]]

Mathematica graphics