vb.net如何解方程 vb怎么解方程( 二 )

dim i,j as interger
for i=1 to 9
for j=i+1 to 10
if a a(i)a(j) then
t=a(j)
a(i)=a(j)
a(j)=t
end if
next
next
end sub
private sub command_(click)
dim b(1 to 10) as interger
dim a(1 to 10) as interger
randomize
for i=1 to 10
a(i)=int(rnd*90)+10
list1.additem a(i)
b(i)=int(rnd*90)+ 10
list2.additem b(i)
next
call min(a)
call min(b)
if a(1)b(1) then
m=a(1)
else
m=b(1)
end if
text1.text="A,B种的最小值："vbcrlfm
end sub
一元三次方程：
针对方程"ax^3+bx^2+cx+d=0"的求根程序。
控件只需一个Command1 ，结果显示在“立即”中。
代码如下。（参考）
========================
Private Sub Command1_Click()
Dim x1r As Double, x1i As Double, x2r As Double, x2i As Double, x3r As Double, x3i As Double
Dim ret As String
Const eq = "ax^3+bx^2+cx+d=0"
a = InputBox("请输入a", eq)
b = InputBox("请输入b", eq)
c = InputBox("请输入c", eq)
d = InputBox("请输入d", eq)
ret = CubicEquation(a, b, c, d, x1r, x1i, x2r, x2i, x3r, x3i)'5x^3+4x^2+3x-12=0
Debug.Print "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"ret
Debug.Print x1r; " + "; x1i; " i"
Debug.Print x2r; " + "; x2i; " i"
Debug.Print x3r; " + "; x3i; " i"
End Sub
Private Function CubicEquation _
【vb.net如何解方程 vb怎么解方程】(ByVal a As Double, ByVal b As Double, ByVal c As Double, ByVal d As Double, _
x1r As Double, x1i As Double, x2r As Double, x2i As Double, x3r As Double, x3i As Double) As String
'Cubic equation(v2.2), coded bybtef (please let this line remain)
Dim e As Double, f As Double, g As Double, h As Double, delta As Double
Dim r As Double, sita As Double, pi As Double, rr As Double, ri As Double
If a = 0 Then
CubicEquation = "Not a cubic equation: a = 0"
Exit Function
End If
'pi = 3.14159265358979
pi = 4 * Atn(1)
b = b / a'simplify to a=1: x^3+bx^2+cx+d=0
c = c / a
d = d / a
e = -b ^ 2 / 3 + c'substitute x=y-b/3: y^3+ey+f=0
f = (2 * b ^ 2 - 9 * c) * b / 27 + d
If e = 0 And f = 0 Then
x1r = -b / 3
x2r = x1r
x3r = x1r
CubicEquation = "3 same real roots:"
ElseIf e = 0 Then'need to deal with e = 0, or it will cause z = 0 later.
r = -f'y^3+f=0, y^3=-f
r = Cur(r)
x1r = r - b / 3'a real root
If r0 Then'r never = 0 since g=f/2, f never = 0 there
sita = 2 * pi / 3
x2r = r * Cos(sita) - b / 3
x2i = r * Sin(sita)
Else
sita = pi / 3
x2r = -r * Cos(sita) - b / 3
x2i = -r * Sin(sita)
End If
x3r = x2r
x3i = -x2i
CubicEquation = "1 real root and 2 image roots:"
Else'substitute y=z-e/3/z: (z^3)^2+fz^3-(e/3)^3=0, z^3=-g+sqr(delta)
g = f / 2'-q-sqr(delta) is ignored
h = e / 3
delta = g ^ 2 + h ^ 3
If delta0 Then
r = Sqr(g ^ 2 - delta)
sita = Argument(-g, Sqr(-delta))'z^3=r(con(sita)+isin(sita))
r = Cur(r)
rr = r - h / r
sita = sita / 3'z1=r(cos(sita)+isin(sita))
x1r = rr * Cos(sita) - b / 3'y1=(r-h/r)cos(sita)+i(r+h/r)sin(sita), x1=y1-b/3
sita = sita + 2 * pi / 3'no image part since r+h/r = 0
x2r = rr * Cos(sita) - b / 3
sita = sita + 2 * pi / 3
x3r = rr * Cos(sita) - b / 3
CubicEquation = "3 real roots:"
Else'delta = 0
r = -g + Sqr(delta)
r = Cur(r)
rr = r - h / r
ri = r + h / r
If ri = 0 Then
CubicEquation = "3 real roots:"
Else
CubicEquation = "1 real root and 2 image roots:"
End If
x1r = rr - b / 3'a real root
If r0 Then'r never = 0 since g=f/2, f never = 0 there
sita = 2 * pi / 3
x2r = rr * Cos(sita) - b / 3
x2i = ri * Sin(sita)