File in = new File("C:\\input.sql");
創新互聯公司長期為上1000+客戶提供的網站建設服務,團隊從業經驗10年,關注不同地域、不同群體,并針對不同對象提供差異化的產品和服務;打造開放共贏平臺,與合作伙伴共同營造健康的互聯網生態環境。為馬龍企業提供專業的成都網站制作、做網站,馬龍網站改版等技術服務。擁有十載豐富建站經驗和眾多成功案例,為您定制開發。
File out = new File("C:\\out.sql");
BufferedReader reader = null;
PrintWriter writer = null;
try {
reader = new BufferedReader(new FileReader(in));
writer = new PrintWriter(new FileOutputStream(out));
String text = null;
int line = 1;
while ((text = reader.readLine()) != null) {
writer.println(line + " " + text);
line++;
}
writer.flush();
} catch (FileNotFoundException e) {
e.printStackTrace();
} catch (IOException e) {
e.printStackTrace();
} finally {
if (writer != null) {
writer.close();
}
if (reader != null) {
try {
reader.close();
} catch (IOException e) {
e.printStackTrace();
}
}
}
針對方程"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 _
(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 by btef (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 r 0 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 delta 0 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 r 0 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)
Else 'r 0
sita = pi / 3
x2r = -rr * Cos(sita) - b / 3
x2i = -ri * Sin(sita)
End If
x3r = x2r
x3i = -x2i
End If
End If
End Function
Private Function Cur(v As Double) As Double
If v 0 Then
Cur = -(-v) ^ (1 / 3)
Else
Cur = v ^ (1 / 3)
End If
End Function
Private Function Argument(a As Double, b As Double) As Double
Dim sita As Double, pi As Double
'pi = 3.14159265358979
pi = 4 * Atn(1)
If a = 0 Then
If b = 0 Then
Argument = pi / 2
Else
Argument = -pi / 2
End If
Else
sita = Atn(Abs(b / a))
If a 0 Then
If b = 0 Then
Argument = sita
Else
Argument = -sita
End If
ElseIf a 0 Then
If b = 0 Then
Argument = pi - sita
Else
Argument = pi + sita
End If
End If
End If
End Function
解一元一次方程:
設置4個文本框,分別代表一元一次方程中的參數k,b,x,y
分別命名txtk,txtb,txtx,txty.計算按鈕命名為cmdCalc。
在代碼窗口里粘貼如下代碼:
Private Sub cmdCalc_Click()
Dim k, b As Long
k = txtk.Text
b = txtb.Text
If txtx.Text = "x" Then
MsgBox "x的值為:" (txty.Text - b) / k
ElseIf txty.Text = "y" Then
MsgBox "y的值為:" k * txtx.Text + b
End If
End Sub
計算時求x則在txtx那里輸入一個x,
求y則在txty那里輸入一個y,
在各文本框中輸入參數,
然后按下按鈕,
就有提示框彈出,顯示結果。
一元二次方程:
privat sub command1_click()
dim a,b,c,x1,x2,d as sigle
a=val(textl.text)
b=val(text2.text)
c=val(text3.text)
d=b^2-4*a*c
if d0 then
x1=(-b+sqr(d))/(2*a)
x2=(-b-sqr(d))/(2*a)
else if d=0 then
x1=(-b/2*a)
x2=x1
else msgbox"方程沒有實根"
end if
text4.text="x1=" x1 "" "x2=" x2
end sub
sub min(byref a() as integer)
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種的最小值:" vbcrlf m
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 _
(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 by btef (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 r 0 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 delta 0 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 r 0 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)
Else 'r 0
sita = pi / 3
x2r = -rr * Cos(sita) - b / 3
x2i = -ri * Sin(sita)
End If
x3r = x2r
x3i = -x2i
End If
End If
End Function
Private Function Cur(v As Double) As Double
If v 0 Then
Cur = -(-v) ^ (1 / 3)
Else
Cur = v ^ (1 / 3)
End If
End Function
Private Function Argument(a As Double, b As Double) As Double
Dim sita As Double, pi As Double
'pi = 3.14159265358979
pi = 4 * Atn(1)
If a = 0 Then
If b = 0 Then
Argument = pi / 2
Else
Argument = -pi / 2
End If
Else
sita = Atn(Abs(b / a))
If a 0 Then
If b = 0 Then
Argument = sita
Else
Argument = -sita
End If
ElseIf a 0 Then
If b = 0 Then
Argument = pi - sita
Else
Argument = pi + sita
End If
End If
End If
End Function
二元一次方程:
Dim a, b, c As Integer
Dim x, y As Single
Dim d As Double
a = Val(InputBox("輸入二次項系數"))
b = Val(InputBox("輸入一次項系數"))
c = Val(InputBox("輸入常數項"))
d = b ^ 2 - 4 * a * c
If d 0 Then
MsgBox "方程無解"
ElseIf d = 0 Then
x = -b / (2 * a)
MsgBox "方程有一個解:" x
Else
x = (-b + Sqr(d)) / (2 * a)
y = (-b - Sqr(d)) / (2 * a)
MsgBox "方程有兩個解:" x "和" y
End If
三元一次方程:
方程組如下,
ax+by+cz=d
a'x+b'y+c'z=d'
a"x+b"y+c"z=d"
其中x,y,z為未知數,a,a',a",b,b',b",c,c',c",d,d',d",為用戶輸入的數值
解N元一次方程,indat為N+1行、N列的數組,outdat為N個元素的數組
Public Sub 解方程(ByRef InDat() As Double, ByVal InDatCount As Long, ByRef OutDat() As Double, ByRef OutDatCount As Long)
Dim Xt() As Double
Dim Dt As Double
Dim Ss As Long
Dim OtSCount As Long
Dim XtOut() As Double
If InDatCount 1 Then
ReDim Xt(1 To InDatCount - 1, 1 To InDatCount) As Double
For j = 1 To InDatCount - 1 '行
For i = 2 To InDatCount + 1 '列
Xt(j, i - 1) = InDat(j, i) * InDat(InDatCount, 1) / InDat(1, 1) - InDat(InDatCount, i)
Next i
Next j
OtSCount = 0
解方程 Xt, InDatCount - 1, XtOut, OtSCount
Dt = 0
For i = 1 To InDatCount - 1
Dt = Dt + InDat(InDatCount, i + 1) * XtOut(i)
Next i
Dt = Dt + InDat(InDatCount, i + 1)
ReDim Preserve OutDat(1 To 1 + OtSCount) As Double
OutDat(1) = -Dt / InDat(InDatCount, 1)
For i = 2 To OtSCount + 1
OutDat(i) = XtOut(i - 1)
Next i
OutDatCount = 1 + OtSCount
Else
ReDim OutDat(1 To 1) As Double
If InDat(1, 1) 0 Then
OutDat(1) = -InDat(1, 2) / InDat(1, 1)
Else
OutDat(1) = 0
End If
OutDatCount = 1
End If
End Sub
絕對值是“|”,可以直接顯示,同理對數可用log(x)代替,根號和其他不支持顯示。
如果要顯示數學式子,只能畫吧。
計算時可用“^”求冪或求根,“/”表示除法和分數線,還有math類。
VB的運算順序是:先乘除、后加減,有括號的先算括號內,有負號的先算負號。
請你比較一下這個運算中x和y的值:
Dim n As Single = 4
Dim x As Single
Dim y As Single
x = n + 1
x = x / n
x = x - 1
x = Math.Sqrt(x)
y = Math.Sqrt((n + 1) / n - 1)
這樣就會發現,你的代碼中括號的位置錯了。
正確的應該是: Math.Sqrt((n + 1) / n - 1)
新聞標題:vbnet求根的簡單介紹
本文路徑:http://vcdvsql.cn/article48/hshjhp.html
成都網站建設公司_創新互聯,為您提供App設計、微信小程序、電子商務、建站公司、軟件開發、網站制作
聲明:本網站發布的內容(圖片、視頻和文字)以用戶投稿、用戶轉載內容為主,如果涉及侵權請盡快告知,我們將會在第一時間刪除。文章觀點不代表本網站立場,如需處理請聯系客服。電話:028-86922220;郵箱:631063699@qq.com。內容未經允許不得轉載,或轉載時需注明來源: 創新互聯