Tag Info

New answers tagged

0

Nasser in his comment is referring (somewhat cryptically) to an undocumented second argument of Return. You would use it this way. test1[] := Module[{}, Do[Print[i]; If[i > 3, Print["i > 3"]; Return[100, Module]], {i, 1, 5}]; 200] However, I prefer to avoid undocumented stuff, so I recommend test2[] := Catch[ Do[Print[i]; If[i > ...


-1

Maybe this doesn't answer your question, but I would proceed as follows (avoiding error messages in the first place): fun = Sin[a*x] + Cos[b*x] + Log[c*x] /. {a -> 1, b -> 1, c -> 1}; roots= Union@Map[FindRoot[fun, {x, #}] &, Range[1, 12]] {{x -> 0.28847}, {x -> 3.40346}, {x -> 4.06124}} roots = Cases[roots, Rule[_, x_] /; x >= 1 ...


1

Like stated in the duplicate's link: functionexample[a_, b_, c_, x_] := Sin[a*x] + Cos[b*x] + Log[c*x] rootexample[a_, b_, c_, result_] := FindRoot[functionexample[a, b, c, x] == result, {x, 1, 12}, Method -> "Brent", PrecisionGoal -> 16][[1, 2]] a = 1; b = 1; c = 1; Quiet[Table[ Check[rootexample[a, b, c, i], "NaN", {FindRoot::bbrac}], {i, ...


2

I have used Sow/Reap in simple situations, but for what your proposing, I would usually follow your second idea. Something like this toy example: myfn[___]["Properties"] = {"a", "b", "function"}; myfn[x_, a_, b_, func_]["a"] := a; myfn[x_, a_, b_, func_]["b"] := b; myfn[x_, a_, b_, func_]["function"] := func; myfn[x_, a_, b_, func_][t_?NumericQ] := ...


3

I do not have a lot of first hand experience with this, as I've never took the time to implement a proper solution for this problem. Also, I don't know a lot about FEM methods. So what I am going to say is mainly based on observing how various Mathematica functions work. Don't use Sow/Reap for this I don't think Sow/Reap are designed with this ...


0

Since you are specifically interested in pattern matching rather than functional equivalents such as the one presented by eldo here is an additional answer. Szabolcs already gave my preferred solution, which is to use Alternatives, though he did not recommend it. Nevertheless I do. As complete code for reference: foo[rules : _Rule | {__Rule}] := ...


2

Edit This edited answer reflects comments made on my original version by the OP. Clear[rulelist, rule]; rulelist = {{tt -> 1, zz -> 1}, {tt -> 1, zz -> 2}, {tt -> 2, zz -> 1}, {tt -> 2, zz -> 2}}; Table[rule[i] = rulelist[[i]], {i, 4}]; To see where you went wrong let's look at what Derivative returns when it is given your version ...


4

I think your definition of d is not properly generalizable because the list dimensions don't match when doing higher derivatives. So I instead use a simpler definition of the Gateaux derivative from Wikipedia which does exactly the same thing as what you're trying to do. I call it gatD, and it takes the operator, the function u and a List of test functions. ...


4

Edit The definition of the Moyal product in the original question was missing a factor 1/n! under the sum. I used the textbook definition instead. A reference for this definition, without any unnecessary technicalities, is here: Quantum Mechanics in Phase Space (arXiv), see the appendix. Thanks to Rahul Narain for spotting the discrepancy between my ...


14

Ramblings Arguments of the left-hand-side head are evaluated in the course of function definition, therefore you can use a utility function that constructs the patterns that you want. For example: SetAttributes[nq, HoldFirst] Quiet[ nq[s_Symbol] := s_?NumericQ ] Now: ClearAll[f] f[nq @ a, nq @ b, nq @ c] := a + b + c Definition[f] f[a_?NumericQ, ...


1

The failure you observe is caused by automatic renaming within nested scoping constructs: Enforcing correct variable bindings and avoiding renamings for conflicting variables in nested scoping constructs You can use any of the methods described therein to correct the problem. For the first example using the form MeshFunctions -> Function @@ {{x, y}, ...


0

Put everything in a Module to localize your Symbols: fn[m_?MatrixQ] := Module[{M = m, L, i, j, M2, M3, A}, If[FreeQ[M, 0], ## &[], Print[First[Dimensions[M]]]]; L = SparseArray[M]["NonzeroPositions"]; i = First[First[L]]; j = Part[First[L], 2]; M2 = M; M2[[{1, i}]] = M2[[{i, 1}]]; M2[[All, {1, j}]] = M2[[All, {j, 1}]]; If[M2[[1, 1]] ...


0

A very crude way to do this would be: func[mat_] := With[{M = mat}, If[FreeQ[M, 0], ## &[], Print[First[Dimensions[M]]]]; L = SparseArray[M]["NonzeroPositions"]; i = First[First[L]]; j = Part[First[L], 2]; M2 = M; M2[[{1, i}]] = M2[[{i, 1}]]; M2[[All, {1, j}]] = M2[[All, {j, 1}]]; If[M2[[1, 1]] > 0, ## &[], M2 = M2*Normal[ ...


0

mymesh = x$ + y$; myplot[mesh_] := Plot3D[x^2 + y^2, {x, -1, 1}, {y, -1, 1}, MeshFunctions -> {Function[{x, y, z}, mesh]}] myplot[mymesh]


3

Your original was ok, apart from the incorporation of the Function[{x,y,z}, body]inside the Plot function. You should pass it as an argument instead: mymesh=Function[{x,y,z},x y]; myplot[mesh_]:=Plot3D[x^2+y^2,{x,-1,1},{y,-1,1},MeshFunctions->mesh]; and then myplot[{mymesh}] or even myplot[mymesh]. Taking into account your ammendment: elliptic=z ...


3

mymesh[x_, y_] := x*y myplot[mesh_] := Plot3D[x^2 + y^2, {x, -1, 1}, {y, -1, 1}, MeshFunctions -> mesh] myplot[mymesh[#1, #2] &] ADDENDUM f1 = x^2 + y^2 + z^2 - 1; f2 = z y^2 - x^3 + z^2 x; curveSpherePlot[c_] := ContourPlot3D[ x^2 + y^2 + z^2 == 1.0001, {x, -1, 1}, {y, -1, 1}, {z, -1, 1}, MeshFunctions -> c, PlotPoints -> 50] ...


1

cf = Compile[{{data, _Real, 1}}, Module[{x, a, b}, x = Last@data; a = data[[1 ;; -2 ;; 2]]; b = data[[2 ;; -2 ;; 2]]; a.Sin[b + x] ] ]; cf@RandomReal[{0, 1}, 10000001] // Timing {0.374402, 2.10248*10^6}


0

Late to the party, but I think this kind of neat: fr[1] = {{1}}; fr[a_] := ArrayPad[fr[a - 1], {{{0, 1}, {0, 0}}, {{0, 0}, {0, 2}}, {{1, 0}, {0, 0}}, {{0,0}, {2, 0}}}[[Mod[a, 4, 1]]], a]; Ah - lol - just saw Mr. Wizard's update... Edit: Here's an attempt at shaving some size off - just for fun... fr2[1]={{1}}; fr2[a_] ...


6

I think this does what you want. f[1] = {{1}}; f[n_?EvenQ] := ArrayPad[f[n - 1], {0, {2 - #, #} &@Mod[n, 4]}, n] f[n_?OddQ] /; Mod[n, 4] == 3 := Prepend[f[n - 1], ConstantArray[n, n]] f[n_?OddQ] /; Mod[n, 4] == 1 := Append[f[n - 1], ConstantArray[n, n]] f[12] Okay, more to my own liking: ClearAll[f] f[1] = BoxMatrix[0] (* produces a packed array ...


4

Since all of the component functions are Listable f[{a_, m_, s_}, x_] := Total[a*Exp[-(x - m)^2/(2*s^2)]] n = 5; amp = Array[a, n]; mean = Array[m, n]; sigma = Array[s, n]; f[{amp, mean, sigma}, x] a[1]/E^((x - m[1])^2/ (2*s[1]^2)) + a[2]/E^((x - m[2])^2/ (2*s[2]^2)) + a[3]/E^((x - m[3])^2/ ...


4

f[data_] := Total[#1*Exp[-((x - #2)^2/(2 #3^2))] & @@@ data]; f[{{A, mx, sigma}}] f[{{A, mx, sigma}, {A2, mx2, sigma2}}] Use Function, Apply and Total.


5

The name f can be used for two "different" functions, one depending on three variables and the other depending on two: f[x_, y_, θ_] := f[x, y] D[f[x, y, θ], x] $f^{(1,0)}(x,y)$ D[f[x, y, θ], y] $f^{(0,1)}(x,y)$ D[f[x, y, θ], θ] $0$


4

If you are also interested in easy way of viewing the points on figure, you can also use << Optimization`UnconstrainedProblems package. This package runs the optimization function (like FindRoot), keeps track of the function and gradient evaluations and steps taken during the search (using the EvaluationMonitor and StepMonitor options), and shows ...


5

EvaluationMonitor (and StepMonitor) have been mentioned, but not every function has these options. So here's a more general way: You need to prevent the function from evaluating for non-numeric arguments. This is a very very common issue described here among other places. Solution 1: f[x_?NumericQ] := (Print[x]; Sin[x] - Cos[x]) FindRoot[f[x], {x, .5}] ...


6

EvaluationMonitor works in this case (per b.gatessucks' helpful suggestion). StepMonitor also works although it doesn't display the starting value. Code FindRoot[Sin[x] - Cos[x], {x, 0.5}, EvaluationMonitor :> Print["x=", x, ", y=", Sin[x] - Cos[x]]] FindRoot[Sin[x] - Cos[x], {x, 0.5}, StepMonitor :> Print["x=", x, ", y=", Sin[x] - Cos[x]]]


1

replace[expr_, levelspec_, rules__] := Replace[expr, List @ rules, levelspec] replace[Range @ 10, {1}, 7 -> "seven"] replace[Range @ 10, {1}, 7 -> {"seven"}] replace[Range @ 10, {1}, 7 -> "seven", 8 -> "eight"] replace[Range @ 10, {1}, {7 -> "seven", 8 -> "eight"}] All give the expected results.



Top 50 recent answers are included