6
$\begingroup$

Referring to this link I happen to realize that actually the trace being projected is dependent on an equation and not on disk or circle. Though I was presuming that it is getting traced because of the movement of circle/disk. So, in mathematica is it possible that the object can be traced automatically, say the same output of cycloid program without using parametric equations for trace of point on circle.

$\endgroup$
7
  • 2
    $\begingroup$ You could extract the coordinates for elements in a graph if they are unique, say there is only one Disk[] in the graph. Ideally you'd need a way to tag the points you may want to extract later but I don't think there is a way to attach such labels to Mathematica Graphics elements. One possible solution would be to Sow[] the information as you build up the plot, then Reap[] the information you need later if you choose to. $\endgroup$
    – SEngstrom
    Commented May 11, 2013 at 16:16
  • $\begingroup$ You could always use a particle filter... :D $\endgroup$
    – rm -rf
    Commented May 11, 2013 at 16:18
  • $\begingroup$ @rm-rf: can you elaborate more on this particle filter concept? $\endgroup$ Commented May 11, 2013 at 16:28
  • 1
    $\begingroup$ @rafiki It was a little tongue-in-cheek... While it is true that particle filters are very useful in real world tracking applications (see this video of the man with a glowing butt, for an example), it is overkill for the application you suggest. Something like what SEngstrom suggested (extract coordinates of interest) is what I would do as well. $\endgroup$
    – rm -rf
    Commented May 11, 2013 at 16:36
  • 1
    $\begingroup$ @rm-rf A particle filter ... kind of reference.wolfram.com/mathematica/ref/ImageFeatureTrack.html (see "Neat Examples") $\endgroup$ Commented May 12, 2013 at 19:38

1 Answer 1

9
$\begingroup$
h = {Disk[], Red, PointSize[Large], Point[{1, 0}]};
r = Image@Total[ImageData /@ (ColorSeparate /@ 
               Table[
                      Graphics[{Translate[Rotate[h, - 2 t/(Pi)], {t, 0}]}, 
                                 PlotRange -> {{0, 6 Pi}, {-1, 1}}, Background -> Black], 
                      {t, 0, 6 Pi, 2 Pi/20}])[[All, 1]]]

enter image description here

enter image description here

Edit (Perhaps cleaner)

(*the object to trace*)
h = {Disk[], Red, PointSize[Medium], Point[{1, 0}]};

obj[t_, col_] := Graphics[Translate[Rotate[h, -2 t/(Pi)], {t, 0}], 
                          PlotRange -> {{0, 6 Pi}, {-1, 1}}, Background -> col];
dt = Pi/20;

tr[0, dt] = First@ColorSeparate[obj[0, Black]];
tr[t_, dt_] :=  tr[t, dt] = ImageAdd[tr[t - dt, dt], First@ColorSeparate[obj[t, Black]]];

Animate[ ImageCompose[ImageMultiply[tr[t, dt], Red], {obj[t, White], .6}], {t, 0, 6 Pi, 2 Pi/20}]

enter image description here

$\endgroup$
2
  • $\begingroup$ Is your code supposed to show the rotating disk with the red dot (from the bottom half of the figure in your post) too? Because I'm only getting the cycloid trace. $\endgroup$
    – Aky
    Commented May 12, 2013 at 8:37
  • $\begingroup$ @Aky Take a look at the edit $\endgroup$ Commented May 12, 2013 at 16:01

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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