免费注册 查看新帖 |

ChinaUnix.net

  平台 论坛 博客 文库
12下一页
最近访问板块 发新帖
查看: 6785 | 回复: 19

初学perl,写了一个算24点的小程序,请前辈高手指点一下 [复制链接]

论坛徽章:
0
发表于 2010-07-12 03:41 |显示全部楼层
练习的作业,大家不要笑,总觉得写的还是C的那个套路,所以想请前辈高手指点一下

我算法大概是这样的,perm是排列生成器,输入一个数组,给出全排列。
rec_cala是取出前两个元素,加上运算符生产一个新的表达式作为第一个元素放入数组中,这样递归调用,当数组只有一个元素时对表达式求值,如果表达式的值是24,则打印。
  1. my @test_arr=(10,4,7,6);
  2. my @oprator_arr=('+', '-','*','/');
  3. rec_cala(\@test_arr);

  4. sub rec_cala
  5. {
  6.     my ($arr_ref) = @_;
  7.     my @input_arr = ();
  8.     push @input_arr,@$arr_ref;

  9.     if (scalar(@input_arr) <= 1)
  10.     {
  11.         $result = eval $input_arr[0];
  12.         if ($result > 23.9 && $result < 24.1)
  13.         {
  14.             print $input_arr[0];
  15.             print "  = 24\n";
  16.         }
  17.     }
  18.     else
  19.     {
  20.         my @perm_arr = perm(\@input_arr);

  21.         foreach(@perm_arr)
  22.         {
  23.             my @next_arr = @$_;
  24.             my $op1 = pop @next_arr;
  25.             my $op2 = pop @next_arr;        
  26.                         
  27.             foreach(@oprator_arr)
  28.             {
  29.                 @op_expr_arr = @next_arr;
  30.                 push @op_expr_arr, "($op1 $_ $op2)";
  31.                 rec_cala(\@op_expr_arr);   
  32.             }   
  33.             
  34.         }
  35.     }
  36. }

  37. sub perm
  38. {
  39.     my ($arr_ref)=@_;
  40.     my @arr=@$arr_ref;
  41.     my @result = [];
  42.    
  43.     while(scalar(@arr))
  44.     {
  45.         my $curr_element = pop @arr;
  46.         my @next_step = ();
  47.         foreach $curr_array (@result)
  48.         {
  49.             $curr_len = scalar(@$curr_array);
  50.             for($i=0; $i<= $curr_len;$i++)
  51.             {
  52.                 my @tmp = @$curr_array;            
  53.                 my @tail_arr = splice(@tmp,$i,$curr_len -$i);
  54.                 push @tmp,$curr_element;
  55.                 push @tmp,@tail_arr;
  56.                 push @next_step,[@tmp];
  57.             }
  58.         }
  59.         @result =  @next_step;
  60.     }
  61.     return @result;
  62. }
复制代码

论坛徽章:
0
发表于 2010-07-12 12:16 |显示全部楼层
第26行, my @next_arr = @$_;
是什么意思。

论坛徽章:
0
发表于 2010-07-12 12:46 |显示全部楼层
本帖最后由 smilefoxzhu 于 2010-07-12 12:59 编辑
第26行, my @next_arr = @$_;
是什么意思。
leigh111 发表于 2010-07-12 12:16


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

论坛徽章:
0
发表于 2010-07-16 14:06 |显示全部楼层
  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. }
复制代码
发现其实排列部分可以稍微改一下,也比较清楚一些,其它的慢慢改吧

论坛徽章:
0
发表于 2010-07-16 16:23 |显示全部楼层
生成的结果重复率非常高,不知道能不能过滤。

论坛徽章:
0
发表于 2010-07-16 22:31 |显示全部楼层
非常感谢楼主,能够把自己的学习所得写出来

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

