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

Groups > comp.soft-sys.math.mathematica > #2293 > unrolled thread

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

Back to article view | Back to comp.soft-sys.math.mathematica

Contents

  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

#2293 — 2D and 3D side-by-side plots via DynamicModule. How to save points?

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]
    ]
   ]
  }
 ]

[toc] | [next] | [standalone]

#2310

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 *)]

[toc] | [prev] | [standalone]

Back to top | Article view | comp.soft-sys.math.mathematica

csiph-web