title: Stiffness or Singularity

text: So trying to run some simulations based on a model I found in literature. I am by no means a _Mathematica_ expert, or a mathematician for that matter. Initial I was getting a `NDSolve:ndsz` error so I changed the `Method` to `StiffnessSwitching`. Now I am getting an underflow error, change the `StartingStepSize` to `1/10` and I get an overflow. Am I just an idiot or what? I'm pretty sure I have all the initial conditions correct from the journal article (which I presume works).               Needs["DifferentialEquations`NDSolveProblems`"];     Needs["DifferentialEquations`NDSolveUtilities`"];     Needs["FunctionApproximations`"];     Clear["Global`*"];     σ = 300;     er0 = 4.4*10^3;     σ0 = 33;     psi = .65;     hstar = 2 psi/(1 + 2 psi);     littleh = 7.2*10^4;     tmin = 0;     tmax = 1000000;     (* for 5 model*)     Cat = 67;     kp = 10^6;     kc = .33;     ϵf = .049;     R = 8.314;     Temp = 1350;     Q = 316000;          eqns = {      h'[t] == littleh/σ*(1 - h[t]/hstar)*er'[t],      er'[t] == er0 (1 + dd[t]) Exp[-Q/(R* Temp)]*Sinh[(σ*(1 - h[t]))/(σ0 (1 - dop[t]) (1 - doc[t]))],      dd'[t] == Cat*er'[t],  dop'[t] == kp/3 (1 - dop[t])^4 , doc'[t] == kc/ϵf*er'[t] ,      h[0] == 0.1, er[0] == 0.1, dop[0] == .4, doc[0] == .001, dd[0] == 10^10        };          sol = NDSolve[eqns, {h, er, dd, doc, dop}, {t, tmin, tmax},        Method -> "StiffnessSwitching", StartingStepSize -> 1/10]                    SetOptions[Plot, Frame -> True, FrameLabel -> {"Time (unit)", "Strain (unit)", "title"},        LabelStyle -> {FontFamily -> "Times", FontSize -> 20},        ImageSize -> 600];               Plot[{h[t] /. sol[[1]][[1]], er[t] /. sol[[1]][[2]]}, {t, tmin, tmax},        AxesOrigin -> {0, 0}, PlotStyle -> {{Black}, {Gray, Dashed}}]      > >     General::ovfl: Overflow occurred in computation. >> >     NDSolve::nlnum: The function value   {Overflow[], Overflow[], > 1.143906412473046*10^429, >     Overflow[], Overflow[]} is not a list of numbers with dimensions {5} at > {t, dd[t], >     doc[t], dop[t], er[t],h[t]} = {0.000871366, -2.8508*10^123, > -2.84047*10^122, >     7.65381*10^105, -4.26071*10^121, 6.32403*10^281}. >> >


title: Behavior of Commonest when there is an even split between the elements of the list it is given

text: How can I alter `Commonest` so that, when I give it an input of four zeroes and ones such as $\\{0,1,1,0\\}$, which has an even split in its elements, it returns the first element of the input list, which happens to be $0$ in the example?


title: mathematica apply list of functions to the same arguments

text: How can I apply list of functions to the same arguments? e.g. ApplyFun[{fun1,fun2,fun3},{arg1,arg2}] I looked here and could not find: https://reference.wolfram.com/mathematica/guide/ApplyingFunctionsToLists.html http://reference.wolfram.com/legacy/flash/ EDIT: "Through" is partial solution, because it cannot be used in expressions, where these functions are used without arguments.


title: Polynomial factorization over finite fields with non-prime order

text: One can easily factor a polynomial over finite fields of prime order, using `Factor` command:               Factor[1 + x^2, Modulus -> 2]     ===>  (1 + x)^2      Now, is it possible to do this over finite fields of non-prime order? As an example, $ x^2 + x + 1$ is reducible over GF(4), and can be decomposed as $(x-a)(x-a^2)$, where $a\not\in \\{0,1\\} $ is a field member. Problem is, members of non-prime order finite fields are not denoted by ordinary numbers; rather, they use either polynomial or vector notation.


title: Voronoi diagrams for generators other than points

text: Any suggestions how to determine Voronoi diagram for sites other than points, as e.g. in the picture below? Input is a raster image. ![enter image description here](http://i.stack.imgur.com/iab6u.png)


title: "Legended" not working with "Plot" or "LogLinearPlot"

text: Version 9 has a new option `Legended`, which I find appealing since it should allow me to add individual expressions/curves to a legend, but it doesn't seem to be working for expressions in `Plot` or `LogLinearPlot`. For example, I would like to plot $log(x)$ and $x sin(x)$ together but only have $log(x)$ appear in the legend, I try:               LogLinearPlot[{Legended[Log[x], "Log(x)"], x Sin[x]}, {x, 1, 100}]      and the curve for $Log(x)$ just disappears instead of appearing on it's own in the legend. If `Legended` is not supposed to be used with the "`Plot`..." family of symbols, then could someone suggest an alternative solution to my problem?


title: Proving (self) similarity with Mathematica - Reccurrence Plots, Similarity Plots etc

text: I posted this question in math.se but given the sheer tumultuous number of questions that keep appearing on math.se and also given that I am trying to accomplish this in Mathematica, I thought I'd post an alternate version of this question here. (I hope that's not totally unacceptable to quasi-reproduce my question from elsewhere). I do realize that I'll receive perhaps different flavors of an answer from math.se and mathematica.se. Simply put, given two sets of data (Discrete Fourier transform matrices in this case), how do I prove similarity in the data. ![](http://i.stack.imgur.com/KXRB1.png) ![](http://i.stack.imgur.com/ulYo7.png) Comparing the figure on the Left with that on the Right, I somehow have an inkling that theres similarity in the figures. What I have is DFT data for these figures too (just the top left corner of the DFT data, with the DC component removed), which looks so: ![](http://i.stack.imgur.com/m0GvI.png) ![](http://i.stack.imgur.com/bfuVJ.png) The DFT corner on the left is for the contour plot on the left and the one on the right is for the contour plot on the right. I did a bit of research and came up with these: self similarity matrix, Smith Waterman algorithm for gene sequencing, it is implemented in Mathematica (also see ref/SmithWatermanSimilarity), and a somewhat related question posted on Mathematica.SE several months ago. I understand that this is more math related than Math _ematica_ related but as I'd like to use Mathematica since I pre and post process my data in it, I thought I'd ...ask! `:)` I used the `MatrixPlot` to generate the plots from the data below. ## Here is DFT data for the figure on the **left** :               {{0, 0., 23.1306, 0., 4.63337, 0., 4.87462, 0., 1.13912, 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0.}, {0., 59.8403, 0., 11.402, 0., 0.,        0., 1.53024, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0.}, {23.3079, 0., 23.2309, 0., 3.80344, 0., 4.07117, 0., 1.07381,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 11.3638, 0.,        3.51212, 0., 4.17147, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0.}, {4.56479, 0., 3.80023, 0., 4.05799, 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0., 4.1947, 0.,        1.12046, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0.}, {5.12425, 0., 4.21734, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0.}, {0., 1.54858, 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {1.07898, 0.,        1.094, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0.}, {0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0.}, {0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0.}, {0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}}      ## And data for the figure on the **right** :               {{0, 0., 0.940723, 0., 2.95705, 0., 2.92228, 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0.}, {0., 18.867, 0., 7.68905, 0., 0., 0.,        1.61012, 0., 1.07367, 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0.}, {1.28581, 0., 12.1276, 0., 6.00817, 0., 0., 0., 1.7524, 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 8.01748, 0., 14.725, 0.,        0., 0., 1.05116, 0., 2.1411, 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0.}, {2.77763, 0., 6.2871, 0., 1.82885, 0., 1.65436, 0., 1.43276,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0.,        3.54584, 0., 1.45959, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0.}, {3.11339, 0., 0., 0., 1.89853, 0., 3.24873, 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0.}, {0., 1.83295, 0., 0., 0., 1.57703,        0., 1.14208, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0.,        0., 1.61293, 0., 1.32478, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0.}, {0., 1.02113, 0., 2.18193, 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0.976133, 0.,        0.931741, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0.}, {0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0.}, {0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0.}, {0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0.}}


title: 2 non-linear equations with 2 unknowns which I cannot solve

text: I have the following equations and I would like to solve them in Mathematica **anyway**. Numerical results are very much welcomed. However, when I use the command `NSolve`, I get the following error message: The expression $b^{\frac{1}{2}\log (ab)}$ involves unknowns in more than one argument, so inverse functions cannot be used. Here are the equations that I want to solve:               NSolve[      {(Integrate[(E^(-x^2/2 + Log[a]^2/Log[a*b])*(E^(-(-1 + x)^2/2 + x^2/2))^(Log[a]/Log[a*b])*Log[E^(Log[a]^2/Log[a*b])*(E^(-(-1 + x)^2/2 + x^2/2))^(Log[a]/Log[a*b])])/       Sqrt[2*Pi], {x, 1/2 + Log[a^(-1)], 1/2 + Log[b]}] +      (a*Erfc[(1/2 + Log[b])/Sqrt[2]]*Log[a])/2)/((1 + Erf[(1/2 + Log[a^(-1)])/Sqrt[2]])/2 +      (E^((Log[a]^2*(1 + 2*Log[a*b]))/(2*Log[a*b]^2))*(-Erf[(-2*Log[a] + (1 + 2*Log[a^(-1)])*Log[a*b])/(2*Sqrt[2]*Log[a*b])] +       Erf[(-2*Log[a] + (1 + 2*Log[b])*Log[a*b])/(2*Sqrt[2]*Log[a*b])]))/(2*a^(1/(2*Log[a*b]))) + (a*Erfc[(1/2 + Log[b])/Sqrt[2]])/2) -       Log[(1 + Erf[(1/2 + Log[a^(-1)])/Sqrt[2]])/2 + (E^((Log[a]^2*(1 + 2*Log[a*b]))/(2*Log[a*b]^2))*       (-Erf[(-2*Log[a] + (1 + 2*Log[a^(-1)])*Log[a*b])/(2*Sqrt[2]*Log[a*b])] + Erf[(-2*Log[a] + (1 + 2*Log[b])*Log[a*b])/(2*Sqrt[2]*Log[a*b])]))/       (2*a^(1/(2*Log[a*b]))) + (a*Erfc[(1/2 + Log[b])/Sqrt[2]])/2] == 0.1,      (Integrate[(E^(-(-1 + x)^2/2 + Log[b]^2/Log[a*b])*Log[E^(Log[b]^2/Log[a*b])/      (E^(-(-1 + x)^2/2 + x^2/2))^(Log[b]/Log[a*b])])/     ((E^(-(-1 + x)^2/2 + x^2/2))^(Log[b]/Log[a*b])*Sqrt[2*Pi]), {x, 1/2 + Log[a^(-1)], 1/2 + Log[b]}] +       (b*(1 + Erf[(-1/2 + Log[a^(-1)])/Sqrt[2]])*Log[b])/2)/        ((b*(1 + Erf[(-1/2 + Log[a^(-1)])/Sqrt[2]]))/2 + (E^((Log[b]^2*(1 + 2*Log[a*b]))/      (2*Log[a*b]^2))*(Erf[(-1 + 2*Log[b]*(1 + Log[a*b]^(-1)))/(2*Sqrt[2])] -        Erf[(-1 + 2*Log[a^(-1)] + (2*Log[b])/Log[a*b])/(2*Sqrt[2])]))/        (2*b^(1/(2*Log[a*b]))) + Erfc[(-1/2 + Log[b])/Sqrt[2]]/2) -        Log[(b*(1 + Erf[(-1/2 + Log[a^(-1)])/Sqrt[2]]))/2 +         (E^((Log[b]^2*(1 + 2*Log[a*b]))/(2*Log[a*b]^2))*(Erf[(-1 + 2*Log[b]*(1 + Log[a*b]^(-1)))/(2*Sqrt[2])] -          Erf[(-1 + 2*Log[a^(-1)] + (2*Log[b])/Log[a*b])/(2*Sqrt[2])]))/(2*b^(1/(2*Log[a*b]))) + Erfc[(-1/2 + Log[b])/Sqrt[2]]/2] == 0.1},      {a, b}]      * * *               f0[x_] := 1/Sqrt[2*Pi*1^2]*E^(-(x + 0)^2/(2*1^2))     f1[x_] := 1/Sqrt[2*Pi*1^2]*E^(-(x - 1)^2/(2*1^2))          yl = -1.070751889428462     yu = 2.0707518894284505          a = 1/l[yl]     b = l[yu]          l[x] = f1[x]/f0[x]          Solve[-(1/2) (-1 + x)^2 + x^2/2 - Log[y] == 0, x]         \--> here I must find the inverse function of $l$ but I couldn't do that either, so then I did it half-manually, which is:               ll[x_] := 1/2 + Log[x]          NSolve[{(Integrate[a*InputForm[1/(E^(x^2/2)*Sqrt[2*Pi])]*Log[a], {x, ll[b], Infinity}] + Integrate[E^(Log[a]^2/Log[a*b])*InputForm[1/(E^(x^2/2)*Sqrt[2*Pi])]*             l[x]^(Log[a]/Log[a*b])*Log[E^(Log[a]^2/Log[a*b])*l[x]^(Log[a]/Log[a*b])], {x, ll[a^(-1)], ll[b]}])/          (Integrate[InputForm[1/(E^(x^2/2)*Sqrt[2*Pi])], {x, -Infinity, ll[a^(-1)]}] + Integrate[a*InputForm[1/(E^(x^2/2)*Sqrt[2*Pi])], {x, ll[b], Infinity}] +            Integrate[E^(Log[a]^2/Log[a*b])*InputForm[1/(E^(x^2/2)*Sqrt[2*Pi])]*l[x]^(Log[a]/Log[a*b]), {x, ll[a^(-1)], ll[b]}]) -          Log[Integrate[InputForm[1/(E^(x^2/2)*Sqrt[2*Pi])], {x, -Infinity, ll[a^(-1)]}] + Integrate[a*InputForm[1/(E^(x^2/2)*Sqrt[2*Pi])], {x, ll[b], Infinity}] +            Integrate[E^(Log[a]^2/Log[a*b])*InputForm[1/(E^(x^2/2)*Sqrt[2*Pi])]*l[x]^(Log[a]/Log[a*b]), {x, ll[a^(-1)], ll[b]}]] == 0.1,        (Integrate[b*InputForm[1/(E^((-1 + x)^2/2)*Sqrt[2*Pi])]*Log[b], {x, -Infinity, ll[a^(-1)]}] +            Integrate[(E^(Log[b]^2/Log[a*b])*InputForm[1/(E^((-1 + x)^2/2)*Sqrt[2*Pi])]*Log[E^(Log[b]^2/Log[a*b])/l[x]^(Log[b]/Log[a*b])])/l[x]^(Log[b]/Log[a*b]),             {x, ll[a^(-1)], ll[b]}])/(Integrate[InputForm[1/(E^((-1 + x)^2/2)*Sqrt[2*Pi])], {x, ll[b], Infinity}] +            Integrate[b*InputForm[1/(E^((-1 + x)^2/2)*Sqrt[2*Pi])], {x, -Infinity, ll[a^(-1)]}] +            Integrate[(E^(Log[b]^2/Log[a*b])*InputForm[1/(E^((-1 + x)^2/2)*Sqrt[2*Pi])])/l[x]^(Log[b]/Log[a*b]), {x, ll[a^(-1)], ll[b]}]) -          Log[Integrate[InputForm[1/(E^((-1 + x)^2/2)*Sqrt[2*Pi])], {x, ll[b], Infinity}] + Integrate[b*InputForm[1/(E^((-1 + x)^2/2)*Sqrt[2*Pi])],             {x, -Infinity, ll[a^(-1)]}] + Integrate[(E^(Log[b]^2/Log[a*b])*InputForm[1/(E^((-1 + x)^2/2)*Sqrt[2*Pi])])/l[x]^(Log[b]/Log[a*b]), {x, ll[a^(-1)], ll[b]}]] ==         0.1}, {a, b}]      * * * Please let me know if there is still something missing. **MORE NOTES:** 1- $y_u>y_l$ should be satisfied 2- $a,b>0$ and $ab>1$ 3- $l[x]$ monotone increasing. This means one can choose some densities $f0[x_]$ and $f1[x_]$ such that $l$ is monotone increasing. Because we need its inverse! According to these notes, is the solution unique? or are there still more roots if I change $f0[x_]$ and $f1[x_]$? Is there anyway to get a solution? I also tried `FindRoot` and `SolveAlways` which gave no result at all. Thank you very much in advance.


