# Tag Info

19

One way would be to redirect all messages issued by ToExpression to a string-stream. Here is an example of that approach, with minimal error-checking: Needs["Developer"] interpret[str_String] := Module[{s = StreamToString[], r, m} , Block[{$Messages = {s}}, r = ToExpression[str, InputForm, HoldComplete]] ; m = StringFromStream[s] ; Close[s] ; ... 14 Yes. It turns out that Normal accepts an undocumented second parameter which may be a Symbol or a list of Symbols and it will only affect those forms. Plain application converts all these forms (and more): abby = { SparseArray[{3 -> "a", 5 -> "b"}], <|1 -> "a", 2 -> "b", 3 -> "c"|>, Series[Exp[x], {x, 0, 5}], Quantity[1, ... 13 UPDATE: quite interesting parallel discussion and solutions (see Emerson Willard answer) can be found HERE. Maybe this is not exactly what you are looking for, but at least this gives you a very close guess and it is easy to figure out the rest. dis = ProbabilityDistribution[ 1/(2*E^((-m + Log[5])^2/8)*Sqrt[2*Pi]), {m, -Infinity, Infinity}]; PDF[dis, ... 13 You can use Series to specify the order of approximation. When an expression involving the output of Series, which is a SeriesData object, is evaluated, the calculus is done for you. sol = Solve[x^2 + (b + Epsilon)*x + c == 0, x] approx = sol /. Epsilon -> Series[Epsilon, {Epsilon, 0, 1}] // Normal Alternatively, you could apply Series to the ... 11 y = a[b, c][d]; y[[0, 0]] = w; y (* w[b, c][d] *) 11 For arbitrarily nested heads I would use recursion and pattern matching, like this: ClearAll[replaceFirstHead] replaceFirstHead[head_[body___], newHead_] := replaceFirstHead[head, newHead][body] replaceFirstHead[head_, newHead_] := newHead replaceFirstHead[a[1][2][3][4, 5, 6], x] (* x[1][2][3][4, 5, 6] *) There is no need to test for _Symbol or _?AtomQ ... 11 The two examples in this question relate to two different aspects of pattern matching. I will start with the simpler to understand and intentional aspect, which is the second example. g[2] /. g[ 1 + (1|other) ] -> post (* g[2] *) In the above, the pattern doesn't match, and it can never match. g[2] has one argument. Since Plus is OneIdentity, 2 ... 11 My offering: And @@ Or @@@ Outer[Equal, {x, y, z, m}, {2, 3, 4}] 10 f[m_] = 1/(2*E^((-m + Log[5])^2/8)*Sqrt[2*Pi]); Integrate[f[m], {m, -Infinity, Infinity}] 1 dist = ProbabilityDistribution[f[m], {m, -Infinity, Infinity}]; Since the integral of f[m] is unity, f[m] does not have to be scaled to be a distribution. A candidate distribution will probably have two parameters and must be defined on the interval ... 9 I think you've found a bug in pattern matcher. This problem can be reduced to matching sequence of length one with named BlankSequence patterns in Orderless functions, it stopped working in v10.1. In previous versions your replacement rule works (as noted by belisarius). Minimal example of this behavior is: ClearAll[f, a] SetAttributes[f, {Orderless}] ... 9 Well, the following meets your formal requirements evenFunction[f_][args__] := f[Abs /@ Unevaluated[args]] evenFunction[even][a, b, c] even[Abs[a], Abs[b], Abs[c]] But is it really better than evenFunction[f_][args__] := f @@ Abs[{args}] I, myself, would choose the 2nd version over the 1st. Update It is not necessary to set the attribute ... 8 I think an acceptable solution is to Thread over Alternatives: Basic solution: SetAttributes[f, Flat]; f[a, b, c] /. Thread[f[a, f[b, c] | other], Alternatives] -> post post Though, it won't be very helpful in more complex situations: f[a | b, f[b, c | h]]. General solution (experimental) tupplesOver[ f[a | g, f[b, c | h] | other], ... 8 This question is closely related to: How to remove redundant {} from a nested list of lists? How to completely delete the head of a function expression If you wish to strip the brackets from a single expression in a nontrivial case please consider Delete as described in my answer to the second referenced question above. Unlike using Apply (e.g. # & ... 7 You can generate the monomials by using CoefficientRules, like this In[55]:= monomialList[poly_, vars_] := Times @@ (vars^#) & /@ CoefficientRules[poly, vars][[All, 1]] monomialList[a x^2 + b x y + c y^2, {x, y}] Out[56]= {x^2, x y, y^2} 7 A pattern matching method: fn[x_, {var__}] := List @@ Pick[x, x, Alternatives[var]^_.] fn[a x^2 + b x y + c y^2, {x, y}] {x^2, x y, y^2} But a better approach I believe is (hopefully now corrected at last): fn2[x_, var_] := Collect[List @@ Expand @ x, var, 1 &] fn2[a x^2 + b x y + c y^2, {x, y}] {x^2, x y, y^2} fn2[x (x^2 + y^2), {x, y}] ... 7 You mean like this? Times @@ Map[ Beta[First[#] + a, Last[#] + b] &, {{1, 1}, {12, 1}, {7, 9}, {10, 14}}] 7 There seems to be a subtlety in the way delayed rules are used. Have a look at the following: {a,a,a} /. a/;(Print["lhs evaluated"];True) :>(Print["rhs valuated"]; RandomReal[]) (*lhs evaluated lhs evaluated lhs evaluated rhs evaluated rhs evaluated rhs evaluated *) (* {0.797753,0.567294,0.91182} *) This shows that when we use a delayed ... 7 I believe this is what$PrePrint is for, since you only want to affect how the expression looks, and I'm guessing you want it to happen automatically for every input. Using $PrePrint thus allows you to use Out[n] without worrying about the held expressions. This seems to work (but I would like to find a better way to take care of the signs between terms in ... 7 In this example, I am assuming that the structure of your expressions will always be similar to your input: input = a*b*c + Cos[x - y]; The method below is not exactly general. First remove the outer-most Plus: list = List @@ Expand[input] (* {a b c, Cos[x - y]} *) We then Map Apply over the list while being careful to avoid those expressions which ... 7 This is related to the Orderless attribute of Times and Plus. These attributes could be removed permanently with some hacks, but that would break Mathematica. If you only want to display the result in a certain way, but not do calculations with it, it may be safe to remove those attributes temporarily using Block. Block[{Plus, Times}, With[{result = ... 7 What I think you want: S = {s1, s2, s3}; x = {1, 2, 4, s1, y}; Intersection[x, S] Outputs: {s1} As for # see http://reference.wolfram.com/language/tutorial/PureFunctions.html For your edited question: set = {s1, s2, s3}; x = {1, 2, 4, s1, y, f1[s1], f2[s2]} p = Alternatives @@ set; Cases[x, p | _[p]] {s1, f1[s1], f2[s2]} Reference ... 7 This is a bug I fixed in 10.4.0. Sorry for the inconvenience! To work around it in earlier versions, evaluate the following block of code: InactiveDumpassembleInactiveSumProduct[{args_, disp_, interp_, char_, tag_, tooltip_, fmt_}] := TemplateBox[args, tag, DisplayFunction -> Function[disp], InterpretationFunction -> Function[interp], ... 6 I believe Block will work for you here: mem : averageFreeEnergyDensityCompiled["square", n_] := mem = Block[{Part}, Compile[{{j, _Real}, {d, _Real}, {a, _Real}, {h, _Real}, {dx, _Real}, {th, _Real, 2}, {ph, _Real, 2}}, Evaluate[(*apply boundary conditions*) s[i1_, i2_] := Which[i1 == n + 1 && i2 == n + 1, s[1, 1], i1 == ... 6 Often, it is desirable to apply Simplify or FullSimplify to parts of an expression and then recombine the parts. A particularly effective function for this purpose is Collect. For instance, Collect[expr, a^2 - b^2, Simplify] (* (4 a^2 - 3 b^2)/(a^2 - b^2)^2 - 8/(b^2 - c^2)^2 *) Although there is no need to use FullSimplifyin this case, it runs faster ... 6 The following appears to be what you want. repl[expr_, max_] := With[{largest = Max[Cases[expr, C[n_] :> n, Infinity]]}, If[largest <= max, expr /. (R[C[largest], anything__] :> R[C[largest], anything].(II + R[C[largest + 1], C[largest]])) // repl, expr] ] repl[myExpr, 7] Alternative formulation if recursion doesn't float ... 6 Update In the interest of simplifying the code somewhat, I've modified one of the replacements. For instance, we can do expr2 = Thread[expr1, Plus] /. Plus -> Times or epxr2 = expr1 /. expT[Plus[a__]] :> Times @@ expT /@ a rather than expr2 = expr1 //. {expT[a_ + b_] :> expT[a] expT[b]} So: f[expr_] := Thread[expr /. Power[E, a_] :> ... 6 You don't say explicitly how you want to handle terms of order zero. Assuming that these are also to be discarded expr = a x^3 + b x^2 + c x + d; minOrder = 2; coefList = CoefficientList[expr, x]; lenCoefList = Length[coefList]; Expand[(Expand[x*expr] /. ((x^n_ /; n > minOrder) ->$t^n) /. {x -> 0, \$t -> x})/x] (* b x^2 + a x^3 *) ...

6

One can use Operate[] with Apply[]: Operate[w @@ # &, a[b, c][d]] w[b, c][d]

6

It is not completely clear to me what form the output is intended to take. Recommend that you always give examples of both inputs and corresponding outputs. S = {s1, s2, s3}; x = {1, 2, 4, s1, y, f1[s1], f2[s2], f1[s1 + s2], f2[f1[s1] + s3]}; DeleteCases[x, _?(FreeQ[#, Alternatives @@ S] &)] (* {s1, f1[s1], f2[s2], f1[s1 + s2], f2[s3 + f1[s1]]} *) ...

6

As it was mentioned in the question and in the comments this is fairly easy to program. eqs = {Y == a + b X, Z == 1/X + Y}; edges = Flatten@ Map[Outer[Rule, Cases[{#[[2]]}, s_Symbol /; Not@NumericQ[s], \[Infinity]], Cases[{#[[1]]}, s_Symbol /; Not@NumericQ[s], \[Infinity]]] &, eqs] (* {a -> Y, b -> Y, X -> Y, X -> Z, Y ...

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