2
$\begingroup$

Some Graphics in Mathematica could also be described by functions, in particular by ParametricPlots. For example, take this figure of a 'house' with a round 'roof'.

Graphics[{
    Line[{{-1,0},{-1,-1},{1,-1},{1,0}}],
    Circle[{0,0},1,{0,Pi}]
}]

Simple Graphics

Turning this manually into parametric functions gives:

Manipulate[
    ParametricPlot[
        Piecewise[{
            {{-1,-(tt-0)},0<=tt<1},
            {{-1+2(tt-1),-1},1<=tt<2},
            {{1,-1+(tt-2)},2<=tt<3},
            {{Cos[Pi(tt-3)],Sin[Pi(tt-3)]},3<=tt<4}
        }],
    {tt,0,t},Axes->False],
{{t,4},0,4}]

Moving ParametricPlot

Is it possible to generate a (possibly Piecewise) parametric function which may be drawn using ParametricPlot automatically based on Graphics as input?

Background: imagine using Mathematica to export G-code for CNC laser engraving or cutting while giving you control over the order, direction and speed of each segment, and allowing you to verify the behaviour of your CNC before printing. Note that exporting an SVG will not give you control over direction nor speed.

$\endgroup$
  • $\begingroup$ Per the GIF, you can export it with "AnimationRepetitions"->Infinity as an option and it'll repeat indefinitely. $\endgroup$ – b3m2a1 May 22 '19 at 17:23
  • $\begingroup$ Going to i.stack.imgur.com/QbMbE.gif shows me a GIF which loops indefinitely. As does the GIF I created locally. I think it's a browser thing. Though I could be wrong. Can't be bothered generating it again ;) thanks though. $\endgroup$ – LBogaardt May 22 '19 at 17:29
  • 1
    $\begingroup$ the imgur one only loops twice. That’s Mathematica’s default. $\endgroup$ – b3m2a1 May 22 '19 at 17:34
  • $\begingroup$ Ah, indeed. Thanks! Any idea how to generate GIFs which only run Forward, and then return to the start? $\endgroup$ – LBogaardt May 22 '19 at 19:57
  • $\begingroup$ Try Export[..., Manipulate[..., AnimationDirection -> Forward], "AnimationRepetitions"->Infinity] $\endgroup$ – b3m2a1 May 22 '19 at 20:49
