Mapping From Sphere Patches

I do not know why but something in me is telling me to map from sphere patches.

ParametricPlot3D[
{Cos[θ] Cos[ϕ],Sin[θ] Cos[ϕ], Sin[ϕ]},
{θ,0, 2π},
{ϕ, -π/2, π/2}]

Degenerate Bezier Stuff

The degenerate patches are VERY skinny when mapped forward.

n=3

n=3: All 3 Degenerate

Clear[p,B,λ1,λ2,λ3,n, expression]
n=3;
{p1,p2,p3}=Chop[Table[ {Cos[θ], Sin[θ]},{θ,2.π/3,2π, 2π/3}]];
p[3,0,0]=p[2,1,0]=p[2,0,1]=p1;
p[0,3,0]=p[1,2,0]=p[0,2,1]=p2;
p[0,0,3]=p[1,0,2]=p[0,1,2]=p3;
p[i_,j_,k_]={0,0};
expression=Sum[
k=n-i-j;
((n!)/(i! j! k!))p[i,j,k]  ((λ1)^i) ((λ2)^j)((λ3)^k),
{i,0,n},{j,0,n-i}];
p={0,0};
ParametricPlot[
λ3=1-λ1-λ2;
expression+ p λ1 λ2 λ3,
{λ1,0,1},
{λ2,0,1},
RegionFunction->Function[{x1,x2,λ1,λ2},λ1+λ2 <1],
PerformanceGoal->"Quality",
PlotRange->All
]

Normal[
Series[expression/.{λ1->x,λ2->y,λ3->1-x-y},{x,0,2},{y,0,2}]
]

n=3: Just One Degenerate.

Clear[p,B,λ1,λ2,λ3,n]
n=3;
{p1,p2,p3}=Chop[Table[ {Cos[θ], Sin[θ]},{θ,2.π/3,2π, 2π/3}]];
p[3,0,0]=p[2,1,0]=p[2,0,1]=p1;
p[0,3,0]=p2;
p[0,0,3]=p3;
p[i_,j_,k_]={0,0};
expression=Sum[
k=n-i-j;
((n!)/(i! j! k!))p[i,j,k]  ((λ1)^i) ((λ2)^j)((λ3)^k),
{i,0,n},{j,0,n-i}]
p={0,0};
ParametricPlot[
λ3=1-λ1-λ2;
expression+ p λ1 λ2 λ3,
{λ1,0,1},
{λ2,0,1},
RegionFunction->Function[{x1,x2,λ1,λ2},λ1+λ2 <1],
PerformanceGoal->"Quality",
Epilog->{Red, Point[p1]}
]

n=3: 2 Degenerate

Clear[p,B,λ1,λ2,λ3,n, expression]
n=3;
{p1,p2,p3}=Chop[Table[ {Cos[θ], Sin[θ]},{θ,2.π/3,2π, 2π/3}]];
p[3,0,0]=p[2,1,0]=p[2,0,1]=p1;
p[0,3,0]=p[1,2,0]=p[0,2,1]=p2;
p[0,0,3]=p3;
p[i_,j_,k_]={0,0};
expression=Sum[
k=n-i-j;
((n!)/(i! j! k!))p[i,j,k]  ((λ1)^i) ((λ2)^j)((λ3)^k),
{i,0,n},{j,0,n-i}];
p={0,0};
ParametricPlot[
λ3=1-λ1-λ2;
expression+ p λ1 λ2 λ3,
{λ1,0,1},
{λ2,0,1},
RegionFunction->Function[{x1,x2,λ1,λ2},λ1+λ2 <1],
PerformanceGoal->"Quality",
PlotRange->All,
Epilog->{Red, Map[Point,{p1,p2}]}
]

n=4

All 3 degenerate

Clear[p,B,λ1,λ2,λ3,n]
n=4;
{p1,p2,p3}=RandomReal[{0,1},{3,2}];
{p1,p2,p3}=Chop[Table[ {Cos[θ], Sin[θ]},{θ,2.π/3,2π, 2π/3}]];
p[4,0,0]=p[3,1,0]=p[3,0,1]=p1;
p[0,4,0]=p[1,3,0]=p[0,3,1]=p2;
p[0,0,4]=p[1,0,3]=p[0,1,3]=p3;
p[i_,j_,k_]={0,0};
expression=Sum[
k=n-i-j;
((n!)/(i! j! k!)) p[i,j,k]  ((λ1)^i) ((λ2)^j)((λ3)^k),
{i,0,n},{j,0,n-i}];
ParametricPlot[
λ3=1-λ1-λ2;
expression,
{λ1,0,1},
{λ2,0,1},
RegionFunction->Function[{x1,x2,λ1,λ2},λ1+λ2 <1],
PerformanceGoal->"Quality"
]

