# Tag Info

2

InternalPartitionRagged uses Accumulate internally to generate a list of positions from the sub-list lengths, then MapThread and Take to extract the corresponding elements from the array. You can check the internal definition with Needs["GeneralUtilities"]; PrintDefinitions[InternalPartitionRagged] The reason for pointing this out is that answers which ...

4

The following two expressions are equivalent. Table[RandomReal[], {10^8}]; // AbsoluteTiming {7.99593, Null} RandomReal[1., 10^8]; // AbsoluteTiming {1.20604, Null} The second expression shows the advantage of RandomReal over Random. Edit Another consideration is the generator used. For example, when the Mersenne twister is specified, there is not ...

1

Borrowing heavily from other answers here, but I wanted to do as much as I could inside Compile. On my machine, this is a bit faster than LLIAMnYP's main: runsComp = Compile[{{list, _Real, 1}}, Block[{ans = ConstantArray[{0, 0}, Length@list + 1], t = 0., j = 1, len = Length[list]}, Do[(t += list[[i]]) <= 1 || (ans[[j + 1]] = {ans[[j, 2]] + 1, i}; ...

4

Here's my take at making a function as fast as possible. main = Module[{idxs = sub[Accumulate@#]}, InternalPartitionRagged[#, idxs]] &; sub = Compile[{{list, _Real, 1}}, Block[{i, l = Length[list], ref = 1., bag = InternalBag[{0}]}, For[i = 1, i <= l, i++, If[list[[i]] >= ref || i == l, InternalStuffBag[bag, i]; ref = ...

14

