자연수로 방정식 풀기

Oct 18 2020

나는 조건으로 자연수에서 다음 방정식을 풀려고합니다. $a\ge1$, $b\ge1$, 및 $r\ge3$:

$$\frac{a(a + 3)(a(r - 5) + (12 - r))}{9}=\frac{b (9 + b (-14 + r) - r)}{3}\tag1$$

제가 아는 방법은 다음과 같은 방정식을 푸는 것입니다. $b$ 그리고 나는 얻었다 :

$$b=\displaystyle\frac{1}{6} \left(\sqrt{3\cdot\frac{4 a (a+3) (r-14) (a (r-5)-r+12)+3 (r-9)^2}{(r-14)^2}}+\frac{15}{r-14}+3\right)\tag2$$

이제 Mathematica를 사용하여 제곱근 아래의 함수가 완전한 제곱인지 확인했습니다. 다음 코드를 사용합니다.

ParallelTable[
  If[IntegerQ[
    FullSimplify[
     Sqrt[3*((
        4 a (3 + a) (12 + a (-5 + r) - r) (-14 + r) + 
         3 (-9 + r)^2)/(-14 + r)^2)]]], {a, r}, Nothing], {a, 1, 
   10^5}, {r, 3, 10^5}] //. {} -> Nothing

그리고 내가 얻은 해결책은, 방정식을 넣어 $(1)$ 원래 문제에 대한 해결책을 찾을 수 있는지 확인합니다.

이 방법은 매우 오랜 시간이 걸리지 만 이것을 프로그래밍하는 더 빠르고 똑똑한 방법이 있는지 모르겠습니다. 이것으로 나를 도울 수 있습니까? 많은 감사드립니다.

답변

6 Roman Oct 18 2020 at 21:46

훨씬 빠르게 해결 $r$ 정수인지 확인하십시오. (항상 합리적이며 제곱근이 포함되지 않음)

Solve[(a(a+3)(a(r-5)+(12-r)))/9 == (b(9+b(-14+r)-r))/3, r] // FullSimplify

(*    {{r -> (a(3+a)(-12+5a)+3(9-14b)b)/((-1+a)a(3+a)-3(-1+b)b)}}    *)

