[推荐]VB 程序设计的常用算法

风花雪月 · 发表于 2005-8-14 10:49

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？我要加入

x

算法（ Algorithm ）：计算机解题的基本思想方法和步骤。算法的描述：是对要解决一个问题或要完成一项任务所采取的方法和步骤的描述，包括需要什么数据（输入什么数据、输出什么结果）、采用什么结构、使用什么语句以及如何安排这些语句等。通常使用自然语言、结构化流程图、伪代码等来描述算法。 
<H3><A>一、计数、求和、求阶乘等简单算法 </A></H3>
此类问题都要使用循环，要注意根据问题确定循环变量的初值、终值或结束条件，更要注意用来表示计数、和、阶乘的变量的初值。例：用随机函数产生 100 个 [0 ， 99] 范围内的随机整数，统计个位上的数字分别为 1 ， 2 ， 3 ， 4 ， 5 ， 6 ， 7 ， 8 ， 9 ， 0 的数的个数并打印出来。 
本题使用数组来处理，用数组 a(1 to 100) 存放产生的确 100 个随机整数，数组 x(1 to 10) 来存放个位上的数字分别为 1 ， 2 ， 3 ， 4 ， 5 ， 6 ， 7 ， 8 ， 9 ， 0 的数的个数。即个位是 1 的个数存放在 x(1) 中，个位是 2 的个数存放在 x(2) 中， …… 个位是 0 的个数存放在 x(10) 。 
将程序编写在一个 GetTJput 过程中，代码如下： 
Public Sub GetTJput() 
Dim a(1 To 100) As Integer 
Dim x(1 To 10) As Integer 
Dim i As Integer, p As Integer 
' 产生 100 个 [0 ， 99] 范围内的随机整数，每行 10 个打印出来 For i = 1 To 100 
a(i) = Int(Rnd * 100) 
If a(i) < 10 Then 
Form1.Print Space(2); a(i); 
Else 
Form1.Print Space(1); a(i); 
End If 
If i Mod 10 = 0 Then Form1.Print 
Next i 
' 统计个位上的数字分别为 1 ， 2 ， 3 ， 4 ， 5 ， 6 ， 7 ， 8 ， 9 ， 0 的数的个数，并将统计结果保存在数组 x(1),x(2),...,x(10) 中，将统计结果打印出来 
For i = 1 To 100 
p = a(i) Mod 10 ' 求个位上的数字 
If p = 0 Then p = 10 
x(p) = x(p) + 1 
Next i 
Form1.Print " 统计结果 " 
For i = 1 To 10 
p = i 
If i = 10 Then p = 0 
Form1.Print " 个位数为 " + Str(p) + " 共 " + Str(x(i)) + " 个 " 
Next i 
End Sub 
<H3><A>二、求两个整数的最大公约数、最小公倍数 </A></H3>
分析：求最大公约数的算法思想： ( 最小公倍数 = 两个整数之积 / 最大公约数 ) 
(1) 对于已知两数 m ， n ， 使得 m>n ； 
(2) m 除以 n 得余数 r ； 
(3) 若 r= 0 ，则 n 为求得的最大公约数，算法结束；否则执行 (4) ； 
(4) m ← n ， n ← r ，再重复执行 (2) 。 
例如 : 求 m=14 ,n=6 的最大公约数 . m n r 
14 6 2 
6 2 0 
m=inputBox("m=") 
n=inputBox("n=") 
nm=n*m 
If m < n Then t = m: m = n: n = t 
r=m mod n 
Do While (r <> 0) 
m=n 
n=r 
r= m mod n 
Loop Print " 最大公约数 =", n 
Print " 最小公倍数 =", nm/n 
<A>三、判断素数 </A>
只能被 1 或本身整除的数称为素数基本思想：把 m 作为被除数，将 2—INT （ <IMG src="http://www.ahbvc.cn/jpkc/vbjpck/cysf_clip_image002.gif">）作为除数，如果都除不尽， m 就是素数，否则就不是。（可用以下程序段实现） 
m =val( InputBox(" 请输入一个数 ")) 
For i=2 To int(sqr(m)) 
If m Mod i = 0 Then Exit For 
Next i 
If i > int(sqr(m)) Then 
Print " 该数是素数 " 
Else 
Print " 该数不是素数 " 
End If 
将其写成一函数 , 若为素数返回 True ，不是则返回 False 
Private Function Prime( m as Integer) As Boolean 
Dim i% 
Prime=True 
For i=2 To int(sqr(m)) 
If m Mod i = 0 Then Prime=False: Exit For 
Next i 
End Function

