Perl学习指南

Perl 与数学：一份快速参考

use Math::Cephes::Matrix qw(mat);
            $a = mat [[1, 2], [3, 4]];
            $b = [1, 1];
            print "@{$a->mul($b)}";
            # print "3 7"
            

use  Math::MatrixReal;
            $a = Math::MatrixReal->new_from_rows( [[1, 2], [3, 4]] );
            $b = Math::MatrixReal->new_from_cols( [ [1, 1] ] );
            print $a*$b;
            # print "[  3.000000000000E+000 ]
            #        [  7.000000000000E+000 ]"
            

use PDL;
            $a = pdl [[1, 2],[3, 4]];
            $b = pdl [[1], [1]];
            print $a x $b;
            # print "[
            #         [3]
            #         [7]
            #        ]"
            

>> a = [1, 2; 3, 4];
            >> b = [1; 1];
            >> a*b
            ans =
            3
            7
            

> a = matrix(c(1,2,3,4), ncol=2, byrow=T)
            > b = matrix(c(1,1), ncol=1)
            > a%*%b
            [,1]
            [1,]    3
            [2,]    7
            

use Math::Cephes::Matrix qw(mat);
            $mat = mat [[1, 2, 3], [4, 5, 6], [7, 8, 9]];
            $mat = $mat->coef;
            for my $i (1..2) {   # 0 first index
            print "@{$mat->[$i]}[1..2]\n";
            }
            # print "5 6
            #        8 9"
            

use  Math::MatrixReal;
            $mat = Math::MatrixReal->new_from_rows(
            [[1, 2, 3], [4, 5, 6], [7, 8, 9]] );
            for my $i (2..3) {   # 1 first index
            for my $j (2..3) {
            print $mat->element($i, $j), " ";
            }
            print "\n";
            }
            # print "5 6
            #        8 9"
            

use PDL;
            $mat = pdl [[1, 2, 3], [4, 5, 6], [7, 8, 9]];
            print $mat->slice("1:2,1:2");   # 0 first index
            # print "[
            #         [5 6]
            #         [8 9]
            #        ]"
            

mat = [1,2,3; 4,5,6; 7,8,9];
            mat(2:3, 2:3)
            ans =
            5        6
            8        9
            

> mat = matrix(1:9, ncol=3, byrow=T)
            > mat[2:3, 2:3]
            [,1] [,2]
            [1,]    5    6
            [2,]    8    9
            

> vec = 1:10
> vec
[1]  1  2  3  4  5  6  7  8  9 10
> vec %% 2
[1] 1 0 1 0 1 0 1 0 1 0
> vec[vec %% 2 == 1]
[1] 1 3 5 7 9
> vec[vec %% 2 == 1] + 1
[1]  2  4  6  8 10

#! /usr/local/bin/perl -w
use strict;
# -----------------------------------------------------------
#     RSA algorithm -- assymetrical\public-key cryptography
# -----------------------------------------------------------
use Math::Pari qw(gcd PARI) ;
# -----------------------------------------------------------
# m -- message
my $m = 'Perl' ;
print "original: $m\n" ;
my $tmpl = 'C*' ;
my @m = unpack($tmpl, $m) ;       # string -> unsigned char values
print "coded: @m\n" ;
# n = pq -- in RSA, p & q = prime, each 1024 bits/308 digits long
my $p = PARI("prime(".int(rand 50).")") ;
my $q = PARI("prime(".int(rand 50).")") ;
my $n = $p*$q ;            # $n = Pari's obj
# choose a random number r, s.t.
#     1 < r < (p-1)(q-1) = b
#     gcd(r, b) = 1 -- relative prime
my $b = ($p-1)*($q-1) ;
my $r ;
do {$r = int rand $b ; } until (gcd($r,$b) == 1) ;
$r = PARI $r ;
# rk = 1 mod (p-1)(q-1) -- k = private key; (n, r) public
my $k = (1/$r)%$b ;        # Pari's math operators, since vars = Pari
# encrypt -- c = (m ^ r) mod n
my @c ;
map { $c[$_] = ($m[$_]**$r)%$n } 0..$#m ;   # Perl: ** for power
print "ciphered: @c\n" ;
# decrypt -- m = (c ^ k) mod n
my @d ;
map { $d[$_] = PARI("($c[$_]^$k)%$n") } 0..$#c ;   # Pari: ^ for power
print "deciphered: @d\n" ;
print "decoded: " . pack($tmpl, @d) . "\n" ;
__END__
original: Perl
coded: 80 101 114 108
ciphered: 18431 6512 5843 7236
deciphered: 80 101 114 108
decoded: Perl
</font></tt>

