首页 > Research, 程序设计 > 快速看懂简单perl代码

快速看懂简单perl代码

2010年7月28日 madongfly 发表评论 阅读评论

最近在实现PLSV，写了一个matlab的版本，效果却远没有原作者论文上说的好。

给作者发信索要代码，答曰：本人已在公司工作，出于保密，不能给你代码，不过在这个网页(需翻墙)上有别人写的代码，你可以看一看。

看了那个blog上的代码，是一个日本人写的perl代码，一看代码风格很严谨，遂认为是精品，于是慢慢品读，但因为我是头一次读perl的代码，所以边看边查，做了一点记录。

代码太长，附在文章最后吧，先是我做的一点记录：

#!/usr/bin/perl
这一行是Linux类系统下脚本的第一行，指定脚本执行环境，python也有。

use
导入模块，类似java的import

定义变量，直接使用一个$符号，比如$a，就表示定义了一个名为a的标量。这个不管是int，float，string，char……一律使用这个表示。
定义数组，直接使用符号@，比如@array，表示定义一个名为array的数组。基本上和上面的差不多，但是perl中好像是没有直接的二维数组的定义。
定义Hash，使用符号%，比如%hash，表示定义一个名为hash的哈希结构。哈希结构基本上在前期用的不多，在后面的时候，可以和数组组合成比较强大的结构体。

our、my
定义变量的关键字，具体含义还没有深究，先简单的把它当做matlab里的global。

shift函数
原型：shift ARRAY；把数组的第一个值移出并且返回它，然后把数组长度减一并且把所有的东西都顺移。如果在数组中不再存在元素，它返回 undef。如果省略了 ARRAY，那么该函数在子过程和格式的词法范围里移动 @_；它在文件范围（通常是主程序）里移动 @ARGV

@_是子程序的参数列表，@ARGV从名字上就能猜到是命令行参数。our $input = shift 这条语句也就是得到第一个参数，也就是文件名。

open(F, “$input”) 。从名字上就能看出这是打开一个文件。

chomp 函数，去掉字符串末尾的换行符。默认对$_进行操作，$_是什么没时间深究，从程序上下文来看，应该就是打开文件中的每一行。这个while循环就是把文件里每个词取出来，存入词频表W。

our $wordsize = (keys %W); 显然，获得词的数目。不过为什么还要用括号括起来呢？猜测keys %W是得到W的key的集合，然后括号是得到这个集合的个数。简单查了一下好像的确是这样的。

到这儿之后，接下来的代码都是跟PLSV的算法相关的了，根据关键字的名称，基本可以顺利读下去了，我也就懒得再整理了。

其实吧，我懒得再整理的真正原因，是因为到这儿看到了几个核心函数之后，发现作者的实现方式可谓“绝对暴力”，完全没有任何优化，循环里面嵌套没必要的循环，这让我对该代码产生了怀疑……

完全浏览之后，果然大失所望，在该算法最核心的部分，作者根本就没有用到论文中说的拟牛顿法，而是自己用了一个简单粗暴的梯度下降法，并且如果严格按论文来说的话，该梯度的计算还是错的……

不过失望之余，还是很佩服日本人的严谨，从算法功能和实现上来说，该代码可谓低级，但是编程风格确实是很不错的，能把这么低级的实现用这么认真的风格写出来，还是很需要勇气的……

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321

#!/usr/bin/perl
# Probabilistic Latent Semantic Visualization
# Copyright (c) 2009, Kei Uchiumi
 
use warnings;
use strict;
 
# Usage
# perl plsv.pl corpus
 
our $dimension = 2;
our $topicsize = 2;
our $alpha = 0.01;
our $beta = 0.0001;
our $ganma = 0.0001 * $topicsize;
our $docnum = 0; # document size N
our $iteration = 50;
 
# for sgd parameters
our $rate = 0.1; # learning rate
our $input = shift;
 
my %W;
 
open(F, "$input") or die "Couldn't open $input $!";
while ()
{
   chomp;
   my $line = $_;
   my @tokens = split(/\s/,$line);
   &storeword(\%W, \@tokens);
   $docnum++;
}
close(F);
 
our $wordsize = (keys %W);
$beta = $beta * $docnum;
 
# init parameters
our %theta;
our %phi;
our %xai;
 
# init phi
for (my $i = 0; $i < $topicsize; $i++)
{
   my @position;
   for (my $d = 0; $d < $dimension; $d++)
   {
      #$position[$d] = rand;
      $position[$d] = 1;
   }
   $phi{$i} = \@position;
}
# init xai
for (my $i = 0; $i < $docnum; $i++)
{
   my @position;
   for (my $d = 0; $d < $dimension; $d++)
   {
      $position[$d] = 0;
   }
   $xai{$i} = \@position;
}
# init theta
for (my $i = 0; $i < $topicsize; $i++)
{
   my @words;
   my $denominator = 0;
   for (my $j = 0; $j < $wordsize; $j++)
   {
      $words[$j] = -log(1.0 - rand);
      $denominator += $words[$j];
   }
   for (my $j = 0; $j < $wordsize; $j++)
   {
      $words[$j] = $words[$j] / $denominator;
   }
   $theta{$i} = \@words;
}
 
our %prob_zpx;
our %prob_zpnm;
 
# learning start
for (my $i = 0; $i < $iteration; $i++)
{
   &expectation($input);
   &maximization($input);
}
 
# output
use Data::Dumper;
print "Result\n";
print "Phi\n";
print Dumper(%phi);
print "Xai\n";
print Dumper(%xai);
print "Theta\n";
print Dumper(%theta);
 
