Can I define a function for vectors of arbitrary dimension?

Is it possible to do analytic calculations with _Mathematica_? For example, I want to compute: $$\partial \frac{\sum_{j=1}^n G_{j} \prod_{k=1}^{j-1} (1 - G_{k})}{\partial G_l}=-\prod_{k\neq l} (G_k-1)$$ Is it possible to define such analytic functions for an arbitrary parameter $n$? Right now, I do it by hand by defining a function like this               f[a_, b_, c_, d_] = a + b (1 - a) + c (1 - a) (1 - b) + d (1 - a) (1 - b) (1 - c)      but I want to do it generally for an $n$-vector, not a 4-vector


Varying number of function arguments

I have a function of six arguments:               ffit[q1_, q2_, q3_, q4_, q5_, q6_] :=         (a1*q1^2 + a2*q2^2 + a3*q3^2 + a4*q4^2 + a5*q5^2 + a6*q6^2)      `a1,...,a6` being constants and `q1,...,q6` coordinates. Is there a simple way ho to define the function in a more concise way so that I could easily get also the same function with an arbitrary number of arguments (`ffit[q1_,q2_,q3_]` for instance)?


Constructing functions with variable number of output arguments

In Mathematica, you can construct a function `f` to have different definitions based on its input arguments. For example, `f[x_] := ...` and `f[x_, y_] := ...`. You can also get more specific and define it for specific heads as `f[x_someHead] := ...` or inputs matching arbitrary patterns as `f[x_?somePatternQ] := ...` (of course, one must be careful to keep the order from specific to general). These definitions are the `DownValues` of the function. Now, I'd like to construct a function that has different definitions based on _the number of output variables/symbols requested_ , but for the same set of inputs. Consider the following dummy example in pseudo Mathematica code               f[mu_, sigma2_] := Switch[OutputArgs[],                                 0, Plot[PDF[NormalDistribution[mu, sigma2], x], ...]                                1, RandomReal[NormalDistribution[mu, sigma2], 1000]                                2, {Mean@#, Variance@#}&@ RandomReal[...]                        ]      Here `OutputArgs[]` is a functionality that I'd like, which when called from inside a function, tells you how many outputs have been _requested_ (loosely reminiscent of `OptionValue` which knows which function it's called from). With this, I can use the function call simply as `f[0,1]` to plot the normal distribution (perhaps inside a `Manipulate` to play with the parameters), then when I'm satisfied, I can use the same function call, but with an output argument as `a = f[0,1]` to get a random sample, and with two outputs to get an empirical estimate of the mean and variance. I realize that this is a bit at odds with the classical notion of a function having a well defined output based on the input, rather than a well defined output based on the number of outputs for a given input. * * * My interest is purely academic and arose from working on porting some MATLAB code to Mathematica. Some might have recognized that right away, and this is a feature that that I _do_ find useful — a sentiment also shared by a few others that I've spoken to here. I wouldn't write code this way and I know that it is also possible to achieve the same by other means such as using flags as `f[0, 1, "Plot"]` or options as `f[0, 1, Options -> "RandomSample"]`, etc. for the above example. However, I'm interested in exploring if there are ways to imitate this behaviour in Mathematica.


Show Simplified Directives

Is there a way to force Mathematica to convert an already rendered Graphic to the simplified Directive form of that Graphic. **Background:** I am currently editing Graphics using Drawing Tools and then calling `InputForm[gr]`, but this often doesn't work well because the output of `InputForm` are much larger then the original input. For example I am looking for the following code               gr = Graphics[{Red, Circle[]}];     InputForm[gr]      To output the simplest form possible. For example `HoldForm[InputForm[gr]]` could print `Graphics[{Red, Circle[]}]` or `Graphics[{Red, Circle[0,0]}]`. **EDIT:** There are a lot of Graphic directives listed in the docs, so there probably isn't a direct answer, but simply answers that get closer to respecting the original input. The best technique IMO would somehow create a trained function which evolves based on the version of Mathematica that you are currently using. Obviously manual transformation are less then ideal.


ListContourPlot interpolation screws up on concave set of data

I want to create `ListContourPlot`s for sets of Data (from a physics simulation) given as Triplets {x, y, f(x, y)}. Certain parameter regions in the x-y-plane are excluded by experiments. The list of triplets simply does not contain any Triplets with excluded x-y-parameters. `ListPointPlot3D` shows that this is not the problem. The problem is that `ListContourPlot` (which I prefer to use, since I have to correlate exclusions from different quantities) interpolates values into regions where no data points are given, as soon as the shape of the data- filled region becomes concave. I already tried creating a list that is only defined in the excluded regions and painting it over the original plot, however, my dataset is not entirely concave, so that overpainting will cut off some of the interesting parts of the plot... I figure it has something to do with the "Method" option of `ListContourPlot`, but those things are really badly documented. Here is a list of 140 data triplets that show the problem.               l= {{14., 2.1, 125.433}, {14., 2.1375, 125.957}, {14., 2.175,        126.58}, {14., 2.2125, 127.354}, {14., 2.25, 128.415}, {14.5,        2.1125, 125.698}, {14.5, 2.15, 126.315}, {14.5, 2.1875,        127.087}, {14.5, 2.225, 128.152}, {15., 2.1, 125.593}, {15., 2.1375,        126.238}, {15., 2.175, 127.061}, {15., 2.2125, 128.256}, {15.5,        2.1125, 125.886}, {15.5, 2.15, 126.669}, {15.5, 2.1875,        127.783}, {16., 2.1, 125.73}, {16., 2.1375, 126.534}, {16., 2.175,        127.708}, {16.5, 2.1125, 126.054}, {16.5, 2.15, 127.082}, {17., 2.1,        125.829}, {17., 2.1375, 126.85}, {17.5, 2.1, 125.858}, {17.5,        2.1375, 127.016}, {18., 2.1, 125.868}, {18., 2.1375,        127.185}, {18.5, 2.1125, 126.243}, {18.5, 2.15, 128.277}, {19.,        2.125, 126.76}, {19.5, 2.1125, 126.183}, {20., 2.1, 125.633}, {20.,        2.1375, 127.686}, {20.5, 2.125, 126.573}, {21., 2.1125,        125.763}, {21.5, 2.1, 125.093}, {21.5, 2.1375, 127.062}, {22.,        2.125, 125.806}, {22.5, 2.1125, 124.979}, {22.5, 2.15,        127.707}, {23., 2.125, 125.111}, {23.5, 2.1, 124.03}, {23.5, 2.1375,        125.248}, {24., 2.1, 123.738}, {24., 2.1375, 124.82}, {24.5, 2.1,        123.445}, {24.5, 2.1375, 124.411}, {24.5, 2.175, 126.896}, {25.,        2.125, 123.689}, {25., 2.1625, 124.924}, {25.5, 2.1125,        123.092}, {25.5, 2.15, 123.987}, {25.5, 2.1875, 125.801}, {26.,        2.125, 123.022}, {26., 2.1625, 123.937}, {26., 2.2, 125.892}, {26.5,        2.125, 122.703}, {26.5, 2.1625, 123.512}, {26.5, 2.2,        124.901}, {27., 2.1125, 122.198}, {27., 2.15, 122.848}, {27.,        2.1875, 123.782}, {27., 2.225, 125.874}, {27.5, 2.125,        122.095}, {27.5, 2.1625, 122.745}, {27.5, 2.2, 123.676}, {27.5,        2.2375, 125.734}, {28., 2.125, 121.808}, {28., 2.1625,        122.394}, {28., 2.2, 123.198}, {28., 2.2375, 124.563}, {28.5,        2.1125, 121.39}, {28.5, 2.15, 121.87}, {28.5, 2.1875,        122.506}, {28.5, 2.225, 123.412}, {28.5, 2.2625, 125.253}, {29.,        2.125, 121.29}, {29., 2.1625, 121.747}, {29., 2.2, 122.372}, {29.,        2.2375, 123.256}, {29., 2.275, 124.961}, {29.5, 2.125,        121.036}, {29.5, 2.1625, 121.454}, {29.5, 2.2, 122.006}, {29.5,        2.2375, 122.762}, {29.5, 2.275, 123.966}, {30., 2.1, 120.465}, {30.,        2.1375, 120.896}, {30., 2.175, 121.334}, {30., 2.2125,        121.862}, {30., 2.25, 122.595}, {30., 2.2875, 123.735}, {30.5, 2.1,        120.187}, {30.5, 2.1375, 120.599}, {30.5, 2.175, 121.065}, {30.5,        2.2125, 121.525}, {30.5, 2.25, 122.157}, {30.5, 2.2875,        123.07}, {30.5, 2.325, 124.9}, {31., 2.125, 120.167}, {31., 2.1625,        120.593}, {31., 2.2, 121.078}, {31., 2.2375, 121.561}, {31., 2.275,        122.237}, {31., 2.3125, 123.247}, {31., 2.35, 126.014}, {31.5,        2.125, 119.881}, {31.5, 2.1625, 120.285}, {31.5, 2.2,        120.747}, {31.5, 2.2375, 121.268}, {31.5, 2.275, 121.808}, {31.5,        2.3125, 122.628}, {31.5, 2.35, 124.034}, {32., 2.1125,        119.484}, {32., 2.15, 119.849}, {32., 2.1875, 120.264}, {32., 2.225,        120.742}, {32., 2.2625, 121.268}, {32., 2.3, 121.85}, {32., 2.3375,        122.72}, {32.5, 2.1125, 119.213}, {32.5, 2.15, 119.558}, {32.5,        2.1875, 119.949}, {32.5, 2.225, 120.396}, {32.5, 2.2625,        120.911}, {32.5, 2.3, 121.431}, {33., 2.1, 118.846}, {33., 2.1375,        119.16}, {33., 2.175, 119.512}, {33., 2.2125, 119.91}, {33., 2.25,        120.365}, {33., 2.2875, 120.871}, {33.5, 2.125, 118.783}, {33.5,        2.1625, 119.101}, {33.5, 2.2, 119.458}, {33.5, 2.2375,        119.856}, {34., 2.1, 118.333}, {34., 2.1375, 118.614}, {34., 2.175,        118.923}, {34., 2.2125, 119.261}};          ListPlot@l[[All, 1 ;; 2]]      ![Mathematica graphics](http://i.stack.imgur.com/CkKWd.png)


Numerically/Analytically Solving a System of Equations

I have $6$ functions $f_i(x,y,z)$, $(i = 1, \ldots, 6)$ in three variables $x,y,z$, and I would like to find a simultaneous instance of these variables, say $(x_0, y_0, z_0)$, such that $f_i(x_0, y_0, z_0) = 0$ for each $i = 1, \ldots, 6$. The functions are pretty well-behaved, with mostly low order polynomial factors and some square roots. I know a solution exists, and with some manual searching I've already narrowed down the area where it must be to a pretty small region. What I would like to do now is (preferably) use an exact solver to find the exact solution, or (alternatively) use a numerical search to further narrow down the region of the optimum. I've tried working with functions like `(N)Solve`, `FindMinimum`, `FindRoot` to do this, but it doesn't seem to work very well. The program just runs forever, with no result. My main question is: **What is the best solution for this problem in Mathematica?** Maybe the problem is just too complicated for Mathematica to solve (even numerically though?!), but if it is not, which routine should I call in this case to have the best chance of getting an answer? (I would also be curious to know in general which of these is suitable for what. Is there any real difference in efficiency between `Solve`, `FindMinimum`, `Minimize`, `FindRoot` etc.? Or do they just end up sharing the same optimized algorithms internally?) Thanks.


Nested Nintegrate - two variable limits of integral

This is, so to say, the next part of the question: Nested NIntegrate - NIntegrate::inum: - error Now I define three functions:               r[x_] := q[x] /. NDSolve[{q'[t] == 0.0001 + (-1 + I*1 + q[t])*q[t], q[0] == 0}, q,         {t, 0, 50}][[1]]          beta = 1;          fn[k_, t_?NumericQ] := Exp[8*NIntegrate[r[s]*Exp[2*beta*1] + 8*r[s], {s, t, k}]]          f00[x_, t_, p_] :=         p*Exp[-8*NIntegrate[r[s]*Exp[2*beta*1] - 8*r[s], {s, t, x}]] +         8*Exp[-8*NIntegrate[r[s]*Exp[2*beta*1] - 8*r[s], {s, t, x}]]*           NIntegrate[Exp[2*beta*1]*fn[y, t], {y, t, x}]      When I evaluate               f00[20, 2, 0.5]      I obtain the error: > NIntegrate::nlim: s = y is not a valid limit of integration. The difference between the first question is now both limits of the integral in the definition of `fn` are variables, and I have to evaluate the integral               NIntegrate[Exp[2*beta*1]*fn[y, t], {y, t, x}]       What I can do?


How to simplify expression and use HoldForm at the same time?

Hopefully a simple problem for the experts here. I have a need many times to build a symbolic expression for an equation (say a PDE) to use for plot labels in a low level function inside `Manipulate`, and so I make a function that I call to build the pde in symbolic form, so I can use it for a plot label. I pass the PDE parameters to this function, and the function uses `HoldForm` to build it. But when one of the parameters is 1 (or even zero), and because of `HoldForm`, these remain stuck there and do not simplify away, and I'd like to remove them. Currently I use `If` statement to check for these cases. But I have a feeling there is a better way. Here is the function (example)               f[c_] := Module[{},       HoldForm[c* D["u"["x", "t"], {"x", 2}] == "f"["x", "t"]]        ]      now, when I call it like this               f[1]       it returns ![enter image description here](http://i.stack.imgur.com/Otcoh.png) So now I do               f[c_] := Module[{},       If[c == 1,        HoldForm[ D["u"["x", "t"], {"x", 2}] == "f"["x", "t"] ],        HoldForm[c* D["u"["x", "t"], {"x", 2}] == "f"["x", "t"] ],        ]       ]      and now `f[1]` returns ![enter image description here](http://i.stack.imgur.com/7Qynb.png) I tried many things, (Defer, Simplify, Evaluate, etc...) and nothing works, other than by doing this manual check _before_ using `HoldForm`. And about the use of strings there, I had to do it this way :). Too many problems if I use actual symbols. Long story. May be for another topic I can explain why, but for the above works ok for me now other than those extra checks I have to do manually. question is: is there a trick to do what I am doing about without the If check (I have few parameters to check, and have to do many checks for 1's and 0's as well). Not a big problem for me to do the checks, just wondering if there is a trick I am overlooking. thanks


How to set the background of a section to light gray?

How to set the background of a section to light gray and leave background of content below and above the section as default?


Is it possible to create a compiled function with some symbolic arguments?

I am trying to create a compiled function that takes in several arguments. However, some of the arguments contain symbolic entries and thus I get the following error message when executing the cell containing the compiled function: > Compile::cplist: b should be a tensor of type Integer, Real, or Complex; > evaluation will use the uncompiled function. > > Compile::cret: The type of return values in [...] are different. Evaluation > will use the uncompiled function. and this error message when trying to call the function: > CompiledFunction::cfta: "Argument {<<1>>} at position 2 should be a rank 2 > tensor of !(\"machine-size real number\")s. " Here is the compiled function I am trying to create:               calcK=Compile[{{nnpe,_Integer,0},b,{d,_Real,2},j,{t,_Real,0}},         Module[             {i,k,numQuadPts,p,pCoords,w,kSub},             k=Array[0`&,{nnpe*2,nnpe*2}];             numQuadPts=4;             p=1/Sqrt[3];             pCoords={{-p,-p},{p,-p},{p,p},{-p,p}};             w={1,1,1,1};             For[i=1,i<=numQuadPts,i++,                 k+=Transpose[b].d.b*Det[j]*w[[i]]/.{xi->pCoords[[i,1]],eta->pCoords[[i,2]]};             ];         Return[t*k]];     ];      Here is some sample input data (I apologize in advance for the large lists):               nnpe=4;     t=.25;     d={{1.0989*10^9, 3.2967*10^8, 0}, {3.2967*10^8, 1.0989*10^9, 0}, {0, 0,3.84615*10^8}};     b={{((-(1/4) + eta/4)*(0.25*(1/4 - xi/4) + 0.25*(1/4 + xi/4)))/(0. - 0.625*eta) +          ((-0.25*(-(1/4) - eta/4) - 0.25*(1/4 + eta/4))*(-(1/4) + xi/4))/(0. - 0.625*eta),         0, ((1/4 - eta/4)*(0.25*(1/4 - xi/4) + 0.25*(1/4 + xi/4)))/(0. - 0.625*eta) +          ((-0.25*(-(1/4) - eta/4) - 0.25*(1/4 + eta/4))*(-(1/4) - xi/4))/(0. - 0.625*eta),         0, ((1/4 + eta/4)*(0.25*(1/4 - xi/4) + 0.25*(1/4 + xi/4)))/(0. - 0.625*eta) +          ((-0.25*(-(1/4) - eta/4) - 0.25*(1/4 + eta/4))*(1/4 + xi/4))/(0. - 0.625*eta), 0,         ((-(1/4) - eta/4)*(0.25*(1/4 - xi/4) + 0.25*(1/4 + xi/4)))/(0. - 0.625*eta) +          ((-0.25*(-(1/4) - eta/4) - 0.25*(1/4 + eta/4))*(1/4 - xi/4))/(0. - 0.625*eta),         0}, {0, ((-(1/4) + eta/4)*(-10.*(-(1/4) - xi/4) - 10.*(1/4 - xi/4)))/          (0. - 0.625*eta) + ((10.*(-(1/4) - eta/4) + 10.*(1/4 - eta/4))*(-(1/4) + xi/4))/          (0. - 0.625*eta), 0, ((1/4 - eta/4)*(-10.*(-(1/4) - xi/4) - 10.*(1/4 - xi/4)))/          (0. - 0.625*eta) + ((10.*(-(1/4) - eta/4) + 10.*(1/4 - eta/4))*(-(1/4) - xi/4))/          (0. - 0.625*eta), 0, ((1/4 + eta/4)*(-10.*(-(1/4) - xi/4) - 10.*(1/4 - xi/4)))/          (0. - 0.625*eta) + ((10.*(-(1/4) - eta/4) + 10.*(1/4 - eta/4))*(1/4 + xi/4))/          (0. - 0.625*eta), 0,         ((-(1/4) - eta/4)*(-10.*(-(1/4) - xi/4) - 10.*(1/4 - xi/4)))/(0. - 0.625*eta) +          ((10.*(-(1/4) - eta/4) + 10.*(1/4 - eta/4))*(1/4 - xi/4))/(0. - 0.625*eta)},        {((-(1/4) + eta/4)*(-10.*(-(1/4) - xi/4) - 10.*(1/4 - xi/4)))/(0. - 0.625*eta) +          ((10.*(-(1/4) - eta/4) + 10.*(1/4 - eta/4))*(-(1/4) + xi/4))/(0. - 0.625*eta),         ((-(1/4) + eta/4)*(0.25*(1/4 - xi/4) + 0.25*(1/4 + xi/4)))/(0. - 0.625*eta) +          ((-0.25*(-(1/4) - eta/4) - 0.25*(1/4 + eta/4))*(-(1/4) + xi/4))/(0. - 0.625*eta),         ((1/4 - eta/4)*(-10.*(-(1/4) - xi/4) - 10.*(1/4 - xi/4)))/(0. - 0.625*eta) +          ((10.*(-(1/4) - eta/4) + 10.*(1/4 - eta/4))*(-(1/4) - xi/4))/(0. - 0.625*eta),         ((1/4 - eta/4)*(0.25*(1/4 - xi/4) + 0.25*(1/4 + xi/4)))/(0. - 0.625*eta) +          ((-0.25*(-(1/4) - eta/4) - 0.25*(1/4 + eta/4))*(-(1/4) - xi/4))/(0. - 0.625*eta),         ((1/4 + eta/4)*(-10.*(-(1/4) - xi/4) - 10.*(1/4 - xi/4)))/(0. - 0.625*eta) +          ((10.*(-(1/4) - eta/4) + 10.*(1/4 - eta/4))*(1/4 + xi/4))/(0. - 0.625*eta),         ((1/4 + eta/4)*(0.25*(1/4 - xi/4) + 0.25*(1/4 + xi/4)))/(0. - 0.625*eta) +          ((-0.25*(-(1/4) - eta/4) - 0.25*(1/4 + eta/4))*(1/4 + xi/4))/(0. - 0.625*eta),         ((-(1/4) - eta/4)*(-10.*(-(1/4) - xi/4) - 10.*(1/4 - xi/4)))/(0. - 0.625*eta) +          ((10.*(-(1/4) - eta/4) + 10.*(1/4 - eta/4))*(1/4 - xi/4))/(0. - 0.625*eta),         ((-(1/4) - eta/4)*(0.25*(1/4 - xi/4) + 0.25*(1/4 + xi/4)))/(0. - 0.625*eta) +          ((-0.25*(-(1/4) - eta/4) - 0.25*(1/4 + eta/4))*(1/4 - xi/4))/(0. - 0.625*eta)}};     j={{10.*(-(1/4) - eta/4) + 10.*(1/4 - eta/4), 0.25*(-(1/4) - eta/4) +         0.25*(1/4 + eta/4)}, {10.*(-(1/4) - xi/4) + 10.*(1/4 - xi/4),       0.25*(1/4 - xi/4) + 0.25*(1/4 + xi/4)}};      And finally, I call the compiled function with:               calcK[nnpe, b, d, j, t]      which produces the aforementioned error message. I'm thinking it has something to do with the fact that the "b" and "j" matrices contain "xi" and "eta". Thus, I cannot define the type in the compiled function definition.


Programmatically control notebook resize area

How might I programmatically control the notebook resize area? In particular, I want to be able to execute "Restore Down" when the window is maximized.


How to convert multidimensional matrix into regular matrix?

I have this multidimensional matrix:               {{{{a1, a2}, {a3, a4}}, {{b1, b2}, {b3, b4}}}, {{{c1, c2}, {c3, c4}}, {{d1, d2}, {d3, d4}}}}      I would like to convert it into this regular matrix:               {{a1, a2, b1, b2}, {a3, a4, b3, b4}, {c1, c2, d1, d2}, {c3, c4, d3, d4}}      I have tried to use Flatten and Partition, but then I get this result:               {{a1, a2, a3, a4}, {b1, b2, b3, b4}, {c1, c2, c3, c4}, {d1, d2, d3, d4}}      Thanks in advance :-)


Evaluation of OptionValue[]

I have a function that takes an `OptionsPattern` and I want to access several options, say `a`, and `b`. This works great:               f1[OptionsPattern[]] := Block[{},        {OptionValue[a],OptionValue[b]}       ];     Options[f1] = {a -> 1, b -> 2};      Calling `f1[]` returns `{1,2}` as expected. The problem is that I don't know in advance which options I'll want to access. So I thought about trying this:               f2[OptionsPattern[]] := Block[{list},        list={a,b};        OptionValue /@ list       ];     Options[f2] = {a -> 1, b -> 2};      `f2` doesn't work, and neither do `f3`:               f3[OptionsPattern[]] := Block[{},        OptionValue /@ {a,b}       ];      They both return `{OptionValue[a], OptionValue[b]}`. However, this **_does_** work:               f4[OptionsPattern[]] := Block[{},        OptionValue[#]& /@ {a,b}       ];      > **Question** : Why on earth do `f2,f3` not work, while `f4` does, and what > is the difference between `f4` and `f3` anyhow? _PS_ These also these don't work:               f5[OptionsPattern[]] := Block[{},       Evaluate[OptionValue /@ {a, b}]       ];          f6[OptionsPattern[]] := Block[{},       OptionValue /@ Evaluate[{a, b}]       ];


How to flush machine underflows to zero and prevent conversion to arbitrary precision?

I'm working on some pretty intense computation in _Mathematica_ ; when my code started running slowly, I tracked the source of the problem to `Exp[]`. I need to exponentiate every element of a 50x500x500 array; performing the operation on a 500x500 array takes on the order of 3 seconds (according to `AbsoluteTime`), so the entire array should take about 50 times that. Unfortunately, that's calculation needs to happen for every data point. I've read about lots of ways to speed up _Mathematica_ code, but none of those methods seem to apply here. I'm already working in `MachinePrecision`. I have noticed that some of my results are ridiculously small (for example, `4.282835067271648*10^-78127094`), but I'm not sure how to make _Mathematica_ ignore those; they're obviously **much** smaller than `$MachineEpsilon`. Any advice is greatly appreciated! **Update** : Below is a sample of my code and the generated output. To give it some context, `g0`, is a scalar, `σg0` is a length 50 array, and `g` is a 500x500 array.               (* Added after Oleksandr R.'s comment *)     SetSystemOptions["CatchMachineUnderflow" -> False];          n = Length[σg0];     probgs = ConstantArray[N[0], {50, 500, 500}];     For[i = 1, i <= n, i++,       probgs[[i]] =          N[(1/(Sqrt[2 π] σg0[[i]])) Exp[-0.5 ((g - g0)/σg0[[i]])^2]];       ]; // AbsoluteTiming     Precision[probgs]      Output:               {4.816275, Null}     MachinePrecision      Turning off underflow definitely helped; 5 seconds isn't bad at all for what I'm doing.


Finite precision - how to get rid of "near zeros"

I am performing a finite-precision operation on a matrix `A` which I know precisely; call the result `B`. The operation is taking the square root by `B = MatrixPower[A,1/2]`, but it's not quite relevant. The point is that the form of `A` is such that the output will contain a lot of entries equal to `0`, simply because `A` has a lot of invariant subspaces spanned by the standard base vectors. I would like to see resulting matrix is like: in the first approximation it interests me how many non-zero entries it has and where. The problem is, the entries of `B` which are supposed to be `0` come out as small reals of the type $1.234...\times 10^{-10}$. I've tried applying `N` to `B` with some modest requirement on precision, but this does not seem to help. Ideally, I would like to set all entries of `B` which are approximately `0` to precisely `0`. Any help would be appreciated. P.S. It just occurred to me that I can take a function `f` that maps small numbers to `0`, and is identity otherwise, and apply it to `B` element-wise. But there should be a more elegant solution, it seems to me.


How can I replace very small scientific form of numbers in output with 0.0?

How cam I get rid of very small scientific form numbers in my output, replacing them with zero? (eg: 2.27682*10^-18 --> 0.0)


how to calculate with just double floating point precision

I want to calculate with simple double floating point precision.               NestList[#^2 &, 0.5, 50]     =>      {0.5, 0.25, 0.0625, 0.00390625, 0.0000152588, 2.32831*10^-10,       5.42101*10^-20, 2.93874*10^-39, 8.63617*10^-78, 7.45834*10^-155,       5.56268464626800*10^-309, 3.09434604738300*10^-617,       9.57497746095000*10^-1234, 9.1680193377700*10^-2467,       8.4052578577800*10^-4933, 7.0648359655800*10^-9865,       4.9911907221000*10^-19729, 2.4911984824000*10^-39457,       6.206069878700*10^-78914, 3.851530333900*10^-157827,       1.483428591300*10^-315653, 2.20056038500*10^-631306,       4.84246601000*10^-1262612, 2.34494770600*10^-2525223,       5.4987797400*10^-5050446, 3.0236578700*10^-10100891,       9.142506900*10^-20201782, 8.358543200*10^-40403563,       6.986524500*10^-80807125, 4.881152400*10^-161614249,       2.382564900*10^-323228497, 5.67661600*10^-646456994,       3.22239600*10^-1292913987, 1.03838400*10^-2585827973,       1.07824100*10^-5171655946, 1.16260000*10^-10343311892, Underflow[],       Underflow[], Underflow[], Underflow[], Underflow[], Underflow[],       Underflow[], Underflow[], Underflow[], Underflow[], Underflow[],       Underflow[], Underflow[], Underflow[], Underflow[]}      But I would really like to get                {0.5, 0.25, 0.0625, 0.00390625, 0.0000152588, 2.32831*10^-10,       5.42101*10^-20, 2.93874*10^-39, 8.63617*10^-78, 7.45834*10^-155, 0, 0, 0, 0 ...}      And I want                FixedPoint[#^2 &, 0.5]  =>  0.      not                FixedPoint[#^2 &, 0.5]  =>  Underflow[]


Replace very small numbers by zero in the output of a list

I have a long nested list, but many elements are numbers of order 10^-18 or less, eg               {{0.217548, -0.217548, -0.0373272, -9.83823*10^-18, -8.13807*10^-19}, \     {0.217548, 0.217548, 0.0373272, 7.54332*10^-18, 6.23849*10^-19}, \     {0.183095, 0.0504041, 0.00207916, -0.214279, -0.0218996}, \     {0.985472, -0.193791, -0.461242, 4.17611*10^-20, 1.22184*10^-20}, \     {0.985472, 0.193791, 0.461242, -1.18329*10^-30, -9.86076*10^-31},      {0.60405, 9.7862*10^-23, -9.11593*10^-24, -1.54354*10^-22, -1.91278*10^-23}, \     {0.80994, 0.556147, 0.623645, 0.558531, 0.625958}}      Then, to make the output more readable, I want to print in the output the numbers with absolute value smaller than 10^-18 as zeros. What is the smartest and fastest way to do this? Thanks


Does Mathematica 8 work on Windows 8?

I just saw that Windows 8 RTM has showed up on Technet, and I've been wondering if I should upgrade my main machine. I've been trying to determine the compatibility of various app with Windows 8 and the one thing I can't seem to find is anybody that has tried Mathematica 8 on Windows 8. Does anybody have any experience with Mathematica 8 on Windows 8?


FullSimplify ratio of two gamma functions

I have the following input               m = 2;     Gamma[n + m]/Gamma[n + 1];     FullSimplify[%]      It gives me               1+n      For `m=3`, it gives me               (1 + n) (2 + n)      For `m=4`, it gives me               (1 + n) (2 + n) (3 + n)      For `m=5`, it gives me               Gamma[5 + n]/Gamma[1 + n]      I would like to have expression like `(1 + n) (2 + n) (3 + n) (4+n),` how should I do to get it?


Building intervals

I'm facing the right know the problem of building intervals to an arbitrary number. The special thing is that the first and the last intervals should have fixed length, while the "middle" ones should be of a fixed number. I think an example will make things more clear;-) We take the number 111, the first and the last 3 intervals should have the length 10, in between there should be 5 intervals. The solution would be: {{0,10},{10,20},{20,30},{30,40.2},{40.2,50.4},{50.4,60.6},{60.6,70.8},{70.8,81},{81,91},{91,101},{101,111}} I hope I made the problem understandable. Thank you! rainer


How can my Manipulate be aware of a local variable inside a nested Module

I have 3 sets of 5 x-y points:               RandomInteger[10, {3, 5, 2}]      ![Mathematica graphics](http://i.stack.imgur.com/m7dna.png) I want to display only one set of points at a time, and use a slider to move on to show the next set. This of course could be simply done with a `Manipulate`:               Manipulate[Module[{l},       l = RandomInteger[10, {3, 5, 2}];       ListPlot[l[[i]], PlotRange -> {{-1, 11}, {-1, 11}}]], {i, 1, 3, 1}]      ![Mathematica graphics](http://i.stack.imgur.com/oezOd.png) However, notice that I have to hard code the Manipulate parameter to have a maximum of 3 (the number of sets there is). To avoid hard-coding, I have to make the `Manipulate` aware of the `Length[l]` i.e. the number of sets there is). I just can't seem to find a way how to do so given that `l` was a variable local to only the `Module`. * * * **My question is** : how can I make my `Manipulate` aware of a local variable in my nested `Module`? * * * **PS** : I could of course nest the `Manipulate` within a `DynamicModule`, but I'm wondering if there's any straightforward way to achieve the same thing with the opposite nesting (`Module` inside `Manipulate`).               DynamicModule[{l},      l = RandomInteger[10, {3, 5}];      Manipulate[ListPlot[l[[i]]], {i, 1, Length[l], 1}]]


Correct graphical representation of a discrete function (PMF)

I have a list: `{1,2,2,3,3,3,3,4,4,5}`. I want to plot the percentage occurrence of elements in the whole list. So the list plot I want to do is:               list={{1,1/10},{2,2/10},{3,4/10},{4,2/10},{5,1/10}};     ListPlot[list]      What is the name of this kind of plot in _Mathematica_? How should I do it in _Mathematica_ 7?


Is my system too complicated for Solve?

I am trying to solve a system of three nonlinear equations using _Mathematica_. `Solve` takes forever to run and never solves my system of equations. Is my system too complicated? I have looked through the suggestions on using `Solve` in the _Mathematica_ help, but none of these seem to work. I am wondering if I am going about solving the problem the wrong way. Any help would be greatly appreciated! I have attached my code below. ### Solving the Tensegrity Model Defining reference conditions               l0 = Sqrt[0.375];     s0 = 0.5 ;     k = 1;      Using prestress to define               ξ = 1 - lR/l0;          lR[ξval_] := l0 (1 - ξval);          lRvalues = Table[lR[ξrange], {ξrange, {0.0, 0.1, 0.5, 0.9, 1.0}}];      Defining cable lengths               Clear[sx, sy, sz]     l1[sx_] := 0.5 Sqrt[sx^2 + sy^2 - 2 sy + 2];     l2 := 0.5 Sqrt[sy^2 + sz^2 - 2 sz + 2];     l3[sx_] := 0.5 Sqrt[sz^2 + sx^2 - 2 sx + 2];          F1[lR_] = k (l1[sx] - lR);     F2[lR_] = k (l2 - lR);     F3[lR_] = k (l3[sx] - lR);          F1values = Table[F1[lr], {lr, lRvalues}];     F2values = Table[F2[lr], {lr, lRvalues}];     F3values = Table[F3[lr], {lr, lRvalues}];     F1values[[1]] /. sx -> 0.5     (*-0.612372 + 0.5 Sqrt[2.25 - 2 sy + sy^2]*)          sxval = Range[0.5, 2, 0.5];     For[j = 1, j < Length[sxval] + 1, j++,      For[i = 1, i < Length[F1values] + 1, i++,       Solve[{(F1values[[i]] /. sx -> sxval[[j]]) (1 - sy)/l1[sxval[[j]]] ==           F2values[[i]] sy/l2,          F2values[[i]] (1 - sz)/l2 == (F3values[[i]] /. sx -> sxval[[j]]) sz/           l3[sxval[[j]]],          T == 2 ((F1values[[i]] /. sx -> sxval[[j]]) sxval[[j]]/              l1[sxval[[j]]] + (F3values[[i]] /. sx -> sxval[[j]]) (              sxval[[j]] - 1)/l3[sxval[[j]]])}, {T, sy, sz}]       (*sy1 = NSolve[(F1values[[i]] /. sx -> sxval[[j]]) (1 - sy)/l1[sxval[[j]]] ==       F2values[[i]] sy/l2, sy, Reals] // FullSimplify;*)       (*Print[sy1]*)       ]      ]`


Specify a constraint on an interval under FindMinimum

I have an interpolated function that looks like this: $\hskip1.2in$![enter image description here](http://i.stack.imgur.com/iRxEx.png) and, based on extreme and critical points, I want to use a polynomial to approximate the function. The points in question are:               pts = {{-0.405234, 1.67277}, {-0.163136, -0.261272}, {0.0847028, -0.183542},         {0.483178, -0.408663}, {0.590177, 1.67277}};      $\hskip1.2in$![enter image description here](http://i.stack.imgur.com/wB56T.png) I know I could use `Fit` to get a polynomial with the desired order, but not every polynomial is acceptable. In order to preserve the qualitative nature of the curve, the polynomial must be _at least_ of order $n=4$, and a requirement is that the polynomial respects the _minima_ of the original curve. Based on that, I did the following: Let $P_4(x) = a_0 + a_1 x + a_2 x^2 + a_3 x^3 + a_4 x^4$. Then I constructed the function (sorry for the lousy programming)               p4[ls_] := Function[x, Module[{a, c4},        a = Flatten@({a0, a1, a2, a3} /.        Solve[Flatten@{(a0 + a1 #1 + a2 #1^2 + a3 #1^3 + a4 #1^4 - #2 == 0) & @@@ #,          (a1 + 2 a2 #1 + 3 a3 #1^2 + 4 a4 #1^3 == 0) & @@@ #} &@ls[[{2, 4}]],          {a0, a1, a2, a3}]);       c4 = a4 /.        (FindMinimum[         Abs[a[[1]] + a[[2]] #1 + a[[3]] #1^2 + a[[4]] #1^3 + a4 #1^4 - #2] & @@ ls[[1]] +         Abs[a[[1]] + a[[2]] #1 + a[[3]] #1^2 + a[[4]] #1^3 + a4 #1^4 - #2] & @@ ls[[3]] +         Abs[a[[1]] + a[[2]] #1 + a[[3]] #1^2 + a[[4]] #1^3 + a4 #1^4 - #2] & @@ ls[[5]],         {a4, 0}])[[2]];       (a[[1]] + a[[2]] x + a[[3]] x^2 + a[[4]] x^3 + a4 x^4) /. {a4 -> c4}       ]];      This function basically finds the coefficients $a_0, ...,a_3$ of the polynomial by imposing it to pass trough the two minima and ensuring that they are indeed minimia (fortunately I didn't had to impose $a_4 > 0$), and determines $a_4$ as the constant that minimizes the function $$|P_4(x_1) - y_1| + |P_4(x_3) - y_3| + |P_4(x_5) - y_5|$$ The result is good but not that good: $\hskip1.2in$![enter image description here](http://i.stack.imgur.com/wwLy7.png) So, I try with $P_6(x) = a_0 + a_1 x + a_2 x^2 + a_3 x^3 + a_4 x^4 + a_5 x^5 + a_6 x^6$ (againg, sorry for the ugly programing):               p6[ls_] := Function[x, Module[{a, c6},        a = Flatten@({a0, a1, a2, a3, a4, a5} /.       Solve[Flatten@{(a0 + a1 #1 + a2 #1^2 + a3 #1^3 + a4 #1^4          + a5 #1^5 + a6 #1^6 - #2 == 0) & @@@ #,         (a1 + 2 a2 #1 + 3 a3 #1^2 + 4 a4 #1^3 + 5 a5 #1^4 + 6 a6 #1^5 == 0) & @@@ #}         &@ ls[[2 ;; 4]], {a0, a1, a2, a3, a4, a5}]);       c6 = a6 /. (Quiet@FindMinimum[          Abs[a[[1]] + a[[2]] #1 + a[[3]] #1^2 + a[[4]] #1^3 + a[[5]] #1^4 +           a[[6]] #1^5 + a6 #1^6 - #2] & @@ls[[1]] +           Abs[a[[1]] + a[[2]] #1 + a[[3]] #1^2 + a[[4]] #1^3 + a[[5]] #1^4 +           a[[6]] #1^5 + a6 #1^6 - #2] & @@ls[[3]] +           Abs[a[[1]] + a[[2]] #1 + a[[3]] #1^2 + a[[4]] #1^3 + a[[5]] #1^4 +           a[[6]] #1^5 + a6 #1^6 - #2] & @@ls[[5]], {a6, 0}])[[2]];       (a[[1]] + a[[2]] x + a[[3]] x^2 + a[[4]] x^3 + a[[5]] x^4 + a[[6]] x^5 + a6 x^6) /.          {a6 -> c6}     ]];      Again I force the minima, but I add a third condition on the coeficients, that there must be a minima in $x_3$. This works like a charm for `pts`: $\hskip1.2in$![enter image description here](http://i.stack.imgur.com/wWvNW.png) I should be very happy but, if I change the definition for `pts`               pts = {{-0.419826, 1.67277}, {-0.292539, -0.296446}, {0.00452181, -0.162576},        {0.6037, -0.534627}, {0.735329, 1.67277}}      I end up with $\hskip1.2in$![enter image description here](http://i.stack.imgur.com/vuHRr.png) which is terrible (qualitatively speaking that is)! **The solution** is (kinda?) obvious, I need to impose the constraint $$2 a_2 + 6 a_3 x + 12 a_4 x^2 + 20 a_5 x^3 + 30 a_6 x^4 \le 0 \quad x \in (x_2 + \delta_1,x_4 - \delta_2) \tag{C}$$ (where $\delta_{1,2}$ can be fixed to ensure smoothness) but I have been unable to work with the interval. I've tried defining a function by pieces and apply it to $a_6$ in the constraint section of `FindRoot`, use `HeavisidePi`, etc, without success so, **my quiestion is: how to include the constraint (C) in`FindRoot`?** For reference, here is a (coarse) table to generate the original interpolated function for the first and second case:               case1 = {{-0.405234, 1.67277}, {-0.305234, 0.264728}, {-0.205234, -0.2388},        {-0.105234, -0.242507}, {-0.00523355, -0.197663}, {0.0947664, -0.183713},        {0.194766,-0.203222}, {0.294766, -0.252936}, {0.394766, -0.334333},        {0.494766, -0.404536}};          case2 = {{-0.419826, 1.67277}, {-0.319826, -0.275709}, {-0.219826, -0.248922},        {-0.119826, -0.185553}, {-0.0198259, -0.163342}, {0.0801741, -0.169325},        {0.180174, -0.197047}, {0.280174, -0.244685}, {0.380174, -0.313329},        {0.480174, -0.41021}, {0.580174, -0.524263}, {0.680174, -0.190625}};      Thanks for the attention.


How to speed up recursive compiled functions?

I'm trying to speed up the recursive function that calculates Rotation numbers:               ClearAll[θ]     θ[n_, Ω_, k_] := θ[n, Ω, k] = θ[n - 1, Ω, k] + Ω -         k/(2 π) Sin[2 π θ[n - 1, Ω, k]]     θ[0, Ω_, k_] := 0      Notice that I'm using memoization. Here's the timing of the uncompiled function:               AbsoluteTiming[Table[θ[n, .2, 1]/n, {n, 1, 1000}];]      > >     {0.016223, Null} >   Now I tried compiling the recursive function:               ClearAll[compθ]     compθ =       Compile[{{n, _Integer}, {Ω, _Real}, {k, _Real}},       If[n == 0, 0,        compθ[n - 1, Ω, k] + Ω - k/(2 π)Sin[2 π compθ[n - 1, Ω, k]]],       {{compθ[_, _, _], _Real}},        CompilationOptions -> {"InlineCompiledFunctions" -> True,          "ExpressionOptimization" -> True}, RuntimeOptions -> {"Speed"}]      The timing of the compiled function is worse:               AbsoluteTiming[Table[compθ[n, .2, 1]/n, {n, 1, 1000}];]      > >     {0.342844, Null} >   Of course the timing could be improved if I could somehow use memoization with the compiled function, but I couldn't find any example that shows how to do it. Is it possible? I also noticed with `CompilePrint` that the compiled function calls MainEvaluate, which is probably slowing the computation, but this comment suggests that this may be unavoidable. Is this true?


Simplify square roots

If I simplify an equation like Sqrt[A^5]+5*Sqrt[A^3]-Sqrt[A] then I get (A^2+5A-1)*Sqrt[A] with no problems. But when I need to simplify Sqrt[(A^5) (1 + a) ] + 5 Sqrt[A^3 (1 + a)] - Sqrt[A (1 + a)] as (A^2+5A-1)Sqrt[A (1 + a)], I get the original one: > >     Sqrt[(A^5) (1 + a) ] + 5 Sqrt[A^3 (1 + a)] - Sqrt[A (1 + a)] >   > > I tried `Simplify`, `FullSimplify`, `Expand`, `Factor`, but they all return > the original equation. What is going on behind the scenes ?


Giving a custom style a colored gradient background

In _Mathematica_ , customizing Sections, Subsections, Titles and so on, can be done with Format > Style > .... Changing the background color of a style is one of the things you can do. Here is an example where I have colored the background orange: ![enter image description here](http://i.stack.imgur.com/NNIp6.png) But I want to change the background to show a color gradient. I mean, instead of having the same orange in all of the background, there should be a gradient so the orange fades from top to bottom. Gradient styles will be found in Palettes > Color Schemes. But I can't get it to work for changing the color of a cell background.


How to change Mathematica cursor globally?

I usually use my OS with negative colors (to keep my eyes calm...). I had seen a function called `MouseAppearence` that changes the cursor. I would like configure _Mathematica_ to use another cursors on all notebook area. I need this because when I turn the color to negative the cursor disappears. This would be very useful to me. Someone knows how can I do this?


Why does this Quantity calculation lose precision?

(Sqrt[#] Sqrt[Quantity[2, "ElectronMass" ("SpeedOfLight")^2] + #] )/(       Quantity[1, "ElectronMass" ("SpeedOfLight")^2] + #) &[      Quantity[50, "Gigaelectronvolts"]]     (* 1.00000 *)     InputForm[%]     (* 0.99999999994777708655477259390422583293`6.882488164549814 *)      The precision is only 6 digits, which is anomalously low. I'm expecting about 0.999999999948, so that `InputForm` magnitude is not just a floating-point error. I'm aware that the physical constants involved, including the ones on which the units depend, are not themselves known to very high precision. But it seems to me that the structure of the expression should allow Mathematica to keep a great deal more precision than it shows me.


To solve an equation

I am trying to solve the equation:               Solve[Re[Integrate[(2 c - (r^2) Exp[- I 1.4746])^(0.5), {r, 0, 31.7576}]] == 2.1216, c]      I want to integrate an expression in the unknown $c$, in some integration interval, then evaluate the real part, and at last solve the equation, and obtain $c$. I don't know why nothing has been returned.


Assuming seems not working and "Solve::svars: Equations may not give solutions for all "solve" variables." issue

I am trying to solve these equations                   Assuming[{x1 ∈ Reals && x1 > 0 && x1 < 1},       Solve[{(a3 - r2)^2 + (b3 + r2 - 1)^2 ==          r2^2, (a6 - r2)^2 + (b6 + r2 - 1)^2 == r2^2,         b5 == k1*(a5 - 1) + 1, b3 == k1*(a3 - 1) + 1,         b2 == k1*(a2 - 1) + 1, b6 == k2*(a6 - a1) + b1,         b4 == k2*(a4 - a1) + b1, (a2 - 1/2)^2 + (b2)^2 ==          1/4, (a1 - 1/2)^2 + (b1)^2 == 1/4, (a4 - x1)^2 + (b4 - y1)^2 ==          r1^2, x1 + r1 == 1, (a5 - x1)^2 + (b5 - y1)^2 ==          r1^2, (y1 - b4)*k2 == -(x1 - a4), (b1)*k2 == -(a1 - 1/2), (b2)*          k1 == -(a2 - 1/2), (1 - r2 - b3)*k1 == -(r2 - a3), (1 - r2 - b6)*          k2 == -(r2 - a6), (b5 - y1)*k1 == -(a5 - x1)}, {x1, y1, r1, r2,         k1, k2, a1, a2, a3, a4, a5, a6, b1, b2, b3, b4, b5, b6}]]      And it does output a valid solution > >     x1 -> 5/6, y1 -> 2/3, r1 -> 1/6, r2 -> 1/4, k1 -> 3/4, k2 -> -(4/3), >     a1 -> 9/10, a2 -> 1/5, a3 -> 2/5, a4 -> 7/10, a5 -> 11/15, a6 -> 9/20, >     b1 -> 3/10, b2 -> 2/5, b3 -> 11/20, b4 -> 17/30, b5 -> 4/5, b6 -> 9/10 >   But it also outputs a bunch of other invalid/undesired "solutions". I was trying to limit the output by using `Assuming`, apparently it does not work though. Also, the console outputs > >     Solve::svars: Equations may not give solutions for all "solve" > variables. >   However, I clearly gave 18 variables with 18 equations. Why so? My mma is 9.0.0.0. on mac.


How to represent very long integers with at-most-8-digit(base-10) short integers with * and +

I need an algorithm in Mathematica, which can represent any very long integer, prime or not, into the the product operation "*" and sum "+" forms by short integers (not more than 8 decimal digits). Additional rules on the final expression of the very long integer are: (1). the lengths (base-10 decimal digits) of all short prime integers employed should be as close to 6 as possible, the closer the better; if there are _n_ different short integers used, we use the sum of squared differences between their lengths and 6 as the criterion: the smaller the better (first priority); (2). the less "+" operators used the better (second priority); the less "*" the better(the third priority). The final expression of the integer should be usable immediately in C/C++. Example numbers for testing:               29427736469514379027531261659072347     58899562724319710108573382000184640     1732944474195510410991057714955859184      Is there any Mathematica implementation of such algorithm? Thanks!


Non-numerical value for a derivative on NDSolve function

I am trying to solve the following system of differential equations:               eqn1 = m1 x1''[t] + k1 (x1[t] - x2[t]) + c1 (x1'[t] - x2'[t]) == 0;     eqn2 = m2 x2''[t] + k1 (x2[t] - x1[t]) + c1 (x2'[t] - x1'[t]) + k2 (x2[t]) + c2 (x2'[t])     ==c2*(1.09013 Cos[Pi*13.88*t]) + k2*(0.025 Sin[Pi*13.88*t]);      To solve them I am using the following code for `NDSolve`:               ivals = {x1[0] == 0, x1'[0] == 0, x2[0] == 0, x2'[0] == 0};     soln = NDSolve[{{eqn1, eqn2}, ivals}, {x1[t], x2[t]}, {t, 0, 10}];      When I try to solve this I get the following error message: > NDSolve::ndnum: Encountered non-numerical value for a derivative at t == 0 And I don't understand why. I would very much appreciate some help.


Memory Leak in Frontend - anyone know a workaround?

When using Rasterize on a Graphics expression composed of many differently coloured Graphics objects memory is allocated in the frontend which is then not released or reused when a similar graphic object is created. Rasterize (or its underlying machinery) is used underneath Export when a graphic object is exported using Export, for instance when creating a jpg file. In the example given 4 MB of memory is allocated each cycle but not freed. Eventually the frontend will crash.               Do[Sleep[3]; img = Rasterize[Graphics[Table[       { ColorData["TemperatureMap"][RandomReal[]], Circle[{RandomReal[], RandomReal[]}, 1.0] },        {1000}]]], {1000}];       Does anyone know if this is a known bug and if there are any workarounds pending a fix from Wolfram?


How do I draw a DensityPlot in polar coordinates?

I am trying to plot $J_m(\chi_{mn} r) \cos(m\phi),$ where $J_m(\chi_{mn}) =0,$ as a `DensityPlot` in polar coordinates (solution to 2D wave equation in polar coordinates). First, some definitions               besselzero = N@Table[BesselJZero[l, n], {l, 0, 25}, {n, 1, 25}];     bzeros[l_, n_] := besselzero[[l + 1, n]];      for speed purposes. For the purposes of this question consider $m=3$ (but there's essentially the same problem for any $m$):               DensityPlot[      Cos[3 ArcTan[y/x] ] BesselJ[3, bzeros[3,1]Sqrt[x^2+y^2]],{x,-1,1},{y,-1,1},      Epilog->{Thick,Circle[]},PlotRange->{-1,1},      RegionFunction->Function[{x,y,z},Norm[{x,y}]<1.]]      ![Mathematica graphics](http://i.stack.imgur.com/SWnqz.png) This is _nearly_ right, except that the sign on the left-hand side ($y<0$) of the plot is wrong (it should not be mirror symmetric around $y=0$, rather continue alternating positive and negative after each $\Delta\phi=\pi/3$). Looking at the `Plot3D` of `ArcTan[y/x]` I realized the cause of the problem was because of how `ArcTan` is defined, so I tried a workaround:               DensityPlot[      Cos[ 3 Piecewise[{{0, x > 0 && y == 0}, {\[Pi]/2,             x == 0 && y > 0}, {(3 \[Pi])/2, x == 0 && y < 0}, {(2 \[Pi])/2,             x < 0 && y == 0}, {ArcTan[y/x],             x > 0 && y > 0}, {ArcTan[y/x] + \[Pi],             x < 0 && y > 0}, {ArcTan[y/x] + \[Pi],             x < 0 && y < 0}, {ArcTan[y/x] + 2 \[Pi],             x > 0 && y < 0}}] ] BesselJ[3,         bzeros[3, 1] Sqrt[x^2 + y^2]], {x, -1, 1}, {y, -1, 1},      Epilog -> {Thick, Circle[]}, PlotRange -> {-1, 1},      RegionFunction -> Function[{x, y, z}, Norm[{x, y}] < 1.]]      ![Mathematica graphics](http://i.stack.imgur.com/LuSwG.png) This is _nearly_ right, except for those white regions. Is there a better way to plot functions of this sort?


Padding sub-lists in a list

I have a list, say `Alist``               Alist = {{1}, {2}, {1, 3}, {4, 5, 6}, {4}};      and want a list, `Blist` such that               Blist = {{0, 0, 1}, {0, 0, 2}, {0, 1, 3}, {4, 5, 6}, {0, 0, 4}};      What I mean is that, if the set of numbers in Alist has the length smaller than 3, then I want to pad zeros on the left until the whole sub-list has length 3. This should be quite a simple problem, but somehow I could not successfully get a program done (issue with defining conditional variables in the Do and If in each set of loop running). Can someone provide an answer and a short program command for it? The simpler the better.


Riffle and Partition

At some point I noticed that I was using `Riffle` and `Partition` together a lot. I would do things like               Partition[Riffle[{1,2,3},{4,5,6}],2]      or               Partition[Riffle[{1,2,3}, 6 , {2, -1, 2}], 2]      The question is: are better alternatives, in terms of memory and speed?


Facegrids at ticks

I want to plot a 3D graphic and I want facegrids at the ticks that I specify. I've tried several solutions but I cannot get this working. The result with the code provided below is that it does its job except in the x-axis where it only draws a facegrid at the middle coordinate (and not in all ticks). Any advice is most welcome. Here is my code:               Plot3D[exp[R, bn, 50], {R, 2, 100}, {bn, 1, 5},            AxesStyle -> Thickness[0.005],            Ticks -> {{2, 10, 20, 30, 50, 100}, {1, 2, 3, 4, 5},                       {0.5, 1.0,1.5, 2.0, 2.5}},             Boxed -> False,            Mesh -> {{0, 2, 5, 10, 15, 20, 30, 40, 50, 60, 70, 80, 90, 100},                      {1,1.5, 2, 2.5, 3, 3.5, 4, 4.5, 5}},             PerformanceGoal -> "Quality",            FaceGrids -> All,            AxesLabel -> {"X","Y","Z"}     ]      ![Mathematica graphics](http://i.stack.imgur.com/KKEUo.png)


Why Interpolation makes ListPlot3D slow?

I'm trying to use `ListPlot3D` to plot some data, and I'm using the `InterpolationOrder` option to make the plot smoother. But the output plot is not very responsive when rotate or edit with the drawing tool. Here is an example:               ls = Table[Sinc[x*y], {x, -10, 10, 0.2}, {y, -10, 10, 0.2}];     ListPlot3D[ls, PlotRange -> All]      ![enter image description here](http://i.stack.imgur.com/l0mny.jpg) setting `InterpolationOrder->2` gives a smoother plot, ![enter image description here](http://i.stack.imgur.com/eCWs9.jpg) The problem is the second plot response very slowing when rotate with the mouse. So is it possible to produce an interpolated smooth but very responsive plot? Here is what I've tried so far               f = ListInterpolation[ls, {{-10, 10}, {-10, 10}}];     ListPlot3D[Table[f[x, y], {x, -10, 10, 0.1}, {y, -10, 10, 0.1}],       PlotRange -> All];      this gives nicer plot than the first one, but is still seems not as good as the second one. Adding more points seems makes the plot unresponsive.


Numerical evaluation of a sum

I am trying to compute numerically `NSum[(-1)^n/n^3, {n, 1, Infinity}]`. Of course, using first `Sum` would work here, but often it's not an option (no closed-form). I would like to compute the sum with an arbitrary number of digits. So far, I've found that               NSum[(-1)^n/n^3, {n, 1, Infinity},      WorkingPrecision -> 24,       AccuracyGoal -> 24, PrecisionGoal -> Infinity]      Will give only 16 digits (`-0.9015426773696957`), whatever the value of `WorkingPrecision` and `AccuracyGoal`. However, if I add the option `Method -> "AlternatingSigns"`, I get as many digits as I want, and it's really controled by `WorkingPrecision`. Among the other options, `Method -> "EulerMaclaurin"` gives a wrong answer. Not all digits are correct, and there is an imaginary part: `-0.901542677369695714049804 + 15.503138340149910087738157 I`. And `Method -> "WynnEpsilon"` also fails, giving `-0.9015426773696957140`, even if I ask for more digits. So, is there something I'm doing wrong? Is there a reason it does not work if I don't give a specific method? Is there a more straightforward way to compute a sum (or any numerical result, for that matter)? And, since I'm quite interested by numerical computations with Mathematica and I'm a beginner (with Mathematica, not with numerical analysis :-)), is there a good guide out there ? As an aside, I know Maxima better, and I'm used to the option `fpprec`, that controls "bigfloat" evaluation in every computations. Is there something similar in Mathematica? I think it has a better control of accuracy, so maybe the question does not make sense (maybe there is no "global" setting). * * * To answer rasher's comment, since there is not much space in comments: Actually, if I use larger values of the option `NSumTerms`, I get more and more digits, but they don't agree with what I get with `Method -> "AlternatingSigns"`:               NSum[(-1)^n/n^3, {n, 1, Infinity}, WorkingPrecision -> 50,       AccuracyGoal -> 50, PrecisionGoal -> Infinity, NSumTerms -> 5000]      -0.90154267736969571404980362113358749307373971926               NSum[(-1)^n/n^3, {n, 1, Infinity}, WorkingPrecision -> 50,       AccuracyGoal -> 50, PrecisionGoal -> Infinity,       Method -> "AlternatingSigns"]      -0.90154267736969378050491347983360150530995076960417 After 14 digits, they are different numbers. And here it's possible to check:               Sum[(-1)^n/n^3, {n, 1, Infinity}] // N[#, 50] &      -0.90154267736969571404980362113358749307373971925537 So, the answer with `Method -> "AlternatingSigns"` is also wrong! And it's not better if I combine `Method` and `NSumTerms` options:               NSum[(-1)^n/n^3, {n, 1, Infinity}, WorkingPrecision -> 50,       AccuracyGoal -> 50, PrecisionGoal -> Infinity,       Method -> "AlternatingSigns", NSumTerms -> 5000]      -0.90154267736969571404546474460914681065800480608588 So the results differ after 20 digits. Now I'm even more puzzled :-) I can see that your comment is right, since I get the right answer, but I absolutely don't understand why, and why the other methods fail without notification. Also, it's not a very satisfying approach, since I can't set the number of accurate digits in the output (it depends on `NSumTerms` in a non obvious way).


How do I call a 32-bit DLL using .NET/Link and a 64-bit version of Mathematica?

The .NET/Link tutorial shows how to call functions defined in DLLs. The example uses the `GetTickCount` Win32 API function               << NetLink`     InstallNET[]     getTickCount = DefineDLLFunction["GetTickCount", "kernel32.dll", "int", {}]          getTickCount[]          (* ==> 91226108 *)      Unfortunately this does not work by default when usign a 64-bit version of Mathematica to call a function defined in a 32-bit DLL. Let's use the 32-bit version of `kernel32.dll` to test:               getTickCount =       DefineDLLFunction["GetTickCount", "c:\\windows\\SysWOW64\\kernel32.dll", "int", {}]          getTickCount[]          NET::netexcptn: A .NET exception occurred: System.BadImageFormatException:         An attempt was made to load a program with an incorrect format.         (Exception from HRESULT: 0x8007000B)        at Wolfram.NETLink.DynamicDLLNamespace.DLLWrapper15.GetTickCount().      How can I call a 32-bit DLL from a 64-bit Mathematica?


Why is this infinite series wrongly computed by Mathematica?

Could you let me know if _Mathematica_ (newer versions) is able to correctly compute this one?               Sum[(-1)^(n + 1) Cos[3^n x]^3/3^n, {n, 1, Infinity}]


How to widen PlotLegends?

I have a plot whose legend, when placed at the bottom, is two lines rather than one:               Plot[{x, x^2}, {x, 0, 5}, PlotRange -> {0, 5}, PlotLegends -> Placed[Abs /@ {Subscript[a, 2]/Subscript[a, 1], Subscript[a, 3]/Subscript[a, 1]}, Below]]      If I do the same thing without the absolute value signs, it plots in a row as I'd like:               Plot[{x, x^2}, {x, 0, 5}, PlotRange -> {0, 5}, PlotLegends -> Placed[{Subscript[a, 2]/Subscript[a, 1], Subscript[a, 3]/Subscript[a, 1]}, Below]]      I'm guessing the absolute value signs make this slightly too wide, but putting the two legends side by side would clearly fit into the plot. I've spent a while digging through the documentation and cannot figure out how to do this - help would be appreciated!


Listplot imaginary part of complex numbers

I have the following list               w={{0.01,99 +0.00001414 I},{0.15,6.6370108 +0.003144129 I},{0.25,3.9515722 +0.00854493297 I},{6,0.10041 +0.28132187 I}}      and I want to `ListPlot` the imaginary part but with the command `Im[w]` I get the list               {{0,0.00001414},{0,0.00314413},{0,0.00854493},{0,0.281322}}      This way I basically lose the x axis values 0.01, 0.15, 0.25 and 6. How can I get in a list the imaginary part and the x axis values? (With `Re[w]` I can get the real part right, the 0.01, 0.15 etc don't change)


How to hide Box in Graphics3D?

I might be doing something stupid, but I can't see what it is. This simple example shows that I'm trying to hide the Box, but failing. (I tried it just once, in different positions, too.) The code is a little weird, so that might be the problem...               splot1 = SphericalPlot3D[        Cos[\[Theta]], {\[Theta], 0, Pi}, {\[Phi], 0, Pi}, Mesh -> None,         Boxed -> False, PlotPoints -> 80];          aGraphicsComplex = splot1[[1]];          Graphics3D[{Boxed -> False,        Lighting -> {{"Point", RGBColor[1, .9, .9], {2, 2, 4}}},        Boxed -> False,       aGraphicsComplex /. GraphicsComplex[pts_, objs__] :>          GraphicsComplex[          With[{r = 4 Sin[11 (ArcTan[#[[1]], #[[2]]] + #[[3]] )]},             {r, r, 2} #] & /@ pts, objs]}]      ![the box that won't go away](http://i.stack.imgur.com/z1XgV.png)


Import invocation fails with Get::noopen : Cannot open JLink error

The following function call fails when I invoke it in a fresh _Mathematica_ session:               z1 = Import["Hydrogen Z1.xlsx",         Path -> "F:\\Mathematica Projects\\NIST x-ray attenuation data"][[1]]      The path exists and the Excel file exists in that path, but I get the following errors when I invoke the function:               Get::noopen: Cannot open JLink`. >>     Needs::nocont: Context JLink` was not created when Needs was evaluated. >>     Part::partd: Part specification Null[[1]] is longer than depth of object. >>     Part::partd: Part specification Null[[1]] is longer than depth of object. >>      The result returned is `Null[1]` On the other hand, if I invoke the `Import` function to try to fetch data from a web page using the following command, I get no errors:               Import["http://physics.nist.gov/PhysRefData/XrayMassCoef/ElemTab/z56.html", "Data"]      Unfortunately, there are some problems with the way the data is formatted (which is why I downloaded the data into the Excel files in the first place). Strangely, after using Import to fetch data from the web, the original function call to Import to read the Excel files works just fine without error. This leads me to believe that the failure of the first command occurs because some package is needed but not loaded by default and Import is smart enough to load this package when fetching data from the web but not when attempting to read Excel file data locally. So, presumably a `Needs` statement is needed. What package do I need to load to make this work on the first try (if that is indeed the problem)? Or is the problem something else altogether?


How to make AutoAction take effect only one time?

**WARNING** : better don't try this when you have any relevant notebooks open, the generated palette will edit your currently selected notebook in ways which are not easily noticed or undone! `AutoAction` will repeatedly take effect when cursor over the button of pallete.               Cell[BoxData[\(\(CreatePalette[\({\(Button[\("Create Inline Cell", \(\(FrontEndExecute[\(FrontEndToken["CreateInlineCell"]\)]\)[\(NotebookRead[\(InputNotebook[]\)]\)]\), \(AutoAction -> True\)\)]\)}\)]\) ;\)], "Input"]      Here is one pallete to create inline cells, I wish it would perform only once when the selected content is the same. How to make `AutoAction` Take effect only for different selected contents Welcome to add an button to revert the value, ie convert new generated inline cell back to the prevous state(maybe plaintext). What is the same content: In one Text Cell, content is `who are you`. when selected content is `who`, just convert `who` into one inline cell, if second time, i select `who are` they are not the same contents.


MatrixPlot with Tooltips

`MatrixPlot` is very nice to have a first look of data, I would like to have a `MatrixPlot` with tooltips for each value. I tried adding `Tooltip` to all the values but it didn't work. My matrix is not very big (~20x25), so each square is visible. **EDIT:** This is the version I did using the answer of Heike:               matPlot[matWithTooltips_, opts : OptionsPattern[]] :=       With[{dim = Dimensions[matWithTooltips],         mat = matWithTooltips /. Tooltip[a_, ___] :> a},       DynamicModule[{pt = {0, 0}, ij, xy, label, direction},        direction[mxy_] := 1 - 2 Boole[Thread[mxy > dim/2]];        LocatorPane[Dynamic[pt],         Dynamic[          xy = Floor[pt];          ij = {dim[[1]], 1} + Cross[xy];          label = If[And @@ Thread[1 <= ij <= dim],            {{FaceForm[], EdgeForm[{Thick, LightGray}], Rectangle[xy]},             Text[              Framed[Replace[                Extract[matWithTooltips, ij], {Tooltip[a_, b_] :> b,                  Tooltip[a_] :> a}], Background -> White],              direction[xy] + xy,              -1.2 direction[xy]]},            {}];          MatrixPlot[mat, Epilog -> label, opts]],         AutoAction -> True,         Appearance -> None]]]      The main improvement is that it can receive a matrix with its own tooltips in the data. Thanks to all for the help.


how to solve a linear system (Ax=b) using domain decomposition?

The Domain decomposition is a natural technique for reducing the computational cost for solving large-scale linear systems, somebody know how to do it using mathematica?


CreateDialog behaves differently in Player Pro

nm = "start";          d1 :=        Dynamic[Grid[{{         TextCell["Enter a name: "],         InputField[Dynamic[nm], String],         DefaultButton[DialogReturn[ret = nm]]}}]];          CreateDialog[TabView[{"dlg1" -> d1, "dlg2" -> d1}], WindowTitle -> "tt"];      In _Mathematica_ initially the edit box will show `Start`. After exiting the dialog both variables, `ret` and `nm`, will have value that was entered in the box. In Player Pro the initial value of `nm` is not shown in the edit box and the entered value is not assigned to the variables. What is the reason for that and how to pass values in and out of the dialog in _Player Pro_ or better how to make the code exhibit the same behaviour? Both _Mathematica_ and _Player Pro_ are _v9_. I believe the player in previous versions behaved like _Mathematica_.


How to plot the product of the NDSolve result and any known function

How can I plot the product of the `NDSolve` result, e.g. `x[t]/.solution` and any known function, for instance, `Sin[x]`?


Finding "Maxima" and "Minima" on a B-Spline

I need to find the "Maxima" and "Minima" on a B-Spline or more correct the points where the 2nd components of the derivate equal zero. For example:               g = BSplineFunction[{{1, 2}, {2, 4}, {3, -1}, {4, 2}}] ;      dg=g';     Solve[{dg[t][[2]] == 0, 0 <= t <= 1}, t]      The problem is that "Solve" wont work for this kind of application, and "Minimize" or similar functions stop at the first finding. Any ideas?   CX


Real and/or improved CForm of expressions

I'd quite like to be able to automatically generate C++ versions of certain mathematical expressions that I've manipulated in Mathematica. The resultant C++ code fragment is then going to be used independently of Mathematica. Mathematica provides a `CForm` function, which almost seems like what I want, but I can't get it to do basic conversions nor tell it how to convert Mathematica symbols into my C++ identifiers. **For example, I would like the output from`CForm[x[0]^2]` or `ToString[x[0]^2, CForm]` to be `"std::pow(obj.x_[0], 2)"`.** This can be a string; it doesn't need to be usable in Mathematica any more. Of course, my actual expressions of interest are a lot more complicated than this. But:   * I don't have a way of telling Mathematica that symbol `x` is to be renamed to `obj.x_` (not a valid symbol name in Mathematica so can't use it directly). String manipulation after conversion is too unreliable for this so a more direct method is preferred.   * I can't tell Mathematica that `x` is an array, not a function, so it gives me `x(0)` instead of `obj.x_[0]`.   * Mathematica thinks I want to use its own `Power` function, but I'd really like to use `std::pow`. Perhaps `CForm` isn't suited to this task, but I would still appreciate a solution using any other available method if possible. I really think that Mathematica should be able to help me here, because it knows where I need brackets and so on. I've tried:               Format[x[a_], CForm] :=         "obj.x_[" <> ToString[a, CForm] <> "]"          Format[Power[a_, b_], CForm] :=          "std::pow(" <> ToString[a, CForm] <> ", " <> ToString[b, CForm] <> ")"          ToString[x[0]^2, CForm]      but of course `Power` is protected so the second `SetDelayed` gives me an error, and my `ToString[x[0]^2, CForm]` output is really weird (`Power("obj.x_[0]",2)`) because I've tried to use strings in the `Format`.


Is it possible to show Tooltips in a ListPicker menu? This effect is possible using TabView, but I would much prefer using ListPicker. Below is a simplified version of my code.               ItemList =       {"Apples",        "Oranges",        "Bananas",        "Watermelon"};     ReviewsList =       {"10 Reviews",        "7 Reviews",        "16 Reviews",        "12 Reviews"};     TooltipList =       {"5 Positive, 3 Neutral, 2 Negative",        "4 Positive, 1 Neutral, 2 Negative",        "10 Positive, 2 Neutral, 4 Negative",        "6 Positive, 3 Neutral, 3 Negative"};     CombinedList = Table[Column[         {Style[ItemList[[i]], FontColor -> Purple,            FontFamily -> "Verdana", FontSize -> 12, FontWeight -> Bold],          Tooltip[           Style[ReviewsList[[i]], FontFamily -> "Verdana",             FontSize -> 12], TooltipList[[i]]]}         ], {i, 1, 4}];          (* Column *)     Column[CombinedList]          (* TabView *)     TabView[Table[CombinedList[[i]] -> 1, {i, 1, 4}], Dynamic[x],       ControlPlacement -> Left]          (* ListPicker *)     ListPicker[Dynamic[x], CombinedList]


Incrementally revealing Grid (or TableForm) entries

I have a `Grid` (or `TableForm`) object like this `Grid[{{Ins, Outs}, {a, b}, {c, d}, {e, f}}, Frame -> All]` ![enter image description here](http://i.stack.imgur.com/nFp9q.png) that I would like to "incrementally reveal" (within a `Manipulate`) in the sense, for example, that one row at a time is revealed with each click of the `Manipulate`. The part giving me trouble is that I want to "fill in" the table from _bottom to top_ , while maintaining the (final) header cells and grid lines throughout each incremental reveal. I started out by filling the yet-to-revealed entries with white space (until they are revealed). This is fine for small tables like this, but I also need it to work for tables with dozens of rows so I am seeking something more systematic. Any hints/tips/nudges would be appreciated. **Edit:** To clarify, the desired behavior is like this:               one = Grid[{{Ins, Outs}, {, }, {, }, {e, f}}, Frame -> All];     two = Grid[{{Ins, Outs}, {, }, {c, d}, {e, f}}, Frame -> All];     three = Grid[{{Ins, Outs}, {a, b}, {c, d}, {e, f}},        Frame -> All];      Manipulate[{one, two, three}[[i]], {i, {1, 2, 3}}]      ![enter image description here](http://i.stack.imgur.com/wJoTH.png) ![enter image description here](http://i.stack.imgur.com/MMmel.png) ![enter image description here](http://i.stack.imgur.com/owg6U.png)


How to dynamically update a variable by using mouse over?

I want to extract the `Graphics` type when I hover my mouse over an object, but I failed to do so. Below is the code I am working on. Any suggestions are welcome               m = "E";     Graphics[{        Mouseover[ {Black, Disk[{-10, 0}]}, {m = "D"; Red, Disk[{-10, 0}]}],       Mouseover[ {Black, Rectangle[{10, 0}]}, {m = "R"; Red,          Rectangle[{10, 0}]}]       ,  Text[Dynamic[m], {0, 0}]       }]


How can I create a list containing the normalized element-by-element product of two given lists?

I have to calculate: ![enter image description here](http://i.stack.imgur.com/nfbVq.jpg) How can I create such a sum? Do I have to set the factors of each term manually (one by one), like `G1 = 1, H1 = 1, G2 2, H2 = ...`.? ### Update ![enter image description here](http://i.stack.imgur.com/UxKzV.jpg) Addtional Questions:   1. How can I store te results into another List? (In this example, the list `F`)   2. Sometimes, a variable turns blue and does not get calculated in expression. How do I fix this?


Fast way to extract data from a list

I used `data=Table[{i,f[i]},{i,1,n}]` to produce a list, here `n` is greater than 2^20 = 1048576. The function f(N) runs in time `O(N*Log(N))`, it is defined as:               Mod[PowerMod[i,n,n]-i,n] (n is an argument in a function which use this)      Now I want to give a table which shows the values of i that f(i) is 0, and another table for f(i) non-zero. I used `zero = Select[data,#[[2]]==0&]`, but it is slow in the following sense:               n=2^22, timing for data =  10.171, timing for zero =  4.508     n=2^23, timing for data =  21.606, timing for zero =  9.250     n=2^24, timing for data =  43.399, timing for zero = 17.971     n=2^25, timing for data =  84.209, timing for zero = 34.523     n=2^26, timing for data = 167.420, timing for zero = 71.885      The hardest computation is the `data`, But after that I want to have a much faster way to know the zeros of the function `f`. Of course I can use `For` or `Do` to append the zeros `i` each time f(i) is zero. But we know that `AppendTo` is slow, and `For` or `Do` is slower than `Table`. Is there any way to construct a list + exact data fast? * * * Update: Thanks for all the suggestion. Here is a table of comparison. The green columns is to find i such that `f[i]=0` and the white columns (excluding the 1st and 2nd column) is to find i such that `f[i]!=0`. The last 2 columns are in fact using "NonzeroPositions" (the last column) as mentioned by ubpdqn, then do the complement (the second last column). This method is faster. ![enter image description here](http://i.stack.imgur.com/jucJm.png)


How to loop in reverse order?(e.g. for i from 10 to 1)

I have a list `F = {382.856, 638.53, 915.482, 1192.44, 1469.39, 1746.34, 2023.29, 2181.91}` And I want to use it to calculate V: ![enter image description here](http://i.stack.imgur.com/ZaVI3.jpg) I think it should be something like: `V = Table[ V[i] = V[i+1] + F[i], {...loop in reverse order}]`, I'm not sure about the expression, and didn't find options to excute loop in reverse order. In Mathematica's reference, I only find that `Do[expr,{i,imax}]` , does this mean that the loop can only go in increasing order?


Problem with PlanarGraphPlot And ConvexHull

I'm getting a lot of strange errors when using `PlanarGraphPlot` with a simple list of 11 points. This is using Mma 9.0.1 64-bit Mac OS X.               << ComputationalGeometry`;     x = {{184978.59580704456`, 77909.66948289984`},           {184978.27815712072`,77909.76595227784`},          {184978.27082673783`, 77909.74177736834`},          {184977.5543690799`, 77909.95958192856`},          {184977.65873976916`, 77910.2913545858`},          {184977.87393886593`, 77910.32174601014`},          {184978.3127146399`, 77911.75682671613`},          {184979.13720817852`, 77911.37094455786`},          {184979.40459261995`, 77911.34308556134`},          {184979.6157774594`, 77912.04232488069`},          {184980.40222282038`, 77911.69604330455`}};     PlanarGraphPlot[x]      Errors I get are               Mod::indet: Indeterminate expression Mod[-1,0] encountered. >>          Part::partw: Part 1 of {} does not exist. >>          Part::pspec: Part specification Indeterminate is neither a machine-sized integer nor a list of machine-sized integers. >>          Part::pspec: Part specification {{4,2},{1,4,6},{6},{7,2,1},{6,6},{2,5,6,3,5},{11,10,9,4},{},{7,10},{9,7,11},{10,7}}[[8,1]] is neither a machine-sized integer nor a list of machine-sized integers. >>          Part::pspec: Part specification {{4,2},{1,4,6},{6},{7,2,1},{6,6},{2,5,6,3,5},{11,10,9,4},{},{7,10},{9,7,11},{10,7}}[[8,1]] is neither a machine-sized integer nor a list of machine-sized integers. >>          General::stop: Further output of Part::pspec will be suppressed during this calculation. >>          Part::partw: Part 1 of {} does not exist. >>          Set::shape: Lists {ComputationalGeometry`Private`merge$30945[[ComputationalGeometry`Private`l0$30945]],ComputationalGeometry`Private`merge$30945[[ComputationalGeometry`Private`r0$30945]]} and ComputationalGeometry`Private`insert[{{4,2},{1,4,6},{6},{7,2,1},{6,6},{2,5,6,3,5},{11,10,9,4},{},{7,10},{9,7,11},{10,7}}[[{6,{{4,2},{1,4,6},{6},{7,2,1},{6,6},{2,5,6,3,5},{11,10,9,4},{},{7,10},{9,7,11},{10,7}}[[8,1]]}]],6,{{4,2},{1,4,6},{6},{7,2,1},{6,6},{2,<<3>>,5},<<1>>,{},{7,10},{9,7,11},{10,7}}[[<<1>>]],2,3] are not the same shape. >>          Mod::indet: Indeterminate expression Mod[-1,0] encountered. >>          Part::partw: Part 1 of {} does not exist. >>          General::stop: Further output of Part::partw will be suppressed during this calculation. >>          Set::shape: Lists {ComputationalGeometry`Private`merge$33935[[ComputationalGeometry`Private`l0$33935]],ComputationalGeometry`Private`merge$33935[[ComputationalGeometry`Private`r0$33935]]} and ComputationalGeometry`Private`insert[{{4,2},{1,4,6},{6},{7,2,1},{6,6},{2,5,6,3,5},{11,10,9,4},{},{7,10},{9,7,11},{10,7}}[[{6,{{4,2},{1,4,6},{6},{7,2,1},{6,6},{2,5,6,3,5},{11,10,9,4},{},{7,10},{9,7,11},{10,7}}[[8,1]]}]],6,{{4,2},{1,4,6},{6},{7,2,1},{6,6},{2,<<3>>,5},<<1>>,{},{7,10},{9,7,11},{10,7}}[[<<1>>]],2,3] are not the same shape. >>          Mod::indet: Indeterminate expression Mod[-1,0] encountered. >>          General::stop: Further output of Mod::indet will be suppressed during this calculation. >>          Set::shape: Lists {ComputationalGeometry`Private`merge$35305[[ComputationalGeometry`Private`l0$35305]],ComputationalGeometry`Private`merge$35305[[ComputationalGeometry`Private`r0$35305]]} and ComputationalGeometry`Private`insert[{{4,2},{1,4,6},{6},{7,2,1},{6,6},{2,5,6,3,5},{11,10,9,4},{},{7,10},{9,7,11},{10,7}}[[{6,{{4,2},{1,4,6},{6},{7,2,1},{6,6},{2,5,6,3,5},{11,10,9,4},{},{7,10},{9,7,11},{10,7}}[[8,1]]}]],6,{{4,2},{1,4,6},{6},{7,2,1},{6,6},{2,<<3>>,5},<<1>>,{},{7,10},{9,7,11},{10,7}}[[<<1>>]],2,3] are not the same shape. >>          General::stop: Further output of Set::shape will be suppressed during this calculation. >>      Removing certain points from the list (like the last one) causes the plot to succeed. Also this set of points fails to give proper `ConvexHull`               y = {{1.8497859580704457`, 0.7790966948289985`},         {1.8497827815712071`, 0.7790976595227784`},         {1.8497827082673783`, 0.7790974177736835`},         {1.849775543690799`, 0.7790995958192857`},         {1.8497765873976917`, 0.779102913545858`},         {1.8497787393886593`, 0.7791032174601015`},         {1.849783127146399`, 0.7791175682671613`},         {1.8497913720817853`, 0.7791137094455786`},         {1.8497940459261994`, 0.7791134308556135`},         {1.849796157774594`, 0.7791204232488069`},         {1.849804022228204`, 0.7791169604330455`},         {1.849803552734635`, 0.7791159289575218`},         {1.8498057134522492`, 0.7791151852825192`},         {1.8498006729413692`, 0.7790991813917657`},         {1.8498002121744468`, 0.7790984699581178`},         {1.8497995890919037`, 0.7790977401058187`},         {1.8497986151981813`, 0.7790973602143807`},         {1.8497975924352397`, 0.7790973993547065`},         {1.8497955957785752`, 0.77909842160827`},         {1.8497951821355425`, 0.7790997823117062`},         {1.8497944840038416`, 0.779101624213374`},         {1.8497934996381435`, 0.7791037516125543`},         {1.8497920021456453`, 0.779106194441444`},         {1.849792775326504`, 0.7791094914607818`},         {1.8497897908134828`, 0.7791098506337076`}}     Graphics@Point@y[[ ConvexHull[y] ]]      Thanks


Determining whether two $k$-chromatic graphs are isomorphic (respecting vertex coloration)

Consider the case where I have two $k$-chromatic graphs $G_1$ and $G_2$, i.e. two graphs where individual vertices can be colored with one of a set of $k$ total colors, and I would like to determine if the two graphs are equivalent while respecting vertex coloration. Is there a way to do this in Mathematica 8 or 9? If so, is there a known computational complexity for the algorithm being employed?


What's the internal command for entering a fraction?

I'm looking for the `FrontEnd`Foo[...]`-like command that's triggered when pressing `Ctrl + /`. Are there any discoverability features in Mathematica that would have helped in this case? E.g., in Emacs I could have just pressed `Ctrl + h k Ctrl + /` ("Find function for key `Ctrl + /`").


What is the order of execution of Animate?

I used to think the execution order of `Animate` is the same as `For` until I find:               Animate[var++,{n,0,10,1}];       the var increases while `n` not. But               Animate[var=n,{n,0,10,1}];       the `n` keeps increasing. Why would this happen? If I want a expression which don't contain n to be executed only once in every step, what should I do? (Actually, I want to embed a code in my website using `CDF`. It will be OK if there are other solutions without using `Animate`.)


Is there a convenient way to copy/paste text-interspersed SE code snippets into Mathematica?

Is there a way to copy and paste code snippets from SE to _Mathematica_ if these snippets are interspersed with text? Like e.g. in Morphing Graphics, color and location in both the question and answer, there are code blocks separated by text and graphics. Pasting this into _Mathematica_ in `n` steps is tiresome. Perhaps there is some nice way to make pasting as comfortable as the other way round with the code and graphics palettes?


Speed up plot of $\sum_{j\ge1} 2^{-j}(1-2^{-j})^{n-1}$

I'm a beginner at Mathematica. I would like to plot the following function: $${n\over2} \sum_{j\ge1} 2^{-j}(1-2^{-j})^{n-1}$$ However the following code is just too slow:               Plot[n/2 NSum[2^(-j) (1 - 2^(-j))^(n - 1), {j, 1, Infinity}], {n, 1, 100}]      I think it may be trying to expand the $(n-1)$th power symbolically instead of numerically. How can I fix that?


How to find the non-differentiable point(s) of a given continuous function?

For example, the non-differentiable point of the function $f(x)=|x|$ is at $x=0$.   How to find the non-differentiable points of a continuous function that is defined numerically?


Constructing a Summation with a Variable Number of Inner Sums

I have a question regarding multiple sums. And my second index depends on the first index. Here it is: $$ \sum_{d=1}^{P}e^{-d}\sum_{\substack{1\leq k_{1}\leq Q \\\ 1\leq k_{2}\leq Q \\\\... \\\\...\\\1\leq k_{d}\leq Q}}e^{-(k_{1}+...+k_{d})} $$ I could not write this sum in mathematica. The problem is that my second sum is a multiple sum and I do not know how to sum $d$ times. How can I do it?


Finding all dictionary words that can be made with a given set of characters (Wordfeud/Scrabble)

This is a slightly more involved variant of this recent question. By sheer coincidence I happened to have been building a Wordfeud (Scrabble clone) game in Mathematica. ![Mathematica graphics](http://i.stack.imgur.com/RHMKk.png)   _My interactive Wordfeud board in Mathematica_ I used `DictionaryLookup` with `StringExpression` to find matches corresponding to my hand (7 letters) and the fixed letters in the same row on the board that can be used. With 15 characters on a row that would be a maximum of 8 extra letters at fixed positions. I believe Mr.wizard's solution of generating all permutations would be unbearably slow in this case. I wonder whether the mma.se community has better ideas for this variant. Being far removed from my own MMA installation I can't currently post what I've got so far, but will do so this weekend. My solution typically took somewhere around 10-20 secs if memory serves, which is a tad slow. The next step-up in complexity would be having to deal with all potential words crossing your row. Extra points if you have ideas to tackle that efficiently.


Thousands separator (comma) option for NumberString/StringCases?

I've been looking for a way to read numbers that have thousands separators in them:               StringCases[" 1142.123 ",  Whitespace ~~ NumberString ~~ Whitespace, 1]      gives               {" 1142.123 "}      but               StringCases[" 1,142.123 ", Whitespace ~~ NumberString ~~ Whitespace, 1]      gives               {}      So ideally there's a Mathematica way of defining `NumberString` to recognize commas in numbers. Or should I be looking into regexen at this point?


Trying to solve simultaneous equations based on format found on official website

$\def\1{x_1}\def\2{x_2}\def\3{x_3}\def\f{f(\1,\2,\3)}\def\bs{\bigskip}\def\b{\begin{pmatrix}}\def\e{ \end{pmatrix}}\def\le{\left}\def\ri{\right}\def\g{g(\1,\2,\3)}\def\l{\lambda}\def\n{\nabla}\def\x{\lambda_1}\def\y{\lambda_2}$ I am putting in the following input:               Solve[{2 + 2 a*d + 2 a*e == 0, 1 - 2 b + 2 d*b + 2 e*b == 0,        1 + 2 d*c + 2 e*c == 0, -2 + a^2 - 2 b + b^2 + c^2 ==         0, -2 + a^2 + b^2 + c^2 == 0}, {a, b, c, d, e}]      And it is returning:               (* {} *)      What am I doing wrong? Is this not computable? \begin{align} 2+2\x\1+2\y\1 = 0 \\\ %8 1+2\x\2+2\y\2-2\y = 0 \\\ %9 1+2\x\3+2\y\3=0 \\\ %10 \1^2 + \2^2 - 2\2+\3^2-2=0 \\\ %11 \1^2 + \2^2 + \3^2 - 2 = 0 %12 \end{align}


How to make 3 parameters selection and then execute, and not with each selection?

Manipulate[{u*v}, Row[{Control[{u, 0, 1}], Control[{v, 0, 1}]}],       ControlType -> VerticalSlider, ControlPlacement -> Up]      Q1.- How to select the operation *, +, - or /? in the first parameter of Manipulate Q2.- AND how to force Manipulate/MAthematica to WAIT that I modify various paramenters ( u , v and operation) to execute the operation, AND NOT make the operation in every change I made in u, and in every change of v, and in every change of "+-*/" ? . Iwant to select u, v and operation, and THEN (only whe I push a buttom or similar) execute with the parameters.


LinkSnooper troubles on Windows

I'm trying to get LinkSnooper up and working on a Windows 7 machine to monitor the interaction between the Mathematica front end and MathLink. I'm facing great troubles following the instructions here. Namely, my arguments to MLOpen are as follows:               -LinkMode Launch -LinkName "'C:/Program Files/Wolfram Research/Mathematica/9.0/SystemFiles/Java/Windows-x86-64/javaw' -classpath \"C:/Program Files/Wolfram Research/Mathematica/9.0/SystemFiles/Links/JLink/JLink.jar\" com.wolfram.jlink.util.LinkSnooper -kernelname 'C:/Program Files/Wolfram Research/Mathematica/9.0/mathkernel.exe'"      and when loading the kernel, a file system browser pops up and asks me to select a MathLink program to run. Anyone got this working on a windows machine and perhaps have some suggestions?


Multivariable Delay Diff. Equ. with Ndsolve and Nintegrate

I'm trying to simulate the following equation in _Mathematica_ for $u(x,t)$: $$\frac{1}{\alpha} \frac{\partial u(x,t)}{\partial t} = -u + \int_{-\infty}^\infty {\rm d} y w(x-y) f(u(y,t - |y|/v))$$ where $$w(z)=-\frac{w_o}{2\pi}(1-|z|)e^{-\frac{|z|}{\sigma}}, f[u] = \frac{1}{1+e^{-a(u-\theta)}}$$. So far I've written the following code to do this without the absolute value in `y`, spatial distance and time delays in $u$, which works:               h[z_Real] := Integrate[-(1/(2 Pi))*(1 - y)*Exp[-y]*(1/(1 + Exp[z])), {y, 0, 10}];          solu = NDSolve[{D[z[x, t], t] == -z[x, t] + h[z[x, t]], z[x, 0] == 0.8 Abs[Sin[x]]},                     z[x, t], {t, 0, 5}, {x, -5, 5}];          Plot3D[Evaluate[z[x, t] /. solu], {t, 0, 5}, {x, -5, 5}, PlotRange -> All]      The question I'm asking is whether it's possible to add in the delay. Unfortunately, when I include it and change the initial condition to `z[x,t/;t<=0]=0.8`, I get an error message. Does anyone have a suggestion about how I should proceed? Thanks.


How to put the labels in the minimun and maximun option in the slide verticals? Manipulate

I like this, but.. .. how could I put the labels to know +- over where value I are moving? for examples, between 0 and 8.                Manipulate[{u*v}, Row[{Control[{u, 0, 1}], Control[{v, 0, 1}]}],        ControlType -> VerticalSlider, ControlPlacement -> Up]


A simple expression which Mathematica will not simplify

Sorry for the vague title, but I wasn't sure how to phrase this. I was using _Mathematica_ to solve a fairly simple algebraic equation, but when I tried to substitute the solution into the original equation as a check, I can't seem to recover my original answer. Minimal example:               eq = a == (1 - b)/Sqrt[1 - 2 b]          sol = Solve[eq, b]          FullSimplify[(1 - b)/Sqrt[1 - 2 b] /. sol, a > 0]      The final line outputs > >     {(a (a + Sqrt[-1 + a^2]))/Sqrt[-1 + 2 a (a + Sqrt[-1 + a^2])], >      (a (a - Sqrt[-1 + a^2]))/Sqrt[-1 + 2 a (a - Sqrt[-1 + a^2])]} >   even after I've specified that a is positive. So `FullSimplify` is not enough to make this last line output `a`. What am I missing?


Are there a function to choose the greatest value in a discrete function?

Supose a discrete function show 1st, 2nd,...6th value are               h = {5, 4, 2, 8, 9, 1}      And I want to find the maximun in the subset of indexes 1,3,5,6 (what are {5,2,9,1}) Are there any function to do this easily? or Must I prgram one for doing that?


Manually adjust graph vertex location by dragging?

Sometimes I have a graph and I want to make tweaks to the vertex locations. Is there any way to manually adjust graph vertex location by dragging? If I double click to edit, I can move around the vertex rendered shape (square) or the label inside the square, but not the vertex itself. Also, even if I could move the vertex, it is under the rendered square/circle which does not seem to move with it. I have been using `GraphPlot`. (Should I be using `Graph` instead? I don't really understand the difference.):               GraphPlot[Import["D:/dev/ProjectEuler/keylog.gv"],       VertexLabeling -> True, PlotStyle -> {Black},       VertexRenderingFunction -> ({EdgeForm[Black], White, Disk[#1, 0.08],           Black, Text[#2, #1]} &)]


Prove an identity in quantum harmonic oscillator

**Problem** : In the context of quantum harmonic oscillator the eigenfunctions are given by: $ u_n(x) = (N_n/\sqrt{b}) H_n(x/b) \exp\left[-x^2/(2b^2)\right] $, where $N_n$ is the normalization factor: $ N_n = \left(\frac{1}{\sqrt{\pi} 2^n n!}\right)^{1/2} $ and $b = \left(\frac{\hbar^2}{m k}\right)^{1/4}$, where $m$ is the mass and $k$ is the spring constant. My book asks me to prove that the following equation holds, where $\varphi_n(k)$ are the eigenfunctions in the momentum space: $ \varphi_n(k) = \sqrt{b} N_n H_n(b k) \exp(-b^2 k^2 / 2), k=p/\hbar $ **Attempted solution** :               ClearAll["Global`*"];     norm[n_] := (1/(Sqrt[π] 2^n n!))^(1/2)          u[n_, x_] := 1/Sqrt[b] norm[n] HermiteH[n, x/b] Exp[-(x^2/(2 b^2))]          φ1[n_, k_] :=      Assuming[       {n ∈ Integers, n > 0, x ∈ Reals, k ∈ Reals, b > 0},       1/Sqrt[2 π] Integrate[u[n,x]Exp[-I k x], {x, -∞, +∞}]]          φ2[n_, k_] :=      Assuming[       {n ∈ Integers, n > 0, b > 0},       Sqrt[b] norm[n] HermiteH[n, b k] Exp[-((b^2 k^2)/2)]]          ParallelTable[         {j, Simplify[φ1[j, k] == φ2[j, k]]},         {j, 1, 8}] // TableForm      And here is the output: ![enter image description here](http://i.stack.imgur.com/37i18.png) **My question is** : Why does the relation hold only for $4k, k \in Z$ ? If I print $φ1[n,k]$ and $φ2[n,k]$ I see that in $φ1$ there are $(-i)^j$ terms, which is why the equation holds only for multiples of 4. Does anyone have any idea at all on where the error is ? (In my book? In how I do the Fourier transform? Something else I'm missing?)


Simple problem about shadow symbols in multi-contexts

When I'm tiding up my simple packages, `shadow` awlays comes out. Here is an example. Packages1                      BeginPackage["MyTest1`"]                 f1[x0_]:=Module[{x=x0},StringReplace["sdfasdfwhat hahahahah",x_->"DummyInMyTest1"]]                 g1[x0_]:=Module[{x=x0},StringReplace["sdfasdfwhat hahahahah",x_->"DummyInMyTest1"]]                 EndPackage[]      Packages2                      BeginPackage["MyTest2`"]                 f2[x0_]:=Module[{x=x0},StringReplace["sdfasdfwhat hahahahah",x_->"DummyInMyTest2"]]            g2[x0_]:=Module[{x=x0},StringReplace["sdfasdfwhat hahahahah",x_->"DummyInMyTest2"]]                 EndPackage[]      At first time, they are in one packages, now split them into two packages. Shadows about x is confusing, for I've used Module... actually I wish it to prevent the shadow problem but failed. Here we go               `$ContextPath`     Out[2]= {PacletManager`,QuantityUnits`,WebServices`,System`,Global`}     In[3]:= <<MyTest1`     In[4]:= <<MyTest2`     In[4]:= x0::shdw: Symbol x0 appears in multiple contexts {MyTest2`,MyTest1`}; definitions in context MyTest2` may shadow or be shadowed by other definitions. >>     In[4]:= x::shdw: Symbol x appears in multiple contexts {MyTest2`,MyTest1`}; definitions in context MyTest2` may shadow or be shadowed by other definitions. >>     In[4]:= x$::shdw: Symbol x$ appears in multiple contexts {MyTest2`,MyTest1`}; definitions in context MyTest2` may shadow or be shadowed by other definitions. >>     In[5]:= $ContextPath     Out[5]= {MyTest2`,MyTest1`,PacletManager`,QuantityUnits`,WebServices`,System`,Global`}      How to avoid these shadows but Quiet? Maybe duplicates with some shadows Q/A. :)


J/Link: Callback from J/Link into Java when Mathematica process terminates?

Is it possible to get a callback from J/Link into java when the (remote) link closes or the Mathematica process is terminated (killed) altogether?


Numerical Differentiation using 1500 data points

I have a set of 1500 data points (which are some energy eigenvalues) corresponding to a parameter H0 (which represents magnetic field. H0 values are equispaced going from $-3.0$ to $3.0$ in steps of $0.005$. Please note that the energy eigenvalues are not exact and they have experimental error in them. What I am trying to do is first plot those data points in _Mathematica_. I have found the command `ListLinePlot[{{x1, y1}, {x2, y2}, ...}]`. However, feeding such a huge set of data points consumes a lot of time. So is there any other way out? For example, importing the data file from Fortran. I have used the command `Import["file", "table"]` where "file" is a Fortran data file. But it is giving the error message "File not found during import". Then I would like to find the second derivative of the plot. Accurate evaluation of second derivative is very crucial for my purpose. I have done the plot using "gnuplot" and then found the first derivative of the plot using the central difference formula: $\frac{f(x+h)-f(x-h)}{2h}$. Here $h = 0.005$. Then I evaluated the first derivative of the latter plot using the same formula to get the second derivative plot. I am getting the plot but not the desired result (a peak is to be obtained near a value of H0, pre-calculated). In other words, I am getting a disagreement between theoretical and numerical values of H0. The eigenvalue evaluation is OK I think because I have checked it both in _Mathematica_ and Fortran. Maybe something is going wrong in the second derivative evaluation. Kindly advise how to carry out numerical differentiation from a set of data points in _Mathematica_.


Entering numbers in Scientific Notation?

I need to play with a lot of powers such as `10^-3`. `1E-3` does not work for it. Is there any short form for it?


Find a notebook I had open recently

I worked on a notebook a few weeks ago and now I can't find after looking through the most likely directories. The recent list only has 6 items in it, none of them the notebook in question. Is there a way to find ALL notebooks I have created or opened?


NMaximize the Likelihood

I am still pretty new to Mathematica, but have to solve a quite complex problem. The function               kdis[x_, a_] := KernelMixtureDistribution[Inner[List, x, (1+x)^a, List]]      gives me a bivariate kernel density estimate of two gamma random variables given by               gamran[k_, t_, nr_] := RandomVariate[GammaDistribution[k, t], nr]      Given some observations               xy = {{x_1,y_1},{x_2,y_2},...,{x_n,y_n}}      , I seek to maximize the likelihood function               Likelihood[kdis[gamran[2, 0.5, 250000], gamran[k, t, 250000]], xy]      using either NMaximize or FindDistributionParameters.               NMaximize[{Likelihood[kdis[gamran[2, 0.5, 250000], gamran[k, t, 250000]], xy], 0 < k <= 10 && 0 < t <= 10}, {{k, 0.01, 10}, {t, 0.01,10}},StepMonitor :> Print[k]]          FindDistributionParameters[xy,kdis[gamran[2.7, 0.5, 250000], gamran[k,t,250000]],{{k,1},{t,1}}, ParameterEstimator -> "MaximumLikelihood"]      Both functions seem to run endlessly. In particular, NMaximize never even finishes the first step (StepMonitor never prints something). As the problem is constrained to positive values of $k$ and $t$, I define constraints and a positive initial region for NMaximize. However, I get the following error message:               GammaDistribution::posprm: "Parameter k at position 1 in GammaDistribution[k,t] is expected to be positive."      which makes no sense to me given the constraints and the intial region. I know the problem is computationally very demanding. However, plotting the Likelihood with ContourPlot takes some time, but works and gives me relatively well defined maxima within my initial region. So I dont quite understand what is wrong with my script.


Fast Spherical Harmonics radiative transfer

This is a rather specific question and I apologize for spamming you with some lengthy code. But it could be interesting for some reader and maybe you can help out, so please bear with me. I am using the Spherical Harmonics Method to solve a radiative transfer problem in spherical symmetry, namely the penetration of diffuse UV radiation into interstellar clouds. It uses an expansion in Legendre polynomials to approximate the depth and angular dependence of the problem. I have a working solution and I am interested in a some additional input:   1. Is there a more elegant/simpler way to set up solutions for the intensity for varying values of $\omega$ (scattering albedo) and g (mean scattering angle $\langle \cos(\theta)\rangle$)   2. My solution is monochromatic and still relatively slow. For real applications one needs to perform the same calculations on a wavelength grid numerous times. How to speed up the solution? Wouldn't it be neat if _Mathematica_ could do the radiative transfer efficiently?   3. For higher approximation order, solving the Eigenvalue problem and getting the list of $A_m$ from the boundary conditions becomes extremely slow. Any ideas on how to improve? Here is what I got so far. First some definitions:               (* definition of the modified spherical Bessel function of the first kind *)     SphericalBesselI[0, 0] := SphericalBesselI[0, 0] = 1;     SphericalBesselI[l_, z_] := Sqrt[π/(2 z)] BesselI[l + 1/2, z];     (* expansion coefficients for the Henyey-Greenstein phase function *)     σ[l_][g_] := g^l     (* diagonal matrix elements *)     h[l_][g_, ω_] := h[l][g, ω] = (2 l + 1) (1 - ω σ[l][g]);     (* low-order determinants *)     F[0][g_, ω_][k_] := F[0][g, ω][k] = -h[0][g, ω];     F[1][g_, ω_][k_] := F[1][g, ω][k] = h[0][g, ω] h[1][g, ω] - k^2;     F[l_][g_, ω_][k_] := F[l][g, ω][k] = -h[l][g, ω] F[l - 1][g, ω][k] -       l^2 k^2 F[l - 2][g, ω][k];     (* helper function to access the i-th Eigenvalue k *)     kEV::mmatch = "Inconsistent list of Eigenvalues.";     kEV[list_List][m_Integer] := Module[{pos, neg},        pos = Select[Sort@list, Positive];        neg = Select[Sort@list, Negative];        If[(Length[pos] == Length[neg]) && m <= Length[pos],          If[Positive[m], pos[[m]], neg[[m]]],          Message[kEV::mmatch]; $Failed]];     (* calculate the Eigenvalues *)     calculateEigenvalues[L_][g_, ω_] :=         NSolve[F[L][g, ω][k] == 0, k][[All, 1, 2]];     R[0, m_][g_, ω_][k_] := R[0, m][g, ω][k] = 1;     R[1, m_][g_, ω_][k_] := R[1, m][g, ω][k] = (1 - ω)/k[m];     R[l_Integer, m_Integer][g_, ω_][k_] /; m < 0 := R[l, m][g, ω][k] = (-1)^l R[l, -m][g, ω][k]     R[l_Integer, m_][g_, ω_][k_] :=  R[l, m][g, ω][k] =           1/(l k[m]) (h[l - 1][g, ω] R[l - 1, m][g, ω][           k] - (l - 1) k[m] R[l - 2, m][g, ω][k]);     (* Mark's boundary condition *)     getAngles[M_Integer] :=       Sort@Select[      List @@ (NRoots[LegendreP[2 M, x] == 0, x] /. Equal[_, x_] :> x),       Negative]      B[i_Integer, m_Integer][g_?NumberQ, ω_?NumberQ][Lmax_,         taumax_?NumberQ, k_, angles_] :=         Sum[(2 l + 1) R[l, m][g, ω][k] LegendreP[l,         angles[[i]]] SphericalBesselI[l, k[m] taumax], {l, 0, Lmax}];      Now the procedure to set up function to calculate the mean intensity (averaged over the full solid angle) as function of the optical depth $\tau$ and the specific intensity as function of optical depth $\tau$ and angle $\mu=\cos(\theta)$.               createSphericalHarmonics[g_, ω_, I0_, tauMax_, L_?OddQ] :=       Module[       {M = (L + 1)/2, angles, eigenvalues, kEigenValues, AList},       (* angles for the boundary conditions from Mark's condition *)       angles = -SetPrecision[getAngles[M], Infinity];       (* calculate Eigenvalues from the recurrence relations F*)       eigenvalues =          SetPrecision[calculateEigenvalues[L][g, ω], Infinity];       (* calculate the A_k from the boundary conditions, i.e.           that the incoming intensity at the edge of the sphere and at          angle_i equals I_ 0*)       (* assuming isotropic illumination gives ConstantArray[I0, Mmax].           Alternatively we could define an I_ 0[mu] as declination dependent I_ 0*)       AList = LinearSolve[          N[SetPrecision[             Table[B[i, m][g, ω][L, tauMax, kEV[eigenvalues], angles],                    {i, 1, M}, {m, 1, M}]           , Infinity], 30],           N[SetPrecision[ConstantArray[I0, M], Infinity], 30]];           (* the N[#, 30] should prevent the LinearSolve::luc error but it doesn't *)      (* output are two InterpolationFunctions: {mean intensity as function of tau, intensity as function of angle and optical depth tau} *)      {       Function[tau,         Sum[AList[[m]] R[0, m][g, ω][        kEV[eigenvalues]] SphericalBesselI[        0, (tauMax - tau) kEV[eigenvalues][m]], {m, 1, M}]],       Function[{tau, mu},        Sum[(2 l + 1) LegendreP[l, mu] Sum[        AList[[m]] R[l, m][g, ω][          kEV[eigenvalues]] SphericalBesselI[          l, (tauMax - tau) kEV[eigenvalues][m]], {m, 1, M}], {l, 0, L}]]       }      ]      To demonstrate the solution, let's assume $g=0.5$, albedo $\omega=0.6$, approximation order of the Legendre polynomials $L=19$ and incoming intensity $I_0=1$, and optical depth to cloud center $\tau_c=10$.               {meanIntensity, intensity} = createSphericalHarmonics[0.5, 0.6, 1., 10, 19];          PolarPlot[{1, intensity[0, Cos[mu]], intensity[1, Cos[mu]]}, {mu, 0, π/2},           Epilog -> {Dashed, (Line[{{0, 0}, {Cos[ArcCos @ #],           Sin[ArcCos @ #]}}] & /@ (-getAngles[10]))}]      ![polar plot of intensity](http://i.stack.imgur.com/nvBOW.jpg) The wavy curve is the approximated intensity as function of angle $\mu$ at the surface of the cloud, the dashed lines show the angles that were used to specify the boundary conditions. The olive curve shows the angular dependence of the intensity at $\tau=1$. The angular averaged, mean intensity:               Plot[Log10@(meanIntensity[tau]/meanIntensity[0]), {tau, 0, 10},           PlotRange -> {{0, 10}, All}]      ![plot of angular mean intensity](http://i.stack.imgur.com/Xfs3F.jpg) I am pretty sure there are plenty of bugs still in the code, but they are not the point of this post, but rather the performance and coding style.