# Tag Info

14

A fast uncompiled alternative without pattern matching is to use the NonzeroPositions property of SparseArray, as long as you're dealing with numerical data. list = RandomInteger[{1, 100}, 10^7]; Needs["GeneralUtilities"] SparseArray[Unitize[list - Max[list]] - 1]["NonzeroPositions"] // AccurateTiming (* 0.120459 *) Position[list, Max[list]] // ...

13

For a 1D list you can also use Pick[Range@Length@list, list, Max@list]

12

Original question As noted in the comments the use of Dispatch is the easiest way to make this replacement operation much faster. However taking this as an opportunity to explore other optimizations here are some examples for you to consider: (dsp = Dispatch[soln]) // RepeatedTiming // First 0.0030 Total[vars] /. dsp // RepeatedTiming {0.0038, ...

11

Approach As halirutan suggested in question 71310 we can create a custom, compiled color function and apply it using the trick Image[colorFunction@ImageData@img] on my computer with my custom avocado color function this is more than eight times faster than Colorize, taking only 0.035 seconds. How to create a fast custom color function In order to ...

9

For a one-dimensional list: compPos = Compile[{{list, _Integer, 1}, {max, _Integer}}, Block[{copy = list, i = 1}, Do[ If[ list[[j]] == max, copy[[i++]] = j], {j, Length[list]}]; copy[[1 ;; i - 1]] ], CompilationTarget -> "C" ]; Though I think Position is a good non-compiled alternative in this case, since the "pattern" ...

8

This is more of a comment than an answer but it's too long for a comment box and I hope to extend it as I learn more. My first thought was that the negative value might be preventing some optimization so I looked for a counterexample and found something surprising: Table[ With[{a = RandomInteger[{1, 100000}, 1000000 + x]}, First @ Timing @ Do[Tally[a], ...

7

My guess is that Tally preallocates a number of bins equal to 10% of the length of the list. If the need exceeds that, then it probably has to reallocate the bins, apparently in a time-consuming manner. Table[ l1 = l2 = RandomInteger[{1, max}, 10 max]; l2[[-1]] = -1; {First@Timing@Tally[l1], First@Timing@Tally[l2]}, {max, 2^Range[12, 21]}] // ...

7

It is also pretty straightforward to create your own color map. For example, the following code reads in the image, and multiplies each of the color channels by an appropriate factor, then recombines the three into a single color image. It is very fast. Change the constants (in this case, 0, 1, and 0) at will. img = ...

6

The OP's (current) definition of ncalc is unreadable and unsalvageable, so I made one up from pieces of the code. ncalc = Piecewise[{ {-21. + 294. u - 1029. u^2, u < 1/7}, {2. v (131.25 - 367.5 u + 257.25 u^2), 5/7 < u < 6/7}, {5.25, u == 6/7}, {33.8811 v^2 , u > 1/7}}, -1380.75 + 3160.5 u - 1800.75 u^2] When you set shared ...

6

It is possible to Compile Position itself for machine types (e.g. Integer or Real): posmax = Compile[{{list, _Integer, 1}}, Position[list, Max@list] ]; Performance: x = RandomInteger[{1, 100}, 10^7]; Position[x, Max@x] // Timing // First posmax[x] // Timing // First 0.44754 0.0736 With a C compiler this should be faster still; I'll find out in a ...

5

My proposal: Nearest[list -> Automatic, Max[list], {All, 0.5}] Among non-C solutions, it's slightly faster than Pickett's, but slower than Simon Woods's. list = RandomInteger[{1, 100}, 10^7]; Needs["GeneralUtilities"]; Nearest[list -> Automatic, Max[list], {All, 0.5}] // AccurateTiming SparseArray[Unitize[list - Max[list]] - ...

5

