Posts tagged: projections

Mathematica code:

Rot60 = 
Table[
Table[
RotationTransform[a, {1, 1, 0}, {0, 0, 0}][Tuples[{-1, 1}, 3][[v]]],
{v, 1, 8, 1}],
{a, 0, 2 Pi, 2 Pi/60}]

Edge := {1, 2, 4, 3, 7, 8, 6, 5, 1, 3, 4, 8, 7, 5, 6, 2}

CubeProjections[color_, pr_, b_, s_, h_, w_, m_, a_] :=
Graphics[
Table[
Translate[
{AbsoluteThickness[h], If[color == 0, Black, White],
Line[
Table[
Table[
Rot60[[1 + Mod[w (y + m*x) + a, 60]]][[Edge[[k]]]][[c]],
{c, 1, 2, 1}],
{k, 1, 16, 1}]]},
{s*x, s*y}],
{x, -6, 6, 1}, {y, -b, b, 1}],
PlotRange -> {{-pr/3, pr/3}, {-pr+1, pr-1}}, ImageSize -> 500,
Background -> If[color == 0, White, Black]
]

Manipulate[
PM = {color, pr, b, s, h, w, m, a};
CubeProjections[color, pr, b, s, h, w, m, a],
{color, 0, 1, 1}, {{pr, 17}, 1, 52}, {{b, 5}, 1, 20, 1},
{{s, 3}, 0, 5}, {{h, 1}, .01, 10},
{{w, 1}, 0, 20, 1},{{m, 1}, 0, 20, 1},
{a, 1, 60, 1}]

P = {0, 29, 20, 1.3, 2.5, 1, 0, 0}

Manipulate[
CubeProjections30[P[[1]], P[[2]], P[[3]], P[[4]], P[[5]], P[[6]],
P[[7]], a],
{a, 1, 30, 1}]
Mathematica code:Rot80 =  Table[  Table[   RotationTransform[a, {1, 1, 0}, {0, 0, 0}][Tuples[{-1, 1}, 3][[v]]],  {v, 1, 8, 1}],{a, 0, 2 Pi,  Pi/80}]Edge := {1, 2, 4, 3, 7, 8, 6, 5, 1, 3, 4, 8, 7, 5, 6, 2}CubeTrail[h_, op_, N_, s_, r_, z_, t_, PR_, IS_, C_] := Graphics[  Table[   Scale[    Translate[     {AbsoluteThickness[h], Opacity[op],       If[C == 1, Black, White],      Line[       Table[        {Rot80[[1 + Mod[t, 80]]][[Edge[[e]]]][[1]],         Rot80[[1 + Mod[t, 80]]][[Edge[[e]]]][[2]]},        {e, 1, 16, 1}]]},     r{Cos[2 Pi*(n*t/80 + k)/N], Sin[2 Pi*(n*t/80 + k)/N]}],    z^n, r{Cos[2 Pi*(n*t/80 + k)/N], Sin[2 Pi*(n*t/80 + k)/N]}],   {k, 1, N, 1},   {n, 1, s, 1}],  PlotRange -> PR, ImageSize -> 500,   Background -> If[C == 0, Black, White]]Manipulate[P = {h, op, N, s, r, z, t, PR, IS, C}; CubeTrail[h, op, N, s, r, z, t, PR, 500, 0],{{h, 1}, 0, 20}, {op, 1, 0}, {{N, 4}, 1, 16, 1}, {s, 1, 100, 1}, {{r, 3.5}, 0, 10}, {z, 1, 0},{{PR, 5}, 1, 5}, {C, 0, 1, 1},{t, 0, 100, 1}]P ={1.5, 1, 4, 8, 3.8, 0.75, 0, 5, 500, 0}Manipulate[CubeTrail[P[[1]],P[[2]],P[[3]],P[[4]],P[[5]],P[[6]],t,P[[8]],500,0],{t, 1, 80, 1}]

Mathematica
code:
Rot80 = 
Table[
Table[
RotationTransform[a, {1, 1, 0}, {0, 0, 0}][Tuples[{-1, 1}, 3][[v]]],
{v, 1, 8, 1}],
{a, 0, 2 Pi, Pi/80}]

