1
$\begingroup$

I am trying to create a fourier drawing tool like this but am running into an iteration limit on larger images. Being quite new to mathematica, how could I go about fixing this / making the program more efficient?

Here is my code:

    img = Import["/DIR/PHOTO.png"]


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]

lines = Cases[Normal@ListContourPlot[Reverse@ImageData[img], Contours -> {0.5}], _Line, -1];

ParametricPlot[Evaluate[tocurve[#, 1, t] & /@ lines], {t, 0, 1}, Frame -> True, Axes -> False]

My errors are:

enter image description here enter image description here enter image description here enter image description here enter image description here

For reference, image is a human face with a black and white filter applied. There will obviously be a good deal of curves and what not, but how do I go about cleaning this up? Thanks for the help!

$\endgroup$

Your Answer

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

Browse other questions tagged or ask your own question.