I googled for images of graphs and found nothing that even comes close to this one, so I want to experiment some more.

limc = 4;
primes = Join[{1}, Prime[Range[limc]]];
(* if you want to evaluate several times, put the above 2 lines in a
separate cell and evaluate. Then run these below as needed *)

limc = Length[primes] - 1;
limv = Prime[limc + 1]^2 - 1;
a = Flatten[Table[p -> p (m + 1), {p, primes}, {m, 1, limv/p - 1}]];
g = Graph[a];
sources = Select[VertexList[g],VertexOutDegree[g, #] >= 1 &];
sources -> Placed["Name", Center]]),
Show[g]
primes = Join[primes, Flatten[Position[VertexDegree[g], 1]]];
Print[Length[%] - 1 , " primes less than ", limv]


The graph of the first 4 primes up to limv is:

You will notice the one points to many odd numbers that have only one connection. These are the primes.

My question: It there a method to retrieve parts of a graph from the graph object? Yes, we can use Flatten[Position[VertexDegree[g], 1]] as indicated above. The key to this solution was to use 1 (unity) to point to all numbers in the range. Then only the numbers with VertexDegree of 1 are the primes.

New question: How do we get only the source numbers p labeled?

• @J.M. blood diamond? Apr 2, 2016 at 17:36
• @Yves, it's been years and I still haven't seen one. Apr 2, 2016 at 17:38
• How come the color? I know your skills are red hot, of course... Apr 2, 2016 at 17:39
• Maybe an aesthetic choice. Apr 2, 2016 at 19:24
• sources = Select[VertexList[g], VertexOutDegree[g, #] > = 1 &]; SetProperty[g, {VertexLabels -> (Thread[ sources -> Placed["Name", Center]]), VertexSize -> (Thread[sources -> 3/2])}]?
– kglr
Apr 3, 2016 at 11:17

sources = Select[VertexList[g], VertexOutDegree[g, #] >= 1 &];