# Tag Info

9

More recent (10.1+) versions of Mathematica feature the SequencePosition function, which can be told to stop after the first match, like so: SeedRandom[1337]; a = RandomInteger[{1, 10}, 10000]; b = {1, 7, 1}; SequencePosition[a, b, 1] // AbsoluteTiming (* {0.000175, {{88, 90}}} *) This is quite a bit faster than the MemberQ/Partition-based approach: ...

3

Opacity always gives a huge performance drop in interacting with Graphics3D. So let's skip it during interactions with Sliders using ControlActive. And of course the main thing, as noted in comments, do not calculate the same mesh each time: mesh = ConvexHullMesh[ RotationTransform[{{1, -1, 0}, {1, 0, 0}}, {0, 0, 0}]@ RotationTransform[{{1, 1, 1}, ...

4

In your present example the operation that is slow is the rasterization of the Graphics expression. This is implicitly performed by both ImageDifference[target,example1] and ColorConvert[example1, "RGB"]. By pre-rasterizing for example2 you remove this costly step and the ImageDifference is two orders of magnitude faster. If you include the rasterization ...

6

Indeed, the newt function as you wrote it freezes Mathematica at least for a minute or so (I aborted it afterwards without waiting to see if it would complete). Instead, you can prevent any attempts at symbolically evaluating the newt function by DensityPlot by restricting it to numerical arguments only: Clear[newt] newt[n_?NumericQ, z_?NumericQ] := ...

1

