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

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


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

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


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

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


title: Strange numerical integration result

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


title: Clustering adjacent points in 2D

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


title: github api v3 repository create

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


title: How to define a package without adding it to $ContextPath

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


title: Changing Datelist order

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


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

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


title: Geocoding addresses to geographic coordinates

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


title: Functions that operate on symbolic matrices?

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


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

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


title: A double series with divisibility restrictions

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


title: Return partial result when MemoryConstrained aborts NDSolve

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


title: Inequality test returned unevaluated

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


title: Remove singleton from Interval

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


title: Turning sound into a graph

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


title: Correct way to populate a DiagonalMatrix?

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


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

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


title: Expectation of CauchyDistribution

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


title: Enlarging a contour plot

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


title: 3 hour calculation? ParallelMap & ParallelTable

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


title: How can I find the row differences of a matrix?

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


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

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


title: Using a built-in symbol as a variable

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


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

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


title: 3rd derivative keyboard shortcut

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


title: Not getting anti-aliasing with BarChart3D

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


title: Pre and Post in a Block[]

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


title: Exporting CellFrameLabels to HTML

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

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


title: How to use MKL from Mathematica?

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


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

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


title: Animating the Lorenz Equations

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


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


title: Regarding how to use Reduce

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


title: Transparency in a 3D plot

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


title: Probable Bug in ConvexHullMesh

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


title: How draw a line dynamically using manipulate?

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


title: Generating equally distributed voxel points based on a given point

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


title: How can Mathematica convert CMYK values to RGB or HSB?

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


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

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


title: Transcendental equation inside another equation when 3D plotting

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


title: How to manipulate a plot with intermediate parameters

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


title: Extract date from a not well-formed string

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


title: Going Beyond Pseudorandom Numbers

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


title: Using NDSolve with coupled ODE

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


title: Solving a system of equations using matrix form

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


title: Can Mathematica solve 625 linear coupled differential equations?

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


title: Will I be able to use NDSolve, and then how

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


title: NIntegrate, view integration options

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


title: Pattern to match L, but not L[_]

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


title: ListPlot: Plotting large data fast

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


title: Unique[] in RHS of rule

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


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

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


title: Octonions in Mathematica

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


title: Calibrating Precision in calculations

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


title: Formatting Equation Output Neatly

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


title: Dynamic graph visualisation using JLink/Java and GraphStream

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


title: Speeding up a numerical constrained quadratic optimization

text: I'm trying to solve a quadratic optimization problem in 35 variables, $\vec{α} = \left< α_1, \ldots, α_{35}\right>$: $$ \begin{aligned} &\operatorname*{maximize}_\vec{α}&&1.0\cdot α_1 - 2.7\cdot {α_1}^2 + 1.0\cdot α_2 + \cdots + 0.6\cdot α_{34} \cdot α_{35} -1.6 \cdot {α_{35}}^2 \\\ &\operatorname*{subject to}&&0 = α_1 + α_2 + \cdots - α_{34} + α_{35} \\\ &&& \forall_i(α_i \geq 0) \end{aligned} $$ where the expression to be maximized has 665 terms, all linear or quadratic. The obvious command:               nn = 35;     objective = 1.0*Subscript[α,1] - 2.7*Subscript[α,1]^2 + [...];     equalityConstraint = 0 == Subscript[α,1] + Subscript[α,2] + [...];     NMaximize[{objective, equalityConstraint} ~Join~ Table[Subscript[α, n] >= 0, {n, 1, nn}],         Table[Subscript[α, n], {n, 1, nn}]]      runs too slowly. I suspect that Mathematica's full nonlinear-optimization machinery, unneeded for this type of problem, may be slowing it down. What can I do to increase performance?


title: Setting OperatorSubstitution to False has issues with PDF and EPS exports. Are these bugs?

text: In `Plot`, I would like to use my own font, eg Inconsolata, for operators such as ×, so I set `OperatorSubstitution` to `False` as follows.               Plot[       x,       {x, 0, 10^10},       BaseStyle -> {PrivateFontOptions -> {"OperatorSubstitution" -> False}},        LabelStyle -> {FontFamily -> "Inconsolata"}     ]      There are three vector formats into which I can export the figure: SVG, EPS, and PDF. Only the SVG export gives the correct result, ie the character × is in the font specified. The others have the following issues. My first question is: **Are they bugs?**   * PDF export: operators are omitted altogether.   * EPS export: the instruction of setting `OperatorSubstitution` is omitted, ie font substitution for operators still occur. I'm using Mathematica 9 for Mac. My second question is: **Is there any way to work around the issue with PDF export?**


title: Unexpected behavior of confidence bands for data presenting two regions with uneven noise