1
$\begingroup$
ClearAll[toParametricLines]
toParametricLines[mcm_: .1][g_Graphics] := Module[{bsfs = 
    MeshPrimitives[DiscretizeGraphics[g, MaxCellMeasure -> {"Length" -> mcm}], 1] /. 
      Line -> (BSplineFunction[#, SplineDegree -> 1] &)}, 
  ParametricPlot[Through@bsfs@t, {t, 0, 1}]]

Examples:

g1 = Graphics[{Line[{{-1, 0}, {-1, -1}, {1, -1}, {1, 0}}], Circle[{0, 0}, 1, {0, Pi}]}];
toParametricLines[][g1]

enter image description here

SeedRandom[1]
g2 = Graphics[{RandomColor[], BezierCurve @ #} & /@ RandomReal[1, {10, 4, 2}]]

enter image description here

Show[toParametricLines[][g2], Axes -> False]

enter image description here

Update: For the case of a single closed curve, we can get a single BSplineFunction (as opposed to one function for each Line object returned by MeshPrimitives[...]) using

ClearAll[toParametricLines2]
toParametricLines2[mcm_: .1][g_Graphics] := Module[{bsf = 
     MeshPrimitives[DiscretizeGraphics[g, MaxCellMeasure -> {"Length" -> mcm}], 1] /. 

      l : {__Line} :> BSplineFunction[Join @@ l[[All, 1]], SplineDegree -> 1] }, 
    ParametricPlot[bsf@t, {t, 0, 1}]]

toParametricLines2[][g1]

same as the first picture above

$\endgroup$
  • 1
    $\begingroup$ Presumably there is only one cutting tool, so there should only be one BSplineFunction. $\endgroup$ – Carl Woll May 22 '19 at 15:33
  • $\begingroup$ @Carl, right; good point. To get a single BSplineFunction for all the Line primitives returned by MeshPrimitives[...] we need an additional step to combine the coordinates in the correct order. $\endgroup$ – kglr May 22 '19 at 15:43
  • $\begingroup$ You're basically approximating the original Graphic with a set of points and then interpolating those points. Cool idea. And definitely appropriate for any CNC task, as long as the approximation-resolution is higher than the CNC machine's resolution. $\endgroup$ – LBogaardt May 22 '19 at 17:23
  • $\begingroup$ Nonetheless, I would have hoped there was a more fundamental way to 'explode' a Graphic and adapt the internal Mathematica code to a parametric function. For example, a Line[{{a,b},{c,d}}] must refer to some internal plot-function which takes a,b,c,d as input arguments (I assume). $\endgroup$ – LBogaardt May 22 '19 at 17:27
  • 1
    $\begingroup$ I now see InputForm[ParametricPlot[{Cos[t], Sin[t]}, {t, 0, Pi}]] yields a Graphic with a Line with many points, similar to your approximation. So to Mathematica, a Plot internally is a Graphic and a Graphic is not internally a Plot, as I first assumed (see reference.wolfram.com/language/tutorial/…) $\endgroup$ – LBogaardt May 23 '19 at 11:32
0
$\begingroup$

I wrote a function which takes Graphics as input and outputs a Piecewise parametric function by replacing the Head. The list of implemented Graphics types can easily be extended.

graphicsToParametricFunctions::grphtp="Unknown graphics type: `1`";
graphicsToParametricFunctions=Function[{graphics},Module[{line=Function[{pointPairs,t},With[{len=Length[pointPairs]},Piecewise[MapIndexed[{{((#2[[1]]-len t))#1[[1,1]]+(1+len t-#2[[1]])#1[[2,1]],(#2[[1]]-len t)#1[[1,2]]+(1+len t-#2[[1]])#1[[2,2]]},(#2[[1]]-1)/len<t<#2[[1]]/len}&,pointPairs]]]]},Module[{rules={Line[args__/;Depth[args]==3]:>Function[{t},line[Subsequences[args,{2}],t]],Line[args__/;Depth[args]==4]:>Function[{t},line[Flatten[Map[Subsequences[#,{2}]&,args],1],t]],Circle[{centerx__,centery__},radius__,{arc1__,arc2__}]:>Function[{t},{centerx+radius Cos[(1-t) arc1+t arc2],centery+radius Sin[(1-t) arc1+t arc2]}],BezierCurve[args__]:>Function[{t},Map[BernsteinBasis[Length[args]-1,#,t]&,Range[0,Length[args]-1]].args]}},Function[{t},Evaluate[PiecewiseExpand[Piecewise[MapIndexed[If[AnyTrue[Keys[rules],Function[{rule},MatchQ[#1,rule]]],{Replace[#1,rules][t-#2[[1]]+1],#2[[1]]-1<t<#2[[1]]},Message[graphicsToParametricFunctions::grphtp,#1]]&,Flatten[Level[graphics,1]]]]]]]]]];

Case 1

Two different types of Graphics which are attached, shaped as a house.

houseGraphic=Graphics[{Line[{{-1,0},{-1,-1},{1,-1},{1,0}}],Circle[{0,0},1,{0,Pi}]}]

Graphic of a house

houseParametricFunction = graphicsToParametricFunctions[houseGraphic]

Piecewise of a house

Manipulate[Show[ParametricPlot[houseParametricFunction[tt],{tt,0,t}],PlotRange->{{-1,1},{-1,1}},ImageSize->220,Axes->False],{t,0,2,0.1}]

GIF of a house

Case 2

Two Lines which are separate.

twoLinesGraphic=Graphics[{Line[{{{-1,1},{-1,-1},{1,-1},{1,1},{-1,1}},{{-1/2,1/2},{-1/2,-1/2},{1/2,-1/2},{1/2,1/2},{-1/2,1/2}}}]}]

Graphic of two squares

twoLinesParametricFunction=graphicsToParametricFunctions[twoLinesGraphic]

Piecewise of two squares

Manipulate[Show[ParametricPlot[twoLinesParametricFunction[tt],{tt,0,t}],PlotRange->{{-1,1},{-1,1}},ImageSize->220,Axes->False],{t,0,1,0.05}]

GIF of two squares

Case 3

Random BezierCurves.

SeedRandom[1]
bezierGraphic=Graphics[Map[BezierCurve[#]&,RandomReal[1,{10,4,2}]]];

Graphic of random Beziers

bezierParametricFunction=graphicsToParametricFunctions[bezierGraphic]

Piecewise of random Beziers

Manipulate[Show[ParametricPlot[bezierParametricFunction[tt],{tt,0,t}],PlotRange->{{0,1},{0,1}},ImageSize->220,Axes->False],{t,0,10,0.5}]

GIF of random Beziers

Case 4

Not implemented Graphics type.

graphicsToParametricFunctions[Graphics[Disk[]]]

Screenshot of an error

$\endgroup$

Your Answer

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

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