[第77期]编写VBA代码解方程

wcymiss

1. Sub qj()
   
2.     Dim x#, y#, t&, p&, D#
   
3.     D = InputBox("请输入pell方程x^2-Dy^2=1的D值：")
   
4.     '题目只有73和61，就不写容错语句了。
   
5.     t = Timer
   
6.     y = 0: x = 0: p = 0
   
7.     Do
   
8.         y = y + 1
   
9.         x = (1 + D * y ^ 2) ^ 0.5
   
10.         If Int(x) = x Then
    
11.             If Right(Right(y, 5) ^ 2 * D + 1, 5) * 1 = Right(Right(x, 5) ^ 2, 5) * 1 Then p = 1
    
12.         End If
    
13.     Loop While p = 0
    
14.     MsgBox "方程x^2-" & D & "y^2=1的最小正整数解为：(" & x & "," & y & ")" & Chr(10) & Chr(10) & "使用时间：" & Timer - t & "秒"
    
15. End Sub

复制代码

fangjianp

可以输入<100的非平方自然数,求解时间<1%秒
详见附件
请狼版老师审核!

[ 本帖最后由 fangjianp 于 2011-7-3 19:10 编辑 ]

wangexcel009

pell方程式，
以前做过的，euler题目的第66题Problem 66
26 March 2004
Consider quadratic Diophantine equations of the form:
x2 – Dy2 = 1
For example, when D=13, the minimal solution in x is 6492 – 131802 = 1.
It can be assumed that there are no solutions in positive integers when D is square.
By finding minimal solutions in x for D = {2, 3, 5, 6, 7}, we obtain the following:

32 – 222 = 1
22 – 312 = 1
92 – 542 = 1
52 – 622 = 1
82 – 732 = 1
Hence, by considering minimal solutions in x for D  7, the largest x is obtained when D=5.
Find the value of D  1000 in minimal solutions of x for which the largest value of x is obtained.
Answer: 661  
第一题：

1）      x 2-73y2=1 的最小正整数解
Sub aaa()
Dim x, y
d = 73
x = 2
aaa:
y = Int(Sqr((x ^ 2 - 1) / d))
If x ^ 2 - d * y ^ 2 = 1 Then
Debug.Print x, y
Exit Sub
End If
x = x + 1
GoTo aaa
End Sub

answer: 2281249       267000

第二题：
2）      x 2-61y2=1 的最小正整数解
Sub aaa()
t1 = Timer
Dim a(100)
Dim p(100)
Dim q(100)
Dim pp(100)
Dim qq(100)

mx = 0

For D = 61 To 61
If Sqr(D) = Int(Sqr(D)) Then D = D + 1
a(0) = Int(Sqr(D))
p(0) = a(0)
q(0) = 1
pp(0) = 0
qq(0) = 1
pp(1) = a(0)
qq(1) = D - a(0) * a(0)
a(1) = Int((a(0) + pp(1)) / qq(1))
p(1) = a(0) * a(1) + 1
q(1) = a(1)

n = 1
Do While a(n) <> 2 * a(0)
   n = n + 1
   pp(n) = a(n - 1) * qq(n - 1) - pp(n - 1)
   qq(n) = (D - pp(n) * pp(n)) / qq(n - 1)
   a(n) = Int((a(0) + pp(n)) / qq(n))
   p(n) = a(n) * p(n - 1) + p(n - 2)
   q(n) = a(n) * q(n - 1) + q(n - 2)
Loop

r = n - 1

If r / 2 = Int(r / 2) Then
   For n = r + 2 To 2 * r + 1
      pp(n) = a(n - 1) * qq(n - 1) - pp(n - 1)
      qq(n) = (D - pp(n) * pp(n)) / qq(n - 1)
      a(n) = Int((a(0) + pp(n)) / qq(n))
      p(n) = a(n) * p(n - 1) + p(n - 2)
      q(n) = a(n) * q(n - 1) + q(n - 2)
   Next n
   If p(2 * r + 1) > mx Then
      mx = p(2 * r + 1)
      maxd = D
   End If
    Debug.Print D; p(2 * r + 1); q(2 * r + 1), mx; maxd