Edge := {1, 2, 4, 3, 7, 8, 6, 5, 1, 3, 4, 8, 7, 5, 6, 2}

CubeTrail[h_, op_, N_, s_, r_, z_, t_, PR_, IS_, C_] :=
Graphics[
Table[
Scale[
Translate[
{AbsoluteThickness[h], Opacity[op],
If[C == 1, Black, White],
Line[
Table[
{Rot80[[1 + Mod[t, 80]]][[Edge[[e]]]][[1]],
Rot80[[1 + Mod[t, 80]]][[Edge[[e]]]][[2]]},
{e, 1, 16, 1}]]},
r{Cos[2 Pi*(n*t/80 + k)/N], Sin[2 Pi*(n*t/80 + k)/N]}],
z^n, r{Cos[2 Pi*(n*t/80 + k)/N], Sin[2 Pi*(n*t/80 + k)/N]}],
{k, 1, N, 1},
{n, 1, s, 1}],
PlotRange -> PR, ImageSize -> 500,
Background -> If[C == 0, Black, White]]

Manipulate[P = {h, op, N, s, r, z, t, PR, IS, C};
CubeTrail[h, op, N, s, r, z, t, PR, 500, 0],
{{h, 1}, 0, 20}, {op, 1, 0},
{{N, 4}, 1, 16, 1}, {s, 1, 100, 1},
{{r, 3.5}, 0, 10}, {z, 1, 0},
{{PR, 5}, 1, 5}, {C, 0, 1, 1},
{t, 0, 100, 1}]

P ={1.5, 1, 4, 8, 3.8, 0.75, 0, 5, 500, 0}

Manipulate[
CubeTrail[P[[1]],P[[2]],P[[3]],P[[4]],P[[5]],P[[6]],t,P[[8]],500,0],
{t, 1, 80, 1}]

Mathematica code:

Rot = 
Table[
Table[
RotationTransform[a, {1, 1, 0}, {0, 0, 0}][Tuples[{-1, 1}, 3][[v]]],
{v, 1, 8, 1}],
{a, 0, 2 Pi, 2 Pi/100}]

Edge := {1, 2, 4, 3, 7, 8, 6, 5, 1, 3, 4, 8, 7, 5, 6, 2}

CubeProjections[color_, pr_, b_, s_, h_, w_, m_, a_] :=
Graphics[
Table[
Translate[
{AbsoluteThickness[h], If[color == 0, Black, White],
Line[
Table[
Table[
Rot[[1 + Mod[w (y + m*x) + a, 100]]][[Edge[[k]]]][[c]],
{c, 1, 2, 1}],
{k, 1, 16, 1}]]},
{s*x, s*y}],
{x, -b, b, 1}, {y, -b, b, 1}],
PlotRange -> {{-5*pr/14, 5*pr/14}, {-pr, pr}}, ImageSize -> 500,
Background -> If[color == 0, White, Black]
]

Manipulate[
PM = {color, pr, b, s, h, w, m, a};
CubeProjections[color, pr, b, s, h, w, m, a],
{color, 0, 1, 1}, {{pr, 17}, 1, 52}, {{b, 5}, 1, 20, 1},
{{s, 3}, 0, 5}, {{h, 1}, .01, 10},
{{w, 1}, 0, 20, 1},{{m, 1}, 0, 20, 1},
{a, 1, 100, 1}]

P = {0, 27.7, 20, 1.3, 2.75, 1, 0, 18}


Show@
CubeProjections[P[[1]],P[[2]],P[[3]],P[[4]],P[[5]],P[[6]],P[[7]],P[[8]]]


