# Tag Info

14

You can just step through $i$ and $j$ while trying to simultaneously satisfy: $$i^2+(i+1)^2=j^2+(j+1)^2+(j+2)^2$$ Just loop and if the inequality is too small on the left, increment $i$. If it's too small on the right, increment $j$. That looks like this: Clear[f, g, i, j]; f[i_] = i^2 + (i + 1)^2; g[j_] = j^2 + (j + 1)^2 + (j + 2)^2; max = 10^6; i = 1; j ...

14

There are several reasons. Firstly the built-in function has some minor overhead to check the arguments and call the appropriate internal function depending on whether the first argument is a list, a sparse array or an association. Secondly, with a packed array, LengthWhile uses compilation in an attempt to increase performance. There is some overhead in ...

14

Your test is quite synthetic: you take only few first elements. If you you have longer sequence of positive elements then build-in LengthWhile is faster lst = RandomInteger[{-1, 30000}, 100000]; rst1 = LengthWhile[lst, # >= 0 &]; // AbsoluteTiming rst2 = lengthwhile[lst, # >= 0 &]; // AbsoluteTiming rst1 == rst2 (* {0.096340, Null} *) (* ...

11

Okay, this is a bit of an embarassment. Here is a very small modification of the original code. I simply made explicit option settings, made a denominator to Sin explicitly real, that kind of thing. My tests show the same timing as the original, give or take an iota. ie = 200; ez = ConstantArray[0., {ie + 1}]; hy = ConstantArray[0., {ie}]; fdtd1d = ...

11

Update: the lhs of $i^2+(i+1)^2=j^2+(j+1)^2+(j+2)^2$ is always odd so $j$ should be even. The fastest solution I found: max = 10^12; {(Sqrt[3 + 6 (# + 1)^2] - 1)/2, #, #^2 + (# + 1)^2 + (# + 2)^2} & @@@ (2 Position[#, 0]) &@UnitStep[Abs[# - Round[#]] - 1.*^-10] &[ Sqrt[0.75 + 1.5 #^2] - 0.5] &@ Range[3., Sqrt[max/3.], 2] // ...

9

Clear[fa, ga]; fa = Total[{#, # + 1}^2] &; ga = Total[{#, # + 1, # + 2}^2] &; Update: A closed form function soln = Assuming[{C[1] ∈ Integers && C[1] >= 0 && x > 0 && y > 0}, Simplify@ Reduce[Total[{x, x + 1}^2] == Total[{y, y + 1, y + 2}^2], {x, y}, Integers]] /. C[1] -> n; ...

7

You can make the performance-limiting parts of your code run over 4000 times as fast. The original code takes 7.71 seconds on my machine when samplecount = 2000. By correctly compiling the code, the same operation takes a few milliseconds. First off, note that the line p1 = ParallelMap[f1, s]; is essentially computing PDF[gmm1, x] at a large number of ...

7

Okay, I'll go first. This is not an answer per se to the post, but more an invitation to write a fast sorting code for machine reals. That way we can get some sense of what might be feasible (showing timings of existing implementations would also be useful; I leave that for others). In Mathematica. Using Compile, of course. The point is to illustrate a few ...

6

SubsetQ is implemented in top-level using Complement[a, b] === {}. It has some overhead because it has to treat associations specially, plus it has to go through the requisite error-handling rigmarole. But has the same time complexity in the length of the first argument: But this is on the shortlist of functions to reimplement in C when we have time. ...

6

I was able to speed up your code by a factor of 47,500 times faster than original. First, note that you can get a fairly good speedup just by eliminating the superfluous nested Table and Sum operators: n = 999; ak = RandomReal[{1, 10}, {1000, n}]; pimatk = RandomReal[{1, 10}, {1000, n}]; fikyj = RandomReal[{1, 10}, {1000, n}]; bk = RandomReal[{1, 10}, ...

5

You can use Association very fast and very elegantly! p = GroupBy[testdata, First]; q[id_] := Quartiles[p[id][[All, 5]]]; KeyExistsQ[p, 5555] (* True *) q[5555] // AbsoluteTiming (* {0.000185, {28502.8, 56197.3, 88398.3}} *)

4

This is not particularly fast but works: f = (-1 + Sqrt[3 + 6 #^2])/2 &; q = IntegerQ /@ (f /@ Range[1000000]); answer = Pick[Range[1000000], q] yields the triples : {1, 11, 109, 1079, 10681, 105731} fanswer = f /@ answer {1, 13, 133, 1321, 13081, 129493} Dropping first case which is 0^2+1^2+2^2=1^2+2^2: trip = Rest[{(# - 1), #, # + 1} & /@ ...

4

If you're going to reuse the list in V9, a little preprocessing may help: t1 = GatherBy[testdata, First]; t2 = t1[[All, 1, 1]]; MapIndexed[(pos@#1 = #2[[1]]) &, t2]; selquartsNew[id_] := If[Head[pos[id]] =!= pos, Quartiles[t1[[pos[id]]][[All, 5]]], {}, {}] selquartsNew[42] // Timing (* {0., {17875.9, 34250.9, 57568.4}} *)

4

You can use ParallelCombine for this task: plot = Plot[#, {x, -10, 10}, PlotPoints -> 10] &; funcs = {Sin[x], Cos[x], Sinc[x]}; g = ParallelCombine[plot, funcs, Show] Be aware that the expressions in funcs are not held in this example. Consider using Formal Symbols for the plot variables. You can add styling with post-processing, e.g.: ...

3

Plot by itself is not parallelizable using Parallelize. You can plot each curve in a different kernel using ParallelTable and then Show the results together Show[ ParallelTable[ Plot[ Sin[a x] , {x, 0, Pi} , PlotRange -> {-1, 1} ], {a, {1, 2, 3}}]] You may need to use DistributeDefinitions so the sub-kernels know the definitions of your ...

3

my stab at it, unfortunately only a marginal improvement in time: ii=13; Clear[a, b]; b = FoldList[Times, 1, Table[ Exp[MangoldtLambda[n]], {n, 2, ii}]]; a = Prepend[Table[ Limit[ Zeta[s] Total[Exp[Divisors[n]]^(s - 1) MoebiusMu[Divisors[n]]], s -> 1], {n, 2, ii}], 1] ; Monitor[aa = Prepend[Table[ ...

2

I realized now that I included unnecessary many terms of the Dirichlet inverse of the Euler totient. Therefore a better program is: ii = 13 aa = Range[ii]*0; Monitor[Do[ Clear[A, a, b, n, k]; b = Table[Product[Exp[MangoldtLambda[n]], {n, 1, k}], {k, 1, nn}]; a = Table[ If[n == 1, 1, Limit[Zeta[s] Total[ Exp[Divisors[n]]^(s - ...

2

Update Your code appears to be from yesterday's question: My Baum-Welch algorithm is very slow. Is it due to Mathematica? Answer The nested Table[Table[Tables and nested Sum[Sum[s not only make the code hard to read, but may also have a performance hit. Without a clue as to what ak, pimatk, fikyj, bk are, and how big they are, and what n is, this is ...

2

A very clear description of a Mathematica implementation of BW is given by Robert J Frey here. He seems to not have performance issues.

1

EDIT After comments from RunnyKine... Just another approach and timing: subs[u_, v_] := Length@Intersection[u, v] == Length@v Performance: BenchmarkPlot[{count1[#, list] &, count2[#, list] &, Tally@Map[Function[x, subs[x, list]], #] &}, RandomInteger[100, {100000, #}] &, PowerRange[1, 1000], "IncludeFits" -> True, Frame -> ...

1

OK, now let me make use of the experience got from this answer. With the help of CompilationTarget -> "C" and RuntimeOptions -> "Speed" (both are indispensable), the Table approach turns out to be the most elegant and fast and universal. The 1D case: n = 10^6; a = RandomReal[1, n]; pxz = Compile[{{n, _Integer}, {a, _Real, 1}}, Table[If[n/4 + 1 ...

1

Timings below comes from version 10.0.1 under Windows. I will use this timing function: SetAttributes[timeAvg, HoldFirst] timeAvg[func_] := Do[If[# > 0.3, Return[#/5^i]] & @@ Timing@Do[func, {5^i}], {i, 0, 15}] Pick Although not as fast as pre-grouping methods Pick quite fast when used well. First transpose your data so columns are easy (and ...

1

The performance issue is that you are dynamically building several levels of tables into tables into a plot function into a manipulate. This is very slow and what you are looking for is to build the table outside the plot and outside the manipulate and only do the indexation inside. However (!!) it seems to me there is a very straightforward solution to ...

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