Else
   If p(r) > mx Then
      mx = p(r)
      maxd = D
   End If
    Debug.Print D; p(r); q(r), mx; maxd
End If
Next D
Debug.Print mx; maxd
Debug.Print Timer - t1
End Sub

answer: 1766319049  226153980

[ 本帖最后由 wangexcel009 于 2011-6-24 13:11 编辑 ]

xmyjk

题一解答：X=2281249,Y=267000

1. Option Explicit
   
2. Sub testb()
   
3. Dim x As Double, y, i As Integer, a As Long, t As Single
   
4. 
   
5. t = Timer
   
6. y = Array(0, 1, 4, 5, 6, 9)
   
7. For a = 1 To 100000
   
8.   For i = 0 To 5
   
9.      x = Sqr((1 + (a * 10 + y(i)) ^ 2 * 73))
   
10.      If x - Int(x) = 0 Then
    
11.      [a2] = x: [b2] = a * 10 + y(i)
    
12.      GoTo line1
    
13.      End If
    
14.   Next
    
15. Next
    
16. 
    
17. line1:
    
18. MsgBox Timer - t & "秒"
    
19. End Sub
    

复制代码

第二题：X=1766319049,Y =226153980

1. Sub test1()
   
2. Dim x As Double, yy(0 To 5) As Integer, x2 As Double, t As Single, i As Integer, a As Long, y As Double
   
3. 
   
4. t = Timer
   
5. yy(0) = 0: yy(1) = 2: yy(2) = 3: yy(3) = 5: yy(4) = 7: yy(5) = 8
   
6. For a = 1 To 300000000
   
7.   For i = 0 To 5
   
8.     y = a * 10 + yy(i)
   
9.     x2 = 61 * y ^ 2 + 1
   
10.     x = Sqr(x2)
    
11.     If x - Int(x) = 0 And x ^ 2 = x2 Then
    
12.       If Right(chengfa(x, x), 5) - Right(chengfa(Val(chengfa(y, 61)), y), 5) = 1 Then
    
13.         Debug.Print x, y
    
14.         [A2] = Str(x): [b2] = Str(y)
    
15.         MsgBox Timer - t & "秒"
    
16.         Exit Sub
    
17.       End If
    
18.     End If
    
19.   Next
    
20. Next
    
21. End Sub
    
22. 
    
23. Function chengfa(y As Double, cs As Double) As String
    
24. Dim a() As Integer, i As Long, b() As Double, c As String, csw As Long
    
25. 
    
26. csw = Len(Trim(Str(cs)))
    
27. ReDim a(1 To csw) As Integer
    
28. ReDim b(1 To csw) As Double
    
29. c = ""
    
30. For i = 1 To csw
    
31.    a(i) = Mid(Trim(Str(cs)), csw - i + 1, 1)
    
32.    b(i) = a(i) * y
    
33.    If i = 1 Then
    
34.       c = b(i)
    
35.    Else
    
36.       c = (b(i) + Val(Left(c, Len(c) - i + 1))) & Right(c, i - 1)
    
37.    End If
    
38. Next
    
39. 
    
40. chengfa = c
    
41. 
    
42. End Function
    

复制代码

[ 本帖最后由 xmyjk 于 2011-7-17 22:59 编辑 ]

yumoym

问题1：

1. Sub solution()
   
2.   '1） x^2-73*y^2=1 的最小正整数解
   
3.   y = 1
   
4.   While Int(Sqr(1 + 73 * y ^ 2)) <> Sqr(1 + 73 * y ^ 2)
   
5.     y = y + 1
   
6.   Wend
   
7.   MsgBox "x=" & Sqr(1 + 73 * y ^ 2) & ",y=" & y
   
8. End Sub
   

复制代码

chen2010

我求得X=2281249，Y=267000，不知对不对？怎么样弄回复才是楼主可见？
贴个附件

[ 本帖最后由 chen2010 于 2011-7-7 09:12 编辑 ]

cjh-01

ddddddddddd

huoxieshen

