# improving efficiency of a code

I have the code:

SquareEdges[n_Integer?Positive] :=
Reap[Do[If[IntegerQ[Sqrt[Prime[i + 1] + Prime[j + 1]]],
Sow[{i, j}]], {i, n - 1}, {j, i + 1, n}]][[2, 1]]

results = {};
n = 13;
While[n < 10001, poss = SquareEdges[n];
gr = Graph[poss, VertexLabels -> Automatic];
numNodes = Length[Select[VertexOutDegree[gr], # < 1 &]];
AppendTo[results, numNodes];
n++]
Print[results]


It seems to be working quite slowly. How can I improve the speed of it?

• What is SquareEdges? It seems to be undefined. Jan 7, 2023 at 9:41
• thx henrik! I have edited it to contain the full code. It did not show it completeley for some reason Jan 7, 2023 at 10:05
• See here for a faster way to check if an integer number is a perfect square (much faster than your If[IntegerQ[Sqrt[...]]]). Jan 7, 2023 at 12:09

Clear[SquareEdges]
SquareEdges[n_Integer?Positive] :=
Reap[Do[If[IntegerQ[Sqrt[Prime[i + 1] + Prime[j + 1]]],
Sow[{i, j}, ToString@n]], {i, n - 1}, {j, i + 1, n}]][[2, 1]]


You don't have to calculate these repeatedly as every iteration adds a few more entries. The following lookup takes 5.8s on my machine.

lut = SquareEdges[1001];


Now you can lookup from this table and Sow instead of Append:

n = 13;
Reap[While[n < 1001, poss = Select[lut, Last@# <= n &];
gr = Graph[poss(*,VertexLabels\[Rule]Automatic*)];
Sow[Length[Select[VertexOutDegree[gr], # < 1 &]]
];
n++]][[2, 1]] // AbsoluteTiming


Result

{3.16412, {1, 2, 2, 2, 2, 2, 3, 3, 3, 4, 4, 4, 3, 3, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 5, 4, 4, 4, 5, 5, 5, 5, 6, 6, 6, 6, 7, 7, 7, 7, 6,
6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 7, 6, 6, 6, 6, 6, 6, 8, 8, 8, 8,
8, 8, 8, 8, 9, 9, 10, 10, 10, 10, 10, 10, 8, 7, 7, 7, 7, 7, 7, 7,
7, 7, 7, 7, 7, 6, 6, 6, 7, 7, 7, 7, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 9,
9, 9, 8, 8, 8, 8, 6, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 7, 6, 6,
7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 6, 6, 6, 6, 6, 6, 6,
6, 6, 6, 8, 8, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10,
10, 10, 10, 10, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10,
10, 10, 10, 10, 10, 10, 9, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10,
11, 11, 11, 11, 11, 11, 12, 12, 12, 11, 11, 11, 11, 11, 11, 11, 11,
11, 11, 11, 11, 11, 11, 12, 12, 11, 11, 11, 10, 10, 10, 10, 10, 10,
10, 10, 10, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 12, 12,
12, 13, 12, 10, 10, 11, 11, 11, 11, 11, 11, 11, 11, 11, 10, 10, 8,
8, 8, 8, 8, 8, 8, 8, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8,
8, 8, 8, 8, 8, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 7, 7,
7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8,
8, 8, 8, 8, 8, 8, 8, 9, 9, 9, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
8, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 7, 7, 7, 7,
7, 7, 7, 7, 7, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5, 5,
5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6,
6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
8, 8, 8, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 9, 9, 9,
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 8, 8, 8, 8,
8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
8, 8, 8, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 9, 8, 8, 8, 8, 8,
8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 7, 7, 7, 7, 7, 7, 6, 5,
5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
5, 5, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
5, 5, 5, 5, 5, 5, 5, 5, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
4, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6,
6, 6, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
7, 7, 7, 7, 7, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6,
6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6,
6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 8,
8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
8, 8, 8, 8, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
7, 7, 7, 6, 6, 6, 6, 6, 6, 6}}

• thanks for answering! Another question: Is ther anything I can do to get the estimated time of this code? cuz I am planning to run it for 1000000 numbers. Jan 7, 2023 at 16:04
• My knowledge about Graphs is quite superficial. I would suggest that you follow the modifications suggested by Henrik Schumacher and post a fresh question when you have given it your best shot.
– Syed
Jan 7, 2023 at 16:45

In addition to what Syed already pointed out, you can speed up the search for the restricted set of edges by using a SparseArray and by using Table instead of Sow and Reap. Moreover, I suggest to employ Count because it is more idiomatic (and also a bit faster because it does not have to create sets first):

A = SparseArray[lut -> _, {1001, 1001}];
result = Table[
Count[VertexOutDegree[Graph[A[[1 ;; n, 1 ;; n]]["NonzeroPositions"]]], 0]
, {n, 13, 1000}];


Originally, I meant to propose

AbsoluteTiming[
A = SparseArray[lut -> _, {1001, 1001}];
result = Table[
Differences[A[[1 ;; n, 1 ;; n]]["RowPointers"]]
, {n, 13, 1000}];
]


which is 10 times faster (because it avoid Graph altogether). But it gives a different result if not all vertices of from 1 to n appear in loss = A[[1 ;; n, 1 ;; n]]["NonzeroPositions"]. Not sure whether you want the one or the other...

The idea is that you use A[[1 ;; n, 1 ;; n]] (or rather its symmetrization) as the adjacency matrix of an undirected graph. Then rp = A[[1 ;; n, 1 ;; n]]["RowPointers"] contains the numbers of nonzeroes per row (== number of edges a vertex is attached to). More precisely, vertex i has rp[[i+1]] - rp[[i]] neighbors.