2

With BSplineSurface, I was trying to interpolate data points belonging to a sphere, but unfortunately I don't get the right geometry closing:

r = 1;
step = 30 π /180 ;
pts = Table[
            r {Cos[Θ] Cos[Ψ], 
               Cos[Θ] Sin[Ψ], 
               Sin[Θ]},
            {Θ, 0, 2 π, step}, 
            {Ψ,   0,  π, step}
];
Graphics3D[{BSplineSurface[pts, SplineClosed -> {True, True}],
            Red, Point[#] & /@ pts}
]

my attempt

How can one get the right Spline-closing to get a sphere out of the interpolation?

J. M.'s missing motivation
  • 124,525
  • 11
  • 401
  • 574
N.Schl
  • 105
  • 5
  • 1
    So, what are your desiderata for your spline surface. As is, the question is way to broad. Btw.: "Nice" spline interpolation for surfaces with a topology different from a reactangle, cylinder, or torus are rather nontrivial. – Henrik Schumacher Jul 09 '18 at 15:51
  • I restrict myself to the sphere interpolation then first. Is it possible to get the "right" closing of the BSpline Surface to reproduce the sphere geometry? – N.Schl Jul 09 '18 at 17:03
  • 1
    Well, you get something that almost looks like a sphere with r = 1; step = 10 Pi/180; pts = Most@ Table[r {Cos[\[CapitalTheta]] Cos[\[CapitalPsi]], Cos[\[CapitalTheta]] Sin[\[CapitalPsi]], Sin[\[CapitalTheta]]}, {\[CapitalPsi], -Pi, Pi, step}, {\[CapitalTheta], -Pi/2, Pi/2, step}]; Graphics3D[{BSplineSurface[pts, SplineClosed -> {True, False}], Red, Point[#] & /@ pts}]. – Henrik Schumacher Jul 09 '18 at 17:49

1 Answers1

5

In fact, a sphere has a very simple NURBS representation. It can be easily built up from the NURBS circle of Piegl and Tiller. A Mathematica implementation goes like this:

mySphere[center : (_?VectorQ) : {0, 0, 0}, radius : _?NumericQ : 1] :=
  Block[{ctrlpts},
        ctrlpts = Composition[TranslationTransform[center],
                              ScalingTransform[ConstantArray[radius, 3]]] /@ 
        Outer[Append[#2 #1[[1]], #1[[2]]] &,
              {{0, -1}, {1, -1}, {1, 1}, {0, 1}},
              {{1, 0}, {1, 1}, {-1, 1}, {-1, 0}, {-1, -1}, {1, -1}, {1, 0}}, 1];
        BSplineSurface[ctrlpts, SplineClosed -> True, SplineDegree -> 2, 
                       SplineKnots -> {{0, 0, 0, 1/2, 1, 1, 1},
                                       {0, 0, 0, 1/4, 1/2, 1/2, 3/4, 1, 1, 1}}, 
                       SplineWeights -> Outer[Times, {1, 1/2, 1/2, 1},
                                              {1, 1/2, 1/2, 1, 1/2, 1/2, 1}]]]

For example:

Graphics3D[mySphere[], Boxed -> False]

NURBS sphere

(I had used this here for generating ellipsoids.)

J. M.'s missing motivation
  • 124,525
  • 11
  • 401
  • 574