14

When we have a long list of rules it would be resonable choosing a functional approach, which is much faster than rule based one. In such cases consider e.g. Reverse /@ rep Sometimes it would be more efficient using Transpose twice than Map once, e.g. Rule @@@ Transpose @ Reverse @ Transpose[ List @@@ rep] Nonetheless ususally we need not to play with ...


12

Part Part is a general approach to this kind of reordering challenge: rep = {a1 -> b1, a2 -> b2, a3 -> b3}; rep[[All, {2, 1}]] {b1 -> a1, b2 -> a2, b3 -> a3} Reference: Head and everything except Head? Reverse Also there is a faster form of Reverse: Reverse[rep, 2] {b1 -> a1, b2 -> a2, b3 -> a3} Slot / Function Slot notation ...


9

Using Replace(All) or Map is kinda slow for larger lists. Why not simply use: ConstantArray[Range[Max[s]], Length[s]]


8

{a1 -> b1, a2 -> b2, a3 -> b3} /. Rule[x_, y_] -> Rule[y, x]


7

Thread[ a -> b] {a1 -> b1, a2 -> b2, a3 -> b3} Also: Inner[Rule, a, b, List] {a1 -> b1, a2 -> b2, a3 -> b3} and # -> #2 & @@@ Transpose[{a, b}] {a1 -> b1, a2 -> b2, a3 -> b3} Rule @@@ Transpose[{a, b}] {a1 -> b1, a2 -> b2, a3 -> b3}


6

