Setting $RecursionLimit across all parallel kernels

I'm trying to optimize an elliptic curve factoring method by running it in parallel. There is a recursive step which required me to set the recursion limit higher than 256, however when I try and run it in parallel apparently the `$RecursionLimit` on each different kernel isn't changed. Here's part of the output:               In[76]:= ParallelECFactor[2418059292539721278076064468260051655561,1000,40]     (kernel 4) $RecursionLimit::reclim: Recursion depth of 256 exceeded.     (kernel 3) $RecursionLimit::reclim: Recursion depth of 256 exceeded.     (kernel 2) $RecursionLimit::reclim: Recursion depth of 256 exceeded.     (kernel 1) $RecursionLimit::reclim: Recursion depth of 256 exceeded.     (* and many more *)


Solving recursion relations using Mathematica

I want to solve the recursion relation given in equation 2.7(a/b) on page $6$ of this paper. (..the initial seed is $F_1 = G_1 = 1$ and the functions $\alpha$ and $\beta$ are defined on page $5$ in equation $2.4$ on page 5..) Eventually one defines the function $F_n^{(s)}$ and $G_n ^{(s)}$ as given in $2.8a$ and $2.8b$ on page 6..) * * * I am writing down the recursion relation again here, Given $n$ vectors, $q_1,q_2,..,q_n$ we have for the set of functions $F_n$ and $G_n$, $F_n(q_1,q_2,...,q_n) = \sum_{m=1}^{n-1} \frac{G_m(q_1,..,q_m)}{(2n+3)(n-1)}[ (2n+1)\alpha(k,k_1)F_{n-m}(q_{m+1},..,q_n)+2\beta(k,k_1,k_2)G_{n-m}(q_{m+1},..,q_n)] $ $G_n(q_1,q_2,...,q_n) = \sum_{m=1}^{n-1} \frac{G_m(q_1,..,q_m)}{(2n+3)(n-1)}[ 3\alpha(k,k_1)F_{n-m}(q_{m+1},..,q_n)+2n\beta(k,k_1,k_2)G_{n-m}(q_{m+1},..,q_n)] $ where $\alpha(k,k_1) = \frac{k.k_1}{k_1^2}$ and $\beta(k,k_1,k_2)=\frac{k^2(k_1.k_2)}{2k_1^2 k_2^2}$ and $k_1 = \sum_{i=1}^m q_i$ , $k_2 =\sum_{i=m+1}^{n} q_i$ and $k = k_1 + k_2$ (..and the seed of the recursion is $F_1 = G_1 = 1$..) If $\pi$ is the set of permutations of a set of $n$ distinct elements then one defines, $F_n(s) = \frac{1}{n!} \sum_{\pi} F_n (q_{\pi(1)},..,q_{\pi(n)})$ $G_n(s) = \frac{1}{n!} \sum_{\pi} G_n (q_{\pi(1)},..,q_{\pi(n)})$ * * * One can see some example solutions for specific patterns of arguments for say $F_2^{(s)}$ and $F_3^{(s)}$ here in equation A.3 and A.4 on page 19. I can in principle solve this by hand but its quite laborious and its not producing the comparatively more simple looking solutions as in A.3 and A.4 above. I would love to know if there is a way by which this can be automated to produce arbitrarily high order solutions.


Unequal and Compile

