How can I reduce time to run this code?

I want to find the coefficients $a$, $b$, $c$, $d$, $e$, $k$ of the equation $$\sqrt{a x+b}+\sqrt{c x+d}=\sqrt{e x+k},$$ where $a$, $b$, $c$, $d$, $e$, $k$ belongs to $[-8,8]$ and different from 0 so that the given equation has two integer solutions (different from 0). For example, the equation $$\sqrt{6-x}+\sqrt{2x-3}=\sqrt{3x+3}$$ has two solutions $x=2 \lor x=3.$

I tried

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


But, this code runs too long and I can't get the solution. How can I reduce the execution time?

For a long time, I got some equations

• Do you mean run the code or Compile[] it? (See link.) Aug 11, 2016 at 2:13
• I want to run the code. Aug 11, 2016 at 2:14
• I want to run the code. Aug 11, 2016 at 2:23
• You have 6 parameters, each with 16 possible values, thus you have 16^6=16777216 cases to check. With repeated squaring you can reduce your problem to a quadratic. To have two roots the discriminant must be >0, that still leaves more than 8 million cases. You can check for integer roots of your quadratic, that still leaves 297930 equations, each with a pair of integer roots. How fast do you expect that to be?
– Bill
Aug 11, 2016 at 8:08

You can rewrite the code with Compile to speed up it, it really works a lot.

Firstly use Solve and Simplify to get a shorter expression of x.

In[1]:= x /.
Solve[{Sqrt[a x + b] + Sqrt[c x + d] == Sqrt[e x + k]},
x] // Simplify

Out[1]= {(b c - c d + b e + d e + c k - e k + a (-b + d + k) -
2 Sqrt[b^2 c e + a (d^2 e + d (a - c - e) k + c k^2) -
b (-(c - e) (-d e + c k) + a (d e + c k))])/(a^2 + (c - e)^2 -
2 a (c + e)),
(b c - c d + b e + d e + c k - e k + a (-b + d + k) +
2 Sqrt[b^2 c e + a (d^2 e + d (a - c - e) k + c k^2) -
b (-(c - e) (-d e + c k) + a (d e + c k))])/(a^2 + (c - e)^2 -
2 a (c + e))}


Then write a function cf by Compile to find if a given {a, b, c, d, e, k} has integer solution x. And use this function to test all possible {a, b, c, d, e, k}

In[2]:= cf = Compile[{{list, _Integer, 1}},
(*if x is an integer, return {a,b,c,d,e,k,x}, else return {}*)
Module[{a, b, c, d, e, k, delta, tmp1, tmp2, tmp3, x1, x2,
resultlist},
{a, b, c, d, e, k} = list;
delta =
b^2 c e - b d (a + c - e) e - b c (a - c + e) k +
a (d^2 e - d (-a + c + e) k + c k^2);
If[delta < 0, {},
tmp1 = b (c + e) - (c - e) (d - k) + a (-b + d + k);
tmp2 = 2 Sqrt[delta];
tmp3 = a^2 + (c - e)^2 - 2 a (c + e);
If[tmp3 == 0, {},
x1 = (tmp1 + tmp2)/tmp3; x2 = (tmp1 - tmp2)/tmp3;
resultlist = Select[{x1, x2}, Round[#] == # &];
If[resultlist == {}, {}, Join[list, resultlist]]
]] // Round
], RuntimeAttributes -> Listable
];
result = cf@Tuples[DeleteCases[Range[-8, 8], 0], 6] //
DeleteCases[#, {}] &; // AbsoluteTiming

Out[3]= {9.368221, Null}


It takes less than 10 seconds to get the result.

• I want the equation has always two integers solutions. Aug 11, 2016 at 6:29
• I don't want the equation has this form 5, 5, 5, 5, 4, 4, -1, -1. Aug 11, 2016 at 6:32
• You can change delta < 0 into delta <= 0 so that the two solutions will be different Aug 11, 2016 at 7:10