The main reason for the slowness of the magicSquare is that your failed to insist on vecterization. (you're already aware of its importance, right? ) Making use of the internal functions owning Listable attribute and treating lists as a whole as much as possible, it's not hard to come to the following: magicSquare2[n_] /; Mod[n, 4] == 0 := Module[{mat, ...

5

I propose: errorOps[n_, w_] := Module[{masks, tup}, masks = Permutations[Join @@ ConstantArray @@@ {{1, w}, {0, n - w}}]; tup = ArrayPad[{"X", "Y", "Z"} ~Tuples~ {w}, {0, {1, 0}}, "U"]; Join @@ Map[tup[[All, #]] &, 1 + masks (Accumulate /@ masks)] ] errorOps[10, 7] // Length // AbsoluteTiming {0.0406705, 262440} An alternate ...

5

As to why I do not know. Maybe the FrontEnd is too inefficient in creating thousands of output cells. Maybe people do not do this and use WriteString instead. E.g. this evaluates in 0.6 seconds on my machine $startTime = AbsoluteTime[]; Do[mybigfun[i]; WriteString["stdout", " \n", {i, Date[]}], {i, 10^4}]; AbsoluteTime[] -$startTime while this ...

4

Using the option Evaluated->True or wrapping the first argument of Plot with Evaluated gives a 100x speed-up: ls1[t_] := Quantity[10, "Nanometers"]/t Plot[ls1[Quantity[t, "Seconds"]]/Quantity[1, "SpeedOfLight"], {t, 0, 10}] // Timing ls2[t_] := Quantity[10, "Nanometers"]/t Plot[ls2[Quantity[t, "Seconds"]]/Quantity[1, "SpeedOfLight"], {t, 0, 10}, ...

4

As simple as it sound, use Set instead of delayed assignment. i.e., replace your := in the function definitions with =. First, make sure everything is safe by clearing x,y,a,b as: ClearAll[x,y,a,b] Then, define your functions as: f[x_, y_] = (Cos[x] Sin[y])/2.; (*The surface.*) fx[a_, b_] = Module[{x, y}, D[f[x, y], x] /. {x -> a, y -> b}]; ...

4

In Mathematica every inter-Kernel communication comes with significant overhead. Your simple Do loop with a shared Sow on every value is about the worst possible situation. Instead (for performance) you want to gather results within each Kernel and only pass them back to the master in a single call. (Or at least a limited number of calls.) Using linked ...

4

Here's one speed-up: Use approximate machine real inputs. Outer is a bit faster than Table here. Clear[x, y]; f[x_, y_] := (Cos[x] Sin[y])/2 (*The surface.*) df[x_, y_] = D[f[x, y], {{x, y}}]; normalVector[a_, b_] := Join[-df[a, b], {1}]; tangentVector[x_, y_, θ_] := Join[#, {df[x, y].#}] &@{Cos[θ], Sin[θ]}; xr = yr = 1; n = 20.; (* < this ...

4

Is this faster than the fastest of yours? xyz = {"X", "Y", "Z"}; ErrorOps[n_, w_] := Flatten[With[{tups = Tuples[xyz, w], R = Range[n]}, Table[R /. Join[Thread[Complement[R, i] -> j], Thread[i -> "U"]], {i, Subsets[R, {n - w}]}, {j, tups}]], 1]

3

NIntegrate does each integral separately This has been observed before: NIntegrate piecewise vector function, Nested NIntegrate of vector function. It is also clear from the following BenchmarkPlot: int[n_] := Block[{shaxis}, shaxis = Table[1.0*i, {i, 1, n}]; NIntegrate[shaxis/(x^3 + 10), {x, 0, Infinity}, Method -> {"GlobalAdaptive", Method ...

3

Select[listoffuns, Resolve[Exists[t, # == 0], Reals] &] Constructs list1 for you and Select[listoffuns, !Resolve[Exists[t, # == 0], Reals] &] constructs lists2. However the test Resolve[Exists[t, # == 0], Reals] & is computationally so expensive, that the For loop does not add any significant overhead. You'd be best off performing a refined ...

3

To convert a list of linear expressions to a matrix containing the coefficients the following is easier to write than CoefficientArrays, but seems to be a little slower: D[identity, {basis}] \left( \begin{array}{cccccc} 1 & 0 & 1 & 0 & 0 & -1 \\ 0 & 1 & 1 & 0 & 0 & 0 \\ -1 & 0 & 0 & 1 & -1 ...

2

First let's take look at your version: pixelsize = 5.3; (flatimaData = Flatten[MapIndexed[{#2[[1]] pixelsize, #2[[2]] pixelsize, #1} &, imaData, {2}], 1];) // AbsoluteTiming (* 2.44 seconds *) Now I try it with Table instead of MapIndexed: dims = Dimensions@imaData; (flatimaData2 = Flatten[ Table[{i*pixelsize, j*pixelsize, ...

2

Just for fun: f[x_, y_] := Cos[x] Sin[y]/2 grd[u_, v_] := Grad[z - f[x, y], {x, y, z}] /. {x -> u, y -> v}; tg[x0_, y0_, {a_, b_}] := With[{ru = {1, 0, D[f[x, y], x] /. {x -> x0, y -> y0}}, rv = {0, 1, D[f[x, y], y] /. {x -> x0, y -> y0}}}, a ru + b rv] tn[x_, y_, {s_, t_}] := With[{pt = {x, y, f[x, y]}}, Graphics3D[{Point[pt], ...

2

In version 10 even a single Rule will produce a Dispatch object: Dispatch[ a -> 1 ] // InputForm Dispatch[{a -> 1}] Dispatch[ a -> 1 ] // AtomQ True Association is also a hash structure and provides a comparably fast alternative to Dispatch, which an interface for adding, deleting and updating rules. In many cases Associations may be ...

2

According to a comment by @ilian, this has been fixed as of version 10.0.0. It certainly works in version 10.1, as we can see below: $Version (* 10.1.0 for Linux x86 (64-bit) (March 24, 2015) *) fC[randomdata] == (fC /@ randomdata) (* True *) totalC /@ randomdata totalC[randomdata] 2 I think this works Ordering[dat, -Count[dat, Max[dat]]] but it is actually slower than Position[dat,Max[dat]] This also works, but again, it's still slower pos1[list_, max_] := Block[{i = 1, l = Length[list]}, Last[Reap[While[i <= l, If[list[[i]] == max, CompoundExpression[Sow[i], i++], i++]]]]] ... unfortunately so is this more compact solution ... 2 Edit: revised to perform the correct operation this time! In many cases this code appears to be faster than either your own SparseArray formulation or kguler's Internal`DeleteTrailingZeros methods: unPad = MinMax /@ SparseArray[#]["AdjacencyLists"] /. pos_ :> Take @@@ Pick[{#, pos}\[Transpose], UnitStep @ pos[[All, 1]], 1] &; A few ... 1 I would do this line by line, using the ability of ReadList to read a single record via its third argument. You can then check whether you want to keep that record, and Sow it if you do. Thus, I would use something like this: importFunction[path_, columns_, maxRows_:∞] := Block[ {inputstream, record, i = 1}, inputstream = OpenRead[path]; Reap[ ... 1 One way to improve the performance of your code is to remove definitions of auxiliary functions from the bodies of function definitions. Such auxiliary functions are redefined every time the function is called. This is demonstrated by f[] := Module[{g}, g[] := SymbolName[g]; g[]] Table[f[], {4}] {"g$11401", "g$11402", "g$11403", "g\$11404"} In your ...

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