Projection of a 3d curve to 2d

Question

This question is related to:

How to obtain the coordinates of the intersection line of two surfaces?

Read the link first.

First, I have tried MaxCellMeasure->0.5, MaxCellMeasure->{"Length"->0.5} and MaxCellMeasure->{"Area"->0.5}, and change the number 0.5. It seems that the numbers of point doesn't change.

Secondly, it's very fast to run your code, but it takes about minutes to run my code with my f[x,y,z], g[x,y,z]. And this is my code:

Clear[f,g];
f[x_,y_,z_,t_]:=x^2+y^2+(z-1)^2-t^2/4;
g[x_,y_,z_]:=Piecewise[{{(x-1/2)^2+y^2+z^2-1/16,(x-1/2)^2+y^2-1/16<=0&&z>=0}},z];
reg=DiscretizeRegion[ImplicitRegion[{f[x,y,z,2]==0, g[x, y, z] == 0}, {x, y, z}]];
MeshCoordinates[reg]

Is it because I used Piecewise in g function that it needs more time to run the code?

Third, what I want to do next is below. In fact, I want to plot the projection of the intersection line on xy plane. And this is point projection, as shown below

Connect (0,0,1) and one point on the intersection line, extend it to intersect with xy plane. The yellow pint is want I am looking for. Repeat this for all points on the intersection line, then I can get a closed curve on xy plane. And I need to plot the curve in a 2-dimensional figure, instead of three-dimensional figure here.(I don't want to use Plot3D+Viewpoint to show a 2d curve in 3d coordinate, because the exported pdf file will be large.) I can calculate the yellow points' coordinate (x',y') based on (x,y,z) of red points on the intersection line. x'=x/(1-z),y'=y(1-z). But how to achieve this?

Or maybe I should use another way: use ParametricPlot

ParametricPlot[{x/(1-z),y/(1-z)},{x,y,z}] and x,y,z satisfy f[x,y,z]==g[x,y,z]

Answer 1

It actually takes me a fraction of a second to run your code (version 10.4 on OS X 10.11.4).

You can use MaxCellMeasure to get more points:

Length@MeshCoordinates@
     DiscretizeRegion[
      ImplicitRegion[{f[x, y, z, 2] == 0, g[x, y, z] == 0}, {x, y, 
        z}], MaxCellMeasure -> {"Length" -> #}] & /@ {0.1, 0.05, 0.005} // AbsoluteTiming
(* {0.368696, {76, 101, 965}} *)

One way to achieve the projection is to use ScalingTransform:

curve = MeshCoordinates[reg];
center = {0, 0, 1};
proj = ScalingTransform[{1, 1, 1}/(1 - #[[3]]), center][#] & /@ curve;
Graphics3D[{Point@curve, Blue,Point@proj, Red, PointSize[Large], Point[{0, 0, 1}]}]

If you want to plot the points in 2D, you can sort the list by the closest neighbor and then plot

ls = proj;
pt = proj[[1]];

line = Prepend[Table[
    ls = DeleteCases[ls, pt];
    pt = First@Nearest[ls, pt],
    {n, 1, Length@ls - 1}
    ], pt];

Graphics[Line@line[[All, 1 ;; 2]], PlotRange -> All]