Tag Info

Hot answers tagged

10

I tried to do this without looking at the previous answers... let me know if I accidentally plagiarized! With[{n = 87}, Module[{radii = Sqrt[Range[n]], angles, coords}, angles = Accumulate @ Most[ArcCot[radii]] ~Prepend~ 0; coords = radii * Transpose @ Through[{Cos, Sin}[angles]]; Graphics[{ EdgeForm[Black], Reverse @ MapIndexed[{ ...


9

No time for a full answer but with four cores in ParallelSum: ParallelSum[Prime@i, {i, PrimePi[10^9]}] // AbsoluteTiming MaxMemoryUsed[] {55.366167, 24739512092254535} 108337144 Pretty fast and very little RAM required. A modest refactoring of wxffles's code in a more native style including rasher's suggestion: Module[{n = 10^9, r, v, s}, r = ...


8

It's pretty clear that the complexity of this function is $\text{O}(n^3)$, since we're iterating over each element of a matrix (a factor of $n^2$) and taking a sum at each one (an additional factor of $n$). As a former USACO competitor, I don't like $\text{O}(n^3)$ algorithms. However, we can't really do anything to reduce the complexity; LU decomposition ...


7

Here's a direct translation of the code you linked: Module[{n = 10^9, r, v, p, sp}, r = Floor@Sqrt@n; v = Table[Floor@(n/i), {i, 1, r}] ~Join~ Range[-1 + Floor@(n/r), 1, -1]; ClearAll[s]; Scan[(s[#] = (# (# + 1))/2 - 1) &, v]; For[p = 2, p <= r, ++p, If[s[p] > s[p - 1], Scan[(s[#] -= p (s[Floor[#/p]] - s[p - 1])) &, ...


6

Couple of ways: f[x_, y_] := y*x^2 SparseArray[{i_, j_} :> f[i, j], {3, 3}] // Normal Array[f, {3, 3}] Table[f[x, y], {x, 3}, {y, 3}] (* {{1, 2, 3}, {4, 8, 12}, {9, 18, 27}} {{1, 2, 3}, {4, 8, 12}, {9, 18, 27}} {{1, 2, 3}, {4, 8, 12}, {9, 18, 27}} *) If you already have the array (say in this example a 3x3 zeroes) and you want to go over it and ...


5

Here is your initialization code: (*SeedRandom[30];*) (*initial coordinates of masses*) mass = RandomReal[{0, 3}, {4, 2}]; (*mass 1 is connected to {2,3} and so on*) spring = {{2, 3}, {1, 4}, {1, 4}, {2, 3}}; (*spring constant*) k = 2.; (*spring rest length*) l = 1.; (*step size*) step = 0.02; (*tolerance*) tol = 10^-10.; (*pinned masses*) pinned = {2, ...


5

As pointed out in the comments, Return only exits from the inner most construct. So, even though foo[4] hits the True clause in the first If statement, that only exits Do. Instead of using Return, use Throw/Catch, e.g. bar[x_] := Module[{$myTag}, Catch[ Do[ If[x == (n^2), Throw[0, $myTag]]; If[x == (n^4), Throw[1, $myTag]] , ...


5

Behavior you're describing is briefly mentioned in last paragraph of "Controlling Infinite Evaluation" tutorial and very similar example is shown in documentation of Update function. It's related to how Mathematica optimizes evaluation, how it decides that expression has not changed since last evaluation and whether it needs to be re-evaluated. For what ...


4

For the given problem it will be far more efficient to use IntegerPartitions: IntegerPartitions[91, {3}, Range[1, 51, 2]] {{51, 39, 1}, {51, 37, 3}, {51, 35, 5}, {51, 33, 7}, . . .} If you only need one solution: IntegerPartitions[91, {3}, Range[1, 51, 2], 1] {{51, 39, 1}}


4

I nest the right turns with # + Normalize@Cross[#] &. Since 2012rcampion has rather solved the coloring, here's a version using a close match from one of Mathematica's gradients. cf = Lighter[ColorData["AvocadoColors", 1. - #], (1. - #)^8] &; With[{npts = 87}, Graphics[ GraphicsComplex[ NestList[# + Normalize@Cross[#] &, {1., 0.}, npts - ...


4

If your Module were not inert you could use the second parameter of Return as follows: foo[x_] := Module[{n}, Do[ If[x == (n^2), Return[0, Module]]; If[x == (n^4), Return[1, Module]], {n, 1, 5} ]; Return[2] ] foo[4] 0 Alternatively you could Return to CompoundExpression if you eliminate it from within the Do loop: foo[x_] := ...


3

I don't quite have full completion, but I do wrap Mathematica in GNU rlwrap. I know that you can teach rlwrap a list of keywords to autocomplete, and even program it to determine what completions to suggest from your context. At the very least, you get history and line editing out of it. My recipe: I used MacPorts to install rlwrap, and their port seems ...


3

First we define the city to search from: city1 = Entity["City", {"Champaign", "Illinois", "UnitedStates"}]; (You can enter the Entity object by typing Ctrl+= champaign Enter.) We then search for the nearest city using GeoNearest: GeoNearest["City", city1, {1, Quantity[10, "Kilometers"]}] The option 1 means that we should return at most 1 match. Of ...


3

Your use of UpSetDelayed had issues. The first problem is that it couldn't deal with the pattern corresponding to the differentiation variable and order in defining the derivative. Later, when defining the action of PiecewiseExpand, UpSetDelayed cannot work at all because it needs to be associated with BernsteinBasis (or some symbol) and not with the ...


3

Given line1 = {p1, p2}; line2 = {p3, p4}; you could define two points on these lines: l1 = {1 - u1, u1}.line1; l2 = {1 - u2, u2}.line2; and just solve for the intersection: l1 /. Solve[l1 == l2, {u1, u2}] Alternatively (and more elegantly) you could use projective geometry, where Cross[p1,p2] is the line between two points p1 and p2 and ...


3

(this answer resumes the discussions over at the comments and over the chat. Thanks to @IstvánZachar for helping out and for suggesting my posting it as answer). The problem is that deltaf[f1[A,x]] evaluates f1[A,x] (=14 (1 - x)) before actually computing Sum[D[f, a[i, k]], {i, {A, B}}, {k, {1, 2, 3}}]. Specifying that the attributes of deltaf are to remain ...


3

Dan Fortunato and I made use of Compile for this one. index = Compile[{{p, _Integer}, {r, _Integer}, {n, _Integer}}, If[p <= r, r + Quotient[n, r] - p, Quotient[n, p] ], CompilationTarget -> "C", Parallelization -> True, RuntimeOptions -> "Speed" ]; PrimeSum = Compile[{{n, _Integer}}, Module[{r = Floor[Sqrt[n]], V, S, p = 2, ...


2

If you want the minimal set of distances start with Subsets: cities = {Entity["City", {"Bombay", "Maharashtra", "India"}], Entity["City", {"Bengaluru", "Karnataka", "India"}], Entity["City", {"Agra", "UttarPradesh", "India"}], Entity["City", {"Aurangabad", "Maharashtra", "India"}]}; # -> GeoDistance @@ # & /@ Subsets[cities, {2}] For a ...


2

In Mathematica v10.1 there's undocumented GeneralUtilities`ReapList function. It accepts two arguments: expression and a tag. Using it on adapted test suite from OP: Needs["GeneralUtilities`"] ClearAll[tag] ReapList[Sow[15, tag], tag] (* {15} *) ReapList[Sow[{}, tag], tag] (* {{}} *) ReapList[ Sow[{16, 17}, tag]; Sow[18, tag]; Print["hello"]; Sow[{19, ...


2

Here's a quick&dirty&buggy solution for your two wishes, although I strongly suggest you to do you works the way as the notebook interface designed to. Cls := (SelectionMove[InputNotebook[], All, Notebook]; FrontEndExecute[FrontEndToken["Clear"]]); $Post = (If[Head@$outputNB == Symbol, $outputNB = CreateNotebook[]]; If[# === Null, 1;, ...


2

I have two efficiency increase approaches using existing functions. Distribute the load evenly over the available kernels in parallel. This has gains in speed but memory usage will be about the same. Distribute the load evenly over time. This significantly reduces memory usage but increases time. Capture the number of primes we want to sum. nn = ...


2

Here's something very similar to the Neat example found in the Documentation for FindShortestTour. Is this what you're asking for, or are you asking how FindShortestTour was implemented? (* grab random cities and their GeoPositions *) cities = SemanticInterpretation["US state capitals"]; locs = EntityValue[cities, "Position"]; (* find the shortest tour *) ...


2

The default $HistoryLength causes Mathematica to crash! By default $HistoryLength = Infinity, which is absurd. That ensures Mathematica will crash after making output with graphics or images for a few hours. Besides, who would do something like In[2634]:=Expand[Out[93]].... You can ensure a reasonable default setting by including ($HistoryLength=2), or ...


1

Use Piecewise for discontinuous right-hand sides and coefficients. If, with a capital I, more a programming construct than an algebraic/functional one. NDSolve does discontinuity processing, which improves error estimation and step size when done accurately; using Piecewise helps with that. s = NDSolve[{ Derivative[1][Ca][t] == Piecewise[{{-10*Ca[t] + ...


1

This code from this Wolfram guide uses RandomReal[] to get 100 random points in a plane, than solves traveling salesman problem using FindShortestTour[], and in turn renders suitable drawing: With[{p = RandomReal[10, {100, 2}]}, Graphics[{Line[p[[Last[FindShortestTour[p]]]]], PointSize[Large], Red, Point[p]}]] Tho output should look like this: ...


1

The calculation seems to work, producing the curve, Plot[Sol[x], {x, -.45, 0}] Finding zeroes of Sol requires a modification of the expression in the Question, FindRoot[Sol[x], {x, -0.45}, Evaluated -> False] (* {x -> -0.325184} *) It is not possible to comment on why this might not agree with another calculation without seeing that other ...


1

The function doolittleDecomposite2 refactored by @2012rcampion can use Span(;;) to avoid the inner Do loop doolittle[mat_?MatrixQ] := Module[ {temp = ConstantArray[1, Dimensions@mat], row = Length@mat}, Do[ temp[[k, k ;; row]] = mat[[k, k ;; row]] - temp[[k, ;; k - 1]].temp[[;; k - 1, k ;; row]]; temp[[k + 1 ;; row, k]] = (mat[[k + 1 ;; ...



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