Here is a relatively compact Mathematica routine for generating the -th iterate of a Hilbert curve in . The algorithm is due to Skilling:

HilbertCurve =
Compile[{{x, _Integer}, {b, _Integer}, {n, _Integer}},
Module[{t = BitXor[x, Quotient[x, 2]], p = 2, k, q, r, xx},
xx = Total[Table[BitAnd[Quotient[t, 2^(r (n - 1) + k)], 2^r],
{r, b - 1, 0, -1}, {k, n - 1, 0, -1}]];
Do[q = p - 1;
Do[t = xx[[k]];
If[BitAnd[t, p] != 0,
xx[[1]] = xx[[1]] ~BitXor~ q,
t = BitAnd[t ~BitXor~ xx[[1]], q];
xx[[{1, k}]] = BitXor[xx[[{1, k}]], t]],
{k, n, 2, -1}];
If[BitAnd[xx[[1]], p] != 0,
xx[[1]] = xx[[1]] ~BitXor~ q];
p *= 2, {r, b - 1}];
2 xx/(p - 1) - 1], RuntimeAttributes -> {Listable}]

I’ve seen a variety of routines for generating the Hilbert curve before, but none were as compact or as general as this one. If you want a version that generates exact rational coordinates, it is easy to take out the requisite parts from the Compile[] function.

(This visualization is admittedly a bit messy-looking; if you have suggestions for making a nice display of the four-dimensional version, tell me about it in the comments!)

Advertisements

Like this:

LikeLoading...

Related

This entry was posted on Monday, January 30th, 2017 at 4:14 am and is filed under Curves, Graphics. You can follow any responses to this entry through the RSS 2.0 feed.
You can leave a response, or trackback from your own site.