第一题：

1. Sub mysub()
   
2. Dim x As Double, y As Double
   
3.   For y = 1 To 500000
   
4.    x = 73 * y ^ 2 + 1
   
5.    If Sqr(x) = Int(Sqr(x)) Then
   
6.       If Sqr(x) = CLng(Sqr(x)) Then
   
7.           MsgBox "x ^ 2 - 73 * y ^ 2 = 1的最小正整数解是：" & Sqr(x) & " " & y
   
8.            Exit For
   
9.       Else
   
10.       End If
    
11.    Else
    
12.    End If
    
13.    Next y

复制代码

第一题也可以按第二题方法解：如：

1. Sub mysub2()
   
2. Dim n As Integer
   
3. Dim a(1000) As Variant, p(1000) As Variant, q(1000) As Variant, x(1000) As Variant, y(1000) As Variant
   
4. x(1) = 0
   
5. a(1) = Int(Sqr(73))
   
6. y(1) = 1
   
7. x(2) = a(1)
   
8. y(2) = 73 - x(2) ^ 2
   
9. p(1) = a(1)
   
10. q(1) = 1
    
11. For n = 2 To 100
    
12. a(n) = Int((a(1) + x(n)) / y(n))
    
13. x(n + 1) = a(n) * y(n) - x(n)
    
14. y(n + 1) = (73 - x(n + 1) ^ 2) / y(n)
    
15. q(2) = a(2)
    
16. p(2) = a(1) * a(2) + 1
    
17. p(n) = a(n) * p(n - 1) + p(n - 2)
    
18. q(n) = a(n) * q(n - 1) + q(n - 2)
    
19. If y(n) = 1 And n Mod 2 = 1 Then
    
20. MsgBox "x ^ 2 - 73* y ^ 2 = 1的最小正整数解是：" & p(n - 1) & " " & q(n - 1)
    
21. Exit For
    
22. Else
    
23. End If
    
24. Next n
    
25. End Sub

复制代码

End Sub第二题：

1. Sub mysub2()
   
2. Dim n As Integer
   
3. Dim a(1000) As Variant, p(1000) As Variant, q(1000) As Variant, x(1000) As Variant, y(1000) As Variant
   
4. x(1) = 0
   
5. a(1) = Int(Sqr(61))
   
6. y(1) = 1
   
7. x(2) = a(1)
   
8. y(2) = 61 - x(2) ^ 2
   
9. p(1) = a(1)
   
10. q(1) = 1
    
11. For n = 2 To 100
    
12. a(n) = Int((a(1) + x(n)) / y(n))
    
13. x(n + 1) = a(n) * y(n) - x(n)
    
14. y(n + 1) = (61 - x(n + 1) ^ 2) / y(n)
    
15. q(2) = a(2)
    
16. p(2) = a(1) * a(2) + 1
    
17. p(n) = a(n) * p(n - 1) + p(n - 2)
    
18. q(n) = a(n) * q(n - 1) + q(n - 2)
    
19. If y(n) = 1 And n Mod 2 = 1 Then
    
20. MsgBox "x ^ 2 - 61 * y ^ 2 = 1的最小正整数解是：" & p(n - 1) & " " & q(n - 1)
    
21. Exit For
    
22. Else
    
23. End If
    
24. Next n
    
25. End Sub

复制代码

[ 本帖最后由 huoxieshen 于 2011-7-12 15:27 编辑 ]

abing3

方程不一样,请代入不同的变数 p   (第一题2 秒左右, 第二题 6分钟左右)
代码如下.

Dim a(200), b(200), c(200), d(200), e(200), resultstring As String, total, total1



Sub test()
Dim k As Double, m As Double, n As Double, flag, i, p As Long


p = 61   '乘数赋值给P   61  or 73


