如今回头看,这真的不是一个难题
mathematica 发表于 2018-7-25 15:07
如今回头看,这真的不是一个难题
Clear["Global`*"];(*Clear all variables*)
abcd={"a","b","c","d"}
pers=Permutations@abcd
mark=Tuples[{"+","-","*","/"},{3}]
(*函数,给出一个{"a","b","c","d"} 给出所有排列,返回结果的元素是"a*b+c-d"这种*)
fun:=StringJoin[#]&/@(Riffle&/@mark)
mylist={
{"((a","b)","c)","d"},
{"(a","b)","(c","d)"},
{"a","(b","c)","d"},
{"a","((b","c)","d)"},
{"a","(b","(c","d))"}
}
(*abcd顺序不变,得到所有的可能情况*)
out=Flatten&/@mylist]
(*函数,对于一个字符串"a*b+c/d",得到所有的顺序可以改变的字符串列表*)
strall:=StringReplace]&/@pers
sol=Flatten&/@out]
暴力求解,列举出所有可能的情况
本帖最后由 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",
为了节省篇幅,仅仅列举出一部分结果
所有结果放在附件里面
mathematica 发表于 2018-7-25 16:40
暴力求解,列举出所有可能的情况
Groupings,{Plus,Subtract,Times,Divide}->2,HoldForm]
这个{Plus,Subtract,Times,Divide}->2是什么意思?
所有可能的表达式有7680种，去重后有1170种。这个1170怎么得到的?
mathematica 发表于 2018-7-25 17:26
Groupings,{Plus,Subtract,Times,Divide}->2,HoldForm]
这个{Plus,Subtract,Times,Divide}->2是什么 ...
#算24点程序
use strict;use warnings;use diagnostics;
my $a=9;
my $b=5;
my $c=2;
my $d=7;
#利用穷举法,列出abcd四个变量之间所有的各种排列
&cacu($a,$b,$c,$d);
&cacu($a,$b,$d,$c);
&cacu($a,$c,$b,$d);
&cacu($a,$c,$d,$b);
&cacu($a,$d,$b,$c);
&cacu($a,$d,$c,$b);
&cacu($b,$a,$c,$d);
&cacu($b,$a,$d,$c);
&cacu($b,$c,$a,$d);
&cacu($b,$c,$d,$a);
&cacu($b,$d,$a,$c);
&cacu($b,$d,$c,$a);
&cacu($c,$a,$b,$d);
&cacu($c,$a,$d,$b);
&cacu($c,$b,$a,$d);
&cacu($c,$b,$d,$a);
&cacu($c,$d,$a,$b);
&cacu($c,$d,$b,$a);
&cacu($d,$a,$b,$c);
&cacu($d,$a,$c,$b);
&cacu($d,$b,$a,$c);
&cacu($d,$b,$c,$a);
&cacu($d,$c,$a,$b);
&cacu($d,$c,$b,$a);
#子函数,利用三重循环计算abcd位置不变的时候的所有可能,
#四个数之间只可能有三种运算符,加括号只可能有五种可能.
sub cacu
{
my ($a,$b,$c,$d)=@_;
my @op=("+","-","*","/");#运算符数组
foreach my $x (@op)#第一个运算符
{
foreach my $y (@op)#第二个运算符
{
foreach my $z (@op)#第三个运算符
{
my $str1="(($a$x$b)$y$c)$z$d";
my $str2="($a$x$b)$y($c$z$d)";
my $str3="($a$x($b$y$c))$z$d";
my $str4="$a$x(($b$y$c)$z$d)";
my $str5="$a$x($b$y($c$z$d))";
if(abs(eval($str1)-24)<0.000001){print $str1 . "=24\n";}
if(abs(eval($str2)-24)<0.000001){print $str2 . "=24\n";}
if(abs(eval($str3)-24)<0.000001){print $str3 . "=24\n";}
if(abs(eval($str4)-24)<0.000001){print $str4 . "=24\n";}
if(abs(eval($str5)-24)<0.000001){print $str5 . "=24\n";}
}
}
}
}
贴一下我的perl代码,居然在分母等于零的时候也能运行,我真佩服perl,
代码写起来真爽!
perl太牛逼了
本帖最后由 chyanog 于 2018-7-27 15:25 编辑
chyanog 发表于 2013-6-25 12:11
((1+2)+3)*4=24
(1+(2+3))*4=24
不用字符串，不考虑去重
Clear["`*"];
calc24 :=
Cases[
Tuples[{Tuples[{Plus, Subtract, Times, Divide}, 3], Permutations}] /.
{{o1_, o2_, o3_}, {a_, b_, c_, d_}} ->
HoldForm /@ {
a~o1~b~o2~c~o3~d,
(a~o1~b)~o2~(c~o3~d),
(a~o1~(b~o2~c))~o3~d,
a~o1~(b~o2~(c~o3~d)),
a~o1~((b~o2~c)~o3~d)
},
e_ /; ReleaseHold@e == 24, {2}
] // Quiet;
calc24[{2, 3, 5, 7}]
考虑去重
Clear["`*"];
calc24 :=
Groupings, {Plus -> {2, Orderless}, Subtract -> 2, Times -> {2, Orderless}, Divide -> 2}, HoldForm] //
DeleteDuplicatesBy //
ReplaceAll] //
DeleteDuplicates //
Pick[#, ReleaseHold@# /. ComplexInfinity -> 0, 24] & //
Quiet;
calc24[{2, 3, 5, 7}]
chyanog 发表于 2018-7-27 15:22
不用字符串，不考虑去重
考虑去重
我想写一个穷举法列举出所有的不重的表达式a+b+c*d这种的,
对应的mathematica代码是?
chyanog 发表于 2018-7-27 15:22
不用字符串，不考虑去重
考虑去重
其实如果代码都在1秒之内执行完毕,
任何语言都没啥差别,
以可维护性 可读性为差别的标准
mathematica 发表于 2018-7-25 17:26
Groupings,{Plus,Subtract,Times,Divide}->2,HoldForm]
这个{Plus,Subtract,Times,Divide}->2是什么 ...
@chyanog
下面两个计算结果不一样，一个长度是1170，一个长度是1192
(*为什么两个结果不一样呢*)
Clear["Global`*"];
aa=Groupings,{Plus->{2,Orderless},Subtract->2,Times->{2,Orderless},Divide->2},HoldForm];
(*下面的结果是1170*)
bb=Union]&/@aa]//Length
(*下面的结果是1192*)
cc=Union]&/@aa]//Length
正确结果应该是1170，为什么呢？
看下面的代码，用无理数带进去，最后结果长度是1170
Clear["Global`*"];
aa=Groupings,{Plus->{2,Orderless},Subtract->2,Times->{2,Orderless},Divide->2},HoldForm];
bb=FullSimplify]&/@aa;
(*带入四个无理数，乘以10^8,然后高精度计算，如果表达式不相等，那么计算结果很难相等*)
cc=IntegerPart]&/@(bb/.Thread[{a,b,c,d}->{EulerGamma,Pi,E,Sqrt}]);
dd=Union@cc
Length@dd
mathematica 发表于 2019-1-21 13:28
@chyanog
下面两个计算结果不一样，一个长度是1170，一个长度是1192
同样的union函数，为什么结果不一样呢？