6
$\begingroup$

I mean

r = TransformedRegion[Cuboid[], Function[p, 
{p[[1]]*(-p[[1]] + p[[2]] + p[[3]]), 
p[[2]]*(p[[1]] - p[[2]] + p[[3]]), 
p[[3]]*(p[[1]] + p[[2]] - p[[3]])}]];
Region[r]

Unfortunately, this short code does not work for me in 13.2 on Windows 10.

$\endgroup$
2
  • $\begingroup$ Mathematica quits itself during the execution. $\endgroup$
    – user64494
    Commented Feb 13, 2023 at 21:03
  • $\begingroup$ For me it gets OOM. It does not just "exit". Someone needs to try it with 64 GB of RAM. $\endgroup$ Commented Feb 14, 2023 at 9:58

2 Answers 2

6
$\begingroup$

A workaround

$Version

(* "13.2.1 for Mac OS X ARM (64-bit) (January 27, 2023)" *)

Clear["Global`*"]

r = ImplicitRegion[0 <= x <= 1 && 0 <= y <= 1 && 0 <= z <= 1, {x, y, z}];

r2 = TransformedRegion[r, 
  Function[p, {p[[1]]*(-p[[1]] + p[[2]] + p[[3]]), 
    p[[2]]*(p[[1]] - p[[2]] + p[[3]]), p[[3]]*(p[[1]] + p[[2]] - p[[3]])}]]

(* ParametricRegion[{{x (-x + y + z), y (x - y + z), (x + y - z) z}, 
  0 <= x <= 1 && 0 <= y <= 1 && 0 <= z <= 1}, {x, y, z}] *)

Region[r2]

enter image description here

$\endgroup$
0
8
$\begingroup$

Edit

  • To get a more smooth surface, we use RegionPlot3D and use DisplayFunction to transform the region.
RegionPlot3D[
 BoundaryDiscretizeRegion[Cuboid[], MaxCellMeasure -> .01], 
 DisplayFunction -> 
  ReplaceAll[{x_Real, y_Real, z_Real} :> {x (-x + y + z), 
     y (x - y + z), z (x + y - z)}], Boxed -> False, 
 MaxRecursion -> 2]

enter image description here

  • Transform the Dodecahedron.
reg = PolyhedronData["Dodecahedron", "Region"]; RegionPlot3D[
 BoundaryDiscretizeRegion[reg, MaxCellMeasure -> .01], 
 DisplayFunction -> 
  ReplaceAll[{x_Real, y_Real, z_Real} :> {x (-x + y + z), 
     y (x - y + z), z (x + y - z)}], MaxRecursion -> 2, 
 Boxed -> False]

enter image description here

Original

  • We can DiscretizeRegion the Cuboid[] at first.
Clear[r];
r = TransformedRegion[DiscretizeRegion@Cuboid[], 
  Function[
   p, {p[[1]]*(-p[[1]] + p[[2]] + p[[3]]), 
    p[[2]]*(p[[1]] - p[[2]] + p[[3]]), 
    p[[3]]*(p[[1]] + p[[2]] - p[[3]])}]];
Region[r]

enter image description here

  • Test another reg,for example some polyhedrons.
Clear[reg, r];
reg = PolyhedronData["Dodecahedron", "Region"];
r = TransformedRegion[DiscretizeRegion[reg], 
   Function[
    p, {p[[1]]*(-p[[1]] + p[[2]] + p[[3]]), 
     p[[2]]*(p[[1]] - p[[2]] + p[[3]]), 
     p[[3]]*(p[[1]] + p[[2]] - p[[3]])}]];
{reg, Region[r]}

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.