Tag Info

New answers tagged

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 *) ...


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: ...


0

I would recommend checking out SageMathCloud (https://cloud.sagemath.com/). Note it has recently migrated from sagenb.org/. Great benefit is the cloud-based computing option. Love to prototype here. I just started playing around with it, so not super familiar, but claims are pretty powerful and convincing (sagemath.com/#features).


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 ...


0

You could already do this with DownValues TEST["value"] = 2; TEST["method"] = Function[{x}, x^2]; Definition[TEST] TEST[method] = Function[{x}, x^2] TEST[value] = 2 TEST["value"] = TEST["method"][TEST["value"]]; Definition[TEST] TEST[method] = Function[{x}, x^2] TEST[value] = 4 This method might be easier and more straightforward.


0

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 ;; ...


0

I encountered the same question. My approach is to take partial derivatives w.r.t. all variables to be linearized to construct the linearized expression, plus the constant term: (* Expression to be linearized in da, db, dc *) expr = da*db + da^2 + db^3 + dc + da*dc^2 + 12 (* Make List of all vars to be linearized *) ds = {da, db, dc}; (* Create list of ...


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}}


0

So the range is not to large you can make a "brute-force" attack ;-) data = Tuples[Range[0,51], 3]; and Select[data, Plus @@ # == 92 &] you´ll get 1788 solutions. This is regarding to the complete Range (0..51). The sum of three odd numbers is odd, so never equal to 92. For the edited questions solution is possible in the same way and delivers ...


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, ...


0

One can also use ComplexExpand: curvature[x_, y_, z_, t_] := With[{s = {x, y, z}}, With[{v = D[s, t]}, With[{fT = v/Norm[v]}, With[{fK = D[fT, t]/Norm[v]}, ComplexExpand@Norm[fK] ]]]] curvature[Cos[t], Sin[t], t, t] /. t -> 1 // N (* 0.5 *)


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 ...


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;, ...


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 ...


0

I believe LUDecomposition is builtin. LUDecomposition[{{1, 6, 1, 9}, {4, 4, 9, 7}, {10, 4, 10, 2}, {10, 3, 10, 2}}] {{{1, 6, 1, 9}, {4, -20, 5, -29}, {10, 14/5, -14, -(34/5)}, {10, 57/20, 57/56, 11/7}}, {1, 2, 3, 4}, 1}


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, ...


1

I think this does what you're after (to be honest, I had some trouble deciphering the question). patchedData = Module[{gb = GatherBy[SortBy[#, First], First], lens, tot = 0, cnt = 1, mems = {}, sets}, lens = Length /@ gb; sets = Append[Reap[ Scan[(tot += #; mems = {mems, cnt++}; If[tot >= 12, Sow[Flatten@mems]; ...


4

This isn't a problem you should try to solve automatically. Use good code hygiene and make sure you don't call private functions. You should (aim to) understand your code well enough that you don't get surprises like this --- you wrote it, and you know it better than anyone else. If there are surprises even to you, how will anyone else understand it?! ...


0

Let me refer to the second IndicesFromStrings as IndicesFromStrings2. To make it work, replace Set[ReleaseHold[ToExpression[#1]], ToString[First@#2]] with Clear[#1]; Set[Evaluate@ToExpression[#1], First@#2], i.e. IndicesFromStrings2[ls_List, opts:OptionsPattern[]] := ( Clear[#1]; Set[Evaluate@ToExpression[#1], First@#2] ) & ~MapIndexed~ ( ...


2

Using Sort incorrectly Sorting mathematical expressions without numeric conversion New users are often baffled by the behavior of Sort on lists of mathematical expressions. Though this is covered in the documentation of Sort itself they expect that expressions will be ordered by numeric value but they are not. Instead expressions are effectively ordered ...


5

Symbols are created at the instant that they are read -- not when they are evaluated. In the first example, there are two expressions: Needs[...]; and myProgramF[...]. The first expression is read and evaluated, loading the package. The second expression is then read, resolving myProgramF using the loaded package. It is then evaluated. In the second ...


1

A mild refactoring of ubpdqn's code: f[n_, d_] := #*Map[{-Cos[#], -Sin[#]} &, #/d] & @ Sqrt @ Range @ n di[n_, d_, rad_] := Module[{fu, pt, grad, pg}, fu = f[n, d]; pt = MapIndexed[{Disk[#, rad], Sqrt[HoldForm @@ #2] ~Style~ Black ~Text~ #} &, fu]; grad = Reverse[{{0, 0}, ##} & @@@ Partition[fu, 2, 1]]; pg = ...


2

Try this: Clear["Global`*"]; m = 1; \[HBar] = 1; k = 1; V = -k/Sqrt[1 + x^2 + y^2]; A = 8; \[CapitalDelta] = 10^-3; SE[Etr_] := -\[HBar]^2/(2 m) \!\( \*SubsuperscriptBox[\(\[Del]\), \({x, y}\), \(2\)]\(\[Psi][x, y]\)\) + V \[Psi][x, y] - Etr \[Psi][x, y] == 0 \[CapitalOmega] = Disk[{0, 0}, A]; BC = DirichletCondition[\[Psi][x, y] == ...


11

I appreciate that attempts should be the minimum standard. As this does not resemble the desired result, perhaps it can be a starting point. I look forward to OP attempt and other answers. f[n_, d_] := Module[{r = Range@n, a}, a = Sqrt[#]/d & /@ r; MapThread[#1 {-Cos[#2], -Sin[#2]} &, {Sqrt[r], a}]] di[n_, d_, rad_] := Module[{fu, pt, grad, pg}, ...


8

adjmat = {{0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, {1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0}, {0, 1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, ...


3

Here is a very simple version of what you seem to be looking for. First I enter some fake data: points = {{0, 0, 0}, {1, 0, 0}, {1, 1, 0}, {0, 1, 1}, {0, 0, 1}, {0, 1, 0}}; am = {{0, 1, 0, 0, 1, 0}, {1, 0, 0, 0, 1, 0}, {0, 0, 0, 1, 0, 1}, {0, 0, 1, 0, 0, 1}, {1, 1, 0, 0, 0, 0}, {0, 0, 1, 1, 0, 0}}; i.e. points (their coordinates) and adjacency ...



Top 50 recent answers are included