几万行TXT文本记录如何快速除重并乱序排列呢？

2013-07-20 09:37:11 1.6k 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

Spaghettifying DRAM：从行锤击到位翻转的内存安全实验指南内存是计算机系统的基石，而DRAM依靠电容存储电荷的特性，天然存在漏电与数据丢失风险。当同一行被高频反复激活时，相邻行的电荷会因物理耦合发生异常，导致原本稳定的比特发生0/1翻转，这就是行锤击攻击的底层原理。与传统软件漏洞不同，这一过程直接作用于存储介质本身，属于典型的硬件故障注入技术。理解DRAM的行列结构、刷新机制与地址映射，是掌握内存安全防护的前提。在Linux环境下，通过物理地址映射、行锤击循环和位翻转检测，可以复现并评估内存颗粒的抗干扰能力，为固件加固、ECC策略验证及硬件可靠性测试提供数据支撑。阅读详情

几万行TXT文本记录如何快速除重并乱序排列呢？

我现在用的方法：
Private Sub Command1_Click()
Dim strtmp
Dim i
Open App.Path & "\" & Text1.Text For Binary As #1
strtmp = Split(Input(LOF(1), 1), vbCrLf)
For i = 0 To UBound(strtmp) - 1
List1.AddItem strtmp(i)
Next
Close #1
List1.ListIndex = 0

List2.Clear

Dim e As Integer
Dim t As Integer
For e = 0 To List1.ListCount - 1
Randomize
t = Int(Rnd * List1.ListCount)
List2.AddItem List1.List(t)
List1.RemoveItem (t)
If List1.ListCount = 0 Then Exit Sub
Next e
End Sub

Private Sub Command2_Click()
Dim i As Integer, j As Integer
Dim n As Integer
With List2
For i = 0 To .ListCount - 1
For j = .ListCount - 1 To i + 1 Step -1
If .List(j) = .List(i) Then
List2.RemoveItem j
End If
Next j
Next i
End With

List2.ListIndex = 0
For n = 0 To List2.ListCount - 1
If List2.List(n) = "" Then
' List2.RemoveItem n
End If
Next n

Open App.Path & "\" & Text1.Text For Output As #1
For i = 0 To List2.ListCount
Print #1, List2.List(i)
Next
Close #1

Text2.Text = List2.ListCount

End Sub

用这方法很慢，会卡死，有什么方法可以快速处理吗？请给下代码，谢谢了呀。

...全文

Pix4Dmapper实战：从无人机影像到高精度正射地图的完整流程解析本文详细解析了使用Pix4Dmapper软件，将无人机影像处理生成高精度正射影像图（DOM）和数字表面模型（DSM）的完整工作流程。内容涵盖从项目准备、数据导入、坐标系设置（特别是自定义CGCS2000坐标系）、空三加密、像控点刺点到最终成果生成与检查的核心步骤与实用技巧，旨在帮助用户高效、准确地完成测绘数据处理。阅读详情

camry82

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

+ 关注 + 加入社区

切换为时间正序

舉杯邀明月 2013-07-21

打赏
举报

即使相同数据量，运行结果也无法完全稳定。因为跟CPU负荷状态有很大关系。并且，GetTickCount()得到的时间，精度是很差的。

舉杯邀明月 2013-07-21

打赏
举报

我几次测试的结果表明，3W数据的时候，两种方法速度相当。数据量越多，排序筛选相对更快。但数据少些，用Dictionary对象处理就要快些。把41F的图片，另存为 *.rar文件，打开就能解压我的测试源码。里面也有编译好的 .exe程序。有兴趣的可以试下。

舉杯邀明月 2013-07-21

打赏
举报

To: SupermanKing
　　我先前把你的“快排”和删除的代码，跟我用Dictionary对象进行处理的代码，重新组织了一个测试程序。
生成数据是用的你的方式。只是我修改了一下，但生成结果是相同的。
得出的初步结论是：
　　“快排”在把有序数据打乱后，排序时间明显增加。对“乱序”进行排序的时间基本就是有序数据的2倍。
　　排序后进行筛选，数据多时占明显优势。因为排序时间基本就是正比关系，而Dictionary对象的时间，是指数关系，这个指数是略大于2的，也就是耗时比“平方关系”的时间还多。
下图是我的一次测试结果：

