VB编程用经常要用到的算法

感觉不错，转了过来

我看到的原始地址http://www.cnblogs.com/redfox241/archive/2008/04/15/1154841.html

算法（Algorithm）：计算机解题的基本思想方法和步骤。算法的描述：是对要解决一个问题或要完成一项任务所采取的方法和步骤的描述，包括需要什么数据（输入什么数据、输出什么结果）、采用什么结构、使用什么语句以及如何安排这些语句等。通常使用自然语言、结构化流程图、伪代码等来描述算法。

一、计数、求和、求阶乘等简单算法

　　此类问题都要使用循环，要注意根据问题确定循环变量的初值、终值或结束条件，更要注意用来表示计数、和、阶乘的变量的初值。

　　例：用随机函数产生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

　　

二、求两个整数的最大公约数、最小公倍数



分析：求最大公约数的算法思想：(最小公倍数=两个整数之积/最大公约数)

       (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 

三、判断素数

　　只能被1或本身整除的数称为素数  基本思想：把m作为被除数，将2—INT（）作为除数，如果都除不尽，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



　　　



四、验证哥德巴赫猜想

　　（任意一个大于等于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 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



五、排序问题

　　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





六、查找问题

　　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



　　

七、插入法

　　把一个数插到有序数列中，插入后数列仍然有序

　　基本思想：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



　　

八、矩阵（二维数组）运算

　　　（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 & "列"

九、迭代法

　　　算法思想：



对于一个问题的求解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

十、数制转换

     将一个十进制整数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

十一、字符串的一般处理

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;

(4) 再依次取下一个字符，重得（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



十二、穷举法

　　穷举法（又称“枚举法”）的基本思想是：一一列举各种可能的情况，并判断哪一种可能是符合要求的解，这是一种“在没有其它办法的情况的方法”，是一种最“笨”的方法，然而对一些无法用解析法求解的问题往往能奏效，通常采用循环来处理穷举问题。

　　例： 将一张面值为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



十三、递归算法

　　用自身的结构来描述自身，称递归

　　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