数学研发论坛

 找回密码
 欢迎注册
123
返回列表 发新帖
楼主: mathematica

[擂台] 求算24点的程序,要求快且求出所有解!

[复制链接]
 楼主| 发表于 2018-7-25 15:07:23 | 显示全部楼层
如今回头看,这真的不是一个难题

点评

@chyanog 只有穷举法去重呀,不穷举法能怎么办呢?  发表于 2018-7-25 17:19
如果要去重就麻烦一点,比如((1+3)+8)+12和((8+1)+12)+3可视为重复的  发表于 2018-7-25 15:28
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
 楼主| 发表于 2018-7-25 16:40:04 | 显示全部楼层
mathematica 发表于 2018-7-25 15:07
如今回头看,这真的不是一个难题
  1. Clear["Global`*"];(*Clear all variables*)
  2. abcd={"a","b","c","d"}
  3. pers=Permutations@abcd
  4. mark=Tuples[{"+","-","*","/"},{3}]
  5. (*函数,给出一个{"a","b","c","d"} 给出所有排列,返回结果的元素是"a*b+c-d"这种*)
  6. fun[z_]:=StringJoin[#]&/@(Riffle[z,#]&/@mark)
  7. mylist={
  8. {"((a","b)","c)","d"},
  9. {"(a","b)","(c","d)"},
  10. {"a","(b","c)","d"},
  11. {"a","((b","c)","d)"},
  12. {"a","(b","(c","d))"}
  13. }
  14. (*abcd顺序不变,得到所有的可能情况*)
  15. out=Flatten[fun[#]&/@mylist]
  16. (*函数,对于一个字符串"a*b+c/d",得到所有的顺序可以改变的字符串列表*)
  17. strall[str_]:=StringReplace[str,Thread[{"a","b","c","d"}->#]]&/@pers
  18. sol=Flatten[strall[#]&/@out]
复制代码


暴力求解,列举出所有可能的情况

点评

@chyanog 链接不错,去重标准还真不是那么简单。  发表于 2018-7-28 18:06
@hujunhua 这里有相关的讨论 https://www.zhihu.com/question/28095987  发表于 2018-7-27 16:45
@chyanog 相重的标准不是可相互恒等变形么?  发表于 2018-7-27 15:19
Groupings[Permutations[{a,b,c,d},{4}],{Plus,Subtract,Times,Divide}->2,HoldForm] 生成所有的表达式,这样就够了  发表于 2018-7-25 17:17
所有可能的表达式有7680种,去重后有1170种。当然去重的标准不是唯一的,http://oeis.org/A140606  发表于 2018-7-25 17:13
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
 楼主| 发表于 2018-7-25 16:48:47 | 显示全部楼层
本帖最后由 mathematica 于 2018-7-25 16:57 编辑

"((a+b)+c)+d","((a+b)+d)+c","((a+c)+b)+d","((a+c)+d)+b","((a+d)+b)+c","((a+d)+c)+b","((b+a)+c)+d","((b+a)+d)+c","((b+c)+a)+d","((b+c)+d)+a","((b+d)+a)+c","((b+d)+c)+a","((c+a)+b)+d","((c+a)+d)+b","((c+b)+a)+d","((c+b)+d)+a",
"((c+d)+a)+b","((c+d)+b)+a","((d+a)+b)+c","((d+a)+c)+b","((d+b)+a)+c","((d+b)+c)+a","((d+c)+a)+b","((d+c)+b)+a","((a+b)+c)-d","((a+b)+d)-c","((a+c)+b)-d","((a+c)+d)-b","((a+d)+b)-c","((a+d)+c)-b","((b+a)+c)-d","((b+a)+d)-c",
"((b+c)+a)-d","((b+c)+d)-a","((b+d)+a)-c","((b+d)+c)-a","((c+a)+b)-d","((c+a)+d)-b","((c+b)+a)-d","((c+b)+d)-a","((c+d)+a)-b","((c+d)+b)-a","((d+a)+b)-c","((d+a)+c)-b","((d+b)+a)-c","((d+b)+c)-a","((d+c)+a)-b","((d+c)+b)-a",
"((a+b)+c)*d","((a+b)+d)*c","((a+c)+b)*d","((a+c)+d)*b","((a+d)+b)*c","((a+d)+c)*b","((b+a)+c)*d","((b+a)+d)*c","((b+c)+a)*d","((b+c)+d)*a","((b+d)+a)*c","((b+d)+c)*a","((c+a)+b)*d","((c+a)+d)*b","((c+b)+a)*d","((c+b)+d)*a",
"((c+d)+a)*b","((c+d)+b)*a","((d+a)+b)*c","((d+a)+c)*b","((d+b)+a)*c","((d+b)+c)*a","((d+c)+a)*b","((d+c)+b)*a","((a+b)+c)/d","((a+b)+d)/c","((a+c)+b)/d","((a+c)+d)/b","((a+d)+b)/c","((a+d)+c)/b","((b+a)+c)/d","((b+a)+d)/c",
"((b+c)+a)/d","((b+c)+d)/a","((b+d)+a)/c","((b+d)+c)/a","((c+a)+b)/d","((c+a)+d)/b","((c+b)+a)/d","((c+b)+d)/a","((c+d)+a)/b","((c+d)+b)/a","((d+a)+b)/c","((d+a)+c)/b","((d+b)+a)/c","((d+b)+c)/a","((d+c)+a)/b","((d+c)+b)/a",
"((a+b)-c)+d","((a+b)-d)+c","((a+c)-b)+d","((a+c)-d)+b","((a+d)-b)+c","((a+d)-c)+b","((b+a)-c)+d","((b+a)-d)+c","((b+c)-a)+d","((b+c)-d)+a","((b+d)-a)+c","((b+d)-c)+a","((c+a)-b)+d","((c+a)-d)+b","((c+b)-a)+d","((c+b)-d)+a",
"((c+d)-a)+b","((c+d)-b)+a","((d+a)-b)+c","((d+a)-c)+b","((d+b)-a)+c","((d+b)-c)+a","((d+c)-a)+b","((d+c)-b)+a","((a+b)-c)-d","((a+b)-d)-c","((a+c)-b)-d","((a+c)-d)-b","((a+d)-b)-c","((a+d)-c)-b","((b+a)-c)-d","((b+a)-d)-c",

为了节省篇幅,仅仅列举出一部分结果
所有结果放在附件里面

24Dian3Qiong2Ju3.rar

6.76 KB, 下载次数: 1, 下载积分: 金币 -1 枚, 经验 1 点, 下载 1 次

点评

穷举出所有的可能  发表于 2018-7-25 16:49
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
 楼主| 发表于 2018-7-25 17:26:25 | 显示全部楼层
mathematica 发表于 2018-7-25 16:40
暴力求解,列举出所有可能的情况


Groupings[Permutations[{a,b,c,d},{4}],{Plus,Subtract,Times,Divide}->2,HoldForm]
这个{Plus,Subtract,Times,Divide}->2是什么意思?

所有可能的表达式有7680种,去重后有1170种。这个1170怎么得到的?

点评

https://bbs.emath.ac.cn/thread-461-1-1.html  发表于 2018-7-25 17:55
DeleteDuplicatesBy[Groupings[Permutations[{a,b,c,d},{4}],{Plus->{2,Orderless},Subtract->2,Times->{2,Orderless},Divide->2},HoldForm],Factor@*ReleaseHold]//Length  发表于 2018-7-25 17:54
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
 楼主| 发表于 2018-7-27 12:59:11 | 显示全部楼层
mathematica 发表于 2018-7-25 17:26
Groupings,{Plus,Subtract,Times,Divide}->2,HoldForm]
这个{Plus,Subtract,Times,Divide}->2是什么 ...
  1. #算24点程序
  2. use strict;use warnings;use diagnostics;
  3. my $a=9;
  4. my $b=5;
  5. my $c=2;
  6. my $d=7;
  7. #利用穷举法,列出abcd四个变量之间所有的各种排列
  8. &cacu($a,$b,$c,$d);
  9. &cacu($a,$b,$d,$c);
  10. &cacu($a,$c,$b,$d);
  11. &cacu($a,$c,$d,$b);
  12. &cacu($a,$d,$b,$c);
  13. &cacu($a,$d,$c,$b);
  14. &cacu($b,$a,$c,$d);
  15. &cacu($b,$a,$d,$c);
  16. &cacu($b,$c,$a,$d);
  17. &cacu($b,$c,$d,$a);
  18. &cacu($b,$d,$a,$c);
  19. &cacu($b,$d,$c,$a);
  20. &cacu($c,$a,$b,$d);
  21. &cacu($c,$a,$d,$b);
  22. &cacu($c,$b,$a,$d);
  23. &cacu($c,$b,$d,$a);
  24. &cacu($c,$d,$a,$b);
  25. &cacu($c,$d,$b,$a);
  26. &cacu($d,$a,$b,$c);
  27. &cacu($d,$a,$c,$b);
  28. &cacu($d,$b,$a,$c);
  29. &cacu($d,$b,$c,$a);
  30. &cacu($d,$c,$a,$b);
  31. &cacu($d,$c,$b,$a);
  32. #子函数,利用三重循环计算abcd位置不变的时候的所有可能,
  33. #四个数之间只可能有三种运算符,加括号只可能有五种可能.
  34. sub cacu
  35. {
  36.     my ($a,$b,$c,$d)=@_;
  37.     my @op=("+","-","*","/");#运算符数组
  38.     foreach my $x (@op)#第一个运算符
  39.     {
  40.         foreach my $y (@op)#第二个运算符
  41.         {
  42.             foreach my $z (@op)#第三个运算符
  43.             {
  44.                 my $str1="(($a$x$b)$y$c)$z$d";
  45.                 my $str2="($a$x$b)$y($c$z$d)";
  46.                 my $str3="($a$x($b$y$c))$z$d";
  47.                 my $str4="$a$x(($b$y$c)$z$d)";
  48.                 my $str5="$a$x($b$y($c$z$d))";
  49.                 if(abs(eval($str1)-24)<0.000001){print $str1 . "=24\n";}
  50.                 if(abs(eval($str2)-24)<0.000001){print $str2 . "=24\n";}
  51.                 if(abs(eval($str3)-24)<0.000001){print $str3 . "=24\n";}
  52.                 if(abs(eval($str4)-24)<0.000001){print $str4 . "=24\n";}
  53.                 if(abs(eval($str5)-24)<0.000001){print $str5 . "=24\n";}
  54.             }
  55.         }
  56.     }
  57. }
复制代码

贴一下我的perl代码,居然在分母等于零的时候也能运行,我真佩服perl,
代码写起来真爽!
perl太牛逼了

点评

use strict;use warnings;use diagnostics;这句改成use strict;否则遇到分母等于零输出不完全  发表于 2018-7-27 15:51
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
发表于 2018-7-27 15:22:44 | 显示全部楼层
本帖最后由 chyanog 于 2018-7-27 15:25 编辑
chyanog 发表于 2013-6-25 12:11
((1+2)+3)*4=24

(1+(2+3))*4=24


不用字符串,不考虑去重
  1. Clear["`*"];
  2. calc24[list_] :=
  3.   Cases[
  4.     Tuples[{Tuples[{Plus, Subtract, Times, Divide}, 3], Permutations[list]}] /.
  5.      {{o1_, o2_, o3_}, {a_, b_, c_, d_}} ->
  6.       HoldForm /@ {
  7.         a~o1~b~o2~c~o3~d,
  8.         (a~o1~b)~o2~(c~o3~d),
  9.         (a~o1~(b~o2~c))~o3~d,
  10.         a~o1~(b~o2~(c~o3~d)),
  11.          a~o1~((b~o2~c)~o3~d)
  12.         },
  13.     e_ /; ReleaseHold@e == 24, {2}
  14.     ] // Quiet;

  15. calc24[{2, 3, 5, 7}]
复制代码

考虑去重
  1. Clear["`*"];
  2. calc24[list_] :=
  3.   Groupings[Permutations[{a, b, c, d}], {Plus -> {2, Orderless}, Subtract -> 2, Times -> {2, Orderless}, Divide -> 2}, HoldForm] //
  4.        DeleteDuplicatesBy[Factor@*ReleaseHold] //
  5.       ReplaceAll[Thread[{a, b, c, d} -> list]] //
  6.      DeleteDuplicates //
  7.     Pick[#, ReleaseHold@# /. ComplexInfinity -> 0, 24] & //
  8.    Quiet;

  9. calc24[{2, 3, 5, 7}]
复制代码

点评

Factor@*ReleaseHold这句话是什么意思?  发表于 2018-7-28 16:45
我的编程,一般用autolisp perl而已偶尔VB  发表于 2018-7-28 16:18
对我来说就偶尔解个方程,求个最值而已  发表于 2018-7-28 16:18
你掌握的mathematica函数很多,所以可以推断出你花了很长时间研究mathematica  发表于 2018-7-28 16:18
没啥难懂的,把代码拆解开,分步执行,很快就会明白了  发表于 2018-7-27 20:09
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
 楼主| 发表于 2018-7-27 16:00:02 | 显示全部楼层
chyanog 发表于 2018-7-27 15:22
不用字符串,不考虑去重

考虑去重

我想写一个穷举法列举出所有的不重的表达式a+b+c*d这种的,
对应的mathematica代码是?

点评

用Groupings的方法算吗,楼上的点评里已经贴过了  发表于 2018-7-27 16:11
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
 楼主| 发表于 2018-7-28 16:03:21 | 显示全部楼层
chyanog 发表于 2018-7-27 15:22
不用字符串,不考虑去重

考虑去重

其实如果代码都在1秒之内执行完毕,
任何语言都没啥差别,
以可维护性 可读性为差别的标准
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
您需要登录后才可以回帖 登录 | 欢迎注册

本版积分规则

小黑屋|手机版|数学研发网 ( 苏ICP备07505100号 )

GMT+8, 2019-1-16 11:21 , Processed in 0.054379 second(s), 18 queries .

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表