# functions
sub xaiupdate
{
   my $docid = shift;
   my $topic = shift;
   my $grad = shift;
 
   my $x = $xai{$docid};
   my $p = $phi{$topic};
 
   for (my $i = 0; $i < $dimension; $i++)
   {
      my $diff = $grad * ($x->[$i] - $p->[$i]) - $ganma * $x->[$i];
      $x->[$i] += $rate * $diff;
   }
   return;
}
 
sub phiupdate
{
   my $docid = shift;
   my $topic = shift;
   my $grad = shift;
 
   my $x = $xai{$docid};
   my $p = $phi{$topic};
 
   for (my $i = 0; $i < $dimension; $i++)
   {
      my $diff = $grad * ($p->[$i] - $x->[$i]) - $beta * $p->[$i];
      $p->[$i] += $rate * $diff;
   }
   return;
}
 
sub update
{
   my $input = shift;
 
   my $docid = 0;
   open(F,"$input") or die "Couldn't open $input $!";
   while ()
   {
      chomp;
      my $line = $_;
      my @tokens = split(/\s/,$line);
 
      my $p_zpnm = $prob_zpnm{$docid};
      for (my $i = 0; $i < @tokens; $i++)
      {
         my $p_znm = $p_zpnm->{$i};
         for (my $j = 0; $j < $topicsize; $j++)
         {
            my $p_zpx = $prob_zpx{$docid}->[$j];
            my $p_z = $p_znm->[$j];
            my $grad = $p_zpx - $p_z;
            &xaiupdate($docid,$j,$grad);
            &phiupdate($docid,$j,$grad);
         }
      }
      $docid++;
   }
   close(F);
}
 
sub thetaupdate
{
   my $input = shift;
   my $topic = shift;
   my $word = shift;
 
   my $numerator = 0;
   my $denominator = 0;
   my $docid = 0;
   open(F,"$input") or die "Couldn't open $input $!";
   while ()
   {
      chomp;
      my $line = $_;
      my @tokens = split(/\s/,$line);
 
      my $p_zpnm = $prob_zpnm{$docid};
      for (my $i = 0; $i < @tokens; $i++)
      {
         my $p_znm = $p_zpnm->{$i};
         if ($tokens[$i] eq $word)
         {
            $numerator += $p_znm->[$topic];
         }
         $denominator += $p_znm->[$topic];
      }
      $docid++;
   }
   close(F);
 
   return ($numerator+$alpha)/($denominator+$alpha*$wordsize);
}
 
sub maximization
{
   my $input = shift;
# theta update
   for (my $i = 0; $i < $topicsize; $i++)
   {
      for (my $j = 0; $j < $wordsize; $j++)
      {
         $theta{$i}->[$j] = &thetaupdate($input,$i,$j);
      }
   }
# xai, phi update
   &update($input);
 
   return;
}
 
sub euclid
{
   my $topic = shift;
   my $docid = shift;
 
   my $docpositions = $xai{$docid};
   my $topicpositions = $phi{$topic};
 
   my $d = 0;
   for (my $i = 0; $i < $dimension; $i++)
   {
      my $diff = $docpositions->[$i] - $topicpositions->[$i];
      $d += $diff * $diff;
   }
 
   return $d;
}
 
sub dist
{
   my $topic = shift;
   my $docid = shift;
 
   my $denominator = 0;
   for (my $i = 0; $i < $topicsize; $i++)
   {
      $denominator += exp(-1/2 * &euclid($i, $docid));
   }
   my $numerator = exp(-1/2 * &euclid($topic, $docid));
 
   return $numerator/$denominator;
}
 
sub posterior
{
   my $docid = shift;
   my $topic = shift;
   my $word = shift;
 
   my $p_zpx = $prob_zpx{$docid};
   my $denominator = 0;
   for (my $i = 0; $i < $topicsize; $i++)
   {
      $denominator += $p_zpx->[$i] * $theta{$i}->[$word];
   }
   my $numerator = $p_zpx->[$topic] * $theta{$topic}->[$word];
 
   return $numerator/$denominator;
}
 
sub expectation
{
   my $input = shift;
   for (my $i = 0; $i < $docnum; $i++)
   {
      my @probs;
      for (my $j = 0; $j < $topicsize; $j++)
      {
         my $prob = &dist($j,$i);
         $probs[$j] = $prob;
      }
      $prob_zpx{$i} = \@probs;
   }
 
   my $docid = 0;
   open(F,"$input") or die "Couldn't open $input $!";
   while ()
   {
      chomp;
      my $line = $_;
      my @tokens = split(/\s/,$line);
 
      my %probs_znm;
      for (my $i = 0; $i < @tokens; $i++)
      {
         my @probs;
         for (my $j = 0; $j < $topicsize; $j++)
         {
            my $p = &posterior($docid, $j, $tokens[$i]);
            $probs[$j] = $p;
         }
         $probs_znm{$i} = \@probs;
      }
 
      $prob_zpnm{$docid} = \%probs_znm;
      $docid++;
   }
   close(F);
   return;
}
 
sub storeword
{
   my $wh = shift;
   my $ta = shift;
 
   foreach my $w (@$ta)
   {
      unless (defined $wh->{$w})
      {
         $wh->{$w} = 1;
      }
   }
   return;
}
分类: Research, 程序设计 标签: , ,
  1. 本文目前尚无任何评论.
  1. 本文目前尚无任何 trackbacks 和 pingbacks.
注意: 评论者点击“回复”（即默认使用'@user '的方式），系统会给您回复的人发一封通知邮件，使用'@all '，则会将评论发送给之前所有其它评论者。您填写的邮箱不会被泄露，只有博主在后台才能看到。