Word / Программы TpaxGen

‘Метод касательных

Private Sub main()

Dim x, e, h, a, b As Single

Dim N As Integer

Dim g As Variant

x = InputBox("Введи x", "Ввод")

a = InputBox("Введи a", "Ввод", -5)

b = InputBox("Введи b", "Ввод", 5)

e = InputBox("Введи точность", "Ввод", 0.01)

Cells(1, 1) = "N"

Cells(1, 2) = "x"

Cells(1, 3) = "f(x)"

Cells(1, 4) = "f'(x)"

Cells(1, 5) = "h"

N = 1

beg:

N = N + 1

h = f(x) / f1(x)

x = x - h

If x >= a Then

If x <= b Then

GoTo yes

End If

End If

If x < a Then

If x > b Then

GoTo no

End If

End If

yes:

If Abs(h) <= e Then

Cells(N, 1) = N - 1

Cells(N, 2) = x

Cells(N, 3) = f(x)

Cells(N, 4) = f1(x)

Cells(N, 5) = h

End If

If Abs(h) > e Then

GoTo beg

End If

GoTo beg

no:

g = MsgBox("Введи новое приближение x!")

If g = vbCancel Then

GoTo nd

End If

x = InputBox("Введи x", "Ввод")

GoTo beg

nd:

End Sub

Public Function f(z As Variant)

f = -0.503 - 2.818 * z +1.703 * z^2 + z * z * z

End Function

Public Function f1(z As Variant)

f1 = -2.818 + 3.406 * z + 3 * z^2

End Function

'Метод Симпсона

Private Sub main()

Dim a, b, N, s, x, h, st As Single

a = InputBox("Введи a", "Ввод", -5)

b = InputBox("Введи b", "Ввод", 5)

N = InputBox("Введи n", "Ввод", 4)

Cells(1, 1) = "s"

Cells(1, 2) = "x"

h = (b - a) / (2 * N)

x = a + h

s = f(a) + f(b) + 4 * f(b - h)

beg:

If x < (b - h) Then

s = s + 4 * f(x)

x = x + h

s = s + 2 * f(x)

x = x + h

GoTo beg

End If

If x >= (b - h) Then

s = s * h / 3

End If

Cells(2, 1) = s

Cells(2, 2) = x

End Sub

Public Function f(z As Variant)

f = -0.503 - 2.818 * z +1.703 * z^2 + z * z * z

End Function

‘метод половинного деления

Sub main()

Dim a, b, e, h, X As Single

a = InputBox("Введи a", "Ввод", -5)

b = InputBox("Введи b", "Ввод", 5)

e = InputBox("Введи точность e", "Ввод", 0.01)

beg:

X = a

h = (b - a) / 2

X = X + h

If f(X) <> 0 Then

If f(a) * f(X) > 0 Then

a = X

Else

b = X

End If

If Abs(h) <= 2 * e Then

X = (b + a) / 2

Else

GoTo beg

End If

End If

Cells(1, 1) = "x="

Cells(1, 2) = X

Cells(2, 1) = "f(x)="

Cells(2, 2) = f(X)

End Sub

Public Function f(z As Variant)

f = -0.503 - 2.818 * z +1.703 * z^2 + z * z * z

End Function

‘решение СЛАУ методом Гаусса

Sub gaus()

Dim A(4, 5) As Single, x1 As Single, x2 As Single, x3 As Single, x4 As Single, i As Byte, j As Byte

Dim B(3, 5) As Single, C(2, 5) As Single, D(1, 5) As Single

Cells(2, 1) = "A="

For i = 1 To 4

For j = 1 To 5

A(i, j) = InputBox("A(i,j)")

Cells(i, j + 1) = A(i, j)

Next j

Next i

Cells(2, 7) = "="

For j = 1 To 5

Cells(1, j + 7) = A(1, j)

Next j

For i = 2 To 4

For j = 1 To 5

B(i - 1, j) = A(i, j) - A(1, j) * A(i, 1) / A(1, 1)

Cells(i, j + 7) = B(i - 1, j)

Next j

Next i

Cells(2, 13) = "="

For j = 1 To 5

Cells(1, j + 13) = A(1, j)

Cells(2, j + 13) = B(1, j)

Next j

For i = 3 To 4

For j = 1 To 5

