New answers tagged

2

You can start by understanding how Apply works. For example Apply[f, {a, b, c}] f[a,b,c] So, if you need product of these three numbers, you use Apply[Times, {a, b, c}] a b c Now what remains is to find the right elements to multiply. For kth multifactorial of n it is {n,n-k,n-2k,...} which you can write as Range[n,1,-k] Your code construct the series ...


0

Here is another solution: (it's kind of cheating but it is very compact and works fine) f[x_, y_: 0, z_:"something"] := If[z==="something", {x, y, y}, {x,y,z}]


4

A cheap way to get what you want is to use Lighter[] along with "RedBlueTones" and an appropriate bell-shaped curve: LinearGradientImage[Function[x, Lighter[ColorData["RedBlueTones", x], Sech[5 (x - 1/2)]]], {300, 30}] ContourPlot[x y, {x, -1, 1}, {y, -1, 1}, ColorFunction -> (...


8

How about French = Blend[{{0, Blue}, {1/2 - 0.1, White}, {1/2 + 0.1, White}, {1, Red}}, #1] &; Then French /@ (Range[15]/15.) ContourPlot[x, {x, 0, 1}, {y, 0, 1}, ColorFunction -> French] Any variation is possible: e.g. French2 = Blend[{{0, Darker[Blue, 0.7]}, {0.15, Blue}, {1/2 - 0.05, White}, {1/2 + 0.05, White}, {0.9, Red}, {1,...


12

You can implement recursions almost in the same way you have specified them: Clear[a, b, c, s, p]; a[0] = 1.; b[0] = 1/Sqrt[2]; c[0] = 1/2; s[0] = c[0]; a[k_] := a[k] = (a[k - 1] + b[k - 1])/2; b[k_] := b[k] = Sqrt[a[k - 1] b[k - 1]]; c[k_] := c[k] = a[k]^2 - b[k]^2; s[k_] := s[k] = s[k - 1] - 2^k c[k]; p[k_] := p[k] = 2 a[k]^2/s[k]; The first 10 terms: p[#]...


5

James F. Feagin's Quantum Methods with Mathematica book has an elegant implementation of this in chapter 15.1 Commutator Algebra. It's along the lines of @Sjoerd's answer (but figured I'd provide the reference to the book above), first defining typical identities for the NonCommutativeMultiply symbol: Unprotect[NonCommutativeMultiply]; A_ ** (B_ + C_) := A *...


2

That can be done with the NCAlgebra (non-commutative algebra) package, see the documentation. Example: (* Import package *) << NC` << NCAlgebra` << NCGBX` SetNonCommutative[x, y, px, py] SetMonomialOrder[x, y, px, py] (* x to the left, p to the right *) NCSetOutput[NonCommutativeMultiply -> True] (* pretty output *) (* commutation ...


5

I think I've figured it out, but I haven't checked it super carefully so buyer beware: Unprotect[NonCommutativeMultiply]; ClearAll[NonCommutativeMultiply]; NonCommutativeMultiply[] := 1; NonCommutativeMultiply[a_] := a; NonCommutativeMultiply[first___, const_?NumericQ*b_, rest___] := const*NonCommutativeMultiply[first, b, rest]; NonCommutativeMultiply[...


0

I don't know about a package but generally, I would consider it very easy to implement. In order to compute the commutator relations mathematically, you would need to know how they operate on a wave function. Hence to compute a commutator relation for two operators A,B, you would calculate [A,B]psi. So my implementation would read: comm[a_, b_, f_] := ...


6

The immediate cure is to instead use the Chebyshev polynomial of the second kind, $U_n(x)$, in the definition: multiFactorial[x_, k_] := k^(x/k) Gamma[1 + x/k] Product[((j k^(-(j/k)))/Gamma[(j + k)/k])^ (Cos[(π (-j + x))/k]/k ChebyshevU[k - 1, ...


4

Clear["Global`*"] $Version (* "12.2.0 for Mac OS X x86 (64-bit) (December 12, 2020)" *) Treat the case for integer x as a limit. Edited to match revised question Multifactorial[x_Integer, k_Integer?Positive] := Module[{z}, Limit[k^(z/k)*Gamma[1 + z/k]* Product[((j k^(-(j/k)))/Gamma[(j + k)/k])^(1/k* Sin[Pi (z - j)] Cot[Pi*...


2

The problem is that your definitions use Set (=) rather than SetDelayed (:=) in their definitions. = evaluates its right hand side on the spot. You get away with that for function because Minimize can't do the job for unknown x and y, so evaluation does nothing. But in function2, Part extracts the first part of the Minimize expression, and that becomes the ...


3

f[x_?NumericQ, y_?NumericQ] := NMinimize[ E^(x^2 + y^2 + z^2 + w^2 + x*y + x*z + x*w + y*z + y*w + z*w), {z, w}][[1]]; f[1,1]


3

This is the definition of f in the first case: Definition[f] f[x_] := 1/2 (-E^-x + E^x) And this is the second case (with testpol): Definition[f] f[x$_] := 1/2 (-E^-x + E^x) The parameter is renamed, so the same expression is returned for all values. The following actually works: testpol[pol_] := ( r = pol; f[x_] = r; (* or f[x_]:= Evaluate[r]; *) ...


1

Define the derivatives as pure functions, like: dI1x := Derivative[1, 0][I1]; dI1y = Derivative[0, 1][I1]; dI2x := Derivative[1, 0][I2]; dI2y := Derivative[0, 1][I2]; Then e.g.: SeedRandom[1]; ibigsize = {99, 99}; isize = {20, 20}; Idata = imgen[ibigsize, isize, 1, 1]; Idata[[1, 3]][1, 1] (*-0.123381*)


9

You could change a system option to achieve your goal: SetSystemOptions["DefinitionsReordering"->None]; Clear[f] f[x__]:=Print[x] f[x_]:=x; f[x_?EvenQ]:=x^2; f[x_List]:=Length[x] DownValues[f] {HoldPattern[f[x__]] :> Print[x], HoldPattern[f[x_]] :> x, HoldPattern[f[x_?EvenQ]] :> x^2, HoldPattern[f[x_List]] :> Length[x]} Of course,...


6

An idea and a simple implementation Here is one possible way to achieve what you want: define a wrapper which would contain all your definitions, remember their original order, and reorder them after they have been evaluated: ClearAll[defineOrdered] SetAttributes[defineOrdered, HoldAll]; defineOrdered[func_Symbol, definitions__SetDelayed] := Module[{...


4

Well, I give my first shot a "C-". Here is an updated self-corrected version, for posterity. Maybe some unlucky shmuck who is working with held expressions can make use of this someplace in the future. Changes: Change pattern guard to permit replacement rules which use nested lists of rules (an allowed syntax of regular Replace) Use NonNegative ...


2

You could try the following: b' = a; Derivative[n_?Positive][a] := Derivative[n-1][Function[-Sin[b[#]]]] Then: a''[t] -a[t] Cos[b[t]]


6

The problem lies in the machine representation of numbers. Evaluate $MachinePrecision and you should get about 15.9546. That means that you can represent about 16 decimal places plus an exponent. If you look at the documentation for $MachineEpsilon, it says it "gives the difference between 1.0 and the next-nearest number representable as a machine-...


0

Well, you can sample two random numbers and use them as indices of your array: initialState[b_, i_, j_] := Module[{i2 = RandomInteger[{1, i}], j2 = RandomInteger[{1, j}], randArray = RandomChoice[{1/(1 + b), b/(1 + b)} -> {0, 1}, {i, j}]}, randArray[[i2, j2]] = 2; randArray] Unfortunately, I do not undestand the rest of your question.


8

Update: Animation of fire-spreading: ClearAll[initState, vNNeighbors, step, iterationList] initState[b_, i_, j_, pos_: Automatic] := ReplacePart[ RandomChoice[{1/(1 + b), b/(1 + b)} -> {0, 1}, {i, j}], (pos /. Automatic -> RandomChoice[Tuples[{Range@i, Range@j}]]) -> 2] vNNeighbors[dim_: {30, 30}] := AdjacencyList[NearestNeighborGraph@Tuples@...


5

Change the definition X[a_,b_] to X[a_, b_] := Module[{A = f[a], g = Function[b, 6 b]}, A + g[b]]; X[a,b] (*5 a + 6 b*) That's it !


8

I am not sure if this is what you are looking for, but this may help. You can use memoization to define f such that every time it is evaluated, it stores the value in memory: f[a_]:=f[a]=5*a Now if you call f[3] twice, the first time he will compute 5*3 = 15, and the second time he will retrieve the value he has in memory and return 15. I would also ditch ...


0

The problem is that g^2 does not represent the square of a function, that is, (g^2)[x] is not g[x]^2. The system is not set up to operate that way. A similar thing could be said about 2 g * g', namely, that * does not perform the multiplication of functions. To operate with functions, one can sometimes use Composition (@*) or pure functions. Because of ...


3

To add on to Alexei's answer: In[645]:= Clear[slow]; slow[k_] := Evaluate[FullSimplify[Gamma[k + 4]/k!]] In[647]:= DownValues[slow] Out[647]= {HoldPattern[slow[k_]] :> (1 + k) (2 + k) (3 + k)}


3

Let us see. This slow[k_] := FullSimplify[Gamma[k + 4]/k!]; AbsoluteTiming[slow[n]] (* {0.0000689, (1 + n) (2 + n) (3 + n)} *) yields the timing 6.9 10^-5 s. This is a ten times faster: faster[k_] := Evaluate[FullSimplify[Gamma[k + 4]/k!]]; AbsoluteTiming[faster[n]] (* {5.7*10^-6, (1 + n) (2 + n) (3 + n)} *) yielding 5.7 10^-6 s. This is ...


1

First question - performance penalty: I use Range to create sample data and timed the evaluation of all these forms which in the end produce exact same results on AMD Ryzen 1700 with Mathematica 12.2: data[[1 ;; Length@data ;; 1]] (* "1;L;1" *) data[[1 ;; Length@data]] (* "1;L" *) data[[1 ;; -1 ;; 1]] (* "1;-1;1&...


3

According to analytic geometry,we can calculate the normal of plane by Cross or calculate the volume of the three points by Det p1 = {5, 22, 20}; p2 = {89, 0, 89}; p3 = {-1, -1, 10}; Simplify[({x, y, z} - p3) . Cross[p1 - p3, p2 - p3] == 0] Det[{{x, y, z} - p3, p2 - p3, p1 - p3}] == 0 22873 + 1807 x + 426 y == 2064 z -22873 - 1807 x - 426 y + 2064 z == 0 ...


3

LinearModelFit[{{5, 22, 20}, {88, 0, 88}, {-1, -1, 10}}, {x, y}, {x, y}]


3

ClearAll[lazyMansPointsToPlaneFunction] lazyMansPointsToPlaneFunction[pts_][x_, y_] := #2 & @@ Reduce[RegionMember[InfinitePlane@pts][{x, y, z}], z, Reals] Examples: points = {{5, 22, 20}, {88, 0, 88}, {-1, -1, 10}}; lazyMansPointsToPlaneFunction[points][x, y] 22616/2041 + (1784 x)/2041 + (422 y)/2041 Show[Plot3D[lazyMansPointsToPlaneFunction[...


1

This will get you the coefficient values: sol = Solve[ {5 a + 22 b + c == 20, 88 a + c == 88, -a - b + c == 10}, {a, b, c} ] (* Out: {{a -> 1784/2041, b -> 422/2041, c -> 22616/2041}} *) You can then replace these values in your generic equation and solve for $z$: Reduce[a x + b y + c == z /. First@sol, z] (* Out: z == 22616/2041 + (1784 x)/...


Top 50 recent answers are included