VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)

VB爱好者乐园(VBGood)

 找回密码
 立即注册
搜索
查看: 9827|回复: 22

[经验技巧] 消除数组中的重复元素..

[复制链接]
 楼主| 发表于 2008-9-13 11:50:57 | 显示全部楼层 |阅读模式


把我的E文单词模块分开来研究呵..

在input.txt中,有704个单词,用空格分隔开的.
读取它后,去除重复的..最终结果应该是256个不重复的单词..

我原来的方法是用快速排序后,就可以方便的去掉重复的..

现在和大家讨论一个,在不改变原顺序的情况下,去重复的方法.. 每个单词保留第1次
出现的,其它的都删除, 这样在完成清除后,没有改变原input中单词出现的顺序..

我目前效率不高的思路有2种..



方法1,就是2层for

for i=1 to ubound(words)
  for j=i-1 to 0 step -1
   if words(i)=words(j) then words(i)="不要"
  next
next
words=filter(words,"不要",false)


方法2,应该效率更低,就是replace字符串方法来清除..


  呵呵,希望我的思路不会影响到你们的.. 大家来讨论一下自己的更高效的方法吧..

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?立即注册

x
发表于 2008-9-13 15:23:08 | 显示全部楼层
偶也不知效率怎样。

Private Sub Command1_Click()
    Dim t As String
    Dim s As String
    Dim ss As String
    s = "123 234 145 123 670008 123 234 567 abc abcd ttt 123 abc 678 765"
    s = s & " "
    Do While s > ""
        t = Mid(s, 1, InStr(1, s, " ") - 1)
        s = Mid(Replace(s, t & " ", ""), 1)
        ss = ss & t & " "
   Loop
   Text1 = ss
End Sub
如单词不只一个空格,在执行前要规格化为一个空格。

[ 本帖最后由 ymismy 于 2008-9-13 15:24 编辑 ]
回复 支持 反对

使用道具 举报

发表于 2008-9-13 15:29:21 | 显示全部楼层
用HASH
这个问题是LZSS算法解决的问题之一
回复 支持 反对

使用道具 举报

发表于 2008-9-13 15:38:31 | 显示全部楼层
我用collection逐个添加单词,单词作主键,忽略重复键错误,最后,集合里的元素就是所选
回复 支持 反对

使用道具 举报

 楼主| 发表于 2008-9-14 07:33:56 | 显示全部楼层
3#的方法,我也曾经想到过..

写一个自定义的hash算法,将单词转换成得到一个6-8位数字值, 再用一个hash(100000 to 99999999)的boolean数组,做木桶呵, 只要数组中的对应元素为true, 就丢弃这个单词, 为false时,就保留单词,并更改为true..

呵呵,这样无疑是最快的, 只用一轮循环,就可以去除重复了, 不过...这个算法可就比较难呵.
回复 支持 反对

使用道具 举报

发表于 2008-9-14 10:50:10 | 显示全部楼层

回复 #5 VB妮可 的帖子

关键是找到一个好的HASH函数
不过平时用用么XOR就够了
而且捅不用很大足够记录冲突就够了,单词主要是字母,所以可以优化
回复 支持 反对

使用道具 举报

发表于 2008-9-14 14:02:25 | 显示全部楼层
Select DISTINCT * FROM
回复 支持 反对

使用道具 举报

发表于 2008-9-14 17:39:22 | 显示全部楼层
罗云彬 《windows环境下32为汇编语言设计》 第10章 内存管理和文件操作 10.2 文件操作 第379页
有一个对文本文件的英语单词进行统计的小程序 WordCount 汇编写的

看中很久了

算法介绍如下
采用树型结构的办法。树的每个接点有个计数器,还有26个子结点指针,子结点指针根据单词中的下一个字母是A-Z分别指向不同的子结点,假如我们遇到一个单词“ver”,就为它创建4层结点,第1层结点中的第22个指针(代表V)指向第2层,第2层结点中的第5个指针(代表E)再指向第3层结点,同样第3层结点中第19个指针(代表R)指向第4层结点,并将第4层结点的计数中增加1表示遇到了一个“Ver”单词。如果遇到一个单词“var”,那么在第2层结点中的A位置讲出现一个分支指向另一个第2层结点。这样一来,数据树最大可能的深度就是单词的最大长度。
结构中设置了26个指针用来指向下一层结点,分别代表下一个字母分别是A-Z的情况,如果没有下一个字母,则指针设置为NULL,dwCount字段用来计数。
每当程序遇到一个单词的开始字母,就从第1层结点开始处理,如果对应位置的指针已经存在,则继续移动下去,如果不存在,表示以前还没有遇到这样的单词,那么就新申请一块内存建立一个下层结点,依此顺序随着单词中的字母一层层处理下去,直到遇到单词结尾的时候在当前结点数的计数上加1就可以了。
在输出结果的时候,程序用递归的方法遍历整个树,并将每个计数不是0的结点写到记录文件中。



今天正好,改成vb版本了。
也顺便练习一下 用类实现链表结构

这个是用空间换时间的做法,在扫描的时候只需要一次FOR循环
但是输出结果的时候要遍历树,需要循环或者递归。

要重复数据多的时候才能体现这个算法的优势。同一个单词重复上百次,用的空间也不用增加。

