Fill the gap when plotting surfaces

Question

I would like to plot the intersection between the surface $z=-\frac{y}{2}+1$ and the surface $z=\sqrt{1-x^{2}}$.

This is what I tried:

A1 := ParametricPlot3D[{Sqrt[1 - z^2], y, z}, {y, 0, 2}, {z, 
    0, -y/2 + 1}, PlotStyle -> {Red}, PlotStyle -> Thickness[0.02], 
   AxesStyle -> Thick, Boxed -> False, AxesOrigin -> {0, 0, 0}, 
   AxesLabel -> {x, y, z}];
A2 := ParametricPlot3D[{-Sqrt[1 - z^2], y, z}, {y, 0, 2}, {z, 
    0, -y/2 + 1}, PlotStyle -> {Red}, PlotStyle -> Thickness[0.02], 
   AxesStyle -> Thick, Boxed -> False, AxesOrigin -> {0, 0, 0}, 
   AxesLabel -> {x, y, z}];
A3 := ParametricPlot3D[{x, y, -y/2 + 1}, {y, 0, 
    2}, {x, -Sqrt[y - y^2/4], Sqrt[y - y^2/4]}, PlotStyle -> {Blue}, 
   PlotStyle -> Thickness[0.02], AxesStyle -> Thick, Boxed -> False, 
   AxesOrigin -> {0, 0, 0}, AxesLabel -> {x, y, z}];
Show[A1, A2, A3]

Here is the picture:

My question: how can we remove the white gap shown in the picture?

Thanks for any hint.

Answer 1

The OP's solution is doing too much work. In fact, this picture can be generated with a single Plot3D[] call, through the judicious use of Min[] and a straightforward ColorFunction construction:

Plot3D[Min[Sqrt[1 - x^2], 1 - y/2], {x, -1, 1}, {y, 0, 2}, 
       ColorFunction -> Function[{x, y, z}, If[(1 - y/2)^2 < 1 - x^2, Blue, Red]], 
       ColorFunctionScaling -> False, Exclusions -> None, PlotPoints -> 75]

Answer 2

Here's a way, but you lose the misaligned mesh lines:

A1 = ParametricPlot3D[{Sqrt[1 - z^2], y, z}, {y, 0, 2}, {z, 
    0, -y/2 + 1}, PlotStyle -> {Red}, PlotStyle -> Thickness[0.02], 
   AxesStyle -> Thick, Boxed -> False, AxesOrigin -> {0, 0, 0}, 
   AxesLabel -> {x, y, z}, Mesh -> None, BoundaryStyle -> Green];
A2 = ParametricPlot3D[{-Sqrt[1 - z^2], y, z}, {y, 0, 2}, {z, 
    0, -y/2 + 1}, PlotStyle -> {Red}, PlotStyle -> Thickness[0.02], 
   AxesStyle -> Thick, Boxed -> False, AxesOrigin -> {0, 0, 0}, 
   AxesLabel -> {x, y, z}, Mesh -> None, BoundaryStyle -> Green];
boundaryPoints = Join[
   First@Cases[Normal@A1,
     Line[p_] :> DeleteCases[p,
       {x_Real, y_Real, z_Real} /;
        (z == 0 && y != 2) || (y == 0 && z != 0 && z != 1)],
     Infinity],
   Reverse@First@Cases[Normal@A2,
      Line[p_] :> DeleteCases[p,
        {x_Real, y_Real, z_Real} /;
         (z == 0 && y != 2) || (y == 0 && z != 0 && z != 1)],
      Infinity]
   ];
Show[
 DeleteCases[A1, _Line, Infinity],  (* remove green boundary *)
 DeleteCases[A2, _Line, Infinity],
 Graphics3D[{Blue, Polygon@boundaryPoints}]
 ]

Here's a way to get the meshes aligned:

A1 = ParametricPlot3D[{Sqrt[1 - z^2], y, z}, {y, 0, 2}, {z, 
    0, -y/2 + 1}, PlotStyle -> {Red}, PlotStyle -> Thickness[0.02], 
   AxesStyle -> Thick, Boxed -> False, AxesOrigin -> {0, 0, 0}, 
   AxesLabel -> {x, y, z}, Mesh -> None, BoundaryStyle -> Green];
ypts = Cases[Normal@A1,
     Line[p_] :> DeleteCases[p,
       {x_Real, y_Real, z_Real} /;
        (z == 0 && y != 2) || (y == 0 && z != 0 && z != 1)],
     Infinity][[1, All, 2]] // DeleteDuplicates;
mf = {#2 &, #3 &};
mesh = {Subdivide[-2, 2, 21], Subdivide[0, 1, 11]};
A3 = ListPlot3D[Flatten[Table[
     Table[{x, y, -y/2 + 1},
      {x, 
       Subdivide[-Sqrt[y - y^2/4], Sqrt[y - y^2/4], 
        Sqrt[y - y^2/4]/16 /. {dx_ /; dx == 0 :> 1, _ -> 10}]}],
     {y, ypts}], 1],
   PlotStyle -> {Blue}, PlotStyle -> Thickness[0.02], 
   AxesStyle -> Thick, AxesOrigin -> {0, 0, 0}, AxesLabel -> {x, y, z},
   MeshFunctions -> {#1 &, #2 &}, 
   Mesh -> {Join[-#, #] &@Sqrt[1 - Last@mesh^2], First@mesh}];
A1 = ParametricPlot3D[{Sqrt[1 - z^2], y, z}, {y, 0, 2}, {z, 
    0, -y/2 + 1}, PlotStyle -> {Red}, PlotStyle -> Thickness[0.02], 
   AxesStyle -> Thick, Boxed -> False, AxesOrigin -> {0, 0, 0}, 
   AxesLabel -> {x, y, z},
   MeshFunctions -> {#2 &, #3 &}, Mesh -> mesh];

Show[
 A1,
 A1 /.    (* reflect A1 and its VertexNormals *)
  GraphicsComplex[p_, g_, opts___] :> 
   GraphicsComplex[p.DiagonalMatrix[{-1, 1, 1}], 
    g, {opts} /. 
     HoldPattern[VertexNormals -> v_] :> 
      VertexNormals -> v.DiagonalMatrix[-{-1, 1, 1}]],
 A3]

Answer 3

ClearAll[fa, fb, fc]
fa[x_] := -x/2 + 1
fb[x_] := Sqrt[1 - x^2]
fc[x_] := Sqrt[x - x^2/4];

1. You can generate the two red surfaces using a single ParametricPlot3D.
2. You can use the option RegionFunction instead of making the range of the second parameter depend on the value of the first parameter.

p1 = ParametricPlot3D[{{fb[y], x, y}, {- fb[y], x, y}}, {x, 0, 2}, {y, 0, 1}, 
   PlotStyle -> Red, AxesLabel -> {x, y, z},
   AxesStyle -> Thick, Boxed -> False, AxesOrigin -> {0, 0, 0}, 
   RegionFunction -> (0 < #3 <= fa[#2] &)];

p2 = ParametricPlot3D[{y, x, fa[x]}, {x, 0, 2}, {y, -1, 1}, 
   PlotStyle -> Blue, 
   RegionFunction -> (-fc[#2] <= # <= fc[#2] &)];

Show[p1, p2, ImageSize -> Large]