想对递归有更深刻的了解

2008-03-08 03:46:42 207 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

qiu5208 墨衍会员 · AI 创作全网分发关注 + 加入社区

深刻的理解递归汉诺塔（Hanoi）算法： 1，从目标出发，我们将n个盘子从A移动到B通过C，假如我们这样写 hanoi(n， a， b， c); 阅读详情

想对递归有更深刻的了解
那位高手有比较典型的例子,有代码最好,或好的材料欢迎发上来.
代码最好是vb代码.

...全文

浅谈递归思想文章目录前言递归的形态归纳法递归的思想递归思想的练习棋盘放麦粒汉诺塔问题赏金问题归并排序前言如果一谈到“递归”你的脑海就浮现出“自己调用自己”，我想说：“你可能并不懂递归”。当然了，这仅仅是个人鄙见。许多时候，递归确实在“自己调用自己”。我们知道这个道理吧，想用递归解决实际问题却又犯难了——怎么就写不出代码来了呢？我想异于网上千篇一律文章的讲法，小小的别开生面一回，用自己认为容易理解的方式来... 阅读详情

qiu5208

VB基础类 7,788 成员 197,583 内容

+ 关注 + 加入社区

切换为时间正序

qiu5208 2008-03-13

打赏
举报

阶乘，和快速排序法的列子已经熟悉，谢谢你们

结帖吧。

qiu5208 2008-03-12

打赏
举报

谢谢大家

理清了cbm666朋友的代码,受益匪浅



Private Sub Command1_Click()

Dim aay() As String