Mathematica code:
RotAxis = Table[Table[  Table[    R[o, {.01 + x, .01 + y, 0}, {0, 0, 0}],    {o, 0, 2 Pi, 2 Pi/80}], {x, -10, 10, 1}], {y, -10, 10, 1}]Edge := {1, 2, 4, 3, 7, 8, 6, 5, 1, 3, 4, 8, 7, 5, 6, 2}CubeProjections[color_, pr_, b_, s_, h_, w_, m_, o_] :=Graphics[ Table[  Translate[   {AbsoluteThickness[h], If[color == 0, Black, White],    Line[     Table[      Table[      RotAxis[[11 + y]][[11 + x]]      [[1 + Mod[Round[ (Pi + ArcTan[.01 + x, .01 + y])/2Pi] + o, 80]]]      [[Edge[[k]]]][[c]],       {c, 1, 2, 1}],      {k, 1, 16, 1}]]},   {s*x, s*y}],  {x, -b, b, 1}, {y, -b, b, 1}], PlotRange -> {{-pr, pr}, {-pr, pr}}, ImageSize -> 500,  Background -> If[color == 0, White, Black] ]Manipulate[PM = {color, pr, b, s, h, w, m, a};CubeProjections[color, pr, b, s, h, w, m, a],{color, 0, 1, 1}, {{pr, 17}, 1, 52}, {{b, 5}, 1, 10, 1},{{s, 3}, 0, 5}, {{h, 1}, .01, 10},{{w, 1}, 0, 20, 1},{{m, 1}, 0, 20, 1},{a, 1, 80, 1}]P = {0, 20, 5, 3.6, 1.5, 1, 1, 1}Manipulate[CubeProjections[P[[1]],P[[2]],P[[3]],P[[4]],P[[5]],P[[6]],P[[7]],a],{a, 1, 79, 2}]

Mathematica code:

RotAxis =
 Table[Table[
Table[
R[o, {.01 + x, .01 + y, 0}, {0, 0, 0}],
{o, 0, 2 Pi, 2 Pi/80}],
 {x, -10, 10, 1}], {y, -10, 10, 1}]

Edge := {1, 2, 4, 3, 7, 8, 6, 5, 1, 3, 4, 8, 7, 5, 6, 2}

CubeProjections[color_, pr_, b_, s_, h_, w_, m_, o_] :=
Graphics[
Table[
Translate[
{AbsoluteThickness[h], If[color == 0, Black, White],
Line[
Table[
Table[
RotAxis[[11 + y]][[11 + x]]
[[1 + Mod[Round[ (Pi + ArcTan[.01 + x, .01 + y])/2Pi] + o, 80]]]
[[Edge[[k]]]][[c]],
{c, 1, 2, 1}],
{k, 1, 16, 1}]]},
{s*x, s*y}],
{x, -b, b, 1}, {y, -b, b, 1}],
PlotRange -> {{-pr, pr}, {-pr, pr}}, ImageSize -> 500,
Background -> If[color == 0, White, Black]
]

Manipulate[
PM = {color, pr, b, s, h, w, m, a};
CubeProjections[color, pr, b, s, h, w, m, a],
{color, 0, 1, 1}, {{pr, 17}, 1, 52}, {{b, 5}, 1, 10, 1},
{{s, 3}, 0, 5}, {{h, 1}, .01, 10},
{{w, 1}, 0, 20, 1},{{m, 1}, 0, 20, 1},
{a, 1, 80, 1}]

P = {0, 20, 5, 3.6, 1.5, 1, 1, 1}

Manipulate[
CubeProjections[P[[1]],P[[2]],P[[3]],P[[4]],P[[5]],P[[6]],P[[7]],a],
{a, 1, 79, 2}]
Mathematica code:
RotAxis = Table[Table[  Table[    R[o, {.01 + x, .01 + y, 0}, {0, 0, 0}],    {o, 0, 2 Pi, 2 Pi/80}], {x, -10, 10, 1}], {y, -10, 10, 1}]Edge := {1, 2, 4, 3, 7, 8, 6, 5, 1, 3, 4, 8, 7, 5, 6, 2}CubeProjections[color_, pr_, b_, s_, h_, w_, m_, o_] :=Graphics[ Table[  Translate[   {AbsoluteThickness[h], If[color == 0, Black, White],    Line[     Table[      Table[      RotAxis[[11 + y]][[11 + x]][[o]][[Edge[[k]]]][[c]],       {c, 1, 2, 1}],      {k, 1, 16, 1}]]},   {s*x, s*y}],  {x, -b, b, 1}, {y, -b, b, 1}], PlotRange -> {{-pr, pr}, {-pr, pr}}, ImageSize -> 500,  Background -> If[color == 0, White, Black] ]Manipulate[PM = {color, pr, b, s, h, w, m, a};CubeProjections[color, pr, b, s, h, w, m, a],{color, 0, 1, 1}, {{pr, 17}, 1, 52}, {{b, 5}, 1, 10, 1},{{s, 3}, 0, 5}, {{h, 1}, .01, 10},{{w, 1}, 0, 20, 1},{{m, 1}, 0, 20, 1},{a, 1, 80, 1}]P = {0, 20, 5, 3.6, 1.5, 1, 1, 1}Manipulate[CubeProjections[P[[1]],P[[2]],P[[3]],P[[4]],P[[5]],P[[6]],P[[7]],a],{a, 1, 79, 2}]