代码如下
CWord.cls

  1. Private m_lpLetter(0 To 25) As CWord
  2. Private dwCount As Long
  3. Private dwDepth As Long
  4. Private dwIndex As Long
  5. Private m_Value As String

  6. Public Property Let tValue(ByVal vData As String)
  7.     m_Value = vData
  8. End Property

  9. Public Property Get tValue() As String
  10.    tValue = m_Value
  11. End Property


  12. Public Property Let Count(ByVal vData As Long)
  13.     dwCount = vData
  14. End Property

  15. Public Property Get Count() As Long
  16.     Count = dwCount
  17. End Property


  18. Public Property Let Depth(ByVal vData As Long)
  19.     dwDepth = vData
  20. End Property

  21. Public Property Get Depth() As Long
  22.     Depth = dwDepth
  23. End Property
  24. Public Property Let iIndex(ByVal vData As Long)
  25.     dwIndex = vData
  26. End Property

  27. Public Property Get iIndex() As Long
  28.     iIndex = dwIndex
  29. End Property


  30. Public Property Let NextLetter(Index As Integer, ByVal vData As CWord)
  31.     Set m_lpLetter(Index) = vData
  32. End Property

  33. Public Property Get NextLetter(Index As Integer) As CWord
  34.     Set NextLetter = m_lpLetter(Index)
  35. End Property

复制代码


Form1.frm

  1. Dim root As CWord, p As CWord

  2. Dim dwCount As Long
  3. Dim dwIndex As Long
  4. Private Sub Command1_Click()
  5. Set root = New CWord
  6. dwCount = 0
  7. dwIndex = 0
  8. Dim bytWord() As Byte
  9. Dim strword() As String
  10. Dim strtmp As String
  11. 'strtmp = "I LOVE Love YOU i me too to"
  12. 'strtmp = StrConv(strtmp, vbLowerCase)
  13. 'bytWord = StrConv(strtmp, vbFromUnicode)
  14. Open App.Path & "\input.txt" For Binary As #1
  15. ReDim bytWord(FileLen(App.Path & "\input.txt"))
  16. Get #1, , bytWord
  17. Close


  18. Dim i As Long
  19. Set p = root
  20. For i = 0 To UBound(bytWord)
  21. Call CountLetter(LCase(bytWord(i)))
  22. 'Call CountLetter(bytWord(i))
  23. Next
  24. 'MsgBox UBound(bytWord)
  25. '读文件的时候,似乎默认最后一个字符是0
  26. 'Call CountLetter(0)

  27. 'MsgBox dwCount
  28. 'MsgBox dwIndex
  29. MsgBox "共" & dwCount & "个单词,不重复单词共" & dwIndex & "个", vbInformation

  30. ReDim strword(0 To dwIndex - 1)
  31. Call WalkTree(strword(), root)
  32. 'MsgBox strword(dwIndex - 1)

  33. strtmp = Join(strword, " ")
  34. bytWord = StrConv(strtmp, vbFromUnicode)

  35. Open App.Path & "\output.txt" For Binary As #2
  36. Put #2, , bytWord
  37. Close

  38. End Sub

  39. Private Sub CountLetter(b As Byte)
  40. Dim n As Integer
  41. Dim q As CWord
  42. Dim dwDepth As Long
  43. Static strtmp As String
  44. 'LCase
  45. 'If b >= 65 And b <= 90 Then b = b + 32

  46. If b >= 97 And b <= 122 Then
  47. strtmp = strtmp & Chr(b)
  48.   n = b - 97
  49.     If p.NextLetter(n) Is Nothing Then
  50.         dwDepth = p.Depth
  51.         Set q = New CWord
  52.         p.NextLetter(n) = q
  53.         q.Depth = dwDepth + 1
  54.         Set p = q
  55.     Else
  56.         Set p = p.NextLetter(n)
  57.     End If
  58. Else
  59.     If p.Count = 0 Then
  60.         p.iIndex = dwIndex
  61.         p.tValue = strtmp
  62.         dwIndex = dwIndex + 1
  63.     End If
  64.     p.Count = p.Count + 1
  65.     If p.Depth Then dwCount = dwCount + 1
  66.     Set p = root
  67.     strtmp = ""
  68. End If
  69. End Sub

  70. Private Sub WalkTree(StrArr() As String, q As CWord)
  71. Dim i As Integer
  72. If q.Depth > 0 And q.Count > 0 Then
  73.   StrArr(q.iIndex) = q.tValue
  74. End If
  75. For i = 0 To 25
  76. If Not (q.NextLetter(i) Is Nothing) Then
  77.   Call WalkTree(StrArr, q.NextLetter(i))
  78. End If
  79. Next
  80. End Sub
复制代码


原版的汇编代码没什么注释,那我也不加了。算法原理已经说了,大家可以按照自己的理解重新写都可以。

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?立即注册

x
回复 支持 反对

使用道具 举报

发表于 2008-9-14 19:52:00 | 显示全部楼层

用集合

Private Sub Command1_Click()
    Dim a(10) As String
    Dim i As Integer
   
    a(0) = "aaa"
    a(1) = "bbb"
    a(2) = "aaa"
    a(3) = "ccc"
    a(4) = "aaa"
    a(5) = "ddd"
    a(6) = "aaa"
    a(7) = "eee"
    a(8) = "ddd"
    a(9) = "aaa"
    a(10) = "ccc"

    Dim c As New Collection
   
    On Error Resume Next
   
    For i = 0 To 10
        c.Add a(i), a(i)
    Next
   
    Dim s
    For Each s In c
        Debug.Print s
    Next
   
End Sub
回复 支持 反对

使用道具 举报

 楼主| 发表于 2008-9-14 20:21:17 | 显示全部楼层
书林的还有点迷糊..没看太懂..

hh的这个,代码确实很简单,且效果不错,但不知道这种on err的方法,真的能比其它方法更快吧..
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

文字版|手机版|小黑屋|VBGood  

GMT+8, 2022-7-4 05:13

VB爱好者乐园(VBGood)
快速回复 返回顶部 返回列表