How to change a value within a list of lists?

I essentially have two questions, both are related. 1) How do I change a value within a list of lists (I provided a example problem)? 2) Why does my code not work? I have a list which was created from the Tally function on a text file. The result is shown below...               tally = {{"tree", 5}, {"State", 6}, {"swimming", 3}, {"began",      2}, {"season", 8}, {"Force", 2}, {"Sooners", 10}, {"three",      4}, {"second", 14}, {"medley", 6}, {"relay", 17}, {"junior",      5}, {"sophomore", 3}, {"freshman", 5}, {"coach", 2}, {"Pratt",      2}, {"think", 2}, {"close", 2}, {"thought", 2}, {"events",      8}, {"finished", 9}, {"individual", 4}, {"collected",      4}, {"honors", 4}, {"along", 2}, {"third", 13}, {"showing",      4}, {"swept", 2}, {"first", 5}, {"Junior", 2}, {"star",      22}, {"freestyle", 4}, {"runner", 2}, {"Sooner", 2}, {"scored",      2}, {"respectively", 2}, {"finishes", 4}, {"Sophomore",      2}, {"opening", 3}, {"finish", 2}, {"lifetime", 2}, {"times",      2}, {"posted", 3}, {"marks", 2}, {"Championships",      3}, {"conference", 2}, {"recorded", 2}, {"vital", 2}, {"relays",      4}, {"school", 3}, {"records", 2}, {"earned", 3}, {"fourth",      3}, {"campaign", 2}, {"against", 5}, {"Northern", 6}, {"Colorado",      5}, {"helped", 2}, {"Arizona", 2}, {"Idaho", 2}, {"named",      2}, {"Academic", 2}, {"backstroke", 2}, {"fifth", 3}, {"regular",      2}, {"winning", 2}, {"victorious", 2}, {"sixth", 2}, {"RioRancho",      4}, {"School", 2}};      I want to be able to find the string "star" within the list and change the associated number with that string to 1000. I tried using the following code:               tally /. _?Last@(First@# == "star" &) -> 1000      It does not work the way I want. The number value associated with "star" remains unchanged. I know there is a way to do this. I just can't see it... Thank you for any assistance!


Most efficient way to determine conclusively whether an algebraic number is zero

Let `x` be an algebraic number of unspecified degree, expressed using arithmetic, rational powers, and ~~algebraic integers~~ (edit: `Root[...]` constructs). I would like to test conclusively whether it is zero. I don't know whether any of the following are guaranteed to work:               x==0     Simplify[x]==0     FullSimplify[x]==0     PossibleZeroQ[x,Method->"ExactAlgebraics"]      The following should work, but seems unlikely to be efficient:               MinimalPolynomial[x][y]===y      I don't want to use numerical approximation unless the answer is guaranteed to be correct. Do any of the first four lines above guarantee a correct answer? What is the best way to perform this test in Mathematica?


Automatic recovery after crash

I want Mathematica to periodically autosave my notebooks to the temp folder. And in case of front-end crash i want to see the dialog after restart with the following choices:   * recover from autosaved drafts   * discard drafts and open last manually saved versions   * start a new session Ideally i would like to make a fully automated solution that doesn't requre to execute any commands each time i open a new notebook. Do you have any suggestions how to implement this functionality? There is a hidden `NotebookAutoSave` option which saves notebook at every evaluation, but it has several disadvantages. It overwrites manually saved notebook and if i accidentally delete an important code (and evalute something) i'm unable to restore from the manually saved file. In OS X a built-in backup system can help, but when notebook is saved after each evaluation i get too many versions. There is also no possibility to distinguish manually saved version from all that autosaves in the Time Machine. Another problem with `NotebookAutoSave` is that it is only triggered by the evaluation. It doesn't help when i write code, open built-in help and front- end crashes during help browsing process.


How do I perform string matching and replacements?

What are, and how do I use _Mathematica's_ string matching and replacement tools?


How to use Solve rules as a function body?

`Solve` gives me an expression which I want to use as the body of a function. Rather than run `Solve` every time inside my function body, I just want to take the rule output `Solve` already gave me, and repurpose it into something that accepts arguments. For example, this works, but is slow because `Solve` runs in every invocation:               (* returns the two points where the line through pt {x1, y1}      with slope m intersects the circle x^2 + y^2 = 100 *)     intersections[m_, x1_, y1_] :=      Solve[y - y1 == m (x - x1) &&          x^2 + y^2 == 100, {x, y}] /. Rule[_, val_] -> val          intersections[1, 0, 0]     (* result: *) {{-5 Sqrt[2], -5 Sqrt[2]}, {5 Sqrt[2], 5 Sqrt[2]}}      I've tried variations on below, but they don't work:               solution = Solve[y - y1 == m (x - x1) &&           x^2 + y^2 == 100, {x, y}] /. Rule[_, val_] -> val /. {m -> #1,         x1 -> #2, y1 -> #3}          intersections[m_, x1_, y1_] := solution[m, x1, y1]      Below is almost what I want, but the rule replacements don't perform as well as real function arguments, and this is also dependent on copying around replacement symbol names:               solution = Solve[y - y1 == m (x - x1) &&           x^2 + y^2 == 100, {x, y}] /. Rule[_, val_] -> val ;     intersections := solution /. { m -> #1, x1 -> #2, y1 -> #3} &;      How can I take the the expression `Solve` gave me, and "function-ify" it? Copy-pasting the expressions into a function works, but obviously I don't want to do that.


How do I force columns in a Grid to be equally spaced?

Suppose that I have this table `tab`, which I display using `Grid`. Is it possible to force the columns to be equally spaced? All columns should be the same width _and_ no data should be discarded/hidden from view.               tab = {{"aaaa", "b"}, {"1", SpanFromLeft}, {"2", SpanFromLeft}, {"3", SpanFromLeft}};     Grid[tab, Frame -> {None, None, {{1, 1} -> True, {1, 2} -> True}}]      ![gridcolumn](http://i.stack.imgur.com/uiBam.gif)


How Can I plot 3D figures using discrete data in one dimension?

I have an approximate solution for the function `u[x,t]` using the semi- discretization method in time step. For example, I have `u[x,ti]` for all `x` and some `ti`. I want to plot a 3D figure for this function and I don't know how to plot it.


How can I separate a separable function

I have a separable function $f[x,y]$, and I would like to find two functions $g[x]$ and $h[y]$ with $f[x,y]=g[x] h[y]$ where $g[x]$ doesn't depend on $y$ and $h[y]$ doesn't depend on $x$. Ideally, $g$ and $h$ should have the same magnitude, to prevent overflows/underflows. I have a hackish approach that works, but involves a lot of manual labor. Background: $f[x,y]$ is a filter kernel I want to apply to an image, and using two separate 1d-filters is much more efficient. My first approach was to start with $g[x]=f[x,0]$. But that doesn't work for e.g. $f[x,y]=\frac{e^{-\frac{x^2+y^2}{2 \sigma ^2}} x y}{2 \pi \sigma ^6}$ Currently, I have a function that "removes" $x$ or $y$ from $f[x,y]$ using pattern matching:               removeSymbol[f_, s_] := f //. {s^_ + a_ -> a, s^_.*a_ -> a}      but that means I have to manually adjust this pattern for different f's. Is there a more elegant way to do this? $f[x,y]$ is usually a derivative of a gaussian, e.g.               gaussian[x_,y_] := 1/(2 π σ^2) Exp[-((x^2 + y^2)/(2 σ^2))]     f[x_,y_] := D[gaussian[x,y], x, y]


In Grid and using Frame, how can I only frame the header cells?

Suppose that I use `Grid` to display a table `tab`. I did the following, which frames all cells:               tab = {{"a", "b"}, {"1", SpanFromLeft}, {"2", SpanFromLeft}, {"3", SpanFromLeft}};     Grid[tab, Frame -> All]      and gives this output: ![gridall](http://i.stack.imgur.com/QgwCY.gif) But, how do I programatically generate a table in which only the header cells are framed? ![gridsome](http://i.stack.imgur.com/VBLrk.gif) (I created the above by erasing cell dividers manually, using Paint, but for larger tables, I would like to do this programatically.) Thanks.


How does Plot determine vertical range when not user-specified?

Consider the example1:               p0 = Plot[Tan[x Pi/2], {x, -1, 1}]      In this case, the vertical range specified would be $(-\infty, \infty)$, which is clearly impossible to plot, but Mathematica silently chooses a vertical plot range of $[-6.60184, 6.50751]$ (as reported by `AbsoluteOptions[p0, PlotRange]`). In fact, even in cases where the function to be plotted remains finite throughout the interval specified (including its endpoints), Mathematica will sometimes choose a vertical range smaller than the actual range of the function in the specified interval. For example, if one plots               epsilon = 1*^-6;     Plot[Tan[x Pi/2], {x, -1 + epsilon, 1 - epsilon}]      the vertical plot range used by Mathematica is $[-6.60183, 6.50749]$, almost the same as the one used in the previous example. How does `Plot` decide the vertical range of a 2D plot, when the user does not specify (a bounded) one? (Needless to say, I don't expect to get a full description of Mathematica's algorithm for doing this, since it's proprietary information. What I'm hoping to get is just the general idea, in broad strokes.) * * * One thing I can say is that the horizontal range does not seem to enter into the computation of the vertical range, since the vertical range for the plot               Plot[Tan[x Pi/200], {x, -100, 100}]      is exactly the same as for the first example above. 1 Sorry for not posting pictures... The SE Uploader I have installed is not working for some reason.


Emulating Sequence with my own function

I just considered if/how one could implement `Sequence` in Mathematica if it were not predefined. It turned out that the following simple definition has in all my tests exactly the right behaviour:               myseq /: f_[x___, myseq[y___], z___] := f[x, y, z]      Now my question: Does this already correctly reproduce the full behaviour of `Sequence`, or is there something `Sequence` does but `myseq` doesn't which I missed in my tests? Here's what I tested:               foo[myseq[a, b]]     (*     ==> foo[a, b]     *)     Hold[mysec[a,b]]     (*     ==> Hold[a, b]     *)     HoldComplete[myseq[a,b]]     (*     HoldComplete[myseq[a, b]]     *)     Hold[f[myseq[a,b]]]     (*     ==> Hold[f[myseq[a, b]]]     *)     f[myseq[myseq[a,b],c,d],e,myseq[f,g,myseq[]]]     (*     ==> f[a, b, c, d, e, f, g]     *)


Excel DDE Link: reading and writing in real time

I'm wondering if it is possible to link Excel and _Mathematica_ in real time, so that _Mathematica_ can be used as a computing and "storage" tool. Suppose I have an Excel spreadsheet **with an active DDE link** : ![enter image description here](http://i.stack.imgur.com/vEZBx.jpg) I would like to know if it is possible for _Mathematica_ to communicate with Excel in real time **and** store every cell update in Excel. I know there is a package called ExcelLink, with several functions to link _Mathematica_ and Excel. So, if I use, for instance `ExcelRead["A2"]` I get the correct value > 19.36 However, it is not dynamic! I can get dynamic values by using               a=Dynamic[Refresh[ExcelRead["A2"], UpdateInterval -> 0]]     b=Dynamic[Refresh[ExcelRead["B2"], UpdateInterval -> 0]]      However, when I try to add `a+b` I get > 19.36+28.56 And, worse, If I use               Dynamic[a+b, UpdateInterval -> 0]      I get > 19.36+28.56 So, here arises my **first problem** : although _Mathematica_ reads the values in real time from Excel, I'm not able to perform any calculation with them. Is there any way to do it? My **second problem** is: how can I write dynamically the values I'm getting from the DDE Link inside Excel itself? I need to write **every updated value** in Excel in a sequence like shown below ![enter image description here](http://i.stack.imgur.com/csuAE.jpg)


Transcendental equation with ContourPlot3D

I am still a newbie to _Mathematica_ , so I am still getting used to the syntax and logic of the program - but I've been trying to do the following 3D plot:               g[x_, t_] := y /. FindRoot[y == Tanh[(2*y + x)/t], {y, x, t}];     p1 = ContourPlot3D[{z ==           Sech[(2 g[x, t] + x)/t]^2/(t - 2 Sech[(2 g[x, t] + x)/t]^2)}, {t,          0.001, 3}, {x, -1.5, 1.5}, {z, 0, 2.5}, Mesh -> None,         ContourStyle -> Opacity[0.25],         ColorFunction -> ColorData["ThermometerColors"]];          Rasterize[      Show[p1, PlotRange -> {{0.001, 3}, {-1.5, 1.5}, {0, 2.5}},        ViewPoint -> {0.9*Pi, -0.45*Pi, 1.05*Pi}], ImageResolution -> 1200]      The `ContourPlot3D` of the transcendental equation `y == Tanh[(2*y + x)/t]` itself comes out perfect - but after some 10-15 mins of evaluating z, I seem to be getting the right 3D surface from the 2D solutions I've done (cuts through the 3D surface I am trying to plot), but the plot is filled with artifacts. I am the tinkering type, so I tend to need to see things work right a few times, before things like the syntax and logic of _Mathematica_ start to stick in my memory - and I can't figure out this one. What am I doing wrong?


Disagreement between FindGeoLocation and Alpha: "Where Am I?"

While trying to estimate a user's location in a notebook, I noticed that `FindGeoLocation[]` was extremely inaccurate. I realize that it uses an IP lookup to make this estimate, but the location it has found is _definitely_ not my ISP, as it is several thousand kilometers away. `WolframAlpha["Where am I?"]` returns a location 5km from my home. The confusing part is that checking `Trace[FindGeoLocation[]]` indicates that the function contacts the Wolfram servers to run the IP trace. In my case, the result from `FindGeoLocation[]` is for another city in Canada with a _very_ similar name to where I live. Sorry if this information is a bit cryptic, but I'd rather not give out my location. I have access to MMA on nearby servers with different IP addresses, and the result is the same, but I obviously can't carry out any other tests. **EDIT:** To clarify my intention here. I don't expect an accurate location from an IP- based lookup. I know that neither of these methods will be able to improve on actually putting my home address into Google Maps and checking the coordinates. What I'm curious about, is why these methods might return different results. Can anybody speak on how these two methods would be implemented internally such that they would disagree?


Finer granularity with ParallelDo

`ParallelDo` only parallelizes by the innermost variable. Is it possible to distribute the calculation over all the points (all the variable) separately? let me demonstrate:               CloseKernels[]; LaunchKernels[6];     ParallelDo[Print@Row[{i, j, k}, ", "], {i, 2}, {j, 10}, {k, 10}]      This only runs on two kernels, because `i` only has two values. ![enter image description here](http://i.stack.imgur.com/oFMJq.png) Method `"FinestGrained"` is of no help either. As a workaround I can do               WorkUnits = Flatten[Table[{i, j, k}, {i, 2}, {j, 5}, {k, 5}], 2];     ParallelDo[With[{i = w[[1]], j = w[[2]], k = w[[3]]},       Print@Row[{i, j, k}, ", "]       ]      , {w, WorkUnits}]      ![enter image description here](http://i.stack.imgur.com/eKh1W.png) But this seems very clumsy. **Is there a more elegant way to parallelize the calculation over all variables, not just the first in a`ParallelDo`?**


Wallis Formula and Pippenger Product---How do we get symbolic output?

The Wallis Formula computes $\frac{\pi}{2}$ OEIS and the Pippenger Product computes $\frac{e}{2}$ OEIS. Here is a combined formula:               x = 0;  (*Wallis Formula (Pi/2)*)     Defer[     2^(1/2^x) Product[(1 - (2^j + 2 k + 1)^-2)^(2^x)^(-j - 1),               {j,1, \[Infinity]}, {k, 0, 2^(j - 1) - 1}]]     N[%, 20]     N[Pi/4, 20]     x = 1;  (*Pippenger Product (E/2)*)     Defer[     2^(1/2^x) Product[(1 - (2^j + 2 k + 1)^-2)^(2^x)^(-j - 1),               {j, 1, \[Infinity]}, {k, 0, 2^(j - 1) - 1}]]     N[%, 20]     N[E/(2 Sqrt[2]), 20]     x = 1; n = 20;  (*Pippenger Product (E/2) nth excludes Sqrt[2]*)     Defer[     Product[(1 - (2^j + 2 k + 1)^-2)^(2^x)^(-j - 1),     {j, n, n}, {k, 0, 2^(j - 1) - 1}]]     N[%, 20]      **Edit** Expanded formula for top two products: $$2^{\frac{1}{2^x}} \prod _{j=1}^{\infty } \prod _{k=0}^{2^{j-1}-1} \left(1-\frac{1}{\left(2^j+2 k+1\right)^2}\right)^{\left(2^x\right)^{-j-1}}$$ **Bounty Edit** Below is boiler-plate to show the three symbolic results we need. The numerators are $\pi e,\pi,\text{ and } e.$ We need to modify `Product` to add some `Patterns` and `Rules` to achieve symbolic results. (i.e., to eliminate `Solve` and `NProduct` from the functions.) _I have no idea how to do this!_               Clear[m];     wallispippenger[] :=      Solve[2^(Log[2 Sqrt[2]]/Log[2]) NProduct[(1 - (2^j + 2 k + 1)^-2)^(       1 + (2^1)^(-j - 1)), {j, 1, \[Infinity]}, {k, 0, 2^(j - 1) - 1},        WorkingPrecision -> 100] == m/4, {m}]/4     wallispippenger[x_] :=      Solve[2^(1/2^x) NProduct[(1 - (2^j + 2 k + 1)^-2)^(2^x)^(-j - 1), {j,         1, \[Infinity]}, {k, 0, 2^(j - 1) - 1},        WorkingPrecision -> 100] == m/2, {m}]/2     wallis[] := wallispippenger[0]     pippenger[] := wallispippenger[1]     {wallispippenger[], wallis[], pippenger[]}      **Edit** The results before the LH power of two is applied: $$\frac{\pi e}{8 \sqrt{2}}, \frac{\pi}{4},\text{ and }\frac{e}{2 \sqrt{2}}.$$   These are mulitplied by: $$2\sqrt{2}, 2,\text{ and }\sqrt{2}.$$


A function generating particle-in-a-box eigenfunctions

The function sequence is defined over $[-\frac{L}{2},\frac{L}{2}]$ (all elements are valued 0 outside this interval): $$\psi_n(x)=\begin{cases}\sqrt{2/L}\sin{(\frac{n\pi x}{L})} & n \space even \\ \sqrt{2/L}\cos{(\frac{n\pi x}{L})} & n \space odd \end{cases}$$ I would like to create a Mathematica function that takes a natural number $N$ as a single parameter, and returns the corresponding function definition from the sequence. Looks like it boils down to substituting $n=N$ and substituting $\sin\oplus\cos=\begin{cases}\sin & N \space even \\ \cos & N \space odd\end{cases}.$ How can I achieve this?


Inconsistent behavior of WhenEvent[ ]

Consider the following simple example:               sol = NDSolve[ {x''[t] == 1, x'[0] == 0, x[0] == 0,                    WhenEvent[Abs[x[t]] > 1 && x[t] > 2, {x'[t] -> -3 x'[t]}]},                     x[t], {t, 0, 4}];     Plot[x[t] /. sol[[1]], {t, 0, 4}]      ![Mathematica graphics](http://i.stack.imgur.com/UqDmN.png) Clearly `WhenEvent[]` is missing the `x[t] > 2` occurrence. This _may_ happens (my interpretation) if the event detection routine checks for the occurrence of the first part of the AND clause and _then_ for the other AND components, instead of checking them as an OR event trigger. As the `Abs[x[t]] > 1` event isn't fired again between 1 and 2, the rest of the AND clause doesn't get tested again. In testing this interpretation, we can reverse the clause:               sol = NDSolve[{x''[t] == 1, x'[0] == 0, x[0] == 0,                   WhenEvent[x[t] > 2 && Abs[x[t]] > 1, {x'[t] -> -3 x'[t]}]},                     x[t], {t, 0, 4}];     Plot[x[t] /. sol[[1]], {t, 0, 4}]      ![Mathematica graphics](http://i.stack.imgur.com/5qvHW.png) which now works as expected. Of course this isn't a proof. But the strange thing is that reverting to the first version, but encapsulating the clause in a function, also works as expected:               clause[p_] := Abs[p] > 1 && p > 2     sol = NDSolve[{x''[t] == 1, x'[0] == 0, x[0] == 0,                   WhenEvent[clause[x[t]], {x'[t] -> -3 x'[t]}]}, x[t], {t, 0, 4}];     Plot[x[t] /. sol[[1]], {t, 0, 4}]      ![Mathematica graphics](http://i.stack.imgur.com/uoYrx.png) So, what is the moral? Always put your `WhenEvent[]` clause as a function?


Why does a certain CSV file import properly into LibreOffice but not into Mathematica 10.0?

I'm working on a project involving data manipulation and it involves working with CSV files. I know that the files are properly formatted as when I import them into LibreOffice, all of the columns contain the information they are meant to. When I import the files into Mathematica (10.0) however, data from the 45th column (for example) shows up in the 1st column. I'm using:                   Import["filename.csv","Data"]      Does anyone know what the issue might be? Thank you~


Problem with NIntegrate

\!\(\*     ButtonBox["ClearSystemCache",     BaseStyle->"Link",     ButtonData->"paclet:ref/ClearSystemCache"]\)[] ;     sigx = 317;     e1 = 191000;     e2 = 9890;     m = 15;     b = 58;     f2tc = 61.62;     h1 = 0.165;     h2 = 4*h1;     ex = (h1*e1 + h2*e2)/(h1 + h2);     g12 = 7790;     g23 = g12/3;     H = 3*g12*g23/(h1*g23 + h2*g12)     α = Sqrt[((h1 + h2)*ex*H)/(h1*h2*e1*e2)];     sigx2b = (e2/ex)*sigx     sigx2b/f2tc     ep = (sigx2b/(sigx2b - f2tc))     l00 = 2*ArcCosh[ep]/α     p = 1 - Exp[-(F2t/b)^m]     f1 = D[p, F2t]     F = (e2*sigx/ex)*(1 - 1/Cosh[α*l0/2])     f2 = Abs[D[F, l0]]     l = 2;     f = l0/l^2     fc = f*f1*f2 /. F2t -> (e2*sigx/ex)*(1 - 1/Cosh[α*l0/2])     \!\(\*     ButtonBox["NIntegrate",     BaseStyle->"Link",     ButtonData->"paclet:ref/NIntegrate"]\) [fc, {l0, l, 2*l},       Method -> {"GlobalAdaptive",         Method -> {"TrapezoidalRule", "Points" -> 3},         "SingularityHandler" -> None}, PrecisionGoal -> 4]      Where the output for `fc` is               28.862 E^(-10.844 (1 - Sech[0.70973 l0])^15) l0 Abs[       Sech[0.70973 l0] Tanh[0.70973 l0]] (1 - Sech[0.70973 l0])^14      `l0` is the variable but, `NIntegrate` fails to produce any results and simply shows               \!\(\*     ButtonBox["NIntegrate",     Appearance->Automatic,     BaseStyle->"Link",     ButtonData->"paclet:ref/NIntegrate",     Evaluator->Automatic,     Method->"Preemptive"]\)[      28.862 E^(-10.844 (1 - Sech[0.70973 l0])^15)        l0 Abs[Sech[0.70973 l0] Tanh[0.70973 l0]] (1 -          Sech[0.70973 l0])^14, {l0, 2, 4},       Method -> {"GlobalAdaptive",         Method -> {"TrapezoidalRule", "Points" -> 3},         "SingularityHandler" -> None}, PrecisionGoal -> 4]      Can anyone help me?


How can the {x,y,z} points that fall on the outer boundary of a set of values be selected and smoothly surfaced?

For a given set of x,y,z values, that may, or may not form a uniform shape, how can the center of the data cloud be found, and the surface points be located and a solid smooth surface created from them? In some cases a set of points may create intersections of shapes but there are no holes to deal with in the data.               x=RandomReal[1,{400,3}];          ListPointPlot3D[x]      ![scatterplot](http://i.stack.imgur.com/2Di5O.jpg) here's a 2D version of a bSpline interpolation function I have used for joining the surface points smoothly after dividing them in painful ways. Running Mathematica 8.04               ParameterAverageKnots[deg_, data_] :=       Module[{param = data[[All, 1]]},        Join[ConstantArray[param[[1]], deg + 1],         Table[1/deg Sum[param[[i]], {i, j, j + deg - 1}], {j, 2,           Length[param] - deg}], ConstantArray[param[[-1]], deg + 1]]]          UniformKnots[deg_, data_] :=       Rescale[Join[ConstantArray[0, deg],         Range[0, 1, 1/(Length[data] - deg)], ConstantArray[1, deg]], {0,         1}, {data[[1, 1]], data[[-1, 1]]}]          UnclampedKnots[deg_, data_] :=       Rescale[Range[Length[data] + deg + 1], {deg + 1,         Length[data] + 1}, {data[[1, 1]], data[[-1, 1]]}]          BasisMatrix[deg_, data_, knotfunc_] :=       With[{knots = knotfunc[deg, data]},        Table[BSplineBasis[{deg, knots}, j - 1, data[[i, 1]]], {i,          Length[data]}, {j, Length[data]}]]                       BSplineInterpolation2D[data_, deg_, knotfunc_] :=        Module[{knots, m, sol},        knots = knotfunc[deg, data];        m = BasisMatrix[deg, data, knotfunc];        sol = LinearSolve[m, data[[All, 2]]];        BSplineFunction[sol, 1, SplineDegree -> deg, SplineKnots -> knots]];          degree = 3;     pts = RandomReal[5, 10] // Sort     data = Transpose[{Range[10], pts}]     f = BSplineInterpolation2D[data, degree, UniformKnots]     Plot[f[t], {t, 1, 10}, Epilog -> {Red, Point@data}]      ![bslplineInterpolation](http://i.stack.imgur.com/lbfkj.jpg) can it be extended to this purpose? Of course there's still that tough part about getting the outer points to surface, and after splining how to surface the form. To review this issue again after all of the great input and trials, the results show that for some very similar shapes the solution did not work. Here are 2 examples:![Cohesive results ](http://i.stack.imgur.com/GQamk.jpg) Now for slightly changed data with a similar shape:![Non-Cohesive results](http://i.stack.imgur.com/PgObq.jpg) In both of these examples the data points provide very reasonable shapes to surface. One works, the other fails... thoughts? The failed test data can be downloaded here.


Raster with ColorFunction is blank when Dynamic Updating is disabled

**UPDATE** Today I was having these WaveletScalogram problems again. I think this is ultimately some kind of interaction issue with `Dynamic`. I have narrowed it down to this:               Graphics[Raster[{{0}}, ColorFunction -> "AvocadoColors"]]      Run this line, and then disable Dynamic Updating ("Evaluation" menu) and run it again. On my computer it comes out blank when Dynamic Updating is disabled. If you remove the `ColorFunction` option, it will work fine with or without Dynamic Updating. So new question: Why does this happen? Is it a bug? I wonder if others can even reproduce this. * * * **Previous version of this question:** I was trying to export `WaveletScalogram` plots (to image formats) in parallel, and some of the images were coming out blank. I've managed to reduce the issue to what appears to be quirky `Rasterize` behavior on `WaveletScalogram` plots specifically, in parallel computations. I'm on version 8.0.4.0 on Win7 64. With the following:               ParallelTable[      Rasterize@       WaveletScalogram[ContinuousWaveletTransform[RandomReal[{0, 1}, 2000]]],      {f, 4}]      I get: ![enter image description here](http://i.stack.imgur.com/jbIBE.png) Change `ParallelTable` to `Table`, or remove the `Rasterize`, and I get: ![enter image description here](http://i.stack.imgur.com/v5pON.png) I'm just wondering if this is actually a bug or I'm just missing something. **update** I was able to get it to work by hard-limiting the number of kernels to the number of cores on my system (a monstrous 2 cores). The "Parallel Kernel config" is a little confusing in this regard, since I have to set it to "1 parallel kernel" to get 2 parallel kernels controlled by a 3rd master kernel O_O Still this Rasterize behavior is uncalled for, I think.


Extracting sequences from a list?

Suppose I have a list of arbitrary length like               {1, 2, 3, "Open", 3, 2, "Close", 9, 3, 4, "Open", 1, 0, "Close", 3, 5}      and I am trying to extract the sequences inside the open/close tags, i.e. the answer I want is               {{3, 2}, {1, 0}}      What's the right way to do this? The data I am actually working is a large XML document and I am trying to extract sections of it by identifying certain tags as boundaries. I've fiddled with different pattern matching functions but can't figure out how to operate on a list in this way since I am trying to match patterns on an intermediate level between individual elements and the entire list. **EDIT** To clarify, I don't know in advance how many such sequences the data will contain or how many elements will be inside any particular set of tags.


Symbolic Simulations

I have 9 nonlinear equations and 10 unknowns. It is not possible to obtain a numeric solution but I do get a parametric solution. It is useful in my case because I want to observe how parameters (p1, p2, Y1, Y2, alpha, beta, gamma) effects the unknowns. I will now present you the code and explain the problems below it.               PG = 100;          p1 = 0.8;          p2 = 0.2;          (Y1 = 10 & Y2 = 15 & alpha = 0.5 & gamma = 0.4 & beta = 0.3)          Solve[C1 - 10 + PG/2 + GC1 + GL1 == 0 &&        C2 - 15 + PG/2 + GC2 + GL2 == 0 &&        GL1 - fd (a1) t 10 == 0 &&        GL2 - fd (a2) t 15 == 0 &&        GC1 - (t (1 - fd) 25 - PG) ((p1)/((p1) + (p2))) == 0 &&        GC2 - (t (1 - fd) 25 - PG) ((p2)/((p1) + (p2))) ==  0 &&        (0.3/GL1) - (0.5/C1) - (0.3/GC1) - (0.4/PG) == 0 &&        (0.3/GL2) - (0.5/C2) - (0.3/GC2) - (0.4/PG) == 0 &&        GC1 - 4 GC2 == 0,        {C1, C2, GC1, GC2, GL1, GL2, fd, a1, a2, t}]      I want to perform a simulation on the unknown variables by changing the values of parameters. In the above code parameters take only 1 value (i.e. p1 = 0.8) but keeping other values constant I want to change the values of p1 between 0 and 1 to observe the changes in the unknowns and I want to plot it on the graph. We can call it a sensitivity analysis. If I can learn to change it for p1, I will try myself to change it for the other parameters. I tried to use "RandomReals" (i.e. p1 = RandomReals[1,5] - which creates 5 random variables between 0 and 1) but I think there was a problem of mapping each numbers to p1. So, I need help to do the simulation and plotting the change. I hope everything is clear in my question. Since I am new here and it is my 2nd question please tell me if I need more clarification. Thanks in advance.


how to plot log-log histogram in Mathematica 7

I have a large array of real (positive and negative) numbers and I want to plot the histogram of it. I can use               Histogram[data, "Log", PlotRange->All]      but this gives me log scale only in X-axis. How would you get log scale on both axis for a histogram? I have heard that Mathematica 8 has added this feature, but I am using Mathematica 7 right now. Moreover, say I just want Log scale on Y-axis. Is it possible too? Thanks!


Backsubstituting solution into FindRoot

I am trying to solve a system of equations which is dependent to an parameter `alpha`. So I iterate over `alpha` via a `Table` call and try to back substitute the solution found in iteration `i` into the `FindRoot` call. My example leads to an infinite recursion.               sols = {x -> 0, y -> 0}     Table[ {sol = FindRoot[{alpha x == 0, y x = 3 }, sol[[1, 2]], {alpha, 1, 10}]      Heike’s suggestion works perfectly for one parameter. I tried to extend this for two parameters, but I failed.               sols = {x -> 0, y -> 0}     eqns := {alpha x == 0, y x = 3}     Table[sol = FindRoot[eqns, {x, sol[[1, 2]], y, sol[[3, 4]]}], {alpha, 1, 10}]      how can I access the solution of `y` correctly?


Selecting a list from a list of lists

In working through _Programming Paradigms Via Mathematica (A First Course)_ I have come across this two part question: > A permutation of length "n" is a list of the first n positive integers in > some order. Example: {6,1,5,3,4,2} is a permutation of length 6. A > permutation is called balanced if the sum of each consecutive pair is equal > to the sum of the consecutive pair furthest away from the original pair, if > we imagine the permutation written in a circle. For instance, (6,1) and > (3,4) are pairs furthest away in the example above, because they are both 1 > unit away from the original pair. Similarly, (2,6) and (5,3) are furthest > apart. Our example is balanced because pairs furthest apart have the same > sum: 6+1=3+4; 1+5 =4+2; 5+3=2+6; 3+4=6+1; 4+2=1+5; 2+6=5+3. Another way to > see this is to write the consecutive sums in order (7,6,8,7,6,8) and notice > that the corresponding sums are the furthest apart. Note that all of this > makes sense only if the length of the permutation (n) is even. > > (a) Write a function "balancedQ[ ]" which takes one argument which is a list > of even length and returns True if it is balanced, False otherwise. My answer is:               Clear[balancedQ];          balancedQ[list_List] := Module[{list2, list3, list4, list5},        d = 1;        If [EvenQ[Length[list]],          list2 :=           Append[Partition[list, 2, 1], {First[list], Last[list]}], {d = 2,           Goto[End]}];        addPairs[{m_, n_}] := m + n;        list3 := addPairs /@ list2;        list4 := First[Partition[list3, Length[list3]/2]];        list5 := Last[Partition[list3, Length[list3]/2]];        While[Length[list4] > 0,          If[First[list4] == First[list5], {list4 = Rest[list4],            list5 = Rest[list5]}, {d = 2, Goto[End]}]];        Label[End];        If[d == 1, Print["True"], Print["False"]]];      While I am sure that it can be improved upon, it does work returning true for `balancedQ[{6,1,5,3,4,2}]` and false for `balancedQ[{6,1,5,3,4}]` (odd # of elements) and `balancedQ[{6,1,5,3,2,4}]` (unbalanced). The second part of the question is where I have trouble: > (b) The Mathematica function "Permutations[]" returns all possible > permutations of the elements of a list. Use "Permutations[]" and your > function "balancedQ[]" to find all balanced permutations of the numbers > {1,2,3,4,5,6}. In looking through the previous lessons as well as the documentation center it seems to me that `Select` is the correct command, and I used it as follows:               Select[Permutations[{1, 2, 3, 4, 5, 6}], balancedQ]      To my chagrin what I got in return was a column of 720 Falses (mainly) and Trues (a few). Therefore my question is, should I be looking at a different command, or is there an option that I am not seeing relative to `Select`?


Instruct a Table to only evaluate until a condition is fulfilled

I am looking for the way of building a Table of pairs of numbers in a fast way. My true table evaluates huge functions, and I see no way and reason to show those cumbersome expressions here. Let us for simplicity consider this:               Table[{10 - x - y^2, 1/x - y}, {x, 0.1, 15, 0.5}]      In addition my real table is very long, but for the sake of shortness in this example it has a small amount of terms. Here y is a parameter taking several values. For example, y may be 0.1 and 0.5. Now, I only need the part of the table in which each term in the pair {a, b} is positive and real. In my example here, if y=0.1 one gets                {{9.89, 9.9}, {9.39, 1.56667}, {8.89, 0.809091}, {8.39, 0.525}, {7.89,        0.37619}, {7.39, 0.284615}, {6.89, 0.222581}, {6.39,        0.177778}, {5.89, 0.143902}, {5.39, 0.117391}, {4.89,        0.0960784}, {4.39, 0.0785714}, {3.89, 0.0639344}, {3.39,        0.0515152}, {2.89, 0.0408451}, {2.39, 0.0315789}, {1.89,        0.0234568}, {1.39, 0.0162791}, {0.89, 0.00989011}, {0.39,        0.00416667}, {-0.11, -0.000990099}, {-0.61, -0.00566038}, {-1.11, \     -0.00990991}, {-1.61, -0.0137931}, {-2.11, -0.0173554}, {-2.61, \     -0.0206349}, {-3.11, -0.0236641}, {-3.61, -0.0264706}, {-4.11, \     -0.029078}, {-4.61, -0.0315068}}      but I only need its first 20 terms, which have the both figures positive. It is easy to sort it after the table is build. The problem is that the expressions entering the real table are huge, and the table is long. In addition the table is a part of a complex demonstration, which is immensely slowed down by the process of the table evaluation. As soon as I change the parameter y from one value to another, it takes about a minute to evaluate everything. Changing to ParallelTable makes the things even worse. My question: is there a way to instruct Table to stop evaluating as soon as any of the figures in the pair becomes negative? This might considerably shorten its evaluation time. The Menu/Help/Table mentions a possibility of some specifications in the Table operator, but I have found no examples of such specifications and cannot see, if that would be of help.


How can this AbsoluteTime call be made faster?

I need to convert tons of date strings into absolute times. This generates an example data set of 10,000 strings:               dateStrings=DateString[#,{"Year","-","Month","-","Day"," ","Hour",":","Minute",":","Second"}]&/@                   Range[3576302100-10000,3576302100];      I think the simplest way is               AbsoluteTime /@ dateStrings      and this gives exactly the result I want. But on lists of hundreds of thousands of dates, it is quite slow. On the example data set, it takes about 5 s. I can speed it up it a bit by telling `AbsoluteTime` what date format to expect:               AbsoluteTime[{#, {"Year", "-", "Month", "-", "Day", " ",                        "Hour", ":", "Minute", ":", "Second"}}     ] & /@ dateStrings;      And this takes about 3.8 s. How can the performance be improved further?


How to record all the output (including error messages) of a mathematica script in a file?

Is it possible to record all the output of a `Mathematica` script to a file? I am looking for the `Mathematica` equivalent of fortran `./a.out > out.dat` which record all the output string to the file `out.dat`. Using `OpenWrite[]` and `WriteString[]` can record only the part I can specify but not the error messages which also can appear during execution. For example consider the script `test.m`               Print@"Start";     x=1/0;     Print@x;     Quit[];      If you run `math -script test.m` it will produce a message about encountering 1/0 apart from the string "Start" and "ComplexInfinity" due to the `Print`. I want to record all these messages in a file. Is it possible? > **Clarification** When you run a script in terminal it produces different messages, both user defined (with `Print`) or machine generated (like error messages). In a note book they are automatically recorded. But when running the script in background in a remote machine, it is not possible to keep track of all the messages. So I am looking for a way to record them in a file so that I can get an idea of the progress at any instance by looking at that file.


Manipulate and Plot using conditional, like if

I'd like to plot a number of functions that are linked by two parameters. However, the evaluation of these functions over the defined interval should be carried out only for certain values of these parameters. More precisely, this is what I'm looking for:               Manipulate[      Plot[{1, (1/c + 0.5^2/q + (1/q)*(x^2 - x))},        **if[c < 1, {q^(0.1)*c^(0.1)*(0.87 + x)^6.95,          0.2 + q^(0.1)*c^(0.1)*(1.81 - x)^10}, {c^(0.1)*(0.87 + x)^6.95,          0.2 + c^(0.1)*(1.81 - x)^10}],** {x, 0, 1},        PlotRange -> {{0, 1}, {0, 2}}, Filling -> Axis], {c, 1, 5}, {q,        0.01, 0.99}]      The bold-highlighted part is what I'd like to evaluate. Now my question: is it possible to use conditionals in `Manipluate` & `Plot`? Thank you very much for your help in advance. Best, Esco


Generate expressions equivalent to rooted trees

I would like to know how to generate all rooted trees on $n$ vertices using Mathematica? More precisely, I am interested in generating algebraic expressions equivalent to rooted trees and constructed as follows:   * Let $U$ be some function of one variable $x$.    * All expressions are obtained using exclusively composition by $U$ or multiplication by $U$   * Multiplication by $U$ correspond to adding a child to a vertex.   * Composition by $U$ corresponds to adding a parent. Clarifying examples:   * $U\big[U[x] U[x]\big]$ is equivalent to the rooted tree: > ![enter image description here](http://i.stack.imgur.com/VlIJv.jpg)   * While $U[x]U\big[U[x] U[x]\big]$ is equivalent to the rooted tree > ![tree1](http://i.stack.imgur.com/LDLUV.jpg)   * And finally $U\Big[U[x]\,U\big[U[x] U[x]\big]\Big]$ is equivalent to the rooted tree > ![tree2](http://i.stack.imgur.com/gB8FQ.jpg) Could you please help me generate all rooted trees on $n$ vertices, i.e. algebraic expressions as above with $U$ appearing $n$ times?


CurrentImage[] "unable to connect to camera"?

I have a new Macbook Pro (Retina), running Mavericks. For some reason I cannot access the camera in Mathematica using CurrentImage[] or ImageCapture[]. The result is:               CurrentImage::checkcam: Mathematica was unable to connect to a camera. Check      that a camera is properly connected and that it is not currently in use      by another application. >>      I do note that \$ImagingDevices is {}, and \$DefaultImagingDevice is None. Any ideas?


Mathematica crashes after some iterations

I wrote a Mathematica script, which calculates an integral value at a list of points and writes it to a file:               ϵ :=78.36;     z := 1;     bohr := 0.52917721;     boltzmann = 3.16681535*10^-6;     c := 10 * 6.02214129*10^23*1.0*10^-27*bohr^3;     κ := Sqrt[2.*4*π*c*z];     kBT := boltzmann * 300;          λ = κ/Sqrt[ϵ]*Sqrt[z/(kBT)]          funcin =        1/(ϵ*π)*Exp[-(2*r + λ*Sqrt[r^2 + ρ^2 - 2*r* ρ*Cos[θ]])]*         r^2*Sin[θ]*1/Sqrt[ρ^2 + r^2 - 2*r*ρ*Cos[θ]]          intfuncinang =        Assuming[r > 0 && ρ > 0 && ϵ > 0 & &λ > 0, Integrate[funcin, {θ,0,π}, {ϕ,0, 2π}]]          Assuming[ρ > 0 && ϵ > 0 && λ > 0,       funcins =          Integrate[intfuncinang, {r,0,ρ}] + Integrate[intfuncinang,{r, ρ, Infinity}]       ]//Simplify          dataimport = Import["inputfile.dat", "Table"];     datatoint = dataimport[[1 ;;, 1]]          Print[Length[datatoint]]     int = Array[#&, Length[datatoint]];     Do[ρ = datatoint[[i]];        int[[i]] = N[funcins];        points = {datatoint[[i]], int[[i]]};        points >>> "outputfile.dat"        , {i, Length[datatoint]}]      I run this on the console with `math -nopromt -run "<<script.m"`. This works always for some values, but crashes after some time. I am using _Mathematica_ 8. Does anyone have an idea why I am getting crashes?


Handling a sequence of unevaluated arguments

I have the following piece of code:               SetAttributes[createPlayers, HoldAll];     createPlayers[names__] :=       (Clear[player];        players =          Table[numOfPlayers = i;           player[i] = {names}[[i]], {i, Length[{names}]}]);          createPlayers["Aron", "Geoff", "Steve"];          gameStats[stats__] :=       Grid[{         Table[SymbolName[Unevaluated[{stats}]][[i]], {i, Length@{stats}}],         Table[{stats}[[i]], {i, Length@{stats}}]         }, Frame -> All];          gameStats[numOfPlayers, player[1], player[2], player[3]] // Dynamic      This does three tasks:   1. A function to create as many players as required. These players' names can then be viewed with `player[i]`. The total number of players is also stored in the variable `numOfPlayers`.   2. It creates three players by the names Aron, Geoff and Steve respectively.    3. `gameStats` creates a grid displaying useful stats about the game.  Functions 1 and 2 work fine. I can't get function 3 to work though. What I am trying to get at is to display a grid with the symbol names in the top row, and their values in the bottom row - like so: ![enter image description here](http://i.stack.imgur.com/0vOR2.png) Instead the best I can do is this: ![enter image description here](http://i.stack.imgur.com/7Xn5G.png) Either the top row displays the variables' values - which means that both top and bottom rows are the same - or it displays this error message. How can I get the top row to display the variables' symbol names properly?


Tooltips and points don't show when only 2 points in ListPlot?

Problem with `ListPlot` when each point has a `Tooltip` and there are exactly two points(or for a multi-plot `Listplot[{list1, list2...}]` with individual `Tooltip`s per point and each plot having exactly two points). The points don't appear on the plot (or the associated tooltips) in the **3rd and 4th** case below. 1 point is ok, also 3 points or more is ok. I thought it might be to do with two points maybe being just outside the plot region, but extending `PlotRangePadding` and `PlotRange` didn't reveal the points. Any ideas for a workaround? I've submitted this to support in case it is a bug.               ListPlot[{{{1, 1}, {2, 2}}, {{1, 1}, {2, 2}}}]     ListPlot[{{Tooltip[{1, 1}, "1"], Tooltip[{2, 2}, "2"]}, {Tooltip[{1, 1}, "1b"]}}]     ListPlot[{{Tooltip[{1, 1}, "1"], Tooltip[{2, 2}, "2"]},               {Tooltip[{1.1, 1}, "1b"], Tooltip[{2.1, 2}, "2b"]}}]     ListPlot[{{Tooltip[{1, 1}, "1"], Tooltip[{2, 2}, "2"]}}]     ListPlot[{{Tooltip[{1, 1}, "1"], Tooltip[{2, 2}, "2"], Tooltip[{3, 3}, "3"]}}]     ListPlot[{{Tooltip[{1, 1}, "1"]}}]      ![Mathematica graphics](http://i.stack.imgur.com/SWtPs.png)


How can I sort the polynomial by the degree of $x$

f1 = a x^2 + b x + c + x^3      > (* a x^2+b x+c+x^3 *)               f1 /. x -> (x - a/3) // Expand      > (* (2 a^3)/27-(a^2 x)/3-(a b)/3+b x+c+x^3 *) I've tried this:               f1 /. x -> (x - a/3) // Expand // Collect[#, x] &      > (* (2 a^3)/27+x (b-a^2/3)-(a b)/3+c+x^3 *)               f1 /. x -> (x - a/3) // Expand // Collect[#, x] & // PolynomialForm      > (* (2 a^3)/27-(b a)/3+x^3+c+(b-a^2/3) x *)


Unwanted hold in recursive function

I have a function (let it be called f) that does something useful for me and I want to be able to apply it to the elements of a list regardless of their depth and keep the list structure. For example I want to write               F[{{a,b},{c}}]      and get               {{f(a),f(b)},{f(c)}}      So my idea was to use Thread to move down one level of the list each time. So I wrote               F[mat_] := If[mat[[0]] === List, Thread[F[mat]], f[mat]]      But the result I get               If[Hold[Evaluate[{{a, b}, {c}}[[0]] === List]],          Thread[F[{{a, b}, {c}}]], f[{{a, b}, {c}}]]      after of course the recursion depth was reached. So I actually have 2 question. Is there any way to do that with a built-in mathematica function. How can I avoid getting this hold? Evaluate doesn't work. EDIT: As pointed by Rojo my problem is solved by adding Listable to the attributes of f. However I would like to know why my code does not work. How can I get rid of the hold?


RandomVariate[LogNormalDistribution] works not as expected

I currently simulate data with a lognormal distributed covariate. I used the following code to check the generated random numbers (with Mathematica 9).               slogn2 = Select[RandomVariate[LogNormalDistribution[6, 9], 10000000], # < 10 &];      Show[          Histogram[slogn2, 200, "ProbabilityDensity"],          Plot[PDF[LogNormalDistribution[6, 9], x], {x, 0.0001, 10},                PlotRange -> All, PlotStyle -> Thick],           PlotRange -> {{0, 10}, Automatic}      ![\] ](http://i.stack.imgur.com/AI6t9.jpg) I found an unexpected deviation from the PDF. The histogram data are well above the density (see image). Does this indicate an error in the random number generation or how can this be explained?


Analyzing Betting (Keno) in Mathematica

Keno is a popular lottery game that is available with all of the larger casino softwares. The player is given a ticket with 70 numbers on it. He picks 1 to 11 numbers on the ticket. 20 winning numbers are selected randomly. The more of the player's picks that are selected, the bigger the payout. In Sweden, my home country, _Svenska Spel_ (a state owned company) offers the following \begin{array}{c|c|c|} \text{Number of Correct Guesses}&\text{Return} &\text{Average Chance of Winning} \\ \hline 11 & 5000000 &\text{See below} \\ \hline 10 &125000 & \\ \hline9 & 3000 & \\ \hline8 & 300 & \\ \hline 7 & 30 & \\ \hline 6 & 10 & \\ \hline 5 & 5 & \\ \hline 4 & 0 & \\ \hline 3 & 0 & \\ \hline 2 &0 & \\ \hline 1 & 0 & \\ \hline 0 & 0 & \text{1 to 6.2} \end{array} > What I would like to do is to calculate the probability to obtain > $0,1,2,\dots, 11$ right guesses on Keno 11 and compare it to _Svenska spel_. > In addition, I would like to plot this result using histograms. **My Take** What I have done is to define the hypergeometric probability distribution function as:                   Urn[good_, bad_, draws_, need_] := ({{good},{need}}) ({{bad},{draws - need}})/     ({{good + bad},{draws}})      I have then used this to calculate the KenoOdds using the following code:                KenoOdds =       Table[MatrixForm[        Table[{g, k, Round[1/N[Urn[g, 70, 20, k]]] - 1}, {k, 0, g}]], {g,         4, 11}]      The problem is that the first code does not work; all I receive is this message "An unknown box name (Hold) was sent as the BoxForm for the expression. Check the format rules for the expression." H


Drawing an arrow head on a curve

I am trying to create an illustration for a paper and export it to PDF. Here is the code               textsize = 16;     Framed[Show[       ContourPlot[y^2 - Cos[x], {x, -3 Pi, 3 Pi}, {y, -2.5, 2.5},        ContourShading -> None, ContourStyle -> Thickness[0.002],      PlotPoints -> 100, Frame -> None, Contours -> Range[-1, 7, 0.5],      AspectRatio -> 4/(3 Pi), PlotRangePadding -> 0],          ContourPlot[y^2 - Cos[x] == 1, {x, -3 Pi, 3 Pi}, {y, -2.5, 2.5},      ContourShading -> None, ContourStyle -> Thickness[0.004],      PlotPoints -> 200, Frame -> None, AspectRatio -> 4/(3 Pi),      PlotRangePadding -> 0],          Graphics[{Black, Arrowheads[0.025], PointSize[0.0001],      Thickness[0.0001],      Arrow[#] & /@ {{{0.0, Sqrt[2]}, {0.35,          Sqrt[2]}}, {{-0.1, -Sqrt[2]}, {-0.35, -Sqrt[2]}}, {{2 Pi +           0.1, Sqrt[2]}, {2 Pi + 0.35,          Sqrt[2]}}, {{2 Pi - 0.1, -Sqrt[2]}, {2 Pi -           0.35, -Sqrt[2]}}, {{-2 Pi + 0.1, Sqrt[2]}, {-2 Pi + 0.35,          Sqrt[2]}}, {{-2 Pi - 0.1, -Sqrt[2]}, {-2 Pi -           0.35, -Sqrt[2]}}},       Arrowheads[0.015],        Arrow[#] & /@  {{{0, 1}, {0.2,          1}}, {{-0, -1}, {-0.2, -1}}, {{2 Pi + 0.1, 1}, {2 Pi + 0.2,          1}}, {{2 Pi - 0.1, -1}, {2 Pi - 0.2, -1}}, {{-2 Pi + 0.1,          1}, {-2 Pi + 0.2, 1}}, {{-2 Pi - 0.1, -1}, {-2 Pi - 0.2, -1}}},      Arrow[#] & /@  {{{0.1, 1.87}, {0.2,          1.87}}, {{-0.1, -1.87}, {-0.2, -1.87}}, {{2 Pi + 0.1,          1.87}, {2 Pi + 0.2,          1.87}}, {{2 Pi - 0.1, -1.87}, {2 Pi - 0.2, -1.87}}, {{-2 Pi +           0.1, 1.87}, {-2 Pi + 0.2,          1.87}}, {{-2 Pi - 0.1, -1.87}, {-2 Pi - 0.2, -1.87}}}    }],     Graphics[     Point[#] & /@ {{0, 0}, {Pi, 0}, {-Pi, 0}, {2 Pi, 0}, {-2 Pi, 0}}],      Graphics[{Text[Style[0, textsize], {0, -0.4}],      Text[Style[\[Pi], textsize], {Pi, -0.4}],      Text[Style[-\[Pi], textsize], {-Pi, -0.4}],      Text[Style[2 \[Pi], textsize], {2 Pi, -0.4}],      Text[Style[-2 \[Pi], textsize], {-2 Pi, -0.4}]}],      ImageSize -> 500]]      Then I use `Export[...,%]` on the result to create the PDF. Here is a part of it: ![enter image description here](http://i.stack.imgur.com/57t9c.png) So, what's up with the little dots at the tips of the arrows? They are not visible in Mathematica and their size does not decrease if I decrease `Arrowheads`. They only solution I have found so far is take `Imagesize->1000` and then downscale the image in latex, which is not ideal because I need to control the line width across all images. * * * In short the problem can be reduced to:               Graphics[{Arrowheads@0.015, Arrow[{{-2 Pi - 0.1, -1}, {-2 Pi - 0.2, -1}}]},        AspectRatio -> 4/(3 Pi), PlotRangePadding -> 0,        PlotRange -> {{-3 Pi, 3 Pi}, {-2.5, 2.5}}]      ![enter image description here](http://i.stack.imgur.com/lwoQj.png)


Convert frequency counts to long notation in Mathematica

I have a series of frequencies of values, e.g. 5 times 1, 10 times 2 and 5 times 3, as in               list={{1,5},{2,10},{3,5}}      and I would like to convert this to long notation as in               list2={1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,3,3,3,3,3}      what is the most elegant way to do this in Mathematica?


Quickly plotting (number of events) vs. (time) for a very large number of events encoded as pairs of real numbers representing start and end times

I have an array that looks like the following:               exampleArray = {{t1,r1},{t2,r2},{t3,r3},{t4,r4},{t5,r5},...};      Where each pair of real numbers $(t_k,r_k)$ represents some "event" (independent of all other events) starting at time $t_k$ and ending at time $r_k$. Provided some time $t_i$ and `exampleArray`, I'd like to quickly return the number of "events" at this time. I'd also like to quickly plot the number of events versus time over some interval. The catch is that `exampleArray` might have a very large number of elements, so we wouldn't want to scan through it multiple times. Is there an elegant way to do this in Mathematica?


Why does MemoryConstrained have an upper limit on the constraint?

When evaluating MemoryConstrained for a large memory limit:               MemoryConstrained[Print["aaa"],10^10]      I get:               MemoryConstrained::ipnfm: Positive machine-sized integer or Infinity expected at position 2 in MemoryConstrained[Print[aaa],10^10]. >>      I have tested to find the limit, and is exactly 4294967295 bytes. Is there a reason for this? I need a larger memory limit. I am using Mathematica 9.0.1 and 32-bit Windows 7.


How to mark visible points on a Plot3D?

I'd like to illustrate a two-variable function discontinuous at zero. The function is $f(x,y)=xy/(x^2+y^2)$ unless $x=y=0$, in which case $f(0,0)=0$. I thought that I could draw a plot and then mark two sequences of points $(x_n,y_n)$ and, say, $(x^\prime_n,y^\prime_n)$ converging to $(0,0)$ such that $f(x_n,y_n)$ and $f(x^\prime_n,y^\prime_n)$ converge to different limits. I did something like this:               f[x_, y_] := If[x == y == 0, 0, x*y/(x^2 + y^2)]     p := Plot3D[f[x, y], {x, -1, 1}, {y, -1, 1}]     Show[p, ListPointPlot3D[       Thread[{Table[1/n, {n, 5}], Table[1/n, {n, 5}],          Table[f[1/n, 1/n], {n, 5}]}]]]      but the dots are barely visible; I'd like to have them bigger and/or blacker. How to achieve this?


help with dynamic input

I'm trying to build a pop up window with i lines. Each line would read: Number of neurons in layer 1:   Number of neurons in layer 2:   etc until layer i The user would enter a numeric value on each line. That value would be recorded as `d[1],d[2],...,d[i]`. The solution I've come up with results in Mathematica assigning the input from any line to d[i] (for example if there are 5 lines, it assign inputs from line 1, 2..5 all to `d[5]`). I understand why it's happening. I just can't think of how I'm suppose to achieve what I want. Here's my code:               a = Table[       List[StringJoin[{"Number of neurons in layer ", ToString[i], ":"}],         InputField[Dynamic[d[i]], Number]], {i, 3}];      AppendTo[a, {CancelButton[], DefaultButton[DialogReturn[]]}];     CreateDialog[Grid[a, Spacings -> {1, Automatic}, Alignment -> Left], Modal -> True];      Any suggestions? Thanks.


Integrating a functional of an InterpolatingFunction

It is straightforward to `Integrate` an `InterpolatingFunction`. However, even for a simple functional of an `InterpolatingFunction`, `Integrate` returns unevaluated.               ifun1 =       First[         u /.            NDSolve[             {u''[t] + u[t] == 0, u[0] == 0, u'[0] == 1},             u,             {t, 0, π}           ]       ]          Integrate[ifun1[t], {t, 0, π}]     Integrate[2*ifun1[t], {t, 0, π}]      The former `Integrate` returns a `Real`, the latter, the expression unevaluated. How can the second integral be evaluated symbolically? (In my non-MWE, _symbolically_ is important because the solution to my PDE has two arguments, over only one of which I would like to integrate, so `NIntegrate` will not work.) The solution should apply to more-complicated functionals, too (e.g. `2*t*ifun1[t]`). If a solution applies only to functionals that are restricted to a certain family, such as "linear," it would still be helpful.


How to collect q[t] from the following integration

As shown in the following program, the `q[t]` in `a` can be collected from the integration by defining the integration of `fe1[x]` as `Infe1[x]`, the same is true for `fe2[x]` in `b`. But for the equation `c`, how can I collect `q[t]` from it?               fe1 /: Integrate[fe1[x_], x_] := Infe1[x];     fe2 /: Integrate[fe2[x_], x_] := Infe2[x];          a = Integrate[fe1[x]*q[t], {x, 0, L1}]          b = Integrate[fe2[x]*q[t], {x, 0, L1}]             c = Integrate[fe1[x]*fe2[x]*q[t], {x, 0, L1}]


Operations on a List of Vectors (Norm)

I have a List containing vectors. The coordinates are random numbers:               r = {RandomReal[{-1, 1}, n], RandomReal[{-1, 1}, n], RandomReal[{-1, 1}, n]};      Now I want to calculate the Norm of each Vector (into another List). Is this possible without a loop? Something like               Norm[r,2]      Where 2 is the dimension (columns) in which the norm should be calculated.


Why is my ContourPlot cutting off at certain values?

I have               h[phi_, delta_] := ArcCos[-Tan[phi Degree] Tan[delta Degree]]     insolation[phi_, delta_, S_: 1368] := (S/Pi) (Cos[delta Degree] Cos[phi Degree] Sin[h] + h Sin[delta Degree] Sin[phi Degree]) /. h -> h[phi, delta]     ContourPlot[insolation[phi, 23.5 Cos[t]], {t, -Pi, Pi}, {phi, -90, 90},         PlotLegends -> Automatic, ContourLabels -> False, Contours -> 20,          ColorFunction -> "TemperatureMap"]      But the resulting figure has areas that are "missing": ![](http://i.stack.imgur.com/2THqS.png) What am I doing wrong? How do I get the expected vertical contours extending from the truncated edges to the near horizontal axis in the upper center and bottom right and left corners? How to I "fill in" the regions in the upper right and left corners that are 0? * * * A similar figure for comparison: ![](http://i.stack.imgur.com/8TKIm.png)


Indexed replacement

Is there some equivalence of MapIndexed for rules? Consider a substitution on               3 a + 4 b + 21 c + ....      The first integer I want to replace by 1, the second integer by 4, and the i'th integer by i^2.               1 a + 4 b + 9 c  + ....      How would you do that? I imagine some kind of indexed replacement would be useful. Addition:I would like to use it to replace expressions like `f[a]@f[b]@f[c]@...@f[X]` with `f[1]@f[2]@f[3]@...@f[n]`


Add arrows over matrix

# How can I plot this graph * * *               g1 = Table[x[i, j], {i, 5}, {j, 5}] // Grid;          Rasterize@g1      > ![Mathematica graphics](http://i.stack.imgur.com/gHWby.png) I added these arrows by `Ctrl+D`'s graphics tool. This way maybe hard to adjust the positions of x and arrows to a precise consistent level, also we need make arrows parallel.. One way is define the coordinates of x and then use `Graphics` to add `Text` and `Arrow.`. Any other good methods/choices? I think this could be one general job, because sometimes we may add other objects/marks over matrix. This is the diagonal of Fibonacci Numbers over Pascal Triangle ![enter image description here](http://i.stack.imgur.com/UqTAN.png) ![enter image description here](http://i.stack.imgur.com/2rlHm.png) ![enter image description here](http://i.stack.imgur.com/VNj7v.png)


Light syntax parser for Mathematica?

My netbook is too slow to install Mathematica. I'm not set against working in a text editor, but I like having an automated highlighting/formatting environment; can anyone recommend a good gedit plugin or suggest an alternative solution? To clarify: Unless there's something amazing online that can act as a virtual back-end using my login info, I can't use a front-end.


Finding if a matrix is square

I have a matrix which is constructed element by element through some iterations, and thus can be non-square. If it's not square, then I want to make it square filling with `0`. **Is there a function to determine if a matrix is square?** I was thinking of something like this:               (* If determinant of matrix is possible, then fill with 0s, else do nothing. *)     If[Det[matrix]=Indeterminate,Fillwithzeros[matrix]]      I'm pretty sure `Det[matrix] = Indeterminate` is not a correct way to express my thoughts, so maybe you could help me out with my syntax or even suggest a better way to do it :D Thanks!


Mathematica crashes X in Ubuntu

I'm using Ubuntu 13.10 and every time I try to start Mathematica, my Ubuntu session just crashes and I get thrown to the login screen. This also happens if I try to run Mathematica from another computer through SSH and on both Mathematica 8.0 and 9.0. This behaviour started after the last time I did the normal software update for my system. How can I try to solve this problem? I find nothing in the ~/.xsession-errors errorlog for X.


How to overload System`StringJoin to automatically use ToString on arguments?

I am using an overloaded version of the `StringJoin` function since years now, without any problem, as I've invested a lot of time and effort earlier to make its behaviour consistent and predictable (see discussion here). I am fully aware that modifying built-in symbols is not a good idea. The new `StringJoin` automatically converts any non-string input to `String` thus I don't have to type `ToString` every time. It still threads over lists, i.e. `StringJoin[{"1", "2", "3"}]` returns `"123"`. Also `StringJoin[{1, 2, 3}]` returns the same, but `StringJoin[{1, 2, 3}, "s"]` gives `"{1, 2, 3}s"`. The code is:               toString[expr_String] := expr;     toString[expr_] := ToString@expr;     Unprotect[System`StringJoin];     Attributes[System`StringJoin] = {};     System`StringJoin[expr___] := StringJoin@{expr};     System`StringJoin[expr_List] :=        Fold[StringInsert[#1, toString@#2, -1] &, "", expr];     Protect[System`StringJoin];      For me, it works as expected, and I am really happy to use it as it saves me a lot of typing. Though there is one minor annoyance I cannot track down. Consider the following example:               Append[test, 1];      ![Mathematica graphics](http://i.stack.imgur.com/MjEPz.png) Note, that the message is printed with `List`-s wrapping each argument of the printed `StringForm` (that is: `1` and `Append[test, 1]`). Interestingly, `StringForm` on its own works as expected:               StringForm["Test variable insertion: `1`, `2`.", 111, 222]      ![Mathematica graphics](http://i.stack.imgur.com/j6WDp.png) **Question** : Can anyone explain why `Message` fails to print its result correctly? **Caveat:** Modifying `System`` symbols could have many unexpected side-effects. It happens for this modified `StringJoin` too (apart from the above example): as `Import` uses `StringJoin`, the modification causes a massive performance drop when importing e.g. images. For details, see this post.


Custom Errorbar-Function

I wanted to have a better control on the ErrorListPlot, so I defined a custom ErrorBarFunction:               ebar[ebarrad_, ebarthickness_, ptsize_] :=       Function[{coords, errs}, {Thickness -> ebarthickness,        Line[{coords + {-ebarrad, errs[[2, 1]]}, coords + {ebarrad, errs[[2, 1]]}}],         Line[{coords + {-ebarrad, errs[[2, 2]]}, coords + {ebarrad, errs[[2, 2]]}}],         Line[{coords + {0, errs[[2, 1]]}, coords + {0, errs[[2, 2]]}}],         Line[{coords + {errs[[1, 1]], -ebarrad}, coords + {errs[[1, 1]], ebarrad}}],         Line[{coords + {errs[[1, 2]], -ebarrad}, coords + {errs[[1, 2]], ebarrad}}],         Line[{coords + {errs[[1, 1]], 0}, coords + {errs[[1, 2]], 0}}],         PointSize -> ptsize, Point[{coords}]}]      The problem is, that the length (ebarrad) of the errorbarticks can only be set relative to the figureaxes. Is there a way to define those lengths in absolute points?


Visualizing Rubik's Graph

After the August 2010 discovery that the diameter of the Rubik graph is 20, I wanted to make a way to visualize Rubik's graph. Since there are about $4.3 \times 10^{19}$ vertices in this graph, it is not feasible to store the whole thing. However, it is a Cayley graph of a group with 6 generators, it is 6-regular, and given any vertex $v$ in the graph, it's neighborhood $N(v)$ can be generated. Using Roman Maeder's Wolfram Demonstrations Project as a basis, I tried to make a way to visualize this graph, one neighborhood at a time. Starting with the GraphicsComplex `solved`, and the operation `twist`, which is simple enough to operate: ![Rubik's cube, solved state transformed to one front- twist](http://i.stack.imgur.com/jz9mX.png) I want to construct a graph that displays the neighborhood, namely, those configurations of the Rubik's cube that can be reached by a R,L,F,B,U or D operation. The edge corresponding to the operation above should look like this: ![Rubik's cube, first twist](http://i.stack.imgur.com/empmp.png) I would like to do three things:   * Given a configuration $v$, I would like to display $N(v)$, with the edges looking like the graphic above   * Make it interactive, so that when I click on one of the configurations, it's neighborhood is output   * Display the cubes as 3D objects, so that they can be rotated The 3D part would be nice, but it's not necessary. How would I go about doing this?


What's the purpose of the Unique function?

As the title says: What's the purpose of `Unique`?   * I understand that it generates some unique symbol, but when and for what is it to be used? Are there applications in practical solutions, or is it for the backend of programs (I noticed that `Block` etc use variable names similar to what `Unique` creates)?   * How do I use a variable generated by `Unique`? Do I store its name in another variable and then use that as a pointer of some sort by converting its content (e.g. `$123`) to an expression somehow?


How to group lists that own one common element?

I have produced a list of sub-lists by the following:               pairs = Select[        Sort[{2 #1*#2 + #2^2, #1^2 - #2^2} & @@@           Flatten[Tuples /@             DeleteCases[{{#},                 Table[If[GCD[#, i] == 1 && Mod[# - i, 3] != 0, i,                   0], {i, # - 1}]} & /@ Range[100], 0, Infinity], 1]],         Plus @@ # < 120000 &];      In this list, every sub-list only has two elements. Now what I want to do is to group the lists in `pairs` that share one common element. For example, if `pairs={{1,2},{3,4},{2,5},{2,6},{5,4},{9,7}}`, I want to get the result like this:               {{{1,2},{2,5},{2,6}},{{2,5},{5,4}},{{3,4},{5,4}},{{9,7}}}      That is, find all the lists that have a common element, and group them. Some sub-lists may be grouped twice like `{2,5},{5,4}`, while some are alone like `{9,7}`. I know this can be achieved easily by using the loop `For`and `While`, but I want to get a better and neater code to do this. I've tried `GatherBy[list,f]`, but I don't know how to write the function `f`. I'd appreciate it if any one could provide some ways.


Single dot textual form

How do I render a letter with a single dot above it? I see `\\[DoubleDot]` and `\\[TripleDot]` are readily available, but what about a single dot? Specifically I am after Q dot, which is used in thermodynamics. If it helps, here is some background on Unicode and Q dot.


How to find range in which a number falls, from given list of numbers?

How can one find the range in which a number falls, from given list of numbers?               f[x_, list_List] := ???     (*     Return {a,b} where     a & b belongs to list     {a,b} forms shortest possible interval which match condition     if a<=x<=b {a,b}     if x <= a {-∞,a}     if x >= b {b,∞}     *)      `f` Should also consider outer ranges $-\infty$ and $\infty $


How to generate Intervals from a given list?

If I have a list               list={3,7,4,5,1}      how to get the List of Intervals /Ranges               result = {{1,3},{3,4},{4,5},{5,7}}


Finding Minimum of a list after interpolation

I have a set of lists called Er[l], where l is from 1 to 13. I want to find the minimum point in the plot in these lists after interpolation by spline method. I need the values and the points on the plot.                   Er[1]={{6., -0.052309}, {5.9, -0.0585607}, {5.8, -0.0655975}, {5.7, \     -0.0734887}, {5.6, -0.0822908}, {5.5, -0.0920279}, {5.4, -0.102672}, \     {5.3, -0.114093}, {5.2, -0.126007}, {5.1, -0.137885}, {5., \     -0.148821}, {4.9, -0.157357}, {4.8, -0.161233}, {4.7, -0.157053}, \     {4.6, -0.139813}, {4.5, -0.102251}, {4.4, -0.0339586}, {4.3,        0.0798611}, {4.2, 0.260101}, {4.1, 0.536103}, {4., 0.948895}, {3.9,        1.55563}, {3.8, 2.43571}, {3.7, 3.69923}, {3.6, 5.49906}, {3.5,        8.04835}, {3.4, 11.6474}, {3.3, 16.7263}, {3.2, 23.9162}, {3.1,        34.1743}, {3., 49.0186}, {2.9, 70.9924}, {2.8, 104.639}, {2.7,        158.686}}      this was an example of data inside the lists Er[radius,energy]                  ListLinePlot[{Er[1], Er[2], Er[3], Er[4], Er[5], Er[6], Er[7], Er[8],             Er[9], Er[10], Er[11], Er[12], Er[13]},            PlotStyle -> {Black, Red, Blue, Green, Pink, Yellow, Brown, Orange,              Magenta, Gray, Cyan, Purple, Darker[Blue]},            PlotRange -> {{3, 6}, prange},            AxesLabel -> {"r (Å)", "E (kcal/mol)"}, InterpolationOrder -> 3,            Method -> "Spline"];      Thanks in advance


NMaximize, restart

I have to optimize some contrained functions and I am trying to use `NMaximize`. I have the following problem (see code below). I use `NMaximize` for the first function `f1` (constraints `c1` and variables with start intervals `vs1`) and get what I want to get. After that I use `NMaximize` for the function `f2` (with `c2` and `vs2`). After this second numerical optimization I run again the very same optimization for `f1` again and get a different result although I have not changed the start intervals. Could you please explain this? The only way I have found to solve this, is to restart everything with `Quit` but maybe you know an easier way to restart only the command `NMaximize`. I have also tried to set the `Method` for all optimizations but it does not make any difference, the results still vary.               f1 = 1445250/(13229 - 4223 Sqrt[30] (v1 + v2));     c1 = Sqrt[30] + 30 v1 >= 0 && Sqrt[30] + 30 v2 >= 0 &&         Sqrt[30] + 30 v3 >= 0 &&         2 + 45 v2 v3 + 45 v1 (v2 + v3) >= 2 Sqrt[30] (v1 + v2 + v3) &&         v1 + v2 + v3 <= Sqrt[(2/15)];     vs1 = {{v1, 0, 0.01}, {v2, 0, 0.01}, {v3, 0, 0.01}};          f2 = 1445250/(13229 - 8446 Sqrt[30] v1);     c2 = 45 v1 <= Sqrt[30] && Sqrt[30] + 30 v1 >= 0;     vs2 = {{v1, 0, 0.01}};          NMaximize[{f1, c1}, vs1]     NMaximize[{f2, c2}, vs2]     NMaximize[{f1, c1}, vs1]          Out[8]= {190.206, {v1 -> 0.121716, v2 -> 0.121716, v3 -> -0.0111781}}     Out[9]= {190.206, {v1 -> 0.121716}}     During evaluation of In[1]:= NMaximize::cvmit: Failed to converge      to the requested accuracy or precision within 100 iterations. >>     Out[10]= {190.253, {v1 -> 0.121759, v2 -> 0.121754, v3 -> -0.0111782}}


Integration gives ComplexInfinity when it shouldn't

A simple example of my problem is that               Assuming[k ∈ Reals, Integrate[Exp[l]/((1 + Exp[l])*Exp[k*l]), l]] /. {k -> 2}      gives `ComplexInfinity` while               Integrate[Exp[l]/((1 + Exp[l])*Exp[2*l]), l]      gives the correct answer. I would like to get the correct answer in the first case as well. Any suggestions? I'm using _Mathematica_ 6 on a Windows XP PC. ## Failed attempts to bypass the problem   1. Defining Riemann integration as a separate function using `Sum` and `Limit`   2. Using `Assumptions` in preamble, putting `Assuming[]` around `Integrate`, using `Integrate[f,x,Assumptions->{x,params}\in Reals]`   3. Using `FunctionInterpolation` on the function to be integrated before applying the (definite) integral   4. Expanding the function to be integrated with `Series` before integrating Have to hand it to Mathematica, at least it is consistent.


Coloring edges of a graph according to their weight?

What's the simplest way to plot a graph with weighted edges, such that the color of the edge corresponds to the weight of the edge?


More efficient implementation for comparing coefficient lists in a Do-loop

I'm wondering how to speed up the following code so it actually computes for $n=2$:               f[n_] := Expand[Sum[FunctionExpand[QBinomial[n, j, q]]*q^(j^2), {j, 0, n}]]          lhs[n_] := Sum[(-1)^j*q^(j(5j + 1)/2), {j, -n, n}]          rhs3[a_, b_, c_, d_, e_, g_, h_] :=        Expand[q^a - f[1]*q^b*Product[1 - q^i, {i, c, d}] + f[2]*q^e*Product[1 - q^i, {i, g, h}]]          B[n_] :=        Do[         If[CoefficientList[lhs[n], q] == CoefficientList[rhs3[a_, b_, c_, d_, e_, g_, h_], q],            Print[{a,b,c,d,e,g,h}]],          {a, 0, 15}, {b, 0, 15}, {c, 1, 5}, {d, 1, 5}, {e, 0,15}, {g, 1, 5}, {h, 1, 5}]      A Do loop with this many iterators may be too much computing, but there must be some built-in constructs which allow for an effective implementation. Sample input would be `B[2]`. Sample output would be `{11,1,1,1,1,2,3}` (which is actually one possible solution. However, the point is to print all possible solutions, so the actual output would be a number of such lists.) Edit: I want to emphasize that I would like to see an approach that will work for **more complicated functions for rhs3[a_, ...] that involve a few more iterator variables.** To be specific, I would like to execute the comparison at least somewhat quickly for the following RHS with $n=3$ (and I'll label it as rhs3):               rhs3[a_, b_, c_, d_, e_, g_, h_, j_, k_, l_, x_, r_, y_] :=        Expand[-f[3*x + y]*q^a + f[3*x + r + y]*q^b*Product[1 - q^i, {i, c, d}]          - f[3*x + 2*r + y]*q^e*Product[1 - q^i, {i, g, h}]]            + f[3*x + 3*r + y]*q^j*Product[1 - q^i, {i, k, l}]]      with the following variable ranges: `{a, 0, 30}, {b, 0, 25}, {c, 1, 7}, {d, c, 7}, {e, 0, 20}, {g, 1, 7}, {h, g, 7}, {j, 0, 15}, {k, 1, 7}, {l, k, 7}, {x, 0, 5}, {r, -5, 5}, {y, -5, 5}`. This is of course asking for a lot, but I want to state the nature of the problem in full generality for future visitors.


How does Mathematica understand branchcuts of the complex logarithm?

Say I have the function $f(x) = x \tanh(\pi x) \log (x^2 +a^2)$ where $a$ is some positive real number. Then it seems to be me that _Mathematica_ when given such a `Log[]` function implicitly puts a branch-cut along the positive imaginary axis starting at $x = ia$.   * Now if I ask _Mathematica_ to integrate $f(x)$ along some semicircle in the upper half plane parametized as say, $x = A e^{i\phi}$ ($A>a$) for $0 \leq \phi \leq \pi$, then is _Mathematica_ 's answer trustworthy?  Like did a large $A$ expansion (Series about $A=\infty$) and found that $xf(x)$ (that would practically be the integrand when converted into a $\phi$ integral), this function asymptotes as, $e^{2i\phi} \log(e^{2i\phi})A^2 + 2A^2 \log(A) + a^2$ (+ terms which go to zero as $A$ goes to infinity). Now on this asymptotic form the $\phi$ is integrable from $0$ to $\pi$ giving a finite answer. So relying on this _Mathematica_ result can I say that this integral therefore diverges in the large $A$ limit as $ \text{(number)} A^2 + \text{(number)} A^2 \log(A)$ ? * * * Like for example I chose $a=2$ and it seems to me that on using "NIntegrate" Mathematica says that the integral of this function on a circle centered at $2i$ goes to zero as the radius goes to 0. Is this correct? Thinking analytically this seems to be right...


Generating "Penrose-style" drawings of surfaces

In The Road to Reality there are plots of surfaces that use a variable density of dots to suggest curvature. You can see some examples here and here. ![](http://i.stack.imgur.com/1LDCz.jpg) ![](http://i.stack.imgur.com/QI0z4.jpg) I suppose they've been drawn by Penrose, but to me they look like something that could be quite easily generated algorithmically---say, starting from image of a surface of 3D object with lighting. Some of my initial attempts at this below. First, for a sphere:               ImageAdd[#, ColorNegate@ImageEffect[#, {"SaltPepperNoise", 0.5}]] & [       Graphics3D[{GrayLevel[.25],           Specularity[White, 1], Sphere[]},           Lighting -> "Neutral",           Boxed -> False]       // Rasterize]      ![output of the above code](http://i.stack.imgur.com/bAacN.png) And for a more complex object:               Binarize@ImageAdd[#, ColorNegate@ImageEffect[#, {"SaltPepperNoise", 0.78}]] & [       Graphics3D[         {GrayLevel[.25], Specularity[White, 1], KnotData[{6, 2}, "ImageData"]},         Lighting -> "Neutral",          Boxed -> False]]      ![output of the above code](http://i.stack.imgur.com/QWUSu.png) I'm decidedly inexperienced at using all of _Mathematica_ 's image processing functions, especially compared to others on this site! I've been reading the many answers to this related question to get ideas. **So I have two questions.** Firstly, can some of you do better than I at generating these diagrams (I'm sure many can!), or perhaps point me in a fruitful direction? Second, suppose I have a series of frames of surfaces that together make a smooth animation. As soon as I "Penrose-ify" them, I expect that the placements of the points in the frames will sort of "quiver" from frame to frame (if there is a random component in how they are placed), thereby breaking the continuity of the animation. How can one get around this? I ask this question in hesitation after reading this on meta. I hope it will not be judged too similar to other questions or uninteresting. Personally I can see many semi-practical applications of automated ways to generate diagrams like these, e.g. for illustration purposes. Many thanks in advance.


Assign named placeholder to a variable (as a string)

If I want to assign a regular placeholder as a string, it's very easy: (anything the user types in will automatically be given quotes around it, so when they evaluate the cell str is a string)                str = "\[Placeholder]"      I just can't get quotes around a named placeholder (not while assigning to a variable, at least):                str2 = {"\"", Placeholder[ProjectName], "\""}      Any help would be appreciated, thanks in advance!


Compiling Error functions of complex values

According to List of compilable functions `Erf` and `Erfc` are compilable functions. However, I want to make a compiled version of the `PDF` of a `VoightDistribution` to use in a `NonlinearModelFit` and it doesn't seem that the `Erfc` of a complex value will compile.               funcReal =       Compile[{{x, _Real}}, Erfc[x I], CompilationTarget -> "C",        RuntimeOptions -> "Speed"]     funcComplex =       Compile[{{x, _Complex}}, Erfc[x I], CompilationTarget -> "C",        RuntimeOptions -> "Speed"]          Needs["CompiledFunctionTools`"];     CompilePrint[funcReal] (*same as funcComplex*)              1 argument         2 Real registers         4 Complex registers         Underflow checking off         Overflow checking off         Integer overflow checking off         RuntimeAttributes -> {}              R0 = A1         C0 = 0. + 1. I         R1 = 0.         Result = C3          1   C1 = R0 + R1 I     2   C1 = C1 * C0     3   C2 = R0 + R1 I     4   C2 = C2 * C0     5   C3 = MainEvaluate[ Hold[Erfc][ C2]]     6   Return      Note the call to `MainEvalulate`               Erfc[I] // N     funcReal[1]     funcComplex[1]          1. - 1.65043 I          1. - 1.65043 I          1. - 1.65043 I      All the functions work but because of the `MainEvalulate` they offer no performance benefit. How can I compile this function? Is this possible? Is there an alternative formula I could use? Removing the `CompilationTarget` doesn't solve the problem either.


Cannot step into code in Wolfram Workbench

I have written a set of functions in a .m file in Mathematica 9.0 using Workbench 2.0. When I right-click the .nb and click Debug as Mathematica, The .m file loads and successfully initializes. Messages from the console are below.               Start Debug Session     Connected     Loading      EKSPredictiveModel.m     Initialization Complete      I set a breakpoint at the top of my function and execute the function from the nb. When I press Shift Enter, the output line in the notebook simply repeats the function name. No breakpoints are hit - no additional information or errors are shown. Is there a way to diagnose this?


Principal Components - how to obtain linear transformations?

I have a list "xlsf" with 6 columns and 1200 rows for PCA analysis. The PrincipalComponents[xlsf] gives the following: "The principal components of matrix are linear transformations of the original columns into uncorrelated columns arranged in order of decreasing variance" How do I obtain the transformations performed on columns by Mathematica?


BarChart with two ChartLabels

I am creating a BarChart, where i wish to have the actual value on the top of each bar and the label of the bar on the bottom. Basically i have created the BarChart with the label in the bottom, but i cannot figure out how to add the value on the top of each bar.               values = {150445, 161419, 173986, 202405, 214516, 227004,         240700, 256377, 271309, 286944, 307016, 320545};     labels = {2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,         2009, 2010, 2011, 2012};     Show[      BarChart[values, ChartLabels -> labels,        ChartStyle -> "Pastel", AxesLabel -> {"Year", "Diagnosis"}],      Background -> Transparent,      BaseStyle -> {12, FontFamily -> "Helvetica"},      ImageSize -> 600      ]      Is there a way to view the `values`on top of each bar?


How plot the lattice QCD visualization figure?

The following is the 3D grid to visualize the lattice QCD simulations. Please help me, how to plot this fig. employing Mathematica. ![lattice QCD visualization figure](http://i.stack.imgur.com/TYA7S.jpg) Thank you very much.


How to join each of the spheres? Or, how to make a 3D grid?

Graphics3D[{       {RGBColor[#], Sphere[#, 1/50]} & /@ Tuples[Range[0, 1, 1/5], 3]       }      ]      It gives this: ![enter image description here](http://i.stack.imgur.com/SHsMu.jpg) Now I want to get this one: ![enter image description here](http://i.stack.imgur.com/PEnR1.jpg) How? As simple as doable. Thanks in advance.


Minimization problem

How could you find the smallest constant $c$ that satisfies $$\frac{3^{3k}e\sqrt{3}}{\pi\sqrt{k}\;2^{3/2+2k}} \leq 2^{\;c\;k}$$ assuming $k\geq 1$ is an integer. You can of course take logs of both sides and divide by $k$.   Can _Mathematica_ then somehow minimize for $c$? The code for the main term above is               (E/Sqrt[2Pi])/(x^(n x) (1 - x)^(n (1 - x)) Sqrt[ 2Pi n x (1 - x)])/. x -> 1/3 /. n->3k


Delaunay Triangulation for 3D Surface Data

I want to do a Delaunay triangulation on scattered 3D surface data. _Mathematica_ itself does it only for 2D through the command `DelaunayTriangulation[]`, which gives a triangulation for points in a plane. I also tried the MathLink package "TetGenLink", which can itself perform a Delaunay triangulation for three-dimensional data. The problem here is that `TetGenDelaunay[]` produces a triangulation through the inner region of the data, but I can't see how I can manage that the triangulation is only done for the surface (like what is done by MATLAB's `DelaunayTri` (see this SO question).


Creating a function to simplify WolframAlpha query

When I can't remember an integral I usually just query wolfram and have it show steps. This was my naive attempt at trying to make a simpler function.                wolfram[query_] =       WolframAlpha[ToString[query], IncludePods -> "Input",        AppearanceElements -> {"Pods"}, PodStates -> {"Input__Show steps"}]      It doesn't work. I'm completely clueless :) More generally I'm asking: How would I create a permanent function to simplify something this... verbose ?


Efficient dynamic drawing

So for example I have this code:               points = {}; k = 0;     Dynamic@k     Dynamic@Graphics[Point@points]          x = .1; y = .3; K = .9;     While[True,       k++;       {x, y} = {FractionalPart[x + K y], FractionalPart[x]};       AppendTo[points, {x, y}];     ]      The problem is that the list of points is growing and it slows down with time. What I want is to be able to add a point (or another primitive) directly on the dynamic graph without storing unnecessary chunks of data.


xkcd-style graphs

![xkcd 1064](http://i.stack.imgur.com/bjF9V.png) I received an email to which I wanted to respond with a xkcd-style graph, but I couldn't manage it. Everything I drew looked perfect, and I don't have enough command over `PlotLegends` to have these pieces of text floating around. Any tips on how one can create xkcd-style graphs? Where things look hand-drawn and imprecise. I guess drawing weird curves must be especially hard in _Mathematica_. **EDIT:** FWIW, this is sort of what I wanted to create. I used Simon Woods's `xkcdconvert`. By "answers" in this plot, I of course don't mean those given by experts to well-defined problems at places like here, but those offered by friends and family to real-life problems. ![my plot](http://i.stack.imgur.com/ohDio.jpg)


Why do I get two different results from StringLength?

I spent a reasonable amount of time to find the origin of an error in a larger code segment.               str = StringToStream["a1;b1;c1"];          data1 = ReadList[str, Record, 1];     StringLength[data1]     {8}          SetStreamPosition[str, 0];          data2 = Read[str, Record];     StringLength[data2]     8          Close[str];      You can't calculate with a {8}.


Best Practice for using Notation, $Pre, MakeExpression in a package

I'm setting up a package that defines a custom Notation. I'd like to inquire about best practices and possible issues of:   1. using the Notation Package   2. using `$Pre` and `$PreRead`   3. overloading `MakeExpression`


Unexpected result from FullSimplify

In the following simplification why doesn't Mathematica get a zero when asked to compute "Y-Z" eventually?                a = 1 - 4 A Q^2;       b = (-972 + 648) A Q^2 + 54;      c = 9 - 36 A Q^2;            Y = 12 Q/(       Sqrt[A] (          2 - (3 2^(1/3) a )/(Sqrt[b^2 - 4 c^3] + b  )^(1/3)  - (             Sqrt[b^2 - 4 c^3] + b  )^(1/3)/( 3 2^(1/3) )     )   );           Z = (4/A) + (3 2^(1/3) a )/(A (Sqrt[b^2 - 4 c^3] + b  )^(1/3) )  +  (        Sqrt[b^2 - 4 c^3] + b  )^(1/3)/( 3 2^(1/3) A);          Q = Sqrt [ 3/(16 A)];     Y - Z // FullSimplify     (-9 + 4 Sqrt[3] Sqrt[1/A] Sqrt[A])/(2 A)      One can do the above calculation by hand and one would see that for the specific chosen value of $Q = \sqrt{3/16 A}$ one would get $Y = Z = \frac{3}{A}$. Why doesn't Mathematica see this? * * *   * And is there a way to get Mathematica to detect if there are other values of $Q$ where $Y = Z$? (..I found this one value special value of $Q$ by just staring at the equation for sometime...)  * * * Rewriting the functions again. $Y = \frac{12Q}{\sqrt{A}\sqrt{ 2 - \frac{3 (2^{1/3})a }{(\sqrt{b^2 - 4 c^3 } + b )^{1/3} } - \frac{(\sqrt{b^2 - 4 c^3 } + b )^{1/3} }{3 (2^{1/3})} } }$ $Z = \frac{1}{A} \left (4 + \frac{(\sqrt{b^2 - 4 c^3 } + b )^{1/3} }{3 (2^{1/3})} + \frac{3 (2^{1/3})a }{(\sqrt{b^2 - 4 c^3 } + b )^{1/3} }\right ) $ at the chosen values of $Q = \sqrt{\frac{3}{16A} }$ one has $a = \frac{1}{4}$ and $b = - \frac{27}{4}$ and $b^2 - 4 c^3 = 0$. Also whenever I encounter $b^{1/3}$ I am writing that as $-3 \times 2^{-2/3}$. Substituting these into the above one gets $Y = Z = \frac{3}{A}$


Export Notebook causes an INTERNAL SELF-TEST ERROR: Files2|c|1713 message

On my machine (Windows 8.1) and M10 the following two lines, that must be run on an already saved notebook,               Manipulate[Plot[a x^2, {x, -4, 4}, PlotRange -> {-4, 4}], {{a, 1}, -10, 10}]     Export[NotebookFileName[] <> "~", EvaluationNotebook[], "NB"];      cause a strange error message, saying:               INTERNAL SELF-TEST ERROR: Files2|c|1713     Click here to find out if this problem is known, and to help improve     the Wolfram System by reporting it to Wolfram Research.      (the "here" link redirect me to this page, with my license data attached to the link). The error message is generated when the Export command is executed, **but only** if the first Manipulate command was previously executed (so that there is a dynamic output graphics object). If there's no dynamic output the export command works as expected. Disabling _Dynamic updating_ in the _Evaluation Menu_ has no effect. In **M9** the Export command **works fine** (no error messages) also with the presence of some dynamic output. The message is rather annoying, but, anyway, the export command succeeds. I need a fix for this because the Export command is used in the " ** _Mathematica Notebook Auto Backup Package_** " by Josh Burkart (available here: https://github.com/joshburkart/mathematica-autobackup). This package is very useful to create backups of the current notebook at user-defined intervals and with other configurable options. Furthermore I really don't like the alternative route of enabling the _NotebookAutoSave_ option since with that procedure you lose the safe and last "deliberately saved" version of the notebook. It is even more necessary now that, before the next maintenance release, M10 may run into some crashes (not infrequent, at least in some system, and that's the main reason why I searched and found that package). Can somebody check if the two code lines above give the error also with other machines? (Note that the notebook must be saved before running the Export command). Any possible advice to avoid that annoying error message?


Function with zero or one arguments

Is there a neat way to define a function with a single optional argument that defaults to an empty sequence? For example, suppose I want to define a wrapper for `RandomReal` that allows zero or one arguments:               myRandom[] := RandomReal[];     myRandom[x_] := RandomReal[x];      I can see two more compact ways of doing this. The first is to allow any number of arguments and then check whether we have zero or one:               myRandom[x___] := RandomReal[x] /; Length[{x}] ≤ 1;      and the other is to use a default argument of `Sequence[]`, wrapped with `Hold`:               myRandom[x_:Hold[Sequence[]]] := ReleaseHold[RandomReal[x]];      But neither of these seems very neat, and might be problematic or inefficient in some (more realistic) cases. Is there a conventional and/or neat way of doing this sort of thing?


Can Mathematica solve integro-differential equations?

I have integro-differential equations like this:               γ = 0.1;     κ = 0.15;     g = 0.2;     δ = 0.2 + 0.6 I;          eqns = {        x'[t] == -γ x[t] - g Re@z[t],        y'[t] == -κ y[t] + g Re@z[t],        z[t] ==          Integrate[(x[τ] -              y[τ]) Exp[ -δ (t - τ)], {τ, 0, t}]        };          ints = {        x[0] == 1,        y[0] == 0        };          NDSolve[Join[eqns, ints], {x, y}, {t, 0, 10}]      I don't know how to use _Mathematica_ to solve it or if it can be solved at all using some combinations of built-in functions? To solve integro-differential equations in _Mathematica_ is important to me for studying some special physical models.


Discrete FFT of non-periodic signal excited by short pulse

Say I have a signal F(t) which represents a excitation by a pulse (so it is not periodic and declining to zero amplitude). According to this answer, for instance, `Fourier[Data]` in _Mathematica_ assumes otherwise. How can I can specify that the data is not periodic so I can get the correct spectrum?


How can I speed up the export of graphs in DIMACS format?

I'm creating random graphs with suitable properties and exporting them in the DIMACS format. Already, for rather small graphs with, say, ~60k vertices and ~240k edges, `Export` takes several minutes on a high-end machine. My hope is to export much larger graphs in a reasonable time. Here's how I'm doing it now,               g = RandomGraph[DegreeGraphDistribution[Table[8, {60000}]]];     Export["graph.col", g]      The output file is a plaintext file with roughly $e$ lines, where $e$ is the number of edges in the graph. Why does `Export` run so slow? Is there a way I can speed `Export` up, or is there another way to do this faster? I can't imagine what makes _Mathematica_ _so_ slow at extracting the edgelist of the graph and writing it to a file.


Bug report: Attempting to Save Selection As... in a magnified Notebook fails with errors

I have found that attempting to **Save Selection As...** in a magnified Notebook fails with errors. On my system it can be easily reproduced by:   1. opening any documentation page   2. setting Notebook magnification to 150%   3. making an arbitrary selection   4. using **Save Selection As...** in the **File** menu   5. attempting to save as a .PNG image Errors produced in the Messages window: > >     The specified setting for the option WindowSize cannot be used. >   >     During evaluation of In[15]:= Set::shape: Lists >     {System`ConvertersDump`height$3806,System`ConvertersDump`width$3806} >     and {0} are not the same shape. >> >   >     During evaluation of In[15]:= Image::imgarray: The specified argument >     {} should be an array of rank 2 or 3 with machine-sized numbers. >> >   I am running Mathematica 10.0.0.0 under Windows 7.


String templating

I am pretty new to string processing in Mathematica. But I'm having some problems in doing simple string template filling to my mind elegantly. For example when doing export for my answer here, one of my solutions so far is using:               cat = StringJoin @@ (ToString /@ {##}) &;     strvec = cat[#[[1]], " ", #[[2]], " ", #[[3]]] &;     StringJoin[Map[cat["AttributeBegin             Translate ", strvec[#[[3]]], "             Color ", strvec[#[[2]]], "             Surface \"constant\"             Sphere 0.1 -0.1  0.1 360.0             Attribute \"light\" \"shadows\" \"on\"             LightSource \"pointlight\" \"l", #[[1]], "\"             \"intensity\" 1             \"lightcolor\" [", strvec[#[[2]]], "]         AttributeEnd         Illuminate \"l", #[[1]], "\" 1              "] &, {{1, Blue, {0, 0, -1}}, {1, Red, {3, 1.5, 1}}}]]      But what I would really like to do is have a separate the template string from the code so its easy to change without touching the rest of the code. Ideally id want something like this:               lightTemplate = "AttributeBegin         Translate $trans$         Color $color$         Surface \"constant\"         Sphere 0.1 -0.1  0.1 360.0         Attribute \"light\" \"shadows\" \"on\"         LightSource \"pointlight\" \"l$num$\"         \"intensity\" 1         \"lightcolor\" [ $color$ ]      AttributeEnd      Illuminate \"$num$\"      "      Then somehow map my database to fill in values to `$num$`, `$color$` etc... Like i would do in mostly any other high level language (python uses % or {} instead of $ but the idea is the same). I tried using `StringFormat` but that didn't work too well. In a related note is there a nice way to turn something like:               RGBColor[1, 0, 0]       to "1 0 0"


How can a power of 0 or 1 be replaced?

Consider this given example for `ReplaceAll`               1 + x^2 + x^4 /. x^p_ -> f[p]      This returns `1+f[2]+f[4]` - works good (!). But if you choose                In[175]:= 1 +x+ x^2 + x^4 /. x^p_ -> f[p]      Out[175]= 1+x+f[2]+f[4]      It doesn't not work for `1` and `x`. The correct output should be `f[0]+f[1]+f[2]+f[4]`. What is wrong here and to cure it? **EDIT** > Possible way out One possible way out can be to not use `ReplaceAll` (inspired by @eldo). The coefficient and the power of `x` can be combined in this way:               fun[x] = a - b x + c x^2 + d x^4     nfun = Exponent[fun[x], x];     Sum[Coefficient[fun[x], x, i] f[i], {i, 0, nfun}]      And the result is `a f[0] - b f[1] + c f[2] + d f[4]`. However the replace rule for $x^0$ is still a mystery!


Dealing with nested lists

This question is strongly related to: Map and Apply a function on a nested list I am in a bit of a rut in terms of my MMA skills and looking to improve my coding. I've realized that rather than taking advantage of all of capabilities of MMA, I've stuck to a few constructs that are easy coming from a procedural background such as using Table to replicate While-Do functionality. I often have to deal with nested lists:                n1 = 3; n2 = 6; n3 = 5; (*example*)           list1 = Table[Table[RandomInteger[{-5, 5}, n1], {i, 1, n2, 1}], {j, 1, n3, 1}];      list2 = Table[Table[RandomInteger[{-5, 5}, n1], {i, 1, n2, 1}], {j, 1, n3, 1}];      list3 = Table[Table[RandomInteger[{-5, 5}, n1], {i, 1, n2, 1}], {j, 1, n3, 1}];      list = {list1, list2, list3};           I typically have to apply some set of functions to the nested list as follows:               values1 = Table[Min@list1[[i]][[All, #]] & /@ Range[n1], {i, 1, n3}];     values2 = Table[Max@list2[[i]][[All, #]] & /@ Range[n1], {i, 1, n3}];     values3 = Table[StandardDeviation@list3[[i]][[All, #]] & /@ Range[n1], {i, 1, n3}];     values = {values1, values2, values3};      And plot the results:               Grid[{{ListLinePlot[Transpose@values1, PlotStyle -> {Red}, PlotMarkers -> "x"]     , ListLinePlot[Transpose@values2, PlotStyle -> {Green}, PlotMarkers -> "y"]     , ListLinePlot[Transpose@values3, PlotStyle -> {Blue}, PlotMarkers -> "z"]}}]      **Question** : How would you rewrite **ALL** of the above code (including the list generation and plotting) in a functional style (without using Table) so that it is efficient and expandable?