sábado, 25 de octubre de 2014

Como hacer un persona o una imagen con curvas parametricas matematicamente y luego plot How to create a new “person curve”?

http://mathematica.stackexchange.com/questions/17704/how-to-create-a-new-person-curve
up vote 47 down vote favorite
31
Wolfram|Alpha has a whole collection¹ of parametric curves that create images of famous people. To see them, enter WolframAlpha["person curve"] into a Mathematica notebook, or person curve into Wolfram|Alpha. You get a mix of scientist, politicians and media personalities, such as Albert Einstein, Abraham Lincoln and PSY: people
The W|A parametric people curves are constructed from a combination of trigonometric and step functions. This suggests that the images might have been created by parametrising a sequence of contours... which is backed up by some curves being based of famous photos, e.g., the W|A curve for PAM Dirac:
enter image description here
is clearly based on the Dirac portrait used in Wikipedia:
enter image description here
Here's a animation showing each closed contour of Abraham Lincoln's portrait as the plot parameter t increases by 2π units:
Animated Abe
Since the functions are so complicated, I can't believe that they were manually constructed. For example, the function to make Abe's bow tie is (for 8π<t<10π) {x,y}=...
The full parametric curve for Abe has 56 such curves tied together with step functions and takes many pages to display.
So my question is:
How can I use Mathematica to take an image and produce a good looking "people curve"?
Answers can start from line art and just automatically parametrise the lines or they can start from a picture/portrait and identify a set of contours that are then parametrised. Or any other (semi)automated approach that you can think of.
¹ At the time of posting this question, it has 37 such curves.
shareimprove this question

    
Could you please explain why you "can't believe that these were hand written"? –  belisarius Jan 13 '13 at 4:57
    
@belisarius: I've added an example of part of the output from WolframAlpha["Abraham Lincoln curve", {{"EquationsPod:PlaneCurve", 1}, "FormulaData"}]. Not even the most downtrodden intern would be able to hand write such a mathematical function. Although, I admit, it could be hand traced and the traces parametrised - thus the line art comment in my question. –  Simon Jan 13 '13 at 5:14
2  
Given that the coefficients of t inside the sinusoids are 1, 2, 3, ..., this is probably just the Fourier representation of a parametric curve. I'd guess they manually traced the curve as a polygon, took the discrete Fourier transform, and kept just enough of the lowest-order modes to make the curve look right. See also: Ptolemy and Homer (Simpson). –  Rahul Narain Jan 13 '13 at 5:32
1  
Another demonstration: TracingContourLinesInPhotographicImages gets a handle on contour lines. –  Michael E2 Jan 13 '13 at 14:11
1  
The method called "Fourier Descriptors" does something similar: demonstrations.wolfram.com/preview.html?draft/46249/000012/… –  bill s Jan 13 '13 at 17:37

3 Answers

up vote 20 down vote accepted
This now has been discussed in Wolfram blog posts by Michael Trott:
Part 1: Making Formulas… for Everything — From Pi to the Pink Panther to Sir Isaac Newton
Part 2: Using Formulas... for Everything — From Complex Analysis Class to Political Cartoons to Music Album Covers
Here is one of the example apps from blog - go read it in full - fun! Don't miss the link to download the notebook with complete code and apps at the end of the blog.
Newton Outline Manipulable
shareimprove this answer

7  
Nice picture of Newton. But why does his shirt have so many buttons? –  Daniel Lichtblau May 17 '13 at 19:36
3  
@DanielLichtblau Newton was known to dress up in disguises and roam the streets of London in order to catch the counterfeiters. As Warden, and afterwards Master, of the Royal Mint, Newton estimated that 20 percent of the coins taken in during The Great Recoinage of 1696 were counterfeit. Counterfeiting was high treason, punishable by the felon's being hanged, drawn and quartered. Despite this, convicting the most flagrant criminals could be extremely difficult. However, Newton proved to be equal to the task. Disguised as a habitué of bars and taverns, he gathered much of that evidence himself. –  Vitaliy Kaurov May 17 '13 at 19:49
3  
Ironically, it was Newton himself who was drawn above. In portrait form, suitable for hanging in ones quarters. But I digress. –  Daniel Lichtblau May 17 '13 at 20:33
up vote 29 down vote
This shows a way to parametrise a line using the method suggested by Rahul Narain in a comment, i.e. using Fourier to approximate the data with a set of sinusoids. I use Rationalize to convert all the reals back to rationals, this isn't necessary but it makes the expression look more like those used in Wolfram Alpha.
param[x_, m_, t_] := Module[{f, n = Length[x], nf},
  f = Chop[Fourier[x]][[;; Ceiling[Length[x]/2]]];
  nf = Length[f];
  Total[Rationalize[
     2 Abs[f]/Sqrt[n] Sin[Pi/2 - Arg[f] + 2. Pi Range[0, nf - 1] t], .01][[;; Min[m, nf]]]]]

