Tag Info

Hot answers tagged

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


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


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


6

input = {b, a, c}; Perhaps Total[Map[Signature[ #[[Ordering @ input]] ] func[#] &, Permutations[input]]] (* -func[{a, b, c}] + func[{a, c, b}] + func[{b, a, c}] - func[{b, c, a}] - func[{c, a, b}] + func[{c, b, a}] *) or Total[Map[Signature[#]Signature[input] func[#] &, Permutations[input]]] (* same result *) or Signature[input] ...


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


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


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


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


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


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


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


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

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


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


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.


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


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

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


3

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


3

The problem is, that the Head of series is now Dynamic. With a simple Part you get rid of this: ListPlot[series[[1]], PlotLabel -> title] Besides, why not using Manipulate? Your problem seem perfectly suited for this: Manipulate[ forest = Range[30]; energy = Reverse[Range[30]]; Switch[choice , 1, series = forest; title = "Tree Growth" , 2, ...


3

mapping[set_] := Dispatch@Thread[set -> Range@Length@set] input = {a, b, c}; Total[Map[Signature[# /. mapping[input]] function[#] &, Permutations[input]]] (* function[{a, b, c}] - function[{a, c, b}] - function[{b, a, c}] + function[{b, c, a}] + function[{c, a, b}] - function[{c, b, a}]*)


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

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


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


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


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


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


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



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