Say you have two vectors (I'll just make length-5 for demonstration) concatenated into a matrix a. a = RandomInteger[{0, 10}, {5, 2}]; m = NullSpace[Transpose[a]]; {MatrixForm[m], MatrixForm[a]} The Matrix m contains rows that are orthogonal to the two vectors, as you can see since m.a is the zero matrix. Hence m is a matrix whose null space is ...

1

After Reading anderstoods Comment on the Original Post I realized that I had actually constructed the projector on the space orthogonal to the span of the vectors. This led me to the simpler version. Again, if you know that your vectors are linearly independent, you don't have to kick out the vectors. But I like orthogonalizing first. v = ...

2

Not sure about what you want, but perhaps: f[v_] := v Sign[v[[-1]]]/GCD @@ v v0 = {-2, 2, 4, 6, 2, 2}; f@v0 (* {-1, 1, 2, 3, 1, 1} *)

3

There is an undocumented built in solution from the Developer context $ContextPath = Prepend[$ContextPath, "Developer"]; rules = {#, #} -> RandomReal[{}, {128, 128}] & /@ Range[48]; SparseArraySparseBlockMatrix[rules]; // RepeatedTiming (*{0.042, Null}*)

2

Note your iteration rule can be reduced to an explicit formula: $$\boldsymbol{\mathrm{w}}_{n,m}=\boldsymbol{v}+\sum_{k=2}^m f(\boldsymbol{\mathrm{A}}\cdot \boldsymbol{\mathrm{w}}_{n-1,k},\boldsymbol{\mathrm{w}}_{n-1,k})\mathrm{,\;\;(for\;}n>1\mathrm{)}$$ So we can calculate the $n$-th row of $\boldsymbol{\mathrm{w}}$ in one time by performing ...

14

You are right, it can be done in a fraction of second. One can explicitly construct an array of indexes blockArray[mat_] := SparseArray[ Tuples[Range@# - {1, 0, 0}].{Rest@#, {1, 0}, {0, 1}} &@Dimensions@mat -> Flatten@mat] Timings: matrices = RandomReal[1, {48, 128, 128}]; s1 = SparseArray@ ...

4

You can use the CanonicalGraph function in concert with DeleteDuplicatesBy: DeleteIso[gs_List] := DeleteDuplicatesBy[gs, CanonicalGraph]

14

It definitely has something to do with the Interpolation function. Evaluating tempdata = Import["http://www.inrim.it/~magni/cm.dat.gz", "Table"]; cmfunc = Interpolation[tempdata] we get the warning Interpolation::udeg: Interpolation on unstructured grids is currently only supported for InterpolationOrder->1 or InterpolationOrder->All. Order will ...

5

Before using MatrixRank remove columns/rows consisting of zeros only. Also, when a row/column contains precisely 1 non-zero element, delete the corresponding column/row that contains the non-zero element and count one rank. mat = D[Union@Flatten@CoefficientList[f,{z0,z1,z2}], {coefficients}] rank[m_] := Module[{rank = 0, mat = m, c1, c2}, ...

7

Before going into the issues you mention I'd like to point out the following in your code: An expression of the form: nnff[#] & /@ test can be simplified to nnff /@ test here. The NearestFunction generated by Nearest is effectively Listable, as shown in its documentation: "Nearest[...][{x1, x2, ...}] gives a list of the elements closest to each of the ...

3

Let me first start with a cleaned up version of your evol2: Clear@evol3 evol3[mat_, initial_, ti_, tf_] := Module[{dt = (tf - ti)/10, res = col[initial]}, Do[res = MatrixExp[-I*mat, res], {t, ti, tf, dt}]; squ[res]]; Note that you don't need the complicated way to substitute numerical values for t, as Do uses Block internally which does this for ...

1

Let me at least show you how to avoid the Do loop while I think about other possible improvements. The idiomatic way is to use Fold. Here is my version: evol3[mat_, initial_, ti_, tf_] := Module[{dt = (tf - ti)/10, res = col[initial], ar = ArrayRules[mat]}, squ[Fold[ MatrixExp[-I*SparseArray[ar /. t -> #2, Dimensions[mat]], #1] &, ...

2

mind[l1_List, l2_List] := MinimalBy[Table[{k, First@Nearest[l1, k]}, {k, l2}], Norm] RepeatedTiming[mind[testlist1, testlist2]] (* {0.0061, {{0.0057, 0.}}} *) For huge lists you may change Table for ParallelTable

7

DistanceMatrix is fast. It evaluates multiple times in the SameTest. If you rewrite your code, you can see the difference: min=Min[DistanceMatrix[testlist1,testlist2]];//AbsoluteTiming {0.000501174,Null} Intersection[testlist1,testlist2,SameTest->(Abs[#1-#2]<=min&)]//AbsoluteTiming {0.0236643,{0.5}} VS original code ...

0

Just for something different: tab=Join @@ (Tuples[{{#}, Range[-#, #]}] & /@ Range[2]); g[a_, b_] := Times @@ (1 - Unitize[a - b]) Outer[g, tab, tab, 1] // MatrixForm

0

Because the indices i and j are computed similarly, one would expect ar to be a symmetric matrix, but on my four-processor PC it is not. $Version (* "10.3.0 for Microsoft Windows (64-bit) (October 9, 2015)" *) (* {{0, 0, 0, 0, 0, 0, 0, 0}, {0, 1, 0, 0, 0, 0, 0, 0}, {0, 0, 1, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 1, 0}, {0, 0, 0, 0, 0, 0, ... 0 I keep improving my version **First version **, by separate Transpose[base] and Change the way Transpose act, time reduce from 4.52389 sec to 2.57898 sec Clear[lattice]; lattice[basisvec_List, numofcell_List, base_List] := (tmptmp = Transpose[base]; Flatten[ Transpose[(# + tmptmp) & /@ (Tuples[ Range /@ numofcell].basisvec), {1, 3, 2}], ... 0 This appears to be faster, dealing with the x and y coordinate lists separately: lattice2[basisvec_List, numofcell_List, base_List] := Module[{x, y, basex, basey}, {x, y} = Transpose[Tuples[Range /@ numofcell].basisvec]; {basex, basey} = Transpose[base]; Transpose[{Join @@ ((x + #) & /@ basex), Join @@ ((y + #) & /@ basey)}]] 4 This does not solve the problem, but provides some additional observations. As DiscretizeRegion[Interval[{0, 1}], MeshRefinementFunction -> (Echo@#2 > 0.01 &)] or DiscretizeRegion[Interval[{0, 1}], MeshRefinementFunction -> ((Print[#2]; #2 > 0.01) &)] work without any error messages I conclude that Reap is used somewhere within ... 2 For your first question a=1. tmptmp = Tuples[Range /@ {1000, 100}].{{3 a, 0}, {0, Sqrt[3] a}} The basic answer is that in your first case Transpose[# + Transpose[{{0, 0}, {a, 0}, {-a/2, Sqrt[3] a/2}, {3 a/2, Sqrt[3] a/2}}]] & /@ tmptmp the variable a gets evaluated many many times. I simplified the problem by defining a small ... 2 The problem resides in the fact that I was minimizing over a matrix not a number. This can be done, however, over the sum of the total matrix elements, by using the line: FinalFunct[a1_, a2_, a3_, b1_, b2_, b3_, c1_, c2_, c3_] := Sum[StateDifference[a1, a2, a3, b1, b2, b3, c1, c2,c3][[k]][[k]], {k, 1, Length[StateDifference[a1, a2, a3, b1, b2, b3, c1, c2, ... 8 There is another way that is on my machine almost 500x faster then your solution. The idea is to look how Mathematica represents colored strings and use this directly. When we colorize an input string by selecting text and using the Format menu, we can create something like this Now, press Ctrl+Shift+E to see the underlying expression. ... 4 For completeness, here is a way to extend the compiled or LibraryLink approaches to arbitrarily large integers. Since it comes so long after the original answer, I post it separately. As explained in this answer, we can bridge the gap between arbitrary and machine precision at least somewhat efficiently by using IntegerDigits to express a large integer as a ... 4 I really enjoy Mathematica when I can outsource tough algorithmic decisions to their source code- I believe this is the case here. It appears as if your code is doing something expensive (searching and replacing) many different times. I propose to do it all at once. Benchmark: txt = ExampleData[{"Text", "AeneidEnglish"}]; somewords = ... 2 I don't know if limiting yourself to a single traversal really helps that much. I would sort, split the list, and find the element with the smallest ByteCount in three separate passes, perhaps like this: SimplestEquivalents[exprs_, assumptions_, tol_: 10*^-8] := With[{nums = exprs /. assumptions}, Flatten[Map[ MinimalBy[exprs[[#]], ByteCount, 1] ... 3 Using Position and Scan a fast solution is possible. Proof of concept First a short synthetic data set for proof of concept. dataN = {{1931, RandomInteger[{1, 12}], RandomInteger[{1, 30}]}, RandomReal[{1., 10.}]} & /@ Range[2]; dataX = {{1931, RandomInteger[{1, 12}], RandomInteger[{1, 30}]}, "x"} & /@ Range[2]; data = ... 9 Your data looks like an EventSeries to me. Therefore let's treat it like one. es = EventSeries[data /. "x" -> Missing[], MissingDataMethod -> {"Interpolation", InterpolationOrder -> 0}] es["Path"] {{978220800, 7.78}, {978307200, 5.}, {978393600, 5.}, {978480000, 5.}, {979516800, 5.}, {979603200, 3.89}, {979689600, 3.89}, {979862400, 2.22}} ... 6 This should do what you want: Rest @ FoldList[ Replace[{##}, {{{_, c_}, {d_, "x"}} :> {d, c}, {_, arg_} :> arg}]&, {}, data ] while being functional and hopefully fast enough. 10 Without patterns: g[v : {s_List, n_?NumericQ}] := (temp = n; v); g[v : {s_List, "x"}] := {s, temp}; g /@ data {{{1931, 1, 1}, 7.78}, {{1931, 1, 2}, 5.}, {{1931, 1, 3}, 5.}, {{1931, 1, 4}, 5.}, {{1931, 1, 16}, 5.}, {{1931, 1, 17}, 3.89}, {{1931, 1, 18}, 3.89}, {{1931, 1, 20}, 2.22}} Or even faster: data[[All, 2]] = Block[{temp, g}, ... 2 The most straightforward parallelization of you code without a slowdown due to using SetSharedVariable is to use: f[x_, y_, z_] := Sin[x - z + Pi/4] + (y - 2)^2 + 13 n = 10^1*2.; LaunchKernels[]; AbsoluteTiming[ ParallelEvaluate[fmin = f[0., 0., 0.];]; ParallelDo[ If[# < fmin, fmin = #] &@f[xp, yp, zp];, {xp, 0., Pi, Pi/n}, {yp, -2., 4., ... 3 Don't compare to a single (shared) main-kernel variable (fmin) on each kernel. Instead, allow each kernel to find the smallest of the points it has checked. Let each kernel have its own private fmin. Then you'll have$KernelCount candidates for the minimum. Finally select the smallest of these. ParallelCombine is made for precisely this type of approach. ...

3

Update As I now understand your question the function valid is sort of pseudo-code for the purpose of asking the question. The output that you are dealing with is a ragged list that may have two, four or six elements. Starting with the original valid we generate a ragged list. valid[g_?NumericQ] := Table[g^(i/6), {i, If[g < 1.5, 2, If[g < 2, 4, ...

3

The bottom line is that, given the accuracy with which Timing can measure, there is no difference in the timings you report. Timing has a lot more precision than accuracy. What you are seeing are stochastic fluctuations in the timing process. Let me try to justify that conclusion. First, for calibration purposes I need to establish the performance of your ...

1

Composition[ Flatten[#, 1] &, If[Length[#] > 1, Rest[#], Nothing] & /@ # &, GatherBy[#, #[[;; 3]] &] &, Join ][list3dim, list4dim] Using lists generated by Jason B it seems to be twice as fast.

4

I would like to point out that Listable in a pure Function effectively unpacks the array, and makes it much slower than Map for pure Functions. Downvalues always unpack so SetAttributes[f, Listable] doesn't affect performance there. The bottom line is that if one wants to use user defined listability it must be inside a compiled function, otherwise use Map ...

4

Generate a list of random numbers meeting OP's specifications: list3dim = RandomReal[{1, 17}, {4000, 3}]; list4dim = RandomReal[{1, 17}, {14000, 4}]; Do[{n1, n2} = {RandomInteger[{1, Length@list3dim}], RandomInteger[{1, Length@list4dim}]}; list4dim[[n2, ;; 3]] = list3dim[[n1]]; , {20}] And then test a few sorting routines here. First, OP's sorting ...

0

Perhaps you are looking for something like this. F = (* as in the question *) f[x_, i_] = FullSimplify[D[F, Subscript[x, i]]] prod[x_, n_] := Product[f[x, i], {i, 1, n}] Then you can evaluate things such as prod[x, 3] quite quickly for any reasonable n.

4

Update: Current implementation about twice as fast as OP, though there are some caveats. Since you seem to be worried more about the speed of your method, maybe this could help. In the days of version 9 (which for me is still today) I implemented a local adaptive method similar to LocalAdaptiveBinarize, based only on the local mean of pixel values. I will ...

Top 50 recent answers are included