The syntax for a pure function is something like (1+#1+#2)&[a,b], which gives 1+a+b. Now I want to supply the output from some function which looks like {a,b} to the function above, i.e., something like (1+#1+#2)&{a,b}, but with the correct syntax, as that obviously doesn't work. How do I go about doing this?
The easiest approach is to use Apply (##):
In[4]:= (1 + #1 + #2) & ## {a, b}
Out[4]= 1 + a + b
To provide some alternatives, you can also include the Apply within the function if that is more convenient:
f = (1 + # + #2) & ## # &;
f # {a, b}
1 + a + b
Optionally, you can index parts manually:
f = (1 + #[[1]] + #[[2]]) &;
Finally, you may already know this, but for others reading this question:
g[{x_, y_}] := 1 + x + y
g # {a, b}
1 + a + b
Here's a version that is an ordinary function (ie can use square brackets) that will take an arbitrary list. The Apply has been moved inside the function and the ## means SlotSequence (c.f. _ and __ in pattern matching)
In[1]:= (1 + ##&## #) &[{a, b}]
(1 + ##&## #) &[{a, b, c, d, e}]
Out[1]= 1 + a + b
Out[2]= 1 + a + b + c + d + e
Related
I am attempting a problem that can be solved with MUC (method of undetermined coefficients).
However, when I use the Solve function, it gives an error.
y[x_] := a x^3 + b x^2 + c x + d
Solve[{y''[x] + 2 y'[x] + y[x] == x^3}, {a, b, c, d}]
[ERROR]:
Solve::svars: Equations may not give solutions for all "solve" variables.
Shouldn't this solve for all variables in the set?
Thank You for your help :)
Looks like some extra methodology is needed for this.
As you stated, a function with the finite family of derivatives for x^3 is
y[x_] := a x^3 + b x^2 + c x + d
Equating coefficients
sol = Solve[Thread[CoefficientList[
y''[x] + 2 y'[x] + y[x], x] == CoefficientList[x^3, x]]]
{{a -> 1, b -> -6, c -> 18, d -> -24}}
Checking the results
FullSimplify[y''[x] + 2 y'[x] + y[x] == x^3 /. sol]
{True}
I have this expression in Mathematica:
(a^2 (alpha + beta)^2)/(b^2 + c^2) + (a (alpha + beta))/(b^2 + c^2) + 1
As you can see, the expression has a couple of subexpressions that repeat throughout it.
I want to be able to replace a/(b^2+c^2) with d and alpha+beta with gamma.
The final expression should then be:
1+d*gamma+a*d*gamma^2
I have much more complicated expressions where being able to do this would greatly simplify my work.
I have tried Googling this question, and I only find answers that use FactorTerms and ReplaceRepeated, but do not work consistently and for a more complicated expression like this one. I am hoping that someone here has the answer.
The hard part for the case at hand is the rule for d. Perhaps, there are simpler ways to do it, but one way is to expand the powers to products, to make it work. Let's say this is your expression:
expr = (a^2 (alpha + beta)^2)/(b^2 + c^2) + (a (alpha + beta))/(b^2 + c^2) + 1
and these are the rules one would naively write:
rules = {a/(b^2 + c^2) -> d, alpha + beta -> gamma}
What we would like to do now is to expand powers to products, in both expr and rules. The problem is that even if we do, they will auto-evaluate back to powers. To prevent that, we'll need to wrap them into, for example, Hold. Here is a function which will help us:
Clear[withExpandedPowers];
withExpandedPowers[expr_, f_: Hold] :=
Module[{times},
Apply[f,
Hold[expr] /. x_^(n_Integer?Positive) :>
With[{eval = times ## Table[x, {n}]}, eval /; True] /.
times -> Times //.
HoldPattern[Times[left___, Times[middle__], right___]] :>
Times[left, middle, right]]];
For example:
In[39]:= withExpandedPowers[expr]
Out[39]= Hold[1+(a (alpha+beta))/(b b+c c)+((alpha+beta) (alpha+beta) a a)/(b b+c c)]
The following will then do the job:
In[40]:=
ReleaseHold[
withExpandedPowers[expr] //.
withExpandedPowers[Map[MapAt[HoldPattern, #, 1] &, rules], Identity]]
Out[40]= 1 + d gamma + a d gamma^2
We had to additionally wrap the l.h.s. of rules in HoldPattern, to prevent products from collapsing back to powers there.
This is just one case where we had to fight the auto-simplification mechanism of Mathematica, but for this sort of problems this will be the main obstacle. I can't assess how robust this will be for larger and more complex expressions.
Using ReplaceRepeated:
(a^2 (alpha + beta)^2)/(b^2 + c^2) + (a (alpha + beta))/(b^2 + c^2) +
1 //. {a/(b^2 + c^2) -> d, alpha + beta -> gamma}
Or using TransformationFunctions:
FullSimplify[(a^2 (alpha + beta)^2)/(b^2 +
c^2) + (a (alpha + beta))/(b^2 + c^2) + 1,
TransformationFunctions -> {Automatic, # /.
a/(b^2 + c^2) -> d &, # /. alpha + beta -> gamma &}]
Both give:
1 + gamma (d + (a^2 gamma)/(b^2 + c^2))
I modestly --- I am not a computer scientist --- think this is simpler than all other proposed solutions
1+a(alpha+beta)/(b^2 + c^2) +a^2(alpha+beta)^2/(b^2 + c^2) \\.
{a^2-> a z, a/(b^2 + c^2)-> d,alpha+\beta -> gamma,z-> a}
How do I tell mathematica to do this replacement smartly? (or how do I get smarter at telling mathematica to do what i want)
expr = b + c d + ec + 2 a;
expr /. a + b :> 1
Out = 2 a + b + c d + ec
I expect the answer to be a + cd + ec + 1. And before someone suggests, I don't want to do a :> 1 - b, because for aesthetic purposes, I'd like to have both a and b in my equation as long as the a+b = 1 simplification cannot be made.
In addition, how do I get it to replace all instances of 1-b, -b+1 or -1+b, b-1 with a or -a respectively and vice versa?
Here's an example for this part:
expr = b + c (1 - a) + (-1 + b)(a - 1) + (1 -a -b) d + 2 a
You can use a customised version of FullSimplify by supplying your own transformations to FullSimplify and let it figure out the details:
In[1]:= MySimplify[expr_,equivs_]:= FullSimplify[expr,
TransformationFunctions ->
Prepend[
Function[x,x-#]&/#Flatten#Map[{#,-#}&,equivs/.Equal->Subtract],
Automatic
]
]
In[2]:= MySimplify[2a+b+c*d+e*c, {a+b==1}]
Out[2]= a + c(d + e) + 1
equivs/.Equal->Subtract turns given equations into expressions equal to zero (e.g. a+b==1 -> a+b-1). Flatten#Map[{#,-#}&, ] then constructs also negated versions and flattens them into a single list. Function[x,x-#]& /# turns the zero expressions into functions, which subtract the zero expressions (the #) from what is later given to them (x) by FullSimplify.
It may be necessary to specify your own ComplexityFunction for FullSimplify, too, if your idea of simple differs from FullSimplify's default ComplexityFunction (which is roughly equivalent to LeafCount), e.g.:
MySimplify[expr_, equivs_] := FullSimplify[expr,
TransformationFunctions ->
Prepend[
Function[x,x-#]&/#Flatten#Map[{#,-#}&,equivs/.Equal->Subtract],
Automatic
],
ComplexityFunction -> (
1000 LeafCount[#] +
Composition[
Total,Flatten,Map[ArrayDepth[#]#&,#]&,CoefficientArrays
][#] &
)
]
In your example case, the default ComplexityFunction works fine, though.
For the first case, you might consider:
expr = b + c d + ec + 2 a
PolynomialReduce[expr, {a + b - 1}, {b, a}][[2]]
For the second case, consider:
expr = b + c (1 - a) + (-1 + b) (a - 1) + (1 - a - b) d + 2 a;
PolynomialReduce[expr, {x + b - 1}][[2]]
(% /. x -> 1 - b) == expr // Simplify
and:
PolynomialReduce[expr, {a + b - 1}][[2]]
Simplify[% == expr /. a -> 1 - b]
I have the following expression
(-1 + 1/p)^B/(-1 + (-1 + 1/p)^(A + B))
How can I multiply both the denominator and numberator by p^(A+B), i.e. to get rid of the denominators in both numerator and denominator? I tried varous Expand, Factor, Simplify etc. but none of them worked.
Thanks!
I must say I did not understand the original question. However, while trying to understand the intriguing solution given by belisarius I came up with the following:
expr = (-1 + 1/p)^B/(-1 + (-1 + 1/p)^(A + B));
Together#(PowerExpand#FunctionExpand#Numerator#expr/
PowerExpand#FunctionExpand#Denominator#expr)
Output (as given by belisarius):
Alternatively:
PowerExpand#FunctionExpand#Numerator#expr/PowerExpand#
FunctionExpand#Denominator#expr
gives
or
FunctionExpand#Numerator#expr/FunctionExpand#Denominator#expr
Thanks to belisarius for another nice lesson in the power of Mma.
If I understand you question, you may teach Mma some algebra:
r = {(k__ + Power[a_, b_]) Power[c_, b_] -> (k Power[c, b] + Power[a c, b]),
p_^(a_ + b_) q_^a_ -> p^b ( q p)^(a),
(a_ + b_) c_ -> (a c + b c)
}
and then define
s1 = ((-1 + 1/p)^B/(-1 + (-1 + 1/p)^(A + B)))
f[a_, c_] := (Numerator[a ] c //. r)/(Denominator[a ] c //. r)
So that
f[s1, p^(A + B)]
is
((1 - p)^B*p^A)/((1 - p)^(A + B) - p^(A + B))
Simplify should work, but in your case it doesn't make sense to multiply numerator and denominator by p^(A+B), it doesn't cancel denominators
So lately I have been toying around with how Mathematica's pattern matching and term rewriting might be put to good use in compiler optimizations...trying to highly optimize short blocks of code that are the inner parts of loops. Two common ways to reduce the amount of work it takes to evaluate an expression is to identify sub-expressions that occur more than once and store the result and then use the stored result at subsequent points to save work. Another approach is to use cheaper operations where possible. For instance, my understanding is that taking square roots take more clock cycles than additions and multiplications. To be clear, I am interested in the cost in terms of floating point operations that evaluating the expression would take, not how long it takes Mathematica to evaluate it.
My first thought was that I would tackle the problem developing using Mathematica's simplify function. It is possible to specify a complexity function that compares the relative simplicity of two expressions. I was going to create one using weights for the relevant arithmetic operations and add to this the LeafCount for the expression to account for the assignment operations that are required. That addresses the reduction in strength side, but it is the elimination of common subexpressions that has me tripped up.
I was thinking of adding common subexpression elimination to the possible transformation functions that simplify uses. But for a large expression there could be many possible subexpressions that could be replaced and it won't be possible to know what they are till you see the expression. I have written a function that gives the possible substitutions, but it seems like the transformation function you specify needs to just return a single possible transformation, at least from the examples in the documentation. Any thoughts on how one might get around this limitation? Does anyone have a better idea of how simplify uses transformation functions that might hint at a direction forward?
I imagine that behind the scenes that Simplify is doing some dynamic programming trying different simplifications on different parts of the expressions and returning the one with the lowest complexity score. Would I be better off trying to do this dynamic programming on my own using common algebraic simplifications such as factor and collect?
EDIT: I added the code that generates possible sub-expressions to remove
(*traverses entire expression tree storing each node*)
AllSubExpressions[x_, accum_] := Module[{result, i, len},
len = Length[x];
result = Append[accum, x];
If[LeafCount[x] > 1,
For[i = 1, i <= len, i++,
result = ToSubExpressions2[x[[i]], result];
];
];
Return[Sort[result, LeafCount[#1] > LeafCount[#2] &]]
]
CommonSubExpressions[statements_] := Module[{common, subexpressions},
subexpressions = AllSubExpressions[statements, {}];
(*get the unique set of sub expressions*)
common = DeleteDuplicates[subexpressions];
(*remove constants from the list*)
common = Select[common, LeafCount[#] > 1 &];
(*only keep subexpressions that occur more than once*)
common = Select[common, Count[subexpressions, #] > 1 &];
(*output the list of possible subexpressions to replace with the \
number of occurrences*)
Return[common];
]
Once a common sub-expression is chosen from the list returned by CommonSubExpressions the function that does the replacement is below.
eliminateCSE[statements_, expr_] := Module[{temp},
temp = Unique["r"];
Prepend[ReplaceAll[statements, expr -> temp], temp[expr]]
]
At the risk of this question getting long, I will put a little example code up. I thought a decent expression to try to optimize would be the classical Runge-Kutta method for solving differential equations.
Input:
nextY=statements[y + 1/6 h (f[t, n] + 2 f[0.5 h + t, y + 0.5 h f[t, n]] +
2 f[0.5 h + t, y + 0.5 h f[0.5 h + t, y + 0.5 h f[t, n]]] +
f[h + t,
y + h f[0.5 h + t, y + 0.5 h f[0.5 h + t, y + 0.5 h f[t, n]]]])];
possibleTransformations=CommonSubExpressions[nextY]
transformed=eliminateCSE[nextY, First[possibleTransformations]]
Output:
{f[0.5 h + t, y + 0.5 h f[0.5 h + t, y + 0.5 h f[t, n]]],
y + 0.5 h f[0.5 h + t, y + 0.5 h f[t, n]],
0.5 h f[0.5 h + t, y + 0.5 h f[t, n]],
f[0.5 h + t, y + 0.5 h f[t, n]], y + 0.5 h f[t, n], 0.5 h f[t, n],
0.5 h + t, f[t, n], 0.5 h}
statements[r1[f[0.5 h + t, y + 0.5 h f[0.5 h + t, y + 0.5 h f[t, n]]]],
y + 1/6 h (2 r1 + f[t, n] + 2 f[0.5 h + t, y + 0.5 h f[t, n]] +
f[h + t, h r1 + y])]
Finally, the code to judge the relative cost of different expressions is below. The weights are conceptual at this point as that is still an area I am researching.
Input:
cost[e_] :=
Total[MapThread[
Count[e, #1, Infinity, Heads -> True]*#2 &, {{Plus, Times, Sqrt,
f}, {1, 2, 5, 10}}]]
cost[transformed]
Output:
100
There are also some routines here implemented here by this author: http://stoney.sb.org/wordpress/2009/06/converting-symbolic-mathematica-expressions-to-c-code/
I packaged it into a *.M file and have fixed a bug (if the expression has no repeated subexpressions the it dies), and I am trying to find the author's contact info to see if I can upload his modified code to pastebin or wherever.
EDIT: I have received permission from the author to upload it and have pasted it here: http://pastebin.com/fjYiR0B3
To identify repeating subexpressions, you could use something like this
(*helper functions to add Dictionary-like functionality*)
index[downvalue_,
dict_] := (downvalue[[1]] /. HoldPattern[dict[x_]] -> x) //
ReleaseHold;
value[downvalue_] := downvalue[[-1]];
indices[dict_] :=
Map[#[[1]] /. {HoldPattern[dict[x_]] -> x} &, DownValues[dict]] //
ReleaseHold;
values[dict_] := Map[#[[-1]] &, DownValues[dict]];
items[dict_] := Map[{index[#, dict], value[#]} &, DownValues[dict]];
indexQ[dict_, index_] :=
If[MatchQ[dict[index], HoldPattern[dict[index]]], False, True];
(*count number of times each sub-expressions occurs *)
expr = Cos[x + Cos[Cos[x] + Sin[x]]] + Cos[Cos[x] + Sin[x]];
Map[(counts[#] = If[indexQ[counts, #], counts[#] + 1, 1]; #) &, expr,
Infinity];
items[counts] // Column
I tried to mimic the dictionary compression function appears on this blog: https://writings.stephenwolfram.com/2018/11/logic-explainability-and-the-future-of-understanding/
Here is what I made:
DictionaryCompress[expr_, count_, size_, func_] := Module[
{t, s, rule, rule1, rule2},
t = Tally#Level[expr, Depth[expr]];
s = Sort[
Select[{First##, Last##, Depth[First##]} & /#
t, (#[[2]] > count && #[[3]] > size) &], #1[[2]]*#1[[3]] < #2[[
2]]*#2[[2]] &];
rule = MapIndexed[First[#1] -> func ## #2 &, s];
rule = (# //. Cases[rule, Except[#]]) & /# rule;
rule1 = Select[rule, ! FreeQ[#, Plus] &];
rule2 = Complement[rule, rule1];
rule = rule1 //. (Reverse /# rule2);
rule = rule /. MapIndexed[ Last[#1] -> func ## #2 &, rule];
{
expr //. rule,
Reverse /# rule
}
];
poly = Sum[Subscript[c, k] x^k, {k, 0, 4}];
sol = Solve[poly == 0, x];
expr = x /. sol;
Column[{Column[
MapIndexed[
Style[TraditionalForm[Subscript[x, First[#2]] == #], 20] &, #[[
1]]], Spacings -> 1],
Column[Style[#, 20] & /# #[[2]], Spacings -> 1, Frame -> All]
}] &#DictionaryCompress[expr, 1, 1,
Framed[#, Background -> LightYellow] &]