数学研发论坛

 找回密码
 欢迎注册
楼主: mathematica

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

[复制链接]
 楼主| 发表于 2018-7-25 15:01:14 | 显示全部楼层
本帖最后由 mathematica 于 2018-7-25 17:04 编辑
  1. #include<stdio.h>
  2. char mark[4]={'+','-','*','/'};
  3. float cal(float x,float y,int mark)
  4. {
  5.   switch(mark)
  6.   {
  7.     case 0:return x+y;
  8.     case 1:return x-y;
  9.     case 2:return x*y;
  10.     case 3:return x/y;
  11.   }
  12. }
  13. float calculate_A(float a,float b,float c,float d,int mark1,int mark2,int mark3)
  14. {
  15.   float r1,r2,r3;
  16.   r1=cal(a,b,mark1);
  17.   r2=cal(r1,c,mark2);
  18.   r3=cal(r2,d,mark3);
  19.   return r3;
  20. }
  21. float calculate_B(float a,float b,float c,float d,int mark1,int mark2,int mark3)
  22. {
  23.   float r1,r2,r3;
  24.   r1=cal(b,c,mark2);
  25.   r2=cal(a,r1,mark1);
  26.   r3=cal(r2,d,mark3);
  27.   return r3;
  28. }
  29. float calculate_C(float a,float b,float c,float d,int mark1,int mark2,int mark3)
  30. {
  31.   float r1,r2,r3;
  32.   r1=cal(c,d,mark3);
  33.   r2=cal(b,r1,mark2);
  34.   r3=cal(a,r2,mark1);
  35.   return r3;
  36. }
  37. float calculate_D(float a,float b,float c,float d,int mark1,int mark2,int mark3)
  38. {
  39.   float r1,r2,r3;
  40.   r1=cal(b,c,mark2);
  41.   r2=cal(r1,d,mark3);
  42.   r3=cal(a,r2,mark1);
  43.   return r3;
  44. }
  45. float calculate_E(float a,float b,float c,float d,int mark1,int mark2,int mark3)
  46. {
  47.   float r1,r2,r3;
  48.   r1=cal(a,b,mark1);
  49.   r2=cal(c,d,mark3);
  50.   r3=cal(r1,r2,mark2);
  51.   return r3;
  52. }
  53. float get(int a,int b,int c,int d)
  54. {
  55.   int mark1,mark2,mark3;
  56.   float flag=0;
  57.   for(mark1=0;mark1<4;mark1++)
  58.   {
  59.     for(mark2=0;mark2<4;mark2++)
  60.     {
  61.       for(mark3=0;mark3<4;mark3++)
  62.       {
  63.         if(calculate_A(a,b,c,d,mark1,mark2,mark3)==24)
  64.         {
  65.           printf("((%d%c%d)%c%d)%c%d=24\n",a,mark[mark1],b,mark[mark2],c,mark[mark3],d);
  66.           flag=1;
  67.         }
  68.         if(calculate_B(a,b,c,d,mark1,mark2,mark3)==24)
  69.         {
  70.           printf("(%d%c(%d%c%d))%c%d=24\n",a,mark[mark1],b,mark[mark2],c,mark[mark3],d);
  71.           flag=1;
  72.         }
  73.         if(calculate_C(a,b,c,d,mark1,mark2,mark3)==24)
  74.         {
  75.           printf("%d%c(%d%c(%d%c%d))=24\n",a,mark[mark1],b,mark[mark2],c,mark[mark3],d);
  76.           flag=1;
  77.         }
  78.         if(calculate_D(a,b,c,d,mark1,mark2,mark3)==24)
  79.         {
  80.           printf("%d%c((%d%c%d)%c%d)=24\n",a,mark[mark1],b,mark[mark2],c,mark[mark3],d);
  81.           flag=1;
  82.         }
  83.         if(calculate_E(a,b,c,d,mark1,mark2,mark3)==24)
  84.         {
  85.           printf("(%d%c%d)%c(%d%c%d)=24\n",a,mark[mark1],b,mark[mark2],c,mark[mark3],d);
  86.           flag=1;
  87.         }
  88.       }
  89.     }
  90.   }
  91.   return flag;
  92. }
  93. main()
  94. {
  95.   int a,b,c,d;
  96.   printf("Please input 4 numbers(1~13):");
  97.   scanf("%d%d%d%d",&a,&b,&c,&d);
  98.     if((a>=1&&a<=13)&&(b>=1&&b<=13)&&(c>=1&&c<=13)&&(d>=1&&d<=13))
  99.     {
  100.       get(a,b,c,d);
  101.     }
  102.       else
  103.       {
  104.         printf("Input illegal,please input again(1~13):");
  105.         scanf("%d%d%d%d",&a,&b,&c,&d);
  106.         if((a>=1&&a<=13)&&(b>=1&&b<=13)&&(c>=1&&c<=13)&&(d>=1&&d<=13))
  107.          {
  108.               get(a,b,c,d);
  109.          }
  110.       }
  111.   system("pause");
  112. }
