Hot answers tagged

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


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]]&;


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


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


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


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



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