算法问题求解。

zhlong8

所以写了个简单的编译器……显示不出连续两个 $ 见谅

1. my @a = (
   
2.     [1,2,3],
   
3.     [12,343,'a'],
   
4.     ['k' .. 'm']);
   
5. 
   
6. '' =~ compile(@a);
   
7. 
   
8. 
   
9. sub compile {
   
10.     my @ary = @_;
    
11.     my $re = '^';
    
12.     my $name = 'a';
    
13.     for my $items (@ary) {
    
14.         $re .= '(?:';
    
15.         $name ++;
    
16.         $re .= join '|', map {qq,(?{local \$name = "$_"}),} @$items; # 两个 $
    
17.         $re .= ')';
    
18.     }
    
19. 
    
20.     my $show = join '|', map "\$_", 'b' .. $name;  # 是两个 $
    
21.     $show .= '\n';
    
22. 
    
23.     $re .= qq,(?{print "$show"})(*F)\$,;
    
24. 
    
25.     return qr/$re/x;
    
26. }
    

复制代码

zhlong8

幸福的童年啊

1. my @a = (
   
2.     [qw(瓜瓜 jason680 仙子)],
   
3.     [qw(在)],
   
4.     [qw(马路上 山顶 课堂上)],
   
5.     [qw(吃饭 照镜子 逛街 跳舞 翻跟头)],
   
6. );
   
7. 
   
8. '' =~ compile @a;

复制代码

瓜瓜|在|马路上|吃饭
瓜瓜|在|马路上|照镜子
瓜瓜|在|马路上|逛街
瓜瓜|在|马路上|跳舞
瓜瓜|在|马路上|翻跟头
瓜瓜|在|山顶|吃饭
瓜瓜|在|山顶|照镜子
瓜瓜|在|山顶|逛街
瓜瓜|在|山顶|跳舞
瓜瓜|在|山顶|翻跟头
瓜瓜|在|课堂上|吃饭
瓜瓜|在|课堂上|照镜子
瓜瓜|在|课堂上|逛街
瓜瓜|在|课堂上|跳舞
瓜瓜|在|课堂上|翻跟头
jason680|在|马路上|吃饭
jason680|在|马路上|照镜子
jason680|在|马路上|逛街
jason680|在|马路上|跳舞
jason680|在|马路上|翻跟头
jason680|在|山顶|吃饭
jason680|在|山顶|照镜子
jason680|在|山顶|逛街
jason680|在|山顶|跳舞
jason680|在|山顶|翻跟头
jason680|在|课堂上|吃饭
jason680|在|课堂上|照镜子
jason680|在|课堂上|逛街
jason680|在|课堂上|跳舞
jason680|在|课堂上|翻跟头
仙子|在|马路上|吃饭
仙子|在|马路上|照镜子
仙子|在|马路上|逛街
仙子|在|马路上|跳舞
仙子|在|马路上|翻跟头
仙子|在|山顶|吃饭
仙子|在|山顶|照镜子
仙子|在|山顶|逛街
仙子|在|山顶|跳舞
仙子|在|山顶|翻跟头
仙子|在|课堂上|吃饭
仙子|在|课堂上|照镜子
仙子|在|课堂上|逛街
仙子|在|课堂上|跳舞
仙子|在|课堂上|翻跟头

3P用户

用“进位制转化法”来做。

假令所有数组等长，如果数组长度为P，数组个数为N，我们只需将十进制数从小到大依次转成N位P进制数。再根据P进制数依次取出对应数组的对应元素，即可得楼主排列。
此法对数组数据类型无限制。仅为演示，可根据实际状况修改数据。

1. #!/usr/bin/perl
   
2. use strict;
   
3. 
   
4. #十进制转换P进制函数，P除取余法
   
5. my @arr; #转换时，单个P进制存于此数组，每元素存一位
   
6. sub d_to_p{
   
7.         my $quotient = int $_[0]/$_[1];
   
8.         my $remainder = $_[0] - $quotient*$_[1];
   
9.         unshift @arr,$remainder;
   
10.         unless ($quotient) {
    
11.                 return 1;
    
12.         }else{
    
13.                 d_to_p($quotient,$_[1]);
    
14.         }
    
15. }
    
16. 
    
17. my @a1 = qw(1 2 3);
    
18. my @a2 = qw(4 5 6);
    
19. my @a3 = qw(6 7);
    
20. 
    
21. my $P = 3;                  #数组长度
    
22. my $arrCount = 3;           #数组个数
    
23. my $total = $P**$arrCount;  #需要转换P进制数的总个数
    
24. 
    
25. my @result = ();       #转换后P进制数列存于此，每元素一个P进制，每P进制数各位以逗号隔开
    
