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

northwolves

程序版的朋友好久没有得分机会了，这里先奉献一道，谢谢大家支持。

题目：

易知（9,4) 是方程x 2-5y2=1 的最小正整数解。
编写VBA代码 计算：
1）      x 2-73y2=1 的最小正整数解
2）      x 2-61y2=1 的最小正整数解

计分：
1）算法不限，格式不限。
2）通过WEBBROWSER或xmlhttp直接调用网页查询答案者不得分
3）题目1,：1分
   题目2： 1分
4）优秀代码可外加1-2分。

[ 本帖最后由 wangg913 于 2011-6-14 07:29 编辑 ]

紫菜蛋汤

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

1. 
   
2. Option Explicit
   
3. '第一题
   
4. Public Sub s()
   
5.     Dim j As Double
   
6.     Dim k As Double
   
7.     k = 0
   
8.     Do
   
9.         k = k + 1
   
10.         j = 73 * k * k + 1
    
11.         j = Sqr(j)
    
12.     Loop Until Int(j) = j
    
13.     Debug.Print j, k
    
14. End Sub
    
15. '第二题
    
16. Public Sub t()
    
17.     Dim y As Double
    
18.     Dim f As Double
    
19.     y = 0
    
20.     Do
    
21.         y = y + 1
    
22.         f = 61 * y * y + 1
    
23.         f = Sqr(f)
    
24.     Loop Until Int(f) = f
    
25.     Debug.Print f, y
    
26. End Sub
    

复制代码

[ 本帖最后由 紫菜蛋汤 于 2011-6-15 10:35 编辑 ]

死亡メロディ

Public Sub DO用法第一题()
    Dim y As Double '抄袭别人的思路
   dim f as double
Do
        y = y + 1
    Loop Until InStr(CStr(Sqr(73 * y * y + 1)), ".") = 0
   f=sqr(73 * y * y + 1)
    Debug.Print f, y
End Sub

Sub for用法第二题()
Dim y As Double
Dim x As double
For y = 1 To 1000000000
x = Sqr(61 * y * y + 1)
If int(x)=x Then Exit For
Next
Debug.Print y, x
End Sub

[ 本帖最后由 死亡メロディ 于 2011-6-21 01:23 编辑 ]

AVEL

先试试看。
===========================
狼版主给的好像是Pell方程式。。 X2-DY2=1【D为不完全平方数】
用D的平方根的连分数应该可以提高解答速度吧。

[ 本帖最后由 AVEL 于 2011-6-15 17:17 编辑 ]

alzeng

两个题目，执行同一算法，求61时很慢：

1. 
   
2. Sub Getxy()
   
3.     Dim x&, y&, i%
   
4. 
   
5.     i = 73
   
6.     y = Int(i ^ 0.5)
   
7.     Do Until Int((i * y ^ 2 + 1) ^ 0.5) = (i * y ^ 2 + 1) ^ 0.5
   
8.         y = y + 1
   
9.     Loop
   
10.     x = (i * y ^ 2 + 1) ^ 0.5
    
11.    
    
12.     Debug.Print i, x, y
    
13. End Sub
    

复制代码

1. 
   
2. Sub Getxy()
   
3.     Dim x&, y&, i%
   
4. 
   
5.     i = 61
   
6.     y = Int(i ^ 0.5)
   
7.     Do Until Int((i * y ^ 2 + 1) ^ 0.5) = (i * y ^ 2 + 1) ^ 0.5
   
8.         y = y + 1
   
9.     Loop
   
10.     x = (i * y ^ 2 + 1) ^ 0.5
    
11.    
    
12.     Debug.Print i, x, y
    
13. End Sub
    

复制代码

oyzhjr

只做了第二道题，第一道运行了5分钟没结果，第二道10秒左右。
穷举法。

liuguansky

X^2-A*y^2=1
形如此方程,如果A是质数的话,当且仅当A+-1/2为完全平方数时,才会有解,且为Y解.
问题所求全是质数,且+-1/2不存在完全平方数,故无解.

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Target.Count = 1 Then
   
3.         If Target.Column = 1 Then
   
4.             Dim i$, arr, j%, k$, u As Boolean
   
5.             arr = Array(-2, -1, 1, 2)
   
6.             For j = 0 To 3
   
7.                 k = Target.Value + arr(j)
   
