忘记密码   免费注册 查看新帖 |

ChinaUnix.net

  平台 论坛 博客 文库 频道自动化运维 虚拟化 储存备份 C/C++ PHP MySQL 嵌入式 Linux系统
12下一页
最近访问板块 发新帖
查看: 2347 | 回复: 12

求段代码,把汉语字/词 从多个txt文件中摘录出来。已解决 [复制链接]

论坛徽章:
0
发表于 2018-09-19 16:00 |显示全部楼层
本帖最后由 blackantt 于 2018-09-21 09:40 编辑

1.关键字/词文件 key.txt 举例如下
cat key.txt

中国
一网打尽

2.语料库里有多个中文 txt 文件。

3.最终形成 result.txt 如下(最后的句中关键字用括号引起来,取关键字/词前一个句号与后一个句号之间的句子 )
五. 我有[五]个朋友,还有更多女朋友。
五. 他说话一[五]一十。
.....
中国. 我是[中国]人。
中国. 说到[中国],它是个美丽的国家,有十几亿人。
....
一网打尽. [一网打尽]是个成语。
一网打尽. 昨晚,小偷被[一网打尽]了。

word.zip

983.38 KB, 下载次数: 9

论坛徽章:
39
技术图书徽章
日期:2018-08-21 13:30:492015亚冠之首尔
日期:2015-11-04 22:25:43IT运维版块每日发帖之星
日期:2015-08-17 06:20:00寅虎
日期:2014-06-04 16:25:27狮子座
日期:2014-05-12 11:00:00辰龙
日期:2013-12-20 17:07:19射手座
日期:2013-10-24 21:01:23CU十二周年纪念徽章
日期:2013-10-24 15:41:34数据库技术版块每日发帖之星
日期:2015-12-01 06:20:00平安夜徽章
日期:2015-12-26 00:06:30技术图书徽章
日期:2018-08-21 13:30:242016科比退役纪念章
日期:2018-03-07 11:23:33
发表于 2018-09-20 08:01 |显示全部楼层
这么直接的要求,也不悬个赏啥的?

论坛徽章:
0
发表于 2018-09-20 09:03 |显示全部楼层
本帖最后由 blackantt 于 2018-09-21 09:41 编辑
laputa73 发表于 2018-09-20 08:01
这么直接的要求,也不悬个赏啥的?

   想用来给儿子复习成语。论坛悬赏功能吗?  不会用。

use Cwd;
use Data:umper;
use Encode;
use utf8;
my $dir = getcwd;