你在26F的排序时间，那么多个“为０”的，我有点不明白。
是不是你的数据量不对啊？你38F的代码，看得出是1W条。

daniel-du 2013-07-21

打赏
举报

但觉厉

去圣西罗-为尤文喝彩 2013-07-21

打赏
举报

速度和CPU,RAM有关吧。AMD Phenom II X6 1090T +12GB，估计可以跑10秒内。

现在还是人类 2013-07-21

打赏
举报

引用 41 楼 Chen8013 的回复:

你在26F的排序时间，那么多个“为０”的，我有点不明白。是不是你的数据量不对啊？你38F的代码，看得出是1W条。

那个时间是我屏蔽了具体过程只做一个排序过程得到的时间，所以才会有那么多 "0"，而且当时用的是插入法，呵呵


Private Sub Command3_Click()
    Dim ReadArray() As String
    Dim lngArraySize As Long
    Dim strTmp As String
    Dim fs As Integer
    Dim row As Long
    Dim i As Long
    Dim j As Long
    Dim index As Long
    Dim iscompositor As Boolean
    List1.Clear
Dim savetime As Long
savetime = GetTickCount
    '========== 把文本文件以行为单位读入字符串数组 ==========
    row = 0
    ReDim ReadArray(row)
    fs = FreeFile
    Open App.Path & "\" & Text1.Text For Input As #fs
    Do While Not EOF(fs)
    Line Input #fs, strTmp
    ReadArray(row) = strTmp
    row = row + 1
    ReDim Preserve ReadArray(row)
    Loop
    Close #fs
    lngArraySize = row - 1
    ReDim Preserve ReadArray(lngArraySize)
Dim readfiletime As Long
readfiletime = GetTickCount

    '========== 对数组进行排序 ==========
    '冒泡法
    'Call compositor_ebullient(ReadArray)
Dim mpftime As Long
mpftime = GetTickCount
    '选择法
    'Call compositor_select(ReadArray)
Dim xzftime As Long
xzftime = GetTickCount
    '快速法
    Call compositor_quick(ReadArray, 0, lngArraySize)
Dim ksftime As Long
ksftime = GetTickCount
    '插入法
'    Call compositor_insert(ReadArray)
Dim crftime As Long
crftime = GetTickCount
    '希尔法
'    Call compositor_shell(ReadArray)
Dim xrftime As Long
xrftime = GetTickCount
    '========== 对数组进行除重 ==========
    '除重
    Call kill_repeated(ReadArray)
Dim ccftime As Long
ccftime = GetTickCount
    
Dim compositortime As Long
compositortime = GetTickCount
    '========== 将排序好的数组输出 ==========
    lngArraySize = UBound(ReadArray)
    For i = 0 To lngArraySize
        List1.AddItem ReadArray(i)
    Next i
Dim overtime As Long
overtime = GetTickCount
MsgBox "总耗时：" & overtime - savetime & " 毫秒" & vbCrLf & _
       "读文件：" & readfiletime - savetime & " 毫秒" & vbCrLf & _
       "冒泡法：" & mpftime - readfiletime & " 毫秒" & vbCrLf & _
       "选择法：" & xzftime - mpftime & " 毫秒" & vbCrLf & _
       "快速法：" & ksftime - xzftime & " 毫秒" & vbCrLf & _
       "插入法：" & crftime - ksftime & " 毫秒" & vbCrLf & _
       "希尔法：" & xrftime - crftime & " 毫秒" & vbCrLf & _
       "除重复：" & ccftime - xrftime & " 毫秒" & vbCrLf & _
       "加数据：" & overtime - compositortime & " 毫秒"
End Sub

现在还是人类 2013-07-20

打赏
举报

用你的代码测试一下，看看，我的机子就跑了20几秒


Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long

