Based on Vladimirs solution I wanted to post a faster alternative to SimplifyCount which produces the same results as SimplifyCount, but is a factor 3 faster. This can be very significant in case of complicated functions, it is however still significantly slower then Automatic.
myNumberComplexity[x_Integer] :=
If[Positive[x], IntegerLength[x] - 1, IntegerLength[x]]
myNumberComplexity[x_Real] := 1;
myNumberComplexity[x_Rational] :=
myNumberComplexity[Numerator[x]] + myNumberComplexity[Denominator[x]]
myNumberComplexity[x_Complex] :=
myNumberComplexity[Re[x]] + myNumberComplexity[Im[x]]
myNumberComplexity[x_] := 0;
myComplexityFunctionNC[x_] :=
LeafCount[x] + Plus @@ myNumberComplexity /@ Level[x, {-1}]
It is also possible to increase the speed of SimplifyCount
by a factor of two by replacing the sum of the two If
s after hd===Integer
with just this If[Positive[p], IntegerLength[p], IntegerLength[p] + 1]
.
I must however say that I have my doubts that SimplifyCount is still exactly what is being done in (Full-)Simplify. I have an example were SimplifyCount (or my alternateive) does not produce the same as Automatic.
Here the example (which might take a full day (!) with SimplifyCount):
$Assumptions = {{a, b, m, s, q, k, x, y, x0, x1, x2, x3,
X} \[Element] Reals , s > 0, b > 0, a > 0};
kuskgaus0b[a_, b_, m_, s_] :=
ProbabilityDistribution[(b*Sqrt[Gamma[3/b]/Gamma[b^(-1)]]*
Piecewise[{{Gamma[
b^(-1), ((a*(-\[FormalX] + m)*
Sqrt[Gamma[3/b]/Gamma[b^(-1)]])/s)^b]/(2*
Gamma[b^(-1)]), a*(\[FormalX] - m) <= 0}},
1 - Gamma[
b^(-1), ((a*(\[FormalX] - m)*Sqrt[Gamma[3/b]/Gamma[b^(-1)]])/
s)^b]/(2*
Gamma[b^(-1)])])/(E^(((\[FormalX] - m)^2*Gamma[3/b])/(s^2*
Gamma[b^(-1)]))^(b/2)*s*
Gamma[b^(-1)]), {\[FormalX], -Infinity, Infinity}]
D[PDF[kuskgaus0b[a, b, 0, 1], x]*x, b] /. b -> 2;
FullSimplify[%, ComplexityFunction -> Automatic] // AbsoluteTiming
And here the result with Automatic
:
Piecewise[
{{(x*(Sqrt[2]*a*x*(-3 + EulerGamma + Log[2] + 2*Log[a*x]) + E^((a^2*x^2)/2)*(Sqrt[Pi]*(-2*(1 + x^2*(-3 + EulerGamma + Log[2]) + 2*x^2*Log[x]) +
Erfc[(a*x)/Sqrt[2]]*(1 + EulerGamma*(1 + x^2) + x^2*(-3 + Log[2]) + Log[2] + 2*x^2*Log[x] + 2*Log[a*x])) + MeijerG[{{}, {1, 1}}, {{0, 0, 1/2}, {}},
(a^2*x^2)/2])))/(4*Sqrt[2]*E^(((1 + a^2)*x^2)/2)*Pi), x > 0}},
(x*(a*x*(-6 + 2*EulerGamma + Log[4*a^4*x^4]) - Sqrt[2]*E^((a^2*x^2)/2)*(Sqrt[Pi]*(1 + Erf[(a*x)/Sqrt[2]])*(1 + EulerGamma + (-3 + EulerGamma)*x^2 + x^2*Log[2*x^2] +
Log[2*a^2*x^2]) + MeijerG[{{}, {1, 1}}, {{0, 0, 1/2}, {}}, (a^2*x^2)/2])))/(8*E^(((1 + a^2)*x^2)/2)*Pi)]
And now with SimplifyCount
:
Piecewise[{{ComplexInfinity, x == 0},
{(x*(Sqrt[2]*a*x*(-3 + EulerGamma + Log[2] + 2*Log[a*x]) - E^((a^2*x^2)/2)*(-2*Sqrt[2]*a*x*HypergeometricPFQ[{1/2, 1/2}, {3/2, 3/2}, -(a^2*x^2)/2] +
Sqrt[Pi]*x^2*(1 + Erf[(a*x)/Sqrt[2]])*(-3 + EulerGamma + Log[2] + 2*Log[x]) + Sqrt[Pi]*(1 + Erf[(a*x)/Sqrt[2]]*(1 + EulerGamma + Log[2] + 2*Log[a*x])))))/
(4*Sqrt[2]*E^(((1 + a^2)*x^2)/2)*Pi), x > 0}},
(x*(E^((a^2*x^2)/2)*(4*a*x*HypergeometricPFQ[{1/2, 1/2}, {3/2, 3/2}, -(a^2*x^2)/2] - Sqrt[2*Pi]*(1 + (-3 + EulerGamma)*x^2 + x^2*Log[2*x^2] +
Erf[(a*x)/Sqrt[2]]*(1 + EulerGamma + (-3 + EulerGamma)*x^2 + x^2*Log[2*x^2] + Log[2*a^2*x^2]))) + a*x*(-6 + 2*EulerGamma + Log[4*a^4*x^4])))/
(8*E^(((1 + a^2)*x^2)/2)*Pi)]
The differences are the additional Infinity at 0, and the change from MeijerG
to HypergeometricPFQ
.
ComplexityFunction
reference.wolfram.com/mathematica/ref/ComplexityFunction.html It is the first item under Properties and Relations. $\endgroup$ – bill s May 31 '13 at 5:26