|
本帖最后由 90999 于 2016-2-24 13:05 编辑
源于百度这三帖:
http://tieba.baidu.com/p/3753425942
http://tieba.baidu.com/p/3871481362
http://tieba.baidu.com/p/3894610906
文中说到,根据贴主migeyusu的说法 CORE DUO 相对 i3-4 的在老软件性能仅有后者50-60%。
而AMD 的APU和FX 整数效能凭借高主频稍强于 老旧的CORE DUO,
其中贴出了部分代码,我照抄了部分,做出来玩玩。
PS: 其中基本排序算法我不懂是啥,那贴主说是二分查找我就照弄了.........
代码
Form1部分
- Private times As Integer
- Private INTY, SFOY, DFOY, SCIY, MSY, BSY As Long
- ‘-------------------------------------------------------------------------------------------------------------------
- Private Function valTran(a As Single) As Integer
- valTran = Int(1000000 / (a * 100))
- End Function
- ‘-------------------------------------------------------------------------------------------------------------------
- Private Sub form_load()
- times = 0
- Form1.BorderStyle = 1 '窗体大小不可变
- 'Command1.Default = True '默认回车就是按下按钮
- Command1.Caption = "开始(START)"
- End Sub
- ‘-------------------------------------------------------------------------------------------------------------------
- Private Sub Command1_Click()
- Command1.Enabled = False '禁止按下,变灰色
- Command1.Caption = "运行中(PROCESSING)"
- MsgBox "本次测试下需要较长时间,请勿关闭或操作程序"
- Label1(0).Caption = "最大可用整数性能:计算中"
- DoEvents
- INTY = valTran(intCal())
- Label1(0).Caption = "最大可用整数性能:" + Str(INTY)
- DoEvents
- Label2(0).Caption = "最大可用单精度浮点:计算中"
- DoEvents
- SFOY = valTran(sfoCal())
- Label2(0).Caption = "最大可用单精度浮点:" + Str(SFOY)
- DoEvents
- Label3(0).Caption = "最大可用双精度浮点:计算中"
- DoEvents
- DFOY = valTran(dfoCal())
- Label3(0).Caption = "最大可用双精度浮点:" + Str(DFOY)
- DoEvents
- Label4(0).Caption = "科学计算效能:计算中"
- DoEvents
- SCIY = valTran(sciCal())
- Label4(0).Caption = "科学计算效能:" + Str(SCIY)
- DoEvents
- Label5(0).Caption = "常用排序算法性能:计算中"
- DoEvents
- MSY = valTran(MS())
- Label5(0).Caption = "常用排序算法性能:" + Str(MSY)
- DoEvents
- Label6(0).Caption = "基本排序算法性能:计算中"
- DoEvents
- BSY = valTran(BS())
- Label6(0).Caption = "基本排序算法性能:" + Str(BSY)
- DoEvents
- times = times + 1
- Text1.Text = Text1.Text & "第" & Str(times) & "次数值运算成绩是" & Str(INTY) + "/" & Str(SFOY) & "," & Chr(13) & Chr(10) & "归并排序成绩是 " & Str(MSY) & Chr(13) & Chr(10)
- Command1.Caption = "开始(START)"
- Command1.Enabled = True
- End Sub
复制代码 MODULE1部分
- Public Function intCal9() '整数计算 自写的,丢弃
- Dim i As Long, j As Single, n As Long
- j = Timer
- For i = 1 To 30000000
- n = i + 97
- n = n / 177
- n = n * 11
- n = n - 182 '加减乘除8bit
-
- n = i + 13497
- n = n / 4277
- n = n * 1351
- n = n - 9851 '加减乘除16bit
-
- n = i + 1300497
- n = n / 420077
- n = n * 100351
- n = n - 5529851 '加减乘除24bit
-
- n = i + 667555000
- n = n - 322111500
- n = n / 23335123
- n = n * 32132355 '加减乘除32bit
- Next i
- intCal = (Timer - j) / 4
- End Function
- ‘-------------------------------------------------------------------------------------------------------------------
- Public Function intCal() '整数计算
- Dim i As Long, j As Single, s As Long
- Dim a1, a2, a3, a4, a5, a6, a7, a8, a9, a10 As Long
- a1 = Rnd
- a2 = Rnd
- a3 = Rnd
- a4 = Rnd
- a5 = Rnd
- a6 = Rnd
- a7 = Rnd
- a8 = Rnd
- a9 = Rnd
- a10 = Rnd
- j = Timer
- For i = 1 To 4000000
- a1 = a1 + 1
- a2 = a2 - 1
- a3 = a3 * (a1 + a2) * a4
- a4 = (a4 + a3) Mod 10
- a5 = a5 ^ a4
- a6 = (a5 + a6) / 2
- a7 = Not (a7 * a4)
- a8 = a8 Or a7
- a9 = a9 And a8
- a10 = a10 ^ a9
- Next i
- intCal = (Timer - j) / 4
- s = a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + a10
- End Function
- ‘-------------------------------------------------------------------------------------------------------------------
- Public Function sfoCal9() '单精度浮点计算 自写的,丢弃
- Dim i As Long, j As Single, n As Single
- j = Timer
- For i = 1 To 30000000
-
- n = 1.672298 ^ 23 - 3.31425231 + i ^ 1.2
-
- Next i
- sfoCal9 = Timer - j
- End Function
- ‘-------------------------------------------------------------------------------------------------------------------
- Public Function sfoCal() '单精度浮点计算
- Dim i As Long, j As Single, s As Single
- Dim a1, a2, a3, a4, a5, a6, a7, a8, a9, a10 As Single
- a1 = Rnd / 3.14
- a2 = 2 + a1
- a3 = 3 + a1
- a4 = 4 + a1
- a5 = 5 + a1
- a6 = 6 + a1
- a7 = 7 + a1
- a8 = 8 + a1
- a9 = 9 + a1
- a10 = 10 + a1
- j = Timer
- For i = 1 To 10000000
-
- a1 = a1 + 1.1
- a2 = a1 - 1.3
- a3 = a3 + 1.1
- a4 = a4 - 1.2
- a5 = a1 + a2 + a3 + a4
- a6 = a6 + 3.1
- a7 = a7 - 1
- a8 = a8 + 1.4
- a9 = a9 - 1.5
- a10 = a6 + a7 + a8 + a9
- a10 = a10 * a5
- a10 = a10 ^ 0.5
- a5 = a5 / 2
- a6 = Cos(Sin(a10))
- a2 = Abs(a2)
- a4 = Abs(a4)
- a7 = Abs(a7)
- a9 = Abs(a9)
- a10 = 2 ^ (a10 ^ 0.13)
-
- Next i
- sfoCal = Timer - j
- s = a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + a10
- End Function
- ‘-------------------------------------------------------------------------------------------------------------------
- Public Function dfoCal9() '双精度浮点计算 自写的, 丢弃
- Dim i As Long, j As Single, n As Double
- j = Timer
- For i = 1 To 30000000
-
- n = 1.672298 ^ 52 - 19.314252231 + 999.22999 + i ^ 1.2
- Next i
- dfoCal9 = Timer - j
- End Function
- ‘-------------------------------------------------------------------------------------------------------------------
- Public Function dfoCal() '双精度浮点计算
- Dim i As Long, j As Single, s As Double
- Dim a1, a2, a3, a4, a5, a6, a7, a8, a9, a10 As Double
- a1 = Rnd / 3.14
- a2 = 2 + a1
- a3 = 3 + a1
- a4 = 4 + a1
- a5 = 5 + a1
- a6 = 6 + a1
- a7 = 7 + a1
- a8 = 8 + a1
- a9 = 9 + a1
- a10 = 10 + a1
- j = Timer
- For i = 1 To 10000000
-
- a1 = a1 + 1.1
- a2 = a1 - 1.3
- a3 = a3 + 1.1
- a4 = a4 - 1.2
- a5 = a1 + a2 + a3 + a4
- a6 = a6 + 3.1
- a7 = a7 - 1
- a8 = a8 + 1.4
- a9 = a9 - 1.5
- a10 = a6 + a7 + a8 + a9
- a10 = a10 * a5
- a10 = a10 ^ 0.5
- a5 = a5 / 2
- a6 = Cos(Sin(a10))
- a2 = Abs(a2)
- a4 = Abs(a4)
- a7 = Abs(a7)
- a9 = Abs(a9)
- a10 = 2 ^ (a10 ^ 0.13)
-
- Next i
- dfoCal = Timer - j
- s = a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + a10
- End Function
- ‘-------------------------------------------------------------------------------------------------------------------
- Public Function sciCal() '科学计算
- Dim i As Long, j As Single, n As Double
- j = Timer
- For i = 1 To 30000000
- n = 10
- n = i
- n = n ^ 10
- n = 1 / n
- n = Sqr(n)
- n = Sin(n)
- n = Cos(n)
- n = Tan(n)
- n = Log(n)
- n = Abs(n)
- n = Int(n)
- n = 100!
- n = n Mod i
- n = True And n
- n = True Or n
- n = Not n
- Next i
- sciCal = Timer - j
- End Function
- ‘-------------------------------------------------------------------------------------------------------------------
- Public Sub mergesort(ary1() As Long) '归并排序
- Dim LEN1 As Long
- Dim L1 As Long, L2 As Long
- LEN1 = UBound(ary1)
- Dim ary2() As Long
- Dim j As Long, i As Long
- Dim x As Long
- x = 0
- Dim LEN2 As Long
- i = 1
- j = 0
- x = 0
- LEN2 = 1
- L1 = 0
- L2 = 0
- LEN2 = 1
- Do While LEN1 \ LEN2 >= 2
- Do While i <= LEN1
-
- If i + LEN2 * 2 - 1 <= LEN1 Then
- L1 = i + LEN2 - 1
- j = L1 + 1
- L2 = L1 + LEN2
- ElseIf i - 1 + LEN2 * 1 < LEN1 Then
- L1 = i - 1 + LEN2
- j = L1 + 1
- L2 = LEN1
- Else
- L1 = LEN1
- j = LEN1 + 1
- L2 = LEN1
- End If
-
- ReDim ary2(LEN2 * 2)
- Call aryGet(i, L1, j, L2, ary2, LEN2 * 2, ary1)
- i = L2 + 1
-
- Loop
- x = x + 1
- LEN2 = 2 ^ x
- i = 1
- Loop
- ReDim ary2(LEN1)
- L1 = LEN2
- i = 1
- L2 = LEN1
- j = L1 + 1
- Call aryGet(i, L1, j, L2, ary2, LEN1, ary1)
- End Sub
- ‘-------------------------------------------------------------------------------------------------------------------
- Public Sub aryGet(i As Long, ls1 As Long, j As Long, ls2 As Long, arys() As Long, lst As Long, aryk() As Long)
- Dim k As Long, ii As Long
- ii = i
- k = 1
- Do While i <= ls And j <= ls2
- If aryk(i) <= aryk(j) Then
- arys(k) = aryk(i)
- i = i + 1
- Else
- arys(k) = aryk(j)
- j = j + 1
- End If
-
- k = k + 1
- Loop
- If i > ls1 Then
- For j = j To ls2
- arys(k) = aryk(i)
- k = k + 1
- Next j
- Else
- For i = i To ls1
- arys(k) = aryk(i)
- k = k + 1
- Next i
- End If
- For k = 1 To lst
- If ii <= ls2 Then
- aryk(ii) = arys(k)
- ii = ii + 1
- Else
- Exit For
- End If
- Next k
- End Sub
- ‘-------------------------------------------------------------------------------------------------------------------
- Public Function MS() '归并排序 自写的
- Dim i As Long, j As Single
- Dim aaa(16) As Long
- j = Timer
- For i = 1 To 200000
- aaa(1) = Fix(Rnd * (2 ^ 8))
- aaa(2) = Fix(Rnd * (2 ^ 8))
- aaa(3) = Fix(Rnd * (2 ^ 8))
- aaa(4) = Fix(Rnd * (2 ^ 8))
- aaa(5) = Fix(Rnd * (2 ^ 8))
- aaa(6) = Fix(Rnd * (2 ^ 8))
- aaa(7) = Fix(Rnd * (2 ^ 8))
- aaa(8) = Fix(Rnd * (2 ^ 8))
- aaa(9) = Fix(Rnd * (2 ^ 8))
- aaa(10) = Fix(Rnd * (2 ^ 8))
- aaa(11) = Fix(Rnd * (2 ^ 8))
- aaa(12) = Fix(Rnd * (2 ^ 8))
- aaa(13) = Fix(Rnd * (2 ^ 8))
- aaa(14) = Fix(Rnd * (2 ^ 8))
- aaa(15) = Fix(Rnd * (2 ^ 8))
- aaa(16) = Fix(Rnd * (2 ^ 8))
- Call mergesort(aaa)
- Next i
- MS = Timer - j
- End Function
- ‘-------------------------------------------------------------------------------------------------------------------
- Public Function BS() '二分查找 自写的
- Dim aaa(10000) As Integer
- Dim goal As Integer
- Dim j As Single
- Dim i As Long
- Dim p As Integer
- p = 0
- For i = 1 To 10000
- aaa(i) = Int(Rnd * 50 + 50)
- Next i
- goal = 0
- j = Timer
- For i = 1 To 13000000
- goal = Int(Rnd * 50 + 50)
- p = binary_search(aaa, 10000, goal)
- Next i
- BS = Timer - j
- End Function
- ‘-------------------------------------------------------------------------------------------------------------------
- Public Function binary_search(ary2() As Integer, LEN1 As Integer, goal As Integer) 移植于 http://www.cnblogs.com/shuaiwhu/archive/2011/04/15/2065062.html
- Dim low As Integer
- Dim high As Integer
- Dim middle As Integer
- Dim t As Integer
- t = 0
- low = 0
- high = LEN2 - 1
- Do While (low <= high)
- middle = (low + high) / 2
- If ary2(middle) = goal Then
- t = middle
- Exit Do
- ElseIf ary2(middle) > goal Then
- high = middle - 1
- t = 0
- Else
- low = middle + 1
- t = 0
- End If
- Loop
- binary_search = t
- End Function
复制代码
十多年没写VB6了,不足请提出。
附件中 Test1.2(i5) vb6 为原版测试工具, 工程2为以上代码生成的,体积小的是加了UPX壳的。
|
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有帐号?注册
x
阿莫论坛20周年了!感谢大家的支持与爱护!!
曾经有一段真挚的爱情摆在我的面前,我没有珍惜,现在想起来,还好我没有珍惜……
|