Mathematica code:

RotAxis =
 Table[Table[
Table[
R[o, {.01 + x, .01 + y, 0}, {0, 0, 0}],
{o, 0, 2 Pi, 2 Pi/80}],
 {x, -10, 10, 1}], {y, -10, 10, 1}]

Edge := {1, 2, 4, 3, 7, 8, 6, 5, 1, 3, 4, 8, 7, 5, 6, 2}

CubeProjections[color_, pr_, b_, s_, h_, w_, m_, o_] :=
Graphics[
Table[
Translate[
{AbsoluteThickness[h], If[color == 0, Black, White],
Line[
Table[
Table[
RotAxis[[11 + y]][[11 + x]][[o]][[Edge[[k]]]][[c]],
{c, 1, 2, 1}],
{k, 1, 16, 1}]]},
{s*x, s*y}],
{x, -b, b, 1}, {y, -b, b, 1}],
PlotRange -> {{-pr, pr}, {-pr, pr}}, ImageSize -> 500,
Background -> If[color == 0, White, Black]
]

Manipulate[
PM = {color, pr, b, s, h, w, m, a};
CubeProjections[color, pr, b, s, h, w, m, a],
{color, 0, 1, 1}, {{pr, 17}, 1, 52}, {{b, 5}, 1, 10, 1},
{{s, 3}, 0, 5}, {{h, 1}, .01, 10},
{{w, 1}, 0, 20, 1},{{m, 1}, 0, 20, 1},
{a, 1, 80, 1}]

P = {0, 20, 5, 3.6, 1.5, 1, 1, 1}

Manipulate[
CubeProjections[P[[1]],P[[2]],P[[3]],P[[4]],P[[5]],P[[6]],P[[7]],a],
{a, 1, 79, 2}]

Mathematica code:
Rot =  Table[  Table[   RotationTransform[a, {1, 1, 0}, {0, 0, 0}][Tuples[{-1, 1}, 3][[v]]],  {v, 1, 8, 1}],{a, 0, 2 Pi, 2 Pi/100}]Edge := {1, 2, 4, 3, 7, 8, 6, 5, 1, 3, 4, 8, 7, 5, 6, 2}CubeProjections[color_, pr_, b_, s_, h_, w_, m_, o_] :=Graphics[ Table[  Translate[   {AbsoluteThickness[h], If[color == 0, Black, White],    Line[     Table[      Table[       Rot[[1 + Mod[w (y + m*x) + a, 100]]][[Edge[[k]]]][[c]],       {c, 1, 2, 1}],      {k, 1, 16, 1}]]},   {s*x, s*y}],  {x, -b, b, 1}, {y, -b, b, 1}], PlotRange -> {{-pr, pr}, {-pr, pr}}, ImageSize -> 500,  Background -> If[color == 0, White, Black] ]Manipulate[PM = {color, pr, b, s, h, w, m, a};CubeProjections[color, pr, b, s, h, w, m, a],{color, 0, 1, 1}, {{pr, 17}, 1, 52}, {{b, 5}, 1, 10, 1},{{s, 3}, 0, 5}, {{h, 1}, .01, 10},{{w, 1}, 0, 20, 1},{{m, 1}, 0, 20, 1},{a, 1, 100, 1}]P = {1, 28, 9, 3, 1.4, 1, 1, 30}Manipulate[CubeProjections[P[[1]],P[[2]],P[[3]],P[[4]],P[[5]],P[[6]],P[[7]],a],{a, 48, 0, -2}]



