初学perl，写了一个算24点的小程序，请前辈高手指点一下

smilefoxzhu

练习的作业，大家不要笑，总觉得写的还是C的那个套路，所以想请前辈高手指点一下

我算法大概是这样的，perm是排列生成器，输入一个数组，给出全排列。
rec_cala是取出前两个元素，加上运算符生产一个新的表达式作为第一个元素放入数组中，这样递归调用，当数组只有一个元素时对表达式求值，如果表达式的值是24，则打印。

1. my @test_arr=(10,4,7,6);
   
2. my @oprator_arr=('+', '-','*','/');
   
3. rec_cala(\@test_arr);
   
4. 
   
5. sub rec_cala
   
6. {
   
7.     my ($arr_ref) = @_;
   
8.     my @input_arr = ();
   
9.     push @input_arr,@$arr_ref;
   
10. 
    
11.     if (scalar(@input_arr) <= 1)
    
12.     {
    
13.         $result = eval $input_arr[0];
    
14.         if ($result > 23.9 && $result < 24.1)
    
15.         {
    
16.             print $input_arr[0];
    
17.             print "  = 24\n";
    
18.         }
    
19.     }
    
20.     else
    
21.     {
    
22.         my @perm_arr = perm(\@input_arr);
    
23. 
    
24.         foreach(@perm_arr)
    
25.         {
    
26.             my @next_arr = @$_;
    
27.             my $op1 = pop @next_arr;
    
28.             my $op2 = pop @next_arr;        
    
29.                         
    
30.             foreach(@oprator_arr)
    
31.             {
    
32.                 @op_expr_arr = @next_arr;
    
33.                 push @op_expr_arr, "($op1 $_ $op2)";
    
34.                 rec_cala(\@op_expr_arr);   
    
35.             }   
    
36.             
    
37.         }
    
38.     }
    
39. }
    
40. 
    
41. sub perm
    
42. {
    
43.     my ($arr_ref)=@_;
    
44.     my @arr=@$arr_ref;
    
45.     my @result = [];
    
46.    
    
47.     while(scalar(@arr))
    
48.     {
    
49.         my $curr_element = pop @arr;
    
50.         my @next_step = ();
    
51.         foreach $curr_array (@result)
    
52.         {
    
53.             $curr_len = scalar(@$curr_array);
    
54.             for($i=0; $i<= $curr_len;$i++)
    
55.             {
    
56.                 my @tmp = @$curr_array;            
    
57.                 my @tail_arr = splice(@tmp,$i,$curr_len -$i);
    
58.                 push @tmp,$curr_element;
    
59.                 push @tmp,@tail_arr;
    
60.                 push @next_step,[@tmp];
    
61.             }
    
62.         }
    
63.         @result =  @next_step;
    
64.     }
    
65.     return @result;
    
66. }
    

复制代码

leigh111

第26行， my @next_arr = @$_;
是什么意思。

smilefoxzhu

第26行， my @next_arr = @$_;
是什么意思。
leigh111 发表于 2010-07-12 12:16

呃，这句就是把@perm_arr里的一个个数组取出来啊，因为@perm_arr里放的是数组的引用，所以写@next_arr = @$_。
其实直接操作@$_也可以吧，不过要传到第二个foreach里面去，因为让调试方便，省得两个$_掺和所以这么写来着。

smilefoxzhu

1. sub perm
   
2. {
   
3.     my ($arr_ref)=@_;
   
4.     my @arr=@$arr_ref;
   
5.     my @result = [];
   
6.    
   
7.     while(scalar(@arr))
   
8.     {
   
9.         my $curr_element = pop @arr;
   
10.         my @next_step = ();
    
11.         foreach $curr_array (@result)
    
12.         {
    
13.             $curr_len = scalar(@$curr_array);
    
14.             for($i=0; $i<= $curr_len;$i++)
    
15.             {
    
16.                 push @next_step,[ ( @$curr_array[0..$i], $curr_element,@$curr_array[$i+1..$curr_len ])];
    
17.             }
    
18.         }
    
19.         @result =  @next_step;
    
20.     }
    
21.     return @result;
    
22. }

复制代码

发现其实排列部分可以稍微改一下，也比较清楚一些，其它的慢慢改吧

iamlimeng

生成的结果重复率非常高，不知道能不能过滤。

sy5tem

非常感谢楼主，能够把自己的学习所得写出来

给个小小建议，如果能够加上注释，对于初学者的阅读更方便些

smilefoxzhu

回复 6# sy5tem

1. my @test_arr=(10,5,2,2);
   
2. my @oprator_arr=('+', '-','*','/');
   
3. 
   
4. perm(\@test_arr);
   
5. rec_cala(\@test_arr);
   
6. 
   
7. sub rec_cala
   
