Strange behaviour of variables in Table

I'm trying to work with some vectors and have run into a strange problem. An obvious way to define a difference of two vectors would be               dif[x_,y_] := x-y      I thought an equivalent way of doing this would be               dif[x_,y_] := Table[x-z,{z,{y}}][[1]]      However, using this second method, there is some strange behaviour. When I evaluate               dif[{x,z},{0,0}]      I get the result               {x,{0,0}}      which is clearly not what I wanted. If I try evaluating               dif[{x,y},{0,0}]      instead, everything is ok, which leads me to think that the variable `z` in my definition of `dif` is treated as non-local. This seems pretty counterintuitive to me, as I was expecting `z` to act as a dummy variable. > What am I missing? One solution that works is using `Module`. This is a bit unsatisfying though, as it seems to me `z` should be treated as local even without having to explicitly demand this.


Finding all points of period n in an iterated map

I'm trying to implement an algorithm of Jenkinson and Pollicott to calculate the Hausdorff dimension of a Julia set for the map $f_c : z\mapsto z^2 + c$. It's described on page 40 of their paper, _Calculating Hausdorff Dimension of Julia Sets and Kleinian Limit Sets_. I can't seem to get the part about finding the periodic points with period $n$ to work. The idea is to partition the line from $0$ to $c$ through the complex numbers and use Newton's method on each $c_i$ using the solution from one as the initial guess to the next. For $c=0$ we know the solution because they are roots of unity. We also take another precaution: to avoid the sensitivity to initial conditions that's prevalent in Newton's method, we find the roots of $F_{c,n} - I$ instead of finding the roots of $f^n_c - \operatorname{id}$, where $$F_{c,n}(z) = \langle f_c(z_n),f_c(z_1),\dots,f_c(z_{n-1})\rangle$$ I threw this together:               partitionSize = 10;     f[z_, c_] := z^2 + c;     fDim[z_, c_] := f[#, c] & /@ RotateLeft[z, -1];     findPeriodN[N_, c_] :=        Nest[{FindRoot[fDim[z, #[[1]]] - z, {z, #[[2]]}] &, #[[2]] +            c/partitionSize &}, {NestList[#^2 &, (-1)^(1/(2 N - 1)), N], 0},         partitionSize];     findPeriodN[3, 0.25];      And it doesn't work at all. Does anybody know a simple way to do this, or some other implementation that does the same thing?


Take the next element in a nested list

My problem is the following: Consider a list of elements. To better understanding my following explanations, I would take this example:               ListA = {{a, b, c}, {d, e, f}, {g, h, i}};     ListB = {{{a, b}, {c}}, {{d, e, f}}, {{g}, {h, i}}};      Whatever the used list, I want to take an element only from the position of the previous. To illustrate (for ListA): An other program give me the position {1,3} which means the element `c` in `ListA` (`ListA[[1,3]]`). So I would take the element `d` (`ListA[[2,1]]`). I sketched a procedure: _step1_               pos1 = {1, 3};     ListA[[ pos1[[1]] ]][[ pos1[[2]] ]]; (* c *)      _step2_               Listofposition =                      Flatten[                              Table[                                    {i, j},                                    {i, 1, Length@ListA, 1},                                    {j, 1, Length@ListA[[i]], 1}                                   ],                              1                             ];      _step3_               interpos1 = Position[Listofposition, {1, 3}] + 1      _step4_               pos2 = Flatten[Listofposition[ [interpos1[[1]] ]], 1]      _final step_               ListA[[ pos2[[1]] ]][[ pos2[[2]] ]] (* d *)         We can not really say that this solution is elegant. Do you have any other solution? Knowing that most of the lists that I have to deal with have irregular dimensions as ListB. And this is, I think, the main difficulty.       _Edit_ * * * Firstly thank you for your fast answer. I wrote some code from it.   (With using Block to improve performance) Methode n°1 (Karsten 7 and Mr.Wizard) :               Index[x_] := Position[x, _, {Depth[x] - 1}, Heads -> False];          NextE1[x_, y_] := x[[Sequence @@                        Index[x][[Sequence @@ Flatten[Position[Index[x], y] + 1]]]]];          TheNextE1[x_, y_] :=       Block[             {step1, Res},             step1 = Index[x];             Res = x[[Sequence @@                    step1[[Sequence @@ Flatten[Position[step1, y] + 1]]]]]            ];      Method n°2 (Mr.Wizard) :               Index[x_] := Position[x, _, {Depth[x] - 1}, Heads -> False];     Lookup[x_] := Dispatch@Rule @@@ Partition[Index[x], 2, 1, 1, "EOF"];     NextP2[x_, y_] := y /. Lookup[x]     NextE2[x_, y_] := x[[ Sequence @@ NextP2[x, y] ]];          TheNextE2[x_, y_] :=       Block[             {step1, step2, step3, Res},              step1 = Index[x];              step2 = Dispatch@Rule @@@ Partition[step1, 2, 1, 1, "EOF"];              step3 = y /. step2;              Res = x[[ Sequence @@ step3]]            ];       Method n°3 (Mr.Wizard) (No modification) :               NextE3[expr_, pos_] :=       Module[              {f},              f[_, pos] := f[x_, _] := Return[x, MapIndexed];              MapIndexed[f, expr, {Length@pos}]             ];          NextP3[expr_, pos_] :=       Module[              {f},              f[_, pos] := f[_, p_] := Return[p, MapIndexed];              MapIndexed[f, expr, {Length@pos}]             ];      Method n°4 (Algohi) :               Index2[x_] := Cases[MapIndexed[f, x, {-1}], f[y__] :> {y}, {0, -1}]     NextP4[x_, y_] := Last@Index2[x][[Position[Index2[x], First@Cases[Index2[x], {_, y}]]                       [[1, 1]] + 1]] ;     NextE4[x_, y_] := x[[ Sequence @@ NextP4[x, y] ]];          TheNextE4[x_, y_] :=       Block[             {step1, step2, Res},             step1 = Index2[x];             step2 = Last@step1[[Position[step1, First@Cases[ step1, {_, y}]][[1, 1]] + 1]];             Res = x[[ Sequence @@ step2]]            ];            _Performance_ * * * NextE3 > TheNextE1 > TheNextE2 > TheNextE4


Draw only part of axis in graph

I'm looking to draw only one half of an axis in `ContourPlot3D`, mainly because I don't wan't the axis lines to be where the interesting stuff happens (intersection of two surfaces), but I do want to show where the axes are. This is my code so far:               ContourPlot3D[{y == x^2, z == x^3}, {x, -3, 3}, {y, -5, 5}, {z, -10, 10},        AxesLabel -> Automatic, Boxed -> False, AxesOrigin -> {0, 0, 0},        Mesh -> None, ContourStyle -> Opacity[0.3]]      This is the result it produces: ![enter image description here](http://i.stack.imgur.com/Mynnv.jpg) I would like only half of each axis to appear on the graph. I already dug through the documentation, but it seems I can only turn the axes on or off completely, no partial option. Thanks in advance for any help.


Mathematica implementation of Earth Movers Distance?

Has anyone implemented in _Mathematica_ the Earth Mover's Distance (EMD)? A concept dating back to Monge 1871, used to compare histograms and images, e.g., the CIEDE2000 Color Difference algorithm. Yossi Rubner's C implementation can be found here:   * Header file   * C source Computation of EMD is more involved than Euclidean metric. EMD is a linear constrained optimization problem, and so can be handled presumably via _Mathematica_ 's Linear Programming functionality. Although there's typically additional normalization stage, e.g.. found here.


Function argument to default under certain condition

Inspired by this and this question (and how I handle this in practice), what is the best way to default a function value when a certain condition is met? For example, if a function is defined as:               func[x_] := (x - 1)^2 + 5      and for values of `x` less than 0, `x` should equal zero. I also always want the function to evaluate even when `x` is less than 0. Normally, I would handle as such:               func2[x_] := Module[{xx = x},        If[xx < 0, xx = 0];        (xx - 1)^2 + 5]      If I try to use patterns to define the conditions, I have to define the function twice for each region:               func3[x_?Positive] := (x - 1)^2 + 5     func3[x_] := 6      I've had no luck using other patterns to define the function. While this is an admittedly easy example that can be easily handled using `Max[x,0]`, etc., patterns can be much more complex such as "integers divisible by a prime number". So, can a pattern married with a default argument handle this situation? And what is the most efficient on a computation and memory basis? **UPDATE:** Here is a more complicated version of a function to which I referred to in the comments:               func[qi_, dei_, b_, dmin_, rt_, pt_, t_] :=         Module[{ptt = Max[pt, 0], rtt = Max[rt, 0], di, diexp, xotime, xorate},         di = 1/b*((1 - dei)^-b - 1)/365;         diexp = -Log[1 - dmin]/365;         xotime = (di - diexp)/(di*b*diexp) + rtt + ptt;         xorate = qi*(1 + b*di*(xotime - ptt - rtt))^(-1/b);          Piecewise[{{qi/2 (1 + t/rtt), t <= rtt}, {qi, rtt < t <= (rtt + ptt)},             {qi*(1 + b*di*(t - rtt - ptt))^(-1/b), (rtt + ptt) < t <= xotime},             {xorate*Exp[-diexp*(t - xotime)], t > xotime}}]         ]      I'll plug in random variates (which can sometimes be zero based on the distribution), and evaluate this function multiple times. However, `rt` and `pt` should never be negative and should default to zero. In other words, have minimum value of zero. While the way I have it works well, the original question stemmed from the idea that this could be done more efficient with a pattern. jVincent's vanishing patterns solution works only if one argument has this pattern. If both `rt` and `pt` have this pattern, the vanishing pattern doesn't seem to work.


Is it possible to merge cells excluding results with one click?

Now when I merge two cells with right-click "Merge Cells", they merge with the results included, while I only want the commands merged. Can I make it a one- click button? Now I have to delete the results first then merge.


Annotating plots with plain (not italicized) mathematical text

I have a plot and I would like to annotate some mathematical text in it. Initially, Mathematica puts it in italics by using Drawing tools palette, but I want it all in plain text. How can I do it? Thanks for your time.


Launch a specific notebook automatically when Mathematica starts

I run Mathematica on an iMac running OS X 10.6.8. I have set the OS's "Launch Items" to include Mathematica so that the application opens when the computer boots. > Now I want to go further and set Mathematica to launch a specific notebook > on startup. Note: this note book has initialization cells so it will evaluate automatically. All of this goes to my ongoing automation of a variety of processes to run while I take a few days of vacation (IF I can get this working ;-) I've searched Mathematica's "Preferences" and "Options", but haven't found anything to identify or set a specific notebook to launch when Mathematica starts. If someone knows a way to do this that I haven't seen in these, please advise. The following link to an old StackOverflow question, mathematica start front end and eval notebook from command line looks like it provides a way to do what I want to do, but on a Windows OS. As I think about applying or translating this idea to my iMac, it seems like rather than having Mathematica as a "Launch Item", I have a couple of other possibilities:   * setup a shell script using something like OS X's launchD to launch Mathematica and a specific notebook OR   * use MathematicaScript to launch just the kernel and run the code currently in the desired notebook.  Neither of these are strong points. Can anyone recommend a way to do this or on Mac OS X 10.6.8 or some specific references that would help me learn what I need to do? * * * A bit of a footnote for some additional context. The notebook I need to run launches parallel kernels on a couple of servers. I've chosen this path of getting all of this to run on the machines' startup rather than putting all of this on a timer or even logging on remotely to run them because, I've found that (at least for now) restarting both Mathematica on the client machine and as parallel kernels on the servers just runs more reliably. It particularly avoids problems with kernels that haven't launched or some of which have shut down. The Mac OS has a very reliable method to launch and shutdown the machines at specific times. As I need the code in the notebook to run at specific times this seems like a good thing on which to layer the other functionality.


DynamicModule with constant image size

I am new to this forum - I wonder if someone can help me improve this code.   1. I would like the angle $\theta$ to start in the middle of the slider i.e. $\theta = 0$ instead of starting at $\theta = -90$.   2. How do I keep the circle size constant as I slide the $\theta$?               Mohr[σxx_, σyy_, τxy_] :=       DynamicModule[{g1, g2, g3}, OC = 1/2*(σxx + σyy);        R = Sqrt[((σxx - σyy)/2)^2 + τxy^2] ;        g1 = {Thickness[0.01], Circle[{OC, 0}, R]}; σxx1 :=         1/2*(σxx + σyy) + 1/2*(σxx - σyy)*Cos[2*θ*Degree] + τxy*          Sin[2*\[Theta]*Degree];        σyy1 := 1/2*(σxx + σyy) + 1/2*(σyy - σxx)*Cos[2*θ*Degree] - τxy*Sin[2*θ*Degree];       τxy1 := 1/2*(σyy - σxx)*Sin[2*θ*Degree] + τxy*Cos[2*θ*Degree];       τxy1a := 1/2*(σyy - σxx)*Sin[(2*θ*Degree + π)] + τxy*Cos[(2*θ*Degree + π)];        pts = {{σxx1, -τxy1}, {σyy1, -τxy1a}};       g2 = {PointSize[0.05], Red, Point[pts] ,          Inset[Row[{"\!\(\*SubscriptBox[\(σ\), \(xx\)]\) = ", NumberForm[σxx1, {6, 2}], ";",             "  \!\(\*SubscriptBox[\(τ\), \(xy\)]\) = ", NumberForm[-τxy1, {6, 2}]}],           Dynamic[{pts[[1, 1]], pts[[1, 2]]}]],         Inset[          Row[{"\!\(\*SubscriptBox[\(σ\), \(yy\)]\) = ", NumberForm[σyy1, {6, 2}], ";",           "  \!\(\*SubscriptBox[\(τ\), \(xy\)]\) = ", NumberForm[-τxy1a, {6, 2}]}],           Dynamic[{pts[[2, 1]], pts[[2, 2]]}]]         }  ;       g3 = {Thickness[0.01], Blue, Line[pts]};       {Column[{Graphics[{g1, Dynamic[g2], Dynamic[g3],             Inset[Text[Style["Mohr's circle", 18, Purple, Italic]], {49.58, 68.99}]},              ImageSize -> 300 ],           Row[{"θ = " Slider[Dynamic[θ], {-90, 90}], Dynamic@θ " degree"}]}]}]          Mohr[100, 0, 25]      ![enter image description here](http://i.stack.imgur.com/kQ6xc.png) **Edit** barebones version               Mohr[x_, R_] :=      DynamicModule[{g1, g2},       g1 = Circle[{x, 0}, R];       pts = Dynamic @{{R Cos@t + x, R Sin@t}, {R Cos[t + Pi] + x, R Sin[t + Pi]}};       g2 = {PointSize[0.05], Red, Point[Dynamic@pts],              Inset["A very long text", Dynamic@(pts[[1, 1]])]};       {Column[{Graphics[{g1, Dynamic[g2]}, Axes -> True],           Row[{"t = " Slider[Dynamic[t], {-Pi/2, Pi/2}], Dynamic@t }]}]}]          Mohr[100, 25]


Front End editing

As a new Mathematica user I have been grappling with many aspects of its powerful capabilities but am now beginning the find the front end very disappointing in a number of respects.   * Lack of multiple level undo (yes, I've just signed the petition and posted in the Wolfram community site on this)   * Global effect of "Replace All" in the "Find and Replace" dialog   * Weak IDE-like debugging capabilities (I will investigate DebugTrace later; I know Workbench could help but I resent the current €120 cost for what I believe should probably be core capabilities) (Rhetorical?) How do sophisticated and heavy users manage? The specific immediate question however is: does anybody have a viable approach/solution/workaround to undo/redo for (limited scope) _input cell edits_? I'm still amazed by what Mma can do, but what it can't do is becoming increasingly baffling.


Implementing efficient multiple undo

_At the time this question was asked, version 10 was not out yet. The Front End of Mathematica 10 does have multiple undo, see the answer by John Fultz._      The Mathematica Front End's built-in Undo command can only undo a single editing step. **Has anyone implemented or seen implemented an efficient and comfortable multiple undo?** I have in mind ideas such as, `CellEventActions` that keeps a stack in the cell context pushing the cell state every time a key among a list (brackets, @, operators) is pressed. Some other shortcut to recover older states (or a palette, or perhaps tweaking the front end's .tr files??) I am not familiar at all with typical text based implementations and their issues. I guess it wouldn't be a practical problem to lose the undo state between sessions, would it? So, has this been done, or is it doable or practical? What are your thoughts?


Get Mathematica to simplify $\cosh(i x)$

I want Mathematica to simplify `Cosh[I x]` to `Cos[x]` if I tell Mathematica that `x` is Real. I have tried everything, but it ends up giving `Cosh[I x]` back.


What does "Tag Integer is Protected" message mean?

_(Newbie question)_ For every function I define I get this message: ![enter image description here](http://i.stack.imgur.com/LT9kH.png) When I close and reopen Mathematica, and re-enter the function definition, I don't get the message anymore. What does it mean?


How to get matching starting dates for different `FinancialData` properties?

Why do the `"Return"` and `"Volume"` outputs of `FinancialData` differ? Consider the following input for `"Return"`               FinancialData["APL","Return",{{2014,8,14},{2014,8,19}}]      with output               {{{2014,8,15},0.00202899},{{2014,8,18},0.00578536}, {{2014,8,19},-0.00517688}}      versus this input for `"Volume"`               FinancialData["APL","Volume",{{2014,8,14},{2014,8,19}}]       with output               {{{2014,8,14},348800},{{2014,8,15},610700},{{2014,8,18},247200},{{2014,8,19},290500}}      **Notice** : Each function takes the same period, yet the Return input yields one less date. The output dates match if I make the following modification for the Return input               FinancialData["APL","Return",{{2014,8,13},{2014,8,19}}]      which outputs               {{{2014,8,14},0.0102489},{{2014,8,15},0.00202899},{{2014,8,18},0.00578536},{2014,8,19},-0.00517688}}      Now, the dates for Return and Volume match up and the crisis is averted. However, this seems an inelegant fix. Is there something that I am just missing in the aforementioned example? Additionally, I have tested this on multiple stocks, so it is not an artifact of "APL" which I chose at random.


Creating Do loop that cycles back to earlier values

I need to create a `Do` loop that distributes letters in a list of lists. I also need to be able to cycle back through to the beginning of the list. For example, I need to change               list={{a},{a},{a},{a},{a},{a},{a},{a}}       to > >     {{a,b},{a},{a,b},{a},{a,b},{a},{a,b},{a}}.   >   But, I need to add the `b` to `list[[5]]`, then `list[[7]]`, then `list[[1]]`, then `list[[3]]`. Is there any way to use a do function to do that or should I find another method?


Writing loops for triangle elements

![enter image description here](http://i.stack.imgur.com/2yAIc.png) I'm kind of new to using Mathematica, so any help is great. I'm trying to write a program that will create a list or matrix that will give each small triangle's point numbers. For example if given an isosceles right triangle, the example below gives the sides as 4 and the numbering of the points is just like below, then it should give a list or table such as               dat= {{1,2,6},{2,3,7},{3,4,8},{4,5,9},{6,7,10},{7,8,11},{8,9,12},{10,11,13},        {11,12,14},{13,14,15},{2,6,7},{3,7,8},{4,8,9},{7,10,11},{8,11,12},{11,13,14}}.       I've tried writing a few loops, but am not getting anywhere. I know that the starting number on the diagonal of the big triangle will add whatever the side is and start decreasing that value as u go up. For example, the first point always starts at 1, and as u move up the rows of triangle, you add `1+(x+1)` to get 6. Then going up the next row of triangles, it is `6+(x)`, to get 10. And so on. So I see two iterators? once increasing? one decreasing? Any help or ideas will be helpful. Thanks!


Multiple plots on same graph for different parameter?

I would like to be able to `Plot` a function (with an implicit `Integrate` command) with various values for a certain parameter (`phi` in the code below for values `0.01` and `0.02`) all on the same `Plot` to compare.Below is my code:               e = 1.60217657*10^-19;     n = 10^-9/e;     R = 1.5;     sigma = 50*10^-6;     p = (R*phi^3)/(24 sigma);     g = D[Exp[-((curlEprime)^2/2)], curlEprime];          G = p^(-(1/3)) (Exp[-((curlE - p)^2/2)] - Exp[-((curlE - 4 p)^2/2)]) +     Integrate[1/(curlE - curlEprime)^(1/3) g, {curlEprime, curlE - p, curlE}];          de = (2 e^2 n)/(3^(1/3) Sqrt[2 Pi] R^(2/3) sigma^(4/3)) G          Plot[de, {curlE, -10, 10}] /. phi -> {0.01, 0.02}


How to prevent function from passing values to slot

For the following example:               {#, #} & /@ {1, 2}      I am trying to find a method to hold one of the slots (or both ) so that the function do not pass the values to the slot I want to protect. for example I want to get something like this:               {{1, #}, {2, #}}      I tried all type of Hold on the second slot but without and success. any suggestion?


Why is Chop ignored in Plot?

I want to plot multiple functions with the same settings side-by-side, so I use the pure function construct (for clarity, I only use one function in this example)               Plot[        #,        {x, 0, 1}        ] & /@     {        Chop[x, 0.5]     }      however, it somehow ignores the Chop function: ![enter image description here](http://i.stack.imgur.com/kAMYm.png) If I plot the function directly               Plot[        Chop[x, 0.5],        {x, 0, 1}     ]      everything works as expected: ![enter image description here](http://i.stack.imgur.com/cie3d.png) I get similar behaviour with Plot3D. Do you see a problem in my code? Does the pure function and Map mechanism (/@) have something to do with it? PS: I, in fact, want to use Plot3D. That's why I want to draw multiple plots next to each other instead of plotting all functions within one graphics object. I only chose showing the problem using Plot function in order to make the example simpler.


How to name a variable with the value of another variable?

A simple but very important (at least for me) question. In some languages for defining a variable, for example, we can do: i=10 "d"&i=30 So I have defined the variable d10, and... d10=30 That is to say... I've named a variable (d10) as as function of an other variable (i). How can I do this in Mathematica? Sorry if the title is bad. Regards!


How can I add drop shadows to the text of non-input/output cells?

Inspired by simon woods's wonderful shadow function, I want to add drop shadows to all the text of non-input/output cells in a notebook, something like this: ![enter image description here](http://i.stack.imgur.com/hokkY.jpg) By using simon woods's shadow function, I can take some text and add shadow to it:               style["Some text","Text"]//shadow[#,#]&      And then paste the resulting image back. But I can't automate this process. My question is   1. how to make a function that take a notebook as input, and output a "shadowed" version with all the text of non-input/output cells having shadow?   2. If 1 can be done, is it possible to reduce the size of the "shadowed" notebook? As all the text is replaced with images, the notebook may be large. Thanks very much!


Identifying critical points of 2/3D image/cubes

**Upshot** I am interested in identifying critical points of a 3D field/cubes (maxima, minima, tube-like and wall-like saddle points) and 2D field/image (maxima, minima, saddle points). I.e. the generalisation of How to find all the local minima/maxima in a range. **Attempt(s)** The mathematica functions `MinDetect` and `MaxDetect` address partially my request in 2D, as illustrated (using the `GaussianRandomField` function defined here)               u = GaussianRandomField[192] // Chop // GaussianFilter[#, 8] &;     iu = Image[u] // ImageAdjust //Colorize[#, ColorFunction -> "ThermometerColors"] &      ![Mathematica graphics](http://i.stack.imgur.com/dvstY.png) Indeed               um = Image[u] // MinDetect;     uM = Image[u] // MaxDetect;     ImageAdd[ImageAdd[iu, uM], um]      ![Mathematica graphics](http://i.stack.imgur.com/KeOHt.png) Shows that maxima and minima have been detected. On the other hand, saddle points are still to be found. A related query was made there, which is a possible starting point since critical points are the simultaneous zeros of the (2 or 3 components of the) gradient. Let us try and follow this method:               fu = u // ListInterpolation;     fux = Function[{x, y}, D[fu[x, y], x] // Evaluate];     fuy = Function[{x, y}, D[fu[x, y], y] // Evaluate];          fuxx = Function[{x, y}, D[fu[x, y], {x, 2}] // Evaluate];     fuyy = Function[{x, y}, D[fu[x, y], {y, 2}] // Evaluate];     fuxy = Function[{x, y}, D[fu[x, y], x, y] // Evaluate];          pts = FindAllCrossings2D[{fux[x, y], fuy[x, y]}, {x, 1, Dimensions[u][[1]]},           {y, 1, Dimensions[u][[2]]},           Method -> {"Newton", "StepControl" -> "LineSearch"},            PlotPoints -> 256, WorkingPrecision -> 20] // Chop;          dets = Map[fuxx @@ # &, pts] Map[fuyy @@ # &, pts] -      Map[fuxy @@ # &, pts]^2;     trs = Map[fuxx @@ # &, pts] + Map[fuyy @@ # &, pts];      Selecting saddles as critical points which have a Hessian determinant negative.               w = Map[If[# < 0, 1, 0] &, dets]*Map[If[# > 0, 1, 0] &, trs];     saddles = Most /@ Select[Transpose[Join[Transpose[pts], {w}]], #[[3]] == 1 &];      and the maxima and minima               w = Map[If[# > 0, 1, 0] &, dets]*Map[If[# < 0, 1, 0] &, trs];     max = Most /@      Select[Transpose[Join[Transpose[pts], {w}]], #[[3]] == 1 &];     w = Map[If[# > 0, 1, 0] &, dets]*Map[If[# > 0, 1, 0] &, trs];     min = Most /@      Select[Transpose[Join[Transpose[pts], {w}]], #[[3]] == 1 &];      Check that they are indeed at the intersection of the zero gradient contours               ContourPlot[{fux[x, y], fuy[x, y]}, {x, 1, 256}, {y, 1, 256},       Contours -> {0}, ContourShading -> False,       ContourStyle -> {Red, AbsoluteThickness[1.5]},       Epilog -> Join[{{AbsolutePointSize[6], Green, Point /@ saddles},      {AbsolutePointSize[6], Red, Point /@ max},      {AbsolutePointSize[6], Blue, Point /@ min}}]]      ![Mathematica graphics](http://i.stack.imgur.com/UW3mH.png) and that they correspond to critical points of the underlying field                Show[{ContourPlot[fu[x, y], {x, 1, 256}, {y, 1, 256}, Contours -> 35,       ColorFunction -> "ThermometerColors"],      Graphics[{AbsolutePointSize[6], Purple, Point /@ max}],      Graphics[{AbsolutePointSize[6], Gold, Point /@ min}],      Graphics[{AbsolutePointSize[6], Green, Point /@ saddles}]}]      ![Mathematica graphics](http://i.stack.imgur.com/QBwTN.png) **Questions** i) would you know of a more efficient way of finding the saddle points in 2D? ii) could this algorithm be generalized to 3D without significant loss of efficiency? (involves possibly writing a 3D version of `FindAllCrossings2D`) iii) how robust can it be in terms of the smoothness of the field? Here I am after an algorithm which would be efficient (I would like to identify thousands of critical points).


Numeric output formats

I want to print the expression $A[x] = 8020.6596 \times 1.055^x$ as is on a 2D graphic. I included the line               Graphics[Text[HoldForm[A[x] = 8020.6596 \[Times] 1.055^x],{2,0}]]      in the graphics call, but the first constant insists on printing as $8020.66$. How can I fix this problem?


Reverse engineer a sample value from a CDF

The image below shows the cumulative distribution of a normal distribution with mean = 4 and standard deviation = 1. Notice that if you have a value with a rank of 0.8 (meaning it would be 80th item from the bottom in a sorted list of 100 items) you could get the corresponding value from the CDF of a normal distribution of any mean/sd (if you knew how to do it). I'll bet there is a nice way to do this. I can only think of overly complicated, never do it what way! ways. ![enter image description here](http://i.stack.imgur.com/KBJau.png)


How can I merge multiple sets of morphological components (perhaps selected using different metrics)?

Let's say I use `SelectComponents` to select morphological components in an image according to some criterion, like "Elongation". Then let's say, I pull out a different set of morphological components using another criterion like "Area".               m1 = SelectComponents[testImage, "Elongation", # == 1 &];     m2 = SelectComponents[testImage, "Area", # > 42 &];      How can I properly merge `m1` and `m2` into a single set of non-intersecting morphological components?


Is there a way to plot a single level curve of a function of x and y through a given point?

For example, I am trying to plot the single level curve of               f(x,y)=xsin[y/x]+ysin[2x]       that goes through the point (3pi,3pi). Can anyone show me how to do this?


I need to draw a direction field and x1 vs t graph for the ode

I have written the following codes and i am able to get to the trajectory but not able to draw the direction field and x1 or x2 vs time plots.               A = ( {{2, -1},{3, -2}} )      Eigenvalues[A]      Eigenvectors[A]      X[t_] = {x1[t], x2[t]}      system = X'[t] == A.X[t]      sol = DSolve[system, {x1, x2}, t]      particularsols =      Partition[      Flatten[Table[{x1[t], x2[t]} /. sol /. {C[1] -> 1/i,      C[2] -> 1/j}, {i, -20, 20, 6}, {j, -20, 20, 6}]], 2];      ParametricPlot[Evaluate[particularsols... {t, -10, 10},      PlotRange -> {-1, 1}, AxesLabel -> {x1, x2}]


Why are all the lines commented when I create a Mathematica script?

When I created a _Mathematica_ script, I found that all my lines were commented out (when opened with `vi` or `gedit` or any other text editor). So I either need to get rid of the `(**)` manually or through a bash script before I run my _Mathematica_ script from a unix terminal. To create my script, I include the shebang `#!/usr/local/bin/MathematicaScript -script` on the first line and then save my file as a `.m` package. The resulting file looks something like this:               (* ::Package:: *)          (* ::Input:: *)     (*#!/usr/local/bin/MathematicaScript-script*)          (* ::Input:: *)     (**)     (*f[x_] := x*)      **Why are my lines commented? Is there anything I need to do?**


How can I efficiently check if a graph is unit distance?

A unit distance graph is a graph that is embeddable in the plane so that every edge has length 1.               UnitDistanceQ[input_]:=Module[         {g, x, F, v, min, nod, gl},         g = input;         gl = Length[g]; (* Vertex Count *)         (* 2 vertex count variables x1, x2, etc... *)         x = Table[Symbol@@ToExpression["x" <> ToString[i]], {i, 1, 2*gl}];          (* The force to minimize is the squared error of the lengths *)          F = \!\(     \*UnderoverscriptBox[\(\[Sum]\), \(i = 1\), \(gl\)]\(     \*UnderoverscriptBox[\(\[Sum]\), \(j = 1\), \(gl\)]g[[i, j]] \((\((x[[2  i]] - x[[2  j]])\)^2 + \((x[[2  i - 1]] - x[[2  j - 1]])\)^2 - 1)\)^2\)\);         (* Initial vertex positions *)           v = Table[gl*Random[], {i, 1, 2*gl}];         (* Minimization *)           {min, nod} = FindMinimum[F, Transpose[{x,v}], Method->"QuasiNewton"];         (* Output Solution *)                If[min < 10^-3,             Print[{min,nod}];             GraphPlot[g, VertexCoordinateRules ->                  Thread[Range[gl] -> Partition[ x /. nod, 2]],             AspectRatio -> Automatic,              VertexLabeling -> None,              ImageSize->Small]         ]     ]      For example, the golomb graph is unit distance.                g = Graph[               UndirectedEdge @@@ {{1, 2}, {1, 3}, {1, 4}, {2, 3}, {2, 6}, {3,                   8}, {4, 5}, {4, 9}, {4, 10}, {5, 6}, {5, 10}, {6, 7}, {6,                   10}, {7, 8}, {7, 10}, {8, 9}, {8, 10}, {9, 10}}];         m = AdjacencyMatrix[g];         UnitDistanceQ[m]         (* gives             FindMinimum::sdprec: Line search unable                   to find a sufficient decrease in the function value with                   MachinePrecision digit precision. >>      *)      So the question is how to check for a unit distance embedding as fast as possible, my code is not working yet but I think something along these lines will work... My iterative approach works well for the golomb graph when run many times ![enter image description here](http://i.stack.imgur.com/89EOA.png) This is a great question and cool algorithms could be invented here!


How to plot the convolution of dirac delta series with a sine function

I am new to mathematica. I do the convolution of dirac delta :(DiracDelta(x-10)" with "sine(t),t=0-pi". How to plot the output ? Theoretically, the full wave should appear at the location of the singularity.


How to avoid CopyTensor in CompiledFunctions?

In a reply here  Leonid wrote, “Compile can handle a number of higher-level functions, such as Transpose, Partition, Map, MapThread, etc. Most of these functions return expressions, and even though these expressions are probably passed to the calling function, they must be created. For example, a call to ReplacePart which replaces a single part in a large array will necessarily lead to copying of that array. Thus, immutability generally implies creating copies.” However, I still don't understand what things besides the obvious would lead to a CopyTensor. Please help me understand what constructs lead to CopyTensor in my CompiledFunction, and how the CopyTensor can be avoided.


Generating Palindromic_number

I'm trying to construct Palindromic_number, I came up with this code:               palind[n_] :=        FromDigits /@ Join[#, #[[All, -Mod[n, 2] - 1 ;; 1 ;; -1]], 2] &@        Tuples[MapAt[Rest, Array[0~Range~9 &, Ceiling[n/2]], 1]];          palind[3]          (*     {101, 111, 121, 131, 141, 151, 161, 171, 181, 191, 202, 212, 222, \     232, 242, 252, 262, 272, 282, 292, 303, 313, 323, 333, 343, 353, 363, \     373, 383, 393, 404, 414, 424, 434, 444, 454, 464, 474, 484, 494, 505, \     515, 525, 535, 545, 555, 565, 575, 585, 595, 606, 616, 626, 636, 646, \     656, 666, 676, 686, 696, 707, 717, 727, 737, 747, 757, 767, 777, 787, \     797, 808, 818, 828, 838, 848, 858, 868, 878, 888, 898, 909, 919, 929, \     939, 949, 959, 969, 979, 989, 999}     *)      Any better ideas?


Preventing evaluation until all undefined symbols are resolved

FixedPoint[If[# <= 0, 0, # - 1]&, 2 x]      Causes an infinite loop because of 'x'. How do i automatically prevent evaluation until `2 x` is known? I have a similar function being fed into `Plot[]` and it has control over when `x` is known.


Adaptive sampling for slow to compute functions in 2D

**EDIT:** Although I have posted an answer based on my current progress, this in incomplete. Please see the "open issues" section in the answer. * * * Most plotting functions in Mathematica adjust the sampling density dynamically, based on the slope of the function:               DensityPlot[1/(      1 + Exp[10 (Sqrt[x^2 + y^2] - 3)]), {x, 0, 5}, {y, 0, 5},       Mesh -> All, PlotRange -> All]      ![Mathematica graphics](http://i.stack.imgur.com/w9zce.png) Unfortunately the internal algorithm that does this is not directly callable. * * * **Question:** I have a slow to compute 2D function (takes up to 10-40 seconds for a single point even though it's in optimized C++ called through LibraryLink) that I need to sample. How can I sample it adaptively, in a convenient and controlled way? Since the function is so slow to compute,   * I'd like to be able to take the existing points, and refine them more if needed (i.e. continue the computation using the existing results)   * I can't use DensityPlot directly because I can't control how many points it is going to compute, and I need an upper limit on that (i.e. an upper limit on computation time). It also can't be interrupted and continued later. I am looking for   1. effective methods to do this   2. implementations in Mathematica (either as an answer or pointers to libraries) **The messy details:** I am trying to compute a phase diagram and map the boundaries between the phases precisely. So I don't need the function value everywhere, only where it very suddenly drops. The function is either of magnitude 1 (say, between $0.1 \div 1$), or very small (close to zero). The function is computed using Monte Carlo methods, so at a small scale it doesn't appear smooth, and I might get inconsistent results close to the phase boundaries on subsequent runs of the function. This should give you an idea of what sort of function I'd like to apply this to, which might be important when choosing a method.


ImageCapture on Windows 8.1

I have an _Asus SmartTab_ tablet with _Mathematica 9_ on it. When I run `ImageCapture`, nothing shows up in the image window. Originally running this completely crashed the entire OS forcing a reboot, but I have done some updates since. Now I just get the blank window effect.   Does anyone have any ideas on if this is fixable, or has had this happen?


How to work with characters from CJK Unified Ideographs Extension B correctly?

**Background:** Recently I'm trying to deal with some Chinese characters which belongs to the **CJK Unified Ideographs Extension B** block. The motive comes from some further interest following a former question, and some ideas of using Mathematica for typesetting ancient Chinese scriptures. **Edit:** Here is some sample code which looks fine at first sight ( The Unicodes of the three characters involved here are `x20027`, `x200D5` and `x20137`. The setting of the `$SystemCharacterEncoding` of my Mathematica is `"CP936"`. ): ![enter image description here](http://i.stack.imgur.com/M82qV.jpg) But after saving then closing the notebook, I re-opened it, without touching anything, the Front End displays weird now (and note the attendance of the syntax errors): ![enter image description here](http://i.stack.imgur.com/gt1RE.jpg) It seems the Front End is not able to correctly render them. Furthermore, although I can create a textcell looking fine: ![enter image description here](http://i.stack.imgur.com/1iHMS.jpg) whose `CellExpression` is:               Cell["\:d840\:dc27\:d840\:dcd5\:d840\:dd37", "Text", CellChangeTimes->{3.5359048507534103`*^9}]      but if I trig `Ctrl+Shift+E` and edit the `CellExpression` directly (eg. deleting the `CellChangeTimes` item, which should not affect the "appearance" of the cell), then convert the cell back to normal status, things get wrong again: ![enter image description here](http://i.stack.imgur.com/Uy3ku.jpg) This kind of problem never happened when dealing with characters from **CJK Unified Ideographs** and **CJK Unified Ideographs Extension A** blocks, so I guess there may be a bug here. So my questions is: While I do realize the `"Unicode"` encoding in Mathematica referring to only 16-bit Unicode while the CJK-B begin with `x20000`, is there any method to render and work with characters from **CJK Unified Ideographs Extension B** correctly?


Efficient code for tallying entries in very large lists

I am dealing with data sets containing tens of millions of (hashable) entries and simply using the `Tally` function to count the frequency of each unique list element maxes out available memory. What's the most efficient way to perform this sort of operation on very large lists? Some clarifications:   1. I actually don't need all values. I need all values that occur more than once and a sizeable majority of the values occur only once.   2. The datasets themselves do fit in memory in their entirety.


_**How to explain the result of the two functins?_** Input1:               myperiodic[func_, {val_Symbol, min_?NumberQ, max_?NumberQ}] :=      func /. (val :> Mod[val - min, max - min] + min);     Plot[myperiodic[t, {t, -5, 5}] // Evaluate, {t, -40, 40}]      Input2:               f[t_] := If[-5 <= t <= 5, t, If[t > 0, f[t - 10], f[t + 10]]];     Plot[f[t] // Evaluate, {t, -40, 40}]       ![How to explain?](http://i.stack.imgur.com/vJ3c8.png)


Why is the Locator snapping back to the original coordinates? How can I prevent this?

Take the following code:               p = {3, 3};     Graphics[Circle[{5, 5}, 5], Epilog -> Dynamic@Locator[Dynamic[p]],      Axes -> True, GridLines -> {{3}, {3}}]      ![Mathematica graphics](http://i.stack.imgur.com/tLwho.png) Whenever I move the locator close to the original coordinates (marked by the grid on the plot), it quickly snaps back to them. This means that I am unable to position the locator at around `{3.25, 6}`. It will either snap to `{3.0, 6}` or to `{3.5, 6}`. (Please see the image, it is at `{3.5, 6}` there.) Is this a feature or a bug? If it is a feature, how can I turn it off? If it is a bug, how can I work around it? Note that I am using `Epilog` because the graphics in my actual problem are slow to compute/render (large `ListDensityPlot`).


extract values from replacement list

Solve returns a list of replacement rules               In: Solve[x + y == 3 && x - y == 6, {x, y}]     Out: {{x -> 9/2, y -> -(3/2)}}      I am only interested in the right hand side of these rules. To extract the right hand side I use substitution:               ({x, y} /. sol)[[1]]      It gives               {9/2, -(3/2)}      This works, but it is not very elegant. You have to adapt the list of the variables, each time you solve for different variables. Is there a more general way to extract the right hand sides form a list of replacements? **Edit** The number of variables and the number of solutions may both differ.


Quantile & TransformedDistribution

xd = ExponentialDistribution[1.0];     yd = ExponentialDistribution[5.0];     td = TransformedDistribution[x/(x + y), {x \[Distributed] xd, y \[Distributed] yd}];     Mean[td]     CDF[td, z]      All the above works as expected. But when I do               Quantile[td, 0.95]      I get the input echoed as the answer, i.e. MMA can not do this. Same answer in 9 & 10. Any suggestions? Known bug or am I doing something wrong?


Creating an animation illustrating the time-evolution of a pre-computed orbit

As the title says, I would like to use Mathematica in order to create an animation depicting the time-evolution of a three-dimensional (3D) orbit. To begin with, I have an ASCII file which contains the orbit data into four columns. The first column corresponds to the time, while the next three to the x, y and z coordinates respectively. Below, I present a simple code so as to visualize the orbit.               SetDirectory[" ... "];     data = ReadList["orb_3d.out", Number, RecordLists -> True];     dataOrb3D = Table[{data[[i, 2]], data[[i, 3]], data[[i, 4]]},      {i, 1, Length[data]}];      S0 = Graphics3D[Line[dataOrb3D], Axes -> True, AxesStyle ->     Directive[FontSize -> 17, FontFamily -> "Helvetica"], AxesLabel ->      {"x", "y", "z"}, BoxRatios -> {1, 1, 1}, ImageSize -> 500]      The above code produces this image: ![enter image description here](http://i.stack.imgur.com/jknDA.jpg) In order to obtain the ASCII data file, please follow this link. OK, so far so good. Now let me explain the simulation part. The orbit describes the motion of a test-particle (star) under the gravitational field of a galaxy. According to the data file, when t=0 the star must be at (x,y,z) = (0.5,0,0.5). So, I would like to plot at that point, let's say a blue dot, inside the 3D volume. Then as time evolves the blue dot which indicates the star should follow the path according to the data file moving from point to point, join them thus leaving a solid line behind it. When t=250 the simulation finishes and we should have reproduced the image I present earlier. Honestly, I am not sure if what I described is possible with Mathematica. Anyway, it would be great, if there was also a label inside the 3D box (or above it) giving the value of the time at every step of the simulation (i.e. t = 73.27). Finally, I would also like to be able to export this simulation as an .avi or .mp4 file. I know that I described a very ambitious project here! However, I also think that it is a very interesting topic. Many many thanks in advance and I look forward for your replies.


importing and manipulating data file

I have a large text file containing numeric data of 1000 groups each of 200 lines. The lines are unsorted. There is a 9 line header at the beginning of each group, i.e., 209 ⨉ 1000 lines altogether. I want to drop the headers to have a file containing 200 ⨉ 1000 lines. I also want the 200 lines of each output group sorted by the first number in the line. What is a way to do this efficiently in _Mathematica_? My actual data set is much larger than 200 lines and 1000 groups. I made up these number for the sake of discussion.


How can I extract the maximum value from a Histogram?

In Mathematica 8.04 I've created a histogram of returns on a stock using:               returns = FinancialData["SP500", "Return", {Date[] - {5, 0, 0, 0, 0, 0}, Date[]}, "Value"];     μ = Mean[returns];     h = Histogram[returns, 300, "PDF"];      ![Mathematica graphics](http://i.stack.imgur.com/rJO3b.png) where "returns" is a list of the daily returns, and I want 300 bins in the probability density method. Next, I would like to draw a line that represents the mean of the returns so I use:               meanLine = Graphics[{Thick, Darker[Green], Line[{{μ, 0}, {μ, maxFreq + 2}}]}];      The problem is that I need to calculate the highest y-value for the line, which should be equal to the count of the data points in the bin with the most points (I've called this `maxFreq` above). I am currently setting this value manually because I don't know how to extract it from the histogram (h). Note that the x-coordinate of this line (`μ`) is simply the mean of the returns. I've tried looking at `FullForm[h]` to see if I could figure out how to extract the data. Buried within that output is the following:               List[List[Rectangle[List[-0.0015, 0.], List[-0.001, 54.0111]      which shows that I want to set maxFreq = 54.0111. So, I suppose that I want to use the `Max` function, but I don't know how to access the heights of each bin. I think that I need to use some variation of the `Part` function, but I can't figure out how. Any clues would be appreciated. Here is the code that will generate what I'm looking for, but maxFreq is manually entered:               returns = FinancialData["SP500", "Return", {Date[] - {5, 0, 0, 0, 0, 0}, Date[]}, "Value"];     μ = Mean[returns];     h = Histogram[returns, 300, "PDF"];     maxFreq = 54;     meanLine = Graphics[{Thick, Darker[Green],Line[{{μ, 0}, {μ, maxFreq + 2}}]}];     Show[h, meanLine]


Puzzling behavior produced by Exists

I need to simplify a set of solutions of a system, say for example:               A := (a[1] == 3 && a[2] <= 1 && b[1] <= 5) || (a[1] == 3 && a[2] == 1 && b[1] == -7)      I care only about `a[1]` and `a[2]` but I can not use `Eliminate` since I have inequalities. So one solution is:               Simplify[Reduce[Exists[{b[1]}, A]]]      > a[1] == 3 && a[2] <= 1 It works! But since I have a large system (many b's) I need to automate this. Since:               Array[b, 1]      > {b[1]} I tried:               Simplify[Reduce[Exists[Array[b,1],A]]]      > a[1] == 3 && a[2] <= 1 && b[1] <= 5 The second method yields the wrong outcome! What am I doing wrong here?


"Not a valid Filling specification" error

I have a function, which plots the given function array `f`. This is a part of the function:               Plot[-f, {x,0,2}, Filling->{1->{2}}, PlotStyle->Green]      When I specify `{x^2, 2x}` as the function `f`, I get the errors `"2 must be an integer between 1 and 1. "` and `"{2} is not a valid Filling specification."`. I get this error because I have a minus sign in front of the argument `f`. If I plot `{-x^2,-2x}` then everything is fine. So how to multiply everything in `f` by -1 without getting these errors?


Replace function and its derivatives found with Solve

If I have an equation               eq = f[x] + g[x] == 0      and I solve for `f[x]`               sol = Solve[eq,f[x]]      how do I use `sol` to replace both `f[x]` and its derivatives in another equation? For example               eq2 = f'[x]*g[x] + f[x] == 0      and then               eq2 /. sol      outputs               {-g[x] + g[x] f'[x] == 0}


Running postgresql query with backslash

I've been able to connect to a Vertica database, and also been able to run a SELECT query. But I'm not being able to run a query with a backslash in it. (Vertica has commands like postgresql.) The command I'm trying to run is `\d;`. I've tried variations like below with a varying number of backslashes without success: `SQLExecute[conn, "\\\d;"]` What am I doing wrong? Any help would be greatly appreciated! Edit: I should add that the error I'm getting is this: `JDBC::error: [Vertica][VJDBC](4856) ERROR: Syntax error at or near "\" >>`


Builder pattern for complex objects construction

**Intro** I was watching "UnRisk-Q Instrument Builder" talk (https://www.youtube.com/watch?v=Xx3goIBpOdE) and those guys use builder pattern to build complex objects like this:               bondBuilder = BondBuilder[]     bond = bondBuilder @ Nominale[1.] @ StartDate[{2010,10,10}] @ Build[]      and later `bond` is immutable and you can invoke methods on it: `bond @ SomeMethod[]` The reason it works is them using JLink and `@` behaves weirdly there and associates to the left. **Question/Problem** How to implement a builder pattern that:   * looks good & concise in notebook and .m files? You could use custom operator instead of `@` or some `~infix~` notation, but that looks heavy.   * allows partial builder reuse like:              octBuilder = BondBuilder[] @ StartData[{2010, 10, 10}]     bond1 = octBuilder @ Nominale[1.] @ Build[]     bond2 = octBuilder @ Nominale[2.] @ Build[]        * has enough flexibility to add error checking to `Build[]` I obviously do not want to mess a lot with `@` and try to redefine its associativity. I do not want to copy the look but the idea.


Visualizing a 2-dimensional PDF

I have empirical data that describes a 2-dimensional Probability Density Function and I want to visualize that data in a meaningful way using Mathematica. My first instinct is to use a 2D Heat map style plot, where high probabilities would be shown in red, and low in blue or white. However I am a novice when it comes to Mathematica's visualization power so I would like some community input. Is there a better way to visualize this data?


How to plot a function with two parameters determined by another parameter?

I have one small question. My code is like follows.               a = 5;      mm = Solve[a x + y == 7 && x - y == 1, {x, y}];      t1 = x /. mm[[1]];      t2 = y /. mm[[1]];           myfunction[{x_, y_}] := (y + x)/(x + r)     Plot[myfunction /@ {{t1, t2}}, {r, 0, 3}, Evaluated -> True]      I want to change plot of `myfunction` for different `a` in one plot. How could I do? Thanks. **Edit** \- The actual code is more complex than the stripped down example above and fails to produce the figure showing the function ppw[r] for different values of bb. I have tried the replacement methods suggested by Peltio, but they do not work Here is a simplified version of the code using only linear ODEs:               xxin[aa_?NumericQ, bb_?NumericQ] :=NDSolve[{\[Psi]''[r] == -bb \[Psi][r], \[Psi]'[0.1] ==0, \[Psi][1] == aa}, \[Psi], {r, 0.1, 1}, PrecisionGoal -> 20]     xxshell[aa_?NumericQ, cc_?NumericQ] :=NDSolve[{\[Psi]''[r] == \[Psi][r] + 1, \[Psi][1] ==aa, \[Psi][1.5] == cc}, \[Psi], {r, 1, 1.5}, PrecisionGoal -> 20]     xxout[cc_?NumericQ] :=NDSolve[{\[Psi]''[r] == \[Psi][r], \[Psi][1.5] ==cc, \[Psi]'[3] == 0}, \[Psi], {r, 1.5, 3}, PrecisionGoal -> 20]     xxinaTry[aa_?NumericQ,bb_?NumericQ] := (Evaluate[\[Psi]'[1] /. xxin[aa, bb]])[[1]]     xxoutaTry[aa_?NumericQ,cc_?NumericQ] := (Evaluate[\[Psi]'[1] /. xxshell[aa, cc]])[[1]]     xxinbTry[aa_?NumericQ,cc_?NumericQ] := (Evaluate[\[Psi]'[1.5] /. xxshell[aa, cc]])[[1]]     xxoutbTry[cc_?NumericQ] := (Evaluate[\[Psi]'[1.5] /. xxout[cc]])[[1]]           bb = 0.8;       sols = FindRoot[{ xxinaTry[aa, bb] == bb xxoutaTry[aa, cc],       xxoutbTry[cc] == xxinbTry[aa, cc]}, {{aa, 0}, {cc, 0}}];      \[Psi]a =aa /. sols;     \[Psi]b = cc /. sols;     pww[r_] = Evaluate[Piecewise[{{Evaluate[ Exp[\[Psi][r]] /. xxin[\[Psi]a, bb]],       0.1 <= r <= 1}, {Evaluate[       Exp[\[Psi][r]] /. xxshell[\[Psi]a, \[Psi]b]],       1 < r < 1.5}, {Evaluate[Exp[\[Psi][r]] /. xxout[\[Psi]b]],       r > 1.5}}, Indeterminate]];       Show[Plot[pww[r], {r, 0, 3}], PlotRange -> All]      **Edit 2** : By using the above simplified code, I successfully created a plot in the end. (sorry, I do not know how to display a figure here) But when I modified the pww[r] function into the following:                pww[r_][bb_?NumericQ] = Evaluate[Piecewise[{{Evaluate[ Exp[\[Psi][r]] /. xxin[\[Psi]a, bb]],       0.1 <= r <= 1}, {Evaluate[       Exp[\[Psi][r]] /. xxshell[\[Psi]a, \[Psi]b]],       1 < r < 1.5}, {Evaluate[Exp[\[Psi][r]] /. xxout[\[Psi]b]],       r > 1.5}}, Indeterminate]];        Show[Table[Plot[pww[r][bb], {r, 0, 3}], {bb, 0.8, 0.8, 0.1}], PlotRange -> All]      Here, bb is a variable and I delete the bb=0.8; Then                  sols = FindRoot[{ xxinaTry[aa, bb] == bb xxoutaTry[aa, cc], xxoutbTry[cc] == xxinbTry[aa, cc]}, {{aa, 0}, {cc, 0}}];      does not work because it does not know bb. In this case, I tried to replace the `\[Psi]a` and `\[Psi]b` in the function `pww[r_][bb_?NumericQ]` by using the following code:                  Evaluate[aa /. FindRoot[{xxinaTry[aa, bb] == bb xxoutaTry[aa, cc],      xxoutbTry[cc] == xxinbTry[aa, cc]}, {{aa, 0}, {cc, 0}}]]        Evaluate[cc /. FindRoot[{xxinaTry[aa, bb] == bb xxoutaTry[aa, cc],      xxoutbTry[cc] == xxinbTry[aa, cc]}, {{aa, 0}, {cc, 0}}]]      In this case, I got the following kind of errors: > During evaluation of In[1]:= FindRoot::nlnum: The function value {0.244919 > bb+xxinaTry[0.,bb],-0.244919} is not a list of numbers with dimensions {2} > at {aa,cc} = {0.,0.}. >> > > During evaluation of In[1]:= ReplaceAll::reps: > {FindRoot[{xxinaTry[aa,bb]==bb > xxoutaTry[aa,cc],xxoutbTry[cc]==xxinbTry[aa,cc]},{{aa,0},{cc,0}}]} is > neither a list of replacement rules nor a valid dispatch table, and so > cannot be used for replacing. >> > > During evaluation of In[1]:= NDSolve::dsvar: 0.12251026530612244` cannot be > used as a variable. >> > > During evaluation of In[1]:= ReplaceAll::reps: > {NDSolve[{([Psi]^[Prime][Prime])[0.12251]==-0.8 > [Psi][0.12251],([Psi]^[Prime])[0.1]==0,[Psi][1]==0.},[Psi],{0.12251,0.1,1},PrecisionGoal->20]} > is neither a list of replacement rules nor a valid dispatch table, and so > cannot be used for replacing. >> > > During evaluation of In[1]:= FindRoot::nlnum: The function value {0.2 > ([Psi]^[Prime])[1.],0.} is not a list of numbers with dimensions {2} at > {aa,cc} = {0.,0.}. >> > > ... It should be very complex. Could you provide some help? The above code can be run in Mathematica 9.0 and generate the same error in your computer, I believe.


Calculating a potential function using the finite element method

This is my first attempt to use the Finite Element method available in version 10. There are questions and I am very open to suggestions. My example is flow around a cylinder which is a well known example of a potential problem. I wish to extend this to more general shapes. I first set up the region which is straightforward.               Needs["NDSolve`FEM`"];     x2 = 2; y2 = 1; r = 1/8;     reg = ImplicitRegion[0 <= x <= x2 &&0 <= y <= y2 &&      (x - x2/2)^2 + (y - y2/2)^2 >= r^2,{x, y}];      I make the mesh. Question 1: can I just put the refined boundary on the inner circle and not on the outer boundary?               mesh = ToElementMesh[reg, MaxCellMeasure -> 0.0005, "MaxBoundaryCellMeasure" ->0.01];     Show[mesh["Wireframe"], Frame -> True, PlotRange -> All]      ![Mathematica graphics](http://i.stack.imgur.com/lwZ6p.png) There is a problem around the circle at about 1 o'clock—expanded view below. Question 2: is this a problem with the grid generation or the plotting of the grid?               Show[mesh["Wireframe"], Frame -> True,PlotRange -> {{0.6, 1.4}, {0.3, 0.7}}]      ![Mathematica graphics](http://i.stack.imgur.com/gkGdN.png) The differential equation is just the Laplacian and a solution is found easily.               sol = NDSolveValue[{Laplacian[u[x, y], {x, y}] ==        NeumannValue[1., x == 0] + NeumannValue[-1, x == 2]},       u, Element[{x, y}, reg]];      The solution looks good except for the artifact close to {0, 0}. This artifact disappears if `PlotPoints` is increased to {50,25}. Question 3: Is this just a plotting bug that can be ignored?               Column[{       Plot3D[sol[x, y], Element[{x, y}, reg], BoxRatios -> {2, 1, 1},        ImageSize -> 300],       Plot3D[sol[x, y], Element[{x, y}, reg], BoxRatios -> {2, 1, 1},        ImageSize -> 300, PlotPoints -> {50, 25}]     }]      ![enter image description here](http://i.stack.imgur.com/Chd1T.png) A plot of the potential function around the circle, below, looks good. Question 4: if the grid is made up as a polygon how does the solution find the values that are on the circle but not on the grid?               Plot[Evaluate[sol[1 + (r) Cos[θ], 0.5 + (r) Sin[θ]]],      {θ, 0,2 π}]      ![Mathematica graphics](http://i.stack.imgur.com/ykRAA.png) I am interested in the velocity which is the gradient of the potential function. I calculate the velocity using Grad.               ClearAll[f];     f[x_, y_] := Evaluate[Grad[sol[x, y], {x, y}, "Cartesian"]]      The following should plot the speed of the fluid around the circle. Question 5: what is going wrong?               ϵ = 0.0;     Plot[Evaluate[Norm[f[1 + (r + ϵ) Cos[θ],      0.5 + (r + ϵ) Sin[θ]]]], {θ, 0, 2 π}]      ![Mathematica graphics](http://i.stack.imgur.com/oDBN1.png) Moving off the circle does not help much.               ϵ = 0.1;     Plot[Evaluate[  Norm[f[1 + (r + ϵ) Cos[θ],      0.5 + (r + ϵ) Sin[θ]]]], {θ, 0, 2 π}]      ![Mathematica graphics](http://i.stack.imgur.com/bfUHL.png) As usual StreamPlot has a mind of its own and does not produce the streamlines I ask for. Question 6: is there a way of using the region defined at the start rather than a new `RegionFunction`?               spts = Table[{0.001, y}, {y, 0, 1, 0.02}];     StreamPlot[f[x, y], {x, 0, 2}, {y, 0, 1}, AspectRatio -> Automatic,      RegionFunction ->       Function[{x, y, vx, vy, n}, (x - x2/2)^2 + (y - y2/2)^2 >= r^2],      StreamPoints -> spts,      Epilog -> {Point[spts], Circle[{x2/2, y2/2}, r]}]      ![Mathematica graphics](http://i.stack.imgur.com/yQ8m7.png) This is an edit to my problem which may help to establish the issue as being one of a bad mesh. Starting again but making a finer mesh we see that it is sill bad but good in parts. Question: Are there other methods for making a mesh?               mesh = ToElementMesh[reg, MaxCellMeasure -> 0.00001,      "MaxBoundaryCellMeasure" -> 0.01];      Show[mesh["Wireframe"], Frame -> True,PlotRange -> {{0.95, 1.2}, {0.5, 0.7}}]      ![Mathematica graphics](http://i.stack.imgur.com/mRU5B.png) If we now solve using this faulty mesh rather than in the original question by using a default mesh we have:               sol = NDSolveValue[{Laplacian[u[x, y], {x, y}] ==       NeumannValue[1., x == 0] + NeumannValue[-1, x == 2]}, u,        Element[{x, y}, mesh]];      Calculating the gradient as before               ClearAll[f];     f[x_, y_] := Evaluate[Grad[sol[x, y], {x, y}, "Cartesian"]]      The plot of the speed is now                ϵ = 0.0;     Plot[Evaluate[Norm[f[1 + (r + ϵ) Cos[θ],      0.5 + (r + ϵ) Sin[θ]]]], {θ, 0, 2 π}]      ![Mathematica graphics](http://i.stack.imgur.com/LhWpe.png) This is good at locations away from the bad mesh. Thus the problem seems to be a mesh problem with improved mesh resolution giving better results.


Manipulate indexed Interpolating Functions

**MWE** I have some data indexed by `gamma`. For each `gamma` I want to find the intersection points of two lists and plot the lists and the intersection points. I convert the two lists into two functions `ifun[gamma]` and `ifun2[gamma]` using `interpolation`, find their intersection using `FindRoot` and plot them. Instead of creating a separate plot for each gamma, I'd like to be able to throw that inside Manipulate. But I am running into trouble with Manipulate needing to explicitly define dependence on variables, as mentioned in the possible issues.               Table[ifun[gamma]=Interpolation[Table[{i, i^gamma}, {i, 1, 10}]], {gamma, 1, 2, 1}]     Table[ifun2[gamma]=Interpolation[Table[{i, gamma^gamma}, {i, 1, 10}]], {gamma, 1, 2, 1}]     Table[solE[gamma] = {x} /.FindRoot[ifun[gamma][x] == ifun2[gamma][x], {x, 0.15}], {gamma, 1,  2}]          Framed@Show[ListPlot[{#, ifun[1][#]} & /@ solE[1], PlotStyle -> PointSize[Large]], Plot[{ifun[1][x], ifun2[1][x]}, {x, 0, 10}],RegionPlot[x < solE[1][[1]] && -5 < y < 5, {x, 0, 10}, {y, -5, 5}, PlotStyle -> {{Yellow, Opacity[0.2]}}]]      ![enter image description here](http://i.stack.imgur.com/GNqZk.jpg) **Update2** Ok so I did the indexing on the data and not on the functions, solved for the solutions outside the manipulate and just stored the points, interpolated inside Manipulate for plotting..and it works.               Table[data1[gamma] = Table[{i, i^gamma}, {i, 1, 10}], {gamma, 1, 2}]     Table[data2[gamma] = Table[{i, gamma^gamma}, {i, 1, 10}], {gamma, 1, 2, 1}]     Table[solE[gamma] = {x} /.FindRoot[Interpolation[data1[gamma]][x] ==      Interpolation[data2[gamma]][x], {x, 0.15}], {gamma, 1, 2}]      This works:               Manipulate[fun = Interpolation[data1[gamma]];fun2 = Interpolation[data2[gamma]];Plot[{fun[x], fun2[x]}, {x, 1, 5}, Epilog -> {Black, PointSize[Large],   Point[{solE[gamma][[1]], fun[solE[gamma][[1]]]}]},  AxesOrigin -> {0.5, 0}], {gamma, 1, 2, 1}]      ![enter image description here](http://i.stack.imgur.com/GmbKM.jpg)


Needs entry point of a package from a Mathematica script

I am writing a bunch of _Mathematica_ scripts to run command line in a HPC environment. I am organising my solution in small chunks I can test separately. So I have a directory structure like:               ├── test     │   ├── coefficients-test.math     │   ├── main-test.math     │   ├── nearest-test.math     │   ├── rangek-test.math     │   ├── unit.m     │   └── wave-test.math     └── wde         ├── coefficients.m         ├── ???.m         ├── nearest.m         ├── rangek.m         └── wave.m      The `test` folder contains a bunch of unit tests using simple poor man's testing. Each test script begins (say `test/coefficients-test`)               #!/Applications/Mathematica.app/Contents/MacOS/MathematicaScript -script          $Path = Join[$Path, {Directory[]<>"/wde"}];     Needs["unit`"];     Needs["coefficients`"];      and then testing code. I `chmod`ed them with a+x and I just run them like: > $ ./test/coefficients-test.math (Needless to say that in the HPC the _Mathematica_ script path is different, but that is secondary for the moment.) So far so good. The problem is that when I try to develop the main component of my `wde` package, if I name the file `wde/init.m` or `wde/wde.m` or `wde/Kernel/init.m` and try to load it in the test script with `Needs["wde`"]` I get the infamous context not created error; although I have inside it `BeginPackage["wde`"]`. If I name my package, say `wde/main.m` and put inside `BeginPackage["main`"]`, it works. Easy work around, but I was wondering what I am doing wrong in the first place. Do I need to copy my package to a standard _Mathematica_ location for script loading? Why doesn't the `$Path` trick work in this case? Again, this is a purely scripting approach - not sure if this is suitable from the front-end in a notebook, although at this stage this not a concern. Actually, my plan is to develop the script further to generate a CDF via a script and load that in the front-end for demo-ing purposes, etc (I understand this is the recommended solution to CDF production.)


listplot very large numbers

Suppose we have the following function:               NN = 150;     W[n1_] := NN!/(n1 ! (NN - n1!)) (1/2)^n1 (1/2)^(NN - n1)      Then we can Plot or Listplot it:               ListPlot[Table[{n1, W[n1]}, {n1, 1, 10, 0.1}], Joined -> True,       Frame -> True, Axes -> None, BaseStyle -> {FontSize -> 16},       PlotMarkers -> {"\[Bullet]", 10}, PlotStyle -> Red]      ![enter image description here](http://i.stack.imgur.com/FiRF2.png) If we change NN to 200 or more, then we get the following error: > ListPlot::prng: Value of option PlotRange -> > {{0,10.},{-1.341145999799935*10^312,2.466246209857526*10^312}} is not All, > Full, Automatic, a positive machine number, or an appropriate list of range > specifications. >> How can we deal with these large numbers in plot?


How to get CUDALink working on linux (Crunchbang Waldorf) with NVS 3100m

I am trying to get CUDALink working on my laptop. I am running Crunchbang "waldorf" which is based on Debian 7 "wheezy". I am a linux novice. The issue is that Mathematica can "see" the nVidia drivers, but yet I am not able to get CUDALink to work. I have searched, and read over the article CUDALink not working on Linux-64 and Asus GTX460 which is close to my issue but doesn't seem to cover it, and where it does shed some light I don't appear to have any of the directories mentioned. I have engaged the Crunchbang linux forums to no avail.. I would really like to get CUDALink working.. I have tried information such as on this website http://www2.warwick.ac.uk/fac/sci/statistics/staff/academic- research/graham/cuda5-debian-wheezy/ but it ruined my video driver setup and I was forced to go through the smxi script again and re-install to get the GUI back. At the moment I am re-downloading the cuda_5.5.22_linux_64.run file from nVidia. I have tried installing the nVidia CUDA binaries from the debian package manager but it ruins my system every time, forcing me to use the smxi script to repair. Otherwise, Mathematica 9 is running wonderfully. If someone can please illustrate the process of setting up CUDA/CUDALink I would greatly appreciate it. Cheers! Will EDIT: I have installed CUDA 5.5 from the above package and have run deviceQuery, with positive results. It detects the card and all fields are nominal, referencing the nVidia website for the 3100m. EDIT 2: It was discovered from https://wiki.archlinux.org/index.php/Mathematica that the x64 version of Mathematica is "hard wired" to look for drivers in the /usr/lib64 and not in /usr/lib where things are installed in an x64 native system. Since making a symbolic link using "ln -s /usr/lib /usr/lib64" Mathematica's CUDALink appears to be working now. This question is now closed, but hopefully this can act as community support for others. EDIT 3: As is mentioned in my answer, there is now an issue with CUDALink not running certain functions. It is the same symptoms as this question: CUDALink is not initialized


How can I set multiple values to local variables in a Module?

Multiple assignment is supported by `Set`. How can do something similar in `Module` expressions? If I could do it, whould there be drawbacks? Here is what I tried so far:               g[x11_, y11_] := {xx111, yy111} = {x11, y11}          g[x11_, y11_] := Module[{{x111, y111} = {x11, y11}}, 1]          g[1, 2]      > Module::lvset: Local variable specification {{x111, y111} = {1, 2}} contains > {x111, y111} = {1, 2}, which is an assignment to {x111,y111}; only > assignments to symbols are allowed. >> Possible alternatives are:               ggg[x11_, y11_] :=        Module[{xx = {x11, y11}, x1, x2}, {x1 = xx[[2]], x2 = xx[[1]]}]      or               ggg[x11_, y11_] := Module[{x1111=x11, y1111=y11}, what... ]


Google API and URLFetch

I am trying to systematically obtain the distance between two given locations using the Google Maps API Distance Matrix facility: developers.google.com/maps/documentation/distancematrix/ From the example they give in the web: I'd use: > > URLFetch["http://maps.googleapis.com/maps/api/distancematrix/xml?origins=Vancouver+BC|Seattle&destinations=San+Francisco|Vancouver+BC&mode=bicycling&language=fr- > FR&sensor=false"] and then parse the xml data. Now if I want to do this for many cities, I would build a string with URL changing the appropriate `origins` and `destinations` and other parameters. However, it looks pretty cumbersome to me and I feel that there should be a more efficient way to do it. Perhaps using the `parameters` option in `URLFetch`. So, there is the question, using the Google Maps API, given two locations is an more efficient (faster) way to obtain its distance? Thanks in advance!


Code Performance Tuning

The following code takes over 4 seconds to run. Any one has suggestions to make the expressions for `qf`, `phi`, `qr`, and `k` more efficient? Can someone suggest ways I can use`NestWhile` in the place of `While` and `Compile[]` on the four expressions (`qf`, `phi`, `qr`, and `k`) to enable `Parallelization`?               demand[n_, k_] := Min[k Vf, n capacity];     supply[n_, k_] := Min[(n Kj - k) w, n capacity];     flo[n_, ku_, kd_] := Min[demand[n, ku], supply[n, kd]];     gamma[ku_, kd_] := Min[1, supply[L, kd]/demand[L, ku]];     inflow [phi_, FQin_] := (phi - \[Beta] FQin) dx;     density[qin_, qout_, qr_] := (qin - qout + qr)/Vf;          L = 1; \[Beta] = 0.1; dx = 1/6; capacity = 7500; Kj = 150.; w = 100.; Vf = 100.;TT=0; RML = 2     k0 = Table[1, {i1, 1, 10}];     kr = Table[Table[1, {i1, 1, 4}], {i2, 1, 10}];     While[TT < 200000,        qf = Map[flo[L, #[[1]], #[[2]]] &, Partition[k0, 2, 1]];        phi = Flatten[Map[demand[1, #] &, Take[kr, All, -1]]][[2 ;; -2]]*Map[gamma[#[[1]], #[[2]]] &, Partition[k0[[2 ;; -1]], 2, 1]];        qr = (inflow @@ #) & /@ Transpose[{phi, qf[[1 ;; -2]]}];        k = (Plus @@ #) & /@ Transpose[{Insert[Map[density[#[[1]], #[[2]], #[[3]]] &, Flatten /@ Transpose[{Partition[qf, 2, 1], qr}]], 0, {{1}, {-1}}], k0}];        k0 = k;        TT += Plus @@ k0;     ]; // Timing      **Edit:** I also have the following piece of code that will go right below the k0=k in the above code               RMori = Table[100 (i1 dx)^2 + 50 (i1 dx) + 1000, {i1, 1, n - 2}];     RM = MapThread[Min[#1, #2] &, {RMori, flo[1, #[[RML]], #[[RML + 1]]] & /@ kr}];     qr = MapThread[Join[#1, {#2}, #3, {#4}] &, {flo[L, ##] & @@@ Partition[#[[;; RML]], 2, 1] & /@ kr, RM, flo[L, ##] & @@@ Partition[#[[RML + 1 ;;]], 2, 1] & /@ kr, \[Phi]}];     kr = MapThread[(#1 + #2) &, {Join[{0}, #] & /@ (density[Most@#,Rest@#, 0] & /@ qr), kr}];      in line of the suggestions made by SimonWoods, Can some one suggest ways to improve this piece of code? Also, I need some guidance on using `NestWhile` in place of `While`.


List of lengths of runs of elements

I have a list where a few distinct numbers occur, e.g.               {41, 41, 41, 1009, 41, 41, 41, 41, 41, 41, 41, 1009, 41, 41, 41}      I want to extract the information of how many times in a row each number occurs. For the above list,               {{3,7},{1}}      I actually already have something that works, but it seems excessively complicated and amateurish. Any ideas to improve this?               (Take[#, All, {2}] // Flatten) & /@      Sort[       GatherBy[{#[[1]], Length[#]} & /@ Union@Split@INPUTLIST,        First],       First@First[#1] < First@First[#2] &]


Question about NDSolve

Here is my code:               k = 0.42; e = 5; d = 7; n = 1/0.7158; R2 = 40000;           s =       NDSolve[{k^2  (u'[y] )^(3/2) (u'[y] + 2 u[y] Exp[y]/(R2 - Exp[y]))^(           1/2) - (-u'[y] (R2 Exp[-y] - 1) - 2 u[y]) (n - 1)/R2 - 1 == 0,         u[Log[4.17 (n - 1)]] == 4.17},        u, {y, Log[4.17 (n - 1)], Log[(n - 1) R2/(2 n)]}];          C1[y_] = Evaluate[u[y] /. s[[2]]];          Plot[C1[y], {y, Log[4.17 (n - 1)], Log[(n - 1) R2/(2 n)]}]          x = (((-C1'[y] (R2 Exp[-y] - 1) - 2 C1[y])/(-Exp[y] + R2)^3 +            R2/((n - 1) (-Exp[y] + R2)^3)) Abs[          C1'[y] Exp[-y] + 2 C1[y]/(R2 - Exp[y])])^(-1/4) Exp[-y] (n - 1)^(       1/2) R2^(-1/2)          f[y_] = NIntegrate[       2/3 a^(-5/3)         Exp[-a d Abs[x]] (1 + (e n Exp[y]/(R2 (n - 1)))^2/a^2)^(-17/         6), {a, 1, Infinity}]          f1 = FunctionInterpolation[(f[y])^(       3/4), {y, Log[4.17 (n - 1)], Log[(n - 1) R2/(2 n)]}]          Plot[Re[f1[y]], {y, Log[4.17 (n - 1)], Log[(n - 1) R2/(2 n)]}]          s = NDSolve[{k^2  (f1[y]) (u'[y])^(           3/2) (u'[y] + 2 u[y] Exp[y]/(R2 - Exp[y]))^(           1/2) - (-u'[y] (R2 Exp[-y] - 1) - 2 u[y]) (n - 1)/R2 - 1 == 0,         u[Log[4.17 (n - 1)]] == 4.17},        u, {y, Log[4.17 (n - 1)], Log[(n - 1) R2/(2 n)]}]          C1[y_] = Evaluate[u[y] /. s[[2]]]          Plot[Re[C1[y]], {y, Log[4.17 (n - 1)], Log[(n - 1) R2/(2 n)]}]          x = (((-C1'[y] (R2 Exp[-y] - 1) - 2 C1[y])/(-Exp[y] + R2)^3 +            R2/((n - 1) (-Exp[y] + R2)^3)) Abs[          C1'[y] Exp[-y] + 2 C1[y]/(R2 - Exp[y])])^(-1/4) Exp[-y] (n - 1)^(       1/2) R2^(-1/2)          f[y_] = NIntegrate[       2/3 a^(-5/3)         Exp[-a d Abs[x]] (1 + (e n Exp[y]/(R2 (n - 1)))^2/a^2)^(-17/         6), {a, 1, Infinity}]          f1 = FunctionInterpolation[(f[y])^(       3/4), {y, Log[4.17 (n - 1)], Log[(n - 1) R2/(2 n)]}]               Plot[Re[f1[y]], {y, Log[4.17 (n - 1)], Log[(n - 1) R2/(2 n)]}]          (*up to here, I think there is no problem. then the kernel crashes below*)          s = NDSolve[{k^2  (f1[y]) (u'[y])^(           3/2) (u'[y] + 2 u[y] Exp[y]/(R2 - Exp[y]))^(           1/2) - (-u'[y] (R2 Exp[-y] - 1) - 2 u[y]) (n - 1)/R2 - 1 == 0,         u[Log[4.17 (n - 1)]] == 4.17},        u, {y, Log[4.17 (n - 1)], Log[(n - 1) R2/(2 n)]}]          C1[y_] = Evaluate[u[y] /. s[[2]]]          Plot[Re[C1[y]], {y, Log[4.17 (n - 1)], Log[(n - 1) R2/(2 n)]}]      `R2` is a constant. When I set `R2` smaller than `33000`, I can always got a numerical solution of `u[y]`. However when `R2` gets very large,i.e. `40000`, mathematica just doesn't work at all. I mean there is no solution given for the third differential equation. Can anybody tell me how to solve this problem? I will be more than appreciated. Thanks.


Finding all simple paths between two vertices in a graph

There are built-in methods to find a shortest path between two vertices in a graph, and the question on finding all shortest paths between two vertices has gathered quite a bit of attention. A path is _simple_ if it repeats no vertices. As is with all shortest paths between a pair of vertices, the number of simple paths between two vertices can be huge. What would be a nice and clean method of finding all simple paths between two vertices? Assume the input graph is undirected, simple, and it may have cycles in it. I am not interested in the _number_ of simple paths between $s$ and $t$, but I want to explicitly enumerate all of them. Furthermore, note that this problem cannot be solved in polynomial time. Even writing the output might take time that is not polynomial in the number of vertices. One way of listing the simple paths is to use depth-first search. Maybe `DepthFirstScan` is useful here. The DFS can avoid repeating vertices by marking them as they are visited in the recursion, and then removing the mark just before returning from the recursive call. I learned a backtracking solution might not be that fast.


How is + as an infix operator associated with Plus?

How is `+` associated with `Plus`? Suppose I want to define a head `FooBar` and have it associated with a unicode character of my choice, ideally used as an infix form, i.e.               FooBar[x, y]      is equivalent               x ↗ y      as seen by the kernel. How this kind of thing can be done?


Using Reduce on an inequality

I have been evaluating this formula, $\frac {3^r - 1} {2^r - 1}$ for $r>1$. The numerator is always even and the denominator is always odd. I am trying to show that the denominator will not wholly-divide the numerator and leave a denominator of $1.$ The first table shows the `GCD` and the second shows the result is less than the original denominator.               Table[PolynomialGCD[(3^r - 1), (2^r - 1)], {r, 2, 10}]     (* {1, 1, 5, 1, 7, 1, 5, 1, 11} *)          Table[PolynomialGCD[(3^r - 1), (2^r - 1)] < (2^r - 1), {r, 2, 10}]     (* {True, True, True, True, True, True, True, True, True} *)          Reduce[PolynomialGCD[(3^r - 1), (2^r - 1)] < (2^r - 1)]     (* 2^r > 2 *)        The result of `Reduce` is true for $r>1$. Does the `Reduce` remove the `PolynomialGCD` info because it is always true? ### Edit per _rasher's_ comment               Reduce[r ∈ Integers && n ∈ Integers && r >= 1 &&        PolynomialGCD[(3^r (2n - 1) - 1), (2^r (2n - 1) - 1)] < (2^r (2n - 1) - 1)]     (* ((n | r) ∈ Integers && n >= 2 && r >= 1) || (r ∈ Integers && n == 1 && r >= 2) *)            Exists[r, PolynomialGCD[(3^r (2n - 1) - 1), (2^r (2n - 1) - 1)] < (2^r (2n - 1) - 1)]     Exists[n, PolynomialGCD[(3^r (2n - 1) - 1), (2^r (2n - 1) - 1)] < (2^r (2n - 1) - 1)]


How can I prevent a Plot expression from evaluating points forbidden by its RegionFunction?

I just ran into this and it had me scratching my head for a good while. Say I have a function which may produce error messages for certain inputs, like e.g.               f[x_, y_] := (Sin[x] - Sin[y])/(x - y)      which will return `Power::infy` and `Infinity::indet` when called on the diagonal `x==y`. If I want to avoid that singular input in a plot, the standard way of telling Mathematica to not evaluate it there is to use a `RegionFunction` command, like               Plot3D[f[x, y]      , {x, -10, 10}, {y, -10, 10}      , RegionFunction -> Function[{x, y, f}, Abs[x - y] > 5]      ]      This will successfully generate a plot with the diagonal taken off, but it will still produce the same error messages as `f[1,1]`. This behaviour remains even if I add the qualifiers `f[x_: NumericQ, y_: NumericQ]` to the definition, so some singular inputs are definitely passed to the function even though they are away from where I'm telling it to plot. So: why is this? Is this actually the correct way to specify regions to stay away from? If not, what's the best practice for that?


Simplifying a trigonometric equation to obtain specific terms

When I try to solve the non-homogeneous differential equation               DSolve[ y''[x] + y[x] == a Cos[2x] + b Cos[x] + c Cos[2x-3]+ d Cos[2x]^2-         6d Cos[2x]+9d + e Cos[x]^2+ fCos[x] Cos[3x]+h Cos[x]^2 Cos[2x-3] +i cos[x]^4, y[x], x]       I get a solution with squares of $\sin x$ and $\cos x$. I want to remove all the $\sin x$ terms from the solution and want to express the solution in terms of $\cos 2 x$ and $\cos 4x$. So what should be the input that will give the result that I want?


How to generate a matrix group?

I have three $7\times 7$ matrices (with real entries, lots of zeros) and I'd like to check if they generate a finite group (or, more precisely, if the group they generate is of precise order). Would it be possible to do with Mathematica? * * * These are the matrices. All of order 3. I expect this group to be of order 6048 or 12096.               gMatrix =        SparseArray[{{1, 3} -> 1, {2, 1} -> 1, {3, 2} ->           1, {4, 4} -> -(1/2), {4, 5} -> -(1/2), {4, 6} -> -(1/2), {4,            7} -> -(1/2), {5, 4} -> 1/2, {5, 5} -> -(1/2), {5, 6} ->           1/2, {5, 7} -> -(1/2), {6, 4} ->           1/2, {6, 5} -> -(1/2), {6, 6} -> -(1/2), {6, 7} -> 1/2, {7, 4} ->           1/2, {7, 5} ->           1/2, {7, 6} -> -(1/2), {7, 7} -> -(1/2), {_, _} -> 0}, 7];          hMatrix =        SparseArray[{{1, 5} ->           1, {2, 2} -> -(1/2), {2, 3} -> -(1/2), {2, 6} -> 1/2, {2, 7} ->           1/2, {3, 2} -> 1/2, {3, 3} -> -(1/2), {3, 6} -> -(1/2), {3, 7} ->           1/2, {4, 1} -> 1, {5, 4} -> 1, {6, 2} -> -(1/2), {6, 3} ->           1/2, {6, 6} -> -(1/2), {6, 7} ->           1/2, {7, 2} -> -(1/2), {7, 3} -> -(1/2), {7, 6} -> -(1/2), {7,            7} -> -(1/2), {_, _} -> 0}, 7];          kMatrix =        SparseArray[{{1, 4} -> -1, {2, 2} -> -(1/2), {2, 3} -> -(1/2), {2,            6} -> -(1/2), {2, 7} -> 1/2, {3, 2} ->           1/2, {3, 3} -> -(1/2), {3, 6} -> -(1/2), {3, 7} -> -(1/2), {4,            5} -> -1, {5, 1} -> 1, {6, 2} -> 1/2, {6, 3} ->           1/2, {6, 6} -> -(1/2), {6, 7} -> 1/2, {7, 2} -> -(1/2), {7, 3} ->           1/2, {7, 6} -> -(1/2), {7, 7} -> -(1/2), {_, _} -> 0}, 7];


Why will my plot not generate my entire plot?

I am trying to plot a sum of multiple `HeavisidePi` functions. A typical example would be something like this:               Plot[HeavisidePi[1/10 (-595 + x)] + HeavisidePi[1/10 (-535 + x)] +        HeavisidePi[1/10 (-425 + x)] + HeavisidePi[1/10 (-365 + x)], {x,        300, 800}, Exclusions -> None]      In this interval in the code above, I can see all four of them. However, if I were to back out to an interval of {100,800}, for instance, only two of them show up for me (the one at 595 and 425). Any idea why this would be the case? Any help would be greatly appreciated.


Solve f'[x]==0 for x

I tried the following:               f[x_] := x^n/(k + x^(2 n));     Solve[f'[x] == 0, x]      But I got the following response: > Solve::nsmet: This system cannot be solved with the methods available to > Solve. >> Any suggestions?


Solving a differential equation for a variable in a function

This may sound like a very trivial question, but I need to solve a differential equation as follows:               a := 3.24077*10^-20 (* km \[Rule] Mpc *)     b := 3.16888*10^-14 (* s \[Rule] MYear *)     c := a/b*(2.99792*10^5) (*Mpc/ MYear*)     \[HBar] := a^2/b (1.05457*10^-37)(*kgMpc^2/MYear*)     H0 := a/b*71 (*1/MYear*)     G := a^3/b^2*6.67398*10^-20 (*Mpc^3/(Kg*MYear^2)*)     \[CapitalOmega]M := 0.27     \[CapitalOmega]\[Gamma] := 8.24*10^-4     \[CapitalOmega]\[CapitalLambda] := 0.73     \[Lambda] := 1/a^2 1*10^-58(*1/Mpc^2*)     f := 1*10^-4     y := 10     \[Rho]pert[r_] := \[Rho]*(1 + f*Exp[-(r/y)^2]) // N     M2[r_] := 4 \[Pi]*Integrate[\[Rho]pert[r1]*(r1)^2, r1] /. r1 -> r     E2[r_] :=       1/2*((H[999]*r)/(c*(1000)))^2 - ((G *M2[r] (1000))/(        c^2 (r))) - (\[Lambda]*r^2)/(3 (1000)^2)     ScaleFactor2 =       NDSolve[SetPrecision[{(D[R2[r, t], t]) ==           Sqrt[(2*G*M2[r])/R2[r, t] + 2*c^2*E2[r] + (           2 c^2 \[Lambda]*R2[r, t]^2)/3], R2[r, 0] == r/1000}, 200],        R2, {r, 1, 20000}, {t, 1, 15000}, AccuracyGoal -> 2]     Rad2[r_, t_] := Evaluate[R2[r, t] /. ScaleFactor2]     RadPrime2[r_, t_] := D[Rad2[r1, t], r1] /. r1 ->  r     Raddot2[r_, t_] := D[Rad2[r, t], t]     ***chi = DSolve[(c Sqrt[1 + 2 E2[r]])/RadPrime2[r, t], r, t]***      I am looking for a solution for the differential equation chi, but would like an answer whose subject is the variable _r_ that appears in `RadPrime2[r,t]`. In other words, I am looking for the functional form of r(t)... I apologise in advance if this seems really badly phrased and/or trivial, but I couldn't find anything in the literature that helped...


Graphical representation of a moving sound source

Some explanation since I have got a specific and another more open-ended question: I used two microphones in a 90° arrangement (see picture below) to capture sound from a source moving around the room in a circular /elliptical fashion. The intention is to get an idea about directional hearing. (A second measurement with a KEMAR dummy-head was done as well). ![arrangement](http://i.stack.imgur.com/kHEKa.jpg) ![microphone arrangement](http://i.stack.imgur.com/pUUt9.jpg) I saved the measured data as .wav (48kHz) and imported the .wav file into _Mathematica_. (The .wav- file can be found here). That made a pretty long list - approximately 900000 entries per channel. Hence I used                dropfunction[data_, n_] :=       Table[Nest[Drop[#, {1, -1, 2}] &, data[[i]], n], {i, 1, 2}]       to reduce the resolution. I found by hearing/looking at `ListLinePlot` that `n = 7` is a good catch. That leaves around 7000 entries per channel. Here comes my first and very specific question: I plotted the absolute values of my list in a fashion like:               ListLinePlot[Abs@data[[1]], -Abs[data[2]]]      and got: ![left vs. right channel](http://i.stack.imgur.com/MLZtq.png) with left and right channel clearly divided along the x-axis. **Question 1:** Is there a possibility to flip the plot in such a way that x-axis becomes the y-axis? (So that for instance the "loudness" of the right channel is on the right hand side). I tried `PairedBarChart` actually gives the kind of representation I wish, but It is just not suitable for my data. **Question 2:** Does anybody else have a great idea how to graphically represent my data? I tried plotting the difference of the absolute values of both channels to get a graph showing which channel is currently louder at the positions in time/on my elliptical path. With some lowpass-filtering I got: ![enter image description here](http://i.stack.imgur.com/KSAux.png)


How to show a general graphic (not a Plot) inside a Manipulate

I'm building a little interface, which consists only of a button, as you can see here:               Button["File Input",        file = Import[SystemDialogInput["FileOpen"]];                  Print[principalFunction[file]]]      Now I'd like to insert the produced graphic and the button inside a `Manipulate`. Note that I'm not using Plot, Plot3D, etc. -- the graphics are produced by `principalFunction` as the final result of evaluating many other functions.


How do I access the binary matrix underlying an EdgeDetect output?

Applying `EdgeDetect` to an image generates a black and white edge-detected image, which I suspect corresponds to an underlying binary matrix. How can I access this underlying data structure, and map between a given matrix position and the corresponding coordinates in the processed image? Ideally, I'd just like a list of, say, the $1$'s or $0$'s in the matrix (whatever corresponds to the white lines in the edge-detected image) and their coordinates.


DateString and localization, $Language ignored

I have a `DateString` calculated in English. Now I would like to change the output according to localization. I have read that localization is possible for Menu, Messages and Cells. A simple `$Language = "French"` before calling `DateString` is ignored. Since this should be a basic feature for localization, I am wondering if my keywords for Google and SX are just plain wrong? Or is this feature not present?


How to format a large Number

There is a large number               a = 123456789012345678901234567.123456789012345678901234567        By format with AccountingForm               b = AccountingForm[a, 54]        it becomes               123456789012345678901234567.123456789012345678901234567        How to to parameterise the integer part and the fractional and the   n-digit precision part to produce a number. Like               int=123456789012345678901234567.       fra=.123456789012345678901234567       pre=54        resulting to the same outcome like b above? **UPDATE** A general solution was found.               int = 1234567890123456789012345678900;     fra = 123456789012345678901234567890;          SetPrecision[ToExpression[ToString[int] <> "." <> ToString[fra]],      StringLength[ToString[int]] + StringLength[ToString[fra]]]        is still a number,               1.234567890123456789012345678900123456789012345678901234567890*10^30        now look at it as a string with all digits minutely preserved               ScientificForm[%, ExponentStep -> StringLength[ToString[int]]]            1234567890123456789012345678900.123456789012345678901234567890


How to plot two sets of points in diferent colors with Epilog?

I want to plot two sets of poins (say, one in black and other in gray). How can do I this? I only obtain one set, and I don´t know how to use two colors in an Epilog option.               peaks[x_, y_] :=        3*(1 - x)^2*Exp[-(x^2) - (y + 1)^2] -          10*(x/5 - x^3 - y^5) Exp[-x^2 - y^2] - 1/3 Exp[-(x + 1)^2 - y^2];     ContourPlot[peaks[x, y], {x, -2, 2}, {y, -2, 3},        ColorFunction -> "DarkRainbow",        ContourLines -> False,        Contours -> 25,        LabelStyle -> {Bold, 20},        Epilog -> {Black, PointSize -> .036, Point[ {{0, 1}, {1, 1}, {1, 1.5}}]},        Epilog -> {Gray, PointSize -> .036, Point[ {{-1, 1}, {-1, 1}, {-1, 1.5}}]}]      * * * Before posting I tried any options, like               ContourPlot[peaks[x, y], {x, -2, 2}, {y, -2, 3},        ColorFunction -> "DarkRainbow",        ContourLines -> False,        Contours -> 25,        LabelStyle -> {Bold, 20},         Epilog ->         {{Black, Gray}, PointSize -> {.036, 0.36},          Point[{ {{0, 1}, {1, 1}, {1, 1.5}}, {{-1, 1}, {-1, 1}, {-1,1.5}}}]}]


Patterns of function-arguments in expressions

I want a function that compares an expression with a specific pattern. The expression has always the following form:               expr = F1[x1]F2[y1] + F1[x2]F2[y2] + F1[x3]F2[y3]      which is a sum of three terms, each term being the product of`F1[..]*F2[..]` with arbitrary arguments. Now what I need is a function that searches the arguments of the expression for a specific pattern. As an example, I want the following pattern: `x1! = x2`, `x1 == x3`, `y1 != y 2`, `y2 != y3`.               v = F1[a]*F2[b] + F1[c]*F2[d] + F1[a]*F2[e]; IsMyPattern[v] (*True*)     w = F1[a]*F2[a] + F1[c]*F2[c] + F1[a]*F2[e]; IsMyPattern[w] (*True*)     x = F1[a]*F2[b] + F1[a]*F2[d] + F1[a]*F2[e]; IsMyPattern[x] (*False, because x1 == x2*)     y = F1[a]*F2[b] + F1[c]*F2[d] + F1[f]*F2[e]; IsMyPattern[y] (*False, because x1 != x3*)     z = F1[a]*F2[b] + F1[c]*F2[b] + F1[a]*F2[e]; IsMyPattern[z] (*False, because y1 != y2*)      The only idea I have is to use `ToString` and apply string manipulations, but thats ugly and most likely slow. **Update** A followup question on the same issue: How can I make the IsMyPattern function more general, such that it matches inputs which have (complex) coefficients and different signs?               k = 2*F1[a]*F2[b] + F1[c]*F2[d] + F1[a]*F2[e]; IsMyPattern[k] (*True*)     l = F1[a]*F2[b] - F1[c]*F2[d] - F1[a]*F2[e]; IsMyPattern[l] (*True*)     m = I*F1[a]*F2[b] + 3*F1[c]*F2[d] - F1[a]*F2[e]; IsMyPattern[m] (*True*)      **Update2** The solution to this problem is remarkable simple, one just needs to add a BlankNullSequence. The function (for arbitrary number of arguments) looks like this:                IsMyPattern[expr_] := MatchQ[expr, ___ F1[x1__]*F2[y1__] + ___ F1[x2__]*F2[y2__] + ___ F1[x3__]*F2[y3__] /; {x1} =!= {x2} && {x1} === {x3} && {y1} =!= {y2} && {y2} =!= {y3}]


Solving a system of three differential equations

I'm trying to create this coloured graph which I'm going to animate, but I'm stuck with solving a system of three differential equations:               lista = (Sort@{{"Aleppo", 2}, {"Atarib", 2}, {"North Mount Simeon", 2},        {"South Mount Simeon", 2}, {"Al-Safirah", 2}, {"Afrin", 2}, {"Azaz", 2},        {"Al-Bab", 2}, {"Dayr Hafir", 2}, {"Manbij", 2}, {"Ayn Al-Arab", 2},        {"Jarabulus", 2}, {"Daraa", 2}, {"Izra", 2}, {"Al-Sanamayn", 2},        {"Abu Kamal", 2}, {"Mayadin", 2}, {"Deir ez-Zor", 2}, {"Al-Suqaylabiyah", 2},        {"Muhardeh", 2}, {"Masyaf", 2}, {"Hama", 2}, {"Salamiyah",2}, {"Al-Hasakah", 2},        {"Ra's al-'Ayn", 2}, {"Al Qamishli",2}, {"Al-Malikiyah", 2}, {"Homs", 2},        {"Al-Qusayr",2}, {"Talkalakh", 2}, {"Ar-Rastan", 2}, {"Al-Mukharram",2},        {"Palmyra", 2}, {"Harem", 2}, {"Idlib",2}, {"Jisr al-Shugur", 2},        {"Arihah", 2}, {"Ma'arrat al-Numan",2}, {"Latakia", -2}, {"Al-Haffah", -2},        {"Qardaha", -2}, {"Jableh", -2}, {"Quneitra", 2}, {"Fiq", 2}, {"Al-Raqqah", 2},        {"Tell Abyad", 2}, {"Al-Thawrah", 2}, {"Duma",2}, {"Markaz Rif Dimashq", 2},        {"Al-Tall", 2}, {"Al-Qutayfah",2}, {"Al-Nabk", 2}, {"Yabrud", 2},        {"Zabadani", 2}, {"Darayya",2}, {"Qatana", 2}, {"As-Suwayda", 2},        {"Shahba", 2}, {"Salkhad", 2}, {"Tartus", -2}, {"Duraykish", -2},        {"Al-Shaykh Badr", -2},{"Baniyas", -2}, {"Safita", -2}})[[All, 2]];          listb = (Sort@{{"Aleppo", 869}, {"Atarib", 2}, {"North Mount Simeon", 0},        {"South Mount Simeon", 0}, {"Al-Safirah", 0}, {"Afrin",3}, {"Azaz", 26},        {"Al-Bab", 14}, {"Dayr Hafir", 0}, {"Manbij",1}, {"Ayn Al-Arab", 0},        {"Jarabulus", 0}, {"Daraa",31}, {"Izra", 0}, {"Al-Sanamayn", 1},        {"Abu Kamal", 56}, {"Mayadin", 4}, {"Deir ez-Zor", 6}, {"Al-Suqaylabiyah",0},        {"Muhardeh", 0}, {"Masyaf", 0}, {"Hama",565}, {"Salamiyah", 1},        {"Al-Hasakah", 1}, {"Ra's al-'Ayn", 0}, {"Al Qamishli", 36}, {"Al-Malikiyah", 0},        {"Homs",1551}, {"Al-Qusayr", 1}, {"Talkalakh", 1}, {"Ar-Rastan",0},        {"Al-Mukharram", 0}, {"Palmyra", 26}, {"Harem", 0}, {"Idlib", 359},        {"Jisr al-Shugur", 0}, {"Arihah", 0}, {"Ma'arrat al-Numan", 0}, {"Latakia", 224},        {"Al-Haffah", 0}, {"Qardaha", 16}, {"Jableh", 3}, {"Quneitra", 22},        {"Fiq",1}, {"Al-Raqqah", 0}, {"Tell Abyad", 6}, {"Al-Thawrah",0},        {"Duma", 0}, {"Markaz Rif Dimashq", 0}, {"Al-Tall" ,0}, {"Al-Qutayfah", 0},        {"Al-Nabk", 0}, {"Yabrud",4}, {"Zabadani", 49}, {"Darayya", 27}, {"Qatana",8},        {"As-Suwayda", 0}, {"Shahba", 0}, {"Salkhad",0}, {"Tartus", 48},        {"Duraykish", 1}, {"Al-Shaykh Badr", 0}, {"Baniyas", 74}, {"Safita", 1}})[[All, 2]];          listc = (1 - lista);          eq = DSolve[{       x'[t] == #1*y[t]*z[t] - #2*x[t]*y[t],       y'[t] == #3*y[t] - #2*x[t]*y[t],       z'[t] == #1*(x[t] - y[t]),       x[0] == 219100,       y[0] == 287500,       z[0] == 1505920},       {x, y, z}, t] & @@@ Thread[{lista, listb, listc}]      I'm still receiving errors: ![enter image description here](http://i.stack.imgur.com/F32Oh.png) And ![enter image description here](http://i.stack.imgur.com/33B5K.png) EDIT: Okay, so I edited listb so that all the 0s became 1s. But now I get this error: ![enter image description here](http://i.stack.imgur.com/W4KyJ.png)


How to apply Robin boundary condition in Mathematica

Robin condition is the boundary condition which combines the Dirichlet and Neumann condition at the same boundary. For example: At the boundary x = 0 to 2: I want to apply `u[x] = 0` for `x = 0 to 1` and `du/dx = 0` for `x = 1 to 2`. I think one of the possible approach is reformulate the PDE discretization using the finite difference method, and manual apply the Robin boundary condition on the systems of ODE. Could we trick that for `DSolve`, `NDSolve`?


Why this numerical integration takes so long?

Let me explain the problem. I am trying to integrate a one dimensional integral: $$\int {g\left( {{k_x}},parameter1,parameter2,...\right)d{\mkern 1mu} {k_x}} $$ for the sake of clarity, I will give function `g` in the last. I choose a specific set of parameter, and do the following integration:               In:=NIntegrate[g[kx, 9, -2, 7, 1, 1, 0.05], {kx, -\[Pi]/3,\[Pi]/3}]//AbsoluteTiming          Out:={422.396160, 0.163126 + 0.103155 I}      This takes me 422s on my computer!!! I use the following code to show the sampling points used during the integration.               sampp = Reap[      NIntegrate[#, {kx, -\[Pi]/(3), \[Pi]/(3)},        EvaluationMonitor :> Sow[{kx, #}]]] &[     g[kx, 9, -2, 7, 1, 1, 0.05]] ;     {Length[#], ListPlot[#, AxesOrigin -> {0, 0}, Filling -> Axis]} &[      relist@sampp[[2, 2, 1]]]      ![sampling points](http://i.stack.imgur.com/Px5Qz.png) it shows that it used 733 sample points. But should that take 400 seconds? Actually, **the evaluation of the integrand at each sample point is acually fast.** I use the most simple interpolation method to do the same integration as below, I use 1000 sample points that is evenly distributed and it only takes 1.3 second. Besides the integration result is quite accurate.               In:=(sampp = Table[{kx,       g[kx, 9, -2, 7, 1, 1, 0.05]}, {kx, -\[Pi]/3, \[Pi]/3,       2 \[Pi]/3/1000}];     Integrate[     Interpolation[sampp, InterpolationOrder -> 2][     x], {x, -\[Pi]/3, \[Pi]/3}]) // AbsoluteTiming     Out:={1.308075, 0.163126 + 0.103155 I}      So what did _Mathematica_ do in the extremely long 400 second? Of course, it needs to do many error estimation, but that should not take too much time. I scan the documents and related questions in stackexchange. Somebody suggest to set "SymbolicProcessing"->0. OK, I tried               In:=NIntegrate[g[kx, 9, -2, 7, 1, 1, 0.05], {kx, -\[Pi]/3,     \[Pi]/3},      Method -> {"GlobalAdaptive", Method -> "GaussKronrodRule",      "SymbolicProcessing" -> 0}]//AbsoluteTiming     Out:={401.791981, 0.163126 + 0.103155 I}      unfortunately, the result is the same. Even more peculiar, when I use "Trapezoidal" strategy and limit the MaxRecursion                In:=NIntegrate[g[kx, 9, -2, 7, 1, 1, 0.05], {kx, -\[Pi]/3, \[Pi]/3},       Method -> "Trapezoidal", MinRecursion -> 1, MaxRecursion -> 4]     Out:={413.894674, 0.163126 + 0.103155 I}      the sample points shows as follows ![sample points2](http://i.stack.imgur.com/hXK0V.png) it only used 257 sample point, but the time cost is the same??!!It is unbelievable! Anyway, I think the "Trapezoidal" should be the same as evenly sample interpolation method. **I really can't understand what did _Mathematica_ do in the `NIntegrate` of function g. Can somebody explain it?** **Of course, it seems that I can use the simple interpolation integration method manually, because it is fast, and the result seems good in this case. But it is not robust, I insisted using the built in "Adaptive" strategy, because I have to Integrate some other functions which are sharp at specific points.** * * * In the last the form of function `g`               g[kx_, xx_, e_, width_, ii_, label_, \[Eta]_] :=      Inverse[(e - I \[Eta]) IdentityMatrix[2*width] -       armchairibbonmat[kx, width]][[2*(ii - 1) + label,      2*(ii - 1) + label]] E^(I kx xx)          (*armchairibbonmat is a function used in function g*)          armchairibbonmat[kx_, n_] :=     (     h = Table[0, {i, 1, 2 (n + 2)}, {j, 1, 2 (n + 2)}];     a[m_] := 2 m - 1;     b[m_] := 2 m;     t1 = 1;     aa = 1;     Do[     h[[b[i], a[i]]] = t1 E^(I kx aa);     h[[a[i], b[i]]] = t1 E^(-I kx aa);     h[[b[i + 1], a[i]]] = t1 E^(-I kx aa/2);     h[[b[i - 1], a[i]]] = t1 E^(-I kx aa/2);     h[[a[i - 1], b[i]]] = t1 E^(I kx aa/2);     h[[a[i + 1], b[i]]] = t1 E^(I kx aa/2);     , {i, 2, n + 1}];     h = ArrayPad[h, -2]     )