my $keyfile = $dir.'/key.txt';
my $targetpath = $dir.'/txt';
my $resultfile = $dir.'/result.txt';
print $keyfile;
open(RD,$keyfile);
my @keys;
while(<RD>{
        my $line = $_;
        $line =~ s/\n//isg;
        $line = decode('utf8',$line);
        push @keys,$line;
}
close RD;
print Dumper @keys;
opendir DIR,${targetpath};
my @filelist = readdir DIR;
shift @filelist;
shift @filelist;
open(WT,">".$resultfile);
shift @keys;
for my $onekey (@keys){
        my $num = 0;
        my $flag = 'no';
        print WT "result of ".$onekey.":\n";
        for my $one (@filelist){
                open(RDD,$targetpath.'\\'.$one);
                $/ = encode('utf8',"。";
                my @lines=<RDD>;
                for my $oneline (@lines){
                        $oneline = decode("utf8", $oneline);
                        my $newline = $oneline;
                                $newline =~ s/$onekey/(*$onekey*)/isg;
                        if ($newline ne $oneline){
                                print WT $onekey,"...",$newline."\n\n";
                                $num++;
                        }
                        if ($num ==20){
                                $flag = 'yes';
                                last;
                        }
                }
                if ($flag eq 'yes'){
                        last;
                }
                print $one;
        }
}

论坛徽章:
0
发表于 2018-09-21 09:40 |显示全部楼层
本帖最后由 blackantt 于 2018-09-21 09:42 编辑

论坛出错,发重了

论坛徽章:
11
子鼠
日期:2014-10-11 16:46:4815-16赛季CBA联赛之山东
日期:2017-11-10 14:32:142016科比退役纪念章
日期:2017-09-02 15:42:4715-16赛季CBA联赛之佛山
日期:2017-08-28 17:11:5515-16赛季CBA联赛之浙江
日期:2017-08-24 16:55:1715-16赛季CBA联赛之青岛
日期:2017-08-17 19:55:2415-16赛季CBA联赛之天津
日期:2017-06-29 10:34:4315-16赛季CBA联赛之四川
日期:2017-05-16 16:38:55黑曼巴
日期:2016-07-19 15:03:112015亚冠之萨济拖拉机
日期:2015-05-22 11:38:532016科比退役纪念章
日期:2018-03-16 10:24:05
发表于 2018-09-21 11:04 |显示全部楼层
本帖最后由 523066680 于 2018-09-21 12:25 编辑

em...

$line = decode('utf8',$line);
实际压缩包的文本是gbk的不是utf8  ....

只有水浒传是 utf8


建议:
找一个懂网页的,把这些文本转成HTML,关键词高亮粗体,会更直观。

论坛徽章:
11
子鼠
日期:2014-10-11 16:46:4815-16赛季CBA联赛之山东
日期:2017-11-10 14:32:142016科比退役纪念章
日期:2017-09-02 15:42:4715-16赛季CBA联赛之佛山
日期:2017-08-28 17:11:5515-16赛季CBA联赛之浙江
日期:2017-08-24 16:55:1715-16赛季CBA联赛之青岛
日期:2017-08-17 19:55:2415-16赛季CBA联赛之天津
日期:2017-06-29 10:34:4315-16赛季CBA联赛之四川
日期:2017-05-16 16:38:55黑曼巴
日期:2016-07-19 15:03:112015亚冠之萨济拖拉机
日期:2015-05-22 11:38:532016科比退役纪念章
日期:2018-03-16 10:24:05
发表于 2018-09-21 13:16 |显示全部楼层
本帖最后由 523066680 于 2018-09-21 15:09 编辑
  1. =info
  2.     Code by 523066680/vicyang
  3.     2018-09
  4. =cut

  5. use utf8;
  6. use Encode;
  7. use File::Slurp;
  8. use File::Basename qw/basename/;
  9. STDOUT->autoflush(1);

  10. # 读取关键字
  11. my $raw = load( "key.txt" );
  12. my @keys = split(/\r?\n/s, $raw );
  13. printf "Words:\n\t%s\n", encode('gbk', join(",", @keys));

  14. # 读取文本
  15. my $fold = "./txt";
  16. my @files = glob "${fold}/*.txt";
  17. my %book;
  18. grep { $book{ $_ } = load( $_ ) } ( sort @files );

  19. print "\n";

  20. open my $fh, ">:raw:crlf", "result.txt";
  21. select $fh;

  22. my @arr;
  23. my $tmp;
  24. for my $k ( @keys )
  25. {
  26.     printf "%s\n", encode('gbk', $k);
  27.     for my $bk ( sort keys %book )
  28.     {
  29.         @arr = ();
  30.         printf "    %s:\n", basename($bk);
  31.         $tmp = $book{ $bk };
  32.         grep { push @arr, ( /([^。!!?]*$k[^。!!?]*)/g ) } split( /\r?\n/, $tmp );
  33.         grep { s/$k/[$k]/ } @arr;
  34.         grep {  printf "        %s\n", encode('gbk', $_) } @arr;
  35.     }
  36. }

  37. close $fh;

  38. sub load
  39. {
  40.     my $file = shift;
  41.     my $s = read_file($file, {binmode => ":raw"} );
  42.     if ( $s eq encode('utf8', decode('utf8', $s)) ) {
  43.         $s =~s/^\xEF\xBB\xBF//;
  44.         return decode('utf8', $s);
  45.     } else {
  46.         return decode('gbk', $s);
  47.     }
  48. }

复制代码

输出结果在Result.txt


部分结果转成论坛格式:

万不得已
    1.txt:
        ...万不得已
        1、他不会向你借钱,除非万不得已
        2、不到万不得已,我是不会这样做的
        3、王荣病到万不得已的时候,才肯吃药、打针
        4、一般说,老虎并非天生就吃人,只是万不得已而为之
        5、这是他最珍爱的传家之宝,不到万不得已,是绝不肯轻易变卖的
        6、不在万不得已的情况下,绝对不要显灵,特别是不要为了虚荣
    2.txt:
    3.txt:
    水浒传.txt:
侃侃而谈
    1.txt:
        ...侃侃而谈
        1、畅开心扉是为了虚荣,为了侃侃而谈,为了得到别人的信赖,为了交换秘密
        2、勇气是能站起来侃侃而谈
        3、他们俩又是探头偷觑,又是评短论长,又是侃侃而谈,简直就象两个老知交
        4、一位称职的外交人员,定能在重要场合为国家利益侃侃而谈
        5、想不到一向慌乱的他,在会议上陈述理由时,竟能侃侃而谈
    2.txt:
    3.txt:
        1、他对这件事情侃侃而谈时,常常表现出老成持重的样子
    水浒传.txt:
满目凄凉
    1.txt:
    2.txt:
        满目凄凉
        1、富饶的鱼米之乡被鬼子糟踏得满目凄凉
        2、走进山沟,满目凄凉,到处都是残破不堪的景象
        3、他踏上荒废多年的老城墙,满目凄凉
        4、吹散一瓣瓣温婉桃花,满目凄凉,归去路,泪界落腮,心,被一根无名的弦触动了,遂痛到不能自己
        5、一个窗架上突出一根生锈的铁棒,真是满目凄凉.6、满目凄凉的惨状
    3.txt:
    水浒传.txt:




论坛徽章:
0
发表于 2018-09-22 17:34 |显示全部楼层
回复 1# blackantt 求解一下~     if ($title[1] =!  不包含某个txt中的内容,怎么写呢?



论坛徽章:
0
发表于 2018-09-22 22:24 |显示全部楼层
回复 7# 花蝴蝶456789
    请教下6楼大侠。 程序是别人写的,我只会用。



论坛徽章:
0
发表于 2018-09-22 22:40 |显示全部楼层
523066680 发表于 2018-09-21 13:16
输出结果在Result.txt

谢谢,记 录下 ppm 安装过程,备忘

C:\Users\dengz\Desktop\perl-word\perl>perl re.pl
Can't locate File/Slurp.pm in @INC (you may need to install the File::Slurp module) (@INC contains: C:/Perl64/site/lib C:/Perl64/lib) at re.pl line 8.
BEGIN failed--compilation aborted at re.pl line 8.

-----------------------


先安装activeperl到 c:\Perl64
然后在dos下执行
ppm search file-slurp
ppm install file-slurp

论坛徽章:
0
发表于 2018-09-23 08:30 |显示全部楼层
回复 6# 523066680

大神~请问一下哈,我想让$title[4]不包含以key命名的txt文件里所有的内容,这段代码怎么写呢。(这个TXT里的内容,都是一个一个的关键词,每一个关键词占一行。这样的格式)需求:
while(<> {
  chomp;
  my @title = split/\t/;  

    if ($title[4] =! /不包含另一个txt里的所有内容/) {  
     print HD "$_\n";

     }

}


把title4中不包含的内容,输出在HD文件中

这段怎么写呢?


您需要登录后才可以回帖 登录 | 注册

本版积分规则

  

北京盛拓优讯信息技术有限公司. 版权所有 京ICP备16024965号 北京市公安局海淀分局网监中心备案编号:11010802020122
广播电视节目制作经营许可证(京) 字第1234号 中国互联网协会会员  联系我们:wangnan@it168.com
感谢所有关心和支持过ChinaUnix的朋友们 转载本站内容请注明原作者名及出处

清除 Cookies - ChinaUnix - Archiver - WAP - TOP