8.                 If k > 0 Then
   
9.                     If Int(k ^ 0.5) = k ^ 0.5 Then
   
10.                         [b1] = (k * Abs(2 / arr(j)) ^ 2 * Target.Value + 1) ^ 0.5 & "," & k ^ 0.5 * Abs(2 / arr(j))
    
11.                         u = True: Exit For
    
12.                     End If
    
13.                 End If
    
14.             Next j
    
15.             If Not u Then [b1] = "无解"
    
16.         End If
    
17.     End If
    
18. End Sub

复制代码

A1输入A系数,在B1返回解.
若A非质数的话,当且仅当A的约数+-1/2为完全平方数时,才会有解.感觉这样处理会少很多判断.

[ 本帖最后由 liuguansky 于 2011-6-16 10:38 编辑 ]

涅磐86970

试试。。vba水平相当菜- -。。。不对请及时指正~~
Public Sub jisuan1()
    Dim i As Double
    Dim j As Double
    Dim k As Double
    For i = 1 To 1000000
        j = i * i * 73 + 1
        k = Sqr(j)
        If k = CLng(k) Then
        MsgBox Sqr(j) & "," & i & "。"
       Exit Sub
        End If
    Next
    MsgBox "未找到"
End Sub


    Dim i As Double
    Dim j As Double
    Dim k As Double
    For i = 1 To 100000000
        j = i * i * 61 + 1
        If Sqr(j) = CLng(Sqr(j)) Then
        MsgBox Sqr(j) & "," & i & "。"
       Exit Sub
        End If
    Next
    MsgBox "未找到"
End Sub

[ 本帖最后由 涅磐86970 于 2011-6-16 11:09 编辑 ]

alzbz

方程 x^2- D*y^2 = 1 （D为不含平方因子的正整数）的最小正整数解 x0 , y0 可根据连分数理论求出。

设根号 D 的连分数表示式为 [a0;a1,a2,...,an,...]，其中 a0 为 D 的平方根的整数部分，an = 2 * a0 ，该连分数必定从 a1 到 an 循环，n 为循环节长。
为求出 an ，用 pn 和 qn 作为中间变量 ，设pn(0) = 0 ，qn(0) = 1 ，则
   pn(n) = a(n - 1) * qn(n - 1) - pn(n - 1)
   qn(n) = (D - pn(n) * pn(n)) / qn(n - 1)
   a(n) = Int((a(0) + pn(n)) / qn(n))
   n = 1,2...
  
然后由根号 D 的连分数表示式求出根号 D 的渐进分数列 hn / kn
h0 = a0 ，k0 = 1 ，h1 = a0*a1+1 ，k1 = a1 ，有：
   hn(n) = a(n) * hn(n - 1) + hn(n - 2)
   kn(n) = a(n) * kn(n - 1) + kn(n - 2)
   n = 2,3...
  
  最后根据连分数理论求出 x0 ，y0
  当循环节长为偶数时， x0 = hn(n-1)， y0 = kn(n-1)
  当循环节长为奇数时， x0 = hn(2 * n - 1)，y0 = kn(2 * n - 1)
  
  题目1和题目2见附件。

[ 本帖最后由 alzbz 于 2011-6-18 14:34 编辑 ]

lsdongjh

'    x^2-a*Y^2=1
'    x = Math.Sqr(a * (y ^ 2) + 1)

'1)x 2-73y2=1 的最小正整数解
'   (x,y)=(267000,2281249)
Sub testA()
    Debug.Print GetSqrVal(73)
End Sub

'2)x 2-61y2=1 的最小正整数解
'   (x,y)=(42912791,335159612)
Sub testB()
    Debug.Print GetSqrVal(61)
End Sub

Function GetSqrVal(intA As Integer) As String
    On Error GoTo ErrMSG
    Dim x As Double, y As Double
    Dim blIsTrue As Boolean
   
    blIsTrue = False
    y = 0
   
   
    Do Until blIsTrue
       y = y + 1
       x = Math.Sqr(intA * (y ^ 2) + 1)
       If Round(x, 0) = x Then blIsTrue = True
    Loop
   
    GetSqrVal = "(x,y)=(" & y & "," & x & ")"
    Exit Function
   
ErrMSG:
    GetSqrVal = "方程无解"
End Function