5
$\begingroup$

given a Bézier surface, is there a simple way to express $g_{12}$ (from the First fundamental form) again in Bézier form?

More precisely, I have control points and a Bézier function $f$:

cps = {{{0, 0}, {.5, .36}, {1, 0}},
{{.4, .37}, {.6, .3}, {.6, .42}},
{{0, 1}, {.45, .46}, {1, 1}}};
f = BezierFunction[cps];

I can compute $g_{12}$

g12 = D[f[u, v], u].D[f[u, v], v];

Since $g_{12}$ is a polynomial in $u$ and $v$, there is surely a way to express it as a Bézier function. Can I get the corresponding control points in some easy way from this representation? Or do I have to teach Mathematica what are the control points of $\frac{\partial f}{\partial u}$, of $\frac{\partial f}{\partial v}$, and what to do with them to get my result?

Thanks in advance for recommendations!

$\endgroup$
4
$\begingroup$

The operation is surprisingly nontrivial, so I'm putting it out here for reference.

The idea is to work with explicit BernsteinBasis[] expansions and then do a few algebraic manipulations. To wit:

expr = Fold[Dot, #, {Table[BernsteinBasis[2, k, v], {k, 0, 2}],
                     Table[BernsteinBasis[2, k, u], {k, 0, 2}]}] & /@ 
       Transpose[cps, {2, 3, 1}]

yields the explicit basis expansion. Now, compute the required derivative:

dd = D[expr, u].D[expr, v] // Expand;

A look at the (long!) explicit expression reveals that the function does not yet have the compatible basis functions being combined. We thus need to do a few replacements:

ddn = Chop[dd //.
Times[a_., BernsteinBasis[n1_, k1_, u_], c_., BernsteinBasis[n2_, k2_, u_]] :> 
Times[a, c, Binomial[n1, k1], Binomial[n2, k2],
      BernsteinBasis[n1 + n2, k1 + k2, u]]/Binomial[n1 + n2, k1 + k2]];

Now, the (messy!) control point extraction:

ccp = (Function[b, Coefficient[#, b]] /@ Table[BernsteinBasis[3, k, v], {k, 0, 3}]) & /@
      (Coefficient[ddn, #] & /@ Table[BernsteinBasis[3, k, u], {k, 0, 3}])
   {{1.3328, 0.1648, 0.125867, -1.4048},
    {0.18, -0.122667, -0.0462222, 0.122667},
    {-0.357333, 0.249333, -0.0915556, 0.194667},
    {-2.0808, -0.250133, -0.1672, 2.1328}}

This can now be fed to BezierFunction[]:

nbf = BezierFunction[Map[List, ccp, {2}]];

Compare this with the usual derivative expression:

Plot3D[First[nbf[u, v]] - Derivative[1, 0][f][u, v].Derivative[0, 1][f][u, v],
       {u, 0, 1}, {v, 0, 1}, PlotRange -> All]

difference

and we see that the difference is on the order of roundoff.

$\endgroup$
  • $\begingroup$ It's been over two weeks and I am still flabbergasted that someone took the effort of thoroughly answering such an old question. Thank you! However, I cannot accept it before trying it out and that will take some time, as I don't possess any Mathematica license at the moment. $\endgroup$ – Dominik Mokriš Oct 12 '18 at 19:53
  • $\begingroup$ That is fine. ;) This seems to have been asked during one of my hiatuses, so I had missed it. $\endgroup$ – J. M. is away Oct 12 '18 at 20:35
  • $\begingroup$ On Thursday I checked it on my friend's computer and it seems that you are right. Thanks again for the answer! $\endgroup$ – Dominik Mokriš Dec 12 '18 at 21:03

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.