text: Let's generate some noisy data with uneven noise.                   data = Table[{x,Exp[-(x-2)^2] + Exp[-(x+2)^2]*RandomReal[{0.5, 1.5}]},                {x, RandomReal[{-4, 4}, 500]}];      ![enter image description here](http://i.stack.imgur.com/VrQVD.png) Let's fit it with a nonlinear model                   fit = NonlinearModelFit[data, b Exp[-(x-a)^2] + c Exp[-(x+a)^2],               {a, b, c}, x]      from which we extract the σ and 2σ prediction bands for single observations:                   {bands1[x_], bands2[x_]}=Table[fit["SinglePredictionBands",ConfidenceLevel -> cl],           {cl, {.683, .954}}];      The bands seem not to take into account the unevenness of the noise:                   Show[ListPlot[data, PlotStyle -> {Opacity[0.5]}], Plot[{fit[x], bands1[x], bands2[x]},              {x, -4, 4},Filling -> {2 -> {{1}, Directive[{Green, Opacity[0.25]}]}, 3 -> {{2}, Directive[{Yellow, Opacity[0.25]}]}},              PlotStyle -> {Directive[Thickness[0.0075], Red],Black, Black}]]      ![enter image description here](http://i.stack.imgur.com/0j7dt.png) Am I misinterpreting confidence bands, or am I calculating them in the wrong way?


title: Version 7 and 8, different behavior of NSolve. Is it reproducible?

text: I noticed the following difference, and I wonder if it's a problem of my system or the results difference is actually due to the two different versions               oldsa = {0.29289321881345254` -          0.6666666666666666` Sin[0.5235987755982988` + phi] ==         0.75` Cos[psi1], -0.7071067811865475` + h +          0.6666666666666666` Cos[0.5235987755982988` + phi] ==         0.75` Sin[psi1], -0.5` +          0.6666666666666666` Sin[0.5235987755982988` - phi] ==         0.75` Cos[psi2], -0.4660254037844386` + h +          0.6666666666666666` Cos[0.5235987755982988` - phi] ==         0.75` Sin[psi2]}          NSolve[oldsa, {h, phi, psi1, psi2}]      gives solutions in Mathematica version 7, and no solution in ver. 8 Both run on Ubuntu 12.04 x64 Do you get the same resuts?


title: How to get the real PlotRange using AbsoluteOptions?

text: The problem in general involves the unreliable behaviour of `AbsoluteOptions` when option values are implicitly specified (e.g. `Automatic`, `All`, `Full`, etc.), for example the graphics below clearly has a different plot range than the one reported by `AbsoluteOptions`:               {g = Graphics[{}, Frame -> True], AbsoluteOptions[g, PlotRange]}      ![enter image description here](http://i.stack.imgur.com/Jbjwy.gif) * * * ## Original example For demonstrating the problem, have a look at the following example, and try adjusting the rotation angle `a` and/or the `Locator` position, comparing the real `PlotRange` of `pic` indicated by the frame-ticks with the one under the graph obtained by `AbsoluteOptions[pic, PlotRange]`:               Manipulate[      DynamicModule[{pic},       Column[{         pic = Graphics[{FaceForm[], EdgeForm[Black],            GeometricTransformation[Rectangle[], RotationTransform[a]],            Red, Point[p]},           Frame -> True],         p,         AbsoluteOptions[pic, PlotRange]         }]       ],      {{a, 0}, 0, 2 Pi},      {{p, {.1, .2}}, {-2, -2}, {2, 2}, Locator}]      ![Mathematica graphics](http://i.stack.imgur.com/k7ysd.png) As shown in the screen capture above, in my **Mathematica 9.0** on **Windows 7 64-bit** system, the `PlotRange` from `AbsoluteOptions` is not consistent with the real range. And the angle `a` seems to do nothing with it. Additional tests in my system suggest this problem is not restricted on the attendance of `RotationTransform`, but comes with the `GeometricTransformation`. And it happens not only on `Graphics` but also on `Graphics3D`. So my questions are:   * What is going on here?   * How can I obtain the real `PlotRange` of the `Graphics`/`Graphics3D` when there are `GeometricTransformation`s in it?


title: TreeForm display with nested lists as nodes

text: If i have a nested list representing nodes in a binary tree, `{3, {2, {1, None, None}, None}, None}`, what is the easiest way to show the hierarchy, without all the List heads being displayed as intermediate nodes?


title: Is there a shortcut to select all cells above the current cursor position?

text: Is there a command / menu entry / keyboard shortcut to evaluate all cells above / up to the current cursor position? I have the feeling I am missing something elementary here... **Addendum** : In fact, it is more about selection of those cells, evaluation is not the problem as such.


title: 3D plots wrongly displayed when using GraphicsRow in Linux

text: I get an incorrect vertical offset in 3D plots when using GraphicsRow in Mathematica 9 (Linux - Ubuntu 12.04). When displayed by itself, the plot is fine. Here's an example:               f[x_, y_] := Exp[-x^2 - y^2]      Showing the plot by itself works as expected:               a = Plot3D[f[x, y], {x, -2, 2}, {y, -2, 2}]      ![Gaussian shown once](http://i.stack.imgur.com/KZHDM.png) However an incorrect vertical offset appears when showing the plot _multiple_ times with GraphicsRow:               GraphicsRow[{a, a}, ImageSize -> Large]      ![Gaussian shown twice](http://i.stack.imgur.com/BXBL0.png) Does anybody also have this problem? Any idea how to fix this?


title: _?NumericQ equivalent for lists

text: A few months ago I got a simple answer (see: 1 ) to the question of how to force numeric evaluation during use of functions such as NMinimize - namely the use of _?NumericQ in the argument list. I now have the same problem, only this time the argument to the user-defined function I'm trying to minimize is a list. Is there an equivalent to _?NumericQ for lists?


title: Calculating the median difference between elements with a (particular pair) of consecutive integer indices residing in the same sublist

text: NOTE: I formally made a serious mistake in the first example provided. `pointLists[[1]]` had an extra element, and we should have a guarantee that `Length[pointLists[[i]]] == Length[indexLists[[i]]]`. I apologize for wasting people's time with this. * * * I have a list `pointLists` of sublists of 2D coordinates, where an `N = 3` example looks like this:               pointLists =       {{        {131.048, 243.364}, {131.046, 243.321}, {131.037, 243.357},         {130.931, 243.391}, {130.909, 243.377}}, {{164.911, 244.039}, {164.929, 243.942},         {164.74, 244.083}}, {{98.1685, 239.618}, {98.1913, 239.6}, {98.1528, 239.623}      }};      I also have another list `indexLists` (where `indexLists[[i]]` corresponds to `pointLists[[i]]`) which assigns an integer value $\geq 1$ to each coordinate in each sublist. An example of `indexLists` for the above example looks like this:               indexLists = {{1, 2, 3, 5, 6}, {1, 2, 4}, {1, 2, 3}};      What I'd like to calculate here, as quickly as possible, is a list `differenceList` where a position `k` in `differenceList` corresponds to the mean or median difference between coordinates in the same sublist of `pointLists` where the first coordinate and the second coordinate have values of `k` and `(k-1)` in `indexLists`. Sometimes, however, there will be no examples in any of `pointLists` satisfying this criterion. In this case I'd like to simply set `differenceList[[k]] = "NULL"` (or really anything distinct and addressable). * * * Here's another way of thinking about the question: Imagine, for example, that we have a bunch of cells growing in different colonies/plates, and their color changes over time. But we can't always measure the change for each colony at every time point, just whenever we can. Each time we measure a color, we add it on the end of a sublist corresponding to the colony in `pointLists` and we time stamp the addition by adding the time to a position at the same index as `pointLists` in `indexLists`. We then ask... for some time point (e.g. $T = 5$), what's the median change from the previous timepoint (e.g. $T = 4$)? And now imagine that I unfortunately have no control over this data formatting. I just have a structure like `pointLists` and `indexLists` to work with from measurement device. * * * Descriptive Example - Since the description provided is a little wordy, let's plug through the above example in a step-wise fashion (this is optimized for easy reading, and should in no way constrain any algorithm that can achieve the same result): (k = 1) We set `differenceList[[1]] = {0,0}` to handle this special case. (k = 2) For `k=2` we notice that `pointLists[[1]]`, `pointLists[[2]]`, and `pointLists[[3]]` have coordinates with `indexLists` values of $k = 2$ and $1$. We compute the differences as, for the first sublist: `{131.046, 243.321} - {131.048, 243.364} = {-0.002, -0.043}`, for the second sublist: `{164.929, 243.942} - {164.911, 244.039} = {0.018, -0.097}`, and for the third sublist: `{98.1913, 239.6} - {98.1685, 239.618} = {0.0228, -0.018}`. We then set: `differenceList[[2]] = Median[{{-0.002, -0.043}, {0.018, -0.097}, {0.0228, -0.018}}] = {0.018, -0.043}`. (k = 3) For `k=3` we notice that `pointLists[[1]]` and `pointLists[[3]]` have coordinates with `indexLists` values of $k = 3$ and $2$ (and that `pointLists[[2]]` does NOT have any coordinates satisfying this criterion). We compute the differences as - for the first sublist: `{131.037, 243.357} - {131.046, 243.321} = {-0.009, 0.036}`, and for the third sublist: `{98.1528, 239.623} - {98.1913, 239.6} = {-0.0385, 0.023}`. We then set: `differenceList[[3]] = Median[{{-0.009, 0.036}, {-0.0385, 0.023}}] = {-0.02375, 0.0295}`. (k = 4) For `k=4` we notice that none of the sublists have coordinates with an associated index value of $4$ AND ALSO a coordinate with an associated index value of $3$ in `indexLists`, so we set `differenceList[[4]] = "NULL"`. (k = 5) For `k=5` we notice that, while `pointLists[[1]]` has a coordinate with an index value in `indexLists` of $5$, and `pointLists[[2]]` has a coordinate with an index value in `indexLists` of $4$, two coordinates with indices $4$ and $5$ not present in the same sublist, and there are no other examples where a sublist has both values, so we set `differenceList[[5]] = "NULL"`. (k = 6) For `k=6` we notice that `pointLists[[1]]` has coordinates with indices $k = 6$ and $k = 5$ in `pointLists`, and that this is a lone example, so we set `differenceList[[6]] = {130.909, 243.377} - {130.931, 243.391} = {-0.022, -0.014}`. Done. And our result is:               differenceList =        {{0,0}, {0.018, -0.043}, {-0.02375, 0.0295}, "NULL", "NULL", {-0.022, -0.014}}      * * * Is there a clever way to achieve the same result as above for very large instances of `pointLists` (in terms of both the number and length of component sublists)? If it matters, I'd like to optimize for speed and not necessarily memory usage. Also, since I'd like to be able to rerun the algorithm after updating `pointLists`, is there some way to quickly calculate the `differenceList` value at specific positions (i.e. for specific values of $k$) without recalculating the entire list? * * * * * * * * * Let's do one more quick example where we calculate `differenceList[[5]]` for new versions of `pointLists` and `indexLists`.               pointLists = {{{122.534, 191.041}, {122.735, 191.023}, {122.692, 190.999}, {122.742, 191.051}}, {{16.2591, 182.679}, {16.2429, 182.681}, {16.3327, 182.726}, {16.4354, 182.733}, {16.4144, 182.737}, {16.3727, 182.759}, {16.3141, 182.783}, {16.3692, 182.77}, {16.4068, 182.745}, {16.3346, 182.712}}};          indexLists = {{1, 3, 4, 5}, {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}};      Here's a description of how to to calculate `differenceList[[5]]` in the new example: From `pointLists[[1]]` we calculate: `{122.742, 191.051} - {122.692, 190.999} = {0.05, 0.052}`. From `pointLists[[2]]` we calculate: `{16.4144, 182.737} - {16.4354, 182.733} = {-0.021, 0.004}`. And finally, we take the median of those values: `differenceList[[5]] = Median[{{0.05, 0.052},{-0.021, 0.004}}] = {0.0145, 0.028}`. Here, `{122.742, 191.051}` & `{16.4144, 182.737}` have indices of `5` at the same position in the associated `indexLists`. And points `{122.692, 190.999}` & `{16.4354, 182.733}` have indices of four at the same position in `indexLists`. We calculate: `{122.742, 191.051} - {122.692, 190.999`} since these values are in the same sublist of `pointLists` (`pointLists[[1]]`), and `{16.4144, 182.737} - {16.4354, 182.733}` are both in `pointLists[[2]]`. So that's how we do `k = 5` in the new example. If `{122.742, 191.051}` OR `{16.4144, 182.737}` OR both are missing, we'd have `differenceList[[5]] = {-0.021, 0.004}` (and `differenceList[[5]] = {0.05, 0.052}` if `{122.692, 190.999}` OR `{16.4354, 182.733}` OR both are missing). If three of those coordinates are missing `differenceList[[5]] = "NULL"`.


title: mysql insert set problem

text: I need some help.               set = {0, 0};     Print[set];     Needs["DatabaseLink`"];     JDBCDrivers["MySQL(Connector/J)"]     conn = OpenSQLConnection[              JDBC["MySQL(Connector/J)", "localhost:3306/test"],              "Username" -> "root", "Password" -> "root"]     SQLExecute[conn, "INSERT INTO numbers VALUES ([set]) "]      I don't know know how to escape `[set]` in the insert statement In the database the field type is text


title: calculating a sequence of functions using iteration

text: I am trying to compute a sequence of functions using iteration and keep running into problems trying to use built in looping commands because of the recursive nature of the definition. The code below (version 8) shows the first two functions `y1` and `y2`. The output functions are also piecewise linear. Is there an easier way to compute `yn` for any $n$?               {a1, b1} = {.3, .6}; {a2, b2} = {.6, .3};          y0[x_] := x;          f1[x_] := b1*y0[x/a1];          g1[x_] := (b2 - b1)*y0[(x - a1)/(a2 - a1)] + b1;          h1[x_] := (1 - b2)*y0[(x - a2)/(1 - a2)] + b2;          y1[x_] := If[0 <= x < a1, f1[x], If[a1 <= x < a2, g1[x], h1[x]]];          Plot[y1[x], {x, 0, 1}]          f2[x_] := b1*y1[x/a1];          g2[x_] := (b2 - b1)*y1[(x - a1)/(a2 - a1)] + b1;          h2[x_] := (1 - b2)*y1[(x - a2)/(1 - a2)] + b2;          y2[x_] := If[0 <= x < a1, f2[x], If[a1 <= x < a2, g2[x], h2[x]]];          Plot[y2[x], {x, 0, 1}]


title: How to construct a list in a For Loop nested in a Parallel Loop

text: I've the following problem I cannot solve. I allocate an empty matrix, v, of size n x m. Then I want to do a Parallel loop (ex. ParallelDo), and do some operations (described by a function operation[j,y] of two arguements) that as a result gives a numerical output. I want to "store" the i-th output in the i-th element of the list. If I use a Parallel loop with inside a For loop, there is no way to in fact store the output in the list, and at the end of the loop, v, is empty. If I do the same thing with a regular loop (ex. Do), then it works. Here I report a generic expample:               v = Table[{}, {j, 1, m}, {i, 1, n}];          ParallelDo[For[j = 1, j < n+1, j++, v[[j,i]] = operation[j,i]], {i, 1, m}]      But in this case, no matter of what the operation function is, V is still an empty matrix. If I use Do, instead of ParallelDo, then it works. All DistributeDefinitions and related stuff I think are taken care correctly. Thanks!


title: Getting clearer StreamPlot output

text: When I do a `StreamPlot`of a rather complicated pair of differential equations, it loses some details. For example:               StreamPlot[{Tan[y - x], 2^y - 2 Cos[Pi/3 - x]}, {x, -4, 4}, {y, -4, 4}]       Here is the result: ![enter image description here](http://i.stack.imgur.com/uewBK.png) Is there any way to:   * Change the color near each of the critical points to a different set of colors?   * Increase the level of detail near the saddle points and spirals? That is, add more streams?   * Any way to make a collage (for example, a landscape variant in order to capture more of the rich details and global behaviors of all critical points, including the periodic ones in this particular example)?


title: Plot 3D boolean Array or matrix in Mathematica

text: ![enter image description here](http://i.stack.imgur.com/47NjD.jpg) I have been attempting several methods to plot a 3D diagram of a n by n boolean array in _Mathematica_ but none of them produced satisfactory result. I want the $3D$ plot to have a cube when `M[i,j,k] == 1` and when `M[i,j,k] == 0` just leaves as blank. Below is the best result I got.               L=10     M = RandomReal[{0, 1}, {L, L, L}];     For[k = 1, k <= L, k++,       For[j = 1, j <= L, j++,        For[i = 1, i <= L, i++,         If[M[[i, j, k]] < 0.5,          M[[i, j, k]] = 1,          M[[i, j, k]] = 0          ]]]];     Image3D[M, ImageSize -> 500, Boxed -> True]      The `Image3D` function gives a very fluffy and opaque look on the cubes which I couldn't change!! Is there someway I can change the opacity and color of the `Image3D` function in this case? Or is there a better way to plot this matrix?


title: Clustering of space-time data

text: Below is an example of a gaze sequence I recorded during a 3 seconds display. That is, where the eye was at every millisecond. While we should have 3000 points, we are missing some due to blinking. ![enter image description here](http://i.stack.imgur.com/O3CXlm.png) **Fixation or visual fixation is the maintaining of the visual gaze on a single location.** I need to extract those fixations. That is group of gazes that are both contiguous in time and space. Below is the location of fixations. Of course we'll have to implement thresholds. ![enter image description here](http://i.stack.imgur.com/Io08Vm.png) In this file available for download, you will find 7 sequences there if you simply open and run the attached notebook. `gazeSeq[1]` is the first out of 7 sequences made out of 3000 sublists representing each gaze record as `{x,y,time}`:               gazeSeq[1][[1]]      Out[1]= {-0.562, 0.125, 1000.}      where `time` goes from 1000 to 4000 corresponding to the 3 seconds of display. As said above some data points might be missing. While I tried to use `GatherBy`, I could not manage to include the condition of "time contiguity" and would get grouping of gazes that did not happen during the same interval during the trial.


title: Is it possible to manipulate graphs by hand?

text: > **Possible Duplicate:**   >  Generating graphs interactively (GUI) If I plot a graph, is it possible for me to manipulate the vertices such that when I move them, their attached edges will follow. One option that I tried is to change the graph into a graphics object, but then the edges and vertices lose their sense of being connected to each other.


title: Roots of characteristic equation of sixth order

text: I have problem how to localize the roots of the sixth order polynomial given in the form of determinant. Classical Solve gives the solution which are in the long form. Is there way how to present roots in analytical form of constants with some substitutions not to looks so long                c11 = b11 - a11 X;      c22 = b22 - a22 X;      c33 = b33 - a33 X;      c44 = b44 - a44 X;      c55 = b55 - a55 X;      c66 = b66 - a66 X;           poly = Det[({      {c11, b12, b13, b14, 0, 0},      {b21, c22, 0, 0, b25, b26},      {b31, 0, c33, b34, 0, 0},      {b41, 0, b43, c44, 0, 0},      {0, b52, 0, 0, c55, b56},      {0, b62, 0, 0, b65, c66}     })];           Solve[poly == 0, X]


title: Cycles of length N in a graph

text: If I have an undirected graph represented with an adjacency matrix, how can I find all the subgraphs which are a cycle of length N? I don't really know the math nor the programming language well, so I find myself resorting to making a bunch of for loops to try traversing the graph. This is very slow, and I might as well just write it in C at that point. So I'm hoping to learn how to work better with mathematica here. So far, I think I've found a way to tell me the number of such subgraphs. For example, I might be able to get the number of cycles of length 3 in the graph given by the matrix m by doing something like...               Digitize[matrix_] := Map[Sign[#]&,matrix,{2}]      m=Digitize[m]; (* ensure it is normalized *)     ident = Table[KroneckerDelta[i,j],{i,1,Length[m]},{j,1,Length[m]}];     m1 = m*(1-ident); (* remove self-loops, giving steps away of length 1 *)     m2 = (m1.m1)*(1-ident); (* matrix of steps of length 2, with no repeats *)     m3 = (m2.m1); (* matrix of steps of length 3 *)     (* reading diagonal of m3 will tell how many paths lead back to the start? *)       This already looks a bit messy, and I'm not sure how much I can generalize it to larger N. And even then, it doesn't help me get the actual paths. Help? Clarification: Ideally I'd like to eventually write a module that given a length N and an adjacency matrix for an undirected graph, outputs a list of all the unique (up to cyclic reordering) lists of vertices which form a cyclic path of length N.


title: How can I make a grid of plots with no spacing, and have the plots line up perfectly?

text: I am making a bunch of two dimensional plots and I would like to have them arranged in a grid with no space in between them. That is, I want their frames touching each other. My problem is twofold. First I don't know how to get the plots to have a consistent size. When I try to give the plots the same size via `ImageSize`, it applies the size to the overall image, including the tick marks and labels. But when I have two different plots, one with tick labels and one without, giving the same value to `ImageSize` doesn't give the result I'm looking for. Secondly, I want to get rid of any white space around the images such that when I give `Grid` the option `Spacings ->{0,0}` there really is no visible space between the plots. In the example code I use the `CustomTicks` package.               (*an example of what I might plot, simple sum of two dimensional \     Lorentzians*)     lzn[x_, w_, g_] := (x - w + I g)^-1;     exampledata2D =        Table[Re[lzn[w1, .2, .1] lzn[w2, .3, .2] +           lzn[w1, .4, .1] lzn[w2, .8, .1] +           lzn[w1, .8, .2] lzn[w2, .4, .2]], {w1, 0, 1, .01}, {w2, 0,          1, .01}];     << "CustomTicks`";       standardticks = LinTicks[0, 1, .2, 4];     (*I don't want the last tick label for one plot overlapping with the \     first tick label of the plot right next to it.*)     ticks2 = LinTicks[0, 1, .2, 4, ShowLast -> False];     (*Custom plotting function so I don't have to reprint the same \     options over and over *)     plottingfunction[list_, plotopts : OptionsPattern[]] :=        ListContourPlot[list,         Evaluate[FilterRules[{plotopts}, Options[ListContourPlot]]],         Contours -> 30, PlotRange -> All, DataRange -> {{0, 1}, {0, 1}},         BaseStyle -> 18,         ColorFunction -> (Blend[{Red, Orange, Yellow, Green, Blue,              Darker[Blue]}, #] &)];          bottomleft =        plottingfunction[exampledata2D,         FrameTicks -> {{ticks2, StripTickLabels[standardticks]}, {ticks2,            StripTickLabels[standardticks]}}];     bottomright =        plottingfunction[exampledata2D,         FrameTicks -> {{StripTickLabels[standardticks],            StripTickLabels[standardticks]}, {standardticks,            StripTickLabels[standardticks]}}];     topleft =        plottingfunction[exampledata2D,         FrameTicks -> {{ticks2,            StripTickLabels[standardticks]}, {StripTickLabels[            standardticks], StripTickLabels[standardticks]}}];     topright =        plottingfunction[exampledata2D,         FrameTicks -> {{StripTickLabels[standardticks],            StripTickLabels[standardticks]}, {StripTickLabels[            standardticks], StripTickLabels[standardticks]}}];          Grid[{{topleft, topright}, {bottomleft, bottomright}},       BaseStyle -> ImageSizeMultipliers -> 1, Spacings -> {0, 0}]      ![enter image description here](http://i.stack.imgur.com/usCDh.png)


title: TableForm with a title

text: My question is rather simple. I want to put a title into a table. For example, consider a list with depth two and a title               list = Range[4] & /@ Range[4];     title = "Bravo";      And I want to create a table from `list`, i.e.,               TableForm[list]      This will generate a table without a title. Let's say I want to make a title "Bravo" on top of the table(which is center-aligned). Can you suggest a neat way to achieve it? I looked up the possible options for `TableForm`, but I could not find a relevant one.


title: Accessing Reduce from DSolve

text: When solving transcendental equations, `Solve` frequently warns us that inverse functions are being used so that some solutions may not be found. ![enter image description here](http://i.stack.imgur.com/ZfqAV.png) We also see that `Reduce` might provide a more complete solution and, indeed, simply changing `Solve` to `Reduce` provides a complete, quantified result. ![enter image description here](http://i.stack.imgur.com/NIQ6q.png) Somtimes, however, this same message is produced by `DSolve`. ![enter image description here](http://i.stack.imgur.com/7Mhfz.png) My guess is that `DSolve` calls `Solve` which in turn generates the message. Is it possible, though, to access `Reduce` through `DSolve`? For this particular equation, it would be easy enough to separate variables, `Integrate` and then apply `Reduce`. I'm wondering about a more general solution, though.


title: Epilog->Inset crops text with large font sizes

text: Why does `Epilog->Inset` crop the first and last letters here ("a" and "g") when `FontSize` is set to large values (which varies with font family):               Plot[Cos[t], {t, -32 Pi, 32 Pi}, AspectRatio -> 1/4, PlotRange -> All,       Axes -> True, ImageSize -> 600,       Epilog ->        Inset[Graphics@         Text[Style["a   b   c   d   e   f   g", FontSize -> 30]], {0, 0}]      ]      This renders as: ![enter image description here](http://i.stack.imgur.com/mBAew.png) Are there options or a hack which still uses `Epilog -> Inset`, as opposed to using `Show` and passing the text as `Graphics` (which works correctly)?


title: Why is LogLogPlot[] slower than Plot[]?

text: I notice that `LogLogPlot` runs quite bit more slowly than ordinary `Plot`. For example, consider the following two blocks of code which plots (using `Manipulate`) a region in linear scale and log-linear scale. Notice how the log-log-scale manipulation runs more sluggishly. Is there a way to speed up the log-log-scale version? Linear-scale code:                Mhad = 0.93827;      Table[Tooltip[(MxSq - M^2) x/(1 - x) /. M -> Mhad, "x=" <> ToString[x]], {x, 0, .9, .1}];      Manipulate[Plot[{1/s (s - M^2) (s - MxSq) /. M -> Mhad, %},        {MxSq, Mhad^2, 100}, PlotRange -> {{0, 100}, {0, 100}},        AspectRatio -> 1, Filling -> {1 -> Axis}, Frame -> True,        PlotStyle -> Table[If[i == 1,          RGBColor[0, 0, 0],          {RGBColor[1, 0, 0], Thickness[.001]}], {i, 1, 11}]], {{s, 50}, 1,          400}]      Log-log-scale:                Table[Tooltip[(MxSq - M^2) x/(1 - x) /. M -> Mhad, "x=" <> ToString[x]], {x, 0, .9, .1}];      Manipulate[LogLogPlot[{1/s (s - M^2) (s - MxSq) /. M -> Mhad, %},        {MxSq, Mhad^2, 100}, PlotRange -> {{.8, 100}, {.8, 100}},        AspectRatio -> 1, Filling -> {1 -> Axis}, Frame -> True,        PlotStyle -> Table[If[i == 1,          RGBColor[0, 0, 0],          {RGBColor[1, 0, 0], Thickness[.001]}], {i, 1, 11}]], {{s, 50}, 1,          400}]


title: Optimizing an energy functional in mathematica using variational calculus

text: I have an energy functional which I want to optimize using calculus of variation. It would be nice if someone could please post a working example using mathematica. The procedure is as follows, specify the energy functional, compute the Euler-Lagrange equation, discretize them and if possible run for a sample data. There are some links to the package for calculus of variation. But none of them is providing a complete example as I have described in the above paragraph. _**UPDATE1_** I am trying the simple Lucas-and-Kanade energy functional $E(u(x_0,y_0),v(x_0,y_0)) = \int(f_x(x,y,t)u+f_y(x,y,t)v+f_t)dx dy$ I have tried to do it with [this link] _**UPDATE2_** The correct form of the energy functional is, courtesy of [rcollyer] $E(u(x,y),v(x,y)) = \int(f_x(x,y,t)u+f_y(x,y,t)v+f_t)^2dx dy$ The question is now how to descritize the Euler-Lagrange equations. and solve it for some artificial data. (this is not extra thing specified in the question already) *** UPDATE3*** the complete solution procedure is as follows: The E-L equations for the integrand of the above energy functional are as follows and we set the first variation to zero $2f_x(f_x(x,y,t)u+f_y(x,y,t)v+f_t)=0$ $2f_y(f_x(x,y,t)u+f_y(x,y,t)v+f_t)=0$ in the matrix form it will look as follows Now we can simply solve for u and v because we have two equations and two unknowns but the derivatives are needed to be descritized. For example if we take the forward difference assuming the distance is 1 $f_x = f_{i+1}-f_{i}$ $f_y = f_{j+1}-f_{j}$ In above equations i and j represent the indexing in x and y direction respectively. $f_t = f_{2}-f_{1}$ Here in the above equation the function is described by indices 1 and 2 describe the function in the temporal direction. (Mathematica provides a lot of variety for descritizing as per the documentation) So the idea is to be able to replace the derivative with finite differences and we should be able to solve the equation system for u and v given the data. thanks a lot


title: Interpolate specific columns of data

text: I have a txt file with 3 columns of data: x y1 y2 How do I import the file then create 2 functions, one interpolated with {x,y1} values and the other interpolated with {x,y2} values? This is the sort of thing I want to achieve (in pseudocode):               Import "data.txt" into A     f1 = Interpolation(A,{x,y1})     f2 = Interpolation(A,{x,y2})


title: Why is held expression evaluated?

text: Context: I'm studying non-linear dynamics. As part of a bigger problem, I'd like to generate lists of the form `{{deq, ic1}, {deq, ic2}, ...}`, where `deq` is a differential equation and `ic` are initial conditions. **EDIT** : (Use `r` instead of `t` for the tuples as per @Kuba's suggestion *)               ClearAll["Global`*"];     deq = x''[t] == x[t] - x[t]^3 + x[t]^2 + Cos[t];     r = Tuples[{Hold@deq, {{x[0] == 0, x'[0] == 0}, {x[0] == 0, x'[0] == 1}}}]     NDSolve[First@r, {x, x'}, {t, 0, 1000}]      I have the following related questions:   1. ~~Why do I need to`Hold[]` `deq` at the first place ? If I don't use it, `Tuples[]` will "break" `deq` in == and combine all the `{lhs, rhs}` with all the `ic`'s.~~ It's due to the fact that `deq` isn't list which is what `Tuples[]` expects. See @Kuba's answer.   2. Why when later on I pass the result of to `NDSolve[]`, `Hold@deq` is evaluated without me releasing it first ? I checked the documentation of `Hold[]` and it says that this should happen only when the held expression is of the form `f[args]` and UpValues have been defined for f. I don't mind that it does, but I'm trying to understand the logic.   3. How would using `Unevaluated@deq` differ compared to `Hold@deq` ?


title: Levels and slots

text: I am struggling with levels and `#`, if I understand this I think I will be able to grasp the entire concept.                Apply[#1 &, {envelope[1, order["sku1", 5, 10, 4.98]],        envelope[2, order["sku2", 3, 67, 98]]}, {1}]      > >     {1,2} >   This makes perfect sense. Keeping everything els equal but changing the slot to `#2`: > >     {order["sku1", 5, 10, 4.98], order["sku2", 3, 67, 98]} >   This makes also perfect scence. Then I am going back to `#1` but now at level `2` > >     {envelope[1, "sku1"], envelope[2, "sku2"]} >   Why do I get this output I was only expecting `Sku1` and `Sku2`. I also wonder why Depth in this case equals 4, but if I put level 3 I get the entire list? I know this is very simple but I have been struggling with seeing the logic. I have spent quite a lot of time trying to grasp this so please try make it as clear as possible. And If you do not understand the question or think it is poorly explained give me a comment before downgrading the question.


title: How to make an inkblot?

text: How to effectively create a polygon that looks like a realistic inkblot? So far, I could come up with this (borrowing from Ed Pegg Jr.'s Rorschach demonstration):               RandomBlot[num_, opts___] := Module[{pts},        pts = RandomReal[{0, 1}, {num, 2}];        pts = pts[[Append[Last@FindShortestTour[pts, Method -> "TwoOpt"], 1]]];        Graphics[{Polygon@           Table[BSplineFunction[pts, SplineKnots -> "Clamped"][a], {a, 0, 1, 0.001}]}, opts]        ];          blot = RandomBlot[40, ImageSize -> 200, AspectRatio -> 1]      ![Mathematica graphics](http://i.stack.imgur.com/ibwxP.png) There are two problems with this:   * it is a bit slow due to `FindShortestTour`   * the blot contains corners being too sharp and has 'bays' reaching too far inward.  Compare it to a desired outcome: ![inkblot](http://i.stack.imgur.com/loyng.gif) **Update:** I should mention that it is not necessary to actually create a Rorschach-like image, so mirroring is not a requirement.


title: Delete False values from a list

text: I have table:               t = {False, False, False, a <= 456, a <=567, a<= 897}      I want to delete all values which are 'False' and make my table to looks like:               t = {a <= 456, a <=567, a<= 897}      I was tried to make a commend like above:               For[i=1,i< Length[tt], i++, If[tt[[i]]==False, Delete[tt,i], Print[no]]]      But it didn't work. I don't want to delete each 'False' value separately, because I have many tables, and each has a different number of `False` values. How can I improve that?


title: 3- dimensional plot of 2-dimensional systems of differential equations

text: Let's take this first example of a 2D output:               sol = DSolve[             {y''[t] + y'[t] + y[t] == 3 Sin[t] - 4 Cos[t],               y[0] == a, y'[0] == 0},              y[t], t           ];     toplot = Table[ sol[[1, 1, 2]] /. a -> i, {i, 0, 3, 0.5}];     Plot[Tooltip[toplot], {t, 0, 2 \[Pi]}]       How can I visualize these solutions with a 3-D output like the ones obtainable by ListSurfacePlot3D , the independant variable (a) of my example being the 3d coordinate? Here I would like to see 7 parallel curves. Also another example this time for a system of two differential equations:               sol = DSolve[             {x'[t] == x[t]/8 - y[t]  ,              y'[t] == x[t]   + y[t]/8,               x[0] == 0,              y[0] == 1},              {x[t], y[t]}, t           ];     ParametricPlot[{x[t], y[t]} /. sol, {t, -2 \[Pi], 2 \[Pi]}]      How can I get a 3D output of these solutions, the 3d coordinate being the variable t (and I expect to get a helix)? Thanks


title: Using Transpose with a list as the second argument

text: I'm having difficulty understanding the `Transpose` function. I know what the transpose of a matrix is, not a problem, and I see that applying the `Transpose` function to a 3×3 matrix does what is expected. What I am having difficulty with is the definition, which says: > `Transpose[list]`, "transpose the top two levels of list" Consider:               A = {{a, b}, {c, d}}     Transpose[A]      What does it mean when the definition says "transpose the top two levels of the list?" I've read about levels in lists, experimented with `TreeForm`, but something like this is giving me a lot of trouble.               A = {{{a, b}, {c, d}}, {{e, f}, {g, h}}, {{i, j}, {k, l}}}     Transpose[A, {3, 1, 2}]      Can someone help me (gently) understand the definition: > `Transpose[list,{n1,n2,...}]`, "put the $k^{th}$ level in list at level > $n_k$" ?


I am looking for the evaluation of a Hypergeometric function with a matrix argument as for example in Ploev and Edelman or as showcased in this Wikipedia article. From what I understand from _Mathematica_ 's documentation, it only accepts a scalar as the last argument.


title: How to change type order in PearsonDistribution?

text: I need to estimate a Pearson distribution from a batch of tables `tab`: `EstimatedDistribution[tab, PearsonDistribution[a1,a0,b2,b1,b0], ParameterEstimator -> "MethodOfMoments"]` I don't want to specify the type, but rather have it automatically picked. Mathematica does this in the order: 4, 1, 6, 3, 5, 2, and 7. Is it possible to change this default order?


title: What are the hidden specifications for FindRoot

text: The Help page of `FindRoot` says: > "by default, FindRoot uses Newton's method (Newton-Raphson) to solve a > nonlinear system" (or a nonlinear equation I suppose). Nevertheless, there is something hidden for me in the `FindRoot` command. Consider the function               f[x]:=Exp[1 - x] - 1,       whose Newton iteration function is               Nf[x_]:=E^(-1 + x) (-1 + E^(1 - x)) + x      Iterating with this function using `NestList` you obtain the sequence of values produced by Newton's method. The Newton method for large values of the initial guess presents slow convergence for this problem.Taking $x_0=10$ we get:               NestList[Nf, 10., 8]     (* {10., -8092.08, -8091.08, -8090.08, -8089.08, -8088.08, -8087.08, -8086.08, -8085.08} *)      where we can see the slow convergence. A plot of the function `Nf[x]` helps to understand the behaviour of the method. But taking               Module[{s = 0, e = 0}, {FindRoot[f[x], {x, 10.}, StepMonitor :> s++,       EvaluationMonitor :> e++], "Steps" -> s, "Evaluations" -> e}]      produces               {{x -> 1.}, "Steps" -> 7, "Evaluations" -> 11}      needing only 7 steps to get the solution $x=1$. Why `FindRoot` produces this result?. Obviously, `FindRoot` is not using the standard Newton's method, isn't it? Can anyone help me? Thanks.


title: Recommended book on random processes to understand new functionality in Mathematica 9?

text: I am interested in exploring the new functionality on random processes available in _Mathematica_ 9, but I am not familiar with all of the underlying mathematics. Could you recommend a book that provides a foundation on these topics? I am thinking about a book that favors intuition and breadth over proofs. I have an engineering background (and know probability and statistics decently well) and would like to rapidly take advantage of these functions. I am interested in both modeling and estimation issues.


title: How do I identify each surface in a multi-surface Plot3D?

text: I am plotting three surfaces on a 3D plot. They differ in the value of one parameter. Is there a way to distinguish each surface for various values of the parameter. My code is               Plot3D[{2*(Cosh[ h/ T]*(2 + Exp[2 /( T)]) +           Exp[-2  /( T)]*Cosh[3  h/T] ),        2*(Cosh[ h/ T]*(2 + Exp[2 10/( T)]) +           Exp[-2*10 /( T)]*Cosh[3  h/T] ),        2*(Cosh[ h/ T]*(2 + Exp[2 100/( T)]) +           Exp[-2*100 /( T)]*Cosh[3  h/T] )}, {T, 0.001, 1000}, {h, 0, 1},       PlotLabel ->        Style[Framed["Partition Function Z"], 20, Red,         Background -> Lighter[LightYellow]], Background -> LightGray,       ColorFunction -> "BlueGreenYellow",       AxesLabel -> {T[kelvin], B[tesla]}, BoundaryStyle -> Thick,       ClippingStyle -> Opacity[0.5]]      **EDIT** I am trying to use `ShowLegend` because `PlotLegend` cannot work with `Plot3D` in v8... The Code I am using is               Z[T_, h_, a_] :=        2*(Cosh[h/T]*(2 + Exp[2 a/(T)]) + Exp[-2/(T)]*Cosh[3 h/T]);     params = {1, 10, 100};     ShowLegend[Plot3D[       Evaluate[Table[         Tooltip[Z[T, h, a], StringForm["a = ``", a]], {a, params}]], {T,         0.001, 1000}, {h, 0, 1},        PlotLabel ->         Style[Framed["Partition Function Z"], 20, Red,          Background -> Lighter[LightYellow]],        MeshFunctions -> {(*#1&,*)#2 &, #3 &},        Mesh -> {(*15,*)15, Range[7.5, 11, 0.1]},        MeshStyle -> {(*Gray,*)Gray, Black}, Background -> LightGray,        PlotStyle -> {Red, Green, Blue}(*,PlotLegends->Table[StringForm[       "a = ``",a],{a,params}]*), AxesLabel -> {T[kelvin], B[tesla]},        BoundaryStyle -> Thick, ClippingStyle -> Opacity[0.5]],       Graphics3D[{Table[{Arrowheads[0.0004],           Arrow[{{900, 0.2 + 0.25 Log10[a], 9.5}, {50. + 5 a,              0.01 + 0.005 a, Z[50. + 5 a, 0.01 + 0.005 a, a]}}],           Text[Style[Framed[StringForm["J = ``", a]], Red,             Background -> Lighter[LightYellow]], {900, 0.2 + 0.25 Log10[a],             9.5}]}, {a, params}]}],{{{Graphics[{Table[StringForm["a = ``", a], {a, params}]}]}},       LegendPosition -> {1.1, -.4}}]


title: Fast DensityPlot

text: Is it possible to increase the perforamce the `DensityPlot`? For example, let's try to plot this "flower"               f[x_, y_] := (x^2 + y^2) Exp[-x^2 - y^2] Sin[10 Sqrt[x^2 + y^2] + 10 ArcTan[x, y]]^4;          DensityPlot[f[x, y], {x, -3, 3}, {y, -3, 3}, PlotPoints -> 200,       MaxRecursion -> 3, ColorFunction -> Hue, PlotRange -> All,       ColorFunctionScaling -> False, ImageSize -> 600]      ![enter image description here](http://i.stack.imgur.com/aSwfo.png) This toy example takes about 12 seconds on my laptop, eats about 1GB of RAM while plotting and the 34MB result slow down the notebook. The question is   1. How to increase the speed?   2. How to decrease the `MaxMemoryUsed`?   3. How to decrease the size of the output?


title: Problem with plotting a function consisting of HeavisideTheta(s)

text: I have the following data               data={{1.5, 10}, {25, 26.5}, {29.25, 32.75}, {39.25, 42.5}, {62.5, 67}, {73.5, 80.75}, {87.5, 93}, {102, 104.75}, {111, 114.5}, {123, 129}, {146.5, 152.75}, {161.5, 164.5}, {177, 182.25}, {195.75, 206}, {218.25, 226.25}, {234.75, 237.75}, {246, 252.5}, {258.5, 260.25},{266.25, 272.75}, {280.5, 280.75}, {281.5, 283}, {292,301.25}, {314, 322}, {327.5, 328.5}, {329, 330.25}}      Each set of point denotes the starting and ending point of the pulse, so here there are as many pulses as               Length[data]      I make the function consisting of all these pulses as follows:               f[x_] := Sum[HeavisideTheta[x - Part[data, i, 1]] + HeavisideTheta[-x+Part[data,i,2]], {i, 1, Length[data]}]      This - as it can be checked - uses 2 Heaviside functions to create each pulse. The problem is while plotting the net pulse function:               Plot[f[x], {x, 0, Part[Last[data], 2] + 10}, Filling -> Bottom]      ![enter image description here](http://i.stack.imgur.com/JwN5h.jpg) As it can be seen from the "data" list, there are supposed to be the               {146.5, 152.75}, {161.5, 164.5} and {280.5, 280.75}, {281.5, 283}      **pulses in the plot that are just missing**. I _just_ can't figure out how this is happening. Any help will be greatly appreciated!