Call SeachFile(aay, "e:\vbAPI\", "*.txt,*.gif")

Dim i As Integer

For i = 1 To UBound(aay)

Debug.Print aay(i)



Next



End Sub

'==================================================

'搜索文件子过程

Sub SeachFile(Ay() As String, ByVal Path As String, _

              Optional ByVal strSc As String = "")

'Ay():返回所有符合搜索条件的文件,Ay(0)不是,从Ay(1)开始

'path:搜索路径

'strSc:搜索条件,用逗号分开,比如 "*.txt,win*.*"

'====================================================

Static scType() As String '搜索条件字串

Dim i As Long



DoEvents

On Error Resume Next



'初始化

If strSc <> "" Then

  scType = Split(Trim(strSc), ",")

  ReDim Preserve Ay(0)

End If

If Right(Path, 1) <> "\" Then Path = Path & "\"





'对当前的目录进行文件搜索

For i = 0 To UBound(scType)

   Ay(0) = Dir(Path & scType(i), vbNormal Or vbReadOnly Or vbHidden)

   Do While Ay(0) <> ""

         ReDim Preserve Ay(1 + UBound(Ay))

         Ay(UBound(Ay)) = Path & Ay(0)

         Ay(0) = Dir

   Loop

Next



'列举出所有子目录

Dim subPath() As String '存放子目录数组

ReDim subPath(0)

subPath(0) = Dir(Path, vbDirectory)

 Do While subPath(0) <> ""

      

    '去掉当前目录,和上级目录

    If subPath(0) <> "." And subPath(0) <> ".." Then

       

       '判断是否是目录

       If (GetAttr(Path & subPath(0)) And vbDirectory) = vbDirectory Then

        ReDim Preserve subPath(1 + UBound(subPath))

        subPath(UBound(subPath)) = Path & subPath(0)

       End If

    

    End If

    subPath(0) = Dir

Loop



'如果有子目录的话,进行递归

If UBound(subPath) > 0 Then

  For i = 1 To UBound(subPath)

     Call SeachFile(Ay, subPath(i))

  Next

End If



End Sub

z_wenqian 2008-03-12

打赏
举报

Public Sub sort快速递归排序(ByRef dataArray As Variant)
r_Quick dataArray, 0, UBound(dataArray)
End Sub

Private Sub r_Quick(ByRef dataArray As Variant, ByVal low As Long, ByVal high As Long)
Dim i As Long, j As Long, t As Long
If low < high Then
i = low: j = high: t = dataArray(low)
While i < j
While i < j And dataArray(j) > t
j = j - 1
Wend
If i < j Then
dataArray(i) = dataArray(j)
i = i + 1
End If
While i < j And dataArray(i) <= t
i = i + 1
Wend
If i < j Then
dataArray(j) = dataArray(i)
j = j - 1
End If
Wend
dataArray(i) = t
r_Quick dataArray, low, i - 1
r_Quick dataArray, i + 1, high
End If
End Sub

qiu5208 2008-03-11

打赏
举报

不好意思,错了一行,
一定要改,不然有发病毒的嫌疑



'删除空目录

ElseIf fsoFolder.Files.Count = 0 Then

    fsoFolder.Delete

End If

qiu5208 2008-03-11

打赏
举报

理通了7楼的代码,剩下慢慢看.



Sub DeleteEmptyFolders(ByVal recentlyPath As String)

'''''''''''''''''''''''''''''''''''''''''''''''

'删除指定目录下的所有目录.

'recentlyPath参数:指定目录

'''''''''''''''''''''''''''''''''''''''''''''''

Dim fsoFolder As Folder '一个由recentlyPath指定的目录对象

Dim fsoI As Folder

Dim Fso As FileSystemObject '文件系统对象

Set Fso = New FileSystemObject



'交出控制权,及除错

DoEvents

On Error Resume Next



'如果目录不存在的话,退出子过程

If Not Fso.FolderExists(recentlyPath) Then Exit Sub

Set fsoFolder = Fso.GetFolder(recentlyPath) '创建一个folder



'对所有的子目录递归

If fsoFolder.SubFolders.Count > 0 Then

   For Each fsoI In fsoFolder.SubFolders

     DeleteEmptyFolders fsoI.Path '递归

   Next



'删除空目录

ElseIf fsoFolder.SubFolders.Count = 0 Then

    fsoFolder.Delete

End If



End Sub

tmd007 2008-03-10

打赏
举报

写个简单的例子,所谓阶乘的递归

Private Sub Command1_Click()
Debug.Print dg(7)
End Sub

Function dg(n)
If n = 0 Then
dg = 1
Else
dg = dg(n - 1) * n
End If
End Function

qiu5208 2008-03-10

打赏
举报

Recursively delete any subkey

to VBAdvisor

这段程序的作用是什么？

siwolf1129 2008-03-10

打赏
举报

他不想学，哈哈。。。。

VBAdvisor 2008-03-10

打赏
举报

以上的2个例子是完整的。你一步一步的Debug吧，你不然怎么明白Recursive?

qiu5208 2008-03-09

打赏
举报

呵呵，这样的天书可不好看啊。

VBAdvisor 2008-03-09

打赏
举报

Recursively Delete Empty Folders

'References to
'Microsoft Scripting Runtime

Public Sub DeleteEmptyFolders(ByVal strFolderPath As String)
Dim fsoSubFolders As Folders
Dim fsoFolder As Folder
Dim fsoSubFolder As Folder

Dim strPaths()
Dim lngFolder As Long
Dim lngSubFolder As Long

DoEvents

Set m_fsoObject = New FileSystemObject
If Not m_fsoObject.FolderExists(strFolderPath) Then Exit Sub

Set fsoFolder = m_fsoObject.GetFolder(strFolderPath)

On Error Resume Next

'Has sub-folders
If fsoFolder.SubFolders.Count > 0 Then
lngFolder = 1
ReDim strPaths(1 To fsoFolder.SubFolders.Count)
'Get each sub-folders path and add to an array
For Each fsoSubFolder In fsoFolder.SubFolders
strPaths(lngFolder) = fsoSubFolder.Path
lngFolder = lngFolder + 1
Next fsoSubFolder

lngSubFolder = 1
'Recursively call the function for each sub-folder
Do While lngSubFolder < lngFolder
Call DeleteEmptyFolders(strPaths(lngSubFolder))
lngSubFolder = lngSubFolder + 1
Loop
End If

'No sub-folders or files
If fsoFolder.Files.Count = 0 And fsoFolder.SubFolders.Count = 0 Then
fsoFolder.Delete
End If
End Sub

VBAdvisor 2008-03-09

打赏
举报

Recursively delete any subkey

Option Explicit

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Private Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long

Private Const ERROR_SUCCESS = 0&

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_CONFIG = &H80000005
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003

Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const SYNCHRONIZE = &H100000
Private Const KEY_ALL_ACCESS = _
((STANDARD_RIGHTS_ALL Or _
KEY_QUERY_VALUE Or _
KEY_SET_VALUE Or _
KEY_CREATE_SUB_KEY Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY Or KEY_CREATE_LINK) And _
(Not SYNCHRONIZE))
Private Const ERROR_NO_MORE_ITEMS = 259&

Private m_SelectedSection As Long

Private Const REG_BINARY = 3
Private Const REG_DWORD = 4
Private Const REG_DWORD_BIG_ENDIAN = 5
Private Const REG_DWORD_LITTLE_ENDIAN = 4
Private Const REG_EXPAND_SZ = 2
Private Const REG_FULL_RESOURCE_DESCRIPTOR = 9
Private Const REG_LINK = 6
Private Const REG_MULTI_SZ = 7
Private Const REG_NONE = 0
Private Const REG_RESOURCE_LIST = 8
Private Const REG_RESOURCE_REQUIREMENTS_LIST = 10
Private Const REG_SZ = 1
' Delete all the key's subkeys.
Private Sub DeleteSubkeys(ByVal section As Long, ByVal key_name As String)
Dim hKey As Long
Dim subkeys As Collection
Dim subkey_num As Long
Dim length As Long
Dim subkey_name As String

' Open the key.
If RegOpenKeyEx(section, key_name, _
0&, KEY_ALL_ACCESS, hKey) <> ERROR_SUCCESS _
Then
MsgBox "Error opening key '" & key_name & "'"
Exit Sub
End If

' Enumerate the subkeys.
Set subkeys = New Collection
subkey_num = 0
Do
' Enumerate subkeys until we get an error.
length = 256
subkey_name = Space$(length)
If RegEnumKey(hKey, subkey_num, _
subkey_name, length) _
<> ERROR_SUCCESS Then Exit Do
subkey_num = subkey_num + 1

subkey_name = Left$(subkey_name, InStr(subkey_name, Chr$(0)) - 1)
subkeys.Add subkey_name
Loop

' Recursively delete the subkeys and their subkeys.
For subkey_num = 1 To subkeys.Count
' Delete the subkey's subkeys.
DeleteSubkeys section, key_name & "\" & subkeys(subkey_num)

' Delete the subkey.
RegDeleteKey hKey, subkeys(subkey_num)
Next subkey_num

' Close the key.
RegCloseKey hKey
End Sub
' Get the key information for this key and
' its subkeys.
Private Function GetKeyInfo(ByVal section As Long, ByVal key_name As String, ByVal indent As Integer) As String
Dim subkeys As Collection
Dim subkey_values As Collection
Dim subkey_num As Integer
Dim subkey_name As String
Dim subkey_value As String
Dim length As Long
Dim hKey As Long
Dim txt As String
Dim subkey_txt As String

Set subkeys = New Collection
Set subkey_values = New Collection

If Right$(key_name, 1) = "\" Then key_name = Left$(key_name, Len(key_name) - 1)

' Open the key.
If RegOpenKeyEx(section, _
key_name, _
0&, KEY_ALL_ACCESS, hKey) <> ERROR_SUCCESS _
Then
MsgBox "Error opening key."
Exit Function
End If

' Enumerate the subkeys.
subkey_num = 0
Do
' Enumerate subkeys until we get an error.
length = 256
subkey_name = Space$(length)
If RegEnumKey(hKey, subkey_num, _
subkey_name, length) _
<> ERROR_SUCCESS Then Exit Do
subkey_num = subkey_num + 1

subkey_name = Left$(subkey_name, InStr(subkey_name, Chr$(0)) - 1)
subkeys.Add subkey_name

' Get the subkey's value.
length = 256
subkey_value = Space$(length)
If RegQueryValue(hKey, subkey_name, _
subkey_value, length) _
<> ERROR_SUCCESS _
Then
subkey_values.Add "Error"
Else
' Remove the trailing null character.
subkey_value = Left$(subkey_value, length - 1)
subkey_values.Add subkey_value
End If
Loop

' Close the key.
If RegCloseKey(hKey) <> ERROR_SUCCESS Then
MsgBox "Error closing key."
End If

' Recursively get information on the keys.
For subkey_num = 1 To subkeys.Count
subkey_txt = GetKeyInfo(section, key_name & "\" & subkeys(subkey_num), indent + 2)
txt = txt & Space(indent) & _
subkeys(subkey_num) & _
": " & subkey_values(subkey_num) & vbCrLf & _
subkey_txt
Next subkey_num

GetKeyInfo = txt
End Function
' Delete this key.
Private Sub DeleteKey(ByVal section As Long, ByVal key_name As String)
Dim pos As Integer
Dim parent_key_name As String
Dim parent_hKey As Long

If Right$(key_name, 1) = "\" Then key_name = Left$(key_name, Len(key_name) - 1)

' Delete the key's subkeys.
DeleteSubkeys section, key_name

' Get the parent's name.
pos = InStrRev(key_name, "\")
If pos = 0 Then
' This is a top-level key.
' Delete it from the section.
RegDeleteKey section, key_name
Else
' This is not a top-level key.
' Find the parent key.
parent_key_name = Left$(key_name, pos - 1)
key_name = Mid$(key_name, pos + 1)

' Open the parent key.
If RegOpenKeyEx(section, _
parent_key_name, _
0&, KEY_ALL_ACCESS, parent_hKey) <> ERROR_SUCCESS _
Then
MsgBox "Error opening parent key"
Else
' Delete the key from its parent.
RegDeleteKey parent_hKey, key_name

' Close the parent key.
RegCloseKey parent_hKey
End If
End If
End Sub
Private Sub Command1_Click()
txtKeys.Text = GetKeyInfo( _
m_SelectedSection, Text1.Text, 0)
Command2.Enabled = True
End Sub

Private Sub Command2_Click()
' This can be very dangerous!
' Make the user confirm.
If MsgBox("Are you sure you want to delete these keys?", _
vbYesNo) <> vbYes Then Exit Sub

' Delete the keys.
DeleteKey m_SelectedSection, Text1.Text

Command2.Enabled = False
Text1.Text = ""
txtKeys.Text = ""
End Sub
Private Sub Form_Load()
Option1(2).Value = True
Text1.Text = "RemoteAccess\Profile"
End Sub

Private Sub Form_Resize()
Dim hgt As Single
Dim wid As Single

hgt = ScaleHeight - txtKeys.Top
If hgt < 120 Then hgt = 120
txtKeys.Move 0, txtKeys.Top, _
ScaleWidth, hgt

wid = ScaleWidth - Text1.Left
If wid < 120 Then wid = 120
Text1.Width = wid
End Sub

Private Sub Option1_Click(Index As Integer)
' Save the selected section number.
m_SelectedSection = CLng(Option1(Index).Tag)
End Sub

Private Sub Text1_Change()
Command2.Enabled = False
End Sub

用户　昵称 2008-03-08

打赏
举报

写个递归显示硬盘文件结构的例子，就熟悉了

qiu5208 2008-03-08

打赏
举报

一下看不明白，慢慢研究啊。

cbm6666 2008-03-08

打赏
举报

'下面代码是从我写的 Dll 里面的 .cls 抽出来的, 因此,下面代码,除了Command1事件是本地代码, 其它另两个Sub与Function你可以活用, 摆在你的 .cls里面

'*************** 本代码是在指定的文件夹中中以递归方式搜索多媒体文件
*.mp3;*.mid;*.wav;*.wma;*.dat;*.rm;*.rmi;*.rmvb

'添加 Command1 List1

Option Explicit
Dim j%, aa$, subpattern$(), maxpattern%, tfiles&, subsch As Boolean, s
Private Sub Command1_Click()
MsgBox "共查找到: " & CStr(GetPathFiles(List1, "e:\music", "*.mp3;*.mid;*.wav;*.wma;*.dat;*.rm;*.rmi;*.rmvb", True)) & " 个文件"
End Sub

Public Function GetPathFiles(Llist As Object, pschdir$, pExtName$, Optional subyn As Boolean = False) As Long
tfiles = 0
subsch = subyn
s = Split(pExtName, ";")
For j = 0 To UBound(s)
ReDim Preserve subpattern$(j)
subpattern(j) = s(j)
Next j
maxpattern = UBound(s) + 1
Call DGsearch(Llist, pschdir)
GetPathFiles = tfiles
End Function

Private Sub DGsearch(Llist As Object, strpath$)
On Error Resume Next
Dim strFileDir$(), strFile$, dircount&, lDirCount&
If Right(strpath, 1) <> "\" Then strpath = strpath & "\"
strFile = Dir(strpath, vbDirectory Or vbHidden Or vbNormal Or vbReadOnly)
While strFile <> "" '搜索当前目录
DoEvents
If (GetAttr(strpath & strFile) And vbDirectory) = vbDirectory Then '如果找到的是目录
If strFile <> "." And strFile <> ".." Then '排除掉父目录(..)和当前目录(.)
lDirCount = lDirCount + 1 '将目录数增1
ReDim Preserve strFileDir(lDirCount) As String
strFileDir(lDirCount - 1) = strFile '用动态数组保存当前目录名
End If
Else
For j = 0 To maxpattern - 1
aa = subpattern(j)
If aa = "" Then
If UCase(Right(aa, 3)) = UCase(Right(Trim(strFile), 3)) Or subpattern(j) = "*.*" Then Llist.AddItem strpath & strFile: tfiles = tfiles + 1: Exit For
ElseIf UCase(Right(aa, 3)) = UCase(Right(Trim(strFile), 3)) Or subpattern(j) = "*.*" Then
Llist.AddItem strpath & strFile: tfiles = tfiles + 1: Exit For
End If
Next j
End If
strFile = Dir
Wend
If subsch Then
For dircount = 0 To lDirCount - 1
Call DGsearch(Llist, strpath & strFileDir(dircount)) '递归搜索子目录
Next dircount
ReDim strFileDir(0) '将动态数组清空
End If
End Sub

qiu5208 2008-03-08

打赏
举报

怎么没人啊，
难道没人用vb写递归
难道非要把帖子贴到c语言版去不成。

问题补充：
最好谁有成功运用递归解决实际问题的例子。（vb代码）
当然如果网上复制的比较好的内容也可。

richen_99 2008-03-08

打赏
举报

lisp

想对递归有更深刻的了解

相关推荐