New answers tagged

4

This is very similar to the answer by Mr.Wizard, but avoids to introduce a named expression and therefore rewriting the function by using Condition: Replace[_, {_ /; IntegerQ[#] :> # (# - 1), _ :> #}] & /@ {1, 2, 3, x} {0, 2, 6, x} A more direct way is to use Switch: Switch[#, _Integer, # (# - 1), _, #] & /@ {1, 2, 3, x} ...


-1

Please consider this is an extended comment, as like MarcoB I don't understand what you are trying to achieve but have you seen Piecewise? For example x[t_] = Piecewise[ Evaluate@Transpose[{{1 + t, 1 - t, t}, #1[[1]] <= t < #1[[2]] & /@ Partition[Table[1 + 10*(1 - 0.9^k), {k, 0, 3}], 2, 1]}], Indeterminate] Plot[x[t], {t, 0, 4}] ...


4

It is because Attributes have UpValues(*) associated with them so at the end you are not trying to Set to Attributes[Foo] but it will be translated. You can mimic that with e.g. UpSetDelayed (^:=): ClearAll[f] Set[f[x_], attr_] ^:= SetAttributes[x, attr]; SetAttributes[f, {Protected, HoldFirst}] f = 2 Set::wrsym: Symbol f is Protected. >> ...


4

This isn't an exact answer as for how to construct NCSort. However, it is the core of my approach for generating Wick contractions. I ripped out all the bells and whistles. It helps to have some background: I do lattice QCD, and so I mostly think about quark contractions. So, if you see "quark" you can parse that as "fermion". My code is designed to ...


0

The (now obsolete?) Combinatorica package has RankPermutation, which is very poorly documented. It ranks permutations using a zero-indexing system. rankPermutation /@ {{3, 2, 1}, {1, 2, 4, 3}, {1}} {5,1,0} The function seems to be based on the code given in Computational Discrete Mathematics by Sriram Pemmaraju and Steven Skiena, p. 60. Code for ...


3

This seems pretty quick... Block[{base = ConstantArray[1, Binomial[# + 1, 2]]}, base[[Accumulate@Range[#, 2, -1] + 1]] += Range[# - 1]; Accumulate@base] & and this seems faster... Block[{r = Range[#, #^2, #]}, Join @@ Range[Subtract[r, Range[# - 1, 0, -1]], r]] &


2

This seems a different approach, exchanging Table by ConstantArray and Accumulate sieve[d_] := Module[{u = ConstantArray[1, d (d + 1)/2], o = Range[2, d], index}, index = 1 + Accumulate[Reverse[o]]; u[[index]] = o; Accumulate[u] ] However, it does not seem to perform better than the other algorithms in my notebook: AbsoluteTiming[sieve[10000];] ...


11

Just a note - any method generating the permutations and the searching will get very slow very quickly, and blow RAM soon after. Something like this s/b much more efficient (e.g., on my goof-top, for permutations of length 10, it's ~30,000X faster : pr[{}] = 1; pr[{x_, y___}] := Tr[Clip[{y}, {x, x - 1}, {1, 0}] ] Length@{y}! + pr[{y}];


1

Perhaps something like: numByPerm = Position[Permutations[Range[Length@#]], #][[1,1]] &; numByPerm /@ {{3, 2, 1}, {1, 2, 4, 3}, {1}} { 6, 2, 1}


3

Another way without Table: listN[d_]:= Join @@ NestList[d + Rest@# &, Range[d], d - 1] It performs not so bad but slower than the fastest methods.


3

different ... but slow :) f1 = SparseArray[UpperTriangularize[Partition[Range[#^2], #]]][ "NonzeroValues"] & f1 /@ {3, 4} {{1, 2, 3, 5, 6, 9}, {1, 2, 3, 4, 6, 7, 8, 11, 12, 16}} Also different but slower: f2 = Flatten[UpperTriangularize[Partition[Range[#^2], #]] /. 0 -> (## &[])] & f3 = Sort[SparseArray[{i_, j_} /; i <= j :> ...


6

This works: f[d_] := Join @@ MapThread[ Range, Transpose@Table[{(i - 1) d + i, i d}, {i, d}] ]; so f[3] {1, 2, 3, 5, 6, 9} and it's pretty fast as well: AbsoluteTiming[f[10000];] {0.410494, Null} same caveat about Join@@ vs Flatten@ as Martin Büttner by whose wise comment this can be simplified to merely: f[d_] := Join @@ Range @@@ ...


7

Whenever you're building a list with While or For, there's a good chance Table or Array can help. In this case, the solution with Table is quite simple: just use two iterators and make the bounds of the second dependent on the first iterator: list[d_] := Join @@ Table[i*d + j, {i, 0, d}, {j, i + 1, d}] The Join @@ is used to flatten the array. Flatten @ ...


3

Your ajj and bjj functions have a (j (-1 + j^2) π) in the denominator, which is zero when you sum from j=1. Consider this term, x = ajj[j, 40] (* -((40 (-2 j Cos[(j π)/2]^2 - Sin[j π] + j^2 Sin[j π] + 3 Sin[2 j π] - 3 j^2 Sin[2 j π]))/(j (-1 + j^2) π)) *) Now if you simply substitute 1 for j in the above, the system will see that zero in the ...


1

You could also use: cm[f_, s_, t_, n_] := InverseLaplaceTransform[LaplaceTransform[f, s, t]^(n + 1), t, s] (s>0): e.g. TableForm[Table[{j, cm[Exp[-a s] UnitStep[s], s, t, j]}, {j, 1, 10}], TableHeadings -> {None, {"n", "n-fold Convolution"}}]


0

Thanks to all who helped or tried to help me here, finally I found a solution. My special function was the exponential distribution but one can apply it for any arbitrary function. f[x_] = \[Lambda]*Exp[-\[Lambda]*x] UnitStep[x]; g[x_] = \[Lambda]*Exp[-\[Lambda]*x] UnitStep[x]; convi[n_] := {Do[ g[x[i]] = Convolve[f[x[i - 1]], g[x[i - 1]], x[i - 1], ...


3

As Jens says your approach is not very Mathematica-like, i.e., it doesn't make good use of Mathematica's strengths. Here is an implementation that I hope Jens would agree makes better use of those strengths. Although it is more concise than your method, it has more generality; you can pick the column where the index of the list element is inserted. ...


5

Assuming you use a list input that is appropriate for use with Insert as it appears in the function, you would only have to localize list to avoid further errors: insertColumns[list_] := Module[{l = list}, For[i = 1, i <= Dimensions[list][[1]], i++, l = Insert[l, i, {i, 3}]]; l] insertColumns[{{a1, b1, c1}, {a2, b2, c2}, {a3, b3, c3}}] (* ...


10

mat = ConstantArray[1, {4, 4}] - IdentityMatrix[4]; LinearSolve[mat, {-1, 3, 5, 8}] {6, 2, 0, -3}


12

s = {w, x, y, z}; sum = {-1, 3, 5, 8}; add = Plus @@@ Subsets[s, {3}] (* {w + x + y, w + x + z, w + y + z, x + y + z} *) Solve[add == sum, s] (* {{w -> -3, x -> 0, y -> 2, z -> 6}} *)


0

With q = {x, Φ} V = (x^2*m^2 + Φ^2*I)/2 fv = Function[{x, Φ}, Evaluate[Total[Flatten[D[V, {q}]]]]][1, pi/8] (* m^2 + (I pi)/8 *) gives the desired result, if I understand the question correctly. Addendum If, as suggested in a comment, it is necessary that x and Φ have explicit t dependence, the following can be used instead. q = {x[t], Φ[t]} V = ...


3

I'm not sure about your motivation, but the following definition seems to do what you need: BlankNullSequence (BlankSequence will work too) f[x___] := Times[x]*Log[1 - Times[x]]; Derivative[1, 0, 0][f] (*Log[1 - #1 #2 #3] #2 #3 - (#1 #2^2 #3^2)/(1 - #1 #2 #3) &*)


2

Here is the code converted to function + some corrections: function[arrays : {__?ArrayQ}] := Module[{ temp1, temp2, temp3 }, temp1 = Join @@ arrays[[{1, 2}]]; temp2 = Join @@ arrays[[{4, 5}]]; temp3 = Transpose[{ temp1[[;; , 1]], temp1[[;; , 2]] - temp2[[;; 2]] }]; {temp1, temp2, temp3} ] There is no check if appropriate ...


3

The trace shows what happens, but not why, which reasons remain obscure to me. NIntegrate internally evaluates the integrand, so ultimately the outside integral is computed on the integrand 0.5, which is the value of both a1 and a2[x]. The slower way has essentially three evaluations of NIntegrate. The faster way has only two, but it also has several extra ...


3

Simplify your functions when they are defined. G[n_, Q_, eta_] = (-1)^(n + 1)*(4 Q - 2 n + 1)! (n - 1)! (1 - eta^2)^(2 Q - n) eta^2 JacobiP[n - 1, 2, 4 Q + 1 - 2 n, 1 - 2 eta^2]/(4 Q - n)! // FullSimplify; Gnp12[n_, Q_, eta_] = (-1)^ n (4 Q - 1 - 2 n)!/((4 Q - n - 1)! (4 Q + 1 - n)!) eta^2 (n + 2)!* Sum[Binomial[n, m]*(4 Q + 1 - n ...


1

You are right István Sikari-Nágl, it is not as easy at all as it looks. f[x_] = Piecewise[{{x + π, -π < x < 0}, {x - π, 0 < x < π}}]; g = FourierSeries[f[x], x, 2] // ExpToTrig (* -2 Sin[x] - Sin[2 x] *) Edit Now I build the periodic function. Column[{ Plot[f[Mod[x,-2 Pi]], {x,-3 Pi, 3 Pi}, Exclusions -> None, ImageSize -> 250], ...


2

You have made a couple of simple mistakes. Define x1 with Set, not SetDelayed. You don't want to do the integral over and over again when you plot it. Plot x1[t], not x1. Otherwise, the t in x1 will be in a different scope than the t in the 2nd argument to Plot. F0 = 31.6*1000 (*N*); t1 = 0.0109 (*s*); m = 4200(*kg*); k = 40000; ω0 = Sqrt[k/m]; ...


2

You're not going to be able to find all the roots, because there are an infinite number of them. But you can use FindRoot directly to find any subset within a range. x = 3; eqn = BesselY[1, b] BesselJ[1, b x] - BesselJ[1, b] BesselY[1, b x] == 0; sol = FindRoot[eqn, {b, #}] & /@ Range[20] Here are the first few: Sort[DeleteDuplicates[sol[[All, 1, ...


2

x = 3; f[b_] = BesselY[1, b] BesselJ[1, b x] - BesselJ[1, b] BesselY[1, b x] ; FindInstance[{f[b]==0, 0 <= b <= 10}, b, Reals, 7] sol = b /. % // N (* {1.63562, 3.17884, 4.73809, 6.30272, 7.86971, 9.43793} *) There are only 6 real roots. You also can do it with Solve or Reduce: Solve[{f[b]==0, 0 <= b <= 10}, b, Reals] Plot[f[b], {b, 0, ...


1

The trouble with many methods is that they only work on integer inputs. Trying Alexei's answer with approximate numbers {1.0, 1.0 + 2 I, 3.0 - 5 I, 7, 9.0 + I} /. x_ /; Head[x] == Complex -> Sqrt[Re[x]^2 + Im[x]^2]*Exp[I ArcTan[Re[x], Im[x]]] (* {1., 1. + 2. I, 3. - 5. I, 7, 9. + 1. I} *) just spits back out the original answer. Also, a simpler ...


1

Try this: {1, 1 + 2 I, 3 - 5 I, 7, 9 + I} /.x_ /; Head[x] == Complex -> Sqrt[Re[x]^2 + Im[x]^2]*Exp[ArcTan[Re[x], Im[x]]] yielding (* {1, Sqrt[5] E^ArcTan[2], Sqrt[34] E^-ArcTan[5/3], 7, Sqrt[82] E^ArcTan[1/9]} *) Edit: to address your question If you want to have the argument shown as fractions of Pi sa for the angles of 45 grad or 60 ...


0

Since the arguments are rational: v = {1/10, -1 - 2 I, 3 - 5/3 I, 7, 9/10 + I}; Abs[v] Exp[I Arg[v]] {1/10, Sqrt[5] E^(I (-π + ArcTan[2])), 1/3 Sqrt[106] E^(-I ArcTan[5/9]), 7, 1/10 Sqrt[181] E^(I ArcTan[10/9])}


6

Introduction What are good (robust?, simple?, efficient?) patterns for doing this kind of code-switching? This answer outlines a development strategy that can produce robust and extensible method option handling. Conceptually and development-wise, it is not that simple, but it has been successfully applied in large software projects with complicated ...


1

You can achieve this with Inactive and Activate. f[x_, y_, z_] := x + y + z v = {4, 5, 6}; Inactivate only f with Inactive and allow v to resolve. Then Activate the result for the answer. fv = Inactive[f][Sequence @@ v] Activate[fv] Hope this helps.



Top 50 recent answers are included