论坛徽章:
0
发表于 2010-07-20 16:03 |显示全部楼层
回复 6# sy5tem
  1. my @test_arr=(10,5,2,2);
  2. my @oprator_arr=('+', '-','*','/');

  3. perm(\@test_arr);
  4. rec_cala(\@test_arr);

  5. sub rec_cala
  6. {
  7.     my ($arr_ref) = @_;
  8.     my @input_arr = ();
  9.     push @input_arr,@$arr_ref;

  10.     if (scalar(@input_arr) <= 1)
  11.     {
  12.              #如果数组只有一个元素则计算表达式的值,等于24则显示
  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.              #生成全排列
  23.         my @perm_arr = perm(\@input_arr);
  24.        
  25.         foreach(@perm_arr)
  26.         {
  27.             my @next_arr = @$_;
  28.             my $op1 = pop @next_arr;
  29.             my $op2 = pop @next_arr;        
  30.             #取出2个元素,与符号生成一个表达式,然后递归   
  31.             foreach(@oprator_arr)
  32.             {
  33.                 @op_expr_arr = @next_arr;
  34.                 push @op_expr_arr, "($op1 $_ $op2)";
  35.                 rec_cala(\@op_expr_arr);   
  36.             }   
  37.             
  38.         }
  39.     }
  40. }

  41. #排列生成器
  42. #方法是: "先选一个数 1, 然后第二个数 2 可以放在 1 的前面或是后面. 而每一个放法都会产生一个 2 位数, 对於每一个这样的两位数, 第三个数 3, 都可以放在它的前面, 中间, 或是最后; 如此产生一个 3 位数; 而每一个 3 位数, 第 4 位数都可以插入到这 3 个数的任何一个空位中, 如此类推.
  43. sub perm
  44. {
  45.     my ($arr_ref)=@_;
  46.     my @arr=@$arr_ref; #变成数组,引用会直接修改传入参数,而且用起来很麻烦
  47.     my @result = [];    #初始化一个空的数组的引用
  48.    
  49.     #每循环一次数组都会缩短,到0退出
  50.     while(scalar(@arr))
  51.     {
  52.         my $curr_element = pop @arr;   #拿出一个元素,前后无所谓咯,这个是用来插入的元素
  53.         my @next_step = ();        #每次用一个空的数组放结果
  54.         foreach $curr_array (@result) #遍历要插入的数组,第一次这里有一个空的数组的引用,所以会进去
  55.         {
  56.             $curr_len = scalar(@$curr_array);
  57.             for($i=0; $i<= $curr_len;$i++)
  58.             {
  59.                # 插入到数组的各个位置,每插入一次就加到@next_step去
  60.                 push @next_step,[ ( @$curr_array[0..$i], $curr_element,@$curr_array[$i+1..$curr_len ])];
  61.             }
  62.         }
  63.         #插入完成后,把结果作为下一步要插入的数组
  64.         @result =  @next_step;
  65.     }
  66.     return @result;
  67. }
复制代码
加了些注释,应该容易看一点了吧
呵呵

论坛徽章:
0
发表于 2010-07-21 11:16 |显示全部楼层
感谢楼主啊,让我们初学者更容易理解啦

论坛徽章:
0
发表于 2013-06-24 18:55 |显示全部楼层
请教下lz,自己有试过程序吗?
(a+b)*(c+d)=24  这样的算式恐怕不适用?!

论坛徽章:
7
戌狗
日期:2013-12-15 20:43:38技术图书徽章
日期:2014-03-05 01:33:12技术图书徽章
日期:2014-03-15 20:31:17未羊
日期:2014-03-25 23:48:20丑牛
日期:2014-04-07 22:37:44巳蛇
日期:2014-04-11 21:58:0915-16赛季CBA联赛之青岛
日期:2016-03-17 20:36:13
发表于 2013-06-25 14:34 |显示全部楼层
非常感谢 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. while (1) { print "[Q to exit] input: ";

  14. my $i = <>;
  15. $i =~ /^[qQ]/ and last;
  16. my @i = map /(\d+)/g, $i;
  17. @i == 4 or next;
  18. my ( @N, $m, %m ) = P @i;

  19. for my $f (@F) {
  20.   for my $n (@N) {
  21.     for my $o (@O) {
  22.        my $s = sprintf $f, map( { $n->[$_], $o->[$_] } 0, 1, 2 ), $n->[3];
  23.        my $R = eval $s or next;
  24.        print ++$m, "\t$s$/" if $R == 24 and !$m{$s}++ } } }
  25.       
  26. print "NOOO\n" unless %m }
复制代码
您需要登录后才可以回帖 登录 | 注册

本版积分规则 发表回复

基于案例的 SQL 优化实战训练营

讲师:中电福富特级专家梁敬彬,参与本次课程培训,你将收获:
1. 能编写出较为高效的 SQL;
2. 能解决70%以上的数据库常见优化问题;
3. 能得到老师提供的高效的相关工具和解决方案;
4. 能举一反三,收获不仅仅是 SQL 优化。
现在购票享受8.8折优惠!
----------------------------------------
优惠时间:2019年3月20日前

大会官网>>
  

北京盛拓优讯信息技术有限公司. 版权所有 16024965号-6 北京市公安局海淀分局网监中心备案编号:11010802020122
中国互联网协会会员  联系我们:huangweiwei@it168.com
感谢所有关心和支持过ChinaUnix的朋友们 转载本站内容请注明原作者名及出处

清除 Cookies - ChinaUnix - Archiver - WAP - TOP