风花雪月 · 发表于 2005-8-14 10:49

<A>四、验证哥德巴赫猜想 </A>
（任意一个大于等于 6 的偶数都可以分解为两个素数之和） 
基本思想： n 为大于等于 6 的任一偶数，可分解为 n1 和 n2 两个数，分别检查 n1 和 n2 是否为素数，如都是，则为一组解。如 n1 不是素数，就不必再检查 n2 是否素数。先从 n1=3 开始，检验 n1 和 n2 （ n2=N-n1 ）是否素数。然后使 n1+2 再检验 n1 、 n2 是否素数， … 直到 n1=n/2 为止。 
利用上面的 prime 函数，验证哥德巴赫猜想的程序代码如下： 
Dim n%,n1%,n2% 
n=Val(InputBox(" 输入大于 6 的正整数 ")) 
For n1=3 to n\2 step 2 
n2=n-n1 
If prime(n1) Then 
If prime(n2) then 
Print n & "=" & n1 & "+" & n2 
Exit For ' 结束循环 
End if 
End if 
Next n1 
<A>五、排序问题 </A>
1 ．选择法排序（升序） 
基本思想： 
1 ）对有 n 个数的序列（存放在数组 a(n) 中），从中选出最小的数，与第 1 个数交换位置； 
2 ）除第 1 个数外，其余 n-1 个数中选最小的数，与第 2 个数交换位置； 
3 ）依次类推，选择了 n-1 次后，这个数列已按升序排列。 
程序代码如下： 
For i = 1 To n - 1 
imin = i 
For j = i + 1 To n 
If a(imin) > a(j) Then imin = j 
Next j 
temp = a(i) 
a(i) = a(imin) 
a(imin) = temp 
Next I 
2 ．冒泡法排序（升序） 
基本思想： ( 将相邻两个数比较，小的调到前头 ) 
1 ）有 n 个数（存放在数组 a(n) 中），第一趟将每相邻两个数比较，小的调到前头，经 n-1 次两两相邻比较后，最大的数已“沉底”，放在最后一个位置，小数上升“浮起”； 
2 ）第二趟对余下的 n-1 个数（最大的数已“沉底”）按上法比较，经 n-2 次两两相邻比较后得次大的数； 
3 ）依次类推， n 个数共进行 n-1 趟比较，在第 j 趟中要进行 n-j 次两两比较。 
程序段如下 
For i = 1 To n - 1 
For j = 1 To n-i 
If a(j) > a(j+1) Then 
temp=a(j) ： a(j)=a(j+1) ： a(j+1)=temp 
End if 
Next j 
Next i 
 
3 ．合并法排序（将两个有序数组 A 、 B 合并成另一个有序的数组 C ，升序） 
基本思想： 
1 ）先在 A 、 B 数组中各取第一个元素进行比较，将小的元素放入 C 数组； 
2 ）取小的元素所在数组的下一个元素与另一数组中上次比较后较大的元素比较，重复上述比较过程，直到某个数组被先排完； 
3 ）将另一个数组剩余元素抄入 C 数组，合并排序完成。 
程序段如下： 
Do While ia <= UBound(A) And ib <= UBound(B) ' 当 A 和 B 数组均未比较完 
If A(ia) < B(ib) Then 
C(ic) = A(ia) ： ia = ia + 1 
Else 
C(ic) = B(ib) ： ib = ib + 1 
End If 
ic = ic + 1 
Loop 
Do While ia <= UBound(A) 'A 数组中的剩余元素抄入 C 数组 
C(ic) = A(ia) 
ia = ia + 1 ： ic = ic + 1 
Loop 
Do While ib <= UBound(B) 'B 数组中的剩余元素抄入 C 数组 
C(ic) = B(ib) 
ib = ib + 1 ： ic = ic + 1 
Loop

风花雪月 · 发表于 2005-8-14 10:50

<A>六、查找问题 </A>
1 ． ① 顺序查找法（在一列数中查找某数 x ） 
基本思想：一列数放在数组 a(1)---a(n) 中，待查找的数放在 x 中，把 x 与 a 数组中的元素从头到尾一一进行比较查找。用变量 p 表示 a 数组元素下标， p 初值为 1 ，使 x 与 a(p) 比较，如果 x 不等于 a(p) ，则使 p=p+1 ，不断重复这个过程；一旦 x 等于 a(p) 则退出循环；另外，如果 p 大于数组长度，循环也应该停止。（这个过程可由下语句实现） 
p = 1 
Do While x <> a(p) And p < =n 
p = p + 1 
Loop 
下面写一查找函数 Find ，若找到则返回下标值，找不到返回 0 
Option Base 1 
Private Function Find( a( ) As Single,x As Single) As Integer 
Dim n%,p% 
n=Ubound( a ) 
p = 1 
Do While x <> a(p) And p < =n 
p = p + 1 
Loop 
If p>n then p=0 
Find=p 
End Function 
 
