消除数组中的重复元素..

VB妮可 · 发表于 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字符串方法来清除..

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

ymismy · 发表于 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算法解决的问题之一

yidie · 发表于 2008-9-13 15:38:31

我用collection逐个添加单词，单词作主键，忽略重复键错误，最后，集合里的元素就是所选

VB妮可 · 发表于 2008-9-14 07:33:56

3#的方法,我也曾经想到过..

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

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

仙剑魔 · 发表于 2008-9-14 10:50:10

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

slore · 发表于 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

Private m_lpLetter(0 To 25) As CWord
Private dwCount As Long
Private dwDepth As Long
Private dwIndex As Long
Private m_Value As String
Public Property Let tValue(ByVal vData As String)
m_Value = vData
End Property
Public Property Get tValue() As String
tValue = m_Value
End Property
Public Property Let Count(ByVal vData As Long)
dwCount = vData
End Property
Public Property Get Count() As Long
Count = dwCount
End Property
Public Property Let Depth(ByVal vData As Long)
dwDepth = vData
End Property
Public Property Get Depth() As Long
Depth = dwDepth
End Property
Public Property Let iIndex(ByVal vData As Long)
dwIndex = vData
End Property
Public Property Get iIndex() As Long
iIndex = dwIndex
End Property
Public Property Let NextLetter(Index As Integer, ByVal vData As CWord)
Set m_lpLetter(Index) = vData
End Property
Public Property Get NextLetter(Index As Integer) As CWord
Set NextLetter = m_lpLetter(Index)
End Property

复制代码

Form1.frm

Dim root As CWord, p As CWord
Dim dwCount As Long
Dim dwIndex As Long
Private Sub Command1_Click()
Set root = New CWord
dwCount = 0
dwIndex = 0
Dim bytWord() As Byte
Dim strword() As String
Dim strtmp As String
'strtmp = "I LOVE Love YOU i me too to"
'strtmp = StrConv(strtmp, vbLowerCase)
'bytWord = StrConv(strtmp, vbFromUnicode)
Open App.Path & "\input.txt" For Binary As #1
ReDim bytWord(FileLen(App.Path & "\input.txt"))
Get #1, , bytWord
Close
Dim i As Long
Set p = root
For i = 0 To UBound(bytWord)
Call CountLetter(LCase(bytWord(i)))
'Call CountLetter(bytWord(i))
Next
'MsgBox UBound(bytWord)
'读文件的时候，似乎默认最后一个字符是0
'Call CountLetter(0)
'MsgBox dwCount
'MsgBox dwIndex
MsgBox "共" & dwCount & "个单词，不重复单词共" & dwIndex & "个", vbInformation
ReDim strword(0 To dwIndex - 1)
Call WalkTree(strword(), root)
'MsgBox strword(dwIndex - 1)
strtmp = Join(strword, " ")
bytWord = StrConv(strtmp, vbFromUnicode)
Open App.Path & "\output.txt" For Binary As #2
Put #2, , bytWord
Close
End Sub
Private Sub CountLetter(b As Byte)
Dim n As Integer
Dim q As CWord
Dim dwDepth As Long
Static strtmp As String
'LCase
'If b >= 65 And b <= 90 Then b = b + 32
If b >= 97 And b <= 122 Then
strtmp = strtmp & Chr(b)
n = b - 97
If p.NextLetter(n) Is Nothing Then
dwDepth = p.Depth
Set q = New CWord
p.NextLetter(n) = q
q.Depth = dwDepth + 1
Set p = q
Else
Set p = p.NextLetter(n)
End If
Else
If p.Count = 0 Then
p.iIndex = dwIndex
p.tValue = strtmp
dwIndex = dwIndex + 1
End If
p.Count = p.Count + 1
If p.Depth Then dwCount = dwCount + 1
Set p = root
strtmp = ""
End If
End Sub
Private Sub WalkTree(StrArr() As String, q As CWord)
Dim i As Integer
If q.Depth > 0 And q.Count > 0 Then
StrArr(q.iIndex) = q.tValue
End If
For i = 0 To 25
If Not (q.NextLetter(i) Is Nothing) Then
Call WalkTree(StrArr, q.NextLetter(i))
End If
Next
End Sub

复制代码

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

haohello · 发表于 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

VB妮可 · 发表于 2008-9-14 20:21:17

书林的还有点迷糊..没看太懂..

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

		自动登录	找回密码
密码			立即注册

VBGood网站全文搜索

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

本帖子中包含更多资源

回复 #5 VB妮可的帖子

本帖子中包含更多资源

用集合

VBGood网站全文搜索

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

本帖子中包含更多资源

回复 #5 VB妮可 的帖子

本帖子中包含更多资源

用集合

回复 #5 VB妮可的帖子