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$
7
  • $\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$ Commented May 6, 2020 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
    Commented May 6, 2020 at 12:31
  • $\begingroup$ I am looking for something to behave in the same way as ParametricPlot3D. $\endgroup$
    – Myridium
    Commented May 6, 2020 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
    Commented May 6, 2020 at 13:52
  • 1
    $\begingroup$ @kglr - I can't get your example to run to completion. It crashes Mathematica. $\endgroup$
    – Myridium
    Commented May 19, 2020 at 6:00

2 Answers 2

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

$\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

$\endgroup$
1
  • $\begingroup$ "I don't know how to get axes on the Image3D however" - use Raster3D[] instead so you can put it in Graphics3D[]. $\endgroup$ Commented May 23, 2020 at 4:54

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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