Tag Info

Hot answers tagged

9

Implementations Here is an "idiomatic" one: ClearAll[mapRec, reverse]; mapRec[f_, ll_] := Block[{$IterationLimit = Infinity}, reverse@mapRec[{}, f, ll]]; mapRec[accum_, _, {}] := accum; mapRec[accum_, f_, {head_, tail_}] := mapRec[{f[head], accum}, f, tail]; reverse[ll_] := reverse[{}, ll]; reverse[accum_, {}] := accum; reverse[accum_, {head_, tail_}] := ...


6

You have 2 sources of inefficiency in your code. One is that you don't use the machine-precision for your dx (and therefore xls), and another one is that Band is not the fastest way to build a SparseArray object, and in the time-dependent case you have to build a new one for every time point. Here is the code which is on the same level of performance as ...


5

So far, the best I've been able to do uses Reap and Sow to construct an ordinary list while I traverse the linked list with a While loop. At the end, I reconstitute it using Fold in the normal way. It's pretty easy to capture the head of the list. It will fail (throw $Failed) if the list isn't terminated properly, or if it contains a head other than the head ...


4

Not heavily tested, but ~1.6X faster than fastest so far (including the time in that to get positions) in my quick tests, keeps things in the string domain: ss = StringSplit[sequence, pattern]; result = Most@ FoldList[(s = StringJoin[#, pattern, #2]; If[StringLength@s >= 1000, StringTake[s, -1001], s]) &, ss[[1]], Rest@ss] In any case, as ...


4

Prompted by a comments conversation with Mr. Wizard, a method I use often. list = RandomInteger[1000, 100]; Module[{a, o, t}, Composition[o[[##]] &, Span] @@@ Pick[Transpose[{Most[Prepend[a = Accumulate[(t = Tally[#[[o = Ordering[#]]]]) [[All, 2]]], 0] + 1], a}], Unitize[t[[All, 2]] - 1], 1]] &[list] list[[#]] & /@ % (* ...


3

Original Bresenham I guess I can come of with a somewhat shorter implementation without using Reap and Sow. If someone is interested, it follows almost exactly the pseudo-code here bresenham[p0_, p1_] := Module[{dx, dy, sx, sy, err, newp}, {dx, dy} = Abs[p1 - p0]; {sx, sy} = Sign[p1 - p0]; err = dx - dy; newp[{x_, y_}] := With[{e2 = 2 err}, ...


3

Here is an old fashioned approach, using stacks. It is quite general in the sense that it will handle tree structures with more than two children per node. It is also fairly slow; it has the correct (linear) complexity but maybe an order of magnitude more pushing/popping than the length. SetAttributes[push, HoldRest]; SetAttributes[pop, HoldAll]; ...


3

I didn't read all of your question so I may misunderstand, but based on the example at the bottom I believe your operation is equivalent to this: sspos[list_] := {#[[1, 2]], #[[All, 1]]} & /@ ReplaceList[list, {a___, x__, ___} :> {Length@{a} + 1, {x}} ] ~GatherBy~ Last ~Cases~ {_, __}; test = {3, 0, 1, 0, 3, 2, 2, 0, 3, 0, 1, 3, 0, 2, 3, 3, 0, ...


3

You can easily see that if the nearest approach of the two infinite lines does not fall within both segments then you must calculate the nearest distance of all four end points to the other segment. pointsegdis[{seg_, pointlist_}] := Module[{u = Subtract @@ seg, mean = Plus @@ seg/2}, {#, (mean - u Sign@# Min[1, Abs@#]/2) &@(-(2 ( # - ...


3

The main thing that I am trying to show is that you can use Accumulate and that almost all these functions are compilable. I hope it also shows when to use Table rather than Do, to avoid making unnecessary ConstantArrays. I personally find the use of Table in your code confusing. Of course it is nice to localise variables from time to time, which is also ...


3

It occurred to me that this problem can be recast as an image processing one. I think this approach is different enough to warrant its own answer. I like the style much better. f3[array_List, ele_, dist_] := Image[array] ~Binarize~ {ele, ele} ~MaxFilter~ {0, dist} // Join @@ Pick[array, ImageData @ #, 1] & f3[ar, 5, 2] {10, 6, 5, 7, 3, 7, 5, ...


2

I got an error running your code in version 7 and I had to use FromDigits[Normal@#, 2] to fix it. Therefore I don't know if my comparative timings are meaningful but here is what I came up with: f2[array_, ele_, dist_] := SparseArray[Unitize[array - ele], Automatic, 1]["AdjacencyLists"] // Outer[Plus, Range[-dist, dist], #, 1] & // ...


2

After some significant time browsing related questions on this site as well as trial and error, I believe that I have managed to create a solution for what I was trying to accomplish. Taking the advice from Ariel I have essentially created my own custom array of checkboxes that do not experience any major delay when one of them is clicked. I have ...


2

The reason about change only the argument of the external function, the behavior changes may be related to the setting of "ExpressionOptimization" under CompilationOptions. There is a related function called OptimizeExpression under Experimental` context, which I believe, according to this post by Daniel Lichtblau, is the one used by Compile for expression ...


1

Another way of doing this (http://mathforum.org/library/drmath/view/51980.html) is to find the mutual perpendicular between the two lines using the cross product, converting this to a unit vector, and then using the dot product between that cross product, and any vector going between the two lines. Like this: newMinDist[{p1_, p2_}, {q1_, q2_}] := Module[ ...


1

The link you gave shows how to find the distance between any two points on the lines. You can then use Mathematica's Minimize function to find the shortest distance. Like this. minDist[{p1_, p2_}, {q1_, q2_}] := Module[{P, Q, u, v, w}, u = Normalize[p2 - p1]; v = Normalize[q2 - q1]; P[s_] := p1 + s u; Q[t_] := q1 + t v; ...


1

An extended comment. I'm not sure if this has been realized, please correct me if it has. The result of the Divide[a,b] operation is not the same as the first 3 which are identical. {a, b} = List @@ RandomReal[{-50, 50}, {2, 1*^7}]; x1 = a/b; x2 = a b^-1; x3 = a/b; x4 = Divide[a, b]; Now... Tally[x1 - x2] Tally[x2 - x3] Both give 10^7 zeros. ...


1

Prompted by some conversation in comments elswhere, my method. Module[{o}, If[OrderedQ[#], Most@Accumulate@Prepend[Tally[#][[All, 2]], 1], o = Ordering[#]; o[[Most@Prepend[Accumulate[Tally[#[[o]]][[All, 2]]] + 1, 1]]]]] &[targetListHere] Can clobber GatherBy method by over an order of magnitude (e.g. on RandomInteger[1*^6,1*^5] my tests ...



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