3
$\begingroup$

How can one write a function VolumeParametricPlot achieving the effect of a ParametricPlot3D with three parametrising variables, so as to create a plot of a volume rather than a surface?

As a simple example:

VolumeParametricPlot[
  {x,y,(x^2+y^2-1/6 y^3)+h},
  {x,-5,5},
  {y,-5,5},
  {h,-0.2,0.2}
]

enter image description here


Additional information:

RegionPlot3D won't work for the general problem, and is also quite slow because of its implementation. I am looking for something to behave in the same way as ParametricPlot3D, except with three parametrising variables instead of only two.

$\endgroup$
  • $\begingroup$ What about ParametricPlot3D[{x, y, (x^2 + y^2 - 1/6 y^3)}, {x, -5, 5}, {y, -5, 5}, BoxRatios -> {1, 1, 0.6}, PlotStyle -> Thickness[0.2]]? $\endgroup$ – J. M.'s technical difficulties May 6 at 12:02
  • $\begingroup$ and ParametricPlot3D[{x, y, (x^2 + y^2 - 1/6 y^3)}, {x, -5, 5}, {y, -5, 5}, BoxRatios -> 1, Extrusion -> .4]? $\endgroup$ – kglr May 6 at 12:31
  • $\begingroup$ I am looking for something to behave in the same way as ParametricPlot3D. $\endgroup$ – Myridium May 6 at 12:56
  • 1
    $\begingroup$ if speed is not an issue you can use ParametricRegion + DiscretizeRegion. E.g., parreg = ParametricRegion[{x, y, h + (x^2 + y^2 - 1/6 y^3)}, {{x, -5, 5}, {y, -5, 5}, {h, -1, 1}}]; DiscretizeRegion[parreg, Method -> {"MarchingCubes", PlotPoints -> 150}] $\endgroup$ – kglr May 6 at 13:52
  • 1
    $\begingroup$ @kglr - I can't get your example to run to completion. It crashes Mathematica. $\endgroup$ – Myridium May 19 at 6:00
3
$\begingroup$

You can post-process polygon primitives into polyhedra with the desired height:

ClearAll[toPolyhedron]
toPolyhedron[h_][p : Polygon[coords_, VertexColors -> colors_, ___]] :=
  Module[{prt = Partition[coords, 2, 1, 1], assoc = AssociationThread[coords, colors]}, 
    Join[Translate[p, {0, 0, # h/2}] & /@ {-1, 1}, 
     Polygon[Join @@ MapIndexed[TranslationTransform[{0, 0, (-1)^#2[[1]] h/2}] /@ # &, 
       {#, Reverse@#}], VertexColors -> assoc /@ Join[# , Reverse[#]]] & /@ prt]]

Examples:

pplt = ParametricPlot3D[{x, y, (x^2 + y^2 - 1/6 y^3)}, {x, -5, 5}, {y, -5, 5}, 
   Mesh -> None, BoxRatios -> 1, 
   ColorFunction -> "Rainbow", Lighting -> "Neutral", 
   ImageSize -> 400, PlotRangePadding -> Scaled[.05]];

Row[{pplt, Normal[pplt] /. p_Polygon :> toPolyhedron[10][p]}, Spacer[10]]

![enter image description here

Show[Normal[pplt] /. p_Polygon :> toPolyhedron[30][p], 
 ParametricPlot3D[{x, y, (x^2 + y^2 - 1/6 y^3)}, {x, -5, 5}, {y, -5, 5},
   Mesh -> None, ColorFunction -> "Rainbow", 
  BoundaryStyle -> Directive[Thick, Black]], 
 PlotRangePadding -> {Scaled[.05], Scaled[0.05], Scaled[.15]}, 
 Lighting -> "Neutral", ImageSize -> Large, BoxRatios -> 1]

enter image description here

Update: As an alternative to post-processing, you can use the option DisplayFunction to get the desired result in a single step:

ParametricPlot3D[{x, y, (x^2 + y^2 - 1/6 y^3)}, {x, -5, 5}, {y, -5, 5}, 
 Mesh -> None, BoxRatios -> 1, ColorFunction -> "Rainbow", 
 Lighting -> "Neutral", ImageSize -> Large, 
 BoundaryStyle -> Directive[Thick, Black], 
 PlotRangePadding -> {Scaled[.05], Scaled[0.05], Scaled[.15]}, 
 DisplayFunction -> (Normal[#] /. p_Polygon :> toPolyhedron[30][p] &)]

enter image description here

| improve this answer | |
$\endgroup$
0
$\begingroup$

I used this for the point cloud to Image3D conversion: https://www.wolfram.com/language/gallery/make-a-3d-image-from-a-point-cloud We generate a million points from the domain {x,y,h}, apply f and voxelize the point cloud by bin-counting. I've used a more complicated function to showcase the general problem. I don't know how to get axes on the Image3D however:

PointCloudToImage3D[points_, thresh_, slices_] := 
 Block[{ranges, bins, binCounts, transposedBinCounts}, 
  ranges = Round[{Min[#], Max[#]} & /@ Transpose[points]];
  bins = Append[#, ((#[[2]] - #[[1]])/slices)] & /@ ranges;
  binCounts = BinCounts[points, Sequence @@ bins];
  transposedBinCounts = 
   Map[UnitStep[# - thresh] &, 
    Reverse[Transpose[binCounts, {3, 2, 1}], {1, 2}], {3}];
  ImageAdjust@Image3D[Ceiling@transposedBinCounts]]
f[x_, y_, h_] := {x^2 - y^2, h y/4., x h}
pts = f @@@ 
   RandomVariate[UniformDistribution[{{-5, 5}, {-5, 5}, {-5, 5}}], 
    1000000];
ListPointPlot3D[RandomSample[pts, 5000], 
 BoxRatios -> 1] (* show reduced point count*)
Image3D[PointCloudToImage3D[pts, 1, 50], BoxRatios -> 1]

listplot and voxelized points

| improve this answer | |
$\endgroup$
  • $\begingroup$ "I don't know how to get axes on the Image3D however" - use Raster3D[] instead so you can put it in Graphics3D[]. $\endgroup$ – J. M.'s technical difficulties May 23 at 4:54

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.