R = (a(3+a)(-12+5a)+3(9-14b)b)/((-1+a)a(3+a)-3(-1+b)b);
With[{s = 10^3},
  Do[If[IntegerQ[R] && R >= 3, Sow[{a, b, R}]], {a, s}, {b, s}] // Reap // Last // First]

(*    {{3, 6, 24}, {5, 8, 244}, {5, 10, 31}, {5, 14, 19}, {9, 18, 177},
       {9, 20, 46}, {12, 30, 45}, {32, 112, 139}, {33, 114, 573},
       {35, 126, 220}, {45, 180, 553}, {47, 450, 16}, {48, 204, 129},
       {63, 294, 3750}, {77, 396, 3889}, {116, 728, 46750}}                *)

더 빨라짐 : 계산 대신 $r$ 정수인지 확인하면 분자가 분모로 나눌 수 있는지 확인할 수 있습니다.

R = (a(3+a)(-12+5a)+3(9-14b)b)/((-1+a)a(3+a)-3(-1+b)b);
With[{s = 10^3},
  Do[If[Divisible[a(3+a)(-12+5a)+3(9-14b)b, (-1+a)a(3+a)-3(-1+b)b] && R>=3,
        Sow[{a, b, R}]], {a, s}, {b, s}] // Reap // Last // First]

(*    {{3, 6, 24}, {5, 8, 244}, {5, 10, 31}, {5, 14, 19}, {9, 18, 177},
       {9, 20, 46}, {12, 30, 45}, {32, 112, 139}, {33, 114, 573},
       {35, 126, 220}, {45, 180, 553}, {47, 450, 16}, {48, 204, 129},
       {63, 294, 3750}, {77, 396, 3889}, {116, 728, 46750}}                *)

3 MichaelE2 Oct 18 2020 at 21:36

Fastest square number test 에서 빠른 완전 제곱 테스트를 빌리고 테스트 케이스의 길이를 줄입니다.

(* OP's *)
Table[
   If[IntegerQ[
     FullSimplify[
      Sqrt[3*((4 a (3 + a) (12 + a (-5 + r) - r) (-14 + r) + 
            3 (-9 + r)^2)/(-14 + r)^2)]]], {a, r}, Nothing], {a, 1, 
    300}, {r, 3, 30}] // Flatten[#, 1] & // AbsoluteTiming

(*  {83.9498, {{5, 19}, {117, 15}, {252, 29}}}  *)

sQ[n_] := FractionalPart@Sqrt[n + 0``1] == 0;
Table[
   If[IntegerQ[#] && sQ[#] &[
     3*((4 a (3 + a) (12 + a (-5 + r) - r) (-14 + r) + 
          3 (-9 + r)^2)/(-14 + r)^2)], {a, r}, Nothing], {a, 1, 
    300}, {r, 3, 30}] // Flatten[#, 1] & // AbsoluteTiming

(*  {0.068718, {{5, 19}, {117, 15}, {252, 29}}}  *)

에 대한 $10^5 \times 10^5$ 검색하면 개선 된 코드는 80000 초 정도 소요되지만 $10^8$OP에 걸리는 초. (병렬화 된 경우 적절한 요소로 나눕니다.)

3 UlrichNeumann Oct 18 2020 at 21:41

NSolve제한된 매개 변수 범위로 시도1<= a,b,r <=50

NSolve[{1/9 a (a + 3) (a (r - 5) + 12 - r) ==1/3 b (9 + b (-14 + r) - r) , 50 >= a >= 1, 50 >= b >= 1 ,50 > r >= 1}, {a, b, r}, Integers]
(**{{a -> 3, b -> 6, r -> 24}, 
{a -> 5, b -> 10, r -> 31}, 
{a -> 5,b -> 14, r -> 19},
{a -> 9, b -> 20, r -> 46}, 
{a -> 12, b -> 30,r -> 45}}*)

1 bbgodfrey Oct 19 2020 at 19:13

Roman에 의해 R약간 수정 된 우수한 두 번째 솔루션 은

R = HornerForm[(a (3 + a) (-12 + 5 a) + 3 (9 - 14 b) b)/
    ((-1 + a) a (3 + a) - 3 (-1 + b) b)]
With[{s = 10^4}, Do[If[Divisible[a (3 + a) (-12 + 5 a) + 3 (9 - 14 b) b, 
    (-1 + a) a (3 + a) - 3 (-1 + b) b] && R >= 3, Sow[{a, b, R}]], 
    {a, s}, {b, s}] // Reap // Last // First]

(* {{3, 6, 24}, {5, 8, 244}, {5, 10, 31}, {5, 14, 19}, {9, 18, 177}, {9, 20, 46}, 
    {12, 30, 45}, {32, 112, 139}, {33, 114, 573}, {35, 126, 220}, {45, 180, 553}, 
    {47, 450, 16}, {48, 204, 129}, {63, 294, 3750}, {77, 396, 3889}, {116, 728, 46750}, 
    {117, 2340, 15}, {159, 1166, 6826}, {240, 2156, 2098129}, {243, 2214, 576}, 
    {357, 3906, 72807}, {372, 4154, 2509849}, {492, 6314, 398389}} *)

350 초 안에 나는 다양한 조합을 사용하여 접근 빠르게 찾을 시도 Tuples, Table, Cases,와 Select,하지만 내가 할 수있는 최선이었다

Flatten[Table[If[Divisible[a (-36 + a (3 + 5 a)) + (27 - 42 b) b, 
    a (-3 + a (2 + a)) + (3 - 3 b) b] && R > 2, {a, b, R}, Nothing, Nothing], 
    {a, 10000}, {b, 10000}], 1]

동일한 결과를 동일한 시간에 생성했습니다.

튜토리얼 인 DiophantineReduce 는 다른 많은 경우 중에서도이 질문이있는 "선형 변수가있는 방정식"에 대해 설명합니다. 지원Reduce

Reduce[R == r && a > 0 && b > 0 && r > 2, {a, b, r}, Integers]

1 초 이내에 긴 결과를 산출하며, 그 일부는 사실상

(* b > 1/2 + Sqrt[3 - 12 a + 8 a^2 + 4 a^3]/(2 Sqrt[3]) && r == R *)

(아니 우연 1/2 + Sqrt[3 - 12 a + 8 a^2 + 4 a^3]/(2 Sqrt[3])의 값이 b있는가 Denominator[R] == 0.) 위의 내 방식의 불평등을 고용,

Flatten[Table[If[Divisible[a (-36 + a (3 + 5 a)) + (27 - 42 b) b, 
  a (-3 + a (2 + a)) + (3 - 3 b) b] && R > 2, {a, b, R}, Nothing, Nothing], {a, 10000},
  {b, Ceiling[1/2 + Sqrt[3 - 12 a + 8 a^2 + 4 a^3]/(2 Sqrt[3])], 10000}], 1]

이 답변의 시작 부분에 제공된 결과를 15 초 만에 재현하여 크게 향상되었습니다. 이 접근 방식을 훨씬 더 큰 도메인에 적용하면 (그리고 ParallelTable프로세서가 6 개인 PC에서 사용)

Flatten[ParallelTable[If[Divisible[a (-36 + a (3 + 5 a)) + (27 - 42 b) b, 
    a (-3 + a (2 + a)) + (3 - 3 b) b] && R > 2, {a, b, R}, Nothing, Nothing], 
    {a, 6000}, {b, Ceiling[1/2 + Sqrt[3 - 12 a + 8 a^2 + 4 a^3]/(2 Sqrt[3])], 
    300000}], 1]

 (* {{3, 6, 24}, {5, 8, 244}, {5, 10, 31}, {5, 14, 19}, {9, 18, 177}, {9, 20, 46},
     {12, 30, 45}, {32, 112, 139}, {33, 114, 573}, {35, 126, 220}, {45, 180, 553},
     {47, 450, 16}, {48, 204, 129}, {63, 294, 3750}, {77, 396, 3889}, {116, 728, 46750},
     {117, 2340, 15}, {159, 1166, 6826}, {240, 2156, 2098129}, {243, 2214, 576}, 
     {357, 3906, 72807}, {372, 4154, 2509849}, {492, 6314, 398389}, {768, 12336, 1769}, 
     {1266, 26028, 12553000}, {1545, 43860, 30}, {3792, 138336, 186}, 
     {5973, 266574, 121035}} *)

1070 초 만에 다음은 b대 a.

Show[ListLogLogPlot[%[[2, All, ;;2]], PlotRange -> All, ImageSize -> Large, AxesLabel ->
    {a, b}, LabelStyle -> {14, Bold, Black}], LogLogPlot[1/2 + Sqrt[3 - 12 a + 8 a^2 +
    4 a^3]/(2 Sqrt[3]), {a, 1, 10000}, PlotRange -> All]]

분명히 대부분의 점은 불평등 곡선 바로 위에 있습니다. 이것은 전부는 아니지만 대부분의 솔루션은 곡선 바로 위를 검색하여 얻을 수 있음을 나타냅니다. 예를 들어