<tt class="code"><font size="-1">#! /usr/local/bin/perl -w
use strict ;
R("getwd()");
sub R {
my $Rpath = "C:\R\rw\bin\" ;
my $Rcmd = $Rpath . "rterm --vanilla --quiet --slave" ;
my $Rscript = shift ;
$Rscript =~ s/(\r|;\r)/ ;/gm ;
$Rscript =~ s/<-/=/gm ; # \r or <- will break "echo"
return `echo $Rscript | $Rcmd` ;
}

my $dir = 'D:\tmp\prog\math\lp32';
my $lp_solve = "d:\mydir\lp_solve.exe";
my $lpfile = "d:\mydir\model.lp";
(my $lp = << "    EOF") =~ s/^\s+//gm;
min: 8  x1 + 15 x2       ;
c1:  10 x1 + 21 x2 > 156 ;
c2:  2  x1 +    x2 > 22  ;
EOF
open OUTFILE, "+>$lpfile";
print OUTFILE $lp;
close OUTFILE;
$output = qx($lp_solve < $lpfile);
$output =~ s/\r//gm;
print $lp;
print $output;
system("del $lpfile");

use strict;
use warnings;
my ($a1,$a2,$a3,$ref);
for my $x (0..20) {
for my $y (0..20) {
$ref->[$x][$y] = rand 100;
}
}
use Math::Cephes::Matrix qw(mat);
$a1 = mat $ref;
use  Math::MatrixReal;
$a2 = Math::MatrixReal->new_from_rows( $ref );
use PDL;
use PDL::Slatec;
$a3 = pdl $ref;
use Benchmark qw(cmpthese);
cmpthese(100,
{
cephes=>sub{$a1->inv()},
matrixreal=>sub{$a2->inverse()},
pdl=>sub{matinv($a3)}
}
);
__END__
Rate matrixreal     cephes        pdl
matrixreal 5.28/s         --       -94%       -99%
cephes     83.3/s      1479%         --       -87%
pdl         625/s     11744%       650%         --

Perl 编程格式指南

名称

介绍

编码规则

Perl版本

文档

版本

1.0.0       P5EE 1 的首发版
1.0.1       P5EE 1.0的第二次发布版
1.0.10      P5EE 1.0的第二次发布版的第一次修正版
1.1.0       P5EE 1.1的首发版
2.0.0       P5EE 2 的首发版

1.1.6   ->      1.001006
2.0.0   ->      2.000000

注释

# story count
my $sc = 0;

警告和严格语法

词汇范畴变量

输出

传递引用参数

return($user, $form, $constants);

my @return = ($user, $form);
push @return, $constants if $flag;
return @return;

if ($flag) {
return($user, $form, $constants);
} else {
return($user, $form);
}

垃圾收集

my $huge_data_structure = get_huge_data_structure();
do_something_with($huge_data_structure);
undef $huge_data_structure;

__END__ 和 __DATA__ 和 __PACKAGE__

测试

STDIN/STDOUT

文件和Globs

my $path = "$dir/$file";                # 错
my $path = catfile($dir, $file);        # 对
my $dir = ".";                          # 错
my $dir = curdir();                     # 对
mkdir("/path"), mkdir("/path/to"), ...  # 错
`mkdir /path`; `mkdir /path/to`, ...    # 大错特错
mkpath("/path/to/my/dir", 0, 0775);     # 对

系统调用

样式

术语

名字

$Minimum = 10;          # 错
$MAXIMUM = 50;          # 对

$thisVar      = 'foo';  # 错
$this_var     = 'foo';  # 对
$work_hard    = 1;      # 对，动词，布尔类型的标记
$running_fast = 0;      # 对，动名词，布尔类型的标记

@stories     = (1, 2, 3);      # 对
$comment_ref = [4, 5, 6];      # 错
$comments    = [4, 5, 6];      # 对
$comment     = $comments->[0]; # 对

$obj->getStory();             # 错
$obj->setStoryByName();       # 又错了
$obj->getStoryByID();         # 还是错！这不是Java！
$obj->get_story();            # 对
$obj->set_story_by_name();    # 对
$obj->get_story_by_id();      # 对

