![]() |
Неправильно выполняется VBS скрипт для решения уравнений
Есть сей скрипт, решающий уравнения.Он работает по количеству циклов.
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 Программа выполняется, но ответ выдается с совершенно другой точностью.Помогите найти ошибку, ибо уже намучился с этой проблемой, ничего не помогает.Заранее спасибо! |
ProTech Inc,
Цитата:
|
megaloman, линейные, квадратные,кубические, дробно-рациональные
если есть возможность написать свой вариант - пожалуйста Метод - генетический алгоритм. |
Ошибка заключалась в неправильном вводе формулы, как оказалось, формула должна была быть введена так:f = (c*l+d*m+e*n+f*o)/(l+m+n+o).
|
Время: 22:46. |
Время: 22:46.
© OSzone.net 2001-