Tag Info

New answers tagged

4

You mentioned Sow and Reap in a comment, so here's a recursive function using those. Performance-wise it's a total disaster but perhaps it's of interest anyway: f[{first_, rest___}] := f[{rest} + Sow @ Max[-first, 0]] Reap[f @ balance][[2, 1]] (* {0, 80, 0, 0, 20} *)


3

I am also going to ignore the "association" aspect of this for the sake of simplicity. There is nothing wrong with loops conceptually; they just need to be written using the right Mathematica tools if one wants efficiency. (Unless you wish to write the entire thing in a procedural style and compile to C for maximum performance.) In this case FoldList is ...


0

Here's what I have so far; it doesn't change the balance list, but it does incrementally build up a deposit list. I'm guessing something like that has to happen, and I don't know enough (monads?) to write this in a functional way. [I'm kind of ignoring the fact I wanted a deposit association, because it's easy to build one from the list I get.] ...


1

list = {a, b, c, d}; app = {{1, "x"}, {3, "w"}, {1, "q"}}; Fold[MapAt[f[#, u] & /. u -> #2[[2]], #1, #2[[1]]] &, list, app] (* {f[f[a, "x"], "q"], b, f[c, "w"], d}*) Or perhaps: r = list (r[[#1]] = f[r[[#1]], #2]) & @@@ app; r (* {f[f[a, "x"], "q"], b, f[c, "w"], d} *)


1

The reason is that you have an inefficient inner loop when you use myBBBlik. Every time you call myBBBlik, it takes a certain amount of time to calculate the result (on my computer, about 1/2 second of mucking around because your likelhood function is a bit complex). But myBBBlik2 creates an algebraic expression once (?or twice?) and can substitute the ...


0

Module is not necessary here, and is in fact the source of the problem: fTest1[f_] := Module[{w, x}, NMinimize[{f, 1 >= x >= 0, 1 >= w >= 0}, {x, w}]] fTest2[f_] := NMinimize[{f, 1 >= x >= 0, 1 >= w >= 0}, {x, w}] fTest1[x^2 - w^2] (* NMinimize::nnum errors and NMinimize[___] *) fTest2[x^2 - w^2] (* {-1., {x -> 0., w -> 1.}} ...


1

Not sure if this help or not but you can try it: fTest[f_, variables_] := Module[variables, NMinimize[{f, 1 >= x >= 0, 1 >= w >= 0}, {x, w}]] ans=fTest[y, {x, w}] (*1., {x$8300 -> 0., w$8300 -> 1.}}*) The easiest way I found is as follows: ToExpression[StringReplace[ToString[ans], "$" :> "+0*"]] (*{-1., {x -> 0., w -> ...


4

ClearAll[eF] eF[z_: y] := Module[{j = 1, p = Partition[#, 2]}, First[Times @@ (z[Length@p] - p[[-1]]) Exp[Total[(Subtract[##] 2 z[j++] + {#-#2}^2) & @@@ p]]]] & Examples: ClearAll[a, b, c, d, e, f] eF[][{a, b, c, d}] (* E^((a-b)^2+(c-d)^2+2 (a-b) y[1]+2 (c-d) y[2]) (-c+y[2]) (-d+y[2]) *) eF[][{a, b, c, d, e, f}] (* E^((a-b)^2+(c-d)^2+(e-f)^2+2 ...


1

Nothing intrinsically wrong with what you've done, but perhaps a bit messy. For example, here's the epsilon>1 case done a bit more Mathematica style. Easier to read and faster: (* epsilon>1 case as function *) genResults = Module[{inc = 1, init = RandomVariate /@ #1, rvs = RandomReal[{-1, 1}, {#2, Length@#1}]}, ...


3

Yet another approach. data = {1, 3, 4, 6, 8, 0, 11, 12, 0, 13}; filterF[{a_, b_, c_} /; b == 0] := (a + c)/2 filterF[{a_, b_, c_}] := b fiter[data_] := Join[{data[[1]]}, filterF /@ Partition[data, 3, 1], {data[[-1]]}] fiter @ data {1, 3, 4, 6, 8, 19/2, 11, 12, 25/2, 13}


6

Here are two possibilities. First, use MovingMap: ClearAll[av]; av[{l_, 0, r_}] := (l + r)/2; av[{_, m_, _}] := m; and then smoothMM[list_] := Join[{First@list}, MovingMap[av, list, 3], {Last@list}] or, you can use in-place assignments: smooth2[list_] := Module[{copy = list, pos = Flatten[Position[list[[2 ;; -2]], 0]] + 1 }, copy[[pos]] = ...


7

This duplicates the behavior of yours (no effect on zeroes at ends): smoothee=ReplacePart[#, i_ /; i > 1 && i < Length@# && #[[i]] == 0 :> Mean[{#[[i - 1]], #[[i + 1]]}]] &; smoothee[{0, 1, 3, 4, 6, 8, 0, 11, 12, 0, 13, 0}] (* {0, 1, 3, 4, 6, 8, 19/2, 11, 12, 25/2, 13, 0} *) Here's a goofy ...


3

You can use ListConvolve or ListCorrelate, like this: ListConvolve[ {{1, 1, 1}, {1, 0, 1}, {1, 1, 1}}, mat]


3

Here's another way that's quite a bit faster on David Stork's example: #.Y.# &[A.X] SeedRandom[0]; A = Table[RandomReal[], {3000}]; X = Table[RandomReal[], {3000}, {8000}]; Y = Table[RandomReal[], {8000}, {8000}]; AbsoluteTiming[A.X.Y.X\[Transpose].A] AbsoluteTiming[(A.X).Y.(X\[Transpose].A)] AbsoluteTiming[A.(X.Y).(X\[Transpose].A)] ...


8

Since your central question was about speed (or time complexity), you might wish to know an important result from elementary theory of algorithms and computational complexity, which is that the time and space complexity of matrix multiplication depends upon the order of such multiplication (see Introduction to Algorithms by Cormen, Leiserson and Rivest). As ...


6

In Einstein notation your initial expression is $$A_{i}A_{j}X_{ik}X_{jl}Y_{kl}\\=A_iX_{ik}Y_{kl}X^\mathsf{T}_{lj}A_j\\=AXYX^\mathsf{T}A$$ which can be easily entered into Mathematica as A.X.Y.X\[Transpose].A It's unlikely you'll be able to devise anything faster than this, but this should be very fast. On my machine, this executes in 0.062 seconds for ...



Top 50 recent answers are included