ListLinePlot "Cannot Take Positions" error with Fourier of WAV file

When I try to do a Fourier analysis of a WAV file with a sample rate of 22050 I get an error "Cannot take positions". What am doing wrong?               In[5]:= Import[path,"Options"]     Out[5]= {AudioChannels->1,AudioEncoding->Integer16,SampleRate->22050}          In[13]:= ListLinePlot[Abs[Fourier[signal2[[0;;22050]]]]]     During evaluation of In[13]:= Part::take: Cannot take positions 0 through 22050 in {-0.139099,-0.143005,-0.147125,-0.149109,-0.14563,-0.136719,-0.12442,-0.102112,-0.0857239,-0.0933228,-0.115112,-0.132629,-0.14621,-0.165161,-0.18399,-0.194122,-0.194702,-0.184052,<<15>>,0.144867,0.124451,0.100403,0.0848694,0.0855713,0.100586,0.11911,0.128052,0.123932,0.110077,0.0941772,0.0918274,0.107971,0.134216,0.157959,0.176849,0.187927,<<905296>>}. >>     During evaluation of In[13]:= Fourier::fftl: Argument RowBox[{\({\(-0.13909912109375`\), \(-0.14300537109375`\), \(-0.147125244140625`\), \(-0.14910888671875`\), \(-0.1456298828125`\), \(-0.13671875`\), \(-0.124420166015625`\), \(-0.10211181640625`\), \(-0.085723876953125`\), \(-0.09332275390625`\), \(-0.1151123046875`\), \(-0.13262939453125`\), \(-0.146209716796875`\), \(-0.1651611328125`\), \(-0.183990478515625`\), \(-0.194122314453125`\), \(-0.1947021484375`\), \(-0.184051513671875`\), \(<< 15 >>\), 0.144866943359375`, 0.12445068359375`, 0.10040283203125`, 0.084869384765625`, 0.0855712890625`, 0.1005859375`, 0.119110107421875`, 0.1280517578125`, 0.123931884765625`, 0.110076904296875`, 0.09417724609375`, 0.091827392578125`, 0.10797119140625`, 0.13421630859375`, 0.157958984375`, 0.176849365234375`, 0.18792724609375`, \(<< 905296 >>\)}\), "[[", RowBox[{"0", ";;", RowBox[{"", \(<< 5 >>\), ""}]}], "]]"}] is not a non-empty list or rectangular array of numeric quantities. >>     During evaluation of In[13]:= ListLinePlot::lpn: Abs[Fourier[{-0.139099,-0.143005,-0.147125,-0.149109,-0.14563,-0.136719,-0.12442,-0.102112,-0.0857239,-0.0933228,-0.115112,-0.132629,-0.14621,-0.165161,-0.18399,-0.194122,-0.194702,-0.184052,<<16>>,0.124451,0.100403,0.0848694,0.0855713,0.100586,0.11911,0.128052,0.123932,0.110077,0.0941772,0.0918274,0.107971,0.134216,0.157959,0.176849,0.187927,<<905296>>}[[0;;22050]]]] is not a list of numbers or pairs of numbers. >>     Out[13]= A very large output was generated. Here is a sample of it:     ListLinePlot[Abs[Fourier[{-0.139099,-0.143005,-0.147125,-0.149109,-0.14563,-0.136719,-0.12442,-0.102112,-0.0857239,-0.0933228,-0.115112,-0.132629,-0.14621,-0.165161,-0.18399,-0.194122,-0.194702,<<905313>>,0.0675659,0.0622253,0.0541382,0.0477905,0.0399475,0.0280457,0.015564,0.00323486,-0.00512695,-0.00515747,-0.00265503,-0.00686646,-0.0162048,-0.0269775,-0.0352173,-0.0334473}[[0;;22050]]]]]     Show Less\[ThinSpace]Show More\[ThinSpace]Show Full Output\[ThinSpace]Set Size Limit...


How to parallel this nested table efficiently?

I have an 8 core CPU and want to parallel evaluate the following nested `Table`               Table[Table[expr[i,j], {i,1,10}], {j,1,4}]      But there is a problem, the time cost of evaluating `expr[i,j]` increases with the value of variable `i`. If `expr[1,j]` takes 5min, `expr[2,j]` will take 10min and `expr[10,j]` will take 3hours. Now you see, no matter where I will put `Parallel`, in the outer `Table` or in the inner `Table`, the efficiency will not change. The best way would be to first evaluate the most time consuming terms `expr[10,1]`, `expr[10,2]`, `expr[10,3]`, `expr[10,4]` and other expressions with less time cost just throw onto the remaining core one by one. I naively tried several parallel order, for example               ParallelTable[expr[i,j], {i,10,1,-1}, {j,1,4}]      but this will not use 4 cores out of my 8 cores. The question is what is the best way to parallelize this nested table evaluation?


How can I draw a grid behind graphics without using Plot?

I want to a show simple vector summation but I don't know how to draw a grid behind the vectors. I am pretty sure I can do it with _Mathematica_ but how? It should look like this: ![Vector summation](http://i.stack.imgur.com/vSgO6.png)


Seemingly simple optimization problem is slow

I'm trying to generate a demand curve numerically, given a utility function. The function for the demand is defined like so:               Demand[UF_, x_, m_, w_, p_] := NArgMax[{UF, {x >= 0, m >= 0, p x + m <= w}}, {x, m}][[1]]      Where `UF` is the utility, `x` is consumption of a good, `w` is consumption of everything else in dollars, `p` is the price of the good in dollars and `w` is the budget. The constraints say that consumption must be non-negative and that the budget must not be exceeded. Now I'm trying to plot the demand curve for an innocent looking utility function:               Manipulate[Plot[Demand[5 Sqrt[x] + m, x, m, w, p], {p, 1, 10}], {w, 1, 100}]      This is very slow. What am I doing wrong?


$Path hijacked by PacletManager?

**Summary:** Since _Mathematica_ version 6, the PacletManager seems to have engineered an escalating hijack of the `$Path` variable. Add-on packages need to have a PacletInfo.m file for their documentation to function correctly. However, use of this file also seems to trigger an override of the `$Path` variable's control of file loading. This breaks some of the functionality of Wolfram Workbench when using _Mathematica_ 9 and 10. **Examples:** Suppose, as a minimal example, I have a `Test` directory in my `$UserBaseDirectory/Applications` directory that contains a `PacletInfo.m` file that reads               Paclet[       Name -> "Test",       Version -> "0.0.1"     ]      as well as a file `foo.txt` containing the text `"Applications directory"`. Also, in my `$HomeDirectory` I have another `Test` directory containing just a text file `foo.txt` reading `"Home directory"`. Now, _Mathematica_ 6 behaves as I would expect -- if I empty the `$Path` variable, `Get` can't find either `foo.txt` file, and if I put the `$HomeDirectory` in the `$Path` it will find the file in the `$HomeDirectory` (note: clearing the `$Path` variable will interfere with stuff like searching the documentation, so you probably want to run these in a fresh kernel and then restart):               $Path = {};         Get["Test/foo.txt"]     (* During evaluation of In[2]:= Get::noopen: Cannot open Test/foo.txt. *)     (* $Failed *)          $Path = {$HomeDirectory};     Get["Test/foo.txt"]     (* "Home directory" *)      In _Mathematica_ 7 or 8, there is a different behavior -- even with an empty `$Path` it will find `foo.txt` in the Applications directory, but with `$HomeDirectory` in the path it will find `foo.txt` in the `$HomeDirectory`, as before:               $Path = {};     Get["Test/foo.txt"]     (* "Applications directory" *)          $Path = {$HomeDirectory};     Get["Test/foo.txt"]     (* "Home directory" *)      In _Mathematica_ 9 or 10, however, it always finds the text file in the Applications directory, _even if only the`$HomeDirectory` is in the `$Path`_:               $Path = {};     Get["Test/foo.txt"]     (* "Applications directory" *)          $Path = {$HomeDirectory};     Get["Test/foo.txt"]     (* "Applications directory" *)      With no `PacletInfo.m` file we get the expected (version 6) behavior in all versions. As a side note, there is no effect on the results if we change the name of the `Test` directory in the `$UserBaseDirectory/Applications` directory to something else; `Get` behaves as if `foo.txt` were in a directory with whatever name is listed in the `PacletInfo.m` file. **Discussion:** What seems to be happening is that, when a new kernel is started (or if we manually call `PacletManager`RebuildPacletData[]`), a list of paths is scanned for `PacletInfo.m` files, and the `Name` entries in those files are registered as directory search paths, corresponding to the actual directories in which the `PacletInfo.m` files are located. In recent versions these paths take precedence over the search paths in `$Path`. The behavior in versions 9 and 10 interferes with the way Wolfram Workbench is supposed to work. When launching _Mathematica_ from the Workbench, it puts the local development folder at the beginning of the `$Path` variable directory list, so that the development version of the package is loaded, rather than any installed version in the Applications directory. When the `PacletInfo.m` file present, however, the installed version is always loaded. **My questions:**   1. I'm curious if anyone has any insight as to whether the current behavior is considered desirable. Clearly a list of documentation directories has to be maintained, but is it necessary for the `$Path` to be overridden?   2. Does anyone have a workaround to get Workbench to load the development version of a package? The obvious method is to either overwrite or delete the installed version in the `Applications` directory, but this is clumsy. More elegant would be to manually add the development directory to the beginning of the paclet search path, as well as to the `$Path`, but I haven't found a way of doing that yet.


Background: I want to split graphics in a Manipulate in several parts in a tabview control. But the tabview somehow interferes with the locators as in the following simplified example:                Manipulate[       TabView[{aa -> Graphics[Line[{{0, 0}, p}], PlotRange -> 1],          bb -> 1}] , {{p, {1, 1}}, Locator}]      Question: How to use Locators on a graphic in a tabview. ( How to get the snippet above working ? ) EDIT: I left out too much in the previous example, this is a better description.                 Manipulate[        pts1 = pts;       TabView[{         a -> Graphics[Line[pts1]],         b -> Graphics[Line[pts]]}],       {{pts, ptsI}, Locator, LocatorAutoCreate -> All},        Initialization -> {pts = {{0, 0.5}, {0, 0.6}}}]      So, there is one set of data, in this example pts. In one part of the display (A) the data is modified, the data is then shown on ( B ). -


Derivatives with respect to Cartesian coordinates of functions in spherical coordinates

This seems to me to be a common task, and the more surprised I was to not have found much on this. Suppose I have an expression `f` in spherical coordinates `r,theta,phi`, and want to compute partial derivatives of `f` with respect to Cartesian coordinates `x,y,z`, but with the result expressed in `r,theta,phi` again. I have solved it by defining the following function (in Mathematica 10):               myD[f_,n_Integer/;n>=1&&n<=3]:=       With[{jac=Transpose@CoordinateTransformData["Spherical"->"Cartesian","InverseMappingJacobian",{r,theta,phi}]},         jac[[n]].(D[f,#]&/@{r,theta,phi})     ]      With this I can compute $\frac{\partial f}{\partial z}$ by writing `myD[f,3]`. Take for example `f=r`, you should get: $$ \frac{\partial f}{\partial z}=myD[f,3]=\frac{\partial r}{\partial z}=\frac{z}{r}=\frac{r\cos\theta}{r}=\cos\theta $$ I was wondering if this is really the way to go for such a mundane task? I suspect that there is a nicer functionality built into Mathematica which I am not aware of. Does anyone have an idea?


define the range of Longitude from 0-360 in the World plot from CountryData

How can I change the Longitude range to 0-360 in the such plots?               Graphics[{GrayLevel[0.2],AbsoluteThickness[1.5],       CountryData[         "World", {"SchematicPolygon",{"Equirectangular",{0,180}}}       ]/.Polygon->Line},       Frame->True,ImageSize->200]      ![World map](http://i.stack.imgur.com/YYVnY.png) Thanks


How can I transform a list of binary digits into integers?

I want to transform a list of binary digits into integers. With the `Table` function, I produce four lists of binary digits of length 32. Then I tried to turn these lists into integers, but it didn't work. Any suggestions?               Table[b[i] = 1, {i, 0, 32}];     Table[b[k] = b[i + j] = Mod[(b[i + j - 5] + b[i + j - 32]), 2], {i, 32, 35}, {j, 0, 31}]     FromDigits[{b[k]}, 2]


Is it possible to use styled (e.g., colored) text in PlotLabel?

Sometimes, I want to provide a key or legend for my `Plot` or `ListPlot` without using the `PlotLegends` package. Sometimes, I just want to use the option `PlotLabel` inside my `Plot` or `ListPlot`:               Plot[{x^2, x^3}, {x,0,10}, PlotStyle->{Red, Blue},          PlotLabel->"Red curve: x^2\nBlue curve: x^3"]      Is there any way to actually make the string `"Red curve: x^2"` red and the string `"Blue curve: x^3"` blue, within `PlotLabel`?


A triple sum related question

I'm trying to compute the triple sum               Sum[1/(i! j! k! ), {i, 1, Infinity}, {j, i + 1, Infinity}, {k, j + 1, Infinity}]      but Mathematica doesn't return   any value. What else can I do here? Thanks!


Constructing a symbolic Hermitian matrix

I need to construct a symbolic Hermitian matrix like               m = {          {           n, a, b, b},          {Conjugate[a], n, b, b},          ...         }      but I am not able to set the variables `n, a, b` in order to obtain a Hermitian matrix. I tried with `$Assumptions` but after that `HermitianMatrixQ[m]` gives me `False` as a result. I need that for a Cholesky decomposition of the `m` matrix.


Given an implicit solution, how to plot transformation of this implicit solution?

I have a function, which gives an implicit solution of a variable $y$ as a function of $x$. Moreover, I have a function $f$ which depends on $y$. How to plot a ratio of $f/y$, given that $y$ is only given in an implicit form? **Edit** Let me be more specific. First, I have a polynomial $G(y,x)=0$, which defines implicitly $y$ as function of $x$, let's call it $y=g(x)$. Second, I have a function $f(y)$. I want to plot a ratio $f(y)/y$ as a function of $x$ or, using $y=(g(x))$, $f(g(x))/g(x)$. How to plot it given that $y=g(x)$ is given implicitly by a polynomial?


Syntax question regarding Triple Integrals in Mathematica

Integrate[1, {z, 0, 5}, {x, -Sqrt[ 9 - y^2], Sqrt[ 9 - y^2]} , {y, -3, 3}]       > 60 Sqrt[9 - y^2] How comes I am not getting a number for my final answer? This triple integral should evaluate to an exact number.


Problem with grid alignment

This grid works:               Grid[Table[Append[ConstantArray[1, 5],     If[i === 1, Button["", 0;, ImageSize -> {30, 315}], SpanFromAbove]],     {i, 20}], Alignment -> {Center, Center}, Frame -> All]      I want the first row to be one single place, except for the button, but when I do it, it gets crap:               Grid[Table[Append[If[i === 1, Prepend[ConstantArray[SpanFromLeft, 4], 1], ConstantArray[1, 5]],     If[i === 1, Button["", 0;, ImageSize -> {30, 300}], SpanFromAbove]],     {i, 20}], Alignment -> {Center, Center}, Frame -> All]      What can I do to the second piece of code to make the button align like it did the first time?


Make a differentiable smooth sawtooth waveform

So, I am trying to understand the effect of sawtooth waveform on a mechanical system model. For example, a system of a plate and a box on it. And then we try to oscillate the plate. In order to do that, I need to calculate the inertial force caused by the sawtooth waveform. And to find the inertial force, I need to calculate second derivative of sawtooth waveform. But because, you know, sawtooth waveform is not differentiable everywhere, I think make an approximation by using a smooth sawtooth waveform is enough. 'Smooth' here, I mean substitute upper tip and bottom tip of the sawtooth waveform into a circular curve of a certain radius. So in short, my question is: How to make sawtooth wavefrom with a dull tip with Mathematica? Here, although I said sawtooth, it would be better if applicable to any triangle waveform. **EDIT:** What if my triangle waveform is made from a completely arbitrary piecewise function such as below               f = Piecewise[{{10 Mod[x, 1], 0 <= Mod[x, 1] < 0.1},       {-(10/9) Mod[x, 1] + (10/9), 0.1 <= Mod[x, 1] < 1}}];     Plot[Evaluate[f], {x, -3, 3}]      ![enter image description here](http://i.stack.imgur.com/FbFAt.jpg) Is it still possible?


Plot Ticks disappear when combining Plot with Graphics

I'm attempting a simple Plot that I want to add asymptote markers to:               Module[{p, g},      p = Plot[1/Sqrt[1 - x^2/4], {x, -2, 2},        PlotRange -> {{-2.2, 2.2}, {0, 5}}];      g = Graphics[{Line[{{2, 0}, {2, 5}}], Line[{{-2, 0}, {-2, 5}}]}];      {p, Show[g, p]}]      With just the plot I get my tick marks ![with ticks](http://i.stack.imgur.com/Dg6nb.png) However, when I combine the plot and the pair of lines: ![no ticks](http://i.stack.imgur.com/TSzLw.png) the tick marks on my axes disappear? Observe that it even the vertical ticks are gone, so this isn't an issue of them being pushed off the combined image.


ScheduledTask with scoped variables. Working with timed evaluation

I guess I have to try harder and focus more but timed evaluation always frustrates me. I will show the issue on simple example of delayed trigger.                ClearAll@time; time = 0;      CreateScheduledTask[time++;, {1, 5}]      StartScheduledTask@ScheduledTasks[];           DynamicWrapper[Dynamic@time,                      If[time === 5, RemoveScheduledTask[ScheduledTasks[]]; Print["end"]]]      > >     1... 2... 3... 4... 5 "end" (*so it works OK*) >   * * * In general one may want to scope such procedure:               DynamicModule[{x},     ClearAll@x;          Column[{Button["start", x = 0;                              RemoveScheduledTask[ScheduledTasks[]];                              StartScheduledTask@CreateScheduledTask[x++;, {1, 5}]],              DynamicWrapper[Dynamic@x, If[x === 5, Print@1]]                  }] ]      > output before clicking: >   >   >     FE`x$$number (*as expected*) >   > > output after clicking: >   >   >     0 (*and it does not change*) >   We can see that the only procedure that was enabled was `x = 0;`. I was suspecting problems because `ScheduledTasks` are not related to `FrontEnd` while `DynamicModule` is. What is interesting is that changing `DynamicModule` to `Module` fixes the problem. **The question are:**   * What am I missing in case of `DynamicModule`? I've seen Module variable scoping in ScheduledTasks but I couldn't use it for my purpose. (*I've added `ClearAll` but it does not seem to make any difference.   * Schould I use `Module` even if this is only a minimal example of the code that will be implemented in larger cdf? Moreover, John Fultz reminded couple of times (e.g. here) that such constructs are incorrect.


Differentiating a function that has NIntegrate within it

I am something of a novice with Mathematica. I have written the following code;               Clear[band, en, w, fermi, k, T, S, a]     k = 86*10^-6;     T = 4000;     band[en_, w_] := 10000 Exp[-en^2/2 w^2];     fermi[en_, ef_] := 1/(Exp[(en - ef)/(k T)] + 1);     Plot[band[en, w] /. w -> 1, {en, -4, 4}]     Plot[fermi[en, ef] /. ef -> 0, {en, -4, 4}]     Plot[{band[en, w] /. w -> 1, (band[en, w]*fermi[en, ef]) /. {ef -> 0, w -> 1}}, {en,-4,4}]     S[ef_] := -k NIntegrate[(band[en, w]*fermi[en, ef]*Log[fermi[en, ef]]) /. w -> 1, {en, -Infinity, Infinity}]     Plot[S[ef], {ef, -4, 4}, PlotRange -> All]     a[ef_] := D[S[ef], ef]     Plot[a[ef], {ef, -4, 4}]      It works very nicely until I try to plot a, which is simply the derivative of S wrt ef - even though I can plot S vs ef a few lines above. Plotting a gives error messages along the lines of;               General::ivar: "-3.83657 is not a valid variable."      This is clearly something to do with NIntegrate evaluating too early, or not being a function of ef in the way I would expect it to be, or similar. But I have no idea how to fix it. I would be very grateful for any suggestions anyone could give. I think this issue is showing up my fundamental lack of understanding how Mathematica works, and so replies along the lines of "You should read and understand such- and-such article..." would also be very welcome! Many thanks, Nick


NSolve with numerical function

I would like to solve numerically an equation which involves a numerical function constructed by fitting some data:               data := {{0, 1}, {1, 1}, {.2, 3}, {.4, 5}, {.6, 2}};     try[x_?NumberQ, y_?NumberQ] := (auy = y;     solution = FindFit[data, A (aux - auy) + B Exp[aux - auy], {A, B}, aux];     myFit[aux_?NumberQ] = (A (aux - auy) + B Exp[aux - auy]) /.      solution; Return[myFit[x]])          NSolve[y - try[1, y] == 0, y]      I tried with this code but it does not function (various errors). Does anyone know how to help me? thank you in advance!


Dropping value of one variable when another changes

# Context: There is a list of lists `list` where lists are different length. Using one control I change a part of list to view, and with another one — what certain part of part to show at the end. Thought, `Length` could define here number of values in chosen part of `list`.               list = {{1, 2, 3, 4}, {1, 2, 3}}; (* for example *)     Manipulate[list[[j, k]], {j, 1, 2, 1}, {k, 1, Length[list[[j]]], 1}]      # Problem: When control of j- _th_ part switches to part of `list` with k- _values_ > then it was before, it leads to a mistake, though when switching in opposite direction slider disposes itself correctly: ![Mistake in an action](http://i.stack.imgur.com/y5Qdh.jpg) # Question: Do I desire that from `Length` in vain, and what is the solution of this problem? Assume, I can somehow set a value of k to 1, when j changes. How can I achieve this? Thanks. I apologize for that the title not corresponding to an issue fully. Had no idea how to name it.


How to group each element with each consecutive elements in one head

Suppose I have the following list:               list = {a, b, c, d}      I want to generate this result:               {{f[a, a], f[a, b], f[a, c], f[a, d]}, {f[b, b], f[b, c],       f[b, d]}, {f[c, c], f[c, d]}, {f[d, d]}}      What could be the shortest way? The list elements can be anything and not necessarily sorted.


Interfacing Mathematica with MINE using JLink

In last December's Science David N. Reshef, et al. proposed an interesting method to detect associations in data ( _Detecting Novel Associations in Large Data Sets_ , Science **334** , 1518, 2011). Contrary to classical correlation methods, this method is able to detect non-linear relationships. ![Mathematica graphics](http://i.stack.imgur.com/qdnah.png) (table from the cited article) On their website, the authors provide a Java application, MINE, and an interface to the language R. Having no Java experience I never took up JLink but it is my guess that it should be reasonable straightforward to interface MINE with Mathematica. Could someone show me how? Native implementations of the method in Mathematica are more than welcome too. I'm planning to do that in the near future, but still haven't found time to read the technical report yet.


Plotting an implicit polar equation

_Mathematica_ can use `ContourPlot` to draw implicit Cartesian equations, but doesn't seem to have a similar function to plot an implicit polar equation, for example $\theta ^2=\left(\frac{3 \pi }{4}\right)^2 \cos (r)$ What's the best way to do this?


How do you set attributes on SubValues?

`SubValues`, as discussed in a previous question, are declared as follows               f[x_][y_] := {ToString[Unevaluated[x]], ToString[Unevaluated[y]]}      But, attempting to use `SetAttributes` on `f` only affects the `DownValues` of `f` during evaluation, not the `SubValues`. In other words, if `HoldAll` is set on `f`, then only `x`, in the above code, is held. In code,               SetAttributes[f, HoldAll]     f[ 1 + 2 ][ 3 + 4 ]     (*     ==> { "1 + 2", "7" }     *)      Attempting to use `SetAttributes` on `f[x]` results in the error               SetAttributes::sym: "Argument f[x] at position 1 is expected to be a symbol."      and, similarly, for `f[x_]` simply because neither are symbols. A work around is not to set a `SubValue` directly, but, instead, return a pure function and use the third argument to set the attribute, as follows               SetAttributes[g, HoldAll]     g[x_] := Function[{y},                {ToString[Unevaluated[x]], ToString[Unevaluated[y]]},               {HoldAll}              ]     g[ 1 + 2 ][ 3 + 4 ]          (*     ==> {"1 + 2", "3 + 4"}     *)      But, `SubValues[g]` returns an empty list, indicating that while equivalent, this construct is not processed in the same manner. So, how does one set the attributes on `f` such that the `SubValues` are affected during evaluation?


Set PointSize to pixel size

I have a set of 1million 2D points and I would like to produce an image 200x200 pixels where each point will have the size of a pixel (no more). Additionally each point may repeats several times so I would like to add some weight on it (small number of repetitions ->Light Green , ... , large number of repetitions ->Dark Green) I am experimenting with the following data set before I use the real one :               data = Flatten[        Table[Table[{i, j} k, {i, 1, 50}, {j, 1, 50}], {k, 1, 10, .5}], 2];      So which is the correct PointSize in my case and how can I set the intensity of each point ? I am not that experienced on Graphics so I would appreciate any insight.


Summing a trig series

I am trying to sum the following expression:               (Cos[(2 π m)/N]^2 Cos[(2 π n)/ N])/(2 (Cos[(2 m π)/N] - Cos[(2 n π)/N]))      from `m=1` to `(N+1)/2` excluding the term `m=n`. I split this sum into two: the first from `m=1` to `n-1`, and the second from `m=n+1` to `(N+1)/2`. I run into two problems: the first series just does not evaluate ( _Mathematica_ returns the expression). However when I plot it plugging in some values for `n`, `N` (with `N` always greater than `m`, `n`), I find the function to be well behaved in the interval. The second series from `n+1` to `(N+1)/2` does sum, but it evaluates to complicated `QPolygamma` functions, and `FullSimplify` doesn't help. Any help would be appreciated!


Find continuous sequences inside a list

I have a list which is something like this:               {3,4,5,6,7,10,11,12,15,16,17,19,20,21,22,23,24,42,43,44,45,46}      What I'd like to to is get the intervals which are in a "continuous" sequence, something like:               {{3,7},{10,12},{15,17},{19,24},{42,46}}      and get the extremes. Note that the original data (of which this is a small excerpt) shows no sign of regularity or repetition. Numbers start from 1 and get up to 200 (these numbers come from applying Position[] to an array). Any pointers/ideas?


Optimizing a Numerical Laplace Equation Solver

Laplace's Equation is an equation on a scalar in which, given the value of the scalar on the boundaries (the boundary conditions), one can determine the value of the scalar at any point in the region within the boundaries. Initially, I considered using `NDSolve`, but I realized that I did not know how to specify the boundary conditions properly. In the example below, my boundary is a square with value 0 along the top, left and right boundary and 1 along the bottom boundary. Alternatively, the solutions to the equation can be approximated via the Method of Relaxation. In the method, the region is divided into a grid, with the grid squares along the boundary being assigned (fixed) boundary conditions, and the value for the grid squares within the boundary being iteratively calculated by assigning the average values (in the previous time- step) of four grid squares adjacent to it. My current code is as follows               localmeaner =        Mean@{#1[[#2 - 1, #3]], #1[[#2 + 1, #3]], #1[[#2, #3 - 1]], #1[[#2, #3 + 1]]} &;          relaxer = ({#[[1]]}~Join~          Table[           {#[[j, 1]]}~Join~            Table[localmeaner[#, j, i], {i, 2, Dimensions[#][[2]] - 1} ]~            Join~{#[[j, Dimensions[#][[2]]]]}, {j, 2,             Dimensions[#][[1]] - 1}]~Join~{#[[Dimensions[#][[1]]]]}) &;          matrixold = Append[ConstantArray[0, {41, 40}], ConstantArray[1, 40]]; (*test matrix fixing the boundary conditions as 0 on the top, left and right boundaries and 1 on the bottom boundary*)          tempmatrix = Nest[relaxer, matrixold, 300]; (*matrix after 300 relaxations*)      `localmeaner` is a function that takes the average of the four grid squares adjacent to a square. `relaxer` is a function that preserves the boundary values but otherwise applies `localmeaner` onto each of the grid cells to produce their new values based on the average of the four grid cells adjacent to it. > Is there a quicker way to find a numerical solution to the Laplace's > Equation given specific boundary conditions? As a point of interest, one can plot the solution as `ArrayPlot[tempmatrix*1., ColorFunction -> "Rainbow"]`, resulting in the following image, which helps one to visualize the results. ![enter image description here](http://i.stack.imgur.com/uji7W.png) NB: I'm planning to extend this solution to approximations that can work in polar coordinates, Cartesian coordinates in three dimensions and spherical coordinates, so I'm hoping that the answers could be equally general.


Rotate a grid, made up of lines, so that it aligns with the xy axes

While working on an answer for another problem I hit upon one of my own. I took the image given in that question and cleaned it up so that I could detect the grid lines:               i = ColorNegate@       Binarize[Import["http://i.stack.imgur.com/NbTGY.jpg"], .99]          lines = ImageLines[        Image[ImageData@Dilation[i, 0.5] -         ImageData@DeleteBorderComponents@Dilation[i, 0.5]]     ];          Show[i, Graphics[{Thick, Green, Line /@ lines}]]      ![the image with the lines marked](http://i.stack.imgur.com/nKxS0.png) From here I would like to rotate the grid so that the they are absolutely vertical and horizontal. The original picture looks like a scanned piece of paper and I imagine it could be rotated more than this sample is. My attempt was to separate the horizontal lines from the vertical lines:               hor = Select[lines, #[[1, 1]] == 0 &];     ver = Reverse[Select[lines, #[[2, 2]] == 0 &], 2];      Then I would like to find a transfer function that will bring the end point of each horizontal line to the same y value that the starting point has, and respectively for the vertical lines. So my fruitless attempt to do that looks like this:               pts = {Join[Transpose[Apply[{#, 0} &, ver, {2}]][[1]],         Transpose[Apply[{0, #2} &, hor, {2}]][[1]]],        Join[Transpose[Apply[{#, 0} &, ver, {2}]][[2]],         Transpose[Apply[{0, #2} &, hor, {2}]][[2]]]}     pts // MatrixForm      ![how the matrix looks](http://i.stack.imgur.com/DVnyq.png) And then               transf = FindGeometricTransform[pts[[1]], pts[[2]]][[2]];     newLines = transf@# & /@ lines;     Show[ImagePerspectiveTransformation[i, transf, DataRange -> Full],       Graphics[{Thick, Green, Line /@ newLines, Yellow, Line /@ lines}]]      It returns errors and I don't get the rotation I'm looking for. ![final result](http://i.stack.imgur.com/qaEYf.png) Any ideas are welcome as long as they start from the lines that I have. It may be possible to find the grid in a different way and perhaps then the procedure to find the rotation would not be the same.


How can I fix Mathematica's text line-breaking algorithm not to line-break so soon?

I have some custom plotting functions that simplify the placement of footnotes and source notes under the plot. It is important that the line length of the footnotes fills up the available space and lines up neatly with the plot, which has a known, fixed width. Below is a somewhat simplified version of my code for creating a grid containing these notes, with some `Frame`s added so you can see the relationship of the length of the text lines to the width of the `Grid` cells. My problem is that, no matter what I do with `LinebreakAdjustments`, the lines in the footnote text break far too "soon", and leave far more whitespace than one would see in any other program that lays out text in a text box. How can I fix this? It's the sort of thing my persnickety user base will consider a show-stopper.               Options[SourceNote] = {FootnoteMargin -> 5.7, NoteFontSize -> 14,         LeftCellSize -> 10, TotalSize -> 45, NotesMargin -> 0.8};     Options[GraphNotesGrid] = {FootnoteMargin -> 5.7, NoteFontSize -> 14,         LeftCellSize -> 10, TotalSize -> 45, NotesMargin -> 0.8};          SourceNote[x : {__String}, opts : OptionsPattern[]] :=        With[{fnm = OptionValue[FootnoteMargin], fs = OptionValue[NoteFontSize]},          If[Length[x] ==  1,       {DisplayForm[AdjustmentBox[Style["Source:", fs, FontFamily -> "Arial", Black],                  BoxMargins ->  {{fnm, 0}, {0, 0}}]],              Style[StringTrim[x[[1]] ], fs, FontFamily -> "Arial", Black]},      {DisplayForm[AdjustmentBox[Style["Sources:", fs, FontFamily -> "Arial", Black],                  BoxMargins ->  {{fnm, 0}, {0, 0}}]],      (* delete empty strings AFTER counting length to allow "Sources: company reports" case *)        Style[ StringJoin @@ Riffle[ Union[DeleteCases[ StringTrim /@ x, ""]], "; "], fs,                FontFamily -> "Arial", Black], " "}] ]          GraphNotesGrid[cf_?MatrixQ, cs : {__String},         opts : OptionsPattern[]] /; Dimensions[cf][[2]] == 2 :=       With[{fnm = OptionValue[FootnoteMargin],         fs = OptionValue[NoteFontSize], l = OptionValue[LeftCellSize],         ts = OptionValue[TotalSize], topm = OptionValue[NotesMargin]},        Grid[Join[(Map[{DisplayForm[AdjustmentBox[            Style[#[[1]], fs, FontFamily -> "Arial", Black],             BoxMargins -> {{fnm, 0}, {0, 0}}]],             Framed@Pane[ Style[#[[2]], fs, Black, LineIndentMaxFraction -> 0,              LinebreakAdjustments -> {1.2, 200, 12, 1, 500}, (* I tried playing with this *)             FontFamily -> "Arial"], (ts - l)* CurrentValue["FontMWidth"]]} &, cf]),            {SourceNote[cs]}], (* real version does do FilterRules*)        Spacings -> {{0, {}, 0}, {topm, {}, 0}},         ItemSize -> {{l, ts - l}, Automatic}, Alignment -> {Left, Top},         Frame -> All, FrameStyle -> Blue] ]      Here is an example:               GraphNotesGrid[{{"*",         "This is a test footnote that is designed to go over several lines \     and demonstrate the crappy line-breaking algorithm. This might or \     might not be long enough. We shall see. "}, {"**",         "This is another very long footnote which you do not need to read \     but do need to notice the line-breaking"}}, {"ABC", "CBS", "NBC"}]      ![enter image description here](http://i.stack.imgur.com/3lQsP.png)


How to make a curve selectable from a scaned image and convert it to a list of coordinates

I have a scanned image (binary-ized): ![example picture](http://i.stack.imgur.com/gQvOw.jpg) Is there any way to reduce one of these curved lines (full or dotted) to a series of its coordinates (e.g., sampling interval of 0.01 on x-axis)? I've read some similar examples: Recovering data points from an image How do I find the coordinates of points in this image? How can I extract data points from a black and white image? Obtain Data points from a graph on an image without axes But my problem is slightly different: I have several curves in one image. I would like to isolate them one from another and make each curved selectable by a simple click so that, for the selected curve, a series of coordinates of its sampled points (e.g., interval of 0.01 on x-axis) can be returned. Like this: ![clic](http://i.stack.imgur.com/HPsBv.png) ![image selected](http://i.stack.imgur.com/iI5ME.png) ![coordonnates returned](http://i.stack.imgur.com/SskBx.png)


Using FindRoot with an interpolating function

This question bears resemblance to a few other questions on mathematica.SE about finding points of intersection of crossing curves. I know that the guidebook of numerics has an entry about the whole curve crossing thingy (can't seem to find the link right now). However, my question is a little different. Yes, crossing curves are involved. I have two curves that cross each other at two points:               curve1 = 3 x^2 + 3 x;     curve2 = 1.8 x ^2 + 2;     Plot[      {curve1, curve2},      {x, -5, 5},      PlotRange -> All      ]      ![Curves crossing](http://i.stack.imgur.com/UjLia.png) With `Roots[...]` I can find the points at which these curves cross each other, so:               Roots[curve1 == curve2, x]      > >     x==-3.04699||x==0.546988 >   So this is nice and happy! Now, if I were to get data out of the individual plots, interpolate this data and fold it into and `InterpolatingFunction`, I am unable to use `FindRoot[...]` to do the same as `Root[...]`               pic1 = Plot[curve1, {x, -5, 5}];     Data1 = Cases[Normal[pic1], Line[Data1_] :> Data1, Infinity];     intplC1 = Data1 // Flatten // Interpolation     pic1 = Plot[curve2, {x, -5, 5}];     Data2 = Cases[Normal[pic1], Line[Data2_] :> Data2, Infinity];     intplC2 = Data2 // Flatten // Interpolation               FindRoot[intplC1 == intplC2, {x, 0.2}]      > FindRoot::nlnum: The function value > {InterpolatingFunction[{{1.,528.}},{4,7,0,{528},{4},0,0,0,0,Automatic},{{<<1>>}},{Developer`PackedArrayForm,{<<1>>},{-5.,60.,-4.99693,59.9172,<<43>>,3.80528,-1.7292,3.78277,<<478>>}},{Automatic}]-<<1>>} > is not a list of numbers with dimensions {1} at {x} = {0.2}. >> So my question(s) are:   1. I am thinking I am not using `Cases[...]` correctly here despite the fact that `Data1//ListLinePlot` and `Data2//ListLinePlot` seem to plot fine enough.   2. How can I use `FindRoot[...]` on my `InterpolatingFunctions` to find the **multiple** roots in this case?   3. For this situation, am I right to assume that `Roots[...]` is well and sufficient?


Improving code for comparing and modifying nested matrices

I have a matrix such as:                tT = {{a, b, c}, {d, e, f}, {g, h, i}};      a = {{0, 0, 1}, {0, 1, 0}, {1, 0, 0}};      b = {{1, 0, 0}, {0, 0, 0}, {0, 1, 0}};      c = {{0, 0, 0}, {1, 0, 1}, {0, 0, 0}};      d = {{1, 0, 0}, {0, 1, 0}, {0, 1, 0}};      e = {{0, 1, 0}, {1, 0, 0}, {1, 0, 0}};      f = {{0, 1, 0}, {1, 0, 0}, {0, 0, 1}};      g = {{1, 0, 0}, {0, 0, 0}, {0, 0, 1}};      h = {{0, 0, 0}, {0, 1, 0}, {0, 0, 0}};      i = {{1, 0, 0}, {0, 0, 0}, {1, 0, 0}};      That the picture of matrix is same as: ![enter image description here](http://i.stack.imgur.com/qP8YU.png) In the first step, I want to compare elements of tT11 with the elements of tT12, also compare between elements of tT11 with the elements of tT13. Moreover, compare between elements of tT12 with the elements of tT13. After that tT21 with tT22 and tT23 and so on. If at least one of the corresponding elements of tT11 and tT12 are simultaneously equal to 1, I want to put a zero instead for all elements in tT12. Also, I want to make the same comparison, between elements of tT11 with the elements of tT13 with the same condition. (moreover, tT12 and tT13). Also the corresponding element in other rows. I write below line:               Do[     If[tT[[r, n, k, q]] == tT[[r, m, k, q]]==1,         Do[tT[[r, m, x, y]] = 0,{x,1,3},{y,1,3}]],         {r, 1, 3}, {n, 1, 2}, {k, 1, 3}, {q, 1, 3}, {m, n + 1, 3}]      Actually, my desire is to get the result that I bring it below: I am going to generalize this goal to a much larger matrix and this matrix (tT 3*3) is just an example. How can I modify above written process (code) for more efficiency. How can I replace other commands instead of two `Do` loops. My desired result is:   ![enter image description here](http://i.stack.imgur.com/fuKfV.png) Thank you so much for your attention.


Problem with exporting lists to Excel

When I use the form `Export["file", list, "Table"]` to export a list to Excel, I get columns of lists. I want my Excel sheet to have each list element in a separate column. For example,               Export["file.xls", {{2, 5}, {5, 7}}, "Table"]      Gives the output > >     {2,5} >     {5,7} >   I want those lists above to be split up. How do I do this?


select from a list based on digits

I wish to know how do I count the number of occurrences of numbers that end in digits d. e.g. Say I create a list of Divisors of 12! I now want to count those divisors that end in 12. Like 12 & 112 would qualify but 120 would not. Thanks.


Adding Dynamic functionality to a Graph

I would like to make the edges and vertices of a `Graph` interactive, a simple demonstration is to change their colors:               DynamicModule[{col = Green},      Dynamic@Graph[{         EventHandler[          Style[1, col],             {"MouseClicked" :> (col = col /. {Red -> Green, Green -> Red})}],         2, 3, 4, 5},        {1 -> 2, 1 -> 3, 2 -> 4,         EventHandler[          Style[2 -> 5, col],             {"MouseClicked" :> (col = col /. {Red -> Green, Green -> Red})}]         }]]      The above code generates a graph that has two clickable objects (one edge, one vertex) however they both change color when one of the objects is clicked. I suspected this is due to my `EventHandler` code and the events would trigger whenever the **Graph** is clicked. The color change event is not thrown, however, if one of the other edges/vertices is clicked so I'm a bit stuck. As an aside, I used `Rule` instead of `DirectedEdge` which seems to work although I don't know if this is the _right_ way to make a graph.


Trying to solve a transcendental equation involving bessel functions

I've never used _Mathematica_ before and am trying to numerically solve equation (12) from this paper: http://arxiv.org/abs/hep-ph/9907218v2. Ideally I'd be able to find the smallest value of $x_{n\nu}$ for $exp(-kr\pi)$ close to 1, and close to 0 for some range of $\nu$ (must be larger than 2) and then plot it. I've tried a few methods I found after googling, but none seem to work. I tried to use this: http://tinyurl.com/oozfv84 by writing:               f= (2*BesselJ[a, x] +            x*(BesselJ[a + 1, x] + BesselJ[a - 1, x]))*(2*            BesselY[a, x*exp[-Pi]] +            x*exp[-Pi]*(BesselY[a + 1, x*exp[-Pi]] +               BesselY[a - 1, x*exp[-Pi]])) - (2*BesselY[a, x] +            x*(BesselY[a + 1, x] + BesselY[a - 1, x]))*(2*            BesselJ[a, x*exp[-Pi]] +            x*exp[-Pi]*(BesselY[a + 1, x*exp[-Pi]] +               BesselY[a - 1, x*exp[-Pi]]));      sol[_a] = NSolve[f ==0 && x>0 && x < 10 && a > 2 && a < 12, x, Reals);      and was told that NSolve can't solve it. I've also tried using               sol[a_] := x /. FindRoot[f, {{x, 0}, {a, 2}}];       which throws up an error: > SetDelayed::write : Tag Plus in _My definition of f here_ [a_, x_] is > Protected.


Plotting three-dimensional plot with Interpolating functions

I want to plot my functions, but I can't seem to figure out what's going wrong. I want to be able to animate it as well.               N0 = 4; μ = 2; ϵ = 5     crazy = Flatten[     Join[     Table[x[i, j]''[t] == ϵ*(1 - x[i, j][t]^2)*x[i, j]'[t] -        x[i, j][t] + μ*(x[i + 1, j][t] + x[i, j + 1][t] -           4*x[i, j][t] + x[i - 1, j][t] + x[i, j - 1][t]), {i, 1,       N0 - 1}, {j, 1, N0 - 1}],          {Table[      x[i, 0]''[t] == -x[i, 0][t] + ϵ*(1 - x[i, 0][t]^2)*         x[i, 0]'[          t] + μ*(x[i, 1][t] + x[i + 1, 0][t] - 4*x[i, 0][t] +            x[i - 1, 0][t] + x[i, N0][t]), {i, 1, N0 - 1}],          Table[      x[i, N0]''[t] == ϵ*(1 - x[i, N0][t]^2)*x[i, N0]'[t] -         x[i, N0][         t] + μ*(x[i + 1, N0][t] + x[i, 0][t] - 4*x[i, N0][t] +            x[i - 1, N0][t] + x[i, N0 - 1][t]), {i, 1, N0 - 1}],          Table[      x[0, j]''[t] == ϵ*(1 - x[0, j][t]^2)*x[0, j]'[t] -         x[0, j][t] + μ*(x[1, j][t] + x[0, j + 1][t] -            4*x[0, j][t] + x[N0, j][t] + x[0, j - 1][t]), {j, 1,        N0 - 1}],          Table[      x[N0, j]''[t] == ϵ*(1 - x[N0, j][t]^2)*x[N0, j]'[t] -         x[N0, j][         t] + μ*(x[0, j][t] + x[N0, j + 1][t] - 4*x[N0, j][t] +            x[N0 - 1, j][t] + x[N0, j - 1][t]), {j, 1, N0 - 1}],          x[0, 0]''[t] == ϵ*(1 - x[0, 0][t]^2)*x[0, 0]'[t] -        x[0, 0][t] + μ*(x[1, 0][t] + x[0, 1][t] - 4*x[0, 0][t] +           x[N0, 0][t] + x[0, N0][t]),          x[N0, 0]''[t] == ϵ*(1 - x[N0, 0][t]^2)*x[N0, 0]'[t] -        x[N0, 0][        t] + μ*(x[0, 0][t] + x[N0, 1][t] - 4*x[N0, 0][t] +           x[N0 - 1, 0][t] + x[N0, N0][t]),          x[0, N0]''[t] == ϵ*(1 - x[0, N0][t]^2)*x[0, N0]'[t] -        x[0, N0][        t] + μ*(x[1, N0][t] + x[0, 0][t] - 4*x[0, N0][t] +           x[N0, N0][t] + x[0, N0 - 1][t]),          x[N0, N0]''[t] == ϵ*(1 - x[N0, N0][t]^2)*x[N0, N0]'[t] -        x[N0, N0][        t] + \[Mu]*(x[0, N0][t] + x[N0, 0][t] - 4*x[N0, N0][t] +           x[N0 - 1, N0][t] + x[N0, N0 - 1][t]),                   x[0, 0][0] == 1, x[0, 0]'[0] == .5, x[N0/2, N0/2][0] == 0,      x[N0/2, N0/2]'[0] == 0},     Table[x[i, j]'[0] == 0, {i, 1, N0/2 - 1}, {j, 0, N0}],      Table[x[i, j][0] == 0, {i, 1, N0/2 - 1}, {j, 0, N0}],     Table[x[i, j]'[0] == 0, {i, N0/2 + 1, N0}, {j, 0, N0}],      Table[x[i, j][0] == 0, {i, N0/2 + 1, N0}, {j, 0, N0}],     Table[x[N0/2, j]'[0] == 0, {j, 0, N0/2 - 1}],      Table[x[N0/2, j][0] == 0, {j, 0, N0/2 - 1}],     Table[x[N0/2, j]'[0] == 0, {j, N0/2 + 1, N0}],      Table[x[N0/2, j][0] == 0, {j, N0/2 + 1, N0}],     Table[x[0, j][0] == 0, {j, 1, N0}],      Table[x[0, j]'[0] == 0, {j, 1, N0}]]];               moo = NDSolve[crazy, Table[x[i, j], {i, 0, N0}, {j, 0, N0}], {t, 100}]               points = Table[{i, j, x[i, j][t]} /. moo, {i, 0, N0}, {j, 0,      N0}]          Animate[ListPointPlot3D[points], {t, 0, 100     }, AnimationRate -> 2, AnimationRepetitions -> 2,      AnimationRunning -> False]


Pattern matching to head with HoldFirst

I want to define a function that only operates on expressions with a head from a given list, such as               f[expr:(_And|_Or)] := Print["LHS is ", expr[[1]]];      This of course works fine when `x` is just an expression such as `expr = p == q || p == q + 1`. However, now I'd like to be able to print out parts of `expr` even when p and q both have values defined. That is, if `f` and `expr` are defined as above, then               p = 1;     q = 2;     f[expr]      should print "LHS is True". The obvious thing to try is of course to add               SetAttributes[f, HoldFirst]      but now `f` doesn't match `expr`, i.e. `f[expr]` simply returns `f[expr]`. I've tried variations of this, but nothing I can come up with seems to work, `expr` is always either evaluated before matching the head or the correct head is not found.


Parametric Interpolation of 2D data

I want to create an interpolation through the following 2dim data points:               data = {{22.78, 0.2431}, {22.06, 0.262}, {21.51, 0.2774}, {21.07,         0.2905}, {20.7, 0.302}, {20.38, 0.3121}, {20.1, 0.3213}, {19.86,         0.3296}, {19.28, 0.3499}, {5.41, 0.363}, {5.88, 0.364}, {18.71,         0.3709}, {5.14, 0.3715}, {5.11, 0.3734}, {6.3, 0.3772}, {6.4,         0.3824}, {4.96, 0.3882}, {18.15, 0.3925}, {4.9, 0.4036}, {4.89,         0.4083}, {6.69, 0.4141}, {17.6, 0.4147}, {4.91, 0.4372}, {17.06,         0.4374}, {6.61, 0.4414}, {6.43, 0.4493}, {4.98, 0.459}, {16.52,         0.4603}, {5.07, 0.4791}, {15.99, 0.4835}, {5.19, 0.4995}, {15.47,         0.5067}, {5.33, 0.5204}, {14.96, 0.5297}, {5.5, 0.5415}, {14.45,         0.5524}, {5.69, 0.5626}, {13.95, 0.5745}, {5.9, 0.5834}, {13.46,         0.5957}, {6.13, 0.6035}, {12.98, 0.6158}, {6.38, 0.6227}, {12.5,         0.6346}, {6.65, 0.6407}, {12.03, 0.6518}, {6.94, 0.6571}, {11.57,         0.6672}, {7.25, 0.6717}, {11.12, 0.6805}, {7.57, 0.6842}, {10.68,         0.6915}, {7.91, 0.6944}, {10.25, 0.7}, {8.27, 0.7021}, {9.83,         0.7059}, {8.64, 0.7072}, {9.42, 0.7091}, {9.02, 0.7095}};      With the common interpolation the plot looks like this:               dataInt = Interpolation @ data;     Show[{       ListPlot[data,          PlotRange -> {{0, 25}, {0, 1}}, ImageSize -> 800],        Plot[dataInt[r], {r, 5, 25},          PlotStyle -> RGBColor[0, 0, 1, .5]]}]      ![Listplot with interpolation](http://i.stack.imgur.com/Zjfyn.jpg) I already tried to obtain a better interpolation using Nearest or try to interpolate the two components seperatly but I was not able to get it the way I want it to be: It just does not connect the right points together. I already tried the solution presented here Parametric differentiable interpolation of a 2D data set using parametrizeCurve[] but it does not create an adequate interpolation either:               tvals = parametrizeCurve[data];     int = Interpolation[Transpose[{tvals, data}]]     Show[{       ListPlot[data, PlotRange -> {{0, 25}, {0, 1}}, ImageSize -> 800],        ParametricPlot[int[t], {t, 0, 1}]}]      ![Interpolation with using parametrizeCurve](http://i.stack.imgur.com/rc2bD.jpg) I must admit, that I dont understand the method behind `parametrizeCurve`, but it seems to be working with the wrong dimension of my data. I would be very happy to get a solution to my problem.


How do I estimate the Pareto front in my multiobjective optimization problem?

I need to minimize a function of two parameters that gives two "stress" outputs `{A,B} = f[tau,mu]`. How do I estimate (even roughly), the Pareto front for this problem? (That is, if I'm not mistaking, the set of (tau,mu) for which the ouputs (A,B) is Pareto-optimal. That is, you can't improve A or B without making the other one increasing.) Could it be just one single point? (Just so you know, `f` is a big, long piece of simulation based on several sets of data, and it still takes (after hard work of optimization, compilation and parallelization) something like 1 or 2 seconds to get one point. Therefore, I think any _rough_ estimation method'd be enough :) This is it, thank you guys! -- Iago-lito


Having problems with ListPlot and a PaddedForm wrapper

I defined a function `f[x_] = x^3 2 x`. Then I had to construct a table showing vertically, the values of `f` corresponding to x on the interval [-3,3] in increment of 0.5. So, I did this:               f[x_] = x^3 - 2 x;     a := PaddedForm[x, {2, 1}];     b := PaddedForm[f[x], {5, 3}];     p = Table[{a, b}, {x, -3, 3, .5}];     TableForm[p,        TableHeadings -> {None,{"x", "f(x)=x^3-2x"}},        TableAlignments -> Center]      I had my answers and so far it was ok. But next, I had to plot the set of values with heavy dots. So I did this:               ListPlot[p];      But now there's an error saying: > Co-ordinate -3.0 in {-3.0,-21.000} is not a floating-point number .... How do I fix this?


Force change in aspect ratio of Inset image

I have an image that I want to place in the background of a plot and stretch it to cover the entire plot area. However, the aspect ratio of the image does not match the aspect ratio of the plot, and `Inset` refuses to stretch the image.               image = Image@Map[ColorData["SunsetColors"],         Table[(y - x^2 + 1)/2, {y, Reverse@Range[0, 1, 0.02]}, {x, 0, 1, 0.01}], {2}];     ContourPlot[y - x^2, {x, 0, 1}, {y, 0, 1}, ContourShading -> None,       Prolog -> Inset[image, {0, 0}, {0, 0}, {1, 1}]]      ![enter image description here](http://i.stack.imgur.com/X3VNc.png) The `Inset` documentation states: >   * If size is given as $\{w,h\}$, then any object $\mathit{obj}$ whose > aspect ratio is not fixed will be horizontally or vertically stretched so as > to fit exactly in a $w\times h$ rectangle. > >   * If $\mathit{obj}$ is an object with fixed aspect ratio, then blank space > will be left equally on both sides if there is a direction where the object > would have to be stretched in order to fit exactly. > > Evidently `Inset` thinks the image is an object with fixed aspect ratio. How can I get around this?


HTML documentation build issue with Wolfram Workbench 2 and MMA 9

Using the Wolfram Workbench 2 (and Mathematica 9) to build HTML documentation for a package I am developing, I am ending up with HTML pages that contain a lot of text elements that look like this: > Div[{class -> MCap}, {Change a few exchange reaction flux bounds to reflect > an aerobic minimal glucose medium.}] or > Div[{}, {XMLElement[a, {href -> javascript:input('i_9'), onmouseover -> > javascript:return(true);}, {XMLElement[img, {src -> Files/Constraint-based > modeling/I_10.gif, height -> 35, width -> 447, alt -> Click for copyable > input}, {}]}]}]Div[{name -> i_9_out, id -> i_9_out, class -> IFL}, {}] It looks a lot like a shadowing error and indeed a new `Div` function has been introduced to Mathematica 9. Is there a way to work around this for the moment? The HTML documentation builds fine with Mathematica 8.


Solve[ ] for 2 variables not returning list of two variables

I type into mathematica:               Solve[2 Sin[(Sqrt[3] x - 3 y)/2] == 2 Sin[(Sqrt[3] x + 3 y)/2], {x, y}]      expecting it to return a list of pairs of solutions of the form               {{x->x1,y->y1},{x->x2,y->y2},{x->x3,y->y3},etc...}      as per the documentation. But instead it gives me ![](http://i.stack.imgur.com/ymBEJ.png) which is not quite what I was expecting. How can I get this function to return a list of the pairs of solutions. I'm confused. Thanks!


Correct usage of GeoPosition

My goal is to trace a ray down to the ground. I have done:               {re, rp} = GeodesyData["ITRF00", #] & /@ {"SemimajorAxis", "SemiminorAxis"}     sat = {0, 2 re, 0};     point = Normalize[{.2, -1, .28}];     sol = FindRoot[GeoPosition[GeoPositionXYZ[sat + f point, "ITRF00"]][[1, 3]],{f,100}];      The idea is I'm starting at point `sat` with a ray in the direction of `point`. If this ray intersects with the earth there should be a point where `GeoPosition[]` will give a zero height. So far the results I have gotten seem right when I plot them and for simple cases but I get the following error messages:               GeoPositionXYZ::invcoord: {0.18911736861805847*f, 12756274 - 0.9455868430902923*f, 0.2647643160652819*f} is not a valid coordinate specification. >>     GeoPosition::invcoord: GeoPositionXYZ[{0.18911736861805847*f, 12756274 - 0.9455868430902923*f, 0.2647643160652819*f}, "ITRF00"] is not a valid coordinate specification. >>     Part::partw: Part 3 of GeoPositionXYZ[{0.189117 f,12756274-0.945587 f,0.264764 f},ITRF00] does not exist. >>     GeoPositionXYZ::invcoord: {#1, #2, #3} is not a valid coordinate specification. >>      Is there a better way to use `GeoPosition[]` with `FindRoot[]`?


How can I write a function which takes another function of a variable and the variable itself as arguments and gives a list of critical points?

This is an exercise from Power Programming with Mathematica by Wagner. I need a function which takes a function and a variable as arguments, like this: critpts[f_,x_]:= and then on the rhs I've got something like /;Derivative[f[x]]=0 as a condition at the end, and what I want is something that will generate a list of rules like x->0 which describe the values of critical points. An example would be that if the function worked it'd mean something like this: critpts[x^2,x] would generate something like this: x->0. I don't even know how I can generate a list of rules at all.


How can I type left (sub)superscript?

I want to type in my variable next to its plot and I'm typing the text in using `Inset`. However my variable has superscripts to the left. Say it looks like this: $ \sideset{_a^b}{'}F $ How can I type this in _Mathematica_? Right now I just do `Ctrl``^` and `Ctrl``_` and fill in the super/subscript and then delete the place holder for the regular script. This works for a while but if I correct something else on the plot then it automatically vanishes. Is there a stable and standard way to do this?


How can I trace a functional expression's evaluation visually?

Ok, so the goal is to visualize the execution of this expression               foo /@ {3 + 1, bar /@ {1 + 2, {4 + 7}}}      in the following fashion using nested rectangles with mouseover highlighting and tooltips that show the highlighted subexpression's values. ![enter image description here](http://i.stack.imgur.com/VxXvu.png) Ok, that works and looks great, but the code is ugly:               Clear[foo, bar];     expr = MapAll[h1,         Unevaluated[foo /@ {3 + 1, bar /@ {1 + 2, {4 + 7}}}],         Heads -> True];          expr = expr //. h1[x_] :> h2[HoldForm[x], h3[x]];          expr = expr //.         h2[x_, y_] :>          Mouseover[          Tooltip[Framed[x, Background -> White, FrameMargins -> 10,             RoundingRadius -> 10], y],           Tooltip[Framed[x, Background -> Hue[0.6, 1, 1, 0.1],             FrameMargins -> 10, RoundingRadius -> 10], y]];          Cleanh2[x___] :=       Module[{xx = {x}},        xx = xx //. {Framed[a_] :> a, Tooltip[b_, c_] :> c,           Verbatim[HoldForm][d__] :> d, Mouseover[e_, f_] :> e};       Sequence @@ xx]          expr = expr //. h3 -> Cleanh2;          MouseAppearance[      Magnify[Dynamic[Evaluate[expr] //. Verbatim[HoldForm][d___] :> d],        1], "+"]      and quickly breaks:               expr = MapAll[h1,         Unevaluated[         Module[{t = RandomInteger[1, 10]},           MapThread[f, {t, RotateLeft[t] + RotateRight[t]}]]],         Heads -> True];          expr = expr //. h1[x_] :> h2[HoldForm[x], h3[x]];          expr = expr //.         h2[x_, y_] :>          Mouseover[          Tooltip[Framed[x, Background -> White, FrameMargins -> 10,             RoundingRadius -> 10], y],           Tooltip[Framed[x, Background -> Hue[0.6, 1, 1, 0.1],             FrameMargins -> 10, RoundingRadius -> 10], y]];          expr = expr //. h3 -> Cleanh2;     MouseAppearance[      Magnify[Dynamic[Evaluate[expr] //. Verbatim[HoldForm][d___] :> d],        1], "+"]      How can I do this cleanly in a general fashion? There must be a way...


Improving convergence in a numerical integration (Version 5.2)

I have a double integral that I am trying to calculate numerically, and I'm having convergence issues.               f[x_, z_] := (Exp[-1*gamma*x]/x^0.5)*BesselI[1, (alpha*z*x)^0.5];     a[tau_, z_] := (alpha*z)^0.5*NIntegrate[f[tau - taup, z]*Exp[-1*gammaL*(tau - taup)]*Exp[-1*gammaS*(tau - taup)], {taup, 0, tau}, WorkingPrecision -> 200];     b[tau_, z_] := 0.25*alpha*z* NIntegrate[{f[tau - taup, z]*f[tau - taupp, z]*Exp[-1*(gammaL + gammaS)*Abs[taup - taupp]]}, {taup, 0, tau}, {taupp, 0, tau}, WorkingPrecision -> 200];     S[tau_, z_] := (1 + a[tau, z] + b[tau, z]);          gamma = 1;     gammaL = 10;     gammaS = 10;     alpha = 1;      Evaluating e.g. `S[100,10]` I get a convergence warning. From my understanding of how I'm expecting the integrals to behave, I think the answer I'm getting is incorrect. I get an answer of `3.259`.               NIntegrate::ncvb: NIntegrate failed to converge to prescribed accuracy after 7 recursive bisections in taup near taup = 99.96171345046263`.     NIntegrate::slwcon: Numerical integration converging too slowly; suspect one of the following: singularity, value of the integration being 0, oscillatory integrand, or insufficient WorkingPrecision. If your integrand is oscillatory try using the option Method->Oscillatory in NIntegrate.      I've played with `WorkingPrecision` and `AccuracyGoal`. Are these the right things to try? I am using rather dated Mathematica 5.2... Thanks for any hints.


Extract substring by repeated StringPattern

This code failed, but may exemplify my intention.               StringCases["aA1bbbbbbbbbbaA2baA3b...aA4b",Repeated[Shortest["a"~~xx__~~"b"],{2,100}]]      I want to get the substring `"aA2baA3b"`. They (`a~~__~~b` is one string pattern) are in succession. single `"aA3b"` is not expected to get and should be omitted.               StringCases["aA1bbbbbbbbbbaA2baA3b...aA4b",Repeated[Shortest["a"~~__~~"b"],{2,100}]]      gives > "aA1bbbbbbbbbbaA2baA3b"


Finding distribution parameters of a gaussian mixture distribution

**Short version** : how to estimate the parameters of a mixture of multivariate normal distributions (i.e.: Gaussian mixture model)? * * * **Long version**. I am trying to estimate the parameters of a mixture of multivariate Gaussian distribution. I know how to do it for a single multivariate normal distribution:               dist = MultinormalDistribution[{0, 0}, {{1, 0}, {0, 1}}];     dataSet = RandomVariate[dist, 300];     estDist = EstimatedDistribution[dataSet, MultinormalDistribution[{m1, m2}, {s11, s12}, {s12, s22]}}]]          Plot[{PDF[dist, {x, 0}], PDF[estDist, {x, 0}]}, {x, -4, 4}, Filling -> Axis]     SmoothDensityHistogram[dataSet]     Plot3D[PDF[estDist, {x, y}], {x, -2, 2}, {y, -2, 2}]      ![Similarity of PDF at y=0, density of dataset and estimated density.](http://i.stack.imgur.com/EulrX.png) All fine and dandy. However, the same approach does _not_ work for me with mixture distributions. In particular, I am interested in mixtures of Gaussian distribution (Gaussian Mixture Model). I generate a sample dataset:               targetDist = MixtureDistribution[{1/3, 2/3}, {MultinormalDistribution[{0, 0}, {{1, 0}, {0, 1}}], MultinormalDistribution[{3, 3}, {{1, 0}, {0, 1}}]}];     dataSet = RandomVariate[targetDist, 500];     ListPlot[dataSet]     SmoothHistogram3D[dataSet]      ![Mixture of Gaussians](http://i.stack.imgur.com/tYVJD.png) I try to find the estimated distribution with:               estimatedDist = EstimatedDistribution[dataSet,         MixtureDistribution[{w1, w2}, {             MultinormalDistribution[{m11, m12}, {{s111, s112}, {s112, s122}}],             MultinormalDistribution[{m21, m22}, {{s211, s212}, {s212, s222}}]         }]]      But the evaluation always fails with:               NMaximize::cvdiv: Failed to converge to a solution. The function may be unbounded. >>      For some reason, it works if, instead of using `MultinormalDistribution` I use `BinormalDistribution` with $\rho$=0. I know how to estimate these parameters using the Expectation Maximization algorithm, but I was wondering if there is a Mathematica-friendly way to do it. * * * **Edit**. Giving initial estimates of the parameters does not really improve much. Even when giving the _exact_ parameters like this:               estimatedDist = EstimatedDistribution[dataSet,          MixtureDistribution[             {w1, w2},             {MultinormalDistribution[{m11, m12}, {{s111, s112}, {s121, s122}}],              MultinormalDistribution[{m21, m22}, {{s211, s212}, {s221, s222}}]}],             {{w1, 1/3}, {w2, 2/3}, {m11, 0}, {m12, 0}, {s111, 1}, {s112, 0}, {s121, 0}, {s122, 1}, {m21, 3}, {m22, 3}, {s211, 1}, {s212, 0}, {s221, 0}, {s222, 1}}]      `EstimatedDistribution` seems to take much more time than what it would be reasonable (and, since the estimates are exact, "reasonable" means 0.1 sec). After about 15 minutes of processing on a 3.3GHz Xeon, I got this error:               FindMaximum::eit: The algorithm does not converge to the tolerance of     4.806217383937354`*^-6 in 500 iterations. The best estimated solution,     with feasibility residual, KKT residual, or complementary residual of     {2.1536*10^-12,0.00200273,5.6281*10^-13}, is returned. >>      Then a popup message:               INTERNAL SELF-TEST ERROR: MLParseStream|c|297     Click here to find out if this problem is known, and to help improve     Mathematica by reporting it to Wolfram Research.


reconstruct a 3D curve from discrete curvature and torsion

I tried to reconstruct a 3D curve with given curvature and torsion. I saw some threads talking about using runge kutta. However, as far as I see that they required curvature and torsion were continuous. Unfortunately, my curvature and torsion are discrete. They are not functions of arc-length, but indexed by arc-length. Anyone can help to see how to solve the problem with discrete curvature and torsion. Thank you. Hi here is an example. Assume we have a trajectory indexed with arc-length of $\delta s$ and total samples of 500. I have $$y_{s} = \begin{bmatrix} r_{s}\\ T_{s}\\ N_{s}\\ B_{s} \end{bmatrix}$$ where $s = 1, 2, ..., 500$. Now we can create a function used by runge-kutta as $$y_{s}^{'} = \begin{bmatrix} 0 & 1 & 0 & 0\\ 0 & 0 & \kappa_{s} & 0\\ 0 & -\kappa_{s} & 0 & \tau_{s}\\ 0 & 0 & -\tau_{s} & 0 \end{bmatrix}y_{s}$$ Note that here $\kappa_{s}$ and $\tau_{s}$ are not function of $s$. Instead, they are indexed by $s$. Therefore, if $s = 1.5$, we are not able to compute $\kappa_{s}$ and $\tau_{s}$. In terms of using runge-kutta, for $$k_{1} = \delta s f(y_{s}, x_{s})$$ it is fine since $x_{s}/\delta s$ always is an integer. However for $$k_{2} = \delta sf(y_{s}+\frac{k_{1}}{2}, x_{s}+\frac{\delta s}{2})$$ $\frac{x_{s}+\frac{\delta s}{2}}{\delta s}$ cannot be an integer, therefore we cannot find corresponding $\kappa$ and $\tau$ in this case. Not sure if I explained my problem clearly.Thank you.


VectorPlot differences between v9 and v10

The following code displays differently with v9 & v10:               VectorPlot[{1, 2 x (1 - x)}, {t, 0, 1}, {x, 0, 1},      VectorScale -> {.03, Automatic, None},      VectorStyle -> {Red, "Segment"}]      In v9 the arrowheads are not present. This is the image I want. ![No arrowheads here](http://i.stack.imgur.com/cFyOz.jpg) In v10, arrowheads are present and I do not want them. ![with arrowheads](http://i.stack.imgur.com/5RGOv.jpg) I have tried using VectorStyle->{Red,Arrowheads[0]} in v10 but to no avail.


When exporting an (animated) GIF, is it possible to specify the size of the color palette?

I've exported an animation to animated GIF, which generated a 15mb file. I've been asked if I could regenerate the file, limiting it to only 16 colors, but I can't find any documentation on how I might do that. Is there a way to make `Export[]` reduce the color palette, preferably dithering as needed?


Reading in scientific notation from C++ to Mathematica

With a text file with entries formatted as (output from C++):               f[38.67] = -2.5387862698183892298317350539374412777263289550697e-05;     ⋮      Is there a way to read this into _Mathematica_? It seems to be getting confused with the `e`, thinking it is just a symbol `e`.


Shortcut to insert CounterBox

Is there a shortcut to inserting a `CounterBox` as you type in text mode? I haven't yet made extensive use of them but I can foresee them in my near future and the current method of inserting them is a little bit of a pain. Here is the current method: Start by opening a new notebook. Create a text cell with the following content: > The current counter of title is: XXX. Select the XXX and go to `Insert > Automatic Numbering...`. This will give you some options. For Counter leave it as it is (Title). And select "This counter object". After clicking OK now the XXX will be replaced by 0 since the current count for title cells is 0. If you now create a Title cell above the one you just created then that 0 will become a 1. I don't mind using the little GUI asking me what counter to insert. What I do not like is having to go to `Insert > Automatic Numbering...` all the time. I would actually prefer if possible to do some sort of input autoreplacement but this clearly would not work since we need to define what gets replaced. I thought about maybe using input alias but this again requires me to define the inputs. What I want to be able to do is something like this... > The current counter of title is [AliasDelimiter]ref[Title][AliasDelimiter] and get > The current counter of title is 0 I'm trying to emulate $\LaTeX$ here using ref. I don't know if I have explored this question enough but so far I'm running out of ideas to make the process of entering counterboxes as painless as possible. The last idea I had was to create a palette with an input box in which you entered the tag or counter but then I realized that even if this is possible (I highly doubt it is) it would then just be the same as the `Insert > Automatic Numbering...` gui. So the question again: Is there a some sort of shortcut to inserting a `CounterBox`?


Round image corners

I just read StackExchange blog _It’s OK to Ask and Answer Your Own Questions_ which even encourages it and decided to ask about a problem I now know how to solve. But I found an elegant answer only recently (and will post it now below), much inspired by this very site and answers I'm trying to understand. Q: I would like to round the corners of an image into circular arcs of some radius before I upload it to a blog. Test image: ![enter image description here](http://i.stack.imgur.com/f1gur.jpg)


3D Contour Plot parts of sphere with gradient less than 0, equal to 0 and more than 0

I want to plot only **parts** of the sphere of radius 1 where the gradient $\frac{\partial z}{\partial x}$ is < 0, = 0 and > 0. The full sphere is given by:               ContourPlot3D[x^2 + y^2 + z^2 == 1, {x, -1, 1}, {y, -1, 1}, {z, -1, 1}]      ![enter image description here](http://i.stack.imgur.com/iTGBe.jpg) I know how to plot parts of the sphere where $x^2 + y^2 + z^2 < 0.5 $ or something, but I can't figure out how to apply the condition to the gradient. UPDATE: The positive and negative gradients turn out fine, but when I try to plot gradient = 0 it turns out funny. I tried to find $\frac{\partial z}{\partial x} = 0$ for the equation but it didn't work: $$x^2 + y^2 + z^2 == xy $$               eq1 = x^2  y + y^2 + z^2 x == x y     ContourPlot3D[Evaluate[eq1], {x, -2, 1}, {y, -2, 2}, {z, -2, 2}]          deriv = Derivative[1, 0][z][x, y] /.          First[  Solve[    D[eq1 /. z ->   z[x, y], x],             Derivative[1, 0][z][x, y]  ]  ]  /. z[x, y] ->  z;          Positive1 =        ContourPlot3D[Evaluate[eq1], {x, -2, 2}, {y, -2, 2}, {z, -2, 2},         RegionFunction ->  Function[{x, y, z}, deriv > 0], Mesh -> False,          ContourStyle -> Blue, MaxRecursion -> 5];     Negative1 =        ContourPlot3D[Evaluate[eq1], {x, -2, 2}, {y, -2, 2}, {z, -2, 2},         RegionFunction ->  Function[{x, y, z}, deriv < 0], Mesh -> False,         ContourStyle -> Red, MaxRecursion -> 5];     zero1 = ContourPlot3D[        Evaluate[eq1], {x, -2, 2}, {y, -2, 2}, {z, -2, 2},         RegionFunction ->  Function[{x, y, z}, deriv = 0], Mesh -> False,         ContourStyle -> Green, MaxRecursion -> 5];          Show[Positive1]     Show[Negative1]     show[zero1]      ![enter image description here](http://i.stack.imgur.com/aXsUE.png) ![enter image description here](http://i.stack.imgur.com/ou2Iv.png) ![enter image description here](http://i.stack.imgur.com/lfqaT.png)


decompose a number (less than 255) in a sum of powers of 2

Is there a built in function that would take a number and decompose it into a sum of powers of 2? The numbers will be non negative less than 256. For what it's worth I'm trying to understand a paper on RAID 6, which uses some Galois field in calculating the second parity (in this case) byte. There's a rule for mulitplying by 2, which is unusual in iteself, at least to me. It seems that in order to generalize mulitplication to any two bytes I would have decompose those bytes into powers of 2 and mulitply them like polynomials. Then in this case, mod them by 255. I can write a function to do the necessary decomposition, but I thought that there might be a built in function.


Problems with visual update in GUI

Consider the following. When clicking in "Browse" and then choosing a file, the path will remain the original one and won't change to the one of the file I chose:               nb = EvaluationNotebook[];          DynamicModule[      {path1 = FileNameJoin[{$HomeDirectory, "Desktop", "file.nb"}],       path2 = FileNameJoin[{$HomeDirectory, "Desktop", "file.xls"}]},       CreateDialog[       Column[{Row[{InputField[Dynamic[path1], String, Enabled -> False],            FileNameSetter[Dynamic[path1],             "Open", {"Mathematica Notebook" -> {"*.nb"}}]}],          Row[{InputField[Dynamic[path2], String, Enabled -> False],            FileNameSetter[Dynamic[path2],             "Open", {"Excel files" -> {"*.xls", "*.xlsx"}}]}]}],        NotebookEventActions :> {"WindowClose" :> (SetOptions[nb,             Visible -> True])}]     ]


Is there a way to get BSplineFunction beyond MachinePrecision?

I have been using `BSplineFunction` (Mathematica 8) to generate a smooth representation of some data, which I might then do some further processing on. As I understand it, BSplineFunction should be analytic and I should be able to pull out a value anywhere. The results of BSplineFunction however are limited to MachinePrecision, regardless of the input data's precision or accuracy. For example,               data = {{17980, -1}, {17990, -1}, {18000, 0}, {18010, 1}, {18020,      3}, {18040, 0}, {18050, -1}, {18080, 2}, {18100, 0}};          f = BSplineFunction[data, SplineDegree -> 3];      Asking for a value:               f[1/5]      Will give               {18001.6, 0.158667}      Initially, I thought something like               N[f[1/5],300]      would produce an answer with 300 digits for example, but instead it only returns the same answer as above.In fact, changing the 300 to 3 also produces the same result. Note, Precision[data] and Accuracy[data] both give $\infty$. However, Precision[f], and Accuracy[f] give MachinePrecision, and 14.9546, respectivley. PrecisionGoal and AccuracyGoal are not available options for BSplineFunction (it lets you know if you try). It will take setting WorkingPrecision to some number as an option, for example,               f = BSplineFunction[data, SplineDegree -> 3, WorkingPrecision -> 8000]      without giving any error, but the answers remain unchanged. Am I trying to get answers out of BSplineFunction it simply isn't possible for it to give, or is there perhaps some other setting I need to explore? Thank you for any assistance.


Displaying a small histogram overlay on a large image

I needed to overlay a small histogram onto a large image, specifically in the bottom right hand corner. However, I could not do this in an intuitive and computationally cheap fashion due to inexperience. There are two images, the histogram               imgHist=Histogram[{filtGreenLengths, filtRedLengths}, 20, Background -> White,       ImageSize -> {200, 100}]      and the main image               image      I first tried to directly perform the overlay, using the code               finalPic = ImageCompose[image, {imgHist,0.5}, Scaled[{0.9, 0.085}]]      but the ImageCompose function freaked out and stretched imgHist to equal the size of image and then moved the enormous expanded imgHist to the bottom right hand corner. I could not find an option to turn off this auto-stretching in the documentation. In the end, I had to do this               imgHist =        ImageCrop[        Histogram[{filtGreenLengths, filtRedLengths}, 20,          Background -> White,          ImageSize -> {200, 100}], {ImageDimensions[image][[1]],          ImageDimensions[image][[2]]}, Padding -> Transparent];      in order to get the result I wanted. This appears to be pretty silly and redundant, so what would be a less hackish way of doing this?


Configuring Remote Kernel via terminal in Linux

There's a server at work, which I would like to use as a remote kernel. I have access to it via terminal (server is running Red Hat, my client Windows 7). I don't know if the kernel is set up or not, so I want to check this. However, I don't know how perform this check in the terminal. All guides I have seen so far require the front end. So, is there a way to configure a remote kernel via the terminal?


Slow import of multigigabyte TIF image stacks

**Update 6:** After contacting Wolfram Technical Support, I was advised that the frame-to-frame import timing variability can be eliminated by reading in the frame stack from frame to frame with the commands:               data[[k]] = Import["multiframe.tiff", {"ImageList", k}]      or               data[[k]] = Import["multiframe.tiff", {"GraphicsList", k}]      My response was: If we write a simple script like this:               StackDepth = Import["...\\data.tif", "ImageCount"]          data = Array[0 &, StackDepth];     TimingArray = Array[0 &, StackDepth];          For[i = 1, i <= StackDepth, i++,           FrameStartTime = AbsoluteTime[];              data[[i]] = Import["...\\data.tif", {"GraphicsList", i}];             FrameEndTime = AbsoluteTime[];        TimeArray[[i]] = FrameEndTime - FrameStartTime;               Print[i, "   ", TimeArray[[i]]];     ];      For a 10,000 frame stack, where individual frames have dimensions {256,256}, we have a ~0.85 second per frame import time (implying that it will take 10^4*0.85 seconds ~ 2.5 hours to load in all of the frames. So the loading times are actually longer than just using data[[i]] = Import["...\data.tif"];. Also, if we try a 5,000 frame stack, we have a ~0.5 second / frame loading time. So it seems this fix just spreads out the slow loading time to all frames. Is there a way around this or a patch? * * * I noticed that it takes half an hour or so for me to import a $\approx 1.86$ GB TIF file consisting of exactly 15,000 images with 256 x 256 pixels (via the Import[] command), whereas it takes only a few seconds to load the same file in a program like ImageJ. My machine has 128 gigs of ram, and a fairly modern Xeon processor, so I doubt that's the issue. I'm hoping to understand why this is happening, and what, if anything, I can do about it. Because of the device I'm using to capture the images, it would be very helpful to import files in this TIF format. That said, it doesn't seem to help to try other image formats like PNG. * * * For an example, I've uploaded the exact TIF file I'm using, which is again a stack with exactly 15,000 images, each consisting of a {256, 256} pixel lattice, to the following dropbox folder: https://www.dropbox.com/s/1xdztnk4iykjabb/ExampleTIF.tif (to retrieve the file, click "download" in the upper-right-hand corner). The first {256, 256} frame of the TIF file ($\approx 128$ kb in size) can be found here: https://www.dropbox.com/s/o85s74rdi33hq76/frame1.tif (unfortunately, you have to download the image to see it, as the preview appears to be broken). I have clocked that it takes 1528.1894075 seconds (about 25 minutes and 28 seconds) to load the full TIF stack with the command:               data = Import["E:\\data\\ExampleTIF.tif"];      The loading time I observe for the single frame appears to be $\approx 24$ milliseconds, which implies that the full stack should load in $24$ milliseconds $\times 15,000$ frames $\approx 6 $ minutes. The $24$ millisecond loading time per frame seems excessive in and of itself without accounting for the factor of 4-5x per-frame slowdown when loading the full stack. Why is ImageJ, LabVIEW, etc. so much faster than Mathematica? I can load the full stack in less than 30 seconds with either of these programs. * * * I previously asked this question here: Speeding up TIF import without an explicit example. Unfortunately I lost my account log-in information, and was unable to update the old question. * * * **Update 5:** In the comments section, Simon Woods wrote: "To see what Import is actually doing with those functions you could do a trace like this: With[{syms = Alternatives @@ Symbol /@ Names["*` _TIFF_ "]}, Trace[Import["frame1.tif"], syms, TraceInternal -> True]]" Here's the result of that trace analysis:               {{{{{{{{{{{{{{{{{{{{{{{{{{{{{Image`ImportExportDump`ImageFrameCountTIFF["E:\\data\\ExampleTIF.tif"], 15000}}},{{{Image`ImportExportDump`ImageReadTIFF["E:\\data\\ExampleTIF.tif"], {IMAGES FROM TIFF STACK HERE}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}      As can be clearly seen, Image`ImportExportDump`ImageReadTIFF, which is the same function I've analyzed the behavior of below, is being used for the TIFF stack import. Image`ImportExportDump`ImageReadTiledTIFF[] & Image`ImportExportDump`ImageReadTileTIFF[] remain mystery functions. * * * **Update 4:** There appears to be some metadata for my TIFF stack. Running the command:               Import["E:\\data\\ExampleTIF.tif", "Table"]      Returns:               {{"II*\.00ü", "\.02\.00Andor",        "SOLIS\.00\.00\.00\.00\.00\.00\.00\.00\.00\.00\.00\.00\.00\.00\.00\     \.00\.00\.00\.00\.00\.00t\.0e\.0fB"}, {"`"}, {"l"}, {"i"}, {"å\.0eÕ       \.08"}, {"P\.10%\.0e0\.11\.10I\.0f\.06\.11L\[RawEscape]42O<\     \[Divide])»\.19Â\.0f       Í\.10"}, {"æ       ½"}, {""}, {"T"}, {"õ\.11g"}, {"\.0e1\.0f\.02\.11Þ\.10Y\.10â\.11\     \.1c\.11]\.15l\.1dG44É%s\.15       \.12L\.0f"}, {"\.10õ"}, {""}, {"\.0f>\.0e\.1d\.12Ç       Å\.10ç\.0e\.1c\.0fç\.0fý\.0eR\.0f\.0ea\.0e\.0b\.0b\.06\.0e"}, {}, \     {"3\.0eÆ\.0f\.0f       î\.0b\[Paragraph]\.0eb\.0e¹       %\.0fÏ\.0eû\.0fA\.0e\.b4            »\.0f\.10\.12\.11X\.0ei\.10ñ\.10ò\.0eÊ\.0f\.15\.0fk\.10=\.10\.0e¡\     \.11R       A\.0bä\.0eL\.0f¹\.0fØ\.10â\.0e\[PlusMinus]\.0e\.13\.0f~       æ       "}, {"¢       Ü\.0f9"}, {"W\.0e|       t"}, {"Æ       \.14\.0f"}, {"ê\.11{\.11º\.10\.0e¨\.0fõ       \.0fT"}, {"\.07"}, {"É"}, {"\.10¼       \.1f\.0f\.0eì\.13R\.10Å\.10Q\.11B\.0fÁ"}, {"\.10\.08"}, {"l\.10Ô\     \.12j"}, {".\.0eü\.0eÓ\.0fð\.0f\.18\.0f"}, {"\.0f\.10Þ"}, {"é"}, \     {"I"}, {"0       \.0ea\.0b\.0bÍ\.0bj"}, {"%\.0eB\.10=\.0b[       \[Paragraph]\.0e\.16\.0b3"}, {}, {"\.0b\[Micro]"}, {"Ö\.0f\""}, {"p\     \.0fú"}, {"w       \.0fB\.12E"}, {"Å       Þ"}, {"\.04\.0e¨\.0fÃ\.0b)\.0fÁ\.0eÆ"}, {"Ñ"}, {"m\.0f \.0fû\.10:\     \.0f("}, {"x\.0f\.06\.0f¾\.10¨\.10(\.10½"}, {"ø\.0bW\.0b<            U"}, {"I"}, {"T\.10\.1c\.0el\.11ò            ¿       \.10ä\.0e\[Paragraph]"}, {"N\.0f\.02\.0f\.13\.0eÛ\.0eã       \[Degree]       \.05"}, {"H\.0e\.0fô       "}, {"\.0f5       0\.0b«\.0e«\.0f.       §\.0f7\.10+\.0e"}}      Most of this looks like junk, but you can see the name of the camera used to collect the data as well as some optical setup specifications. Perhaps there's a way to strip this data out and prevent whatever trigger is causing Mathematica to repeatedly scan through the image stack? * * * **Update 3:** I've updated the second figure to show that the import time for a fixed set of $N = 100$ frames exhibits reliable linear scaling with the depth of the first frame, $k$, in the image stack.               Image`ImportExportDump`ImageReadTIFF[]       Is clearly the wrong tool to use to import a large stack of TIF files. I also think that, after some handwringing (leading to a delay in importing a single frame), this is probably the function that Import[] calls when passed the ExampleTIF.tif stack. However, I haven't been able to get:               Image`ImportExportDump`ImageReadTiledTIFF[]      Image`ImportExportDump`ImageReadTileTIFF[]     Image`ImportExportDump`ImageReadStripedTIFF[] (striped?)       To work at all. Perhaps one of these functions represents a way forward? That said, I can't even set of arguments that these functions need. * * * **Update 2:** Ok, let's do some experiments to help elucidate the cause underlying slow loading times for large TIF stacks. First, based on Simon Wood's observation, notice that we can use:               Image`ImportExportDump`ImageFrameCountTIFF["E:\\data\\ExampleTIF.tif"]      To return an integer value corresponding to the number of frames in the TIF image stack. We can then use:               Image`ImportExportDump`ImageReadTIFF["E:\\data\\ExampleTIF.tif", Table[i, {i, StartFrame, EndFrame}]]      To return the set of frames including and between specifiable StartFrame and EndFrame integer variables. ![enter image description here](http://i.stack.imgur.com/fYeEi.png) First we notice that, setting StartFrame = 1, linearly increasing the number of frames we want to import (by linearly increasing EndFrame) requires what appears to be a quadratically scaling amount of time. ![enter image description here](http://i.stack.imgur.com/eVsrq.png) Secondly, we can notice that attempting to import a fixed length stack of 100 frames has a time-cost that scales with the depth of the 100 frames in the stack. In other words, for some {StartFrame, EndFrame} pair, the frame set including and between {StartFrame+k,EndFrame+k} appears to take a longer time to load, and this delay appears to linearly scale with $k$. So the trouble, I'm guessing, lies with properly indexing the TIF image stack. Is there any clever way to fix this? * * * **Update 1:** Following up on Simon Wood's comment, entering ?*` _TIFF_ in Mathematica v9.0 gives a set of functions, one of them being ImageReadTIFF. However:               image = Image`ImageReadTIFF["E:\\data\\frame1.tif", All];      just returns:               Image`ImageReadTIFF["E:\\data\\frame1.tif", All]      Is there any obvious mistake on my part?


Is it in general faster to get the eigenvectors and eigenvalues of a dense array rather than a sparse array?

I always thought that things in general go faster when working with sparse array but, I got this: > `Eigenvalues::arhm:` Because finding 144 out of the 144 eigenvalues and/or > eigenvectors is likely to be faster with dense matrix methods, the sparse > input matrix will be converted. If fewer eigenvalues and/or eigenvectors at > machine precision would be sufficient, consider using N on the matrix and > restricting this number using the second argument to `Eigenvalues`. >>


Find Root Iteration

I have an iterative sum from $k=0$ to $k=n$ where the resulting sum is a polynomial of degree $n$. I want to find the numerical root of this polynomial using FindRoot, starting from $x_0$ where the root I'm interested in is converging to some value. However I only know this $x_0$ for small $n \sim 60$. Then FindRoot will give me a more precise $x_0$ and I can use this to find the root for $n=65$. I then use this root as my $x_0$ for $n=70$ etc. etc. However I can only really increase $n$ by $5$ each time as I don't know where the root is converging and if I increase $n$ by more, FindRoot starts finding other roots which I know aren't the value I'm looking for. How I can set it up so that I can run to $n=300$, for example, where FindRoot will use the root found $5$ iterations ago as its $x_0$? Here's a sample:               max=90;     f[[0]]=1;          For[n=1,n<=max,n=n+1,     f[[n]]=Sum[f[[k]]Coefficient[S,y^k],{k,0,n}]];          MySum=Sum[f[[i]],{i,0,max}]          FindRoot[MySum ,{x,x_0},WorkingPrecision->7]      where $S$ is some polynomial $S(x,y)$


Row Alignment in Grid

I've been working on creating tables of differences in MAA similar to the image below, but with a bit more detail: ![Example difference Table](http://i.stack.imgur.com/QXSSi.jpg) I've written a function that will take an anonymous function, a range of values and some optional arguments to create the table:               differenceTable[f_: Function[{g}, g], range_List, n_: 3, diff_: 3, p_: 2] :=     Module[     {a = N[f /@ range, n]},      Grid[     {{"x"} ~ Join ~ {"f[x]"} ~ Join ~ (Table[Superscript[\[CapitalDelta], k], {k, 1, diff}]),     {Column[range, Center, 1]} ~ Join ~ (Column[#, Center, 1] & /@ (SetPrecision[#, p] & /@ diffList[a, diff + 1]))},     Spacings -> 2,      Dividers -> {{False, True}, {False, True}}     ]     ]      with,               diffList[x_List, n_] :=        Module[{d = Differences[x]}, {x} ~ Join ~diffList[d, n - 1]];     diffList[x_List, 1] := {x}      For example:               differenceTable[Sin[#] &, Range[10, 90, 10] Degree]      gives ![My Difference Table](http://i.stack.imgur.com/jXieM.jpg) Which is great. The problem I run into is that when the function values and the x values take on non-standard formatting (fractional notation and exponentials specifially) the spacing between rows is thrown off. For example:               differenceTable[Sin[#] &, Range[Pi/18, Pi/2, Pi/18]]      gives: ![my difference table 2](http://i.stack.imgur.com/GMDjl.jpg) I'm not sure how to fix this without eliminating the taper in the table, which I would like to keep. Does anyone know of a fix for this?


How to make InverseFunction work on function defined with restriction on arguments

This example works to define `InverseFunction` on the first argument of a function               f = Function[{##} /. {x_, y_} :> Beta[x, y] - x + y];     g = InverseFunction[f, 1, 2];     g[3, 4]     (*Root[{1 + Beta[#1, 4] - #1 &, 1.17659010788279817113535497590}]*)     N[%]     (* 1.17659 *)      When changing the definition of `f` to use `x_Integer` instead of `x` it no longer works               f = Function[{##} /. {x_Integer, y_Integer} :> Beta[x, y] - x + y];     g = InverseFunction[f, 1, 2];     g[3, 4]      Returns unevaluated               InverseFunction[{##1} /. {x_Integer, y_Integer} :> Beta[x, y] - x + y &, 1, 2][3, 4]      How to make `InverseFunction` work on functions defined with restrictions on its arguments? I looked at `ConditionalExpression` but could not figure how to use it here. V 9.01 on windows


How can I set an image size fully depending upon ImageSize?

I have an image assigned to `myPicture`               myPicture =      ![enter image description here](http://i.stack.imgur.com/oO9ov.jpg)                Image[myPicture, ImageSize -> {500, 300}]      I get result like this, after evaluation: ![enter image description here](http://i.stack.imgur.com/UmtAm.png) My problem is that the image is not fitted to the rectangle. How can I solve that one?


Making a conjecture concerning a certain upper-triangular matrix

I have searched for commands which will let me to create matrices and do matrix operations, but I don't know how to apply _Mathematica_ to the following exercise. > Make a conjecture for the result of `A*A*A`, where `A` is an n x n matrix of > the form ![A*A*A matrix of nxn rows](http://i.stack.imgur.com/O6Gjv.png) I would like to know if _Mathematica_ can calculate `A*A*A` and the approach I could use to carry out the calculation.


How to use Show in case one of the graphics doesn't exist?

I tried to combine three and more graphics with the `Show` command; but sometimes there is no data, so some of the graphics are empty lists. I tried this:               Show[ grPacing, grAcq, If[grNewMap !={}, grNewMap] ... ]      But there are a lot of errors. Any ideas? Thank you, Liad.


Creating a function after working out an example calculation

I have created this setup, it is giving me the correct answer, however I am interested in a function that does all this calculations and creates a output of mean and standard deviation. The function is has to be able to set the limit which i have named y, and run over a list.               In[302]:= list = RandomReal[{-10, 10}, 20]          Out[302]= {4.48825, 3.31096, -5.1268, -2.11263, 2.04758, 7.41939, \     1.37117, 4.73285, -1.38028, 4.55688, 6.2333, 5.67909, 6.41423, \     0.709616, -3.75265, -3.16793, 2.10447, 0.583272, -0.370173, -8.65539}          In[303]:= pp = Range[Length[list]];          In[304]:= y = 2;          In[305]:= vt = If[(-y > list[[#]] || list[[#]] > y), yes, no] & /@ pp          Out[305]= {yes, yes, yes, yes, yes, yes, no, yes, no, yes, yes, yes, \     yes, no, yes, yes, yes, no, no, yes}          In[306]:= groups = SplitBy[vt, # == yes]          Out[306]= {{yes, yes, yes, yes, yes, yes}, {no}, {yes}, {no}, {yes,      yes, yes, yes}, {no}, {yes, yes, yes}, {no, no}, {yes}}          In[307]:= fpt = DeleteCases[groups, no, {2}]          Out[307]= {{yes, yes, yes, yes, yes, yes}, {}, {yes}, {}, {yes, yes,      yes, yes}, {}, {yes, yes, yes}, {}, {yes}}          In[308]:= rp = Range[Length[fpt]];          In[309]:= bob = Length[fpt[[#]]] & /@ rp;          In[310]:= countLength = DeleteCases[bob, 0];          In[311]:= N[StandardDeviation[countLength]]          Out[311]= 2.12132          In[312]:= N[Mean[countLength]]          Out[312]= 3.`


How to check if a 3D point is in a planar polygon?

Following up on ndroock1's question, I naively tried to apply the solutions to a 3D point and polygon and they didn't work. For example, functions involving `ArcTan` that are used in kguler's answer don't work with three arguments, Mac's answer doesn't consider the 3rd dimension at all, the undocumented function `Graphics`Mesh`PointWindingNumber` doesn't work in 3D, and complex numbers only map to 2D planes. And so on. So, is there any way to **check if a 3D point is in a 3D planar polygon?**


Comparing the last output of a nested function with all the previous ones

my main question is how I can compare the last output of a nested function with all the previous ones and stop iterating when I find a repeating value. (I have 2 other questions but I think they are so simple that they do not deserve a separate topic, so I'll post them here). For example, let's say I want to see if a number is happy or not (I got the idea from a recent topic) and look at all the iterations. Here is the code I wrote               f = NestWhileList[Total @ (#^2 & @ IntegerDigits[#]) &, #, !(# == 1 || # == 4) &] &      for `f@309` I get               {309, 90, 81, 65, 61, 37, 58, 89, 145, 42, 20, 4}      I wrote that code because I know that the list will eventually reach 1 or 4. What if I didn't? Let's say I know only that the list will reach a cycle, but the numbers can change. How can I compare the last iteration with all the others and stop when I find a number repeated? In this case the list should stop at               {309, 90, 81, 65, 61, 37, 58, 89, 145, 42, 20, 4, 16, 37}      because 37 is already there. **Subquestion 1.** `f @ {309,21}` don't work, I have to write `f /@ {309,21}`. I thought that pure functions were listable, like `#^3 &`, why is f not? Has it something to do with Nest? **Subquestion 2.** It's a little question about pure functions, what's the difference between `f := #^2 &` and `f = #^2 &`? **EDIT 2** Thank you for the answers, if someone is curious, here is a timing test on my computer. Naming               (* Leonid *)     f1[n_] := Module[{appeared}, appeared[_] = False;        NestWhileList[Total[IntegerDigits[#]^2] &,          n, (! appeared[#] && (appeared[#] = True)) &]];     (* Belisarius/WReach *)     f2 = NestWhileList[Total@(#^2 &@IntegerDigits[#]) &, #, Unequal,          All] &;     (* j.Vincent *)     f3 = NestWhile[Append[#, Total@(#^2 &@IntegerDigits[#[[-1]]])] &, {#},          Length[Union[#]] == Length[#] &] &;     f4 = Block[{continue}, (continue[a_] := (continue[a] = False; True);          NestWhileList[Total@(#^2 &@IntegerDigits[#]) &, #, continue])] &;     (* image_doctor *)     f5 = FixedPoint[         DeleteDuplicates@           Append[#, Total@(#^2 &@IntegerDigits[#]) & @ Last[#]] &, {#}] &;     (* WReach *)     nestUntilCycle[f_, x_] :=        Module[{fast = x, more = True},         NestWhile[f, f@x, (fast = f@f@fast; # != fast) &];         NestWhileList[(If[more, fast = f@fast]; f@#) &,          x, # != fast || more && (more = False; True) &]];     (* Mr.Wizard *)     f6 = Module[{in},          in[x_] := (in[x] = "Exit"; Total[IntegerDigits[x]^2]);         Most@NestWhileList[in, #, # =!= "Exit" &]] &;     f7 = NestWhileList[Total[IntegerDigits[#]^2] &, #,          Signature@{##} =!= 0 &, All] &;      I obtained               AbsoluteTiming[f1 /@ Range[1, 25000];]     AbsoluteTiming[f2 /@ Range[1, 25000];]     AbsoluteTiming[f3 /@ Range[1, 25000];]     AbsoluteTiming[f4 /@ Range[1, 25000];]     AbsoluteTiming[f5 /@ Range[1, 25000];]     AbsoluteTiming[nestUntilCycle[Total@(#^2 &@IntegerDigits[#]) &, #] & /@ Range[1,25000];]     AbsoluteTiming[f6 /@ Range[1, 25000];]     AbsoluteTiming[f7 /@ Range[1, 25000];]          {3.0888054, Null}     {1.7004030, Null}     {2.6676047, Null}     {2.5740045, Null}     {1.9500035, Null}     {5.6784099, Null}     {2.9640052, Null}     {2.6520046, Null}      Time was not an issue, I included it only for completeness. Note: as Leonid and others pointed out, in this case the differences are negligible, but with longer lists and cycles it is better to avoid methods with quadratic complexity. Let's use the function proposed by Mr.Wizard and see what changes               f0 = Mod[# + 1, 2000] &;     (* Leonid *)     f1[n_] := Module[{appeared}, appeared[_] = False;        NestWhileList[f0, n, (! appeared[#] && (appeared[#] = True)) &]];     (* Belisarius/WReach *)     f2 = NestWhileList[f0, #, Unequal, All] &;     (* j.Vincent *)     f3 = NestWhile[Append[#, f0[#[[-1]]]] &, {#},          Length[Union[#]] == Length[#] &] &;     f4 = Block[{continue}, (continue[a_] := (continue[a] = False; True);          NestWhileList[f0, #, continue])] &;     (* image_doctor *)     f5 = FixedPoint[DeleteDuplicates@Append[#, f0 @ Last[#]] &, {#}] &;     (* WReach *)     nestUntilCycle[f_, x_] :=        Module[{fast = x, more = True},         NestWhile[f, f@x, (fast = f@f@fast; # != fast) &];         NestWhileList[(If[more, fast = f@fast]; f@#) &,          x, # != fast || more && (more = False; True) &]];     (* Mr.Wizard *)     f6 = Module[{in}, in[x_] := (in[x] = "Exit"; f0[x]);         Most@NestWhileList[in, #, # =!= "Exit" &]] &;     f7 = NestWhileList[f0, #, Signature@{##} =!= 0 &, All] &;        On my pc               AbsoluteTiming[f1@ 0;]     AbsoluteTiming[f2@ 0;]     AbsoluteTiming[f3@ 0;]     AbsoluteTiming[f4@ 0;]     AbsoluteTiming[f5@ 0;]     AbsoluteTiming[nestUntilCycle[f0, #] & @0;]     AbsoluteTiming[f6@ 0;]     AbsoluteTiming[f7@ 0;]          {0.0110007, Null}     {17.0559755, Null}     {0.0940053, Null}     {0.0080004, Null}     {0.0160010, Null}     {0.0150008, Null}     {0.0100006, Null}     {0.3420196, Null}      Calling out `f2` and trying with `f0 = Mod[# + 1, 20000] &` these are the results               {0.1140065, Null}     {8.9305108, Null}     {0.0840048, Null}     {0.9790560, Null}     {0.1470084, Null}     {0.1040060, Null}     {55.5261759, Null}


Missing something in my input for CountryData dependencies

I'm trying to find (a)which countries have dependencies (b)and a list of countries that consider themselves dependencies (c)and a list of countries that don't consider themselves dependencies. * * * Okay, so to find the countries that have dependencies (part a) I input                CountryData["Countries", "Dependencies"]      But that output gives me {} throughout the list with the names of 10 or so countries, which I'm not sure are correct. * * * For part b, of finding the countries that consider themselves dependencies, I have:                Flatten[Map[CountyData[#,"Dependencies"]&]]      for this part I'm not sure what else I am missing. * * * I got stuck at part b, so I think this part is similar to part c.


Taking only particular subsets and doing calculations

I have subsets formed from a list using the `Subsets` command and want to do a particular calculation, lets say subtraction using the `Subtract` command only with the sets I want. For example,               m = {4, 5, 3, 2, 8};          Subsets[m, {2}]          {{4, 5}, {4, 3}, {4, 2}, {4, 8}, {5, 3}, {5, 2}, {5, 8}, {3, 2}, {3, 8}, {2, 8}}      From this list first I want to take the subsets that contains 4 and do subtraction. Then I want to take all subsets that contain 5, including `{4,5}` and do subtraction and so on.