【已解决】如何将文本中部分相同的行归类在一起？

wujianfu · 发表于 2012-4-24 10:50:36

本帖最后由 wujianfu 于 2012-4-24 13:27 编辑

有一文本内容如下（邮箱地址是随机生成用于测试的，非真实存在）：
4554452@15.com
ting455hai11985@1543.com
kel122ejiabing2002@163.com
shu54eijinat@15.com
445555@15.com
xahjhj1818@163.com
31jk21@15.com
ba24bymes@163.com
df4@15.com
we45nyibaoshe@123.com
hzc45546jf@1543.com
1112hgh233@163.com
sun545mingjie88@163.com

要求整理成如下形式（即相同邮箱主机的行归类在一起）：
4554452@15.com
df4@15.com
shu54eijinat@15.com
445555@15.com
31jk21@15.com
ting455hai11985@1543.com
hzc45546jf@1543.com
kel122ejiabing2002@163.com
1112hgh233@163.com
sun545mingjie88@163.com
xahjhj1818@163.com
ba24bymes@163.com
we45nyibaoshe@123.com

自己尝试写了些代码，但效率非常低，而且到后面运行缓慢，求高手改进算法，我的代码如下：

#include <File.au3>
#include <Array.au3>
$CountLines=_FileCountLines(@ScriptDir&"\邮箱地址.txt")
$EmailAddress=FileOpen(@ScriptDir&"\邮箱地址.txt")
Dim $EmailServers[1]
For $i=1 To $CountLines Step 1
$CountLinesDetails=FileReadLine($EmailAddress,$i)
$Server=StringMid($CountLinesDetails,StringInStr($CountLinesDetails,"@",0,-1))
If _ArraySearch($EmailServers,$Server,1)=-1 Then _ArrayAdd($EmailServers,$Server)
Next
If FileExists(@ScriptDir&"\已整理.txt") Then FileDelete(@ScriptDir&"\已整理.txt")
$NewTxtFile=FileOpen(@ScriptDir&"\已整理.txt",1)
For $t=1 To UBound($EmailServers)-1 Step 1
For $i=1 To $CountLines Step 1
  $CountLinesDetails=FileReadLine($EmailAddress,$i)
  If StringInStr($CountLinesDetails,$EmailServers[$t])<>0 Then FileWriteLine($NewTxtFile,$CountLinesDetails)
Next
Next
FileClose($EmailAddress)
FileClose($NewTxtFile)

邮箱地址.txt请用上面给出的地址测试。

502762378 · 发表于 2012-4-24 11:17:05

#Include <File.au3>
$sfile = "邮箱地址.txt"
$afile = "已整理.ini"
For $n = 1 To _FileCountLines($sfile)
        $line = FileReadLine($sfile,$n)
        $sline = StringSplit($line,"@")
        IniWrite($afile,$sline[2],$line,"")
Next

kevinch · 发表于 2012-4-24 11:29:39

#include <array.au3>

Dim $str="4554452@15.com"&@CRLF& _
                "ting455hai11985@1543.com"&@CRLF& _
                "kel122ejiabing2002@163.com"&@CRLF& _
                "shu54eijinat@15.com"&@CRLF& _
                "445555@15.com"&@CRLF& _
                "xahjhj1818@163.com"&@CRLF& _
                "31jk21@15.com"&@CRLF& _
                "ba24bymes@163.com"&@CRLF& _
                "df4@15.com"&@CRLF& _
                "we45nyibaoshe@123.com"&@CRLF& _
                "hzc45546jf@1543.com"&@CRLF& _
                "1112hgh233@163.com"&@CRLF& _
                "sun545mingjie88@163.com"
$arr=StringSplit($str,@CRLF,1)
$dic=ObjCreate("scripting.dictionary")
For $n=1 To $arr[0]
        $arrt=StringSplit($arr[$n]&"@","@")
        If $dic.exists($arrt[2]) Then
                $dic($arrt[2])=$dic($arrt[2])&@crlf&$arr[$n]
        Else
                $dic($arrt[2])=$arr[$n]
        EndIf
