close

Вход

Забыли?

вход по аккаунту

?

текст программы

код для вставкиСкачать
Public Class Form1
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
ReDim A1(n, 2), B1(m, 2)
For i = 0 To n - 1
For j = 0 To 1
A1(i + 1, j + 1) = CSng(Me.DataGridView1.Item(j, i).Value)
Next
Next
For i = 0 To m - 1
For j = 0 To 1
B1(i + 1, j + 1) = CSng(Me.DataGridView2.Item(j, i).Value)
Next
Next
interpol()
End Sub
Private Sub ЗагрузитьToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ЗагрузитьToolStripMenuItem.Click
Me.OpenFileDialog1.ShowDialog()
End Sub
Private Sub OpenFileDialog1_FileOk(ByVal sender As System.Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles OpenFileDialog1.FileOk
If fl = 0 Then
loadsystemfromfile(Me.OpenFileDialog1.FileName, Me.DataGridView1)
n = n1 + 1
Else
loadsystemfromfile(Me.OpenFileDialog1.FileName, Me.DataGridView2)
m = n1 + 1
End If
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Dim it As Integer
Dim osth As Single
Dim otv As String
stp = CSng(Me.TextBox2.Text)
itmax = CInt(Me.TextBox4.Text)
eps = CSng(Me.TextBox3.Text)
otv = "Абсолютный коэффициент термоэдс Sa(T)" + Chr(13)
For i = 1 To n
otv = otv + CStr(Sa(i, 1)) + " " + CStr(Sa(i, 2)) + Chr(13)
Next
osth = 0
approks(stp)
Zeidel(itmax, it, stp)
For i = 1 To n
osth = osth + (Sa(i, 2) - fynk(Sa(i, 1), stp)) ^ 2
osth = osth ^ 0.5
Next
otv = otv + "Коэф Гаусс-Зейдель: " + Chr(13)
For i = 0 To stp
otv = otv + "C" + CStr(i) + "=" + CStr(C(i)) + Chr(13)
Next
otv = otv + Chr(13) + "Кол-во итераций it=" + CStr(it) + Chr(13) + Chr(13) + "Ошибка аппроксимации Q = " + CStr(osth) + Chr(13)
Me.RichTextBox1.Text = otv
End Sub
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
Dim h, xx1, x, xx2, y1, y2, mh, mw, msx, msy, ms, TA, TB, j As Single
Dim otv As String
Dim graph As Graphics = Me.PictureBox2.CreateGraphics
Dim pn As Pen = New Pen(Color.Black, 2)
Dim pn1 As Pen = New Pen(Color.Brown, 2)
Me.PictureBox2.Refresh()
mh = CSng(Me.PictureBox2.Height) / 2
mw = CSng(Me.PictureBox2.Width) / 2
MS = CSng(Me.TextBox1.Text)
msx = mw / (Sa(n, 1) * ms)
msy = mh / (Sa(n, 1) * ms / 50)
graph.TranslateTransform(0, mh)
graph.DrawLine(pn, 0, -mh * 2, 0, mh * 2)
graph.DrawLine(pn, mw * 2, 0, -mw * 2, 0)
h = 0.05 : K1 = 0
TA = Sa(1, 1) : TB = Sa(1, 1)
For i = 1 To n
If Sa(i, 1) < TA Then
TA = Sa(i, 1)
Else
If Sa(i, 1) > TB Then
TB = Sa(i, 1)
End If
End If
Next
For x = TA To TB Step h
xx1 = x
xx2 = (xx1 + h)
y1 = -fynk(xx1, stp)
y2 = -fynk(xx2, stp)
If y1 * y2 < 0 Then K1 = K1 + 1
graph.DrawLine(pn, msx * xx1, y1 * msy, msx * xx2, y2 * msy)
Next
For i = 1 To n
graph.DrawRectangle(Pens.ForestGreen, msx * Sa(i, 1) - 1, -msy * Sa(i, 2) - 1, 2, 2)
Next
Me.RichTextBox1.Text = Me.RichTextBox1.Text + "Кол-во корней= " + CStr(K1) + Chr(13)
j = 0
If K1 = 1 Then
iter = 0
otv = Chr(13) + "Корень: " + CStr(hord(TA, TB)) + Chr(13)
otv = otv + "Число итераций=" + CStr(iter) + Chr(13)
Else
For i = TA To TB Step 50
y1 = fynk(i, stp)
y2 = fynk(i + 50, stp)
If y1 * y2 < 0 Then
iter = 0
j = j + 1
otv = otv + "Корень №" + CStr(j) + "= " + CStr(hord(i, i + 50)) + Chr(13) + "Число итераций=" + CStr(iter) + Chr(13)
End If
Next
End If
Me.RichTextBox1.Text = Me.RichTextBox1.Text + otv
End Sub
Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
Dim h, kof As Single
Dim otv As String
Dim i, j As Integer
ReDim E1(n, 2), E2(n, 2)
h = CSng(Me.TextBox6.Text)
kof = CInt(Me.TextBox7.Text)
i = 50 : j = 0
Do
If i < 1000 Then
i = i + 50 : j = j + 1
E1(j, 1) = i
E1(j, 2) = pr(Sa(1, 1), Sa(j, 1), h)
runge(Sa(1, 1), Sa(j, 1), h)
E1(j, 2) = E1(j, 2) + Rung
Else
i = i + 20 : j = j + 1
E1(j, 1) = i
E1(j, 2) = pr(Sa(1, 1), Sa(j, 1), h)
runge(Sa(1, 1), Sa(j, 1), h)
E1(j, 2) = E1(j, 2) + Rung
End If
Loop Until i = Sa(n, 1)
otv = "Зависимость E(T), интегрирование методом правых прямоугольников: " + Chr(13)
For i = 1 To n
otv = otv + CStr(E1(i, 1)) + " " + CStr(E1(i, 2)) + Chr(13)
Next
otv = otv + Chr(13)
i = 50 : j = 0
Do
If i < 1000 Then
i = i + 50 : j = j + 1
E2(j, 1) = i
E2(j, 2) = trap(Sa(1, 1), Sa(j, 1), h)
runge(Sa(1, 1), Sa(j, 1), h)
E2(j, 2) = E2(j, 2) + Rung
Else
i = i + 20 : j = j + 1
E2(j, 1) = i
E2(j, 2) = trap(Sa(1, 1), Sa(j, 1), h)
runge(Sa(1, 1), Sa(j, 1), h)
E2(j, 2) = E2(j, 2) + Rung
End If
Loop Until i = Sa(n, 1)
otv = otv + "Зависимость E(T), интегрирование методом трапеций: " + Chr(13)
For i = 1 To n
otv = otv + CStr(E2(i, 1)) + " " + CStr(E2(i, 2)) + Chr(13)
Next
Me.RichTextBox1.Text = Me.RichTextBox1.Text + otv
End Sub
Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click
Dim mh, mw, msx, msy, y1, y2, x1, x2, ms As Single
Dim max As Double
Dim graph As Graphics = Me.PictureBox1.CreateGraphics
Dim pn As Pen = New Pen(Color.Gray, 1)
Dim pn1 As Pen = New Pen(Color.Gray, 1)
Me.PictureBox1.Refresh()
mh = CSng(Me.PictureBox1.Height) / 2
mw = CSng(Me.PictureBox1.Width) / 2
ms = CSng(Me.TextBox1.Text)
max = E1(1, 2)
For i = 1 To n
If Math.Abs(E1(i, 2)) >= max Then
max = Math.Abs(E1(i, 2))
End If
Next
msx = mw / (max * ms / 5)
msy = mh / (max * ms * 2) ' Масштабные коэффициенты
graph.TranslateTransform(0, mh)
graph.DrawLine(New Pen(Brushes.Black, 1), 0, -mh * 2, 0, mh * 2) ' Рисовалки graph.DrawLine(New Pen(Brushes.Black, 2), 0, 0, mw * 2, 0)
For i = 1 To n - 1
x1 = E1(i, 1) : y1 = -E1(i, 2)
x2 = E1(i + 1, 1) : y2 = -E1(i + 1, 2)
graph.DrawLine(pn, msx * x1, y1 * msy, msx * x2, y2 * msy)
Next
For i = 1 To n - 1
x1 = E2(i, 1) : y1 = -E2(i, 2)
x2 = E2(i + 1, 1) : y2 = -E2(i + 1, 2)
graph.DrawLine(pn1, msx * x1, y1 * msy, msx * x2, y2 * msy)
Next
End Sub
End Class
Module Module1
Public n, n1, m, itmax, iter, n2, qq, q, ll, fl, K1, stp As Integer
Public Rung, A(,), A1(,), B1(,), A2(,), Sa(,) As Single
Public B(), B2(,), E1(,), E2(,), C(), eps, aa(), bb(), cc(), dd() As Double
Public sysload As Boolean
Public Sub loadsystemfromfile(ByVal filename As String, ByVal tableName As System.Windows.Forms.DataGridView)
Dim myreader As Microsoft.VisualBasic.FileIO.TextFieldParser
Dim st() As String
myreader = New Microsoft.VisualBasic.FileIO.TextFieldParser(filename)
myreader.SetDelimiters(" ")
ReDim st(1)
st = myreader.ReadFields()
Try
n1 = CInt(st(0)) - 1
Catch
MsgBox("Не возможно прочитать файл", MsgBoxStyle.Critical, " Ошибка фийла")
Return
End Try
fl = fl + 1
ReDim A(n1, 1)
tableName.RowCount = n1 + 1 : tableName.ColumnCount = 2
ReDim st(n1 + 1)
For i = 0 To n1
st = myreader.ReadFields()
For j = 0 To 1
A(i, 0) = CSng(st(0))
A(i, 1) = CSng(st(1))
tableName.Item(j, i).Value = st(j)
Next j
Next i
If myreader.ReadToEnd = "" Then
MsgBox("Данные получены", MsgBoxStyle.OkOnly)
Else
MsgBox("Данные утеряны", MsgBoxStyle.OkOnly)
End If
End Sub
Public Sub interpol()
Dim graph As Graphics = Form1.PictureBox1.CreateGraphics
Form1.PictureBox1.Refresh()
Dim pn As Pen = New Pen(Color.Black, 1)
Dim pn1 As Pen = New Pen(Color.Black, 2)
Dim i, i1, j As Integer
Dim k(m), l(m), h(m), s(m), r(m), ed(,), ost, hh As Double
Dim mh, mw, msY, msX, fi, ms, x As Decimal
ReDim aa(m), bb(m), cc(m + 1), dd(m), ed(n, 2), Sa(n, 2)
k(1) = 0
l(1) = 0
For i = 2 To m
h(i) = B1(i, 1) - B1(i - 1, 1)
h(i - 1) = B1(i - 1, 1) - B1(i - 2, 1)
s(i) = 2 * (h(i) + h(i - 1))
r(i) = 3 * ((B1(i, 2) - B1(i - 1, 2)) / (h(i)) - ((B1(i - 1, 2) - B1(i - 2, 2)) / h(i - 1)))
k(i) = (r(i) - h(i - 1) * k(i - 1)) / (s(i) - h(i - 1) * l(i - 1))
l(i) = h(i) / (s(i) - h(i - 1) * l(i - 1))
Next i
cc(1) = 0
cc(m) = k(m)
For i = (m - 1) To 2 Step (-1)
cc(i) = k(i) - l(i) * cc(i + 1)
Next i
For i = 1 To m
dd(i) = (cc(i + 1) - cc(i)) / (3 * h(i))
bb(i) = (B1(i, 2) - B1(i - 1, 2)) / (h(i)) - ((cc(i + 1) + 2 * cc(i)) * h(i) / 3)
aa(i) = B1(i - 1, 2)
Next i
mh = CSng(Form1.PictureBox1.Height) / 2
mw = CSng(Form1.PictureBox1.Width) / 2
ms = CSng(Form1.TextBox1.Text)
msX = mw / (B1(m, 1) * ms)
msY = mh / (B1(m, 1) * ms / 55)
graph.TranslateTransform(0, mh)
graph.DrawLine(pn1, 0, -mh * 2, 0, mh * 2)
graph.DrawLine(pn1, mw * 2, 0, -mw * 2, 0)
graph.DrawEllipse(Pens.Red, msX * B1(1, 1) - 2, -msY * B1(1, 2) - 2, 4, 4)
graph.DrawEllipse(Pens.Red, msX * B1(m, 1) - 2, -msY * B1(m, 2) - 2, 4, 4)
i1 = 0
For i = 1 To m - 1
hh = 0.1
For x = B1(i, 1) To B1(i + 1, 1) Step hh
fi = aa(i + 1) + bb(i + 1) * (x - B1(i, 1)) + cc(i + 1) * (x - B1(i, 1)) * (x - B1(i, 1)) + dd(i + 1) * (x - B1(i, 1)) * (x - B1(i, 1)) * (x - B1(i, 1))
If x < 1001 Then
ost = (x Mod 50)
If ost = 0 Then
i1 = i1 + 1
ed(i1, 1) = x
ed(i1, 2) = fi
End If
Else
ost = (x Mod 20)
If ost = 0 Then
i1 = i1 + 1
ed(i1, 1) = x
ed(i1, 2) = fi
End If
End If
graph.DrawRectangle(pn, msX * x, -msY * fi, 1, 1)
Next x
Next i
i = 50 : j = 0
Do
If i < 1000 Then
i = i + 50 : j = j + 1
Sa(j, 1) = i
Sa(j, 2) = A1(j, 2) - ed(j, 2)
Else
i = i + 20 : j = j + 1
Sa(j, 1) = i
Sa(j, 2) = A1(j, 2) - ed(j, 2)
End If
Loop Until i = B1(m, 1)
End Sub
Public Sub approks(ByVal mm)
Dim i, j As Integer
ReDim B(mm), B2(mm, mm)
For ii = 0 To mm
For j = 0 To mm
For i = 0 To n - 1
B2(ii, j) = B2(ii, j) + (Sa(i + 1, 1) ^ (j)) * (Sa(i + 1, 1) ^ (ii))
Next i
Next j
Next ii
For i = 0 To mm
For j = 0 To n - 1
B(i) = B(i) + (Sa(j + 1, 2) * Sa(j + 1, 1) ^ (i))
Next j
Next i
End Sub
Public Sub Zeidel(ByVal itmax, ByRef it, ByVal mm)
Dim S, T, Mn, x3() As Double
Dim i, j, fl As Integer
ReDim C(mm), x3(mm) 'задание начального приближения
it = 0
fl = 1
Do
it = it + 1
If it > 1 Then
fl = 0
For i = 0 To mm
Mn = 0
Mn = C(i) - x3(i)
If Math.Abs(Mn) > eps Then
fl = 1
End If
Next
For i = 0 To mm
x3(i) = C(i)
Next
End If
i = 0
Do
S = 0
For j = 0 To mm
If i <> j Then
S = S + B2(i, j) * C(j)
End If
Next
T = B(i) - S
C(i) = T / B2(i, i)
i = i + 1
Loop While i <= mm
Loop While (fl = 1) And (it < itmax)
End Sub
Public Function fynk(ByVal X, ByVal k)
Dim i As Integer
For i = 0 To k
fynk = fynk + C(i) * X ^ i
Next
End Function
Public Function hord(ByVal x1, ByVal x12)
Dim eps1 As Single
eps1 = CSng(Form1.TextBox5.Text)
iter = 0
Do
iter = iter + 1
x1 = x1 + (x12 - x1) * (fynk(x1, stp)) / (fynk(x1, stp) - fynk(x12, stp))
Loop While (Math.Abs(fynk(x1, stp)) >= eps1)
hord = x1
End Function
Public Function pr(ByVal xx1, ByVal xx2, ByVal h)
Dim sum, x As Double
sum = 0 : q = 0
For x = xx1 To xx2 Step h
sum = sum + h * fynk(x, stp)
Next
pr = sum + osh(xx1, xx2, h)
q = 1
End Function
Public Function trap(ByVal xx1, ByVal xx2, ByVal h)
Dim sum, x3 As Single
sum = 0 : q = 0
For x3 = xx1 + h To xx2 - h Step h
sum = sum + fynk(x3, stp)
Next
sum = 2 * sum + fynk(xx1, stp) + fynk(xx2, stp)
trap = (h / 2) * sum
trap = trap + oshib(xx1, xx2, h)
q = 2
End Function
Public Function osh(ByVal xx1, ByVal xx2, ByVal h)
Dim sum, x As Double
sum = 0
For x = xx1 To xx2 Step h
sum = sum + h * fp1(x)
Next
osh = (h / 2) * sum
End Function
Public Function oshib(ByVal xx1, ByVal xx2, ByVal h)
Dim sum, x3 As Double
sum = 0
For x3 = xx1 To xx2 Step h
sum = sum + h * fp2(x3)
Next
oshib = -((h ^ 2) / 12) * sum
End Function
Public Sub runge(ByVal xx1, ByVal xx2, ByVal h)
Dim kof As Single
kof = CInt(Form1.TextBox7.Text)
Rung = 0
If q = 1 Then
Rung = (pr(xx1, xx2, h) - pr(xx1, xx2, h * kof)) / (kof ^ 2 - 1)
Else
Rung = (trap(xx1, xx2, h) - trap(xx1, xx2, h * kof)) / (kof ^ 2 - 1)
End If
End Sub
Function fp2(ByVal X)
For i = 2 To stp
fp2 = fp2 + C(i) * i * (i - 1) * X ^ (i - 2)
Next
End Function
Function fp1(ByVal X)
For i = 1 To stp
fp1 = fp1 + C(i) * X ^ (i - 1) * i
Next
End Function
End Module
Документ
Категория
Разное
Просмотров
22
Размер файла
34 Кб
Теги
программа, текст
1/--страниц
Пожаловаться на содержимое документа