# Tag Info

7

Here is one way to define oper: oper[n_][f_] := (f[##] - Apply[f, {##}(1-UnitVector[Length@{##}, n])]) / {##}[[n]] & oper[n1_, ns__][f_] := oper[n1][oper[ns][f]] The first definition is the main one. It generates the desired pure function for a given input function (which may or may not be pure itself): oper[2][f] (* (f[##1] - f @@ ({##1}*(1 - ...

7

This is one possibility: oper[ns__] := Fold[Function[{f, n}, (f[##] - f @@ ReplacePart[{##},n -> 0])/Slot[n] &], #, {ns}] & With this, you can do oper[2,1][f][x,y,z] (-((-f[0, 0, z] + f[0, y, z])/y) + (-f[x, 0, z] + f[x, y, z])/y)/x Note that even though ns__ is a pattern (hence not totally "pure"), any operation ...

5

Your assumption should be made on the value of g[_], not of plain g. Otherwise, your assumption can be introduced globally through $Assumptions, or as a second argument to Simplify, or using Assuming, all with the same result. Clear[f, g, r] f[arg_] := a - I arg Conjugate[f[g[r]]] (* Out: Conjugate[a] + I Conjugate[g[r]] *) Assuming[g[_] ∈ Reals, ... 5 F[listInt:{__Integer}]:= The semicolon is just another way to name a pattern 4 the main issue is that you cannot (readily*) modify the actual argument to a function Try this: InsertRows[vectors_List, matrix0_List,position_Integer] := Module[{matrix}, matrix = matrix0; Do[matrix = Insert[matrix, vectors[[i]], position], {i, Length@vectors}]; matrix] usage: matrix = InsertRows[{vector1, vector2}, matrix, ... 4 Here are a couple of approaches without using a loop, but utilising Flatten and FlattenAt: FlattenAt[Insert[matrix, {vector1, vector2}, 2], 2] {{3, 4, 5}, {10, 11, 12}, {20, 21, 22}, {6, 8, 10}, {9, 12, 15}} ir[vecs_, matrix_, pos_] := Flatten[{matrix[[1 ;; pos - 1]], vecs, matrix[[pos ;; -1]]}, 1] ir[{vector1, vector2}, matrix, 2] {{3, 4, 5}, ... 4 The ding you hear is your kernel crashing, probably because you removed the recursion limit and exhausted the stack space. Once the kernel crashes, it forgets any definitions you made. 4 You can use Boole like this: xn[n_Integer?Positive] := x^Boole[OddQ[n]] 4 Format[binom[a_, b_]] := TraditionalForm@Binomial[a, b] Now binom[a, b]$a \choose b\$ and With[{a = 10, b = 5}, binom[a, b]] 252

4

Here is another possible solution which doesn't require you to use Simplify: Clear[f, a, g, r] f[arg_] := a - I arg Conjugate[g[r_]] ^:= g[r] Conjugate[f[g[r]]] (* ==> Conjugate[a] + I g[r] *) This uses UpSetDelayed to make the desired assumption part of the definitions associated with g.

4

I propose: oper[n_][fn_] := Function[Null, (fn[##] - fn @@ ReplacePart[Hold[##], n -> 0])/Slot[n], HoldAll] oper[2][f][x, y, z] (-f[x, 0, z] + f[x, y, z])/y This also works on Functions that hold their arguments, e.g.: foo = Function[Null, HoldForm[+##], HoldAll]; oper[1][foo][2 + 2, 1/0, Print[7]] (-(0+1/0+Print[7])+((2+2)+1/0+Print[7])) ...

3

You need to add an Evaluate as Plot has the attribute HoldAll. foo[f_, opts : OptionsPattern[Plot]] := Plot[f[x], Evaluate@Flatten@{x, First@OptionValue[PlotRange]}, opts] foo[# &, PlotRange -> {{-3, 3}, Automatic}]

3

There is a closely related function DifferenceDelta, which you could use as follows: op[n_][f_] := -DifferenceDelta[f[##], {#, 1, -#} &@{##}[[n]]]/{##}[[n]] & Here is an example: op[2][g][x, y, z] (* ==> (-g[x, 0, z] + g[x, y, z])/y *) The bonus question has already been answered by WReach, and I don't have anything shorter for that. ...

3

CircleDot[a_, b_] := (a + b) a b Now 4⊙3 84

3

I'm still not sure what you want but I guess you just want to pass functions as arguments. That is so trivial in Mathematica that you might just not have dared to try it. A very simplistic version of your confirm function which does a check as you have described could be written like: confirm[psi_, u_, e_, m_] := Module[{lhs, rhs, x}, lhs = -D[psi[x, ...

3

If has attribute HoldRest: Attributes[If] (* {HoldRest, Protected} *) and so the second and third arguments are not evaluated unless If chooses to do so, which, unless the first argument evaluates to True or False, it does not. You can use With to insert the defined values of f1 and f2 prior to evaluation: Clear[f, f1, f2]; f[x_] := With[{f1 = f1, f2 ...

2

Although Do or For loops with Break[] certainly works, it looks clumsy in Mathematica. Here is what I would suggest instead: checksol[psi_, u_, e_, m_] := TakeWhile[ Range[0, m + 10], Simplify[(-D[psi[x, #], {x, 2}] + u[x]*psi[x, #] == e[#] psi[x, #])] &] checksol[wavefunction, potential, energy, m] (* ==> {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, ...

1

I believe I have found something that may solve your problem. I discovered today: DataUnorderedAssociation This is an undocumented function that appears to work like Association at least in a limited set of operations, yet it puts its keys into a consistent order: DataUnorderedAssociation /@ Permutations@{"d" -> 1, "b" -> 2, "a" -> 3, "c" ...

1

Runge-Kutta Formula Implementation Options[RKSolve] = {Method -> Automatic, WorkingPrecision -> MachinePrecision}; RKSolve::badmeth = "1 is not a valid value of option 2"; RKSolve[func_, {a_, b_, h_: .1}, ya_, opts : OptionsPattern[]] := Module[{num, method, subfn, order}, method = Method /. {opts} /. Options[RKSolve]; If[ ! ...

1

Clear[f] f[n_ /; EvenQ[n] && n > 0, x_] := 1 f[n_ /; OddQ[n] && n > 0, x_] := x

1

Another workaround (inspired by Simon Rochester's observation about If's HoldRest attribute) -- make a "new" If without that attribute: If2[a_, b_, c_] := If[a, b, c]; f[x_] := If2[x < 1, f1, f2] f[x] (*If[x<1,f1,f2]*) {f1, f2} = {-1, 1}; f[x] (*If[x<1,-1,1]*) (seems safer than changing the real If!)

1

Thanks so much for the help guys. I figured I would come back and post what I settled on. Once I had it running properly I wanted to run it in parallel to speed it up. (*Checkone Function checks a Schrodinger Equation for eigenstate: num*) checkone[psi_, v_, e_, num_] := Block[{LHS, RHS, x}, LHS = -D[psi[x, num], {x, 2}] + v[x]*psi[x, num]; RHS = ...

1

Here is the method I was alluding to in a comment to DumpsterDoofus's answer: dat = {{0, 0}, {18, 1}, {70, 1/4}, {90, -1}, {110, 2}}; (* DumpsterDoofus's solution *) fd[x_] = Integrate[Interpolation[dat, InterpolationOrder -> 0][x], x]; {xa, ya} = Transpose[dat]; f1 = y /. First[DSolve[{y'[x] == First[ya] + Differences[ya].UnitStep[x - Most[xa]], ...

1

In the same spirit as Simon's answer, we can also use Unevaluated. Thread@Unevaluated@findPrime@{7, 8, 37, 127}

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