How to generate grid points on boundary of $[-1,1]^d$ for arbitrary dimension $d$ and specified resolution?

This must be a trivial thing, but I was not able to find a function for it in Mathematica. How do you efficiently create a grid with constant but specific resolution $r$ in all directions on the boundary of $[-1,1]^d$ in arbitrary $d$ dimensions? By that, I mean, for example, for $d=2$ and $r=1/2$ a list with all equidistant points on the edge of the square:

points={{-1, -1}, {-1, 0}, {-1, 1}, {0, -1}, {0, 1}, {1, -1}, {1, 0}, {1, 1}}


in $d=3$ and $r=1/2$

points={
{-1, -1, -1}, {-1, -1, 0}, {-1, -1, 1}, {-1, 0, -1}, {-1, 0, 0},
{-1, 0, 1}, {-1, 1, -1}, {-1, 1, 0}, {-1, 1, 1}, {0, -1, -1},
{0, -1, 0}, {0, -1, 1}, {0, 0, -1}, {0, 0, 1}, {0, 1, -1}, {0, 1, 0},
{0, 1, 1}, {1, -1, -1}, {1, -1, 0}, {1, -1, 1}, {1, 0, -1}, {1, 0, 0},
{1, 0, 1}, {1, 1, -1}, {1, 1, 0}, {1, 1, 1}}


At the moment I am doing this for arbitrary dimension $d$ and specified resolution $r$ with Table as follows:

d = 3;
r = 1/2;
(*Create indices*)
ids = Array[id, d];
(*Prepare argument for Table*)
arg = {Permutations[ids], {ids[[1]], {-1, 1}}};
Do[
AppendTo[arg, {ids[[i]], -1, 1, 2*r}]
, {i, 2, Length@ids}
]
arg;
(*Generate points with Table*)
points = Sort@DeleteDuplicates@Flatten[Table @@ arg, d];
Length@points
(*Plot in 2D and 3D*)
If[d == 2, Graphics@Point@points]
If[d == 3, Graphics3D@Point@points]


but I just wanted to know, if there is already a built-in function or more efficient way to do this. Thanks!

Here's a pretty general solution. This generates the desired boundary lattice points in $[0,1]^d$; apply Rescale[] as needed:

makeGrid[d_Integer?Positive, n_Integer /; n > 1] :=
Module[{sh = {{0}, {1}}, ins = ArrayPad[Subdivide[n], -1]},
Do[sh = Insert[Transpose[Outer[Append,
CoordinateBoundsArray[ConstantArray[{0, 1}, k], Into[n]], {0, 1}, k]],
Unevaluated[Sequence @@ Flatten[Outer[Append, sh, ins, k], {{2}, {1}}]], 2],
{k, d - 1}]; sh]


Examples:

{Graphics[{AbsolutePointSize[4], Point[Flatten[makeGrid[2, 8], 1]]}, Frame -> True],
Graphics3D[Sphere[Flatten[makeGrid[3, 5], 2], 0.01], Axes -> True]} // GraphicsRow


Since version 10.1, there has been a built-in function CoordinateBoundsArray to do this kind of thing. It is readily adapted to your special case.

lattice[d_Integer?Positive, r_?NumericQ] :=
Flatten[CoordinateBoundsArray[ConstantArray[{-1, 1}, d], r], d - 1]

lattice[2, 1]

{{-1, -1}, {-1, 0}, {-1, 1}, {0, -1}, {0, 0}, {0, 1}, {1, -1}, {1, 0}, {1, 1}}

lattice[3, 1]

{{-1, -1, -1}, {-1, -1, 0}, {-1, -1, 1}, {-1, 0, -1}, {-1, 0, 0}, {-1,0, 1},
{-1, 1, -1}, {-1, 1, 0}, {-1, 1, 1}, {0, -1, -1}, {0, -1, 0}, {0, -1, 1},
{0, 0, -1}, {0, 0, 0}, {0, 0, 1}, {0, 1, -1}, {0, 1,0}, {0, 1, 1},
{1, -1, -1}, {1, -1, 0}, {1, -1, 1}, {1, 0, -1}, {1, 0, 0}, {1, 0, 1},
{1, 1, -1}, {1, 1, 0}, {1, 1, 1}}

• There is still a need to delete the points within the $r$-hypercube, however. – J. M. is away May 26 '16 at 15:22
• @J.M. wrap it in Select[Flatten[CoordinateBoundsArray[ConstantArray[{-1, 1}, d], r], d - 1], Max@Abs@# == 1 &] as I did - it's worth noting that this is considerably faster than my implementation. – dr.blochwave May 26 '16 at 16:40
• Presumably there is some sort of optimization going on under the hood. – dr.blochwave May 26 '16 at 16:42
• @J.M. I should have stated that my answer is only meant to reproduce the points output the OP showed. – m_goldberg May 26 '16 at 23:09

You could try something like this:

generateGrid[dim_] := DeleteCases[Tuples[{-1, 0, 1}, dim], {0 ..}]


For the case of specifying a resolution as well, try:

generateGrid[dim_, r_] := Select[Tuples[Range[-1, 1, r], dim], Max@Abs[#] == 1 &]
Graphics3D@Point@generateGrid[3, 1/2]


But it won't be very efficient for higher dimensions or fine resolution, due to the use of Tuples[], as mentioned in the comments. This alternative might be better in terms of memory than using Tuples[], although it's not any faster:

generateGrid2[dim_, r_] := Module[{coords, pt},
coords = Range[-1, 1, r];
Last@Reap@Do[
pt = coords[[1 + IntegerDigits[i, Length@coords, dim]]];
If[Max@Abs[pt] == 1, Sow[pt]],
{i, (Length@coords)^dim}]
]


You could always compile this to make it even faster, but of course the algorithm complexity remains the same:

generateGridCompile = Compile[{{dim, _Integer}, {r, _Real}},
Module[{coords, pt, pts, len, i, n = 1},
coords = Range[-1, 1, r];
len = Length@coords;
pts = Table[0., {i, len^dim - 1}, {j, dim}];
Do[pt = coords[[1 + IntegerDigits[i, len, dim]]];
If[Max[Abs[pt]] == 1, pts[[n]] = pt; n++];,
{i, len^dim}];
pts],
CompilationTarget -> "C",
RuntimeOptions -> "Speed"];


• ...or DeleteCases[Tuples[{-1, 0, 1}, 3], {0 ..}]. – J. M. is away May 26 '16 at 11:27
• For finer grids and larger dimensions I would expect this to slow down as Tuples will be making many more elements than are required. Is this likely to be the case? I'd be interested to find a more efficient alternative. (Although I do admit Tuples was my first port of call!) – Quantum_Oli May 26 '16 at 11:41
• Thanks. But what about the resolution to be specified? But I think this is my fault, I should have been more specific, sorry :D – Mauricio Fernández May 26 '16 at 11:54
• @MauricioLobos I've added that, but as I mention you may run into problems with high dimensions or fine resolutions. – dr.blochwave May 26 '16 at 12:21