← Back to branch summary

~jtv/corpusfiltergraph/cross-python

« back to all changes in this revision

Viewing changes to trunk/lib/corpusfg/graphs/sa-champollion/zh_cn/mansegment-utf8.pl

  • Committer: tahoar
  • Date: 2012-05-02 15:46:23 UTC
  • Revision ID: svn-v4:bc069b21-dff4-4e29-a776-06a4e04bad4e::266
new layout. need to update code to use the new layout

Show diffs side-by-side

added added

removed removed

Lines of Context:
trunk/lib/corpusfg/graphs/sa-champollion/zh_cn/mansegment-utf8.pl
 
1
#!/usr/bin/perl
 
2
###############################################################################
 
3
# This software is being provided to you, the LICENSEE, by the Linguistic     #
 
4
# Data Consortium (LDC) and the University of Pennsylvania (UPENN) under the  #
 
5
# following license.  By obtaining, using and/or copying this software, you   #
 
6
# agree that you have read, understood, and will comply with these terms and  #
 
7
# conditions:                                                                 #
 
8
#                                                                             #
 
9
# Permission to use, copy, modify and distribute, including the right to      #
 
10
# grant others the right to distribute at any tier, this software and its     #
 
11
# documentation for any purpose and without fee or royalty is hereby granted, #
 
12
# provided that you agree to comply with the following copyright notice and   #
 
13
# statements, including the disclaimer, and that the same appear on ALL       #
 
14
# copies of the software and documentation, including modifications that you  #
 
15
# make for internal use or for distribution:                                  #
 
16
#                                                                             #
 
17
# Copyright 1999 by the University of Pennsylvania.  All rights reserved.     #
 
18
#                                                                             #
 
19
# THIS SOFTWARE IS PROVIDED "AS IS"; LDC AND UPENN MAKE NO REPRESENTATIONS OR #
 
20
# WARRANTIES, EXPRESS OR IMPLIED.  By way of example, but not limitation,     #
 
21
# LDC AND UPENN MAKE NO REPRESENTATIONS OR WARRANTIES OF MERCHANTABILITY OR   #
 
22
# FITNESS FOR ANY PARTICULAR PURPOSE.                                         #
 
23
###############################################################################
 
24
# mansegment.perl Version 1.1
 
25
# Run as: mansegment.perl [dictfile] < infile > outfile
 
26
# A Chinese segmenter for both GB and BIG5 as long as the cooresponding 
 
27
# word frequency dictionary is used.
 
28
#
 
29
# Written by Zhibiao Wu at LDC on April 12 1999
 
30
# Modified by Xiaoyi Ma at LDC, March, 2003
 
31
# Change of v1.1:
 
32
# - simplified code
 
33
# - regenerated database to be compatible with perl5
 
34
#
 
35
# Algorithm: Dynamic programming to find the path which has the highest 
 
36
# multiple of word probability, the next word is selected from the longest
 
37
# phrase.
 
38
#
 
39
# dictfile is a two column text file, first column is the frequency, 
 
40
# second column is the word. The program will change the file into a dbm 
 
41
# file in the first run. So be sure to remove the dbm file if you have a
 
42
# newer version of the text file.
 
43
##############################################################################
 
44
 
 
45
binmode(STDIN, ":utf8");
 
46
binmode(STDOUT, ":utf8");
 
47
binmode(STDERR, ":utf8");
 
48
$wd = 1; # width of a character
 
49
$| = 1; # disable Perl output buffering
 
50
 
 
51
$greedy = 0;
 
52
$trace = 0;
 
53
 
 
54
if ($0 =~ /\//) {
 
55
    $DICTPATH = $1 if ( $0 =~ /(.+)\/[^\/]+/ );
 
56
} else {
 
57
    $DICTPATH = ".";
 
58
}
 
59
 
 
60
if (@ARGV[0] ne "") {
 
61
    $dictfile = @ARGV[0];
 
62
} else {
 
63
    $dictfile = "$DICTPATH/Mandarin.fre.utf8";
 
64
}
 