Next
$arrt=$dic.items
$dic=0
MsgBox(0,"",_ArrayToString($arrt,@CRLF))

提供另一种思路

zldfsz · 发表于 2012-4-24 11:59:26

回复 2# 502762378

用写配置文件的方法，不错的思路，再把等号删掉就行了

veket_linux · 发表于 2012-4-24 12:42:45

挺麻烦的呵


#include <array.au3>
Local $fp = FileOpen( @ScriptDir & "\1.txt", 0)
Local $buf = FileRead($fp)
FileClose($fp)

Local $arr1 = StringSplit($buf, @CRLF)
;_ArrayDisplay($arr1, "包含空白行")
Local $i
For $i = $arr1[0] To 1 Step -1
        If StringLen($arr1[$i]) = 0 Then
                _ArrayDelete($arr1,$i)
                $arr1[0] -= 1
        EndIf
Next
_ArrayDisplay($arr1, "剔除空白行--归类前")

Local $arr2[$arr1[0]+1][2]
$arr2[0][0] = $arr1[0]
For $i = 1 To $arr2[0][0]
        $arr2[$i][0] = $arr1[$i]
        $arr2[$i][1] = StringMid($arr2[$i][0],StringInStr($arr2[$i][0],"@"))
Next
;_ArrayDisplay($arr2, "@后的域名所有")

Local $arr3[$arr1[0]+1]
$arr3[0] = 0
Local $j
Local $k
$arr3[1] = $arr2[1][1]
$arr3[0] = 1
$i = 2
For $j = 2 To $arr2[0][0]
        For $k = 1 To $j-1
                If StringCompare($arr2[$j][1], $arr2[$k][1]) = 0 Then ExitLoop
        Next
        If $k = $j Then
                $arr3[$i] = $arr2[$j][1]
                $arr3[0] += 1
                $i += 1
        EndIf
Next
For $i = $arr2[0][0] To $arr3[0]+1 Step -1
        _ArrayDelete($arr3, $i)
Next
;_ArrayDisplay($arr3, "@后的域名无重复")

$k = 1
For $i = 1 To $arr3[0]
        For $j = 1 To $arr2[0][0]
                If StringCompare($arr2[$j][1],$arr3[$i]) = 0 Then
                        $arr1[$k] = $arr2[$j][0]
                        $k += 1
                EndIf
        Next
Next

_ArrayDisplay($arr1, "最终结果--归类后")

veket_linux · 发表于 2012-4-24 12:46:11

截图

happytc · 发表于 2012-4-24 13:14:39

回复 1# wujianfu

这种要求，就不用自己写代码了，直接用工具就可以了。
如用vim来做，只需运行下面的命令就可以了
:sort /@.*/ r

wujianfu · 发表于 2012-4-24 13:25:23

感谢各位，结合502762378 给的代码，我自己再整理了一下，算是解决了。以下是代码：

#Include <File.au3>
$EmailAddres="邮箱地址.txt"
$TxtFile="邮箱地址_归类.txt"
$IniFile=@TempDir&"\Temp.ini"
If FileExists($IniFile) Then FileDelete($IniFile)
For $i=1 To _FileCountLines($EmailAddres)
        $LineDetails=FileReadLine($EmailAddres,$i)
    $var=StringSplit($LineDetails,"@")
    IniWriteSection($IniFile,$var[2],$LineDetails)
Next
If FileExists($TxtFile) Then FileDelete($TxtFile)
$TxtFileOpen=FileOpen($TxtFile,1)
For $i=1 To _FileCountLines($IniFile) Step 1
        $LineDetails=FileReadLine($IniFile,$i)
        If Not (StringLeft($LineDetails,1)="[" And StringRight($LineDetails,1)="]") Then
                FileWriteLine($TxtFileOpen,$LineDetails)
        EndIf
