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

1 Answer 1

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$
3
  • $\begingroup$ I want the equation has always two integers solutions. $\endgroup$ Aug 11, 2016 at 6:29
  • $\begingroup$ I don't want the equation has this form 5, 5, 5, 5, 4, 4, -1, -1. $\endgroup$ Aug 11, 2016 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, 2016 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.