New answers tagged

1

Setting Method->"EndomorphismMatrix" in comment above solved the problem. Thank you very much!


12

I will make an exception to the usual practice I try to follow on this site, and fully replicate my post from this answer of mine here, since it answers this question just as directly or even more, than the one I originally posted it for. I hope this will not cause objections. In addition to the standard Reap - Sow functionality, this one also allows access ...


17

I do not know how Sow and Reap are actually implemented, but to show you that it isn't magic, I can provide the following toy implementation for you. ClearAll[sow, reap]; sow[x_, tag_] := x; SetAttributes[reap, HoldFirst]; reap[expression_] := Block[{sow, a}, a = <||>; sow[x_, tag_] := With[{exp = x}, If[ MissingQ[a[tag]] , ...


1

Handling Accidental Dupes With the solution outline by kglr we can get into trouble in the special case that we have two lists differ only up to a swap like, dupePerms = With[{r = BlockRandom@RandomInteger[{5}, 15]}, { Insert[r, 1, 3], Insert[r, 1, 8] } ] { {0, 5, 1, 3, 0, 2, 5, 3, 2, 4, 0, 2, 3, 3, 2, 2}, {0, 5, 3, 0, 2, 5, 3, 1, 2, 4, 0, 2,...


3

This seems to be faster than OP's insertCurVal for long lists of perms: The idea: Given a list of insertion positions, pos = {pos1, pos2, ..., posk}, if the input list is duplicate-free, the first step of insertions does not introduce any duplicates. If we manage to avoid duplicates up to insertion in $pos_i$, then insertion of val in $pos_{i+1}$ creates ...


2

Given that Reduce is able to solve some related problems, like can internally do what FrobeniusSolve is doing (according to Properties & Relations), I decided to see if it could do something smart to solve this problem. It seems that it can't because it is a bit slower than binSplitsSized2. I'm sharing it here so that others who are looking into this ...


2

I'd use LinearSolve instead of Inverse: ser[t_] = {x1[t], x2[t]}; Aw = {{-1, 2}, {0, -4}}; mat := {{x1[t]*x2[t]^2, 37}, {x1[t]*Cos[x2[t]], 2}}; (*** No Inverse[] ***) eqinn = ser[0] == {1, 1}; eqdyn = D[ser[t], t] == Aw . ser[t]; eqinn = ser[0] == {1, 1}; ev = WhenEvent[ Mod[t, 1], {#1 -> LinearSolve[#2, #1], "RestartIntegration"} ]...


1

For this system we can make numerical code, but we need to test it with a large system Attributes[WhenEvent] = {}; ser[t_] = {x1[t], x2[t]}; Aw = {{-1, 2}, {0, -4}}; func = Block[{x, y}, With[{code = Inverse[{{x*y^2, 37}, {x*Cos[y], 2}}]}, Compile[{{x, _Real}, {y, _Real}}, code, CompilationTarget -> "C"]]]; funQ[x_?NumericQ, y_?...


2

Here is a small teste example: t = Table[{x, y, {f1[x, y], f2[x, y], f3[x, y]}}, {x, 1, 2, 0.5}, {y, 2, 3, 0.5}] ; Flatten[Map[Thread, t, {2}], 2]


2

This works in 0.25 seconds. zetas=FullSimplify[zetas]; terminalcons=FullSimplify[terminalcons]; speccons=List@@{FullSimplify[speccons]/.(1.0->1)}; setcons={-1.0<=u51<=1.0,-10.0<=u52<=10.0}; FindMinimum[Flatten@{obj, speccons, terminalcons, setcons}, {u51, u52}] (* {0.660595,{u51->0.00600015,u52->0.04524}} *)


1

Try setcons = And @@ Thread[{-15, -100} <= {0., 0. + 100 u51} <={15,100}] && -10 <= u51 <= 10 && -10 <= u52 <= 10 constraints = speccons && terminalcons && setcons; R = ImplicitRegion[constraints, {u51, u52}]; NArgMin[obj, {u51, u52} \[Element] R] (* {0.00600015, 0.0452401} *) RegionPlot[R]


6

It looks to me like you're recalculating a lot of stuff that should be constant (unless you're doing dangerous things with global variables). Here's a way to not do that, mostly by changing newTest and newtest[{{x_, y_}, n_}, b_, c_, snk_] := Abs[x] < 10000 && Norm[{x, y} - snk] > 0.001; unstablePts[b_, c_] := With[ { centre = centre[b, ...


3

I think the problem is not neither the Do loop or the fact that the code is not compiled. (I think FindMinimum will try to compile if it can.) The problem seems to be rather that FindRoot is not good at handling VectorLessEqual. This is a quite new feature and so I was surprised that it existed. Rephrasing the inequality constraints "in the good ol' way&...


1

You have several choices with variations: With[{a = (g1[i]; g2[i])}, h1[a]; h2[a]] (g1[i]; g2[i]) // Function[i, h1[i]; h2[i]] Function[i, h1[i]; h2[i]][g1[i]; g2[i]] (h1[#]; h2[#]) & [g1[i]; g2[i]] (g1[i]; g2[i]) // (h1[#]; h2[#]) & You asked: Is there a general rule about which paradigm is faster or uses less memory? I really doubt there is much ...


2

Note: I found that this answer doesn't actually work, but I'll leave it here as it provides some insight nonetheless. Upon surrounding different sections with Echo[AbsoluteTiming[...], "section-label", First][[2]], your Do loop actually seems quite fast (0.002 seconds on my machine). FindMinimum, however, takes quite a while. (To test this more ...


5

Since the question is about performance, I think some timings should be included. There are two types of arrays and performance differs. Packed arrays are arrays whose elements are machine numbers of the same type. Functions are optimized to leverage strengths of the CPU on such arrays. Unpacked arrays are essentially, I think, lists of pointers (to lists ...


6

Breadth first search Well, BFS can be implemented using a queue which in turn is easy to implement with Association. First, let's emulate a query function neigbors: G = RandomGraph[{100, 200}]; adj = AdjacencyMatrix[G]["AdjacencyLists"]; neigbors[vertex_] := adj[[vertex]]; Not let's implement the queue: iter = 0; counter = 0; visited = <||>; ...


6

I expect that what you are asking for is not possible. The graph functions very likely use internal functions instead of the public API. In fact, I expect many algorithms to be implemented in a low-level language like C or C++. Overriding the public API won't help. As a workaround, you could implement BFS yourself. bfs[neifun_, v0_] := Module[{dist = <||&...


7

ClearAll[a] a = Array[x, {3, 2, 4}]; MatrixForm[a, TableDirections -> {Column, Row, Row}] flattened = Flatten[a, {{2}, {3}, {1}}] MatrixForm[flattened, TableDirections -> {Column, Row, Row}]


9

Transpose generalizes nicely to arbitrary levels! Try Transpose[a, {3, 1, 2}] The specification of {3, 1, 2} causes the first level in a (corresponding to the first position in the list {3, 2, 1}) to become the third level in the result, the second level to become the first, etc.; see the docs for more examples.


1

…This step is needed since in the full version of the code I make some manipulations with this table which require a lot of time, so it is preferable to generate it preliminarly. I don't think so, probably there's a design miss somewhere. Anyway, here's my solution. The key idea is: Parallel* only speeds up calculation when code inside it is really slow, in ...


4

You're using Compile in wrong way. I'd suggest reading this and this post as a start. The following is a quick fix for your code: rule = Flatten[ DownValues /@ {pproductLabVec3, pproductLabVec2, pproductLabVec1, ϕVal}]; θproductLabVec = Hold@Compile[{{EN, _Real}, {mN, _Real}, {θN, _Real}, {ϕN, _Real}, {EXrest, _Real}, {mX, _Real}, {...


3

The following takes approx. 4 seconds for 10^5 evaluations. A sped up could be obtained if the data is not fed one by one, but in bunches. Then instead of of calculating scalars, one could work with vectors. boost[thn_, phn_, en_, mn_, m_, e_, ph_, th_] := Module[{mn2 = mn^2, vn, gamn, gam, pt, tht, pht, pn}, p = Sqrt[e^2 - m^2] {Sin[th] Cos[ph], Sin[...


0

Your ArrayFlatten method can be made as fast as the other methods with two small tweaks: applying SparseArray to the list of dense matrices rather than at the end, and using N on the diagonal matrix to turn the off-diagonal zeros into approximate reals. matrices = RandomReal[{}, {128, 128}] & /@ Range[48]; mat1 = SparseArray @ ArrayFlatten @ ReleaseHold ...


5

If you're looking for real solutions only, you may want to explicitly expand your variables into their real and imaginary parts, e.g. doing equations /. \[CapitalLambda][i_] :> \[CapitalLambda]re[i] + I \[CapitalLambda]im[i] Then you can separate each of your equations into two, one for the real part of the equation and another for the imaginary part (to ...


0

My idea is as follows. Start from a given function f = x[1] x[2]/((1 - h t[1] x[1] x[2]^-1) (1 - h t[2] x[2] x[1]^-1)) and discard the prefactor. Thus we a looking for the terms in the expansion that do not contain x[i] g = 1/((1 - (h t[1] x[1])/x[2]) (1 - (h t[2] x[2])/x[1])) /. {x[i_] ->y^(1 + 10 i)} Coefficient[Normal[Series[g, {h, 0, 10}]] /. h -> ...


2

Also Data Structures and Efficient Algorithms Enhance Your Code Performance The Mathematica Compiler Effective Use of the Mathematica Compiler and Code Generation


3

Here are a couple of further suggestions to make the code faster and a bit shorter. n = 160; t = 100; id = IdentityMatrix[n, SparseArray, WorkingPrecision -> MachinePrecision]; A = 0.5 ((DistanceMatrix[Range[1., n]] + id)^-3 - id); M = 2. (A + id); F = LinearSolve[M]; iprv = ConstantArray[0., {n, t}]; ParallelDo[ Block[{m, k, Psi, B, h1, h2, H, h, u, ...


2

We first define the number of 1's: n1 and the number of 0' s: n2 and create a single sample list: li: n1 = 2; n2 = 3; n = n1 + n2; li = Join[Table[1, n1], Table[0, n2]]; We now create all different permutations of the sample list. perm = Union@Permutations[li]; We now have a lot of rotated list in perm that we need to delete. Towards this aim we rotate ...


4

ClearAll[L2] L2[n_, m_] := Permute[PadRight[ConstantArray[1, m], n], SymmetricGroup @ n] L2[3, 2] {{1, 1, 0}, {1, 0, 1}, {0, 1, 1}} L2[4, 2] {{1, 1, 0, 0}, {1, 0, 1, 0}, {1, 0, 0, 1}, {0, 1, 1, 0}, {0, 1, 0, 1}, {0, 0, 1, 1}}


4

To get the matrix inversion to work on machine numbers just replace F = Inverse[0.0 + M]; That brings the running time to under 150 seconds on my MBPro -- replace the Do line by Timing@Do[ to have Mathematica tell you about running time. You can indeed shave a few seconds off by moving the matrix definition and inverse out of the Do loop, but not much.


5

Not sure whether this works always correctly. Say you want the lost of all $n$-tuples with $k$ 1 up to rotation. You can encode such a tuple by going through it in clockwise order and by counting the number of steps from one 1 to the next. This gives you k integers that ought to sum to n. We can always rotate this list of k integers, such that its maximum ...


7

The reason for Evaluate is that Compile is surprisingly bad at recognizing the expression that it is suppose to optimize. One can use Evaluate as a workaround, but I prefer to use With as follows (Block is supposed to shield x and kx from external definitions): cf = Block[{x, kx}, With[{code = integrand[x, kx]}, Compile[{{x, _Real}, {kx, _Real}}, ...


2

How can we stop without offering a recursive idea? Compact the binary elements into integers for fast processing: intperm[n_, 0] := {0} intperm[n_, 1] := Array[2^# &, n, 0] intperm[n_, m_] := 2^n - 1 - # & /@ intperm[n, n - m] /; m > n/2 intperm[n_, m_] := (intperm[n, m] = Join[2 intperm[n - 1, m - 1] + 1, 2 intperm[n - 1, m]]) binperm[n_, m_] :...


8

We can achieve a speed up of approx. 2 by using Riffle: list = {1, 2, 3, 4, 5, 6, 7, 8}; For the first problem: Riffle[list[[2 ;; ;; 2]], list[[1 ;; ;; 2]]] For the second problem: Riffle[list[[-2 ;; 1 ;; -2]], list[[-1 ;; 2 ;; -2]]]


9

PermutationList[Cycles[Partition[list,2]]] {2, 1, 4, 3, 6, 5, 8, 7} Simply Reverse the output above to get your second list: Reverse @ % {7, 8, 5, 6, 3, 4, 1, 2} Alternatively, define a Cycles object that can used to Permute other lists: cycles = Cycles[Partition[Range @ 8, 2]]; Permute[list, cycles] {2, 1, 4, 3, 6, 5, 8, 7} or list[[...


8

If you have the do that very often, store your lists in a packed matrix like a below (that's a good idea anyways!), use your current code to generate a permutation, and then use Part to apply the permutations on the columns of a n = 16; a = RandomInteger[{1, 100}, {1000000, n}]; p1 = Flatten@(Reverse@Partition[Range[n], 2]); b1 = Map[Flatten@(Reverse@...


4

f[len_,wt_] := Table[ Boole[MemberQ[sub,i]], {sub,Subsets[Range[len],{wt}]}, {i,len} ] Try it online! Subsets[Range[len],{wt}] is designed to pick out all possible wt-tuples of indices from 1 to len. We simply use Boole to decide when a particular index i is in a particular subset sub, and loop over all such subsets and indices.


3

ClearAll[f0] f0 = Module[{ss = MapIndexed[Thread[{#2[[1]], #}] &, Subsets[Range@#, {#2}]]}, SparseArray[Join @@ ss -> 1, {Length@ss, #}]] &; Examples: f0[3, 2] f0[3, 2] // Normal {{1, 1, 0}, {1, 0, 1}, {0, 1, 1}} f0[5, 2] // Normal {{1, 1, 0, 0, 0}, {1, 0, 1, 0, 0}, {1, 0, 0, 1, 0}, {1, 0, 0, 0, 1}, {0, 1, 1, 0, 0}, {0, 1, 0, 1, ...


6

With[{n = 5, k = 2}, ReplacePart[ConstantArray[0, n], Thread[# -> 1]] & /@ Subsets[Range[n], {k}]] {{1, 1, 0, 0, 0}, {1, 0, 1, 0, 0}, {1, 0, 0, 1, 0}, {1, 0, 0, 0, 1}, {0, 1, 1, 0, 0}, {0, 1, 0, 1, 0}, {0, 1, 0, 0, 1}, {0, 0, 1, 1, 0}, {0, 0, 1, 0, 1}, {0, 0, 0, 1, 1}}


11

L[n_, m_] := Permutations@Array[Boole[# <= m] &, n] L[3, 2] (* {{1, 1, 0}, {1, 0, 1}, {0, 1, 1}} *)


2

Basically the following should do (replacing N by n and C by c): SparseArray[ Rule[ Transpose[{ Join @@ KeyValueMap[ConstantArray[#1, Length[#2]] &, n], Join @@ Values[n] }], Join @@ Values[c] ] ] To problem is that your numbers are too large. The matrix has as many rows as the largest key in the association n. And a sparse array has ...


3

In MMA you seldom use loops. And when you nevertheless use a loop to create a list, do not use AppendTo, this will reallocate the list every time you add an element. Instead use Sow and Reap. Here is a solution without loops: xlist = Range[0., 1., 0.1]; ylist = Range[0., 2., 0.2]; Clear[f, f1] f[x_, y_, z_] := x + 3*y - z f1[z_] = {z, Mean[f[xlist, ylist, z]...


5

Try this: f[t_] := Sqrt[0.9604 + 0.0099 (Cos[1. t] + Cos[\[Pi] t])^2] // Rationalize g[t_] := D[f[t], t] Reduce[g[t] >= 0 && 0 < t < \[Pi]] // N (* 0.758547 <= t <= 1.09113 || 1.46694 <= t <= 1.9027 || 2.27564 <= t <= 3.013 *) Have fun!


7

After replacing 3.14159 with $\pi$ it works: f[t_] = Sqrt[0.9604 + 0.0099 (Cos[t] + Cos[π*t])^2]; Reduce[f'[t] > 0 && -10 <= t <= 10, t] (* -9.86111 < t < -9.03828 || -8.34402 < t < -7.89698 || -7.33471 < t < -7.07256 || -6.82692 < t < -6.02582 || -5.30983 < t < -4.89873 || -4.40083 < t ...


1

You can use DumpSave: g = GridGraph[{1000, 1000}]; VertexCount[g] 1000000 ByteCount[g] 95969272 DumpSave["graph.mx", g]; FileByteCount["graph.mx"] 47968625 The caveat is when retrieving the graph, we need to reinitialize it too after importing the mx file. My guess is that mx files store the expression in InputForm and Graph is ...


Top 50 recent answers are included