title: Plotting data that lands on the axis

text: I have a data point that lands right on the Y axis, which corresponds to the index of refraction of some sample. the x axis is the mole fraction of chloroform of my samples. How do I get the first data point to look sensible (ie, not directly on the axis). I think it looks funny like this.               Needs["ErrorBarPlots`"];     moleFraction[molesA_, molesB_] = molesA/(molesA + molesB);     molesChloroform = {0.125, 0.100, 0.0625, 0.0375, 0};     molesAcetone = {0, 0.027, 0.068, 0.0952, 0.136};     molefrac = moleFraction[molesChloroform, molesAcetone];     calibrationIndexOfRefraction = {1.440, 1.421, 1.395, 1.380, 1.351};     errorBars = {0.1, 0.1, 0.1, 0.1, 0.1};     newList = Partition[Riffle[molefrac, calibrationIndexOfRefraction], 2];     test = Thread[{newList, ErrorBar[errorBars[[1]], 0]}]     ErrorListPlot[test, PlotRange -> {{0, 1.2}, {1.30, 1.45}},       Frame -> True]      ![My Plot](http://i.stack.imgur.com/MJRfK.jpg)


title: Aligning Text Using Spaces While Maintaining Pretty Print

text: To help illustrate my problem, consider the following cell: ![Goal](http://i.stack.imgur.com/F3DvF.png) First thing to notice is that there is syntax highlighting. Second, I can pretty print mathematics; that is, I see $x^2$ instead of `x^2`. Finally, the equal signs are aligned "nicely." I will expand on what I mean by "nicely" in a second. As of now, I have no idea how to create the cell I illustrated above. Let me elucidate what I mean by this. By default the "Style of newly typed cells" is `Input` and the "Format type of new input cells" is `StandardForm` (in V9 you can see this in the Preferences -> Evaluation menu). ![menu](http://i.stack.imgur.com/whMbt.png) To create a cell that is similar, but not exact, to the cell I have shown above, I need to type the following: `variable` `Space` `=` `Space` `1` `;` `Enter` `var` `Space x 13` `=` `Space` `x` `Ctrl + 6` `2` `→` `;` This produces the following. Notice that the equal signs are not quite aligned. ![standardform](http://i.stack.imgur.com/ud7zJ.png) Hitting `Space` 13 times is not what I call a "nice" way of aligning the equal signs. What I expect, is to hit `Space` 6 times to align the equal signs since this is a monospace font. **Question:** Is there a way to modify the FrontEnd so that the sequence of keyboard commands: `variable` `Space` `=` `Space` `1` `;` `Enter` `var` `Space x 6` `=` `Space` `x` `Ctrl + 6` `2` `→` `;` produces the first image above and I am able to evaluate it? Let me explain what I have tried so far. **(Attempt 1)** Changing "Format type of new input cells" to `InputType`. Using the second set of keyboard commands above, I get what is desired, but evaluating the cell gives me an error.               MakeExpression::boxfmt: InputForm in MakeExpression[FormBox[RowBox[{RowBox[{variable,=,1}],;}],InputForm],InputForm] is not a box formatting type. A box formatting type is any member of $BoxForms. >>      **(Attempt 2)** Changing "Format type of new input cells" to `Raw InputType`. I try using the second set of keyboard commands above and can align the equal signs, but I lose the ability to pretty print math and lose syntax highlighting. I am able to evaluate the cell. ![rawinputform](http://i.stack.imgur.com/wEzEU.png) **(Attempt 3)** Keeping "Format type of new input cells" as `StandardForm`. I use the first set of keyboard commands to produce the third image. Then I highlight the cell bracket and convert to `InputForm` (via `Shift + Ctrl + I`). This gives the following. ![converted](http://i.stack.imgur.com/EnqKR.png) I can then add a few spaces to align the equal signs. ![aligned](http://i.stack.imgur.com/9iT4U.png) Then I change the `x^2` to a $x^2$. Unlike in **(Attempt 1)** , I can evaluate this cell. Even though this gives me what I desire, it is a tedious way to go about it.


title: Compiled DiagonalMatrix

text: The standard function DiagonalMatrix cannot be compiled, so I tried writing my own:               diagMat = Compile[{{vec, _Real, 1}},                       Module[{size = Length[vec], matr},                              matr = Table[0, {size}, {size}];                              Do[matr[[i, i]] = vec[[i]], {i, size}];                              matr]     ];      While this function works, it does not compile. (I check this by doing Export["test.c",diagMat] , is there a simpler way to do this? ) It gives the error message: > CCodeGenerate::wmreq: The expression > Function[{vec,iCompile$67,matrCompile$68},Block[{i=iCompile$67,matr=matrCompile$68},{matr[[i,i]]=vec[[i]],i,matr}]] > requires Mathematica to be evaluated. The function will be generated but can > be expected to fail with a nonzero error code when executed. >> I'm not sure what's wrong here, as all the functions I use are compilable. Thanks


title: Variance/Standard Deviation with a Constant Vaule

text: When applying variance (`Variance[10]`) or standard deviation (`StandardDeviation[10]`) to a constant value in Mathematica, Should the return be zero ? What I get from `StandardDeviation[10]` is the error saying that `standardDeviation::rectt: Rectangular array expected at position 1 in StandardDeviation[10]`. How do I fix it ?


title: How to speed up Manipulate with Graphics3D

text: How do I speed up the Manipulate of the Graphics3D objects here? It is currently painfully slow, and I'm at a loss. I have reviewed many other posts and implemented what I could based on them, but it has had minimal effect on the speed. I have tried implementing:   * Reducing the angles used to 10 degree steps   * Memoization   * Dynamic (applied at various levels to various functions)   * Initialization code for Manipulate   * TrackedSymbols option for Manipulate   * Using With (both inside and outside Manipulate for the functions currently in Initialization) I am building a demonstration of the rotation of vectors through the Euler angles. I have excluded the last rotation because the speed is already so slow. (Apologies in advance for posting the entire code and the poor formatting here and there, which I've chosen to leave as is so that it can be copied and pasted into Mathematica.)               Manipulate[      Graphics3D[{        (* Size a graphics box to make visualization area constant *)           graphicsBox,             (* Original coordinate axes *)        origCoordAxes,             (* Vectors rotated once *)        vectorsRotatedOnce[ψ],             (* Vectors rotated twice *)             vectorsRotatedTwice[ψ, θ],             (* Plane surface first rotation *)             planeSurfaceFirstRotation[ψ],             (* Plane surface second rotation *)             planeSurfaceSecondRotation[ψ, θ]        },       BoxStyle -> Directive[Opacity[.1]],       ViewVertical -> {0, 0, -1},       ViewPoint -> {-12, -10, -5}       ],           {{ψ, 60}, 1, 91, 10},      {{θ, 40}, 1, 91, 10},           Initialization :> (        x0 = {2, 0, 0};        y0 = {0, 2, 0};        z0 = {0, 0, 2};        x1[ψ_] := x1[ψ] = RotationMatrix[ψ Degree, z0]. x0;        y1[ψ_] := y1[ψ] = RotationMatrix[ψ Degree, z0]. y0;        z1[ψ_] := z1[ψ] = RotationMatrix[ψ Degree, z0]. z0;        x2[ψ_, θ_] := x2[ψ, θ] = RotationMatrix[θ Degree, y1[ψ]]. x1[ψ];        y2[ψ_, θ_] := y2[ψ, θ] = RotationMatrix[θ Degree, y1[ψ]]. y1[ψ];        z2[ψ_, θ_] := z2[ψ, θ] = RotationMatrix[θ Degree, y1[ψ]]. z1[ψ];             graphicsBox = Sequence[          EdgeForm[None], Opacity[0],          Cuboid[{0, 0, 0}, {1.25, 1.25, 1.25}],          Cuboid[{0, 0, 0}, {-1.25, -1.25, -1.25}]           ];             origCoordAxes = Sequence[          Black, Opacity[.25],          Arrow[Tube[{{0, 0, 0}, {1, 0, 0}}, 0.005]],          Text[Style["\!\(\*SubscriptBox[\(x\), \(0\)]\)", Black, Large], {1.2, 0, 0}],          Arrow[Tube[{{0, 0, 0}, {0, 1, 0}}, 0.005]],          Text[Style["\!\(\*SubscriptBox[\(y\), \(0\)]\)", Black, Large], {0, 1.2, 0}],          Arrow[Tube[{{0, 0, 0}, {0, 0, 1}}, 0.005]],          Text[Style["\!\(\*SubscriptBox[\(z\), \(0\)]\)", Black, Large], {0, 0, 1.2}]          ];             vectorsRotatedOnce[ψ_] := vectorsRotatedOnce[ψ] =          Sequence[           Red, Opacity[1],           Arrow[Tube[{{0, 0, 0}, x1[ψ]}, 0.01]],           Text[Style["\!\(\*SubscriptBox[\(x\), \(1\)]\)", Black, Large], (1.2 x1[ψ])],           Text[Style["ψ", Lighter@Blue, Large], ((1/3) ( x1[ψ] + x0))],           Green,           Arrow[Tube[{{0, 0, 0}, y1[ψ]}, 0.01]],           Text[Style["\!\(\*SubscriptBox[\(y\), \(1\)]\)", Black,  Large], (1.2 y1[ψ])],           Text[Style["ψ", Lighter@Blue, Large], ((1/3) ( y1[ψ] + y0))],           Blue,           Arrow[Tube[{{0, 0, 0}, z1[ψ]}, 0.01]],           Text[ Style["\!\(\*SubscriptBox[\(z\), \(1\)]\)", Black,Large], (1.2 z1[ψ])]               ];             vectorsRotatedTwice[ψ_, θ_] :=          vectorsRotatedTwice[ψ, θ] =          Sequence[           Lighter@Red, Opacity[.3],           Arrow[Tube[{{0, 0, 0}, x2[ψ, θ]}, 0.01]],           Text[ Style["\!\(\*SubscriptBox[\(x\), \(2\)]\)", Black, Large], (1.2 x2[ψ, θ])],           Text[ Style["θ", Lighter@Green, Large, Opacity[1]], ((1/3) ( x2[ψ, θ] + x1[ψ]))],           Lighter@Green,           Arrow[Tube[{{0, 0, 0}, y2[ψ, θ]}, 0.01]],           Lighter@Blue,           Arrow[Tube[{{0, 0, 0}, z2[ψ, θ]}, 0.01]],           Text[Style["\!\(\*SubscriptBox[\(z\), \(2\)]\)", Black,Large], (1.2 z2[ψ, θ])],           Text[Style["θ", Lighter@Green, Large,  Opacity[1]], ((1/3) ( z2[ψ, θ] + z1[ψ]))]           ];             planeSurfaceFirstRotation[ψ_] :=          planeSurfaceFirstRotation[ψ] =          Sequence[           Opacity[.2],           Directive[Blue, Glow[Blue], Specularity[0]],           Dynamic@Rotate[surfaceX2[ψ Degree][[1]], 0, {0, 0, 1}],           Dynamic@Rotate[surfaceX2[ψ Degree][[1]], π/2, {0, 0, 1}]           ];             planeSurfaceSecondRotation[ψ_, θ_] :=          planeSurfaceSecondRotation[ψ, θ] =          Sequence[           Opacity[.2],           Directive[Green, Glow[Green], Specularity[0]],           Dynamic@Rotate[Rotate[surfaceX2[θ Degree][[1]], ψ Degree, {0, 0, 1}],              3 π/2, x1[ψ]],           Dynamic@Rotate[Rotate[surfaceX2[θ Degree][[1]], ψ Degree - π/2,{0, 0, 1}], 3 π/2, x1[ψ]]           ];             surfaceX2[α_] := surfaceX2[α] =          ParametricPlot3D[{r Cos[u], r Sin[u], 0}, {u, 0, α}, {r,             0, 1.5},           Mesh -> None,           Axes -> None,           Boxed -> True,           Lighting -> {{"Ambient", Blue}},           PerformanceGoal -> "Speed"           ];        ),      TrackedSymbols :> {ψ, θ}      ]


title: Transform fancy usage messages in 1D string

text: When we look at the usage messages of built-in functions nowadays (not in the good old times, when they were a simple descriptions) we see that although they look pretty in the front end, it is really hard to get a simple, one- dimensional string representation. Just try this and see yourself               ToString[Integrate::usage]      This is completely useless when one seeks for a simple string form. When you look at the _Wolfram Workbench_ you may have noted, that they _do_ provide simple string usage messages even for built-in functions. **Question:** Is it possible to create/extract/steal simple, non-formatted usage messages for **all** (or almost all) built-in functions **automatically**? With _automatically_ I mean having one function which works for almost all usage messages. To give an example, the `Integrate` help message of the _Workbench_ looks like this: > Integrate[f,x] gives the indefinite integral Integral f dx. > Integrate[f,{x,xmin,xmax}] gives the definite integral Integral _xmin ^xmax > f dx. Integrate[f,{x,xmin,xmax},{y,ymin,ymax},...] gives the multiple > integral Integral _xmin ^xmaxdxIntegral _ymin ^ymaxd y ... f. > > Attributes: {Protected,ReadProtected} Options: > {Assumptions,GenerateConditions,PrincipalValue}


title: ContourPlot with parameter

text: I have an equation for function `F[x,y]==0` which first argument `x` is real and another, `y`, is complex. All constants in equation are real. I define `y` as `y=a+I*b`. I need to plot `Im[y]` as function of `x`. (in other words, I need a plot of `b` as function of `x`. The equality for `F` for `a` and `b` and `x` can be solved only using `FindRoot` function. Here's how I tried to plot what I need:               ContourPlot[{{Im[F] == 0, Re[F] == 0}}, {b, 0.1,        10^8}, {x, 0.1, 10^16}]      But nothing is plotted. Any ideas? Thank you for help! * * * Here is the function and constants:               e2 = 5     e3 = 1     omega1 = 1.1242*10^(16)     omega2 = 4.5896*10^(15)     omega3 = 5.5927*10^(15)     e1 = 1 - omega1^2/x^2     c = 3*10^8     k1 = Sqrt[y^2 - x^2/c^2 e1]     k2 = Sqrt[y^2 - x^2/c^2 e2]     k3 = Sqrt[y^2 - x^2/c^2 e3]     h = 5*10^(-9)     y = a + I b     F = ((k2/e2 + k1/e1)*(k3/e3 + k2/e2))/((k1/e1 - k2/e2)*(k3/e3 -             k2/e2)) - Exp[-2 k2 h]      Here is my attemption to plot roots I that I tried with FindRoot. But I am not sure it plots all roots correctly and I don't even know where to search for them:                findPoint[i_] :=       Evaluate[Function[        Assuming[a \[Element] Reals && b \[Element] Reals,          FindRoot[{(Re[F] /. x -> (10000*i)) ==             0, (Im[F] /. x -> (10000*i)) == 0}, {{a, 0.5}, {b, 0.2}}]]]]     list1 := Table[b /. findPoint[i][[1]], {i, 1, 2000}]     list2 := Table[10000*i, {i, 1, 2000}]     PointDone := Inner[List, list1, list2, List]     Show[{Graphics[Point[PointDone], Axes -> False, AspectRatio -> 1/2,         Frame -> {{True, False}, {True, False}}, FrameTicksStyle -> 18]}]      Here is a plot I got.. ![enter image description here](http://i.stack.imgur.com/Mqjhq.png)


title: How to Maximize[Log[n]^(1/Log[n]), n]

text: I am new to Mathematica and am trying to work out how to use Maximize.               Maximize[Log[n]^(1/Log[n]),n]      Should give a solution at $e^e$. However in Mathematica you don't get anything. What's the right way to do this?


title: Control parameters of different styles of DistributionChart

text: Using `DistributionChart`, you can choose among several styles aka `ChartElementFunction`:               ChartElementData["DistributionChart"]          {"Density", "DensityQuantile", "FadingQuantile",      "GlassQuantile", "HistogramDensity", "LineDensity", "PointDensity",       "Quantile", "SmoothDensity"}      Is there a way to control their parameters? The documentation does not seem to say. * * * The problem is that the defaults are less than optimal for my data. Consider these: Using `SmoothDensity`: ![SmoothDensity](http://i.stack.imgur.com/VpyTN.png) Using `HistogramDensity`: ![HistogramDensity](http://i.stack.imgur.com/ZdRmQ.png) Using `LineDensity`: ![LineDensity](http://i.stack.imgur.com/xPq13.png) Clearly, `SmoothDensity` grossly misrepresents the data (just compare with the `LineDensity` version); the violins should all look like the ones for 2 and 9. `HistogramDensity` does a better job but its resolution is horrible; there are 100 data points per size, about 70 of which fall into the upper class -- that should be plenty of points to draw more bars. I would like to tell `HistogramDensity` to use more/smaller bins, and/or `SmoothDensity` to smooth less. How is this possible?


title: How to obtain differential equations of motion using Lagrangian dynamics?

text: I'm confused to find a set of differential equations of motion of a pair of masses, `m1` and `m2` joined by a spring of constant `k`. The unstretched length of the spring is `L`, and the initial conditions are; `x1[0]=0, x2[0]=L+a, x1'[t]=0, x2'[t]=0`. `x1[t]` and `x2[t]` are the positions of the masses `m1` and `m2` at any time `t`. I used Lagrangian dynamics to find the differential equations of motion, but I'm not sure my codes are correct. And I have no idea where I need to put the initial conditions to find the differential equations. Can someone help me?               Needs["VariationalMethods`"];     T = 0.5*m1*x1'[t]^2 + 0.5*m2*x2'[t]^2;     V = 0.5*k*(x2[t] - x1[t] - L);     lag = T - V;     eqn[n_] = EulerEquations[lag, {x1[t], x2[t]}, t];


title: Mapping a function that assigns values to a list over a different list

text: I'm trying to get used to Mathematica's approach to programming and list manipulation, and am struggling with one thing. Say that I have a function `f` which takes a list of two values and returns a list of two values. I also have a list of doubles, `c = {{1, 2}, {1, 3}, {1, 4}, {2, 3}, {2, 4}, {3, 4}}`. For each double in `c`, I want to return a list of four values: two of them zero, and the ones with corresponding indices in `c` should be defined by applying the function `f` to the double in `c`. Let me show some examples. For the value `{1,3}`, I would like to return `{ f[{1,3}][[1]], 0, f[{1,3}][[2]], 0 }`, and for `{2,3}`, I would like `{ 0, f[{2,3}][[1]], f[{2,3}][[2]], 0 }`. I am completely stumped by this problem when I try to find a nice solution using `Map` and other standard Mathematica list operations. The approach that I've tried was to map over `c` trying to assign values to a list of zeroes depending on the values in `c`, but I'm lost as to how I would accomplish that. I can basically do what I want with a loop:               result = {};     Do[      list = {0, 0, 0, 0};      list[[x[[1]]]] = f[x][[1]];      list[[x[[2]]]] = f[x][[2]];      AppendTo[result, list],     {x, c}]      but I would like to learn a better approach. Here, I don't even know how to perform the operation inside the `Do` loop more elegantly, because something like               Map[(list[[x[[#]]]] = f [x][[#]])&, {1,2}]      does not work. I would appreciate any suggestions and help with this problem.


title: Exporting to quicktime in linux version?

text: In _MMA_ (8.0.0/Linux), I tried to to create an animation using the command               Export["s4s5mov.mov", listOfFigures]      and got the output ![enter image description here](http://i.stack.imgur.com/bFWPP.png) Doing a little research, one can read in the Documentation Center that ![enter image description here](http://i.stack.imgur.com/woicu.png) And I was wondering **if there is some way to overcome this limitation _within MMA_**. **EDIT** Here is a sample code of the inverted animation problem:               movingP = Table[Show[         ParametricPlot[{Sin[x], Cos[x]}, {x, 0, 2 \[Pi]}, AxesLabel -> {x, y}],         Graphics[{Red, PointSize[Large],               Point[{Sin[(n \[Pi])/8], Cos[(n \[Pi])/8]}]}]         ], {n, 0, 15}]          Export["~/Desktop/point.avi", movingP]      will produce an avi like this: ![enter image description here](http://i.stack.imgur.com/JPkLa.gif) (The gif has been tampered to look like the avi)


title: Forcing RecurrenceTable + NIntegrate to evaluate lazily

text: I have a recurrence relation that grows exponentially if expressed in closed- form. I need to integrate this function. If I plot it, I think _Mathematica_ evaluates the recurrence numerically at every level, so the recurrence doesn't grow to be a huge expression. `NIntegrate`, however, seems to be trying to find a closed-form equation to integrate, even when I turn off symbolicprocessing. I've tried all the options I can think of, including extracting my relation to a function, adding `Simplify` to the recurrence, and I'm just completely stumped at how I can force _Mathematica_ to stop using symbolic manipulation for an expression that has $2^{100}$ terms. Anyone have any ideas?               HOWavefunctions = Function[{q, n},          RecurrenceTable[{y[i + 1] ==             Sqrt[2/(i + 1)]*q*y[i] - Sqrt[i/(i + 1)]*                y[i - 1], y[0] == 1/(Pi^0.25*E^(0.5*q^2)),           y[1] == Sqrt[2]*q*y[0]}, y, {i, 0, n}]]     n = 100;     Plot[HOWavefunctions[q, n][[n + 1]]^2, {q, 14.05, 15}]     NIntegrate[HOWavefunctions[q, n][[n + 1]]^2, {q, 14.05, 15}]      (If you turn $n$ down to $15$ or so, both work just fine.) I guess, ultimately, what I'm looking for is a way to tell `RecurrenceTable` to evaluate 'lazily', that is, only evaluate a term once all variables have numeric values, and never ever expand the relationship symbolically. I tried inserting a `Simplify` in the recurrence, but _Mathematica_ apparently ignored me.


title: Slow Open Dialog user Interface in Mac OSX Mavericks

text: The other day I noticed an interesting problem with Mathematica on the Mac. When I'm in the Mathematica application and try to open a mathematica file with the "Open" option of the file menu the open dialog box will appear as expected. However if I have to go several folders deep in my filesystem hierarchy to a folder with many mathematica files the operation of the open dialog box will bog down to an unusable point. The symptoms are as follows. When I try to scroll through the list of available files the window and the Mathematica app will freeze for 20-30 seconds. It will then jump unpredictably to around the list and freeze again for another 20-30 seconds. This repeats itself over and over rendering it impossible to open the file that I really wish to open. I opened the MacOS activity monitor while this is occurring and found that the coreservicesd process zooms out of control and takes over 80-90% of the processor clock cycles and that the com.apple.IconServicesAgent takes up most of the remaining clock cycles. My guess is the the Mathematica front end for some reason doesn't play nice with Mac OSX Mavericks. I think that it is specific to Mathematica though because I've not noticed any problem with other applications. Anyone have a similar experience or a fix?


title: Determining the dates of days

text: I'm trying to use `WeatherData[]` to give me (not sure how) the temperature, humidity, wind-speed, cloud cover... at a certain location. I only want the information for weekdays (e.g. Monday-Friday) for the last 83 years. How do I make a list of all these dates in a format (`DateList` or `DateString`) that `WeatherData[]` can use?


title: Computations in the exterior algebra

text: I want to be able to compute with explicit exterior algebras of vector spaces. For example, given a real vector space $V$ of $3 \times 3$ matrices, I want to consider expressions of the form $v\wedge w\in \Lambda^2 V$ and would like Mathematica to understand that $v\wedge w=-w\wedge v$, and $v\wedge w+v\wedge t=v\wedge (w+t)$ etc. In particular, I want to be able to define linear operators on $\Lambda^2 V$ on a basis of decomposable elements and extend it by linearity to all elements. As an example, I would like to define an inner product $$B(x\wedge y,z\wedge w)=\langle x,y\rangle \langle z,w\rangle-\langle x,w\rangle\langle y,z\rangle$$ and have Mathematica understand that $$B(e_1\wedge e_2+e_3\wedge e_4,e_1\wedge e_2-e_3\wedge e_4)=0,$$ where $e_1,e_2,e_3,e_4\in V$ are orthonormal. So far, my attempts were tricking Mathematica into thinking that $v\wedge w$ is the ordered pair `{v,w}`, but the problem is that this only makes computations work for _decomposable_ vectors, since it thinks that $e_1\wedge e_2+e_3\wedge e_4=(e_1+e_3)\wedge (e_2+ e_4)$, i.e., `{e1,e2}+{e3,e4}={e1+e3,e2+e4}`, but I want to rule this out. The command `\wedge` in Mathematica does not have a meaning (only makes for a nice display), and I tried using `TensorWedge[,]` but I can't get it to answer back results of expressions explicitly. I also gave a couple Packages a try, like "Grassmann" and "Ricci", but I feel there should be an easier way of doing this... Any thoughts?


title: How to fill between abscissa values?

text: How can I produce a fill (in a plot) that extends between two given abscissa values, and "infinitely" in the ordinate direction? (Of course, here "infinitely" just means "up to the top and bottom boundaries of the plot, _whatever those may be_ ".) I thought that `RegionPlot` would do the trick, but no: `RegionPlot` requires that the extent of regions be fully specified in both directions; e.g. it does not understand a third parameter having a form anything like `{y, -Infinity, Infinity}`. EDIT: Let me clarify the question. _Just as an example_ , imagine that I have a random bunch of `Graphics` objects displayed together: ![enter image description here](http://i.stack.imgur.com/JzKKK.png) OK, now, I want to show a vertical shaded band between `x=-1` and `x=1`. Conceptually, this is a very simple, commonplace idea, but to do it with _Mathematica_ one must suffer a little... Note that for the desired modification only two parameters are relevant: the abscissas of the edges of the region of interest. _Any_ $y$-dimension information is completely extraneous to the problem, and can only complicate or sharply reduce the generality of the original figure. I was not able to find any way to do what I want to do that did not require specifying extraneous, irrelevant parameters. For example: ![enter image description here](http://i.stack.imgur.com/smZzc.png) Why did the aspect ratio change? Who knows. More importantly, notice that for `RegionPlot` I had to specify the _irrelevant_ range parameters `{x, -5, 5}` and `{y, -1, 6}`. These parameters are, in fact, worse than irrelevant: they actually mess up what was there before. For example, now the content-agnostic `All` spec in the pre-existing `PlotRange->{{-5, 5}, All}` parameter, and the also content-agnostic `PlotRangePadding->0.5` specification, no longer work. I have to replace the first one with a fragile, hard-coded vertical range specification, and fuss with the second one: ![enter image description here](http://i.stack.imgur.com/hQilm.png) My hope is to find a way to achieve the same effect that is less disruptive, and that it does not force me to specify irrelevant or excessively specific parameters.


title: How to mathematically represent MMA 9 Spikey?

text: I am trying to figure out how to mathematically represent the MMA 9 Spikey in order to send to a 3D printer. According to this page, " _In particular, spikeys for version 2 and up are based on a hyperbolic dodecahedron with embellishments rather than a cumulated icosahedron."_ How might I represent these "embellishments?" An .stl file has been generated (and is here, for all interested) of a rhombic hexecontahedron. This, however, is the farthest I have progressed. Any help would be appreciated.


title: Resizing graphics with an inset when exporting

text: I am generating a number of graphics using _Mathematica_ that contain text. Adding the text to the graphic has been a considerable challenge, but I have finally come up with the following:               testg = Graphics[{Inset[        Graphics[Polygon[{{0, 0}, {10, 0}, {10, 10}, {0, 10}}],           ImageSize -> {90, 90}], {Left, Center}, {Left, Center}],         Inset[Graphics[          Inset[Cell[            TextData[{StyleBox["Text One\nText Two\n",                FontFamily -> "Arial", FontSize -> 30,                TextAlignment -> Left, LineSpacing -> {1, 0}],               StyleBox["Text Three", FontFamily -> "Arial", FontSize -> 12,                TextAlignment -> Left, LineSpacing -> {1, 0}]}]]],           ImageSize -> {125, 90}, ImageMargins -> 0, ImagePadding -> None,           AspectRatio -> Full], {Right, Center}, {Right, Center}]},        ImageSize -> {220, 90}, AspectRatio -> Full]      You will, no doubt, observe that the final graphic is produced by insetting the actual graphic (for demonstration purposes, I've made it just a rectangle) and then a cell with the text. I have had to size the rectangle to fit the text, and I have manually sized the text though trial and error. The composed image size is that of the two separate graphics with a bit of padding. My question is, how can I resize this graphic on export? I would like to create much higher resolution images for use in a print environment.               Export["test.png", testg]      Setting the ImageSize on the export works to change the size of the PNG, but does not scale up the two Inset graphics. I need a way of doing this. As I will be producing many, many images, I would like to do this within _Mathematica_. Any help will be appreciated. Alternative: I am actually **very** new to _Mathematica_ , so a I would also be interested in better approach than mine.


title: What is the fundamental difference between ArrayPlot and MatrixPlot?

text: Suppose I have a matrix called `data`. It seems that I can plot `data` using either `ArrayPlot` or `MatrixPlot`:               data = {{1, 0, 1}, {0, 0, 1}};     imgSize = 200;     Grid[{{        ArrayPlot[data, ImageSize -> imgSize],        MatrixPlot[data, ImageSize -> imgSize]        }}]      ![plot1](http://i.stack.imgur.com/j8dMY.gif) So, by default, `ArrayPlot` and `MatrixPlot` give just different styles, it seems. I can adjust style parameters to obtain the same style:               Grid[{{        ArrayPlot[data, ImageSize -> imgSize, FrameTicks -> All,          ColorRules -> {0 -> White, 1 -> Blue}],        MatrixPlot[data, ImageSize -> imgSize,          ColorRules -> {0 -> White, 1 -> Blue}]        }}]      ![plot2](http://i.stack.imgur.com/voR0D.gif) What, if anything, it is the fundamental difference between `ArrayPlot` and `MatrixPlot`?


title: How to preserve focus on InputField after Print?

text: If you press `Enter` in the example below it should become clear that test is being adding to the textbox instead of the current `Notebook`.               EventHandler[      InputField["", String]      , {"ReturnKeyDown" :> (         SetSelectedNotebook[EvaluationNotebook[]];         SelectionMove[EvaluationNotebook[], Notebook, All];         NotebookWrite[EvaluationNotebook[], "test"]         )}]      How might I force the text to be added to the `Notebook` instead of the other `InputField`? **EDIT:** Ideally I am looking for a solution that doesn't involve removing focus from the `InputField`.


title: Image segmentation and object separation in 3D using Mathematica

text: I currently work on an image segmentation scenario to detect cell nuclei in 3D using _Mathematica_. The data I have are image stacks in the TIFF file format. I would like to keep the sequence of image processing steps as small and simple as possible, since I expect the segmentation pipeline to work for several image stacks. I uploaded an example image stack containing several cell nuclei objects. Here is a screenshot of the image stack after creating an `Image3D` object out of it.               smallCropped = Image3D[Import["...\\smallExample.tif"],      Axes -> True, AxesLabel -> {"X", "Y", "Z"}]      ![raw image stack as Image3D object](http://i.stack.imgur.com/YFqVc.png) The image shows about 40-50 cell nuclei objects. Note that due to a different spacings in the z-dimension the objects appear flattened. However, this should not have any influence on the segmentation itself. If you have a look at the data you will find out that the signal to noise ratio (SNR) is very high. The segmentation of the cell nuclei objects should therefore be feasible. Here is a GIF animation of the image stack moving through the stack in the z-dimension: ![enter image description here](http://i.stack.imgur.com/Ecmgk.gif) I applied what seems to me as the most straight forward approach to segmentation in _Mathematica_ (Binarize and MorphologicalComponents):               Show[#, ImageSize -> 512] & /@ {binary = Binarize@smallCropped,        Image3D[Colorize@MorphologicalComponents@binary]}      ![enter image description here](http://i.stack.imgur.com/AYGmH.png) So far so good. As you can see from the colorized components matrix on the left, several cell nuclei objects are assigned the same object label ( _e.g._ the large pink object). Hence, preprocessing steps and a more sophisticated segmentation procedure seem to be required. After going through many types of image filtering and segmentation in _Mathematica_ I got lost at some point and ended up plugging together various different filtering and segmentation steps. In most of the cases, the more I tried the worse the results got ;) I know that there is no golden rule for segmentation in image processing but the task of correctly segmenting the objects in this scenario seems to me not that difficult and I wonder if there exists a nice and easy way. The WatershedComponents method tries to separate connected objects. Since this method currently only works in 2D in _Mathematica_ I implemented a method that first segments all the images of the stack slice by slice using a combination of `GradientFilter`, `WatershedComponents`, `Binarize`, `MaxDetect` and `DistanceTransform`. I then tried to merge the results from this 2D segmentation to end up with a 3D components matrix. I didn't put the code here but you can see the output of these two steps below (left: 2D `WatershedComponents` result, right: 3D result after merging).               compsMatrix =        SelectComponents[          WatershedComponents[GradientFilter[#, 1],            MaxDetect[DistanceTransform@Binarize@ImageAdjust@#],            Method -> {"MinimumSaliency", .3}], "Count",           10 < # < 2000 &] & /@ Image3DSlices[Binarize@smallCropped]      ![enter image description here](http://i.stack.imgur.com/5Ig1t.png) This is where I am at so far. The segmentation accuracy and object separation still looks poor to me and I am curious what steps might improve the results. My questions are: **1\. What preprocessing steps (e.g. filters) built in Mathematica might be suitable to increase the segmentation accuracy in this case? Is there a combination of standard filters that might work here?** **2\. How could I improve the separation of objects in 3D?** **3\. What about`WatershedComponents` for `Image3D` objects?** **Edit: response comment on Erosion** A suggestion in the comments was to use `Erosion`. I know that erosion helps to separate objects.however, in this scenario it did not help and I would lose much information about the objects. **Edit: response to answer by UDB** Thanks to the nice approach proposed by UDB I could go on with the 3D segmentation problem and try the approach with my data. At first the results looked very promising but when taking a closer look, I have to say that the solution proposed does not provide a satisfying result. I have checked the results for the test image stack provided above I then used the functions proposed by UDB:               distcompiled =        Compile[{{dist, _Integer, 3}},         Module[{dimi, dimj, dimk, disttab, i, j, k,           ii}, {dimi, dimj, dimk} = Dimensions[dist];         disttab = Table[(i - ii)^2, {ii, dimi}, {i, dimi}];         Table[          Min@Table[disttab[[i, ii]] + dist[[ii, j, k]], {ii, dimi}], {i,            dimi}, {j, dimj}, {k, dimk}]], CompilationTarget -> "C"];          Options[EuclideanDistanceTransform3D] = {Padding -> 1};     EuclideanDistanceTransform3D[im3d_Image3D, OptionsPattern[]] :=        Module[{dist3d, i, j, k, ii, dimi, dimj, dimk},         dist3d =          Developer`ToPackedArray@          ParallelMap[           Round[ImageData[               DistanceTransform[#, DistanceFunction -> EuclideanDistance,                 Padding -> OptionValue[Padding]]]^2] &,            Image3DSlices[            Image3D[ArrayPad[ImageData[im3d, "Bit"], 1,               Padding -> OptionValue[Padding]]]]];        If[OptionValue[Padding] != 0,          dist3d =            Developer`ToPackedArray@            ParallelMap[             If[Times @@ Dimensions[#] == Total[Flatten[#]], # +                 1073741822, #] &, dist3d, {1}];];        dist3d = Developer`ToPackedArray@distcompiled[dist3d];        dist3d = ArrayPad[dist3d, -1];        Image3D[Sqrt@dist3d, "Real"]];      As you can see, I changed the `CompilationTarget` to "C" and added a missing comma after the local variable disttab in the distcompiled function. I then packed the function together and gave it a name:               splitSegmentation3D[img3d_Image3D] :=       Function[{image},         Image3D[Colorize[          MorphologicalComponents[           ImageMultiply[            Binarize[             LaplacianGaussianFilter[              EuclideanDistanceTransform3D[               ColorNegate[                Binarize[                 ImageMultiply[MaxDetect[#], #] &[                  EuclideanDistanceTransform3D[image]], 5]]], 1]],             image]]]]][img3d]      As proposed I set the threshold for accepted maxima to 5 in this function. For binarization I use the proposed `TotalVariationFilter` as pre-processing step and then do a simple `Binarize`. I then do the last of the pipeline using the function `splitSegmentation3D`:               {smallCropped = Image3D[Import["...\\smallExample.tif"],     prepro = TotalVariationFilter[smallCropped],     bin = Binarize[prepro],     comps = splitSegmentation3D[Binarize[prepro]]}      ![enter image description here](http://i.stack.imgur.com/OiQL9.png) The components image looks just like the components image in the answer except for the colors...good. But when taking a closer look at the segmentation by slicing through the images in z-dimension, you see the details. I put the results of the complete image processing chain next to each other (from left to right: original, preprocessed, binary, components image): ![enter image description here](http://i.stack.imgur.com/58wvb.gif) I see multiple problems with this approach. First, using `TotalVariationFilter` as preprocessing step also blurs the image which results in many connected objects. Second, the splitting performs heavy over segmentation resulting in splitted objects. Third, many objects seem to be rounded by the segmentation. I think this results from the `EuclideanDistanceTransform3D` in combination with `ImageMultiply`. I don't think that a perfect segmentation is possible on my data, but it should work out for at least some of the objects.


title: Converting a BSplinecurve to function

text: I am having two set of data. This is d000 and d001. The set d001 is a subset of d000. I am fitting the d000 data by using the BSpline of the d001 data according to the following commands:               Table[Graphics[{Green, PointSize[Large], Point[d000], Red,         Point[d001], Black, BSplineCurve[d001]}, AspectRatio -> 1,        Axes -> True]]     SP = BSplineFunction[d001, SplineKnots -> "Unclamped"]     dsp[t_] = 2*0.33*10^(-9)*10^(12)*D[SP[t], t]      My problem is that the SP is defined with respect to the parameter t of the curve (that does the fitting), not with respect to a variable x, that defines the domain of the data d000. Does anyone know how I can convert the SP to a function of x?


title: CUDA* commands are very slow on OS X and Mac

text: I have Mathematica 8.0.4.0 installed on my new MacBook Pro running OS X 10.8. I also have the latest CUDA drivers (and even the CUDA SDK) from nVIDIA. I've noticed that commands like CUDAQ[] take a VERY long time to return 'True'. The CUDA resources paclet is already installed. Here's some examples:               In[1]:= Needs["CUDALink`"]          During evaluation of In[1]:= General::cdir: Cannot set current directory to authserver. >>          In[2]:= AbsoluteTiming[CUDAQ[]]          Out[2]= {112.003663, True}          In[3]:= AbsoluteTiming[CUDAResourcesInformation[]]          Out[3]= {7.734287, {{"Name" -> "CUDAResources"...      Has anyone else seen CUDAQ[] take 112 seconds to return? It's almost like Mathematica thinks the paclet isn't installed or something. Subsequent runs of CUDAQ[] in the same session return quickly. If I kill the kernel and launch a new one, it's back to 100+ seconds again. Other CUDA commands also take a very long time to initially run and then run quickly if run again in the same session. Restarting the kernel gets you back to the excessive times again. A related question: is there a log somewhere where I can see what the heck the kernel is doing when I type in that initial CUDAQ[]? Thanks!


title: Matrices and Upper / Lower Triangular Factorizations

text: Does anyone know (I have searched documentation, online and MathSource) if there are ways to coax out the following factorizations from Mathematica?   * $A = LU$, $LU$ factorization   * $PA = LU$, $LU$ factorization with Partial Pivoting   * $PAQ = LU$, $LU$ factorization with full pivoting   * $A = LDU$, $LDU$ decomposition I found one library in MathSource for $LU$, but it does not behave very well.


title: Read expression from Mathematica via Mathlink C++

text: This is a simple C++ program to send an expression to the_Mathematica_ Kernel and get its response.               #include <mathlink.h> //mathlink header     #include <stdio.h> //standard io header     #include <stdlib.h>     #include <iostream>     using namespace std;          /* initialising variables */     MLENV env = (MLENV)0;     MLINK link = (MLINK)0;          int MLEvaluate(MLINK mlp, char* s)     {         return MLPutFunction(mlp, "EvaluatePacket", 1L)             && MLPutFunction(mlp, "ToExpression", 1L)             && MLPutString(mlp, s)             && MLEndPacket(mlp);     } /* MLEvaluate */          int main(int argc, char *argv[]) {         int errno;         int packet;         char input[255];              /* initialises MathLink environemnt object */         env = MLInitialize(0);              /* links the program to the MathKernel */         link = MLOpenString(env, "-linkmode launch -linkname 'C:\\Program Files\\Wolfram Research\\Mathematica\\9.0\\math.exe'", &errno);         MLActivate(link); //activates a MathLink connection with a mathlink program              cout << "Enter your expression: ";         cin >> input;         MLEvaluate(link, input);              /* get packets until we find a ReturnPacket or error */         while ((packet = MLNextPacket(link)) && packet != RETURNPKT) MLNewPacket(link);              /* once the results is returned */         if (MLError(link)) printf("\nError Has Occured!\n");  //if an error is returned             else {                                                //if an integer is returned             int result;             const char *string;             MLGetString(link, &string);             printf("\nResult: %s\n", string);                  MLReleaseString(link, string);         }              printf("\nPress Enter to Exit...");         getchar(); //holds the console till users presses enter         getchar(); //holds the console till users presses enter         return 0;     }      When I type the expression show below in response to the console prompt > 2+2 I get an answer. However, when I type in > 2+a I dont seem to be able to read the answer as string Where did I go wrong? Please advise


title: remove -1 values from a list

text: I would like to turn a list which looks like this one:               {{-1, -1, -1}, {-1, 2, 3}, {-1, -1, 2}, {2, 3, 4}}      into one which looks like that one:               {{}, {2, 3}, {2}, {2, 3, 4}}      Is there an efficient way to do this?


title: Why are the two shades of the same color in this figure?

text: Given $S \subseteq \mathbb{C}$ I am trying to plot $f(S)$ for given complex valued function $f$ Looking at other answers on this site for similar questions, I came up with this               f = Function[z, 1/Conjugate[z]];          (*Plot limit parameters*)     plimit = 1;     space = 2;     plrange = {{Re[f[-plimit]] - space, Re[f[plimit]] + space},                {Im[f[-plimit]] - space, Im[f[plimit]] + space}}          ParametricPlot[       Evaluate@({Re[f[z]], Im[f[z]]}*Boole[Abs[z] < 1] /. z -> x + I*y),       {x, -plimit, plimit},       {y, -plimit, plimit}, (*Indicates the rectablge from which the points satisfying Boole[..]==1 will be picked.*)       PlotRange -> plrange     ]      The result of this command is ![enter image description here](http://i.stack.imgur.com/HsgYC.jpg) My question is why are there two different colors in this image? One light and one dark. Is the plot trying to tell me something here? **SYSTEM INFORMATION:** Version 8.0.1.0 Platform Linux x86(32-bit) Ubuntu 11.04


title: What algorithm is Mathematica 9 using for "SpectralEmbedding" of graphs?

text: When I specify that a graph should be realized using the "SpectralEmbedding" procedure, what paper / algorithm for spectral embedding is this based on? I was unable to find any documentation for this. Also, are we guaranteed that the contours of a $N \times M$ rectangular lattice will be straight lines after this embedding procedure?


title: Labelling of multiple BarChart elements with "Stacked" layout

text: I am trying to create a stacked `BarChart` where each `BarChart` has different `ChartLabels`. Consider the following example:               BarChart[{{5, 6, 7, 5, 7}, {8, 5, 6, 7, 8}}, ChartLayout -> "Stacked",       ChartLabels -> {Placed[{"One", "Two"}, Above],         Placed[{5, 6, 7, 5, 7}, Center]}]      > ![enter image description here](http://i.stack.imgur.com/GMxNE.png) But what I would like to have is separate labels for the segments in the two chart elements. The following image illustrates this: > ![enter image description here](http://i.stack.imgur.com/NFgzU.png) I can't figure out how to do that using `ChartLabels`. When I try providing multiple lists for the chart labels it doesn't work.


title: How can I set a keyboard shortcut to run a command?

text: I want to use this to add a keyboard shortcut to an undo function I wrote. The basic problem is the following: I have a command, let's say `x=1`, and I want to run the command with a keyboard shortcut. Is there a way to do it? Editing the KeyEventTranslation.tr file is what I tried. Adding               Item[KeyEvent["z",Modifiers->{Command}],Evaluate[x=1]],      does not work.               Item[      KeyEvent["z", Modifiers -> {Command}],        FrontEndExecute[{FrontEnd`NotebookWrite[FrontEnd`InputNotebook[],"x=1"]}]]      adds the text x=1 where the cursor is, but it still needs to be evaluated and I need to be at the right place with the cursor. Are there other ways? This might be related, but I couldn't get anything out of it so far.


title: ScalingFunctions not working properly for x-axis

text: I am trying to make a chart where the x-axis has a log scale and the y-axis is in reverse order. I tried to use `LogLinearPlot`, and I tried to combine it with `ScalingFunctions`. My code was:               LogLinearPlot[1/x, {x, 1, 1000}, ScalingFunctions->"Reverse"]      But this failed. So I tried using `Plot` and `ScalingFunctions`:               Plot[1/x, {x, 1, 1000}, ScalingFunctions -> {"Log", "Reverse"}]      That gave me an error as well. I noticed that `ScalingFunctions` works just fine when applied to the y-axis, as in:               Plot[1/x, {x, 1, 1000}, ScalingFunctions -> "Log"]     Plot[1/x, {x, 1, 1000}, ScalingFunctions->"Reverse"]      However, when I apply `ScalingFunctions` to the x-axis, it will give an error; for example:               Plot[1/x, {x, 1, 1000}, ScalingFunctions -> {"Log", Identity}]      Can anyone tell me what to do to get a reversed y-axis and a logarithmic x-axis at the same time?


title: Applying a for loop on Out[]

text: I have a number of expressions, each one is an output: Out[135], Out[136], etc. I wish to print all of these outputs in a C++ form using the function: CForm. I can apply it on each Out[] separately like so,               CForm[Out[135]]      I was trying to save time and create a for loop as follows:               For[i = 0, i = 34, i++, Out = Out[135 + i]; Print[CForm[Out]]]      But this didn't work! Any suggestions?


title: Solve telling me all my solutions are zero

text: I'm trying to use _Mathematica_ to solve a complicated system of equations. Here is a screenshot of the equations, and what _Mathematica_ outputs. ![](http://i.imgur.com/Dw9JdAv.jpg) The variables $v_i$ and $w_i$ act as constants in this equation. I do understand the solution _Mathematica_ gives is technically correct, however I do not want the trivial solution. How can I make _Mathematica_ ignore that particular solution? This is the code, as asked for.               ybe[a_, b_, c_, d_, e_, f_, R_, S_, T_] :=       Sum[Subscript[R, d, e, \[Alpha], \[Beta]] Subscript[S, \[Alpha], f, a, \[Gamma]] Subscript[T, \[Beta], \[Gamma], b, c] - Subscript[T, e, f, \[Beta], \[Gamma]] Subscript[S, d, \[Gamma], \[Alpha], c] Subscript[R, \[Alpha], \[Beta], a, b], {\[Alpha], 0, 1}, {\[Beta], 0,1}, {\[Gamma], 0, 1}]          Subscript[r[u_], k_, l_, i_, j_] :=        \[Delta][i+j, k+l] (\[Delta][i, j, k, l, 0] Subscript[u, 1] + \[Delta][i, j, k, l, 1] Subscript[u, 2] + \[Delta][i, k, 0] \[Delta][j, l, 1] Subscript[u, 3] + \[Delta][i, k, 1] \[Delta][j, l, 0] Subscript[u, 4] + \[Delta][i, l, 1] \[Delta][j, k, 0] Subscript[u, 5] + \[Delta][i, l ,0] \[Delta][j, k, 1] Subscript[u, 6])          eqns = DeleteCases[        Flatten[          Table[ybe[a, b, c, d, e, f, r[u], r[v], r[w]] == 0,             {a, 0, 1}, {b, 0, 1}, {c, 0, 1}, {d, 0, 1}, {e, 0, 1}, {f, 0, 1}]],        0 == 0]          Solve[eqns, Table[Subscript[u, i], {i, 6}]]


title: Quirk in VertexColors interpolation when displaying Polygon

text: When using `VertexColors` the docs state: > The interior of the polygon is colored by interpolating between the colors > specified by VertexColors. It however doesn't say how this interpolation is carried out. I've seen at times that small quirks show up that I wouldn't expect, and I'm wondering if someone else has a clearer perspective on exactly why and when these show up.                aim = {Cos[2 \[Pi] #], Sin[2 \[Pi] #]} &;      angles[n_] := Range[0, 0.5, 0.5/(n - 1)];      colors[n_] := Join[ConstantArray[Purple, n], ConstantArray[Orange, n]];           draw[n_, a_] :=         Graphics[{           Polygon[Join[aim /@ angles[n], a aim@# & /@ Reverse[angles[n]]],              VertexColors -> colors[n]         ]}]      Using this definition and `n->5`, I don't see anything wrong when `a->0.415` but when `a->0.414` it looks like it's interpolating incorrectly, and when n is set larger two such quirks appear which seem to always be present. This can be seen in the three calls:                GraphicsColumn[{draw[5, 0.415], draw[5, 0.414], draw[100, 0.415]}]      So the question is, why does this happen and is there a general way to avoid it, or test for when it's expected to happen? I know that for this particular example I can avoid it simply by splitting my single polygon into many smaller 4 point polygons, I'm not asking for code that just draws a shaded arc. I'm interested in the underlying problem. ![Graphics showing the appearance of the quirks](http://i.stack.imgur.com/dNwCF.png)


title: How to create a screen shot of a notebook

text: I would like to use Mathematica _programmatically_ to take snapshots or screenshots of any open notebook. For example, I would like to get from the notebook created with this command               CreateDocument[{TextCell["Need help", "Section"],        TextCell["Can you help?"]}, WindowTitle -> "MyNotebook"]      An image like this ![entire notebook screenshot](http://i.stack.imgur.com/oZayu.jpg) The output can be a file or an image. I use Windows.


title: How to highlight overlapping regions in RegionPlot according to the overlapping times?

text: I want to plot the overlapping regions of several inequalities. For example, `RegionPlot[{x + y > 0, x - y > 0, x^2 + y^2 < 1, x y < 1}, {x, -2, 2}, {y, -2, 2}]` The regions for the inequalities can overlap twice, three times, and so on. I want to make a plot in grayscale, such that the more times they overlap, the darker the region is. Is there a way to do that?


title: Creating a notebook that has cells of a certain style password protected

text: I am teaching students how to use Mathematica. I want to create a problem set that has cells with a certain style (probably Input or some new style that is a variant of Input) locked down so that the students can not see them at all or just see an unevaluatable placeholder instead. But I also want a cell within the notebook that permits someone with a password (like me) to make these hidden cells visible and evaluatable. Extra credit: it would be cool if I could relock these cells so that they reverted to their hidden form. Concession: Maybe the unlocking cell does not have to be in the notebook but could be a function in an external notebook that worked on the problem set notebook. Right now I accomplish the basic idea by having two notebooks, one with the answers and one without them. But this is ugly and leads to synchronization errors as I change my mind. Ideas welcome. Obviously, simpler is better.


title: Changing a wave simulation

text: I want to adjust some code that I found on this Wolfram Demonstration: http://demonstrations.wolfram.com/WaterRipplesPassingThroughASlit/ Basically it shows a wave passing through a single slit. I want to change the code so that there is no longer any slit, so the wave just bounces off the walls. It's that bit I'm having trouble with. I'll put the code I have now then explain what I think it's doing and what I've tried:               Manipulate[      With[{ripple = iter[tf]},            Show[ListPlot3D[ripple, Mesh -> False, PlotRange -> {-1, 1},          ImageSize -> 450, ColorFunction -> "PearlColors", Axes -> False]]],      {{tf, .45, Style["t", Italic]}, 0.05, 1., 0.001, ImageSize -> Tiny},      ControlPlacement -> Left,      SynchronousInitialization -> False,      SynchronousUpdating -> False,      Initialization :> (        n = 64; dx = 1.0/(n - 1.);        Courant = 1/Sqrt[2];        dt = (Courant dx)/c; c = 1.;         iter = Compile[{{tf, _Real}},           Module[{z1 = ConstantArray[0., {64, 64}],             z2 = ConstantArray[0., {64, 64}]},            Do[{z1, z2} = {z2, z1}; z1[[32, 16]] = Sin[16. \[Pi] t];             Do[If[0.45 < i/n < 0.55 || ! 0.48 < j/n < 0.52,               z2[[i, j]] =                1/(1. + 5. dt) (Courant^2 (z1[[i - 1, j]] + z1[[i + 1, j]] +                      z1[[i, j - 1]] + z1[[i, j + 1]])) - z2[[i, j]]], {i,               2, 63}, {j, 2, 63}], {t, 0., tf, dt}]; z1]];)]      I don't think anything before 'Initialization' needs to be changed. The second half sets up two 64X64 grids z1 and z2. They get updated by the Do command. The part that seems to be directly about the slit is                      Do[If[0.45 < i/n < 0.55 || ! 0.48 < j/n < 0.52,               z2[[i, j]] =                1/(1. + 5. dt) (Courant^2 (z1[[i - 1, j]] + z1[[i + 1, j]] +                      z1[[i, j - 1]] + z1[[i, j + 1]])) - z2[[i, j]]], {i,               2, 63}, {j, 2, 63}], {t, 0., tf, dt}]      Because it is telling the program to do something if the grid in question is where the slit should be. The issue is that I can't just delete that part, because then the wave doesn't evolve over time! It's like the instructions for how the other parts of the grid should act are also in that line, but I don't understand it. Any hints at all would be so useful, I've been stuck for a day!


title: Problem with InverseFunction of Sqrt

text: I want to build a table of `InverseFunction`s, f.e.:               Table[InverseFunction[Head[foo][#] &][x], {foo, {Sin[x], Log[x], Sqrt[x]}}]      > {ArcSin[x], E^x, Power(-1)[x]} I' m frustrated by the fact that `Sqrt[x]` evaluates to `Power ...` instead of `x^2`. As a temporary fix I have written:               Table[InverseFunction[(Head[foo] /. Power -> Sqrt)[#] &][x], {foo, {Sin[x], Log[x], Sqrt[x]}}]       which gives the desired result: > {ArcSin[x], E^x, x^2} I would like to find a more general and reliable way to prevent this kind of "Head-Substitution". I tried many things with `HoldForm` etc., but to no avail. Thanks for your ideas


title: Rendering percent symbol in the correct typeface

text: When I do               ListPlot[Table[RandomReal[NormalDistribution[], {20, 2}], {2}],       PlotStyle -> PointSize[0.02],       Epilog ->        Style[Text["b: 5%", Scaled[{0.05, 0.05}], {-1, -1}],         FontFamily -> "Helvetica"]]      ![enter image description here](http://i.stack.imgur.com/O8VLt.png) the percent symbol is shown in the wrong typeface, possibly Times. How can I make it display in the correct face?


title: Spreading colors in ListDensityPlot

text: I want to create a two-dimensional plot using data from an external file. This file contains several triplets of numbers. The first two columns indicate the x and y position, while the third one works as an indicator for every (x,y) point. The desired plot should depict each point as a colorful dot and the color of each dot should be assigned according to the value of the third column. I used `ListDensityPlot` to create my plot but for a strange reason it joins all the points together and of course spreads the colors. This is the code I used:               SetDirectory[" ... To be inserted ... "];     data = Import["Esc_data.out", "Table"];     S1 = ListDensityPlot[data, Mesh -> None, ColorFunction -> "Rainbow",      PlotLegends -> Placed[BarLegend[Automatic, LegendMargins ->      {{0, 0}, {10, 5}}, LegendLabel -> "\!\(\*SubscriptBox[\(log\), \(10\)]\)(Tesc)",     LabelStyle -> {FontSize -> 15, FontFamily -> "Helvetica"}],      Right], PerformanceGoal -> "Quality", FrameLabel -> {"x", "y"},      RotateLabel -> False,      LabelStyle -> Directive[FontSize -> 17, FontFamily -> "Helvetica"],      ImageSize -> 500]      The correct plot should be the following: ![correc plot](http://i.stack.imgur.com/BsorZ.png) It took me two minutes and four lines in `gnuplot` to create this plot! So, it must be achievable in _Mathematica_ too. However, I couldn't find out how to control the size of the dots and mainly how to "tell" to the program not to join the points between them. The data file can be obtained here or here. Many many thanks in advance! * * * I modified VLC's last version like this               Clear[colorbar]     colorbar[{min_, max_}, colorFunction_: Automatic, divs_: 150] :=      DensityPlot[y, {x, 0, 0.1}, {y, min, max}, AspectRatio -> 10,      PlotRangePadding -> 0, PlotPoints -> {2, divs}, MaxRecursion -> 0,      Frame -> True,      FrameLabel -> {{None,       "log10(\!\(\*SubscriptBox[\(T\), \(esc\)]\))"}, {None, None}},      LabelStyle -> Directive[FontFamily -> "Helvetica", 15],      FrameTicks -> {{None, All}, {None, None}},      FrameTicksStyle -> Directive[FontFamily -> "Helvetica", 15, Plain],      ColorFunction -> colorFunction]          With[{opts = {ImageSize -> {Automatic, 500}}, cf = "Rainbow"},      Row[{ListPlot[List /@ data[[All, {1, 2}]],      PlotStyle -> ({PointSize[0.0045], ColorData[cf][#1]} & /@         Rescale[data[[All, 2]], {1.5, 5}]),      PlotRange -> {{-1, 1}, {-1, 1}}, AspectRatio -> 1, Frame -> True,      AspectRatio -> 1, RotateLabel -> False, Axes -> None,      FrameTicks -> True, FrameLabel -> {"x", "y"},      LabelStyle -> Directive[FontFamily -> "Helvetica", 17],      ImagePadding -> {{60, 10}, {60, 20}}, opts],      Show[colorbar[{1.5, 5}, cf], ImagePadding -> {{10, 60}, {20, 10}},      opts]}]]      Now the frame labels of the main plot are shown. However, the colorbar is larger than the square. I want the height of the colorbar to be the same as the height of the square. Finally, how could I merge in a `Show` this plot with the following contour               V = 1/2*(ω1^2*x^2 + ω2^2*y^2) - ϵ*x^2*y^2;     ω1 = 0.4; ω2 = 0.4;     ϵ = 1;     xmin = 1;     hesc = 0.0064;     C0 = ContourPlot[V, {x, -xmin, xmin}, {y, -xmin, xmin},      Contours -> {hesc}, ContourStyle -> {Gray, Thickness[0.003]},      AspectRatio -> 1, ContourShading -> False, PlotRange -> All,      PlotPoints -> 200, ImageSize -> 500];      ![new plot](http://i.stack.imgur.com/BukCx.png)


title: Volume of a graph

text: I have the following list:               AA={         {0.,0.,0.,0.,0.,0.,0.,0.},         {0.,-10.9421,-17.3061,-19.0045,-19.0045,-17.3061,-10.9421,0.},         {0.,-16.8109,-27.6012,-24.8577,-24.8577,-27.6012,-16.8109,0.},         {0.,-19.9862,-34.0245,-28.3369,-28.3369,-34.0245,-19.9862,0.},         {0.,-19.9862,-34.0245,-28.3369,-28.3369,-34.0245,-19.9862,0.},         {0.,-16.8109,-27.6012,-24.8577,-24.8577,-27.6012,-16.8109,0.},         {0.,-10.9421,-17.3061,-19.0045,-19.0045,-17.3061,-10.9421,0.},         {0.,0.,0.,0.,0.,0.,0.,0.}     };      This list is the input for a 3D Plot:               ListPlot3D[AA, DataRange -> {{0, 4000}, {0, 4000}},       InterpolationOrder -> 1, Filling -> Axis, PlotRange -> All]      ![enter image description here](http://i.stack.imgur.com/UGrRT.png) How can I calculate the volume of this graph? I've tried `NIntegrate` but it didn't work out for me.


title: Why can't NumberQ be used as the head of a pattern?

text: Consider the following:               list={1/First[{}], 1, 2, 1/First[{}], 3};     DeleteCases[list,_NumberQ]      I wanted to remove all cases, which did not match `_!NumberQ` (e.g. `1/First[{}]`), in the first place. But after `DeleteCases[list,_!NumberQ]` did not work, I tried it with `DeleteCases[list,_NumberQ]`, just to see whether that would work...didn't. What I am doing wrong?


title: Randomizing a lab

text: I teach a class where students do a weekly lab in Mathematica. They do it in a computer lab, and because there are many of them, and only one of me, I encourage them to help one another. Unfortunately, that means I get a lot of labs with the exact same `Plot` commands, or the exact same "make up your own example" solutions, etc. What I would like to do is, in some sense, "randomize" the lab when each student opens it. To keep things simple, Let us consider a question that looks like > Find the square root of the following number: # Here, # would ideally be replaced by a random number _as soon as_ the student opens the lab. That is, I am looking for a way to do the following:   * run a command as soon as the lab is opened   * the only remnant of this command, after it is run, is its output I know that second one is probably difficult, but I would even be satisfied with a way to have # reference the output of a hidden command, for example. Thanks! PS: I have no idea what the tags should be for this question, so I chose by best guesses; please feel free to improve them.


title: Trouble using FindInstance with MatrixRank

text: I'm really confused about what's going wrong with my call to FindInstance:               In[47]:= FindInstance[                MatrixRank[{{0, 1, 1}, {1, 0, 1}, {(-1)^i1, 1, 0}}] == 3,                 {i1}, Integers]          Out[47]:={{i1 -> 33}}      The matrix `{{0,1,1},{1,0,1},{-1,1,0}}` has rank 2. Also when I repeat the above call with the `MatrixRank` function set equal to 2, `FindInstance` returns `{}`. What am I missing??


title: Insert EndNote citation in Mac OS

text: I'm trying to insert citations in a notebook. I found a thread that goes back to 2010 saying that the Endnote plugin for Mathematica is not supported on Mac OS. Does anyone know whether this is still the case?


title: What is the relationship between Mathematica and Wolfram Desktop?

text: I'm confused about the differences among various Wolfram products. In particular what is the relationship among Mathematica, Mathematica Online, Wolfram Programming Cloud, and Wolfram Desktop? Are the latter things I get access to through Mathematica (as I do with Alpha)?


title: How to plot a barycentric line

text: I want to plot a barycentric function on an equilateral triangle (ternary plot). For example               f1 = {Abs[Sin[x]], Mod[x, 2], Abs[Cos[x]]};      At the moment I evaluate a list of data points and join them with a line               Show[{b3["PlotAxis"],ListPlot[b3["Data"][Range[0,100,1/#],f1],Joined->True]}]&/@{1,10,100}      ![enter image description here](http://i.stack.imgur.com/lhIQ8.png) Where b3 is:               b3 = GetBarycentric[3];     b3["Axis"] = {{1/2, Sqrt[3]/2}, {1, 0}, {0, 0}};     b3["Convert"][{a_, b_, c_}, axis_: b3["Axis"]] := Module[{         abc = {a, b, c}, sum = Total[{a, b, c}]},        Piecewise[{{ (axis[[1]] a + axis[[2]] b)/sum, sum > 0}, {axis[[2]], sum <= 0}}]];     b3["Data"][values_, rlines_] := b3["Convert"][#] & /@ Transpose[rlines /. x -> values]     b3["PlotAxis"] := Graphics[{Thin, Line[{#1, #2, #3, #1}]}] & @@ b3["Axis"];      I can not use listplots 'Joined->True', because lines are intermittent. ![enter image description here](http://i.stack.imgur.com/wxg9B.gif) How can I transform the function and plot it?


title: How can I use Max[] in a function that is passed a list not find the max of the list

text: For most functions in `Mathematica`, passing them a list will call the function on each element of the list. For example:               ExampleFunction1[x_] := x + 1     ExampleFunction1[{1, 2, 3}]      (* {2, 3, 4} *)      But things change when you use `Max[]`. For example if I have this function:               ExampleFunction2[x_] := Max[x, 4]       If I pass this a single number `x`, it will return either `x` or `4`, whichever is larger, but, as documented, if i pass it a list like this:               ExampleFunction2[{1, 3, 7}]       It will return 7. Instead I'd like it to return `{ 4, 4, 7}`. How can I make my function so that `Max` uses an element of a list as its argument instead of the entire list?


title: How to scrape the headlines from New York Times and Wall Street Journal?

text: How to scrape headlines from New York Times, Wall Street Journal main pages to create datasets similar to this service? Importing HTML from nyt.com (HTML4) results in a `String` and the markup is not preserved. Is there a workaround? For wsj.com (XHTML) is either not valid (is there a W3C XHTML validator?) or a problem for XML`Parser. Any clues?               In[362]:= StringQ@Import["http://nyt.com","HTML"]     Out[362]= True          Import["http://wsj.com","XML"]     During evaluation of In[361]:= XML`Parser`XMLGet::nfprserr: Attribute 'property' is not declared for element 'meta' at Line: 11 Character: 71 in /tmp/m00009067531/wsj.     During evaluation of In[361]:= XML`Parser`XMLGet::prserr: Expected an attribute name at Line: 50 Character: 45 in /tmp/m00009067531/wsj.     During evaluation of In[361]:= Import::fmterr: Cannot import data as XML format. >>     Out[361]= $Failed


title: How to solve an eigensystem faster?

text: I have a module that I need to call 1-10 million times in my program. Currently, it is taking several hours to run so I am hoping that I can cut down some runtime with your help.               r = RandomReal[NormalDistribution[0., 1./2.], 6];          es = Eigensystem[H0[\[Omega]0, r[[1]], r[[2]], r[[3]], r[[4]], r[[5]], r[[6]] ];          \[Epsilon] = es[[1]];     v = es[[2]];     vS = Conjugate[v];          (*elements of v and vS are called later; v[[1]], vS[[1]] etc...*)      H0 is a compiled function which sped things up a little. It looks like this: ![enter image description here](http://i.stack.imgur.com/9UA7T.png). In copy-paste form, H0[] is                {{0, (ωz1 - ωz2)/      2, (-ωx1 + ωx2)/(2 Sqrt[2]) - (I ωy1)/(      2 Sqrt[2]) + (I ωy2)/(      2 Sqrt[2]), (ωx1 - ωx2)/(2 Sqrt[2]) - (      I ωy1)/(2 Sqrt[2]) + (I ωy2)/(      2 Sqrt[2])}, {(ωz1 - ωz2)/2,       0, (ωx1 + ωx2)/(2 Sqrt[2]) + (I ωy1)/(      2 Sqrt[2]) + (I ωy2)/(      2 Sqrt[2]), (ωx1 + ωx2)/(2 Sqrt[2]) - (      I ωy1)/(2 Sqrt[2]) - (I ωy2)/(      2 Sqrt[2])}, {(-ωx1 + ωx2)/(2 Sqrt[2]) + (      I ωy1)/(2 Sqrt[2]) - (I ωy2)/(      2 Sqrt[2]), (ωx1 + ωx2)/(2 Sqrt[2]) - (      I ωy1)/(2 Sqrt[2]) - (I ωy2)/(      2 Sqrt[2]), ω0 + (ωz1 + ωz2)/2,      0}, {(ωx1 - ωx2)/(2 Sqrt[2]) + (I ωy1)/(      2 Sqrt[2]) - (I ωy2)/(      2 Sqrt[2]), (ωx1 + ωx2)/(2 Sqrt[2]) + (      I ωy1)/(2 Sqrt[2]) + (I ωy2)/(2 Sqrt[2]),      0, -ω0 + 1/2 (-ωz1 - ωz2)}}      Is there anything else that can be optimized here?


title: NIntegrate fails while Integrate works

text: I have a function $f(t)$ defined as $f(t)=\int\limits_0^t(t-\xi)^{\alpha-1}\ \cos(\xi)\ d\xi$ where $0<\alpha<1$. I now want to evaluate this integral at various values of time. Therefore, my code for the function definition reads:               f[t_] := NIntegrate[(t-x)^(a-1) Cos[x], {x, 0, t}]      For the sake of this example, let us choose $\alpha=.3$, and let us attempt to evaluate $f(t)$ at $t=0.2$. Calling `f[.2]` returns the following error: > NIntegrate::zeroregion: Integration region > {{0.2,0.200000000000000011102230246246115891736237825076626353161415959706}} > cannot be further subdivided at the specified working precision. NIntegrate > assumes zero integral there and on any further indivisible regions. > > NIntegrate::inumri: The integrand Cos[x]/(0.2 -x)^0.7 has evaluated to > Overflow, Indeterminate, or Infinity for all sampling points in the region > with boundaries > {{0.200000000000000011102230246246115891736237825076626353161415959706,0.200000000000000011092200115363618871738896620143270802392916628941}}. What is most puzzling is that there exists an analytical solution this integral in terms of the hyper-geometric function. Defining $f(t)$ as               f[t_] := Integrate[(t-x)^(a-1) cos[x], {x, 0, t}]      and then calling `f[.2]` returns the correct value of the integral with no errors: $f(.2)=2.02934$. In fact, the analytical solution is               f[t] = ConditionalExpression[3.33333 t^0.3 HypergeometricPFQ[{1}, {1.15, 0.65}, -(t^2/4)],          Re[t] > 0 && Im[t] == 0]      Does this error has something to do with `WorkingPrecision`? I am relatively new to _Mathematica_ , so forgive me if this is trivial. ### UPDATE My ultimate goal is to make this function Listable so that I can pass a list of times as the function argument. Consider again the function defined in terms of `Integrate` (and not `NIntegrate`). Here $\alpha-0.1$. I now define an array to form my list of times.               time = Array[#/5 - .2 &, 11];      Passing this to $f(t)$ as `f[time]` gives me the error > Power::infy: "Infinite expression 1/0^1.9 encountered." > > Infinity::indet: Indeterminate expression 0. ComplexInfinity encountered. I note that it does give me the output, despite the error. However, if I pass the list of times manually I get the desired output:               f[{0, 0.2, 0.4, 0.6, 0.8, 1, 1.2, 1.4, 1.6, 1.8, 2}]      > {0, 8.36644, 8.50035, 8.06263, 7.20356, 6.00083, 4.52232, 2.83781, 1.02105, > -0.851216, -2.70136} Is this also related to `WorkingPrecision` and how `Array` defines its entries?


title: Launching remote kernels - will it help RAM needs?

text: Given the exasperating RAM needs of my Mathematica program, I contemplated launching remote kernels to run my Mathematica script. This is a two part question: ## Part 1 If I launch a remote kernel(s), is the need for RAM also distributed amongst all the remote computers? ## Part 2 I keep getting an error message when I try to launch a remote kernel from the Mathematica GUI. > The kernel c20-0707-23 failed to connect to the front end. (Error = > MLECONNECT). You should try running the kernel connection outside the front > end. I have located the Kernel Program correctly on the remote computer. When I try starting a kernel over ssh in a terminal window with:               ssh username@remote.computer /path/to/math      Or               ssh username@remote.computer /path/to/MathKernel      After I enter the password to log in to the remote computer, I see that a kernel has been launched. However, the same doesn't occur with the front end. Are there any easy to understand **tutorials/examples** on launching remote kernels, without needing the GUI as I'd like to run scripts? I tried reading, this, for instance and the only thing that it did was make me panic as it was greek. I also read this but it's not an entirely similar problem Here's a sample script that I used to launch local kernels and execute a simple `NDSolve` command:               #!/usr/local/bin/MathematicaScript -script          CloseKernels[]     LaunchKernels[3]     Print["AbsoluteTiming reveals:" NDSolve[{y'[x] == y[x] Cos[x + y[x]],          y[0] == 1}, y, {x, 0, 30}]; // AbsoluteTiming ]     CloseKernels[]      This question may help answer the other question I linked in the first line.


title: Manual maximum likelihood estimation of a mixture with no closed form

text: Let $X$ be a random variable that is from a mixture of two Lognormals (Lognormals(mu1,sigma) and Lognormals(mu2,sigma)) and set $Y=X_1+X_2+...+X_{10}$ a sum of 10 random variables from this mixture. There is no closed form for $Y$, but according to the Fenton approximation, the sum of Lognormals is approximately Lognormal distributed. I cannot use `FindDistributionParameters` in this case and have to use `NMaximize` instead. First let me show you how I did this in an easy case, a simple Mixture of two Lognormals (no sums here): Generate 100 data points with arbitrary mu and sigma:               dat2 = RandomVariate[     MixtureDistribution[{0.2,      1 - 0.2}, {LogNormalDistribution[-2, 0.3],      LogNormalDistribution[1.1, 0.3]}], 100]       define the function to be maximized:               loglikeli2[x_, p_, μ1_, μ2_, σ_] :=      Total[Log[      PDF[MixtureDistribution[{p,        1 - p}, {LogNormalDistribution[μ1, σ],        LogNormalDistribution[μ2, σ]}], x]]]      this function will be maximized:               toMaximize2[p_, μ1_, μ2_, σ_] :=      loglikeli2[dat2, p, μ1, μ2, σ]      NMaximize works like a charm:               NMaximize[{toMaximize2[     p, μ1, μ2, σ], μ1 ∈ Reals, σ >      0, μ2 ∈ Reals, p >= 0,      1 - p >= 0}, {p, μ1, μ2, σ}]      However in the case of the sum of Lognormals this is getting a bit more difficult. this is the function that has to be maximized: $f(y|p,\mu_1,\mu_2,\sigma) = \sum_{j=0}^{10} \binom{10}{j} p^j (1-p)^{10-j} g_{(j,10-j)}(y) $ where $g(y)$ is the density sum of a random variable from the mixture of two lognormals. First, generate the data:               mix[p_, m1_, m2_, s_] :=      MixtureDistribution[{p, 1 - p}, {NormalDistribution[m1, s],       LogNormalDistribution[m2, s]}];          dat3 =       Plus @@ RandomVariate[mix[0.75, 0.5, -1.5, 0.2], {2, 100}];      This function approximates the density of a sum of lognormally distributed paramters (Fenton approximation). These are the formulas you can find on the wiipedia page of the Lognormal distribution.               dSumOfLogN[y_, μ_, σ_] :=      Module[{ExpV, V, s2, mu}, ExpV = Total[Exp[μ + 0.5*σ^2]];      (* Expectation *)     V = Total[Exp[μ + 0.5*σ^2]^2*(Exp[σ^2] - 1)];      (*Varinace *)     s2 = Log[1 + V/(ExpV^2)];     (* the new sigma^2 *)     mu = Log[ExpV] - 0.5*s2;     (* the new mu *)     PDF[LogNormalDistribution[mu, Sqrt[s2]], y]]     (* returns the pdf with the new mu and sigma *)      this function builds 2 vectors of length 10. jvector is a vector of two variables that sum to 10. For example with `jvector = {3, 7}`, `mu = {1.2, 4.5}` and `sigma = {2, 2}`, you get a `fullmuvector` of 3x 1.2 and 7x 4.5 = {1.2,1.2,1.2,4.5,...,4.5} same for `fullsigmavector`.               dSumOfTypes[y_, jvector_, μ_, σ_] :=      Module[{fullMuVector, fullSigmaVector},     fullMuVector =       Join @@ (ConstantArray @@@ Transpose[{#2, #1}]) &[jvector, μ];     fullSigmaVector =       Join @@ (ConstantArray @@@ Transpose[{#2, #1}]) &[jvector, σ];     dSumOfLogN[y, fullMuVector, fullSigmaVector]]      this is the sum of mixtures $f(x)$:               dSumOfMixtures[y_, pvector_, μ_, σ_] :=       Module[{mysum, jCombis},     jCombis =        Join @@ (Permutations /@         IntegerPartitions[10, {2}, Range[0, 10]]);     (* jCombis generates a vector {{0,10},{1,9},..,{10,0}} *)     mysum =      Sum[PDF[MultinomialDistribution[10, pvector], jCombis[[i]]]*      dSumOfTypes[y, jCombis[[i]], μ, σ], {i, 1,       Length[jCombis]}]; mysum]      this is the loglikelihood function               loglikeli3[y_, p_, μ_, σ_] := Total[Log[dSumOfMixtures[y, p, μ, σ]]]      and this has to be maximized:               toMaximize3[p_?NumericQ, μ_?NumericQ, σ_?NumericQ] := loglikeli3[dat3, p, μ, σ]      but `NMaximize` fails due to numerical problems and I have no clue how to interpret them               NMaximize[{toMaximize3[{p, 1 - p}, {m1, m2}, {s, s}],        m1 ∈ Reals, s > 0, m2 ∈ Reals, p >= 0, 1 - p >= 0}, {p, m1, m2, s}]      I'm also looking for advice to improve the code, make it shorter, faster etc. Also, can I somehow make my own distribution out of this with `ProbabilityDistribution` ? this is the error I get:               NMaximize::nnum: "The function value -Hold[toMaximize3[{0.731302,1-        0.731302},{0.676536,0.189867},{1.96476,1.96476}]] is not a number at {p,\      [Mu]1,\   [Mu]2,     \[Sigma]} = {0.7313017730309139`,0.6765358037113711`,0.18986655930905658`,1.9647629127390598`}


title: ShowSelection color

text: The color of a selection is controlled by the operating system. E.g., enter the following code in separate cells.               nb=EvaluationNotebook[]          SelectionMove[nb, Next, CellContents]            2+2      and the 2+2 will be selected and highlighted. One gets the same color highlighting text or input using the Mouse. Is there a way to over-rule the OS and change the selection color using the **Option Inspector...**? I've searched for likely terms in the **Option Inspector...** , such as "Selection" and "Highlight", without success.


title: How to get a list of 3-connected graphs?

text: I'd like to use `GraphData` to get a list of graphs with vertex connectivity at least 3. I know `GraphData["Nonplanar", 6]` gives all the nonplanar graphs on 6 vertices, but I can't figure out how to get `GraphData` to do a selection based on the `"VertexConnectivity"` property.


title: Where can I find a dark stylesheet for mathematica?

text: The default white is very tiring for the eye after some hours.


title: distance between two curves

text: I try to compute the distance between two curves. I use the `EuclideanDistance` to do that. Here my code:               j = -1;     a32 = 3.9683436;     a43 = 4.2925064;     alfaF32 = 1.54553;     alfaF43 = 2.34472;     mu = 10^-3;     tot4 = alfaF32*mu;     tot5 = alfaF43*mu;          S = ((EuclideanDistance[{a43 (-Sqrt[(16 tot5*i)/                   3 (1 + tot5/(27 i^3))] - (2 tot5)/(9 j*i)) +               a43}, {a32 (Sqrt[(16 tot4*i)/3 (1 + tot4/(27 i^3))] - (                 2 tot4)/(9 j*i)) + a32}])/(3/2 - 4/3))^2;     n = ListPlot[Table[S, {i, 0.0001, .3, 0.0001}]]      But the x-axis is wrong, i try to explan. The x-axis must go from 0.0001 to 0.3 as in the S function. But the x-axis is completly wrong (the dimension is from 0.3/0.0001). Someone could help me?


title: Solving for a charge distribution from a dipole moment

text: I've been looking around but I haven't been able to find any way of solving this conceptually simple problem.   In short I am trying to find the charge density in a dielectric in an external electric field given, \begin{equation} \overline{p}(\overline{r})= \int \rho(\overline{r}_{0},\overline{r}) \ \overline{r}_{0} \ dV_{0} \end{equation} In my case $\overline{p} = \alpha \overline{E}$ where $\alpha$ is the polarizability and $\overline{E}$ is the applied electric field. I'm not sure really how to approach this. I've looked into solving integral equations using _Mathematica_ but nothing I've seen seems quite like the problem I have.


title: How to sort the adjecency matrix of bipartite graph so to have two off-diagonal blocks

text: In a bipartite graphs there are two class of nodes, say A and B. Each node of class A may interact only with nodes of the class B, and viceversa. The corresponding adjecency matrix is thus composed by two off-diagonal blocks (if you sort the vertices in an appropriate way). I realize that when working with adjecency matrix for a given bipartite graphs, sometimes I get the desired order in the adjecency matrix, and thus if I plot it, it is formed by two off-diagonal blocks:               g1=CompleteGraph[{5,3}]     m1=AdjacencyMatrix[g1] // MatrixPlot      ![matrix plot of the bipartite graph](http://i.stack.imgur.com/2RcHT.png) However, sometimes if I plot the adjecency matrix directly from the bipartite graphs, now it is not in the desired order:               l2 = CompleteGraph[{5, 3}] // EdgeList;     weights = RandomReal[{0.5, 2}, Length[l2]];     g2 = Graph[l2, EdgeWeight -> weights, GraphLayout -> "BipartiteEmbedding"]     m2=AdjacencyMatrix[g2] // MatrixPlot      ![matrix plot of the bipartite graph](http://i.stack.imgur.com/PQebb.png) I'm trying to find a way to automatically sort m2 so to tranform it in a two off-diagonal blocks matrix.


title: Generating EventHandler using Table

text: I would like to change the edge color of a graph when double clicking on it, the following code works:               DynamicModule[{col = Green, col2 = Blue, col3 = Green},         Dynamic@Graph[{1, 2, 3} , {             EventHandler[1 \[UndirectedEdge] 2,             {"MouseDown" :> If[CurrentValue[                 "MouseClickCount"] == 2, (col = col /. {Red -> Green, Green -> Red})]}      ],          EventHandler[3 \[UndirectedEdge] 2,         {"MouseDown" :> If[CurrentValue[             "MouseClickCount"] == 2, (col2 = col2 /. {Red -> Blue, Blue -> Red})]}      ],          EventHandler[1 \[UndirectedEdge] 3,         {"MouseDown" :> If[CurrentValue[             "MouseClickCount"] == 2, (col3 = col3 /. {Red -> Green, Green -> Red})]}      ] },      EdgeStyle -> {1 \[UndirectedEdge] 2 -> col,                    3 \[UndirectedEdge] 2 -> col2,                   1 \[UndirectedEdge] 3 -> col3}             ](* Graph *)     ]      But when I changed it like this, it doesn't work at all. Would somebody please help and point out what is wrong?               DynamicModule[{kk = {3 \[UndirectedEdge] 2, 1 \[UndirectedEdge] 2,                           3 \[UndirectedEdge] 1 },                    col = Green, col2 = Blue, col3 = Green},                     Dynamic@Graph[{1, 2, 3},                     Table[EventHandler[i, {"MouseDown" :>                         If[CurrentValue["MouseClickCount"] == 2,                                (col = col /. {Red -> Green, Green -> Red})]}        ], {i, kk}] ]     ]      @Pickett Thanks so much for your detail instructions, I learned a lot from you. And I followed your method, and take a step further, intending to write some codes to delete the unwanted edges from a RandomGraph by double clicking on them. By inspecting the FullForm[dynGraph], the EventHandlers seems attached to each edge correctly, but again it doesn't work. How can I get around not setting the value of edglst in the first place?               DynamicModule[{rg, edglst, eventhlers },       rg = RandomGraph[{6, 12}];      vlst = VertexList[rg];      edglst = EdgeList[rg];      vcood = VertexCoordinates /. AbsoluteOptions[rg, VertexCoordinates];      eventhlers =        MapThread[        EventHandler[#, {"MouseDown" :>             If[CurrentValue["MouseClickCount"] == 2, (              pos = First@First@Position[edglst, #];              edglst = Drop[edglst, {pos}];              eventhlers = Drop[eventhlers, {pos}])]}] & , {  edglst } ];      dynGraph =        Dynamic@Evaluate@         Graph[vlst, eventhlers, VertexCoordinates -> vcood,           EdgeStyle -> {Thick}];      Evaluate@eventhlers;      dynGraph       ]


title: How to speed up text recognition

text: I have a large corpus of text to analyse. I've managed to automate splitting it into individual lines because I've found that each line in this relatively old scanned document needs to be dealt with subtly differently because of the difference in clarity of the lines. I've found that a good way to alter the lines to get the best character recognition is to use `Binarize` with different thresholds for the binarization. For example, here is a line of text: ![line to analyse](http://i.stack.imgur.com/2p0XX.jpg) I import this:               Import["image.jpg"]      and then create a table of different binarizations (I tried with a similar method with `ImageAdjust` but this involved looping over three variables with multiple values: `{c,b,\[Gamma]}` in the `ImageAdjust` options):               binarized=Binarize[image,#]&/@Range[0.45,0.95,0.025]      I've found that this is the range and fineness of the thresholds needed to get a good fidelity from the readings of different lines.               textrec=TextRecognize[#]&/@binarized      This in itself takes rather a long time and outputs everything from:               (*      Output==>{"~'»ur1f'lf+ lilfv :\\ '¢f\\1f'~u\\r1 \\-f-'._\\_' _-\\11~<r.r"}     *)      to               (*      Output==>{"All this sounds like a. solemn vow! Anyone hear-"}     *)      I then take this and split it into individual words, removing punctuation and a few other strings:               ssplit=StringSplit[#,("\""|"?"|"["|"\[OpenCurlyDoubleQuote]"|","|       "."|"\[CloseCurlyDoubleQuote]"|"'s"|"\[CloseCurlyQuote]s"|"'"|"]"|"'"|"!"|" ")]&/@textrec      I then take this and check each binarization of the line in the dictionary, asking how many total words are in the dictionary (The `DictionaryLookup` also takes a long time):               With[{x=DeleteCases[(DictionaryLookup[#,IgnoreCase->True]&/@#),{}]},{Length[x],x}]&/@ssplit      This gives an output like the following (first element is the number of words found in the dictionary, second element is the list of words found in the dictionary:               {{1, {{"I"}}},       {1, {{"I"}}},       {0, {}},       {0, {}},       {0, {}},       {1, {{"huh"}}},       {4, {{"all"}, {"this"}, {"sounds"}, {"like"}}},       {5, {{"all"}, {"this"}, {"sounds"}, {"like"}, {"anyone"}}},       {4, {{"all"}, {"this"}, {"sounds"}, {"like"}}},       {4, {{"all"}, {"this"}, {"like"}, {"a"}}},        {6, {{"all"}, {"this"}, {"like"}, {"a"}, {"vow"}, {"anyone"}}},       {5, {{"all"}, {"this"}, {"like"}, {"a"}, {"anyone"}}},        {5, {{"all"}, {"this"}, {"like"}, {"a"}, {"anyone"}}},       {5, {{"all"}, {"this"}, {"like"}, {"a"}, {"anyone"}}},       {6, {{"all"}, {"this"}, {"sounds"}, {"like"}, {"a"}, {"anyone"}}},       {8, {{"all"}, {"this"}, {"sounds"}, {"like"}, {"a"}, {"solemn"}, {"vow"},{"anyone"}}},       {6, {{"all"}, {"this"}, {"sounds"}, {"like"}, {"a"}, {"anyone"}}},       {8, {{"all"}, {"this"}, {"sounds"}, {"like"}, {"a"}, {"solemn"}, {"vow"},{"anyone"}}},       {6, {{"all"}, {"this"}, {"like"}, {"a"}, {"solemn"}, {"anyone"}}},       {0, {}},       {0, {}}}      So you can see that there is a value for the binarization threshold which gives all of the words as words in the dictionary. The last word is a half word and this is solved in another way. The question (and my apologies for the length if this question) is whether anyone can find a way to speed up this process. Each document has a hundred or so lines and I will have a lot of documents to go through. Any advice would be gratefully received. I have found a way to fix words which are not found in the dictionary (ie. not correctly recognized by `TextRecognize` using some contextual analysis, but that may warrant another question another time) Belisarius has asked me to add a few more lines of text, so here they are. They are direct from the document, so you can see the variance in line contrast and darkness: ![enter image description here](http://i.stack.imgur.com/KEcov.jpg) ![enter image description here](http://i.stack.imgur.com/tzUK5.jpg) ![enter image description here](http://i.stack.imgur.com/cKeca.jpg) ![enter image description here](http://i.stack.imgur.com/UhiFD.jpg) ![enter image description here](http://i.stack.imgur.com/EJTWL.jpg) Nothing political should be read into this :-) **Edit:** I was also asked to explain how I split the text up into lines. It is not elegant by any means and if someone else has a nicer way to code this, I would love to see it. The particular image that I'm using for this example can be found here. Import the image and take its dimensions:               img=Import["image1.jpg"]     dims=ImageDimensions[img]      In this example the format is two column, so I pull out the left and right. I'll focus entirely here on the left:               imgl=ImageTake[img,{1,dims[[2]]},{1,Round[dims[[1]]/2]}];      This will take the n^th line from the image:               itl[n_]:=ImageTake[imgl,{n,n}]      Now we go through all the lines and find those which have less than ten pixels with brightness less than 200. This will give a list of all the lines which are not blank.               rowsl=Position[If[Length[Select[ImageData[itl[#],"Byte"][[1,;;,1]],#<200 &]]<10,      blank,itl[#]]&/@Range[dims[[2]]],Except[blank]]//Flatten      Now we go through the list of all the non-white lines and find the differences between these line numbers. If the difference is more than 3 pixels we treat it as part of a white space between text lines:               valsl=Position[Differences[rowsl],Except[1|2|3]][[2;;]]//Flatten      This will take the information from the white space regions and find the regions which are not white, ie. lines of text               trythesel=Partition[Riffle[valsl,valsl+Table[1,{n,Length[valsl]}]][[2;;]],2];      Take 3 pixels above and 3 pixels below the lines of non-blank that have been found:               linesl={rowsl[[#[[1]]]]-3,rowsl[[#[[2]]]]+3}&/@trythesel;      We can then pull out the n^th line of text by using:               nthline=ImageCrop[ImageTake[imgl,linesl[[n]]]]


title: How do I plot many arrows in a sphere?

text: I want to plot a lot of arrows in a sphere (3D-Plot). That is not a problem with a small number of `Arrows`; for a few I can do than something like this:               Show[       Graphics3D[{Thickness[Large], Arrowheads[Large],         Arrow[{{0, 0, 0}, {1, 0, 0}}], Arrow[{{0, 0, 0}, {0, 1, 0}}]},          Axes -> True],        SphericalPlot3D[1, {θ, 0, Pi}, {φ, 0, 2*Pi},          PlotStyle -> Opacity[0.2]]]      However, I want do something like a for-loop to plot many `Arrows`               For[i = 1, i < 11, i++, Arrow[{{0, 0, 0}, {1/i, (1-i)/5, (1-i)/5}}]      I have tried to paste for loop in many places of my graphics code, but without success. How should I build that code?


title: Next highly composite number?

text: R language has this function 'nextn' (link) which computes the next highly composite number greater than a given one, which is used to find the optimal padding size for the subsequent FFT operation. So I am looking for similar _Mathematica_ function               NextHighlyCompositeNumber[ n_Integer?Positive, primes:{__Integer?PrimeQ} ]      which will output the smallest number $m \geqslant n$ such that $m = p_1^{e_1} \cdots p_k^{e_k}$ for some non-negative exponents $e_k$. This seems to be a combinatorial search kind of problem, which could be solved using integer linear programming (if available).


title: Solving for vector elements in a function to which the vectors are not passed explicitly

text: I want to define a function which takes in two integers (indicating the lengths of 2 vectors), and solves a simple set of expressions at a set of points to find all the values in both the vectors. so far I have managed to successfully create a function which does exactly what I say above, except that rather than taking two integers as arguments, it takes the two vectors itself. Forgive me for the length of this next code fragment:               solution[svec_, nvec_] :=        NSolve[        Table[          approx[svec, nvec, -Cos[n*Pi/(Length[nvec] + Length[svec])]] ==             exact[-Cos[n*Pi/(Length[nvec] + Length[svec])]],          {n, 1, Length[nvec] + Length[svec]}],        Join[svec, nvec]];      The               -Cos[n*Pi/(Length[nvec] + Length[svec])      part is just a set of points. All of the above works fine. My attempt to change it so that it takes in just integers was to do the following: STEP ONE: create a function which takes an integer, gives a vector of length integer:               nvec[Q_] := Table[Unique["n"], {Q}];     svec[M_] := Table[Unique["s"], {M}];      STEP TWO: replace all of the `svec`s and `nvec`s in the previous code fragment with `nvec[Q]` and `svec[M]`. (could also get rid of Lengths obviously):               solution[Q_, M_] :=        NSolve[         Table[           approx[svec[M], nvec[Q], -Cos[n*Pi/(Q + M)]] == exact[-Cos[n*Pi/(Q + M)]],           {n, 1, M + Q}],         Join[svec[M], nvec[Q]]];      STEP THREE: Call the function               sol = solution[10, 20]      For some reason, this doesn't work. I never get an error; it just never finishes evaluating. Any help would be very much appreciated


title: High-quality RegionPlot3D for logical combinations of predicates

text: Unlike `RegionPlot`, `RegionPlot3D` copes poorly with logical combinations of predicates (`&&`, `||`), which should result in sharp edges in the region to be plotted. Instead, these edges are usually drawn rounded and sometimes with severe aliasing artifacts. This has been observed in many posts on this site:   * Problem in RegionPlot3D   * on RegionPlot3D and ContourPlot3D   * Tailoring RegionPlot3D with PlotPoints?   * "`RegionPlot3D` plots always seem to have that 'home-made' look about them..."   * "...the limitations of `RegionPlot3D` make the edges appear jagged." One solution, as noted by Silvia, by halirutan, and most recently by Jens, is to use a `ContourPlot3D` instead with an appropriate `RegionFunction`, as this produces much higher-quality results. I think it would be useful to have a general-purpose solution along these lines. That is, we want a single function that can be used as a drop-in replacement for `RegionPlot3D` and will automatically produce high-quality results by setting up the appropriate instances of `ContourPlot3D`. Here is a test example, inspired by this post:               RegionPlot3D[1/4 <= x^2 + y^2 + z^2 <= 1 && (x <= 0 || y >= 0),      {x, -1, 1}, {y, -1, 1}, {z, -1, 1}]      ![enter image description here](http://i.stack.imgur.com/OeHtI.png) It should look more like this (created by increasing `PlotPoints`, and even then the edges are not perfectly sharp): ![enter image description here](http://i.stack.imgur.com/R4QIM.png)


title: How to find the name of the current function

text: I would like to know the name of the current function from within that function. For example, consider the following code               myFunction[args___] :=       Module[{},         checkArgs[args,"myFunction"];         someCode[]       ];      where checkArgs is used in several functions which have the same types of arguments and reports an error message which includes the name of the function it was called from. I would like to call checkArgs without having to give it the name of the function. The evaluation stack, obtained using Stack, I believe does not contain this information unless called from within a StackComplete, and this is generally not the case in normal use of the function. I appreciate that "the current function" is not necessarily a well-defined concept in Mathematica, since you can have nested function definitions, and a function is just a rule definition anyway. However, the options management system uses this concept. If I have OptionsPattern in the function definition, I can call OptionValue[x], and something knows to look in Options[myFunction] to find the information about the options. So could whatever this mechanism is using be accessed? Is there a way to get the current function from the options system? The best solution I have come up with is this:               (fn:myFunction)[args___] :=       Module[{},         checkArgs[args,fn];         someCode[]       ];      which avoids having to pass in the function name explicitly, but is still quite ugly.


title: Question about variable name autocompletion in $Mathematica$ 9 on OS X

text: For the command autocompletion, I can simply use `Ctrk`+`K` and then use `Return` or `Tab` to choose the completion. But when I want to autocomplete the local variables I have input, `Ctrk`+`K` works, but both `Return` and `Tab` fail to input the variable's name. I have tried to change this behavior with the **Interface** panel of the **Preferences** dialog , but there are no options I can change. Do you know some easy to make `Return` and `Tab` work for local variable autocompletion?


title: Specifying unlabeled FrameTicks in Plot

text: I am running _Mathematica_ 7\. Suppose that I plot $\sin(x)$ for $x = 0..10$ and frame the plot using `Frame -> True`: > >     Plot[Sin[x], {x, 0, 10}, PlotRange -> All, Frame -> True] >   > > ![Plot 1](http://i.stack.imgur.com/djEIO.gif) Now suppose that I would like the horizontal axis to have ticks every $0.5$ (which it does), but with the ticks _labeled_ only every $1$. Is there a way to do this? `FrameTicks` seemed to be a possibility, but when I used `Range[0, 10, 1]` in the bottom horizontal axis specification, I lost the (non-labeled) ticks at every $0.5$: > >     Plot[Sin[x], {x, 0, 10}, PlotRange -> All, Frame -> True, >      FrameTicks -> {{Automatic, Automatic}, {Range[0, 10, 1], Automatic}}] >   > > ![Plot 2](http://i.stack.imgur.com/QjacX.gif) Thanks for your time.


title: Is there a concise form of Which or similar conditional?

text: Suppose that I want to write a function `fun` that takes an `Integer` `num` as input, and returns `Red` if `num == 1`, `Orange` if `num == 2`, and `Yellow` if `num == 3`. One way, I think, to do this is to use `Which`:               fun[num_Integer] := Which[num == 1, Red, num == 2, Orange, num == 3, Yellow]      Is there a more concise way to write `fun`? In other words, is there any built-in function (analogous to `Which`) that I can use that would allow me to avoid typing "`num`" all the time instead of always having to specify it to `Which`. Writing `fun` as a series of nested `If` statements would be even lengthier. Do you have any suggestions? Thanks for your time.


title: Simplify product of square roots

text: What assumption is needed to make both outputs equal to `Sqrt[P^2]/2`               In[65]:= tps = (1/2) (1 - T (1 - P^2) + Sqrt[(1 - T(1 - P^2))^2 - P^2]);              tms = (1/2) (1 - T (1 - P^2) - Sqrt[(1 - T(1 - P^2))^2 - P^2]);              FullSimplify[Sqrt[tms tps]]              FullSimplify[Sqrt[tms] Sqrt[tps]]               Out[67]= Sqrt[P^2]/2          Out[68]= 1/2 Sqrt[1 + (-1 + P^2) T - Sqrt[(-1 + P^2) (-1 + T (2 + (-1 + P^2) T))]]                   Sqrt[1 + (-1 + P^2) T + Sqrt[(-1 + P^2) (-1 + T (2 + (-1 + P^2) T))]]      Comment: There are many similar questions on the web but I couldn't find a proper answer. To assume that T and P are real isn't enough. Edit: T and P are real numbers and not necessarily equal to zero. So the question should better be, what is the reason that both ways don't yield the same result and how can I change this?


title: Solving homogeneous Fredholm Equation of the second kind

text: I am trying to solve a homogeneous Fredholm integral equation of the second kind, i.e. $\lambda y(x) = \int\limits_a^b e^{i[\phi(t)+k(t-x/M)^2]} y(t)\,dt$ where $\lambda$ is the eigenvalue (to be determined), and $\phi(t)$ is a polynomial in $t$. Has anyone come across a Mathematica routine to do this? Thanks! Mark