# How can I reduce the time to run this code?

I am trying to find the integers $$a, b, c, d \in [-15, -1] \cup [1, 15]$$ so that the equation $$\left| x^2 + a x + b \right| = c x + d$$ has four distinct integeral solutions different from $$0$$.

To this end, I tried

ClearAll[a, b, c, d];
sol = x /. Solve[{Abs[x^2 + a x + b] == c x + d} , x, Reals];
ClearAll[f];
(f[{a_, b_, c_, d_}] :=
Quiet@Check[And @@ (IntegerQ /@ #), False]) &[sol]
poss = Select[
Tuples[Range[-15,
15], {4}],  #[[1]] #[[2]] #[[3]] #[[4]] !=
0  && #[[1]]^2 - 4 #[[2]] > 0 && #[[2]]^2 - #[[4]]^2 != 0 &&
f[#] &];
Take[poss, Length[poss]];
With[{s = sol},
getSolution[poss_] := Block[{a, b, c, d}, {a, b, c, d} = poss;
Join[poss, s]]]
getSolution /@ poss


and got 426 solutions. But the time is about 15 minutes. How can I reduce the time?

First solve the equation analytically:

sol[a_, b_, c_, d_] = Solve[Abs[x^2 + a x + b] == c x + d, x][[All, 1, 2]] // FullSimplify

{1/2 (-a + c - Sqrt[-4 b + (a - c)^2 + 4 d]),
1/2 (-a + c + Sqrt[-4 b + (a - c)^2 + 4 d]),
1/2 (-a - c - Sqrt[(a + c)^2 - 4 (b + d)]),
1/2 (-a - c + Sqrt[(a + c)^2 - 4 (b + d)])}


Then establish the grid to be searched:

grid = Tuples[DeleteCases[Range[-15, 15], 0], 4];


This sets the selection condition:

predicate = And[FreeQ[#, 0], And @@ (IntegerQ /@ #), DuplicateFreeQ[#]] &[sol @@ #] && And @@ Thread[#[[3]] (sol @@ #) + #[[4]] >= 0]&;


And finally, perform the selection:

(gridSelected = Parallelize[Select[grid, predicate]];) // AbsoluteTiming

{15.3167, Null}


Check the result

Length[gridSelected]
RandomSample[gridSelected, 10]
sol @@@ %

426

{{-10, -3, 2, 10}, {-8, 13, -1, 7}, {1, -11, -4, 13},
{12, -5, -4, 12}, {-4, -14, 1, 10}, {-12, -10, 9, 12},
{12, -4, -3, 12}, {-7, -14, 2, 8}, {-15, -12, 11, 15}, {11, -8, -7, 11}}

{{-1, 13, 1, 7}, {1, 6, 4, 5}, {-8, 3, 1, 2}, {-17, 1, -7, -1},
{-3, 8, -1, 4}, {-1, 22, 1, 2}, {-16, 1, -8, -1}, {-2, 11, -1, 6},
{-1, 27, 1, 3}, {-19, 1, -3, -1}}

• There are some tuples with solution is 0. Please repair. – minhthien_2016 Oct 23 '18 at 9:31
• @minhthien_2016 I used FreeQ[#, 0] in the predicate, so I think there are not solutions with 0. The grid does not contain 0 either, because I deleted it before building grid. – Αλέξανδρος Ζεγγ Oct 23 '18 at 9:33
• I tried Length[gridSelected] gridSelected[[;; 100]] sol @@@ % and tried with solution 100. Reduce[Abs[x^2 - 14 x + 12] == 13 x - 14, x, Reals]. This equation only has two solutions. – minhthien_2016 Oct 23 '18 at 9:58
• @minhthien_2016 There might exist erroneous solutions. – Αλέξανδρος Ζεγγ Oct 23 '18 at 10:11
• @minhthien_2016 I added an additional condition to the predicate to exclude the erroneous solutions. Please see the updated contents. – Αλέξανδρος Ζεγγ Oct 23 '18 at 10:20
Clear["*"]
grid = Tuples[DeleteCases[Range[-15, 15], 0], 4];

cpicked =
With[{IntegerQ = FractionalPart[#] == 0 &},
Compile[{{m, _Integer, 1}},
Module[{a = m[[1]], b = m[[2]], c = m[[3]], d = m[[4]], delta1,
delta2, r1, r2, r3, r4},
If[(a + c)^2 - 4 (b + d) < 0 || (a - c)^2 - 4 (b - d) < 0,
0,
delta1 = Sqrt[(a - c)^2 - 4 (b - d)];
delta2 = Sqrt[(a + c)^2 - 4 (b + d)];
r1 = 1/2 (-a + c - delta1);
r2 = 1/2 (-a + c + delta1);
r3 = 1/2 (-a - c - delta2);
r4 = 1/2 (-a - c + delta2);
r1 != r2 != r3 != r4 != 0 &&
d + c r1 >= 0 && d + c r2 >= 0 && d + c r3 >= 0 && d + c r4 >= 0 &&
IntegerQ[r1] && IntegerQ[r2] && IntegerQ[r3] && IntegerQ[r4] // Boole]],
RuntimeAttributes -> {Listable}]
];

(ans = Pick[grid, cpicked @grid, 1]) // Length // AbsoluteTiming


{0.470872, 426}

• If I want to GCD[c,d]==1`. Where I put this conditions? – minhthien_2016 Oct 24 '18 at 11:47
• Thank you for your edit. – minhthien_2016 Oct 25 '18 at 9:13