Drawings

I use these grids to construct smooth approximations to bivariate angular probability densities (of interest in protein bioinformatics) and to specify semiparametric priors on bivariate angular density spaces. The grid on the Torus illustrates the proper angular wrapping behavior of planar grid. I drew them in Mathematica.

Code and variants below.

Here I plotted one density associated to a lattice point, for different grid sizes.

The graphs I prefer.

Code

Definition of the lattice

(*Lattice points.*)
P[n_][i_, j_] :=
  Pi/(2 n + 1) {2 i + Boole[Mod[j, 2] == 1] + j/(2 n + 1), 2 j}
Points[n_] :=
  Flatten[Table[P[n][i, j], {i, -n, 3 n}, {j, -n, 3 n}], 1]

Planar grid

n = 2;
(*Custom colors*)
blue = {0.29803922, 0.44705882, 0.69019608};
red = {0.76862745, 0.30588235, 0.32156863};

(*White covering rectangles for the edges.*)
Cover = Graphics[{RGBColor[1, 1, 1, 0.6],
    Rectangle[{-5, -5}, {0, 2 Pi}], Rectangle[{-5, -5}, {4 Pi, 0}],
    Rectangle[{2 Pi, 0}, {4 Pi, 4 Pi}],
    Rectangle[{-5, 4 Pi}, {4 Pi, 2 Pi}]}];

(*Lattice points grid.*)
pointplot =
  ListPlot[Flatten[Table[P[n][i, j], {i, 0, 2 n}, {j, 0, 2 n}], 1],
   PlotStyle -> {RGBColor[blue], PointSize[0.02]}];

(*Voronoi diagram.*)
voronoi =
  HighlightMesh[
   VoronoiMesh[Points[n]], {Style[1, RGBColor[red], Thickness[0.008]],
     Style[2, Opacity[0]]}];

(*Putting everything together.*)
Show[
 voronoi, Cover, pointplot,
 PlotRange -> {{-0.5, 2 Pi + 0.5}, {-0.5, 2 Pi + 0.5}},
 Axes -> True, Ticks -> {{0, 2 Pi}, {0, 2 Pi}},
 AxesOrigin -> {-0.5, -0.5}, AxesStyle -> Directive[Thick, Gray],
 LabelStyle -> {Large}, TicksStyle -> Large
 ]

Grid on the torus

n = 5;

(*Vertices of the Voronoi diagram. *)
vertices =
  MeshPrimitives[VoronoiMesh[Points[n]], 1] /. Line[x_] -> x;
(*Removing the outer boundary of the Voronoi diagram.*)
vertices =
  Select[vertices, -1 <= #[[1, 1]] <= 2 Pi + 1 && -1 <= #[[1, 2]] <=
      2 Pi + 1 && -1 <= #[[1, 1]] <= 2 Pi + 1 && -1 <= #[[2, 2]] <= 2 Pi + 1  &]; s[u_, v_] := {Cos[u] (2 + Cos[v]), Sin[u] (2 + Cos[v]), Sin[v]}; f[p1_, p2_] := Line[{s @@ p1, s @@ p2}];  (*Faces of the Voronoi diagram.*)  faces = MeshPrimitives[VoronoiMesh[Points[n]], 2] /. Polygon[x_] -> x;
(*Removing the outer boundary of the Voronoi diagram.*)
faces = Select[
   faces, -1 <= #[[1, 1]] <= 2 Pi + 1 && -1 <= #[[1, 2]] <=
      2 Pi + 1 && -1 <= #[[1, 1]] <= 2 Pi + 1 && -1 <= #[[2, 2]] <= 2 Pi + 1 &];  g[face__] := Polygon[Apply[s, { face}, 1]];  bluepoints =    Flatten[Table[Sphere[s @@ P[n][i, j], 0.05], {i, 0, 2 n}, {j, 0, 2 n}], 1];  (*Putting everything together*)  Show[Graphics3D[Join[      (*Faces*)      g @@@ faces, {RGBColor[red], Thickness[0.005]},      (*Vertices*)      f @@@ vertices,      (*Points*)      {RGBColor[blue], PointSize[0.02]}, bluepoints]],      (*Parameters*)      Lighting -> "Neutral", Boxed -> False]

Leave a comment

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s