Tag Info

New answers tagged

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", ...


3

Here is one approach that does what you want: phoneSpell[n_Integer] := With[{k = StringLength@ToString@n, v = IntegerDigits@n, r = {0 -> "0", 1 -> "1", 2 -> "ABC", 3 -> "DEF", 4 -> "GHI", 5 -> "JKL", 6 -> "MNO", 7 -> "PRS", 8 -> "TUV", 9 -> "WXY"}}, StringJoin @@@ Flatten[Outer[List, Sequence @@ Characters[v /. ...


1

Keep the LHS of the replacement rule as simple as possible, e.g., use b -> 1/a {a b, a b c, a a b} /. b -> 1/a {1, c, a}


0

Use HoldForm for this: HoldForm[a a b] /. a b -> 1 (* a 1 *)


3

The same problem also appears in the related function ClebschGordan. This is indeed a bug which appears when Mathematica is given symbolic parameters instead of specific integers or half-integers. We can check that the first result in the question is incorrect by using the explicit sum definition of ThreeJSymbol given in the documentation under Properties: ...


3

Just to expand on what @eldo has written. I found that this odd behavior happens for all odd $n$ values where $n$ is the argument of this function:- f[n_] := Module[{r1, r2, r3}, r1 = ThreeJSymbol[{a, 0}, {b, 0}, {c, 0}] /. {a -> n, b -> n, c -> 0}; r2 = ThreeJSymbol[{a, 0} /. a -> n, {b, 0} /. b -> n, {c, 0} /. c -> 0]; r3 = ...


2

Line1: ThreeJSymbol is evaluated before replacement. Line2: ThreeJSymbol is evaluated after replacement. To give another example: D[x^2, x] /. x -> 2 4 D[x^2 /. x -> 2, x] 0


4

This question has essentially been asked many times before, perhaps most recently here: Converting hierarchies of rules to associations I addressed it myself when I demonstrated the use of Replace and FixedPoint in place of ReplaceRepeated to get the standard traversal in: ReplaceRepeated seemingly omits some rules As already explained by RunnyKine ...


3

Another option is to use Condition: Replace[foo, {foo_ /; RandomReal[] < p :> bar, foo_ :> baz}] where p is the probability you want to give to the first replacement. This is somewhat similar to using an If, but I find it somewhat more idiomatic. I would also avoid using ReplaceAll, when you actually want Replace as ReplaceAll might recurse down ...


6

Use Replace instead of ReplaceAll Replace[a[b[c, d]], head_[arg__] :> newHead[arg], {0, Infinity}] newHead[newHead[c, d]] ReplaceAll fails to do what you want because it acts from the outside in. Once it found a match (the entire expression) on the outside, its job was done. Replace on the other hand, acts from inside out.


9

You can use RandomChoice to randomly select an item from a list. You can even randomly select an operator and apply it. For example: f[x_List] := RandomChoice[{Reverse, Identity}][x] Table[f[{1, 2, 3, 4}], {10}] returns: {{4, 3, 2, 1}, {4, 3, 2, 1}, {1, 2, 3, 4}, {1, 2, 3, 4}, {1, 2, 3, 4}, {1, 2, 3, 4}, {4, 3, 2, 1}, {1, 2, 3, 4}, {4, 3, 2, 1}, ...


2

rules = {a b -> p, a c / d -> q} Expand[a (b + 42 c/d)] /. rules (*p + 42 q*)


7

Although apparently undocumented Replace and ReplaceAll work with Association and this combination is considerably faster than Map. Further it appears to be somewhat faster than using a Dispatch table as well. Update: it seems Lookup is faster still. See additional timing result. Setup: rules = Thread[Range @ 26 -> CharacterRange["a", "z"]]; asc = ...


10

In V10, another option is to use Association. par=<|"mu"->1,"sigma"->1,"lb"->0,"ub"->10|>; f[x_, p_Association:par] := PDF[LogNormalDistribution[p["mu"], p["sigma"]], x] Plot[f[x, ##], {x, #lb, #ub}] &@par Another form for Plot is: Plot[f[x, par], {x, par@"lb", par@"ub"}] And as @Mr.Wizard commented, you can use the default ...


13

There are a number of options and their attractiveness will depend on the scenario for their use, therefore it is difficult to make any broad recommendations of best practice. I will say that generally it is not recommended to rely on global assignments as in your first example, because this method scales poorly and because it is easy to make mistakes and ...


2

That code looks familiar. ;-) There are many different ways to approach this, as you can see from the answers you're getting. Fundamentally it is important to learn how to manipulate arbitrary expressions rather than carrying around specific bits of code or you will end up in the trap of cargo cult programming. You have output that looks like this: r1 = ...


1

input = Flatten[List[Minimize[{x - 2 y^2, 1500 >= x >= y >= 0}, {x, y}], List[FindRoot[{v - Sin[u] == 0, v + u == 30}, {u, 0}, {v, 20}]]], 1]; {x, y, u, v} /. Join @@ Rest @ input (* {1500, 1500, 30.675, -0.674984} *) or {x, y, u, v} /. Join@##2 & @@ input (* {1500, 1500, 30.675, -0.674984} *) or {x, ...


0

Try this: Cases[List[Minimize[{x - 2 y^2, 1500 >= x >= y >= 0}, {x, y}], List[FindRoot[{v - Sin[u] == 0, v + u == 30}, {u, 0}, {v, 20}]]], Rule[x_, y_] :> y, {0, -1}] or {x, y, u, v} /. Level[List[Minimize[{x - 2 y^2, 1500 >= x >= y >= 0}, {x, y}], List[FindRoot[{v - Sin[u] == 0, v + u == 30}, {u, 0}, {v, 20}]]], ...


2

If you don't need the value of the minimization, just throw it away and use a flattened list of rules: {x, y, u, v} /. Flatten[{Last@Minimize[{x - 2 y^2, Q >= x >= y >= 0}, {x, y}], FindRoot[{v - Sin[u] == 0, v + u == 30}, {u, 0}, {v, 20}]}]


1

You could use the replacement rule that Öskå already provided: Integrate[f[x], {x, lb, ub}] /. Integrate[x__] :> NIntegrate[x, Method -> "GaussKronrodRule"] However this will throw one unnecessary error message: Integrate::argmu: Integrate called with 1 argument; 2 or more arguments are expected. >> You could wrap the left-hand-side of the ...



Top 50 recent answers are included