for (@list) {
print;              # 对；每个人都知道这是什么意思
print uc;           # 不好；很少有人知道这个
print uc $_;        # 看起来好一些了
}

if (-d $file) {   # $file现在是一个目录
# ...
} elsif (-l _) {  # $file现在是一个symlink        # ...
}

    P5EE::Standard          # 　好
P5EE::Authz             # 　好
P5EE::MainCode          # 　好

    P5EE::styleguide        # 对于文档来说还不错

* x?emacs: cperl-mode
.xemacs/custom.el:
------------------
(custom-set-variables
'(cperl-indent-level 4)
'(cperl-continued-statement-offset 4)
'(cperl-tab-always-indent t)
'(indent-tabs-mode nil)
)
* vim
.vimrc:
-------
set expandtab " replaces any tab keypress with the appropriate number of spaces
set tabstop=4 " sets tabs to 4 spaces
" 将制表符换成适当数量的空格
" 将制表符换成4个空格

foo(@bar) ;     # 错
foo(@bar);      # 对

my $foo   = 1;
my $bar   = 2;
my $xyzzy = 3;
open(FILE, $fh)   or die $!;
open(FILE2, $fh2) or die $!;
$rot13 =~ tr[abcedfghijklmnopqrstuvwxyz]
[nopqrstuvwxyzabcdefghijklm];
# note we use a-mn-z instead of a-z,
# for readability
$rot13 =~ tr[a-mn-z]
[n-za-m];

# this is my function!  这是我的函数
sub foo {
my (@data) = @_;
my $obj = new Constructor;
my ($var1, $var2);
$obj->setFoo($data[1]);
$var1 = $obj->getFoo(1);
$var2 = $obj->getFoo($var1);
display($var1, $var2);
return($data[0]);
}
print 1;

for(@list)         # 错
for (@list)        # 对
my ($ref)          # 对
my($ref)          # 首选
localtime ($time); # 错
localtime($time);  # 对

my @array = ('a', 'b', 'c');
my ($first_element) = @array;           # a
my ($first_element) = ('a', 'b', 'c');  # a
my $element_count  = @array;            # 3
my $last_element   = ('a', 'b', 'c');   # c

for ( map { [ $_, 1 ] } @list )     # 可以
for ( @list )                       # 也还可以。

@list = qw(
bar
baz
);              # 正确
if ($foo && $bar && $baz
&& $buz && $xyzzy
) {
print $foo;
}

print foo(@bar), baz(@buz) if $xyzzy;

print 1, 2, 3;                          # 好的
delete $hash{key} if isAnon($uid);      # 好的