' 需要引用：Microsoft Scripting Runtime
Private Sub Command1_Click()
   Dim objDict As New Dictionary
   Dim arrBuf() As String
   Dim arrOut() As String
   Dim arrIndex() As Long
   Dim i&, p&, m&, strTemp$
Dim savetime As Long
savetime = GetTickCount
   Open App.Path & "\" & Text1.Text For Binary As #1
   arrBuf = Split(Input(LOF(1), 1), vbCrLf)
   '筛选、除重
   p = -1
   m = UBound(arrBuf)
   ReDim arrOut(m)
   For i = 0 To m
      strTemp = arrBuf(i)
      If (Len(strTemp)) Then
         If (Not objDict.Exists(strTemp)) Then
            p = p + 1
            objDict.Add strTemp, p
            arrOut(p) = strTemp
         End If
      End If
   Next
   Close #1
   objDict.RemoveAll
   Set objDict = Nothing
   If (p = -1) Then
      MsgBox "没有内容。", vbExclamation
      Exit Sub
   End If
   '乱序输出
   ReDim arrIndex(p)
   For i = 0 To p
      arrIndex(i) = i
   Next
   Randomize
   m = p
   For i = 0 To p
      p = Rnd() * m
      List1.AddItem arrOut(arrIndex(p))
      arrIndex(p) = arrIndex(m)
      m = m - 1
   Next
MsgBox "耗时：" & GetTickCount - savetime & " 毫秒"
End Sub

Private Sub Command2_Click()
    Dim test As String
    Dim i As Long
Dim savetime As Long
savetime = GetTickCount
    Open App.Path & "\" & Text1.Text For Output As #1
    For i = 1 To 100000
        test = String(8 - Len(Hex(i)), "0") & Hex(i)
        Print #1, test
    Next i
    Close #1
MsgBox "耗时：" & GetTickCount - savetime & " 毫秒"
End Sub

现在还是人类 2013-07-20

打赏
举报

引用 2 楼 Chen8013 的回复:

10W数据，也就2秒左右：

Option Explicit

' 需要引用：Microsoft Scripting Runtime
Private Sub Command1_Click()
   Dim objDict As New Dictionary
   Dim arrBuf() As String
   Dim arrOut() As String
   Dim arrIndex() As Long
   Dim i&, p&, m&, strTemp$
   
   Open App.Path & "\" & Text1.Text For Binary As #1
   arrBuf = Split(Input(LOF(1), 1), vbCrLf)
   '筛选、除重
   p = -1
   m = UBound(arrBuf)
   ReDim arrOut(m)
   For i = 0 To m
      strTemp = arrBuf(i)
      If (Len(strTemp)) Then
         If (Not objDict.Exists(strTemp)) Then
            p = p + 1
            objDict.Add strTemp, p
            arrOut(p) = strTemp
         End If
      End If
   Next
   Close
   objDict.RemoveAll
   Set objDict = Nothing
   If (p = -1) Then
      MsgBox "没有内容。", vbExclamation
      Exit Sub
   End If
   '乱序输出
   ReDim arrIndex(p)
   For i = 0 To p
      arrIndex(i) = i
   Next
   Randomize
   m = p
   For i = 0 To p
      p = Rnd() * m
      List1.AddItem arrOut(arrIndex(p))
      arrIndex(p) = arrIndex(m)
      m = m - 1
   Next
End Sub

你是不是打字打漏了，不是“2秒左右”是“20秒左右”吧，呵呵

舉杯邀明月 2013-07-20

打赏
举报

10W数据，也就2秒左右：

Option Explicit