Next        
FileClose($TxtFile)
FileDelete($IniFile)
ShellExecute($TxtFile)

wujianfu · 发表于 2012-4-24 13:38:44

回复 7# happytc
问题是我不会用vim啊，而且也不知道vim有这个命令。不知道用正则能不能解决，求正则高手。

lixiaolong · 发表于 2012-4-24 13:47:50

Local $out

$EmailAddress = FileOpen(@ScriptDir & "\邮箱地址.txt")
$NewTxtFile = FileOpen(@ScriptDir & "\已整理.txt", 2)
$srex = StringRegExp(FileRead($EmailAddress), '.+', 3)
FileClose($EmailAddress)

For $i = 0 To UBound($srex) - 1
        $a = StringRegExp($srex[$i], '@([^\.]+)\.com', 1)
        For $s = 0 To UBound($srex) - 1
                If StringRegExp($srex[$s], '@' & $a[0] & '\.com', 0) And _
                                Not StringRegExp($out, $srex[$s], 0) Then
                        $out &= $srex[$s] & @CRLF
                EndIf
        Next
Next

FileWrite($NewTxtFile, $out)
FileClose($NewTxtFile)

3mile · 发表于 2012-4-24 14:16:45

后缀排序后,前缀需不需要排序?
比如将:
4554452@15.com
df4@15.com
shu54eijinat@15.com
445555@15.com
31jk21@15.com

排序成:
31jk21@15.com
445555@15.com
4554452@15.com
df4@15.com
shu54eijinat@15.com

楼上各位的想法很值得学习,2楼的502762378兄思路让人大开眼界,非常有创意.
如果前缀需要排序的话试试下面这个:

#include <array.au3>

Dim $str="4554452@15.com"&@CRLF& _
                "ting455hai11985@1543.com"&@CRLF& _
                "kel122ejiabing2002@163.com"&@CRLF& _
                "shu54eijinat@15.com"&@CRLF& _
                "445555@15.com"&@CRLF& _
                "xahjhj1818@163.com"&@CRLF& _
                "31jk21@15.com"&@CRLF& _
                "ba24bymes@163.com"&@CRLF& _
                "df4@15.com"&@CRLF& _
                "we45nyibaoshe@123.com"&@CRLF& _
                "hzc45546jf@1543.com"&@CRLF& _
                "1112hgh233@163.com"&@CRLF& _
                "sun545mingjie88@163.com"
$arr=StringRegExp($str,'[^\r\n]+',3)
Dim $arr2[UBound($arr)][3]
For $i=0 to UBound($arr)-1
        $arr2[$i][0]=$arr[$i]
        $arr2[$i][1]=StringFormat('%10s',StringRegExpReplace($arr[$i],'.+@',''))
Next
_ArraySort($arr2,0,0,0,1)

Local $k=1
For $i=0 to UBound($arr2)-2
        If $arr2[$i][1]==$arr2[$i+1][1] Then
                $arr2[$i][2]=$k
                $arr2[$i+1][2]=$k
        Else
                $arr2[$i][2]=$k
                $k+=1
        EndIf
Next


For $k=1 to $arr2[UBound($arr2)-1][2]
$kk=_ArrayFindAll($arr2,$k,0,0,0,0,2)
_ArraySort($arr2,0,$kk[0],$kk[UBound($kk)-1],0)
Next
For $i=0 to UBound($arr)-1
        $arr[$i]=$arr2[$i][0]
Next
_ArrayDisplay($arr)
$str=_ArrayToString($arr,@CRLF)
FileWrite("output.txt",$str)

xms77 · 发表于 2012-4-24 18:56:29

回复 11# 3mile
学习了，考虑更健全了！

		自动登录	找回密码
密码			加入

[效率算法] 【已解决】如何将文本中部分相同的行归类在一起？

相关帖子

评分

评分

本帖子中包含更多资源

评分