14
$\begingroup$

Consider this given example for ReplaceAll

1 + x^2 + x^4 /. x^p_ -> f[p]

This returns 1+f[2]+f[4] - works good (!). But if you choose

 In[175]:= 1 +x+ x^2 + x^4 /. x^p_ -> f[p]
 Out[175]= 1+x+f[2]+f[4]

It doesn't not work for 1 and x. The correct output should be f[0]+f[1]+f[2]+f[4].

What is wrong here and to cure it?

EDIT

Possible way out

One possible way out can be to not use ReplaceAll (inspired by @eldo). The coefficient and the power of x can be combined in this way:

fun[x] = a - b x + c x^2 + d x^4
nfun = Exponent[fun[x], x];
Sum[Coefficient[fun[x], x, i] f[i], {i, 0, nfun}]

And the result is a f[0] - b f[1] + c f[2] + d f[4].

However the replace rule for $x^0$ is still a mystery!

$\endgroup$
8
  • 3
    $\begingroup$ 1 does not match x^0 but To obtain f[1], write 1 + x + x^2 + x^4 /. x^p_. :> f[p] notice the p_. pattern. This now returns 1 + f[1] + f[2] + f[4] see reference.wolfram.com/mathematica/guide/Patterns.html $\endgroup$
    – Nasser
    Jun 26, 2014 at 9:51
  • $\begingroup$ Thanks @Nasser (specially for the information about patterns). But I would be still interested to know if there is any way to do it with Replace for 1. $\endgroup$
    – Sumit
    Jun 26, 2014 at 10:15
  • $\begingroup$ possible duplicate of How do I replace a variable in a polynomial? $\endgroup$
    – Artes
    Jun 26, 2014 at 10:51
  • 1
    $\begingroup$ I don't think so @Artes. The problem is not with the replacement in general but with power 0 and 1. Even if you consider your own answer in the referrence z^4 + z^2 + 4 /. z^(a_Integer) -> x^(1/2 a) and use 1 + z + z^2 /. z^(a_Integer) -> f[a], you can see it doesn't work for 1 and z, and that is exactly where my question is. $\endgroup$
    – Sumit
    Jun 26, 2014 at 11:37
  • $\begingroup$ thanks @bobthechemist. This is fine. The earlier title was probably a bit misleading for quick glance. $\endgroup$
    – Sumit
    Jun 26, 2014 at 13:58

9 Answers 9

6
$\begingroup$

It would be cumbersome with ReplaceAll. I suggest to use Exponent instead:

Plus @@ (f /@ Exponent[1 + x + x^2 + x^4, x, List])

f[0] + f[1] + f[2] + f[4]

Considering Öska's objection

Alternating signs are not easily handled, maybe something like this:

fun1 = 1 - x - x^2 + x^4;
fun2 = List @@ fun1;

minus = Position[fun2, Times[-1, __]] // Flatten;
plus = Complement[Range@Length@fun2, minus];

fun3 = (f /@ Exponent[fun1, x, List]);

Plus @@ Join[Part[fun3, plus], Part[fun3, minus] /. a_ :> -a]

f[0] - f[1] - f[2] + f[4]

ADDENDUM