(*can compiled*)     Compile[{}, Table[Boole[a == b == c], {a, 3}, {b, 3}, {c, 3}],       CompilationTarget -> "C"][]          (*can compiled*)     Compile[{}, Table[Boole[a != b != c], {a, 3}, {b, 3}, {c, 3}]][]          (*can't compiled*)     Compile[{}, Table[Boole[a != b != c], {a, 3}, {b, 3}, {c, 3}],       CompilationTarget -> "C"][]      ![enter image description here](http://i.stack.imgur.com/8dF5Y.png) Why doesn't the third snippet code compile when I set CompilationTarget -> "C"?


Graphic Timelines in Mathematica in v9 (2014)

I noticed a previous question on this site: how to make graphic timelines in mathematica The question concerned the creation of "graphic timelines" of this form: https://kmcstrategy.usc.edu/files/2013/02/TimeLine_border_year.jpg Where I can enter in some date in some format, e.g. day/month/year = 3/14/15, and then have it display on a timeline bar with indicated months over some range. The question was asked (and answered) on July 14th, 2012, and given the number of graphics updates in Mathematica v8 and v9, I was wondering if there was a more modern way of doing the same thing? Perhaps something built it?


Opening multiple kernels in command line for batch operation

I have been searching around for a while, and perhaps I'm just using the wrong terminology, but I haven't found a way to do this. I have a mathematica notebook converted and saved as nobel_test.m, which runs perfectly on my own computer. Because it takes about an hour to run, I'm trying to run multiple at one time on a computer cluster that can have 100 instances going at once (named nobel). I converted my original notebook by making everything InputForm, ending with Exit[], etc, and changing outputs so that they are saved in external text files instead of printing into the notebook. When I tested this, it ran fine by itself - the script ran, read the correct contents, created and printed the files it needed to, etc. I used the command               math -noprompt -run "<<nobel_test.m"      I also tried               math -noprompt -script "nobel_test.m"      which also works for single cases. However, the banner opens ("The following versions are available...mathematica-8.0.4.." etc.), and while no In[1]:= or anything like that prints, it seems to enter an input-less front end that can't be closed (without quitting the kernel). It automatically closes about an hour later when the notebook finishes evaluating. Because of this, I can only run sequentially, rather than in parallel. I thought -noprompt was supposed to prevent the banner from opening, so that you could just submit job after job to the max of your licenses; but because it opens and holds there, I have to wait until the current job is done before starting a new one. Is there a way to quit that section without closing the kernel, or other good ways to execute several mathematica scripts at once? Again, apologies if this is commonly asked, I'm probably not searching the correct things. Any help would be greatly appreciated!


Problem importing a JCAMP-DX mass spectral file

I have some problems importing a JCAMP-DX EI-mass spectral file using Mathematica 9. For example, if I download the mass spectrum of nonacosane in JCAMP format from NIST, http://webbook.nist.gov/cgi/cbook.cgi?ID=C630035&Mask=200#Mass-Spec using the code               data = Import["http://www.kuleuven.be/bio/ento/temp/nonacosane.dx"];     data     {{{26, 10}, {30, 30}, {41, 2269}, {51, 10}, {55, 2379}, {59, 10}, {67,         289}, {71, 7189}, {80, 20}, {84, 839}, {91, 10}, {96, 269}, {100,         169}, {110, 139}, {114, 149}, {126, 569}, {137, 20}, {141,         1089}, {152, 50}, {156, 129}, {168, 429}, {180, 30}, {184,         119}, {196, 339}, {209, 40}, {213, 10}, {225, 539}, {237,         20}, {241, 10}, {253, 469}, {265, 10}, {269, 10}, {282, 109}, {296,         90}, {310, 99}, {324, 80}, {338, 70}, {352, 70}, {366, 40}, {407,         10}}}      it seems I only get some of the peaks. Apparently, Mathematica is only importing the first pair of each row of XY values in the input file, whose structure is               ##TITLE=Nonacosane     ##JCAMP-DX=4.24     ##DATA TYPE=MASS SPECTRUM     ##ORIGIN=Japan AIST/NIMC Database- Spectrum MS-NW-5944     ##OWNER=NIST Mass Spectrometry Data Center     Collection (C) 2011 copyright by the U.S. Secretary of Commerce     on behalf of the United States of America. All rights reserved.     ##CAS REGISTRY NO=630-03-5     ##$NIST MASS SPEC NO=233118         ##MOLFORM=C29 H60         ##MW=408         ##$NIST SOURCE=MSDC     ##XUNITS=M/Z     ##YUNITS=RELATIVE INTENSITY     ##XFACTOR=1     ##YFACTOR=1     ##FIRSTX=26     ##LASTX=410     ##FIRSTY=10     ##MAXX=410     ##MINX=26     ##MAXY=9999     ##MINY=10     ##NPOINTS=160     ##PEAK TABLE=(XY..XY)     26,10 27,289 28,90 29,1079     30,30 33,10 39,179 40,40     41,2269 42,659 43,6609 44,239     51,10 52,10 53,90 54,249     55,2379 56,1269 57,9999 58,469     59,10 63,10 65,20 66,30     67,289 68,329 69,1659 70,1129     71,7189 72,429 77,10 79,30     80,20 81,139 82,409 83,1459     84,839 85,5279 86,369 87,20     91,10 93,10 94,10 95,90     96,269 97,1189 98,659 99,2149     100,169 101,10 107,10 109,40     110,139 111,649 112,619 113,1599     114,149 123,20 124,99 125,389     126,569 127,1289 128,139 129,10     137,20 138,70 139,219 140,499     141,1089 142,149 143,10 151,10     152,50 153,139 154,449 155,929     156,129 157,10 166,50 167,99     168,429 169,839 170,119 171,10     180,30 181,70 182,379 183,779     184,119 185,10 194,20 195,60     196,339 197,679 198,109 208,20     209,40 210,279 211,589 212,109     213,10 222,20 223,30 224,259     225,539 226,99 227,10 236,10     237,20 238,219 239,489 240,99     241,10 250,10 251,20 252,229     253,469 254,99 255,10 264,10     265,10 266,189 267,419 268,99     269,10 279,10 280,159 281,399     282,109 283,20 294,149 295,369     296,90 297,10 308,119 309,359     310,99 311,10 322,99 323,319     324,80 325,10 336,90 337,289     338,70 339,20 350,60 351,229     352,70 353,10 364,40 365,129     366,40 378,20 379,90 380,20     407,10 408,469 409,159 410,30     ##END=      I was just wondering what would be the best way to get around this, and have this file import correctly? Edit: I was also wondering what is the best way to read both the actual data and any metadata stored in the JCAMP file and then have these exported to a file?


Fitting a variable using multiple equations

I would like to find the best fit of two variables for a number of approximate equations, such as:               1x+2y+2=7.04     2x+y+4=7.98     1.5x+1.5y-2=2.53     1.8x+3y-1=6.77      That should come up with a result: `x = ~1`, `y = ~2` (exact value for whatever the best fit is). I can't find any inspiration in either   * CurveFittingAndApproximateFunctions or    * StatisticalModelAnalysis .  I don't expect anyone to do it for me, but perhaps someone could push me in a correct direction? Thanks in advance, r.


How to get intersection values from a parametric graph?

I have this graphed:               ParametricPlot[{2.4*Cos[t] + 1.6*Cos[3 t/2], 2.4*Sin[t] - 1.6 Sin[3 t/2]}, {t, 0, 4*Pi}]      ![](http://i.stack.imgur.com/vNGDI.png) It is a star, and the lines cross each other twice in the third quadrant. I need to find the t-values at those points. I have tried a variety of methods but none of them seem to be working. I have approximate $(x,y)$ coordinates for the two points as: `{{-0.3054, -0.9543}, {-1.007, -0.005534}}` ## Any help would be appreciated!


Gamma Incomplete Function representation in Mathematica and Matlab

I am confused about Gamma Incomplete function calculation in Mathematica and MatLab: For example, in Mathematica: `Gamma[5,3] = 19.56` But in MatLab: `gammainc(5,3) = 0.8753` I don't know which one is correct, Matlab result or Mathematica result?


Interpolation of mostly-structured 3D data

this question relates to interpolation of 3D data and Improved interpolation of mostly-structured 3d data I have an irregular 3d data set that is quite large (around 70,000 triplets--- let's call it `Data1`). `ListPointPlot3D[Data1]` gives ![list point plot of data](http://i.stack.imgur.com/Ha3QY.jpg) Clearly, the characteristic feature of this set is that its resolution differs vastly from one direction to the other so that main information for the data lies in thirty stripes of $> 2000$ points each. I have issues with creating an interpolation for this dataset for the reasons mentioned in the other two posts so I would like to "normalise" my grid so that this becomes interpolatable. At this stage, I'd be happy to get even linear interpolation along the non- dense direction but running `Interpolation[Data1]` just crashes the Kernel. What I thought of doing was split the strips via `FindClusters`, find the one with the least elements and then reduce the elements of the rest by dropping elements (I can afford to lose some information at the edges) but I don't really know how to implement the right distance in `FindClusters`. The default Euclidean distance obviously doesn't work: the $(x, y)$ coordinates of the set forced to split in thirty clusters gives   `Take[#, 2] & /@ Data1;`   `FindClusters[%, 30];`   `ListPlot[%]`   ![clustered_data](http://i.stack.imgur.com/gvLXc.jpg) So my question is two-fold:     * How to implement the distance that would cluster the data properly?   * Can you think of a better way to regularise the grid so as to be able to interpolate this data set? Here's a link to part of the data. \---- **EDIT** \---- I managed to solve my problem but I'll keep the question open in case anyone would care to improve. For the record, the Non-Grid Interpolation Package looks really good but didn't really help here - I gave up on the Delaunay triangulation after 15' of evaluation time and the nearest neighbour method didn't look all that good. So primarily what I did was I straightened the data set (an answer explains one way to obtain the angle) and then sorted it and split it to clusters by the $ x $-coordinate:                 Rot[x_] := {{Cos[x], Sin[x], 0}, {-Sin[x], Cos[x], 0}, {0, 0, 1}};     RotData = Rot[.10795 Pi].# & /@ Data1;     RotData = SortBy[#, #[[2]] &] & /@ (RotData~GatherBy~(Round[First@#, 165]&)~SortBy~First);      (don't ask how I chose to round to 165!).I then added a missing stripe by averaging:                 Mean@(RotData[[1]] + RotData[[2]]);     RotData = Insert[RotData, %, 2];      Following that, I calculated the domain where all data take values and defined a resolution and step for future reference:               lowlimit = Max@(Min /@ (Map[#[[2]] &, RotData, {2}]));     upplimit = Min@(Max /@ (Map[#[[2]] &, RotData, {2}]));     resolution = 2200;     step = (upplimit - lowlimit)/resolution;      And I finally created interpolating functions along each cluster and ran a loop to get them to evaluate to points on a regular grid. This wouldn't work if I didn't average over the x-coordinate but for this dataset this gives a very small error.               Table[Module[{TempXData, TempInterpData, t},         TempXData = Evaluate@RotData[[j]];         TempInterpData = Drop[#, 1] & /@ TempXData;         t = Interpolation[TempInterpData, Method -> "Spline"];         Table[{Mean@(First /@ TempXData), y, t[y]}, {y, lowlimit,upplimit,step}]], {j, 1, Length[RotData]}];     IntData = Flatten@%~Partition~3;      Now, `IntData` is an interpolatable set:   ![enter image description here](http://i.stack.imgur.com/MVg8h.jpg) So (in the hope this can be useful to someone _OTHER_ than myself) if you run into a dataset you can't interpolate, you might want to think about "striping it", Interpolating the stripes and then using the interpolation to populate a regular grid.


How can I find the sum of the even digits of a number of all elements of a list?

Let $E(n)$ denote the sum of the even digits of $n$. For example, $E(123456789) = 2 + 4 + 6 + 8$. I tried               a = IntegerDigits[123456789]      and               Total[Select[a, EvenQ]]      Now, I want to find the sum $$S= E(1)+ E(2)+\cdots + E(2014).$$ I tried               tab = Table[i, {i, 2014}]      With the 2012-th, I tried               Total[Select[IntegerDigits[tab[[2012]]], EvenQ]]      But, I do not how to find the sum $S$. How can I do it with _Mathematica_?


The second argument of Signature

I've noticed that `Signature` can have an undocumented second argument. What does it do?               Signature[{1,2,3,4}, ?]


Optimization of power tower fractal generator

I tried to optimize the code for generating power tower fractals from here. As the author suggested, I tried to memorize the points already tested in a list. Here is my code :               convlist = {};     convQ[z_, max_] := Module[{list},       If[MemberQ[convlist, z], 1,        list =          Quiet[NestWhileList[N[(z^#)] &, z, Abs[#1 - #2] > 0.01 &, 2, max]];        If[Length[list] < max,         convlist = Union[convlist, list];         1, 0]]]          LaunchKernels[8];     ParallelEvaluate[SetSystemOptions["CatchMachineUnderflow" -> False]];     DistributeDefinitions[convQ];     SetSharedVariable[convlist];          towerFract[xmin_, xmax_, ymin_, ymax_, step_] :=      ArrayPlot[       ParallelTable[        convQ[x + I y, 50], {x, xmin, xmax, step}, {y, ymin, ymax, step}]]          towerFract[-1, 0, -1, 0, 0.01]      However, my code does not seem to work properly :   * the CPU is not used at 100% (whereas in the original version it is)   * I don't have a proper result. I think that it may be related to the `CatchMachineUnderflow` option, or to the `SetSharedVariable` declaration. My questions are :   * How to make my code work properly, and, if possible, efficiently?   * Is there a better way of doing what I am trying to do?


How to work with quarternions in Wolfram Mathematica?

How can I write the insructions from this link http://blog.wolframalpha.com/2011/08/25/quaternion-properties-and-interactive- rotations-with-wolframalpha/ in Mathematica to obtain the same result? Thanks!


Generating an obstacle-avoiding closed-curve with a fixed perimeter and a target area

I was wondering if there was a neat way to solve the following problem in Mathematica v9 - Provided a binarized image (where we call black pixels "obstacles" or vice versa, whichever is most convenient), is there a way to automatically generate a closed-curve with a fixed perimeter length and target amount of enclosed area (or vice versa, a fixed enclosed area and a target perimeter length) that avoids obstacles as well as the edges of the image? For a fun example image, perhaps the automatically generated inkblot ![enter image description here](http://i.stack.imgur.com/19SQ6.png) from J.M.'s answer to How to make an inkblot?, calling black pixels obstacles in this case? I don't have any fantastic ideas for how to do this, and as such my efforts thus far consist mostly of placing a random polytope on the surface of the image, and making sure that no points come within a distance 'd' of the polytope's edges. We first import and process the image as follows:               img = Import["http://i.stack.imgur.com/19SQ6.png"];     img = Binarize[ColorSeparate[img][[1]]]      We can then define a polygon, poli, and use the distance function from this Wolfram demonstration http://demonstrations.wolfram.com/DistanceOfAPointToAPolygon/ to check that the distance from the center of every dark pixel to the polygon is at least some threshold amount. Here's the distance function:               dis[{a_, b_}, p_] := Module[{pz, az, bz, z},     If[a == b, {a, Norm[p - a]},      {pz, az, bz} = Map[First[#] + I Last[#] &, {p, a, b}];       z = (pz - az)/(bz - az);     If[Not[0 <= Re[z] <= 1], d1 = Norm[p - a]; d2 = Norm[p - b];       If[d1 < d2, {a, d1}, {b, d2}],       {a + Re[z] (b - a), Norm[Im[z] (b - a)]}]]];      An example of its usage would be the following:               p = {1, 1};     poli = {{0, 0}, {5, 6}, {1, -1}};          f = Map[dis[#, p] &, Partition[poli, 2, 1, 1]];     {c, d} = First[Sort[f, Last[#1] <= Last[#2] &]];      Where 'd' is the minimum distance from 'p' to 'poli'. This approach is inelegant, to say the least, and I'm having a difficult time coming up with a good procedure to randomly generate polygons with perimeter/area constraints, or to determine the most efficient way to sweep the polygon across the image.


Mathemathica: How to plot diagram?

i want to plot a diagram by this command using mathemathica. but it plotted as a beeline while it must be have a bit aberration.what is my fault in plotting? ![enter image description here](http://i.stack.imgur.com/EYiDc.png) i want to display my diagram such as this.![enter image description here](http://i.stack.imgur.com/T21BX.png)


Define function that counts recursive fibonacci

If I write                    count=0;          fib[0]:=(count=count+1; 0);          fib[1]:=(count=count+1; 1);          fib[n_] := (count = count+1; fib[n-2] + fib[n-1]);      Then I can type for example                    fib[5]      and then                    count      and I can see how many times the "fib" was used to compute fib[5]. How can I write this as a function that gives me this number immediatly? So for example f[n_] := ... ?


Finding the area of a circle using monte carlo simulation

I wrote the following code to find the area of the circle $x^2+y^2=1$ using monte carlo simulation :               McArea[Num_] := Module[{hit, miss, index, x, y},        hit = 0; miss = 0;       For[index = 1, index <= Num, index = index + 1,         x = Random[Real, {-1, 1}];         y = Random[Real, {-1, 1}];         If[y <= Sqrt[1 - x^2], hit = hit + 1, miss = miss + 1];];       Return[(hit/Num) 4];]      `McArea[100]` is around `3.56`, and the larger I make `Num`, the result gets larger, but only a bit. It doesn't seem to be the correct because my output is too far from `3.14`. Is there something wrong with the code?


Cutting bagels into linked halves

I recently came across this video: Mathematically correct breakfast, which shows how a bagel can be neatly sliced into two identical linked halves. ![enter image description here](http://i.stack.imgur.com/YpMqNm.jpg) I'd like to try this with Mathematica. Here's a ~~torus~~ bagel and a ~~Möbius strip~~ cut overlaid. How can I slice the bagel along this cut to create the two halves and pry it open?               With[{opts = {Mesh -> False, Boxed -> False, Axes -> False}},          bagel = ParametricPlot3D[{Cos[t] (3 + Cos[u]), Sin[t] (3 + Cos[u]), Sin[u]},              {t, 0, 2 Pi}, {u, 0, 2 Pi}, opts,              PlotStyle -> Directive[Opacity[0.3], FaceForm[Orange], Lighting -> "Neutral"]];          cut = ParametricPlot3D[{Cos[t] (3 + r Cos[t/2]), Sin[t] (3 + r Cos[t/2]), r Sin[t/2]},              {r, -1, 1}, {t, 0, 2 Pi}, opts,              PlotStyle -> Directive[Opacity[0.9], FaceForm[Gray], Lighting -> "Neutral"]];     ]     bagel ~Show~ cut      ![enter image description here](http://i.stack.imgur.com/yf6Om.png) Although I've used a Möbius strip for the cut, I have a feeling it is a 2-twist strip because of the two sides — I haven't been able to fit this correctly inside a torus...


Front-end issue: Some glyphs not displayed

I have a weird issue, that cropped up recently: If I type `\[UpArrow]` and hit return, the uparrow is not displayed in the output (it is in the input). Changing the format of the output cell (Tried every option) doesn't affect this; copying and pasting to an input cell and it is displayed again. The version of _Mathematica_ is 9.01 on 64-bit Scientific Linux 6.5 and it seems likely that this happened on updating; there are issues with graphics as well (I now need to do "mathematica -mesa" to show 3-D graphics) Opening notebooks that were run on my work computer generates a huge number of failed assertions, all of which seem to be linked to missing glyphs. Anyone seen this before?


How to position legends exactly where I want them?

I just noticed another plot legend question today and while user solutions to this, in particular code by @Jens, are IMO better than the built in solutions, exact positioning often still requires some trial and error. How can I easily position my legends by way of locators?


Gnome wants to kill Mathematica 10 during selection

I am using Linux (CentOS, Gnome 3.8.4) and I suspect this is an OS dependent problem. When I input some text, and use mouse to select the text as follows: First press the mouse left button, keep holding the button while move the mouse to select something, and do not release the button for about 5 seconds (i.e. typical selection process, only hold the button for longer time). Then a window jumps out: ![enter image description here](http://i.stack.imgur.com/Zs2fm.png) I have to press `wait` (if I press `Esc`, Mathematica is killed, without asking me to save anything). I am not sure if it is a bug of Mathematica, or the Linux Gnome side. When using KDE there is no such problem. EDIT: (1) Sounds like my expression is not clear :) Here is screencast: http://youtu.be/YX3hXTfE1aI Note that after selecting the letter a, I didn't release the mouse button. (2) In Mathematica 9, there is no such problem.


Complex valued 2+1D nonlinear PDE using NDSolve

I am trying to follow the main ideas presented in this question, applying it to my own problem, which is a complex, time-dependent, nonlinear PDE: $$i \frac{\partial \psi}{\partial t} = \left[ -\nabla^2 + (|\psi|^2-1) \right] \psi$$ It is supposed to show the evolution of a vortex, so that is what I take as initial condition. The code is organized as follows I work in 2D, on a regular grid from xl to xr and yl to yr, on the time interval [0.,tmax].               xl = yl = -5.;     xr = yr = 5.;     tmax = 2.;      This is the phase of the (complex) initial condition:               ClearAll[ϕ]     ϕ[x_?MachineNumberQ, y_?MachineNumberQ] := ArcTan[x, y]     ϕ[0., 0.] := 0.      Taking the gradient of the phase and plotting it with `StreamDensityPlot`, one can see the winding velocity of the "quantum" fluid. ![currents](http://i.stack.imgur.com/3NLJ2.png) As for the spatial part of the initial condition, I take a Tanh profile, because the density $|\psi|^2$ in the center of the vortex should be 0, and far away it should be 1 (the equation in normalized in that way).               ClearAll[vortex];     vortex[x_?MachineNumberQ, y_?MachineNumberQ] :=      Tanh[4 Norm[{x, y}]] E^(I ϕ[x, y])      Here is the plot of the spatial profile: ![spatial- profile](http://i.stack.imgur.com/KljYq.png) Now for the main part of the code, which uses NDSolve to propagate the initial condition in time, with the appropriate boundary conditions. Finally, the solution is plotted at different instances of time and an animation is created.                sol = ψ /.             First[              NDSolve[                {(-1. + Abs[ψ[x, y, t]]^2)*ψ[x, y, t] - I*Derivative[0, 0, 1][ψ][x, y, t] -                    Derivative[0, 2, 0][ψ][x, y, t] - Derivative[2, 0, 0][ψ][x, y, t] == 0,                    ψ[x, y, 0.] == vortex[x, y],                    ψ[xl, y, t] == 1.,                    ψ[xr, y, t] == 1.,                    ψ[x, yl, t] == 1.,                    ψ[x, yr, t] == 1.                 }, ψ, {x, xl, xr}, {y, yl, yr}, {t, 0., tmax},                  Method -> {"MethodOfLines",                             "DifferentiateBoundaryConditions" -> False,                            "SpatialDiscretization" ->                                  {"TensorProductGrid",                                   "DifferenceOrder" -> 4,                                   "MaxPoints" -> 100,                                   "MinPoints" -> 100,                                   "AccuracyGoal" -> 2,                                   "PrecisionGoal" -> 2}                                 }]]];           Export["evolve.gif", pl, AnimationRepetitions -> Infinity, "DisplayDurations" -> .1]      There are various errors in the output of this code. Apart from the (I hope) benign complaint about the inconsistency of the boundary and initial condition, `NDSolve` simply chokes at t=0.02, complaining about convergency issues. I have tried playing with the parameters, but I have not found any way of circumventing this issue.


Simplify an expression under certain condition

I have a variable A = g / (1 + g R) Actually, if the quantity (g R) >> 1 it is possible to write A as A ≈ 1/R. How can I do this in Mathematica? I tried with Assumptions, Refine, Simplify, but i can get the simplified form. Thanks


Reap and Sow From NDSolve solution

I want to get the answer of my `NDSolve` in the form of table (the value of each `x` and `y`). Let's say that I want to copy this result into the excel or microsoft word and then put it in the appendix or make a chart from it. I tried to use `Reap` and `Sow` function in order to do this.               s = NDSolve[{y'[x] == y[x] Cos[x + y[x]], y[0] == 1}, y, {x, 0, 30}]     Reap[Sow[s,{x,0,30}]      However, instead of giving me a number `(x,y)`, it gives me an interpolation function. Anyone has an idea how to get `x` and `y` from this type of equation?


Sum of Multinomial Coefficients

Basically, I want to write a function to compute the following sum $f(m,L):=\sum_{0\leq k_1,\cdots, k_n\leq m} \binom{m}{k_1,k_2,\cdots k_n}$ and $\mathrm{supp}(k)=L \subseteq \left \\{ 1,...,n \right \\}$ I wrote the following function but it doesn't work:               L = {1, 2, 4, 5};     f[m, L] := Return[For[i = 1, i <= m, i++, Total[Multinomial@@Take[L, i]]]];     f[3, L]     (*f[3, {1, 2, 4, 5}]*)      What am I missing? Thank you EDIT: I added a condition to the indices $k$, which I forgot to mention earlier. $\mathrm{supp}(k)=L$ means that $L$ is the set of indices such that the components of the vector $k=(k_1,...,k_n)$ are nonzero.


multiple generators for iterative construction of fractal

The code below is an attempt to use more than one generator (in this case two) to generate a fractal using the standard iterative procedure involving generators. Only the first two stages of the construction are included. Ideally, for each line segment one of the two generators would be applied selected at random. This would be similar to Mandelbrot's stock chart cartoons including what he called shuffling. An y help with streamlining the code would be aoppreciated                {a1, b1} = {.3, .6}; {a2, b2} = {.7, .2};     {c1, d1} = {.2, .7}; {c2, d2} = {.6, .3};     Clear[y1, f1, g1, h1, i1, j1, k1];     Clear[y2, f2, g2, h2, i2, j2, k2];     y0[x_] := x;     If[RandomInteger[] == 1,      f1[x_] := b1*y0[x*1/a1];      g1[x_] := (b2 - b1)*y0[(x - a1)/(a2 - a1)] + b1;      h1[x_] := (1 - b2)*y0[(x - a2)/(1 - a2)] + b2;      y1[x_] /; 0 <= x < a1 := f1[x];      y1[x_] /; a1 <= x < a2 := g1[x];      y1[x_] := h1[x],           i1[x_] := d1*y0[x*1/c1];      j1[x_] := (d2 - d1)*y0[(x - c1)/(c2 - c1)] + d1;      k1[x_] := (1 - d2)*y0[(x - c2)/(1 - c2)] + d2;      y1[x_] /; 0 <= x < c1 := i1[x];      y1[x_] /; c1 <= x < c2 := j1[x];      y1[x_] := k1[x]]               If[RandomInteger[] == 1,      f2[x_] := b1*y1[x*1/a1];      g2[x_] := (b2 - b1)*y1[(x - a1)/(a2 - a1)] + b1;      h2[x_] := (1 - b2)*y1[(x - a2)/(1 - a2)] + b2;      y2[x_] /; 0 <= x < a1 := f2[x];      y2[x_] /; a1 <= x < a2 := g2[x];      y2[x_] := h2[x],           i2[x_] := d1*y1[x*1/c1];      j2[x_] := (d2 - d1)*y1[(x - c1)/(c2 - c1)] + d1;      k2[x_] := (1 - d2)*y1[(x - c2)/(1 - c2)] + d2;      y2[x_] /; 0 <= x < c1 := i2[x];      y2[x_] /; c1 <= x < c2 := j2[x];      y2[x_] := k2[x]]          Plot[y1[x], {x, 0, 1}, PlotRange -> {{0, 1}, {0, 1}}]     Plot[y2[x], {x, 0, 1}, PlotRange -> {{0, 1}, {0, 1}}]


Solving a diffusion equation

I need to solve a particular diffusion equation with NO boundaries http://astronomy.nju.edu.cn/~chenpf/c/courses/fluid/pringle81.pdf equation (2.10) with `nu = cost`. I use this code to simplify the equation:               pde = D[s[x, t], t] == (3/2)*D[s[x, t], x] + (3/4)*x^-2*D[s[x, t], {x, 2}] - 1/(4*x);     mu = 0.5;     sigma = 0.05;      and to solve the equation (which by choosing `nu = cost` becomes a linear diffusion partial equation) I use this:                sol =        DSolve[{pde, s[x, 0] == Exp[-(x - mu)^2/(2*sigma^2)]/Sqrt[2*Pi*sigma^2]}, s[x, t], {x, t}]      with a particular choice of the initial function (a gaussian function). But when I try               Plot3D[s[x, t] /. sol, {x, 0, 1}, {y, 0, Automatic}]      to plot the results, which should reproduce Figure 1 in the paper above, I get a lot of errors and I don't understand why.


Solving a simple BVP

I'm new to mathematica and am interested in solving the following BVP: $\epsilon \,y'' + 2 y' + y^3 = 0$, for $0 < x < 1$ and $y(0) = 0, y(1) = 1/2$. I have no experience with coding, so although I have read through the _Mathematica_ documentation, I'm still a bit confused as to how to do this. I think I understand `DSolve`, but what does that actually give me, and how do i plot it?


Plotting data with 4 columns!

I'd like 3Dplot a list of data with `4` columns (these are mesh outputs):               x1 y1 z1 Dose1     x2 y2 z2 Dose2     .     .     .      which command i should to use??


Quick Hessian matrix and gradient calculation?

I am absolutely new to Mathematica and I actually want to try implementing a little optimization method . Long story short assuming I have a predefined two-variable function f(x,y) I want to calculate a Hessian matrix and a gradient symbolically. Then I want to be able to quickly plug specific x,y values into them. How is it done in Mathematica?


How to augment the realm of functions Mathematica thinks it knows how to integrate symbolically

My question involves extending the functionality of `Integrate` over specific integrals in the most generic manner. Specifically, is it possible to "hack into" `Integrate` so as a to add to the "grammar" of analytic integration a new family of integrals which the user would have provided (in the spirit of `ProbabilityDistribution` which allows the user to include his own PDF into the existing tools). The idea is that Mathematica would be able to identify when such integrals pop up and replace it by the given definition. The specific example I have in mind involves the integral of `MultinormalDistribution` over square subregions of the integration domain. That is to say I would like to attach to either `MultiNormalDistribution`, or `Expectation`, (or `Integrate`) the following rule               Expectation[Boole[(x>a)&&(y>b)], {x,y} ~Distributed~         MultinormalDistribution[{0,0},{{1,c},{c,1}}]] = FF[a,b,c]      (where `FF` is a given function of `a`, `b`, and `c` which could be tabulated). @JM suggested using `TagSet` or `TagSetDelayed`, but the difficulty is to decide to which function it should be associated with, and with what efficiency, given that it would be unwise to temper with build in symbols like `Integrate`? **Attempt** As a simpler toy problem I tried               Unprotect[Integrate];      Integrate /: Integrate[f[x], {x, a_, b_}] = F[a, b]      Protect[Integrate];      for which `Integrate[f[x],{x,1,2}]` returns `F[1,2]` But for instance `Integrate[2 f[x], {x, 1, 2}]` is not evaluated, which suggests that my new (possibly admittedly dangerous) definition has not been taken as a global rule for integration. More relevantly, I tried               Unprotect[Expectation];     Expectation[ Boole[x_ > a_ && y_ > b_], {x_, y_}~Distributed~         MultinormalDistribution[{0, 0}, {{1, c_}, {c_, 1}}]] = FF[a, b, c]     Protect[Expectation];      so that               Expectation[       Boole[x > 1 && y > 2], {x, y}~Distributed~       MultinormalDistribution[{0, 0}, {{1, 1/3}, {1/3, 1}}]]       returns `FF[1,2,1/3]` (after a short while). **Questions**   1. What is the best way to write down the definition? Assign it to `MultinormalDistribution`, `Expectation`, `Integrate`?   2. How to make sure it is "integrated" by Mathematica so that when attempting, e.g. to compute the expectation of `d*Boole[x>a && y>b]` it would return `d*FF[a,b,c]` (or the expectation of `u+Boole[x>a && y>b]` the Expectation of `u + FF[a,b,c]`)? More specifically, how to make sure Mathematica tries to transform a given integral into a form which could match the new definition?


Black line after ImageTrim

as shown in Image correlation I would like to detect the shift between a stack of images. Here are the images: ![image 1](http://i.stack.imgur.com/r2QWw.png) ![image 2](http://i.stack.imgur.com/3NbR9.png) and here the code:               {i1, i2} = {Import["http://i.stack.imgur.com/r2QWw.png"],       Import["http://i.stack.imgur.com/3NbR9.png"]}     ch = ChanVeseBinarize /@ {i1, i2};     dsc = FillingTransform /@ (DeleteSmallComponents[#, 5] & /@ {ch[[1]],        ColorNegate[ch[[2]]]});     pts = ImageCorrespondingPoints[dsc[[1]], dsc[[2]]];     f = FindGeometricTransform[pts[[1]], pts[[2]],      "Transformation" -> "Translation", Method -> "RANSAC"]     GraphicsGrid@{{i1,      ImagePerspectiveTransformation[i2, f[[2]], DataRange -> Full]}}      Unfortunately, applying `ImageTrim` leaves a black line at the edge:               ImageTrim[      ImagePerspectiveTransformation[i2, f[[2]],       DataRange -> Full], {{f[[2, 1, 1, 3]],       f[[2, 1, 2, 3]]}, {ImageDimensions[i1][[1]],       ImageDimensions[i1][[2]]}}]      ![trimmed](http://i.stack.imgur.com/WcIj9.png) Does anybody knows a solution for this problem?


Create complicated text formulas in graphics

I want to put somewhat complicated, or at least non-standardly formatted, text on some of my graphics. For example, I'd like to be able to use `f^[4](x)` (where the `^[4]` should obviously be a superscript rather than `f^(4)[x]` for the fourth derivative as a plot label. I'd like to control the formatting of various mathematical objects (for example, I'd like `x^2+x+1` to be written that way rather than as `1+x+x^2`), and the like. The only way I've found for doing this is actually building up the string using StyleBox'es, which is both time-consuming and ugly. Am I missing something?


Math text is reversed using Graphics3D

I'm trying to display the text $y+\tau\theta$ using the following graphics directive inside a Show[] with several other graphics objects:               Graphics3D[{FontSize -> 28, Text[y + \[Tau]\[Theta], {1, 0.1, .5}]}]      However, the displayed text is shown as $\tau\theta+y$ instead of $y+\tau\theta$. This isn't a huge deal, but I'm trying to keep my notation consistent. If I enclose the text in quotes, it displays it in the correct order but in "text" font instead of "math" font. Any suggestions? I'm using version 8, if it makes a difference.


Use TeX in Graphics object

Graphics[Text[Style["Sqrt[a^2-b^2]", FontSize->25], {0,0}]]       yields: ![enter image description here](http://i.stack.imgur.com/paAeU.png) but I want the nicer looking $\sqrt{a^2-b^2}$ instead of the ugly "Sqrt[a^2-b^2]". How?


Rendering polygon as graph with directed edges in Mathematica

In Mathematica I'm trying to render a polygon as a set of vertices and directed edges. What I have so far:               Graphics[Polygon[{{1, 10}, {2, 4}, {10, 5}, {20, 10}}]]      I see Mathematica has the `Graph` and `PathGraph` commands - both of which have a `DirectedEdges` option - but it seems like I have no control over the position of the vertices with these commands. If I could customize the fill and edge/stroke of the `Polygon` command, that would be acceptable - but I'm not seeing how to do it. It looks like this command is specifically meant to draw filled polygons. I'd also be OK with a custom Mathematica routine to draw what I want using a loop and multiple `Line` commands within a `Graphics` command - but I can't see how to draw the lines as arrows (I'm sure I could make the routine do this with _three_ `Line`s per edge, but I really just think I'm missing something here.)


Retain original form of formatted equation

I am having trouble getting Mathematica to retain my original equation form. For example: ![enter image description here](http://i.stack.imgur.com/LHhw9.jpg) As you can see, even though I use HoldForm, it still changes the style of my equation. Very frustrating.


How to plot Error Bars in a 3D scatter plot

This is a simple problem which is proving difficult to solve. I want to plot error bars on points in a 3D scatter graph. I plot error bars on points within a 2D scatter by:               ErrorListPlot[{{{x1_,y1_},ErrorBar[x1_err,y1_err]},{x2_,y2_},ErrorBar[x2err_,y2err_]}}]      I can plot 3D point data by:               ListPointPlot3D[{{x1_,y1_,z1_},{x2_,y2_,z2_}}]      However, the `ErrorBar` function doesn't seem to work in 3D (have tried `ErrorBar3D` and variations of). Any suggestions much appreciated!


Animate a sequence of bitmap-like data Mathematica 9.0.0

I am new to Mathematica, but already find it a very nice tool. Right now I am trying to create an animation of numeric data, where each frame corresponds to a distinct text file with a table-like content. With one static frame (file) I can do the following:               file = "Desktop/d1.txt"     data = Import[file, "Table"]     ArrayPlot[data]      Now, with multiple frames (files) I have to somehow animate a list of 2D lists, e.g.:               files = { "Desktop/d1.txt", "Desktop/d2.txt", "Desktop/d3.txt" }     data = Map[Import[#] &, files]      ListAnimate is said to accept a list:               ListAnimate[data]      ,but it does not display the bitmap and shows a box with an advancing position bar and text representation of the data[[1]] . I would like to playback all the files' content as consecutive bitmaps. Should I somehow rearrange my 2D lists and/or may be ListAnimate is the wrong function for that task and I should use something else?


How to choose MaxStepFraction for optimal speed of NDSolve

I'm trying to use `NDSolve` to solve a 1D Schrodinger's equation, and it seems that `MaxStepFraction` has huge effect on the performance.               L = 5; Et[t_] := Cos[2 t];        eqn = I D[ψ[x, t], t] == -(1/2) (D[ψ[x, t], {x, 2}]) + Et[t]*x*ψ[x, t]     init = {ψ[x, 0] == Exp[-(4 x^2)], ψ[L, t] == ψ[-L, t]}          sol = NDSolve[{eqn}~Join~init, ψ, {x, -L, L}, {t, 0, 6}, MaxStepFraction -> 1/2000]; // AbsoluteTiming      Here are the timing information I get:               MaxStepFraction |time(second)|     ----------------+------------+     1/1800          |not converge|      1/2000          | 4.5        |      1/2500          | 98.5       |      1/3000          | 9.1        |       For not converge, I mean it gives warning like: > NDSolve::eerr: Warning: scaled local spatial error estimate of > 640.1602231577178`at t = 4.504519571558874` in the direction of independent > variable x is much greater than the prescribed error tolerance. Grid spacing > with 1801 points may be too large to achieve the desired accuracy or > precision. A singularity may have formed or a smaller grid spacing can be > specified using the MaxStepSize or MinPoints method options. >> If we slightly change L, and let `L=7.5`, the performance is quit different:               MaxStepFraction |time(second)|     ----------------+------------+     1/1800          |not converge|      1/2000          | 64         |      1/2500          |not converge|      1/3000          | 136        |      **Questions** :   1. Why the value of MaxStepFraction affect the performance so dramatically? For example, sometimes converge very fast, and sometimes doesn't converge at all.    2. Are there some guide lines for choose the the value of MaxStepFraction for optimal performance?   3. General guide lines for better performance of NDSolve for PDEs (or should I leave NDSolve and build my own solver)?  PS: I'm using version 9 on Red Hat Enterprise Linux 6, on Intel(R) Xeon(R) CPU E5-2670 0 @ 2.60GHz.


Integral too slow and with conditionals

When I try to solve this integral: $$\int_{-a}^a \frac{x}{\left(x^2+y^2\right)^{3/2}} \, dy$$ it's return               ConditionalExpression[(2 a)/(x Sqrt[a^2 + x^2]),        Im[x]^2 <=          Re[x]^2 && (Im[x/a] > 1 || Im[x/a] < -1 ||           Re[x/a] !=            0) && (Sqrt[-((Im[x] Re[x])/(Im[a] Re[a]))] ∉            Reals ||           Im[x] (Im[x] + (Re[a] Re[x])/Im[a]) <=            Re[x] ((Im[a] Im[x])/Re[a] + Re[x]) ||           Re[Sqrt[-((Im[x] Re[x])/(Im[a] Re[a]))]] >= 1)]      and takes _37s_ to solve! Is there any particular reason? Is there a way to obtain only the `[[1]]` part ?


EventLocator with LSODA?

Is the `EventLocator` option not compatible with `LSODA` on `NDSolve`. Below is what I tried to do to arrest my simulation if the time step went below a certain value (based on this suggestion). **The script file is alsoattached.** The error messages that I get are: How should I go about it so that I can use `EventLocator` with `LSODA`. The reason I am doing this is because my equation turns stiff and the last half of the time steps are extremely small, slow and unnecessary for me. > >     NDSolve::moptx: Method option Method in {NDSolve`LSODA, >     MaxDifferenceOrder -> 12, Method -> {EventLocator, Event :> >     If[stepsize < 10  , 0, 1]}}} is not one of {LinearSolveMethod, >     MaxDifferenceOrder}. >   >     NDSolve::initf: The initialization of the method NDSolve`LSODA failed. >                 #!/usr/local/bin/MathematicaScript -script          $HistoryLength=0;         $pwf=$InputFileName;     Needs["VectorAnalysis`"]     Needs["DifferentialEquations`InterpolatingFunctionAnatomy`"];     Clear[Eq0,EvapThickFilm,h,Bo,\[Epsilon],K1,\[Delta],Bi,m,r]     Eq0[h_,{Bo_,\[Epsilon]_,K1_,\[Delta]_,Bi_,m_,r_}]:=\!\(     \*SubscriptBox[\(\[PartialD]\), \(t\)]h\)+Div[-h^3 Bo Grad[h]+h^3 Grad[Laplacian[h]]+(\[Delta] h^3)/(Bi h+K1)^3 Grad[h]+m (h/(K1+Bi h))^2 Grad[h]]+\[Epsilon]/(Bi h+K1) + (r)D[D[(h^2/(K1+Bi h)),x] h^3,x] ==0;     SetCoordinates[Cartesian[x,y,z]];     EvapThickFilm[Bo_,\[Epsilon]_,K1_,\[Delta]_,Bi_,m_,r_]:=Eq0[h[x,y,t],{Bo,\[Epsilon],K1,\[Delta],Bi,m,r}];     TraditionalForm[EvapThickFilm[Bo,\[Epsilon],K1,\[Delta],Bi,m,r]];               L=79.5788; TMax=12500*100;     Off[NDSolve::mxsst];     Clear[Kvar];     Kvar[t_]:=  Piecewise[{{1,t<=1},{2,t>1}}]     (*Ktemp = Array[0.001+0.001#^2&,13]*)     hSol=h/.NDSolve[{     (*Bo,\[Epsilon],K1,\[Delta],Bi,m,r*)          EvapThickFilm[0,1*10^-6,1,0.001,1,2*0.025,0],     h[0,y,t]==h[L,y,t],     h[x,0,t]==h[x,L,t],     (*h[x,y,0] == 1.1+Cos[x] Sin[2y] *)     h[x,y,0]==1+(-0.05 Cos[2\[Pi] x/L] -0.05 Sin[2 \[Pi] x/L])(Cos[2\[Pi] y/L])     },     h,     {x, 0, L},     {y,0, L},     {t, 0, TMax},               StepMonitor :> (            laststep = thisstep; thisstep = t;             stepsize = thisstep - laststep;            ),               Method->{"LSODA","MaxDifferenceOrder"->12, Method -> {"EventLocator",               "Event" :> (If[stepsize < 10^-4, 0, 1])} },     MaxStepFraction->1/50,     PrecisionGoal->3     ][[1]]                         {TMin,TRup}=InterpolatingFunctionDomain[hSol][[3]];     hSolGridData=InterpolatingFunctionValuesOnGrid[hSol];     hSolCoords=InterpolatingFunctionCoordinates[hSol];     finalStep=InterpolatingFunctionCoordinates[hSol][[3]];     (*rupture=NumberForm[N[TRup/100],6];*)     rupture=TRup/100;          $parameterfile=StringJoin[$pwf,".dat"];     Export[$parameterfile, {0, 100, 0, 0.0001, 35.1, 7.02, 0, 3, 1, 5, SetPrecision[rupture,5]}];         $matfile=StringJoin[$pwf,".mat"];         Export[$matfile,hSolGridData];     (*Exports time step data*)     $timefile=StringJoin[$pwf,"_time",".mat"];     Export[$timefile,InterpolatingFunctionCoordinates[hSol][[3]]];          hGrid = InterpolatingFunctionGrid[hSol];     {TMin,TRup}=InterpolatingFunctionDomain[hSol][[3]];     Length[hGrid];     {nX,nY,nT}=Drop[Dimensions[hGrid],-1];          fac=0.98;               $epsfile0=StringJoin[$pwf,"_0",".eps"];     $pngfile0=StringJoin[$pwf,"_0",".png"];     $epsfileRup=StringJoin[$pwf,"_TRup",".eps"];     $pngfileRup=StringJoin[$pwf,"_TRup",".png"];     ic=Plot3D[hSol[x,y,0*TRup],{x,0,L},{y, 0, L},          PlotRange->{{0,L},{0,L},{0,3.5}},     BaseStyle->{FontWeight->"Plain",FontSize->18},     PlotPoints->65,     ColorFunction->GrayLevel     ];     Export[$epsfile0,ic,ImageSize->{350,350}];         Export[$pngfile0,ic,ImageResolution->350];     rupProfile=Plot3D[hSol[x,y,fac*TRup],{x,0,L},{y, 0, L},          PlotRange->{{0,L},{0,L},{0,3.5}},     BaseStyle->{FontWeight->"Plain",FontSize->18},     PlotPoints->65,     ColorFunction->GrayLevel     ];     Export[$epsfileRup,rupProfile,ImageSize->{350,350}];         Export[$pngfileRup,rupProfile,ImageResolution->350];          dataxy=Import[$matfile];         datat=Import[$timefile];               (*$epsfile0=StringJoin[$pwf,"_0_dft",".eps"];     $pngfile0=StringJoin[$pwf,"_0_dft",".png"];     $epsfileRup=StringJoin[$pwf,"_TRup_dft",".eps"];     $pngfileRup=StringJoin[$pwf,"_TRup_dft",".png"];     FDataFirst=Abs[Fourier[dataxy[[All,All,1]]]];     dftfirst=MatrixPlot[FDataFirst]*)


help with StringJoin

dollarWon := 100     "(" <> Style["$" <> ToString[dollarWon], If[dollarWon >= 0, Darker[Green], Red]] <> ")"      I am getting an error: String expected at position 2. Isn't it possible to use Style in the above expression? Thanks.


How to highlight a string pattern?

This is an example in the help pages (Working with patterns: Highlight Patterns):                   SeedRandom[12345];         dna=StringJoin[Table[{"a","c","t"}[[RandomInteger[{1,3}]]],{50}]]              StringReplace[dna,x:("a"~~_~~"a"):>"\!\(\*StyleBox[\""<>x<>"\",     FontColor->RGBColor[1,0,0],FontSize->18,FontWeight->\"Bold\"]\)"]      > >     "\!\(\*StyleBox[\"aca\",\n > FontColor->RGBColor[1,FontWeight->\"Bold\"]\)atccttttattactcccacccatcccatc\!\(\*StyleBox[\"ata\",\n > FontColor->RGBColor[1,0,0],FontSize->18,FontWeight->\"Bold\"]\)ctatcttctct\!\(\*StyleBox[\"ata\",\n > FontColor->RGBColor[1,0,0],FontSize->18,FontWeight->\"Bold\"]\)t"   >   > > ![screen grab](http://i.stack.imgur.com/Pa3df.png) # How to highlight the black part of the DNA with a pattern# (any professional name)? **Method 1: not perfect, some problem see appendix I**               rules=MapThread[RuleDelayed,{StringSplit[dna,x:("ag"~~_~~_~~"t"~~_~~"ca")],Style[#,Red]&/@StringSplit[dna,x:("ag"~~_~~_~~"t"~~_~~"ca")]}];     StringReplace[dna,rules]      > > > acttaagctttcgggtgagtgtactgcccactcctagctttcctttagttcttagacgagctggcgcgtagatggctacgtgacttgaatgcattagtgtctagatgcattatggaaccattccaatcgtctcggagggctagtgctgccatcttggttatgtggtatcgtgatttgaatcagtccagcgctataaagtcttcgctgtt~~aggctgca~~ggagccgagggcatcggacgtacaaaatgcgggggtagactgacgaccgcagaggccacatacgacaggccgccggcgtgcgactagatagccgcgagtggggttggctaagcacatcga~~agtgtaca~~gaaaacccctaccccatgagtcgtgcagacgcctccagaaaccagg~~agtttaca~~gcaggacctgagaactaatgttaatgctccatcacctctgcatgcctatccattaagcaaggcacactcagcccctaaaagcgagcggctccccaggagaa >   ![enter image description here](http://i.stack.imgur.com/ngi1g.png) **[update1]** sub question 1: How to remove the StringExpression (~~) to improve it? thanks for rm and Silva's tips, [this is solved]. * _[unsolved-main problem]_ *sub Question 2: How to achieve the effect in a better way without appendix I's problem? my first thought is to use _Except_ ,but failed Following are the CellPrint effects:                CellPrint@TextCell[Row[List@@StringReplace[dna,rules],""],"Text"]      > > > "acttaagctttcgggtgagtgtactgcccactcctagctttcctttagttcttagacgagctggcgcgtagatggctacgtgacttgaatgcattagtgtctagatgcattatggaaccattccaatcgtctcggagggctagtgctgccatcttggttatgtggtatcgtgatttgaatcagtccagcgctataaagtcttcgctgtt""aggctgca""ggagccgagggcatcggacgtacaaaatgcgggggtagactgacgaccgcagaggccacatacgacaggccgccggcgtgcgactagatagccgcgagtggggttggctaagcacatcga""agtgtaca""gaaaacccctaccccatgagtcgtgcagacgcctccagaaaccagg""agtttaca""gcaggacctgagaactaatgttaatgctccatcacctctgcatgcctatccattaagcaaggcacactcagcccctaaaagcgagcggctccccaggagaa" >   # Appendix I When I'm trying golden's suggest to shorten my example, @m_goldberg > >        SeedRandom[12345]; >         dna = StringJoin[Table[{"a", "c", "t"}[[RandomInteger[{1, 3}]]], > {50}]] > > rules=MapThread[RuleDelayed,{StringSplit[dna,x:("a"~~_~~"a")],Style[#,Red] > &/@StringSplit[dna,x:("a"~~_~~"a")]}]; >         StringReplace[dna,rules] >   ![enter image description here](http://i.stack.imgur.com/MCSRC.png)


FourierSeries for rational function looks wrong

I have the following code:               ser[x_] = FourierSeries[(\[Pi]^2 + a)/(3 x^2 + a), x, 10] // N // Chop      It gives me some series, which I then try to plot. And surprisingly, the result isn't even similar to the function I passed to `FourierSeries[]`: for comparison, I've used this code:               Plot[{ser[x], 1000 (\[Pi]^2 + a)/(3 x^2 + a)}, {x, -\[Pi], \[Pi]}]      ![output](http://i.stack.imgur.com/2Mntb.png) Fourier transform for function given in documentation works correctly, while for this one doesn't. I've tried using directly the formula given in documentation as default formula (used `NIntegrate[]`), and that gives me expected results.   What have I done wrong? Is this a bug? _Addition to answer comments:_ ![some more code](http://i.stack.imgur.com/WrPSL.png) As one can see, the Fourier coefficients computed via `NIntegrate[]` are _quite_ different from ones generated by `FourierCoefficient[]`. _Update:_   As pointed in comments, setting `GenerateConditions->True` appears to yield correct result, not generating any conditions though. Why should this be needed?


Checking if an expression is equal to zero

I have 6 points in $\mathbb R^3$ as follows:               points = {         {Log[1 + a/n], Log[1 + b/(a + n)], Log[1 + c/(a + b + n)]},          {Log[1 + a/n], Log[1 + b/(a + c + n)], Log[1 + c/(a + n)]},          {Log[1 + a/(b + n)], Log[1 + b/n], Log[1 + c/(a + b + n)]},          {Log[1 + a/(b + c + n)], Log[1 + b/n], Log[1 + c/(b + n)]},          {Log[1 + a/(c + n)], Log[1 + b/(a + c + n)], Log[1 + c/n]},         {Log[1 + a/(b + c + n)], Log[1 + b/(c + n)], Log[1 + c/n]}     }      where $a$, $b$, $c$ and $n$ are all positive numbers. I want to test if they all lie on the same plane. We know that if $P,Q,R$ and $S$ are on the same plane, then $\overrightarrow{PS} \cdot (\overrightarrow{PR} \times \overrightarrow{PQ}) = 0$. The issue is than I cannot simplify the following expression:               FullSimplify[         (points[[1]] - points[[6]]).CrossProduct[points[[2]] - points[[6]], points[[3]] - points[[6]]],           a > 0 && b > 0 && c > 0 && n > 0     ]      to zero. While numerical evaluation of the same expression (for any value of $a, b, c$ and $n$) results in numbers very close to zero.               Table[        (points[[i]] - points[[1]]).CrossProduct[points[[2]] - points[[1]], points[[3]] - points[[1]]],        {i, 4, 6}     ] /. {a -> 10, b -> 11, c -> 13, n -> 1} // N          (* Output: {-2.22045*10^-16, -2.22045*10^-16, -4.44089*10^-16} *)      That's why I guess they must lie on the same plane. How can I simplify the expression? **Edit:** Thanks to `Michael E2`'s answer, I was able to solve a more general form of the problem for more than 6 points. Here is a related question I asked on `math.SE`. I used the following piece of code to generate the points and verify my guess:               m[X_, P_] := Table[Log[1 + X[[i]]/(1 + Sum[If[P[[j]] < P[[i]], X[[j]], 0], {j, Length[X]}])], {i, Length[X]}];     With[{n = 3},        points = m[Subscript[x, #] & /@ Range[n], #] & /@ Permutations[Range[n]];        MatrixRank[Simplify[# - points[[1]] & /@ points, And @@ (Subscript[x, #] & /@ Range[n])], ZeroTest -> (Expand@PowerExpand@# == 0 &)]     ]


How do I exclude the vertical line plotted at a discontinuity?

Condsider               function = Tan[1 x] + Tan[2 x]     Plot[function, {x, 0, 1.5}]      ![enter image description here](http://i.stack.imgur.com/AxM3L.png) It has a strong discontinuity around 0.8. The problem is , if I want to find `function==0`, Mathematica will not only find the real root `x~1.1` , but also a artifact root `x~0.8` Because I think Mathematica created a line around the discontinuity. A single point the has its y value of all values, which I call "a point that is every point". To make this obvious, let me make a Contour Plot:               ContourPlot[function + 2*y == 0, {x, 0, 1.5}, {y, 0, 1.5}, PlotPoints -> 100]      ![enter image description here](http://i.stack.imgur.com/cQMf0.png) We know that only curved line represents real roots. The constant line is the artifact. In fact, if you plot contour for `function + 2*y == 1` or `function + 2*y == 2`, this artifact line remains. Of course, since it is a point that is every point:               ContourPlot[function + 2*y == 1, {x, 0, 1.5}, {y, 0, 1.5}, PlotPoints -> 100]     ContourPlot[function + 2*y == 2, {x, 0, 1.5}, {y, 0, 1.5}, PlotPoints -> 100]      ![enter image description here](http://i.stack.imgur.com/7CWfd.png) ![enter image description here](http://i.stack.imgur.com/Uzfzm.png) So, how to solve the problem in Contour Plot if function to plot has a strong discontinuity that Mathematica tries wrongly (hard) to connect.


Interpolation and points of non-differentiability

I have some data, which if expressed by some elementary functions, would contain a non-differentiable point. I would like to be able to use something like interpolate to convert the data into a function and then differentiate it but somehow still preserve the non-differentiability property at that point. MWE               list = Table[{j, Max[5, j]}, {j, 0, 15, 1}]          {{0, 5}, {1, 5}, {2, 5}, {3, 5}, {4, 5}, {5, 5}, {6, 6}, {7, 7}, {8,        8}, {9, 9}, {10, 10}, {11, 11}, {12, 12}, {13, 13}, {14, 14}, {15,        15}}      My data comes from a continuous function which is not differentiable at $x=5$.               fint = Interpolation[list]          dfint[x_] = D[fint[x], x]          Plot[dfint[x], {x, 0, 15}, AxesOrigin -> {0, -1}]      The Derivative looks like this: ![enter image description here](http://i.stack.imgur.com/69CjV.jpg) Instead of like this: ![enter image description here](http://i.stack.imgur.com/kM0KW.jpg) **Update 12:38 AM May 22:**               lista = DeleteCases[list, a_ /; a[[1]] >= 6]     listb = DeleteCases[list, a_ /; a[[1]] <= 4]          {{0, 5}, {1, 5}, {2, 5}, {3, 5}, {4, 5}, {5, 5}}          {{5, 5}, {6, 6}, {7, 7}, {8, 8}, {9, 9}, {10, 10}, {11, 11}, {12,        12}, {13, 13}, {14, 14}, {15, 15}}          ga = Interpolation[lista]     gb = Interpolation[listb]          dga[x_] = D[ga[x], x]     dgb[x_] = D[gb[x], x]          g[x_] = Piecewise[{{ga[x], x <= 5}, {gb[x], x > 5}}]          dg[x_] = Piecewise[{{dga[x], x < 5}, {dgb[x], x > 5}}]      Doing this               Plot[dg[x], {x, 0, 15}, AxesOrigin -> {0, -1}]      gives ![enter image description here](http://i.stack.imgur.com/DqFpa.jpg) However               dg[5]          0      I guess I need to get this to be indeterminate.


How to do assignments through MathLink?

In Mathematica I can make the assignment 'foo = bar' with Set[foo,bar]. However, if I try to evaluate 'Set[foo,bar]' through MathLink then it appears that MathLink gets stuck while trying to read additional information from the link. Here's a small sample program, "myassignment.tm" :               void myAssignment P(( ));          :Begin:              :Function:  myAssignment     :Pattern:   myAssignment[ ]     :Arguments: { }     :ArgumentTypes: { }     :ReturnType:    Manual     :End:          #include "mathlink.h"     #include <stdio.h>          void myAssignment()      {        MLPutFunction( stdlink, "EvaluatePacket", 1 );         MLPutFunction( stdlink, "Set", 2 );           MLPutSymbol( stdlink, "foo" );            MLPutSymbol( stdlink, "bar" );        MLEndPacket( stdlink );       MLNextPacket( stdlink ); /* Get return packet */       MLNewPacket( stdlink ); /* Discard return value, which is simply 'bar' */      }          int main(int argc, char *argv[]) { return MLMain(argc, argv); }      I have kept the sample program here short and concise. Adding error checking for every MathLink statement and printing out all the packets received after the assignment and their content doesn't reveal any additional information. It appears to hang after the last MLNewPacket statement has been executed. I could possibly install a yield-function, but I'd much rather understand why Mathematica is blocking at this point. Does anyone have any insights into this ? Edit : Ultimately my goal is to assign default values to optional arguments of a function. Hence I want something equivalent to this :               Options[ foo ] = { bar->42 };      The actual name of the optional argument is not bar and the default value is not 42. Instead both are obtained by a call into a C library, which is why all of this has to happen through MathLink. Assuming I solve the assignment problem described above I can set the default value(s) by creating the list of rule(s) _and_ the assignment through MathLink. I'd like these default values to be put in place when the program is installed, so I would also add this to my template :               :Evaluate: myAssignment[];       Alternatively I can avoid the assignment in MathLink by just creating the list of rule(s) in MathLink (in which case I'll call the function `myRules`) and then add this line to the template :               :Evaluate: Options[ foo ] = myRules[]      Unfortunately, none of the above solutions work for me, and it also fails with the simplification proposed by @halirutan.


Coloring Points in a Plot, based on their position in the list

Before I describe the question, I'd like to say that I've seen the excellent answers posted here but have not managed to get them to work for my own data. I have a list of values that I would like to plot in polar coordinates. The values represent the position of a series of coupled pendulums, and as such while the angle changes the radius does not. Here is a sample of the data for the pendulums, at a certain time `t`.               position = {       {-1.25084, 1}, {-1.42995, 1}, {-1.7497, 1}, {-1.83175, 1}, {-1.733,1}, {-1.86803, 1},        {-1.79935, 1}, {-1.87909, 1}, {-1.78354, 1}, {-1.81614, 1}, {-1.58559, 1}, {-1.71751, 1},        {-1.72079, 1}, {-1.60622, 1}, {-1.72122, 1}, {-1.46695, 1}, {-1.62577, 1}, {-1.75079, 1},        {-0.89456, 1}, {-0.950143, 1}, {-1.5654, 1}     }      What I would like to do is to color each of the pendulum based on their position; that is, the first pendulum (with angle -1.25084) would be colored purple, the next (with angle -1.42995) slightly purplish-blue and all the way to the last pendulum (with angle -1.5654) being colored red. The purpose of coloring the pendulums as such is that, as I vary time `t` using `Manipulate`, I would then be able to track the pendulums by their color. My attempt at this is below, but somehow it doesn't work in the way I intend it to.               n = Length[Transpose[position][[1]]]     position = Transpose[{Transpose[position][[1]], (1 + 0.001*Range[n]/n)}];     (* adding a small modifier to the radius of each pendulum to allow me to         identify the specific pendulum and give it a color later *)     pendulumcolor = ColorData["Rainbow"][1000*(#2 - 1)] &;     (* defining a colour function that extracts the pendulum number and relates         it to a color *)     ListPolarPlot[position,        PlotRange -> {{-1, 1}, {-1, 1}},        PlotStyle -> Thick,        Joined -> True,        ColorFunction -> pendulumcolor] /.          Line[a__] :> {AbsolutePointSize[8], Point[a]}      My output looks something like this, which is definitely not what I intended. The colors of each point should be different, rather than being all red. ![enter image description here](http://i.stack.imgur.com/CTyqf.png) **Edit** :In response to VLC's request, a sample of my code is provided below.               n = 100;     (* n is the number of pendulums in our system *)          pendulumplotstyle =        Table[Directive[PointSize[Large], ColorData["Rainbow"][Mod[i, 10]/10]], {i, 0, n}];     (* every ten pendula are coloured to span the color of the rainbow *)          Manipulate[       ListPolarPlot[List /@ funcposition[tdummy],          PlotRange -> {{-1, 1}, {-1, 1}},         PlotStyle -> pendulumplotstyle],       {tdummy, 0, 10, 0.001}]      In the above code, we have a function `funcposition[t]` that gives the position of the pendulums as a function of time `t`. This function is a numerical solution to an ODE that I'd rather not put up because of the length. The code will not work as-is due to the presence of `funcposition[t]` but it should give a good idea of what I'm doing.


Issue with Set function

Tables often come with column headers. Indexing the columns with the header is a natural thing to do. Although a proper dictionary is the usual solution in such a case, I find it often practical and elegant to index these through the symbol corresponding to the column header string. So say: I have an array:               mtvguests = {{Last Name, First Name},{Kolmogorov, Andrei},{Milankovic, Milutin}}      `mtvguests[[All, lastName]]` is a fairly natural and readable syntax. The following two functions help towards this end:               SetAttributes[SymbolValidWMMA, Listable];     Options[SymbolValidWMMA] := {camelCase -> False, RulesStringPatterns->{"/"->"or"}}         SymbolValidWMMA[s_String, OptionsPattern[]] :=           Fold[StringReplace[#1, #2] &, s,            Join[ OptionValue[RulesStringPatterns], If[OptionValue[camelCase], {Except[WordCharacter] ~~ x_ :> ToUpperCase[x],               StartOfString ~~ Whitespace ... ~~ x_ :>                ToLowerCase[x]}, {}], {Whitespace -> "",              StartOfString ~~ x:DigitCharacter :> "d"<>x,              Except[WordCharacter] -> "" }]];      (I am not a big fan of camel case but in this case it comes as handy).               Options[IndicesFromStrings] :=      Join[Options[SymbolValidWMMA], {Prfx -> "", Sfx -> "",                      Ctxt -> ""}];                 IndicesFromStrings[ls_List, opts : OptionsPattern[]] :=                    (ToExpression[#1 <> "=" <> ToString[First@#2]]) &                     ~MapIndexed~ (If[OptionValue[Ctxt] != "", OptionValue[Ctxt] <> "`",                          ""] <> OptionValue[Prfx] <>                         SymbolValidWMMA[#,                          Sequence @@ FilterRules[{opts}, Options[SymbolValidWMMA]]] <>                         OptionValue[Sfx] & /@ ls);      An example.               mtvguests = {{"Kolmogorov", "Andrei"}, {"Milankovic", "Milutin"}};      Prepend[mtvguests, {"Last Name", "First Name"} ] // TableForm      Then               IndicesFromStrings[{"Last Name", "First Name", "Cycles/Operators",        "2_2_Tu"}, camelCase -> True]      yields: > >     {"lastName", "firstName", "cyclesorOperators", "d22Tu"} >   And               mtvguests[[All, lastName]]      would return: > >     {"Kolmogorov", "Milankovic"} >   The symbol mangling can be tweaked:               IndicesFromStrings[{"Last Name", "First Name", "Cycles/Operators",        "_2_Tu"}, Ctxt -> "mtv", camelCase -> False,       RulesStringPatterns -> {DigitCharacter -> "nb", "/" -> "",         "_" -> "U"}]      would now return: > >     {"mtv`LastName", "mtv`FirstName", "mtv`CyclesOperators", "mtv`UnbUTu"} >   The previous works. Now for the question: I am not sure how to make the following work:               IndicesFromStrings[ls_List, opts : OptionsPattern[]] :=        (Set[ReleaseHold[ToExpression[#1]], ToString[First@#2]]) &         ~MapIndexed~(If[OptionValue[Ctxt] != "", OptionValue[Ctxt] <> "`",              ""] <> OptionValue[Prfx] <>             SymbolValidWMMA[#,              Sequence @@ FilterRules[{opts}, Options[SymbolValidWMMA]]] <>             OptionValue[Sfx] & /@ ls);


Efficient implementation of a linear complexity measure of binary sequences

For a implementation of testing the quality of random number generators I implemented the NIST test suite in Mathematica based on the nice workbook by Ilja Gerhardt. However I took up the challenge that Ilja was complaining about the efficiency of Mathematica (see provided link). I was able to speed up most of the test considerably by using Mathematica's native functions. However the the most costly test the Linear Complexity Test gives me some trouble. The test itself is straightforward (see NIST documentation), however it uses the Linear Complexity function based on the Berlekamp-Massey algorithm. My current implementation of this algorithm looks like this:               LinearComplexity = Compile[     {{u, _Integer, 1}},      Module[{len, b, c, d, p, pinit, tmp, l, m}, len = Length[u];      l = 0;     m = 0;     c = b = Join[{1}, Table[0, {len - 1}]];     pinit = Table[0, {len}];     Do[      d = Mod[        u[[n]] +          Take[c, {2, l + 1}].Reverse[Take[u, {n - l , n - 1 }]], 2];      If[d == 1,       tmp = c;       p = pinit;       p[[1 + n - m ;; 1 + l + n - m]] = b[[1 ;; l + 1]];       c  = Mod[c + p, 2];       If[2*l <= n, l = n - l; m = n; b = tmp;];       ]      , {n, 1, len}      ];     l     ]];      which is about 50% faster than the original cody by Ilja (see link to his Notebook for reference). Just as an example, the code returns the linear complexity of a binary sequence as follows               SeedRandom[29328];     tst = RandomInteger[{0, 1}, 20000];     LinearComplexity[tst] // Timing      returns               {4.882831, 10001}      However for very large binary sequences the code still is rather slow. I'm aware of multiple shortfalls of it, and would need advice how to fix them. First I would like to get rid of the Do-loop which is in any case not a good idea within Mathematica. Furthermore I would like to switch over to SparseArrays since for long random binary sequences this should reduce the size of the datastructure at least by 50% (random binary sequences have about 50% ones and 50% zeros). One potential implementation of SparseArrays is the following code:               LinearComplexitySparse[seq_List] :=Module[{len, u, b, c, d, p, pinit, tmp, l, m},     len = Length[seq];     u = SparseArray[seq];      l = 0;     m = 0;     c = b = SparseArray[{1 -> 1}, len, 0];     pinit = SparseArray[{}, len, 0];     Do[      d = If[l == 0, Mod[u[[n]], 2],         Mod[u[[n]] +           Take[c, {2, l + 1}].Reverse[Take[u, { n - l, n - 1  }]], 2]];      If[d == 1,       tmp = c;       p = pinit;       p[[1 + n - m ;; 1 + l + n - m]] = b[[1 ;; l + 1]];       c  = Mod[c + p, 2];       If[2*l <= n, l = n - l; m = n; b = tmp;];         ];      , {n, 1, len}      ];     Return[l];     ];      Which is more memory efficient but 2x slower since it is not compiled.               SeedRandom[29328];     tst = RandomInteger[{0, 1}, 20000];     LinearComplexitySparse[tst] // Timing          {8.392854, 10001}      I did not manage to implement compile (see following code)               LinearComplexitySparseCompiled :=       Compile[{{seq, _Integer, 1}},        Module[{len, u, b, c, d, p, pinit, tmp, l, m},         len = Length[seq];         u = SparseArray[seq];          l = 0;         m = 0;         c = b = SparseArray[{1 -> 1}, len, 0];         pinit = SparseArray[{}, len, 0];         Do[          d = If[l == 0, Mod[u[[n]], 2],             Mod[u[[n]] +               Take[c, {2, l + 1}].Reverse[Take[u, { n - l, n - 1  }]], 2]];          If[d == 1,           tmp = c;           p = pinit;           p[[1 + n - m ;; 1 + l + n - m]] = b[[1 ;; l + 1]];           c  = Mod[c + p, 2];           If[2*l <= n, l = n - l; m = n; b = tmp;];             ];          , {n, 1, len}          ];         Return[l];         ];       ]      since it is complaining about c not being a Tensor and multiple other stuff:               SeedRandom[29328];     tst = RandomInteger[{0, 1}, 20000];     LinearComplexitySparseCompiled[tst] // Timing          Compile::cplist: c should be a tensor of type Integer, Real, or Complex; evaluation will use the uncompiled function. >>          Compile::part: Part specification b[[1;;l+1]] cannot be compiled since the argument is not a tensor of sufficient rank. Evaluation will use the uncompiled function. >>          Compile::cset: Variable c of type {_Integer,0} encountered in assignment of type {_Real,1}. >>          Compile::cplist: c should be a tensor of type Integer, Real, or Complex; evaluation will use the uncompiled function. >>          Compile::part: Part specification b[[1;;l+1]] cannot be compiled since the argument is not a tensor of sufficient rank. Evaluation will use the uncompiled function. >>          Compile::cset: Variable c of type {_Integer,0} encountered in assignment of type {_Real,1}. >>          Compile::cret: The type of return values in Module[{len,u,b,c,d,p,pinit,tmp,l,m},len=Length[seq];u=SparseArray[seq];l=0;m=0;c=b=SparseArray[{Rule[<<2>>]},len,0];pinit=SparseArray[{},len,0];Do[d=If[Equal[<<2>>],Mod[<<2>>],Mod[<<2>>]];If[d==1,Set[<<2>>];Set[<<2>>];Set[<<2>>];Set[<<2>>];If[<<2>>];];,{n,1,len}];Return[l];]; are different. Evaluation will use the uncompiled function. >>          {8.689256, 10001}      any ideas to improve the above code, to get it compiled or to point me to some efficient implementation of the linear complexity measure are mostly welcome.


What are Root objects with multiple polynomials?

In Mathematica 9 a new flavor of `Root` object with multiple polynomials was introduced. For example,               Root[{327680000000000000 - 1280000000 #1^8 + #1^16 &, #1 + 25 #2 + 25 #2^5 &}, {7, 3}]      I've read the documentation several times, but still do not have a clear understanding of what these expressions mean, or what advantage they have over the older syntax with a single polynomial. Any advice or explanation are welcome.


Select cases from a list

I have a list in the form :               {1,1,1,0,-1,-1,1,1,1,0,0,0,0,-1,-1}      No I'm trying to select only those sequences which start with 1 have a zero (or many zeros) between and are followed by -1. For example: 1,0,-1 | 1,0,0,0,0,-1 I tried to use Cases, but I'm not sure how to define the pattern. Can someone help me out please?


How to transform Do loop to more efficient codes?

I'm new to Mathematica. Here is my original program: How to rewrite the Do part?               Clear["Global`*"];     da = {};     dt = 0.02;     endtime = 2;     Q = dQ = {0, 0, 0};     G = {0, -9.8, 0};     Do[      ddQ = G - Q;      dQ = dQ + ddQ*dt;      Q = Q + dQ*dt;      da = Append[da, dQ[[2]]]      , {t, 0, endtime, dt}      ]     ListPlot[Flatten[da], DataRange -> {0, endtime}, PlotRange -> All]     Quit[];      Where Q denotes coordinates of a particle. ddQ denotes the acceleration which depends on the coordinates Q of the particle. In order to make the posted program readable and clean, I provided acceleration value in one element only.


Creating directory structure through Mathematica

Is there `mkdirs()` (make directory structure) equivalent in _Mathematica_? I want to specify something like this : `dir1/dir2/dirn` and I want _Mathematica_ to create the directory structure `dir1/dir2/dirn`


How do I construct a non-linear model from experimental data?

I want to find a function $w=f(x,y,z)$ that fits experimentally determined values of w. For example, assume               x = {1, 1, 1, 2, 2, 2}          y = {1, 2, 3, 1, 2, 3}          z = {1, 2, 3, 4, 5, 6}      and experiments have given               w = {.531, .341, .163, .641, .713, -0.40e-1}      I want to fit this data according to this relationship:               w = x^a + (b x^2)/y + c y z      How can I find the constants a, b and c and estimate the error the model produces?


Plot an undefined function

When I plotted an undefined function, Mathematica also spends considerable time to process it. It returns a blank figure necessarily. What confuses me is where the `Plot` spends the time. For example, assuming that I forgeted to define the function `f`, I execute the code below. After a moment, I will get a blank graphics.               Plot3D[Im@f[1/4, u + I v], {u, -2, 2}, {v, -2, 2}, Mesh -> None,              PlotStyle -> Directive[Opacity[0.7], Orange], ImageSize -> Large, PlotPoints -> 50]      During this moment, what happened to Mathematica?


Making a predictive statistical model

I am totally new to _Mathematica_ , and I have never used a similar program, apart from perhaps Excel (and I didn't even use Excel on a professional level). So I want to create a mathematical model which will give me an estimation on when Moore's law will end, using my input. It won't be anything revolutionary, but I want this to be my first _Mathematica_ project (I'm in high school, and I suspect I'll be using _Mathematica_ more in university). I'm having trouble even navigating around in _Mathematica_ , I'm wondering where I can find the tools to start modeling? I know they exist, as seen here, but where can I find the function or functions I need to make my own model?


How to correctly disconnect from the kernel?

I'm connecting to and disconnecting from the kernel but I'm doing something wrong. I crash the text formatting in the terminal and got some warnings. There are some instructions to connecting to the kernel, but I almost didn't find anything about the disconnecting from the kernel. This question is related to connection to the remote machine and particularly to my this answer. I'm doing the following (based on this instructions):   1. Open terminal and run `math`              Mathematica 9.0 for Linux x86 (64-bit)     Copyright 1988-2013 Wolfram Research, Inc.     In[1]:= y=x^2                   2     Out[1]= x      OK, it works fine.   2. Open regular _Mathematica_. Create a new kernel configuration (Evaluation menu -> Kernel Configuration Options...) Select Advanced Options. Arguments to MLOpen:              -LinkName 8000@127.0.0.1,8001@127.0.0.1 -LinkMode Listen -LinkProtocol TCPIP -LinkOptions MLDontInteract -LinkHost 127.0.0.1      Shell command to launch kernel: leave empty (we will do it manually) Set the notebook's kernel to the one you just set up, and evaluate something (`2+2`).   3. In the terminal evaluate the following:              link=LinkConnect["8000@127.0.0.1,8001@127.0.0.1",LinkProtocol->"TCPIP"]      (* connect to front end link *)          $ParentLink = link; (* set the front end link as parent link *)        4. Now in the notebook you see that 2+2=4 :) Disconnect from the kernel:              links = {$ParentLink, MathLink`$ServiceLink, MathLink`$PreemptiveLink};      $ParentLink = Null; LinkClose /@ links;        5. In the terminal evaluate `y=x^2` one more time              In[8]:= y=x^2          Out[8]= RawBoxes[SuperscriptBox[x, 2]]      It's not what you expect to see. Moreover, you can see that `$FrontEnd` isn`t empty              In[9]:= $FrontEnd          Out[9]= RawBoxes[InterpretationBox[PanelBox[TooltipBox[            C FrontEndObject  C, InterpretationBox[StyleBox[FrontEndObject\              [LinkObject["8000@127.0.0.1,8001@127.0.0.1", 58, 1]],                      ShowStringCharacters -> True, NumberMarks -> True],             FrontEndObject[LinkObject["8000@127.0.0.1,8001@127.0.0.1",\              58, 1]], Editable -> True, AutoDelete -> True]],           FrameMargins -> {{4, 5}, {4, 4}}], -FrontEndObject-,          Editable -> False]]          6. Evaluate `2+2` in the notebook and               link=LinkConnect["8000@127.0.0.1,8001@127.0.0.1",LinkProtocol->"TCPIP"]      $ParentLink = link;      in the terminal one more time. The notebook is now reconnected to the kernel, but you can see warnings like              SetDelayed::write: Tag UpdateDynamicObjects in UpdateDynamicObjects[] is Protected. >>     SetDelayed::write: Tag UpdateDynamicObjectsSynchronous in UpdateDynamicObjectsSynchronous[] is Protected. >>      _Except the bad formatting in the terminal and these warnings everything works fine._ The first I can temporary fix by               In[16]:= $Post=TextForm;          Out[16]//TextForm= Null          In[17]:= y=x^2                         2     Out[17]//TextForm= x      But it produces annoying `//TextForm`. The messages come from the reevaluation of `$InstallationDirectory/SystemFiles/FrontEnd/TextResources/GetFEKernelInit.tr` which contain the following lines               UpdateDynamicObjects[] := (            FrontEnd`Private`changes = Internal`GetTrackChanges[];            If[Length[FrontEnd`Private`changes] =!= 0,                 MathLink`CallFrontEnd[FrontEnd`UpdateDynamicObjectsSynchronous[                                 FrontEnd`Private`changes]]];        )          UpdateDynamicObjectsSynchronous[] :=         MathLink`CallFrontEnd[FrontEnd`UpdateDynamicObjectsSynchronous[                 Internal`GetTrackChanges[]]];      Do you have any experience with disconnecting from the kernel?


Order list of monomials by degree (Pascal's Triangle)

Suppose I have the following list of monomials:               {1,x,x^2,y,y^2,x*y,x^2*y,x*y^2,x^2*y^2}      How could I manipulate it to get               {1,x,y,x*y,x^2,y^2,x^2*y,x*y^2,x^2*y^2}      such that they are in order by the total degree of the multivariate monomials? It is important that although x*y, x^2, and y^2 all have the same degree, the x*y comes first. **Further Details** I was vague with my sorting conditions. Let me further define the problem. The following could be considered Pascal's triangle of monomials:                                   |                         1                    x    |    y               x^2      x*y      y^2           x^3     x^2*y | x*y^2     y^3         ...          x^2*y^2          ...                         |      My goal is to ultimately extract a number of monomials from this triangle SYMMETRICALLY (from the centerline), starting at the top and moving outward from the centerline, moving to the next line in the triangle when needed. For example, if I want 4 monomials, I should get:               {1,x,y,x*y}      If i want 8 monomials, I should get:               {1,x,y,x*y,x^2,y^2,x^2*y,x*y^2}      A tricky case is if I want 9 monomials:               {1,x,y,x*y,x^2,y^2,x^2*y,x*y^2,x^2*y^2}      I can form a form of this triangle by creating the following matrix (easily generated):                 1     x     x^2     x^3  ...       y   x*y   x^2*y   x^3*y     y^2 x*y^2 x^2*y^2 x^3*y^2     y^3 x*y^3 x^2*y^3 x^3*y^3       .       .       .      So if I need a list of `n` monomials (assuming n is a valid number that lends to the symmetrical requirement), then I generate a size `Ceiling[Sqrt[n]]` matrix. When I flatten the resulting matrix, I obtain a list similar to the one I originally posted, that I feel if could be sorted based on the symmetry rules, would allow me to obtain the desired number of monomials. If anybody has a better approach to this, I would be most grateful.


How to set PlotLegend Number Format

Is there any way to make Mathematica to show the legend labels like a real number rather than in fraction form? I read the `BarLegend` options, however they are just related to graphics so I just set the `PlotLegend` to `Automatic`. A sample of legend I have problem with is shown below:               MatrixPlot[Rm1,      ColorFunction -> ColorData["GrayTones"],      ImageSize -> 200,      PlotLegends -> Automatic]      ![enter image description here](http://i.stack.imgur.com/xo5bZ.png)


Change "Format type of new input cells" to InputForm

In Preferences -> Evaluation there is a menu to change "Format type of new input cells" and the only options available are: StandardForm, TraditionalForm, and Raw InputForm. ![menu](http://i.stack.imgur.com/2e6e0.png) Is it possible to set this to InputForm? Edit: This is V9.


Padding plot ticks with zeros on the right

I would like to know how can I make a real-valued plot tick pad with a zero to the right of the decimal point on integer values. This is what I have:                Plot[0, {x, 8.5, 9.3},          PlotRange -> {{7.9, 11}, {0, 0}},          Axes -> {True, False},          Ticks -> {Range[0.0, 11.0, N[0.2, 4]]},          PlotStyle -> {Red, Thickness[0.02]}]      The ticks are displayed as `8., 8.2, 8.4, ..., 9., ...`; I want to see them displayed as `8.0, 8.2, 8.4, ..., 9.0, ...`


Understanding the discrepancy between txt file import and export times, and possibly speeding up Import

I attempted to import a very short .txt file string using the `Import` command:               Import["C:\\TestFile.txt"] // AbsoluteTiming          Out: {0.020001, "Test"}      Why does this take 20 milliseconds? `Export` is about an order of magnitude faster for the same string:               Import["C:\\TestFile.txt","Test"] // AbsoluteTiming          Out: {0.002000, "C:\\test.txt"}      Are there any hidden options for `Import` like the following (concerning TIF files) from a previous question of mine Slow import of multigigabyte TIF image stacks?:               Image`ImportExportDump`ImageReadTIFF      Quoting the user cormullion from my previous question: "For the OP's single frame, it's 0.015 for Import, but 0.000745 for ImageReadTIFF on Mac/M9. That might be worth having."


Efficient way to turn a subset into a permutation

> For an input vector $\\{a_1,a_2,\ldots,a_n,b_{1},b_2,\ldots,b_{m}\\}$ and a > list of ordered positions $\\{k_1,k_2,\ldots, k_n\\}$, such that $1\leqslant > k_1 < k_2 < \ldots < k_n \leqslant n+m$, I would like to output a vector > where each $a_i$ are located at $k_i$-th position, and for every $1 > \leqslant s<t \leqslant m$, $b_s$ precedes $b_{t}$ in the resulting list. My implementation of this is based on the observation that $\\{k_1,\ldots,k_n\\} \cup \\{k_1,\ldots,k_n\\}^c$ is the inverse of the needed permutation, where complement is understood in the set of natural numbers from 1 to $n+m$.               Reshuffle[ab_, kvec_] := ab[[Ordering[Join[kvec, Complement[Range@Length[ab], kvec]]]]]        Reshuffle[{a1, a2, b1, b2, b3}, {2, 4}]         (* Out= {b1, a1, b2, a2, b3} *)      I am somewhat dissatisfied with this solution, as it has sub-optimal complexity. I am hoping there is a direct way to construct the permutation to transform input `ab` into the result, that does not use `Ordering` or `Complement`. Thanks for reading.


Elegantly adding two differently spaced lists of ordered pairs $(x, y)$

Suppose that I have two lists, `list1` and `list2`, of ordered pairs $(x, y)$. The two lists are differently spaced in $x$; some ordered pairs in `list1` and `list2` have the same $x$ value, but some do not. I would like to combine the two lists such that all ordered pairs are included in the resulting list, which I will call `list`. If two ordered pairs happen to have the same $x$ value, then their $y$ values are added. Otherwise, the ordered pairs are included as-is. Here is an example. `list1` and `list2` are defined as follows:               list1 = {{0, 0}, {1, 1}, {2, 4}, {3, 9}, {4, 16}};     list2 = {{0, 0.5}, {0.4, 1}, {1, 2}, {1.5, 3}, {3.25, 8}, {4, 8}};      I would like to write a function `addLists` that takes `list1` and `list2` and returns the following list:               list = {{0, 0.5}, {0.4, 1}, {1, 3}, {1.5, 3}, {2, 4}, {3, 9}, {3.25, 8}, {4, 24}}      One way to write `addLists` is to use a rather long, complicated combination of `SortBy`, `GatherBy`, `Map`, `Total`, and `Transpose`:               addLists[list1_List, list2_List] := Module[{xList, yList, list},       list = SortBy[Join[list1, list2], First];       xList = DeleteDuplicates[list[[All, 1]]];       list = GatherBy[list, First];       yList = Map[Total[#[[All, 2]]] &, list];       list = Transpose[{xList, yList}]       ]          addLists[list1, list2]      which gives the desired output (matching `list`):               {{0, 0.5}, {0.4, 1}, {1, 3}, {1.5, 3}, {2, 4}, {3, 9}, {3.25, 8}, {4, 24}}      But, I think that there must be a simpler -- perhaps even built-in -- way to do this. Do you have any suggestions?


How to apply a conformal map to a jpg (or other image)

I would like to apply a conformal map to a jpg. For example, the map $z\mapsto z^2$ to this image: http://thumbs3.ebaystatic.com/d/l225/m/mGyeriV7l-YArkeBd9oMUng.jpg Any help on how to do this?


ErrorListPlot marker missaligned with error bar

> **Possible Duplicate:**   >  Point Renderings Slightly Off in Mathematica I'm using the `ErrorListPlot` function in the `ErrorBarPlots` package. I want to display markers and the error bars, however, the marker appears to be shifted slightly to the left of the error bars. I'm not sure which is actually at the correct position. I'm using Mathematica 8.0.4 on Windows 7. Example Code:               ErrorListPlot[{{5, 1}}, PlotMarkers -> Automatic]      Image illustrating the problem: ![http://dl.dropbox.com/u/3730003/errorlistplot.gif](http://i.stack.imgur.com/pcdVJ.gif) Using `ErrorBar` as such:               ErrorListPlot[{{{5, 1}, ErrorBar[1]}}, PlotMarkers -> Automatic]      doesn't solve the problem.


How to find coordinates of an abstract vector relative to a basis

Let's say I have a degree 3 homogeneous polynomial over variables $x0, x1, x2.$ There are then 10 distinct monic monomials, forming a basis of the vector space of polynomials of degree 3. If I have another polynomial of degree 3 in $x0, x1, x2$, how can I find out the coordinates of the expansion, returning a list according to some chosen ordering of the monomials? So the desired output would be a list of 10 numbers. For example, let's say I want the ordering $x0^3, x0^2x1, x0^2x2, x0x1^2, x0x1x2, x0x2^2, x1^3, x1^2x2, x1x2^2, x2^3$ and I want the output corresponding to the polynomial $(x0+x1)^2x0$. Then I want the output to be the array {1, 2, 0, 1, 0, 0, 0, 0, 0, 0}. The degree 3 was an arbitrary choice, and therefore as was the 10-dimensionality. So the method needs to at least work for fixed degree at a time, if not necessarily so that I can put in a degree at the very beginning for it to always work. Also, eventually I will want to take an array of polynomials and want to generate a list of lists of coefficients, so hopefully the method suggested will be amenable to this. Thanks.


Make which controls are visible in a Manipulate depend on a control value

I want to make a simple demonstration using Manipulate in which I have one or two input fields show depending on whether or not another control is True or False. How can I achieve such functionality?               Manipulate["DoSomethig", {ShowMore, {True, False}}, WhatShouldBeHere?]      ![ShowMore is unchecked](http://i.stack.imgur.com/9S8Xv.png) ![ShowMore is checked](http://i.stack.imgur.com/QJLp5.png)


How do I get the heading elements from the TableForm option TableHeadings?

The following,               table =        TableForm[ConstantArray[0, {3, 3}],         TableAlignments -> Right,         TableHeadings -> {None, {"One", "Two", "Three"}}]      generates a table with headings: ![enter image description here](http://i.stack.imgur.com/aPbJo.png) I see that its `FullForm` is               TableForm[       List[         List[HoldForm[\[Placeholder]], HoldForm[\[Placeholder]], HoldForm[\[Placeholder]]],         List[HoldForm[\[Placeholder]], HoldForm[\[Placeholder]], HoldForm[\[Placeholder]]],         List[HoldForm[\[Placeholder]], HoldForm[\[Placeholder]], HoldForm[\[Placeholder]]]],         Rule[TableAlignments, Right],         Rule[TableHeadings, List[None, List["One", "Two", "Three"]]       ]     ]      and I could parse this to retrieve the value of `TableHeadings`. But is there a more canonical approach? I found that for plots, one can use `Options[plot]`, but I couldn't find a counterpart for tables.


What string pattern will match $n$ contiguous characters drawn from a given alphabet?

I'd like to use `StringCount` to count the number of subwords in a string that have the form `****` where `*` is designed to stand for any character in a specified set:               starSet = {"A","B","C"};     modifiedStringCount[string,"*****"]      For example:               string = "ABAACAWABCAA";      Would generate an output of `2` if `Overlaps -> FALSE` and a output of `3` is `Overlaps -> TRUE`. Is there a way to do this?


Get Cos[2 x] in "Solve"

![enter image description here](http://i.stack.imgur.com/eXlpr.jpg) My goal is to get an analytical solution of x ( $\lambda$ in the problem), when $\epsilon$ (f[x] in the problem) is maximum (use inverse form). I found that if I can use trigonometric identity to change `Sin[x]` and `Cos[x]` to `Sin[2x]` or `Cos[2x]`, then I can achieve my goal. Here is the code that I wrote, but I found it is not very good, because for the third line I copy and paste from the evaluation cell. So, can anyone think of an easier way to change $\epsilon$ in terms of 2$\lambda$, or can provide another way to achieve the goal?               f[x_] = (R ω^2 Sin[x] Cos[x])/(g - ω^2 (Cos[x])^2 R);          f'[x] // FullSimplify;          Solve[2 R ω^2 (R ω^2 + (-2 g + R ω^2) Cos[2 x]) == 0, Cos[2 x]][[1]] // FullSimplify;


Dsolve is not solving equation ( 3 system with 2.order diferantial equations)

I added an image of my equations at the bottom. I dont understand why it is not solving. This is 3 systems with 2.order diferantial equations. I also put my initial conditions. But it is not solving. Without initial conditions it is not solving, too. May you please help me, why it is not solving. Am I writing codes wrongly. Here is my code:               deq2 = DSolve[{              D[T1[t], {t}, {t}] == -1.062880475*10^7*T1[t] + 845.813407*T2[t],               D[T2[t], {t}, {t}] == 281.937803*T1[t] - 1.135556134*10^6*T2[t] -                1.807293611*10^6*T3[t] + 854.700858*(1 - 555.5555556*t)*Exp[-194.4444444*t],               D[T3[t], {t}, {t}] == -1.036565839*10^10*T3[t] - 6.506256977*10^9*T2[t],               T1[0] == 0, T1'[0] == 0, T2[0] == 0, T2'[0] == 0, T3[0] == 0, T3'[0] == 0},              {T1[t], T2[t], T3[t]}, t]      I tried also another way.               {T1[t], T2[t], T3[t]} = {T1[t], T2[t], T3[t]       } /. Dsolve[{             D[T1[t], {t}, {t}] == -1.062880475*10^7*T1[t] + 845.813407*T2[t],              D[T2[t], {t}, {t}] == 281.937803*T1[t] - 1.135556134*10^6*T2[t]               -1.807293611*10^6*T3[t] + 854.700858*(1 - 555.5555556*t)*Exp[-194.4444444*t],              D[T3[t], {t}, {t}] == -1.036565839*10^10*T3[t] - 6.506256977*10^9*T2[t],              T1[0] == 0, T1'[0] == 0, T2[0] == 0, T2'[0] == 0, T3[0] == 0, T3'[0] == 0},              {T1[t], T2[t], T3[t]},              t] // FullySimplify // First      ![enter image description here](http://i.stack.imgur.com/tTuSC.png)


Mathematica not recognising closed forms as specific values

I have a Mathematica program that outputs a piecewise function, and some parts of the expression are not being recognised as specific numbers when using `FullSimplify`. For example, in the output there is               ArcCos[3/5] + 2 ArcSec[Sqrt[5]]      which is actually equal to $\pi$, and there is also               ArcCos[3/5] - 2 ArcCos[2/Sqrt[5]]      which is actually equal to $0$. I was wondering if there was a way to have Mathematica recognise these sort of outputs in their more simplified form. I know that I can use numerical approximation, but was wondering if it was possible to do so while keeping the output in exact/closed form.


Solving System of Nonlinear with Three Differential Equations

I've been trying to solve a system of nonlinear differential equation, but the conditions are a bit weird. Two of the differentials equate to the same equation, but have different boundary conditions. The third differential equate to something else. For the background on the problem I am trying to solve, it is related to concentration as a function of time for a reaction. Here is the code I have put, which was more or less straightforward, but I keep getting 'true.' I've tried using DSolve and NDsolve, but I am unable to get a graph for my three concentration profiles (I do not need an analytical solution, just a graphical one).               NDSolve[{     A'[t] == -kf A[t] *B[t] + kb * c[t],      B'[t] == -kf A[t] *B[t] + kb * c[t],      c'[t] == kb * c[t] + kf A[t] B[t],      A[0] == 1, B[0] == 2, c[0] == 0},      {A, B, c}, {t, 100}]       kf and kb are constants I've already equated into my code But I keep resulting with:               NDSolve[{True, True, True, A[0] == 1, B[0] == 2, c[0] == 0}, {A, B, c}, {t, 100}]      I'm thinking it's because I'm multiplying two functions together, I haven't solved ODEs this way. I'd appreciate any input, or hints/guides/direction. Thanks! If there is something unclear, or if I am lacking proper question asking etiquette please let me know!


Labeling points on a graph with their coordinates in parentheses

I need to create some graphs in _Mathematica_ with a bunch of labels, such as axes labels, graph labels, etc. In particular, there must be some points that must be labeled with their coordinates. Thanks to Internet search and this website in particular, I learned how to use the `Epilog` option. So I can do things like               Plot[x^2, {x, 0, 1}, Epilog -> {Text[y == x^2, {0.5, 0.5}]}]      to label an equation or                ListPlot[{{1, 1}}, Epilog -> {Text["(1,1)", {0.5, 0.5}]}]      to label a point. Thru my experimenting, as you can see in these two examples, I figured that meaningful _Mathematica_ inputs can be used in `Text`, but meaningless (for _Mathematica_ ) would cause an error message, so I do them as strings in quotes. Now here's a problem. I need to label a point whose x-coordinate is 2/3, and I want it to look as a stacked fraction. I can't type coordinates of points in parentheses without quotes because for _Mathematica_ it's an error. But if I type it in quotes, the parentheses don't stretch vertically, which doesn't look right. ![my ListPlot samples](http://i.stack.imgur.com/Rmksn.png) Can anybody advise a solution to this problems?


TimeConstrained for parallel computations

The Mathematica manual states > `TimeConstrained` takes account only of CPU time spent inside the main > Mathematica kernel process; it does not include additional threads or > processes. However, my computation involves a parallel computation. As an example, consider the code               count = 0;     SetSharedVariable[count];     ProgressIndicator[Dynamic[count], {0, 500}]          f = Total[ParallelTable[count++; i^2, {i, 1, 500}]];          TimeConstrained[f, .1, "fail"]          (* 41791750 *)      How can I achieve that "fail" is returned. I can imagine that it could be complicated to compute the total CPU time of all sub-processes, but for my application it would be sufficient to consider the absolute amount of real- time that has passed as `AbsoluteTiming[]` does. Any suggestions?