Improve inverted 3D Truchet tiling?

Question

Here is a 3D inverted Truchet tiling, p is "radius of the tubes", n is "volume".

    inverze[x_] := 8 x/(x[[1]]^2 + x[[2]]^2 + x[[3]]^2) ;
    p = 0.3;
    n = 4;
    nrotace = 
    Table[RandomInteger[3], {i, 1, n}, {j, 1, n}, {k, 1, n}, {r, 1, n}];
    nzrcadleni = 
    Table[RandomInteger[1], {i, 1, n}, {j, 1, n}, {k, 1, n}, {r, 1, n}];
    mat = Table[(If[nzrcadleni[[i, j, k, 3]] == 1, 
    ReflectionMatrix[{1, 0, 0}], IdentityMatrix[3]]).(If[
    nzrcadleni[[i, j, k, 2]] == 1, ReflectionMatrix[{0, 1, 0}], 
    IdentityMatrix[3]]).(If[nzrcadleni[[i, j, k, 1]] == 1, 
    ReflectionMatrix[{0, 0, 1}], IdentityMatrix[3]]).RotationMatrix[
    nrotace[[i, j, k, 1]] (Pi/2), {0, 0, 1}].RotationMatrix[
    nrotace[[i, j, k, 2]] (Pi/2), {0, 1, 0}].RotationMatrix[
    nrotace[[i, j, k, 3]] (Pi/2), {1, 0, 0}], {i, 1, n}, {j, 1, n}, {k, 1, n}];
    tst = Table[2 {i - (n + 1)/2, j - (n + 1)/2, k - (n + 1)/2} + (mat[[i, j, k]].#) & /@ {{(1 + p Cos[v]) Cos[u] - 1, (1 + p Cos[v]) Sin[u] - 1, p Sin[v]}, {(1 + p Cos[v]) Sin[u + (3/2) Pi] + 1, p Sin[v], (1 + p Cos[v]) Cos[u + (3/2) Pi] - 1}, {p Sin[v], (1 + p Cos[v]) Sin[u + Pi] + 1, (1 + p Cos[v]) Cos[u + Pi] + 1}}, {i, 1, n}, {j, 1, n}, {k, 1, n}];
    tst2 = (inverze /@ Flatten[tst, 3]);
    ParametricPlot3D[tst2, {u, 0, Pi/2}, {v, 0, 2 Pi}, PlotPoints -> Automatic, PlotRange -> {{-5, 5}, {-5, 5}, {-5, 5}}, PlotStyle -> {Red,Specularity[White, 20]}, RegionFunction -> Function[{x, y, z, u, v}, x^2 + y^2 + z^2 <= 5^2], ViewPoint -> {1, 1, 1}, SphericalRegion -> True, PlotTheme -> "ThickSurface", Boxed -> False, Axes -> False]

Result

Here is what it looks like when it is ray traced:

You can also change continuously the point of inversion to make some nice videos. Please suggest useful code optimizations.

Here is the effect of the continuous change of the point of inversion: https://www.youtube.com/watch?v=7QWqqTdT8Kg — Woertgner, Feb 23 '18 at 12:28
This may be a very interesting topic, but as posted, it is not appropriate for this site because there is no question about Mathematica. — m_goldberg, Feb 23 '18 at 12:29
I'm voting to close this question as off-topic because it poses no question that is appropriate to this site. — m_goldberg, Feb 23 '18 at 12:30
I'd like to see this code remain available on SE. Maybe editing the question would be a better approach than removal. — Alan, Feb 23 '18 at 20:38
Could you explain a bit the details of your code or of how the image is generated, to help us improve it? You could start by defining nrotace and nzrcadleni with nrotace = RandomInteger[3, {n, n, n, n}]; nzrcadleni = RandomInteger[1, {n, n, n, n}]; or, shorter, {nrotace, nzrcadleni} = RandomInteger[#, {n, n, n, n}] & /@ {3, 1};. — anderstood, Feb 23 '18 at 22:00
If you simply would like to showcase your code and model you can post at Wolfram Community where question format is not required. — Vitaliy Kaurov, Mar 01 '18 at 03:50
Try to write your question like in this post. Show what each part of the code does, and suggest where you think the code could use some optimizations. — QuantumDot, Mar 21 '18 at 00:28

Improve inverted 3D Truchet tiling?

0 Answers0