Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.soft-sys.math.mathematica > #2310

Re: 2D and 3D side-by-side plots via DynamicModule. How to save points?

Show all headers | View raw

On May 11, 9:29 am, "Christopher O. Young" <c...@comcast.net> wrote:
> This works wonderfully fast. Setting LocatorAutoCreate to true and then
> keeping track of the Length of the point-list Q lets us have as many points
> as we want. The only problem is that I'm losing the point values between
> runs. I couldn't figure out how to save them. I tried all the Initialization
> schemes I saw in the Mathematica Help.
>
> Any help appreciated.
>
> DynamicModule[
>  {
>   Q = {{0, 0}, {1, 1}, {2, 0}, {3, 2}},
>   r,
>   h
>   },
>
>  {
>   Slider[Dynamic[r], {0, 1, 0.01}, Appearance -> "Labeled"],
>   Slider[Dynamic[h], {-5, 5, 1}, Appearance -> "Labeled"],
>
>   LocatorPane[
>    Dynamic[Q],
>
>    Dynamic[
>     Show[
>      Plot[
>       InterpolatingPolynomial[Q, x], {x, -10, 10},
>
>       PlotStyle -> {Thick, Blue},
>       AspectRatio -> 1,
>       PlotRange -> {{-10, 10}, {-10, 10}},
>       GridLines -> Automatic,
>       AxesOrigin -> {0, 0},
>       ImageSize -> 400
>       ],    (* Plot *)
>
>      Graphics[{
>        {Thick, Pink, BezierCurve[Q, SplineDegree -> Length[Q]]},
>        {Black, Dotted, Line[Q]}
>        }
>       ]
>      ]     (* Dynamic *)
>     ],  (* Show *)
>
>    LocatorAutoCreate -> True
>    ], (* LocatorPane *)
>
>   Dynamic[
>    Show[
>     Graphics3D[
>      {
>       Table[Sphere[{Q[[k, 1]], Q[[k, 2]], h}, r], {k, 1, Length[Q]}],
>
>       Tube[
>        BezierCurve[
>         Table[{Q[[k, 1]], Q[[k, 2]], h}, {k, 1, Length[Q]}],
>         SplineDegree -> Length[Q]]],
>       {Thick, Dotted,
>        Line[Table[{Q[[k, 1]], Q[[k, 2]], h}, {k, 1, Length[Q]}]]}
>       },
>
>      Axes -> True,
>      AxesLabel -> {"x", "y", "z"},
>      AspectRatio -> 1,
>      PlotRange -> 10,
>      AxesOrigin -> {0, 0}
>      ],
>     ParametricPlot3D[{t, InterpolatingPolynomial[Q, t], h}, {t, -10,
>        10}] /.
>      Line[pts_, rest___] :> Tube[pts, 0.1, rest]
>     ]
>    ]
>   }
>  ]


This seems to work.  Just three changes, as indicated.

DynamicModule[{X(* Change 1 *)= {{0, 0}, {1, 1}, {2, 0}, {3, 2}}, r,
  h}, {Slider[Dynamic[r], {0, 1, 0.01}, Appearance -> "Labeled"],
  Slider[Dynamic[h], {-5, 5, 1}, Appearance -> "Labeled"],
  LocatorPane[Dynamic[Q, (X = Q = #) &(* Change 2 *)],
   Dynamic[Show[
     Plot[InterpolatingPolynomial[Q, x], {x, -10, 10},
      PlotStyle -> {Thick, Blue}, AspectRatio -> 1,
      PlotRange -> {{-10, 10}, {-10, 10}}, GridLines -> Automatic,
      AxesOrigin -> {0, 0}, ImageSize -> 400],(*Plot*)
     Graphics[{{Thick, Pink,
        BezierCurve[Q, SplineDegree -> Length[Q]]}, {Black, Dotted,
        Line[Q]}}]] (*Dynamic*)],(*Show*)
   LocatorAutoCreate -> True],(*LocatorPane*)
  Dynamic[Show[
    Graphics3D[{Table[
       Sphere[{Q[[k, 1]], Q[[k, 2]], h}, r], {k, 1, Length[Q]}],
      Tube[BezierCurve[
        Table[{Q[[k, 1]], Q[[k, 2]], h}, {k, 1, Length[Q]}],
        SplineDegree -> Length[Q]]], {Thick, Dotted,
       Line[Table[{Q[[k, 1]], Q[[k, 2]], h}, {k, 1, Length[Q]}]]}},
     Axes -> True, AxesLabel -> {"x", "y", "z"}, AspectRatio -> 1,
     PlotRange -> 10, AxesOrigin -> {0, 0}],
    ParametricPlot3D[{t, InterpolatingPolynomial[Q, t], h}, {t, -10,
       10}] /. Line[pts_, rest___] :> Tube[pts, 0.1, rest]]]},
 Initialization :> (Q = X)(* Change 3 *)]

Back to comp.soft-sys.math.mathematica | Previous | Next — Previous in thread | Find similar | Unroll thread

Thread

2D and 3D side-by-side plots via DynamicModule. How to save points? "Christopher O. Young" <cy56@comcast.net> - 2011-05-11 08:29 +0000
  Re: 2D and 3D side-by-side plots via DynamicModule. How to save points? Chris Degnen <degnen@cwgsy.net> - 2011-05-12 08:35 +0000

csiph-web