Tag Info

New answers tagged

5

You can use Table if you Clear within the loop: α = 0.2; β = 0.1; Table[ Clear[θi, pi]; θi[j_] := θi[j] = θi[j - 1] + β*pi[j - 1]; pi[j_] := pi[j] = pi[j - 1] - α*Sin[θi[j - 1] + β*pi[j - 1]]; θi[0] = Pi/4 + i/10; pi[0] = 0.8 - i/10; Table[{θi[j], pi[j]}, {j, 0, 100}], {i, 10} ] // ListPlot[#, AxesLabel -> {"θ(j)", "p(j)"}] & Using ...


3

I found an answer on StackOverflow, which I cannot reduce any further, so I'll quote: As you might well know, Mathematica loads binary MX files that implement some of its functionality. These MX files store implementations as well as definitions and attributes. This is insidious, but your Unprotect[Rule] is undone by Mathematica's newly loaded ...


5

You ought to set up functions that are indexed by i, not just looped through and reusing the same names. Why use θi when you could use θ[i]? α=0.2;β=0.1; For[i = 1, i < 10, i++, θ[i][j_] := θ[i][j] = θ[i][j - 1] + β*p[i][j - 1]; p[i][j_] := p[i][j] = p[i][j - 1] - α*Sin[θ[i][j - 1] + β*p[i][j - 1]]; θ[i][0] = Pi/4+i/10; p[i][0] = 0.8-i/10; graph[i] ...


0

I am late but just for fun another way: rcv[1] = 1 rcv[n_?IntegerQ] := (rcv[n] = rcv[Floor[n/2]]) /; Or[Mod[n, 4] == 0, Mod[n, 4] == 3] rcv[n_?IntegerQ] := rcv[n] = 2 rcv[Floor[n/2]] + 2 - Mod[n, 4] Comparing with Mr. Wizard f (I could have used any of the answers): f[1] = 1 f[n_Integer?Positive] := f[n] = With[{x = n~Mod~2}, If[OddQ[# + x], 2 ...


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


4

I'd do something like this: myfunction[V_, a_, b_, c_] := Block[{v1}, If[TrueQ[a < b] && TrueQ[b > c], Abort[], (* else *) myFunction[v1_, a, b, c] = a*v1^2 + b*v1 + c; myFunction[V, a, b, c] ]]; It is similar to my answer here. Basically, you memoize on some of the arguments.


2

Edit: revision - for this to work properly you need to evaluate the expression inside the function: myfun[a_,b_,c_]/; a < b && b > c:= myfun[a,b,c]=Function[{V}, Evaluate[ function code ] ] usage is then for example: Plot[myfun[a,b,c][V],{V,0,1}] if you need the Abort you can simply do myfun[a_,b_,c_]:=Abort[] which will ...


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


4

I guess this is too easy, but \[CenterDot], or Esc.Esc, is all set up for use as an infix operator, with no need to mess with box structures or confuse the user by changing the built-in meaning of .. You can just set CenterDot = myDot and then call a·b (* myDot[a, b] *)


2

Although I prefer kguler's method I don't want to be left out of the fun therefore: Cases[triplets, {r_, c1_, c2_} :> matrix[[r, c1 ;; c2]]]


3

you still can use MapThread. consider the example given by kguler: MapThread[matrix[[#, #2 ;; #3]] &, Transpose[triplets]]


4

You can use matrix[[#, #2 ;; #3]] & @@@ triplets A 20 by 10 example: matrix = RandomInteger[10, {20, 10}]; matrix // TableForm triplets = Flatten/@Transpose[{RandomInteger[{1, 20}, {8}], Sort/@RandomInteger[{1, 10}, {8, 2}]}] {{14, 5, 10}, {11, 4, 10}, {2, 2, 10}, {10, 8, 10}, {12, 3, 9}, {3, 3, 5}, {6, 4, 7}, {5, 5, 10}} matrix[[#, #2 ;; ...


4

You can define $r$-associated Stirling number of the second kind with the following recurrence relation (wiki): $$ S_r(n+1, k)=k\ S_r(n, k)+\binom{n}{r-1}S_r(n-r+1, k-1) $$ The corresponding definition (with necessary special cases) in Mathematica is ClearAll[S]; S[_, 0, 0] = 1; S[r_, n_, 1] /; n >= r = 1; S[r_, n_, k_] /; r > 0 && n > 0 ...


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


5

This question is closely related to: Best practice of passing a large number of parameters to functions In my answer there I gave a couple of abstractions to simplify definitions of the type you describe. I shall reiterate my approach with adjustment for your syntax. Code using listWith SetAttributes[{listWith, defWithOpts2}, HoldAll] listWith[(set : ...


2

The new cluster of Inactive, Inactivate, and Activate heads in 10.0+ were designed for exactly this task. So far as I can tell, they give approximately the same level of functionality as macros in Common Lisp. Consider the following preliminary step that exhibits the desired rewrite in inactive form, just to show the technique at work ...


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


17

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


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


5

I am guessing that you intend for a transformation into myDot[a, b] rather than myDot[a.b] and I will answer accordingly. Different output formatting would remain possible. There is not much that you can do to affect the parsing of code as that is handled by the Front End before even CellEvaluationFunction is called. To see how an expression is parsed you ...


6

Updated First, let's stop Dot from creating these box structures. MakeBoxes[Dot[x__], form_] := RowBox[{"Dot", "[", RowBox@Riffle[MakeBoxes /@ {x}, ","], "]"}] Next, let's specify that these structures should instead be interpreted as myDot: MakeExpression[RowBox@(row : {PatternSequence[_, "."] .., _}), form_] := MakeExpression[ RowBox@{"myDot", ...


1

I had a very similar problem for a system of very large number of ODEs and none of the methods proposed above worked. The main reason is that the coefficient If[x[t] >= 0, -10, 0] is a stiff function. Several bad things happen because of that. For stiff system the step size decreases substantially and it may take forever to integrate. The simplest ...


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

According to David B. Wagner's book, Power Programming with Mathematica (ch 9.3), you can define upvalues for Series. Here's how I implement it: Clear[f]; ClearAll[f]; SetAttributes[f, NumericFunction] f[x_?NumericQ] = Cos[x]/x; (*So that Series works at regular points*) Derivative[n_][f][x_] := Derivative[n][1/# Cos[#] &][x]; (*Give explicit ...


1

What you want is probaly f[x_?EvenQ] := f[x] = f[x/2] f[x_?OddQ] := f[x] = f[(x - 1)/2] + f[(x + 1)/2] f[0] = 0; f[1] = 1; DiscretePlot[f[x], {x, 100}] Here are some references that will help you understand how the above code works. http://reference.wolfram.com/language/ref/PatternTest.html ...


4

Your usage of even and odd doesn't make much sense. Use EvenQ and OddQ to test if an integer is even or odd. Also use ListPlot or DiscetePlot if your function is not continous. Your problem could be solved like this: fuscF[x_] := If[EvenQ[x], fuscF[x/2], fuscF[(x - 1)/2] + fuscF[(x + 1)/2] ]; fuscF[0] = 0; fuscF[1] = 1; ListPlot[Table[fuscF[n], ...


0

With the introduction of associations in V10, an alternative using associations might be considered. I believe it has the advantage of making the function code more readable. Clear[x, y, z]] f[arg_Association] := ArcSin[arg[x]^2 arg[y]/arg[z]] {f[<|x -> 1, y -> 3, z -> Pi|>], f[<|y -> 3, z -> Pi, x -> 1|>]} {ArcSin[3/π], ...


5

Obsolete since 1991 but ... still working and useful:) lst = {Tan, Sin, Cos, x}; Compose @@ lst (* Tan[Sin[Cos[x]]] *) or, Fold: foldF = Fold[#2[#] &, #, {##2}] & @@ Reverse@# &; foldF@lst (* Tan[Sin[Cos[x]]] *)


3

It is Composition list = {Tan, Sin, Cos, x}; (Composition @@ Most@list)@Last@list (* Tan[Sin[Cos[x]]] *)


1

Apply[Apply[Composition, Drop[%, -1]], Take[%, -1]]


2

You can force Simplify to return inequalities with head Greater and right hand side 0 by adapting the ComplexityFunction and adding a transformation function that will convert a Less expression to a Greater expression: Simplify[a<0, ComplexityFunction->(If[#[[2]]===0 && Head[#]===Greater,1,1000] LeafCount[#1]&), ...


4

The build-in D do almost what you want with NonConstants. I just add converters from f[i,j] format to D format and vice versa. $drvFunctions = {f, g, h}; fromD[expr_] := expr /. HoldPattern@D[f_[ind__] | f_, i_, _Rule] :> f[ind, i] drv[expr_, i_] := fromD@D[expr, i, NonConstants -> $drvFunctions] drv[expr_, ind__] := Fold[drv, expr, {ind}] drv[f, i] ...


2

Update I did not fully understand your question at first. I have tried like this. Unprotect[Plus, NonCommutativeMultiply]; NCM := NonCommutativeMultiply; constQ[t_] := If[TrueQ[Head[t] == Symbol], MemberQ[Attributes[t], Constant], NumberQ[t]] Drv[n_?constQ, i_] := 0 Drv[f_, i_] := f[i] Drv[n_?constQ f_, i_] := n f[i] Drv[f_[i__], j_] := f[i, j] ...


0

I feel like Series is a function that is designed and intended to give the power series (not Laurent series) expansion of a function. It does its best, so if you did something like Series[Cos[x]/x,{x,0,10}] you will get the Laurent series though. However, if you are using unspecified f[x], it will assume f[x] has a power series expansion and give it (as you ...


0

Given the numerical nature of the definitions, this problem can best be attacked using the NumericalCalculus package: Needs["NumericalCalculus`"] Chop[Normal[NSeries[f[x], {x, 0, 2}]]] (* ==> 1.00002/x - 0.5 x *) To improve the numerical accuracy of the results, you may want to adjust the WorkingPrecision and Radius options depending on the actual ...


2

In general, I'd also use Piecewise because it's clearest. However, to play devil's advocate, here is an example of where Piecewise is not the best choice (at least in Mathematica version 10.0.0): Plot[ Piecewise[{{Sin[x], {x, 0} ∈ ImplicitRegion[-1 < x < 1, {x, y}]}, {1, True}}], {x, -2, 2}] The warning here seems to be due to the fact ...


0

You can turn the message off by doing Off[Thread::tdlen] You are not really avoiding it, just putting under the carpet


0

Option 1 : Condition f[a_,b_]/;a>b := Sin[a-b]; f[a_,b_]/;a<b := Tan[a/b]; f[a_,b_]/;a==b := Cos[a+b]; Option 2 : Piecewise f[a_,b_] := Piecewise[{ {Sin[a-b], a>b}, {Tan[a/b], a<b}, {Cos[a+b], a==b} }] Option 3 : Which Which[ a>b,Sin[a-b], a<b,Tan[a/b] a==b,Cos[a+b] ] Option 4 : If If[a>b, Sin[a-b], ...


4

From testing in version 7, which I have not yet repeated in version 10, I recommend that you use your first form, as I found it to have at least a small performance advantage over Piecewise etc. I also find it very readable. If you can reformulate your function for application to vectors then the use of UnitStep etc., where possible without being overly ...


1

Your last two lines are not equivalent expressions; for proper comparisons they should have the same arguments: logGab1D[f_, a_, f0_, a0_, w_] := Exp[-(Log[2, f Abs[Chop[Cos[ a - a0]]]/f0]^2)/(2 (0.424 w)^2)] logGab1D[.7, 0, .7, 0, 1.6] (* 1. *) Exp[-(Log[2, .7 Abs[Chop[Cos[0 - 0]]]/.7]^2)/(2 (0.424 1.6)^2)] (* 1.*) logGab1D[0, 0, .7, 0, 1.6] (* ...


2

You forgot the 0 in the first f0 ClearAll[logGab1D]; logGab1D[f_, a_, f0_, a0_, w_] := Exp[-(Log[2, f0 Abs[Chop[Cos[ a - a0]]]/f0]^2)/(2 (0.424 w)^2)] logGab1D[0, 0, .7, 0, 1.6] (* 1*) but then ...What is f for?



Top 50 recent answers are included