1

There are a lot of applications that you make a glyph from a scanned image. Mathematica does have fine tools to interpolate curves like the BezierCurve[] function. The idea is very simple. Given the group of 2D points (the data), you calculate the corresponding control points (the pts) using some algorithm (for an example, please see the documentation for BezierCurve[] function). My question is the following:

  • Is it possible to make a function f that converts the contour of a closed image to a set of points 2D (the data), finds the corresponding control points pts (and saves the resulting glyph to an appropriate format like eps)?

For experiments you could use the following simple line. (I guess that f depends on an additional parameter $n$ for the maximum number of points allowed in data. If $n$ is very big like $n=1000$ the output glyph should be perfect but then it is very difficult to calculate the data. So the value of $n$ should be small like up to N= 100 or up to $n=50$ different 2D points in data...)

enter image description here

xyz
  • 605
  • 4
  • 38
  • 117
kornaros
  • 1,047
  • 5
  • 14

1 Answers1

2

I am going to copy-paste Simon Wood's answer of How to create a new “person curve”?

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]


img = Import["https://i.stack.imgur.com/GhK3X.png"];

ires = 500; (*Image size to work with*)
img = Binarize[img~ColorConvert~"Grayscale"~ImageResize~ires~Blur~3]~ Blur~3;
lines = Cases[Normal@ListContourPlot[Reverse@ImageData[img], 
              Contours -> {0.5}], _Line, -1];

f[t_] = tocurve[#, 20, t] & /@ lines;
ParametricPlot[f[t], {t, 0, 1}, Frame -> True, Axes -> False, AspectRatio -> .3]

enter image description here

For complicated curves f[t] might be a collection of functions. The second index of tocurve is the N you are looking for.

To plot it in a different way,

Graphics[Polygon[Table[f[t][[1]], {t, 0, 1, 0.01}]]]

enter image description here

Which is much closer to what we start from.

Community
  • 1
Sumit
  • 15,912
  • 2
  • 31
  • 73
  • Thanks for the editing. I try to change tocurve[#, 20, t] to other value like tocurve[#, 10, t] without much success I will try some other ideas from http://mathematica.stackexchange.com/questions/637/character-edge-finding I haven't finished yet but I hope I will have an alternative answer. +1 for your answer! – kornaros Jun 07 '16 at 11:57
  • You can try increasing the value like 200 or higher. – Sumit Jun 07 '16 at 12:09
  • @SumitΙ have already done! The results are the same... Have you tried this? – kornaros Jun 07 '16 at 12:12
  • my bad, I didn't put the definition of tocurve in my answer. Sorry for that. It will work now. Use bigger image size (ires) along with the argument of tocurve if you want more points. – Sumit Jun 07 '16 at 12:20