Mathematica code:

Rot = 
Table[
Table[
RotationTransform[a, {1, 1, 0}, {0, 0, 0}][Tuples[{-1, 1}, 3][[v]]],
{v, 1, 8, 1}],
{a, 0, 2 Pi, 2 Pi/100}]

Edge := {1, 2, 4, 3, 7, 8, 6, 5, 1, 3, 4, 8, 7, 5, 6, 2}

CubeProjections[color_, pr_, b_, s_, h_, w_, m_, o_] :=
Graphics[
Table[
Translate[
{AbsoluteThickness[h], If[color == 0, Black, White],
Line[
Table[
Table[
Rot[[1 + Mod[w (y + m*x) + a, 100]]][[Edge[[k]]]][[c]],
{c, 1, 2, 1}],
{k, 1, 16, 1}]]},
{s*x, s*y}],
{x, -b, b, 1}, {y, -b, b, 1}],
PlotRange -> {{-pr, pr}, {-pr, pr}}, ImageSize -> 500,
Background -> If[color == 0, White, Black]
]

Manipulate[
PM = {color, pr, b, s, h, w, m, a};
CubeProjections[color, pr, b, s, h, w, m, a],
{color, 0, 1, 1}, {{pr, 17}, 1, 52}, {{b, 5}, 1, 10, 1},
{{s, 3}, 0, 5}, {{h, 1}, .01, 10},
{{w, 1}, 0, 20, 1},{{m, 1}, 0, 20, 1},
{a, 1, 100, 1}]

P = {1, 28, 9, 3, 1.4, 1, 1, 30}

Manipulate[
CubeProjections[P[[1]],P[[2]],P[[3]],P[[4]],P[[5]],P[[6]],P[[7]],a],
{a, 48, 0, -2}]
2-D projections of rotating cubes
Mathematica code:
Rot =  Table[  Table[   RotationTransform[a, {1, 1, 0}, {0, 0, 0}][Tuples[{-1, 1}, 3][[v]]],  {v, 1, 8, 1}],{a, 0, 2 Pi, 2 Pi/100}]Edge := {1, 2, 4, 3, 7, 8, 6, 5, 1, 3, 4, 8, 7, 5, 6, 2}CubeProjections[color_, pr_, b_, s_, h_, w_, m_, o_] :=Graphics[ Table[  Translate[   {AbsoluteThickness[h], If[color == 0, Black, White],    Line[     Table[      Table[       Rot[[1 + Mod[w (y + m*x) + a, 100]]][[Edge[[k]]]][[c]],       {c, 1, 2, 1}],      {k, 1, 16, 1}]]},   {s*x, s*y}],  {x, -b, b, 1}, {y, -b, b, 1}], PlotRange -> {{-pr, pr}, {-pr, pr}}, ImageSize -> 500,  Background -> If[color == 0, White, Black] ]Manipulate[PM = {color, pr, b, s, h, w, m, a};CubeProjections[color, pr, b, s, h, w, m, a],{color, 0, 1, 1}, {{pr, 17}, 1, 52}, {{b, 5}, 1, 10, 1},{{s, 3}, 0, 5}, {{h, 1}, .01, 10},{{w, 1}, 0, 20, 1},{{m, 1}, 0, 20, 1},{a, 1, 100, 1}]P = {0, 26.7, 7, 3.5, 1.3, 5, 1, 0}Manipulate[CubeProjections[P[[1]],P[[2]],P[[3]],P[[4]],P[[5]],P[[6]],P[[7]],a],{a, 48, 0, -2}]


2-D projections of rotating cubes

Mathematica code:

Rot = 
Table[
Table[
RotationTransform[a, {1, 1, 0}, {0, 0, 0}][Tuples[{-1, 1}, 3][[v]]],
{v, 1, 8, 1}],
{a, 0, 2 Pi, 2 Pi/100}]

Edge := {1, 2, 4, 3, 7, 8, 6, 5, 1, 3, 4, 8, 7, 5, 6, 2}

