In[]:=
(*Definetheparametricsurfacefunction*)ParametricSurface[u_,v_,shape_]:=Switch[shape,"sphere",{Sin[u]Cos[v],Sin[u]Sin[v],Cos[u]},"cone",Module[{k=1,r=u},{rCos[v],rSin[v],kr}],"paraboloid",Module[{r=u},{rCos[v],rSin[v],r^2}],_,Throw["Unknown shape: Choose 'sphere', 'cone', or 'paraboloid'"]];(*Definethestereographicprojectionfunction*)StereographicProjection[x_,y_,z_]:=If[1-z==0,Nothing,{x/(1-z),y/(1-z)}];(*Definetheinverseprojectionfunction*)InverseProjection[xProj_,yProj_,shape_]:=Module[{rProj=Sqrt[xProj^2+yProj^2]},Switch[shape,"sphere",Module[{denom=1+rProj^2},{(2xProj)/denom,(2yProj)/denom,(1-rProj^2)/denom}],"cone",{xProj,yProj,rProj},"paraboloid",{xProj,yProj,rProj^2},_,Throw["Unknown shape: Choose 'sphere', 'cone', or 'paraboloid'"]]];(*Selectshape*)shapeType="cone";(*Changethistotestdifferentshapes*)(*Generateaparametricsurface*)uRes=20;vRes=40;(*Reducedresolutionforbettergridvisibility*)u=If[shapeType=="sphere",Subdivide[0.01,Pi,uRes-1],Subdivide[0,1,uRes-1]];v=Subdivide[0,2Pi,vRes-1];(*CreatemeshgridusingTable*){uMesh,vMesh}=Transpose[Flatten[Table[{u[[i]],v[[j]]},{i,1,uRes},{j,1,vRes}],1]];(*Computeparametricsurface*){x,y,z}=Transpose[ParametricSurface@@@Transpose[{uMesh,vMesh,ConstantArray[shapeType,Length[uMesh]]}]];(*Applystereographicprojectionandfilterinvalidpoints*){xProjFiltered,yProjFiltered}=Transpose[DeleteCases[StereographicProjection@@@Transpose[{x,y,z}],Nothing]];(*Reconstructthesurfaceusinginverseprojection*){xRecon,yRecon,zRecon}=Transpose[InverseProjection@@@Transpose[{xProjFiltered,yProjFiltered,ConstantArray[shapeType,Length[xProjFiltered]]}]];(*Reshapereconstructedpointsinto2Darrays*){xRecon2D,yRecon2D,zRecon2D}=ArrayReshape[#,{uRes,vRes}]&/@{xRecon,yRecon,zRecon};(*Createfigurewith3subplots*)(*Finaloutput*)GraphicsRow[{(*Original3DSurface*)ParametricPlot3D[ParametricSurface[u,v,shapeType],{u,0.01,Pi},{v,0,2Pi},PlotStyle->Cyan,BoxRatios->{1,1,1},AxesLabel->{"X","Y","Z"},Mesh->All,PlotLabel->"Original 3D "<>ToUpperCase[shapeType]],(*2DProjection*)ListPlot[Transpose[{xProjFiltered,yProjFiltered}],PlotStyle->Blue,PlotRange->{{-5,5},{-5,5}},AspectRatio->1,AxesLabel->{"X'","Y'"},PlotLabel->"2D Projection (Holographic Encoding)"],(*Reconstructed3DSurface*)Graphics3D[{Red,Thick,Line[Table[Table[{xRecon2D[[i,j]],yRecon2D[[i,j]],zRecon2D[[i,j]]},{j,1,vRes}],{i,1,uRes}]],Line[Table[Table[{xRecon2D[[i,j]],yRecon2D[[i,j]],zRecon2D[[i,j]]},{i,1,uRes}],{j,1,vRes}]]},BoxRatios->{1,1,1},Axes->True,AxesLabel->{"X","Y","Z"},PlotLabel->"Reconstructed 3D "<>ToUpperCase[shapeType]]},ImageSize->Full]
Out[]=
