# How to plot this transformed region?

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.

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

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]


## 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]


• 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]


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]


• 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]}
`