26. foreach  ((0..$total-1)) {
    
27.         @arr = ();
    
28.         d_to_p($_,$P);
    
29.         while($arrCount-$#arr-1){   #P进制位数不足者，左端补0
    
30.                 unshift @arr,0;
    
31.         }
    
32.         push @result,join(",",@arr);
    
33. }
    
34. 
    
35. 
    
36. #输出演示
    
37. foreach  (@result) {
    
38.         my @tmpArr = split(",",$_);
    
39.         if($a1[$tmpArr[0]] and $a2[$tmpArr[1]] and $a3[$tmpArr[2]])  #实际数组长度不等，当且仅当各位P进制位对应数组元素有定义时才输出。
    
40.         {
    
41.         print $a1[$tmpArr[0]],"|";
    
42.         print $a2[$tmpArr[1]],"|";
    
43.         print $a3[$tmpArr[2]],"\n";
    
44.         }
    
45. }

复制代码

jason680

...
jason680|在|马路上|吃饭
jason680|在|马路上|照镜子
jason680|在|马路上|逛街
...
看到自己的ID.....吓了一跳....

  [qw(瓜瓜 jason680 仙子)],
而且跟两个版主并列....

yinyuemi

Using "echo", just for fun!

1. #!/usr/bin/perl
   
2. use strict;
   
3. 
   
4. my @a1=(1,2,3);
   
5. my @a2=(4,5,6);
   
6. my @a3=(6,7);
   
7. my $p;
   
8. my @total;
   
9. 
   
10. 
    
11. @total =("{", map {$_=~/[{}]/?$_:$_.","} (map {$_=~/#/?"}\\|{":$_} (@a1,"#",@a2,"#",@a3),"}"));
    
12. $p= join "", map {$_} @total; $p=~s/,}/}/g;$p=~s/{([^,]+)}/$1/g;
    
13. system("echo -e \"\\n\"$p")
    

复制代码

guap514

1. my $c = C->new( [1..3], ['a'..'c'], [], ['A'..'C'] );
   
2. while( my $str = $c->get() ){
   
3.     print $str, "\n";
   
4. }
   
5. 
   
6. package C;
   
7. my (@array,@int,@func,$over);
   
8. sub new {
   
9.     my $self    = bless {}, shift;
   
10.     return $self->add( @_ );
    
11. }
    
12. sub add {
    
13.     my $self    = shift;
    
14.     push @array, @_;
    
15.     return $self;
    
16. }
    
17. sub get {
    
18.     my $self    = shift;
    
19.     $self->_init if ! @func;
    
20.     my $string  = join '|', reverse map { $_->() } @func;
    
21.     return $over ? undef : $string;
    
22. }
    
23. sub _init {
    
24.     my $self    = shift;
    
25.     foreach my $i( 0..$#array ){
    
26.         my @arr = @{ $array[ $i ] } ? @{ $array[ $i ] } : ('');
    
27.         unshift @func, sub {
    
28.             if( $int[ $i ] > $#arr ){
    
29.                 $int[ $i ] = 0;
    
30.                 $int[ $i - 1 ] ++;
    
31.                 $over = 1 if $i == 0;
    
32.             }
    
33.             my $ret = $arr[ $int[ $i ] ];
    
34.             $int[ $i ]++ if $i == $#array;
    
35.             return $ret;
    
36.         };
    
37.     }
    
38. }
    
39. 1;

复制代码

forward_ding

谢谢各位，都很猛，我得抽时间好好研究一下，突然发现自己的基础很差{:3_201:}

另外问下zhlong8 在11楼里缺少的$是哪个变量的？

zhlong8

谢谢各位，都很猛，我得抽时间好好研究一下，突然发现自己的基础很差

另外问下zhlong8 在11楼里 ...
forward_ding 发表于 2011-06-28 15:31

    就是标出来那两行 \ 后面应该是两个 $ 可是只显示出来一个。

    谁能解决显示不出来两个 $ 的问题？有奖 {:2_168:}

guap514

test

1. $$

复制代码

yinyuemi

1. \$$

复制代码

斑竹的代码：

1. my @a = (
   
2.     [1,2,3],
   
3.     [12,343,'a'],
   
4.     ['k' .. 'm']);
   
5. 
   
6. '' =~ compile(@a);
   
7. 
   
8. 
   
9. sub compile {
   
10.     my @ary = @_;
    
11.     my $re = '^';
    
12.     my $name = 'a';
    
13.     for my $items (@ary) {
    
14.         $re .= '(?:';
    
15.         $name ++;
    
16.         $re .= join '|', map {qq,(?{local \$$name = "$_"}),} @$items; # 两个 $
    
17.         $re .= ')';
    
18.     }
    
19. 
    
20.     my $show = join '|', map "\$$_", 'b' .. $name;  # 是两个 $
    
21.     $show .= '\n';
    
22. 
    
23.     $re .= qq,(?{print "$show"})(*F)\$,;
    
24. 
    
25.     return qr/$re/x;
    
26. }

复制代码