3
$\begingroup$

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 &];  
SetProperty[g, {VertexLabels -> (Thread[
 sources -> Placed["Name", Center]]), 
VertexSize -> (Thread[sources -> 3/2])}]
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:
enter image description here

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?
Thanks, kglr, for the answer.

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

Mathematica graphics

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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