求在当前目录多个文本文件中取出包含单词列表文件中各单词的前后行

blackantt

回复 9# pitonas

oh，问题又来了。

pitonas，
  第2版程序，当newword有1000个,phonetic.txt有固定的3万行左右，文本资料有300个共30M时。 程序run起来非常慢。可能要几天几夜吧。  我的电脑配置挺好的.

   我想可能是在300文本中查找，与在phonetic里匹配音标在一个程序的原因吧。  你能不能再看看，先用第1版程序产生ok.txt到硬盘,然后再与phonetic.txt文件匹配出音标。总之perl下这东西有没有可能提速。 (测试文件  在  http://mail.qq.com/cgi-bin/ftnEx ... d&code=f5227e21  )

thanks

pitonas

在明日{:2_172:}

回复 11# blackantt


   

blackantt

回复 12# pitonas

   
谢谢。

   我在想能不能  egrep -B2 -A2 -f newword.txt *.txt > ok1.txt , 然后再用perl去做 ok1.txt 与 phonetic.txt 的vlookup 形成 ok.txt
在windows的sfu下面试了半天，steve的grep等都是有bug不能用的。最后只有gnu的grep没问题。

   这种应用是否一定要提前把txt文件放到数据库里，再从索引库里抽？那就太麻烦了。

pitonas

也许明天, try grep

now 试试这个脚本? 小伙伴们, 如果你不满意，请告诉我

1. #!/usr/bin/perl
   
2. 
   
3. # README! newword.txt 每行字後面没有空格
   
4. ####################################
   
5. 
   
6. my $Dir     = '/ok/xyz';
   
7. my $save    = '/ok/abc/myok.txt';
   
8. my $newword = '/ok/abc/newword.txt';
   
9. my $phone   = '/ok/abc/phonetic.txt';
   
10. 
    
11. #####################################
    
12. 
    
13. open my $dic, $newword or die "$newword:\t$!";
    
14. open my $pho, $phone   or die "$phone:\t$!";
    
15. 
    
16. my %dic   = map { chomp; $_, [] } <$dic>;
    
17. my @word  = keys %dic;
    
18. my %phone = map @$_, grep $dic{ $_->[0] }, map [split], <$pho>;
    
19. 
    
20. sub findtxt {
    
21.     my $dir = shift;
    
22.     map { -d $_ ? findtxt($_) : /\.txt$/ ? $_ : () } glob "$dir/*";
    
23. }
    
24. 
    
25. for my $file ( findtxt $Dir) {
    
26.     open my $f, $file or die "$file:\t$!";
    
27.     print $file, "\n";
    
28.     my $data = do { local $/; <$f> };
    
29.     $data =~ s/\s+/ /g;
    
30.     my @data = split /(?<=,|\.|\?)/, $data;
    
31.     for my $w (@word) {
    
32.         for my $i ( 0 .. $#data ) {
    
33.             if ( $data[$i] =~ /\b$w/i ) {
    
34.                 my ( $u, $d ) = ( $i - 1, $i + 1 );
    
35.                 $u = $i if $u < 0;
    
36.                 $d = $i if $d > $#data;
    
37.                 my $s = join '', @data[ $u .. $d ];
    
38.                 $s =~ s/\b$w/[ $w ]/ig;
    
39.                 push @{ $dic{$w} }, "$w $phone{$w}\n$s\n# $file";
    
40.             }
    
41.         }
    
42.     }
    
43. }
    
44. 
    
45. open my $S, '>', $save or die "$save:\t$!";
    
46. for my $k ( sort keys %dic ) {
    
47.     next unless @{ $dic{$k} };
    
48.     print $S join( "\n\n", @{ $dic{$k} } ), "\n\n";
    
49. }
    
50. 
    

复制代码

回复 13# blackantt


   

pitonas

{:2_172:} 小伙伴们, 这个高端大气上档次。
如果你不满意，请告诉我
use grep

1. #!/usr/bin/perl
   
2. # [ grep ] VERSION
   
3. ##############  EDIT  ###############
   
4. 
   
5. my $Dir     = '/ok/xyz';
   
6. my $save    = '/ok/abc/ok.txt';
   
7. my $newword = '/ok/abc/newword.txt';
   
8. my $phone   = '/ok/abc/phonetic.txt';
   
9. 
   
10. #####################################
    
11. 
    
12. open my $dic, $newword or die "$newword:\t$!";
    
13. open my $pho, $phone   or die "$phone:\t$!";
    
14. 
    
15. my %dic   = map { chomp; $_, [] } <$dic>;
    
16. my @word  = keys %dic;
    
17. my %phone = map @$_, grep $dic{ $_->[0] }, map [split], <$pho>;
    
18. my @pbar  = qw[ \ _ / | ];
    
19. my $sep   = qr/(?<=\?|\.|!)/;               
    
20. 
    
21. for my $w (@word) {
    
22.     print "\n$w\t\t";
    
23.     my $t = 0;
    
24.     ####################         grep       ########################
    
25.     my @grep = split /--\r?\n/, `grep -r -B1 -A1 -P '\\b(?i)$w' $Dir`;
    
26.    
    
27.     for my $g (@grep) {
    
28.         my ($file) = $g =~ /^(.*?txt)[\:\-]/;
    
29.         print "\b\b\b", $pbar[ $t++ % 4 ], "  ";
    
30. 
    
31.         $g =~ s/$file.//g;
    
32.         $g =~ s/\s+/ /g;
    
33.         my @data = split $sep, $g;
    
34. 
    
35.         for my $i ( 0 .. $#data ) {
    
36.             next unless $data[$i] =~ /\b$w/i;
    
37.             my ( $left, $right ) = ( $i - 1, $i + 1 );
    
38.             $left++  if $left < 0;
    
39.             $right-- if $right > $#data;
    
40.             my $s = join ' ', @data[ $left .. $right ];
    
41.             $s =~ s/\b$w/[ $w ]/ig;
    
42.             push @{ $dic{$w} }, "$w $phone{$w}\n$s\n# $file";
    
43.         }
    
44.     }
    
45.     print "\b\b\bOK";
    
46. }
    
47. 
    
48. open my $S, '>', $save or die "$save:\t$!";
    
49. for my $k ( sort keys %dic ) {
    
50.     next unless @{ $dic{$k} };
    
51.     print $S join( "\n\n", @{ $dic{$k} } ), "\n\n";
    
52. }
    

复制代码

blackantt

回复 14# pitonas

pitonas,thanks

   It's very good . 第3个程序非常快，非常完美.   第4个我还没试，因为我前天下了个gnu的grep,单用 grep -B2 -A2 -f newword.txt *.txt 运行很长时间，还是没结果。我想grep快不过你的第3个程序吧。

   谢谢你，热心的pitonas