Tag Info

Hot answers tagged

8

i = Module[{k = 100000, m = 5, data, dt, t}, data = (dt = .0001 + .0005 #; t = -dt; NestList[{Cos[4 #[[2]]] Cos[t += dt], Sin[#[[1]]] Sin[t]} &, RandomReal[{0, 2 π}, 2], k]) & /@ Range[0, m]; ListPlot[data, AspectRatio -> 1, PlotRange -> {{-1, 1}, .5 {-1, 1}}, Axes->None, ...


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

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

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

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


4

There are two easy approaches that come to mind. The first is to simply use MapThread. MapThread[foo, {Range[0, 4], Range[24, 32, 2]}] {foo[0, 24], foo[1, 26], foo[2, 28], foo[3, 30], foo[4, 32]} If you are collecting all results this is probably a perfectly good approach as memory is unlikely to be a problem. The second is to define the ...


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

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


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

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

If you're only using hundreds of iterations, then Table as @george2079 suggests in a comment is the simplest way to go. If you're looking at millions of iterations, then using the vectorized property of the built-in functions is more efficient. Below, 100 million values are computed in a little over 3 seconds (Mac 2.7GHz 16GB i7): V0 = 1.; ΔV = 2.; T = 5; ...


3

You can use a Table with variable iterator limit. e.g. Table[f[i, r], {i, 0, 5}, {r, {i}}] {{f[0, 0]}, {f[1, 1]}, {f[2, 2]}, {f[3, 3]}, {f[4, 4]}, {f[5, 5]}} Or Table[f[i, r], {i, 0, 5}, {r, 0, i, 2}] // TableForm f[0,0] f[1,0] f[2,0] f[2,2] f[3,0] f[3,2] f[4,0] f[4,2] f[4,4] f[5,0] f[5,2] f[5,4]


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

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

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


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

Table also supports iterating in reverse order (from the docs): Table[expr,{i,Subscript[i, min],Subscript[i, max],di}] uses steps di. Table[i, {i, 10, 1, -1}] out: {10, 9, 8, 7, 6, 5, 4, 3, 2, 1} What you want to do looks more like a recursive definition. For example: f = {382.856, 638.53, 915.482, 1192.44, 1469.39, 1746.34, 2181.91} v[8] = f[[8]]; ...


2

A basic solution, which prints one iteration per line, is (* create a temporary directory and move to it *) SetDirectory[CreateDirectory[]]; outfile = "results.txt"; (* "touch" outfile *) Put[outfile]; Do[ (* append i to outfile *) PutAppend[i, outfile], {i, 5}] FilePrint@outfile 1 2 3 4 5


2

This is what I do usually to save my result: SetDirectory["Directory"](* Sets your directory to a folder you want*) file = OpenWrite["file.dat", FormatType -> OutputForm](* Opens a file called file.dat *) Do[ F[i](* calculates what you like as a function of i *) Write[file, F[i]]; (* writes F[i] in ith line of the file*) ,{i,1,n}] Close[file]; In your ...


2

f[x_, y_, z_] := x + y + z list = Range[10]; Fold[f[1, 2, #] &, 0, list] 30 This just adds 3 at each step as can be seen from FoldList FoldList[f[1, 2, #] &, 0, list] {0, 3, 6, 9, 12, 15, 18, 21, 24, 27, 30} Fold[f[1, 2, #] &, 0, list] == FoldList[f[1, 2, #] &, 0, list][[-1]] True Or perhaps you intend Fold[f[1, 2, ...


1

As Kuba said, FoldList is what I need: FoldList[g[#1, 3] + #2 &, .5, delta]


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



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