dat = {0.71, 0.685, 0.16, 0.82, 0.73, 0.44, 0.89, 0.02, 0.47, 0.65}; Module[{t = 0}, Split[dat, (t += #) <= 1 || (t = 0) &] ] {{0.71, 0.685}, {0.16, 0.82, 0.73}, {0.44, 0.89}, {0.02, 0.47, 0.65}} Credit to Simon Woods for getting me to think about using Or in applications like this. Performance I decided to make an attempt at a higher ...

4

f[x_, y_] := Module[{new}, If[Total[new = Append[x, y]] >= 1, Sow[new]; {}, new]] Reap[Fold[f, {}, dat]][[2, 1]]

4

What I am most interested in is described in Oleksandr's answer. Here's something else I would also try: There are several built-in functions that take advantage of parallelization without any special settings (and without using the Parallel tools framework). I would like to know how well these scale to a high number of cores. Examples: Matrix ...

8

4 TB memory? N-body of course; dir = 2; T = 10; k = 1; l = 10; n = l^3; v = 6; q[i_] := (-1)^i m[i_] := RandomReal[5] Rem[o_] := l (o - IntegerPart[o]) eqns = Table[ {D[Subscript[r, i][t], {t, 2}] m[i] == Sum[ Normalize[Subscript[r, i][t] - Subscript[r, j][t]] k q[ i] q[j]/(Subscript[r, i][t] - Subscript[r, ...

3

Pieter, here is one suggestion: - try a FEM calculation on a huge and complicatd structure, eg. stress around clusters of cracks :)

2

The problem is with the function evaluating at each point of plot instead of being set once and for all. This is due to the misuse of setdelayed (:=). end = 5; delta :=RandomChoice[{0.08, -0.08, 0.16, -0.16}]; f[x_] = Piecewise[ Table[{Sin[x Pi + delta]^100, i <= x < i + 1}, {i, 0, end-1}]]; Plot[f[x], {x, 0, end}, PlotRange -> All, PlotPoints ...

4

Since Sum holds its arguments, it ends up computing Mean[x] and Mean[y] in every step in the sum. Try Total[(x - Mean[x])(y - Mean[y])]/Total[(x - Mean[x])^2] which uses vectorized operations. In general, Sum is most suited to compute sums of symbolic quantities, sums with symbolic limits etc. Total or Tr is much faster for numeric stuff.

8

I have a method that's more accurate, but I'm not sure how robust it is in the end. But maybe some of my tricks are useful for you. My first step to make the problem easier is to try to remove the perspective. If the pipes are all (more or less) vertical lines in the image, I can use image processing filters with anisotropic filter sizes, i.e. filters that ...

0

I will post the solution gradually in try myselft until the really answer to solve it testg4 = ConvexHullMesh[pts] // RegionBoundary; NMinimize[ RegionUnion[testg4, TransformedRegion[ TransformedRegion[testg4, RotationTransform[rad, dir, p]], TranslationTransform[x]]] // MeshPrimitives[#, 0] & // Level[#, {2}] & // ...

6

You can also use FindHamiltonianCycle. To convert Hamiltonian path problem to Hamiltonian cycle problem, just add one vertex and connect it to all other vertices. After that just run FindHamiltonianCycle[g, All] For example, countHamiltonianPaths[g_] := Length[ FindHamiltonianCycle[ AdjacencyGraph[PadRight[AdjacencyMatrix[g], (VertexCount[g] + ...

2

This is the same basic algorithm but in my own style. It runs only about twice as fast as yours, but hopefully it will be of interest anyway. The recursive function count maintains the current vertex, the adjacency list $a$ and a counter $i$. At each call the current vertex is removed from the adjacency list and the function recursively scanned over the ...

4

This is not really very efficient but here goes. We can create a rational function that is effectively a generating function in three variables, one to force 8 factors, one to force a sum e1ual to 24, one to force a sum of squares equal to 86. The other parameters just keep track of what factors get used in a coefficient. vals = Range[5]; aa = Array[a, 5]; ...

0

If you don't need to many quadrature points (say, less than 1000), then the easiest way to get them is simply by finding the eigenvalues of the tridiagonal Jacobi matrix, the Golub Welsch algorithm. Here's a post describing the rules for the matrix elements. pointsAndWeightsGaussLegendre[n_] := Module[{jacobi}, jacobi = ConstantArray[0, {n, n}]; ...

7

A slightly different approach with Reduce (or Solve) We define: matC = Range[5]; (* the list of the integers from which we build a list *) Let us use a vector to indicate the multiplicities of any integer: matX = Array[ x, 5 ]; (* @Kuba: that's more concise, indeed *) So x[1] will tell us how many times $1$ appears a possible solution. We can then ...

13

Select[ IntegerPartitions[24, {8}, Range[5]], #.# == 86 & ] {{5, 5, 4, 2, 2, 2, 2, 2}, {5, 5, 3, 3, 3, 2, 2, 1}, {5, 4, 4, 4, 2, 2, 2, 1}, {5, 4, 4, 3, 3, 3, 1, 1}, {4, 4, 4, 4, 4, 2, 1, 1}} Slightly more general approach (in case where IntegerPartitions is not what we need): ClearAll[ar, a]; ar = Array[a, 8] ar /. Solve[Flatten@{ ...

4

To take advantage of that kind of memory, you really want to do some parallel processing. Mathematica's parallel processing focuses on data-parallelism, or more simply, embarrassingly parallel problems. So you might try out various Monte Carlo simulations. I don't recommend trying to reproduce full MPI functionality with LinkCreate et al. In the case ...

0

Update Fully compiling the code to C makes it as fast as the built-in: cBernstein = Compile @@ (Hold[{n, {j, _Real, 1}, u}, Table[expr u^i (1 - u)^(n - i), {i, j}], CompilationTarget -> C] /. expr -> FunctionExpand[Binomial[n, i]]) BezierSurface4 = With[{cBernstein = cBernstein}, With[{AllBasis = Function[{deg, u0}, cBernstein[deg, ...

0

How about Graphics3D @ BSplineSurface[cpts] // AbsoluteTiming

4

The more I've thought about this question, the more my answer (above) has changed. Now my answer is this: Assuming there is a high-bandwidth connection to the Wolfram server, choose a problem that relies on Mathematica's superior handling of curated data. Create an enormous problem that relies on curated financial data, geographic data, biological data, ...

1

You could just try to find the next largest prime number http://www.iflscience.com/editors-blog/largest-ever-prime-number-found-gimps https://www.youtube.com/watch?v=tlpYjrbujG0

4

Here's a quick helper function to do so. It first finds the position of each $1$ in the original matrix using Position; it then selects $n$ of these positions randomly using RandomSample and replaces their value with $-1$ using ReplacePart: Clear[flipsome] flipsome[matrix_?MatrixQ, n_Integer] := ReplacePart[matrix, RandomSample[Position[matrix, 1], n] ...

20

I've always wondered about the scalability of MathLink (now officially "Wolfram Symbolic Transfer Protocol"). This is the protocol used by Mathematica to communicate between the front end and the kernel, and the basis of the Parallel package. It has quite low bandwidth and high latency relative to, for example, MPI libraries. I also wonder how many MathLink ...

13

I am sure you can easily install also Linux on it and then you could contact Vladyslav Shtabovenko, the current maintainer of FeynCalc (https://github.com/vsht) and ask him about hard problems in High Energy Physics he would like to benchmark on such a King-Kong machine. Either him or somebody else could also provide you with more complicated examples of ...

11

I would choose a problem that exploits the unique power of Mathematica, in particular the natural functions involving graph theory, symbolic math, graphics, and the high compute power you have available. So I would choose some image recognition and clustering problem such as: Take some large number of images ($\sim\!\!10^8$) and perform deep learning on ...

5

This might be faster (you will need to install libpng): Needs["CCompilerDriver"] loadpng\$source=" // Load a PNG image from a file into memory. // Placed into the public domain by Mark Adler, January 24, 2016 #include <stdio.h> #include <stdlib.h> #include <string.h> #include <stdint.h> #include <setjmp.h> #include ...

6

The following is approx 30 times faster: (imageData = Flatten@ImageData@image; mean = Mean@imageData; nonzeroPixels = Total@Unitize@imageData; zeroPixels = Length@imageData - nonzeroPixels; stdDeviation = StandardDeviation@imageData) // Timing

4

I love the brevity and elegance of garej's second method and I would probably Accept it for that reason if nothing else, were this my Question. Nevertheless it seems that using the position method referenced in the question is actually faster. positionDuplicates[list_] := GatherBy[Range @ Length @ list, list[[#]] &] a = RandomReal[1, 1*^6]; b = ...

3

With RegionNearest RegionNearest is a function that basically processes the region and returns a function of type RegionNearestFunction which is optimized for finding the nearest point in the region quickly. You should use the returned function to find the closest point in the region. As it is now you are recomputing this function again and again, which ...

3

dups = DeleteDuplicates[myNewList]; pos = Flatten[ First@Position[myNewList, dups[[#]]] & /@ Range[Length[dups]]]; myList[[pos]] {1, 3}

12

Comparable to other results: Lookup[Thread[myNewList -> myList], DeleteDuplicates@myNewList] {1,3} Seems most appropriate (fast and concise) for the OP task (V.10): Values@AssociationThread[myNewList -> myList] {1,2} P.S. Learned the general idea from this post of Mr.Wizard. Addenum: Some notes concerning speed. @Mr.Wizard suggested ...

5

Module[{f}, f[x_] := (f[x] = 0; 1); Pick[myList, f /@ myNewList, 1]] {1, 3}

14

You can accomplish this using DeleteDuplicatesBy, by first taking your two input lists and making a matrix out of them, and then deleting the rows where the last element (the element that came from myNewList) is a duplicate. Then you transpose back and assign the sublists of the reduced matrix to the new lists you want. {myListDuplicatesDeleted, ...

1

This seems to be a bit faster. First off, there's no reason to redraw the ParametricPlot every time you change p. That sped it up a bit. Then I figured, why make the If statement? Let's just always set p equal to the nearest region point. Getting rid of the If statement sped it up some more. region = ParametricRegion[{Sin[u], Sin[2*u]}, {{u, 0, ...

1

SearchAll[sequence_, search_] := Module[{map}, map = Map[# -> "\!$$\*StyleBox[\"" <> # <> "\",FontColor->" <> ToString@RGBColor[RandomReal[], RandomReal[], RandomReal[]] <> "]$$" & , search]; StringReplace[sequence, map]] SearchAll["CGACATCACCGATGGGGAAGATCGGGCTCGCCACTTCGGGCTCATGA", {"CGA", "CATG"}] // Style[#, ...

7

You can do it probably most efficiently in compiled code, if you're not too concerned about precision. Here you can use the listability of compiled functions over tensor arguments. Your function is basically the Mandelbrot iteration: mandelbrot = Compile[{{c, _Complex, 0}, {d, _Integer, 0}}, Block[{i = 0, z = c}, While[Abs[z] < 2.0 && i < ...

3

Again I will propose solving the problem by a recursive function. helper[c0_, c_] := Module[{r = (Abs[#] < 2 & /@ c)}, Pick[#, r] & /@ {c0, c^2 + c0}] z[n_Integer?Positive, c0_List] := z[n - 1, c0, c0^2 + c0] z[0, c0_, _] := c0 z[n_, c0_, c_] := z[n - 1, Sequence @@ helper[c0, c]] With[{stepSize = .0001, n = 46}, Module[{c0, p}, c0 = ...

1

The If requires a scalar argument. z2[12,#]& /@ c should work.

0

Thank you very much to Scabolcs and rhermans. I have used ImageHistogram together with ParallelTable. For 10 images the improved code needs on my computer 2.51 sec (AbsoluteTiming) whereby the old code needed 124.22 sec. The speed is improved to a factor of about 50 ... great ... The only small but important difference is: I need a logarithmic y scale for ...

2

OK, let me kill the unanswered question. Your func can be simplified to: func[z_, nei_] := Module[{t = ConstantArray[0, Length@Flatten@z]}, t[[Rest@nei]] = 1; Partition[t, Length@z]]; func[Z, Neighbors[[2]]] If you still want to compile it, you just need a little modification: cfunc = Compile[{{z, _Integer, 2}, {nei, _Integer, ...

6

Your Func is far beyond best. As mentioned before, currently you'd better set effort on learning to code in "Mathematica-style" rather than try to relieve the slowness (which is mostly caused by bad coding in my view) with Compile. Here's an uncompiled function that's about 300 times faster than your Func: func = Function[{l0, l1, l2, ll3}, Module[{l3 = ...

7

The following is ten times faster. The remaining time is mostly consumed while evaluating your function, so there may be some optimization window there. point1[j_] := Join[x[[;; j]], w[[j + 1 ;;]]]; point2[j_] := Join[x[[;; j - 1]], w[[j ;;]]]; max = 11; fx = f[x]; β = SparseArray[{{i_, i_} -> -1/100}, {size, size}]; Do[{ w = x + β.fx; T = ...

9

I think this is pretty clearly a case where Outer is simply overloaded with an optimized definition for Plus. A look at the Trace shows that there are no intermediate steps: Trace[ Outer[Plus, Range[3], Range[3]], TraceInternal -> True ] {{Range[3], {1, 2, 3}}, {Range[3], {1, 2, 3}}, Outer[Plus, {1, 2, 3}, {1, 2, 3}], {{2, 3, 4}, {3, 4, 5}, {4, ...

4

General idea A general rule of thumb to reduce the time and memory needed for a computation is to use inexact (floating-point) numerics instead of exact or symbolic approaches, and to use it early. Of course, one might worry about accuracy, but there's no guarantee that feeding an exact, symbolic problem to FindRoot will be more accurate than feeding an ...

4

I realize this is an old question, but I recently had the same issue and have come across (link to google groups question) what I think is a cleaner solution. I don't want to take credit for coming up with that solution, but I thought it would be helpful to add it to this site. I'll use a simple example function to demonstrate. f[x_] := f[x] = x ...

2

You are using the global symbol t within a compiled function. This is not going to work like you expect it. What you probably want is the following simple function providing that I understood you correctly: f = Compile[{{l, _Integer, 1}}, Module[{ list = {{1, 1, 1}, {2, 2, 2}, {3, 3, 3}}, t = Most[{{1}}]}, t = Map[list[[#]] &, l]; t ...

2

Cases can be used to extract a value that's part of a pattern: Cases[#, x_ f[_] -> x, Infinity] & /@ testList Out: {{2, 3}, {2}, {Sqrt[2]}}

Top 50 recent answers are included