4
$\begingroup$

Reading the question plotting the image of a function under constraints I see that the TransformedRegion command allows one to plot the image of functions whose domain is in $R^2$ and the image is in $R^2$. I tried to use TransformedRegion with a function of $R^3$ into $R^3$ but it did not work and there is no TransformedRegion3D command.

reg = DiscretizeRegion[
  ImplicitRegion[True, {{x, 0, 1}, {y, 0, 1}, {z, 0, 1}}], 
  MaxCellMeasure -> 0.001]

f[x_, y_, z_] := {y*z, x*z, x*y}

Question: Is there some way to plot the image of f in the code above in Mathematica?

$\endgroup$
3
  • 1
    $\begingroup$ What would this look like? Perhaps plot a cloud of random points in a cube and displace them using the function. $\endgroup$
    – flinty
    Commented Apr 27 at 15:59
  • $\begingroup$ But: mr = MeshRegion[{{0, 0, 0}, {1, 0, 0}, {1, 1, 0}, {0, 1, 0}, {0, 0, 1}, {1, 0, 1}, {1, 1, 1}, {0, 1, 1}, {0.5, 0.5, 1.5}, {1.5, 0, 0}, {1.5, 1, 0}, {1, -0.5, 0}}, Hexahedron[{1, 2, 3, 4, 5, 6, 7, 8}]] and \[ScriptCapitalR] = TransformedRegion[mr, ShearingTransform[30 Degree, {1, 0, 0}, {0, 1, 0}]] $\endgroup$ Commented Apr 27 at 16:33
  • $\begingroup$ treg = TransformedRegion[reg, f] and Region[treg] works as well but on the cloud. It seems to go to hang up on v12.2.0. $\endgroup$
    – Syed
    Commented Apr 28 at 1:07

3 Answers 3

4
$\begingroup$

TheTransformedRegion command also works in 3D. In your case

reg = ImplicitRegion[True, {{x, 0, 1}, {y, 0, 1}, {z, 0, 1}}];
treg = TransformedRegion[reg, 
Function[p, {p[[2]]*p[[3]], p[[1]]*p[[3]],p[[1]]*p[[2]]}]];
Region[treg]

enter image description here

$\endgroup$
2
  • $\begingroup$ Thanks! There is a missing [ in the code in the answer: p[1]] should be p[[1]]. I tried to edit it but it would not allow for corrections less than 6 characters... $\endgroup$ Commented Apr 27 at 18:50
  • $\begingroup$ @SergioParreiras" Thank you. Fixed. $\endgroup$
    – user64494
    Commented Apr 27 at 18:55
8
$\begingroup$
Clear[reg, f];
reg = DiscretizeRegion[
   ImplicitRegion[{0 <= x <= 1, 0 <= y <= 1, 0 <= z <= 1}, {x, y, z}],
    MaxCellMeasure -> 0.01];
f[x_, y_, z_] := {y*z, x*z, x*y};
RegionPlot3D[reg, 
 DisplayFunction -> 
  ReplaceAll[{x_Real, y_Real, z_Real} :> f[x, y, z]], 
 MaxRecursion -> 3, PlotPoints -> 2, ViewPoint -> {-2.4, -1.7, -1.7}]

enter image description here

$\endgroup$
4
  • $\begingroup$ Yes, this is a faster way. However, RegionMember[treg,{x,y,z}] produces x | y | z) \[Element] Reals && ((x == 0 && y == 0 && z == 0) || (x == 0 && y == 0 && z == 1) || (x == 0 && y == 0 && z < 1 && z > 0) || (x <= 1 && x >= 0 && y <= 1 && y >= 0 && x y - z == 0 && z >= 0) || (x > 0 && y > 0 && x y - z <= 0 && z > 0 && -y + x z <= 0 && x - y z >= 0) || (x <= 1 && x > 0 && x - y >= 0 && y >= 0 && -y + x z == 0) || (x >= 0 && x - y <= 0 && y <= 1 && y > 0 && x - y z == 0)), whereas RegionMember[reg, {x, y, z}] doesn't produces an expression. $\endgroup$
    – user64494
    Commented Apr 28 at 9:14
  • $\begingroup$ (i) RegionConvert[treg, "Parametric"] produces ParametricRegion[{{y z, x z, x y}, 0 <= x <= 1 && 0 <= y <= 1 && 0 <= z <= 1}, {x, y, z}]. (ii) Indeed, RegionPlot3D draws better than Region. $\endgroup$
    – user64494
    Commented Apr 28 at 9:33
  • $\begingroup$ @user64494 RegionPlot3D[treg] does not product the smooth graphics3D since treg is too complex althought it is the parametric form. $\endgroup$
    – cvgmt
    Commented Apr 28 at 9:36
  • $\begingroup$ Every approach has its advantages and deficiencies. $\endgroup$
    – user64494
    Commented Apr 28 at 9:55
2
$\begingroup$

Visualization of how the transformation take place based on @cvgmt answer.

reg = DiscretizeRegion[
   ImplicitRegion[{0 <= x <= 1, 0 <= y <= 1, 0 <= z <= 1}, {x, y, z}],
    MaxCellMeasure -> 0.001];
f[x_, y_, z_] := {y*z, x*z, x*y};

Manipulate[
 RegionPlot3D[reg, 
  DisplayFunction -> 
   ReplaceAll[{x_Real, y_Real, 
      z_Real} :> (Transpose[{#[[2]] - #[[1]], #[[1]]}] . {n, 1} &@{{x,
          y, z}, f[x, y, z]})], Boxed -> False, Mesh -> 9], {n, 0, 1}]

enter image description here

Manipulate with much quicker response (not based on @cvgmt answer).

lines = {Table[Line@{{n, 0, 0}, {n, 0, 1}}, {n, 0, 1, 1/10}], 
     Table[Line@{{0, 0, n}, {1, 0, n}}, {n, 0, 1, 1/10}], 
     Table[Line@{{n, 0, 0}, {n, 1, 0}}, {n, 0, 1, 1/10}], 
     Table[Line@{{0, n, 0}, {1, n, 0}}, {n, 0, 1, 1/10}], 
     Table[Line@{{0, n, 0}, {0, n, 1}}, {n, 0, 1, 1/10}], 
     Table[Line@{{0, 0, n}, {0, 1, n}}, {n, 0, 1, 1/10}], 
     Table[Line@{{n, 1, 0}, {n, 1, 1}}, {n, 0, 1, 1/10}], 
     Table[Line@{{0, 1, n}, {1, 1, n}}, {n, 0, 1, 1/10}], 
     Table[Line@{{n, 0, 1}, {n, 1, 1}}, {n, 0, 1, 1/10}], 
     Table[Line@{{0, n, 1}, {1, n, 1}}, {n, 0, 1, 1/10}], 
     Table[Line@{{1, n, 0}, {1, n, 1}}, {n, 0, 1, 1/10}], 
     Table[Line@{{1, 0, n}, {1, 1, n}}, {n, 0, 1, 1/10}]} // Flatten //
    DeleteDuplicates;
nlines = lines /. {x_, y_, z_} :> {y z, x z, x y};

(Transpose /@ Transpose[{#[[2]] - #[[1]], #[[1]]}]) . {n, 
     1} & /@ (Transpose[{lines, nlines}] /. Line -> Sequence);
Manipulate[
 Graphics3D[{Opacity[0.5], Line[%]}, Boxed -> False], {n, 0, 1}]

enter image description here

$\endgroup$

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.