How to generate grid points on boundary of $[-1,1]^d$ for arbitrary dimension $d$ and specified resolution?
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}}
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
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"];