8. {
   
9.     my ($arr_ref) = @_;
   
10.     my @input_arr = ();
    
11.     push @input_arr,@$arr_ref;
    
12. 
    
13.     if (scalar(@input_arr) <= 1)
    
14.     {
    
15.              #如果数组只有一个元素则计算表达式的值，等于24则显示
    
16.         $result = eval $input_arr[0];
    
17.         if ($result > 23.9 && $result < 24.1)
    
18.         {
    
19.             print $input_arr[0];
    
20.             print "  = 24\n";
    
21.         }
    
22.     }
    
23.     else
    
24.     {
    
25.              #生成全排列
    
26.         my @perm_arr = perm(\@input_arr);
    
27.        
    
28.         foreach(@perm_arr)
    
29.         {
    
30.             my @next_arr = @$_;
    
31.             my $op1 = pop @next_arr;
    
32.             my $op2 = pop @next_arr;        
    
33.             #取出2个元素，与符号生成一个表达式，然后递归   
    
34.             foreach(@oprator_arr)
    
35.             {
    
36.                 @op_expr_arr = @next_arr;
    
37.                 push @op_expr_arr, "($op1 $_ $op2)";
    
38.                 rec_cala(\@op_expr_arr);   
    
39.             }   
    
40.             
    
41.         }
    
42.     }
    
43. }
    
44. 
    
45. #排列生成器
    
46. #方法是: "先选一个数 1, 然后第二个数 2 可以放在 1 的前面或是后面. 而每一个放法都会产生一个 2 位数, 对於每一个这样的两位数, 第三个数 3, 都可以放在它的前面, 中间, 或是最后; 如此产生一个 3 位数; 而每一个 3 位数, 第 4 位数都可以插入到这 3 个数的任何一个空位中, 如此类推.
    
47. sub perm
    
48. {
    
49.     my ($arr_ref)=@_;
    
50.     my @arr=@$arr_ref; #变成数组，引用会直接修改传入参数，而且用起来很麻烦
    
51.     my @result = [];    #初始化一个空的数组的引用
    
52.    
    
53.     #每循环一次数组都会缩短，到0退出
    
54.     while(scalar(@arr))
    
55.     {
    
56.         my $curr_element = pop @arr;   #拿出一个元素，前后无所谓咯，这个是用来插入的元素
    
57.         my @next_step = ();        #每次用一个空的数组放结果
    
58.         foreach $curr_array (@result) #遍历要插入的数组，第一次这里有一个空的数组的引用，所以会进去
    
59.         {
    
60.             $curr_len = scalar(@$curr_array);
    
61.             for($i=0; $i<= $curr_len;$i++)
    
62.             {
    
63.                # 插入到数组的各个位置，每插入一次就加到@next_step去
    
64.                 push @next_step,[ ( @$curr_array[0..$i], $curr_element,@$curr_array[$i+1..$curr_len ])];
    
65.             }
    
66.         }
    
67.         #插入完成后，把结果作为下一步要插入的数组
    
68.         @result =  @next_step;
    
69.     }
    
70.     return @result;
    
71. }
    

复制代码

加了些注释，应该容易看一点了吧
呵呵

sy5tem

感谢楼主啊，让我们初学者更容易理解啦

bakerwm

请教下lz，自己有试过程序吗？
（a+b）*（c+d）=24  这样的算式恐怕不适用？！

rubyish

非常感谢 LZ :

1. #!/usr/bin/perl
   
2. my @o = qw[ + - * / ];
   
3. my @O = map { $a = $_; map { $b = $_; map [ $a, $b, $_ ], @o } @o } @o;
   
4. my @F = (
   
5.     '( ( %d %s %d ) %s %d ) %s %d',
   
6.     '( %d %s ( %d %s %d ) ) %s %d',
   
7.     '( %d %s %d ) %s ( %d %s %d )',
   
8.     '%d %s ( ( %d %s %d ) %s %d )',
   
9.     '%d %s ( %d %s ( %d %s %d ) )' );
   
10. sub P {
    
11.     @_ ? map { my $i = $_; map [ $_[$i], @$_ ],
    
12.         &P( @_[ 0 .. $i - 1, $i + 1 .. $#_ ] ) } 0 .. $#_ : [] }
    
13. 
    
14. 
    
15. while (1) { print "[Q to exit] input: ";
    
16. 
    
17. my $i = <>;
    
18. $i =~ /^[qQ]/ and last;
    
19. my @i = map /(\d+)/g, $i;
    
20. @i == 4 or next;
    
21. my ( @N, $m, %m ) = P @i;
    
22. 
    
23. for my $f (@F) {
    
24.   for my $n (@N) {
    
25.     for my $o (@O) {
    
26.        my $s = sprintf $f, map( { $n->[$_], $o->[$_] } 0, 1, 2 ), $n->[3];
    
27.        my $R = eval $s or next;
    
28.        print ++$m, "\t$s$/" if $R == 24 and !$m{$s}++ } } }
    
29.       
    
30. print "NOOO\n" unless %m }

复制代码