Tag Info

Hot answers tagged

5

Use With: Table[With[{v = varx[[i]]}, D[#1, v] &], {i, 3}]` (* {D[#1, x1] & , D[#1, x2] & , D[#1, x3] & } *) See the section "Scope" of the documentation page for With. Note that Function (&) has the attribute HoldAll, so that the value of varx[[i]] needs to be inserted into the function. The above gives a list of operators. An ...


4

There may be a better way to approach this problem. If you transform your function f[t] into the frequency domain ft[w], convolution becomes multiplication, and the iterative convolution of f[t] with itself becomes raising ft[w] to a power. Here is a simple example where f[t_] := Exp[-t^2/2]; ft[w_] := FourierTransform[f[t], t, w] Now you can plot the ...


4

This will deliver what you want on a one off and is based on your first block of code: tmp = Table[y, {30}] list = MapThread[If[#1 == #2, #1, 1] &, {list, tmp}] So to figure out what is happening you can cut and paste into different cells and repeat. What we see is the the list list accumulates the 1s -- which I guess are the accumulation of the ...


4

Table has attribute HoldAll. This means its arguments are left unevaluated: Attributes[Table] (* {HoldAll, Protected} *) Using an Evaluate will force the evaluation order to be as you desire: x = {i, 5}; Table[i, Evaluate@x] (* {1, 2, 3, 4, 5} *)


4

chainTable[expr_, itr : {sym_, __?NumericQ | {__}} ..] := Apply[Join, Map[Function[Null, Table[expr, #], HoldAll], Unevaluated@{itr}]]; SetAttributes[chainTable, HoldAll]; (* As per Jacob's comment *) chainTable[x^2, {x, 1, 9}] {1, 4, 9, 16, 25, 36, 49, 64, 81} chainTable[x^2, {x, 1, 9}, {x, 10, 90, 10}] {1, 4, 9, 16, 25, 36, 49, 64, 81, 100, 400, 900, ...


4

Plot has attributes, HoldAll, so the Sum isn't evaluated, try this: Plot[Evaluate[Sum[a^10*(-1)^(x - a), {a, 1, x}]], {x, 1, 10}] Where the sum evaluates to: before plotting: related questions/answers: Difference in Plot when using Evaluate vs when not using Evaluate How and when to use Evaluate? Behavior of expression evaluation in Plot I ...


3

I'm going to step out on the limb and answer re: what is almost certainly the "problem" - you are repeatedly evaluating to the same result, an aspect of recursive functions, so you're creating excess work. By example of Fibonacci numbers: fib[1] = 1; fib[2] = 1; fib[n_] := fib[n - 1] + fib[n - 2]; fib[5] // Timing fib[30] // Timing (* {0., 5} ...


3

Following belisarius' suggestion you might use something like: SetAttributes[f, HoldFirst] f[body_, n_Integer?Positive, m__:3] := Block[{a}, Do[body, ##] & @@ Thread[{Array[a, n], m}] ] Use: f[Print[a[1], a[2], a[3]], 3] f[Print[a[1], a[2]], 2, 4] f[Print[a[1], a[2]], 2, 5, 7] How are parameters evaluated for a Plot in Manipulate The second ...


3

Maybe this will do what you want ClearAll[q] q[1, B_, A_, f_] := f q[n_ /; n > 1, B_, A_, f_] := Block[{\[Omega]}, q[n, B, A, f] = Function[x, Evaluate[ Integrate[ q[n - 1, B, A, f][\[Omega]] f[x - \[Omega]], {\[Omega], B, A}]] ] ] Plotting q2 will now be very fast, as Mathematica will evaluate the integral for q2 to a ...


3

con[f_, g_, x_, l_, u_] := Integrate[(f /. x -> x ) (g /. x -> (y - x)), {x, l, u}]; func[u_, ll_, ul_] := Nest[con[#, PDF[NormalDistribution[], x], x, ll, ul] &, PDF[NormalDistribution[], x], u]; Using integration limits of -1 and 1: tab = Table[func[j, -1, 1], {j, 5}]; Plot[tab, {y, -3, 3}, PlotLegends -> Range[5]] gives: EDIT ...


2

Does this do what you want: cf[f_, n_] := NestList[Convolve[#1, f, x, y] /.y -> x &, f, n] Usage: f0[x_] := PDF[NormalDistribution[-2, 2], x] Then: cf[f0[x], 3] Gives: {E^(-(1/8) (2 + x)^2)/(2 Sqrt[2 \[Pi]]), E^(-(1/16) (4 + x)^2)/( 4 Sqrt[\[Pi]]), E^(-(1/24) (6 + x)^2)/(2 Sqrt[6 \[Pi]]), E^(-(1/32) (8 + x)^2)/(4 Sqrt[2 \[Pi]])} If you ...


2

Solutions: Firstly,I give a number to n n = 6; lam = Array[\[Lambda], n]; l[i_] := lam[[i]] + n - i m[i_] := n - i num = Times @@ Flatten@Table[l[i]^2 - l[j]^2, {i, 1, n - 1}, {j, i + 1, n}]; den = Times @@ Flatten@Table[m[i]^2 - m[j]^2, {i, 1, n - 1}, {j, i + 1, n}]; dimLamta = num/den Summary: We can define a united fuction to caculate it! ...


2

One way to set this up is to define: n = 6; lam = Array[λ, n]; m[n_, i_] := n - i; el[n_, i_] := lam[[i]] + n - i; Then for any j, you can calculate the product: j = 4; Product[(el[n, i]^2 - el[n, j]^2)/(m[n, i]^2 - m[n, j]^2), {i, 1, j - 1}]


2

Well, since I've been asked to answer the question in a simple way, here it is: fun:=#^2& Table[fun@i, {i, Join[Range[1, 9, 1], Range[50, 90, 10]]}] {1, 4, 9, 16, 25, 36, 49, 64, 81, 2500, 3600, 4900, 6400, 8100} Or like @Kuba said: Join[fun@Range[1,9,1],fun@Range[50,90,10]] {1, 4, 9, 16, 25, 36, 49, 64, 81, 2500, 3600, 4900, 6400, 8100}


2

Revised version It seems you don't want to use Plot, because this creates a continuous plot in the region. You want to draw the sum for integer values of x. It takes a good amount of time, but your sum can be evaluated analytically s = Sum[Binomial[x, l]*l^50*(-1)^(x - l), {l, 0, x}] (* (-(-1)^x)*x* HypergeometricPFQ[{2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, ...


2

If I understand your query, you're looking for something like: myNestedLoop[range_, vars_] := Sequence @@ Transpose[{vars, ConstantArray[range, Length@vars]}] Table[{a, b, c}, Evaluate@myNestedLoop[Range[3, 9, 3], {a, b, c}]] (* {{{{3, 3, 3}, {3, 3, 6}, {3, 3, 9}}, {{3, 6, 3}, {3, 6, 6}, {3, 6, 9}}, {{3, 9, 3}, {3, 9, 6}, {3, 9, 9}}}, ...


1

A bit of help with the first stage... f[r_,x_]:=r x-x^3; To generate a bifurcation diagram... ListPlot[ Module[{x=0.5, n=1000},Apply[Join,Table[Thread[{r,NestList[f[r,#]&,x,n][[n/2;;-1]]}],{r,0,3,0.0125}]]], Frame->True,Axes->False, ImageSize->600, PlotStyle->PointSize[Tiny]] If you start reading up on the various functions used ...


1

data = {{1749.08, 580.}, {1749.17, 626.}, {1749.25, 700.}, {1749.33, 557.}, {1749.42, 850.}, {1749.5, 835.}, {1749.58, 948.}, {1749.67, 663.}, {1751.66, 10}, {1751.77, 20}} Total /@ GatherBy[data, IntegerPart[#[[1]]] &][[All, All, 2]] (* {5759.,30} *) Note the data might be a bit ambiguous: if the month is 12, the year gets bumped to the ...


1

This was (partially answered on the mathematica-community site). Here is that posting: Without solving the problem of finding the condition where the trajectory lies within a disk. This modification of your code may help you construct a numerical technique. sol = DSolve[{y'[t] == g/(2 zf) y[t] + u z[t], z'[t] == -g + g/zf z[t] - u y[t], ...


1

I am confused by the test which has exponent 10 and the code which has exponent 50 so have dealt with both: f[x_, n_] := Total[Binomial[x, #] #^n (-1)^(x - #) & /@ Range[0, x]] Visualizing: GraphicsRow[ ListLogPlot[Table[f[x, #], {x, 1, 5}], Filling -> Axis, PlotStyle -> {Red, PointSize[0.02]}, FillingStyle -> Thick, AxesOrigin ...


1

You can use Slot (#) but the pure function (&) should be at a different position, i.e. varx = {x1, x2, x3}; Table[List[#1, varx[[i]]], {i, 3}] & @@@ {{f, g}, {h, i}} {{{f, x1}, {f, x2}, {f, x3}}, {{h, x1}, {h, x2}, {h, x3}}}


1

One way to deal with the point mass is to use the function DiracDelta to represent the discontinuity. Using your density function der[x], the integral is: c = Integrate[der[x], {x, -Infinity, Infinity}] 0.798485 So the height of the delta function must be 1-c (=0.201515). Accordingly, your PDF is: pdf[x_]:=der[x] + (1 - c) DiracDelta[x] To check, we ...


1

This appears to be a follow up of this question. As suggested altering using list will provide the intermediate results. Using: qlist[f_, g_, x_, b_, a_, n_] := Nest[Convolve[#, f (UnitStep[x - b] - UnitStep[x - a]), x, y] &, g, n] To achieve you goal and assuming k3,k2 are or will be defined your goal can be achieved: ...


1

Nest seems perfect for Newton's method. newtonStep[f_] := # - f[#]/f'[#] &; Block[{$MaxExtraPrecision = 5000}, N[Nest[newtonStep[ArcTan], 1/2, 8], 10] ] (* 8.829190025*10^-2598 *) With NestList, you can observe the convergence. newtonStep[f_] := # - f[#]/f'[#] &; Block[{$MaxExtraPrecision = 5000}, N[NestList[newtonStep[ArcTan], 1/2, 8], 10] ...


1

Of course m_goldberg has the proper mathematica-esque soluiton, but for education purpose heres a working version of your loop approach.. newton1[function_, variable_, initial_, iterations_] := Module[{p, f}, p[1] = initial; f[x_] := function /. variable -> x; Do[p[i] = p[i - 1] - f[p[i - 1]]/f'[p[i - 1]] // N;, {i, 2, ...


1

I have a hard time following your code, but it doesn't look to me that you are on the right path. Here is how I would tackle this problem. f[x_] := ArcTan[x] df[x_] = f'[x]; iterStep[x_] := x - f[x]/df[x] root = With[{n = 8}, Nest[iterStep, 1/2, n]]; Block[{$MaxExtraPrecision = 4000}, Abs @ root < 10^-2500] True Block[{$MaxExtraPrecision = 4000}, ...


1

First product: prod[k_] := Module[ {n, num, den, ind, numerator, denominator}, n = Length@k; num = (k - Range[n] + n)^2; den = n - Range[n]; ind = Flatten[Table[{i, j}, {i, 1, n - 1}, {j, i + 1, n}], 1]; numerator = Times @@ (#1 - #2 & @@@ (num[[#]] & /@ ind)); denominator = Times @@ (#1^2 - #2^2 & @@@ (den[[#]] & /@ ind)); ...


1

Easiest way -> take out $\sigma$, put everything in a Table and use $\sigma$ as the loop variable. It will make a Table of {$\sigma$,x}. Table[μ = 0.15; λ = 0.4; ρ = 1; r = 0.04; i = 3; θ = 1; κ = 0.1; (*no sigma*) γ[κ_, μ_, λ_, ρ_, σ_, r_] = (2 κ - 2 μ + 2 λ ρ σ + σ^2 + Sqrt[8 r σ^2 + (-2 κ + 2 μ - 2 λ ρ σ - σ^2)^2])/(2 \σ^2); b[κ_, ...


1

Say for $n=1$, you have defined f[{i1}] as your first experiment. For $n=2$, your experiments are defined by f[{i1,i2}], for $n=3$ the experiments are defined by f[{i1,i2,i3}] and etc, with the idea that you wish to allow $n$ such experiments. If you structure your experiments this way, then you can create a list of all experiments by m = 3; n = 3; c = ...



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