while (<$fh>){      # 错
while (<$fh>) {     # 对

    for (@list) { print }

    for (@list) {
print;
smell();
}

# 对
if ($foo) {
print;
}
else {
die;
}
# 错
if ($foo) {
print;
} else {
die;
}

   print $x , $y;   # 错
print $x, $y;   # 对
$x = 2 >> 1;    # 好
$y = 2**2;      # 好

    $bool = $flag1 or $flag2;       # 错误！无法运行
$value = $foo || $bar;          #  正确
open(FILE, $file) or die $!;
$true  = foo($bar) && baz($buz);
foo($bar) and baz($buz);

    baz($buz) if foo($bar);

    print "foo" . "bar" . "baz"
. "buz";                    # 错
print "foo" . "bar" . "baz" .
"buz";                      # 对
print $foo unless $x == 3 && $y ==
4 && $z == 5;               # 错
print $foo unless $x == 3 && $y == 4
&& $z == 5;                 # 对

    $foo{$bar{baz}{buz}};       # 不错
$foo{ $bar{baz}{buz} };     # 更好

    $what{'time'}{it}{is} = time();

    open(FILE, $fh) or die $!;      # 对
die $! unless open(FILE, $fh);  # 错
print "Starting\n" if $verbose; # 对
$verbose && print "Starting\n"; # 错

        print <
只要记住，除非你在“打印至”的记号两边写上单引号（<<'EOT'），那么其间的文本是可以内插的。所以要打印“$”和“@”符号是需要转义的。
致谢
这篇样式指导是以slashcode样式指导为基础。
它也和mod_perl样式指导保持一致，它是C语言阿帕奇样式指导中的精华。
http://slashcode.com/docs/slashstyle.html
http://cvs.apache.org/viewcvs.cgi/modperl-docs/src/devel/modperl_style/modperl_style.pod?rev=1.5
http://dev.apache.org/styleguide.html
最新中译版在Perl中国推广组FPC中会随时更新。
更新
$Log: perlstyle.pod,v $
Revision 1.2  2001/11/30 16:00:52  spadkins
Renamed 'Component' to 'Service' throughout. Improved perldocs.
Revision 1.1  2001/11/22 05:16:59  spadkins
Major new architectural framework proposal
Revision 1.1  2001/11/16 23:21:38  spadkins
initial stuff
版本
原版  $Id: perlstyle.pod,v 1.2 2001/11/30 16:00:52 spadkins Exp $
中译版 $Id: perlstyle.pod,v 1.2 2005/05/02 13:00:52 spadkins Exp $

grep 函数介绍

grep函数

(如果你是个Perl的新手,你可以先跳过下面的两段,直接到 Grep vs.loops 样例这一部分,放心,在后面你还会遇到它)

<pre>
grep BLOCK LIST
grep EXPR, LIST
</pre>

请避免在 BLOCK 或 EXPR 块中修改 $_ ,因为这会相应的修改 LIST 中元素的值。同时还要避免把 grep 返回的列表做为左值使用，因为这也会修改 LIST 中的元素。(所谓左值变量就是一个在赋值表达式左边的变量)。一些 Perl hackers 可能会利用这个所谓的”特性”，但是我建议你不要使用这种混乱的编程风格.

grep 与循环

这个例子打印出 myfile 这个文件中含有 terriosm 和 nuclear 的行(大小写不敏感).

open FILE "<myfile" or die "Can't open myfile: $!";
print grep /terrorism|nuclear/i, <FILE>;

while ($line = <FILE>) {
if ($line =~ /terrorism|nuclear/i) { print $line }
}

计算数组中匹配给定模式的元素个数

在一个标量上下文中,grep 返回的是匹配的元素个数.

$num_apple = grep /^apple$/i, @fruits;

输出列表中的不同元素

@unique = grep { ++$count{$_} < 2 }
qw(a b a c d d e f g f h h);
print "@unique\n";
输出结果: a b c d e f g h

取出列表中出现两次的值

@crops = qw(wheat corn barley rice corn soybean hay
alfalfa rice hay beets corn hay);
@duplicates = grep { $count{$_} == 2 }
grep { ++$count{$_} > 1 } @crops;
print "@duplicates\n";

列出当前目录中的文本文件

@files = grep { -f and -T } glob '* .*';
print "@files\n";

从数组中选出非重复元素

@array = qw(To be or not to be that is the question);
print "@array\n";
@found_words =
grep { $_ =~ /b|o/i and ++$counts{$_} < 2; } @array;
print "@found_words\n";
输出结果:
To be or not to be that is the question
To be or not to question

逻辑表达式 $_ =~ /b|o/i 匹配包含有 b 或 o 的元素(不区别大小写)。在这个例子里把匹配操作放在累加前比反过来做有效些。比如，如果左边的表达式是假的，那么右边的表达式子就不会被计算。

选出二维坐标数组中横坐标大于纵坐标的元素

# An array of references to anonymous arrays
@data_points = ( [ 5, 12 ], [ 20, -3 ],
[ 2, 2 ], [ 13, 20 ] );
@y_gt_x = grep { $_->[0] < $_->[1] } @data_points;
foreach $xy (@y_gt_x) { print "$xy->[0], $xy->[1]\n" }
输出结果:
5, 12
13, 20

在一个简单数据库中查找餐馆

这个例子里的数据库实现方法不是实际应用中该使用的，但是它说明了使用 grep 函数的时候，只要你的内存够用， BLOCK 块的复杂度基本没有限制。

# @database is array of references to anonymous hashes
@database = (
{ name      => "Wild Ginger",
city      => "Seattle",
cuisine   => "Asian Thai Chinese Korean Japanese",
expense   => 4,
music     => "\0",
meals     => "lunch dinner",
view      => "\0",
smoking   => "\0",
parking   => "validated",
rating    => 4,
payment   => "MC VISA AMEX",
},
#   { ... },  etc.
);
sub findRestaurants {
my ($database, $query) = @_;
return grep {
$query->{city} ?
lc($query->{city}) eq lc($_->{city}) : 1
and $query->{cuisine} ?
$_->{cuisine} =~ /$query->{cuisine}/i : 1
and $query->{min_expense} ?
$_->{expense} >= $query->{min_expense} : 1
and $query->{max_expense} ?
$_->{expense} <= $query->{max_expense} : 1
and $query->{music} ? $_->{music} : 1
and $query->{music_type} ?
$_->{music} =~ /$query->{music_type}/i : 1
and $query->{meals} ?
$_->{meals} =~ /$query->{meals}/i : 1
and $query->{view} ? $_->{view} : 1
and $query->{smoking} ? $_->{smoking} : 1
and $query->{parking} ? $_->{parking} : 1
and $query->{min_rating} ?
$_->{rating} >= $query->{min_rating} : 1
and $query->{max_rating} ?
$_->{rating} <= $query->{max_rating} : 1
and $query->{payment} ?
$_->{payment} =~ /$query->{payment}/i : 1
} @$database;
}
%query = ( city => 'Seattle', cuisine => 'Asian|Thai' );
@restaurants = findRestaurants(\@database, \%query);
print "$restaurants[0]->{name}\n";
输出结果: Wild Ginger

如何使用 strict 和 warnings

什么场合要用 use strict

当你的程序有一定的行数时，尤其是在一页放不下时，或者是你找不到发生错误的原因时。

为什么要用 use strict？

众多的原因之一是帮你寻找因为错误拼写造成的错误。比如错误使用了'$recieve_date' 变量，但实际上你在程序中已声明的是 '$receive_date' 变量，这个错误就很难发现。同样，use strict 迫使你把变量的范围缩到最小，使你不必担心同名变量在程序的其它部份发生不良作用。（尽管这是 my 的功能，但是如果你使用 use strict 的话，它会强迫你用 my 声明变量，来达到上述目的）。用 use strict 麻烦吗？不麻烦，只要在你的脚本的开始加上11个字符而已！(use strict;), 另外在整个程序中用my 声明变量。不错，那我怎么用 use strict 呢？在你的脚本的开头 '#!/usr/local/bin/perl' 后面加上这句就行。

use strict;

Global symbol "$xxx" requires explicit package name at ./tst line 5.

# 把这段代码:
$string = "hello world";
@array = qw(ABC DEF);
%hash = (A=>1, B=>2);
# 改成:
my $string = "hello world";
my @array = qw(ABC DEF);
my %hash = (A=>1, B=>2);
# 把这段代码:
# '$name' is global here
foreach $name (@names) {
print "Name: $name\n";
}
# 改成:
foreach my $name (@names) {
# Now '$name' only exists in this block
print "Name: $name\n";
}
# 把这段代码:
# 同样, '$digit' 在这里是全局变量
foreach $digit (@digits) {
$number = 10*$number + $digit;
}
print "Number: $number\n";
# 改成： (外层的变量('$number')
# 将在外层声明):
my $number = 0;
foreach my $digit (@digits)
# 现在'$digit' 仅仅在这个代码块里存在
$number = 10*$number + $digit;
}
print "Number: $number\n";
# 把这段代码:
sub my_sub {
($arg1, $arg2) = @_;
print "Arg1: $arg1 Arg2: $arg2\n";
}
# 改成:
sub my_sub {
my ($arg1, $arg2) = @_;
print "Arg1: $arg1 Arg2: $arg2\n";
}
# 下面的代码好像在用 DBI 嘛？一样要改！:
$sth->bind_columns(\$field1, \$field2);
while ($sth->fetch) {
print "F1: $field1 F2: $field2\n";
}
# 改成:
$sth->bind_columns(\my ($field1, $field2));
while ($sth->fetch) {
print "F1: $field1 F2: $field2\n";
}

use warnings;

#!/usr/local/bin/perl -w
# 或者
$^W = 1;
# 或者
BEGIN { $^W = 1 }

# 把这段代码:
sub add_two_numbers_which_might_be_undef {
$_[0] + $_[1];
}
# 根据Perl 的版本不同改成下面的样子:
# 1
sub add_two_numbers_which_might_be_undef {
# 参见 'perldoc perllexwarn'
# 因为最好是只在你希望的地方禁止掉warning
no warnings "uninitialized";
$_[0] + $_[1];
}
# 2
sub add_two_numbers_which_might_be_undef {
local $^W;
$_[0] + $_[1];
}

你还可以参阅 "Ovid的": 妙文"'use strict' is not Perl" 。"okay，现在你应该没什么借口不用 use strict 或 use warnings 了吧，它使我们大家生活可以轻松一些：）