This can be shortened to:

 Plus @@ (D[#, x] & /@ MonomialList@fun1 /. Times[a_?NumberQ, __] :> a /. 
    a_?NumberQ :> f[Abs@a]*Sign@a /. (0) -> f@0*First@fun1)

f[0] - f[1] - f[2] + f[4]

$\endgroup$
2
  • $\begingroup$ What if one has 1 + x - x^2 + x^4? Using Plus is a wrong IMO. $\endgroup$
    – Öskå
    Jun 26, 2014 at 10:16
  • $\begingroup$ Can it be generalised for a series like Sum[a[n]x^n,{n,0,3}]? One hard way would be to find the individual Coefficient and then combine with Exponent. I wonder if there is any less complex way! $\endgroup$
    – Sumit
    Jun 26, 2014 at 10:27
6
$\begingroup$

Here's a set of replacements that works on the following test cases:

test1 = 1 + x + x^2 + x^4;
test2 = 2 + x - x^2 + x^4;
test3 = -2 - x + x^2 - x^4;
test4 = -2 - x - x^2 - x^4;
rules = {
   (* For x^0 *)
   n_?NumberQ :> If[n > 0, 1, -1] f[0],
   (* For  positive x^1 *)
   n_ /; Head[n] == Symbol :> f[1],
   (* for positive x^n *)
   n_^p_ :> f[p],
   (* For negative x^1 or x^n *)
   n_ /; Head[n] == Times :> (
     Replace[n, {m_ /; Head[m] == Symbol :> f[1], m_^p_ :> f[p]}, 1]
     )
   };

Replace[#, rules, 1] & /@ {test1, test2, test3, test4} // Column

(* {f[0] + f[1] + f[2] + f[4],
f[0] + f[1] - f[2] + f[4], 
-f[0] - f[1] + f[2] - f[4], 
-f[0] - f[1] - f[2] - f[4]} *)

The rules are desgined based on the observation that Head[n_] will be Times if there is a negative sign in front of x.

Head /@ # & /@ {test1, test2, test3, test4}
(* 
{Integer + 2 Power + Symbol, 
Integer + Power + Symbol + Times,
Integer + Power + 2 Times, 
Integer + 3 Times} 
*)

Therefore, I want to develop one rule for the ^0 case and two rules for the x^ cases. The way I've done this is to take a nested replacement approach so that I can call the replacement only once if the coefficient is positive and twice if the coefficient is negative. I don't think I can figure out a solution using ReplaceAll.

$\endgroup$
4
  • $\begingroup$ What about 2 + x - x^2 + x^4 ?. Gives me 2 + f[1] - f[2] + f[4] $\endgroup$
    – eldo
    Jun 26, 2014 at 13:27
  • $\begingroup$ @eldo right, thinking.... $\endgroup$ Jun 26, 2014 at 13:33
  • $\begingroup$ I think you could append /. f[0] -> f[0]*First@test1 to test1 /. rules to account for the negative case. $\endgroup$
    – eldo
    Jun 26, 2014 at 14:46
  • $\begingroup$ @eldo I tried a different (clunkier?) approach that seems to work. $\endgroup$ Jun 26, 2014 at 15:23
6
$\begingroup$

If only one (or perhaps two) variables are involved, and the expression is polynomial therein and of modest degree, then it's straightforward to do this with CoefficientList and Dot as in the example below.

With[{cc = CoefficientList[1 + x^2 + x^4, x]}, 
 cc.Thread[f[Range[0, Length[cc] - 1]]]]

(* Out[357]= f[0] + f[2] + f[4] *)
$\endgroup$
5
$\begingroup$

Hopefully I don't misunderstand, but I think this does what you request:

1 + x + x^2 + x^4 /. {x^p_. :> f[p], 1 :> f[0]}
f[0] + f[1] + f[2] + f[4]

The use of Optional handles the case of x, but since x is not present in 1 we need an additional rule for that. Please also note the use of RuleDelayed to correctly localize p.

If you allow modification of the function f itself we could establish:

f[] = f[0];

Then:

1 + x + x^2 + x^4 /. x^p_. | 1 :> f[p]
f[0] + f[1] + f[2] + f[4]

This works via vanishing patterns.

$\endgroup$
1
  • $\begingroup$ the simplicity of the '.'...and delay $\endgroup$
    – ubpdqn
    Jun 27, 2014 at 7:48
4
$\begingroup$

Just for variety:

fun[poly_] := Total[f[First@#1] #2 & @@@ CoefficientRules[poly]]

Some test cases:

test = {1 + x + x^2 + x^4, 1 - x - x^2, 1 + 2 x + 3 x^3}

yields:

Grid[{#, fun@#} & /@ test, Frame -> All, Alignment -> Left]

enter image description here

I just note this answer is consistent with others, e.g Daniel Lichtblau. However, OP wanted 1+x^2+x^4->1+f[2]+f[4]...

$\endgroup$
1
  • $\begingroup$ In my humble opinion one of the best answer so far. The OP wanted exactly this. Don't understand your "However..." $\endgroup$
    – eldo
    Jun 27, 2014 at 0:01
3
$\begingroup$

A rule for $x^0$ will never be applied if x^_ is not there in the original equation.

(Note: You can do this for $x^1$: 4 - 3 x + 2 x^2 - x^5 /. {x^p_ :> f@p, Power@x -> f@1}, cf. OneIdentity attribute that is assigned to Power.)

CoefficientList will probably be the best choice for you:

In[1]:= With[{c = CoefficientList[#, x]}
        , c.(f /@ (Range@Length@c - 1)) ]&[4 - 3 x + 2 x^2 - x^5]
Out[1]= 4 f[0] - 3 f[1] + 2 f[2] - f[5]

However, you can always define your own structures. For example, you could introduce power that never evaluates. To make it printed the way the original is printed, you can do the following:

In[2]:= MakeBoxes[power[x_, p_], tag_] ^:= 
        With[{boxes = MakeBoxes[Power[x, p], tag]}
        , InterpretationBox[boxes, power[x, p]]]

Now you can have a transformer for polynomials [of one variable]

In[3]:= toLazyPowers[poly_, x_] /; PolynomialQ[poly, x] :=
        With[{c = CoefficientList[poly, x]}
        , c.(power[x, #] & /@ (Range@Length@c - 1))]

that returns expressions with explicit “powers”, only those powers don't have any definitions associated with them:

In[4]:= toLazyPowers[4 - 3 x + 2 x^2 - x^5, x]
Out[4]= 4 x^0 - 3 x^1 + 2 x^2 - x^5

Then you will be able to perform replacements with $x^0$:

In[5]:= toLazyPowers[4 x^0 - 3 x^1 + 2 x^2 - x^5, x] /. power[x, p_] :> f@p
Out[5]= 4 f[0] - 3 f[1] + 2 f[2] - f[5]

To go back, replace your power with original Power:

In[6]:= Out@4 /. power -> Power
Out[6]= 4 - 3 x + 2 x^2 - x^5

which can be formalised, e.g., this way:

In[7]:= toEagerPowers@expr_ := expr /. power -> Power

Note: Sure, you can enrich power with definitions like

power[power[expr_, n_Integer], m_Integer] := power[expr, n m]

but prior to doing that, it's better to ask yourself what exactly you need this symbol for. In the example above it's actually used for printing polynomials, and not much for anything else. For “regular representations” of polynomials in terms of Mathematica's data structures you don't need powers at all; coefficients lists, maybe combined with a custom head, would do.

$\endgroup$
3
$\begingroup$

Another alternative is to multiply by a symbolic term $x^n$ so that every term matches the pattern, and subtract $n$ from the matched power:

expr = 10/x + 2 + x + x^2 + x^4

Module[{n},
 Expand[expr x^n] /. x^p_. :> f[p - n]
 ]

(* 10 f[-1] + 2 f[0] + f[1] + f[2] + f[4] *)
$\endgroup$
1
  • $\begingroup$ neat use of symbolic manipulation...think i could use this $\endgroup$
    – ubpdqn
    Jun 27, 2014 at 10:16
1
$\begingroup$

I think I found a pretty simple solution that should cover the most important cases.

The trick is to convert all numbers n (including all coefficients) to n f[0], then use a pattern that converts expressions such n f[0] f[3] to n f[3].

f /: Times[rest___, f[0], f[x_]] := Times[rest, f[x]]
convert[sym_Symbol] := {sym :> f[1], sym^n_ :> f[n], n_?NumericQ :> n f[0]}

A test:

3*(-5) x + I x^2 - a x^3 + 6 /. convert[x]

6 f[0] - 15 f[1] + I f[2] - a f[3]


You can extend convert to work with symbolic additive constants like this:

conv[sym_Symbol, c___] := {
  sym :> f[1],
  sym^n_ :> f[n],
  n_?NumericQ :> n f[0],
  Sequence @@ (# :> # f[0] & /@ {c})}

You will have to supply the constants to be covered as additional arguments. An example:

a + b + c + a x^2 + b x^2 /. conv2[x, a, b, c]

a f[0] + b f[0] + c f[0] + a f[2] + b f[2]

If you want to collect the f-Terms, just use FullSimplify:

a + b + c + a x^2 + b x^2 /. conv2[x, a, b, c] // FullSimplify

(a + b + c) f[0] + (a + b) f[2]

$\endgroup$
1
$\begingroup$

For Version 9.0.1.0 (Windows 8 64-bit), this seems to be a good use case for the function Internal`FromCoefficientList:

bifclF = Block[{Power = f[#2] &, x = f[1]}, Internal`FromCoefficientList[#, x]] &

Examples: Using @bobthechemist's examples

test1 = 1 + x + x^2 + x^4; test2 = 2 + x - x^2 + x^4;
test3 = -2 - x + x^2 - x^4; test4 = -2 - x - x^2 - x^4;

cls = CoefficientList[#, x] & /@ {test1, test2, test3, test4}

{{1, 1, 1, 0, 1}, {2, 1, -1, 0, 1}, {-2, -1, 1, 0, -1}, {-2, -1, -1, 0, -1}}

bifclF /@ cls

{f[0] + f[1] + f[2] + f[4],
2 f[0] + f[1] - f[2] + f[4],
-2 f[0] - f[1] + f[2] - f[4],
-2 f[0] - f[1] - f[2] - f[4]}

In version 10, this approach misses f[0]s.

$\endgroup$
4
  • $\begingroup$ It seems to me that undocumented functionality can be avoided by using FromDigits: Block[{Power = f[#2] &, x = f[1]}, FromDigits[Reverse@{-2, -1, 1, 0, -1}, x]] -- or am I mistaken? $\endgroup$
    – Mr.Wizard
    May 10, 2015 at 6:25
  • $\begingroup$ Mr.Wizard, it gives -2 - f[1] + f[2] - f[4] (that is, it misses f[0]) $\endgroup$
    – kglr
    May 10, 2015 at 8:47
  • $\begingroup$ I missed that because in 10.0 your bifclF /@ cls outputs {1 + f[1] + f[2] + f[4], 2 + f[1] - f[2] + f[4], -2 - f[1] + f[2] - f[4], -2 - f[1] - f[2] - f[4]}. $\endgroup$
    – Mr.Wizard
    May 10, 2015 at 9:13
  • 2
    $\begingroup$ Thank you Mr.Wizard, I hadn't tried it in version 10. I'll add the "Version 9 only" caveat. Another reminder not to rely on undocumented functions. $\endgroup$
    – kglr
    May 10, 2015 at 9:29

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.