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$
  • 1
    $\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 May 11 '13 at 16:16
  • $\begingroup$ You could always use a particle filter... :D $\endgroup$ – rm -rf May 11 '13 at 16:18
  • $\begingroup$ @rm-rf: can you elaborate more on this particle filter concept? $\endgroup$ – Sejwal May 11 '13 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 May 11 '13 at 16:36
  • 1
    $\begingroup$ @rm-rf A particle filter ... kind of reference.wolfram.com/mathematica/ref/ImageFeatureTrack.html (see "Neat Examples") $\endgroup$ – Dr. belisarius May 12 '13 at 19:38
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

| improve this answer | |
$\endgroup$
  • $\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 May 12 '13 at 8:37
  • $\begingroup$ @Aky Take a look at the edit $\endgroup$ – Dr. belisarius May 12 '13 at 16:01

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.