找回密码
 加入
搜索
查看: 3020|回复: 11

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

  [复制链接]
发表于 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请用上面给出的地址测试。
发表于 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

评分

参与人数 4金钱 +80 收起 理由
lanfengc + 20 这方法确实不错。 赞一个。 看了几分钟才看 ...
3mile + 20 好创意
lixiaolong + 20
zldfsz + 20 好方法

查看全部评分

发表于 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))
提供另一种思路

评分

参与人数 1金钱 +20 收起 理由
zldfsz + 20 不错

查看全部评分

发表于 2012-4-24 11:59:26 | 显示全部楼层
回复 2# 502762378


    用写配置文件的方法,不错的思路,再把等号删掉就行了
发表于 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, "最终结果--归类后")
发表于 2012-4-24 12:46:11 | 显示全部楼层
截图

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?加入

×
发表于 2012-4-24 13:14:39 | 显示全部楼层
回复 1# wujianfu


    这种要求,就不用自己写代码了,直接用工具就可以了。
如用vim来做,只需运行下面的命令就可以了
:sort /@.*/ r
 楼主| 发表于 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)
 楼主| 发表于 2012-4-24 13:38:44 | 显示全部楼层
回复 7# happytc
问题是我不会用vim啊,而且也不知道vim有这个命令。不知道用正则能不能解决,求正则高手。
发表于 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)
发表于 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)

评分

参与人数 2金钱 +50 贡献 +2 收起 理由
xms77 + 30 学习了,更健全了!
lixiaolong + 20 + 2 学习了!

查看全部评分

发表于 2012-4-24 18:56:29 | 显示全部楼层
回复 11# 3mile
学习了,考虑更健全了!
您需要登录后才可以回帖 登录 | 加入

本版积分规则

QQ|手机版|小黑屋|AUTOIT CN ( 鲁ICP备19019924号-1 )谷歌 百度

GMT+8, 2024-11-15 06:43 , Processed in 0.117950 second(s), 30 queries .

Powered by Discuz! X3.5 Licensed

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表