Alex_Piggy
Advanced Member | Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
Код:
Option Explicit
Dim fso, fStr
Dim aList, a,b,c,d, u
Dim acu, dVal, dRnd, bmin, bmax
Dim ud, udMin, best, vStr
aList = Array (20,23,24,25,26,30,33,34,35,37,40,41,43,45,47,48,50,53,55,57,58,59,60,61,62,65,67,70,71,73,75,79,80,83,85,89,90,92,95,97,98,100)
u = 0.184584124
udmin = 100
Set fso= CreateObject("Scripting.FileSystemObject")
Set fStr = fso.CreateTextFile("results.txt", true)
For a = LBound(aList) to UBound(aList)
For c = a to UBound(aList)
acu = aList(a) * aList(c) / u
bmin = acu / aList(UBound(aList))
If bmin < aList(LBound(aList)) Then bmin = aList(LBound(aList))
bmax = acu / aList(LBound(aList))
If bmax > aList(UBound(aList)) Then bmax = aList(UBound(aList))
For b = Lbound (aList) to UBound(aList)
If aList(b) >= bmin and aList(b) <= bmax Then
dVal = acu / aList(b)
If dVal < aList(b) Then Exit For
dRnd = Round(dVal)
If Abs(dVal - dRnd) < 0.01 Then
If InArray(dRnd,aList) Then
ud = Abs(((100* aList(a) / aList(b)) * (aList(c)/dRnd)) - 100 * u)/u
vStr = "ud= " & ud & "% a=" & aList(a) & " b=" & aList(b) & " c=" & aList(c) & " d=" & dRnd
fStr.WriteLine vStr
If ud < udMin Then
best = vStr
udMin = ud
End if
End If
End If
End If
Next
Next
Next
WScript.Echo "Best: " & best
Function inArray (val, arr)
Dim i
inArray = false
For i = LBound(arr) to UBound(arr)
If val = arr(i) Then
inArray = true
Exit For
End If
Next
End Function
|
Код:
ud= 8,14377629977108E-03% a=20 b=48 c=35 d=79
ud= 3,57638586783113E-03% a=20 b=53 c=45 d=92
ud= 3,55729871315588E-03% a=23 b=35 c=25 d=89
ud= 3,55729871315588E-03% a=23 b=70 c=50 d=89
ud= 3,55729871315588E-03% a=23 b=89 c=70 d=98
ud= 8,70309305135474E-03% a=24 b=47 c=30 d=83
ud= 9,09914182138249E-04% a=24 b=79 c=48 d=79
ud= 8,14377629977108E-03% a=25 b=60 c=35 d=79
ud= 1,03883760927624E-02% a=25 b=67 c=47 d=95
ud= 2,95252834443281E-05% a=26 b=58 c=35 d=85
ud= 3,57638586785038E-03% a=30 b=53 c=30 d=92
ud= 8,01032550265028E-03% a=30 b=62 c=37 d=97
ud= 4,2543277228492E-03% a=33 b=59 c=33 d=100
|
Код:
D:\Downloads\2018_12_31>ptime cscript /nologo test.vbs
ptime 1.0 for Win32, Freeware - http://www.pc-tools.net/
Copyright(C) 2002, Jem Berkes <jberkes@pc-tools.net>
=== cscript /nologo test.vbs ===
Best: ud= 2,95252834443281E-05% a=26 b=58 c=35 d=85
Execution time: 0.323 s
|
|