1 degenerate

Clear[p,B,λ1,λ2,λ3,n,p1,p2,p3]
n=4;
{p1,p2,p3}=RandomReal[{0,1},{3,2}];
{p1,p2,p3}=Chop[Table[ {Cos[θ], Sin[θ]},{θ,2.π/3,2π, 2π/3}]];
p[4,0,0]=p1;
p[0,4,0]=p2;
p[0,0,4]=p[0,1,3]=p[1,0,3]=p3;
p[i_,j_,k_]={0,0};
expression=Sum[
k=n-i-j;
((n!)/(i! j! k!)) p[i,j,k]  ((λ1)^i) ((λ2)^j)((λ3)^k),
{i,0,n},{j,0,n-i}];
ParametricPlot[
λ3=1-λ1-λ2;
expression,
{λ1,0,1},
{λ2,0,1},
RegionFunction->Function[{x1,x2,λ1,λ2},λ1+λ2 <1],
PerformanceGoal->"Quality",
AspectRatio->Automatic,
PlotRange->All,
Epilog->{Red, Point[p1]}
]

2 degenerate

Clear[p,B,λ1,λ2,λ3,n,p1,p2,p3]
n=4;
{p1,p2,p3}=RandomReal[{0,1},{3,2}];
{p1,p2,p3}=Chop[Table[ {Cos[θ], Sin[θ]},{θ,2.π/3,2π, 2π/3}]];
p[4,0,0]=p[3,1,0]=p[3,0,1]=p1;
p[0,4,0]=p2;
p[0,0,4]=p[0,1,3]=p[1,0,3]=p3;
p[i_,j_,k_]={0,0};
expression=Sum[
k=n-i-j;
((n!)/(i! j! k!)) p[i,j,k]  ((λ1)^i) ((λ2)^j)((λ3)^k),
{i,0,n},{j,0,n-i}];
ParametricPlot[
λ3=1-λ1-λ2;
expression,
{λ1,0,1},
{λ2,0,1},
RegionFunction->Function[{x1,x2,λ1,λ2},λ1+λ2 <1],
PerformanceGoal->"Quality",
AspectRatio->Automatic,
PlotRange->All,
Epilog->{Red, Point[p1]}
]

All 3 degenerate AGAIN

If I move the non-mixed points out to the edge I get a clean version again.  I guess that was obvious!  I have only a few control points left: p[2,1,1], p[1,2,1], and p[1,1,2]!  There are six parameters in there!

Clear[p,B,λ1,λ2,λ3,n]
n=4;
{p1,p2,p3}=Chop[Table[ {Cos[θ], Sin[θ]},{θ,2.π/3,2π, 2π/3}]];
p[4,0,0]=p[3,1,0]=p[3,0,1]=p1;
p[0,4,0]=p[1,3,0]=p[0,3,1]=p2;
p[0,0,4]=p[1,0,3]=p[0,1,3]=p3;
p[2,2,0]=(p1+p2)/2;
p[0,2,2]=(p2+p3)/2;
p[2,0,2]=(p1+p3)/2;
p[i_,j_,k_]={0,0}
expression=Sum[
k=n-i-j;
((n!)/(i! j! k!)) p[i,j,k]  ((λ1)^i) ((λ2)^j)((λ3)^k),
{i,0,n},{j,0,n-i}];
ParametricPlot[
λ3=1-λ1-λ2;
expression,
{λ1,0,1},
{λ2,0,1},
RegionFunction->Function[{x1,x2,λ1,λ2},λ1+λ2 <1],
PerformanceGoal->"Quality"
]

What can we do with the six parameters? Problem is that they are bubble elements.

Clear[p,B,λ1,λ2,λ3,n]
n=4;
{p1,p2,p3}=Chop[Table[ {Cos[θ], Sin[θ]},{θ,2.π/3,2π, 2π/3}]];
p[4,0,0]=p[3,1,0]=p[3,0,1]=p1;
p[0,4,0]=p[1,3,0]=p[0,3,1]=p2;
p[0,0,4]=p[1,0,3]=p[0,1,3]=p3;
p[2,2,0]=(p1+p2)/2;
p[0,2,2]=(p2+p3)/2;
p[2,0,2]=(p1+p3)/2;
expression=Sum[
k=n-i-j;
((n!)/(i! j! k!)) p[i,j,k]  ((λ1)^i) ((λ2)^j)((λ3)^k),
{i,0,n},{j,0,n-i}];

