2
$\begingroup$

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 enter image description here enter image description here enter image description here

$\endgroup$
  • $\begingroup$ Do you mean run the code or Compile[] it? (See link.) $\endgroup$ – Michael E2 Aug 11 '16 at 2:13
  • 1
    $\begingroup$ I want to run the code. $\endgroup$ – minthao_2011 Aug 11 '16 at 2:14
  • $\begingroup$ I want to run the code. $\endgroup$ – minhthien_2016 Aug 11 '16 at 2:23
  • 1
    $\begingroup$ 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? $\endgroup$ – Bill Aug 11 '16 at 8:08
7
$\begingroup$

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.

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

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.