CubeProjections[color_, pr_, b_, s_, h_, w_, m_, o_] :=
Graphics[
Table[
Translate[
{AbsoluteThickness[h], If[color == 0, Black, White],
Line[
Table[
Table[
Rot[[1 + Mod[w (y + m*x) + a, 100]]][[Edge[[k]]]][[c]],
{c, 1, 2, 1}],
{k, 1, 16, 1}]]},
{s*x, s*y}],
{x, -b, b, 1}, {y, -b, b, 1}],
PlotRange -> {{-pr, pr}, {-pr, pr}}, ImageSize -> 500,
Background -> If[color == 0, White, Black]
]

Manipulate[
PM = {color, pr, b, s, h, w, m, a};
CubeProjections[color, pr, b, s, h, w, m, a],
{color, 0, 1, 1}, {{pr, 17}, 1, 52}, {{b, 5}, 1, 10, 1},
{{s, 3}, 0, 5}, {{h, 1}, .01, 10},
{{w, 1}, 0, 20, 1},{{m, 1}, 0, 20, 1},
{a, 1, 100, 1}]

P = {0, 26.7, 7, 3.5, 1.3, 5, 1, 0}

Manipulate[
CubeProjections[P[[1]],P[[2]],P[[3]],P[[4]],P[[5]],P[[6]],P[[7]],a],
{a, 48, 0, -2}]

(click through the images to view in high-res)

Penrose tilings are an example of the non-periodic tilings discussed in the last post. Recall that these are tilings that cover the entire infinite plane leaving neither gaps nor overlaps. Whats nice about these tilings is that the set of tiles used to construct the Penrose tilings only consists of two different basic shapes consisting of quadrilaterals

Whats even more remarkable about Penrose tilings is that using just these two shapes it is possible to construct infinitely many different tilings that cover the infinite plane. This infinity is infinitely bigger in size than the countable infinity of the whole numbers ( 1, 2, 3, 4, and so on), but rather equivalent to the uncountable infinity associated to the real numbers (which includes all whole numbers, fractions, and decimals with infinitely many digits).

Despite the existence of these infinitely many different Penrose tilings, there is one peculiar property they all exhibit. Consider any finite region, or patch, of one particular Penrose tiling. Then it is possible to find an exact copy of this patch in any other different Penrose tiling! Moreover, this patch occurs infinitely often in different spots in any given tiling! Note that this is true of any patch of any size no matter how big as long as its finite. This implies that if you were only able to examine a finite part of any Penrose tiling, you could never really distinguish that entire tiling from any other tiling. Thus, different Penrose tilings are only perfectly distinguishable in the infinite limit of the entire plane.

The images shown above display finite regions of Penrose tilings. They are constructed using an elegant "cut-and-project" method (also used here), which involves projecting the points of the integer lattice in 5-dimensional Euclidean space, onto a certain 2-dimensional plane. Connecting adjacent projected points in this plane by lines then yields a Penrose tiling.

Further reading:

Image Source: Wikipedia

(click through for hi-res images)

Examples of tilings constructed as projections of D-dimensional simple cubic lattices (for D = 3, 5, and 7) into d = 2-dimensional physical space.

From: Two-Dimensional Random Tilings of Large Codimension

A 3D orthographic projection of a 4D slice knot rotating while keeping two orthogonal planes fixed.

Created with KnotPlot

more


A 3D perspective projection of a 4D slice knot rotating while keeping two orthogonal planes fixed.

Created with KnotPlot

more

enkiseshat:

Just as a cube can be unfolded into 2-D as 6 squares, a tesseract can be unfolded into 3-D as 6 cubes.

enkiseshat:

Just as a cube can be unfolded into 2-D as 6 squares, a tesseract can be unfolded into 3-D as 6 cubes.




This animation shows 3 dimensional projections of the 24 cell, which is a 4 dimensional figure with no 3 dimensional analog. It has 24 octahedral cells, 96 triangular faces, 96 edges, and 24 vertices. Click here to spin it around yourself!





The 120 cell is a 4 dimensional figure that can be considered the 4 dimensional analog of the dodecahedron. It has 720 five sided faces, 1200 edges, and 600 vertices. This animation shows 3 dimensional cross sections of the 120 cell in a way that is similar to taking 2 dimensional cross sections of a 3 dimensional figure.