f[{x_,y_}]=x y (((1-x-y))^2);
df[{x_,y_}]=D[f[{x,y}],{{x,y}}];
GraphicsGrid[{{
Plot3D[ f[{x,y}],
{x,0,1},
{y,0,1},
RegionFunction->Function[{x,y,z}, x+y<1],
BoundaryStyle->Directive[Red,Thick]
],
StreamPlot[df[{x,y}],
{x,0,1},
{y,0,1},
RegionFunction->Function[{x,y,vx,vy,mag}, x+y<1],
BoundaryStyle->Directive[Red,Thick]
]
}
}]

All 3 degenerate (AGAIN^2)

If I move the non-mixed points out to the edge I get a clean version again.  I guess that was obvious!  I have only a few control points left: p[2,1,1], p[1,2,1], and p[1,1,2]!  There are six parameters in there!

Clear[p,B,λ1,λ2,λ3,n]
n=4;
{p1,p2,p3}=Chop[Table[ {Cos[θ], Sin[θ]},{θ,2.π/3,2π, 2π/3}]];
p[4,0,0]=p[3,1,0]=p[3,0,1]=p1;
p[0,4,0]=p[1,3,0]=p[0,3,1]=p2;
p[0,0,4]=p[1,0,3]=p[0,1,3]=p3;
Mul=1.9;
p[2,2,0]=Mul(p1+p2)/2;
p[0,2,2]=Mul(p2+p3)/2;
p[2,0,2]=1/Mul(p1+p3)/2;
p[i_,j_,k_]={0,0}
expression=Sum[
k=n-i-j;
((n!)/(i! j! k!)) p[i,j,k]  ((λ1)^i) ((λ2)^j)((λ3)^k),
{i,0,n},{j,0,n-i}];
ParametricPlot[
λ3=1-λ1-λ2;
expression,
{λ1,0,1},
{λ2,0,1},
RegionFunction->Function[{x1,x2,λ1,λ2},λ1+λ2 <1],
PerformanceGoal->"Quality",
Epilog->{
{Red,Text[1,p1],Text[2,p2],Text[3,p3]},
{Green,PointSize[0.02],Map[Point,{p[2,2,0],p[0,2,2],p[2,0,2]}]}
}
]

f[{λ1_,λ2_}]=Join[expression,{λ1 λ2}]/.λ3->1-λ1-λ2
g[{λ1_,λ2_}]=Join[expression,{0}]/.λ3->1-λ1-λ2
ParametricPlot3D[
{f[{λ1,λ2}],g[{λ1,λ2}]}, 
{λ1,0,1},
{λ2,0,2},
PlotPoints->78,
RegionFunction->Function[{x,y,z,λ1,λ2},λ1+λ2<1],
BoundaryStyle->{Red, Thick},
PerformanceGoal->"Quality",
BoxRatios->{1,1,0.5}
]

What can we do with the six parameters? Problem is that they are bubble elements.

Clear[p,B,λ1,λ2,λ3,n]
n=4;
{p1,p2,p3}=Chop[Table[ {Cos[θ], Sin[θ]},{θ,2.π/3,2π, 2π/3}]];
p[4,0,0]=p[3,1,0]=p[3,0,1]=p1;
p[0,4,0]=p[1,3,0]=p[0,3,1]=p2;
p[0,0,4]=p[1,0,3]=p[0,1,3]=p3;
p[2,2,0]=(p1+p2)/2;
p[0,2,2]=(p2+p3)/2;
p[2,0,2]=(p1+p3)/2;
expression=Sum[
k=n-i-j;
((n!)/(i! j! k!)) p[i,j,k]  ((λ1)^i) ((λ2)^j)((λ3)^k),
{i,0,n},{j,0,n-i}];

f[{x_,y_}]=x y (((1-x-y))^2);
df[{x_,y_}]=D[f[{x,y}],{{x,y}}];
GraphicsGrid[{{
Plot3D[ f[{x,y}],
{x,0,1},
{y,0,1},
RegionFunction->Function[{x,y,z}, x+y<1],
BoundaryStyle->Directive[Red,Thick]
],
StreamPlot[df[{x,y}],
{x,0,1},
{y,0,1},
RegionFunction->Function[{x,y,vx,vy,mag}, x+y<1],
BoundaryStyle->Directive[Red,Thick]
]
}
}]