Tag Info

New answers tagged

1

k[{data_, {}}] := {} k[{data_, rulez_}] := k[{Sow@StepNTimes[data, rulez[[1]], 5], Rest@rulez}] Reap@k[{data, {M1, M2}}] (* {{}, {{StepNTimes[data, M1, 5], StepNTimes[StepNTimes[data, M1, 5], M2, 5]}}} *)


3

I'm not sure I understand what you are doing but the plots plat should be simple. We put all your results in a Table using ParallelTable to use all available cores in your CPU. data = ParallelTable[ Block[ {r = f[x, cb], fmax, xmax}, fmax = First[r]; xmax = (x /. Last[r]); {cb, xmax, fmax} ], {cb, 0, 0.3, 0.3/20}]; TableForm[N@data, ...


1

SeriesData[ a , 0 , #, 0, Length@#, 1] &@CoefficientList[#, a] &@ Integrate[Series[Cos[x], {x, 0, 3}], {x, 0, a}] second try: int = (SeriesData[a, 0, #[[1]], 0, #[[2]] + 1, 1] &@ {CoefficientList[Integrate[ Normal@# , {x, 0, a }] , a], #[[5]] }) &; int@Series[Cos[x], {x, 0, 3}] int@Series[x^4, {x, 0, 3}] ...


8

Here's a way that doesn't mess with an important system function: Clear[a, times]; m = Array[a, {3, 3}]; TensorContract[ Outer[times, Sequence @@ m] \[TensorProduct] LeviCivitaTensor[Length[m], List], Table[{i, i + Length[m]}, {i, Length[m]}]] (* times[a[1, 1], a[2, 2], a[3, 3]] - times[a[1, 1], a[2, 3], a[3, 2]] - times[a[1, 2], a[2, 1], a[3, 3]] + ...


7

In principle you can redefine safely a native function inside Block and given that Det uses Times for symbolic matrices then Block[ {Times = f}, Det[{{a, b}, {c, d}}] ] f[a, d] + f[-1, b, c] As pointed out by @Kuba and @Jens there are several limitations. A better solution would be this: newDet[m_, f_] := Activate@(Block[{ms = Length[m], Times = ...


2

I believe this question is a combination of these: Annoying display truncation of numerical results Confused by (apparent) inconsistent precision A problem about function N Specifically, for your function to work as desired most directly (and correctly) it will need to return a number or expression in arbitrary precision. This is (best) done by using ...


1

I have Mma v.8.0.0 here and it works and gives the same result as v10. Just as a reference, it works also on v9.0.1. IDK if there are versions between 7.0.1 and 8.0.0, though.


0

Using TraditionalForm[ ] does nothing?: Need to use ParameterVariables ClearAll["Global`*"] vars = {a, b, c, d}; (*Input Matrix*) A = {{a, b}, {c, d}} cp = Collect[CharacteristicPolynomial[A, x], x] TraditionalForm[cp, ParameterVariables -> vars] Reference: http://reference.wolfram.com/language/tutorial/PolynomialOrderings.html


1

There is a built-in function HodgeDual Normal@HodgeDual[{{0, -3, 2}, {3, 0, -1}, {-2, 1, 0}}] (* {-1, -2, -3} *) Normal@HodgeDual[{-1, -2, -3}] (* {{0, -3, 2}, {3, 0, -1}, {-2, 1, 0}} *)


1

As belisarius implies, Mathematica's pattern matcher matches literal expressions and not mathematical equalities. Here's another implementation: skewToq[M_] := If[ And[Dimensions[M] == {3, 3}, M == -Transpose[M]], {M[[3, 2]], M[[1, 3]], M[[2, 1]]} ] skewToq[{{0, -q3, q2}, {q3, 0, -q1}, {-q2, q1, 0}}] (* {q1, q2, q3} *) skewToq[{{0, -3, 2}, ...


3

Set your output to a variable and use in a replacement, e.g. sol = DSolve[...] or setting the output directly sol = {{y -> Function[{x}, x^2 - x^3]}}; z = First[y /. sol]; z[4] -48


4

f1[{a_, b_, ___}] := {a, f[a, b], b}; g1[{a_, B_, b_}] := {g[a, B, b], B, b}; NestList[g1[f1[#]] &, {a, b}, 2][[All, 1 ;; 2]] // TableForm (* a b g[a,f[a,b],b] f[a,b] g[g[a,f[a,b],b],f[g[a,f[a,b],b],f[a,b]],f[a,b]] f[g[a,f[a,b],b],f[a,b]] *) To get your nomenclature ...


1

This does what you want: With[{count = 3, start = {a, b}}, Most /@ NestList[Composition[Prepend[Rest@#, g@@#]&, {#[[1]], f[#[[1]], #[[2]]], #[[2]]}&], Append[start, 0], count]] Explanation: ...& defines an anonymous function. # accesses its argument, which is the list. [[n]] just ...


1

Check that your Compiler setup is actually right. To see what your CCompiler setup is right now you should load the package CCompilerDriver via Needs["CCompilerDriver"] and execute CCompilers[], which you already did. In your case mathematica shows, that the compiler is set to MVS 2012 (this is version 11.0) not version 2013 (which would be version 12.0). To ...


2

Not paticularly elegant for reading but with minimal programming effort we can write f[0] = a; f[1] = b; f[k_] := HoldForm[f[k - 1] + f[k - 2]] ff[n_] := NestList[ReleaseHold, f[n], n - 1] Example ff[7] // Column $\begin{array}{l} f[7-1]+f[7-2] \\ (f[5-1]+f[5-2])+(f[6-1]+f[6-2]) \\ (f[3-1]+f[3-2])+2 (f[4-1]+f[4-2])+(f[5-1]+f[5-2]) \\ b+3 ...


5

Alhough your function may be an example and you could use Block or Module to build your list using looping and Append, list manipulation offers great advantages. For the example of splitting a string (including WhiteSpaceCharacter) the following are ways to do it (starting with the built-in function Characters). Characters["this is"] (*mapping StringTake ...


2

Maybe using Module, something like this: functionA[string_] := Module[{stringWord, n, wordSplit}, n = 1; wordSplit = {}; stringWord = string; While[n - 1 != StringLength[stringWord], wordSplit = Append[wordSplit, StringTake[stringWord, {n, n}]] n++]; wordSplit ] Another option might be to use Block.


8

Your second argument is a function instead of a pattern. Count[{1, 1, 2, 3}, _?(# > 1.5 &)]


0

So normally I would consider a "column" of expressions to be of the form: col0={{"a"}, {"b"}, {"c"}, {"d"}} Note that Mathematica uses Row Major order. row0=First[Transpose[col0]] would extract the first column into a row list. As previously mentioned, appending to lists with AppendTo in a do loop can be expensive. Avoid if possible. Consider using ...


1

While belisarius is right that you can usually make the list you want directly with Table, I'm often in a situation where I need to build up a list with a Do loop. Say I'm numerically propagating a wave function through a series of discrete time steps and need to collect the expectation values for several operators at each time point, this is how I do it. ...


3

but it is not working The above does not describe the problem you are having. When you say not working, you need to explain how it is not working, and what you tried. I just downloaded it and I see no problem. Using V10.01, on windows. Downloaded it from http://library.wolfram.com/infocenter/MathSource/577/ Here are some examples ...


0

Perhaps MatLink is an alternative solution. http://matlink.org/


1

D[f[g[t]*h[t]], t] /. t -> 0 Derivative[1][f][ g[0] h[0]] (h[0] Derivative[1][g][0] + g[0] Derivative[1][h][0]) EDIT: I misread your post. Same approach D[f[g[t], h[t]], t] /. t -> 0 Derivative[1][h][0]* Derivative[0, 1][f][g[0], h[0]] + Derivative[1][g][0]* Derivative[1, 0][f][g[0], h[0]]


1

Since SeriesData is a documented data structure, it seems suitable to take advantage of it. We can calculate the series just once, which in this case will be more than 40 times faster than DumpsterDoofus's method and 12 times faster than Dr. Wolgang Hintze's. (It's tricky to time, since Series/SeriesData cache their results to make subsequent calls a bit ...


2

Use SeriesCoefficient. Let g[x_] := x^3/3!/(Exp[x] - 1 - 1 - x^2/2!) Then calculate the power series up to power m s[m_] := Series[g[x], {x, 0, m}] Finally, your coefficients are t[n_]:=SeriesCoefficient[s[n], n] n! Example Table[t[n], {n, 0, 10}] (* {0, 0, 0, -1, -4, -20, -140, -1155, -10696, -111132, -1285320} *) Regards, Wolfgang


4

Here's something which returns the denominators. Is this what you are looking for? Denominator[(#! SeriesCoefficient[(x^3/6)/( E^x - 1 - x - x^2/2), {x, 0, #}] & /@ Range[0, 25])] which returns {1, 4, 40, 160, 5600, 896, 19200, 76800, 14784000, 19712000, \ 512512000, 186368000, 19568640000, 6021120000, 20889600000, \ 7798784000, 71310131200000, ...


1

h[f[0]] := f[0]; h[f[1]] := f[1]; h[f[x_]] := f[x - 1] + f[x - 2]; nst[n_, num_] := Total@Nest[Cases[#, f[y_] :> h[f[y]], Infinity] &,{f[n]}, num] Testing: Table[nst[10, j], {j, 0, 9}] // TableForm


3

If you're using M10, you could do it with Inactivate (which formats more nicely in Mathematica than it does here in plain text.) Inactivate[f[7] /. #, f] &[DownValues[f]] (* Inactive[f][5] + Inactive[f][6] *) Then Nest it: Clear[step]; SetAttributes[step, HoldFirst]; step[e_] := step[e, 1] step[e_, n_] := Inactivate[Nest[Function[{x}, x /. #], e, n], ...


4

The answers are great. I wanted to add that the problem you are trying to solve fits way better with replacement rules than function definitions, so switching to those can provide a more understandable answer Clear[f]; frules = {f[0 | 1] :> 1, f[n_] :> f[n - 1] + f[n - 2]}; f[7] /. frules (* same as f[7]//ReplaceAll[frules] *) f[7] /. frules /. ...


4

Fixed the bug in original code Thanks for @Michael E2's good suggestion U_?(VectorQ[#, NumericQ] && OrderedQ[#] &) and smart solution to deal with $u_i=u_{i+1}$ $\frac{u-u_i}{u_{i+p}-u_i} and \frac{u_{i+p+1}-u}{u_{i+p+1}-u_{i+1}}$ coeff[u_, i_, j_, U_] /; U[[i]] == U[[j]] := 0; coeff[u_, i_, j_, U_] := (u - U[[i]])/(U[[j]] - U[[i]]) ...


1

This is your code for InverseLaplaceTransform. ig = (3.2526911934581187`*^7 s)/((424000.` + 923.` s) (142122.30337568675` + s^2)) I have tried using ComplexExpand . InverseLaplaceTransform[ig, s, t] // Simplify // ComplexExpand // FullSimplify or InverseLaplaceTransform[ig, s, t] // Simplify // ComplexExpand // Simplify // Chop -45.8409 ...


7

If we are willing to confine ourselves to functions like the example f which: is defined using DownValues only, and has no special attributes such as HoldAll, etc. ... then the following lifting function might be useful: ClearAll[stepper] SetAttributes[stepper, HoldAll] stepper[f_Symbol] := Module[{rules, g} , rules = Rule @@@ ...


18

One way is to use an extra argument that acts as a switch. Clear[f]; f[0] = 1; f[1] = 1; f[n_, True] := f[n - 1] + f[n - 2] Example: f7 = f[7, True] (* Out[329]= f[5] + f[6] *) To proceed another step, can do a replacement. f7 /. f[aa_] :> f[aa, True] (* Out[330]= f[3] + 2 f[4] + f[5] *) Can use Nest to repeat this n times. Nest[# /. f[aa_] ...


2

To complement some of the other answers here is one using Clip ClearAll[cutoffFuncCol]; cutoffFuncCol[threshold_, inputlist_, col_] := Module[{tmp = inputlist}, tmp[[All, col]] = Clip[tmp[[All, col]], {threshold, \[Infinity]}, {0, \[Infinity]}]; tmp] cutoffFuncCol[0.5, dataCol, 2] (* {{A, 0, 0.3}, {B, 0, 0.6}, {C, 0.9, 0.9}} *)


2

In Append[Round[100 #[[1, 1]]] -> RandomChoice[Commonest[#[[All, 2]]]]&/@ clustered, _ -> default] It seems Round[100 #[[1, 1]]] -> RandomChoice[Commonest[#[[All, 2]]]]&/@ clustered is supposed to make a list of rules. A default rule, that always matches if all the other rules don't match, is then added to the list of rules. This is what ...


3

dataCol = {{A, 0.1, 0.3}, {B, 0.4, 0.6}, {C, 0.9, 0.9}}; Adding the Attribute HoldRest to your cutoffFuncCol: ClearAll[cutoffFuncColB]; SetAttributes[cutoffFuncColB, HoldRest]; cutoffFuncColB[threshold_, inputlist_, col_] := (inputlist[[All, col]] = inputlist[[All, col]] /. {x_ /; x > threshold -> x, x_ /; x < threshold -> 0}; ...


4

Here is one way to deal with repeated entries in U. One can define a function to compute the coefficient, using one rule when $u_i = u_j$ and the general formula otherwise. One might put extra conditions on the patterns in coeff below, but if the function is called only within NBSpline, then one might assume the conditions are met. ClearAll[coeff]; ...


4

Is this the behaviour you need? Solution Unprotect[Power]; Power[0, -1] = 1 Protect[Power] Examples 0/0 0 Explanation Revert to normal Unprotect[Power]; ClearAll[Power]; Protect[Power];


0

The advantage of Derivative is that it can derivative at a particular value or derivative in general. In most cases, you can define a function like this myD[f_, lst_List, x0_List] := Derivative[Sequence @@ lst][f][Sequence @@ x0] For example, if the function is defined as f[x_, y_] := Sin[Cos[x + y]] then myD[f, {1, 1}, {a, b}] gives -Cos[a + b] ...


2

Concerning the follow-up question in a comment: ...just for curiosity, if someone knows how to impose a positive codomain to not yet known function, I would very much like to know. One way is to define the system so that x'[t] is positive whenever x[t] < 0. Then when x[t] reaches 0, it will be stuck at 0, unless x'[t] becomes positive for x[t] > ...


0

I posted the solution I found in another thread (Constraining function found by NDSolve to stay positive) and I am reposting it here for convenience. However, in your particular case the model is not complete and you need to ensure that x'[t] is identically zero when x[t]<0. Here is your model with the necessary completion. The description is below. ...


1

Something along the lines of...? Clear[f]; f[]=0; f[x_]:=(Set[f[],f[]+1]; If[f[]>=10,(Set[f[],0];-x),RandomInteger[{0,x}]]);


1

What is going on is pretty simple: Mathematica does not forget your first definition because the pattern is different. This makes sense! Assume you define the faculty fac[0] = 1; fac[n_] := fac[n - 1]*n and your second definition line would overwrite the first one. Then, nothing would work because you would have killed the end of the recursion. Your ...


1

Straightforward method One can do it very efficient without rejections and loops (100-500 times faster than posted methods) n = 10000000; r2 = 0.1; AbsoluteTiming[ choise = RandomChoice[{π r2, 1} -> {0, 1}, n]; box = RandomReal[1, {n, 2}]; circle = Transpose@{0.5 + # Cos@#2, 0.5 + # Sin@#2} &[Sqrt@RandomReal[r2, n], RandomReal[2 π, n]]; pts ...


0

fun[ex_] := Module[{v, p, m, mn, cp}, v = Variables[ex]; p = Cases[ex, Power[#, a_] :> a, Infinity] & /@ v; m = (Min /@ p); mn = (1 - Sign[#]) #/2 & /@ m; {If[Min[m] > 0, CoefficientRules[ex], cp = Times @@ MapThread[Power[#1, -#2] &, {v, mn}] ex; (#1 + mn -> #2) & @@@ CoefficientRules[Expand[cp], v]], v} ] ...


1

Nice to see how much one can do with Groebner bases. This a more elementary solution: function[pol_] := Module[{vars, v, h, aux}, vars = Variables[pol]; v = Length[vars]; h /: h[arg_]^p_ := h [p *arg]; h /: h[arg1_] h[arg2_] := h[arg1 + arg2]; (List @@ pol) /. Table[vars[[n]] -> h[UnitVector[v, n]], {n, 1, v}] /. {c_. h[arg_] :> ...


2

There is nice undocumented function {c, v} = GroebnerBasis`DistributedTermsList[2 x^3 + 3 x^(-2) y + 4 x y^2 - 5 y^(-3) + 1] (* {{{{2, 0, 0, 1}, 3}, {{0, 3, 0, 0}, 2}, {{0, 1, 0, 2}, 4}, {{0, 0, 3, 0}, -5}, {{0, 0, 0, 0}, 1}}, {1/x, x, 1/y, y}} *) Then one can simplify the result Transpose@{Transpose[c[[All, 1]].Replace[v, {# -> 1, 1/# -> -1, ...


3

This is my try that is something trick. function[eq_] := CoefficientRules[eq /. Power[a_, b_?(# < 0 &)] -> Power[a, -10^10 b]] /. a_?(# > 10^9 &) -> -a/10^10 function[2 x^3 + 3 x^(-2) y + 4 x y^2 - 5 y^(-3) + 1] {{-2, 1} -> 3, {3, 0} -> 2, {1, 2} -> 4, {0, -3} -> -5, {0, 0} -> 1}


7

You can use TrigReduce to do what you want: TrigReduce[-2 Cos[v] g[u] Sin[v] Derivative[1][g][u]] -g[u] Sin[2 v] Derivative[1][g][u]



Top 50 recent answers are included