4
$\begingroup$

Overall, I'm quite happy with my Lissajous Curves poster maker; however, getting the final touches of the graphics just right has been a challenge. I've tried two different ways of constraining equally the proportions between curves: 1) Force the plot label ratio above to one line and; 2) Tried to force the proportions of the using PlotRange. I don't suppose there are any Mathematica experts out there who would care to share some ways of improving this graphical function? (I'm hoping to do some really big plots using my free Mathematica online cloud credits.)

makeLcurves[cols_,rows_] := Module[{graphics, radius = 0.45},
 (* Subroutines *)
 functionX[anglevar_, freq_] := radius * Sin[freq anglevar];
 functionY[anglevar_, freq_] := radius * Cos[freq anglevar];
 (* Draw Graphics*)
  graphics = Table[
  ParametricPlot[{functionX[t,x],functionY[t,y]},{t,0,2 Pi },
  Frame->False,
  Axes->False,
  PlotStyle->Directive[Thick,Black],
  PlotRange->{{-.5,.5},{-.5,.5}},
  Mesh->Automatic,
  PerformanceGoal->"Speed",
  PlotLabel->TraditionalForm[x/y ],
  AspectRatio->1],
  {x,rows},{y,cols}
 ];
GraphicsGrid[graphics,
 Frame->All,
 ImageSize->800]
]

makeLcurves[6,6] // Rasterize

enter image description here

$\endgroup$
3
  • $\begingroup$ Write your labels along a single line, e.g., $3/2$. $\endgroup$ Commented Jan 14, 2019 at 3:09
  • $\begingroup$ Or use Beveled as an option to a FractionBox. Or use Pane to enforce a height. $\endgroup$
    – b3m2a1
    Commented Jan 14, 2019 at 3:18
  • 1
    $\begingroup$ Also PlotLabel -> Row[{x, "/", y}] $\endgroup$
    – Michael E2
    Commented Jan 14, 2019 at 3:48

4 Answers 4

4
$\begingroup$
PlotLabel -> ToString[x] <> "/" <> ToString[y],

enter image description here

$\endgroup$
4
$\begingroup$

Solution to the main question based on my comment; but colored according to the ratio of the coefficients of the trig functions that highlights the congruent curves, and a highly efficient computation of the curves based on complex arithmetic. For 6x6, it's several hundred times faster than ParametricPlot, but the prime motivation was I thought the complex-number approach was a cool alternative. (20x20 plot shown; takes ~0.015 sec.)

Block[{rows = 6, cols = 6, phase = Pi/2
  , zpts},
 zpts[n_] := 
  zpts[n] = 
   Exp[2 Pi I Subdivide[0., 1., 80*Max@NumeratorDenominator[n]]];
 Panel[
  Table[
    With[{rat = r/c, color = N@Min[r/c, c/r]},
     Graphics[
      {AbsoluteThickness[1], Hue[2 color, 1., 0.75],
       Line[Transpose@Im@{
           Exp[I*phase] zpts[rat]^Numerator[rat],
           zpts[rat]^Denominator[rat]}
        ]}
      , Background -> Hue[8/Pi*ArcTan[color], 0.08, 1.],
      PlotLabel -> Row[{r, "/", c}]
      ]
     ]
    , {r, rows}, {c, cols}] //
   Grid[#, Frame -> All, ItemSize -> 5] &, 
  Style["Lissajous Curves", Bold, 24, Black], Top,
  Background -> White
  ]
 ]
$\endgroup$
2
  • $\begingroup$ cool approach and color scheme $\endgroup$
    – ubpdqn
    Commented Dec 8 at 21:45
  • $\begingroup$ +1 Very nice and fastest approach! $\endgroup$ Commented Dec 9 at 0:27
3
$\begingroup$
func[r_, c_] := 
 Panel[Outer[
    ParametricPlot[{Cos[#1 t], Sin[#2 t]}, {t, 0, 2 Pi}, 
      Frame -> False, Axes -> False, 
      PlotLabel -> Row[{#1, ":", #2}]] &, Range[r], Range[c]] // 
   Grid[#, Frame -> All, ItemSize -> 5] &, 
  Style["Lissajous Curves", Bold, 24, Black]]

Examples:

Row[{func[2, 3], func[4, 4],func[6, 6]}]

enter image description here

$\endgroup$
1
$\begingroup$
Clear["Global`*"];
SeedRandom[0];
r = 0.45;

Array[
  ParametricPlot[
    {r  Sin[#1 \[Theta]], r Cos[#2 \[Theta]]}
    , {\[Theta], 0, 2 \[Pi]}
    , PlotLabel -> Row[{#1, "/", #2}]
    , PlotStyle -> {Thick}
    , ColorFunction -> "Rainbow"
    , Frame -> False
    , Axes -> False
    , ImageSize -> Tiny
    ] &
  , {6, 6}] //
 Labeled[
   Grid[#, Dividers -> All]
   , Style["Lissajous Curves", Bold, 24, Black]
   , Top] &

Lissajous curves using Mathematica

$\endgroup$
1
  • 1
    $\begingroup$ +1 Also: PlotLabel -> Inactive[Divide] @@ {#1, #2} $\endgroup$ Commented Dec 9 at 0:25

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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