New answers tagged

0

After a lot of trial and error, I created a function that I think is fast enough for general data science (I mean, to be applicable to millions of records). At first, I tried to create two interpolation functions: one for the gap itself (with a zero order interpolation function), and one for the values (the "PathFunction" itself). But Mathematica ...


2

Perhaps, ClearAll[inpField] inpField[arg_, fs_: 5] := InputField[arg, FieldSize -> fs, Background -> Yellow, Appearance -> "Frameless"] Interpretation[{f = {-y, -2 x}, xmin = 0, xmax = 1, ymin = 0, ymax = 1}, Panel@Row[{"StreamPlot[", inpField[Dynamic[f], 12], ", \n ", Invisible["StreamPlo"], "{x, ", inpField[Dynamic[xmin]], ",", ...


3

This is essentially the same algorithm as Leonid's but implemented in terms of Pick instead of sparse arrays: negativePositions2[lst_] := Module[{a, b}, a = Pick[Range[Length[lst]], UnitStep[lst], 0]; b = UnitStep[Differences[a]~Subtract~2]; Transpose[{Pick[a, b~Prepend~1, 1], Pick[a, b~Append~1, 1]}]]


3

Leonid's answer is as impressive as it is too advanced for me (a lot). For lesser mortals like me, not as fast but still acceptable performance: largeTest = RandomInteger[{-100,100},1000000]; a quarter of a second performance for a million length list: Transpose[{#, Append[Rest[# - 1], Length@#]}] & [FoldList[Plus, 1, Length /@ ...


7

Code Using the very fast function intervals from this post by Mr.Wizard, intervals[a_List] := {a[[Prepend[# + 1, 1]]], a[[Append[#, -1]]]}\[Transpose] &@ SparseArray[Differences@a, Automatic, 1]["AdjacencyLists"] We can write: negativePositions[lst_] := intervals[ Flatten@SparseArray[UnitStep[lst], Automatic, 1]["NonzeroPositions"] ...


1

Not a full answer, but there are other tools available, such as Outer and TensorProduct. For example, compare AbsoluteTiming[(mat1 = Table[Etc[t] mtx, {t, 0., 20, 0.01}]);] with AbsoluteTiming[(mat2 = TensorProduct[Et[Range[0., 20, 0.01]], mtx]);] TensorProduct is over twice as fast. The answers are identical: Norm[Flatten[mat1 - mat2]] // Chop


5

Update: You can go even faster with Compile, and exploit the Listable and Parallelization attributes to great effect, if you have a multi-core machine: SeedRandom[0]; cluster = RandomReal[{0, 1}, {5000, 14}]; myDistMatrix = Compile[{{point, _Real, 1}, {tr, _Real, 2}}, Total[(point - tr)^2], RuntimeOptions -> "Speed", ...


4

This is much faster: distMatCompiled = Compile[{{cluster, _Real, 2}}, Outer[Function[diff, diff.diff][#1 - #2] &, cluster, cluster, 1, 1] , CompilationTarget -> "C" ] medoidCompiled[cluster_] := Block[{distances, indexOfMin}, distances = Total@distMatCompiled[cluster]; indexOfMin = First[Ordering[distances, 1]]; {cluster[[indexOfMin]], ...


5

If you're on 10.3+, this should be faster (it's two orders of magnitude faster than your first example on my loungebook): medioid=With[{m = #, d = Tr /@ DistanceMatrix[#, DistanceFunction ->SquaredEuclideanDistance]}, {First@m[[#]], First@#} &@Pick[Range@Length@d, d, Min@d]]&;


4

I do not see an elegant solution using TimeSeriesResample or the like using ResamplingMethod or MissingDataMethod. Maybe there is something undocumented? But programming something that does what you want does look straight forward imo: (* define a function to determine the gapsize for a given time *) gapsize = Function[ {ts, time}, With[ { ...


6

Verily, this is a headache, since Table wants its iterators as Sequence rather than nested list of lists. Here is a method I used quite recently to get sufficiently fast code for this. c1c[n_] := With[{itvals = RandomReal[{0, 1}, {n, 5}]}, With[{iters = Apply[Sequence, Table[{x[j], itvals[[j]]}, {j, n}]]}, c1[n] = cCompile[{}, tTable[1, ...


7

Solution for Update1 The ellipses described by matThetaList can be plotted by Show[ParametricPlot[#[[1]].{Sin[θ], Cos[θ], 1}, {θ, 0, 2 Pi}] & /@ matThetaList, PlotRange -> All] To describe each of these four curves as an ImplicitRegion, first eliminate θ from the parametric equations given in the question, h = Total[#^2 & /@ ({Sin[θ], ...


0

It is handy to use DateString for formatting the time: SetAttributes[myAbsoluteTiming, HoldAll]; myAbsoluteTiming[calculation_] := Module[{startTime, hms, result}, startTime = SessionTime[]; result = calculation; hms = DateString[SessionTime[] - startTime, {"Hour", ":", "Minute", ":", "Second"}]; {hms, result}] It is quite efficient: ...


7

Here, I applied the discrete strategy(sampling $400$ points in a period $2\pi$) to calculate the boundary of ellipses $E_1,\cdots,E_n$. The algorithm mainly consists of four steps as follows : Using the ellipses $E_2,\cdots,E_n$ to trim the black segment of the first ellipse $E_1$; Using the ellipses $E_1,\cdots,E_{n-1}$ to trim the red segment of the last ...


3

This is a very quick-and-dirty, but gives 4X speed-up (7X with tweak for symmetry) on my crappy netbook for the n=8 case, don't have time or patience to test bigger cases to see scaling differences. Perhaps a description of what you're trying to calculate? It appears to be some combinatorial problem, there may well be a much more efficient scheme to do ...


3

As example functions I'll use x[t_] := (0.5 (1 - t^0.8)^0.625 + 0.5 t^0.5)^2 y[t_] := (0.7 (1 - t^0.8)^0.125 + 0.3 t^0.1)^10 To get the points that were calculated while plotting, one can use Reap and Sow. {plot, {tValues, xValues, yValues}} = Reap@ParametricPlot[{Sow[x[Sow[t, "t"]], "x"], Sow[y[t], "y"]}, {t, 0, 1}]; Because ParametricPlot does ...


1

So I found a method that might be of interest, but i'm not sure it's optimal. rawPlotData = ParametricPlot[{x[t], y[t]}, {t, 0, 1}][[1]]; (* get plot data *) plotData = Apply[List, rawPlotData[[1, 3, 2]]][[1]]; Index (1,3,2) of rawPlotData has a Line[-data-] object where -data- contains all the points. I don't know if this is the address for all ...


4

You just need to fully compile your function: fullycompiledBSplineSurf = Hold@Compile[{{ctrlnets, _Real, 3}, {deg1, _Integer}, {deg2, _Integer}, {knots1, _Real, 1}, {knots2, _Real, 1}, {u, _Real}, {v, _Real}}, Module[{i, j, validnets, row, col}, i = searchSpan[{deg1, knots1}, u]; j = searchSpan[{deg2, knots2}, v]; validnets ...


10

Mr.Wizard proposed that the slowness is due to the copying of the data. It seems that this intuition is correct. We can use the two different arguments passing mechanism in LibraryLink to test this conjecture. In LibraryLink, there are the "copied" passing and the "shared" passing. The copied passing copies the data from Mathematica to the library function ...


3

Perhaps something like: f = 6 + # Sin[# + Pi] - Cos[Pi #/4] &; g = # Cos[# + Pi/3]/2 - 1/12 Sin[Pi #] &; Plot[{f[t], g[t]}, {t, 0, 3 Pi}, PlotStyle -> {Red, Blue}, Mesh -> {{0}, {0}}, MeshFunctions -> {ConditionalExpression[f'[#], f''[#] < 0 && g[#] > 0] &, ConditionalExpression[g'[#], g''[#] < 0 && ...


4

I believe that on packed arrays both Dot and Times are performed by external libraries, e.g. Intel MKL, and that following Mathematica's paradigm of immutability the library does not act directly upon the original array but rather a copy. I conjecture that this copying or transport is the cause of the slow-down that you observe and that within Mathematica ...


3

So why the matrix number multiplication and addition so much slower than the matrix vector multiplication? Are there ways to speed them up? It seems that if we use SparseArray for this computation we can get ~3 times speed-up: n = 2000; tres = Table[ (Print[lth]; mtx = RandomReal[{0, 1}, {lth, lth}]; {lth, (AbsoluteTiming[ ...


1

You could introduce further conditional definitions for H which will prevent those computations whose results would end up being thrown away. For instance, you could add: H[i_, j_, k_, l_] /; (i > j || k > l) = Missing[]; As a toy example: m = Table[H[n, 2, 3, 4], {n, 1, 10}] (* Out: {(3 Sqrt[5])/128, (5 Sqrt[15])/256, Missing[], Missing[], ...


2

Here are couple of quick tips. Lets say this is your matrix mat = SparseArray[{{i_, j_} /; Abs[i - j] == 3 -> 1, {i_, i_} -> 1}, {200, 200}]; This is the conventional way to find EigenSystem Eigensystem[SparseArray[{{i_, j_} /; Abs[i - j] == 3 -> 1, {i_, i_} -> 1}, {200, 200}]]; // AbsoluteTiming {53.6551, Null} Now just change the ...


3

Here goes the benchmark for a high-end surface book with i7-6600U (2.6 up to 3.4 GHz, 4 MB cache, 15 W), which might be not quite different from surface pro 4 with intel i7-6650U (2.2 up to 3.4 GHz, 4 MB cache, 15 W). Plugged On battery


1

If the digit and month characters always appear in the exact same place you can use StringTake to extract them and a lookup table for all the conversions: a = Association@Join[ StringPadLeft[ToString[#], 2, "0"] -> # & /@ Range[0, 99], {"Jan" -> 1, "Feb" -> 2, "Mar" -> 3, "Apr" -> 4, "May" -> 5, "Jun" -> 6, "Jul" -> ...


6

If the date format is sufficiently rigid, you might try string patterns or regular expressions. AbsoluteTime[{"05-Mar-2004 10:15:00", {"Day", "-", "MonthNameShort", "-", "Year", " ", "Hour24", ":", "Minute", ":", "Second"}}] // RepeatedTiming (* {0.00043, 3287470500} *) This is about 10 times faster: months = <|"Jan" -> 1, "Feb" -> 2, ...


1

Here's my take, borrowing some code from here and here: ic = Function[x, With[{r = Round[x]}, r + Chop[x - r]], Listable]; SetAttributes[myTiming, HoldAllComplete]; myTiming[calculation_, tf : (Timing | AbsoluteTiming) : AbsoluteTiming] := Module[{timing = tf[calculation]}, Print[StringTemplate["`h` hr `m` min `s` s", ...


0

As pointed out kindly by Oleksandr I bumped into a common beginner's error. Reference to this can be found in the following links: HERE and HERE The correct way to do this, in my case, as I have vectors as variables would have been: fitcst[wlo : {_?NumericQ, _?NumericQ}, wup : {_?NumericQ, _?NumericQ}, sol_] := With[{m = 50, \[Alpha] = 2 Degree}, ...


7

You can use Interpolate to interpolate between the polygon vertices: First make sure the polygon is closed, by appending the first vertex: cyclic = Append[manualPolyPoints, First[manualPolyPoints]]; then accumulate the distance from one vertex to the next: accumulatedDistance = Rescale@Prepend[Accumulate[Norm /@ Differences[cyclic]], 0.]; then ...


1

I prefer @Karsten's approach of making a pure function that can be applied directly to format results from AbsoluteTiming, but if you're new to Mathematica this might be easier to follow: SetAttributes[myAbsoluteTiming, HoldAllComplete]; myAbsoluteTiming[calculation_] := Module[{time, result, hours, minutes, seconds, format}, {time, result} = ...


4

SetAttributes[hmsAbsTiming, HoldAllComplete]; hmsAbsTiming[calculation_] := MapAt[IntegerDigits[IntegerPart[#], MixedRadix[{24, 60, 60}]] &, AbsoluteTiming[ calculation ], 1] If you prefer a Quantity object: SetAttributes[hmsAbsTiming2, HoldAllComplete]; hmsAbsTiming2[calculation_] := MapAt[UnitConvert[Quantity[#, "Seconds"], ...


0

Here's a little one-liner without If, probably not fast on large lists: corr = (! MemberQ[elList, #] & /@ els) /. {True -> 1.13, False -> 1.0}


7

Sure, try for example: pr[14709321003111578837870501266345370175409, 2, 2] There are many things in MMA where small cases/edge cases can be done much more quickly with user code, this is one of them. The advantage here is that PowersRepresentation can handle huge cases...


1

If speed is not you concern, may be this can be worth a try common = Intersection[elList, els]; u = Map[ Position[els, # ] &, common ] ; corr[[ Flatten[u] ]] = 1.13 This can be fit in a single line, and is almost readable corr[[ Flatten[ Position[els, # ] & /@ Intersection[elList, els] ] ]] = 1.13 and will seem even more nice if you use (elList ...


11

You can rewrite your idea using If as follows: If[MemberQ[elList, #], 1., 1.13] & /@ els {1.13, 1., 1., 1.13, 1.} However you may find on larger problems that repetitive use of MemberQ is not as fast as you would like, so consider a hash table in the form of an Association, or if using an older version of Mathematica a Dispatch table. Create a ...


8

Dirichelet random variates are constructed from gamma random variates. Let $$ v_j \stackrel{\text{iid}}{\sim} \textsf{Gamma}(\alpha_j,1) $$ for $j = 1, \ldots, n$ and set $$ x_j = \frac{v_j}{\sum_{j=1}^n v_j}. $$ Then $x \sim \textsf{Dirichlet}(\alpha)$, where $x = (x_1,\ldots,x_n)$ and $\alpha = (\alpha_1,\ldots,\alpha_n)$. Gamma random variates ...


13

Here's a million points processed in half a second: SeedRandom[0]; (* updated for reproducibility *) 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.506174}, {0.497757},..., {0.50284}}, ...


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


10

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



Top 50 recent answers are included