Tag Info

Hot answers tagged

30

Let you have a function and an initial point f[x_] := Cos[x] x0 = 0.2; Then you can calculate a sequence seq = NestList[f, x0, 10] (* {0.2, 0.980067, 0.556967, 0.848862, 0.660838, 0.789478, \ 0.704216, 0.76212, 0.723374, 0.749577, 0.731977} *) and vizualize it with a so-called Cobweb plot p = Join @@ ({{#, #}, {##}} & @@@ Partition[seq, 2, 1]); ...


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


9

Unprotect[Sqrt]; Sqrt[x_] = "blahblah"; Protect[Sqrt]; Sqrt[2] blahblah Unprotect[Sqrt]; ClearAll[Sqrt]; Protect[Sqrt]; Sqrt[2]


8

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


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

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


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]


7

ClearAll[zeroColumns2,zeroColumns2b,zeroColumns3,zeroColumns3b]; zeroColumns2[mat_, m_ ;; n_] := ReplacePart[mat, {_, Alternatives @@ Range[m, n]} -> 0]; (* or Alternatives @@ Range @@ (m ;; n) if you want to use Span *) list1 = {{1, 2, 3, 4, 4}, {4, 5, 6, 9, 5}, {7, 3, 8, 9, 5}, {14, 3, 1, 5, 6}}; zeroColumns2[list1, 1 ;; 3] (* ...


7

An alternative approach m = RandomInteger[9, {5, 5}]; m // MatrixForm MapAt[0 &, m, {;; , 2 ;; 4}] // MatrixForm There is a pattern-based solution, but it is considerably more diffiluct zeroColumns4[mat_, s_Span] := ReplacePart[mat, {_, j_ /; s[[1]] <= j <= (s[[2]] /. All -> ∞) && (Length@s < 3 || Mod[j - s[[1]], ...


7

dottie = FindRoot[Cos[x] == x, {x, 1}] // Values // First 0.739085 Plot[{Cos[x], x}, {x, -5, 5}, Epilog -> {Red, PointSize[0.02], Point[{dottie, dottie}]}] Convergence can be seen with EvaluationMonitor {res, {evx}} = Reap[FindRoot[Cos[x] == x, {x, 0}, EvaluationMonitor :> Sow[x]]] {{x -> 0.739085}, {{0., 1., 0.750364, 0.739113, ...


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


6

I was able to speed up your code by a factor of 47,500 times faster than original. First, note that you can get a fairly good speedup just by eliminating the superfluous nested Table and Sum operators: n = 999; ak = RandomReal[{1, 10}, {1000, n}]; pimatk = RandomReal[{1, 10}, {1000, n}]; fikyj = RandomReal[{1, 10}, {1000, n}]; bk = RandomReal[{1, 10}, ...


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


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


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


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


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


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


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


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


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}


3

I understand from a comment that the use of pure functions is desired, but I think the broader question will have a broader interest. Here's a way that has a little start-up time, but whose efficiency advantage increases with size. zeroColumnsM[mat_?MatrixQ, m_ ;; n_] := With[{ncol = Last@Dimensions@mat}, mat . SparseArray[Delete[Table[{i, i} -> 1, ...


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


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


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


2

There is an internal function that might be of use here. pol = m*u*x^4*y + n*v*x^2*y^3; GroebnerBasis`DistributedTermsList[pol, {u, v, x, y}][[1]] (* Out[176]= {{{1, 0, 4, 1}, m}, {{0, 1, 2, 3}, n}} *)


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


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



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