tocurve[Line[data_], m_, t_] := param[#, m, t] & /@ Transpose[data]
tocurve will take a Line, a number of modes m and a symbolic parameter t and return a parametrisation of the line data. Because of the implied periodicity of the data in Fourier it will only work properly on closed lines.
The hard part is getting a good set of lines from the image of a person. Here's a much simpler example using ListContourPlot to extract the outline of a silhouette.
First load an image and do a bit of preprocessing to ensure a nice contour:
img = Import[
   "http://catclipart.org/wp-content/uploads/2012/11/elephant-silhouette-clip-art.gif"];

img = Binarize[img~ColorConvert~"Grayscale"~ImageResize~500~Blur~3]~Blur~3;
enter image description here
Now extract contours and plot the parametrised curve with 500 modes:
lines = Cases[Normal@ListContourPlot[Reverse@ImageData[img], Contours -> {0.5}], _Line, -1];

ParametricPlot[Evaluate[tocurve[#, 500, t] & /@ lines], {t, 0, 1}, Frame -> True, Axes -> False]
enter image description here
With fewer modes the detail starts to smooth out. Here's the 30 mode curve:
enter image description here
The parametrisation consists of sinusoids:
curves // Short
enter image description here
shareimprove this answer

    
That is pretty impressing! May I ask where curves comes from? –  Stefan Jan 28 '13 at 18:26
up vote 9 down vote
This was supposed to be a comment to Simon's answer, but it's gotten too long. Still, I wanted to share a somewhat cleaned-up version of Simon's Fourier-fitting function param[] (which I have renamed to FourierCurve[]):
FourierCurve[x_, m_, t_, tol_: 0.01] := Module[{rat = Rationalize[#, tol] &, fc},
  fc = Take[Chop[Fourier[x, FourierParameters -> {-1, 1}]], Min[m, Ceiling[Length[x]/2]]];
  2 rat[Abs[fc]].Cos[Pi (2 Range[0, Length[fc] - 1] t - rat[Arg[fc]/Pi])]]
This has the virtue of returning a function that genuinely closes up; more precisely, if f[t_] = FourierCurve[pts, modes, t], then f[0] == f[1]. (The indiscriminate use of Rationalize[] in the earlier version prevented a nice closure of the resulting curve.)
As Rahul alludes to in his comment, this is more or less the "epicycle" approach of Ptolemy for determining the paths of planetary orbits.
Of course, Fourier fitting can also be applied to space curves as well as plane curves. Here's an example:
{f[t_], g[t_], h[t_]} = FourierCurve[#, 20, t] & /@
                        KnotData["FigureEight", "SpaceCurve"]["ValuesOnGrid"];

ParametricPlot3D[{f[t], g[t], h[t]}, {t, 0, 1}, Axes -> None, Boxed -> False,
                 Method -> {"TubePoints" -> 20}, PlotStyle -> Blue, ViewPoint -> Top] /. 
Line[pts_, rest___] :> Tube[pts, 1/8, rest]
figure-eight knot
Since most of the knots given in KnotData[] have their space curves given as InterpolatingFunction[] objects, you can use this approach if you prefer to have explicit parametric expressions for those knots.
shareimprove this answer

1  
(This isn't yet my official return; I found some spare time and decided to exploit it.) –  Ｊ. Ｍ. Feb 7 '13 at 2:53
    
Spare time is hard to come by sometimes... I'll find some one day and come back to evaluating and accepting one of these answers –  Simon Apr 22 '13 at 10:35

Your Answer












 
By posting your answer, you agree to the privacy policy and terms of service.

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

Publicado por en

No hay comentarios:

Publicar un comentario

Suscribirse a: Enviar comentarios (Atom)