Hot answers tagged

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}} *)


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}];


10

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


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 @ ...


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 @@@ ...


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 ...


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}}] (* ...


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} ...


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 ...


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 :> ...


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]] &


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. ...


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 ...


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) &*)


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 ...


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, ...


2

Nest[newtit @@ # &, {2, 2}, 2] {477912/142961, 2239654/428883}


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 ...


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];] ...


1

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


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"}}]


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], ...


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.


1

Why not just deconstruct the argument in the pattern without using Index at all? g[{x1_,x2_,x3_}]:=f[x1,x2,x3]


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 ...



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