②基本思想：一列数放在数组 a(1)---a(n) 中，待查找的关键值为 key ，把 key 与 a 数组中的元素从头到尾一一进行比较查找，若相同，查找成功，若找不到，则查找失败。 ( 查找子过程如下。 index ：存放找到元素的下标。 ) 
Public Sub Search(a() As Variant, key As Variant, index%) 
Dim i% 
For i = LBound(a) To UBound(a) 
If key = a(i) Then 
index = i 
Exit Sub 
End If 
Next i 
index = -1 
End Sub 
 
2 ．折半查找法（只能对有序数列进行查找） 
基本思想：设 n 个有序数（从小到大）存放在数组 a(1)----a(n) 中，要查找的数为 x 。用变量 bot 、 top 、 mid 分别表示查找数据范围的底部（数组下界）、顶部（数组的上界）和中间， mid=(top+bot)/2 ，折半查找的算法如下： 
（ 1 ） x=a(mid) ，则已找到退出循环，否则进行下面的判断； 
（ 2 ） x<a(mid) ， x 必定落在 bot 和 mid-1 的范围之内，即 top=mid-1 ； 
（ 3 ） x>a(mid) ， x 必定落在 mid+1 和 top 的范围之内，即 bot=mid+1 ； 
（ 4 ）在确定了新的查找范围后，重复进行以上比较，直到找到或者 bot<=top 。 
将上面的算法写成如下函数，若找到则返回该数所在的下标值，没找到则返回 -1 。 
Function search(a() As Integer, x As Integer) As Integer 
Dim bot%, top%, mid% 
Dim find As Boolean ' 代表是否找到 
bot = LBound(a) 
top = UBound(a) 
find = False ' 判断是否找到的逻辑变量，初值为 False 
Do While bot <= top And Not find 
mid = (top + bot) \ 2 
If x = a(mid) Then 
find = True 
Exit Do 
ElseIf x < a(mid) Then 
top = mid - 1 
Else 
bot = mid + 1 
End If 
Loop 
If find Then 
search = mid 
Else 
search = -1 
End If 
End Function 
<A>七、插入法 </A>
把一个数插到有序数列中，插入后数列仍然有序 
基本思想： n 个有序数（从小到大）存放在数组 a(1)—a(n) 中，要插入的数 x 。首先确定 x 插在数组中的位置 P ；（可由以下语句实现） 
p=1 
do while x>a(p) and p<=n 
p=p+1 
loop 
a(p)—a(n) 元素向后顺移一个位置以空出 a(p) 元素放入 x ，可由以下语句实现： 
for i=n to p step-1 
a(i+1)=a(i) 
next i 
a(p)=x 
将其写成一插入函数 
Private Sub Instert(a() As Single, x As Single) 
Dim p%, n%, i% 
n = UBound(a) 
ReDim Preserve a(n + 1) 
p = 0 
Do While x > a(p) And p < =n ' 确定 x 应插入的位置 
p = p + 1 
Loop 
For i = n To p Step -1 
a(i + 1) = a(i) 
Next i 
a(p) = x 
End Sub

风花雪月 · 发表于 2005-8-14 10:50

