# Tag Info

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

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

14

Vectorization will help a lot: a[x_?NumericQ] := N[Exp[-Abs[x]]]; x = Table[-10 + 0.02 (j - 1), {j, 1, 1001}]; A = Outer[a[#1 - #2] &, x, x]; // AbsoluteTiming (* {2.11988, Null} *) B = Exp[-Abs[x - #]] & /@ x; // AbsoluteTiming (* {0.016182, Null} *) A == B (* True *) Notice that I am doing arithmetic on vectors the size of x instead of ...

10

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

9

It seems like RandomReal[1., 2] is automatically a packed array, whereas {1., 2.} is not. Notice; (Outer[Times, list1, DeveloperToPackedArray@{1., 2.}];) // AbsoluteTiming // First (* 0.032425 *) whereas (Outer[Times, list1, {1., 2.}];) // AbsoluteTiming // First (* 0.542086 *) Also: list1 = DeveloperFromPackedArray@RandomReal[1., 1000000]; ...

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

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

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

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

6

Outer is highly optimized for several built-in functions (Plus, Times, List). Therefore Exp@-Abs@Outer[Plus, #, -#] &@Range[-10, 10, 0.02]; // RepeatedTiming (* {0.025, Null} *) gives ~50x speedup over Outer[#1 - #2&, #, #] and ~15x speedup over Outer[Subtract, #, #]. Also is a bit faster then Kuba's Exp[-Abs[x - # & /@ x]].

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

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

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

4

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

4

Another way which I find is fractionally faster than @march's and I think scales better when combining information from more than 2 arrays (as you say you are interested in) is simply: GroupBy[Join[array1, array2, array3], First -> Rest, Join]; This produces a well formatted output straight away (imo), for the shorter length 10 and 15 arrays: ...

4

We will use Associations. There are many ways to form these Associations from your data. I will choose one and re-format it at the end. Using your provided data, we form Associations that use the date as the Key: assoc1 = Association[Rule @@@ array1]; assoc2 = Association[#1 -> {##2} & @@@ array2]; We then "intersect" these intersections, taking ...

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

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

3

Yes, two things help. The first is that Subtract is going to execute faster than #1 - #2 &, and the other is that all the operations involved in a are Listable, so getting rid of that _?NumericQ restriction speeds things up greatly. On my computer, this amounts to an order of magnitude speedup: With[{x = Table[-10 + 0.02 (j - 1), {j, 1, 1001}]}, ...

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}*)

3

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

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

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

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

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} *)

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

1

Exp@-Abs@Outer[#1 - #2 &, #, #] &[Range[-10, 10, 0.02]]; // AbsoluteTiming // First 0.950001

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

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