Войти

Показать полную графическую версию : [решено] Неправильно выполняется VBS скрипт для решения уравнений


ProTech Inc
28-01-2018, 23:40
Есть сей скрипт, решающий уравнения.Он работает по количеству циклов.
a = InputBox("Введите левую часть уравнения","GA Solving")
b = 0
min = InputBox("Введите минимальное значение корня","GA Solving")
max = InputBox("Введите максимальное значение корня","GA Solving")
r = InputBox("Введите количество циклов на определение одного корня(больше - точнее)","GA Solving")
s = InputBox("Введите количество попыток определить корень(если вы встретили уравнение с одним корнем ставьте 1;ставьте всегда больше к-ва корней)","GA Solving")
Randomize
For z=1 to s
c = ((max - min + 1)*Rnd + min)
d = ((max - min + 1)*Rnd + min)
e = ((max - min + 1)*Rnd + min)
f = ((max - min + 1)*Rnd + min)
k1 = replace (a,"x",""& c &"")
k2 = replace (a,"x",""& d &"")
k3 = replace (a,"x",""& e &"")
k4 = replace (a,"x",""& f &"")
k1 = replace (k1,",",".")
k2 = replace (k2,",",".")
k3 = replace (k3,",",".")
k4 = replace (k4,",",".")
k1 = eval(k1)
k2 = eval(k2)
k3 = eval(k3)
k4 = eval(k4)
l = 1/Abs(k1)
m = 1/Abs(k2)
n = 1/Abs(k3)
o = 1/Abs(k4)
f = c*l+d*m+e*n+f*o/(l+m+n+o)
For n=1 to r
c = ((max - min + 1)*Rnd + min)
d = ((max - min + 1)*Rnd + min)
e = ((max - min + 1)*Rnd + min)
k1 = replace (a,"x",""& c &"")
k2 = replace (a,"x",""& d &"")
k3 = replace (a,"x",""& e &"")
k4 = replace (a,"x",""& f &"")
k1 = replace (k1,",",".")
k2 = replace (k2,",",".")
k3 = replace (k3,",",".")
k4 = replace (k4,",",".")
k1 = eval(k1)
k2 = eval(k2)
k3 = eval(k3)
k4 = eval(k4)
l = 1/Abs(k1)
m = 1/Abs(k2)
n = 1/Abs(k3)
o = 1/Abs(k4)
D = c*l+d*m+e*n+f*o/(l+m+n+o)
k5 = replace (a,"x",""& D &"")
k5 = replace (k5,",",".")
k5 = eval(k5)
p = 1/Abs(k5)
If p>o Then
f = D
End If
Next
MsgBox f,0,"GA Solving"
Next

В программе нужно заменить количество циклов на точность.Пробовал так - не работает.
a = InputBox("Введите левую часть уравнения","GA Solving")
b = 0
min = InputBox("Введите минимальное значение корня","GA Solving")
max = InputBox("Введите максимальное значение корня","GA Solving")
r = InputBox("Введите минимальную точность определения","GA Solving")
s = InputBox("Введите количество попыток определить корень(если вы встретили уравнение с одним корнем ставьте 1;ставьте всегда больше к-ва корней)","GA Solving")
Randomize
For z=1 to s
c = ((max - min + 1)*Rnd + min)
d = ((max - min + 1)*Rnd + min)
e = ((max - min + 1)*Rnd + min)
f = ((max - min + 1)*Rnd + min)
k1 = replace (a,"x",""& c &"")
k2 = replace (a,"x",""& d &"")
k3 = replace (a,"x",""& e &"")
k4 = replace (a,"x",""& f &"")
k1 = replace (k1,",",".")
k2 = replace (k2,",",".")
k3 = replace (k3,",",".")
k4 = replace (k4,",",".")
k1 = eval(k1)
k2 = eval(k2)
k3 = eval(k3)
k4 = eval(k4)
l = 1/Abs(k1)
m = 1/Abs(k2)
n = 1/Abs(k3)
o = 1/Abs(k4)
f = c*l+d*m+e*n+f*o/(l+m+n+o)
Do
c = ((max - min + 1)*Rnd + min)
d = ((max - min + 1)*Rnd + min)
e = ((max - min + 1)*Rnd + min)
k1 = replace (a,"x",""& c &"")
k2 = replace (a,"x",""& d &"")
k3 = replace (a,"x",""& e &"")
k4 = replace (a,"x",""& f &"")
k1 = replace (k1,",",".")
k2 = replace (k2,",",".")
k3 = replace (k3,",",".")
k4 = replace (k4,",",".")
k1 = eval(k1)
k2 = eval(k2)
k3 = eval(k3)
k4 = eval(k4)
l = 1/Abs(k1)
m = 1/Abs(k2)
n = 1/Abs(k3)
o = 1/Abs(k4)
D = c*l+d*m+e*n+f*o/(l+m+n+o)
k5 = replace (a,"x",""& D &"")
k5 = replace (k5,",",".")
k5 = eval(k5)
p = 1/Abs(k5)
If p>o Then
f = D
L=Abs(k5)
Else
L=Abs(k4)
End If
Loop While L>r
MsgBox f,0,"GA Solving"
Next

Программа выполняется, но ответ выдается с совершенно другой точностью.Помогите найти ошибку, ибо уже намучился с этой проблемой, ничего не помогает.Заранее спасибо!

megaloman
28-01-2018, 23:53
ProTech Inc, Есть сей скрипт, решающий уравнения. »
Уравнения какого вида и каким методом? Не уверен, что кто-то захочет копаться в многоэтажном коде, возможно, кто-то сможет написать свой.

ProTech Inc
29-01-2018, 00:04
megaloman, линейные, квадратные,кубические, дробно-рациональные

если есть возможность написать свой вариант - пожалуйста
Метод - генетический алгоритм.

ProTech Inc
18-02-2018, 23:50
Ошибка заключалась в неправильном вводе формулы, как оказалось, формула должна была быть введена так:f = (c*l+d*m+e*n+f*o)/(l+m+n+o).




© OSzone.net 2001-2012