C(i - 2, j) = B(i - 1, j) - B(1, j) * B(i - 1, 2) / B(1, 2)

Cells(i, j + 13) = C(i - 2, j)

Next j

Next i

Cells(2, 19) = "="

For j = 1 To 5

Cells(1, j + 19) = A(1, j)

Cells(2, j + 19) = B(1, j)

Cells(3, j + 19) = C(1, j)

Next j

For j = 1 To 5

D(1, j) = C(2, j) - C(1, j) * C(2, 3) / C(1, 3)

Cells(4, j + 19) = D(1, j)

Next j

Cells(6, 1) = "x1="

Cells(7, 1) = "x2="

Cells(8, 1) = "x3="

Cells(9, 1) = "x4="

x4 = D(1, 5) / D(1, 4)

x3 = (C(1, 5) - C(1, 4) * x4) / C(1, 3)

x2 = (B(1, 5) - B(1, 4) * x4 - B(1, 3) * x3) / B(1, 2)

x1 = (A(1, 5) - A(1, 4) * x4 - A(1, 3) * x3 - A(1, 2) * x2) / A(1, 1)

Cells(6, 2) = x1

Cells(7, 2) = x2

Cells(8, 2) = x3

Cells(9, 2) = x4

End Sub

‘простой метод Эйлера

Private Sub main()

Dim a, b, n, x0, y0 As Single

Dim h, y, x As Single

Dim tt As Integer

a = InputBox("Левое значение интервала a", "Ввод", -2.15)

b = InputBox("Правое значение интервала b", "Ввод", 3.97)

n = InputBox("Число разбиений n", "Ввод", 20)

x0 = InputBox("Начальное условие x0", "Ввод", a)

y0 = InputBox("Начальное условие y0", "Ввод", 2.662)

Cells(1, 1) = "N"

Cells(1, 2) = "X"

Cells(1, 3) = "Y"

Cells(1, 4) = "f(X,Y)"

Cells(1, 5) = "h*f(X,Y)"

h = (b - a) / n

y = y0

x = x0

tt = 2

While x < b

y = y + h * f(x, y)

x = x + h

Cells(tt, 1) = tt - 1

Cells(tt, 2) = x

Cells(tt, 3) = y

Cells(tt, 4) = f(x, y)

Cells(tt, 5) = h * f(x, y)

tt = tt + 1

Wend

End Sub

Public Function f(xx As Variant, yy As Variant)

f = -2.508 * yy + 0.617 * xx / yy + 1.418 * xx – 2.136

End Function

‘метод простых итераций

Private Sub main()

Dim a, b, e, bb, x, h, st As Single

Cells(1, 1) = "N"

Cells(1, 2) = "A"

Cells(1, 3) = "B"

Cells(1, 4) = "x"

Cells(1, 5) = "f''(A)"

Cells(1, 6) = "f''(B)"

Cells(1, 7) = "h"

Cells(1, 8) = "b"

Cells(1, 9) = "f(x)"

st = 1

beg:

a = InputBox("a", "", -5)

b = InputBox("b", "", 5)

n = InputBox("n", "", 20)

e = InputBox("e", "", 0.01)

If Abs(f11(b)) > Abs(f11(a)) Then

bb = -2 / f11(a)

End If

If Abs(f11(b)) <= Abs(f11(a)) Then

bb = -2 / f11(b)

End If

lbl:

h = bb * f(x)

x = x + h

While x >= a And x <= b

If Abs(h) <= e Then

GoTo lbl

End If

If Abs(h) > e Then

GoTo ed0

End If

GoTo ed1

ed0:

Cells(st, 1) = n

Cells(st, 2) = a

Cells(st, 3) = b

Cells(st, 4) = x

Cells(st, 5) = f11(a)

Cells(st, 6) = f11(b)

Cells(st, 7) = h

Cells(st, 8) = bb

Cells(st, 9) = f(x)

ed1:

st = st + 1

Wend

ed:

End Sub

Public Function f11(z As Variant)

f11 = 3.406 + 6 * z

End Function

Public Function f(z As Variant)

f = -0.503 - 2.818 * z +1.703 * z^2 + z * z * z

End Function

‘метод золотого сечения

Private Sub main()

Dim a, b, eps, x, dx As Single

Dim x1, x2, x3, x4 As Single