Try Dot: Dot[as, bs - as] 270 aa = Array[Subscript[a, #] &, 4]; bb = Array[Subscript[b, #] &, 4]; Dot[aa, bb - aa] // TeXForm $a_1 \left(b_1-a_1\right)+a_2 \left(b_2-a_2\right)+a_3 \left(b_3-a_3\right)+a_4 \left(b_4-a_4\right)$


6

With ReplaceAll you need a pattern to restrict the replacement or it will match the entire list: Flatten[s /. _Integer -> Range[Max@s]] {1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, \ 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8} Performance SHuisman's answer reminded me of performance. If that is important consider ...


5

Use the rule: HoldPattern @ Plus[__NumSymb] :> NumSymb[Unique[]] instead. For example: Table[ testSum[[Range@n]] /. HoldPattern @ Plus[__NumSymb] :> NumSymb[Unique[]], {n, 16} ] //AbsoluteTiming {0.000197, {NumSymb[$11], NumSymb[$275], NumSymb[$276], NumSymb[$277], NumSymb[$278], NumSymb[$279], NumSymb[$280], NumSymb[$281], NumSymb[$282], ...


5

It's because the expression contains both (...)^(1/3) and (...)^(-1/3) so you can do it with two rules: expr = (1/2 (1 + I Sqrt[3])); ToRadicals[Solve[4 n^4 + 4 n + 3 == 0]] /. {expr^(1/3) :> t, expr^(-1/3) :> 1/t} (* results: *) {{n -> -(1/2) Sqrt[1/t + t] - 1/2 Sqrt[-(1/t) - t + 2/Sqrt[1/t + t]]}, {n -> -(1/2) Sqrt[1/t + t] + 1/2 Sqrt[-(1/t) -...


4

Clear["Global`*"] f[h_, s_, a_, b_] := 0.00015034013139827721* h^4*(-12.512450890438938 + Log[0.10272025*RealAbs[h^2]]) - 0.00463012409828799* h^4*(-12.512450890438938 + Log[0.49368002148788936* RealAbs[h^2]]) + (3*(14922.284640000005 + 0.4*h^2 - 272.22*s + 0.3818*s^2)^2*(-12.512450890438938 + Log[...


4

expr = dx/(x*y) + dx^3/(9*x*y) + dy/(x*y) + dx*Exp[x]/(x*y) + dx^3*dy^3*Exp[3*(x + y)]/(x*y) DeleteCases[Except[_. (dx | dy)^(_.) Exp[_]]] @ expr (dx E^x)/(x y) + (dx^3 dy^3 E^(3 (x + y)))/(x y) TeXForm @ % $$\frac{\text{dx}^3 \text{dy}^3 e^{3 (x+y)}}{x y}+\frac{\text{dx} e^x}{x y}$$


4

The problem arises because you want to take the derivative with respect to an expression which is not a valid variable for D[]. A toy example is the following: f[x_] := x^2 g[x_] := D[f[x], x] g[x^2] (* During evaluation of In[130]:= General::ivar: x^2 is not a valid variable.*) What happens is that g[x^2] evaluates to D[f[x^2], x^2] and D does not know ...


4

Depending on your definition of random the method from bill s might have a problem in that some elements can be selected in more than one way. For example in your expr the element at position {3} can be selected from either {3, 2, 1, 2, 1} or {3, 3, 1, 1}. If we use Position to find all elements directly (rather than Dropping afterward) we avoid this. ...


4

Is this acceptable? s={1, 2, 4, 7, 8}; Flatten[Map[Range[Max[s]]&,s]] which is the same as Flatten[Range[Max[s]]&/@s] and both produce {1,2,3,4,5,6,7,8,1,2,3,4,5,6,7,8,1,2,3,4,5,6,7,8,1,2,3,4,5,6,7,8,1,2,3,4,5,6,7,8} which matches what your example code produces. Map or /@ will replace each item in the list with the result of a function applied to ...


3

With[{ints = Range[100]}, Pick[ints, Clip[Total[IntegerDigits[ints], {2}], {-∞, 5}], 5]] Using Nothing: With[{ints = Range[100]}, ints /. Thread[PositionIndex[Clip[Total[IntegerDigits[ints], {2}], {4, ∞}]][4] -> Nothing]]


3

Another approach to consider: Attributes[f] = Listable; f[x_?Negative] := -x^2 f[else_] := else m = {{1, -1, 3}, {-2, 1, -3}, {-2, 3, 3}}; f[m] {{1, -1, 3}, {-4, 1, -9}, {-4, 3, 3}}


3

the outcome should be m1={{1,-1,3},{-4,1,-9},{-4,3,3}}. ClearAll[f,x]; m = {{1, -1, 3}, {-2, 1, -3}, {-2, 3, 3}}; f[x_] := -x^2 Map[If[# < 0, f[#], #] &, m, {2}] If you want to use ReplaceAll m /. (x_ /; x < 0) :> f[x]


3

You could use PolynomialQ[expression,x] to test them, which will see if your overall solution is a polynomial, or, if you have a list of solutions sols, then you could use: Select[sols, PolynomialQ[#, x] &] If your solution, sol has a number of coefficients, for instance c1, c2 and c3 which are free parameters, then you can at least check term by term: ...


3

This is straight-forward to do with assignment: m = {{1, 2, 3}, {4, 5, 6}, {7, 8, 9}}; m[[1 ;; 2, 1 ;; 2]] = {{3, 2}, {1, 2}}; m // MatrixForm We can get the list of all matrices like this: newMatrices = ConstantArray[m, Length[helios]]; newMatrices[[All, 1 ;; 2, 1 ;; 2]] = helios;


3

DeleteCases[func, Except[Alternatives[dx, dx^_, dy, dy^_] Exp[_] _] (* returns: (dx E^x)/(x y) + (dx^3 dy^3 E^(3 (x + y)))/(x y) *)


3

Quick solution: energy /. Subscript[R, s] -> Function[t, a[t]*Subscript[r, s]] Or using linked answer: DChange[energy, Subscript[R, s][t] == a[t]*Subscript[r, s]]


2

I do not know how to do this with patterns alone, but the following works: myExponent[expr_, patt_] := Exponent[expr /. patt :> \[FormalX], \[FormalX]] denrepl := With[{patts = {Den1[_], Den2[_], Den3[_], Den4[_], Den5[_]}}, Function[{expr}, j[MI, #1, #2, #3, -#4, -#5] & @@ (myExponent[expr, #] & /@ patts)] ] Den1[vk] // denrepl (* j[...


2

Mod[Range[Length[s] #], #, 1] & @ Max[s] {1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8} First @ ArrayReshape[Range @ #, {1, Length[s] #}, "Periodic"] & @ Max[s] {1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, ...


2

An alternative simplification Clear["Global`*"]; sol = Solve[4 n^4 + 4 n + 3 == 0] // ToRadicals; rules = {(1/2 (1 + I Sqrt[3]))^(1/3) :> Evaluate[(1/2 (1 + I Sqrt[3]))^(1/3) // FullSimplify], (1/2 (1 + I Sqrt[3]))^(-1/3) :> Evaluate[(1/2 (1 + I Sqrt[3]))^(-1/3) // FullSimplify]} (* {(1/2 (1 + I Sqrt[3]))^(1/3) :> (-1)^(1/9), ...


2

Not sure this is a slick solution but seems to work: rules = {2 <-> 4, 3 <-> 1} /. {a_ <-> b_ :> {a -> b, b -> a}} // Flatten; {2*s[1, 2]^2, 3*s[3, 5]^4} /. p : s[_, _] :> (p /. rules)


1

One way: list = {2*s[1, 2]^2, 3*s[3, 5]^4, g[s[3, 4, 0, 2]]}; list /. expr : s[__] :> (expr /. { 1 -> 2, 2 -> 20, 3 -> 4, 4 -> 40, 5 -> 50 }) {2 s[2, 20]^2, 3 s[4, 50]^4, g[s[4, 40, 0, 20]]}


1

Take a smaller example with the same structure as the one in OP: k = 4; cc = Array[Subscript[c, #] &, k]; pp = Array[Subscript[p, #] &, k]; tt = Array[Subscript[t, #] &, k]; You can get your table using: tbl = (1/Most[cc - (1 - θ) tt]) Rest[pp].Rest[cc - (1 - θ) tt]; TeXForm @ tbl $\left\{\frac{p_2 \left(c_2-(1-\theta ) t_2\right)+p_3 \left(...


1

Just wanted to join in on all of the fun: Rule[Last@#,First@#]&/@rep Same output.


1

(* Not a one-liner, but easy enough to do so *) s = {1, 2, 4, 7, 8}; l = Length[s]; item = Range[Max[s]] Replace[s, {_ -> item}, {1}] (* use level spec *) (* Flatten if desired *)


1

You can try it as a rule. rule = {F[-x_] -> F[x], F[x_] -> F[Abs[x]]} F[-5] /. rule (*F[5]*) F[-x] /. rule (*F[x]*) This may not cover all scenarios, but it includes yours.


Only top voted, non community-wiki answers of a minimum length are eligible