11

Perhaps this: WithCleanup[ SetSystemOptions[ "CompileOptions" -> "TableCompileLength" -> Infinity], Table[Abs[foo[[1, 21]] - foo[[1, -20]]], {2500}]; // AbsoluteTiming, SetSystemOptions["CompileOptions" -> "TableCompileLength" -> 250] ] (* {0.006308, Null} *) Pre V12.2, use WithCleanup = Internal`...


10

First of all, it helps a great deal to define f as follows: ClearAll[f] A = Exp[M]; f[x_, y_] := (weight*Exp[-pts*x]).A.(weight*Exp[-pts*y]); Here, using SetDelayed (:=) is better than Set (=), because the latter creates a humongous symbolic expression that is very expensive to numericise. Defining A first ensures that Exp[M] is computed only once. First@...


9

There are a few things that can be improved here: Don't call {"Latitude", "Longitude"} separately in EntityValue. It's better to use the "Position" property, that returns a GeoPosition object. You also can use the entity class directly in EntityValue, without the need to send the 3143 county entities to WolframAlpha. Finally we ...


7

Included in your timing is the Part operation. Try: b = a[[1]]; Total[b, Infinity]; // RepeatedTiming


7

That's precisely what IntegerPartitions does. For example, for $n=10$ and $x=12$ we have 157 ordered solutions, IntegerPartitions[12, {10}, Range[-3, 3]] (* {{3, 3, 3, 3, 3, 3, 3, -3, -3, -3}, {3, 3, 3, 3, 3, 3, 2, -2, -3, -3}, {3, 3, 3, 3, 3, 3, 1, -1, -3, -3}, ... {2, 2, 1, 1, 1, 1, 1, 1, 1, 1}} *) If you want all ...


7

Runs in a quarter-second by reformulating as a single two-index sum: c = Compile[{{x, _Integer}}, Sum[1/Sqrt[a^2 + t^2 + (100000 - 0.7)^2] - 1/Sqrt[a^2 + t^2 + (100000 + 0.7)^2], {t, 1, x - 1}, {a, t + 1, 40000}], CompilationTarget -> "C", Parallelization -> True, RuntimeOptions -> "Speed"]; c[...


6

This runs in about a second: Needs["CCompilerDriver`"] c = Compile[{{x, _Integer}}, Block[{pover,t}, pover = 0.0; t = 1.0; While[t <= x - 1, pover = pover + Total[Table[ 1.0/Sqrt[a^2 + t^2 + (100000.0 - 0.7)^2] - 1.0/Sqrt[a^2 + t^2 + (100000.0 + 0.7)^2], {a, t + 1, 40000.0, 1}]]; t++]; ...


6

I would argue that it's not a fair comparison unless you consider the performance with NumericArray, as the default Mathematica list-of-lists has many other features regarding numeric stability, etc. that are not present in a merely list of Real32 numbers. Let me demonstrate: In your code you do something like: SeedRandom[1]; coordinates = RandomReal[10, {...


6

One way is to use multiple dispatch instead of optional arguments: X[n_, L_, power_][i_, chain_] := X[n, L, power][i, chain] = DiagonalMatrix@SparseArray@ Table[W[n]^(-IntegerDigits[a, n, 2 L][[chain*L-i+1]]*power), {a, 0, n^(2L)-1}] X[n_, L_][i_, chain_] := X[n, L, 1][i, chain] Here the memoization always happens in the full-argument form. Missing ...


5

Here's a little addition related to the performance of NumericalFunction. Suppose we have a function like func = Cos[x + y^2] Sin[x^2 - y]; A NumericalFunction may be created as follows. The first variant nf0[{x0, y0}] returns a scalar. The second variant nf1[{x0, y0}] returns a 1-vector {z0} for a given input {x0, y0}, and the reason for including it will ...


4

Break the image into r, g, b components and then use the second argument of Binarize to make the conditions different on each channel. The product of the three binary matrices is then your desired image. {r, g, b} = ColorSeparate[imgBig]; Binarize[r, {0, 0.7}] Binarize[g, {0.5, 1}] Binarize[b, {0.5, 1}] I think you'll find this is a lot faster.


4

With any version we can use foo = Table[Table[RandomComplex[], {i, 1000}], {j, 8192}]; With[{s1 = {250}, s2 = {250}, q = Abs[foo[[1, 21]] - foo[[1, -20]]]}, Table[RandomComplex[]*Table[q, s1], s2]]; // AbsoluteTiming Out[]= {0.0010452, Null} In more general case it takes about {0.144313, Null} f[i_, j_] := Abs[foo[[i, 21]] - foo[[j, -20]]] ...


4

This is not an answer to your modified request for a method that uses GeneratingFunction but does address the title question about making the process more efficient. Using your working code and because A only occurs once there are many permutations that need to be generated but then tossed. And because the resulting 96 combinations must start with either {A,...


3

You could try the following code that produces elements each with 7 groups of ```{A, B, C, C, C, C, D, D, D, D, E, E, E, E}`` data = {"A", "B", "C", "C", "C", "C", "D", "D", "D", "D", "E", "E", "E", "E"}; ...


3

If you want speed for larger upper bounds on the variables $\{x,y,z,a,b,m,n\}$, then the following is much faster than even the compiled solution by @chyanog (+1). Rewrite the original equation $1/x+1/y-1/z=0$ as $(x-z)(y-z)=z^2$, after forming a common denominator $x y z>0$, and multiplying through by it. If $r*s$ is a factorization of a given $z^2$ on ...


3

If the numbers are machine floats (complex ones), this will be fast: data3 = Compile[ {{m1, _Complex, 2}, {m2, _Complex, 2}, {m3, _Complex, 2}}, m1 . m2 . m3, RuntimeAttributes -> {Listable}, Parallelization -> True][mat1, mat2, mat3]; (If d1 is changed to d1 =300, then the OP's Table[] runs in 0.34 sec. and the above in 0.012 sec.)


3

Why not just use Solve straight? f[tot_Integer] := Solve[a1 + a2 + a3 + a4 + b1 + b2 + b3 + b4 + c1 + c2 + c3 + c4 == tot && -4 < a1 <= a2 <= a3 <= a4 < 4 && -7 < b1 <= b2 <= b3 <= b4 < 7 && -4 < c1 <= c2 <= c3 <= c4 < 4, {a1, a2, a3, a4, b1, b2, b3, b4, ...


3

[Update: I rewrote most of the text in response to the OP's comments. I suspect what I wrote originally lacked clarity. I hope I have improved it.] The extra time observed in Total[aa // First, Infinity] comes from copying the data in aa[[1]]. It resembles unpacking in that it adds time to the computation that seems unnecessary. Indeed, in unpacked ...


3

I am using the IGraph/M package for this answer. Approach 1: Generate Prüfer sequences, convert to trees, filter duplicates based on canonical labelling. In[17]:= Needs["IGraphM`"] In[18]:= n = 7; In[19]:= DeleteDuplicatesBy[ IGFromPrufer /@ Tuples[Range[n], n - 2], CanonicalGraph ] // Length // AbsoluteTiming Out[19]= {2.0961, 11} ...


2

We can use the function System`DateListPlotDump`DateTicks to generate date ticks. Its argument pattern is: System`DateListPlotDump`DateTicks[{mindate, maxdate}, ndivisons] (* or *) System`DateListPlotDump`DateTicks[{mindate, maxdate}, ndivisons, labelformat] Example: data1 = TimeSeries[{1, 1, 2, 3, 5, 8, 11}, {"Jan 1, 2015"}]; data2 = TimeSeries[{...


2

From the help of GroebnerBasis: "The Groebner basis in general depends on the ordering assigned to monomials. This ordering is affected by the ordering of the Subscript[x, i]." Therefore, there are 2 things to consider, the ordering of xi' s and the ordering of products of xi' s. Considering the order of xi's, we print the xi's and the first ...


2

Memory. Table[RotateLeft[a, {1, 1}];, {i, 1, 500}] requires to allocate and to write $1000 \times 1000 \times 500 \times 8$ bytes for storing the result, while Table[RotateLeft[a, {1, 1}][[1, 1]], {i, 1, 500}]; requires only $500 \times 8$ bytes. However, I cannot reproduce the timings with Mathematica 12 for macos. My timings are 0.413361 for the former and ...


2

Using SawtoothWave instead of TriangleWave seems to run a little faster. t = RandomReal[1, 10^6]; pulseTrain[t_, period_, duty_, phase_, a_] := 0.5 a (1 + Sign[SawtoothWave[t/period + (1 - duty/2) + phase] - (1 -duty)]); pulseTrain[t, 1, .5, 0.3, 1]; // AbsoluteTiming (* ~0.101 *) When I use TriangleWave, I have x = RandomReal[1, 10^6]; squareWaveAlt[...


2

Here's a start you may wish to work with: (* define f *) myF[z_, s_] := 1/(z^s Gamma[Sin[(Pi Gamma[z])/(2 z)]^2]) (* define the integrand *) integrand[z_, s_] := (myF[z, s] - myF[Conjugate[z], s])/( Exp[2 Pi Im@z] - 1) (* define integral expression in terms of z=x+Iy and real 0<s<1 note dz=Idy in the expression for integrating with respect ...


2

tst = Block[{x = rlist[[1]], y = rlist[[1]]}, Module[{sol = (Last[#1] &) /@ First[NDSolve[{eqs, ic}, var, {t, -tmax, tmax}]], Bsol}, Bsol = Table[Map[#1[t1] &, sol, {1}], {t1, ttlist}]; Map[(#1 . G0 . ConjugateTranspose[#1] &)[ttmesh Partition[#1 . Bsol, 2]] &, smat, {2}]]]; // AbsoluteTiming (* {0.0249631, Null} *...


2

One idea is to deform the integration contour around the singularity. For your example: f[x_] := ExpIntegralE[-5, x] - 5! x^-6 NIntegrate[f[x], {x, -1, I, 1}] -0.3767 - 2.02699*10^-13 I We can check by integrating the series approximation: g[x_] = Normal @ Series[f[x], {x, 0, 12}] NIntegrate[g[x], {x, -1, 1}] -(1/6) + x/7 - x^2/16 + x^3/54 - x^4/240 + x^5/...


2

This (also) does not directly answer your question about using GeneratingFunction but it is about 2,000 times faster than the original code and does generate all of the arrangements. This code is a bit slower to generate the number of arrangements compared to your answer using SeriesCoefficient. g[arrangement_, remaining_] := Module[{first, unique, ...


1

A feasible method(海洋之心): set = {a, b, c, d, e}; f = Times @@ DeleteDuplicates[ Flatten[Table[1/(1 - set[[i]]*set[[j]]), {i, 1, 5}, {j, 1, 5}]]] SeriesCoefficient[f, {a, 0, 1}, {b, 0, 1}, {c, 0, 4}, {d, 0, 4}, {e, 0, 4}] But I don't understand the specific principle. I hope you can provide more detailed code and explanation.


1

I think a Chebyshev method could be adapted to your workflow. I don't know what your workflow is, so I don't have any advice about that. Here's a comparison with NIntegrate and @Carl Woll's example. (ClearAll[f]; f0[x_] := ExpIntegralE[-5, x] - 5! x^-6; f[0] = SeriesCoefficient[f0[x], {x, 0, 0}]; f[0.] = N@f[0]; f[x_] = f0[x]; pp = 16 (* order*); ...


1

With "12.2.0 for Mac OS X x86 (64-bit) (December 12, 2020)" Integrate[1/Sqrt[Subscript[\[CapitalOmega], \[CapitalLambda]] + Subscript[\[CapitalOmega], m]*(1 + x)^3], {x, 0, z}] gives a solution in terms of Hypergeometric Functions: (Sqrt[Subscript[\[CapitalOmega], \[CapitalLambda]] + (1 + z)^3* Subscript[\[CapitalOmega], m]]/ Subscript[\[...


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