Tag Info

New answers tagged

2

Perhaps something like: ClearAll[func]; func[add_, pos_: (-1)] := N@FromDigits@MapAt[# + add &, RealDigits[##], {{1, pos}}] & func[4, -1][12.007, 10, 5] (* 12.011` *) func[4, -3][12.707, 10, 5] (* 13.107` *)


1

Truncate early and often. f[0] = f0; f[n_] /; n > 0 := f[n] = Sum[ Series[1/(6 + j x) n (1/x + j f[n - 1]), {x, 0, 0}], {j, 1, 4}]; Timing[ res = Series[ Sum[Series[1/(2 + n x) (n/x + f[n]), {x, 0, 0}], {n, 1, 6}], {x, 0, 0}]] (* Out[140]= {0.012000, SeriesData[x, 0, { Rational[1016635, 162], Rational[5, 486] (-3351289 + 835701 f0)}, ...


3

I still like the differential way (below), but here's a direct way. It is similar to the linked duplicate, Change variables in differential expressions, but I don't conflate $f$ and $\tilde f$, which error is made by its OP and adhered to in the answers. Let f0 represent $\tilde f$. Then f is equivalent under the change of variables, to f == Function[{t, ...


0

you can always define the transformation rule for your variable and operator by defining the Jacobian xp=t+z xm=t-z J1 = D[{xp, xm}, #] & /@ {t, z} (*Jacobian*) J2 = Inverse[J] q={x,y};dq={dx,dy}; t1=Sum[J2[[1,i]]q[[i]],{i,2}] z1=Sum[J2[[2,i]]q[[i]],{i,2}] dz1=Sum[J1[[2,i]]dq[[i]],{i,2}] right now I am using dq for the partial derivative. They are ...


1

There are ways to do this with replacement, as comments suggest. However, it can be messy if you're jumping in with a two-variable function. Let's work from the examples to see how it goes: f'[x] /. f -> (f[g[#]] &) This makes a substitution from $f'(x)$ where $x=g(x)$ (or, more appropriately, $g(t)$): f'[t] /. f -> (f[g[#]] &) This ...


0

I tried another alternative using Replace with {0, Infinity} levelspec and it was surprisingly faster than ReplaceAll in the other answer. replace = Replace[#, {p___, {a, x1_}, {b, x2_}, {c, x3_}, {d, x4_}, q___} -> {p, {"abcd", x1, x2, x3, x4}, q}, {0, Infinity}] &; replace[list2] (* {{e, {"abcd", 0.1, 0.3, 0.5, 0.7}, f, {{"abcd", 0.2, 0.4, ...


11

foo = With[{f = #0}, (# /. {p___, a, b, c, q___} :> Join[{p, "abc"}, f @ {q}])] & lst = {1, 2, a, b, c, 3, {4, a, b, c}, 5}; foo@lst (* {1, 2, "abc", 3, {4, "abc"}, 5} *) This works because With automatically renames the patterns used in RuleDelayed since both are scoping constructs. Other constructs can be used as well such as RuleDelayed itself: ...


4

Level really has nothing to do with the problem you are experiencing; ReplaceAll already works equivalently at all levels, following a depth-first preorder traversal. Instead your problem is that the section of the expression that you wish to replace is not self-contained in list2. In list1 it is complete: {{a, 0.1}, {b, 0.3}, {c, 0.5}, {d, 0.7}} In ...


1

list2 = {{e, {a, 0.1}, {b, 0.3}, {c, 0.5}, {d, 0.7}, f, {{a, 0.2}, {b, 0.4}, {c, 0.6}, {d, 0.8}}, g, h, i}}; list2 /. {e, head__, f , tail__} :> {e, {head}, f, tail} /. {{a, x1_}, {b, x2_}, {c, x3_}, {d, x4_}} :> {"abcd", x1, x2, x3, x4} {{e, {a, 0.1}, {b, 0.3}, {c, 0.5}, {d, 0.7}, f, {"abcd", 0.2, 0.4, 0.6, 0.8}, g, h, i}}


3

This is because Mathematica looks for the largest piece of the expression that matches the pattern. Your pattern is x_, which means every conceivable expression there is will match that pattern. As a result, the entire expression {x,y,z} will be matched as it is the largest matching piece (x, y, and z won't be matched because they are smaller pieces compared ...


2

What goes wrong The help page of ReplaceAll explains why your code is not doing what you want. ReplaceAll (/.) applies a rule or list of rules in an attempt to transform each subpart of an expression expr In the end it applies the rule to the largest subpart it can match. The expression {x,y,z} has two levels (depth of two). {x, y, z} // FullForm ...


2

Replace[{x, y, z}, x_ :> ("^_^" <> ToString[x]), Infinity]


2

First, how you would you find the critical points of a function, say $f(x)=x^3-x$, from scratch? I guess you might write D[x^3 - x, x] (* Out: 3x^2 - 1 *) Then, you want to know when that's equal to zero. So you might type Solve[% == 0, x] (* Out: {{x -> -(1/Sqrt[3])}, {x -> 1/Sqrt[3]}} *) where the % sign refers to the previous output. Now ...


2

It seems to me that there are two natural approaches: (1) modifying color rules before the panel is created or (2) post-processing the output to replace recognizable colors. belisarius already showed a method for the second so I shall address the first. Modifying the color rules The color rules are loaded through this call: ...


12

I know you said you didn't want to reinvent the wheel, but sometimes, it's fun to do so. The code below creates a palette with a Periodic Table and a few buttons to make useful tool tips. It shows how one might change the colors based on properties grabbed from ElementData. Note that this code was written for version 9, and if you wish to use it in ...


6

This example picks the colors according to atomic weight, which are loaded from ElementData[]. Like belisarius's answer, it generates a list of rules to replace colors which is then applied to the pane. Rule @@@ Transpose[{ColorData["Atoms", "ColorList"] , ColorData["NeonColors"][QuantityMagnitude@ElementData[#,"AtomicMass"]/200] & /@ ...


14

myAtoms = {"H", "Li", "Na"}; defCols = myAtoms /. ColorData["Atoms", "ColorRules"]; newCols = {Pink, Yellow, LightBlue}; ColorData["Atoms", "Panel"] /. Thread[defCols -> newCols] Edit: Changing the font color isn't related to the ColorRules, but to the special formatting used by the Panel. So it's cumbersome, but you can see that Mma uses a similar ...


1

I worked out a solution using Position and a Table of Set's i.e. "set x at this position to the numbered variable with the same index i". I really appreciate all of your answers, and hopefully I will get used to using ++i in the future. Clear[replacex] replacex[l_List] := Module[{lCopy = l, positionx, numberedx}, positionx = Position[l, "x"]; numberedx ...


4

Another way: Module[{i = 0, l = #, f}, f[x_String] := Symbol[x <> ToString[++i]]; f[x_] := x; Map[f, l, {2}]] &@list {{0, x1, x2, 0}, {0, x3, x4, x5}, {0, x6, x7, x8}, {x9, x10, x11, x12}, {x13, x14, x15, x16}, {x17, x18, x19, x20}, {x21, x22, x23, x24}, {x25, x26, x27, x28}, {0, x29, x30, x31}}


5

Pickett's answer should get the job done but I encourage you to use indexed objects: Module[{i = 0}, list /. s_String :> x[++i] ]


6

ReplaceAll solution: i = 1; list /. "x" :> Symbol@StringJoin["x", ToString[i++]] The same thing can be achieved with Map: i = 1; Map[If[# == "x", "x" <> ToString[i++] // Symbol, #] &, list, {2}] They both give: {{0, x1, x2, 0}, {0, x3, x4, x5}, {0, x6, x7, x8}, {x9, x10, x11, x12}, {x13, x14, x15, x16}, {x17, x18, x19, x20}, {x21, ...


2

You must carefully define all desired / expected replacement cases. For example: poly = 864 a^6 - 432 a^4 b^2 + 54 a^2 b^4 - b^6 + 54 b^4 x^2; Clear[rep] rep[p_] := p /. p :> p[[0]]@B rep[Power[p_, n_]] := p /. p :> Power[B, n] rep[Times[n_, p_]] := p /. p :> n B rep[poly] B rep[Log@poly] Log[B] rep[1/poly] 1 / B rep[poly*2] ...


0

How about poly = 864 a^6 − 432 a^4 b^2 + 54 a^2 b^4 − b^6 + 54 b^4x^2; expr /. f_ /; PossibleZeroQ[poly - f] -> "E"


0

One (potentially incorrect, but quick and dirty) way to do it is to instead make the substitution 864 a^6 -> E - (−432 a^4 b^2 + 54 a^2 b^4 − b^6 + 54 b^4x^2) Also, do you really mean E? E in Mathematica is the symbol for the base of the natural logarithm...


1

Quantity["Speed of Light"] == QuantityVariable[\[Nu], "Frequency"] (2 \[Pi])/ QuantityVariable[k, "wavenumber"] /. QuantityVariable[\[Nu], "Frequency"] -> Quantity[2, "THz"] // Solve[#, QuantityVariable[k, "wavenumber"]][[1]] & {QuantityVariable[k,"wavenumber"] -> Quantity[(2000000000000 [Pi])/149896229, 1/("Meters")]} % // N ...


3

That's because Dot has the atrribute Flat while CenterDot doesn't: {Dot, CenterDot} // Attributes {{Flat, OneIdentity, Protected}, {}} As the document said, In pattern matching, Flat allows sequences of elements to be replaced: SetAttributes[f, Flat] f[a, b, c, d, e] /. f[b, c, d] -> x f[a, x, e] So, to fix your problem, just set Flat ...


2

It's not answer but comment Code k Esc.Esc k Esc.Esc k //. {k Esc.Esc k -> k} does not work becouse FullForm[k Esc.Esc k Esc.Esc k] (*CenterDot[k,k,k]*) and you try replace CenterDot[k,k] (that is missing on the left side) by k Finally write it in more programatic style CenterDot[k,k,k] //. CenterDot[k,k] -> k (*CenterDot[k,k,k]*) And you ...


2

k Esc.Esc k Esc.Esc k /. CenterDot[k, ___] -> k gives the desired result


1

Slight modifications of existing answers of @RunnyKine and @Algohi (thanks guys!) numRules = MapThread[ Rule, {Range[1, 9], {{"1"}}~ Join~(Partition[CharacterRange["A", "Y"] // DeleteCases[#, "Q"] &, 3])}] (* {1 -> {"1"}, 2 -> {"A", "B", "C"}, 3 -> {"D", "E", "F"}, 4 -> {"G", "H", "I"}, 5 -> {"J", "K", "L"}, 6 -> {"M", ...


1

borrowing rules from RunnyKine r = {0 -> "0", 1 -> "1", 2 -> "ABC", 3 -> "DEF", 4 -> "GHI", 5 -> "JKL", 6 -> "MNO", 7 -> "PRS", 8 -> "TUV", 9 -> "WXY"}; n = 652; StringJoin @@@ Tuples[Characters /@ IntegerDigits@n /. r] (*{"MJA", "MJB", "MJC", "MKA", "MKB", "MKC", "MLA", "MLB", "MLC", "NJA", "NJB", "NJC", "NKA", "NKB", ...



Top 50 recent answers are included