Dim st As Integer

Cells(1, 1) = "n"

Cells(1, 2) = "x1"

Cells(1, 3) = "x2"

Cells(1, 4) = "x3"

Cells(1, 5) = "x4"

Cells(1, 6) = "(x4-x1)"

Cells(1, 7) = "f(x2)"

Cells(1, 8) = "f(x3)"

Cells(1, 9) = "x"

Cells(1, 10) = "dx"

a = InputBox("Вводи a", "Ввод", 1)

b = InputBox("Вводи b", "Ввод", 2)

eps = InputBox("Вводи eps", "Ввод", 0.01)

r = (Sqr(5) - 1) / 2

x1 = a

x4 = b

x2 = x4 - r * (x4 - x1)

x3 = x1 + r * (x4 - x1)

st = 2

n = 1

beg:

If Abs(x4 - x1) >= eps Then

If f(x2) < f(x3) Then

x4 = x3

x3 = x2

f(x3) = f(x2)

x2 = x4 - r * (x4 - x1)

Else

x1 = x2

x2 = x3

x3 = x1 + r * (x4 - x1)

End If

Cells(st, 1) = n

Cells(st, 2) = x1

Cells(st, 3) = x2

Cells(st, 4) = x3

Cells(st, 5) = x4

Cells(st, 6) = Abs(x4 - x1)

Cells(st, 7) = f(x2)

Cells(st, 8) = f(x3)

n = n + 1

st = st + 1

GoTo beg

Else

x = (x1 + x4) / 2

dx = (x4 - x1) / 2

End If

Cells(st, 9) = x

Cells(st, 10) = dx

End Sub

Public Function f(z As Variant)

f = -0.503 - 2.818 * z +1.703 * z^2 + z * z * z

End Function

‘статистика

Sub stat()

Dim x() As Single, u() As Single, n As Integer, x_av!, sx!, sx2!, sx_av!, sx_av2!, t!, e!, U_tab!, i As Byte, b!, a!, m!, c!, d!

10: n = InputBox("Введите количество значений х")

ReDim x(n)

ReDim u(n)

For i = 1 To n

x(i) = InputBox("Введите значение х", "Ввод данных")

Cells(1, i) = x(i)

Next i

a = 0

For i = 1 To n

a = a + x(i)

Next i

x_av = a / n

Cells(3, 1) = "x средн."

Cells(4, 1) = x_av

b = 0

For i = 1 To n

b = b + (x(i) - x_av) ^ 2

Next i

sx2 = b / (n - 1)

Cells(3, 2) = "Выбор. дисперсия"

Cells(4, 2) = sx2

sx = Sqr(sx2)

Cells(3, 3) = "Стандарт"

Cells(4, 3) = sx

m = Abs(x_av) / sx

Cells(3, 6) = "Коэф.вариаций"

Cells(4, 6) = m

sx_av2 = sx2 / n

Cells(3, 4) = "Дисп. средн."

Cells(4, 4) = sx_av2

sx_av = Sqr(sx_av2)

Cells(3, 5) = "Станд. средн."

Cells(4, 5) = sx_av

t = InputBox("Введите коэффициэнт Стьюдента при f=n-1 и заданном p")

e = t * sx_av

Cells(5, 1) = x_av - e

Cells(5, 2) = "<x<"

Cells(5, 3) = x_av + e

For i = 1 To n

u(i) = (Abs(x(i) - x_av)) / (Sqr(sx2 * (n - 1) / n))

Next i

For i = 1 To n

Cells(i + 5, 1) = "U(расч)="

Cells(i + 5, 2) = u(i)

Next i

U_tab = InputBox("Введите U-критерий для сравнения")

For i = 1 To n

If u(i) > U_tab Then

c = MsgBox("Одно из значений содержит ошибку;необходимо ввести массив заново без этого значения")

d = MsgBox(x(i))

GoTo 10

End If

Next i

Cells(9, 1) = " "

Cells(9, 2) = " "

Cells(1, 4) = " "

End Sub

‘матричное выражение

Sub matr()

Dim a!(3, 2), b!(2, 3), c!(3, 1), d!(3, 1), c_t!(1, 3), norma_a As Single, x!(3, 2), y!(3, 2), z!(3, 3), Pr_Z As Single, rez As Single

