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?
• sources = Select[VertexList[g], VertexOutDegree[g, #] > = 1 &]; SetProperty[g, {VertexLabels -> (Thread[ sources -> Placed["Name", Center]]), VertexSize -> (Thread[sources -> 3/2])}]? – kglr Apr 3 '16 at 11:17
sources = Select[VertexList[g], VertexOutDegree[g, #] >= 1 &];