' 需要引用：Microsoft Scripting Runtime
Private Sub Command1_Click()
   Dim objDict As New Dictionary
   Dim arrBuf() As String
   Dim arrOut() As String
   Dim arrIndex() As Long
   Dim i&, p&, m&, strTemp$
   
   Open App.Path & "\" & Text1.Text For Binary As #1
   arrBuf = Split(Input(LOF(1), 1), vbCrLf)
   '筛选、除重
   p = -1
   m = UBound(arrBuf)
   ReDim arrOut(m)
   For i = 0 To m
      strTemp = arrBuf(i)
      If (Len(strTemp)) Then
         If (Not objDict.Exists(strTemp)) Then
            p = p + 1
            objDict.Add strTemp, p
            arrOut(p) = strTemp
         End If
      End If
   Next
   Close
   objDict.RemoveAll
   Set objDict = Nothing
   If (p = -1) Then
      MsgBox "没有内容。", vbExclamation
      Exit Sub
   End If
   '乱序输出
   ReDim arrIndex(p)
   For i = 0 To p
      arrIndex(i) = i
   Next
   Randomize
   m = p
   For i = 0 To p
      p = Rnd() * m
      List1.AddItem arrOut(arrIndex(p))
      arrIndex(p) = arrIndex(m)
      m = m - 1
   Next
End Sub

现在还是人类 2013-07-20

打赏
举报

用数组自己排序会比你这样快很多，还有就是ListBox对于大量的数据操作效率是很低的，可以考虑换个专门用于数据操作的控件来交互。

阳光地带 2013-07-20

打赏
举报

学习了，谢谢

现在还是人类 2013-07-20

打赏
举报

引用 32 楼 Chen8013 的回复:

我不是无意探讨，只是觉得“测试环境”跟实际应用的差别过大，没探讨价值。再说，你始终在回避一个问题：数据筛选！这应该说是不能忽略的地方。　　还有一个要说明的，我刚才忽然想到，我在6F贴图中，那个筛选数据的时间，是不正确的，它是包含读取数据的时间在内。我刚试了下单独的时间，用你的代码生成的数据，10Ｗ条，“筛选时间”是468 ms。

不是我回避什么问题，而是这根本就不是什么问题，先不说时候直接在排序过程里做数据筛选过程，就算独立循环一次去做筛选也不会要多久时间，看你的测试环境应该比我的要强很多了，我的还是好几年前的笔记本电脑，所以速度是差点，你那里跑十多秒的过程我这要二十多秒，不过就这种有差异的环境测试这种过程，我这的10W条数据排序+剔除重复也只用了 (排序)452 ms + (筛选)62 ms，你的是筛选时间就花了 468 ms，h还没有数据排序过程。其实如果数据有了排序，赛选可以说很简单，看看这个过程


Private Sub kill_repeated(strArray() As String)
    Dim max As Long, _
        min As Long, _
        i As Long, _
        j As Long, _
        count As Long, _
        strTmp As String
    max = UBound(strArray)
    count = max
    min = LBound(strArray)
    j = 0
    
    For i = min + 1 To max
        strTmp = strArray(i - 1)
        If Len(strTmp) = 0 Then
            strArray(i - 1) = strArray(i + j)
            j = j + 1
            i = i - 1
            count = count - 1
        Else
            If strArray(i - 1) = strArray(i + j) Then
                j = j + 1
                i = i - 1
                count = count - 1
            Else
                strArray(i) = strArray(i + j)
            End If
        End If
        If i >= count Then Exit For
    Next i
    ReDim Preserve strArray(count)
End Sub

这个赛选过程完全是基于排序好的数据进行筛选，所以根本不需要什么时间，我这里的10W条全反序数据被弄正序之后，只用了62 ms就完成了这种重复筛选。我测试的数据是这样来的。


Private Sub Command2_Click()
    Dim test As String
    Dim i As Long
    Dim j As Long
Dim savetime As Long
savetime = GetTickCount
    Open App.Path & "\" & Text1.Text For Output As #1
    For i = 0 To 9999
        test = String(8 - Len(Hex(10000 - i)), "0") & Hex(10000 - i)
        For j = 1 To 10
            Print #1, test
        Next j
    Next i
    Close #1
MsgBox "耗时：" & GetTickCount - savetime & " 毫秒"
End Sub

nj_dobetter 2013-07-20

打赏
举报

大数据，我一般使用外排序算法

camry82 2013-07-20

打赏
举报

谢谢大家。。

ah_2056 2013-07-20

打赏
举报

引用 34 楼 Chen8013 的回复:

