5
$\begingroup$

I'd like to draw a simple curve by hand. Next, I have to figure out what function defines it the best.

I've been thinking long but I don't have an idea how to make it.

What I could imagine is that somehow draw series of points with drawing tools and get coordinates and then fit an arbitrary function to the coordinates.

In a similar topic someone suggested to use Classify but I don't understand how it helps here.

So I don't know how to start, any idea?

My motivation: This function would serve as a quantum mechanical wavefunction and I want to make some further calculation with this function as solving time-evolution etc so some physical problem.

$\endgroup$
  • 1
    $\begingroup$ What would be the point of that? Perhaps if you give us some context regarding your final goal, we could help better. In other words, what do you need to do once you have that function? Would fitting a spline work? $\endgroup$ – MarcoB May 15 at 21:39
  • $\begingroup$ it would be considered as a physical function and I like to use it in further physical problems $\endgroup$ – Aaron May 15 at 21:57
  • 1
    $\begingroup$ Drawing by hand sounds to me a bit more metaphysical than physical. And is 2 dimensions enough for a quantum mechanical wave function? $\endgroup$ – JimB May 15 at 22:09
  • $\begingroup$ "What I could imagine is that somehow draw series of points with drawing tools..." There's a button for drawing curve by hand on the drawing tool panel: i.stack.imgur.com/yGQnN.png $\endgroup$ – xzczd May 16 at 5:53
11
$\begingroup$
Deploy @ DynamicModule[{list = {}, fits = {}}, Panel @ Row[{Framed @ 
    EventHandler[Dynamic[Graphics[{Thick, Blue,  Line[list], 
       PointSize[Medium], Red, Point[list]}, PlotRange -> 1, ImageSize -> Medium]], 
     {"MouseDown" :> (list = {}; fits = {};), 
      "MouseDragged" :> (AppendTo[list, MousePosition["Graphics"]]), 
      "MouseUp" :> (fits = FindFormula[list, x, 5, All];)}], 
     Dynamic @ fits}, Spacer[10]]]

enter image description here

You can play with the options of FindFormula and show the fit functions as Epilog:

Deploy @ DynamicModule[{list = {}, fits = {}}, Panel @ Row[{Framed @
   EventHandler[Dynamic[Graphics[{Thick, Opacity[.5, Gray], Line[list], 
     PointSize[Medium], Red, Point[list]}, 
     PlotRange -> {{0, 1}, {0, 1}}, ImageSize -> Medium, 
     Epilog -> If[fits === {}, {}, 
        First@Plot[Evaluate[Normal[Keys@fits]], {x, 0, 1}]]]], 
   {"MouseDown" :> (list = {}; fits = {};), 
    "MouseDragged" :> (AppendTo[list, MousePosition["Graphics"]]), 
    "MouseUp" :> (fits = FindFormula[list, x, 5, All, 
          TargetFunctions -> {Times,  Plus, Abs, Sin, Cos, Power}];)}], 
    Dynamic[If[fits === {}, "",
      (i = 1; KeyMap[Style[#, 16, ColorData[97][i++]] &]@fits)]]}, 
    Spacer[10]]]

enter image description here

enter image description here

| improve this answer | |
$\endgroup$
8
$\begingroup$

enter image description here

This does standard fit using Polynomial. You can add more terms to the polynomial and remove term. Can add/remove points. Each point added must be in increasing $x$ order.

Usese LocatorPane to collect points and update the fitting Polynomial as more points are added.

Manipulate[
 (*Version 1.0 alpha   *)
 tick;
 term = Table[x^n, {n, 0, terms - 1}];
 fit = Fit[collection, term, x];
 Style[TraditionalForm@fit, Medium]
 ,
 Grid[{
   {
    Row[{Button["Add term", {terms++; tick = Not[tick]}, ImageSize -> 100],
     Button["Remove term",{If[terms > 1, terms--]; tick = Not[tick]},ImageSize -> 100],
     Button["Erase All", {collection = {}; tick = Not[tick]}, ImageSize -> 100],
     Button["Erase last", {If[Length@collection > 1,
         collection = Delete[collection, -1]; pt = Last@collection
         ]; tick = Not[tick]}, ImageSize -> 100]}]        
    },     
   {LocatorPane[
     Dynamic[pt, {(pt = #) &,
       (If[Length[collection] > 1,
          If[First@pt >= Max[collection[[All, 1]]],
           AppendTo[collection, pt]
           ]
          ,
          AppendTo[collection, pt]
          ];
         tick = Not[tick]) &}
      ]
     ,
     Dynamic@If[Length[collection] > 1,
       Graphics[
        {
         {First@
           Plot[fit, {x, Min[collection[[All, 1]]], Max[collection[[All, 1]]]},
            PlotStyle -> Red
            ]
          },
         {Red, PointSize[0.02], Point[collection]},
         {Blue, Line[collection]}
         },
        ImageSize -> 500,
        PlotRange -> {{-2, 2}, {-2, 2}}, Axes -> True,
        GridLines -> {Range[-2, 2, .2], Range[-2, 2, .2]},
        GridLinesStyle -> LightGray
        ],
       Graphics[
        {
         {Red, PointSize[0.02], Point[collection]},
         {Blue, Line[collection]}
         },
        ImageSize -> 500,
        PlotRange -> {{-2, 2}, {-2, 2}}, Axes -> True,
        GridLines -> {Range[-2, 2, .2], Range[-2, 2, .2]},
        GridLinesStyle -> LightGray
        ]]]}}, Frame -> True
  ],          
 {{tick, False}, None},
 {{state, "collect"}, None},
 {{pt, {0, 0}}, None},
 {{collection, {}}, None},
 {{fit, 0}, None},
 {{terms, 5}, None},
 ControlPlacement -> Bottom, Alignment -> Center, ImageMargins -> 0,     
 TrackedSymbols :> {tick}
 ]
| improve this answer | |
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.