title: Placing text inside a region with RegionPlot

text: I am plotting many regions with RegionPlot. I would like to label each region as I plot it so that I get something that looks like figure made with the following code:               Show[       RegionPlot[x > y, {x, 0, 1}, {y, 0, 1}],       RegionPlot[x < y,  {x, 0, 1}, {y, 0, 1}],       Graphics[Text["B", {0.6, 0.2}]],       Graphics[Text["A", {0.2, 0.6}]]     ]      ![Example of labelled regions](http://i.stack.imgur.com/tzbMd.png) However, as the sets of inequalities are quite complicated and there are many regions, I would like to automatically determine a reasonable place to put each label so that it is in the middle of each region. Is there a simple way to do this? I could manually find a point within each region, but that would be a pain and wouldn't necessarily solve the problem of centering the text within the region.


title: Adjacency Matrix for an Undirected Graph

text: Here is an undirected graph                 m = Graph[{1 \[UndirectedEdge] 3, 2 \[UndirectedEdge] 3,         3 \[UndirectedEdge] 4, 4 \[UndirectedEdge] 5,         4 \[UndirectedEdge] 6, 5 \[UndirectedEdge] 7,         6 \[UndirectedEdge] 8}, GraphLayout -> "SpringEmbedding",        VertexLabels -> "Name", ImagePadding -> 10]      We can get the Adjacency Matrix as follows               g = AdjacencyMatrix[m]      The Normal Form of the sparse array g is as follows.               In[28]:= Normal[g]          Out[28]= {{0, 1, 0, 0, 0, 0, 0, 0}, {1, 0, 1, 1, 0, 0, 0, 0}, {0, 1,        0, 0, 0, 0, 0, 0}, {0, 1, 0, 0, 1, 1, 0, 0}, {0, 0, 0, 1, 0, 0, 1,        0}, {0, 0, 0, 1, 0, 0, 0, 1}, {0, 0, 0, 0, 1, 0, 0, 0}, {0, 0, 0, 0,        0, 1, 0, 0}}      The adjacency matrix does not appear to be correct for the graph m.


title: Restrict access to Lightweight Grid

text: When using the default configuration of the Lightweight Grid Manager, anyone connected to the same internal network where the grid severs are can launch kernels on the grid. What possibilities are there to restrict access to the Lightweight Grid, and how can these restrictions be enabled? Is IPFiler the only way?


title: FindShortestPath with negative weights isn't working

text: I have the following functions defined:               RandomTree[n_, opts:OptionsPattern[]] :=      TreeGraph[UndirectedEdge[RandomInteger[{1,#}], # + 1] & /@ Range[1, n - 1], opts]          RandomCycleTree[n_, opts:OptionsPattern[]] := Module[{tree, e},     tree = RandomTree[n];     e = RandomChoice[EdgeList[GraphComplement[tree]]];     GraphUnion[tree, Graph[{e}], opts]]          RandomCycleTreeWeighted[n_, opts:OptionsPattern[]] :=      RandomCycleTree[n, EdgeWeight -> RandomReal[{-1, 1}, n], opts]      If I execute:               FindShortestPath[RandomCycleTreeWeighted[10,      VertexLabels -> "Name", ImagePadding -> 10], 3, 7]      it returns unevaluated. Can anyone reproduce this and explain why it is happening? Note: I am using Mathematica 9. I also tried executing this in Mathematica 8.0 and it also didn't work.


title: How to rebuild original data from a histogram?

text: I have data in the following form. I have a list of values and a list of frequencies that indicate how often each value has occurred. Example list of values: `{5,7,4}` Example list of frequencies: `{1,2,3}` I would like to obtain the original data from which such a histogram was generated. Any suggestions on how to do this with _Mathematica_ ? Example: `{5,7,7,4,4,4}`


title: How do you remove noise to detect just the human voice?

text: How do you detect different sound frequencies and cut off parts in an audio file? Among instruments, how do you pick up the human voice?


title: Complex Region using Presentations Package

text: Just purchased the Presentations package. First sketched this region:               << Presentations`          Draw2D[      {Opacity[0.6],       ComplexRegionDraw[0 <= Re[z] <= 1, {z, -2 - 2 I, 2 + 2 I}]},      Frame -> True,      Axes -> True,      PlotRange -> 2,      FrameLabel -> {Re, Im},      PlotLabel -> z,      ImageSize -> 300      ]      And I got the image I wanted. ![today](http://i.stack.imgur.com/BRDhj.png) Next, I want to sketch the image of this region under the exponential function $w=e^z$. I tried this:               Draw2D[      {Opacity[0.6],       ComplexRegionDraw[Exp[z], {z, -2 I, 1 + 2 I}]},      Frame -> True,      Axes -> True,      PlotRange -> 2,      FrameLabel -> {Re, Im},      PlotLabel -> z,      ImageSize -> 300      ]      But I got a blank image. Any suggestions? Looks like I might have an idea.               f[z_] := Exp[z]          Draw2D[      {Opacity[0.6],       ComplexRegionDraw[0 <= Re[z] <= 1, {z, -2 - 2 I, 1 + 2 I},         PlotPoints -> 30] // ComplexMap[f]},      Frame -> True,      Axes -> True,      PlotRange -> All,      FrameLabel -> {Re, Im},      PlotLabel -> z,      ImageSize -> 300      ]      And the resulting image: ![today2](http://i.stack.imgur.com/zbGWX.png) Of course, what I really wanted was the image of the the strip with $0\le Re[z]\le1$ and $\infty\le Im[z]\le \infty$.               Draw2D[      {Opacity[0.6],       ComplexRegionDraw[0 <= Re[z] <= 1, {z, 0, 1 + 2 Pi I},         PlotPoints -> 30] // ComplexMap[f]},      Frame -> True,      Axes -> True,      PlotRange -> All,      FrameLabel -> {Re, Im},      PlotLabel -> z,      ImageSize -> 300      ]      And the resulting image. ![today3](http://i.stack.imgur.com/Z016O.png)


title: Problem with GlobalClusteringCoefficient

text: I have a simple problem, I would like to measure the global clustering coefficient for a random graph. Here is my code:               GlobalClusteringCoefficient[RandomGraph[DegreeGraphDistribution[       {2, 1, 1, 1, 1, 2, 1, 3, 3, 1, 1, 2, 2, 2, 2,1, 1, 1, 7, 3, 3, 3, 1, 2, 1}], 10000]]      This is just supposed to create 10000 random graphs, with each vertex in each graph having a fixed number of edges. The error I get is as follows: > GlobalClusteringCoefficient::graph: A graph object is expected at position 1 > in GlobalClusteringCoefficient I tried wrapping everything before the clustering function as follows:               Graph[[RandomGraph[DegreeGraphDistribution[       {2, 1, 1, 1, 1, 2, 1, 3, 3, 1, 1, 2, 2, 2, 2,1, 1, 1, 7, 3, 3, 3, 1, 2, 1}], 10000]]]      And it gives the same error. Anyone know how to convert the random graph generated into a graph object? EDIT: So I had in mind to create a For-loop which would go from `i = 1` until `10,000` \-- but this saved me a lot of computational power. Now I have this:               Mean[GlobalClusteringCoefficient /@        RandomGraph[DegreeGraphDistribution[         {2, 1, 1, 1, 1, 2, 1, 3, 3, 1, 1, 2, 2, 2, 2, 1, 1, 1, 7, 3, 3, 3, 1, 2, 1}], 10000]]      I get a value of `4587/86000`, which is almost too good to be true -- is this really calculating the mean of all 10000 cluster coefficients? I am a little surprised because I have been using _Mathematica_ for a total of one day, but this solved the issue far faster than R.


title: How do I plot a solution of a differential equation?

text: I am having trouble generating a plot for a solution to my differential equations. I always end up with just blank axes.               Clear["Global`*"]      Remove["Global`*"]     m x''[t] == -k m x'[t];     m y''[t] == -k m y'[t] - m g;     U == v Cos[\[Theta]];     V == v Sin[\[Theta]];     soln = DSolve[{m x''[t] == -k m x'[t], m y''[t] == -k m y'[t] - m g,        x[0] == 0, y[0] == 0, x'[0] == U, y'[0] == V}, {x[t], y[t]},       t][[1]] // Simplify;     soln     ParametricPlot[{x[t], y[t]}, {t, 0, 5}]      The solution comes out fine but the graph always comes out blank. I'm sure I'm making some rookie mistake somewhere and would appreciate if someone can point it out.


title: Changing parenthesis size for typography

text: I am using Mathematica to layout some mathematical formulas for publication. The guidelines specify that in case of nested parentheses the encompassing ones need to be bigger than the inner ones. So is there a way to make parentheses bigger easily? Below is an example of what I want. It is made by inserting an invisible column at the beginning of the grouping, but that creates a ugly gap in the formula. ![enter image description here](http://i.stack.imgur.com/QwKye.png)


title: How can I compare the previous value and the current value implemented during NestWhileList?

text: I am trying to write a part of my code. I am using NestWhileList. However, I couldn't find out the right syntax for testing. It should compare previous result and current result and continue if it is True. I want to do this, for instance :               NestWhileList[# + RandomInteger[{-5, 5}] &, 10, previousresult <= currentresult];      and If I have two test options for NestWhileList, for instance :                 NestWhileList[# + RandomInteger[{-5, 5}] &, 10, previousresult <= currentresult && previous result<0];      Is there a way to do it? **Second Question** (This question is not absolutely related to first question.) In addition, if I can't do that, i will try to create a list without testing. If I create list, how can I compare successive two component of list in a functional way? Any help is appreciated.


title: Speed up ContourPlot3D

text: I have two issues with the following code. (1) It executes too slowly. If I use "Speed" instead of "Quality" for PerformanceGoal, I get the speed but an undesirable delay in proper rendering of the contour. Perhaps the calculation of the expression to be contoured is the cause of the slowness. If so, can that be accelerated? (2) How can I make the z-axis vertical. Note its appearance with some jaggies.               Manipulate[           ContourPlot3D[         {z == 10*x*y*Exp[-x - y], z == k}, {x, 0, 6}, {y, 0, 6}, {z, 0, 3},          ContourStyle -> {Red, Opacity[0.9]},         AxesOrigin -> {0, 0, 0}, Boxed -> False, Mesh -> None,          PerformanceGoal -> "Quality",         MeshStyle -> Directive[Thick], AxesStyle -> Directive[Thick],          BoundaryStyle -> Directive[Blue], ContourStyle -> Opacity[0.8],         ViewPoint -> {-4, -8, 4}, ImageSize -> 2 {420, 370}],         {{k, 0.5, Text@Style["k", Italic, FontSize -> 18]}, 0, 1.35, 0.01,          Appearance -> "Labeled"}      ]


title: How can I colorize an imported model?

text: How can I colorize an imported model from for example 3ds max? I'm trying to find the way to colorize a 3D plot from an imported model with something like this:               ColorFunction -> Function[{x, y, z}, ColorData["GreenBrownTerrain"][z^2]]      But I don't know how. Thank you very much for your help.


title: More efficient matrix-vector product

text: Dear mathematica users, In my present research I am faced with a real dense $n\times n$ matrix $A$ where $n \geq 3000$ (hopefully even more). The coefficients of this matrix are fixed, but I will have to repeatedly multiply it by a variable vector: $Ax$. I am not complaining about Mathematica's speed to do the job, which seems quite nice, but since I will need to do this repeatedly for very many times, I was wondering if there was a way to optimise the process. Perhaps, declaring it in a With will help, but besides that I am out of ideas. Another alternative would be a low-rank approximation using SVD. My thoughts were: with the SVD I can write \begin{equation} A = \sigma_1 u_1 v_1^\text{T} + \sigma_2 u_2 v_2^\text{T} + \ldots \end{equation} so \begin{equation} Ax = (\sigma_1 v_1^\text{T}x) u_1 + (\sigma_2 v_2^\text{T})u_2 + \ldots \end{equation} As an example, using a rank 100 approximation to a $3000\times 3000$ matrix (which yields a Frobenius error of $\sim5-10\;\%$) I was able to reduce the computation time by a factor of roughly 3 or 4. I thank in advance for any positive feedback. Best regards, Gabriel Landi **Edit:** Forgot to say that $A$ is symmetric and has zero diagonal.


title: Efficiently extracting an array subset given a separate array

text: I have two arrays. The first array consists of tens of millions of rows and three columns with a string, a number, and a string.               array1 = {{string1, 145745, a}, {string2, 56546, a}, {string3, 56546, b},               {string3, 246, b}, {string7, 12355, a}, {string7, 12355, b}}      The second array has hundreds of thousands of rows but also consists of three columns but with a string, a number, and a number.               array2 = {{string1, 145745, 3.14324}, {string3, 56546, -0.34319}, {string7, 12355, 0.23535}}      In `array2`, the first two elements of each row matches the first two elements of a row (or, at most, two rows) in array1. In other words, `array2[[All,{1,2}]]` is a subset of `array1[[All,{1,2}]]`. The goal is to take from `array1` all the rows that have matching rows in `array2` (when comparing only the first two columns from each array). For example, from the two given arrays above, the final result would be               result = {{string1, 145745, a},{string3, 56546, b},{string7, 12355, a},{string7, 12355, b}}      The fastest command I've come up with is               m=Dimensions[array2][[1]];     Do[     Pick[array1,array1[[All,{1,2}]],array2[[i,{1,2}]]]//Sow     ,{i,m}     ]//Reap      but this is still too slow. This is a simple problem, but I am really looking for the fastest method possible. Any ideas? **EDIT** Previously, I erroneously had               array1 = {{string1, 145745, a}, {string2, 56546, a}, {string3, 56546, b},               {string3, 246, b}, {string7, **145745**, a}, {string7, 12355, b}}      which should have been               array1 = {{string1, 145745, a}, {string2, 56546, a}, {string3, 56546, b},               {string3, 246, b}, {string7, **12355**, a}, {string7, 12355, b}}      This has been corrected above.


title: CDF and personalized style

text: I recently created a custom stylesheet. I then created a notebook with the new style, confirmed that the notebook had adopted the style, and then saved a copy in CDF. But when I opened the CDF in Wolfram's CDF Player, the style had not been applied to the document. Does this mean that CDFs are not able to adopt the style of the original notebook if the style comes from a custom stylesheet? How can I embed the style into cdf?


title: Which ray-tracing software is compatible with Graphics3D?

text: I am interested in working alternative to _Mathematica_ 's FrontEnd for rendering `Graphics3D` produced by _Mathematica_. The requrements are:   * An ability to import `Graphics3D` objects exported from _Mathematica_ in any of 3D export formats supported by _Mathematica_.    * It seems that in most cases _Mathematica_ 's support of 3-rd party 3D geometry formats is incomplete ( _Mathematica_ does not export the complete scene description). So the second requirement is that recovering of dropped parts of the scene description would be as easy as possible. I am most interested in rendering polygonal surfaces computed by _Mathematica_ which are presented internally as `GraphicsComplex`. It will be very appreciated if an answerer show the complete way to render some simple _Mathematica_ -generated surface with several point light sources like this:               lightSources = {{"Point", Red, {1/2, 1, 1}},                      {"Point", Green, {1, 1/2, 1}},                      {"Point", Blue, {0, 0, 1}}};     pl = Show[       Plot3D[Sin[x*y*Pi^2], {x, 0, 1}, {y, 0, 1},         Lighting -> lightSources],        Graphics3D[{PointSize[Large],          Point[lightSources[[All, 3]],           VertexColors -> lightSources[[All, 2]]]}]]      ![plot](http://i.stack.imgur.com/Arypd.png)


title: Using patterns in pure functions

text: Pure functions may be handy if you don't want to assign your function a name. For example I would calculate $x(x-1)$ for some numbers $x$ by               In: #(#-1) & /@ {1, 2, 3}     Out: {0, 2, 6}      Is it possible to use patterns in this construction? For example something like               f[x_Integer] := x(x-1)      but then without defining a function f first.


title: Integrating a half-normal pdf

text: The pdf of a half normal distribution is: $\frac{\sqrt{2}}{\sigma\sqrt{\pi}}\exp\left(-\frac{x^2}{2\sigma^2}\right)$, $x>0$ $$\int_{0}^{\infty}\frac{\sqrt{2}}{\sigma\sqrt{\pi}}\exp\left(-\frac{x^2}{2\sigma^2}\right)\mathrm{d}x=\frac{1}{\sqrt{\sigma}}$$ This doesn't make sense, the integral should be equal to one, right? Mathematica code used to compute this:               Integrate[(Sqrt[2/Pi]/s)*Exp[-(x^2)/(2*s^2)], {x, 0, Infinity}, Assumptions -> Re[s^2] > 0]      What am I doing wrong?


title: Making a multiple choice button

text: I've written the following code to create a multiple choice button that takes an arbitrary number of answer options and will assign a variable true/false depending on whether or not the correct choice is selected:               mchoice[question_, answers_, correct_, var_] :=      DynamicModule[{x},       Column[{Dynamic[var = (x == correct);], (*problem line *)         Dynamic@          ActionMenu[question,            MapThread[#1 :> (x = #2) &, {answers, Range@Length@answers}]],         PaneSelector[          MapThread[#1 -> #2 &, {Range@Length@answers, answers}],           Dynamic[x]]         }]       ]      The code is executed as below and gives the button:               Clear[avar]     mchoice["argon", {"solid", "liquid", "gas"}, 3, avar]      ![Mathematica graphics](http://i.stack.imgur.com/1PUmc.png) The correctness of the selection is stored in `avar` which I can evaluate at the end of the notebook to "grade" the quiz, if you will. The problem is the presence of `Null` above the button. With the code as written, I cannot seem to create a button that both updates the value of avar and doesn't print the answer. For example, if I substitute `Dynamic[var = (x == correct)]` for the problem line, then the student will know if the chosen answer is correct. If I use `Dynamic[var = (x == correct)];` then the result is visually correct but `avar` will not update when the student selects an answer. I _can_ get the desired result by using `Dynamic[var = (x == correct);] /. {Null ->""}` but that feels like I'm cheating (yes, I'm getting the desired result, but no, I'm not using `Dynamic` correctly). I'm interested in either of the following:   1. A better solution to my (* problem line *)   2. Alternative methods for creating a multiple choice button.


title: Non-canonical re-ordering of nested lists

text: I have some data in the form:                data = {{{d, 0.68}, {g, 0.88}, {h, 0.23}, {e, 0.15}, {b, 0.46}, {a, 0.07}},               {{d, 0.86}, {c, 0.99}, {b, 0.21}},               {{c,0.83}, {h, 0.63}, {f, 0.11}},               {{d, 0.31}, {g, 0.65}, {e, 0.88}, {a, 0.70}},               {{d, 0.58}, {g, 0.09}, {c, 0.66}, {b, 0.18}, {a, 0.15}}}      These data are essentially related to each other in the following way:               {{{d, d1}, {g, g1}, {h, h1}, {e, e1}, {b, b1}, {a, a1}},       {{d, d2}, {c, c2}, {b, b2}},       {{c, c3}, {h, h3}, {f, f3}},       {{d, d4}, {g, g4}, {e, e4}, {a, a4}},       {{d, d5}, {g, g5}, {c, c5}, {b, b5}, {a, a5}}}      The ordering of elements within each second level list is:               order1 = {d, g, c, h, e, f, b, a}      I want to collect the second term of each third level pair and rearrange the elements according to a different order:               order2 = {b, h, d, a, e, f, c, g}      so that I end up with something like:               {{b1, h1, d1, a1, e1, f1, c1, g1},      {b2, h2, d2, a2, e2, f2, c2, g2},      {b3, h3, d3, a3, e3, f3, c3, g3},      {b4, h4, d4, a4, e4, f4, c4, g4},      {b5, h5, d5, a5, e5, f5, c5, g5}}      Where an element is missing I want to replace it with a zero to obtain rows of equal length. Using numbers it would look like:                 {{0.46, 0.23, 0.68, 0.07, 0.15, 0, 0, 0.88},         {0.21, 0, 0.86, 0, 0, 0, 0.99, 0},         {0, 0.63, 0, 0, 0, 0.11, 0.83, 0},         {0, 0, 0.31, 0.7, 0.88, 0, 0, 0.65},         {0.18, 0, 0.58, 0.15, 0, 0, 0.66, 0.09}}      I am currently using                (row = #;         Map[(ordi = #; k = Flatten[Position[row, _?((ordi == #) &)]];                  If[Length[k] == 0, 0, row[[k[[1]], 2]]]) & , order2]) &/@ data      **Edit** The code in the original question is now working... (thanks @partial81 for trying it - and sorry for the confusion). However, I am still interested in discovering different ways to get the result. Any alternative suggestions would be appreciated.


title: BSplineFunction derivatives wrong if using weights?

text: In my work, I make heavy use of non-uniform rational B-spline (NURBS) functions, defined using the function `BSplineFunction` with the option defining `weights`. I never before questioned the results given by Mathematica, but it seem that I discovered something that seems like a bug. Let's use a simple example : a quarter of circle. The degree, knot vector, control point vector and weights used for this are :               d = 2;     kV = {0, 0, 0, 1, 1, 1};     P = {{0, 0}, {0, 1}, {1, 1}};     W = {1, 1/Sqrt[2], 1};      I defined the two parametric functions `x` and `y` this way :               x[t_] := BSplineFunction[P[[All, 1]], SplineWeights -> W, SplineDegree -> d, SplineKnots -> kV]][t];     y[t_] := BSplineFunction[P[[All, 2]], SplineWeights -> W, SplineDegree -> d, SplineKnots -> kV]][t];      The results obtained are perfect, `{x[t], y[t]}` is an exact quarter of circle. The problem is when I want to have the derivatives of `x` and `y`. Here is the graph I have when I plot `x'[t]` (blue) and the function I should have (computed by redefining all the NURBS functions from the beginning) ![enter image description here](http://i.stack.imgur.com/JFi0o.png) We can see that _Mathematica_ derivative is in fact `x'[t] = t b2`, which is in reality the derivative of the Spline function defined with the same degree, knot vector and control points, but uniform weights.(which is wrong) I would like to know if I made a mistake somewhere, or if it is really a bug of `BSplineFunction`.


title: How to raise the LegendLayout "Row" size

text: When using `LegendLayout->"Row"`, with a lengthy row, I get line breaks. This would seemed logic if it was confined by another structure. But if happens even when there's no "confinement":               LineLegend[{Blue, Orange, Green}, {"this is a big test",        "this is a big test", "this is a big test"}, LegendLayout -> "Row"]      ![enter image description here](http://i.stack.imgur.com/iurGp.gif) How can I change the `ItemSize`/`ImageSize` of the Legend? (should this behavior be reported?)


title: How can the evaluation queue be aborted?

text: While developing, I would sometimes like to stop evaluation of selected cells at a certain point. The following example nearly seems to work, but repeated runs of `Ctrl+A, Enter` reveal something sticking in memory. Is there a good way break out of the evaluation queue?               Print["1"]          Print["2"]          FrontEndExecute@FrontEndToken["EvaluatorAbort"]          Print["3"]          Print["4"]      _Example of the problem:_ On the fourth repetition (on this occasion) of `Ctrl+A, Enter` the first cell does not evaluate. ![enter image description here](http://i.stack.imgur.com/S5mdH.png)


title: Linear Integer Programming with absolute values in objective function

text: I'm trying to solve a problem of the form $$ \left|a_{1,0}+a_{1,1} x_1 + a_{1,2}x_2\right| + \left|a_{2,0}+a_{2,1} x_1 + a_{2,2}x_2\right|\to\min, $$ where $a_{i,j}$ are real-valued coefficients and the $x_i$ are integers. In fact, in my real problem, their are more variables and the problem looks like this: $$ \sum_{i=1}^n\left|a_{i,0}+\sum_{j=1}^ma_{i,j}x_j\right|\to\min, $$ Is there an easy way to transform this into an linear integer programming probably suitable for Mathematica? I'm not sure how to deal with the absolute values in the objective functions, and how to convert the problem into matrix form. Thanks. **Edit:** As a concrete example, consider the function               f = (x (-9 + 6 x - 8 x^2 + 3 x^3))/(4 (-3 + 3 x - 3 x^2 + x^3)) + 0.0002 Sin[50 x] + 0.0002 Sin[100 x]      which is known on the grid $0,.01,\ldots,1$. Defining               data=Table[{x,f},{x,0,1,.01}]      the problem is to recover the coefficients of $f$ from $data$, knowing that $f$ is a perturbed rational function with integer coefficients of bounded magnitude. If $f$ was not perturbed then               << FunctionApproximations`     RationalInterpolation[f, {x, 4, 3}, {x, 0, 1}]      could be used recover the coefficients (or a variant that specifies the $x_i$) Does the a priori information that the coefficients are integers allow exact reconstruction of $f$ despite the perturbation?


title: Why doesn't Compile work on Permutations function with second args?

text: Here is a narrowed-down example, the first case works, but the second one refuses to use the compiled version:                Compile[{}, Permutations[{1, 2, 3}]][]           Compile[{}, Permutations[{1, 2, 3}, {2}]][]      Full code:               Compile[{},       Module[{c, d, e, g, l, m, o, t, w, A = 10^Range[5, 0, -1]},         Do[{c, d, e, g, l, m, o, t, w} = x;         If[{w, w, w, d, o, t}.A - {g, o, o, g, l, e}.A == {d, o, t, c, o,              m}.A, Print@x], {x, Permutations[Range[0, 9], {9}]}]]       ][]


title: How to solve equations self-consistently

text: I want to solve the following equation self-consistently. So,               H.u = e.u          {{1, d}, {d, 1}}.{u1, u2} = e.{u1, u2}        1. I guess an initial value for `d`   2. Diagonalize `H` and get eigenvectors and eigenfunction `u` and `e->Eigenvector[H] Eigenvalue[H]`   3. Define `d -> d = u1 + u2`   4. Plug `d` in the matrix again   5. Diagonalize `H...` once and again until I get certain convergence, i.e., until the value I get for `d` does not change within a certain convergence range `dmin`. Of course, this a really simplified kind of problem of my actual problem I have to solve with a huge matrix. This is really easy to do in Fortran90, but I wonder how do you do this kind of things in _Mathematica_.


title: Using Control Objects with TabView

text: I have a number of different tabs on my 'dashboard'. Each tab has a few different Controls (drop down boxes) that the user makes selections with. These selections determine what is displayed on the tab in question. The controls, data, graphs etc are all known by seperate names so no control on one tab drives changes on another. My problem is that when I use these drop down controls the entire display jumps back to the default page for the TabView. I think this has something to do with := set delay or Dynamic but I can't work it out. The data comes from -               MOYGraphData := Select[Part[MonthlyFuel, 2 ;;, ;;], #[[4]] == DropDownGeneratorSelection && #[[1]] == DropDownYearSelection && #[[3]] == 0 &];           MOYGraphData1a := Partition[Riffle[Part[MOYGraphData, ;; , 2], Part[MOYGraphData, ;; , ColInDataM]], 2];          MOYGraphData2a := Partition[ Riffle[Part[MOYGraphData, ;; , 2], Part[MOYGraphData, ;; , ColInDataBaselineM]], 2];      Below is how I display it-               MOYGraph := ListLinePlot[Sort[{MOYGraphData1, MOYGraphData2}], PlotMarkers -> Automatic, PlotRange -> {{1, 12}, Automatic}, AxesOrigin -> {1, Automatic}, Ticks -> {Range[1, 12], Automatic}, PlotLabel -> "Monthly View", AxesLabel -> {"Month", YaxisTab2}, AspectRatio -> 1/11, ImageSize -> {1200, 150}]          Tab2 := Column[{Grid[{{YearHead, GenHead, MetricHead(, ChartHead)}, {DropDownYear, DropDownGenerator, DropDownMetric(, DropDownChartType)}}], Column[{HeadingTab2, MOYGraph, Column[{WeekHead, DropDownWeek, WOYGraph}], DOMGraph, Row[{GeneratorTotalWOYFuelVar, GeneratorWOYTotalFuelCons}, Alignment -> Left]}, Alignment -> Center]}, Alignment -> Left];          Dashboard := TabView[{"Introduction" -> IntroPage, "Fuel & Energy" -> Tab2, "Generator Loading" -> Tab3, "Generator Comparison" -> " ", "Data Exclusions" -> " "}, 2];          Dynamic[Dashboard]


title: Is there a better way to approximate some graphs of integrals than interpolation?

text: I'm still pretty new to Mathematica so my apologies if this is a dumb question. I wanted to plot some integrals of functions for no particularly good reason, but the only decent way I could come up with to do that in Mathematica is by getting an interpolation function from a table of points generated from my original function, and then NIntegrating that interpolation function. This seems awfully fiddly. Is there a better way that I've been too dumb to notice? Also, I wrote the "procedure" (very heavy quotes) in a block of text so I could use it later, is there a better way to write a simple program like this so that it can be called later without having to copy paste the text and run it again like I'm doing?               domainend = Input["Enter the maximum domain to calculate"]     iterator = Input["Enter the number of steps for each value of x in the domain."]     function = Input["Enter the function whose integral will be approximated."]     grdom1 = Input["Enter leftmost value to graph"]     grdom2 = Input["Enter rightmost value to graph"]     domainstart = (-domainend)          functionvar[x_] =        Interpolation[         N[Transpose[{           (Table[x, {x, domainstart, domainend, iterator}]),            (Table[function, {x, domainstart, domainend, iterator}] /. ComplexInfinity ->0)                }],          30],         x]     diff = NIntegrate[functionvar[x], {x, domainstart, 0}]     antiderivative[x_] = Integrate[functionvar[x], x]     f = Function[x, functionvar[x]]     i = Function[x, antiderivative[x]]     g = Function[x, antiderivative[x] - diff]          Plot[       {f[x], g[x]}, {x, grdom1, grdom2},          PlotStyle -> Thickness[0.0025], PlotLegends -> {function, \!\(         \*SubsuperscriptBox[\(\[Integral]\), \(0\), \(x\)]\(function \         \[DifferentialD]x\)\)}, Filling -> {1 -> {Axis, LightBlue}}     ]


title: How to draw Graphics3D items with straight border lines?

text: I want to make a `Polygon` with straight border lines. For that purpose I wrote the following code, but it doesn't show straight borders.               Graphics3D[{Style[Polygon[{{20, 0, 10}, {50, 0, 10}, {50, 0, 25}, {20, 0, 25}}],       Lighting -> {{"Ambient", LightBlue}}]}, Boxed -> False, RotationAction -> "Clip"]      How can I make a polygon with straight lines? ![enter image description here](http://i.stack.imgur.com/GrXgX.png)


title: Problem with plot of discontinuous function of 2 variables and adding legend to a contourplot

text: I have 2 problems with which I would need help: -first one is that I would like to plot a discontinuous function of 2 variables but can't succeed (see attachment) -then I also would like to display a legend with a contour plot on which there are several ellipses but can't figure out (also see attachment). I don't want the usual contourplot legend with color graduation but one like : blue->ellipse one red->ellipse two                   s1t = 90         s2t = 40         s1c = -130         s2c = -60         f[x_, y_] := (x/s1t)^2 + (y/s2t)^2 - x*y/(s1t)^2 /; x > 0 && y > 0          f[x_, y_] := (x/s1t)^2 + (y/Abs[s2c])^2 - x*y/(Abs[s1c])^2 /;      x > 0 && y < 0         f[x_, y_] := (x/Abs[s1c])^2 + (y/s2t)^2 - x*y/(s1t)^2 /;      x < 0 && y > 0         f[x_, y_] := (x/Abs[s1c])^2 + (y/Abs[s2c])^2 - x*y/(Abs[s1c])^2 /;      x < 0 && y < 0         ContourPlot[f == 1, {x, -30 Pi, 30 Pi}, {y, -45 Pi, 20 Pi},      Axes -> {True, True}]         ContourPlot[{(x/s1t)^2 - x*y/(s1t*s2t) + (y/s2t)^2 ==      1, (x/s1t)^2 + (y/s2t)^2 + x*y*(1/(s1t^2) - 1/(s2t^2)) == 1,      x^2/(s1t^2) + y^2/(s2t^2) - x*y/(s1t^2) == 1,      x^2/(s1t*Abs[s1c]) +      y^2/(s2t*Abs[s2c]) + (1/s1t - 1/Abs[s1c])*      x + (1/s2t - 1/Abs[s2c])*y +      2*x*y*1/(2*s45^2)*(1 - (1/s1t - 1/Abs[s1c] + 1/s2t - 1/Abs[s2c])*         s45 - (1/(s1t*Abs[s1c]) + 1/(s2t*Abs[s2c]))*s45^2) == 1,      x^2/Abs[(s1t*s1c)] +  y^2/Abs[(s2t*s2c)] + (1/s1t - 1/Abs[s1c])*      x + (1/s2t - 1/Abs[s2c])*y - 1/(2*Sqrt[s1t*s1c*s2t*s2c]) == 1,      x^2/Abs[(s1t*s1c)] +      y^2/Abs[(s2t*s2c)] + (1/s1t - 1/Abs[s1c])*      x + (1/s2t - 1/Abs[s2c])*y + 1/Sqrt[s1t*s1c*s2t*s2c] -      1/(2*S^2) == 1, (x/s1t)^2 + (y/s2t)^2 ==      1, (x/s1t)^2 + (y/s2t)^2 - x*y/(s1t*s2t) ==      1, (x*y - x^2)/(s1t*s1c) - (y^2/(s2t*s2c)) +      x*(s1t + s1c)/(s1t*s1c) + y*(s2c + s2t)/(s2t*s2c) ==      1, (1.95*x*y - x^2)/(s1t*s1c) - (y^2/(s2t*s2c)) +      x*(s1c + s1t)/(s1t*s1c) + y*(s2c + s2t)/(s2t*s2c) ==      1}, {x, -165 Pi, 70 Pi}, {y, -75 Pi, 30 Pi}, Axes -> {True, True},      FrameLabel -> {sigma1, sigma2}, PlotLabel -> failure surface,      AspectRatio -> Automatic]


title: Select rows of matrix that are higher than a given row

text: Imagine I have the following matrix: `X={{0,0,0},{1,0,1},{1,1,1},{1,2,1},{3,3,3}}`. I want to select the sublists that are greater or equal than this list `T={0,1,1}`. Greater in the sense that `X[[]]-T` has no negative entries. The output should look like `R={{1,1,1},{1,2,1},{3,3,3}}`, since all elements of the sublists are equal of greater than the elements of the list T compared element by element. Thanks for help! Thanks for the quick answers. I have searched myself meanwhile and found this one:               Higher[C_] := Select[B, NonNegative[Min[#[[]] - C[[]]]] &];      Does it seem right?


title: Solve equation with inequalities for parameters

text: I want to solve following equation:               Solve[{g^2 - gamma*alpha + alpha^2 -          omega*(omega*alpha)/(gamma - 2*alpha) - (omega^2*            alpha^2)/(gamma - 2*alpha)^2 == 0, gamma > 0, omega > 0,        g > 0}, alpha]      I want to become an analytic, explicit expression for alpha, but _Mathematica_ gives me only a solution with `Root`; for example, (there are more solutions):               {alpha ->        ConditionalExpression[        I Root[g^2 gamma^2 -              4 g^2 gamma Root[               g^2 gamma^2 + (-4 g^2 gamma - gamma^3 -                     gamma omega^2) #1 + (4 g^2 + 5 gamma^2 +                     omega^2) #1^2 - 8 gamma #1^3 + 4 #1^4 &, 1] -              gamma^3 Root[               g^2 gamma^2 + (-4 g^2 gamma - gamma^3 -                     gamma omega^2) #1 + (4 g^2 + 5 gamma^2 +                     omega^2) #1^2 - 8 gamma #1^3 + 4 #1^4 &, 1] -              gamma omega^2 Root[               g^2 gamma^2 + (-4 g^2 gamma - gamma^3 -                     gamma omega^2) #1 + (4 g^2 + 5 gamma^2 +                     omega^2) #1^2 - 8 gamma #1^3 + 4 #1^4 &, 1] +              4 g^2 Root[               g^2 gamma^2 + (-4 g^2 gamma - gamma^3 -                     gamma omega^2) #1 + (4 g^2 + 5 gamma^2 +                     omega^2) #1^2 - 8 gamma #1^3 + 4 #1^4 &, 1]^2 +              5 gamma^2 Root[               g^2 gamma^2 + (-4 g^2 gamma - gamma^3 -                     gamma omega^2) #1 + (4 g^2 + 5 gamma^2 +                     omega^2) #1^2 - 8 gamma #1^3 + 4 #1^4 &, 1]^2 +              omega^2 Root[               g^2 gamma^2 + (-4 g^2 gamma - gamma^3 -                     gamma omega^2) #1 + (4 g^2 + 5 gamma^2 +                     omega^2) #1^2 - 8 gamma #1^3 + 4 #1^4 &, 1]^2 -              8 gamma Root[               g^2 gamma^2 + (-4 g^2 gamma - gamma^3 -                     gamma omega^2) #1 + (4 g^2 + 5 gamma^2 +                     omega^2) #1^2 - 8 gamma #1^3 + 4 #1^4 &, 1]^3 +              4 Root[g^2 gamma^2 + (-4 g^2 gamma - gamma^3 -                     gamma omega^2) #1 + (4 g^2 + 5 gamma^2 +                     omega^2) #1^2 - 8 gamma #1^3 + 4 #1^4 &,                1]^4 + (-4 g^2 - 5 gamma^2 - omega^2 +                 24 gamma Root[                  g^2 gamma^2 + (-4 g^2 gamma - gamma^3 -                        gamma omega^2) #1 + (4 g^2 + 5 gamma^2 +                        omega^2) #1^2 - 8 gamma #1^3 + 4 #1^4 &, 1] -                 24 Root[                  g^2 gamma^2 + (-4 g^2 gamma - gamma^3 -                        gamma omega^2) #1 + (4 g^2 + 5 gamma^2 +                        omega^2) #1^2 - 8 gamma #1^3 + 4 #1^4 &,                   1]^2) #1^2 + 4 #1^4 &, 2] +          Root[g^2 gamma^2 + (-4 g^2 gamma - gamma^3 -                gamma omega^2) #1 + (4 g^2 + 5 gamma^2 + omega^2) #1^2 -             8 gamma #1^3 + 4 #1^4 &, 1], g > 0 && gamma > 0 && omega > 0]}      This is not an explicit solution. I have also tried `Reduce` without success. What can I do?


title: Calculate probability function

text: I would like to calculate the following with _Mathematica_ : > Let $X$ be a random variable with probability function $$p(x)= \left\\{ > \begin{matrix} \frac{x}{6} & \text{for }x \in \\{1,2,3\\}\\\ 0 & > \text{Otherwise} \end{matrix}\right. $$ Calculate $P(X \leq 2)$, $E(X)$ and > $var(x)$ My major problem is to create the probability function with the correct distribution since there haven't been any specific distribution informed in the task. So how do I solve this? If it is any help, then the results are respectively:               {0.5, 2.333, 0.5556}


title: Riemann-Spherical Projection of Network onto the $\mathbb{R}^2$-Plane

text: I'm trying to find a way to plot the graph               g := Graph[{a\[UndirectedEdge]b, b\[UndirectedEdge]c, c\[UndirectedEdge]a,         a\[UndirectedEdge]d, d\[UndirectedEdge]b, d\[UndirectedEdge]e, e\[UndirectedEdge]b},d\[UndirectedEdge]c]      onto a sphere, so that it can be shown that although there isn't a crossing on the sphere there is when projected on the $\mathbb{R}^2$-plane. Here is something much like what I'd like to see: $\hspace{6cm}$![enter image description here](http://i.stack.imgur.com/5Ou0v.jpg) Further, how does one manipulate a graph? I mean, move the points around as you would in reality if the vertices were connected with rubber bands. This is what I'm doing as an alternative to not knowing how to manipulate graphs in Mathematica 8: ![Image](http://i.stack.imgur.com/pK53U.jpg)


title: Why Min cannot be used as constrains of NMinimize?

text: I met a strange problem when trying to do an optimization. Initialization code,               goal = 2.;     vector = {1.0, 1.1, 1.2, 1.3, 1.4, 1.5};          f[m1_Real, m2_Real] := Block[{v},        v = Map[# + m1*Sin[Norm[{m1, m2}]] &, vector];        Clip[v, {0, goal}]];          g[m1_Real, m2_Real] := Max[(goal - f[m1, m2])/goal] + Norm[{m1, m2}];      where `f` is a vector function and `g` is a scaler function. I want to minimize `g[m1,m2]` with constrains `0.8 <= Min[f[m1,m2]] <= 1.0` and `0 <= m1 <= 2 && 0 <= m2 <=2`. Despite this seems straightforward, a direct implementation is problematic,               counter = 0;     NMinimize[{       g[m1, m2],       And[0.8 <= Min[f[m1, m2]]/goal <= 1.0, 0 <= m1 <= 2, 0 <= m2 <= 2]       }, {m1, m2},       Method -> {"NelderMead", "Tolerance" -> .001},       StepMonitor :> (Print[++counter, ":\t", {m1, m2}])]      If we execute the code, an error message NMinimize::bcons will be shown, which tells us that the constrains are not in the valid format. After a few tests I found out that the the problem is related to the command `Min` used in the first constrain `0.8 <= Min[f[m1, m2]]/goal <= 1.0`. If we do not use `Min` then there will be no problem, i.e., `0.8 <= Evaluate[Norm[f[m1, m2]/goal]] <= 1.0` can be evaluated without any problem. So it seems that `Min` is not valid for using as constrains with `NMizimize` (yet we can use `Norm`, `Plus`, etc.). But this is really inconvenient because I do need to use `Min` as part of the constrains. I wonder if we can fix this problem?


title: How to change the color of specified digits in a number?

text: I've been playing with numerical approximations for irrational numbers, and would find it convenient to be able to highlight where these approximations deviate from the known correct answers. For example, it would be nice to be able to output a number that looks like ![not quite Pi](http://i.stack.imgur.com/dBto7.png) where most of the digits have the default Output format, but after a specified number of digits, a different format (bold and red in this example) applies. What would be the most elegant way to accomplish this?


title: PlotRangeClipping not working correctly with small ImageSize and PDF-export

text: Although Mathematica has some nice plotting capabilities, there are some things which are annoying me: I like to export a Graphics oder Plot to PDF for use in $\LaTeX$. I like to a have an ImageSize of the PDF file, which corresponds to the image size in my document (e.g. 6 cm). I don't like to scale my image in $\LaTeX$. When exporting to PDF the `PlotRangeClipping` does not work as expected (especially when having a small `ImageSize`):               cm=72/2.54;     p1 = Graphics[{EdgeForm[{Red, Thickness[.1]}], FaceForm[], Disk[]},       Frame -> True,       PlotRange -> {{0, 1}, {0, 1}},       PlotRangeClipping -> True,       ImageSize -> 6 cm]     Export["p1.pdf", p1]          p2 = Graphics[{EdgeForm[{Red, Thickness[.1]}], FaceForm[], Disk[]},       Frame -> True,       PlotRange -> {{0, 1}, {0, 1}},       PlotRangeClipping -> True,       ImageSize -> 26 cm]     Export["p2.pdf", p2]      While the PlotRangeClipping for in the second generated file (p2.pdf) is more or less okay (not perfect), ![p2.pdf magnified](http://i.stack.imgur.com/kvJKA.png) there are serious problems in p1.pdf: ![p1.pdf magnified](http://i.stack.imgur.com/tvn1q.png) Is this a bug? Is there a way to have an acceptable PlotRangePadding with a small ImageSize?


title: While loop doing cell evaluation not completing

text: I am trying to get a loop structure using `While` to repeatedly evaluate another cell referred to in its body (using a cell tag).               "this is the while construct";     x = 2;     y = 5;     While[x < y,       NotebookLocate["code"];       FrontEndTokenExecute["EvaluateCells"];       x       y     ]      and this is the cell called "code"               "this cell contains the code i want to run";     x = x + 0.1;     y = y - 0.1;      My code seems to enter an endless loop. What I expected was when the two numbers, x and y, became equal, the loop would stop. What am I doing wrong?


title: how to make a pie chart using custom image

text: Can we make a pie chart using a costumed picture? For example, in representing the 0.1 cent, I would like to use this image and cut a piece out, and make a clickable pie chart. Any suggestions are appreciated. ![enter image description here](http://i.stack.imgur.com/8I3B1.jpg)


title: Finding parameters making real part of eigenvalues vanish

text: I have the following $\;3\times3$ matrix: $\left( \begin{array}{ccc} 0.04 -0.4 b & 0 & 0.04 -0.4 b \\\ 0 & -0.08-1.2 b & -0.06-0.9 b \\\ 1.04 -0.4 b & 2.08 -0.8 b & 0 \end{array} \right)$ I want to find the $b$ values that make any of the eigenvalues of this matrix is $0$. When I calculate the eigenvalues I get the following: > >     {Root[- 0.00832 - 0.0384 b + 1.264 b^2 - 0.48 b^3 + (0.08 + 2.24 b - 0.4 > b^2) #1 >           + (0.04 + 1.6 b) 2 + 1. #1^3&, 1], >      Root[- 0.00832 - 0.0384 b + 1.264 b^2 - 0.48 b^3 + (0.08 + 2.24 b - 0.4 > b^2) #1 >           + (0.04 + 1.6 b) #1^2 + 1. #1^3&, 2], >      Root[- 0.00832 - 0.0384 b + 1.264 b^2 - 0.48 b^3 + (0.08 + 2.24 b - 0.4 > b^2) #1 >           + (0.04 + 1.6 b) #1^2+1. #1^3&, 3]} >   Now I want to get the $b$ value that makes the real part of any of the eigenvalues $0$ with the following command:               Map[ NSolve[ Re[#] == 0 && b ∈ Reals, b] &, eigs]      _Mathematica_ finds that the real part of the first eigenvalue will never be $0$, hence produces an empty set. However, for the roots $2$ and $3$, it does not evaluate the command. Also, first root is 0 when $b=0.1$ as I can see it in the plot below (red dots). ![Eigenvalues with respect to $b$](http://i.stack.imgur.com/mR71F.png) Is there any way to find $b$ more effectively?


title: Images as labels of barChart

text: I'm trying to create a BarChart on which images are the labels of each bar. A Minimal example of what I'm trying to do:               image1 = Import["test1.png"];     image2 = Import["test2.png"];     image3 = Import["test3.png"];     BarChart[{0.4, 0.2, 0.8}, ChartLabels -> {image1, image2, image3}]      The problem is the position of the image on the label. The image is not resized to fit within the Bar width, and so it fills a great part of the plot. Another problem is that the image is not centered: the bottom left corner of it is on the label's expected position, and not the center of it. Any ideas how I can solve this? EDIT: as example of an image, wikipedia's picture of the day:               image1=image2=image3=Import["http://upload.wikimedia.org/wikipedia/commons/thumb/a/a5/Cabiria_1914_poster_restored.jpg/401px-Cabiria_1914_poster_restored.jpg"]      works for the problem in hands. (Thanks J.M. for pointing out)


title: Conditional T distribution

text: Suppose $(X,Y)$ has a bivariate t distribution. I want to plot the density of the conditional density of $Y$ given $X$, i.e. $Y|X$. I wonder why the following does not work:               bivT = MultivariateTDistribution[{{1, \[Rho]}, { \[Rho], 1}}, \[Nu]]     bivTCond[x_, y_, \[Nu]_, \[Rho]_]:=          Evaluate@PDF[bivT, {x, y, \[Nu], \[Rho]}] /           Evaluate@PDF[StudentTDistribution[0, 1, \[Nu]], {x, \[Nu]}]     Plot[bivTCond[1, y, 3, 0.5], {y, -3, 3}]      The last command does not produce any plot.


title: Silence debug output from Parallelize?

text: I have this script, which does a bunch of image aligning in parallel: https://gist.github.com/8848a25a15da013ed1ad However, on EVERY print, Mathematica also prints from what Kernel the message came and what the kernel's status is, etc. Is there a way to supress these debug messages? Edit: The messages in question are these: https://gist.github.com/e8ae961dc46c66ed809f And example images are available here: http://dl.dropbox.com/u/10190786/done.zip


title: MySQL Connection Problem

text: I have a problem with the configuration of the J-Connector plug-in with a MySQL database. Most of the time all works well, but sometimes the connection remains blocked for 2 hours and then it gives this error:               JDBC::error: "Communications link failure\n\nThe last packet successfully      received from the server was 7,200,110 milliseconds ago.  The last packet      sent successfully to the server was 7,200,047 milliseconds ago."      Note: I'm executing the query right after the connection is set, without waiting. It seems that the query is fetching results (with Mathematica running), but instead it remains blocked for 2 hours and then it fails. Edit: I have noticed that the connection is correctly estabilished, then during the execution of the query it magically disappears (I have seen this checking the `SHOW PROCESSLIST` with another connection to database), but the JDBC driver didn't know anything about this and then after 2 hours it gives the error. It looks like it has a 2 hours timeout (7,200,000 milliseconds) which I didn't set, my question is: how can I set it to a more reasonable time (like 1 minute)? So I can catch the error and re-execute the query without waiting for a long time. Or, anyway, do you have any other solution to handle MySQL connection problems?


title: Alternative to overloading Set

text: In the ideas shared in my answer to this post Struct equivalent in Mathematica? at the end I propose a solution that changes the way Set works in a particular case that can be expressed in plain words If I see something like x[u][key]=value where u is a symbol then assign value to u[key] (DownValues of u) instead of assigning value as a SubValues of x. The corresponding code               ObjectSet[(_[symbol_Symbol]|symbol_),key_,value_]:=symbol[key]=value;          Unprotect[Set];     Set[symbol_[key_],value_]:=        Block[{$inObjectSet=True},           ObjectSet[symbol,key,value]        ]/;!TrueQ[$inObjectSet];     Protect[Set];      This is needed for what I want to do as Set has a HoldFirst attribute, so I pass the left hand side to a function that will evaluate it. An example after having executed the code above               x[u]["key"]=3     DownValues[u]      Leonid expressed his concerns to this solution of modifying Set in case it becomes widespread. What could be alternatives to this way of doing ?


title: Does Mathematica implement the fast Fourier transform?

text: Is there a fast Fourier transform in _Mathematica_? Although looking in the help I could not find one. I am looking to implement the equivalent of `fft` in MATLAB.


title: Isolating a prefactor in an analytical expression

text: I have a large mathematica expression that looks roughly like               f = A1 Exp[a1 x] + A2 Exp[a2 x] + b1/x + b2/x^2 + c0 + c1 x + c2 x^2         where all the $A_n,a_n,b_n,c_n$ are symbolic constants.   how can I isolate the prefactor of x ? i.e some function that checks the pattern of $f$ and returns $c_1$ ?


title: How can I add a logo to a presentation?

text: I am trying to make a presentation with Mathematica and would like to know if there is a way to add a logo that will show in every slide. I have not found any settings that would allow me to do that automatically and would like to know if there is a straightforward way of implementing this. I tried using a custom template with the logo but this also seemed impossible since custom templates are not possible, to my knowledge, with Mathematica presentations. Any help is appreciated


title: Suppress negative y-axis in ListLinePlot even if all values are zero?

text: I have some lists that will always contain non-negative values, sometimes all zeros. Whatever non-negative values appear in the list, I would like the plots to appear without a negative y-axis. I'll use constant arrays instead of real data for the purpose of this message:               ListLinePlot[ConstantArray[0, 640], PlotRange -> {Full, {0, Full}}]      ![zero case](http://i.stack.imgur.com/Xco0U.jpg)               ListLinePlot[ConstantArray[1, 640], PlotRange -> {Full, {0, Full}}]      ![one case](http://i.stack.imgur.com/dS6VW.jpg) Ignore the aspect ratios... Doesn't the `{0, Full}` portion of `PlotRange -> {Full, {0, Full}}]` specify that I don't want to see anything under y == 0? If so, why does the first plot (zeros) produce a negative y-axis and is there any way to suppress it?


title: How can autocomplete entries be added for DownValues and Properties?

text: I'd like to assign `DownValues` to a symbol like this               x["firstvalue"] = 1;     x["secondvalue"] = 2;      And then have the `DownValue` keys `"firstvalue"` and `"secondvalue"` offered in an autocomplete list once I have entered `x[`. Another useful application for this kind of modification is to have the `"Properties"` of an object like a `FittedModel` added to the autocomplete list. It is not always easy to remember `"SinglePredictionConfidenceIntervalTableEntries"`, which is one of the 64 properties of `FittedModel`. Can this be done? What controls the entries in the autocomplete "engine"? ### Addendum This amazing answer shows a way of altering the behavior of autocomplete. I do not yet understand how it works.


title: Vary the thickness of a plotted function

text: I know, that I can change the color of a function with the help of PlotStyle:               Plot[Sin[x], {x, 0, 3 Pi}, PlotStyle -> {Green, Thickness[0.01]}]      I also know, that I can vary the color in relation to the function value:               Plot[Sin[x], {x, 0, 3 Pi}, PlotStyle -> {Thickness[0.01]},       ColorFunction -> "BlueGreenYellow"]      I wonder if it is possible to change the thickness of a plotted function dependent on the function value, for example the absolute value of the function. For the example above a nice thing would be to have, that the line is e.g. **twice as thick** at the minima and the maxima as it is at the roots.


title: Replace rule with function? Derivatives don't evaluate

text: Say I have an expression (call it expr) involving a function, f[x]. I'd like to be able to evaluate that for a particular choice of f[x] without setting that choice for the whole session. I thought to do this using a replacement,               expr /. f[x_]->x^2      (where expr is some expression involving f[x] and I want to set f to x^2), but this doesn't work on derivatives, e.g., if expr contains f'[x] then it will stay as f'[x] rather than become 2x. What's the best solution to this problem?


title: Import multiple files from folder in order of date added

text: I have a folder that contains certain files I want to import. In my case those are .png files. As all the files I want to import contain the phrase "accum" in their filenames, I can use               SetDirectory[directory]; (*directory is string of the directory that contains the files*)     importString = "./*" <> "accum" <> "*";     files = Import[importString];      to obtain a list consisting of all the images I wanted to import. Of course this list is sorted by filename. What can I do to tell `Import` that the files should not be sorted by "name" but by other options like "date added" (which is what I want)?


title: SpaceFillingMolecularPlot using CAS number of a compound

text: When I tried to get 3D graphics for molecule CAS52364-73-5 using _Mathematica_ 10 it produced following result               ChemicalData["CAS52364-73-5", "SpaceFillingMoleculePlot"]      > >     Missing["NotAvailable"] >   but it makes a plot for caffeine. How can I get for my compound?               ChemicalData["Caffeine", "SpaceFillingMoleculePlot"]      How can I get a plot for my compound?


title: How to remove repeated permutations?

text: I want to get the Permutations on the elements of a list. Then I'm doing this:               a = Drop[Permutations[Range[1, 16], 2], {1, 17}]     i = 15;     While[i <= (240 - 16), a = Drop[a, {i, i}]; i = (i + (16 - 1))]      The first line of the code gives me all the permutations, but I do not want repetitions, like: I already have `{1,2}`, I do not want the `{2,1}`. I'm trying to do this way but there's no result yet. Any help?


title: Minimization by Nelder-Mead

text: Finding a global minimum for this problem (non-linear optimization by the Nelder-Mead downhill simplex method) may not be possible, but by finding local minimum, I am expecting the value of the function at the minimum is around 1 or (far) less than 1 (the lower the value, the better is the answer). `"Nelder-Mead"` method is available for `NMinimize` in _Mathematica_. The problem I am facing is, even though I am changing the method options for Nelder-Mead (for example, `"ShrinkRatio"`, `"ContractRatio"`, `"ReflectRatio"`, and so on) and also initializing the calculation for different initial values (which is chosen by the `"RandomSeed"`), I am getting minima which are way greater than 1. I found people deal these kind of problems by writing codes either in C++ or Fortran and the results are good, but I know neither of them so I am trying to do it with _Mathematica_ using the built-in functions. Here is the what I am trying (a simplified version of the original problem that I have to deal with which has even more number of parameters):               A = ({{a11, 0},{0, a22}});     B = ({{b11, b13},{b13, b22}});     M1 = A + Exp[I phi] B;     M2 = a A + b Exp[I theta] B;     M3 = a A - 3 b Exp[I theta] B;     m1 = Abs[Eigenvalues[M1]];     m2 = Abs[Eigenvalues[M2]];     m3 = Abs[Eigenvalues[M3]];               t1 = T1[a11_?NumberQ, a22_?NumberQ, b11_?NumberQ, b22_?NumberQ,      b13_?NumberQ, phi_?NumberQ] = m1[[1]];     t2 = T2[a11_?NumberQ, a22_?NumberQ, b11_?NumberQ, b22_?NumberQ,      b13_?NumberQ, phi_?NumberQ] = m1[[2]];          t3 = T3[a11_?NumberQ, a22_?NumberQ, b11_?NumberQ, b22_?NumberQ,      b13_?NumberQ, theta_?NumberQ, a_?NumberQ, b_?NumberQ] = m2[[1]];     t4 = T4[a11_?NumberQ, a22_?NumberQ, b11_?NumberQ, b22_?NumberQ,      b13_?NumberQ, theta_?NumberQ, a_?NumberQ, b_?NumberQ] = m2[[2]];          t5 = T5[a11_?NumberQ, a22_?NumberQ, b11_?NumberQ, b22_?NumberQ,      b13_?NumberQ, theta_?NumberQ, a_?NumberQ, b_?NumberQ] = m3[[1]];     t6 = T6[a11_?NumberQ, a22_?NumberQ, b11_?NumberQ, b22_?NumberQ,      b13_?NumberQ, theta_?NumberQ, a_?NumberQ, b_?NumberQ] = m3[[2]];          O2 = 0.235; O1 = 72;     E2 = 0.031; E1 = 0.87;          O4 = 0.0222196; O3 = 0.958157;     E4 = 0.006198; E3 = 0.018862;          O6 = 0.0941698; O5 = 1.60087;     E6 = 3.6079*^-7; E5 = 0.00026;          function[a11, a22, b11, b22, b13, a, b, phi,theta] =      ((t1 - O1)/E1)^2 + ((t2 - O2)/E2)^2 + ((t3 - O3)/E3)^2 + ((t4 - O4)/E4)^2 +     ((t5 - O5)/E5)^2 + ((t6 - O6)/E6)^2;          Do[Print[NMinimize[     function[a11, a22, b11, b22, b13, a, b, phi, theta],      {a11, a22,b11, b22, b13, a, b, phi, theta},     Method -> {"NelderMead", "ShrinkRatio" -> 0.5,"ContractRatio" -> 0.7,     "ReflectRatio" -> 1, "ExpandRatio" -> 2,"RandomSeed" -> j}]], {j, 5}]      Five random iterations (with different initial conditions chosen randomly) find different minima but all are much greater than the expected result. Here they are:               (* {9081.63     {a11->0.0585825,a22->1.22145,b11->-0.26137,b22->0.327416,b13->-0.158818,     a->-1.2025,b->0.168387,phi->-1.01436,theta->0.698082}}          {32448.8     {a11->-0.542868,a22->0.845826,b11->1.10494,b22->0.739838,b13->-0.16513,     a->0.795721,b->0.346771,phi->-0.369352,theta->-0.077746}}          {7122.85     {a11->0.0846693,a22->-0.643122,b11->-0.0834931,b22->-1.14742,b13->-0.37268,     a->1.36398,b->-0.208855,phi->-0.367912,theta->-0.359771}}          {14919     {a11->-0.14745,a22->-0.0507363,b11->0.414601,b22->0.306933,b13->0.420321,     a->0.364225,b->0.663577,phi->-0.625049,theta->-0.33245}}          {13582.6     {a11->-0.182997,a22->0.431253,b11->0.201061,b22->0.507661,b13->0.258584,     a->-0.471931,b->0.741867,phi->-0.5953,theta->-0.0911202}} *)      I tried with different combinations of the Nelder-Mead options with no improvements. The default value of the `MaxIterations` is 100, and I also tried by increasing the number of iterations by using the package of Nelder- Mead from the excellent post Shaving the last 50 ms off NMinimize by Oleksandr R., but again did not get any improvement. Can anyone help me with what I am missing?


title: rule-based implementation of an algorithm

text: When I first started learning about rule-based programming with _Mathematica_ , I tried to translate this algorithm for computing the convex hull of a set of 2-D points in $O(n \log(n))$ time, to use rule-based replacement. For convenience, I'll paste the pseudocode of the algorithm below: > Input: a list P of points in the plane. > >   * Sort the points of P by x-coordinate (in case of a tie, sort by > y-coordinate). > >   * Initialize U and L as empty lists. The lists will hold the vertices of > upper and lower hulls respectively. > >   * for i = 1, 2, ..., n: > > while L contains at least two points and the sequence of last two points of > L and the point P[i] does not make a counter-clockwise turn:   >  remove the last point from L   >  append P[i] to L > >   * for i = n, n-1, ..., 1: > > while U contains at least two points and the sequence of last two points of > U and the point P[i] does not make a counter-clockwise turn:   >  remove the last point from U   >  append P[i] to U > >   * Remove the last point of each list (it's the same as the first point of > the other list). > >   * Concatenate L and U to obtain the convex hull of P. Points in the result > will be listed in counter-clockwise order. > (Actually, I used a version of this algorithm from the book "Computational Geometry" by de Berg & others, but it's pretty much the same thing except for the "counter-clockwise turn condition" that uses determinant instead of cross- product, which isn't really relevant to this question.) This was my implementation, which has the same end result as the stated algorithm, but as you can see doesn't operate quite the same way:               convexHullPM[pts_] := Module[{li, isRightTurn},        isRightTurn[p1_, p2_, p3_] :=           Sign[Det@MapThread[Prepend, {{p1, p2, p3}, {1, 1, 1}}]] == -1;       li = Sort[pts];       li = Join[li, Reverse@Most@li];       li //. {pre___, a_List, b_List, c_List, post___} :>              {pre, a, c, post} /; Not[isRightTurn[a, b, c]]]      It works, giving the same sequence of points as _Mathematica's_ own `ConvexHull` function from the Computational Geometry Package. However it's slow (referring to its time complexity, as the input size increases); timings with increasingly larger sets of input points seem to indicate $O(n^2)$ complexity, which seems about right - because the way I constructed the rule in _Mathematica_ , it starts matching from the start every time a replacement is made. Whereas the listed algorithm has the notion of a current point, and points are removed from the set (if need be) from the most recent points. So what would be a better rule-based implementation?


title: using array elements in minimization

text: I have switched from mupad to _Mathematica_ , however the syntax is completely different here. I want to               Minimize [{Sum[(y[[i]]-3)^2,{i,1,c}], Sum[y[[i]],{i,1,c}]==10},y[[i]]]      for parameter `c`. _Mathematica_ shows me > Part::pspec: Part specification i is neither a machine-sized integer nor a > list of machine-sized integers. Would you please help me


title: Solve and plot an equation that is dependent on a transcendental equation

text: I am trying to plot a function that uses the values of a transcendental equation as its input values:               y = Tanh[(2 y + x)/2.5]     z = 2.5 * Log[2*Cosh[(2 y + x)/2.5]]      for $x = [-1.5, 1.5]$. I am a relative newbie to _Mathematica_ , so I am at a complete loss as to how to go about this. I have successfully plotted the transcendental equation itself using `ContourPlot`, and mathematically I know what to do - but I can't for the life of it figure out how to make _Mathematica_ solve these two equations and plot the result. I find the _Mathematica_ notation to be somewhat cryptic, but I really love the results, so I want to get good at it. Can somebody help?


title: Welcome screen (V9): selecting notebook from Open Recent ... results in initialization cells not evaluating

text: The following represents an abbreviated example of more complicated code, but it replicates a problem the more complicated code encounters.               f[x_, y_] := Module[{o1, o2},       o1 = 2 x;       o2 = 3 y;       Column[{o1, Button["Save data to file", w = Print[o2], Method -> "Queued"]}, Frame -> True]]          z = "";     Grid[{{"input1", InputField[Dynamic[x]]},{"input2", InputField[Dynamic[y]]},{"A button", Button["Evaluate", z = f[x, y], Method -> "Queued"]}},Frame -> True]          Dynamic[z]      I put this code in an `InitializationCell`. When I launch the notebook containing this initialized cell either directly by clicking on the notebook's icon or by selecting it from Mathematica's `File >> Open`... menu, the notebook runs the code on startup as one would expect: ![enter image description here](http://i.stack.imgur.com/CavZG.png) BUT.... When using OS X, Mathematica 9, by default launches a "Welcome to Wolfram Mathematica 9" display. ![enter image description here](http://i.stack.imgur.com/jL2d9.png) If I select the same notebook from the above (by clicking on the correct "Open recent ...." selections) the `InitializationCell` fails to run when the notebook opens. What gives? I can certainly choose not to launch anything from this apparently problematic Welcome screen, but this presents a larger problem if one needs to deploy a Mathematica application to some end user over whom's environment one doesn't have complete control. This kind of inconsistency does not help an end user's confidence in the platform. Can anyone explain why this happens? Does this Welcome screen point to a cached version of the notebook for which it thinks the initialization cells have already run? But remember that this only happens when launching Mma. Can one set anything in a notebook or in the Options Inspector to stop this from happening?


title: How to use Assuming and If together?

text: I would like to compare variables `t` and `u` and print either `Yes` or `No` depending one which is larger. My code is simply the following:               Assuming[t < u, If[t - u < 0, Print[Yes], Print[No]]]      Since `t < u` is assumed, `t - u < 0` holds. So I should get `Yes`. But what I get is a repetition of `If` term. That is,               If[t - u < 0, Print[Yes], Print[No]]      Am I missing something?


title: Plotting a large number of data points

text: I would like to know how to plot when I have a large number of points (arround 600) in a specific format:               X          Y     1.000E-03 1.251E+01      1.500E-03 1.201E+01      2.000E-03 1.144E+01      2.484E-03 1.088E+01      2.484E-03 1.088E+01      2.534E-03 1.082E+01      2.586E-03 1.076E+01      2.586E-03 1.076E+01      3.000E-03 1.027E+01      3.066E-03 1.019E+01      3.066E-03 1.019E+01       All I need is to draw a line trought those points, but it would be anoying to write points in format `(x1,y1), (x2,y2), ...`. It would be tedious if I had to insert the commas and braces by hand for every pair of points coordinates. I'm totaly new in _Mathematica_ and I would appreciate help.


title: How to output local variables when error message is generated without interrupting evaluation?

text: I am running a calculation to generate a dataset. I use several iterations to sweep over a parameter space. A few times an error message is generated (which is not the problem per se). Is it possible to output the value of the iterative variables (or other local variables) for each generation of an error message, without interrupting the evaluation, in order for me to check what is going wrong? I tried (without success)something like this:               messageHandler = If[Last[#], Print[i]] &;     Internal`AddHandler["Message", messageHandler];      for a code that could be something like:               For[i=1,i<=imax,i++,      (*code*)        ]      My code is of course much more complex so that I do not want to use Trace, that outputs a huge amount of data that I cannot read. I tried the debugger in the WorkBench but it seemed like I could not access the local variables after a message interruption. Anyone has a simple Idea?


title: How do I plot a histogram with hatched shading?

text: I can plot an ordinary histogram with blue shading and black borders like this:               T = RandomVariate[NormalDistribution[0, 1], 10000];     Histogram[T, 30]      And I can simulate hatching like this:               T = RandomVariate[NormalDistribution[0, 1], 10000];     Histogram[T, 30, ChartElements -> Graphics[{Black, Line[{{0, 0}, {1, 1}}]}]]      How can I get the hatching and the black borders at the same time?


title: How can I run MUnit tests outside of Workbench under Linux?

text: I would like to run MUnit tests from the command line. On Mac OS, I can do this:               AppendTo[$Path, "/Applications/Wolfram Workbench.app/configuration/org.eclipse.osgi/bundles/13/1/.cp/MathematicaSourceVersioned/Head"];          << MUnit`      and then use the MUnit functions such as TestRun to run the tests. However, on Linux, the MUnit package is stored within a jar file (com.wolfram.eclipse.testing_2.0.126.jar), rather than being "bare" in the filesystem. Workbench must be able to load the package; is it possible to load MUnit from the jar file? One solution would be to extract MUnit into a temporary directory each time you wanted to load it, but this is quite ugly.


title: List manipulation - End loop

text: Given are two matrices (a & b). I want to end the For-loop if **all** values in the matrix (a minus b) are smaller than 7, in contrast to **any** value in the matrix (a minus b) is smaller than 7. Can anybody help me with this problem?               For[Q = 0, Q <= 20, Q += 1,       Print[Q];       Print[a = {{40, 40, 40}, {40, 40, 40}, {40, 40, 40}}];       Print[b = Q {{4, 4, 4}, {4, 3, 4}, {4, 4, 4}}];             compare[matrix_, length_, width_, value_] :=         Module[{state}, state = False; For[i = 1, i <= length, i++,           For[j = 1, j <= width, j++,            If[matrix[[i, j]] < value, state = True]]]; Return[state]];            If[compare[a - b, 3, 3, 7], Break[],]];


title: Implementation of a recurrence relation for the polynomials appearing in the large order asymptotics of the Bessel functions

text: I would like to implement the recurrence relation for the polynomials $U_n(x)$ appearing in the large order asymptotics of the Bessel functions. The recurrence in question is $$U_{n+1}(x)=\frac{1}{2}x^2(1-x^2)U_n^{\prime}(x)+\frac{1}{8}\int_{0} ^x(1-5t^2)U_n(t)dt,$$ with $U_0(x)=1$. I saw implementations for recursions for polynomials, but this one involves integration and differentiation. Any idea? Thank you very much in advance!


title: `Slot` (#) interfering with evaluation

text: In the following I am using one function `makeFunc` to assemble two functions `a[t]` and `b[t]` to pass to use in the formation of a `Table`. `makeFunc` appears to be doing its job appropriately because the error messages and `Trace` show that it has assembled `a[t]` and that the `Table` construct has evaluated the `t` portion of the function. However, `a[t]` is not evaluating itself and so the `Table` appears as `a[0]`, `a[30]`, etc.               tempMakeTableAn[{analEqs_, concs_, initConcs_, rateConstants_,          timeDom_, timeInc_}] :=       Module[{a, b},        a[t_] :=          aZero Exp[-k1 t] /. Evaluate[Join[initConcs, rateConstants]];        b[t_] :=          bZero + 1 - aZero a[t] /. Evaluate[Join[initConcs, rateConstants]];             makeFunc[conc_, time_] := Evaluate[conc[time]];             Column[{Table[{a[t], b[t]}, {t, 0, 300, 30}],          Table[makeFunc[#, timeDom[[1]]] & /@ concs, {t, 0, 300, 30}]}]         ];          tempMakeTableAn[{{Hold[a[t_] := aZero Exp[-k1 t],          b[t_] := bZero + 1 - aZero a[t]]}, {a, b}, {aZero -> 1,         bZero -> 0}, {k1 -> .01}, {t, 0, 300}, {30}}]      > { {{{1, 0}, {0.740818, 0.259182}, {0.548812, 0.451188}, {0.40657, 0.59343}, > {0.301194, 0.698806}, {0.22313, 0.77687}, {0.165299, 0.834701}, {0.122456, > 0.877544}, {0.090718, 0.909282}, {0.0672055, 0.932794}, {0.0497871, > 0.950213}}}, > > {{{a[0], b[0]}, {a[30], b[30]}, {a[60], b[60]}, {a[90], b[90]}, {a[120], > b[120]}, {a[150], b[150]}, {a[180], b[180]}, {a[210], b[210]}, {a[240], > b[240]}, {a[270], b[270]}, {a[300], b[300]}}} } This appears to have something to do with the way that I am utilizing the `Slot` (#) as you can see that when I entered in `a[t]` and `b[t]` directly, the `Table` works. I _think_ that this may have to do with scoping of the variables, because if I remove `a` and `b` as declared variables in the `Module`, everything works as expected. I.e. `a` and `b` get defined globally and the expected `Table` appears. I have also tried some judiciously placed `Evaluate` statements to see if that is what was needed, but that didn't make any changes. I have found a couple of questions that I thought might be applicable (Using pure functions in Table,Evaluate[] seems to not work inside Button[]), but since the construct works when the variables are declared globally, I don't understand why it doesn't work when they are declared within the module. Any help would be appreciated. [If somebody can come up with a better Title, have at it. This was the best that I could figure out].


title: Hardware Performance Metrics for Mathematica

text: Dear Mathematica users I am looking into buying a new computer and Mathematica is one of the main applications I run. To help me assess the overwhelming welter of choice out there:   1. I'd like to know whether there are any system performance metrics, along the lines of those measured by Geekbench http://browser.primatelabs.com/processor-benchmarks, defined specifically for working with Mathematica, and whether there are any tables on the web comparing currently sold machines.    2. It would also be very helpful if these metrics came with detailed descriptions of what they mean. I haven't been able to find a clear definition of what Geekbench numbers mean - e.g. does a measurement of 2000 mean a machine that runs roughly twice as fast as one measuring 1000 and what exactly was it doing when it was running. Many thanks in advance


title: How secure is J/Link?

text: Are there security concerns with using J/Link? If so, is there any way to encrypt the data passed between Mathematica and Java? If Mathematica and the JVM are running on the same machine, is there any reason to worry about this?


title: Bincounting a list

text: I'm a Mathematica novice here. I'm trying to execute the following code to add random 1's into a zero matrix, repeat this many times, and then bin/histogram the number of nearest neighbor 1s. Can anyone help me out with what I need to do to transform my list so that bincounts will play nicely?               ClearAll["Global`*"];      (*clear global variables*)     n = 10;       (*set number of diluent elements*)     Do[         b = SparseArray[{1, 1} -> 0, {100, 1},0];          (*generate zero matrix*)         a = RandomSample[Range[100],  n];          (*select random sites to add elements *)         Do[b[[a[[i]]]] = 1, {i, n}];          (*insert elements*)         e[i] = b;      ,         (*generate iterated variable to record each run*)          {i,50}     ];      (*loop i times*)     f = Table[e[i], {i,1,50}];     (*generate list from iterated variable*)     Do[g[j, i] = f[[j, i]] + f[[j, i + 1]], {j, 50}, {i, 99}];     (*sum nearest neighbors and loop over data set*)     h = Table[g[j, i], {i, 1, 99}, {j, 1, 50}] ;      (*create an indexed list variable*)     BinCounts[h, {0, 3, 1}]      Where Bincounts returns the error: "BinCounts::vectmat: The first argument is expected to be a vector or matrix"


title: ArrayPlot: space between displayed data and frame

text: When I execute the lines               data1 = Table[i + j, {i, 10}, {j, 1}];     data10 = Table[i + j, {i, 10}, {j, 10}];     opts = {ImageSize -> {Automatic, 300}, BaseStyle -> {FontSize -> 14}, ImagePadding -> 25};     bothPlots = Row[{ArrayPlot[data1, opts], ArrayPlot[data10, opts]}]      I get the following picture: ![enter image description here](http://i.stack.imgur.com/xq2At.png) The space between plot data and frame of the 1x10 array is much smaller than the space between the plot data and frame of the 10x10 matrix. Is there a possibility to avoide that or to set that space manually?


title: Retrieving PlotRange form BarChart

text: Consider the following data:               data1={73.9377, 54.4122, 53.0826, 24.1936};     data2={76.828, 49.1673, 45.7883, 18.9015};      I defined my own BarChart as follows:               MyBarCharts[list_]:=       BarChart[        list,        Frame -> {{True, None}, {True, None}}      ]      When applying MyBarCharts to `data1` and `data2` I get (not really surprising) two different (with regard to the coordinate system) plots. Now I would like to have for both plots the exact same coordinate system. I know that with `Histogram` it works as follows:               Histogram[     data2,     PlotRange -> Part[PlotRange /. Options[Histogram[                                            data1,                                            PlotRange -> Automatic                                            ],PlotRange], 2],     Frame -> {{True, None}, {True, None}}]      But the implementation of that approach in MyBarChart does not give the desired result. Has anyone an idea?


title: Symbolic solution of irrational equation

text: Is there any a nice looking solution to the following equation?               eq[x_] := 2 x q1 - 2 q2/x^3 - (4 x^3 q3 - 4 q5/x^5)/(4 Sqrt[x^4 q3 + q4 + q5/x^4])      Better than the one _Mathematica_ gives as output?                Solve[ eq[x] == 0, x]


title: Issue in ParallelTable after evaluating another function using NDSolve and FindRoot. What is wrong with this inverse?

text: I am trying to find the inverse of a function which is defined through `NDSolve` and `NIntegrate`. The question is pretty similar to How to invert an integral equation. Just that in my case $g_1(x)=1$ and $g_2(x)$ is the solution of an NDSolve. Following the first answer http://mathematica.stackexchange.com/a/4604/6138, I tried to implement this using `NDSolve` and `FindRoot`, but I get an error message and I don't understand where it comes from. The bug appears in the fact that if I don't evaluate the inverse function, there is no problem with ParallelTable or Table. After evaluating the inverse function, ParallelTable (but not Table) shows me the same error message. I would also like to know why FindRoot doesn't work in this case. Below is my minimal working code and some comments:               Needs["NumericalCalculus`"]     kvalues = {0.01,0.1,0.5,1.0,2.0};     tini = -Log[100];      tfin = 0;     timeGrid = Range[tini,tfin,(tfin-tini)/10];     fSpace[min_, max_, steps_, f_: Log] :=       InverseFunction[f] /@ Range[f @ min, f @ max, (f @ max - f @ min)/(steps -1)]     kin = 0.00072427;     kfin = 2.159;     klogGrid = fSpace[kin, kfin, 10];          funcA =        NDSolveValue[{         D[f[t, k], t] + f[t, k]^2 + (1 - t)*f[t, k] == 3/2*(1 + k^2),          f[tini, k] == 1},          f, {t, tini, tfin}, {k, kin, kfin}]          funcB[t_?NumericQ, k_] :=        funcB[t, k] = Exp[NIntegrate[funcA[et,k], {et, tini,t}]]          funcD[td_, kd_] := ND[Log[funcB[tt, kd]], tt, td]      Now a simple evaluation with `ParallelTable`:               BTable = ParallelTable[{{tt, kk}, funcB[tt, kk]}, {tt, timeGrid}, {kk,     klogGrid}]      The output is (shortened): > {{{-Log[100], 0.00072427}, 1.}, {{-Log[100], 0.00176173}, 1.}, {{-Log[100], > 0.00428528}, 1.}, {{-Log[100], 0.0104236}, 1.}, {{-Log[100], 0.0253546}, > 1.}, {{-Log[100], 0.0616732}, 1.}, {{-Log[100], 0.150015}, 1.}, {{-Log[100], > 0.3649}, 1.}, {{-Log[100], 0.887592}, 1.}, {{-Log[100], 2.159}, 1.}... Now if I try:               inverseN = FindRoot[funcD[tt, kk] == funcA[tt, kk], {tt, -1}]      I get: > NIntegrate::inumr: The integrand > InterpolatingFunction[{{-4.60517,0.},{0.00072427,2.159}},{4,5,1,{54,25},{4,5},0,0,0,0,Automatic,{},{},False},{<<1>>},{Developer`PackedArrayForm,{<<1>>},{1.,-5.10517,1.,-5.09284,1.,-5.05626,1.,-4.99541,1.,-4.9103,1.,-4.80093,1.,-4.6673,1.,-4.5094,1.,-4.32725,1.,-4.12083,1.,-3.89015,1.,<<5>>,1.,-2.72483,1.,-2.37285,1.,-1.99661,1.,-1.5961,1.,-1.17133,1.,-0.722307,1.,-0.249018,1.,0.248533,1.,0.770344,1.,1.31642,1.,1.88675,<<2650>>}},{Automatic,Automatic}][<<1>>] > has evaluated to non-numerical values for all sampling points in the region > with boundaries {{-Log[100],-4.60186}}. >> The same thing happens if I use the inverse function method suggested in the _Mathematica_ documentation of `FindRoot`:               inv[f_, s_] := Function[{t}, s /. FindRoot[f - t, {s, -2}]]     fInverse = inv[funcB[tt, kk], tt]      Now the bug: If I know evaluate again ParallelTable, I get the same above error message:               BTable = ParallelTable[{{tt, kk}, funcB[tt, kk]}, {tt, timeGrid}, {kk,     klogGrid}]      ... > NIntegrate::inumr: The integrand > InterpolatingFunction[{{-4.60517,0.},{0.00072427,2.159}},....Automatic}][<<1>>] > has evaluated to non-numerical values for all sampling points in the region > with boundaries {{-Log[100],-4.60186}}. >> But after the error messages I get the correct output from above. Nevertheless, with `Table` nothing bad happens:               Table[{{tt, kk}, funcB[tt, kk]}, {tt, timeGrid}, {kk, klogGrid}]      > {{{{-Log[100], 0.00072427}, 1.}, {{-Log[100], 0.00176173}, 1.}, {{-Log[100], > 0.00428528}, 1.}, {{-Log[100], 0.0104236}, 1.}, {{-Log[100], 0.0253546}, > 1.}, {{-Log[100], 0.0616732}, 1.},.... I hope you can reproduce this bug and by the way help me with finding the inverse function. I tried this in _Mathematica_ 10.0 and 9.0


title: Travel time sweet spot using: Mathematica and Google Maps API

text: I want to use _Mathematica_ to do some time minimisation calculations calling on Google Maps API for travel time data. I'm concerned with travel time, e.g. along roads (by car or walk) and **not** linear distances. I have a list of points (lets call them `Pf0, ..., Pfn`), (It could be either post codes, lat long, British National Grid, etc., however the data comes in). I want to take these points and, with some kind of iterative computation, workout where the 'optimum' point (lets call it `Px`) is at to get to minimise travel time to all these points. I'm assuming that I am equally likely to go to any of the points, so I cannot know in advance. But from a point (to be determined) I could go to any of these other fixed points (`Pf0, ..., Pfn`). I imagine I could chose a random seed, somewhere in the polygon described by the fixed points, calculate the total travel time from that point to each fixed point, then vary the point around and see if the time goes up or down. Then iterate until the I have found a minimum. Question 1: How do I ensure that the point is not a local minimum? A more intelligent method might be to vary the seed point along various linear features, this would reduce the total number of possible points, and reflect more realistic tests, since in real life I would probably be on a road. Again the local minima haunts me!   1. Can anyone thing of a better scheme?   2. Can anyone give me a start about how the code would have to work? I'm quite happy with querying the google maps api, as described in previous excellent q/a I need help with making that process iterative. My test data is a load of Mtb trail parks in South Scotland -- the result of the analysis would be the best place to stay if I was thinking of being there a while ;)               trailCentersCodes =        {"DG11QB", "DG54QU", "DG34AQ", "PH336SW", "EH458NB", "DG87BE", "TD90QD", "IV108", "DG28HB"}