-1

I have the given letter below. I want to draw it geometrically by using trigonometry and other formulas.Help me draw the letter OR give me the idea to draw the letter of any language using formulas. Just like O,P,G..etc.,. enter image description here

enter image description here

Muthu Kumar
  • 41
  • 5
  • Is this related to Mathematica ? Or are you asking just for thecmathematics behind it ? – Sektor Aug 13 '15 at 06:05
  • 1
    Figure out a way to find the shape on the critical strip of the Riemann zeta, encode that, done. Win Fields medal along the way. Otherwise, look into perhaps getting some trig series based on Fourier machinations on the shape. Else, segment it and use compositions of splines/beziers... – ciao Aug 13 '15 at 06:06
  • Ya thank for your reply. Please give me the basic commands or basic code for any letter in mathematica – Muthu Kumar Aug 13 '15 at 06:11
  • FromCharacterCode@2949 - Very fast, no math! – ciao Aug 13 '15 at 06:24
  • 2
    I wonder ... No, I better don't – Dr. belisarius Aug 13 '15 at 06:31

1 Answers1

2

You should be able to use the code here:

Making Formulas… for Everything—From Pi to the Pink Panther to Sir Isaac Newton

See the function, pointsListToLines, a third of the way down the page.

Here is a copy of the code from the CDF:

pointListToLines[pointList_, neighborhoodSize_: 6] := 
 Module[{L = DeleteDuplicates[pointList], NF, \[Lambda], lineBag, 
   counter, seenQ, sLB, nearest,  
               nearest1, nextPoint, 
   couldReverseQ,  \[ScriptD], \[ScriptN], \[ScriptS]},
  NF = Nearest[L] ;
       \[Lambda] = Length[L];
  Monitor[
   (* list of segments *)
   lineBag = {};
   counter = 0; 
   While[counter < \[Lambda],
    (* new segment *)

    sLB = {RandomChoice[DeleteCases[L, _?seenQ]]}; 
    seenQ[sLB[[1]]] = True;
    counter++;
    couldReverseQ = True;
    (* complete segment *)

    While[(nearest = NF[Last[sLB], {Infinity, neighborhoodSize}];

      nearest1 = 
       SortBy[DeleteCases[nearest, _?seenQ], 
        1. EuclideanDistance[Last[sLB], #] &];
                 nearest1 =!= {} || couldReverseQ),
                  If[nearest1 === {},
                   (* extend the other end; 
      penalize sharp edges *)
                   sLB = Reverse[sLB]; 
      couldReverseQ = False,
                  (* 
      prefer straight continuation *)

      nextPoint = If[Length[sLB] <= 3, nearest1[[1]],
                                                 \[ScriptD] = 
         1. Normalize[(sLB[[-1]] - sLB[[-2]]) + 
            1/2 (sLB[[-2]] - sLB[[-3]])];
                                                 \[ScriptN] = {-1, 
           1} Reverse[\[ScriptD]];
                                                \[ScriptS] = 
         Sort[{Sqrt[(\[ScriptD].(# - sLB[[-1]]))^2 + 
                                                                  \
    (* perpendicular *) 2 (\[ScriptN].(# - sLB[[-1]]))^2], # } & /@ 
           nearest1]; 
                                                \[ScriptS][[1, 2]]];
                   AppendTo[sLB, nextPoint];
                  seenQ[nextPoint] = True;
                 counter++ ]];
    AppendTo[lineBag, sLB]];
   (* return segments sorted by length *)

   Reverse[SortBy[Select[lineBag , Length[#] > 12 &], Length]],
   (* monitor progress *)

   Grid[{{Text[Style["progress point joining", Darker[Green, 0.66]]], 
      ProgressIndicator[counter/\[Lambda]]},
               {Text[
       Style["number of segments", Darker[Green, 0.66]]],  
      Length[lineBag] + 1}}, 
            Alignment -> Left, Dividers -> Center]]]
Chris Degnen
  • 30,927
  • 2
  • 54
  • 108