Incorrect solution of diffusion equation with Neumann boundary conditions

I want to set up a PDE model, which takes a two-dimensional diffusion equation into account. The key problem is that I have some trouble in solving the two- dimensional diffusion equation numerically. Consider the following code:               L = 10;     T = 10;     system = {        D[c[x, y, t], {t, 1}] == D[c[x, y, t], {x, 2}] + D[c[x, y, t], {y, 2}],        Derivative[1, 0, 0][c][0, y, t] == 0,        Derivative[1, 0, 0][c][L, y, t] == 0,        c[x, 0, t] == c[x, L, t],        c[x, y, 0] == 1        };     sol = NDSolve[system, c, {x, 0, L}, {y, 0, L}, {t, 0, T}];     Manipulate[Plot3D[Evaluate[c[x, y, t] /. sol], {x, 0, L}, {y, 0, L}], {{t,T}, 0, T}]      ![Mathematica graphics](http://i.stack.imgur.com/gwrOZ.png) As you can see for `t = 10` there are artifacts at the two edges where the Neumann conditions were applied. Obviously, `c[x, y, t] = 1` solves the system and since this is the initial condition Mathematica should have no trouble to compute it numerically. It tried various ODE solvers (`"ImplicitRungeKutta"`, `"BDF"`, `"Adams"`), but it seems that there is some problem with the spatial discretization, perhaps because of the Neumann boundary condition for the variable `x`. Any suggestions how to fix it?


Colors for multiple piecewise functions

I have the following $3$ piecewise functions, and I would like that `f1`, `f2` and `f3` have $3$ different colours:               Plot[ Piecewise[{{{f1, f2,f3}, B < 1/2}, {{f1, f2,f3}, B > 1/2}}], {B, 0, 1}]      How can I do that?


Reconstruct text pages cut by shredder

**Q1** : I have a page of printed text file, but it was cut by a paper shredder (from top to bottom). You can download all the paper fragment here. There are some examples of them. How can I reconstruct it? ![enter image description here](http://i.stack.imgur.com/GscbS.png) **Q2** : This time, the situation is even worse - the page was cut by a shredder twice (from top to bottom and from left to right) ! Download Link. ![enter image description here](http://i.stack.imgur.com/h9Ldw.png) My code for **Q1** :               filenames = FileNames["*.bmp", "C:\\Users\\Liao\\Desktop\\B\\file1"];     pics = Import /@ filenames;     binarypic = Binarize[#, 0.9] & /@ pics;     binarydata = ImageData /@ binarypic;     leftandrightdata =      MapIndexed[{#2[[1]], #1[[All, 1]], #1[[All, -1]]} &, binarydata];     result = {};     firstPic = Select[leftandrightdata, ! MemberQ[#[[2]], 0] &][[1, 1]];     start = leftandrightdata[[firstPic]];     DeleteCases[leftandrightdata, start] //.            x_ /; Length[x] > 0 :> (sort =         SortBy[x, HammingDistance[#[[2]], start[[3]]] &];          AppendTo[result, start = sort[[1]]]; Rest[sort]);     Extract[pics,      Prepend[List /@ result[[All, 1]], {firstPic}]] // ImageAssemble      This code maybe dizzy for you, but it doesn't matter. The core idea is simple and straightforward, which use `HammingDistance` to determing whether two images can be combined together. But for **Q2** , I can't really find a good way to solve it.


Correcting a correlation matrix to be positive semidefinite

Does Mathematica have a way to "fix" a correlation matrix that is not positive semi-definite? I looked through the documentation and search the internet but could not find anything.


What strategies can I use to evaluate a limit when Limit[] returns unevaluated

I'm trying to find the following limit using _Mathematica_ : $$\lim_{N\to\infty}\sum_{k=1}^N\left(\frac{k-1}{N}\right)^N$$ The problem is taken from here and is known to converge to $\displaystyle\frac{1}{e-1}$. However, using `Limit` in a straightforward manner returns unevaluated:               Limit[Sum[((k - 1)/n)^n, {k, 1, n}], n -> ∞]     (* Limit[Sum[((k - 1)/n)^n, {k, 1, n}], n -> ∞] *)      How can I explore this problem using _Mathematica_ and obtain the limit?


Best way to compute row eigenvectors

Without qualification, the term eigenvectors (of a matrix) refers to the column eigenvectors (of a matrix) and can be directly computed with `Eigenvectors[]`. To get the row eigenvectors, one can invert the transpose of the matrix returned by `Eigenvectors[]` (or equivalently, the inverse of `JordanDecomposition[][[1]]`). This approach is usually fast enough, but sometimes computing the inverse takes an enormous amount of time compared to just computing the column eigenvectors. This can happen when the column eigenvectors are partially symbolic or involve `Root[]`. > Is there a better way to compute the row eigenvectors of a matrix? In > particular, is there a way to compute the row eigenvectors as fast as the > column eigenvectors?


How can this DivisorSigma code be made fast?

Since Project Euler problems are now fair game for questions I have a question of my own.   A certain problem* states: > For a positive integer n, let σ2(n) be the sum of the squares of its > divisors. For example, > > σ2(10) = 1 + 4 + 25 + 100 = 130. > > Find the sum of all n, 0 < n < 64,000,000 such that σ2(n) is a perfect > square. This _Mathematica_ code takes something like an hour to run on a modern machine:               Sum[If[IntegerQ @ Sqrt @ DivisorSigma[2, i], i, 0], {i, 64*^6 - 1}] ~Monitor~ i // Timing      The similarly naive PARI/GP code takes a minute or two:               sum(n=1,64*10^6,issquare(sigma(n,2))*n)      Is there some way to make the _Mathematica_ code fast, or otherwise solve the problem quickly in _Mathematica_? Using a faster perfect square test helps quite a bit but it is still far from the PARI/GP performance. Compilation does not seem possible as numbers exceed the maximum machine-size integer. (*To foil search engines please do not mention the number of the Project Euler problem related to this question. Thanks.)


Why the EuclideanDistance of these 2 exact points generates the warning N::meprec?

The two points are:               pts = {{1/4 (-1 - Sqrt[5]), Sqrt[5/8 - Sqrt[5]/8]},             {1/4 (-1 - Sqrt[5]), -Sqrt[5/8 - Sqrt[5]/8]}};     EuclideanDistance @@ pts      > N::meprec: Internal precision limit $MaxExtraPrecision = 50.` reached while > evaluating 1/4 (-1-Sqrt[5])+1/4 (1+Sqrt[5]). >>               (* Sqrt[4 (5/8 - Sqrt[5]/8) + Abs[1/4 (-1 - Sqrt[5]) + 1/4 (1 + Sqrt[5])]^2] *)      According to the document, `EuclideanDistance[u, v]` equals to `Norm[u - v]`, so it's not surprising that a `Norm` version generates the same warning and result:               Norm[Subtract @@ pts]      > N::meprec: Internal precision limit $MaxExtraPrecision = 50.` reached while > evaluating 1/4 (-1-Sqrt[5])+1/4 (1+Sqrt[5]). >>               (* Sqrt[4 (5/8 - Sqrt[5]/8) + Abs[1/4 (-1 - Sqrt[5]) + 1/4 (1 + Sqrt[5])]^2] *)      The warning disappears if we choose `Sqrt`:               Sqrt[Total[(Subtract @@ pts)^2]]          (* Sqrt[4 (5/8 - Sqrt[5]/8) + (1/4 (-1 - Sqrt[5]) + 1/4 (1 + Sqrt[5]))^2] *)      Why? Simply a bug?


How to program a clickPanel for chemical elements (like a periodic table)?

The command               ColorData["Atoms", "Panel"]      indicates RGBColors of "Atoms" by clicking a panel. As I don't want to reinvent the wheel, I asked myself: How to transform ColorData["Atoms", "Panel"] in a clickPanel for chemical elements, which could be used as argument for other functions like ElementData[ ] or IsotopeData[ ]?


NIntegrate with and without MaxRecursion

Ran a mathematica code using NIntegrate containing an integration over spherical and normal bessel functions. 1.Would the answer in the two cases change if I use MaxRecursion with some number of recursions and don't use it? 2. And also will it matter if I use the global adaptive strategy? 3. In case I want to exclude singularity points for x variable, would I use {x,a,b,c,d} where a and b are singular points and c and d are integration limits. The following is the integral $\mathbf{W}\left(k,l,m,\theta_{k}\right)=8\pi i^{l}\Gamma\tau_{rei}j_{2}\left(k\eta_{rei}\right)P_{2}\left(\cos\theta_{k}\right)\left[\beta P_{l-2}^{m}\left(\cos\theta_{k}\right)j_{l-2}\left(\xi\right)+\gamma P_{l+2}^{m}\left(\cos\theta_{k}\right)j_{l+2}\left(\xi\right)+2\zeta P_{l}^{m}\left(\cos\theta_{k}\right)j_{l}\left(\xi\right)\right].$ Integration is to be done of the following quantity: ($\Gamma$, $\beta$, $\gamma$ and $\zeta$ are just functions of l and m, $\Lambda$ is just a constant, $\xi=k*C$, C is some constant) $\int\mathbf{W}\left(k,l,m,\theta_{k}\right)\mathbf{W}\left(k,l^{\prime},m^{\prime},\theta_{k}\right)\cos\theta_{k}\frac{\Lambda}{k^{3}}\sin\theta_{k}d\theta_{k}$


Command to insert item into list

Is there a command to insert an item into a list such that they form pairs? In other words to take               InsertObject[{a,b,c},d]      which will output               {{a,d},{b,d},{c,d}}    ?      This would be equivalent to the function,               Table[{{a,b,c}[[i]],d},{i,1,3}]      This way works just fine, but it doesn't seem to be the "Mathematica way" of doing things. Is there a built in command this?


Master Document

I'm wandering is there Master document concept in Mathematica so that the counter will be counted sequencially in master document. Mean file in child document, the counter follow from master document. I knew that I can setup the counter in the specific file, but then if I add some new section in the first file, then I should change the start counter in the next file. I don't want it, I like next file change the start counter directly, just like Latex


How to use all the kernels efficiently

We build a project with _Java_ and _Mathematica_ technologies. For this project we have written a bunch of functions in _Mathematica_ and integrated some functions in one `JSP` file. In this way, we made four `JSP` files containing _Mathematica_ code. These `JSP` (in which files _Mathematica_ functions are integrated) files are linked and triggered by _Java_ `servlet's`. Note: for every request, _Mathematica_ (four `JSP`) files should be run. We are using _Mathematica_ for back-end computations purpose. I have two _Mathematica_ kernels, thus my **question** is: How can I use these two kernels efficiently for processing requests? I've never worked on more kernels than two, if anyone has some experience on that point please let me know.


Prevent mathematica from simplifying

How can i prevent _Mathematica_ from automatically simplifying the expression `Sqrt[a/b]`? In case `a=1` and `b=2`, _Mathematica_ will print `1/Sqrt[2]`, whereas case `a=3` and `b=4`, _Mathematica_ will print `Sqrt[3/4]`. The output of my program would be better readable, if the fractions stayed unsimplified under the square-root symbol.


Graphing a network with state transition flows (of varying size)

In one of Stephen Wolfram's recent blog posts (http://blog.stephenwolfram.com/2013/04/data-science-of-the-facebook- world/#more-5350) he provides the network plot below. The size of the arrows that connects the different countries is supposed to illustrate the volume of people that moved from country X to country Y. **My questions:**   1. Can somebody please illustrate how to replicate this graph in mathematica (or at least point out "relevant" documentation)?    2. [Bonus part] would it be possible to have the size of the flags (or just the end nodes) correspond to the size of the given country's population (i.e. Chinas flag will be relatively larger than USA's Flag, who's flag will be larger than that of the UK, etc.)?  ![Image from Wolfram's Blog Post](http://i.stack.imgur.com/DjWKV.png)


Start animation after choosing of initial values without Animate

I want to simply set some parameters with sliders and click a button to start animation. I know that I can manage this with Animate and Manipulate, but my animation is written like in this post, because I need to perform some calculations for stop condition. So the point is that I want to start loop after setting parameters and clicking button. Is it achievable? //edit Ok, lets say that in the animation from linked post is some variable m               Clear[p];     Dynamic[p]     Do[p = Plot[m Cos[a x], {x, 0, 100}, Frame -> True,          FrameLabel -> {{None, None}, {x,        Style[Column[{"doing my own animation !", Cos[a x]},          Alignment -> Center], 14]}}, GridLines -> Automatic];     If[a > 0.2, Break[]]; (*condition to stop*)     Pause[.2],     {a, 0.1, 1, .01}     ]      I'd like to start this animation with button, and before that set **m** with slider.


FrameLabel and OverTilde

What is the problem with this expression inside ListPrint? `OverTilde` generates here a mess:               FrameLabel->{{"f"<>"("<>ToString[OverTilde["x"]]<>")",None},{"x",None}}


Prevent FullSimplify from converting trigonometric expressions to exponential

There's an option for `FullSimplify`, which is `Trig`, and with it I could prevent a trigonometric identities from being used. I'm looking for a similar option that would prevent `FullSimplify` from using the Euler formula               Sin[x] -> 1/2/I (Exp[x] - Exp[-x])     Cos[x] -> 1/2   (Exp[x] + Exp[-x])      So I want `FullSimplify` to retain `Sin` and `Cos` functions and to use trig identities, but no conversions to `Exp`. ### Edit Example as requested from a comment:               Cos[2 B g t] Sin[u]^2 - I Sin[2 B g t] Sin[u]^2      In this formula, I want `FullSimplify` not to convert `Cos[2 B g t] - I Sin[2 B g t]` to `Exp[-2IBgT]`.


ListContourPlot memory problems?

I have a simple 3d dataset (size 7035 x 3, I put it on my site if you want to check) which I want to plot with ListContourPlot:               x = Import["http://www.inrim.it/~magni/a.dat"];     ListContourPlot[x, PlotRange -> {All, {0, 6}}]      ... and so far so good. But the x scale must - for various reasons - be rescaled, so I did this:               ListContourPlot[x /. {H_, f_, s_} -> {H*80, f, s}, PlotRange -> {All, {0, 6}}]      and M is unable to complete: after some seconds it exits _without errors_ , and I discover the kernel has quit!


Is it possible to insert new colour schemes into ColorData?

Because of the standards in my field, for many plots I need to use (or at least end up using) rather narrowly defined colour schemes, and in particular the Matlab "Jet" scheme, which is well described in this SO answer. I've typically done this by having a bit of boilerplate code which I include when necessary, and which creates the object `ColorData["Jet"]`:               Unprotect[ColorData];     ColorData["Jet"] =        Function[x,         Blend[Transpose[{             {0, 0.1, 0.3, 0.5, 0.7, 0.9, 1.0},              {Darker[Blue], Blue, Cyan, Green, Yellow, Red, Darker[Red]}        }], x]];     Protect[ColorData]      This is convenient because the new colour scheme can be handled using the same syntax as the in-built ones. In version 10, however, the choice of colour schemes has a bunch of additional niceties which I'd like to take advantage of it that's possible. For example, the autocomplete menu for `ColorDat...` gives you instant access to a drop-down menu with images of the schemes' gradients, and which inserts `ColorData["gradient-of-your-choice"]` when you click OK. ![enter image description here](http://i.stack.imgur.com/xkIdz.png) ![enter image description here](http://i.stack.imgur.com/Av0lK.png) Similarly, when you evaluate such `ColorData` objects, they come out with a nice preview of the gradient. ![enter image description here](http://i.stack.imgur.com/VazBL.png) So, my question is: is it possible to take advantage of this structure by 'injecting' additional data into `ColorData`, so that custom colour schemes come up in the choices and behave in the same way as in-built ones?


Sending a command to an already opened frontend

I'm trying to pipe low-level notebook commands to work through terminal and I've tried various ways, but I can't really get to the frontend that's already open. For example Opening a notebook from command line in an existing front end instance this no longer works. I've tried connecting to notebooks kernel, but it didn't work as I expected... perhaps I know too little. I'd imagine it to work like this: math -script file.m or mathematica file.m Where file.m would contain commands to evaluate on currently opened notebooks in an existing mathematica instance. How should I approach it?


Nothing appears in simple plot

I'm trying to get the following simple code to work. (The code is just supposed to graph the norm of the second derivative of a vector function).               z[t_] = {1, t^2, t^3}     Plot[D[D[Norm[z[t]], t], t], {t, 0, 5}]      Nothing appears on the graph, and I get errors like "General::ivar: ... is not a valid variable". I read that these errors can be avoided if one uses the Evaluate command:               Plot[Evaluate[D[D[Norm[z[t]], t], t]], {t, 0, 5}]      This code doesn't result in any errors, but nothing appears in the plot. Interestingly, the code that reverses the order of operations and graphs the second derivative of the norm works fine:               Plot[ Evaluate[Norm[D[D[z[t], t], t]]], {t, 0, 5}]      I tried using DiscretePlot as well, but that didn't help. What am I doing wrong? I suspect the problem somehow relates to evaluation, but I can't figure it out. Thanks in advance for any help!


fitting system of ODEs - "part2 of {} does not exist" errod

I'm trying to fit my data to a system of ODEs:               x'[t]==a*x[t]+b*y[t]     y'[t]==c*y[t]+d*x[t]+e*z[t]     z'[t]==f*z[t]+g*y[t]      having t,x[t],y[t],z[t]. I followed the code from here, but in the end got an error "Part::partw: "Part 2 of {{X[0]->6.99188*10^7,Y[0]->1.44163*10^6,Z[0]->1.22418*10^6}} does not exist. General::stop: Further output of Part::partw will be suppressed during this calculation. >>" I'm a newbie in mathematica, can you point out what I do wrong? Or maybe you can suggest better way to do such fitting? Here's my code:               data = {{0.0001, 69721851.824697, 1710041.15718086, 1249648.07662318},     {0.0002, 69043570.7566936, 2066441.5110575, 1844749.71071548},     {0.0005, 67932147.9362317, 2994541.62071368, 3108260.41352905},     {0.0009, 66863760.1248742, 3587039.29801347, 4282635.21874863},     {0.0015, 64345357.8511309, 968094.021795217, 10585640.3555617},     {0.003, 64768407.2504181, 3655819.53710869, 7812897.34991382},     {0.005, 63761257.6277216, 1222706.2166919, 12090416.0146563},     {0.01, 64307991.5530707, 1139370.28069903, 12657324.2458834},     {0.05, 68583353.8471158, 1802661.70625935, 13079855.4358155},     {0.08, 71169929.0580033, 1496318.92452295, 13991708.7133703},     {0.1, 72811456.5338936, 1853138.14008422, 13681128.3978895},     {0.2, 78742983.529449, 3190647.61480991, 13511961.6223572},     {0.5, 88513835.0051046, 3556145.38852813, 14771090.342085},     {1, 94765316.2395368, 4882322.77031356, 14796960.6588559},     {2, 98437836.0564595, 5353800.46123903, 14862252.8596808},     {5, 99708229.0609698, 3726362.20580859, 16993877.2198709},     {10, 99634510.8439181, 4858332.59695385, 16478819.0906012}};     {t, x, y, z} =       Transpose[data];(*extract data*){xdata, ydata, zdata} = (Transpose[{t, #}]) & /@ {x, y, z};(*get {t,x} and {t,y} pairs*)fx =  Interpolation[xdata, Method -> "Spline"];(*spline interpolation*)fy =  Interpolation[ydata, Method -> "Spline"];     fz = Interpolation[zdata, Method -> "Spline"];     dx = fx'[t];     dy = fy'[t];     dz = fz'[t];     ab = FindFit[Transpose[{fx[t], fy[t], dx}], a*X + b*Y, {a, b}, {X, Y}]     cde = FindFit[Transpose[{fx[t], fy[t], fz[t], dy}], c*Y + d*X + e*Z, {c, d, e}, {X, Y, Z}]     fg = FindFit[Transpose[{fz[t], fy[t], dz}], f*Z + g*Y, {f, g}, {Y, Z}]     (*search backward*)NDSolve[{X'[u] == a*X[u] + b Y[u] /. ab,      Y'[u] == c*Y[u] + d*X[u] + e*Z[u] /. cde,      Z'[u] == f*Z[u] + g *Y[u] /. fg, X[0.0001] == 69721851.824697, Y[0.0001] == 1710041.1571808, Z[0.0001] == 1249648.07662318}, {X[0], Y[0], Z[0]}, {u, 0, 10.01}, MaxSteps -> 20000]     (*find solution of x[t],y[t],z[t] with NDSolveValue*)     sol = NDSolve[{X'[u] == a*X[u] + b Y[u] /. ab,      Y'[u] == c*Y[u] + d*X[u] + e*Z[u] /. cde,      Z'[u] == f*Z[u] + g *Y[u] /. fg, X[0.0001] == 69721851.824697,      Y[0.0001] == 1710041.1571808,      Z[0.0001] == 1249648.07662318}, {X[0], Y[0], Z[0]}, {u, 0, 10.01}, MaxSteps -> 20000]     (*plot the results*)     Show[{ListPlot[{xdata, ydata, zdata}, AxesLabel -> {"time", "value"}, PlotLegends -> {"xdata", "ydata", "zdata"}, PlotStyle -> {Red, Green, Pink}], ListLinePlot[{Table[sol[[1]], {u, 0.0, 10, 0.01}], Table[sol[[2]], {u, 0, 10, 0.01}], Table[sol[[3]], {u, 0, 10, 0.01}]}, PlotStyle -> {Orange, Blue, Yellow}, PlotLegends -> {"solution.x", "solution.y", "solution.z"}]}]


Problem with Label in a Do loop, "nolabel"

Can someone tell me why this code doesn't work and how to fix it ? Thanks.               k = 0;     Do[{       Label[top],       k = k + 1,       Print["k = ", k],       If[k < 4, Goto[top]]},     {10}]      > >     k = 1 >   >     Goto::nolabel: Label top not found. >> >   >     Hold[Goto[top]] >


Replacing whole strings

I imported a text and seperated al words by using `StringCases`. After this I would like to manipulate the text, for example to replace all singular verbs to plural. When I use `StringReplace`, then _Mathematica_ search for a part of the string and replaced it. For example               texttest = "walking walk routes walks"     texttest1 = StringCases[texttest, RegularExpression["\\w(?<!\\d)[\\w'-]*"]];     newwords= {"walk" -> "walking", "walks" -> "walking"};     texttest2 = StringReplace[texttest1, newwords];      The result is: > {"walkinging", "walking", "routes", "walkings"} I would like to get: `{"walking", "walking", "routes", "walking"}`.


Values (or positions) of array row elements within a specified number of positions from target value

I have the need to collect values from the rows of rectangular arrays of arbitrary precision integers, given a target element value and allowed "distance" (positions +/- within the row from found targets). E.g., given a target array of               ar={{6, 10, 6, 5, 7}, {10, 2, 2, 0, 7}, {0, 6, 3, 7, 5}, {2, 8, 6, 9, 1}, {8, 8, 5, 0, 8}}      and a target value of `5`, with an allowed "distance" of `2`, the result should be               {10, 6, 5, 7, 3, 7, 5, 8, 8, 5, 0, 8}      Result must be order-preserving, i.e., as if the array were "read" left to right, top to bottom. I'm using this:               nearEles[array_, ele_, dist_, posOnly_: False] :=        With[{r = Range[-dist, dist], d = Dimensions[array][[2]]},        If[posOnly, #, Extract[array, #]] &[SparseArray[           Map[IntegerDigits[BitOr @@ (BitShiftLeft[FromDigits[#, 2], r]), 2, d] &,                SparseArray[BitXor[1, Unitize[array- ele]]]]]["NonzeroPositions"]]];      so in the above example, called as `nearEles[ar,5,2]` gets me what I need. On actual data (typically 1K X 1K to 4K X 2K array size), performs pretty well. Any ideas for a more efficient (and perhaps less ungainly) method?


Delete contexts from a string representation of a symbol

I want to delete the string representing the context of a symbol. For info I need such a functionality in my `ShowIt` function defined here I'd like to know how I can replace such a string with a rule so that for example,               "MyFunc[ShowIt[Q1`Private`var1$123], ShowIt[Q2`Private`var2$456], 0., 1.]"      gives               "MyFunc[ShowIt[var1], ShowIt[var2], 0., 1.]"      or               "Q1`Private`var1$123"      gives               "var1"


CustomTicks and ListPlot - Can't seem to get them working

I have a very large list of numbers like               list={{a1,b1},{a2,b2},...,{ai,bi}}      where a1 ranges between 10^-9 and 10^-5 and bi varies between 0 and 100. I have generated successfully the plots and am now tweaking them with CustomTicks to look a bit better. But I'm not able to get the XX axis as I want. The YY axis should be linear and the XX axis should be Logarithmic. But the best I could get was this: ![Mathematica graphics](http://i.stack.imgur.com/rLWha.png) Could someone please tell me what I'm doing wrong? I've been trying different things for so long and I can't figure this out. Here is my code:               a = {#, Random[Real, {0, 100}]} & /@               Union[     Range[1*^-9, 1*^-8, 1*^-9]                   ~Join~Range[1*^-8, 1*^-7, 1*^-8]                                     ~Join~Range[1*^-7, 1*^-6, 1*^-8]                   ~Join~Range[1*^-6, 1*^-5, 1*^-7]]          ListLogLinearPlot[a, Joined ->True, Axes -> False, FrameLabel -> {{"A", None}, {"B", None}},                 Frame -> {{True, False}, {True, False}}, LabelStyle -> {Bold, 25},                 PlotStyle -> {{Thickness[0.003], Black},                               {Thickness[0.003], Dashing[0.015], Black},                               {Thickness[0.003], Dashing[0.005], Black}},                PlotRange -> {0, 100}, ImageSize -> {800, 600},                 FrameTicks - {{LinTicks[0, 100, 20, 2], None},                               {LogTicks[E, -8, -5], None}},                FrameTicksStyle -> Directive[Thickness[0.01]]]


vectorial ODE in mathematica with matrix exponentials

I want to solve the following equation in mathematica : `DSolve[{X'[t] == A.X[t], X[0] == ( {{0},{0}} )}, X[t], t]` It is a system of 2 ODEs coupled by the matrix A, that I don't want to put in the form `{{a,b},{c,d}}` in order to have the output as a function of matrix exponential. Mathematica understands that but gives a solution strangely expressed as:                {{X[t] ->       InverseFunction[Dot, 2, 2][A,           E^(t A.1)          InverseFunction[InverseFunction[Dot, 2, 2], 2, 2][A, 0]]}}      Where it indeed uses a matrix exponential, but also relies on a strange notation `InverseFunction [...]` My question is how to get rid of this `InverseFunction` notation to have a more readable expression. Do I for example have a manner to postulate that A is a (2,2) matrix, invertible, with inverse B? Or more generally, how to solve vectorial ODE's and make Mathematica write the solution by relying on exponential matrix notation? If I can hope a better result with maxima, please advise. Thanks a lot for help


Given a symbolic expression how to find if starts with a minus or not?

I am using a Mathematica function which returns some error term in symbolic form. I needed a way to determine if this term starts with a minus sign or not. _There will be only one term_ This is to avoid having to worry about Mathematica auto arranging terms like `x-h` to become `-h+x` and hence it is not fair to ask for more than one term solution. Here are some examples of the expressions, all in input form               negativeTruetests = {(-(71/12))*h^2*Derivative[4][f],     (-1)*h^2*Derivative[10][f],     (-(359/3))*h^2*Derivative[10][f], -2*h, -x*h^-2, -1/h*x }          negativeFalseTests = { h^2*Derivative[4][f] , h^2*Derivative[4][f],     33*h^2*Derivative[4][f], h^-2, 1/h}      I need a pattern to check if the expression starts with minus sign or not. ![Mathematica graphics](http://i.stack.imgur.com/5GB80.png)


Problem while solving system of two second order non linear coupled differential equations using NDSolve function

I am a completely new to _Mathematica_ , and I am sorry if this question is dumb. I have to solve a system of two second order non linear coupled differential equations (that I got from the Lagrangian equation of motions for a particular system). The following is my code: I hope it is clear.               NDSolve[      {       -29.4 + 9.8 Cos[y[t]] + x[t] Derivative[1][y][t]^2 - 4 x''[t] == 0,          9.8 Sin[y[t]] + 2 Derivative[1][x][t] Derivative[1][y][t] + x[t] y''[t] == 0,        x[0] == 1, y[0] == 1.57, Derivative[1][x][0] == 0,        Derivative[1][y][0] == 29.4      },      {x[t], y[t]}, {t, 0.1}     ]      But I am getting exactly the same output as the input. _Mathematica_ is returning the same piece of code.


Integrating over a region without singularity gives an error indicating the function has singularity in that region

I have the following 2D region over which I want to integrate a function:               r1  = Sqrt[mη^2 + (Sqrt[w1^2 - mπ^2] + Sqrt[w2^2 - mπ^2])^2] // Expand;     r2  = Sqrt[mη^2 + (Sqrt[w1^2 - mπ^2] - Sqrt[w2^2 - mπ^2])^2] // Expand;     mη  = 0.547;     mηp = 0.958;     mπ  = 0.137;          RegionPlot[mηp - w1 - w2 < Re[r1] && mηp - w1 - w2 > Re[r2],         {w1, .1, .25}, {w2, .1, .25}, BoundaryStyle -> Blue, FrameLabel -> {"w1", "w2"}]      ![Mathematica graphics](http://i.stack.imgur.com/xmdnv.png) Now I want to integrate the following function over this region:               function[w1_, w2_]=Abs[1.05133+ (6.16152 (0.656093- 1.916 w1 - 1.916 w2)         (0.958- 1. w1 - 1. w2))/(0.921055- 1.916 w1 - 1.916 w2) -          (10.1147 (0.656093- 1.916 w1 - 1.916 w2) (0.958- 1. w1 - 1. w2))/         (1.57895- 1.916 w1 - 1.916 w2) - 55.0594 (-((0.479 w1 (-0.618555 + 1.916 w1))/         (0.0307393+ 1.916 w1)) - ( 0.479 w2 (-0.618555 + 1.916 w2))/(0.0307393+ 1.916 w2))]^2      When I plot the function it doesn't have any singularity:               Plot3D[function[w1,w2],{w1, 0.137, 0.2445}, {w2, 0.137, 0.2445}, BoxRatios -> {1, 1, 4},        RegionFunction -> Function[{w1, w2, z}, mηp - w1 - w2 < Re[r1] && mηp - w1 - w2 > Re[r2]]]      ![Mathematica graphics](http://i.stack.imgur.com/5ABqL.png) But when I use the following command:               NIntegrate[function[w1,w2] Boole[Re[r2]< mηp - w1 - w2 <          Re[r1]], {w1, 0.137, 0.2445}, {w2, 0.137, 0.2445}]      _Mathematica_ says it has a singularity. Why?


Passing a matrix as a function argument

I am trying to do the following:               q = Table[i + j, {i, 1, 15}, {j, 1, 10}];     normalize[mat_] := (temp = Transpose[mat[[2 ;;, 5 ;;]]];       temp1 = Transpose[N[Map[Normalize[#] &, temp]]];       mat[[2 ;;, 5 ;;]] = temp1; Return[mat])     q1=normalize[q];      I get the following error:               Set::setps:      {{2,3,4,5,6,7,8,9,10,11},     {3,4,5,6,7,8,9,10,11,12},     {4,5,6,7,8,9,10,11,12,13},     {5,6,7,8,9,10,11,12,13,14},     {6,7,8,9,10,11,12,13,14,15},<<5>>,     {12,13,14,15,16,17,18,19,20,21},     {13,14,15,16,17,18,19,20,21,22},     {14,15,16,17,18,19,20,21,22,23},     {15,16,17,18,19,20,21,22,23,24},     {16,17,18,19,20,21,22,23,24,25}}      in the part assignment is not a symbol. >>      Can you please help me in finding out what is wrong? I am new to _Mathematica_.


Derivatives (divergence, gradient, curl) of interpolated 3D data

How can I calculate a vector derivative (i.e. divergence, gradient, curl) of interpolated data? For sample data, you can use:               f[x_, y_, z_] := Exp[I z] {1, 0, 0}     testdata=Flatten[Table[N@{x,y,z,f[x,y,z]},{x,0,4 Pi,Pi/10},{y,0,4 Pi,Pi/10},{z,0,4 Pi,Pi/10}],2];     intf = Interpolation[testdata]      I know that for 1D data, like               dim1 = Table[N@{z, f[0, 0, z]}, {z, 0, 2 Pi, Pi/10}];     int1 = Interpolation@dim1;      you can do `D[int1[x],x]`. However, I can't seem to get convince MMA that the interpolated function `intf` actually returns a "vector" quantity (i.e. `Length@intf[x,y,z]->3`), so that I can do something like:               curl = {D[#[[3]],y]-D[#[[2]],z],-(D[#[[3]],x]-D[#[[1]],z]),D[#[[2]],x]-D[#[[1]],y]}&;     curl@intf[x, y, z]     (* Out[] := {0,0,0} *)      Similarly, this should work for gradient:               grad = {D[#[[1]], x], D[#[[2]], y], D[#[[3]], z]} &;      and divergence:               div = (D[#[[1]], x] + D[#[[2]], y] + D[#[[3]], z])&;      I've posted my best attempt in an answer below, but I'm wondering what other solution approaches there are.


Plot hangs Mathematica through NETLink

I have a C# function that calls Mathematica via Wolfram.NETLink. On our home computers all the test calls work perfectly, but on our AWS server (both a microinstance and a beefy c3.xlarge instance), for some reason Plot commands seem to fail. We've tried Export with Plot, and also just computing a vanilla Plot and trying to grab the result through the kernel. Both hang MM indefinitely, and later kernel calls are rejected. When using Export no file is saved; when using Plot, no image comes through the MathKernel. Any and every Plot command, by itself or wrapped in an Export, produces this effect, but only through NETLink (running the exact same command via the MM notebook interface is successful), and only on our AWS server (this works fine on our home computers), and only these commands -- every other MM command we send gets processed just fine.


Accessing sublists conditional on their length

Say I have a list that looks like this:               list = {{{151.335`, 245.102`}, {1, 1}}, {{41.435`, 245.021`}, {2, 2}, {3, 3}},      {{131.048`, 243.364`}, {3, 3}, {56, 56}, {76, 23}}, {{164.911`, 244.039`}, {4, 4}},      {{98.1685`, 239.618`}, {5, 5}}, {{196.333`, 239.212`}, {6, 6}}, {{184.767`, 234.228`},      {7, 7}}, {{213.044`, 234.24`}, {8, 8}}, {{26.6316`, 221.423`}, {9, 9}}};      How can I return the last element in each sublist conditional on the sublist being a critical length `k`? For example if we set `k=3`, we'd return `{{3, 3}, {76, 23}}` from the above list. Here's the naive way to do it:               k = 3;          list = {{{151.335`, 245.102`}, {1, 1}}, {{41.435`, 245.021`}, {2, 2}, {3, 3}},              {{131.048`, 243.364`}, {3, 3}, {56, 56}, {76, 23}}, {{164.911`, 244.039`},               {4, 4}}, {{98.1685`, 239.618`}, {5, 5}}, {{196.333`, 239.212`}, {6, 6}},              {{184.767`, 234.228`}, {7, 7}}, {{213.044`, 234.24`}, {8, 8}},              {{26.6316`, 221.423`}, {9, 9}}};     outputList = {};          For[i = 1, i <= Length[list], i++,       If[Length[list[[i]]] >= k,         outputList = Append[outputList, list[[i]][[Length[list[[i]]]]]];       ];     ];          outputList      Surely there must be a better way?


How can I access the internal function that plots a molecule from a formatted XYZ file?

Mathematica has the ability to plot a molecule using the data contained in an XYZ file. This is a simple text file, of which this is an example. The molecule is plotted using the Import command. Entering this:               Import["https://gist.github.com/anonymous/8fde18207e8abc7b770c/raw/8491d99e7fec7cc989fe38548319e09d6910ba02/form_MO_28","XYZ"]      gives this as the output: ![enter image description here](http://i.stack.imgur.com/4oaFq.jpg) I've been able to put this together with orbital plots, with results like this: ![enter image description here](http://i.stack.imgur.com/KpoVU.jpg) But I can only show other plots alongside the molecule plot, I can't modify the molecule. For example, I'd like to make the tubes forming the bonds smaller in diameter. As it is, the plots don't show if there is a single, double, or triple bond. Somewhere in mathematica, there must be a function which takes as its argument the XYZ text and returns the molecule plot. If I could see that function, I could modify it accordingly. Any clue on how to access this function? The documentation for this feature is minimal.


Remove elements at certain positions from all sub-lists?

Consider a big list where all the inner lists length's are the same                list = {{x1, y1, z1, t1}, {x2, y2, z2, t2}, {x3, y3, z3, t3}, ...};      elementNo = {4, 3, 2};      I want output like this,               {{x1}, {x2}, {x3}, ...}      That is, when I specify `elementNo` as `{4, 3, 2}`, I mean the elements at positions 2, 3 and 4 in the sub-lists should be removed -- I want the elements at position 1 only. When I specify `elementNo` as `{2, 3}`, I want                {{x1, t1}, {x2, t2}, {x3, t3}, ...}      How can I do this?


Dynamic inside Button

This bit of code runs a little animation of a stochastic process:                (* a random walk bm, its min and max  *)      {bm, m, M} = {Table[Random[] - .5, {100}] // Accumulate, Min[bm], Max[bm] }           (* plot of trajectory of bm up to i-th step *)      traj[i_] := ListLinePlot[({Range[1, 100], bm} // Transpose)[[;; i]],          Joined -> True, PlotRange -> {{0, 100}, {m, M}}]           (* animation using Clock *)      q = Dynamic[r = Clock[{1, 100, 1}, 5, 1]; traj[r] ]      Next I'd like to use Button to run the animation. Something like               Button["Run", q]      but this doesn't work. Eventually I'd like to have two buttons, "Repeat" and "Clear" like this:               x = {{0, 0}};        min[x_] := (Sort[x, #1[[2]] < #2[[2]]  &])[[2]]; Column[ {Row[{Button["Repeat",       x = Append[x, { Random[], Random[]  }]],      Button["Reset", x = { {0, 0}}]  }  ],     Dynamic[Show[{ ListPlot[x, PlotRange -> {{0, 1}, {0, 1}}, ImageSize -> 300,        Frame -> True, Axes -> None] , If[Length[x] > 1,        Graphics[{Red, Line[{min[x], {min[x][[1]], -.1} }]}], {}],      If[Length[x] > 1,        Graphics[{Red, Line[{min[x], {0, min[x][[2]]} } ]}], {}]      }]]}]      but instead of dots, I want to plot animated functions involving Clock.


Turning Off Error messages locally

I'm trying to turn `Off` an error in an expression.               myFunction[x_] = 1/x     myFunction2[x_] = Quiet[1/x]  (*1/x*)     myFunction[0]     myFunction2[0]      I do not want to use `:=`, I also do not want to Globally turn Off this error. I want it using `=` such that it looks like:               myFunction3[x_] = TurnedOffError[1/x]  (*TurnedOffError[1/x]*)     myFunction3[0]


Hue function for negative arguments

I want to use `Hue` function for different colours with the argument being a function, i.e.,               Hue[f[i,j]]      Now, `f[i,j]` in my case can take negative values. The range of my function is `[-2,2]` (which can be rescaled to `[-1,1]` if necessary, by dividing the function by 2). The problem is that `Hue` automatically rescales its argument to put it into the range of `[0,1)`. This is a problem for me as it will then show the same colour when my function is either `-1` or `0` or `1`, for example. The actual figure I want to work on can be generated by the following code:               Clear["Global`*"];      n := 10;      angles = Table[RandomReal[{-Pi, Pi}], {i, n}, {j, n}];      f[here_, down_, right_] := Cos[down - here] + Cos[right - here]      g[list_, {i_, j_}] := Module[{m, n}, {m, n} = Dimensions[list]; {list[[i, j]],          If[i != m, list[[i + 1, j]], -list[[1, j]]],            If[j != n, list[[i, j + 1]], -list[[i, 1]]]}]      GraphicsGrid[ MapIndexed[ Graphics[{LightGray, Circle[{0, 0}, 1],          Hue[Rescale[f @@ g[angles, #2], {-2, 2}, {-1, 1}]], Thin,            Arrowheads[Small], Arrow[{{0, 0}, {Cos[#], Sin[#]}}]}] &, angles, {2}]]


How to only work on sublists with non-zero (or positive) values

i have a large compositional dataset which contains non-zero and zero values. here is a sample:                 data = {{22054., 70.62, 0.37, 14.21, 2.89, 0.6, 2.05, 4.18, 4.04},               {22055., 67.84, 0.52, 14.32, 3.77, 0.91, 3., 2.72, 4.62},               {22581., 62.79, 0.62, 13.79, 7.27, 0.46, 2.92, 1.21, 7.97},               {27601., 0., 0., 0., 0., 0., 0., 0., 0.},               {27602., 0., 0., 0., 0., 0., 0., 0., 0.},               {27603., 0., 0., 0., 0., 0., 0., 0., 0.},               {28681., 0., 0., 0., 0., 0., 0., 0., 0.},               {22757., 61.06, 0.77, 16.62, 5.72, 1.66, 4.66, 2.76, 3.46},               {22803., 64.55, 3.01, 16.3, 0.48, 0.09, 0.05, 0.25, 14.29}};      i'm trying to convert the values from weight percent to mol percent. i wish to use the following function to generate a new array of the same length (at level 1) as the original:                    mw = {60.084, 79.866, 101.961, 71.844, 40.304, 56.077, 61.98, 94.2};               molPct[oxw_, mw_] :=             Module[{oxcomp, divmw},             oxcomp = Drop[oxw, None, 1];             divmw = Transpose[Transpose[oxcomp]/mw];             (divmw/ Total[divmw, {2}])*100             ];               dataMolPct = molPct[data, mw]      unfortunately, this function fails due to the zero elements within the array (where it tries to divide by zero..). this code seems to work fine when i delete the rows containing zero-values. I tried the following in an attempt to ignore the 'zero' rows:                    molPct[oxw_ /; oxw > 0, mw_] :=             Module[{oxcomp, divmw, oxmol},             oxcomp = Drop[oxw, None, 1];             divmw = Transpose[Transpose[oxcomp]/mw];             (divmw/ Total[divmw, {2}])*100             ];      ...no luck as i said, it is important that i end up with an array of the same size (as i will join the new data onto the original array). it would be nice to know how to do something similar for excluding negative numbers. any suggestions?


FindInstance with a Diophantine equation seems to go on forever

I tried to find a non-trivial integer solution to the equation   $$2012^2=a^2+b^2+c^2+d^2+e^2$$ with Mathematica but the computation takes minutes; I might be doing something wrong.               FindInstance[2012^2 == a^2 + b^2 + c^2 + d^2 + e^2          && a > 0 && b > 0 && c > 0 && d > 0 && e > 0, {a, b, c, d, e}, Integers]      But when I try               FindInstance[2012^1 == a^2 + b^2 + c^2 + d^2 + e^2          && a > 0 && b > 0 && c > 0 && d > 0 && e > 0, {a, b, c, d, e}, Integers]      I get an immediate result.


How to calculate this integral?

I am trying to Integrate the following Integral : $\int_1^{\infty } \dfrac{\left(x^2-1\right)^{13/2} e^{-ax} }{x^{10}} \, dx \,\, \,\,\,\,\,\,\,\,\,\,\,\,(a=\textrm{real>0})$ Mathematica didn't calculate this integral. Maybe it is too complicated to be done. In Mathematica input form:               Integrate[Exp[-a x] (x^2 - 1)^(13/2)/x^10, {x,1,Infinity}]      If I simply enter that into Mathematica, it instantly returns the same expression. How do I go about this? Is there any tricks that can be applied? Thank's.


Handling output that was returned unevaluated from a function

When evaluating functions, including those described in this post, how do _Mathematica_ users handle values returned from a function that are unevaluated? For example (based on 1):               i[{a_, Longest[b__], c__}] := {"a" -> a, "b" -> {b}, "c" -> {c}} /; Length[{a, b, c}] > 3;     test = {{1, 2}, {1, 2, 3, 4, 5}, {1, 2, 3, 4, 5}};     j=i/@test          (* returns {i[{1, 2}], {"a" -> 1, "b" -> {2, 3, 4}, "c" -> {5}}, {"a" -> 1,  "b" -> {2, 3, 4}, "c" -> {5}}}  *)      So the first element of _j_ is `i[{1, 2}]` \- this is neither the original input `{1,2}` nor in the form of the rest of the output. Two questions: a) While it is likely to be application specific, what approaches do others use to handle unevaluated values that are returned? b) Is there a generic way to detect unevaluated 'returns' for additional parsing ? My current thought is to use `Identity` and `ReplaceAll` to eliminate the 'unwanted' function `i`:               k=j/.i->Identity     (* returns {{1, 2}, {"a" -> 1, "b" -> {2, 3, 4}, "c" -> {5}}, {"a" -> 1,   "b" -> {2, 3, 4}, "c" -> {5}}}  *)      but this approach requires the name of the function (here _i_ ) that was evaluated. Are there any other tricks or approaches to handle this? Am I overlooking benefits to retaining the unevaluated output ?


Horrific Looking Contour Integral in Mathematica Plot:

I'm attempting to display the geometric meaning of a contour integral![enter image description here](http://i.stack.imgur.com/pHRzR.png) but as you can see, the typesetting of the contour integral (created via the Epilog function) looks awful because the contour integral is too high relative to the integrand. In addition, the text is too small. How can this be fixed? My code for this figure is               a = 1.5;     b = 1;     RegionPlot[         q^2/a^2 + p^2/b^2 <= 1, {q, -a - .1, a + .1}, {p, -b - .1, b + .1},         AspectRatio -> Automatic,         Axes -> True,         AxesLabel -> {q, p},         Frame -> False,         PlotStyle -> Directive[Green, Opacity[0.9]],         Ticks -> False,         Epilog -> {Text["\[ContourIntegral]p\[DifferentialD]q",          Offset[{0, 0}, {.7, .35}]]},         ColorFunction -> "Pastel"]


OpenSCAD like functionality with Mathematica?

I keep seeing reference to use of Mathematica as a CAD tool (for instance: http://www.makerbot.com/support/guides/design/). I'd like to use it as such if feasible, but I'm having trouble locating equivalents of the functionality I use in my current design tool, OpenSCAD. I know how to create simple shapes (`Graphics3D[]`, `Cylinder[]`, etc.) and I'm aware that Mathematica can export to STL format. But does Mathematica have equivalents of the following OpenSCAD functions, or is it the wrong tool for the kind of thing I'm trying to do?   * linear_extrude()   * union()   * intersection()   * difference()   * translate()   * rotate()


How to show many data lines with MAnipulate?

How could I show many lines with data, usin Manipulate??               Manipulate[      Print["Number...Square...Cube"];      Do[Print[z, "...", z^2, "....", z^3], {z, 1, zmax}];      PieChart[Table[i^3, {i, 1, zmax}], ChartLabels -> Range[zmax]]      , {zmax, {1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,16}}]      I see the PieChart inside the CDF-place, but the data is showed outside, after the Square of CDF. I´m interesetd too in Show the text of the PieChart greater, and with a label of the data, for example 9 and under the 9.... (21%)


How to solve correctly inside a DO loop and then plot

Here is the corresponding code First the equations setup               Vcl[x_, y_, z_] := (-G*(Mcl/a))/Sqrt[(x^2 + y^2 + z^2)/a^2 + c^2];     V[x_, y_, z_] := Vcl[x, y, z] + 1/2*(κ2 - 4*ω^2)*x^2 + 1/2*v2*z^2;          G = 1;     Mcl = 2.2; a = 0.182; c = 1;     ω = 1; κ2 = 1.8; v2 = 7.6;     cl = -3.264444506;     ch = 0.1;     E0 = cl*(1 - ch);      Then the DO loop with the `Solve`               data = {};     Do[       Vx = V[x, 0, z0];       sol = Solve[Vx == E0 && -1.01 < x < 1.01,x];       xmin = x /. sol[[1]];       xmax = x /. sol[[2]];       AppendTo[data, {xmin, xmax, z0}],       {z0, 0, 0.6, 0.001}       ]      And finally the plot               neg = data[[All, {1, 3}]];     pos = data[[All, {2, 3}]];     L1 = ListPlot[neg, Joined -> True,           PlotStyle -> {Black, Thickness[0.003]}];     L2 = ListPlot[pos, Joined -> True,           PlotStyle -> {Black, Thickness[0.003]}];      L0 = Show[{L1, L2}, Axes -> False, Frame -> True,           PlotRange -> {{-1, 1}, {0, 0.6}}, ImageSize -> 550]      which produces this ![enter image description here](http://i.stack.imgur.com/6dUga.png) The plot has several issues: (i) it should be a continuous line from -1 to 1, while we observe a gap near 0 and also it never reaches +1, (ii) the lower horizontal line it should not be there; probably `Joined` joins two extreme points. I suspect, that both issues are related to the `Solve` inside the DO loop. There z0 belongs to the interval [0, 0.6] but the equation does not have solutions for all these values. The `data` list should somehow store only the correct solutions and reject the cases where there are no solutions at all. Many thanks in advance.


Cell background color changes cell layout

When I change the background color of a cell like in ![enter image description here](http://i.stack.imgur.com/QnYDL.png) the colored cells become slightly indented and their line spacing is increased. How can I change the cell background color while keeping the other cell layout elements fixed?


Filling -> Axis leaves a gap

Filling leaves a gap between the function curve and the axis               Show[Plot[PDF[NormalDistribution[0, 1], z], {z, -3, 6}],      Plot[PDF[NormalDistribution[0, 1], z], {z, c=1.4, 6}, Filling -> Axis]     ]      ![enter image description here](http://i.stack.imgur.com/5PoDc.png) But for other values (e.g., c=0.5 instead of c=1.4 in the above code), the Filling is correct. Is this a bug or am I making some subtle error?


Detecting patterns of black and white stones on a 2D board

I'm writing a program to play a game of Pente, and I'm struggling with the following question: > What's the best way to detect patterns on a two-dimensional board? For example, in Pente a pair of neighboring stones of the same color can be captured when they are flanked from both sides by an opponent; how can we find all the stones that can be captured with the next move for the following board? ![sample board](http://i.stack.imgur.com/cV3Gb.png) Below I show one possible straightforward solution, but with a defect: it's hard to extend it for other interesting patterns, i.e. three stones of the same color in a row surrounded by empty spaces, or four stones of the same color in a row which are flanked from one side but open from another, etc. > I'm wondering whether there is a way to define a DSL for detecting > 2-dimensional structures like that on a board - sort of a _2D pattern > matching_. P.S. I would also appreciate any advice on how to simplify the code below and make it more idiomatic - for example, I don't really like the way how `sortStones` is defined. ## Straightforward solution Here is one way to solve this problem (see below for graphics primitives to generate and display random boards):   * Enumerate all subsets of 3 stones from the board above   * Select those that form an _AABE_ or _ABBE_ pattern, where E denotes an unoccupied space Lets store the board as a list of black and white stones,               a = {black[2, 1], black[4, 3], black[2, 5], black[4, 2], black[5, 3],      black[1, 2], black[1, 3], black[5, 4], black[1, 5], white[3, 1],      white[4, 1], white[4, 4], white[3, 5], white[3, 4], white[5, 1],      white[5, 2], white[3, 3], white[1, 1]}      First, we define `isTriple` which checks whether three stones sorted by their x and y coordinates are in the same row next to each other and follow an ABB or AAB pattern:               isTriple[{a_, b_, c_}] := And[       (* A A B or A B B *)       Head[a] != Head[c] /. {black -> 1, white -> 0},       (* x and y coordinates are equally spaced *)       a[[1]] - b[[1]] == b[[1]] - c[[1]],       a[[2]] - b[[2]] == b[[2]] - c[[2]],       (* and are next to each other *)       Abs[a[[1]] - b[[1]]] <= 1,       Abs[a[[2]] - b[[2]]] <= 1]      Next, we determine the coordinates and the color of the stone that will kill the pair:               killerStone[{a_, b_, c_}] :=       If[Head[a] == Head[b] /. {black -> 1, white -> 0},       Head[c][2 a[[1]] - b[[1]], 2 a[[2]] - b[[2]]],       Head[a][2 c[[1]] - b[[1]], 2 c[[2]] - b[[2]]]]      Finally, we only select those triples where killer stone's space is not already occupied:               sortStones[l_] :=       Sort[l, OrderedQ[{#1, #2} /. {black -> List, white -> List}] &]          triplesToKill[board_] := Module[       {triples = Select[sortStones /@ Subsets[board, {3}], isTriple]},       Select[triples,        Block[          {ks = killerStone[#]},          FreeQ[board, _[ks[[1]], ks[[2]]]]] &]]          displayBoard[a, #] & /@ triplesToKill[a]  //        Partition[#, 3, 3, {1, 1}, {}] & // GraphicsGrid      ![straightforward solution](http://i.stack.imgur.com/QHj2c.png) ## Graphics primitives               randomPoints[n_] := RandomSample[Block[{nn = Ceiling[Sqrt[n]]},         Flatten[Table[{i, j}, {i, 1, nn}, {j, 1, nn}], 1]], n];     (* n is number of moves = 2 * number of points *)     randomBoard[n_] := Module[       {points = randomPoints[2 n]},       Join[        Take[points, n] /. {x_, y_} -> black[x, y],        Take[points, -n] /. {x_, y_} -> white[x, y]        ]]          grid[minX_, minY_, maxX_, maxY_] :=        Line[Join[         Table[{{minX - 1.5, y}, {maxX + 1.5, y}}, {y, minY - 1.5, maxY + 1.5,            1}],         Table[{{x, minY - 1.5}, {x, maxY + 1.5}}, {x, minX - 1.5, maxX + 1.5,            1}]]];          displayBoard[board_] := Module[        {minX = Min[First /@ board], maxX = Max[First /@ board],         minY = Min[#[[2]] & /@ board], maxY = Max[#[[2]] & /@ board], n},        Graphics[{          grid[minX, minY, maxX, maxY],          board /. {            black[n__] -> {Black, Disk[{n}, .4]},            white[n__] -> {Thick, Circle[{n}, .4], White, Disk[{n}, .4]}            }}, ImageSize -> Small, Frame -> True]];          displayBoard[board_, points_] := Show[       displayBoard[board],       Graphics[        Map[{Red, Disk[{#[[1]], #[[2]]}, .2]} &, points]]]


Basic questions about running Mathematica

1. Is there a command window and an editor in Mathematica 8 similar to those in Matlab? In Mathematica GUI mode, all I saw is write code and run it in the same notebook.   2. In my Ubuntu terminal, I successfully started Mathematica by `./math` (which is the only way I know by the way and I would also like to know what options are available when starting up).  When I simply copy and paste the code from Heike , nothing new appears, and when I copy and paste the code of Daniel, it works. Wonder why?   3. Is it correct that there are exactly two ways of running Mathematica code: in a notebook, and in a Mathematica session running in my Linux terminal?  Are the notebook way and the GUI mode the same thing? What does "kernel" mean in Mathematica? What are some basic concepts and common sense of running Mathematica?


logplot for negative valued function

I would like to plot the following function               Plot[(1/x (0.01/(0.01 + x^2) - (10/(10 + x^2))^2)), {x, 0, 10},       Frame -> True, PlotRange -> All]      which is very peaked at 0.01 in log scale, to show it up to higher values, i.e.:               LogPlot[-(1/x (0.01/(0.01 + x^2) - (10/(10 + x^2))^2)), {x, 0, 100},       Frame -> True, PlotRange -> {10^-9, 10}]      However, since function is negative, I must add a minus sign to the function. I would like to get something like the log plot above, but with the y-axis going downwards and with negative values, looking similar to the plot below               LogPlot[-(1/x (0.01/(0.01 + x^2) - (10/(10 + x^2))^2))^-1, {x, 0, 10},       Frame -> True, PlotRange -> {0.1, 10^3}]      but with the right scaling for log axis and negative value sin stead of positive ones, is it possible? Thanks in advance


Visualizing 3x3 spectrahedra

I'm trying to visualize the SDP cone over 3x3 matrices by plotting random 3d sections of it. Since each region is a system of inequality constraints, I'm using RegionPlot, but I think the plots would look better if they only showed the surface...what is a good way to achieve this?               spectro2 := (        X = ( {           {x1, x2, x3},           {x2, x4, x5},           {x3, x5, x6}          } );        vars = Union@Flatten@X;        dvars = {x, y, z};        m = Length@vars;        n = Length@dvars;        makeMat := X /. (Thread[vars -> #]) &;        proj = makeMat /@ Orthogonalize@RandomReal[{-1, 1}, {n, m}];        mat2 =          Total@MapThread[Times, {proj, dvars}, 1] + IdentityMatrix@Length@X;        cons = And @@ (Thread[Eigenvalues[mat2] >= 0]);        RegionPlot3D[cons, {x, -3, 3}, {y, -3, 3}, {z, -3, 3}, Mesh -> 5,          PlotStyle -> Opacity[.7], PlotPoints -> 5]        );     Table[spectro2, {2}, {3}]      ![](http://yaroslavvb.com/upload/sdp-cone.png)


Does there exist any way to add type annotations?

Is there any way to add my own annotations to values or functions in Mathematica? Imagine, for example, that I wanted to annotate a `List` specifically as a `List` of `String`s. I don't think Mathematica will really do anything to enforce such a thing, but what I'd like to use this for is for connecting Mathematica to .NET generic functions. If I know that a `List` is expected to only contain a single type, I could more easily decide what type to call into a generic function with. An example syntax might be something like:               mylist = {"Alice", "Bob", "Carol"}     SetAttribute[myList, NETType[String]]          (* The NETType[] attribute is used to call "GenericListMethod<String>(myList);" *)     NETGenericCall[GenericListMethod,Sequence[myList]]      Update: It's also significant that `myList` should retain (nearly?) native behavior in Mathematica. For example, I should be able to iterate over the list with Map[] without having to explicitly unwrap the list first. I figure it's asking almost entirely too much for normal Mathematica functions to preserve type information.


Using Mathematica to help to determine the consistency of and numerically solve systems of non-linear equations

# The formal problem The question I am about to ask is applicable to many scientific and engineering problems. In short, I am bout to ask for pointers and practical advice for Mathematica beginners who would like to use Mathematica to find a solution to a multi-dimensional non-linear constraint optimization problem, i.e. a problem of the form: Find $\vec{\mathbf{x}}$ so that $\mathbf{F}\left(\vec{\mathbf{x}}\right) = \vec{\mathbf{0}} $. To expand this expression: Find a value of $\vec{\mathbf{x}} = \left| \begin{array}{c} x_{1} \\\ x_{2} \\\ \vdots \\\ x_{n} \end{array} \right|$ so that $\begin{cases} f_1\left(x_0, x_1, \ldots, x_n\right) = 0 \\\ f_2\left(x_0, x_1, \ldots, x_n\right) = 0 \\\ \mbox{ }\vdots& \\\ f_m\left(x_0, x_1, \ldots, x_n\right) = 0 \end{cases}$ Typically, we are looking for $\vec{\mathbf{x}} \in \Re^n$ (i.e. ignore complex solutions in most engineering and scientific disciplines), we have $n \neq m$, and $n$ and $m$ are of single-digit to two-digit numbers. The functions $f_i$ are arbitrary, non-linear and only defined on subspaces of $\Re^n$. There may be additional inequality constraints. * * * # The practical problem I would like to know all the **tools, functions and tricks** experienced Mathematica users like to use to approach this kind of problems. I am **not asking** for a one-command magic "solve that for me" function, as I know that function optimization is in general very hard, and a combination of formal analysis, plotting and numerical exploration are what guides one to a solution, if a solution exists. What I am asking is how Mathematica can help this exploration. * * * # Example Let's take a real-world example in Mathematica syntax, taken form a problem on which I am currently working. I believe this particular set of equations has no real solution (so don't try to actually work on it!) and could be better formulated, but that makes it an even better example. The system looks like that (you don't need to download the file, it's not very interesting):               eq1 = Dhtmp==Chbar+Ghtmp     eq2 = Dfstartmp==Cfstarbar+Gfstartmp     (* ... *)     eq31 = Lmbar==((Dmtmp+Dmstartmp*((1-n)/n))/Wbar)*(1-zprimebar)     eq32 = Lmstarbar==((Dmtmp+Dmstartmp*((1-n)/n))/Wstarbar)*zprimebar*(n/(1-n))     eq33 = Wstarbar==((t/tstar)*(((1-zprimebar)/zprimebar)^(1/theta)))*Wbar     eq34 = zeta==(Ptmp*(Ctmp^phi))/(Pstartmp*(Cstartmp^phi))     eq35 = Wbar==Phbar/(Pmbar*ahbar)     eq36 = Wstarbar==Pfstarbar/(Pmstarbar*afstarbar)     eq37 = ibar==(1/beta)-1      This is the raw set of equations, in that case, a copy-paste from a Matlab file followed by a bit of search/replace to remove underscores, change implicit functions to explicit, label them, etc... With that, some pre- determined values or intervals are given for some of the variables, like `ibar = 1`, etc... As a beginner Mathematica user, the first "trick" that I've learnt that lets me look at the system (thanks to MMA.SE user Simon) is to define a set of pretty-printing "replacements" for the ugly matlab variable names:               MakeBoxes[afstarbar, form_] :=         InterpretationBox[OverscriptBox[SuperscriptBox["af", "*"], "_"], afstarbar]     MakeBoxes[alpha, form_] := InterpretationBox["\[Alpha]", alpha]     (* ... there are 53 of those; I paste them before the equations. *)      In Matlab, typically, I try to plot each equation individually, holding all but one or two variables constant. It helps me get a better idea of the search intervals of the free variables. Then I feed simplified versions of the system to various solvers (`fsolve` for simple stuff, or I write some simulated annealing-like one-time-use solver, etc...), and tune the system until I get a solution. Now, I want to give Mathematica a try, but as a beginner, I know that it's going to be a lot of fumbling around, because I did not find a good list of pointers on what Mathematica users use in real-world to help themselves solve non-linear multi-dimensional constraint optimization problems. I think that the Mathematica Stackexchange website is where such a guide should be found.


correct way to map a function on entries down the pages in a 3D matrix?

**updated:** added another method to the methods I tried below for completion. This is new way of doing it, but most likely not very efficient, did not time it I can only visualize 3D matrices in my mind as a book made up of pages. Each page is a 2D matrix. The third dimension of the matrix is the number of pages in it. This can be easily carried over to higher dimensions. 4D matrix, is a volume of books, and so on. Suppose I have a 3D matrix in Mathematica like this:               a = {{1, 2, 3, 4}, {5, 6, 7, 8}};     b = {{9, 10, 11, 12}, {13, 14, 15, 16}};     c = {{17, 18, 19, 20}, {21, 22, 23, 24}};     m = {a, b, c}          (* {  {{1, 2, 3, 4}, {5, 6, 7, 8}},            {{9, 10, 11, 12}, {13, 14, 15,16}},            {{17, 18, 19, 20}, {21, 22, 23, 24}}        }     *)      and want to map `f` on all elements in each row/col but going down across the pages. From first page to last page of the book, then come back and do the same for next entry and so on. So that the result will be               {          {f[{1, 9, 17}],  f[{2, 10, 18}], f[{3, 11, 19}], f[{4, 12, 20}]},        {f[{5, 13, 21}], f[{6, 14, 22}], f[{7, 15, 23}], f[{8, 16, 24}]}     }      ![Mathematica graphics](http://i.stack.imgur.com/e28gc.png) This is explained in this diagram, which I very skillfully just made using Microsoft Visio ;) ![Mathematica graphics](http://i.stack.imgur.com/acR3H.png) There are the two methods I came up with after a bit of struggle. I'd like to find if there is a better or more elegant method. For example, I could not figure how to use `Map[f,mat, ??]` of the above to produce this result in one step. **Method 1**               Transpose[m];     f /@ Transpose[#] & /@ %      **Method 2**               Map[f[#] &, Table[m[[All, i, j]], {i, 2}, {j, 4}], {2}]       **Method 3 (added 8/20/13)**               Map[f, Partition[Flatten[m, {2, 3}], 4], {2}]      ## Summary and conclusions This problem can be broken up to 2 parts. The first part is how transform the 3D matrix with the correct list in each entry. Once this is done, the rest is easy, since now one can just do `Map[f,mat,{2}]` on the resulting matrix since this maps `f` to each entry. So the trick was is how to do the first part, as the second part I knew. All the answers are very good and learned from them, I selected Leonid's answer since it showed me more general way do this. I did not realized that `Transpose` can be used as a general transformation using its second arguments. Here is the possible transformations showing the one I wanted. This is useful, since now if I want different transformation, I can look this up, and just use `Transpose` again with different permutation. I am adding this to my Mathematica sheet cheat. ![enter image description here](http://i.stack.imgur.com/gmeAJ.png) **Appendix** On a side note. The main difference for me when working with Mathematica 3D matrices, is to remember that the first index is the page number and not the row number as the normal case with 2D matrices. In Matlab, in 3D, the page number is the third index (which is a little bit more natural to me). So in Mathematica, `m[[1,2,3]]` is the second row, third column in the first page. While in Matab to reference the same entry, one writes `m(2,3,1)`. Notice the 3rd dimension index location difference. So in Matlab, the first index is always the row and the second index is the column number, regardless if the matrix is 2D or 3D. Here is the same matrix in Matlab:               a = [1  2  3  4 ;  5 6  7  8];     b = [9  10 11 12; 13 14 15 16];     c = [17 18 19 20; 21 22 23 24];          m = zeros(2,4,3);          m(:,:,1)=a;m(:,:,2)=b;m(:,:,3)=c;          m      gives               m(:,:,1) =              1     2     3     4          5     6     7     8          m(:,:,2) =              9    10    11    12         13    14    15    16          m(:,:,3) =             17    18    19    20         21    22    23    24      It is not a big deal, just something to remember that is all. Ofcourse Matlab does not have a nice to way to use Map's and such so easily as in Mathematica, so it all evens out at the end :)


Program file deleted while running

I have a program running for some time at one computer. Today, unintentionally, I edited the program file from another computer (I use Dropbox), and the program kept running. Trying to correct my mistake, I deleted the program file, and, from the computer it was running, saved it again. My question is: have I ruined the evaluation? Should I start over or Mathematica can deal with such situation? My concern is that I do not know how long the evaluation will take, and it can be some months. Thanks in advance


Behavior of 1.2 ∈ Rationals changes in v9?

A friend of mine using version 9 recently showed me this: ![enter image description here](http://i.stack.imgur.com/WJa9Y.png) It's strange because in version 8.0.4 `1.2 ∈ Rationals` does return `False`: ![enter image description here](http://i.stack.imgur.com/PFubW.jpg) I checked the online document of `Element` and `Rationals`, no modification is mentioned. So it's a silent changing, or a bug?


Numbering element in descending order

How can I numbering the elements in descending order of second elements of sublists? For example, if I have the list which is               m={{1, 5}, {2, 8}, {3, 9}, {4, 2}, {5, 9}, {6, 7}, {7, 9}, {8, 10}, {9, 5}, {10, 2}};      The smallest second element is 2 of `{10,2}` so its number is 1.   Second smallest second element is also 2 of `{4,2}` so its number will be 2.   The output that I want is then: `{4, 6, 9, 2, 8, 5, 7, 10, 3, 1}`.   How can I do this?


Mathematica Compute Time Is Extremely Long (Integrate simple function with parameter scan)

I was wondering if you can help. I have a set of equations I need to solve for a list of parameters; entering each parameter value and solving anew each time is simply not economical. I found a way to vary the parameter and have Mathematica solve the equation, but the calculation now takes extremely long and does not even return a solution. Here is my code below (very simple): ![enter image description here](http://i.stack.imgur.com/oB4pu.png) What am I doing wrong? What can be done to make the calculation faster? Thank you in advance!


List comparison in constraints for Minimize

I am trying to solve an optimization problem, a simplified version of which is as follows:               x = Table[Symbol["x" <> ToString[i]], {i, 7}];     A = {3, 2, 5, 1, 7, 9, 6};     Minimize[{A.x,       And @@ Thread[0 <= x <= 1] &&        Plus @@ x == 3 &&        x \[Element] Integers &&        x != {1, 1, 0, 1, 0, 0, 0}       }, x]      Here, the sought-after solution is for `x`. The issue is that the solution when all but the last constraint (`x != {1, 1, 0, 1, 0, 0, 0}`) are used is exactly `{1, 1, 0, 1, 0, 0, 0}`. When I introduce the last constraint, there is no effect - I still obtain the same solution, although that constraint should remove that particular solution and output the next best one. If I replace the last constraint with `x == {0, 1, 1, 1, 0, 0, 0}`, then the output solution is exactly `{0, 1, 1, 1, 0, 0, 0}`, so the comparison seems to be evaluated, but for some reason, the inequality given by `x != {1, 1, 0, 1, 0, 0, 0}` does not evaluate to `False`, although it should. Any thoughts on this would be appreciated.sov


Plot counting function semi primes

I am trying to generate a plottable semi-prime counting function. Have tried:               DiscretePlot[Gather[{a = PrimeOmega[Range[100]];     b = PrimeNu[Range[100]];     Count[Transpose[{a, b}], {2, 2}]}     +     {a = PrimeOmega[Range[100]];     b = PrimeNu[Range[100]];     Count[Transpose[{a, b}], {2, 1}]}],{x, 0, 15}, Filling -> Bottom]]      but really have no clue as to where to go from here!


Map several functions in one routine

I have several functions, let's assume they are:               func1[x_]=x;     func2[x_]=3*x-5;     func3[x_]=0.1*x^2;      and a lot more like these. For each and every one of these I want to do the following               xvalues = Range[0, 500, 2.5];     points1 = Map[func1, xvalues];     Do[If points1[[[i]] < 0, points1[[i]] = 0, points1[[i]] = points1[[i]],       {i, 1,  Length[points1]}]     table1 = Transpose[{xvalues, points1}];      Now seeing as I have a lot of these functiones, is there any way to automate this in some kind of routine? While answering, please be aware that I don't really have any extensive Mathematica knowledge.


How to visualize large graphs with directed edge bundling

I'm wondering if anyone has implemented edge bundled graph plotting? http://www.win.tue.nl/~dholten/papers/forcebundles_eurovis.pdf


Time series (stochastic process) estimating parameters using characteristic function

I have a time series of assets ${A_1, A_2, ..., A_n}$, which is described by a sophisticated distribution having the following characteristic function: $\phi(u; t;\theta)$, where $\theta$ is a vector of unknown parameters. I need to esimate vector of unknown parameters $\theta$ of characteristic function. I tried to find a PDF using the inverse Fourier transform to use the maximum likelihood method, but the characteristic function is too complicated for that. I also thought about building the empirical characteristic function using the time series of assets and to estimate parameters using the least square method, but I do not know how to build the empirical characteristic function, because time series is not just a sample of random variables, it is a random process that depends on time.


Approximate minimum degree permutation algorithm in Mathematica

In MATLAB there is a nice implementation of the so called AMD (approximate minimum degree permutation) algorithm named amd (see Online MATLAB Documentation). There is an alternative algorithm called COLAMD (see Online MATLAB Documentation). This algorithm is especially interesting when one wants to model large resistor networks e.g. calculate path resistances or reduce a network of resistors (for the theory see, e.g., Efficient Methods for Large Resistor Networks). There the AMD step is a preconditioning step for a large matrix before a Cholesky decomposition (available in _Mathematica_ through _CholeskyDecomposition_ ) is done. The original fortran coded algorithms can be found on the webpage from the autors. Is anybody aware of an implementation of the AMD or the COLAMD algorithm in _Mathematica_?


Calling Mathematica from Java

I'm trying to write a Java program that uses _Mathematica_ code, but when I compile it, a window appears asking for MathLink. I enter               c:\\program files\\wolfram research\\mathematica\\9.0\\mathkernel.exe      but this causes an exception to occur. I don't understand what the problem is. Here is the code I am using:               import com.wolfram.jlink.*;     public class SampleProgram {         public static void main(String[] argv) {             KernelLink ml = null;             try {                 ml = MathLinkFactory.createKernelLink(argv);             } catch (MathLinkException e) {                 System.out.println("Fatal error opening link: " + e.getMessage());                 return;             }                  try {                 // Get rid of the initial InputNamePacket the kernel will send                 // when it is launched.                 ml.discardAnswer();                      ml.evaluate("<<MyPackage.m");                 ml.discardAnswer();                      ml.evaluate("2+2");                 ml.waitForAnswer();                      int result = ml.getInteger();                 System.out.println("2 + 2 = " + result);                      // Here's how to send the same input, but not as a string:                 ml.putFunction("EvaluatePacket", 1);                 ml.putFunction("Plus", 2);                 ml.put(3);                 ml.put(3);                 ml.endPacket();                 ml.waitForAnswer();                 result = ml.getInteger();                 System.out.println("3 + 3 = " + result);                      // If you want the result back as a string, use evaluateToInputForm                 // or evaluateToOutputForm. The second arg for either is the                 // requested page width for formatting the string. Pass 0 for                 // PageWidth->Infinity. These methods get the result in one                 // step--no need to call waitForAnswer.                 String strResult = ml.evaluateToOutputForm("4+4", 0);                 System.out.println("4 + 4 = " + strResult);                  } catch (MathLinkException e) {                 System.out.println("MathLinkException occurred: " + e.getMessage());             } finally {                 ml.close();             }         }     }      My objective is to use _Mathematica_ in java to calculate the maximum of a function. I don't know how to do that, and the documentation on the net is few.


Detecting a collision in n-body simulation with NDSolve

Consider this three-body system:               g = 10; (* gravitational constant *)     m = {100, 1, 1}; (* masses *)     μ0 = g*m; (* gravitational parameters *)     r0 = {{0, 0, 0}, {1, 0, 0}, {-1.1, 0, 0}}; (* initial location vectors *)     v0 = {{0, 0, 0}, {0, 30, 0}, {0, -30.1, 0}}; (* initial velocity vectors *)      Differential equations for velocities and positions:               jmax = Length[m];     v = Evaluate[#] & /@      Table[ToExpression["v" <> ToString[j]], {j, jmax}];     r = Evaluate[#] & /@      Table[ToExpression["r" <> ToString[j]], {j, jmax}];     eqns[μ_List] := Flatten[Table[{     v[[j]]'[t] ==       Sum[(-Normalize[r[[j]][t] - r[[i]][t]]*μ[[i]])/       EuclideanDistance[r[[j]][t], r[[i]][t]]^2, {i,         Delete[Range[jmax], j]}],     r[[j]]'[t] == v[[j]][t],     v[[j]][0] == v0[[j]],     r[[j]][0] == r0[[j]]     }, {j, jmax}]]     fns = Flatten[Table[{v[[j]][t], r[[j]][t]}, {j, jmax}]]      The numerical integration stops when two bodies collide:               μ = μ0;     sol = NDSolve[eqns[μ], fns, {t, 0, 10}][[1]]     vel = (fns /. sol)[[1 ;; -2 ;; 2]];     pos = vel = (fns /. sol)[[2 ;; -1 ;; 2]];      > NDSolve::ndsz: At t == 2.393483348087306`, step size is effectively zero; > singularity or stiff system suspected. >> The solution:               tmax = 2.393483348087306;     ParametricPlot3D[pos, {t, tmax - .1, tmax},       PlotRange -> {All, All, {-.01, .01}}, ImageSize -> 800,       PlotPoints -> 500, MaxRecursion -> 15]      ![collision plot](http://i.stack.imgur.com/yAqA5.png) I would like to detect collisions and modify the computation so that the masses (and in effect, gravitational parameters) and velocities of the collided bodies change: one body's new mass becomes the sum of both masses and the new velocity becomes the sum of both velocities; the other body's new mass and velocity become zero. I have tried to do it with `WhenEvent`:               μ = μ0;     sol = NDSolve[     Append[eqns[μ],      WhenEvent[Length[$MessageList] > 0, Print[tmax = t];      dist =        Table[EuclideanDistance[r[[j + 1]][t], r[[j]][t]], {j,          Length[r] - 1}];      distDif = Table[Abs[dist[[n + 1]] - dist[[n]]], {n, Length[dist] - 1}];      p = Position[distDif, Min[distDif]][[1, 1]];      μ[[p]] += μ[[p + 1]]; μ[[p + 1]] = 0;      v[[p]][t] += v[[p + 1]][t]; v[[p + 1]][t] = 0;      "RestartIntegration"]], fns, {t, 0, 10}][[1]]     vel = (fns /. sol)[[1 ;; -2 ;; 2]];     pos = vel = (fns /. sol)[[2 ;; -1 ;; 2]];      However, this does not work. It seems that I do not catch the error properly, the program aborts before the message can be caught. How to catch this properly?


How to draw a directed graph with arrows showing vertically from bottom to top

If I have a directed graph, how can I draw it with arrows pointing vertically from bottom to top, like showing a class inheritance pattern in OOP(object oriented programming)?


Plotting solutions of a 4th order polynomial equation

I have a polynomial equation of the fourth order, which has $4$ roots depending on a variable parameter `s1`. For each `s1` I have $4$ solutions. I need a `LinePlot` of all roots to see how they move in the complex plane when the parameter `s1` changes. I can solve my equation but I don't know how to plot all the roots together on one diagram (points connected with line for each solution).               poly = -6.110000000000001`*^6 k^4 + 1000.` s1^2 + 60.335263000000005`(-5.` k + s1)^2;          Table[ NSolve[ poly == 0, k], {s1, {0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9}}]


Suppressing negative roots in Mathematica

**Problem** Using Mathematica's `Solve` operator can sometimes lead to an output involving a positive and negative root (say when solving for a variable such as `N^2`. **What Is Happening** Here I simply have a defined function `Radial` followed by implementation (`Solve`) of that function.               Radial[n_,l_,r_]:= LaguerreL[n-l-1, 2*l+1, ((2*Z)*r)/(n*a)] * ((Z*r)/(n*a))^l Exp[-((Z*r)/(n*a))];     Solve[Integrate[             N^2 Radial[1,0,r] r^2,              {r,0,\[Infinity]},             Assumptions -> {Z>0,a>0,{Z,a},Reals}           ]== 1,N]          Out[1]= {{N -> -(Z^(3/2)/(Sqrt[2] a^(3/2)))}, {N -> Z^(3/2)/(Sqrt[2] a^(3/2))}}      _Mathematica_ is kind enough to give me both positive and negative roots. **What I Want** I would like to suppress the negative root, leaving only the positive root solution, i.e. `{N -> (2 Z^(3/2))/a^(3/2)}` **What I've Tried** Here I include a couple things I have tried (some suggested by the kind people in chat).   1. Inserting `N>=0` into `Assumptions` : Resulted in two roots.   2. Inserting `N>=0` and `N` into the `Reals` section. : Resulted in two roots.   3. Inserting `&& N>0` following the `==1` combined with all possible permutations of Tries (1) and (2). : Resulted in no answer given (nor any errors). Hopefully there is a simple way of fixing this (and not some convoluted input syntax). However, for the benefit of the community, any suggestion is welcomed. For my particular case, the simpler the better.


Manipulating a continuous stream of sounds

I need some audio-feedback when a locator is moved on a surface. I have the following code that produces a beep every time the dynamic controller is interacted with such that the pitch of the sound correlates with the _z_ -value of the underlying surface of the `LocatorPane`. The problem is that when the locator is moved, it does not provide a continuous soundstream, rather jerky, disconnected notes. If I increase the length of each sound primitive then they overlap, and cause severe lags.               pt = {0, 0}; (* initialize locator *)          func = Sin[\[Pi]*2*#1*#2] &; (* arbitrary surface *)          sound[{x_, y_}] :=       Sound[SampledSoundFunction[        Sin[0.15/(Rescale[func[x, y], {-1, 1}, {1, 0}] + 1) #] &, 4000,         20000], .1];          LocatorPane[      Dynamic[pt, (pt = Clip@#; EmitSound@sound@pt) &],      ContourPlot[func[x, y], {x, -1, 1}, {y, -1, 1}, ImageSize -> 200]      ]      ![Mathematica graphics](http://i.stack.imgur.com/clLMW.png)


Subsets of a list

Consider the following demand of products for the next four months.               data={1,20,3,40};      I could produce the whole demand in the first months, leading to the following "production vector": `{63,0,0,0}`. As you can imagine, producing everything in the first month leads to high costs of inventory. Another possibility would be {21,0,43,0}. Now I would like to get all possible combinations of the subsets of `data`, leading to:               results=     {{{1},{20,3,40}},     {{1,20},{3,40}},     {{1,20,3},{40}},     {{1},{20,3},{40}},     {{1},{20},{3},{40}},     {1,20,3,4}     }      It is important that `Table[Map[Flatten,results][[i]]==data,{i,Length@results}]` is `True` for all `i`. This means that each sublist of `results` has the same order of figures as in data.


Using Evaluate and Evaluated -> True in Plot

A few use cases: (1) This, as expected, returns (almost) immediately:               f[x_?NumericQ] := Evaluate[(Pause[1]; x)]     Plot[f[x], {x, 0, 1}]        (2) This takes forever:               f[x_?NumericQ] := (Pause[1]; x);     Plot[f[x], {x, 0, 1}, Evaluated -> True]      (3) This is much faster than (1):               f[x_?NumericQ] := {(Pause[1]; x), x x};     Plot[f[x][[1]], {x, 0, 1}, Evaluated -> True]      (4) This returns immediately ... with a "wrong" plot:               f[x_?NumericQ] := {(Pause[a = x + 1]; a), x};     Plot[f[x][[1]], {x, 0, 1}, Evaluated -> True]      (5) While this, as expected, returns immediately, with the "right" plot:               f[x_?NumericQ] := Evaluate[(Pause[a = x + 1]; a)]     Plot[f[x], {x, 0, 1}]      I would like an "authoritative" explanation of cases (3) and (4) ... the rest I think I'm able to understand, but posted for completeness, and to get a complete answer that could be useful for others too.


Finding a Graph Shortest Path with Custom Graph Distance Function

What is the best way to find a shortest path by using a custom distance function? I'm trying to play a little bit with the concept of using distributions instead of a deterministic weight value for each given edge. The results can be different, if we want, for example, to check what is the shortest path, with 95% "confidence". (The Flaw of Averages.) Our knowledge of the distances might not be a certainty and we may want to work with an interval or confidence range for the weights.               loc = Flatten[Solve[Mean[WeibullDistribution[2, 1, x]] == #, x] & /@ {1, 2, 3.01}];     {n1, n2, n3} = WeibullDistribution[2, 1, #] & /@ loc[[All, 2]];     network = {1 \[UndirectedEdge] 2, 1 \[UndirectedEdge] 4, 1 \[UndirectedEdge] 5,                2 \[UndirectedEdge] 3, 2 \[UndirectedEdge] 4, 4 \[UndirectedEdge] 3,                4 \[UndirectedEdge] 7, 4 \[UndirectedEdge] 6, 3 \[UndirectedEdge] 7,                5 \[UndirectedEdge] 6, 6 \[UndirectedEdge] 7};     networkWeight = {n2, n3, n3, n2, n1, n1, n3, n2, n2, n2, n1};     edgeWeights = Map[Mean, networkWeight] // N;     edgeLabels = Thread[Rule[network, edgeWeights]];     g = Graph[network, EdgeWeight -> edgeWeights, EdgeLabels -> edgeLabels,      VertexLabels -> "Name", VertexLabelStyle -> Directive[Red, Italic, 20], ImagePadding -> 20,      GraphLayout -> "SpringEmbedding"]     FindShortestPath[g, 1, 7]      This will tell me that the shortest path from 1 to 7 is `{1,2,3,7}`. But if I calculate the shortest path by hand using Monte Carlo,                  path147 = RandomVariate[n3, 10000] + RandomVariate[n3, 10000];        path1237 =RandomVariate[n2, 10000] + RandomVariate[n2, 10000] + RandomVariate[n2, 10000];        dist147 = EstimatedDistribution[path147, WeibullDistribution[α, β, μ]];     dist1237 = EstimatedDistribution[path1237, WeibullDistribution[α, β, μ]];     NSolve[CDF[dist1237, x] == 0.95 && x > 0, x, Reals] // Quiet     NSolve[CDF[dist147, x] == 0.95 && x > 0, x, Reals] // Quiet      we can see that the path `{1,4,7}` would be our choice in this case. Is there a way to, after assigning the distribution to the `EdgeWeight`, to define a function that will calculate the total weight using the same concept shown above? Many thanks.


Difference in integral character heights

![enter image description here](http://i.stack.imgur.com/YkhKN.png) Above is an example of what happens. It seems that the first integral is longer than the second because the y-character is longer than the x-character as this doesn't happen with other similar-height characters: ![enter image description here](http://i.stack.imgur.com/Bdgvk.png) Is there a way to change this so that the integral defaults to the larger size regardless of whether x or y is used? If it's any help: the stylesheet is **Outline** and the screen environment is **bulleted**. **Edit** \- In response to the comments, this was in a text cell (part of a set of math notes) **Edit** \- By default it is in TraditionalForm. Converting to StandardForm, then back to TraditionalForm makes them look the ideal way: ![enter image description here](http://i.stack.imgur.com/y4cdX.png)


Step-by-step definite integration

I am interested in obtaining the intermediate steps for rather straightforward symbolic definite integrations (e.g., from an elementary calculus text). As an example, for $\int_0^1 x\,dx$ I'd like output along the lines of $$ \int_0^1 x\,dx={x^2\over 2}\Bigg|_0^1={1\over 2} $$ I have reviewed the responses to this question dealing with WolframAlpha-like step-by-step output as well as this one and this one. The answer in the first link above is in the spirit of what I'm after (especially the last answer given by FDSg), but it focuses on _differentiation_. However, when I try this on even elementary definite integrals like $\int_0^1 x\,dx$ it simply returns the answer without the steps. Perhaps I am overlooking something. I do not intend to duplicate that question and this distinction is key to that. In short, I'd be happy if `ShowSteps` (applied to `Integrate[x,{x,0,1}]`) would simply show the output in the displayed equation above (the emphasis being that I don't need to see _how_ the indefinite integral is computed, just what it is, and then completing the evaluation between limits).


Isomorphisms for graphs with loops and multiple edges

I am working with graphs with multiple edges and loops, and I want to eliminate all isomorphic graphs from a long list I've generated. The `FindGraphIsomorphism` function is very nice, but only works for simple graphs. I'm looking to find such a function or its equivalent for multigraphs. For example, ![two multigraphs](http://i.stack.imgur.com/iYDi3.png) Is there possibly a third-party package, or maybe even an external program that would find such graph isomorphisms? Also, is it possible to compare graphics objects in Mathematica, to see whether they are similar? I have tried `SameQ`, but to no avail. ![graphs with self-loops](http://i.stack.imgur.com/36yfX.png) I am assuming this is the result because Mathematica plots the graphs with floating-point values, so it is impossible to have two identical graphs like this. So is there a function that looks at the similarity between two graphics objects? I think something like that might do the trick for me in most cases.


How to add a label to a CopyEvaluate button?

I found a definition of a button               Button[Defer[ Information[ \[SelectionPlaceholder], LongForm -> False]],        None, BaseStyle -> "CopyEvaluate"]      that is doing a good job. How can I add a label to this button definition similar to `Button[label, action]`? I have trid to change the definition given above, but nothing I've done worked.


Export in Manipulate, infinite loop

I want to make export of a plot inside Manipulate, but only once. However, this code runs infinitely and does export infinitely:               Manipulate[Module[{pl},       pl = Plot[Sin[a x + b], {x, 0, 6}];       Export["pl.pdf", pl];       pl]      , {a, 1, 4}, {b, 0, 10}]      If I remove Export[] from Manipulate, problem disappears, but I need it inside Manipulate for other reason;) Can we control number of evaluations of certain code inside Manipulate?


Positive integrand giving negative answer

I'm integrating a positive function f(t) times sin(t) from 0 to pi/5 and get -38. Actually f is slightly negative for a short time (smallest value ~ -0.0005), but far from enough to explain this. Here is the code for the function:               NormFact[k_, S_] :=      Sqrt[(4 S - 2 k - 1) (4 S - k) (4 S - k + 1) (k +        1) (k + 2)/(4*Pi*S)];          xi[k_, j_, S_] := (-1)^j*      Binomial[k, j]*(4*S - k - 1)!/((j + 2)!*(4*S - k - j - 1)!);          Ofunc[t_, S_, coeffs_] :=      1 - Cos[t/2]^(4*S) +      coeffs.Table[      NormFact[k, S]*       Sum[xi[k, j, S]*Sin[t/2]^(2*j + 2)*Cos[t/2]^(4*S - 2*j - 2), {j,          0, k}], {k, 0, Length[coeffs] - 1}];          cfs = {-2.6155133, 0.9614036, 0.100279, -0.432464,      0.39887624, -0.2508507, 0.10555472, -0.0007824, -0.0526054,      0.0703274, -0.0688152, 0.05138949, -0.03833719,      0.02062684, -0.0018939, -0.0027808};      And here's the result when I integrate:               In:= Integrate[Ofunc[t, 58.5, cfs]*Sin[t], {t, 0, Pi/5}]     Out:= -38.132 + 0. I      Can anyone see my mistake?


can mathematica plot graph/visualize rotation matrices

just wondering is there any example online   that show plotting of 3d rotation matrices like in the picture below (source) ![enter image description here](http://i.stack.imgur.com/quZ1h.png)


Custom operators; custom pattern matching with pure functions

What I'm trying to achieve in _Mathematica_ is the creation of a binary operator whose operands are both pure functions over the natural numbers. The result of the operator should be another pure function over the natural numbers. To demonstrate concretely what I want, suppose I have the following functions defined:               f[n_Natural]:=2*n;     g[n_Natural]:=n-1;      (There is no Head called "Natural" so the above pattern matching won't work. But I want _f_ and _g_ to accept only natural numbers. This is **problem No. 1** [SOLVED]) I then want a binary operator defined like so:               Needs["Notation`"];     CombinedFunction[f_NaturalFunction,g_NaturalFunction]:={#}/.{{x_Natural}:>f[#]+g[#]}}&;     InfixNotation[ParsedBoxWrapper["\[CirclePlus]"], CombinedFunction];      Operating $f$ $\oplus$ $g$ yields a pure function $h$ that only takes a natural number as an argument. I have found a way of enforcing the domain of $h$ thanks to this thread, but I want to extend this to ensure that $\oplus$ itself is only defined for unary functions over the natural numbers. Seeing as there's no Head like 'NaturalFunction', I don't know how to do this. This is **problem No. 2**. As an additional issue, the operator (which currently yields a function defined over the integers) currently gives an unsimplified output:               Needs["Notation`"];     CombinedFunction[f_, g_] := {#} /. {{x_Integer} :> f[x] + g[x]} &;     AddInputAlias["4" -> ParsedBoxWrapper["\[CirclePlus]"]];     InfixNotation[ParsedBoxWrapper["\[CirclePlus]"], CombinedFunction];          f=1&;     g=#&;     h=f\[CirclePlus]g      > >     {#1} /. {{x$_Integer} :> (1 &)[x$] \[LeftRightArrow] (#1 &)[x$]} & >   I would have expected the output to be: > >     (1+#)& >   I'm unsure of the inner workings of what I've written so I don't know how to obtain a simplified result. I can now apply $h$ to an integer and it operates as expected. However:               h[3.5]      > >     {3.5} >   I want instead _Mathematica_ to behave as if the function was simply undefined for anything but an integer, just as it would do if I defined $h$ like so:               Clear[h]; h[x_Integer]:=x+1;     h[3.5]      > >     h[3.5] >


Identifying subsets with minimal standard deviation

Consider the following:               data = {10, 11, 15, 12, 9, 8, 7, 6, 8};          DataAll=StandardDeviation[data];     DataMost=StandardDeviation[Most@data];       DataRest=StandardDeviation[Rest@data];              DataOtherCombinations=           Table[                 Sqrt[                      (StandardDeviation@data[[1 ;; -i]])^2                     +(StandardDeviation@data[[-i + 1 ;; -1]])^2                 ],         {i, 3, 8}]          ListPlot[Join[{DataAll,DataMost,DataRest},DataOtherCombinations], Joined -> True]      The plot shows, that the combination `{{10, 11, 15, 12},{9, 8, 7, 6, 8}}` (`i=6` in `DataOtherCombinations`) has the lowest total standard deviation. (I define the total standard deviation as `Sqrt[StandardDeviation[a]^2+StandardDeviation[b]^2]`). I was hoping to find the same result with `FindClusters` but this is not the case:               In[1455]:= FindClusters[data,DistanceFunction->EuclideanDistance]     Out[1455]= {{10, 11, 15, 12, 9, 8, 7, 6, 8}}      Maybe there is a way of customising `FindClusters` or even better: an approach based on the minimisation of the total standard deviation exists already. By the way: `DataOtherCombinations` does not represent all possible combinations. I'm looking for all subsets of `data` with two restrictions: the order of numbers must not be changed (i.e. the subset must be a sequence of `data`) and the minimum length of one sequence must be greater than or equal to `3`. Hence, another possible combination would be `{{10, 11, 15},{12, 9, 8},{7, 6, 8}}`. (I tried it with `Subsets` but this function seems more to return all permutations of all subsets.)


Import image using InputField and Button

I've got a pretty basic problem, which is probably easily solved, but for all my efforts I haven't found a solution yet: I want to make an Image importer of the following form: An `InputField` in which the name (either on computer or on web) can be put in, and next to it a button saying `"Import"`, and clicking of which imports, and displays the picture in the output. I've tried the following, but I keep getting an error message                DynamicModule[{x = "image name"},                     {InputField[Dynamic[x]],                      Button["import", Print[Import[Dynamic[x]]]]                    }                   ]      > >     Import::chtype: >   What am I doing wrong? Might be something very basic, I'm still pretty new to _Mathematica_ and `Dynamic` functions in particular.


Sophistication of Series[...]

I'll give a concrete example and I hope that my general question will be clear. Say I have three variables, $f$, $g$, $h$, and I know that $f=\mathcal O(x)$, $g=\mathcal O(x^2)$, $h=\mathcal O(x^3)$ ($\mathcal O$-notation) or something of that sort. Now, I want to do a series expansion of expressions involving $f$, $g$, $h$ to a consistent order in $x$. For example, if I write `Series[..., {x,0,4}]` I want to keep terms like `f^3` and `f g` but to throw away terms like`f g^2` and `g h`. Is there a simple way to do so?


ParametricPlot Question

I want to graph more than two, lets say 5 different `ParametricPlot`-s all in terms of different time variables. Is there any way to do this, such that they all show up on the same plot? For example, I want to plot:   * `{3Cos[a],4Sin[a]}`.. on some interval,   * `{4Cos[b],5Sin[b]}`.. on some interval,   * `{5Cos[c],6Sin[c]}`.. on some interval,   * `{6Cos[d],7Sin[d]}`.. on some interval,   * `{7Cos[e],8Sin[e]}`.. on some interval, all on one picture. Thank You Very Much.


How can I efficiently "remap" an image?

Many image processing libraries like OpenCV, Intel Performance Primitives or Octave have a useful function called "remap", that takes an image, an array with X coordinates and an array with Y coordinates, and returns an image that "transforms" the image by that geometric mapping. Or, as the IPP documentation puts it: _"Pixel remapping is performed using pxMap and pyMap buffers to look- up the coordinates of the source image pixel that is written to the target destination image pixel:_ > dst_pixel[i, j] = src_pixel[pxMap[i, j], pyMap[i, j]] The closest thing in Mathematica that I'm aware of is `ImageTransformation`, but that takes a function, not an array. Using arrays can often save a lot of time (for example, you can apply the same mapping-array to multiple image, and arithmetic operations on arrays are very fast). The best I've come up with so far is to combine `ImageTransformation` and `ListInterpolation` to convert the arrays to functions:               img = ExampleData[{"TestImage", "Lena"}];     mapX = Table[i + j, {i, 500}, {j, 500}];     mapY = Table[i - j, {i, 500}, {j, 500}];      (Imagine some time-consuming operation here. I know that passing `i+j,i-j` as a function to `ImageTransformation` is probably much faster in this simple case, but that's not the point.)               {xFn, yFn} =        ListInterpolation[#, {{0, 1}, {0, 1}}, InterpolationOrder -> 1] & /@ {mapX, mapY};          Timing[ImageTransformation[img, {xFn @@ #, yFn @@ #} &, {500, 500},        PlotRange -> {{0, 1}, {0, 1}}, DataRange -> Full]]      This works, but is extremely slow (4.7s on my PC). The second idea I had was to use `ListInterpolation` on the image directly (in this case, only on the red channel):               redFn = ListInterpolation[ImageData[img][[All, All, 1]],         InterpolationOrder -> 1];         Timing[Image[redFn[mapY, mapX]]]      This takes 1.7s for one color channel, so it's even slower for 3 channels. For comparison: The IPP's remap function usually takes a few milliseconds.


Memory not freed after running Clear when using a Table

When I'm creating large lists with `Table` I see the memory footprint increasing.               MemoryInUse[]/1024.     (* Out-> 16992.4 *)          data = Table[x, {x, 0, 10000}, {y, 10000}];         MemoryInUse[]/1024.     (* Out-> 408372. *)      I would expect that when I generate the same command `data = Table[...]` just as above the memory would not increase but in fact it just allocates a new block of memory.               data = Table[x, {x, 0, 10000}, {y, 10000}];        MemoryInUse[]/1024.     (* Out -> 799041. *)      Why is that? Even when I do:               Clear[data];     MemoryInUse[]/1024.     (* Out-> 799044. *)      Is this expected behaviour or am I missing something? I can't seem to find a function that clears the memory. I'm using Mathematica 8.0.4.0 on Windows 7


Automatic formatting of isotope symbols in a text cell

`InputAutoReplacements` is an obvious choice for formatting isotope names in text cells. I'd like to be able to type `"1H"`, for example, and when I hit the space bar have it replaced with `Row[{Superscript["",1],"H"}]` inline. But my initial attempts at this have not been productive. Is it possible to use string patterns in `InputAutoReplacements`, such as the pattern in the following `StringReplace`?               StringReplace["14C",        n:NumberString~~atom:(CharacterRange["A","Z"]~~Repeated[CharacterRange["a","z"],{0,1}]        ~~WordBoundary) :>         ToString[Row[{Style[Superscript["",Style[n,Smaller]],                            ScriptBaselineShifts->{Automatic,.4}],atom}],                 TraditionalForm]]      I expected that entering that pattern into the Option Inspector (Global preferences for `InputAutoReplacements`, using `RuleDelayed`) would cause occurrences of `"1H "` typed into a text cell to raise the "1" to a superscript. Nothing happens. You might imaging that formatting the superscripts according to the above rule by hand is tedious.