4
$\begingroup$

A number is 5-smooth if its only prime factors are 2, 3 or 5.

Example:

1, 2, 3, 4, 5, 6, 8, 9, 10, 12, 15, …

Interesting thing is that as they become larger and larger, they are sparser and sparser, with respect to all natural numbers...

Now, how to make a visual illustration of that fact (becoming sparser)?

I was thinking of lets say a 300 x 1000 rectangle, where each pixel means a natural number, and red is 5-smooth, blue is otherwise. This would work for first 300,000 numbers.

Here is a collection of programs in various language regarding 5-smooth numbers: link

Including this:

HammingList[N_] := 
  Module[{A, B, C}, 
    {A, B, C} = 
      (N^(1/3))*{2.8054745679851933, 1.7700573778298891, 1.2082521307023026} - {1, 1, 1};
    Take[Sort @ Flatten @ 
      Table[2^x * 3^y * 5^z , 
        {x, 0, A}, {y, 0, (-B/A)*x + B}, {z, 0, C - (C/A)*x - (C/B)*y}],
      N]];

and

HammingList[20]
 {1, 2, 3, 4, 5, 6, 8, 9, 10, 12, 15, 16, 18, 20, 24, 25, 27, 30, 32, 36}
HammingList[1691] // Last
2125764000
HammingList[1000000] // Last
519312780448388736089589843750000000000000000000000000000000000000000000000000000000

Appreciate any idea and/or insight.

$\endgroup$
1
  • $\begingroup$ What exactly are asking us? You already have a generator written in Mathematica, albeit with bad variable names. You have a concept of how you to display the results, a raster of red and blue pixels -- that's not hard to generate. So what specifically do want from us? $\endgroup$
    – m_goldberg
    Commented May 10, 2014 at 0:23

4 Answers 4

2
$\begingroup$

What about simple Histogram:

Histogram[HammingList[100000], ScalingFunctions -> {Identity, "Log"}, Frame -> True, 
                               BaseStyle -> {18, Bold}, ImageSize -> 800]

enter image description here

$\endgroup$
6
$\begingroup$

Here's some code which produces an image depicting the density of 5-smooth numbers with bright pixels on a dark background, with higher numbers on the right side of the image.

size = 200;
Image @ Transpose @ 
  Partition[
    If[Max @ First @ Transpose @ FactorInteger @ # <= 5, 0.75, 0] & /@ 
      Range[size^2], 
    size/2]

enter image description here

If an integer satisfies the condition that its largest prime factor is less than or equal to 5, it is assigned a value of 0.75 (light gray). Otherwise, it is assigned 0 (black). The first size^2 positive integers are represented in the image.

$\endgroup$
3
$\begingroup$

This is not answer; it is an extended comment on user2790167's answer.

I think the results from phosgene's code would render the data better if it used color rather than gray-scale. The OP asked for red and blue, but this has contrast problems about as severe as phosgene's answer. I propose using fully saturated red and a very light (desaturated) sky blue.

size = 200;
red = {1, 0, 0};
lightBlue = {.85, .93, 1};

Image @ Transpose@
  Partition[
    If[Max @ First @ Transpose @ FactorInteger @ # <= 5, red, lightBlue] & /@ 
      Range[size^2], 
    size/2]

image

$\endgroup$
1
  • $\begingroup$ I have executed replacement rule User2790167 -> phosgene $\endgroup$
    – phosgene
    Commented May 10, 2014 at 18:10
3
$\begingroup$

What if you made a number spiral similar to the prime spiral of Stanislaw Ulam? This transforms the 1D distribution of Hamming numbers into a 2D distribution. Note that kSmoothSpiral generalizes to any k-smooth number.

NumberSpiral[n_Integer] :=
   Block[{m = Floor[N[Sqrt[n]]]},
      If[
         EvenQ[Floor[2.0*Sqrt[n]]],
         {(-1)^m*((n - m*(m + 1)) + Ceiling[m/2]), (-1)^m*(-Ceiling[m/2])},
         {(-1)^m*(Ceiling[m/2]), (-1)^m*((n - m*(m + 1)) - Ceiling[m/2])}
      ]]

kSmoothSpiral[n_Integer, k_Integer] :=
   With[{r = Range[0, n]},
      Map[NumberSpiral, 
      Pick[r, UnitStep[k - Map[Max, FactorInteger[r][[All, All, 1]]]], 1]]
   ]

A 2D histogram shows how the density of smooth numbers drops off radially.

SmoothHistogram3D[kSmoothSpiral[1000000,5], 
   ColorFunction -> (ColorData["DarkRainbow", #3^0.3] &), 
   Boxed -> False, Axes -> False]

k-Smooth Spiral

$\endgroup$
1
  • $\begingroup$ Fascinating! The visualization method is similar to "memory mountain" (google.com/…) $\endgroup$
    – VividD
    Commented Jul 10, 2014 at 19:31

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.