flag = 0
k = 1
While k > 0
m = k * k * p + 1
      
             n = m ^ 0.5
  
          If Val(n) = Int(n) Then
      
                  If n * n = m Then
                  
               
                  
                    

                    Call abc(k, p, 1)
                    Call ab(n)
                    
                    For i = 0 To total - 5
                    
                    
                    
                     If c(i) = d(i) Then
                     flag = 1
                     
                      Else
                      i = total
                      flag = 0
                     
                      End If
                     
                    
                    Next
                    
                    If flag = 1 Then
                    
                  
                  
                     Debug.Print "最小的正整数解如下"
                     Debug.Print "X="; n
                     
                     Debug.Print "Y="; k
                     
                        k = -3
                    End If
                  
                  End If
         
           End If
   
k = k + 1

Wend

End Sub


Sub ab(n As Double)
Dim i, j, k, t, add


For i = 0 To 200

a(i) = 0
b(i) = 0
c(i) = 0

Next




k = n
t = k

For i = 0 To Len(t) - 1
  
   a(i) = Right(t, 1)
    t = Left(t, Len(t) - 1)
   


Next

For i = 0 To Len(k) - 1
   For j = 0 To Len(k) - 1

   b(i + j) = a(i) * a(j)
  
    c(i + j) = c(i + j) + b(i + j)
   
  
   
     
         If c(i + j) > 9 Then
   
     add = c(i + j) \ 10 ' add 进位的数
     
     c(i + j) = c(i + j) Mod 10
     

        c(i + j + 1) = c(i + j + 1) + add
      

      
     Else
     
     
     add = 0
   
   
    End If
   

   
   
Next




Next


total = i + j


  

End Sub



Sub abc(n As Double, m As Long, u As Long)
Dim i, j, k, t, add, f


For i = 0 To 200

a(i) = 0
b(i) = 0
c(i) = 0
d(i) = 0

Next




k = n
t = k

For i = 0 To Len(t) - 1
  
   a(i) = Right(t, 1)
    t = Left(t, Len(t) - 1)
   


Next

For i = 0 To Len(k) - 1
   For j = 0 To Len(k) - 1

   b(i + j) = a(i) * a(j)
  
    c(i + j) = c(i + j) + b(i + j)
   
  
   
     
         If c(i + j) > 9 Then
   
     add = c(i + j) \ 10 ' add 进位的数
     
     c(i + j) = c(i + j) Mod 10
     

        c(i + j + 1) = c(i + j + 1) + add
      

      
     Else
     
     
     add = 0
   
   
    End If
   

   
   
Next




Next

total = i + j






If m > 0 Then

For i = 0 To 200

a(i) = 0
b(i) = 0


Next

k = m
t = m

For i = 0 To Len(t) - 1
  
   e(i) = Right(t, 1)
    t = Left(t, Len(t) - 1)
   



Next





For i = 0 To total
   For j = 0 To Len(k) - 1
   


   b(i + j) = c(i) * e(j)
  
    d(i + j) = d(i + j) + b(i + j)
   
  
   
     
         If d(i + j) > 9 Then
   
     add = d(i + j) \ 10 ' add 进位的数
     
     d(i + j) = d(i + j) Mod 10
     

        d(i + j + 1) = d(i + j + 1) + add
      

      
     Else
     
     
     add = 0
   
   
    End If
   

   
   
Next




Next

total1 = i + j




If u > 0 Then

d(0) = d(0) + u




If d(0) > 9 Then
  
   d(0) = d(0) \ 10
   
   d(1) = d(1) + d(0) Mod 10
   

End If


End If









End If


  
  

     
     
   
  
  
  
  
  

End Sub

smhf_6

Sub xx1()
Dim x, y
On Error Resume Next
Do
y = y + 1
x = (1 + 73 * y * y) ^ (1 / 2)
Loop Until x = Int(x)

MsgBox ("x=" & x & vbCrLf & "y=" & y)
End Sub

结果:
x = 2281249
y = 267000



Sub xx2()
Dim x, y
On Error Resume Next
Do
y = y + 1
x = ((1 + 61 * y * y)) ^ (1 / 2)
Loop Until x = Int(x)

MsgBox ("x=" & x & vbCrLf & "y=" & y)
End Sub

结果:
x = 335159612
y = 42912791

[ 本帖最后由 smhf_6 于 2011-7-20 05:55 编辑 ]