a(1, 1) = 3: a(1, 2) = 4: a(2, 1) = 6: a(2, 2) = 2: a(3, 1) = -3: a(3, 2) = 1

c(1, 1) = 1: c(2, 1) = 3: c(3, 1) = 5

b(1, 1) = -2: b(1, 2) = 1: b(1, 3) = 1: b(2, 1) = 1: b(2, 2) = -5: b(2, 3) = 3

d(1, 1) = -2: d(2, 1) = -3

Cells(1, 2) = "A" :

Cells(2, 1) = a(1, 1)

Cells(2, 3) = a(1, 2) : Cells(3, 1) = a(2, 1)

Cells(3, 3) = a(2, 2) : Cells(4, 1) = a(3, 1)

Cells(4, 3) = a(3, 2) : Cells(1, 6) = "B"

Cells(2, 5) = b(1, 1) : Cells(2, 6) = b(1, 2)

Cells(2, 7) = b(1, 3) : Cells(4, 5) = b(2, 1)

Cells(4, 6) = b(2, 2) : Cells(4, 7) = b(2, 3)

Cells(1, 9) = "c"

Cells(2, 9) = c(1, 1) : Cells(3, 9) = c(2, 1)

Cells(4, 9) = c(3, 1) : Cells(1, 11) = "d"

Cells(2, 11) = d(1, 1) : Cells(4, 11) = d(2, 1)

‘транспонирование c

c_t(1, 1) = c(1, 1)

c_t(1, 2) = c(2, 1)

c_t(1, 3) = c(3, 1)

‘норма A

norma_a = Sqr(a(1, 1) ^ 2 + a(1, 2) ^ 2 + a(2, 1) ^ 2 + a(2, 2) ^ 2 + a(3, 1) ^ 2 + a(3, 2) ^ 2)

‘ d*c_t

x(1, 1) = d(1, 1) * c_t(1, 1) :

x(1, 2) = d(1, 1) * c_t(1, 2)

x(2, 1) = d(2, 1) * c_t(1, 1) :

x(2, 2) = d(2, 1) * c_t(1, 2)

x(3, 1) = d(3, 1) * c_t(1, 1) :

x(3, 2) = d(3, 1) * c_t(1, 2)

Cells(6, 2) = "d*c_t"

Cells(7, 1) = x(1, 1) : Cells(7, 3) = x(1, 2)

Cells(8, 1) = x(2, 1) : Cells(8, 3) = x(2, 2)

Cells(9, 1) = x(3, 1) : Cells(9, 3) = x(3, 2)

‘ d*c_t+B

y(1, 1) = x(1, 1) + b(1, 1) : y(1, 2) = x(1, 2) + b(1, 2)

y(2, 1) = x(2, 1) + b(2, 1) : y(2, 2) = x(2, 2) + b(2, 2)

y(3, 1) = x(3, 1) + b(3, 1) : y(3, 2) = x(3, 2) + b(3, 2)

Cells(6, 6) = "d*c_t+B"

Cells(7, 5) = y(1, 1) : Cells(7, 7) = y(1, 2)

Cells(8, 5) = y(2, 1) : Cells(8, 7) = y(2, 2)

Cells(9, 5) = y(3, 1) : Cells(9, 7) = y(3, 2)

' (d*c_t+A)*A

z(1, 1) = y(1, 1) * a(1, 1) + y(1, 2) * a(2, 1) : z(1, 2) = y(1, 1) * a(1, 2) + y(1, 2) * a(2, 2)

z(1, 3) = y(1, 1) * a(1, 3) + y(1, 2) * a(2, 3) : z(2, 1) = y(2, 1) * a(1, 1) + y(2, 2) * a(2, 1)

z(2, 2) = y(2, 1) * a(1, 2) + y(2, 2) * a(2, 2) : z(2, 3) = y(2, 1) * a(1, 3) + y(2, 2) * a(2, 3)

z(3, 1) = y(3, 1) * a(1, 1) + y(3, 2) * a(2, 1) : z(3, 2) = y(3, 1) * a(1, 2) + y(3, 2) * a(2, 2)

z(3, 3) = y(3, 1) * a(1, 3) + y(3, 2) * a(2, 3)

Cells(6, 10) = "(d*c_t+B)*A"