[quote=引用 30 楼 ah_2056 的回复:] [quote=引用 28 楼 Chen8013 的回复:] 看清楚，我说的是“读文件的方法”。再者，你是对数据进行排序，没做“剔除重复数据”的工作。我们都是用你的代码生成的数据来进行的测试，那个数据是没有重复的。并且，是有序的，用你的排序方法进行排序，是“时间上”应该有特殊性的。我对“快速排序”算法的看法是，适合数据比较多、但不适合数据非常之多的情况（比如几百Ｗ以上）。还有最重要的一点：我没说我2F的这个方法是最快、或者最好的。我只是针对楼主的情况，给一个比较简单的方法来解决问题。

怎么都没人试过DICTIONAR对象啊。[/quote] 请问 DICTIONAR对象是什么东东啊？如果你是少写了个Y的话，我2F的代码，难道不是用的它？

[/quote] 哦哦，我就说嘛，大数据情况下，查找，排序，DICTIONNARY是比较快的，有些时候快过SQL. 但是这些都是VB6里面的，不知道 .NET那个DICTIONARY和哈希速度怎么样。

舉杯邀明月 2013-07-20

打赏
举报

引用 30 楼 ah_2056 的回复:

[quote=引用 28 楼 Chen8013 的回复:] 看清楚，我说的是“读文件的方法”。再者，你是对数据进行排序，没做“剔除重复数据”的工作。我们都是用你的代码生成的数据来进行的测试，那个数据是没有重复的。并且，是有序的，用你的排序方法进行排序，是“时间上”应该有特殊性的。我对“快速排序”算法的看法是，适合数据比较多、但不适合数据非常之多的情况（比如几百Ｗ以上）。还有最重要的一点：我没说我2F的这个方法是最快、或者最好的。我只是针对楼主的情况，给一个比较简单的方法来解决问题。

怎么都没人试过DICTIONAR对象啊。[/quote] 请问 DICTIONAR对象是什么东东啊？如果你是少写了个Y的话，我2F的代码，难道不是用的它？

bcrun 2013-07-20

打赏
举报

看到楼主用Listbox控件来处理大量字符串数组的需求就雷倒了：（）

舉杯邀明月 2013-07-20

打赏
举报

我不是无意探讨，只是觉得“测试环境”跟实际应用的差别过大，没探讨价值。再说，你始终在回避一个问题：数据筛选！这应该说是不能忽略的地方。　　还有一个要说明的，我刚才忽然想到，我在6F贴图中，那个筛选数据的时间，是不正确的，它是包含读取数据的时间在内。我刚试了下单独的时间，用你的代码生成的数据，10Ｗ条，“筛选时间”是468 ms。

现在还是人类 2013-07-20

打赏
举报

引用 28 楼 Chen8013 的回复:

看清楚，我说的是“读文件的方法”。再者，你是对数据进行排序，没做“剔除重复数据”的工作。我们都是用你的代码生成的数据来进行的测试，那个数据是没有重复的。并且，是有序的，用你的排序方法进行排序，是“时间上”应该有特殊性的。我对“快速排序”算法的看法是，适合数据比较多、但不适合数据非常之多的情况（比如几百Ｗ以上）。还有最重要的一点：我没说我2F的这个方法是最快、或者最好的。我只是针对楼主的情况，给一个比较简单的方法来解决问题。

呵呵，既然你对“技术”本身无意探讨，我也就不多说

ah_2056 2013-07-20

打赏
举报

引用 28 楼 Chen8013 的回复:

看清楚，我说的是“读文件的方法”。再者，你是对数据进行排序，没做“剔除重复数据”的工作。我们都是用你的代码生成的数据来进行的测试，那个数据是没有重复的。并且，是有序的，用你的排序方法进行排序，是“时间上”应该有特殊性的。我对“快速排序”算法的看法是，适合数据比较多、但不适合数据非常之多的情况（比如几百Ｗ以上）。还有最重要的一点：我没说我2F的这个方法是最快、或者最好的。我只是针对楼主的情况，给一个比较简单的方法来解决问题。

怎么都没人试过DICTIONAR对象啊。

加载更多回复（25）

几万行TXT文本记录如何快速除重并乱序排列呢？

相关推荐