# Tag Info

12

You can use FoldList to generate evolution of your system. You need a function that propagates your particles in time. Every time you apply your function to state at time $t$ you obtain your state at time $t+dt$. Let's make such function for one particle in 1D. Tr1D[{x_, v_}, dt_, L_] := Module[{u, w}, u = x + v dt; {u, w} = If[u < L, {u, v}, {L - ...

10

ok, this is cheating but since your gas is non-interacting it works. 3 dimensions or 1 dimensions is the same since the collisions only change momentum in the normal direction, ie we assume point particles and no friction. A collision with a wall the only thing it does is to invert the velocity. So you can think of the particle moving at a constant speed ...

9

Slightly expanding my comment. It is a partial answer, explaining most but not all of the observed timing increase. First I show some representative timings. Note that I use 2^16-1 and 2^21-1 below, for reasons that will be explained. AbsoluteTiming[RandomInteger[2^16 - 1, 100000000];] AbsoluteTiming[RandomInteger[2^21 - 1, 100000000];] (* Out[37]= ...

9

The following is not particularly fast and could be more accurate but does make progress toward the goals set in the Question. To begin, consider the analytical properties of f, as defined in the Question. By observation, it has branch points at {I Sqrt[6/5] ξ, I Sqrt[2/5] ξ} and their conjugates. Poles are obtained by p /. ...

9

A possible approach: position[list_List] := Module[{n = 1, f}, f[x_] := f[x] = n++; f /@ Union[list]; f /@ list ]; Examples: SeedRandom[417]; list1 = RandomChoice[Range[22, 28], 4]; position[list1] (* {1, 3, 4, 2} *) SeedRandom[416]; list2 = RandomChoice[Range[22, 28], 4]; position[list2] (* {3, 1, 2, 1} *) A few timings: ...

9

Assuming your lists are positive integers as in OP, this should be quite fast, particularly if duplication is high. Fiddle with using Union vs Sort@DeleteDuplicates - each will have an advantage depending on data. Normal[SparseArray[ With[{us = Sort@DeleteDuplicates@#}, us -> Range@Length@us]][[#]]]&@yourlist For any kind of data, this s/b quick ...

8

A replacement-Rule-based approach: rankList[lst_List] := lst /. Dispatch[Thread[# -> Range@Length@#] &@ Union@lst] It's a little bit of speed-up over Xavier's solution (position): SeedRandom[416]; list3 = RandomChoice[Range[22, 28], 10^6]; rankList[list3]; // AbsoluteTiming // First position[list3]; // AbsoluteTiming // First rankList[list3] === ...

7

Append and Prepend and possibly ReplacePartare most likely slowing your code down substantially. I could not recode your stuff to work without these constructs withing the limited time I had available, nor do I understand competely why you approach the issue this way. Regardless, there is a good and clear demonstration by Philip Gregory that gives an ...

7

The following should be fast enough: myList = ReadList["infile.txt", Number, RecordLists -> True]; // AbsoluteTiming {4.64517, Null}

6

Per my comment. Assume things not defined here were as in your example: myDist = TruncatedDistribution[truncate, MultinormalDistribution[{a, b, c, d, e, f, g, h}, covariancematrix]]; myPDF[{a_, b_, c_, d_, e_, f_, g_, h_}, {i_, j_, k_, l_, m_, n_, o_, p_}] = N@PDF[myDist, {i, j, k, l, m, n, o, p}]; Just call myPDF with the lists of current ...

6

Here is an FFT approach for those interested. mFFT[lis_?VectorQ] := Module[{data, acf, len = Length @ lis}, data = Join[lis, ConstantArray[0., len]]; acf = InverseFourier[Abs[Fourier @ data]^2]; acf = Re @ acf[[1 ;; len]]/Range[len, 1., -1.]] This first half gives the position correlation function of the particle. To get the mean squared ...

6

FindRoot is slowing this down, rather than your function func. UPDATE 1 If every FindRoot evaluation step takes 1 second, and every func evaluation takes 0.02 seconds, then after 20 steps, you will have spent 20.4 seconds. Improving func's performance with 90%, hence it will now take 0,002 seconds, brings down your evaluattion time to 20.04 seconds. ...

5

Well, basically your code is designed with a less efficient algorithm. Bear in mind that Mathematica generally treats a matrix the "same" as a number, so don't spend time on computation conducted at the number level. Then we can convert your code to be running at the matrix level, where the speed is much increased. len = 20; data = RandomReal[{1, 10}, ...

5

Update My previous code had an error, it should be Total[#^2] & (sum of squares) instead of (Total@#^2) & (square of sum). The full code should look like this: data = Import["http://goo.gl/Fmm9fZ", "Table"][[1 ;; -2]]; dx = 1.9*10.^-3; data = data*dx; meanDisp[data_, dn_] := Mean[Total[#^2] & /@ Differences[data, 1, dn]]; meanStd[data_, ...

4

Not an answer, but just a collection of results on my computer (Mac OS X 11.4) The timings are in seconds as reported by AbsoluteTiming. They are in the same order as the test cases provided by OP On Mathematica 8: {1.44, 1.33, 271.7, 0.000066} On Mathematica 9: {0.62, 0.61, 9.00, 0.00012} On Mathematica 10.3: {8.82, 8.78, 8.62, 0.00006} On ...

4

Here's a million points processed in half a second: xyCoordinateCentreCircle = RandomReal[1, {1*^6, 3}]; Map[ Mean[#[[All, -1]]] &, BinLists[ xyCoordinateCentreCircle, {0, 1, 1/10}, {0, 1, 1/10}, {0, 1, 1}], {3}] // AbsoluteTiming (* {0.513721, {{{0.501417}, {0.49537},..., {0.500945}}, {{0.500364}, {0.500607},..., {0.501279}}, ...

4

To fix the memory problems you could rewrite it in a procedural style. It's probably more than a tweak, a bit ugly, and a bit slower. But you can go forever without having to worry about memory. ClearAll@fail; fail = Compile[{{m, _Integer}, {p, _Integer, 1}}, MemberQ[Mod[6 m - 3, #] & /@ p, 2] || MemberQ[Mod[6 m - 3, #] & /@ p, 4]]; ...

4

Your cube file had a very large grid ( 117*117*130 = 1779570), and 2 million points is just far too many for testing a function. So I created cube files for the electron density and electrostatic potential for the molecule furan, using a much sparser grid (around 8000 grid points instead). Here they are: Density cube file Potential cube file Now that ...

4

Without diving into your code too much, everything will run a LOT more smoothly if you use ParametricNDSolve to solve your differential equations with the parameter a: pfun = ParametricNDSolveValue[{x''[t] == -2 x[t], x[0] == a, x'[0] == 1}, x, {t, 0, 10}, {a}] position[t_, a_] := {Sin[#], Cos[#]} &@pfun[a][t] You can keep everything else the same. ...

3

I would memoize sol[a]. The Evaluate in position does nothing if it does not wrap the entire expression after the :=. It's not that important, so I would just drop it. The issue with [[1]] (or First) can be handle in sol. Here are the changes I've described: sol[a_] := sol[a] = First@NDSolve[{x''[t] == -2 x[t], x[0] == a, x'[0] == 1}, {x}, {t, 0, 10}] ...

3

If your real covariance matrix is the identity matrix, then all 8 of the random variables are independent and there's no need for the overhead of dealing with a general structure for a multivariate normal. You can construct the truncated distributions separately, generate a random sample from each, and then multiply the 8 probability densities together. ...

3

This is your definition: m = 1; u[x_, t_] = (t^\[Alpha]*x*(2*t^2 + (1 + \[Alpha])*(2 + \[Alpha])))/ Gamma[3 + \[Alpha]]; Your code makes 3.19 seconds on Mma10.4.1 DUt = FullSimplify[(1/Gamma[m - \[Alpha]])*Integrate[(t - \[Tau])^(m - \[Alpha] - 1)*D[u[x, \[Tau]], {\[Tau], m}], {\[Tau], 0, t}], Assumptions -> {m - 1 < \[Alpha] < m, t ...

2

The answer is as you suspect - when you evaluate Dot[m1, m2, m3, m4, m5, ......m1000] the process is something like this: Look at the input: Dot[m1, m2, m3, m4, m5, ......m1000] Evaluate the first matrix product, m12=m1.m2 Look at the input: Dot[m12, m3, m4, m5, ......m1000] Evaluate the first matrix product, m123=m12.m3 Look at the input: Dot[m123, m4, ...

1

There's a very nice (and more complete) solution here : http://community.wolfram.com/groups/-/m/t/490130 However, I don't understand that code. Maybe someone could built another solution from it, to be exposed here ?

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