Cells(7, 9) = z(1, 1) : Cells(7, 10) = z(1, 2)

Cells(7, 11) = z(1, 3) : Cells(8, 9) = z(2, 1)

Cells(8, 10) = z(2, 2) : Cells(8, 11) = z(2, 3)

Cells(9, 9) = z(3, 1) : Cells(9, 10) = z(3, 2)

Cells(9, 11) = z(3, 3)

‘ Pr(Z)

Pr_Z = z(1, 1) * z(2, 2) * z(3, 3)

Cells(11, 1) = "||A||="

Cells(11, 2) = norma_a

Cells(11, 4) = "Pr ="

Cells(11, 5) = Pr_Z

rez = Pr_Z + norma_a

Cells(11, 7) = "rez ="

Cells(11, 8) = rez

End Sub

‘операции над матрицами

Sub matrix()

Dim A(3, 3) As Single, B(2, 3) As Single, BT(3, 2) As Single, L(3, 3) As Single, c(3, 1) As Single, d(3, 1) As Single

Dim E(3, 3) As Single, F(3, 1) As Single, x(3, 1) As Single, i As Byte, j As Byte, norma As Single

Cells(2, 1) = "A="

Cells(2, 6) = "B="

Cells(2, 11) = "c="

Cells(2, 14) = "d="

For i = 1 To 3

For j = 1 To 3

A(i, j) = InputBox("введите A(i,j)")

Cells(i, j + 1) = A(i, j)

Next j

Next i

For i = 1 To 2

For j = 1 To 3

B(i, j) = InputBox("B(i,j)")

Cells(i, j + 6) = B(i, j)

Next j

Next i

For i = 1 To 3

For j = 1 To 1

c(i, j) = InputBox("c(i,j)")

Cells(i, j + 11) = c(i, j)

d(i, j) = InputBox("d(i,j)")

Cells(i, j + 14) = d(i, j)

Next j

Next i

Cells(6, 1) = "BT="

For i = 1 To 3

For j = 1 To 2

BT(i, j) = B(j, i)

Cells(i + 4, j + 1) = BT(i, j)

Next j

Next i

Cells(6, 6) = "L="

For i = 1 To 3

For j = 1 To 3

L(i, j) = BT(i, 1) * B(1, j) + BT(i, 2) * B(2, j)

Cells(i + 4, j + 6) = L(i, j)

Next j

Next i

Cells(6, 11) = "E="

For i = 1 To 3

For j = 1 To 3

E(i, j) = A(i, j) - L(i, j)

Cells(i + 4, j + 11) = E(i, j)

Next j

Next i

Cells(6, 16) = "x="

For i = 1 To 3

For j = 1 To 1

x(i, j) = 2 * c(i, j) + d(i, j)

Cells(i + 4, j + 16) = x(i, j)

Next j

Next i

Cells(9, 1) = "F="

For i = 1 To 3

For j = 1 To 1

F(i, j) = E(i, 1) * x(1, j) + E(i, 2) * x(2, j) + E(i, 3) * x(3, j)

Cells(i + 7, j + 1) = F(i, j)

Next j

Next i

norma = 0

For i = 1 To 3

For j = 1 To 1

norma = norma + F(i, j) ^ 2

Next j

Next I

norma = Sqr(norma)

Cells(12, 1) = "norma="

Cells(12, 2) = norma

End Sub

'Метод прямоугольников назад

Private Sub main()

Dim A, B, n, x, h As Single

Cells(1, 1) = "----- S -----"

Cells(1, 2) = "----- X -----"

A = InputBox("ВВЕДИ! A", "Ввод", -5)

B = InputBox("ВВЕДИ! B", "Ввод", 5)

n = InputBox("ВВЕДИ! n", "Ввод", 4)

h = (B - A) / n

x = A + h

s = 0

nx:

If x <= B Then

s = s + f(x)

x = x + h

GoTo nx

End If

s = s * h

Cells(2, 1) = s

Cells(2, 2) = x

End Sub

Public Function f(z As Variant)

f = -0.503 - 2.818 * z +1.703 * z^2 + z * z * z

End Function

'Метод прямоугольников среднему"

Private Sub main()

Dim A, B, n, x, h As Single

Cells(1, 1) = "----- S -----"

Cells(1, 2) = "----- X -----"