复制代码

代码写得非常棒,我一下子看明白了
https://blog.csdn.net/xyisv/article/details/54709207
  1. get(a,b,c,d);
  2. get(a,b,d,c);
  3. get(a,c,b,d);
  4. get(a,c,d,b);
  5. get(a,d,b,c);
  6. get(a,d,c,b);
  7. get(b,a,c,d);
  8. get(b,a,d,c);
  9. get(b,c,a,d);
  10. get(b,c,d,a);
  11. get(b,d,a,c);
  12. get(b,d,c,a);
  13. get(c,a,b,d);
  14. get(c,a,d,b);
  15. get(c,b,a,d);
  16. get(c,b,d,a);
  17. get(c,d,a,b);
  18. get(c,d,b,a);
  19. get(d,a,b,c);
  20. get(d,a,c,b);
  21. get(d,b,a,c);
  22. get(d,b,c,a);
  23. get(d,c,a,b);
  24. get(d,c,b,a);
复制代码

代码改成这24行,才完美


点评

虽然没有注释,但是这么棒的代码,我还是一下子看明白了  发表于 2018-7-25 15:03
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
 楼主| 发表于 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秒之内执行完毕,
任何语言都没啥差别,
以可维护性 可读性为差别的标准
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
 楼主| 发表于 2019-1-21 13:28:29 | 显示全部楼层
mathematica 发表于 2018-7-25 17:26
Groupings,{Plus,Subtract,Times,Divide}->2,HoldForm]
这个{Plus,Subtract,Times,Divide}->2是什么 ...

@chyanog
下面两个计算结果不一样,一个长度是1170,一个长度是1192
  1. (*为什么两个结果不一样呢*)
  2. Clear["Global`*"];
  3. aa=Groupings[Permutations[{a,b,c,d},{4}],{Plus->{2,Orderless},Subtract->2,Times->{2,Orderless},Divide->2},HoldForm];
  4. (*下面的结果是1170*)
  5. bb=Union[Together@FullSimplify[ReleaseHold[#]]&/@aa]//Length
  6. (*下面的结果是1192*)
  7. cc=Union[FullSimplify[ReleaseHold[#]]&/@aa]//Length
复制代码


正确结果应该是1170,为什么呢?
看下面的代码,用无理数带进去,最后结果长度是1170
  1. Clear["Global`*"];
  2. aa=Groupings[Permutations[{a,b,c,d},{4}],{Plus->{2,Orderless},Subtract->2,Times->{2,Orderless},Divide->2},HoldForm];
  3. bb=FullSimplify[ReleaseHold[#]]&/@aa;
  4. (*带入四个无理数,乘以10^8,然后高精度计算,如果表达式不相等,那么计算结果很难相等*)
  5. cc=IntegerPart[N[10^8*#,100]]&/@(bb/.Thread[{a,b,c,d}->{EulerGamma,Pi,E,Sqrt[2]}]);
  6. dd=Union@cc
  7. Length@dd
复制代码
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
您需要登录后才可以回帖 登录 | 欢迎注册

本版积分规则

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

GMT+8, 2019-7-22 11:12 , Processed in 0.078582 second(s), 28 queries .

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

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