Board logo

标题: [原创教程] Perl 内嵌 C 代码 [打印本页]
作者: 523066680    时间: 2017-8-4 22:25     标题: Perl 内嵌 C 代码

本帖最后由 523066680 于 2017-8-5 08:23 编辑

在优化猜数字游戏脚本的运行效率时（其实是在看Imager模块的示例偶然发现），发现了 Perl 可以内联 C 代码，可以极大地提高效率。
原本跑完5040次猜数字测试，用 perl 写的test函数消耗（累积）可能需要10秒，现在只需要零点几秒。
  1. use IO::Handle;

  2. use Inline C;

  3. STDOUT->autoflush(1);

  4. 

  5. my $nums = "4109";

  6. my $guess = "0124";

  7. my $AB = "00";

  8. 

  9. for (1..5)

  10. {

  11. 	$AB = "00";

  12. 	test($nums, $guess, $AB);

  13. 	print "$AB\n";

  14. }

  15. 

  16. 

  17. __END__

  18. __C__

  19. void test(char *stra, char *strb, char *AB)

  20. {

  21.     int idx;

  22.     for ( idx = 0; idx < 4; idx++ )

  23.     {

  24.         if ( stra[idx] == strb[idx] )

  25.             AB[0]++;

  26.         else

  27.             if ( strchr(stra, strb[idx]) != 0 )

  28.             {

  29.                 AB[1]++;

  30.             }

  31.     }

  32. }
复制代码
不过以上代码有个问题，就是 $AB = "00" 的重置无效了，每次结果都会被递增，输出如下
  1. 12

  2. 24

  3. 36

  4. 48

  5. 5:
复制代码
所以C函数部分重写，用临时变量从 '0' 开始计数。（为了统一，我用的是字符'0' )
  1. __END__

  2. __C__

  3. void bullcow(char *stra, char *strb, char *AB)

  4. {

  5.     int idx;

  6.     char a = '0';

  7.     char b = '0';

  8. 

  9.     for ( idx = 0; idx < 4; idx++ )

  10.     {

  11.         if ( stra[idx] == strb[idx] )

  12.             a++;

  13.         else

  14.             if ( strchr(stra, strb[idx]) != 0 )

  15.             {

  16.                 b++;

  17.             }

  18.     }

  19. 

  20.     AB[0] = a;

  21.     AB[1] = b;

  22. }
复制代码
作者: codegay    时间: 2017-8-5 01:47


__END__
写在最上面吗？这逻辑我没法懂啊。
作者: 523066680    时间: 2017-8-5 08:08

本帖最后由 523066680 于 2017-8-5 14:44 编辑

回复 2# codegay

    __END__ 在 perl 里面表示脚本结束的节点，可以放备注、数据之类的信息。
作者: 523066680    时间: 2017-8-5 08:57     标题: 效率对比

本帖最后由 523066680 于 2017-8-5 09:08 编辑

时间占用对比，用 Devel::NYTProf 模块分析效率
perl -d:NYTProf normal.pl
nytprofhtml


perl -d:NYTProf InlineC.pl
nytprofhtml


两份完整的测试代码：
  1. use IO::Handle;

  2. STDOUT->autoflush(1);

  3. 

  4. my $nums = "4109";

  5. my $guess = "0124";

  6. my $AB = "00";

  7. 

  8. for ( 1 .. 100000 )

  9. {

  10.     $AB = "00";

  11.     bullcow($nums, $guess, \$AB);

  12.     print "$AB\n";

  13. }

  14. 

  15. sub bullcow

  16. {

  17.     my ($nums, $guess, $AB) = @_;

  18.     my ($A, $B) = (0, 0);

  19.     my $t;

  20. 

  21.     for my $i ( 0 .. 3 )

  22.     {

  23.         if ( substr($nums, $i, 1) eq substr($guess, $i, 1) )

  24.         {

  25.             $A++;

  26.         }

  27.         else

  28.         {

  29.             $t = substr($guess, $i, 1);

  30.             $B++ if ( $nums =~/$t/ );

  31.         }

  32.     }

  33. 

  34.     $$AB = "$A$B";

  35. }
复制代码
内联C的版本：
  1. use Inline C;

  2. use IO::Handle;

  3. STDOUT->autoflush(1);

  4. 

  5. my $nums = "4109";

  6. my $guess = "0124";

  7. my $AB = "00";

  8. 

  9. for ( 1 .. 100000 )

  10. {

  11.     $AB = "00";

  12.     bullcow($nums, $guess, $AB);

  13.     print "$AB\n";

  14. }

  15. 

  16. __END__

  17. __C__

  18. void bullcow(char *stra, char *strb, char *AB)

  19. {

  20.     int idx;

  21.     char a = '0';

  22.     char b = '0';

  23. 

  24.     for ( idx = 0; idx < 4; idx++ )

  25.     {

  26.         if ( stra[idx] == strb[idx] )

  27.             a++;

  28.         else

  29.             if ( strchr(stra, strb[idx]) != 0 )

  30.             {

  31.                 b++;

  32.             }

  33.     }

  34. 

  35.     AB[0] = a;

  36.     AB[1] = b;

  37. }
复制代码
作者: codegay    时间: 2017-8-5 14:40

我对perl完全不懂哦。
作者: Wiki    时间: 2018-9-23 00:10

提高效率啊。



欢迎光临 批处理之家 (http://bathome.net./) Powered by Discuz! 7.2