Computing the average over the values of the boxes surrounding a box in a grid

Recenty,I encounter a problem described as below: > I have a table that owns many boxes,and each box has a sequence like > 1,2,3,4,etc.In addition,every box has a value. > > Now I want to make the value of a box become the average of the values of > boxes that arounding it. > > For example, > > `the value of box 1` become the average of`the values of box 2,11,12`, > > `the value of box 11` become the average of`the values of box 1,2,12,22,21` > > `the value of box 14` become the average of`the values of box > 3,4,5,13,15,23,24,25`               Grid[Reverse@Partition[Range[80], 10], Frame -> All]      ![enter image description here](http://i.stack.imgur.com/ufgS6.png)               sequenceValue = Thread@List[Range[80], RandomInteger[{0, 1}, 80]];     Reverse@Partition[sequenceValue, 10] // Grid[#, Frame -> All] &      ![enter image description here](http://i.stack.imgur.com/Mizh4.png) ### My trial **Extract the sequence of the boundary of table**               ExtractBoundarySequence[length_, width_] := Block[       {bottomData, topData, leftData, rightData, cornerData},      bottomData = Range[2, length - 1];      topData = Range[2 + (width - 1) length, width*length - 1];      leftData = Range[1 + length, 1 + (width - 2) length, length];      rightData = Range[2 length, (width - 1) length, length];       cornerData = {1, length, 1 + (width - 1) length, width*length};      List[cornerData, bottomData, topData, leftData, rightData]     ]      **Extract the sequence of the innerior of table**               ExtractInteriorSequence[length_, width_] := Block[     {},     DeleteCases[      Flatten@Table[{# - 1, #, # + 1} + i *length, {i, -1, 1}], #] & /@      Flatten@Table[Range[2 + length, 2 length - 1]+(i - 1)length , {i, 1, width - 2}]     ]      **Caculate the value of the boundary of table**                CalculateBoundaryValue[SequenceValue_, length_, width_] := Block[      {corner, bottom, top, left, right,       cornerSequence, bottomSequence, topSequence, leftSequence, rightSequence,      value1, value2},      {corner, bottom, top, left, right} =ExtractBoundarySequence[length, width];      bottomSequence = DeleteCases[       Flatten@Table[{# - 1, #, # + 1} + i *length, {i, 0, 1}], #] & /@bottom;      topSequence = DeleteCases[       Flatten@Table[{# - 1, #, # + 1} + i *length, {i, -1, 0}], #] & /@top;      leftSequence = DeleteCases[       Flatten@Table[{#, # + 1} + i *length, {i, -1, 1}], #] & /@ left;      rightSequence = DeleteCases[       Flatten@Table[{# - 1, #} + i *length, {i, -1, 1}], #] & /@ right;          value1 =      Mean /@ (Flatten[       Map[Part[SequenceValue[[All, 2]], #] &,        {bottomSequence, topSequence, leftSequence,          rightSequence}, {2}], 1]);          cornerSequence =     {      DeleteCases[        Flatten@Table[{#, # + 1} + i*length, {i, 0, 1}], #] &[corner[[1]]],      DeleteCases[        Flatten@Table[{# - 1, #} + i *length, {i, 0, 1}], #] &[corner[[2]]],      DeleteCases[        Flatten@Table[{#, # + 1} + i *length, {i, -1, 0}], #] &[corner[[3]]],      DeleteCases[        Flatten@Table[{# - 1, #} + i *length, {i, -1, 0}], #] &[corner[[4]]]     };          value2 =       Mean /@ (Part[SequenceValue[[All, 2]], #] & /@ cornerSequence);           Thread@List[Flatten@{corner, bottom, top, left, right}, Join[value2, value1]]     ]      **Caculate the value of the innerior of table**                CalculateInteriorValue[SequenceValue_, length_, width_] := Block[      {interiorSequence, interiorNumber, value},      interiorSequence =      ExtractInteriorSequence[length, width];      interiorNumber =       Flatten@Table[Range[2 + length, 2 length - 1]+(i - 1)length, {i, 1, width - 2}];      value =          Mean /@ ((Part[SequenceValue[[All, 2]], #] &) /@ interiorSequence);       Thread@List[interiorNumber, value]      ]      **Final sequence-v-alue**               NewSequenceValue[SequenceValue_, length_, width_] := Block[      {NewBoundaryData, NewInteriorData},      NewBoundaryData =      CalculateBoundaryValue[SequenceValue, length, width];      NewInteriorData =      CalculateInteriorValue[SequenceValue, length, width];      SortBy[Join[NewBoundaryData, NewInteriorData], First]     ]      **Using my function:**               Reverse@Partition[NewSequenceValue[sequenceValue, 10, 8], 10] //Grid[#, Frame -> All] &      ![enter image description here](http://i.stack.imgur.com/GyJOm.png) and it can achieve the result. However, I think my method is a little tedious, so my question: is there a better algorithm (method) to solve my problem?


Add noise (random values) to data

I have a data set(x,y,z) corresponding to a hemisphere, to which I want to add some controlled noise (random values) to make the x,y,z values diverge. > data = Flatten[ Table[{i, j, i^2 + j^2}, {i, -10, 10, 1}, {j, -10, 10, 1}], > 1] The above is a 3 coordinate set (x,y,z) values for a hemisphere. How do I add random noise to it? Thank you


Classify command in Mathematica 10

Where can I find documentation about the methods used in the `Classify` command in _Mathematica 10_? Specifically, how does the method `Markov` work? Any pointers to the documentation for the methods available in `Classify`, or an explanation of how the method `Markov` works, will be appreciated.


Simulating a bounded continuous random walk in $n$-dimensions

You're given three $n$-dimensional real vectors, $\mathbf{x_0}$, $\mathbf{a}$ and $\mathbf{b}$, with $\mathbf{a} \le \mathbf{x_0} \le \mathbf{b}$ (vector inequality means component-wise inequality). Starting at $\mathbf{x_0}$, simulate a bounded continuous random walk, such that the end point $\mathbf{x}$ of the walk is always inside the bounds $\mathbf{a} \le \mathbf{x} \le \mathbf{b}$. I want to program this with Mathematica. The parameters of the simulation are the bounds $\mathbf{a}, \mathbf{b}$, the starting point $\mathbf{x_0}$, and a parameter $\sigma$ that controls the standard deviation of the step size. **What's a _simple_ and _efficient_ way to do this?** **Here's what I've tried:** The following function `Walk` takes a vector $\mathbf{x}$ and returns the next point on the random walk.               Walk[x_List, a_List, b_List, sigma_] :=       x + RandomVariate[        TruncatedDistribution[Transpose[{a - x, b - x}],         MultinormalDistribution[ConstantArray[0, Length[x]],           sigma*IdentityMatrix[Length[x]]]]]      For some reason this is exceedingly slow. You can try it yourself. After executing:               a = ConstantArray[0, 10];     b = ConstantArray[1, 10];     x = RandomReal[{0, 1}, 10];      The following line of code takes forever on my PC:               Walk[x, a, b, 4]      **Why?**


Stacked bars in a barchart with individual and overall labels

There are a lot of questions here about formatting of barcharts, but I couldn't find one matching mine. I seek to display data in stacked format, labeling each component of the stack and the total for each bar. I can't make it work for the life of me. As a starting place, consider               BarChart[{{1, 2}, {2, 3}, {2, 4}}, ChartLayout -> "Stacked",       ChartLabels -> {Range[2004, 2006], None}]      I want each component labeled as below -- ![goal](http://i.stack.imgur.com/Wr6C9.png) My efforts to date result in some pieces appearing but never all, and often in the wrong places.


Use output of NDSolve as an integration limit of NIntegrate

I've been working on a ODE, for a function `y[t]`, that, due to it's complexity, has to be solved numerically. I then need to use the results of NDSolve, which I store in the variable $s$, in the following manner:               Plot[          NIntegrate[                     f[r],{r,b,Evaluate[Sqrt[{(y[t])^2+b^2}/.s]]}                    ],          {t,0,5}         ]      which returns the following errors:               NIntegrate::nlim: r = {20.025} is not a valid limit of integration. >>     NIntegrate::nlim: r = {20.025} is not a valid limit of integration. >>     NIntegrate::nlim: r = {19.6024} is not a valid limit of integration. >>     General::stop: Further output of NIntegrate::nlim will be suppressed during this calculation. >>      It seems that the problem is due to $\text{Evaluate}$ returning the number in parentheses...I've tried the function $\text{N}$ but it has the same problem. Maybe I'm doing something else wrong. Can anyone help me? **Edit:** I shall post the complete code as suggested in the comments:               Module[{b = 1., k = 1., Vt0 = 2., L0 = 20.},      s = NDSolve[        {y''[t] - (y'[t])^2 (b^2/((b^2 + (y[t])^2) y[t]) - y[t]/(              b^2 (Exp[(y[t])^2/b^2] - 1))) - (z'[t])^2 (-1/(              y[t] Exp[(y[t])^2/b^2]) (Exp[(y[t])^2/b^2] -                 1) (b^2 + (y[t])^2)) + k*(b^2 y[t])/(b^2 + (y[t])^2) == 0,          y[0] == L0, y'[0] == 0,         z''[t] + 2*y'[t]*z'[t]*(y[t]/(b^2 + (y[t])^2)) == 0, z'[0] == Vt0,          z[0] == 0},        {z, y}, {t, 0, 5}        ];      f[r_] := Sqrt[E^(r^2/b^2)/(-E + E^(r^2/b^2)) - 1];           Plot[       NIntegrate[f[r], {r, b, Evaluate[Sqrt[(y[t])^2 + b^2] /. s]}],       {t, 0, 5}       ]      ]


How to use Button as a control in Manipulate

I am trying to use `Button` as a controller in `Manipulate`. I have done some thing like this:               Manipulate[       p = Column[{Plot[Sin[x - n], {x, 0, 12.4}, ImageSize -> 500]}],        {n, 0, 1},        Button["Export", Export["test.jpg", p]]]      Is there any better way to do this? I am thinking of making something like this:               Manipulate[       Column[{p = Plot[Sin[x - n], {x, 0, 12.4}, ImageSize -> 500],        If[x, Export["test.jpg", p]]}],        {n, 0, 1},        {x, {False, True}}]      in which the controller `x` is represented by `Button` instead of a `Checkbox`. How can I do that?


WSTP Callbacks into CDF

Essentially, what I am trying to find out is the limitation of the WSTP/LINK protocols in Enterprise-licensed CDF. Specifically, are any callbacks to the kernel from those protocols allowed in CDF , Enterprise CDF, or Player Pro? Are any methods disabled? This problem is difficult since very few people discuss the issue, and Wolfram documentation makes little mention of disabling specific functionality for CDF/Player Pro (e.g. http://www.wolfram.com/player-pro/how-player-pro- compares.html is not very specific). More importantly, if callbacks were allowed without any restrictions on what `Evaluate` could do, what would stop a person from evaluating arbitrary expressions using a combination of a LINK and IPC (i.e. interprocess communication)? I have been told by Wolfram representatives that version 10 Enterprise CDF should have less LINK restrictions that the previous version (e.g. .NET/LINK is allowed now), but that still doesn't help me understand where Wolfram draws the line. I appreciate any answers or suggestions. If I hear back from Wolfram on the issue, I will update this post.


Design considerations behind `O` (a.k.a. BigOh, a.k.a. Landau Order)

This works without any warnings: `O[Log[x]]`. This raises a warning: `O[x^2]`. I have a few questions around this:   1. Why is it a good idea for `O[x^2]` to raise a warning when `O[Log[x]]` does not?   2. Is `O[Log[x]]` meaningfully useful in _Mathematica_ given the semantics of its `O[]`?   3. How does one represent $\mathcal{O}(\log(x-x_o))$ naturally in _Mathematica_? (Probably there is no way because it is useless...)   4. Why is `O[x, x0]^2` the representation chosen by _Mathematica_ authors instead of something like `O[(x-x0)^2]`?


How to neglect higher power terms in a polynomial expression

I have a polynomial expression of order n (say n=20). `F(x)=1+x+x^2+x^3++...x^20`. I want to approximate the polynomial for order 3 only. So I need to make the coefficient of power of x greater than 3 to zero. How can I do that in _Mathematica_?


Computing the fundamental matrix and its monodromy matrix

Assume $\dot x(t)=v(x,t)$ is a $T$-periodic, with respect to $t$ dynamical system. That is $x\in\mathbb R^n,\quad t\in\mathbb R,\qquad v(x,t+T)=v(x,t)$. Let $x_0$ be a periodic solution, and in elementary functions. Assume if you must that $x_0$ is as smooth as you need. How can one use Mathematica to compute symbolically a fundamental matrix for the linearised around $x_0$ system and its monodromy matrix? Any help would be appreciated.


How can I monitor and detect when a website has changed?

I'd like to detect when a website has changed, in particular when new products are announced on a site that doesn't change to often. Here's the code I wrote but I don't think it is perfect. Also the site might block me if I ping it too many times...               content = Hash@URLFetch["www.wolfram.com"];     $c = 0; Dynamic[$c]          RunScheduledTask[$c++;       If[content =!= Hash@URLFetch["www.wolfram.com"],        SendMail["To" -> "me@me.com",         "Subject" -> "The wolfram site has been updated!",         "Body" -> {"Check wolfram now"},         "From" -> "email", "Server" -> "smtp.gmail.com",         "UserName" -> "email", "Password" -> "pass",         "PortNumber" -> 587, "EncryptionProtocol" -> "StartTLS"];          content = Hash@URLFetch["www.wolfram.com"]], 100]      I'd also like to create a standalone executable for running this process in the background without mathematica being open.


Using MathKernel without echoing a window

I use M9 under windows 7 on a command prompt as: MathKernel -noprompt -script file.m On execution, there is a like a kernel window opened and then closed immediately. How can I avoid this window and run my script in silence? thanks


Creating a simple function to compute the average of the difference between pairs of elements in an array

I have a list of the form:               {{{1, 2}, {3, 4}}, {{5, 6}, {7, 8}}, {{9, 10}, {11, 12}}}      How can I create a function which will take each set at the highest level of the list:               {{1, 2}, {3, 4}}          {{5, 6}, {7, 8}}          {{9, 10}, {11, 12}}      And subtract the first element of the set from the second element of the set, here:               {3, 4} - {1, 2} = {2, 2}          {7, 8} - {5, 6} = {2, 2}          {11, 12} - {9, 10} = {2, 2}      Then compute the average or median of these values (`{2, 2}` here in either case)? It's clear how to do this using loops or tables, but is there a simpler way to proceed that makes clever use of _Mathematica_? For a table based implementation:               PairList = {{{1, 2}, {3, 4}}, {{5, 6}, {7, 8}}, {{9, 10}, {11, 12}}};     PLMean = Mean[Table[PairList[[u, 2]] - PairList[[u, 1]], {u, 1, Length[PairList]}]]


Rotate lines around their midpoint

I am trying to rotate a series of lines by the same angle around their centre point. Say each line is defined by a co-ordinate at each end, simplified example below of a typical dataset.               foo = {{{100, 25}, {150, 45}}, {{200, 45}, {240, 85}}};      Then the midpoint can be found by:-               boo = (#[[2]] - #[[1]])/2 + #[[1]] & /@ foo;      This is visualised using the code below:               Show[     Graphics[{Thick, Dashed, Black, Line /@ foo}],     Graphics[{Black, PointSize[Large],     Point[boo],     Table[{Black, Text[ToString[boo[[p]]], boo[[p]] + 2]}, {p, Length[boo]}]}]     ]      ![enter image description here](http://i.stack.imgur.com/zmjPE.jpg) I was hoping to create a series of transformations using RotationTransform such as below:               rot = RotationTransform[Pi/2, #] & /@ boo      Then mapping this across foo using MapThread, but I'm not sure which function I should be mapping across to make each line rotate by 90 degrees around its own centre point.               MapThread[?, {woo, rot}]      I think I'm close to what I want to achieve (or maybe not), but I can't quite seem to close it out. All suggestions welcome.


Once more on object orientation in Mathematica: does it have to be so hard?

Recently I came across a set of problems which would be solved most easily within an object-oriented approach. I first attempted to solve them by other means, but found the complexity of the code growing too fast and, while individual functions used a mixture of styles, the overall feel and organization of the code was de-facto procedural. Having looked at the final code, I saw that I would have written it much faster and cleaner in Java, which is when I realized that OO was needed. Basically, I needed it to reuse some behavior and decrease coupling between components. We all know that there were a number of attempts on implementing OO extensions for Mathematica. However, none of them IMO were very simple, and none of those I looked at had a natural "look and feel" for Mathematica (I could have missed some). OTOH, we also know that Mathematica has powerful metaprogramming capabilities, which should make it possible to implement the core of an OO extension rather easily. Since OO is a broad paradigm, here are some requirements to restrict the problem. The desired OO extension should   * _Be idiomatic_. Programming in it should feel natural for experienced Mathematica users. In particular, it should go well with immutable Mathematica expressions, and have the least possible problems concerning interoperability with Mathematica (garbage collection - related problems etc).   * _Support instantiation, inheritance and polymorphism_. By inheritance I mean reuse of behavior (methods) rather than state (fields).   * _Reuse_ as much of the Mathematica's core constructs as possible   * _Limit the things that can be done with it as little as possible_ , compared to the programming techniques and tricks we are used to in Mathematica   * _If possible, have at least minimally convenient syntax_ for things like method calls.   * _Implementation should be simple_ in the sense that it should not introduce too many exterior constructs, such as `ToString` \- `ToExpression` cycles, needless manipulations with contexts, creation of new symbols which are not strictly necessary, etc.  I am not so much worried about efficiency here, since the intended purpose for such an extension is more to help with larger-scale code organization for certain classes of tasks, than to be used with millions of light-weight objects. In many previous questions on similar topics, the two rather separate topics were often mixed together. One concerns mutable struct-like data structures and their possible implementations in Mathematica, and the other was about OO proper. So, to clarify a bit more, I am not so much interested in the former topic here. I am rather more interested in the dynamic aspects (behavior reuse), and ways to conveniently package code and organize larger projects, but not so much in efficient mutable data structures. In other words, the subject matter is what can the object orientation bring to the table for larger Mathematica projects, and how can we make the most out of it in Mathematica. **So, the question is** : can we have a core of such an OO extension in under 100 lines of Mathematica code?


How do I apply a rule to every element in a matrix?

I need to apply a set of rules (I used `Which`) to every element in a matrix, but the rules are dependent on the position `[[i, j]]` of the matrix.


Improved interpolation of mostly-structured 3d data

This question arose in response to a comment by Leonid to my answer for this question. He noted that for unstructured grids, `Interpolation` can only use `InterpolationOrder->1`. For example:               data = Flatten[Table[{x, y, x^2 + y^2}, {x, -10, 10}, {y, -10, 10}], 1];     dataDelete = Delete[data, RandomInteger[{1, Length[data]}]]     intD = Interpolation[dataDelete]     (* Interpolation::udeg: Interpolation on unstructured grids is currently only supported for InterpolationOrder->1 or InterpolationOrder->All. Order will be reduced to 1. *)      which gives a result much worse than `All`-order `Interpolation`. So, here's my question: For data that is _largely_ structured, but is missing one (or a few?) grid points, is there any way to figure out where the grid is missing points? This would allow you to first use linear interpolation to find a good guess for the value of the function at the missing grid points, then add that grid point to the dataset, only to interpolate the whole thing after. Then the error in the interpolation will be localized to the reconstructed region. Something like               dataReconstructed=Append[dataDelete,Sequence @@ Flatten@{#, intD @@ #} & /@missingcoords]     intReconstructed = Interpolation[dataReconstructed]      A manual example:               todelete = RandomInteger[{1, Length[data]}];     dataDelete = Delete[data, todelete];     intD = Interpolation[dataDelete]     missingcoords = {data[[todelete, {1, 2}]]}          dataReconstructed = Append[dataDelete,Sequence @@ Flatten@{#, intD @@ #} & /@missingcoords]     intReconstructed = Interpolation[dataReconstructed]      Comparing these two methods using `exact[x_, y_] := x^2 + y^2`:               Plot3D[intD[x, y] - exact[x, y], {x, -10, 10}, {y, -10, 10}]      ![Mathematica graphics](http://i.stack.imgur.com/WJAgI.png) has differences all over the interpolated region, worse at the missing point. But:               Plot3D[intReconstructed[x, y] - exact[x, y], {x, -10, 10}, {y, -10, 10}]      ![Mathematica graphics](http://i.stack.imgur.com/n4pSD.png) is much better everywhere except for the missing points. In order to do this for a set where I don't know which grid points are missing, **is there a way to figure out where the missing grid points are in a mostly structured grid?**


Changing color of an object in an image

Consider the following image: ![Red ball in a non-red environment ](http://i.stack.imgur.com/Qr7Tx.jpg) How can I change all red colors in this image into (for example) blue.


Small Issue with Chebyshev Derivative Appoximation

I am trying to get approximate the derivative of a function from its Chebyshev expansion. I start out with the following random function               In[4]:= f[x_] = -4.1261 + .99213*x - 0.562172*x^2 - 3.7120 x^3 + 3.06508*x^4      Which looks like ![graph of random function](http://i.stack.imgur.com/v4aNt.jpg) Now I try the Chebyshev approximations as follows:               In[105]:= cgs = 5          In[107]:= Clear[A, a]          In[108]:= A = Array[a, cgs + 1, {0}]          Out[108]= {a[0], a[1], a[2], a[3], a[4], a[5]}          In[109]:=   a[0] = (1/Pi)* Integrate[(f[x]* ChebyshevT[0, x]/Sqrt[1-        x^2]), {x, -1, 1}]          Out[109]= -3.25778          In[110]:= For[i = 1, i <= cgs, i++,  a[i] = (2/Pi)*Integrate[(f[x]*      ChebyshevT[i, x]/Sqrt[1 - x^2]), {x, -1, 1}]]          In[111]:= A          Out[111]= {-3.25778, -1.79187, 1.25145, -0.928, 0.383135, -1.97901*10^-15}          In[113]:= cf = Table[a[i]*ChebyshevT[i, x], {i, 0, cgs}]          Out[113]= {-3.25778, -1.79187 x, 1.25145 (-1 + 2 x^2), -0.928 (-3 x + 4          x^3), 0.383135 (1 - 8 x^2 + 8 x^4), -1.97901*10^-15 (5 x - 20 x^3 + 16 x^5)}          In[115]:= CF[x_] = Sum[cf[[i]], {i, 1, cgs + 1}]          Out[115]= -3.25778 - 1.79187 x + 1.25145 (-1 + 2 x^2) - 0.928 (-3 x + 4 x^3)          + 0.383135 (1 - 8 x^2 + 8 x^4) -  1.97901*10^-15 (5 x - 20 x^3 + 16 x^5)          Plot[{CF[x], f[x]}, {x, -1, 1}]      gives ![graph of function and Chebyshev expansion](http://i.stack.imgur.com/p3m98.jpg) So I think I have done everything correctly up until now, because I cannot see a difference between the two graphs. As for the derivative approximation, I use the discussion in Numerical Recipes section 5.9. First I take the derivative of `f[x]`               In[200]:= df[x_] = D[f[x], x]          Out[200]= 0.99213 - 1.12434 x - 11.136 x^2 + 12.2603 x^3          In[201]:= A          Out[201]= {-3.25778, -1.79187, 1.25145, -0.928, 0.383135, -1.97901*10^-15}          In[236]:= Clear[dA, da]          In[237]:= dA = Array[da, cgs + 1, {0}]          Out[237]= {da[0], da[1], da[2], da[3], da[4], da[5]}      Now I use equation (5.9.2)               In[273]:= da[cgs] = da[cgs - 1] = 0;          In[275]:= For[i = 4, i >= 1, i--, da[i - 1] = 2*(i)*a[i] + da[i + 1]]      to get               In[276]:= dA          Out[276]= {-9.15174, 8.0709, -5.568, 3.06508, 0, 0}          In[277]:= dcf = Table[da[i]*ChebyshevT[i, x], {i, 0, cgs}]          Out[277]= {-9.15174, 8.0709 x, -5.568 (-1 + 2 x^2), 3.06508 (-3 x + 4 x^3),            0, 0}          In[278]:= dCF[x_] = Sum[dcf[[i]], {i, 1, cgs + 1}]          Out[278]= -9.15174 + 8.0709 x - 5.568 (-1 + 2 x^2) + 3.06508 (-3 x + 4 x^3)          Plot[{dCF[x], df[x]}, {x, -1, 1}]      which gives ![plot of wrong derivative](http://i.stack.imgur.com/vmRU4.jpg) which is clearly not the same graph. I was able to figure out that the problem is in the constant term. Namely, it is twice the value it should be. To test this idea I created the `test` function               In[279]:=  test[x_] = -9.151740000000007`/2 + 8.070896000000015` x -      5.568000000000007` (-1 + 2 x^2) + 3.065080000000011` (-3 x + 4 x^3);      and plotted `Plot[{test[x], df[x]}, {x, -1, 1}]` to get ![plot of derivative](http://i.stack.imgur.com/64XHi.jpg) which shows that `test` is the same as `f[x]`. If anyone could help spot my mistake, that would be greatly appreciated.


Return a Part by Reference? (For accessing hierarchical / structured data)

Is there a way to return a part of a list by reference, for reading and writing? I want to do this so I can easily manipulate "rule-styled structured", i.e., hierarchical data that is loaded from a MAT file with `struct`'s. Example:               obj = {"Name" -> "Something", "Age" -> 10};      I think this is a relatively simple way to get / set fields, which deals with nested structures by limiting `Position` to `levelspec` 1:               RuleQ[x_] := False;     RuleQ[rule_Rule] := True;     RuleQ[{}] := True; (* An empty list can be a Rule set... *)     RuleQ[rules_List] := SameQ[Head[First[rules]], Rule];          StructQ[x_] := False;     StructQ[rules_List?RuleQ] := True;          FindFirst[list_List, item_] := Module[{res},        res = Flatten[Position[list, item, 1]];        Return[If[Length[res] > 0, First[res], {}]];        ];          FieldRule[field_] := field -> _;          GetFieldIndex[obj_?StructQ, field_] := FindFirst[obj, FieldRule[field]];          SetField[obj_?StructQ, field_, value_] := Module[{index},        index = GetFieldIndex[obj, field];        If[NumberQ[index],         obj[[index, 2]] = value;         ,         AppendTo[obj, field -> value];         ];        ];     SetAttributes[SetField, HoldFirst];          GetField[obj_?StructQ, field_] := Module[{index},        index = GetFieldIndex[obj, field];        (* How to return a reference? *)        Return[obj[[index, 2]]];        ];     SetAttributes[GetField, HoldFirst];      So you can do something like               Print[GetField[obj, "Name"]];     SetField[obj, "Name", "REPLACED"];     Print[GetField[obj, "Name"]];      All that being said, I would like to do something like this:               GetField[obj, "Name"] = "REPLACED";      An example of my hope for such a feature:               GetFieldByReference[obj_?StructQ, field_] :=         Return[Part[obj, {GetFieldIndex[obj, field], 2}];     SetAttributes[GetFieldByReference, HoldReturn];     obj = {"Name" -> "Something", "Age" -> 10};     GetFieldByReference[obj, "Name"] = "REPLACED";      The contents of `obj` would then be:               {"Name" -> "REPLACED", "Age" -> 10}


Numerically obtaining the inverse Laplace transform of data

I have been using several Mathematica packages to do numerical inverse Laplace transforms on known (expressible in closed form) expressions, $\tilde{f}(s)$. I am now being confronted with the more difficult problem where I can only obtain $\tilde{f}(s)$ as a table like               {{s_1,f_1},{s_2, f_2}, {s_3, f_3 ... etc.}      I have not been able to find any packages for doing the inverse Laplace transform on tabulated data. I saw one ancient discussion in a forum that says the inverse Fourier transform can be used but I don't see how that's possible. I would greatly appreciate if anyone had done something like this before, or knew of an appropriate package, or had any suggestions for a workaround. EDIT: this is how I'm getting tabulated results for the transformed function: I have $\tilde{f}(s) =\frac{1}{s} \frac{1-\tilde{g}(s)}{1-a \tilde{g}(s)}$ where $\tilde{g}(s) = \int_{-\infty}^0 h(s,x) dx$. I know what $h(s,x)$ is, but the integral over $x$ cannot be done analytically so I am doing it numerically which is why I end up with tabular data for $\tilde{f}(s)$.


interpolation of 3D data

I have a 3D surface given in data-points of the form ${x,y,z}$. What is the easiest way to get the interpolated value $z=f(X,Y)$ for given coordinates ${X,Y}$ (which are of course not in the data list)?


Calculating mean of multiple stochastic processes and setting a lower threshold

Thanks to “Rod Lm” I got some very nice input for the following problem. My intention is to simulate within a `Manipulate` function a given number of possible stock price paths and to calculate their mean. So, if something is manipulated the “new mean” is also calculated automatically and both are shown by a line and numerically within the chart. I would also like to know how I can also calculate the mean outside the chart. I tried the following but it didn't work:               Mean[Table[        RandomFunction[          GeometricBrownianMotionProcess[0.1, 0.2, 100], {0, 250, 0.05}][         "Path"], {20}][[All, -1]]]      The next step -if possible- is to introduce a lower boundary. So for example if the initial stock price is 100 then the boundary could be at, let’s say, 70. First, I want the boundary to be shown by a line. Second, I would like to stop all stochastic processes that fall below this threshold and then receiving the mean from all remaining processes. Alternatively, if it’s not possible to stop the processes that fall below the threshold, I also just want the mean of the remaining processes that are beyond the threshold. Third, I also would like to have a manipulable threshold. So, in short, I want to be able to switch the threshold between 20 and 90 and then receive the mean of the processes that remain beyond this boundary. Is something like that possible? If yes, I would be really thankful if I would receive some suggestions how to solve my problem, or at least parts of it. So far I have done the following and is it even possible to modify this code in such a manner that my problem can be solved? My code so far:                Manipulate[        SeedRandom[seed];         ListLogPlot[         Table[RandomFunction[          GeometricBrownianMotionProcess[μ,σ,S0], {0, 250, 0.05}]["Path"], {P}],          Joined -> True,          AxesLabel -> {"Time", "St"},          PlotLabel -> Style["Forecasted Stock Price\n (Brownian Motion)", Bold],          PlotRange -> All,          ImageSize -> 500,          PlotStyle -> Directive[{Thin, Lighter@Gray}]       ],        {{S0, 100, "Initial Stock Value"}, 100, 500, 0.05, Appearance -> "Labeled"},        {{μ, 0.01, "Drift μ"}, 0.01, 1, 0.05, Appearance -> "Labeled"},        {{σ, 0.01, "Standard Deviation σ"}, 0.01, 1, 0.05, Appearance -> "Labeled"},        {{P, 1, "Paths"}, 1, 100, 1, Appearance -> "Labeled"},        {{seed, 77777, "New Random Case"}, 10000, 999999, 1},       Button["Set Initial Values", {S0 = 25, μ = 0.01, σ = 0.01}, ImageSize -> 150],       ControlPlacement -> Left]      ![enter image description here](http://i.stack.imgur.com/jt1WL.png)


Solving differential equations with constraints

The problem is $$ x''(t)=F(t) - kx'(t) \\\ x'(0)=x(0)=0$$ with the additional constraints $$ 0 < x(t) <a \\\ 0 < x'(t) <b $$ where $F(t)$ is a known function and $a,b,k$ are given. At the moment I solve such problems with the help of _`WhenEvent[...]`_. **Example** :               First@First@NDSolve[{       x''[t] == 10 Sin[0.1 t] - 0.1 x'[t], x[0] == 0,        x'[0] == 0, WhenEvent[x[t] > 400, x[t] -> 399],        WhenEvent[x'[t] > 40, x'[t] -> 39],        WhenEvent[x[t] < 0, x[t] -> 1],        WhenEvent[x'[t] < -40, x'[t] -> -39]},       x, {t, 0, 200},       MaxSteps -> 50000];     Plot[{x[t] /. %, 10 x'[t] /. %}, {t, 0, 200}, PlotRange -> All,       PlotLegends -> {"x[t]", "x'[t]"}, ImageSize -> 700]      ![Plot of x, x'](http://i.stack.imgur.com/Mj9fD.png) What is the proper way to solve this type of problem?


Finding intersection of 3D lines

I want to find the intersection of 3D line. I want to detect the 3D light source position by intersecting 3D lines.               lightsource = {0, 0, 250};          p3d1 = {100, 100, 100};      p3d2 = {100, 0, 100};     p3d3 = {0, 100, 100};          d1={500/3, 500/3, 0};     d2={500/3, 0, 0};     d3={0, 500/3, 0};     (*equation of 3 ray*)     ray1 = Flatten[p3d1 + (d1 - p3d1)*t1];     ray2 = Flatten[p3d2 + (d2 - p3d2)*s1];     ray3 = Flatten[p3d3 + (d3 - p3d3)*k1];      I solved the system equation like this AX=B.               eq = ray1 - ray2 - ray3     var = Variables[eq]     A = Coefficient[#, var] & /@ eq;     B = eq - A.var     X = PseudoInverse[A].B (*in this case we can use Inverse[A] because A is invertible.*)     ray1 /. {t1 -> -1}     {100/3, 100/3, 200}(*It is not right*) **What is the problem here?**      ( _Second method: intersecting two rays by two rays_ )               eq = ray2 - ray3;     eqp = eq[[1 ;; 2]];     var = Variables[eqp];     coefs = N[Coefficient[#, var] & /@ eqp];     verif =       Chop[eq /. Solve[eqp[[1]] == 0 && eqp[[2]] == 0, var]]     sol = Solve[eqp == {0, 0}, var];     cs1 = Flatten[ray2 /. sol] (*It is true for the 3 rays*).          I am using this graphics                         Show[Graphics3D[Cuboid[{0, 0, 0}, {100, 100, 100}]],              Graphics3D[{Red, Thick, Line[{p3d1, d1}]}],              Graphics3D[{Green, Thick, Line[{p3d2, d2}]}],              Graphics3D[{Blue, Thick, Line[{p3d3, d3}]}]]      ![enter image description here](http://i.stack.imgur.com/admRs.png)


Writing an expression as sum of squares of expressions

Suppose we have a symmetric homogeneous polynomial expression $P$ in $X=(x_1,\cdots, x_n)$. I want to check whether there are functions $g(X)$ so that $P$ is of the form $\sum _{1\le i<j\le n} g_{ij}(X) (x_i-x_j)^2$. Is there a function to find $g$? As an example: $2 a^4 +2 b^4 + 2 c^4+ 4 a^3 b + 4 ab^3 + 4 a^3 c + 4 a c^3 + 4 b^3 c + 4 b c^3 - 4 a^2 b c- 4 ab^2 c - 4 a b c^2 \- 6 a^2 b^2 - 6 b^2 c^2 - 6 a^2 c^2= (a^2+b^2+2c^2+6ab)(a-b)^2+(b^2+c^2+2a^2+6bc)(b-c)^2+(c^2+a^2+2b^2+6ca)(c-a)^2 $ In _Mathematica_ :               2 a^4 + 2 b^4 + 2 c^4 + 4 a^3 b + 4 a b^3 + 4 a^3 c + 4 a c^3 +  4 b^3 c + 4 b c^3 -     4 a^2 b c - 4 a b^2 c - 4 a b c^2 - 6 a^2 b^2 - 6 b^2 c^2 - 6 a^2 c^2 ==     (a^2 + b^2 + 2 c^2 + 6 a b) (a - b)^2 + (b^2 + c^2 + 2 a^2 + 6 b c) (b - c)^2 +     (c^2 + a^2 + 2 b^2 + 6 c a) (c - a)^2


Simultaneously fitting multiple datasets

What is the proposed approach if one wants to simultaneously fit multiple functions to multiple datasets with shared parameters? As an example consider the following case: We have to measurements of Gaussian line profiles and we would like to fit a Gaussian to each of them but we expect them to be at the same line center, i.e. the fitting should use the same line center for both Gaussians. The solution I came up with looks a little clumsy. Any ideas on how to do this better, especially in cases where we have more than 2 datasets and more than one shared parameter? Example:               f[x_, amplitude_, centroid_, sigma_] :=        amplitude Exp[-((x - centroid)^2/sigma^2)]     data1 = Table[{x, RandomReal[{-.1, .1}] + f[x, 1, 1, 1]}, {x, -4, 6,               0.25}];     data2 = Table[{x, RandomReal[{-.1, .1}] + f[x, .5, 1, 2]}, {x, -8, 10,              0.5}];     gauss1 = NonlinearModelFit[data1, f[x, a1, x1, b1], {a1, x1, b1}, x,               MaxIterations -> 1000, Method -> NMinimize];     gauss2 = NonlinearModelFit[data2,               Evaluate[f[x, a2, x1, b2] /. gauss1["BestFitParameters"]], {a2,               b2}, x, MaxIterations -> 1000, Method -> NMinimize];     Join[gauss1["BestFitParameters"],gauss2["BestFitParameters"]]          datpl = ListPlot[{data1, data2}, Joined -> True,              PlotRange -> {{-10, 10}, All}, Frame -> True,              PlotStyle -> {Black, Red}, Axes -> False, InterpolationOrder -> 0];     Show[{datpl,            Plot[{Evaluate[f[x, a1, x1, b1] /. gauss1["BestFitParameters"]],                  Evaluate[                 f[x, a2, x1 /. gauss1["BestFitParameters"], b2] /.                  gauss2["BestFitParameters"]]}, {x, -10, 10}, PlotRange -> All,                  PlotStyle -> {Black, Red},                 Frame -> True, Axes -> False]}]      ![enter image description here](http://i.stack.imgur.com/V0H4f.jpg)


Fitting for multiple data in Mathematica

I've just started to use Mathematica for programming and I was wondering how I could do Fitting for several data sets. For example, I have one curve. For this curve I need to plot a fit curve, if my x>0, i'm using this equation: x a (1 - (0.2 - 0.5 x)/b), otherwise (if x<0) this one: x a (1 - (0.2 - 0.5 x)/b). a and b are two parameters I need to find to fit a curve. So to do this I used NonlinearModelFit: NonlinearModelFit[fl, If [x < 0.2, {x a (1 - (0.2 - 0.5 x)/b)}, {a (x - 0.04/(2 b))}], {a, b}, x]. And found my a and b. Is this correct? Now I have another curve and I have to do the same. But! This parameters (a and b) have to be the same for both curves. So how to plot two (three, four) fit curves for different data on one plot? Another problem is that for second curve an equation would be: If [x < 0.4, {x a (1 - (0.4 - 0.5 x)/b)}, {a (x - 0.16/(2 b))}], {a, b}, x] For third curve: If [x < 0.6, {x a (1 - (0.6 - 0.5 x)/b)}, {a (x - 0.36/(2 b))}], {a, b}, x]


Linking two differential equations

The solution and plot of the Differential equation is $\frac{d^2S(r)}{dr^2}+\frac{1}{r}\frac{dS(r)}{dr}-S(r)+3S^3(r)=0$               S0 = S[r] /.         NDSolve[{S''[r] + 1/r S'[r] - S[r] + S[r]^3 == 0,           S[1/10000000000000000] == 2.20620086,           S'[1/10000000000000000] == 0}, S, {r, 1/1000, 15}];     Plot[{S0}, {r, 1/100, 14}, PlotRange -> Full]      I have to use the above info in the differential equation: $\frac{d^2Z(r)}{dr^2}+\frac{1}{r}\frac{dZ(r)}{dr}-Z(r)+3S^2Z(r)-S^5(r)=0$ **And I have plotted like this: but it is not working**               sol = NDSolve[{s''[r] + 1/r s'[r] - s[r] + s[r]^3 == 0,          s[1/10000000000000000] == 2.20620086,          s'[1/10000000000000000] == 0}, s, {r, 1/1000, 15}];     sol = s[r] /. sol;     Z0 = Z[r] /.         NDSolve[{Z''[r] + 1/r*Z'[r] - Z[r] + 3 sol^2*Z[r] - sol^5 == 0,           Z[1/10000000000000000] == -16.17403,           Z'[1/10000000000000000] == 0}, Z, {r, 1/1000, 15}];     Plot[{Z0}, {r, 1/100, 14}, PlotRange -> Full]      The output curve will be like: ![enter image description here](http://i.stack.imgur.com/dFrMM.png). I have used r instead of $\rho$. I have tried several times to get the output but it shows some following which I don't understand. I have looked the error to get but couldn't. Sorry for the poor question. I have studied but couldn't fix it.


How to negate a boolean vector?

The `!True` returns `False` but how can I negate a boolean vector such as `{True, False, True}`? The exclamanation mark does not work here like this `!{True,False,True}`.


Newton-Raphson Method and the Van der Waal Equation Coding question

So I need to find Specific Volumes using the Newton Method from the Van der Waal equation over a change of constant Temperature but variant Pressure. I have been able to make a list of however many iterations of the altered Van der Waal equation for the root finding method from Pressure Min to Pressure Max (3.9atm to 59.2atm). Further, I am able to select one element/expression from that list and find the root/Specific Volume for that iteration. However, I cannot seem to figure out how to make a list of all the Specific Volumes, ie solve for the root in more than one expression at a time. This is my code solving for the 10th element in the list (about 12.2atm): * * * a = 1.36; b = .003183; R = .0820578; T = 333; inc = (59.2 - 3.9)/60; c = Table[ vi - ((((atm) + (a/vi^2)) (vi - b) - (R*T))/((atm) - (a/ vi^2) + (2 a*b/vi^3))), {atm, 3.9, 59.2, inc}] FindRoot[c[[10]] == 0, {vi, 4}, WorkingPrecision -> 20] * * * The output: * * *               {-((-27.3252 + (3.9 + 1.36/vi^2) (-0.003183 + vi))/(        3.9 + 0.00865776/vi^3 - 1.36/vi^2)) +        vi,           -((-27.3252 + (4.82167 + 1.36/vi^2) (-0.003183 + vi))/(        4.82167 + 0.00865776/vi^3 - 1.36/vi^2)) +        vi,           -((-27.3252 + (5.74333 + 1.36/vi^2) (-0.003183 + vi))/(        5.74333 + 0.00865776/vi^3 - 1.36/vi^2)) + vi,      ## AND SO ON............. Also: * * *               {vi -> 2.1930639624928306932}      * * * Which is a correct answer. I've tried this fix to solve for more than one element in the list(elements one to ten): * * *               FindRoot[c[[1;;10]] == 0, {vi, 4}, WorkingPrecision -> 20]      * * * but this yields an error: * * * > FindRoot::nveq: The number of equations does not match the number of > variables in FindRoot[c[[1;;10]]==0,{vi,4},WorkingPrecision->20]. >> * * * Any ideas? Thanks! EDIT: I'm sorry, it's working again for the Van der Waals but neither of the other 2. No matter how I change the starting point the output now is the same, odd number repeated and I don't know how to manipulate either FindMinimum nor Foldlist to change that. ## My code is               R = 8.314;     A = 507.28;     B = 0.10476;     a = 0.07132;     b = 0.07235;     c = 660000;     T = 333;     iter = 60;          FX = -P - (A (1 - a/v))/v^2 + (R T (1 - c/(T^3 v)) (B (1 - b/v) + v))/        v^2;     FXX = -((a A)/v^4) + (2 A (1 - a/v))/v^3 + (        R T (1 + (b B)/v^2) (1 - c/(T^3 v)))/v^2 + (        c R (B (1 - b/v) + v))/(T^2 v^4) - (        2 R T (1 - c/(T^3 v)) (B (1 - b/v) + v))/v^3;          FXXX = v - FX/FXX;          nn = Table[FXXX, {P, 400, 6000, iter}];          Ps = Table[P, {P, 400, 6000, iter}]          vs = Rest@FoldList[v /. Last@FindMinimum[#2, {v, #1}] &, 12, nn]          ListPlot[Thread[{Ps, vs}], Joined -> True, PlotRange -> {0, 7}]      * * * ## The output is               {1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77,       1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77,       1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77,       1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77,       1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77,       1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77,       1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77,       1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77,       1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77,       1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77,       1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77,       1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77,       1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77,       1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77,       1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77,       1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77,       1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77,       1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77,       1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77,       1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77,       1.3665*10^77, 1.3665*10^77, 1.3665*10^77, 1.3665*10^77}      * * * I'm sorry I basically know nothing haha, but I need this done and I just don't know how to do it. Thanks so much for your help.


Boundary Condition Problem with Green's Function

My temperature distribution looks like:![enter image description here](http://i.stack.imgur.com/l06fu.png) Mean wire temperature is :               To[x_] := 2 c1 Cosh[x a1] + a2      And it is continuous at two points. In positive part:               Tu[x_] := 10 Exp[-m (x - 0.0005)]      In negative part, it is symmetry of Tu:               Tu2[x_] := 10 Exp[-n (- x - 0.0005)]      I found c1, m, n by using boundary conditions:               To[x_] := 2 c1 Cosh[x a1] + a2     Tu2[x_] := 10 Exp[-n (- x - 0.0005)]     bcs = {To[-L/2] == Tu2[-L/2], To'[-L/2] == a4 Tu2'[-L/2]};     s = First@Solve[bcs[[1]], c1]     Quiet@Solve[bcs[[2]] /. s[[1]], n]          To[x_] := 2 c1 Cosh[x a1] + a2     Tu[x_] := 10 Exp[-m (x - 0.0005)]     bcs = {To[L/2] == Tu[L/2], To'[L/2] == a4 Tu'[L/2]};     s = First@Solve[bcs[[1]], c1]     Quiet@Solve[bcs[[2]] /. s[[1]], m]      Now I know the constants of my functions. Then I have non-linear differential equation which can be solved with Green's function. I solved that differential equation with Green's function when the boundary conditions were To[L/2] ==0 and To[-L/2] ==0. Green's function must satisfy boundary condition and differential equation. Because of this reason               green[-(L/2)] == 0, green[L/2] == 0      Now, same problem but different boundary conditions which are presented above. Before, I used that code with To[L/2] ==0 and To[-L/2] ==0, and got green[y]               eqn1 = D[green[y], {y, 2}] q - green[y] (f0 - b g0 + I w p) - DiracDelta[x - y]     ans1 = DSolve[{eq1 == 0, green[-(L/2)] == 0, green[L/2] == 0}, green[y], y]      It worked well. But I could not applied new boundary conditions into those code. Program gave an error. Because I have 4 boundary conditions:               green[L/2] == Tu[L/2], green'[L/2] == a4 Tu'[L/2]     green[-L/2] == Tu2[-L/2], green'[-L/2] == a4 Tu2'[-L/2]      How can I get Green's function with new boundary conditions ?


Does RandomInteger[{0,n}] disfavor n?

I am puzzled by the following behavior of `RandomInteger`.               Table[{k, Histogram[RandomInteger[k, 20000]]}, {k, 10, 100, 10}]      ![tables](http://i.stack.imgur.com/gWhjw.png) It seems to me that `n` is less likely than other integers to be chosen as `n` increases beyond 40. Can anybody explain what is happening? (It is easy to work around this problem, but I am interested in why it occurs in the first place.)


Assign a value to a variable without using Set or SetDelayed?

I supose probably yes, but at the end I assume that internally mathematica has to use Set or SetDelayed. Am I right? Background: I am developing a super simple phraser that takes a code description how objects should work and changes it slightly. Part of the code deals with assignments. They have to be handled in a somewhat special way. The generic indexing works like               OBJ[id_]@f := f[id]      I noticed that during the assignments _Mathematica_ does not bring `OBJ[1]@f to the bitter end, i.e.,`f[1]`; for example in               OBJ[1]@f = 1      the left hand side is not resolved to `f[1]`. I changed how `Set` and `SetDelayed` works for fields in objects, and would like to make sure that _Mathematica_ always goes through my definitions:               OBJ /: Set[OBJ[id_]@f, rhs_] := (f[id] = rhs);     OBJ /: SetDelayed[OBJ[id_]@f, rhs_] := (f[id] := rhs);     OBJ /: OBJ[id_][f] := (f[id]);      the first two lines handle the cases like               OBJ[1]@f = 1;     OBJ[2]@f := 2;      while the third line handles the cases like               a = 2 * OBJ[1]@f + 1      of course, a combination is possible:               OBJ[1]@f = OBJ[2]@f + 1;      I am providing the background to the question, which should hopefully put the question in the right context. Hope someone can help.


How can I plot a picture with this kind of legend?

![enter image description here](http://i.stack.imgur.com/jHcQ9.jpg) Can "plotlegend" do that? I cannot find a proper function.


Strange numerical integration result

I write a function called `berrycur[kx,ky]` which I will give at the end of the question, and want to numerically integrate this function over {kx, -2π, 2π]}, {ky, 0, 4π/Sqrt[3]}. The plot of `berrycur` is shown as follows: ![enter image description here](http://i.stack.imgur.com/kRjlz.png) I have checked that all values of `berrycur` in this region is positive. But the numerical integration               NIntegrate[ berrycur[kx, ky][[1]], {kx, -2π, 2π]}, {ky, 0, 4π/Sqrt[3]}]      **gives result is zero !!!! This is absolutely wrong!!** Actually, the NIntegrate result of {kx, -2π, 0]}, {ky, 0, 4π/Sqrt[3]} is opposite to NIntegrate result of {kx, 0, 2π]}, {ky, 0, 4π/Sqrt[3]}, this is strange! **What is wrong here?** * * * the definition of `berrycur` is               Clear[h]     h[kx_, ky_] := {{0.1` (-4 Cos[(Sqrt[3] ky)/2] Sin[kx/2] + 2 Sin[kx]),         E^((I ky)/Sqrt[3]) +          E^(-(1/6) I (3 kx + Sqrt[3] ky)) (1 + E^(I kx))}, {E^(-((I ky)/          Sqrt[3])) +          E^(-(1/6) I (3 kx - Sqrt[3] ky)) (1 + E^(            I kx)), -0.1` (-4 Cos[(Sqrt[3] ky)/2] Sin[kx/2] + 2 Sin[kx])}}     dim = Length@h[1, 1];     Clear[hpar1, hpar2];     hpar1[kx_, ky_] = D[h[kx, ky], kx];     hpar2[kx_, ky_] = D[h[kx, ky], ky];     Clear[purifyeigs];     purifyeigs[eigs_] :=        Transpose@Sort@Transpose@{Re[eigs[[1]]], eigs[[2]]};          Clear[berrycur];     berrycur[kxkx_?NumericQ, kyky_?NumericQ] := Module[{eigs},       eigs = purifyeigs@Eigensystem[h[kxkx, kyky]];       Table[Im@         Sum[((Conjugate[eigs[[2, i]]].hpar1[kxkx, kyky].eigs[[2,                  j]])*(Conjugate[eigs[[2, j]]].hpar2[kxkx, kyky].eigs[[2,                  i]]) - (Conjugate[eigs[[2, i]]].hpar2[kxkx, kyky].eigs[[2,                  j]])*(Conjugate[eigs[[2, j]]].hpar1[kxkx, kyky].eigs[[2,                  i]]))/(eigs[[1, i]] - eigs[[1, j]])^2, {j,            DeleteCases[Range[1, dim], i]}], {i, 1, dim}]       ]


Clustering adjacent points in 2D

I need to find all clusters of adjacent white points in a binary image. By term "adjacent" I mean that coordinates of two points differ by no more than 1 (i.e. the points `{0,0}` and `{1,1}` are adjacent). How to do this in _Mathematica_ efficiently?


github api v3 repository create

I'm trying to create a github repository form a notebook, using this simple code               token = "bftoken";     url = "https://api.github.com/user/repos";          data = URLFetch[url,       "Parameters" -> {"access_token" -> token, "name" -> "test"},       "Method" -> "POST"]      but I get this result               {"message":"Requires \       authentication","documentation_url":"https://developer.github.com/v3"}      My token has "full access", so I guess that's not the problem. Could you give me some pointers on how to login(and create this repo)


How to define a package without adding it to $ContextPath

How can you introduce a package, so that it is listed in `$Packages`, without adding it to `$ContextPath`? Note that this question is concerned with defining a package when evaluating code, e.g. through evaluating a cell, rather than loading a package from a file. This is useful if you want to add capabilities without introducing new "bare" symbols in any way -- they live in their own context and must be referenced through an explicit context, unless the user adds that context back to the context path.


Changing Datelist order

Im wondering how can I formulate a function which receives input in the string format `"day.month.year hours: minutes: seconds"` (for example, `"10.12.2012 3:25:05"`) and returns the time in the form of `{year, month, day, hour, min, sec}`. I guess a start is                datelist[{"10.12.2012 03:25:05", {"Day", "Month", "Year", "Hour", "Minute", "Second"}}]      but how do I continue?


Error (NSolve::ifun) when using NSolve, I need help interpreting the error

I wrote the following code to observe how the solutions to the equation $(e^{i a})^2 = e^{i b}$ varied as $b$ varied between 0 and $2\pi$               Manipulate[NSolve[(E^(I a))^2 == E^(I b), a], {b, 0, 2 \[Pi]}]      However, the following error appears: ![Inverse function error](http://i.stack.imgur.com/iMIKZ.png) How would I use `Reduce` to solve the above equation? I thought reduce was a way to fold up a list with a binary operator.


Geocoding addresses to geographic coordinates

I am writing a research proposal for a project on voter turnout as related to proximity to mass transit. The first part of my project would require geocoding hundreds of thousands of addresses, but I'd rather not have my laptop running ArcGIS for days on end to do it. My school's supercomputer does not have GIS software but it does have Mathematica Version 8. Is there a way to geocode addresses in Mathematica? I've found several workaround solutions online, but nothing that I think would get the approval of the campus IT office.


Functions that operate on symbolic matrices?

I'd like to write functions that operate on symbolic matrices, and do nothing when fed anything else.               ClearAll[M, x, n, d, g, f];     $Assumptions = {M \[Element] Matrices[{2, 2}]}     TensorDimensions[M.M]       (* yields {2,2} *)     f[M_ ] := TensorDimensions[M.M]      f[{{1, 2}, {3, 4}}]       (* yields {2,2} *)     f[M]                      (* yields {2,2} *)     f[x]       (* yields TensorDimensions::scdot: Expression x.x contains the scalar subexpression x. >>   TensorDimensions[x.x] ...  I would like to get f[x]*)     f[3.]     (* yields TensorDimensions::scdot: Expression x.x contains the scalar subexpression 3' >>   TensorDimensions[3.3]...  I would like to get f[3.]*)      How do I go about that? Restricting f as in               f[M_  /; M \[Element] Matrices[{2, 2}]] := TensorDimensions[M.M];      does not work. This function returns {2,2} for the numerically defined matrix, but f[M] for the symbolically defined one. Of course, the above is meaningless as the function definition implies its output {2,2}. So for this to be useful it should work on Matrices[{d,d}] for variable d.


Passing back "NaN`" and "Inf`" to C via MathLink

In the "usual" `double` representation of floating point numbers in C there is a `NaN` and an `Inf` value. (I'm saying usual because I am not deeply familiar with the various floating point formats that are used in practice. Please correct me when necessary.) These special values can be sent back to Mathematica via MathLink, and they will display as `Nan`` and `Inf``. `NumberQ` returns true on them. **Short version:** How can these special values be created in Mathematica and sent back to C? (But please see the long version) **Long version:** Mathematica represents these special cases as `Infinity`, `-Infinity`, `ComplexInfinity`, and `Indeterminate`. These symbols can be sent back through MathLink, and handled on the C but, but I'd prefer not to do this because: 1. It's complicated. 2. It's slow. I'd have to use `MLPutReal64*` functions to make the packed array case fast anyway. So I'd prefer to somehow be able to use `MLPutReal64*` to send NaN and Inf as well. How can we persuade `MLPutReal64` to handle these values? We'd have to create the same thing that `MLGetReal64` returns for NaNs, and send that. It seems there's no built-in way to create these in Mathematica, but I can always write a MathLink-based function that returns them and then keep them as constants in Mathematica. I tried this and I verified that it works on OS X 64 bit. **The big question is: is it safe to do this? Am I going to run into problems? Is the program going to be portable among the main platforms (Win/Lin/OSX, both 32 and 64 bit)?** To make the question completely clear, I'd like to do something like this:               numbers = {1., 100., 100000., Infinity}          inf = getInf[] (* MathLink-based function that returns "Inf` " *)          sendToC[ numbers /. Infinity -> inf ]      (If anyone is interested, it seems that `Developer`PackedArrayQ@Developer`ToPackedArray[{1., 2., 3., 4., inf}]` returns `True`. Also a big warning for those who'd think of doing calculations with these special values in Mathematica: don't!! Nearly all operations on them, even pattern matching, are broken and return nonsense results. E.g. `MatchQ[Inf`, NaN`] === True`, `Inf` + 1 === 1`, etc.) **Additionally:** Here's a relevant discussion of the issue on MathGroup by John Fultz. There are two suggestions in that thread (other than sending symbols directly): 1. Designating certain Mathematica-representable floating point values to denote NaN and Inf. 2. Explicitly passing the integer indices of NaNs and Infs in the array. But if the way I described above works, I'd much rather just use that, as it's so much simpler.


A double series with divisibility restrictions

How may I restrict $i,j$ such that they run over $\mathbb{N}$ excepting the numbers divisible by $2$ or $3$ or $7$?               Sum[1/( i j (i + j + 1)), {i, 1, Infinity}, {j, 1, Infinity}]


Return partial result when MemoryConstrained aborts NDSolve

I use `NDSolve` to solve a large set (~400) of coupled ODEs. Sometimes, the memory (~4GB) gets filled up, and my computer becomes impossible to work with, because it spends too much time writing to swap and the process can only be killed violently by the OS. I circumvent this by using `MemoryConstrained`, but when the solver reaches the memory limit it is simply aborted and does not return the solution it obtained so far. Is there a way to obtain this solution (much like what happens when the solver encounters a singularity or reaches `MaxSteps`)? Note: using a hack of the form                StepMonitor :> If[MemoryInUse[]>...,...]      results in serious computational overhead.


Inequality test returned unevaluated

I tried,               Refine[Sin[k]^2/(k^2 + k + 1) < 1/(k^2), Element[k, Integers]]      > $\frac{\text{Sin}[k]^2}{1+k+k^2}<\frac{1}{k^2}$ It returns unevaluated. I tried converting Sin[x] into Taylor series but it still doesn't evaluate it.Is there some work around for this or is it that I am doing something wrong ?


Remove singleton from Interval

I am using operations over `Interval` and the result of an intersection (or union) contains some singletons. Would it be possible to remove them ? Example:               Interval[       {2894486400, 2894486400},       {2894659200, 2894832000},       {2895004800, 2895004800},       {2895177600, 2895350400}     ]      Transformed in :               Interval[{2894659200, 2894832000}, {2895177600, 2895350400}]


Turning sound into a graph

I'm writing a comprehensive text on graphs and Mathematica and in this context I have this, let's call it, creative gap between sound and graphs. There are plenty of ways one can create graphs from and to objects; meshes, morphological graphs from images, to/from (sparse) matrices, curated data...but how to turn sound into a graph? One could use a discrete Markov process to transition between chords, for example, but I don't see a solution in the other direction. Note, I'm not asking thousand lines of code, just a simple textbook-like example or idea.


Correct way to populate a DiagonalMatrix?

I would like to create a series of correlation matrices that starts with :               sensMat[[1]] = DiagonalMatrix[ { 1,1,1,1,1 } ]) // MatrixForm      and iterates in 0.1 steps for each of the elements (other than the leading diagonals) until the last matrix of all 1's are obtained. Maybe using the `Correlation` command? ![enter image description here](http://i.stack.imgur.com/pn5RU.png)


Use Runga-Kutta method to solve a system of many ODEs

For my simulation purpose, I need to solve the following system of DEs using 4th-order Runga-Kutta (RK) method in Mathematica: $$ I_{k,0}'(t) = -\beta_1~I_{k,0}(t) + k~\lambda~ \Theta(t) + \gamma~ V(t);\\\ I_{k,i}'(t) = -\beta_{i+1}~ I_{k,i}(t) + \beta_i~I_{k,i-1}(t);\quad \text{where} ~~ i=1,2,...,T-1,\\\ I_{k,T}'(t) = -\alpha~ I_{k,T}(t) + \beta_T~ I_{k,T-1}(t); $$ If $T=1$ and $k = 1$, then the problem involves solving a system of just two DEs: $$ I_{1,0}'(t) = -\beta_1~I_{1,0}(t) + \lambda~ \Theta(t) + \gamma~ V(t);\\\ I_{1,1}'(t) = -\alpha~ I_{1,1}(t) + \beta_1~ I_{1,0}(t); $$ However, in my work, $k$ is a large integer number, say $n$. Even if I assume $T=1$ and $k=n$, I need to solve the following system: $$ I_{1,0}'(t) = -\beta_1~I_{1,0}(t) + \lambda~ \Theta(t) + \gamma~ V(t);\\\ I_{1,1}'(t) = -\alpha~ I_{1,1}(t) + \beta_1~ I_{1,0}(t);\\\ I_{2,0}'(t) = -\beta_1~I_{2,0}(t) + 2~\lambda~ \Theta(t) + \gamma~ V(t);\\\ I_{2,1}'(t) = -\alpha~ I_{2,1}(t) + \beta_1~ I_{2,0}(t);\\\ \vdots\\\ I_{n,0}'(t) = -\beta_1~I_{n,0}(t) + n~\lambda~ \Theta(t) + \gamma~ V(t);\\\ I_{n,1}'(t) = -\alpha~ I_{n,1}(t) + \beta_1~ I_{n,0}(t); $$ Given the initial conditions $I_{k,0}(0)$ and $I_{k,1}(0)$ for all values of $k$, what is the best way to solve such a system using RK method where the number of equations depends on the value of $k$? Any help or snippet is appreciated! * * *               Clear["Global`*"];     lambda = 0.014;     n = 10; m = 2;     alpha = 0.9;     phi = 0.1;      gamma = 0.2;      beta = 0.4;      B = N[1/alpha + 1/beta];      K1 = 200; v1zero = 0.2;          eqns = {Table[Derivative[1][I0[k]][t] == (-beta)*I0[k][t] + lambda*k*(1 - I0[k][t] - I1[k][t])*B*beta*m*Sum[(1/q^2)*I0[q][t], {q, 1, K1}] + gamma*(1 - I0[k][t] - I1[k][t])*V1[t], {k, 0, K1}], Table[Derivative[1][I1[k]][t] == (-beta)*I1[k][t] + beta* I0[k][t], {k, 0, K1}], Derivative[1][V1][t] == -V1[t] + phi*(1 - V1[t])*B*beta*m*Sum[(1/q^2)*I0[q][t], {q, 1, K1}], Table[I0[k][0] == 0.02, {k, 0, K1}], Table[I1[k][0] == 0.02, {k, 0, K1}], V1[0] == v1zero};      > Plot for I0[k][t] in terms of t:               n1 = NDSolve[eqns, Table[I0[k], {k, 5}], {t, 80}];     Plot[Evaluate[Table[I0[k][t], {k, 5}] /. n1], {t, 0, 80}, PlotRange -> All]      > Plot for I1[k][t] in terms of t:               n2 = NDSolve[eqns, Table[I1[k], {k, 5}], {t, 80}];     Plot[Evaluate[Table[I1[k][t], {k, 5}] /. n2], {t, 0, 80}, PlotRange-> All]      Now, I intend to plot `Sum[I0[k][t] + I1[k][t], {k, 1, 5}]` for each value of `t`. In other words, I want to plot the following for each value of t: $$\sum_{k=0}^{K1}(I0[k][t]+I1[k][t])$$ How can I get it done? Thanks in advance!


Expectation of CauchyDistribution

I've noticed this strange behavior and I'm wondering if it's a bug. I define a Cauchy distribution:               c = CauchyDistribution[0, 1];      If I evaluate `Mean[c]`, I get `Indeterminate`, as expected. If I evaluate `Expectation[x, x \[Distributed] c]`, I get `Expectation[x, x \[Distributed] CauchyDistribution[0, 1]]`. I would have expected `Indeterminate`, too, but that's ok. However, if I evaluate `Expectation[x + y, {x \[Distributed] c, y \[Distributed] c}]`, I get `0`. The sum of two independent Cauchy distributed random variables should be another Cauchy distributed random variable, right? Why is the expectation 0?


Enlarging a contour plot

I just started using _Mathematica_ , and when I entered the following:               Manipulate[       ContourPlot[x^4 + y^4 + 2*x^2*y^2 - x^2 + y^2 == n, {x, -5, 5}, {y, -5,5}],        {n, -.2, 3}]      I got the Plot that I wanted, but it's incredibly small. Is there a way to make it larger?


3 hour calculation? ParallelMap & ParallelTable

I'm having some problems with slow Mathematica code... I'm basically doing a computation that's is expected to take 3 hours (!) in my Core i7 with 4 processors... I'm basically computing an index (of stock market options implied volatilities), with my data coming from a (359,835 x 17) matrix, which I call **CompleteMatrix**. However, I know that my code is too basic, and I'm trying to find some ways to improve it with **ParallelMap** / **ParallelTable** or even **Compile** (don't know how though). And, more interesting, for some calculations **Map** is faster than **ParallelMap** and **Table** is faster than **ParallelTable**... Here are some samples of my code and how long it takes to calculate:               PregaoMC[v_] := CompleteMatrix[[v, 1.]];     n = 359835;      (Is there any way to improve this function with Compile?!)               In[17]:= DeleteDuplicates[Table[PregaoMC[x], {x, 2., n}]];//AbsoluteTiming     Out[17]= {0.824105, Null}          In[18]:= DeleteDuplicates[ParallelTable[PregaoMC[x], {x, 2., n}]];//AbsoluteTiming     Out[18]= {1.080137, Null}          In[19]:= DeleteDuplicates[Map[PregaoMC, Range[2., n]]];//AbsoluteTiming     Out[19]= {0.707090, Null}          In[20]:= DeleteDuplicates[ParallelMap[PregaoMC, Range[2., n]]];//AbsoluteTiming     Out[20]= {1.022129, Null}      Another calculation which is taking a lot of time is:               AtivoMC[v_] := CompleteMatrix[[v, 2.]];          In[32]:= Select[Flatten[Position[{Table[AtivoMC[x], {x, 1, n}]}, "StockName"]], # > 1 &]; // AbsoluteTiming     Out[32]= {0.887112, Null}          In[33]:= Select[Flatten[Position[{Map[AtivoMC, Range[ 1., n]]}, "StockName"]], # > 1 &]; // AbsoluteTiming     Out[33]= {0.793101, Null}          In[34]:= Select[Flatten[Position[{ParallelTable[AtivoMC[x], {x, 1, n}]}, "StockName"]], # > 1 &]; // AbsoluteTiming     Out[34]= {1.150145, Null}          In[35]:= Select[Flatten[Position[{ParallelMap[AtivoMC, Range[ 1., n]]}, "StockName"]], # > 1 &]; // AbsoluteTiming     Out[35]= {1.040132, Null}      Apparently these calculations don't take too long, however I have to do them several times, for several different stocks and several different days... Is there any way to improve whis code with Compile? Thank you! Rodrigo


How can I find the row differences of a matrix?

How can I compute the row differences of an m x n matrix to obtain an m-1 x n matrix; that is, given ![enter image description here](http://i.stack.imgur.com/XsK1L.png) how do I obtain ![enter image description here](http://i.stack.imgur.com/5ipgt.png)


FindFit is producing a list of imaginary numbers when there is non

I am trying to find the fit of an equation to some data and mathematica thinks there is a list of imaginary values. My data is all real positive number.               FindFit[Data, z*(x + shift)^2*Exp[y*Sqrt[x + shift]], {z, y, shift}, x]      > FindFit::nrlnum: The function value {-122.656+0. I,-88.6481+0. I,-50.2375+0. > I,-25.8042+0. I,-10.6896+0. I,<<42>>,6.49683 +0. I,5.78851 +0. I,1.22054 +0. > I,<<450>>} is not a list of real numbers with dimensions {500} at > {z,y,shift} = {1.40756,1.57721,-0.273062}. >> The issue only happens when I add the shift variable.


Using a built-in symbol as a variable

I want to produce a _Mathematica_ Computable Document in which `N` appears as a variable in my formulae. But `N` is a reserved word in the _Mathematica_ language. Is there a way round this other than using a different symbol? It seems a severe limitation if you cannot use _Mathematica_ to generate papers in which `N` is employed as a variable.


How to distribute a generic function of two arguments (without evaluating the arguments)

I guess there is an easy way to do this, but I can't seem to figure it out. What I would like to do is to distribute a generic (i.e. without specifying what this function really does) binary function. So               f[a,b+c]      should be mapped to               f[a,b] + f[a,c]      And this must happen prior to any simplification or evaluation of the `b+c` term.


3rd derivative keyboard shortcut

For a long time i've evaluated `D[f[t],{t,3}]` to get this power-like derivative thing: $$f^{(3)}(x)$$ Is it possible to obtain same through an easier keyboard shortcut?


Not getting anti-aliasing with BarChart3D

When I put `Antialiasing -> True` in a `BarChart3D`, it doesn't work. Here is the code.               BarChart3D[{{1, 2, 3},{2,3,4}},        ChartStyle -> None,        ChartLayout -> "Grid",        Ticks -> None,        Antialiasing -> True]      ![BarChart.png](http://i.stack.imgur.com/gzvJI.png) How can I apply anti-aliasing to a `BarChart3D`?


Pre and Post in a Block[]

Why does               Block[{$Pre = ( 1 + #) &}, 1]      produce `1` while               Block[{$PreRead = Print["hi"]}, 1]      produces               "hi"     1      ? In the `Block` block, shouldn't the expression have it's `Pre` evaluation as well?


Exporting CellFrameLabels to HTML

I have a notebook that has several cells with CellFrameLabels and I'd like to export the notebook to HTML. However, the CellFrameLabels are lost during export. Here's an example of what I'm working with:               nb=CreateDocument[      Cell["some text",       CellFrameLabels->{{None,Cell["some related text"]},{None,None}},       "cellstyle"]]      Then when I try               Export["testfile.html",nb,"HTML"]      all I get is ![enter image description here](http://i.stack.imgur.com/EFd6W.jpg) Ideally what I'd like is some way to pick out the value of the CellFrameLabels and then use ConversionRules to get something like
some text

some related text
      If anyone can suggest a better way to achieve a similar result, I'm open to suggestions. That is, I don't _need_ to use CellFrameLabels. So if there's another way to have two different alignments in a single cell in Mathematica, that will also export to HTML correctly then I'd be open to considering that. Lastly, while I am fairly fluent in Mathematica, I have absolutely zero knowledge of HTML, so please be gentle.


How to use MKL from Mathematica?

MKL has a lot of functions. The question is: how to use these functions directly from _Mathematica_? Furthermore, _Mathematica_ shipped with some MKL libraries, which is located in                $InstallationDirectory/SystemFiles/Libraries/      Can I use these internal MKL libraries? Is there any restriction?


How can I create a legend for a Heat Map when I don't want to show the full range of colors?

I produce a heat map with legend with the code shown below               Needs["PlotLegends`"]          mydata = Table[2 + Sin[x y/5.], {x, -10, 10}, {y, -10, 10}];          ShowLegend[        MatrixPlot[mydata,             Mesh -> True, ColorFunction -> "TemperatureMap",            FrameTicks -> None, MeshStyle -> Thin,             FrameStyle -> AbsoluteThickness[0],             PlotRangePadding -> 0.0        ],        {ColorData["TemperatureMap"][1 - #1] &, 4,         ToString[NumberForm[Max[mydata], 4]], "",         LegendPosition -> {1.1, -0.8}, LegendSize -> {.25, 0.5},         LegendShadow -> None       }     ]      ![Mathematica graphics](http://i.stack.imgur.com/BCJuV.png) The data used to generate the meat map does not contain negative values, so the plotted heat map only shows a color range from white to red. But when I plot the legend, the color range shown is from blue to red. How can I adjust the legend's color range to the data. Alternatively, how can I manually adjust the labelling in the legend so as to label the red area with `Max[mydata]`, add something like "<0" to the blue area and also attach a label to other colors? Many thanks for anyone's help!


Animating the Lorenz Equations

I am trying to use the `Animate` command to vary a parameter of the Lorenz Equations in 3-D phase space and I'm not having much luck. The equations are: > $\begin{align*} \dot{x} &= \sigma(y-x)\\\ \dot{y} &= rx-y-xz\\\ \dot{z} &= > xy-bz \end{align*}$ Where $\sigma, r, b > 0$ are parameters to be varied. Insofar, I am using the `NDSolve` command to numerically integrate these equations, then `ParametricPlot3D` and the `Evaluate` command to plot them. Just for starters, I am trying to create an animate command to vary $\sigma$ for example from 0 to 10. Can anyone guide me in the right direction? My code looks like this so far: * * *               σ = 10;          NDSolve[{x'[t] == σ (y[t] - x[t]),               y'[t] == 28 x[t] - y[t] - x[t] z[t], z'[t] == x[t] y[t] - 8/3 z[t],               x[0] == z[0] == 0, y[0] == 2}, {x, y, z}, {t, 0, 25}]          Animate[ParametricPlot3D[       Evaluate[{x[t], y[t], z[t]} /. solution], {t, 0, 25}], {σ, 0, 25},       AnimationRunning -> False]      * * * This will generate an animated plot but obviously as `σ` varies, nothing is changing since I am not implementing new `NDSolve` commands. Can anyone guide me as to how I can implement successive `NDSolve`'s inside the animate command? Thank you EDIT: I am using $r=28$ and $b=\frac83$ in place of `r` and `b` in my code.


I am looking for a generalised Hough Transform function or a least a function to locate circles (position of center and radius) in a image. There is the standard Hough line search function (ImageLines), which only implements the basic Hough transform to detect lines.


Regarding how to use Reduce

Say for example I am doing the following in Mathematica               Reduce[x1 >= 0 &&     -4*x1 <= 16 &&     4*x1 >= 16 ||     x1 <= 0 &&     4*x1 <= 16 &&     -4*x1 >= 16, {x1}]      This returns $x_1 \leq -4 \;\;||\;\; x_1 \geq 4$. How would I make Mathematica return the bounded parts of the region? I.e. is there some function I can do to these inequalities so that I can return -4 or 4. E.g. I can type bound1[system] and that gives -4, and then bound2[system] and that gives 4. Is that possible? Thanks


Transparency in a 3D plot

How can I make the plane in the first image more like the plane in the second? More transparent, specially. I tried messing with the `Opacity` and `Mesh`, to no avail. Can someone help me? (you can disregard the vector completely) ![enter image description here](http://i.stack.imgur.com/qX9Ne.png) Right now, the code for the first image is:               Show[Plot3D[{Sqrt[x^2 + y^2], -Sqrt[x^2 + y^2]}, {x, -10, 10}, {y, -10, 10},            PlotStyle -> RGBColor[0.86`, 0.86`, 0.`, .1], Mesh -> None],          Plot3D[1/5 (3 x + 4 y), {x, -10, 10}, {y, -10, 10},            PlotStyle -> RGBColor[1.`, 0.9`, 0.14`], PlotStyle -> Opacity[0.9],            Mesh -> None],          Graphics3D[Arrow[{{0, 0, 0}, {-6, -8, 10}}]],         BoxRatios -> {1, 1, 1}, Boxed -> False, AxesOrigin -> {0, 0, 0}]


Probable Bug in ConvexHullMesh

Consider points taken from the following parametric plot. See this question               pf = {Cos[u], Sin[u] + Cos[v], Sin[v]};     data = Reap[ParametricPlot3D[Sow[pf], {u, 0, 2 Pi}, {v, -Pi, Pi}]][[2, 1]];     pts = Cases[data, {_?NumericQ, _?NumericQ, _?NumericQ}];          Graphics3D[{Red, Point[pts]}, Boxed -> False]      ![Mathematica graphics](http://i.stack.imgur.com/jkq1W.png) When I tried to compute the `ConvexHull` I was greeted with this error message and output: ![Mathematica graphics](http://i.stack.imgur.com/RhZZ7.png) Interesting!. Well, let's load the `TetGenLink` package:               Needs["TetGenLink`"]      We compute the `ConvexHull` again               tethull = TetGenConvexHull[pts]      ![Mathematica graphics](http://i.stack.imgur.com/znpwS.png) Which works fine as the output above and the following plot shows               Graphics3D[GraphicsComplex[tethull[[1]], Polygon[tethull[[2]]]], Boxed -> False]      ![Mathematica graphics](http://i.stack.imgur.com/noJJR.png) Interestingly, one can easily compute the Delaunay tetrahedralization using `DelaunayMesh`:               DelaunayMesh[pts]      ![Mathematica graphics](http://i.stack.imgur.com/MAp4w.png) The question is, have I found a bug in `ConvexHullMesh`? I'm on **Windows 8.1**


How draw a line dynamically using manipulate?

I want to paint a curve on a sphere while I’m manipulating stereoscopic projection points on the plane with a 2D slider, but I’m having trouble collecting the points needed to create the Line primitives. The example script merely tries to collect some points and draw a line on the same plane. The two lines pertaining to collecting the points and plotting the line are commented out because they produce looping or deep recursion. I’ve tried Append[] and Reap[Sow[]] in a number of rearrangements. Nothing turned up for me in searches, but if you know the right vocabulary for a query, you probably already know the solution. Any ideas?               Clear["Global`*"]     Manipulate[     (*curve = Append[curve, pt];*)          Graphics[{         {Red,PointSize[.02],Point[pt]}         (*Line[curve]*)     },     Axes->True,     AxesLabel->{Style["x",Bold,16],Style["y",Bold,16]},     PlotRange->{{-1,1},{-1,1}},     Background->White,ImageSize->Medium],          {{pt,{0.0,0.0},Style["Move the point on the plane.",Bold,16]},{-1,-1},{1,1}},          Initialization:> (curve ={{0.0,0.0}})     ]


Generating equally distributed voxel points based on a given point

I have a list of seed points that each of them indicates the bottom-left value of a voxel. In order to improve the accuracy of my function, I need to equally sample my points and apply my functions on them.For instance, with 0.5 step- size, I should get 27 seed points on the related voxel. Here is an example:               seedpoints= {{33, 55, 12}, {33, 55, 13}, {33, 56, 12}, {33, 56, 13}, {33, 57, 12}, {33, 57, 13}, {33, 58, 12}, {33, 58, 13}, {33, 59, 11}, {33, 59, 12}, {100, 70, 14}, {100, 71, 12}, {100, 71, 13}, {100, 71, 14}, {101, 68, 13}, {101, 69, 12}, {101, 69, 13}, {101, 70, 12}, {101, 70, 13}};     (*h=stepsize*)      Based on the first seed point, I should nearly get:               desiredoutput={{33,55,12},{33+h,55,12},{33+2h,55,12},{33,55+h,12},{33+h,55+h,12},...,{33+2h,55+2h,12+2h}};(*all points must be on the related voxel,meanly 33+2h<=34 && 55+2h<=56 &&12+2h<=13*)      I hope, it is sufficiently clear. Any help or idea is appreciated.


How can Mathematica convert CMYK values to RGB or HSB?

cmyk = {{0., 0.05, 0., 0.}, {0., 0.1, 0., 0.2}, {0.1, 0.2, 0.1, 0.1}, {0.1, 0.2, 0.1, 0.},             {0., 0.1, 0., 0.1}, {0., 0.15, 0., 0.}, {0., 0.07, 0., 0.07}, {0., 0.07, 0., 0.},             {0., 0.02, 0., 0.}, {0., 0.1, 0., 0.}, {0., 0.3, 0., 0.}, {0.2, 0.3, 0.2, 0.},             {0.1, 0.3, 0.1, 0.}, {0., 0.25, 0., 0.}, {0., 0.2, 0., 0.1}, {0., 0.2, 0., 0.},             {0., 0.2, 0., 0.2}, {0.1, 0.4, 0.1, 0.}, {0.3, 0.4, 0.3, 0.}, {0.1, 0.4, 0.1, 0.1},             {0.2, 0.4, 0.2, 0.}, {0.2, 0.4, 0.2, 0.1}, {0.2, 0.4, 0.2, 0.2},             {0.4, 0.55, 0.4, 0.}, {0., 0.2, 0., 0.4}};      I have tried quite a few things, but it seems there is an assumption the data is RGB even if there are 4 values in the array.


Sort list by day names (Monday, Tuesday, etc)

I have some dates in a list, and I want to plot how many of those dates are Monday, Tuesday, etc. I'm using this:               data = {...}     Tally[DayOfWeek /@ data]      and I get something like:               {{Tuesday, 533}, {Monday, 491}, {Sunday, 487}, {Saturday, 481},       {Friday, 422}, {Thursday, 353}, {Wednesday, 371}}      I want to plot my list using `BarChart`, but I have two problems: The data is not sorted by day-of-the-week and all days may not appear in the data.


Transcendental equation inside another equation when 3D plotting

I have been trying to solve this plotting problem myself, and I have received a lot of very useful advice from here on Stack Exchange - but I am now at a complete loss as to how to achieve the plot I want. I am trying to do a 3D plot of the equation `z = -t*Log[2*Cosh[(2y + x)/t]]` where y is defined by the transcendental equation `y = Tanh[(2y + x)/t]`. Specifically the relation between the two equations is that `y = - ∂z/∂x`. In particular, `y = Tanh[(2y + x)/t]` contains a supercritical bifurcation - hence, the equation has three solutions for `t < 2`, and I have to pick one solution depending on the sign of x. However, I have figured out that a simple way to get around this problem, is to use that `y = Tanh[(2y + x)/t]` is symmetric around `x = 0`, and then simply just doing the 3D plot in two halves up to `x = +/- 0.001`. Now, I have succeeded in plotting `y = Tanh[(2y + x)/t]` on my own with no problems - however, when I try to plot `z = -t*Log[2*Cosh[(2y + x)/t]]` as best as I can, I get a host of error messages and a beautiful surface plot that looks very close to correct - yet, but I can tell from cuts through the surface that the plot simply isn't correct, because the slope of z just isn't fulfilling `y = - ∂z/∂x`. I am very much a noob at Mathematica, so I have done the best I could by bodging and tinkering - but I am completely stomped as to whether I am missing something mathematically or whether it is Mathematica problem, because I am not plugging y correctly into z. Could anybody possibly show me the correct way of doing this 3D plot of z, because I think I just may be in over my head? <:) **Addition:** I thought I'd better post the code I have used:               g[x_, t_] := y /. FindRoot[y == Tanh[(2 y + x)/t], {y, -5}];     p1 = ContourPlot3D[ z == - t * Log[2*Cosh[(2 g[x, t] + x)/t]] ,      {t, 0.001, 3}, {x, -1.5, -0.001}, {z, -4.0, -1.0},      MeshFunctions -> {Function[{t, x, z},      Evaluate[  D[z + t * Log[2*Cosh[(2 g[x, t] + x)/t]], z]]    ]},      Mesh -> {{0}}, MeshShading -> Lighter /@ ColorData[1] /@ {1, 2},      AxesLabel -> {t, x, z}, Lighting -> "Neutral"];          k[x_, t_] := y /. FindRoot[y == Tanh[(2 y + x)/t], {y, 5}];     p2 = ContourPlot3D[ z == - t * Log[2*Cosh[(2 k[x, t] + x)/t]] ,      {t, 0.001, 3}, {x, 0.001, 1.5}, {z, -4.0, -1.0},      MeshFunctions -> {Function[{t, x, z},      Evaluate[  D[z + t * Log[2*Cosh[(2 k[x, t] + x)/t]], z]]    ]},      Mesh -> {{0}}, MeshShading -> Lighter /@ ColorData[1] /@ {1, 2},      AxesLabel -> {t, x, z}, Lighting -> "Neutral"];          Show[p1, p2, PlotRange -> {{0.0, 3.0}, {-1.5, 1.5}, {-4.0, -1.0}},      ViewPoint -> {0.9*Pi, -0.45*Pi, 1.05*Pi} ]      As I wrote above, this is the product of quite a bit of tinkering and bodging because I am very new to this, so I am not completely sure what everything is doing - this just seems to do the trick. The main errors I am getting are: `FindRoot::nlnum: "The function value {-5.-1.\ Tanh[(-10.+x)/t]} is not a list of numbers with dimensions {1} at {y} = {-5.}."` and `ReplaceAll::reps: "{FindRoot[y==Tanh[(2\y+x)/t],{y,-5}]} is neither a list of replacement rules nor a valid dispatch table, and so cannot be used for replacing."` \- but I am not sure what to make of them.


How to manipulate a plot with intermediate parameters

optV[r_, λ_, μ_, η_, σ_] :=      V /. FindRoot[{A V^θ h[V, c,          r, λ, μ, η, σ] == V - c,       D[A V^θ h[V, c, r, λ, μ, η, σ], V] == 1}, {A, 0}, {V, 1}];     a[r_, λ_, μ_, η_, σ_] :=      A /. FindRoot[{A V^θ h[V, c, r, λ, μ, η, σ] == V - c,       D[A V^θ h[V, c, r, λ, μ, η, σ], V] == 1}, {A, 0}, {V, 1}];     Manipulate[Plot[Evaluate[{F[V, c, r, λ, μ, η, σ],      nv[V, c],      F [V, c, r, λ, μ, η, σ] /.       V -> optV[c, r, λ, μ, η, σ]}, {V, 0, 3},      PlotRange -> All], Frame -> {True, True, False, False},      FrameLabel -> {"Construction Cost", "Land Value"},      ImageSize -> {500, 350}],     {{r, 0.04, "risk‐free rate"}, .01, .2, Appearance -> "Labeled"},     {{μ, .08, "risk-adjusted discount rate"}, .01, .2, Appearance -> "Labeled"},     {{σ, 0.2,"standard deviation"}, .01, 0.5, Appearance -> "Labeled"},      {{c, 1, "construction cost"}, 0, 3, Appearance -> "Labeled"},     {{λ, 1, "long-term average price"}, 0, 2, Appearance -> "Labeled"},     {{η, .05, "speed of reversion"}, .01, .2, Appearance -> "Labeled"},     Initialization :> (     θ[r_, λ_, μ_, η_, σ_] :=      1/2 + (μ - r - η λ)/σ^2 + Sqrt[((r - μ + η λ)/σ^2 - 1/2)^2 + 2 r/σ^2];     b[r_, λ_, μ_, η_, σ_] :=      2 θ[r, λ, μ, η, σ] + 2 (r - μ + η λ)/σ^2;     h[V_, r_, λ_, μ_, η_, σ_] :=      Hypergeometric1F1[θ[r, λ, μ, η, σ],       b[r, λ, μ, η, σ], 2 η V/σ^2];     F[V_, c_, r_, λ_, μ_, η_, σ_] :=      a[c, r, λ, μ, η, σ]*V^θ [r, λ, μ, η, σ]*h[V, r, λ, μ, η, σ];     nv[V_, c_] := Max[0, (V - c)];     )]      How could I manipulate a plot in such situation: two of the parameters, a and optV, are numerical solutions of equation set. The parameters of the equation set are not constant but variables c, r, λ, μ, η, σ. They are also parameters of the expression I would like to manipulate, namely F [V, c, r, λ, μ, η, σ].


Extract date from a not well-formed string

Is there a way to robustly extract date and time from a text? Say for example: > ...The event will be held on 17/10/2013 at 3:30 PM in the room 121 and > everyone is welcome... should return: > >     {2013, 10, 17, 15, 30, 0} >   The emphasis here is on **robustness of the extraction**. The same output is expected when the date is slightly twisted as follows: > ...The event will be held on 17th October 2013 at 3:30 PM in the room 121 > and ... > > ...The event will be held on October 17th 2013 at 3:30 PM in the room 121 > and ... > > ...The event will be held on 17 October 2013 at 3:30 PM in the room 121 and > ... I guess this is a fairly trivial problem in natural language processing, though I am not aware of the state-of-the-art. I think simple regular expressions are the way to go. Is there an existing resource that can do this?


Going Beyond Pseudorandom Numbers

I cooked up this simple bit of code in hopes to exceed pseudorandom number generation maybe touch the face of true randomization:                   For[i = 1, i < 65, i++,       seed0 = RandomInteger[{1, 22957480^3}];       SeedRandom[seed0]; seed0 = RandomInteger[{1, 22957480^3}]];     SeedRandom[seed0];      I am concerned over the default seed value though. Anyone have a better way to generate randomness?


Using NDSolve with coupled ODE

I am trying to solve a simple coupled ODE in _Mathematica_ but an error keeps on popping. I am very new to _Mathematica_.               Clear[x, y, z, x13, deq1, deq2, deq3, deq4, deq5, deq6, deq7, deq8,      deq9]           deq1 := y11'[t] == 4*(y21 - y12);     deq2 := y12'[t] == 2*y12 - 6*y13 + 4*y32;     deq3 := y13'[t] == 3*y13 + 5*(y33 - y11) - 2*y12;     deq4 := y21'[t] == 5*y21 + 7*y31 - 6*y23;     deq5 := y22'[t] == 6*y33 + 3*(y23 - y32); := y21'[t] == 5*y21 + 7*y31 - 6*y23;     deq6 := y23'[t] == 5*y23 + 2*(y33 - y22) - 5*y21;     deq7 := y31'[t] == 4*y31 - 2*(y33 - y11) + 5*y21;     deq8 := y32'[t] == 6*y32 - 5*(y33 - y22) + 3*y12;     deq9 := y33'[t] == -9*y33 + 4*(y23 - y32);     deqsys = {deq1, deq2, deq3, deq4, deq5, deq6, deq7, deq8, deq9,         y11[0] == 1, y12[0] == 0, y13[0] == 0, y21[0] == 0, y22[0] == 0,         y23[0] == 0, y31 == 0, y32 == 0, y33 == 0};     Sol = NDSolve[deqsys, {y11[t], y22[t], y23[t], y33[t],y21[t],y12[t],y13[t],y31[t],y32[t]}, {t, 0, 10}]       > NDSolve::dvnoarg: The function y11 appears with no arguments. >>


Solving a system of equations using matrix form

Please bear with me as I am a beginner at Mathematica. In the following system, all variables on the right hand side are known, except for `w1`, `w2` and `w3`, for which we are trying to solve. ![enter image description here](http://i.stack.imgur.com/NuG4w.jpg) I am trying to solve this system in Mathematica, but I am not sure where to start. Also, in my real example, the system is composed of 10 equations instead of three: we are trying to solve for `w1`, `w2` and `w3` where `FA = FB = FC = FD = .... = Fj`. Please let me know if the explanation is a bit confusing, and I will try to explain better! Thanks!


Can Mathematica solve 625 linear coupled differential equations?

I'm trying to solve an atomic physics problem in which I need to solve 625 linear coupled differential equations. I generated them by using the AtomicDensityMatrix Package. They are Liouville equations of my 25 level system. I am using the the command `DSolve` for solving them. When I solved 25 coupled differential equations with the same procedure there was no problem. example:               x1'[t]= 20*x2[t]+ 0.8*x41[t]+ 5*x152[t]+....,      x2'[t]= 48*x1[t]+ 12*x65[t] + 0.6*x60[t]+....,      x3'[t]=.....,     x4'[t]=.....,      with some initial conditions               x1[0]= 1/9, x2[0]=2, x3[0]=5......,      Can _Mathematica_ solve this large number of equations? What command can I use? Either `DSolve`, `NDsolve`... It would be very very tough for me to write this equations in some other software. I need some help.. I know definitely there will be a way to solve them in _Mathematica_ only..


Will I be able to use NDSolve, and then how

So I am completely new to Mathematica, so sorry if this is a dumb question. I have a set of 3 coupled nonlinear differential equations. They are (a,b,c,D,L constants): $$mx''=Dx'\sqrt{x'^2+y'^2+z'^2}+L(az'-by')$$ $$my''=Dy'\sqrt{x'^2+y'^2+z'^2}+L(bx'-cz')$$ $$mz''=Dz'\sqrt{x'^2+y'^2+z'^2}+L(cy'-ax')$$ And I have initial conditions for $x,y,z,x',y',z'$ Will I be able to solve this for x,y,z? Any help is appreciated!


NIntegrate, view integration options

The _Mathematica_ manual says: `NIntegrate` symbolically **analyzes its input** to transform oscillatory and other integrands, subdivide piecewise functions, and **select optimal algorithms**.   1. How do I extract the specific value of `Method` (and other related options) being used for a particular case? In other words, if the method is set to `Automatic`, how do I know which method was **actually** used for integration for a given case?   2. Can I achieve better accuracy if I modify the parameters for `NIntegrate`? I mean, does the automatic selection work well for a majority of cases (if an integrand is non-problematic)? [from your experience]


Pattern to match L, but not L[_]

I have an expression where I want to replace `L` but not `L[_]` For example, the following doesn't work and               sub = {L :> 2};     L + L[tilde] /. sub     (* 2 + 2[tilde], but I want 2 + L[tilde]*)      Is there a simple variation on the substitution pattern for this to work? I tried things like `sub = {L_Symbol :> 2}` but couldn't figure it out.


ListPlot: Plotting large data fast

Mathematica produces fantastic-looking graphics, but it can be slow on large data sets. Here is an example for a (random) time series:               rv = RandomVariate[ExponentialDistribution[2], 10^5];      Plotting this takes quite some time:               t = AbsoluteTime[]; ListLinePlot[rv, PlotRange -> All]     AbsoluteTime[] - t (* Put this line into the NEXT cell, and evaluate both cells together*)      The option `PerformanceGoal->"Speed"` has no effect. Turning off antialiasing makes it much faster (but if you increase the data size to 10^6 instead of 10^5, it is still VERY slow. A time series of 10^6 points is quite reasonable in my applications):               t = AbsoluteTime[];      Style[ListLinePlot[rv, PlotRange -> All], Antialiasing -> False]     AbsoluteTime[] - t (* This line in separate cell! *)      Reducing the number of `MaxPlotPoints` makes it much faster, but completely distorts the shape of the data:               t = AbsoluteTime[]; ListLinePlot[rv, PlotRange -> All, MaxPlotPoints -> 1000]     AbsoluteTime[] - t (* This line in separate cell! *)      **Question** : I am interested in tricks to show the data quickly without distorting the shape. I am showing here my own solution, which is quite a bit of a hack, but it works. Are there more elegant solutions? ## Edit: My own answer, previously posted as part of the question, is now an independent answer (see below)


Unique[] in RHS of rule

I have a function, `explicit` that takes dot product of two symbols, and replaces it with repeated dummy indices generated by `Unique[]`.               explicit[expr_] :=        expr //. {Dot[a_, b_] :> (Subscript[a, #] Subscript[b, #]) &[       Unique[]]};      So that if my input is `v.w`, then the output is $v_{$3}w_{$3}$ which is good. The problem is that if there is a single term multiplying two pairs of dot products, I don't know how to get `Unique[]` to generate a new symbol for each pair. That is, if I input `c.d e.f` the output is $c_{$3}d_{$3}e_{$3}f_{$3}$, which is bad. I want $c_{$3}d_{$3}e_{$4}f_{$4}$, with new repeated subscripts. How do I modify my code?


How to draw a combinatorial graph with different colors of edges?

![enter image description here](http://i.stack.imgur.com/xqy3h.png) For example, like above. I've read some examples and descriptions in here, but couldn't figured it out.


Octonions in Mathematica

Is there a package or Notebook for _Mathematica_ that can enable me to do some numerical calculations with octonions? Maybe a way to plug-in the octonion multiplication table?


Calibrating Precision in calculations

As the title says, I encounter an irritating problem which has to do with the accuracy or the precision used in the calculations. To be more specific, I have the following code:               Clear["Global`"];     Off[General::spell];          Vnuc[x_, y_, z_] := -Mn/Sqrt[x^2 + y^2 + z^2 + cn^2] /. {Mn -> 0.08,      cn -> 0.25};     Vdisk[x_, y_, z_] := -Md/Sqrt[x^2 + y^2 + (α + Sqrt[h^2 + z^2])^2] /. {Md     -> 0.82, α -> 3, h -> 0.1};     Vbar[G_, Mb_, a_, b_, c_, x_, y_, z_] := Module[{},      m[u_] := Sqrt[x^2/(a^2 + u) + y^2/(b^2 + u) + z^2/(c^2 + u)];      λ = If[m[0] > 1, u /. FindRoot[m[u]^2 == 1, {u, 1}], 0];      Δ[u_] := Sqrt[(a^2 + u) (b^2 + u) (c^2 + u)];      w000 = NIntegrate[1/Δ[u], {u, λ, \[Infinity]}];      w100 = NIntegrate[1/Δ[u] 1/(a^2 + u), {u, λ, \[Infinity]}];      w001 = NIntegrate[1/Δ[u] 1/(c^2 + u), {u, λ, \[Infinity]}];      w010 = 2/Δ[λ] - w100 - w001;      w110 = (w010 - w100)/(a^2 - b^2); w011 = (w001 - w010)/(b^2 - c^2);      w101 = (w100 - w001)/(c^2 - a^2);      w200 = 1/3 (2/(Δ[λ] (a^2 + λ)) - w110 - w101);      w020 = 1/3 (2/(Δ[λ] (b^2 + λ)) - w011 - w110);      w002 = 1/3 (2/(Δ[λ] (c^2 + λ)) - w101 - w011);      w111 = (w110 - w011)/(c^2 - a^2);      w120 = (w020 - w110)/(a^2 - b^2); w012 = (w002 - w011)/(b^2 - c^2);      w201 = (w200 - w101)/(c^2 - a^2);      w210 = (w110 - w200)/(a^2 - b^2); w021 = (w011 - w020)/(b^2 - c^2);      w102 = (w101 - w002)/(c^2 - a^2);      w300 = 1/5 (2/(Δ[λ] (a^2 + λ)^2) - w210 - w201);      w030 = 1/5 (2/(Δ[λ] (b^2 + λ)^2) - w021 - w120);      w003 = 1/5 (2/(Δ[λ] (c^2 + λ)^2) - w102 - w012);      cc = 15/16 G Mb;      pot = -(cc/6) (w000 - 6 x^2 y^2 z^2 w111 +         x^2 (x^2 (3 w200 - x^2 w300) +            3 (y^2 (2 w110 - y^2 w120 - x^2 w210) - w100)) +         y^2 (y^2 (3 w020 - y^2 w030) +            3 (z^2 (2 w011 - z^2 w012 - y^2 w021) - w010)) +         z^2 (z^2 (3 w002 - z^2 w003) +            3 (x^2 (2 w101 - x^2 w201 - z^2 w102) - w001)));      pot     ];          data1 = Table[Vnuc[x, y, 0] + Vdisk[x, y, 0] +      Vbar[1, 0.1, 7, 1.5, 0.6, x, y, 0], {x, -10, 10, 0.5}, {y, -10,      10, 0.5}];     data2 = Table[Vnuc[x, 0, z] + Vdisk[x, 0, z] +      Vbar[1, 0.1, 7, 1.5, 0.6, x, 0, z], {x, -10, 10, 0.5}, {z, -10,      10, 0.5}];     data3 = Table[Vnuc[0, y, z] + Vdisk[0, y, z] +      Vbar[1, 0.1, 7, 1.5, 0.6, 0, y, z], {y, -10, 10, 0.5}, {z, -10,      10, 0.5}];          Sxy = ListContourPlot[data1, ContourStyle -> Black,      ContourShading -> False, DataRange -> {{-10, 10}, {-10, 10}}]     Sxz = ListContourPlot[data2, ContourStyle -> Black,      ContourShading -> False, DataRange -> {{-10, 10}, {-10, 10}}]     Syz = ListContourPlot[data3, ContourStyle -> Black,      ContourShading -> False, DataRange -> {{-10, 10}, {-10, 10}}]      However, when I try to create the three data tables `data1`, `data2` and `data3` the program reports several error messages regarding the precision on the `FindRoot` inside the module. Even if I tested a lot of variations for `MachinePrecision`, `WorkingPrecision`, `PrecisionGoal` and `AccuracyGoal` I could not solve this problem. Is there any other mistake that eludes me? I would be really very grateful, if someone could help me out with this issue. Many thanks in advance.


Formatting Equation Output Neatly

I looked around and couldn't find the answer to this anywhere, so I'm sorry if this is a bad question - I'm pretty new to mathematica. I wrote a program to help me compute some annoying series expansions, and the output is pretty ugly, for example: $\epsilon ^2 \left(\left(a_{5,1} a_{6,1}+a_{1,1} \left(a_{2,1}+a_{6,1}\right)\right) X_{1,2}+\left(a_{5,1} \left(a_{9,1}+a_{10,1}\right)+a_{1,1} \left(a_{3,1}+a_{9,1}+a_{10,1}\right)\right) X_{1,3}+\left(a_{5,1} \left(a_{7,1}+a_{8,1}\right)+a_{1,1} \left(a_{4,1}+a_{7,1}+a_{8,1}\right)\right) X_{1,4}+\left(a_{6,1} \left(a_{9,1}+a_{10,1}\right)+a_{2,1} \left(a_{3,1}+a_{9,1}+a_{10,1}\right)\right) X_{2,3}+\left(a_{6,1} \left(a_{7,1}+a_{8,1}\right)+a_{2,1} \left(a_{4,1}+a_{7,1}+a_{8,1}\right)\right) X_{2,4}+a_{3,1} \left(a_{4,1}+a_{7,1}+a_{8,1}\right) X_{3,4}\right)+\epsilon \left(X_3 \epsilon a_{3,2}+X_4 \epsilon a_{4,2}+X_1 \left(\epsilon a_{1,2}+\epsilon a_{5,2}+a_{1,1}+a_{5,1}\right)+X_2 \left(\epsilon a_{2,2}+\epsilon a_{6,2}+a_{2,1}+a_{6,1}\right)+X_4 \epsilon a_{7,2}+X_4 \epsilon a_{8,2}+X_3 \epsilon a_{9,2}+X_3 \epsilon a_{10,2}+X_3 a_{3,1}+X_4 a_{4,1}+X_4 a_{7,1}+X_4 a_{8,1}+X_3 a_{9,1}+X_3 a_{10,1}\right)$ I'm wondering if there's a way to have it output this in a more readable way, for example, something like: $X_{1}*(coefficients)\\\ X_{2}*(coefficients)\\\ ...\\\ X_{1,2}*(coefficents)\\\ etc...$ Is there a way to do so? Thanks!


Dynamic graph visualisation using JLink/Java and GraphStream

Visualising the addition of new nodes and edges to a graph to 'watch it grow' is to something _Mathematica_ is not suited to by default. However this type of animation really helps convey the emergence of graph features (like clustering) to the untrained audience. There seems to be a lot of interest in doing this from the many users working with graphs in _Mathematica_. For example here are two questions on the topic (one, two). I am going to re-ask this basic question with some more specifics. It seems that JLink is a popular tool, and many users seem to be very comfortable with it and advocate more use (and programming in Java generally). For example, see Leonid's answer to a previous question. Unfortunately I am not a programmer at all and the documentation for JLink uses terminology that is over my head. I've hit a wall of frustration and really need a few pointers. There are some good Java tools for 2D dynamic graph visualisation. For example, GraphStream. So my question is, how do I visualise the growth of the below dynamic graph from this question using JLink and GraphStream? The third and forth elements of the lists are the beginning and end time periods when the edge exists).               dynamicGraph =         {{0, 1, 0, 20}, {1, 2, 1, Infinity}, {2, 3, 2, 21}, {3, 4, 3, 22},          {4, 5, 4, Infinity}, {5, 6, 5, Infinity}, {6, 7, 6, 26}, {7, 8, 7, 25},              {8, 9, 8, Infinity}, {9, 10, 9, 24}, {0, 6, 10, 27}, {1, 6, 11, Infinity},          {1, 5, 12, Infinity}, {2, 5, 13, Infinity}, {2, 4, 14, Infinity},          {6, 8, 15, Infinity}, {5, 8, 16, Infinity}, {5, 9, 17, Infinity},          {4, 9, 18, Infinity}, {4, 10, 19, 23}};      There are many parts to the question and many solutions I guess. Answers need only address one part or step in the process.   1. How do actually use GraphStream with JLink? It consists of a bunch of `.jar` files, so if these are in the notebook directory I to start with something like `Needs["JLink"]; InstallJava[]; AddToClassPath[NotebookDirectory[]];`. Then what? A quick summary in layman's terms of basics of JLink would be great .   2. Is a workable approach to generate graphs in Mathematica and export them to a file supported by GraphStream (eg. `.dot`, GraphML) then use the JLinked tool to read the file and display the animation (a little like Szabolic's answer here)? Yet I can't understand the format to make the graph in a readable dynamic format (just answering this part would be a huge help). Nor how to execute the code (ideally from within _Mathematica_ ). I hope this question will be of use to many others and answers that cover any steps in the process, or links to examples of using JLink that might aid my learning, would be greatly appreciated.