A = InputBox("ВВЕДИ! A", "Ввод", -5)

B = InputBox("ВВЕДИ! B", "Ввод", 5)

n = InputBox("ВВЕДИ! n", "Ввод", 4)

h = (B - A) / n

x = A + h / 2

s = 0

nx:

If x < B Then

s = s + f(x)

x = x + h

GoTo nx

End If

s = s * h

Cells(2, 1) = s

Cells(2, 2) = x

End Sub

Public Function f(z As Variant)

f = -0.503 - 2.818 * z +1.703 * z^2 + z * z * z

End Function

‘метод прямоугольников вперёд

Private Sub main()

Dim A, B, n, x, h As Single

Cells(1, 1) = "----- S -----"

Cells(1, 2) = "----- X -----"

A = InputBox("ВВЕДИ! A", "Ввод", -5)

B = InputBox("ВВЕДИ! B", "Ввод", 5)

n = InputBox("ВВЕДИ! n", "Ввод", 4)

h = (B - A) / n

x = A

s = 0

nx:

If x < B Then

s = s + f(x)

x = x + h

GoTo nx

End If

s = s * h

Cells(2, 1) = s

Cells(2, 2) = x

End Sub

Public Function f(z As Variant)

f = -0.503 - 2.818 * z +1.703 * z^2 + z * z * z

End Function

‘погрешности

Sub d1()

Dim dtx1!, dtx2!, dtx3!, dt_y!, dl_y!, dy_dx1!, dy_dx2!, dy_dx3!, x1!, x2!, x3!, y!

x1 = InputBox("Введите х1", "Ввод данных")

Cells(1, 1) = "x1"

Cells(2, 1) = x1

x2 = InputBox("Введите х2", "Ввод данных")

Cells(1, 2) = "x2"

Cells(2, 2) = x2

x3 = InputBox("Введите х3", "Ввод данных")

Cells(1, 3) = "x3"

Cells(2, 3) = x3

dtx1 = 0.05: dtx2 = 0.05: dtx3 = 0.05

y = x1 ^ 3 / (x1 + 2 * x3 ^ 2) + x3 / x2

Cells(1, 4) = "y"

Cells(2, 4) = y

dy_dx1 = (3 * x1 * x1 * (x1 + 2 * x3 * x3) - x1 ^ 3) / (x1 + 2 * x3 * x3) ^ 2

Cells(4, 1) = "y'(x1)"

Cells(5, 1) = dy_dx1

dy_dx2 = (-x3 / x2 ^ 2)

Cells(4, 2) = "y'(x2)"

Cells(5, 2) = dy_dx2

dy_dx3 = 1 / x2 - (x1 ^ 3 * 4 * x3 / (x1 + 2 * x3 ^ 2) ^ 2)

Cells(4, 3) = "y'(x3)"

Cells(5, 3) = dy_dx3

dt_y = (Abs(dy_dx1)) * dtx1 + (Abs(dy_dx2)) * dtx2 + (Abs(dy_dx3)) * dtx3

Cells(7, 1) = "Абс.погр.y"

Cells(8, 1) = dt_y

dl_y = (dt_y / (Abs(y))) * 100

Cells(7, 3) = "Отн.погр.y (%)"

Cells(8, 3) = dl_y

End Sub

'Деление отрезка на три равные части

Private Sub main()

Dim x1, x2, x3, x4, f2, f3, x, e As Single

Dim i As Integer

x1 = InputBox("a")

x4 = InputBox("b")

e = InputBox("e")

i = 1

While Abs(x4 - x1) > 2 * e

Cells(i, 1) = x1

Cells(i, 4) = x4

x2 = x1 - (x4 - x1) / 3

Cells(i, 2) = x2

x3 = x4 - (x4 - x1) / 3

Cells(i, 3) = x3

f2 = f(f2)

Cells(i, 5) = f2

f3 = f(f3)

If f2 < f3 Then

Cells(i, 7) = "YES!"

x4 = x3

Else

Cells(i, 8) = "NO!"

x1 = x2

i = i + 1

End If

Wend

x = (x4 + x1) / 2

Cells(1, 8) = x

Cells(1, 9) = f(x)

End Sub

Public Function f(z As Variant)

f = -5.503 + 2.818 * z – 1.703 * z * z + z * z * z

End Function