<A>八、矩阵（二维数组）运算 </A>
（ 1 ） 矩阵的加、减运算 
C(i,j)=a(i,j)+b(i,j) 加法 
C(i,j)=a(i,j)-b(i,j) 减法 
（ 2 ）矩阵相乘 
（矩阵 A 有 M*L 个元素，矩阵 B 有 L*N 个元素，则矩阵 C=A*B 有 M*N 个元素）。矩阵 C 中任一元素 (i=1,2,…,m; j=1,2,…,n) 
For i = 0 To m 
For j = 0 To n 
c(i, j) = 0 
For k = 0 To l 
c(i, j) = c(i, j) + a(i, k) * b(k, j) 
Next k 
Next j 
Next i 
（ 3 ）矩阵传置 
例 : 有二维数组 a(5,5) ，要对它实现转置，可用下面两种方式： 
For i=1 to 5 (2) For i=2 to 5 
For j=i+1 to 5 For j=1 to i 
t=a(i,j) t=a(i,j) 
a(i,j)= a(j,i) a(i,j)= a(j,i) 
a(j,i)=t a(j,i)=t 
Next j Next j 
Next i Next i 
（ 4 ）求二维数组中最小元素及其所在的行和列 
基本思路同一维数组，可用下面程序段实现（以二维数组 a(2,3) 为例）： 
‘变量 max 中存放最大值， row,column 存放最大值所在行列号 
Max = a(1, 1): row = 1: Column = 1 
For i = 1 To 2 
For j = 1 To 3 
If a(i, j) > a(row, Column) Then 
Max = a(i, j) 
row = i 
Column = j 
End If 
Next j 
Next i 
Print " 最大元素是 "; Max 
Print " 在第 " & row & " 行 ,"; " 第 " & Column & " 列 " 
<H3><A>九、迭代法 </A></H3>
算法思想： 
对于一个问题的求解 x ，可由给定的一个初值 x0 ，根据某一迭代公式得到一个新的值 x1 ，这个新值 x1 比初值 x0 更接近要求的值 x ；再以新值作为初值，即： x1 → x0, 重新按原来的方法求 x1, 重复这一过和直到 |x1-x0|< ε ( 某一给定的精度 ) 。此时可将 x1 作为问题的解。 
例：用迭代法求某个数的平方根。已知求平方根的迭代公式为： 
Private Function Fsqrt( a As single ) AS single 
Dim x0 As Single, x1 As Single 
x0 =a/2 ' 迭代初值 
x1 = 0.5*(x0 + a/x0) 
Do 
x0 = x1 ' 为下一次迭代作准备 
x1 = 0.5*(x0 + a/x0) 
Loop While Abs(x1 - x0) > 0.00001 
Fsqrt=x1 
End Function 
<H3><A>十、数制转换 </A></H3>
将一个十进制整数 m 转换成 → r(2 － 16) 进制字符串。 
方法：将 m 不断除 r 取余数，直到商为零，以反序得到结果。下面写出一转换函数，参数 idec 为十进制数， ibase 为要转换成数的基（如二进制的基是 2 ，八进制的基是 8 等），函数输出结果是字符串。 
Private Function TrDec(idec As Integer, ibase As Integer) As String 
Dim strDecR$, iDecR% 
strDecR = "" 
Do While idec <> 0 
iDecR = idec Mod ibase 
If iDecR >= 10 Then 
strDecR = Chr$(65 + iDecR - 10) & strDecR 
Else 
strDecR = iDecR & strDecR 
End If 
idec = idec \ ibase 
Loop 
TrDec = strDecR 
End Function 
<H3><A>十一、字符串的一般处理 </A></H3>
1 ．简单加密和解密 
加密的思想是： 
将每个字母 C 加（或减）一序数 K ，即用它后的第 K 个字母代替，变换式公式： c=chr(Asc(c)+k) 
例如序数 k 为 5 ，这时 "A" → "F" ， "a" →? "f" ， "B" →? "G"… 
当加序数后的字母超过 "Z" 或 "z" 则 c=Chr(Asc(c)+k -26) 
例如： You are good → Dtz fwj ltti 
解密为加密的逆过程 
将每个字母 C 减（或加）一序数 K ，即 c=chr(Asc(c)-k), 
例如序数 k 为 5 ，这时 "Z" → "U" ， "z" → "u" ， "Y" → "T"… 
当加序数后的字母小于 "A" 或 "a" 则 c=Chr(Asc(c)-k +26) 
下段程序是加密处理： 
i = 1: strp = "" 
nL = Len(RTrim(strI)) 
Do While (i <= nL) 
strT = Mid$(strI, i, 1) ' 取第 i 个字符 
If (strT >= "A" And strT <= "Z") Then 
iA = Asc(strT) + 5 
If iA > Asc("Z") Then iA = iA - 26 
strp = strp + Chr$(iA) 
ElseIf (strT >= "a" And strT <= "z") Then 
iA = Asc(strT) + 5 
If iA > Asc("z") Then iA = iA - 26 
strp = strp + Chr$(iA) 
Else 
strp = strp + strT 
End If 
i = i + 1 
Loop 
Print strp 
2 ． 统计文本单词的个数 
算法思路： 
（ 1 ）从文本（字符串）的左边开始，取出一个字符；设逻辑量 WT 表示所取字符是否是单词内的字符，初值设为 False 
（ 2 ）若所取字符不是 “ 空格 ” ， “ 逗号 ” ， “ 分号 ” 或 “ 感叹号 ” 等单词的分隔符，再判断 WT 是否为 True ，若 WT 不为 True 则表是新单词的开始，让单词数 Nw=Nw+1 ，让 WT=True; 
（ 3 ）若所取字符是 “ 空格 ” ， “ 逗号 ” ， “ 分号 ” 或 “ 感叹号 ” 等单词的分隔符，则表示字符不是单词内字符，让 WT=False; 
• 再依次取下一个字符，重得（ 2 ） (3) 直到文本结束 。 
下面程序段是字符串 strI 中包含的单词数 
Nw = 0: Wt = False 
nL = Len(RTrim(strI)) 
For i = 1 To nL 
strT = Mid$(strI, i, 1) ' 取第 i 个字符 
Select Case strT 
Case " ", ",", ";", "!" 
Wt = False 
Case Else 
If Not Wt Then 
Nw = Nw + 1 
Wt = True 
End If 
End Select 
Next i 
Print " 单词数为： ", Nw 
 <A>十二、穷举法 </A>
