line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# $File: //member/autrijus/Lingua-ZH-Keywords/Keywords.pm $ $Author: autrijus $ |
2
|
|
|
|
|
|
|
# $Revision: #9 $ $Change: 3723 $ $DateTime: 2003/01/20 22:15:45 $ |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
package Lingua::ZH::Keywords; |
5
|
|
|
|
|
|
|
$Lingua::ZH::Keywords::VERSION = '0.04'; |
6
|
|
|
|
|
|
|
|
7
|
2
|
|
|
2
|
|
1529
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
95
|
|
8
|
2
|
|
|
2
|
|
13
|
use vars qw($VERSION @ISA @EXPORT @StopWords); |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
173
|
|
9
|
|
|
|
|
|
|
|
10
|
2
|
|
|
2
|
|
12
|
use Exporter; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
90
|
|
11
|
2
|
|
|
2
|
|
4700
|
use Lingua::ZH::TaBE (); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=head1 NAME |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
Lingua::ZH::Keywords - Extract keywords from Chinese text |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 SYNOPSIS |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# Exports keywords() by default |
20
|
|
|
|
|
|
|
use Lingua::ZH::Keywords; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
print join(",", keywords($text)); # Prints five keywords |
23
|
|
|
|
|
|
|
print join(",", keywords($text, 10)); # Prints ten keywords |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=head1 DESCRIPTION |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
This is a very simple algorithm which removes stopwords from the |
28
|
|
|
|
|
|
|
text, and then counts up what it considers to be the most important |
29
|
|
|
|
|
|
|
B. The C subroutine returns a list of keywords |
30
|
|
|
|
|
|
|
in order of relevance. |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
The stopwords list is accessible as C<@Lingua::ZH::Keywords::StopWords>. |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
If the input C<$text> is an Unicode string, the returned keywords |
35
|
|
|
|
|
|
|
will also be Unicode strings; otherwise they are assumed to be |
36
|
|
|
|
|
|
|
Big5-encoded bytestrings. |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
=cut |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
@ISA = qw(Exporter); |
41
|
|
|
|
|
|
|
@EXPORT = qw(keywords); |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
@StopWords = qw( |
44
|
|
|
|
|
|
|
提供 相關 我們 可以 如何 因為 目前 如果 其他 我的 大家 沒有 主要 所以 |
45
|
|
|
|
|
|
|
以上 這個 所有 有關 就是 他們 因此 但是 以及 是否 由於 對於 任何 什麼 |
46
|
|
|
|
|
|
|
這些 現在 無法 成為 可能 不過 包括 必須 關於 這是 這樣 以下 已經 你的 |
47
|
|
|
|
|
|
|
雖然 許多 也是 不是 除了 還是 為了 之後 只要 其中 都是 各種 還有 非常 |
48
|
|
|
|
|
|
|
而且 這種 其它 不要 我要 他的 只是 各位 只有 的話 不能 這裡 相當 我是 |
49
|
|
|
|
|
|
|
全部 很多 可是 或是 其實 那麼 你們 下列 如此 另外 然後 各項 才能 不會 |
50
|
|
|
|
|
|
|
甚至 總會 不得 怎麼 即可 作為 至於 當然 根據 我想 能夠 之間 為何 不知 |
51
|
|
|
|
|
|
|
例如 期間 時候 也有 常見 並且 容易 我有 實際 有人 有些 分別 並不 以後 |
52
|
|
|
|
|
|
|
使得 經由 重新 如下 在此 這麼 那些 整個 都有 這次 之前 令人 來的 就會 |
53
|
|
|
|
|
|
|
上述 位於 那個 而已 使用 假如 於是 還得 是在 無法 何況 曾經 我們的 |
54
|
|
|
|
|
|
|
); |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
my $Tabe; |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
sub keywords { |
59
|
|
|
|
|
|
|
$Tabe ||= Lingua::ZH::TaBE->new; |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
eval { require Encode::compat } if $] < 5.007; |
62
|
|
|
|
|
|
|
my $is_utf8 = eval { require Encode; Encode::is_utf8($_[0]) }; |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
my (%hist, %ref); |
65
|
|
|
|
|
|
|
$hist{$_}++ for grep { |
66
|
|
|
|
|
|
|
length > 2 and index($_, '一') == -1 |
67
|
|
|
|
|
|
|
} $Tabe->split( |
68
|
|
|
|
|
|
|
$is_utf8 ? Encode::encode(big5 => $_[0]) : $_[0] |
69
|
|
|
|
|
|
|
); |
70
|
|
|
|
|
|
|
delete @hist{@StopWords}; |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
my $count = $_[1] || 5; |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# By occurence, then freq, then lexical order |
75
|
|
|
|
|
|
|
map { |
76
|
|
|
|
|
|
|
$is_utf8 ? Encode::decode(big5 => $_) : $_ |
77
|
|
|
|
|
|
|
} grep length, (sort { |
78
|
|
|
|
|
|
|
$hist{$b} <=> $hist{$a} |
79
|
|
|
|
|
|
|
or |
80
|
|
|
|
|
|
|
($ref{$b} ||= freq($b)) <=> ($ref{$a} ||= freq($a)) |
81
|
|
|
|
|
|
|
or |
82
|
|
|
|
|
|
|
$b cmp $a |
83
|
|
|
|
|
|
|
} keys %hist)[ 0 .. $count-1 ]; |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
sub freq { |
87
|
|
|
|
|
|
|
my $tsi = $Tabe->Tsi($_[0]); |
88
|
|
|
|
|
|
|
$Tabe->TsiDB->Get($tsi); |
89
|
|
|
|
|
|
|
return $tsi->refcount; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
1; |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
__END__ |