65
 
 
66
#$dict_db = $dictfile.".db";
 
67
 
 
68
@ARGV=();
 
69
$#ARGV = -1;
 
70
 
 
71
# read in frequency dictionary in associate array.
 
72
 
 
73
&read_dict();
 
74
 
 
75
# read in Mandarin files.
 
76
 
 
77
while (<>) {
 
78
    chomp;
 
79
    $newline = "";
 
80
    $ch = 0;
 
81
    $thisLine = $_;
 
82
    $lineLen = length($thisLine);
 
83
    $index=0;
 
84
    while($index<$lineLen){
 
85
        $c = substr($thisLine, $index, $wd);
 
86
        $index++;
 
87
 
 
88
        $code = unpack("U", $c);
 
89
 
 
90
        if ($c eq " ") {
 
91
            $newline .= $c;
 
92
        } elsif ($code >= hex('3000') && $code <= hex('9FFF')) {
 
93
            if ($ch == -1){
 
94
                $newline = $newline . " " . $c;
 
95
            } else {
 
96
                $newline = $newline . $c;
 
97
            }
 
98
            $ch = 1;
 
99
        } else {
 
100
            if ($ch == 1) {
 
101
                $newline = $newline . " " . $c;
 
102
            } else {
 
103
                $newline .= $c;
 
104
            }
 
105
            $ch = -1;
 
106
        }
 
107
    }
 
108
 
 
109
    $_ = $newline;
 
110
    s/^ *//g;
 
111
    @segment = split(/\s+/,$_);
 
112
 
 
113
    foreach (@segment) {
 
114
        &process($_);
 
115
        print " ";
 
116
    } 
 
117
    print "\n";
 
118
}
 
119
 
 
120
sub process {
 
121
    my ($sentence) = @_;
 
122
 
 
123
    return if ($sentence eq "");
 
124
    
 
125
    if ($sentence =~ /^[\x00-\xFF]+$/) {
 
126
        print $sentence;
 
127
        return;
 
128
    }
 
129
 
 
130
    print STDERR "Input: $sentence\n" if $trace;
 
131
 
 
132
    $top = 1;
 
133
    $value{1} = 1;
 
134
    $position{1} = 0;
 
135
    $next{1} = -1;
 
136
    $result{1} = "";
 
137
    $nextid = 2;
 
138
    $len = length($sentence);
 
139
 
 
140
    # Take out the top most path in the stack and extend that path
 
141
    # into several new paths, and put those paths into the stack.
 
142
    while (($top != -1) && 
 
143
           (!(($position{$top} == $len) && ($next{$top} == -1)))) {
 
144
 
 
145
        #print STDERR  "$. $result{$top}\n";
 
146
 
 
147
        # find the first open path
 
148
        $current = $top;
 
149
        $father = $top;
 
150
        while (($current != -1 ) && ($position{$current} == $len)) {
 
151
            $father = $current;
 
152
            $current = $next{$current};
 
153
        }
 
154
 
 
155
        # remove this path
 
156
        if ($current == $top) {
 
157
            $top = $next{$top};
 
158
        } else {
 
159
            $next{$father} = $next{$current};
 
160
        }
 
161
 
 
162
        if ($current == -1) {
 
163
            # no open path, finished, take the first path
 
164
            $next{$top} = -1;
 
165
        } else {
 
166
            $firstword = substr($sentence, $position{$current}, $wd);
 
167
 
 
168
            $i = $freq{"m,$firstword"};
 
169
            if ($i > $len - $position{$current}) {
 
170
                $i = $len - $position{$current};
 
171
            }
 
172
            if ($i < $wd) {
 
173
              $i = $wd;
 
174
            }
 
175
            
 
176
            while ($i>=$wd) {
 
177
              $word = substr($sentence, $position{$current}, $i);
 
178
 
 
179
              # If you want to add algorithmic segments you can do it like so:
 
180
              #$digit0 = "○|零|一|二|三|四|五|六|七|八|九";
 
181
              #$digit1 = "一|二|三|四|五|六|七|八|九";
 
182
 
 
183
              #if ($word =~ /^((($digit1)千)?(($digit1)百)?(($digit1)十)?($digit1)?|十($digit1))$/) {
 
184
              #  $freq{$word} = 1;
 
185
              #}
 
186
 
 
187
              if ($i == $wd) {
 
188
                $freq{$word} = 1; # single character always counts as a word
 
189
              }
 
190
 
 
191
              if ($freq{$word}) {
 
192
                &pronode();
 
193
                last if $greedy;
 
194
              }
 
195
              
 
196
              $i -= $wd;
 
197
            }
 
198
        }
 
199
    }
 
200
   
 
201
 
 
202
    if ($top == -1) {
 
203
        print STDERR "Error: $. $sentence\n";
 
204
    } else {
 
205
 
 
206
      if ($trace) {
 
207
        foreach $k (sort {$a <=> $b} (keys %result)) {
 
208
          print STDERR "$k $result{$k}\n";
 
209
        }
 
210
      }
 
211
 
 
212
        $result{$top} =~ s/^ *//g;
 
213
        print $result{$top};
 
214
    }
 
215
 
 
216
    return;
 
217
}
 
