New answers tagged

1

Use RandomComplex[{-1 + -r*I, 1 + r*I}, {n^2, n^2}] instead of Table, generate a random n*n matrix is much faster than generate a random number n^2 times. MatrixExp[mat, v] equal to MatrixExp[mat].v, and MatrixExp[mat] will be use for many times. So you can store it to avoid repeating calculation. (because of the floating error, the result of MatrixExp[...


1

What about Table[x[Max[i, j], Min[i, j]], {i, 1, 6}, {j, 1, 6}] // MatrixForm


1

I'm surprised that nobody followed up on QuantumDot's suggestion to use Dt[]: With[{n = 9}, (Table[Dt[y, {x, k}], {k, n}] /. First @ Solve[Table[Dt[Sin[x] + Sin[x + y] - y, {x, k}] == 0, {k, n}], Table[Dt[y, {x, k}], {k, n}]]) /. {x -> π, y -> 0}] {-1, 0, 1/2, 0, -1/2, 0, 1/2, 0, 17}


3

In V10, you can use Association to speed this up a bit: bothA = AssociationThread[both[[All, 1]] -> both]; Lookup[bothA, v, {}] (* gives OP's output with {} for missing dates *) Lookup[bothA, v, Nothing] (* omits the {} from output *) Large example -- Update: forgot definition of dates, which had been lost; had to recompute results. dates = ...


2

Mr.Wizard has shown how memory performance is affected. I wish to illustrate various aspects of timing performance. First, Developer`ToPackedArray@Table[] takes about the same time as ConstantArray[]: v = Range@1*^6; (* all examples with Mr.Wizard's (packed) v *) With[{copt = SystemOptions["CompileOptions"]}, Internal`WithLocalSettings[ ...


2

Functions march in a comment proposed ConstantArray, and indeed this works: pQ = Developer`PackedArrayQ; toP = Developer`ToPackedArray; v = Range[5]; ConstantArray[v, 7] // pQ (* True *) Padding functions will return packed arrays with some syntax but not others: PadRight[{v}, {7, Automatic}, v] // pQ (* True *) PadRight[{{}}, ...


4

A few points to make here: Always use Listable attributes of functions, that will speed things up. When unnecessary, do not use symbolic processing, use numeric processing instead. Thus, I'll first change the data to N form, then use Listable attributes of Mean and StandardDeviation to get the result in a shorter and faster code. imgd = N@imageData; ...


5

Personally, I would prefer march's solution of using ConstantArray[] instead of the tweak I am about to show. As I noted, one should not be (re)setting system options willy-nilly, and especially if you don't know what you're doing. Thus, here is how one can localize the setting change I mentioned in the comments: With[{copt = SystemOptions["CompileOptions"]}...


9

JM commented: If you want to try things out, use Nylander's second snippet, which is using a Beeman integrator. This looks to be faster than native NDSolve[] for this specific case. Paul Nylander's code is here. Below is a modified version of his code which computes all points simultaneously using the fact that all the operations in Beeman's ...


10

I don't have any breakthrough ideas, but I am able to cut the computation time in half on my computer by optimizing the usage of NDSolve. My version of your code looks like this: X[1] = 1; X[2] = -(1/2); X[3] = -(1/2); Y[1] = 0; Y[2] = Sqrt[3]/2; Y[3] = -Sqrt[3]/2; Sol[k_, c_, h_, xo_, yo_] := NDSolve[{ x''[t] + k x'[t] + c x[t] - Sum[(X[i] - x[t])/(h^...


3

Using Raspberry Pi 3 and V10.3.1.0, I ran the following adapted benchmark code used by @bobthechemist (No overclocking or increased memory split): dft = Module[{data}, Timing[SeedRandom[1]; data = RandomReal[{}, {240000}]; Do[Fourier[data], {11}]]] ef = Module[{m1, m2}, Timing[SeedRandom[1]; m1 = RandomReal[{}, {2.2`*^5}]; m2 = RandomReal[{}, {...


4

This answer shows how to define a new NIntegrate rule that evaluates f in the list of two integrands {f[x],g[f[x]]+h[x]} only once per sampling point. The answer can be also easily modified into an answer of "NIntegrate over a list of functions". The definition of the NIntegrate rule LessEvaluationsRule given below is also aimed to be didactic and ...


4

First, NIntegrate[f1[x], {x, xmin, xmax}] usually proceeds by constructing an Experimental`NumericalFunction from the expression for f1[x]. This will circumvent an attempt to memoize f1 in the OP's manner, f1[x_] := f1[x] =.... One can prevent this by memoizing the function with ?NumericQ checks via f2[x_?NumericQ] := f2[x] = .... One thing to consider is ...


-1

Testing my comment does indicate that one can cut the number of evaluations of f[] in half easily. f[x_, y_, z_] := Module[{}, totCalls++; Exp[Sin[x]] + Cos[y + z] ] totCalls = 0; NIntegrate[ {f[x, y, z], Sqrt[f[x, y, z]] + x}, {x, 0, 10}, {y, 0, 10}, {z, 0, 10}, Method -> {"LocalAdaptive", "SymbolicProcessing" -> 0}, ...


3

I got around to actually evaluating your code and I realized that g is not remembering its values; DownValues[g] only has a length of three. The "solution" is to restrict the function to numeric values, per The difference between "SymbolicProcessing" -> 0 and restricting the function definition to numeric values only, but doing that actually ...


2

If I am not mistaken your final expression may be reduced to: Table[ { ggr[ randomList[[1]], randomList[[1 + 2 j]] ] }, {j, mm*nn} ] {{-7.01292 - 10.5223 I}, {-8.64938 - 9.92198 I}, {-10.2158 - 9.0987 I}, {-8.64938 - 9.92198 I}} Or equivalently: Array[{ggr[randomList[[1]], randomList[[1 + 2 #]]]} &, mm*nn]


1

change your last two lines to: cT[{_, a2_, a3_}] := c11[m, n, a2, a3, F3, b]; cT /@ centroidList (*{80.1567, -95.8522, 0., 0., -80.1567, 95.8522, 0., 0.}*) Is this what you want?


2

I did manage to get a 6-7 times speed up by separating the definition of psi into two integrals and experimenting with the option values. (I am not sure how significant the speed-up is... OP mentioned in the comments that 1 second is the goal.) Here are the two new functions: Clear[psi1] psi1[x_?NumericQ, y_?NumericQ, z_?NumericQ, t_?NumericQ, opts : ...


4

Probably this should be a comment to JasonB's post, but I have too little reputation to comment... Here is another version using Scan: Scan[If[f@# == 10, Return@#]&, Range[10]] (* 5 *) Returning the index of an arbitrary list: l = Range[1, 21, 2] (* {1, 3, 5, 7, 9, 11, 13, 15, 17, 19, 21} *) Scan[If[f@l[[#]] == 10, Return@#] &, Range@Length@l] (*...


3

I hesitate to add this because it's so ugly, but it works as requested. It will give the last number meeting the requirement, and will stop the first time it encounters a number that doesn't nn = 0; Scan[If[f@# <= 10, nn++, Return@nn] &, Range@10] (* 5 *)


4

TakeWhile[Range@10, f@# <= 10 &] // Length Alternative answer that might be helpful depending on the issue at hand If your list is sorted and your test is monotonic, instead of checking every list entry from the beginning you could use a binary search (divide and conquer approach) Clear@f f[x_] := (Pause@2; 2 x) (* your costly condition*) Needs["...


10

1 + LengthWhile[Range@10, f@# != 10 &] 5


13

SelectFirst would work: SelectFirst[Range[10], f[#] == 10 &] You can tell that it only executes f on indexes 1-5 if you add a Print statement to the definition: f[x_] := (Print[x]; 2 x)


2

You can use NestWhile f[x_]:=x^2; (*your function.*) NestWhile[#+1&,0,f[#+1]<10&] Which returns 3 as the last number satisfying the condition. The #+1 in the expr portion increments the iterator for the NestWhile, and the #+1 in the test tests the next value of the iterator. If the next value fails the test you get the current value of the ...


15

As is demonstrated very well in this post you can use a criteria for your pattern, thereby only applying your function as long as you are searching and not to all elements. Also there is a specific FirstPosition function. f[x_] := Module[{}, Pause[0.5]; 2 x] AbsoluteTiming[ Position[f /@ Range[10], 10, 1, 1] ] AbsoluteTiming[ FirstPosition[f /@ Range[...


3

Maybe you just want a efficient way to do this while retaining the procedural approach. If that is the case, you can consider the following: ok = True; f[x_] := If[ok, 2 x, Null]; For[i = 1, i <= 10, i++, If[f[i] == 10, (ok = False; Return[i])]] (* Return[5] *) ok = True; Position[f /@ Range[10], 10] (* {{5}} *)


0

This approach is quite different from my previous answer. Therefore I decided to separate them for clarity. Let us write first a function that for a given sample returns the probability to obtain it via the random process described in the original post. prob[ncol_, max_, len_, conf_] := Module[{cnt = ConstantArray[max, ncol], ucnt, p = 1}, Do[ ...


3

Here is the "nested Dynamic" approach the tutorial suggests. Dynamic Points special case You can't just put Dynamic in the ListPointPlot3D but you can in Graphics3D. Manipulate[Show[{ Plot3D[func[x, y], {x, 0, 2}, {y, 0, 2}, PlotPoints -> 50], Graphics3D[ {Green, PointSize[0.1], Dynamic@Point[pointsDgd3DOpt[[1 ;; nEndpoint]]]} ] ...


2

Here is an example with DynamicModule Example DynamicModule[ {data, sample, uLimit}, data = RandomReal[{-5, 5}, {1000, 3}]; sample = RandomSample[data, 300]; uLimit = 100; Column[{ Slider[Dynamic@uLimit, {1, 300, 1}, ContinuousAction -> False], Dynamic @ Show[{ ListPlot3D @ data, ListPointPlot3D[ sample[[;; uLimit]], ...


3

I use the tick method for all my demos and Manipulate. It works all the time and for all problems. It is based on the event callback method used in standard GUI frameworks. An event happens (such as moving a slider, or clicking a button) then a local action is performed, only based on that one event. Then the GUI is updated. This means no other action needs ...


2

With help from Sander Huisman on Wolfram Community: Wolram Community linkParallelisation? LaunchKernels[8] AbsoluteTiming[Length[listClassMStar = ParallelMap[StarData[m1, #] &, vars]]] My summary: The Length value on the output was coming out as 10, which really threw me. But Transpose corrected that. My computer is older with only 2 CPUs so my ...


4

The behavior you are encountering is the time taken by Mathematica evaluate all the Symbols in the System context, including definitions (and Options) that are only loaded on first use. (For one of my own encounters with this delayed loading please see Why do I have to evaluate this twice?) In a fresh Kernel observe that GraphPlot has no Options: Quit[] (...


2

Answer courtesy of Rahul: s = DiscretizeRegion[ ImplicitRegion[ Min[EuclideanDistance[{x, y, z}, #] & /@ carbonXYZ] == rc + ra, {x, y, z}], {{-1, 28}, {-2, 23}, {-5, 5}}, MaxCellMeasure -> 0.1] RandomPoint[s]


1

Not a real answer, too long to put in a comment... What I would suggest is to use smaller precision goals and restrain NIntegrate's adaptive algorithm. This way you can get an answe in a relatively short time, analyze does it make sense, and continue with refinements that require more computational time. The code below produces results under 35s on my ...


2

Here is a solution that with the help of LibraryLink: CAGDBezierSurface[pts_, u_, v_] := Module[{m, n, row, col}, {m, n} = Dimensions[pts, 2] - 1; row = BezierNonzeroBasis[m, u]; col = BezierNonzeroBasis[n, v]; bezierSurf[row, col, pts] ] pts = Table[{ Cos[2 Pi u/6] Cos[v], Sin[2 Pi u/6] Cos[v], v}, {u, 6}, {v, -1, 1, 0.5}]; f = BezierFunction[...


4

Using Graphics Using the data supplied by yourself, you could do something along the lines of: grs = Graphics[{White, Rotate[Disk[#1, #2], #3]}, Background -> Black, PlotRange -> {{-1, 1}, {-1, 1}}] & @@@ SheppLoganData; ImageAdjust@Image@Total@MapThread[ #2 ImageData[ ColorConvert[ Rasterize[Style[#, Antialiasing -> ...


7

Interestingly enough, MapThreading Cross works but is much slower: Using sample lists: list1 = Array[c, {20, 20, 20, 3}]; list2 = Array[d, {20, 20, 20, 3}]; We can perform this operation in the following two ways, using MapThread: listCrossMarch1[list1_, list2_] := MapThread[Cross, {list1, list2}, 3] listCrossMarch2[list1_, list2_] := MapThread[{#1[[2]] ...


9

How about this furious[a_, b_] := Module[{a1, a2, a3, b1, b2, b3, c}, {a1, a2, a3} = Transpose[a, {2, 3, 4, 1}]; {b1, b2, b3} = Transpose[b, {2, 3, 4, 1}]; c = {-a3 b2 + a2 b3, a3 b1 - a1 b3, -a2 b1 + a1 b2}; Transpose[c, {4, 1, 2, 3}]] Timing results (from march's answer) for version 10.4.1 list1 = RandomReal[{-1, 1}, {32, 32, 32, 3}]; list2 = ...


2

Here is a solution via the Wolfram LibraryLink technique: First, let us make a comparison between BezierNonzeroBasis[n, u] and BernsteinBasis[n, Range[0, n], u] Do[BezierNonzeroBasis[10, 0.1], {10000}] // AbsoluteTiming Do[BernsteinBasis[10, Range[0, 10], 0.1], {10000}] // AbsoluteTiming BezierNonzeroBasis[10000, 0.1]; // AbsoluteTiming ...


3

I have experienced serious memory leaks with NDSolve, NIntegrate, and FindRoot in every version of Mathematica I have owned (still on V9), perhaps over 20 years. They typically show up for me when the routine is called at a deep level in a complex program. The only cure in many cases is to remove the offending routine and write your own. For NIntegrate, ...



Top 50 recent answers are included