穷举法（又称 “ 枚举法 ” ）的基本思想是：一一列举各种可能的情况，并判断哪一种可能是符合要求的解，这是一种 “ 在没有其它办法的情况的方法 ” ，是一种最 “ 笨 ” 的方法，然而对一些无法用解析法求解的问题往往能奏效，通常采用循环来处理穷举问题。 
例： 将一张面值为 100 元的人民币等值换成 100 张 5 元、 1 元和 0.5 元的零钞，要求每种零钞不少于 1 张，问有哪几种组合？ 
Dim i%, j%, k% 
Print "5 元 1 元 0.5 元 " 
For i = 1 To 20 
For j = 1 To 100 - i 
k = 100 - i - j 
If 5.0 * i + 1.0 * j + 0.5 * k = 100 Then 
Print i, j, k 
End If 
Next j 
Next i
<H3><A>十三、递归算法 </A></H3>
用自身的结构来描述自身，称递归 
VB 允许在一个 Sub 子过程和 Function 过程的定义内部调用自己，即递归 Sub 子过程和递归 Function 函数。递归处理一般用栈来实现，每调用一次自身，把当前参数压栈，直到递归结束条件；然后从栈中弹出当前参数，直到栈空。 
递归条件： （ 1 ）递归结束条件及结束时的值；（ 2 ）能用递归形式表示，且递归向终止条件发展。 
例：编 fac (n)=n! 的递归函数 
Function fac(n As Integer) As Integer 
If n = 1 Then 
fac = 1 
Else 
fac = n * fac(n - 1) 
End If 
End Function

zpywy · 发表于 2007-9-20 01:32

收藏中......
十分感谢楼主的资料

无水1324 · 发表于 2007-10-12 11:13

楼主真实个高人，以后又这方面的问题要多向你请教

wanyeqing2003 · 发表于 2007-11-26 19:56

好东西。收藏。

abss · 发表于 2008-1-24 10:33

好东西。收藏。

bx52121 · 发表于 2008-3-27 21:33

请教楼主龙格库塔变步长法的编写程序，急用，谢谢！~

konggu168 · 发表于 2008-4-3 18:52

楼上的朋友如果还没找到，请留下信箱

繁华末路 · 发表于 2008-12-5 19:57

请教楼主如何编一个平面钢架矩阵有限元程序vb编的，谢谢！

xiaoli1983 · 发表于 2009-1-12 22:13

有点遗憾，缺少使用VB编程那些优化算法，好像比你原来用的程序简单:@(

yangjiong · 发表于 2009-1-15 21:21

谢谢！！很好！！！

logxing · 发表于 2009-1-24 23:27

不错，不过我现在都使用vb2005了。
有没有比较高级的算法啊，比如多元函数极值，非线性最小二乘法等优化算法，还有矩阵求逆，稀疏矩阵的算法等等。

账号		自动登录	找回密码
密码			我要加入

[VB] [推荐]VB 程序设计的常用算法

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

回复：（风花雪月）[推荐]VB 程序设计的常用算法

回复：（风花雪月）[推荐]VB 程序设计的常用算法

回复：（风花雪月）[推荐]VB 程序设计的常用算法

回复 #4 风花雪月的帖子

龙格库塔变步长法

ok

[VB] [推荐]VB 程序设计的常用算法

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

回复：（风花雪月）[推荐]VB 程序设计的常用算法

回复：（风花雪月）[推荐]VB 程序设计的常用算法

回复：（风花雪月）[推荐]VB 程序设计的常用算法

回复 #4 风花雪月 的帖子

龙格库塔变步长法

ok

回复 #4 风花雪月的帖子