218
 
 
219
 
 
220
sub pronode {
 
221
 
 
222
    $value{$nextid} = $value{$current} * $freq{$word} / $freq{total};
 
223
    $result{$nextid} = $result{$current} . " " . $word;
 
224
    $position{$nextid} = $position{$current} + $i;
 
225
    
 
226
    # check to see whether there is duplicated path
 
227
    # if there is a duplicate path, remove the small value path
 
228
    $index = $top;
 
229
    $father = $index;
 
230
    $needInsert = 1;
 
231
    while ($index != -1) {
 
232
        if ($position{$index} == $position{$nextid}) {
 
233
            if ($value{$index} >= $value{$nextid}) {
 
234
                $needInsert = 0;
 
235
            } else {
 
236
                if ($top == $index) {
 
237
                    $next{$nextid} = $next{$index};
 
238
                    $top = $nextid;
 
239
                    $needInsert = 0;
 
240
                } else {
 
241
                    $next{$father} = $next{$index};
 
242
                }
 
243
            }
 
244
            $index = -1;
 
245
        } else {
 
246
            $father = $index;
 
247
            $index = $next{$index};
 
248
        }
 
249
        
 
250
    }
 
251
    
 
252
    
 
253
    # insert the new path into the list
 
254
    if ($needInsert == 1) {
 
255
      $index = $top;
 
256
        while (($index != -1) && ($value{$index} > $value{$nextid})) {
 
257
            $father = $index;
 
258
            $index = $next{$index};
 
259
        }
 
260
        if ($top == $index) {
 
261
            $next{$nextid} = $top;
 
262
            $top = $nextid;
 
263
        } else {
 
264
            $next{$father} = $nextid;
 
265
            $next{$nextid} = $index;
 
266
        }
 
267
    }                           # 
 
268
    
 
269
    $nextid++;
 
270
 
 
271
}
 
272
 
 
273
sub read_dict {
 
274
    open F, "<:utf8", "$dictfile" || die "Dictonary file $dictfile not found";
 
275
    while (<F>) {
 
276
        chomp;
 
277
        s/^ *//;
 
278
        split;
 
279
        $freq{$_[1]}  = $_[0];
 
280
        $header = substr($_[1],0,$wd);
 
281
        if ($freq{"m,$header"}) {
 
282
            if ($freq{"m,$header"} < length($_[1])) {
 
283
                $freq{"m,$header"} = length($_[1]);
 
284
            }
 
285
        } else {
 
286
            $freq{"m,$header"} = length($_[1]);
 
287
        }
 
288
        $freq{total} += $_[0];
 
289
    }
 
290
    close(F);
 
291
}
 
292
 
 
293