NonlinearModelFit::nrlnum error using FindFit /NonlinearModelFit

My question is related to my previous post I'm trying to fit experimental data (after suggestion here by David) ![enter image description here](http://i.stack.imgur.com/X7qw2.png) with Airy type function `data01 = Import["366.0000cm_660.0000nm.png"]; data02 = ImageData[data01]; min02 = Min[data02]; max02 = Max[data02]; ( _Dimensionalities of images_ ) dim01a = Import["366.0000cm_660.0000nm.png", "ImageSize"] [1]; dim01b = Import["366.0000cm_660.0000nm.png", "ImageSize"] [2]; dim01 = Min[dim01a, dim01b]; ReducPix = 5; data03 = Table[ (data02[[i]][[j]][1] - min02)/max02, {i, 1, dim01b, ReducPix}, {j, 1, dim01a, ReducPix}]; ( _Dimensionalities_ ) dim03a = Dimensions[data03][1]; dim03b = Dimensions[data03][2]; dim03 = Min[dim03a, dim03b] ListPlot3D[data03, PlotRange -> All]               airy[r_] := (2 BesselJ[1, r]/r)^2 /; r != 0.      airy[0.] = 1; FitFunction = a0 airy[Sqrt[a2 (x - a1)^2 + b2 (y - b1)^2]]; data3D = Flatten[MapIndexed[{#2[1], #2[2], #1} &, data03, {2}], 1]; fit = NonlinearModelFit[data3D, FitFunction, {{a0, 1}, {a1, 70}, {a2, 10}, {b1, 50}, {b2, 10}}, {x, y}]; ` However there is an error > NonlinearModelFit::nrlnum: The function value {2.33602*10^119-3.43765*10^103 > I,3.24204*10^118+0. I,4.62528*10^117+6.12971*10^101 > I,6.78701*10^116-1.182*10^101 I,<<44>>,1.18061*10^96+0. I,1.15086*10^96+0. > I,<<12238>>} is not a list of real numbers with dimensions {12288} at > {a0,a1,a2,b1,b2} = {0.206555,69.9985,-2.9634,50.0133,-2.99061}. >> not sure what does it mean. Any idea?


Change the color of a Locator in a Manipulate

How can I change the color of a `Locator` in a `Manipulate`? As an example, consider the following.               Manipulate[       Graphics[{Line[{{0,0},pt}]},         PlotRange -> 2       ], {{pt,{0,0}},{-2,-2},{2,2}, Locator}]      It's easy enough to hide the `Locator` and then add any primitives that I want:               Manipulate[       Graphics[{         Line[{{0,0},pt}],         {PointSize[Large],Red,Point[pt]}},         PlotRange -> 2       ], {{pt,{0,0}},{-2,-2},{2,2}, Locator, Appearance -> None}]      The `Locator` itself, though, seems impervious to any directives I try.


Does parallel programming use up large quantities of memory in Mathematica?

When I start Mathematica with a fresh kernel and load a program I am developing to analyze biology data, the amount of used system memory is 1.9 GB (free memory is 14.5 GB). These memory values are reported by an application external to Mathematica. After I run the code I have developed, the amount of used system memory is 13.2 GB (free memory is 3.2 GB). So, this means that running my code has consumed 13.2-1.9 = 11.3 GB of memory. After running the code, `MaxMemoryUsed[]` reports a value of 2.7 GB.   1. Even though _Mathematica_ is reporting `MaxMemoryUsed` at 2.7Gb, my system is still reporting 13.2 GB of used memory. If this is true, why hasn't Mathematica cleared the 11.3 - 2.7 = 8.6 GB of memory it says it hasn't used and returned it to the system?   2. I have tried setting `$HistoryLength = 0` and it has not made a difference in the reported memory usage.   3. My code (posted below) does use several `ParallelTable` statements. Do these statements send a copy of the memory content to each parallel kernel?   4. Do you have suggestions to solve this mystery of where is my memory? Thank you for your thoughts. Todd \--------------- Mathematica Code ------------               (* load cel data *)     time0 = AbsoluteTime[];     SetDirectory[cellocation];     celfilenames = FileNames[]; (* names of data files to import *)     celvarnames =        Table[StringSplit[celfilenames[[i]], {"."}][[1]], {i, 1,          Length[celfilenames]}] ;(* names of datafiles, with extensions \     removed, to be used downstream *)     Table[microarray[celvarnames[[i]]] = Import[celfilenames[[i]]], {i, 1,         Length[celfilenames]}];(* assign data to microarray variable \     using celvarnames as indexes to microarray; each chip's data is \     assigned to a different index to microarray *)          chipsize =       chipdimensions[       microarray[celvarnames[[1]]]] (* determine chip dimensions *)          (* load affy cdf data *)     SetDirectory[affycdflocation];     cdffilenames = FileNames[];     cdffile =        Import[Flatten[StringCases[cdffilenames, ___ ~~ ".cdf" ~~ ___]][[         1]]];           (* convert hybidization symbol names to string names *)     experimentchips = Map[ToString, experimentchips];     controlchips = Map[ToString, controlchips];     Print["Experimental condition chips: ", experimentchips]     Print[]     Print["Control condition chips: ", controlchips]          pmindexes =        Table[Select[cdffile[[i, 3, 2]], #[[5]] != #[[6]] &][[All, 4]], {i,          1, Length[          cdffile]}]; (* perfect match probe indexes by probeset; same \     order as affy cdf file *)          mmapmindices =        Map[Transpose,         Thread[affyindextoMMAindices[pmindexes,           chipsize]]]; (* create Mathematica indices equivalent to Affy pm \     index positions by probeset *)           pmtemp = ParallelTable[        Extract[microarray[celvarnames[[i]]], mmapmindices[[j]]], {i, 1,          Length[celvarnames]}, {j, 1,          Length[mmapmindices]}]; (* get pm data from all the chips; data \     grouped by chip; within each chip,data is organized in same order as \     probes listed in cdf file *)          Table[pmsignal[celvarnames[[i]]] = pmtemp[[i]], {i, 1,         Length[celvarnames]}] ;(* put the pm data into the pmsignal \     variable, using celvarnames as indexes referring to the different \     chips *)          Clear[pmtemp,        microarray]; (* no need to retain duplicate information in memory, \     once data is assigned to specific chips *)          Table[pmstdev[celvarnames[[i]]] =         Map[StandardDeviation, pmsignal[celvarnames[[i]]]], {i, 1,         Length[celvarnames]}];     (* compute standard deviations by pm probeset,for each chip, and \     store it in pmstdev using celvarnames as indexes *)          subsetsize =        0.10*Length[         pmstdev[celvarnames[[           1]]]]; (* Use 10% of probesets to calculate clusters below *)          Table[pmstdevsubset[celvarnames[[i]]] =         BlockRandom[SeedRandom[1234];          RandomChoice[pmstdev[celvarnames[[i]]], Floor[subsetsize]]] , {i,         1, Length[celvarnames]}];     (* select a random subset of pm probset stdev for establishing \     "normal" pm probeset standard deviations for each chip *)          pmtemp = ParallelTable[        Sort[FindClusters[pmstdevsubset[celvarnames[[i]]], 3,            DistanceFunction -> EuclideanDistance,            Method -> "Agglomerate"]][[-1]], {i, 1,          Length[celvarnames]}]; (* Find the largest cluster for each pm \     standard deviation subset by chip; the mean of these clusters will \     set the "normal" pm variation for each chip; only find 3 clusters to \     make calculation quicker *)          Table[pmstdevcluster[celvarnames[[i]]] = pmtemp[[i]], {i, 1,         Length[pmtemp]}] ;(* assign pmtemp results to pmstdevcluster using \     celvarnames as keys *)          Clear[pmtemp]; (* no need to store same data twice *)          Table[pmpostocheck[celvarnames[[i]]] =         Flatten[Position[pmstdev[celvarnames[[i]]],           x_ /; x > Mean[pmstdevcluster[celvarnames[[i]]]]]], {i, 1,         Length[celvarnames]}];      (* determine each chips pm probeset positions whose st devs are \     greater than the "normal" threshold, which is calculated by taking \     the mean of the largest clusters for each chip - stored in \     pmstdevcluster *)          pmexperimentemp =        ParallelTable[        Flatten[Drop[          errorcorrection[pmsignal, experimentchips[[i]], pmpostocheck],           1], 2], {i, 1,          Length[experimentchips]}];(*calculate improved pmsignal in \     experimental chip probesets that have unusually high signal variation \     using the same probesets in comparable experimental condition chips \     as a surrogate*)          pmcontroltemp =        ParallelTable[        Flatten[Drop[          errorcorrection[pmsignal, controlchips[[i]], pmpostocheck], 1],          2], {i, 1,          Length[controlchips]}];(*calculate improved pmsignal in control \     chip probesets that have unusually high signal variation using the \     same probesets in comparable control condition chips as a surrogate*)          Table[pmsignal[experimentchips[[i]]] =         ReplacePart[pmsignal[experimentchips[[i]]],          Thread[pmpostocheck[experimentchips[[i]]] ->            pmexperimentemp[[i]]]], {i, 1,         Length[experimentchips]}]; (* replace spurious pmsignal with \     replacement values in experimental condition chips *)          Table[pmsignal[controlchips[[i]]] =         ReplacePart[pmsignal[controlchips[[i]]],          Thread[pmpostocheck[controlchips[[i]]] ->            pmcontroltemp[[i]]]], {i, 1,         Length[controlchips]}]; (* replace spurious pmsignal with \     replacement values in control condition chips *)          Clear[pmexperimentemp,        pmcontroltemp]; (* don't store data longer than needed *)          Table[experimentchippmmean[experimentchips[[i]]] =         Mean[Flatten[pmsignal[experimentchips[[i]]]]], {i, 1,         Length[experimentchips]}];      (* calculate each experimental chips pmsignal mean to use in \     standardization *)          Table[controlchippmmean[controlchips[[i]]] =         Mean[Flatten[pmsignal[controlchips[[i]]]]], {i, 1,         Length[controlchips]}]; (* calculate each control chips pmsignal \     mean to use in standardization *)          Table[experimentchippmstdev[experimentchips[[i]]] =         StandardDeviation[Flatten[pmsignal[experimentchips[[i]]]]], {i, 1,         Length[experimentchips]}]; (* calculate each experimental chips \     pmsignal standard deviation to use in standardization *)          Table[controlchippmstdev[controlchips[[i]]] =         StandardDeviation[Flatten[pmsignal[controlchips[[i]]]]], {i, 1,         Length[controlchips]}]; (* calculate each control chips pmsignal \     standard deviation to use in standardization *)          pmexpstandtemp =        ParallelTable[        Map[(# - experimentchippmmean[experimentchips[[i]]])/           experimentchippmstdev[experimentchips[[i]]] &,          pmsignal[experimentchips[[i]]]], {i, 1,          Length[experimentchips]}];(* standardize each experimental chips \     pmsignal *)          pmcontrolstandtemp =        ParallelTable[        Map[(# - controlchippmmean[controlchips[[i]]])/           controlchippmstdev[controlchips[[i]]] &,          pmsignal[controlchips[[i]]]], {i, 1,          Length[controlchips]}];(* standardize each control chips pmsignal \     *)          Table[experimentstandard[experimentchips[[i]]] =         pmexpstandtemp[[i]], {i, 1, Length[experimentchips]}];      (* reassign data from pmexpstandtemp to proper indexed variable *)          Table[controlstandard[controlchips[[i]]] =         pmcontrolstandtemp[[i]], {i, 1,         Length[controlchips]}];(* reassign data from pmcontrolstandtemp to \     proper indexed variable *)          Clear[pmexpstandtemp, pmcontrolstandtemp]; (* free up memory *)          time1 = AbsoluteTime[] - time0


Splitting strings at lower case characters and numbers

I'm trying to split the strings of chemicals into their elements and numbers. See this example `"Fe3O4"` will be split into `{"Fe","3","O","4"}` I've tried using `StringSplit` and various `_LowerCaseQ` type patters but it isn't working. I've also tried using `StringSplit[#,""]` to split everything and then finding the lower case characters and putting it back together but I haven't got it to work. Any solution would be greatly appreciated.


Simplify an expression containing NonCommutativeMultiply

How does mathematica evaluate the following expression to zero:               -a ** (b ** c - c ** b) + b ** (a ** c - c ** a) -       c ** (a ** b - b ** a) + (a ** b - b ** a) **        c - (a ** c - c ** a) ** b + (b ** c - c ** b) ** a      In the reference of the non commutative multiplication `**` is stated that it is assumed to be associative and consequently the expression should be equal to zero. However just applying `Simplify[]` doesn't work for me.


How do I label contour lines that are superimposed on a 3d plot?

I need to generate a 3D plot of a function, say $z = \sin(x)\cos(y)$, with contour lines drawn at specified intervals. I also want to label each contour line with its $z$-value. I have discovered how to superimpose the contour lines on the 3D graph thanks to this post: Adding contour lines to a 3D plot?. However, I still cannot figure out how to label these contour lines with their $z$-values. How can this be done?


How to calculate only four elements per column in a block matrix?

I have a matrix generated like this :               Table[Sequence @@ {f[t[[i]], j, x], g[t[[i]], j, x]}, {i, 16}, {j, 3}]      where $f$ and $g$ are two different functions, $t$ is a vector or `List` containing values of time, and $x$ is a variable number. This provides with the following matrix : $\small \begin{pmatrix} f[t[[1]],1,x] & g[t[[1]],1,x] & f[t[[1]],2,x] &g[t[[1]],2,x] & f[t[[1]],3,x] & g[t[[1]],3,x]\\\ f[t[[2]],1,x]&g[t[[2]],1,x]&f[t[[2]],2,x]&g[t[[2]],2,x]&f[t[[2]],3,x]&g[t[[2]],3,x]\\\ f[t[[3]],1,x]&g[t[[3]],1,x]&f[t[[3]],2,x]&g[t[[3]],2,x]&f[t[[3]],3,x]&g[t[[3]],3,x]\\\ f[t[[4]],1,x] & g[t[[4]],1,x] & f[t[[4]],2,x] &g[t[[4]],2,x] & f[t[[4]],3,x] & g[t[[4]],3,x]\\\ f[t[[5]],1,x] & g[t[[5]],1,x] & f[t[[5]],2,x] &g[t[[5]],2,x] & f[t[[5]],3,x] & g[t[[5]],3,x]\\\ f[t[[6]],1,x] & g[t[[6]],1,x] & f[t[[6]],2,x] &g[t[[6]],2,x] & f[t[[6]],3,x] & g[t[[6]],3,x]\\\ f[t[[7]],1,x] & g[t[[7]],1,x] & f[t[[7]],2,x] &g[t[[7]],2,x] & f[t[[7]],3,x] & g[t[[7]],3,x]\\\ f[t[[8]],1,x] & g[t[[8]],1,x] & f[t[[8]],2,x] &g[t[[8]],2,x] & f[t[[8]],3,x] & g[t[[8]],3,x]\\\ f[t[[9]],1,x] & g[t[[9]],1,x] & f[t[[9]],2,x] &g[t[[9]],2,x] & f[t[[9]],3,x] & g[t[[9]],3,x]\\\ f[t[[10]],1,x] & g[t[[10]],1,x] & f[t[[10]],2,x] &g[t[[10]],2,x] & f[t[[10]],3,x] & g[t[[10]],3,x]\\\ f[t[[11]],1,x] & g[t[[11]],1,x] & f[t[[11]],2,x] &g[t[[11]],2,x] & f[t[[11]],3,x] & g[t[[11]],3,x]\\\ f[t[[12]],1,x] & g[t[[12]],1,x] & f[t[[12]],2,x] &g[t[[12]],2,x] & f[t[[12]],3,x] & g[t[[12]],3,x] \end{pmatrix}$ Now, in my experiments, I've found out that I don't need to calculate **every** value of the matrix but only four elements for each column, because the other ones are equal to zero. So I need to obtain the following matrix : $\small \begin{pmatrix} f[t[[1]],1,x] & g[t[[1]],1,x] & 0&0 & 0 & 0\\\ f[t[[2]],1,x]&g[t[[2]],1,x]&0&0&0&0\\\ f[t[[3]],1,x]&g[t[[3]],1,x]&f[t[[3]],2,x]&g[t[[3]],2,x]&0&0\\\ f[t[[4]],1,x] & g[t[[4]],1,x] & f[t[[4]],2,x] &g[t[[4]],2,x] & 0 & 0\\\ 0 & 0 & f[t[[5]],2,x] &g[t[[5]],2,x] & f[t[[5]],3,x] & g[t[[5]],3,x]\\\ 0 & 0 & f[t[[6]],2,x] &g[t[[6]],2,x] & f[t[[6]],3,x] & g[t[[6]],3,x]\\\ 0 & 0 & 0 &0 & f[t[[7]],3,x] & g[t[[7]],3,x]\\\ 0 & 0 & 0 &0 & f[t[[8]],3,x] & g[t[[8]],3,x]\\\ 0 & 0 & 0 &0 & 0 & 0\\\ 0 & 0 & 0 &0 & 0 & 0\\\ 0 & 0 & 0 &0 & 0 & 0\\\ 0 & 0 & 0 &0 & 0 & 0 \end{pmatrix}$ Is there a way to construct the matrix avoiding the calculus of the elements which are always equal to zero? I tried this               Table[Sequence @@ {f[t[[i]], j, x], g[t[[i]], j, x]}, {i, 2j-1,2j+2}, {j, 3}]      but obviously without success... My concern is with the time consumption (when working with large matrices).


Need 4D plot (3D + color for function)

I have a function f(x,y,z) of three variables and some constants:               P1 = 630*10^6;     a1 = 6.1;     deltaf = 680*10^-28;     rho = 13600;     Na = 6.03*10^23;     M = 270;     N1 = rho*Na/M;     sigmaf = N1*deltaf;     v1 = 161/(0.7958)^3;     Ef = 3.2*10^-11;     A1 = 3.87*P1/(v1*Ef*sigmaf);          flux1[x_, y_, z_] :=   A1*Cos[\[Pi]*x/a1]*Cos[\[Pi]*y/a1]*Cos[\[Pi]*z/a1];       I want to plot this function in 3D frame with color to represent the value of a f(x,y,z) at each triplet point. And need color bar to show variation. Give me suggestions. I have used the following command but it is not working properly.               ContourPlot3D[      A1*Cos[\[Pi]*x/a1]*Cos[\[Pi]*y/a1]*Cos[\[Pi]*z/a1], {x, -3,        3}, {y, -3, 3}, {z, -3, 3},       ColorFunction -> (ColorData["TemperatureMap"][#3] &)]      I want the plot to look like this: ![plot](http://i.stack.imgur.com/h0Zwy.png) (It is the last plot on this page.)


Finding the characteristic function of a TransformedDistribution[]

I am trying to find the characteristic function of a sum of "named" distributions, though I am interested in how to use Mathematica to find the characteristic function of $$f(X_1,\ldots, X_n),$$ where $X_i$ are some given random variables. A toy problem is finding the characteristic function of $X+Y$, where $X$ and $Y$ are iid $\mathcal{N}(0,1)$. The following code:               \[ScriptCapitalD] =  TransformedDistribution[x + y, {x, y} \[Distributed] NormalDistribution[]]     CharacteristicFunction[\[ScriptCapitalD], \[Lambda]]      Produces the output               CharacteristicFunction[TransformedDistribution[\[FormalX]1 + \[FormalX]2, {\[FormalX]1, \[FormalX]2} \[Distributed] NormalDistribution[0, 1]], \[Lambda]]      which is obviously not what's desired. It seems that CharacteristicFunction only works with named distributions that ship with Mathematica. Is this correct? If not, how can I make it work with a transformed distribution? (I know that there are other ways to find the characteristic function of $X+Y$ above; it was only used for illustration purposes.)


Problems with doing calculus on Interpolating functions

The following is my code:               a := 3.24077*10^-20 (* km \[Rule] Mpc *)     b := 3.16888*10^-14 (* s \[Rule] MYear *)     c := a/b*(2.99792*10^5) (*Mpc/ MYear*)     H0 := a/b*71 (*1/MYear*)     G := a^3/b^2*6.67398*10^-20 (*Mpc^3/(Kg*MYear^2)*)          \[Rho]crit1 := 3/(8 \[Pi]*G)*(H0)^2          M1[r_] := (4 \[Pi] )/3*\[Rho]crit1*(r)^3          E1[r_] := 0         ScaleFactor =            NDSolve[{Sqrt[R[r, t]] (D[R[r, t], t]) ==                Sqrt[(2*G*M1[r])/c + 2 c*E1[r]*R[r, t]], R[r, 0] == r/1000},              R, {r, 1, 10000}, {t, 1, 10000}] // FullSimplify;         Plot3D[Evaluate[R[r, t] /. %], {r, 1, 10000}, {t, 1, 10000}]         ParticleHorizon[r_, g_] :=           NIntegrate[(c Sqrt[1 + 2 E1[r]])/           D[Evaluate[R[r1, t] /. ScaleFactor, r1 -> r], r], {t, 0, g}]         Plot3D[ParticleHorizon[r,g], {r, 1, 10}, {g, 1, 10}]      My problem is that once I've solved the differential equation to get `R[r,t]` (which it solves without a problem, giving me an interpolating function), I have trouble differentiating the result with respect to `r`, to be used in my `ParticleHorizon` function. I think it might be because the differential operator uses `DSolve` or `NDSolve` intrinsically. Here, `a,b,c,f,G` and `lambda` are constants and `M1[r]` is a boundary condition that we need to solve the differential equation for `R[r,t]`. `E1[r]` has been set to 0 for now for simplicity. Any ideas on how to proceed? Also, the rule to change `r1->r` was just me trying to see if it works, which it doesn't... Thanks in advance!


ListDensityPlot crashes the kernel

ListDensityPlot[      Flatten[Table[{i, j, Sin[i + j]}, {i, 1, 20}, {j, 1, 20}], 1]]      gives the expected result, but a linear scale crashes my kernel (please save your work before trying)               ListDensityPlot[      Flatten[Table[{i*1.*^15, j, Sin[i + j]}, {i, 1, 20}, {j, 1, 20}], 1]]      why? And how to fix it? I'm using OS X 10.9. Here is the screen crop. ![enter image description here](http://i.stack.imgur.com/iCzY8.png)


An error message with NIntegrate and inability to plot the integrand

I took a function of x which depended on parameters on m,n,a,y and then first summed up the n from -Infinity to Infinity and then I set the other parameters to some random values and then I asked it to integrate and I got a funny message back -                Sum [    (((-m^2 + n^2/a^2 - x^2)/(m^2 + n^2/a^2 + x^2) + (      2 n^2 (m^2 - a m^2 + n^2 - n^2/a + x^2 - a x^2))/(      a^3 (m^2 + n^2/a^2 + x^2)^2)) Gamma[-I x + (1 + y)/2] Gamma[     I x + (1 + y)/2] )/((m^2 + n^2 + x^2) Gamma[-I x] Gamma[     I x]) , {n, -Infinity, Infinity}] // FullSimplify          1/Sqrt[-m^2   x^2] x (Cot[\[Pi] Sqrt[-m^2 - x^2]] -  Cot[a \[Pi] Sqrt[-m^2 - x^2]] +      a \[Pi] Sqrt[-m^2 - x^2] Csc[a \[Pi] Sqrt[-m^2 - x^2]]^2)      Gamma[ 1/2 (1 - 2 I x + y)] Gamma[1/2 (1 + 2 I x + y)] Sinh[\[Pi] x]               m = 46.5675786575; a = 5; y = 0;          Integrate [  1/Sqrt[-m^2 - x^2]  x (Cot[\[Pi] Sqrt[-m^2 - x^2]] - Cot[a \[Pi] Sqrt[-m^2 - x^2]] + a \[Pi] Sqrt[-m^2 - x^2] Csc[a \[Pi] Sqrt[-m^2 - x^2]]^2) Gamma[ 1/2 (1 - 2 I x + y)] Gamma[   1/2 (1 + 2 I x + y)] Sinh[\[Pi] x]  , {x, 0, Infinity}]      And then Mathematica tells me this - NIntegrate::izero : "Integral and error estimates are 0 on all \integration subregions. Try increasing the value of the MinRecursion \ option. If value of integral may be 0, specify a finite value for the \   AccuracyGoal option. !(*ButtonBox[\"[RightSkeleton]\", \ ButtonStyle->\"Link\", ButtonFrame->None, \ ButtonData:>\"paclet:ref/NIntegrate\", ButtonNote -> \ \"NIntegrate::izero\"])" 0.`+ 0.` I   * What does this mean?    * Even if I try to plot the above integrand as a function of $x$ (for say the above fixed values of m, a and y) then why is the plot not coming?


How to write efficient code? How to make this example run faster?

I would like to learn writting more efficiently. I am working on problem of simulating random walks (abnormal diffusion). I believe this is good example of inefficient code. How can I make it faster?               xvv[n_, a_] := (       xx = #1 Cos[#2] &;       yy = #1 Sin[#2] &;       lval = RandomVariate[ParetoDistribution[0.01, a], n];        phival = RandomReal[{0, 2 Pi}, n];       xv = Thread[xx[lval, phival]];       yv = Thread[yy[lval, phival]];       {xv, yv}     )          mm[n_, a_] := (       laz = xvv[n, a];       {Sqrt[laz[[1, All]]^2 + laz[[2, All]]^2], laz[[1, All]]}     )          xm2[tmax_, ni_, a_] := (       t = 0; x = 0;j=1; values = Transpose[mm[10000, a]];       While[t < tmax,        {t, x} = {t + 0.1 RandomVariate[ParetoDistribution[0.1, ni]], x} + values[[j]];j++;]; x     )          tab2[tmax_, ni_, a_] := Table[xm2[tmax, ni, a], {i, 1, 100}];          valt = Table[10^(j), {j, 1, 1.7, .2}]     Ngamm[mi_, ni_] := (       a = mi - 1;       a3 = Table[{i, MedianDeviation[tab2[i, ni - 1, a]]^2}, {i, valt}];        model = FindFit[Log[a3], aa xxx + b, {aa, b}, xxx];       aa /. model     )      Edited (I accidentaly deleted part of xm2 (j=1; and j++;)) (now it should work). mi and ni in Ngamm should be larger than 1. (range that is interesting is 1 to 5). Thank you for responses. **Edit: Now codel looks a bit better, but it is not much faster.               xm3[tmax_, ni_, a_] := Module[{augvalues =         {Accumulate[           0.1 RandomVariate[ParetoDistribution[0.1, ni], 10000]],           Accumulate[           0.1 RandomVariate[ParetoDistribution[0.1, a], 10000] Cos[             RandomReal[{0, 3.1415}, 10000]]]}, j = 1},       While[augvalues[[1, j]] < tmax, j++]; augvalues[[2, j]]]          tab2[tmax_, ni_, a_] := Table[xm3[tmax, ni, a], {i, 1, 50}];          valt = Table[10^(j), {j, 1.0, 2.8, .1}]     Ngamm[mi_,        ni_] := (a3 =         Table[{i, MedianDeviation[tab2[i, ni - 1, mi - 1]]^2}, {i, valt}];       model = FindFit[Log[a3], aa xxx + b, {aa, b}, xxx];       aa /. model)


Create ParametricFunction object without ParametricNDSolve

Documentation of v9 states that `ParametricFunction` is generated by `ParametricNDSolve` and `ParametricNDSolveValue`. Is there any way of creating `ParametricFunction` by definition, similar to creating an `InterpolatingFunction` by `Interpolation`? My motivation behind is that for certain parameters, I need solution of `ParametricNDSolveValue` to be returned and for other parameters I want to use analytical solution to be returner in the same format -`ParametricFunction`.


Speed up Select on large list

I am running this on a very large list, it is important to notice that some times the dates in v occure several times, and I want the selected list to show the same amount. This produces the right output but it is way to slow. How can I speed it up.               both={{{1996, 1, 5, 0, 0, 0.},2}, {{1996, 1, 8, 0, 0, 0.},3}, {{1996, 1, 11, 0, 0, \     0.},1}}     v={{1996, 1, 5, 0, 0, 0.}, {1996, 1, 8, 0, 0, 0.}, {1996, 1, 11, 0, 0,        0.}, {1996, 1, 11, 0, 0, 0.}, {1996, 1, 11, 0, 0, 0.}, {1996, 1, 11,        0, 0, 0.}, {1996, 1, 11, 0, 0, 0.}, {1996, 1, 11, 0, 0, 0.}, {1996,        1, 11, 0, 0, 0.}, {1996, 1, 12, 0, 0, 0.}, {1996, 1, 15, 0, 0,        0.}, {1996, 1, 16, 0, 0, 0.}}      `Select[both, Function[{f}, MatchQ[f[[1]], #]], 1] & /@ v`


Solution of Coupled Second Order ODEs with Boundary Conditions

D[Tu1[x], {x, 2}] qu - Tu1[x] (fu0 + I w p) == Tou[x] f1              D[T1[x], {x, 2}] q - T1[x] (f0 - b g0 + I w p)==       To[x] (f1 - b g1) - g1      For T1 , `Range[0, L/2]` For Tu1, `Range[L/2, La/2]` Here, there are two differential equations with coupled boundary conditions;               T1'[0]==0     Tu1[La/2] == 0     Tu1[L/2] == T1[L/2]     a4 Tu1'[L/2] == T1'[L/2]      And also,               Tou[x_] := E^(a3 x) c2 + E^(-a3 x) c3     To[x_] := 2 c1 Cosh[x a1] + a2      I know all constants in the equations. I tried following code, but I coud not get answer, " error: not the same shape "               {T1, Tu1} = {T1, Tu1} /.        DSolve[{D[T1[x], {x, 2}] q - T1[x] (f0 - b g0 + I w p) -            To[x] (f1 - b g1) + g1 == 0,          D[Tu1[x], {x, 2}] qu - Tu1[x] (fu0 + I w p) - Tu[x] f1 == 0,          T1'[0] == 0, Tu1[L/2] == T1[L/2], a4 Tu1'[L/2] == T1'[L/2],          Tu1[La/2] == 0}, {T1, Tu1}, x]      How can I find solution of differential equations?


Modelling a Rocket Launch using NDSolve

I'm trying to model a rocket launch with _Mathematica_ but I've run into a little problem since I don't know how to turn the thrust off. I'm using Newton's Law of Universal Gravitation plus an added term for the rocket's thrust and trying to find its position as a function of time. Here is the code so far (it is at a very basic stage at the moment with constant mass and no drag added, plus the thrust never stops, which is my biggest concern right now):               (*Gravitational Constant*)     G = 6.672*10^-11     (*Mass of Earth and rocket*)     M = AstronomicalData["Earth", "Mass"]     m = 2800000     (*Rocket thrust*)     T = 34020000     (*Radius of Earth*)     r = AstronomicalData["Earth", "Radius"]     (*Numerical solution modelling the gravitation interation between the \     Earth and a launching rocket*)     (*NOTE: Rocket mass will change over time; also, add in drag*)     soln = NDSolve[{        x''[t] == -((G M x[t])/(x[t]^2 + y[t]^2 + z[t]^2)^(3/2)),        y''[t] == -((G M y[t])/(x[t]^2 + y[t]^2 + z[t]^2)^(3/2)) + 0.25 T/m,        z''[t] == -((G M z[t])/(x[t]^2 + y[t]^2 + z[t]^2)^(3/2)) + 0.75 T/m,        x[0] == 0, y[0] == 0, z[0] == r, x'[0] == 0, y'[0] == 0,         z'[0] == 0}, {x[t], y[t], z[t]}, {t, 0, 20000},        MaxSteps -> 10000000, Method -> "StiffnessSwitching"]          RocketPlot =       ParametricPlot3D[{x[t], y[t], z[t]} /. soln, {t, 0, 10000000}, AxesLabel -> {x, y, z}]      Does anyone know if conditional statements can be used inside `NDSolve` so that the thrust can be stopped at a certain position or time? Any help would be appreciated, cheers guys.


Filling dependence on order of points in ListPlot

ListPlot[{{{1, 0}, {0, 0.5}}, {{1, 1}, {0, 1}}}, Filling -> {1 -> {2}},       FillingStyle -> LightGray, Joined -> True, Frame -> True]      ![Mathematica graphics](http://i.stack.imgur.com/gox6G.png) Results in no filling, whereas...               ListPlot[{{{0, 0}, {1, 0.5}}, {{0, 1}, {1, 1}}}, Filling -> {1 -> {2}},       FillingStyle -> LightGray, Joined -> True, Frame -> True]      ![](http://i.stack.imgur.com/uH2mK.png) gives the expected fill. Why does the order matter or more literally is this expected behavior and if so why?


BSplinefunction and its derivative

Hi I am trying to use curve fit some data using the `BSplinefunction`. I havent been using _Mathematica_ long, so my questions might be quite basic.               pts = {{0, 645.01`}, {5, 645.445`}, {10, 645.622`}, {15,      646.048`}, {20, 646.475`}, {25, 646.934`}, {30, 647.496`}, {35,      648.296`}, {40, 649.095`}, {45, 651.485`}, {50, 652.017`}, {55,      652.611`}, {60, 653.268`}, {65, 653.924`}, {70, 654.231`}, {75,      654.473`}, {80, 654.8`}, {85, 655.136`}, {90, 655.146`}, {95,      655.126`}, {100, 656.136`}, {105, 655.116`}, {110, 655.126`}, {115,     655.106`}, {120, 655.116`}, {125, 655.096`}}      using;               SP = BSplineFunction[pts]      I am trying to find out if there is a way to expand this function and look at its individual parts over a specified range within my dataset. I am also trying to look at the derivative of the function at a specific points by using.               SP'[pts1 = Table[{i, SP'[i]}, {i, 0, 1, .1}];      Is this the right method to get the derivative? If it isnt, I would appreciate it if someone could point in the right direction. Any help is much appreciated.


Some global variables are defined even at the start of a fresh session

In a fresh _Mathematica_ session evaluating               Names["Global`*"]      doesn't give an empty list. The result is either > >     {rhs, z} >   or contains even more elements. Is this peculiar to Linux or does it happen as well in other platforms?


Wrapping at evaluation for inline cell

I've been playing with inline evaluation and I've came to the conclusion that it's most convenient to put the `Dynamic@` inside the inline cell, so I've started to search for a way to omit typing it altogether. I've tried using `CellEvaluationFunction` and `CellProlog`, but with no luck. How can I achieve this? Also, it would be best if the wrapping with `Dynamic[]` occurred only in inline cell evaluations (which happen in ordinary text cells)


Issue with very large lists in Mathematica

I have a need to work with very large arrays of data in Mathematica. The length of the list is not known upfront. The typical size is a few hundred thousands elements and could easily go beyond a million elements in some cases. There are two major types of lists I need to work with: 1. list of real numbers, 2. list of some (different) symbolic expressions. While the list of real numbers is internally converted into packed array and does not seem to cause much performance issues, it is the second type of list (very long list of some different symbolic expressions), which is causing a major problem. It turned out that access time (get or set) to **a single** element of such lists grows **linearly** (if not faster) with the length of the list. I wrote a simple test to evaluate average access speed **per element** for such lists along with the workaround to deal with the issue: https://www.dropbox.com/s/7j9qlppmrsrmjug/CLM_DynArray_Test_204__008.nb?dl=0 . I ran the test on _Mathematica_ 7, 9, and 10. Version 7 does not have **get** issue but still has **set** issue and both versions 9 and 10 have both **get** and **set** issues. This definitely looks like an error in internal Mathematica implementation unless I missed something. I would appreciate any help with that problem. Here is the excerpt from the code above to illustrate the problem:               ClearAll["Global`*"];          nnnList = {1000, 1500, 2000, 3000, 4000, 5000, 7000, 10000, 15000, 20000, 30000,                40000 , 50000, 70000, 100000};          MinReperition = 5;     MaxLength = MinReperition*Max[nnnList];          CreationTiming[nnn_?IntegerQ, useVariables_?BooleanQ] := CreationTiming[nnn,useVariables, True];     CreationTiming[nnn_?IntegerQ, useVariables_?BooleanQ, useRepetitions_?BooleanQ] :=       Module[         {timing, noOfRepetitions, repetitionCount},         noOfRepetitions = If[useRepetitions, Ceiling[MaxLength/nnn], 1];         timing = 10^6*Mean[           Table[             If[useVariables,               Timing[vars = Table[{ToExpression["var" <> ToString[ii]]}, {ii, 1, nnn}];][[1]],               Timing[vars = Table[RandomReal[], {ii, 1, nnn}];][[1]]             ],            {repetitionCount, 1, noOfRepetitions}           ]         ];       Return[timing];     ];          AccessTiming[nnn_?IntegerQ, useVariables_?BooleanQ] :=       Module[         {timing, x, noOfRepetitions, repetitionCount},         noOfRepetitions = Ceiling[MaxLength/nnn];         CreationTiming[nnn, useVariables, False];         timing = 10^6*Mean[           Table[Timing[Do[(x = vars[[ii]]), {ii, 1, nnn}];][[1]],            {repetitionCount, 1, noOfRepetitions}]         ];       Return[timing];     ];          plotOptions = {PlotRange -> All, Frame -> True, GridLines -> Automatic};          Print["Access time per Real Table element in microseconds."];     Print[DiscretePlot[AccessTiming[nnn, False]/nnn, {nnn, nnnList}, Evaluate[plotOptions]]];          Print["Access time per variable Table element in microseconds."];     Print[DiscretePlot[AccessTiming[nnn, True]/nnn, {nnn, nnnList}, Evaluate[plotOptions]]];      **nnnList** is the list of lengths to be tested for access speed. For small list lengths it is necessary to repeat the test more times so that to obtain a better average result. For the largest list length the test will be performed MinReperition times. **CreationTiming** measures time in microseconds, which is necessary to create a Table of length **nnn**. If **useVariables** [Equal] False, then the function populates the Table with random real numbers. If **useVariables** [Equal] True, then the function populates the Table with generated symbolic variables (var1, var2, var3, etc...). **useRepetitions** [Equal] True (default) will result in multiple runs. **useRepetitions** [Equal] False will result in a single run. **AccessTiming** measures time in microseconds, which is necessary to consecutively get all the elements from a Table of length **nnn**. **DiscretePlot** plots **the time per element** to access all elements. As the time per elements grows at least linearly the total time to access all elements grows at least quadratically.


How to make the code inside Compile conciser without hurting performance?

Consider the following sample:               ie = 200;     ez = ConstantArray[0., {ie + 1}];     hy = ConstantArray[0., {ie}];          fdtd1d = Compile[{{steps}},         Module[{ez = ez, hy = hy},          Do[ez[[2 ;; -2]] += hy[[2 ;; -1]] - hy[[1 ;; -2]];            ez[[1]] = Sin[n/10];            hy[[1 ;; -1]] += ez[[2 ;; -1]] - ez[[1 ;; -2]], {n, steps}];            ez]];          fdtd1d[1000]; // AbsoluteTiming      > >     {0.0100000, Null} >   Apparently there're 2 sentences (of course in real situation there can be more) with same structure that can be represented with a function if `fdtd1d` is built with `Function`:               ie = 200;     ez = ConstantArray[0., {ie + 1}];     hy = ConstantArray[0., {ie}];          ClearAll[f];     SetAttributes[f, HoldFirst]     f[list1_, list2_, end_] :=        list1[[end ;; -end]] += (list2[[2 ;; -1]] - list2[[1 ;; -2]]);          fdtd1d = Function[{steps},         Module[{ez = ez, hy = hy},          Do[f[ez, hy, 2]; ez[[1]] = Sin[n/10.]; f[hy, ez, 1], {n, steps}];         ez]];          fdtd1d[1000]; // AbsoluteTiming      > >     {0.1050000, Null} >   But this method isn't available for `Compile`, even with the trick mentioned here:               ie = 200;     ez = ConstantArray[0., {ie + 1}];     hy = ConstantArray[0., {ie}];          ClearAll[f];     f = Function[{list1, list2, end},         list1[[end ;; -end]] += (list2[[2 ;; -1]] - list2[[1 ;; -2]]),         HoldFirst];          fdtd1d = Compile[{steps},         Module[{ez = ez, hy = hy},          Do[f[ez, hy, 2]; ez[[1]] = Sin[n/10.]; f[hy, ez, 1], {n, steps}];         ez], CompilationOptions -> {"InlineExternalDefinitions" -> True}];          << CompiledFunctionTools`     CompilePrint@fdtd1d      > Compile::argset: The assignment to Compile`FunctionVariable$1571 is illegal; > it is not valid to assign a value to an argument. >> >   >   >     …… >     1 Return Error >   So, as the title said, is there a way to make the code inside `Compile` conciser without performance decreasing or even compilation failure?


Extract Position where value is unequal to 0

When I use               Position[somelist,0]      I get the position where values are 0. But what would be the command to get the positions which are unequal to 0               Position[somelist,Unequal[0]]      doesn't work.


How to create a "standard" CDF programmatically?

How can I programmatically create a CDF which is similar to the CDFs created by `File -> CDF Export -> Standalone...`? `Export` supports CDFs but it does not use the same options as File -> Export... and it does not seem to allow setting the `WindowSize` which I also need. * * * My current solution is the following (ugly):               manip = Manipulate[Plot[k x, {x, 0, 10}], {k, 1, 5}, SaveDefinitions -> True]          Export["file.cdf",        doc = CreateDocument[manip,         ScrollingOptions -> {"VerticalScrollRange" -> Fit},          ShowCellBracket -> False,          Deployed -> True, CellContext -> Notebook,          TrackCellChangeTimes -> False]];          NotebookClose[doc]


Finding strings in Web Code

I haven't found an answer that solves my problem, although I think it's actually a simple one. It seems hard to me because I don't have a lot of experience with string patterns. I have a Web Code like               ...strings1	...strings2	...      that I have imported using               v = Import[*url*, "Table"]      I want to find these strings _string1_ , _string2_ , etc., but when I use `StringCases` like               StringCases[ToString[v], "class=test, >" ~~ x__ ~~ "	" -> x]      The code will return everything between the first `class=test, >` and the last `</td>`, resulting in something like               strings1	...strings2`      But I want all the strings between each paired `class=test, >` and `	`, I have tried to use `Overlap` without success.


Drawing a graph with specified edge lengths

I was wondering if it was possible to ask Mathematica to draw a graph provided some set of vertices: $(v_1, ..., v_N) \in V$ connected by $M$ edges $(e_1, ..., e_M) \in E$, where the length of each edge, $(l_1, ..., l_M) \in L$, is explicitly specified? Obviously I don't expect Mathematica to have a built-in semidefinite convex optimization package to find approximate solutions to the graph realization problem. Rather, I'm wondering if its possible to utilize the "ball and spring" approach Mathematica already uses for displaying arbitrary fixed edge length graphs? Update (in response to comments) - There's a lot of theory in the literature on solving this "Graph Realization Problem" for graphs with various topologies, some of the most recent focusing on semidefinite convex optimization methods. However, I'm trying to focus my question on specifically getting Mathematica to try a ball and spring minimization process to "realize" a graph provided a specified topology and set of edge lengths. Certainly if anyone knows of an SDP solver for graph realization implemented in Mathematica, I'd love to hear about it. However, I somehow doubt such an implementation exists.


Getting "Null" output from package?

I have a script written to test a package as follows:               SetDirectory[NotebookDirectory[]];     << test`          A = {{1, 2}, {3, 4}}     cp = CharacteristicPolynomial[A, L]     sol = Sum[L[n, cp], {n, 0, 1}]      Which outputs "L+ Null". The package is as follows:               BeginPackage["test`"]          L::usage="description goes here"          Begin["`Private`"]          ClearAll["Global`*"]          L[n0_,cp0_]:=         Module[{n=n0,cp=cp0},         L[n_,cp_]:=             L[n,cp]=                 Which[                     n==0,L[0]=1,                     n==1,L[1]=L,                     n==2,L[2]=Simplify[-(cp-L^2)],                     n>2 && EvenQ[n]==True,L[n]=Simplify[L[n/2] L[n/2]],                     n>2 && EvenQ[n]==False,L[n]=Simplify[L[n-1] L[1]]                     ]     ]          End[]     EndPackage[]      Essentially, my function "L[ ]" has 4 possible outputs:   when n=0 L[0]=1,   when n=1, L[1]=L,   when n=2, L[2]=Simplify[-(cp-L^2)]   when n>2 and even, L[n]=Simplify[L[n/2] L[n/2]]   when n>2 and odd, L[n]=Simplify[L[n-1] L[1]] Why is L[0,cp]= Null, when all of the other possibilities work?   If I try just L[0,cp] (no Sum[ ]) I receive no output. What does that mean?   Is Which[ ] the best method of approach in this situation?


Best way to give presentations with Mathematica

I have typically used PowerPoint or plain PDFs of slides to give presentations, but with heavy mathematical content, it can be tedious to create these presentations and make them look good. How can I best make use of Mathematica to give presentations? (I would prefer a slide-by-slide type format to what I've seen a few people do—using a regular notebook with the font size pumped up and collapsing/expanding sections as they go along.)


Choosing PrecissionGoal and AccuracyGoal for decomposed integral with NIntegrate

Assume I have a complicated integral $I$ which can feature all kinds of difficulties like infinite interval, rapidly oscillatory integrand, integrable singularities and numerically almost singular points in the integrand. Assume further that I need to compute it many times, so I need to optimize speed. I figured that I need to help Mathematica a bit to avoid problems such as `NIntegrate::slwcon` if I do not want to increase `MaxIterations`, `MinIterations`, `WorkingPrecision` a lot, which would decrease speed. So I decompose the domain of integration into several $I=I_1+I_2+I_3\ldots I_n$ ($n$ finite). `NIntegrate` behaves better now and I can manually perform integral transformations and choose well suited Methods for the different domains. However: With fixed `AccuracyGoal` and `PressicionGoal` for each of $I_i$ `NIntegrate` will choose sufficiently many sampling points and iterations to achieve these error levels, even if the total contribution of $I_i$ is negligibly small. How would you proceed (how would you choose `AccuracyGoal` and `PressicionGoal` for the individual integrands) to reduce the total number of integrand evalutations to the minimum required as to achieve given global values of `AccuracyGoal` and `PressicionGoal`? Since the integrand of $I$ is fixed I can reorder $I_i$ such that difficult but possibly small ones appear late and I can use the previous results as estimates for the total value of $I$. However assume that I do not have any analytic estimates for $I_i$.


Integration of UnitStep or HeavisideTheta

I am using Mathematica 9. If I evaluate               Integrate[Piecewise[{{1 - r, r > 0 && r < R}}, 0], r]      then I get               Piecewise[{{r - r^2/2, r > 0 && r - R < 0}}, 0]      This is wrong, because for $r>R$ it should evaluate $R-\frac{R^2}{2}$ instead of $0$. I get the correct result, if I plug in R manually. Is this a Bug? Here is some minimal test code to visualize the problem               t1[r_] = Integrate[Piecewise[{{1 - r, r > 0 && r < R}}, 0], r]     t2[r_] = Integrate[Piecewise[{{1 - r, r > 0 && r < 1}}, 0], r]     Plot[{t1[r] //. R -> 1}, {r, -0.5, 2}]     Plot[{t2[r] //. R -> 1}, {r, -0.5, 2}]      ![enter image description here](http://i.stack.imgur.com/143g7.png) The plots and the function definitions are only to visualize the problem.   * This problem also appears in a similar way when integrating UnitBox[R r]   * When using HeavisideTheta[R-Abs[r]] it doesn't even evaluate   * When using UnitStep[1-Abs[r]] and UnitStep[R-Abs[r]] both will result in the "wrong" evaluation   * Trying to use t[x_]=Integrate[...,{r,0,x}] will only make it worse, as I have to abort the evaluation after a minute or more. (same with := instead of =) I think this question is related Integral with HeavisideTheta takes too long to evaluate


Trying to find the best Pade approximant for a given numer of terms

Let suppose that I have a function $f[x]$ I want to approximate using a Pade expansion and that I decide what would be maximum number of terms to be used. Is there any way with Mathematica to find what have to be the degrees of numerator and denominator in order to have the best approximation over a given range of $x$ ? Doing this manually is, as one could expect, quite tedious. Any help and suggestion will be really appreciated.


Conditional Expectation -- How can Mathematica find a more general closed form?

Mathematica can't find a solution to this Expectation.                Expectation[f \[Conditioned] 1 - (1 - f)^k >= p, {f, k} \[Distributed]       UniformDistribution[{{0, 1}, {2, 5}}],Assumptions->{p>0}]      But it can find solutions when I substitute specific rational numbers for p. Here's an example                Expectation[      f \[Conditioned] 1 - (1 - f)^k >= 3/11, {f, k} \[Distributed]       UniformDistribution[{{0, 1}, {2, 5}}]]      It can even find solutions when I substitute transcendentals for p. Here's an example.                Expectation[      f \[Conditioned] 1 - (1 - f)^k >= 1/\[Pi], {f, k} \[Distributed]       UniformDistribution[{{0, 1}, {2, 5}}]]      Is there some assumption I could add to the Expectation that would let Mathematica find a general solution? I've played around with various ideas such as p>0 but I can't find anything that works. Alternatively, can someone explain why Mathematica can't find a general solution? P.S. If anyone cares, this question arises out of an attempt to understand subsidized insurance markets. Ultimately, I would like to use things fancier than UniformDistribution over which to compute the Expectation, but until I can get a close form solution to this simple case, more challenging cases look impractical.


How can I get Overlay to position graphics according to coordinates?

If I draw graphics like this, I get exactly what I need:               Graphics[{{Blue, Disk[{0, 0}, 10, {0, Pi/2}]}, {Red,         Disk[{0, 0}, 3, {0, Pi/4}]}}]      ![enter image description here](http://i.stack.imgur.com/GAtsU.png) But I need to accomplish this task with `Overlay[]`. Here's the code:               graphics1 = Graphics[{Red, Disk[{0, 0}, 3, {0, Pi/4}]}];       graphics2 = Graphics[{Blue, Disk[{0, 0}, 10, {0, Pi/2}]}];       Overlay[{graphics2, graphics1}]      And I get this as output:   ![enter image description here](http://i.stack.imgur.com/allsb.png) How can I position these graphics according to coordinates?   Thank you for any suggestions or answers.


Partitioning time series data in sublists by their duration

I would like to do calculations on irregularly sampled time series data at intervals - for example on an hourly basis - rather than over the whole time series. The entire dataset is split up by time into sublists of continuous data, so there are no large gaps in time within a sublist. Each data point includes a time value, but the data are not uniformly distributed in time, so the index of the numbers cannot be used as a proxy for duration and I could not find a way to use Partition. The data is in a list of several sublists (varying length) - these are the continuous datasets. I'd like to keep these sublists, but do the calculations at intervals (e.g. hourly) within the sublists. Each continuous dataset contains another set of sublists, one for each data point, in which there are elements (a fixed number) corresponding to each measurement type and the time. I think I need to somehow split the data first by duration into another layer of sublists, and then apply the same calculations to the sublists. For more information: The code I currently have assigns names to each data type and calculates background values within the second layer of lists as follows.               co=#[[All,1]]&/@mainlist;     co2=#[[All,3]]&/@mainlist;          co2int=#[0]&/@(LinearModelFit[{#[[All,1]],#[[All,3]]}tr,{1,x},x]&/@mainlist;     (*calculating the intercept using two measurement types*)     co2corr=co2-co2int;     (*using the intercept to correct CO2 background*)          times=#[[All,15]]&/@mainlist;      I'd like to do similar calculations but for hourly datasets within each sublist rather than to each sublist as a whole. The data structure looks something like this:               mainlist=     {       {(*first cts dataset*)         (*{co,coerr,co2,co2err,...,{yyyy,MM,dd,hh,mm,ss}}*)          {2*10^18,0.3,2*10^20,0.41,...{2004,12,18,04,18,22}},         ...,         {3*10^18,0.35,2.1*10^20,0.42,...{2004,12,18,06,19,42}}       },       ...(*further cts datasets*)       {(*final cts dataset*)          {2.3*10^18,...,{2004,12,29,19,4,53}},         ...       }     }      Many thanks.


Iteration process involving several functions

I would like to carry out a following iteration process:   Apply function `f1[a_,b_,c_,d_]` to a starting list `l1={a1,b1,c1,d1}`, which will result in `l2={a2,b2,c2,d2}`. Then apply function `f2[a_,b_,c_,d_]` to list `l2` to get `l3={a3,b3,c3,d3}`. Finally apply function `f3[a_,b_,c_,d_]` to list `l3` to get `l4={a4,b4,c4,d4}`. As soon as this is over, I would like `{a4,b4,c4,d4}` to be the starting values of the process, in other words to start the procedure with values of `l4` obtained in the previous step. This should repeat until `l1` and `l4` in the same step are identical. It would be also good if I could get lists `l1`,...,`l4` from the last step returned at the end of the process. Any idea how can I do it in _Mathematica_? I couldn't find a similar problem solved on the net. I read all about `FixedPoint`, `NestWhile` and `Fold` in the documentation, but I still don't know how to apply it to this problem, so I'd be grateful for all tips and advices. Functions `f1`,...,`f3` are a bit complicated and involve reading values from dll library. Let's say they look like this one:               f1[{a_,b_,c_,d_}]:={       afrombc[b-0.2,c],       b-0.2,       c,       dfromab[afrombc[b-0.2,c],b-0.2]     }      `afrombc[]` and `dfromab[]` are predefined functions connected with dll library.


How to deal with matrices involved in system of SDEs?

This question is in continuation of the the previous posts Solving Stochastic differential equation and Fast Simulations with Compile. What I want to do is numerically solving the epidemic model which can be defined as a system of stochastic differential equations (given below) by Euler-Maruyama method: $$ \begin{array}{lll} dx_1&=& (-m_{12}x_1+m_{21}x_2)dt+\sqrt{\frac{m_{12}x_1+m_{21}x_2}{2}}(dw_1-dw_2),\\\ dx_2&=&(m_{12}x_1-m_{21}x_2)dt+\sqrt{\frac{m_{12}x_1+m_{21}x_2}{2}}(-dw_1+dw_2). \end{array} $$ It can also be written in a more similar form as follows $$ \left(\begin{array}{c}dx_1 \\\dx_2\end{array}\right)=\left(\begin{array}{c}-m_{12}x_1+m_{21}x_2 \\\m_{12}x_1-m_{21}x_2\end{array}\right)dt +\left( \begin{array}{cc} m_{12} x_1+m_{21} x_2 & -m_{12} x_1-m_{21} x_2 \\\ -m_{12} x_1-m_{21} x_2 & m_{12} x_1+m_{21} x_2 \end{array} \right)^{1/2}\left(\begin{array}{c}dw_1 \\\dw_2\end{array}\right), $$ where $0\leq t\leq T=100$, $x_1(0)=950$, $x_2(0)=50$, $m_{12}=\frac{0.04x_2}{x_1+x_2}$ and $m_{21}=0.01$. $w_1$ and $w_2$ are two independent standard Wiener processes. I want to implement EM method or Milsetin method for finding some sample paths of this It$\hat{\text{o}}$ SDE, but there is a need for computing the (principal) matrix square root at each time discretization. For this, one may use the following code for computing matrix functions:               FunM[fun_, X_] :=       Module[{faux, dim, mataux, JordanD, sim, JordanF, eps, fdiag, diagQ,         fauxD}, (dim = Length@X;         faux[xx_, i_, j_] :=          Which[i <= j, 1/Abs[i - j]! (D[fun, {x, Abs[i - j]}]) /. x -> xx,           True, 0];        mataux[Y_] :=          Table[faux[Y[[i, j]], i, j], {i, 1, dim}, {j, 1, dim}];         JordanD = JordanDecomposition[X] // N; sim = JordanD[[1]];         JordanF = JordanD[[2]];        eps = 1*10^-10;         diagQ = Norm[JordanF - DiagonalMatrix[Diagonal[JordanF]]];        fauxD[xx_] := (fun) /. x -> xx;         fdiag := DiagonalMatrix[Map[fauxD, Diagonal[JordanF]]];        Which[diagQ < eps, sim.fdiag.Inverse[sim], True,          sim.mataux[JordanF].Inverse[sim]])]      Although I used this, I failed to implement EM and Milestin methods. I will be grateful if someone put some hints or answers for implementing EM for the above SDE.


Why is parallel slower?

I always assumed that distributing a computation is faster, but it isn't necessarily true. When I do `Sum[i,{i,10^4}]` I retrieve an answer much faster then if I do `ParallelSum[i,{i,10^4}]`. Why is this the case? Is there a certain rule on when I should compute in parallel and when I should stick to a single core?


How to plot partial derivative of an integral vs. another variable?

Just to take an example, because my original numerical integral was too complex:               T[t_] = NIntegrate[Exp[(eta - 1)*t], {eta, 0, 4}]      But when I am using                Plot[D[T[t],t],{t,0,1}]      It seems it doesn't work. How can I plot the derivative of the integral?


Recursive function for calculating the arithmetic mean of a vector

I want to write recursive function for calculating the arithmetic mean of a vector. For $X(n)=\\{1,2,3,\ldots, n\\}$, the formula is ${\rm Mean}(X(n))=((n-1)\, {\rm Mean}((X(n-1))+X_n)/n$. My program works in my R-language version, but here in _Mathematica_ it takes in account only the last two number. How can I fix my code?               Meen[x_] := (        If[Length[x] == 1,           Return[x],          n = Length[x] - 1;           y = x[[1 ;; n]];           result = 1/(n + 1)*(n*Meen[x[[1 ;; n]]]  + x[[n + 1]])]        )          X = {1, 2, 3, 4, 5};     Meen[X]      > >     {9/5} >


Moving the start of a graph to the right, finding maxima in an oscillator

I have the following code written to simulate a driven damped oscillator               Clear[x, v, K];     K = 5.0;      m = 0.75;      b = 0.05;      Fo = 0.75;      Ω = 2.80;     x[0] = 0.; v[0] = 0.;          FinalTime = 150;      Δt = 0.005;      Steps = Round[FinalTime/ Δt];          Do[t = n*Δt;       F[n] = - K*x[n] - b*v[n] + Fo*Sin[Ω*t];       v[n + 1] = v[n] + (F[n]/m)*Δt;       x[n + 1] = x[n] + v[n + 1]*Δt,       {n, 0, Steps}];          xdata = Table[{n*Δt, x[n]}, {n, 0, Steps}];          ListPlot[xdata, AxesLabel -> {"t", "x[t]"},      PlotLabel -> "Driving Frequency = 2.80 ",      PlotStyle -> PointSize[0.0005]]      I am a newbie to Mathematica, so understand that first; the class this is for is more a mechanics lab than Mathematica course (supposedly). Anyhow. I get with this a nice graph of the oscillator, and I can see where it eventually settles into steady-state. I wanted to know how to do a couple of things.   1. Move the start of the graph from zero to the right -- say start it at 100 -- so that the steady-state amplitude and frequency are easier to see.    2. Show where the maxima are (part of this exercise is the relation between riving frequency and amplitude)    3. I'd really like to display more than one driving frequency (the capital omega) on the same graph, showing that the eventual steady-state frequency depends on the mass only.  I hope it's clear what I want to do. The reason is partly that while I can take a measure of the steady-state frequency by just measuring it from the screen I wanted a better way to do that. Anyhow, any help is appreciated. If I have approached this in entirely the wrong way let me know. And I hope this hasn't been too redundant -- i couldn't find anything on here that seemed to match exactly what i needed to do and this is one of those situations where I am learning this on the fly.


How to substitue local variables into expression with free variables?

I'm wondering how to do the following:                   expr = L + R;              foo[L_, R_] := expr;              foo[1, 2]               (* L + R *)      and have it substitute the function variables into the expression. I realize that I could create dummy variables and do it like               foo[l_, r_] := expr /. L->l /. R->r      but my actual expression has a lot of free variables, and so I would like to know if there is a simpler way.


Question on accuracy and precision of NIntegrate

As a Mathematica newbie, I was testing the accuracy/precision of NIntegrate (9.0.1.0 on Mac) and have obtained a very peculiar result.               f[x_] := (1/2) PDF[NormalDistribution[-100, 1], x]         + (1/2) PDF[NormalDistribution[+100, 1], x]     g[n_] := NIntegrate[f[x] Log2[1/f[x]], {x, -Infinity, Infinity},         AccuracyGoal -> Infinity, PrecisionGoal -> Automatic,         MaxRecursion -> 1000, WorkingPrecision -> n]     Plot[g[n], {n, 50, 100}]      ![Output](http://i.stack.imgur.com/LfN8P.png) The correct value, which cannot be calculated analytically, should be around 3.0471. There was no error message for any value of n. I am not interested in calculating this specific integral, but I am curious whether there is any way I can feel assured that the numerical value Mathematica returns is correct and by how much. In comparison, the GNU Scientific Library gives me an error bound (although it uses machine floating point numbers, which can be another source of trouble).


Randomness test suites that can be invoked from Mathematica

There are several test suites referenced at csrc.nist.gov designed to test a (pseudo-)random byte sequence for randomness, and discover possible skews, correlations, patterns, or other hidden non-randomness in it. Are there implementations of any of them or other similar test suites in _Mathematica_? Or some precompiled libraries (including _Java_ or _.NET_ modules) that can be invoked from _Mathematica_ running on _Windows_?


Operations on online files via public URL access

I need _Mathematica_ to access an online public directory via some URL (fake in this case) http://example.com/images and perform operations similar to those _Mathematica_ can do on OS directories and files. Examples:   1. Get all files names - like: {image1.png, image2.png, ...}   2. Import files into _Mathematica_   3. Get various files info What is an efficient way to do it if it's possible at all?


Assigning row of values to a lower triangular matrix

I want to assign a linear row of values to the elements of a lower triangular matrix, i.e., if the row of values is {1,2,3,4}, then the matrix (4 X 4) should be:               {{1,0,0,0},{2,1,0,0},{3,2,1,0},{4,3,2,1}}      _**I can do this with a (nested) For loop, but was wondering if there was any easier way._** Thank you for your help and time in advance


Why do two codes give different output?

I have tried the following to get the eigenvalues of several matrices of the type:               J := D[{i - l*r - ux*r*x - uy*r*y, -mx*x + ex*ux*r*x, -my*y +        ey*uy*r*y}, {{r, x, y}}] // StandardForm      Then with three possible solutions given by `Solve`               FullSimplify[J/. Solve[i - l*r - ux*r*x - uy*r*y == 0 && -mx*x + ex*ux*r*x ==       0 && -my*y + ey*uy*r*y == 0, {r, x, y}]]     Eigenvalues[%[[1]]]      But it does not give me the eigenvalues, it just outputs: > Eigenvalues[{{-l, -((i ux)/l), -((i uy)/l)}, {0, -mx + (ex i ux)/l, 0}, {0, > 0, -my + (ey i uy)/l}}] Only the following code gives them:               FullSimplify[J/. Solve[i - l*r - ux*r*x - uy*r*y == 0 && -mx*x + ex*ux*r*x ==       0 && -my*y + ey*uy*r*y == 0, {r, x, y}]]     %[[1]]     Eigenvalues[%]      Why? In other words, why is               Function[%[[1]]]       different from               %[[1]]     Function[%]      ?


Cropping an image to a minimum bounding box for a set of points

Imagine a define a pointlist inside of an image: ![enter image description here](http://i.stack.imgur.com/quvDb.png) Provided a pointlist for the set of red dots around the toy horse, is there a way for me to automatically crop to a minimum bounding box for this set of points?


What determines the value of $MaxNumber?

What determines the value of `$MaxNumber`?               $MaxNumber      > >     1.233433712981650*10^323228458 >   _Mathematica_ can instantly calculate:               44787922`!      > >     1.0809571*10^323228455 >   But refuses to calculate: > 44787923`! > > During evaluation of In[3]:= General::ovfl: Overflow occurred in > computation. >> >   >   >     Overflow[] >   It seems like an arbitrary cutoff rather than a limitation of the system.


How to embed fonts when exporting Mathematica graphics as PDF

Upon exporting a Mathematica graphics expression as a PDF, Mathematica does not seem to embed any nonstandard fonts used. When you open the resulting PDF document with a PDF viewer, all the text items are rendered with standard fonts instead. Is there a way to make Mathematica embed nonstandard fonts? Example with Mathematica 8.0.4 under Mac OS X 10.7:               g = Graphics[{ Circle[],         Text["Sample",          BaseStyle -> {FontFamily -> "Papyrus", FontWeight -> "Bold",            FontSize -> 24}]}, ImageSize -> Tiny]     f = Export["~/Desktop/Graphics.PDF", g, "PDF"]      The resulting PDF does not use the correct font.


Error checking and trapping techniques with Throw and Catch

Mathematica provides several mechanisms for checking arguments and trapping errors in a function definition. Typical methods are : Definitions with argument patterns, definitions with `Condition`, definitions with `Which` or `Switch`. All of them combined with `Message` I have also seen a technique which uses `Throw` and `Catch`. This is probably not so well-known. Perhaps someone could explain how it works and possible pros and cons/limits?


How can I determine the hyperlink of a currently opened documentation page programmatically?

Every pages in the documentation has a hyperlink. Here are some examples:               "paclet:ref/NotebookRead"     "paclet:guide/GraphStylingAndLabeling"     "paclet:tutorial/ListsOverview"      Well, my question is: If I open a docs page, then how can I get the hyperlink of it programmatically? ## my tries Till now, I can get the `NotebookInformation` of documentation notebooks (if it exist):               Select[NotebookInformation /@           Notebooks[], ("DocumentType" /. #) == "Help" &]      The output might be:               {{"FileName" ->         FrontEnd`FileName[{$RootDirectory, "C:", "Program Files",       "Wolfram Research", "Mathematica", "9.0", "Documentation",       "ChineseSimplified", "System", "Tutorials"}, "ListsOverview.nb",           CharacterEncoding -> "CP936"],        "FileModificationTime" -> 3.56977*10^9,       "WindowTitle" -> "List - Wolfram Mathematica",      "MemoryModificationTime" -> 3.58634*10^9,        "ModifiedInMemory" -> True, "DocumentType" -> "Help",       "StyleDefinitions" -> {NotebookObject[         FrontEndObject[LinkObject["d5i_shm", 3, 1]], 46]}}}      But I don't know what to do next. The correspondence between the `FileName` and hyperlink seems to be confusing.


CUDA: setting grid dimensions

I'm new to CUDA, and CUDALink. I see how CUDAFunctionLoad allows one to set the block dimensions. On calling the function, you can also either pass as argument or have MMA automatically select the number of threads to be launched as the max length of the arguments passed. However, I don't see how I can set the grid dimensions if I want a bidimensional grid. It should be possible, right?


Character edge finding

The following line of code finds the edge of a character:               pic = Binarize[GradientFilter[Rasterize[Style["\[Euro]", FontFamily -> "Times"],                                    ImageSize -> 200] // Image, 1]]      ![Mathematica graphics](http://i.stack.imgur.com/PCnxH.png) The coordinates of the edges can be found as follows:               pdata = Position[ImageData[pic], 1];      Test:               Graphics[Point[pdata]]      ![Mathematica graphics](http://i.stack.imgur.com/OQSw8.png) However, the points are not sorted in an order usable by `Line` or `Polygon`:               Graphics[Polygon[pdata]]      ![Mathematica graphics](http://i.stack.imgur.com/Wiw6L.png) This brings me to my question:   * What would be an efficient method to sort the coordinates so that it would plot properly with `Line` or `Polygon`? Additionally,   * How to thin and smooth the set of points?   * How to deal with characters with holes in them, like the ones below? ![Mathematica graphics](http://i.stack.imgur.com/92FKS.png) or ![Mathematica graphics](http://i.stack.imgur.com/dM7jQ.png)


How do I use FinancialData to obtain company revenue and income?

I'd like to make a plot of a company's revenue and income over time. I can do this via Wolfram Alpha pretty easily, just by searching "Ford revenue and earnings from 2000 to 2012". As such I can, if necessary, tease out the data from a corresponding `WolframAlpha` call. Rather than resorting to Wolfram Alpha, I assumed `FinancialData` would be more appropriate. Surprisingly, from an initial inspection of the docs, it does not seems like there is an easy way to get these two particular properties. My question is - can I reliably calculate revenue and/or net income (i.e. profit) from the supported properties of `FinancialData`? Perhaps based off of `EarningsPerShare`?


Axis labels are clipped (in BarChart)

I have created a bar chart with the below code. My $x$ axis labels have been cut in half for some reason. My $x$ axis heading is also missing. I tried using `Placed -> Below` instead of `Placed -> Axis` as proposed in an answer to a similar question about labels bieng cut in half but this does not seem to work at all with my version ( _Mathematica_ 9). When I resize the chart the axis labels eventually stop bieng cut in half when the chart is huge but my main $x$ axis heading is still missing. I can't use Labeled `[{xheading,yheading}, {position,position}]` becasue it is not a graphics object and I need my bar chart to be a graphics object so I can use it in `Show` later.               data = {{71.74887892, 75.81967213}, {75.81120944, 77.88018433},             {0.6600660066, 1.673640167}, {84.74576271, 79.34782609},             {76.4, 79.49790795}, {78.84267631, 80.11782032},             {71.51515152, 74.30249633}, {85.57692308, 79.37062937},             {71.875, 74.3772242}, {66.28477905, 64.25233645},             {1.490066225, 1.914414414}, {1.474926254, 1.763224181}};     dataLabel = {"DT401       ", "DT402       ", "DT403       ", "DT404       ",                   "DT405       ", "DT406       ", "DT407       ", "DT408       ",                   "DT409       ", "DT410       ", "DT411       ", "DT412       "};     label = "Truck";          BarChart[data, PlotRange -> {{0, 25}, {0, 100}},       ChartLabels -> {Placed[l, Axis], Placed[{"", ""}, Bottom]},       PlotLabel -> label,       AxesLabel -> {label, label}]      ![enter image description here](http://i.stack.imgur.com/ZUpuW.jpg)


ReplacePart inside For loop

I am trying to replace the last column of the following expression (`mat`) by doing               mat = {{1, 2}, {1, 4}};     For[q = 1, q < 3, q +=1,       If[mat[[q, 2]] < 3, ReplacePart[mat, {q, 2} -> -1], ReplacePart[mat, {q, 2} -> 1]];]      So I expect to get               mat = {{1, -1}, {1, 1}}      But nothing changes. Do you have any idea why it does not work?


Quantity and Trig functions

I have a bunch of data to which I've assigned units using `Quantity`, including some angular measurements in degrees. I'd like to be able to use these measurements with trigonometric functions, but it seems that trig functions don't "know" about `Quantity`, so I'm forced to convert those measurements to radians and then apply the trig function to the magnitudes, like this:               x = Quantity[23.4, "AngularDegrees"]     Cos[QuantityMagnitude @ UnitConvert[x, "Radians"]]      This works, but it's slow and seems clunky, at best. Is there a more elegant (and hopefully faster) approach?


Strange behavior using variable in Exists

I came across a behavior that doesn't make sense to me when I tried to use Exists in Reduce. If I run commands:               l = {a0, a1, x};     Reduce[Exists[l , a1 != 0 && a0 + a1 x == 0 && a1 < 0], Reals]      I get output:               a1 < 0 && a0 == -a1 x      But if I run command:               Reduce[Exists[{a0, a1, x} , a1 != 0 && a0 + a1 x == 0 && a1 < 0], Reals]      I get output:               True      I think the problem is in exists part:               Exists[l, a1 != 0 && a0 + a1 x == 0 && a1 < 0]      Gives output               a1 != 0 && a0 + a1 x == 0 && a1 < 0      And               Exists[{a0, a1, x} , a1 != 0 && a0 + a1 x == 0 && a1 < 0]      Gives output (which I think is correct):               \!\(\*SubscriptBox[\(\[Exists]\), \({a0, a1, x}\)]\((a1 != 0 && a0 + a1\ x == 0 && a1 < 0)\)\)      Can somebody explain what is going on there and how could I use variable in Exists if this not the correct way?


Can I get access to Amazon's AWS API within Mathematica?

Has anyone tried access Amazon AWS API from _Mathematica_ , I'm assuming the HTTP WebService module of _Mathematica_ would be a starting point. Any suggestions on getting started would be welcome.


Creating plot markers with centered text

I want to create a series of plot markers which are circles, squares etc. with 2-3 letter codes centered within the marker. My current attempt looks like this:               {     t4dot =  Graphics[{Green, Disk[{0, 0}, ImageScaled[0.07]],                Style[Text["T4"], Yellow, Bold, 18]}],     gk1dot = Graphics[{Red, Rectangle[{0, 0}],                Style[Text["Gk1", {0.5, 0.5}], Yellow, Bold, 14]}]     }      which makes: ![enter image description here](http://i.stack.imgur.com/UB4eO.jpg) The "T4" marker is about right (although the centering is an issue). Obviously, I haven't been able to get `rectangle[]` to scale properly. When I tried to use these graphics as plot markers the circle and rectangle were huge and swamped the graph whilst the text stayed the same size. I am aiming to make markers for which the graphics primitive and the text are nicely centered and scale as a group. I want to be able to call the resulting graphics with something like:               ListPlot[{{5, 7}, {4, 6}}, PlotMarkers -> {{t4dot, 16}, {gk1dot, 18}},       PlotRange -> {{3, 6}, {3, 8}}, ImagePadding -> 35]      Any ideas about how to achieve this? Also, I have looked here and here and I noticed that Mathematica often offsets the text towards the top-left corner of the graphic. Is there a way to overcome this?


ListPlot3D - How to make the Color depending on a second list

From a simulation (solid state physcis) i obtained a `list1={{300,0,0},...}` with x values=300,400,...,1500 and y-values=0,0.08,...,20 and z values. I plotted them using `ListPlot3D`. I want to investigate the change in z value for fixed y, i.e. does z value change a lot for a given y in the range of all x values. Therefore I want to make a coloring like this:   1. If z' value of {x',y',z'} is equal to z value at {x=300,y',z} then it should be Gray   2. If z' value of {x',y',z'} is lower than z value at {x=300,y',z}: going from Yellow to Red   3. If z' value of {x',y',z'} is higher than z value at {x=300,y',z}: going from Green to Blue How can I do that? I tried the following:   * Manipulation of list1 to get list2={0,0.3,...}, which has same amount of elements as points (x,y,z) in list1 and same ordering,    * The values in list2 are 0.5 when point at same position in list1 satiesfies 1)   * The values in list2 are < 0.5 when point at same position in list1 satiesfies 2)   * The values in list2 are > 0.5 when point at same position in list1 satiesfies 3) I tried to use a colorfunction:               colorf =  Blend[{{0, Blue}, {0.49, Green}, {0.5, Gray},{0.51, Yellow}, {1,Red}}, #] &;     ListPlot3D[list1,ColorFunction->colorf/@ list2]      I do get a coloring but not the correct one. I checked by exchanging all z values in list1 with values in list2 and made a density plot and colors are at different postions. Is there any solution to make the color like I want to have it?


Optimization of correlation calculation

How can I make the following line of code run faster? Is there a way to do this calculation as a matrix vs vector than vector vs vector? In the code below, `f` is a matrix with one more row than `vector`. `f` has many columns and `vector` has only one column.               vector=RandomReal[1,100000];     f=RandomReal[1,{100001,520}];     pearson = Map[Correlation[f[[2 ;;, #]], vector] &, Range[5, Dimensions[f][[2]]]];


Dashed line with alternating colored dashes

I am doing a plot where I have multiple shaded regions, and I want the line that separates the two regions to be dashed with dashes being alternating colors (so the demarcation stands out from both regions). For example, say I am plotting the two regions shown here               Plot[{1, Abs[BesselJ[1, x]]}, {x, 0, 20}, Filling -> Axis]      ![enter image description here](http://i.stack.imgur.com/z26zI.jpg) The only way I could think to add the dashing was using `ColorFunction`, but it doesn't give what I'm looking for:               bgplot = Plot[{1, Abs[BesselJ[1, x]]}, {x, 0, 20},       Filling -> Axis, PlotStyle -> {Automatic, None}];     dashplot = Plot[Abs[BesselJ[1, x]], {x, 0, 20},       PlotStyle -> Thickness[.01],        ColorFunction -> (If[EvenQ[Floor[#]], Black, White]&),       ColorFunctionScaling -> False, PlotPoints -> 500];     Show[bgplot, dashplot]      ![enter image description here](http://i.stack.imgur.com/QgojW.jpg) This is almost what I want, but the dashes are all the same length in the x-coordinate, whereas I'd prefer they be the same total length. Also, I have to have `PlotPoints` set to an unreasonably high value to avoid any gray regions. Any ideas how to do this better?


Differential equations with jump conditions

Suppose I want to solve an ODE with a `DiracDelta` source term. In the following example, `DSolve` does it correctly while `NDSolve` (understandably) misses the Delta and provides the solution corresponding to a zero right hand side:               ex = y /. First[DSolve[{y'[x] + y[x] == DiracDelta[x - 1], y[2] == 1}, y, x]];     nu = y /. First[NDSolve[{y'[x] + y[x] == DiracDelta[x - 1] , y[2] == 1}, y, {x, 0.1, 2}]];     Plot[ex[t], {t, 0.9, 1.1}]     Plot[nu[t], {t, 0.9, 1.1}]      `Plot` of `DSolve` solution ![Plot of DSolve solution](http://i.stack.imgur.com/3CYaZ.gif) `Plot` of `NDSolve` Solution ![enter image description here](http://i.stack.imgur.com/29elo.gif) Is there anyway around this using `NDSolve` (without converting the system to integral form)? I'd be happy to lend `NDSolve` a hand, say by telling it to look for a piecewise continuous solution (`{x,0.1,1,2}`) and provide jump conditions (in the above example `y(1+eps) - y(1-eps) == 1`). (`DSolve` does not solve the real equations I am really interested in... they are multidimensional, nonlinear, and a bit too messy to replicate here).


Leave expression tree formatting the same when a replacement rule is applied

If I type `e1 := 3 x + 2 (1 + y) z // TreeForm`, I get an expression tree. If I then type `e1 /. x -> 3`, I get another prefectly correct expression tree. Is there a way that I can get `TreeForm`'s formatting to keep the nodes in the same location after the transformation?


> `TINV()` returns the t-value of the Student's t-distribution as a function > of the probability and the degrees of freedom. For example `TINV(0.475,42) = > 0.720842172`. (source) What is the Mathematica equivalent for the Excel function tinv()?


How to draw an ellipse arc in 3D?

There is no Circle or Disk object in 3D. I quickly found a way to use Cylinder (thin lines, no faces, very flat):               Module[{s},     Graphics3D[{EdgeForm[Thickness[Small]], FaceForm[None],        Cylinder[{s = {1/2, 1/2, 1/2}, s + {0, 1/1000, -2/1000}}, 1/2]},        Axes -> True, AxesLabel -> {"x", "y", "z"},        PlotRange -> {{0, 1}, {0, 1}, {0, 1}}]]      ![3D circle](http://i.stack.imgur.com/cWkT1.png) But   * orientation of the cylinder is tricky,    * choice of coordinate shift is dependent on graphics size and magnification. I have to take into account the parameters of relative thickness,   * it requires me to make a few auxiliary functions (without speaking for instance if I want to define a circle by center, radius and angles to the axis, or by three points)    * I cannot only draw an arc between 2 angle positions nor make it elliptical.  If I want all this, am I forced to recreate the wheel and construct computationally a 3D polygon approximating an ellipse ?


Export image data precision

I'm sure there is a very easy way to control this, but I have been searching for an hour now without luck. I plot a function and export it to get a table that I can use in TikZ.               Plot[{AiryAi[x], AiryBi[x]}, {x, -20, 10}]     Export["airyfunctions.dat", %]      The resulting .dat file has numbers with about 16-17 digits (e.g. `4.044732860029933`) whereas I'd like them to have about 5 digits of precision. Also, the table currently separates the coordinates from the plot like: `{x_1,y_1}, {x_2,y_2}, {x_3,y_3}`. I'd prefer if they were formatted instead with spaces `x_1 y_1` and newlines. I tried using `"FieldSeparators" -> " "` without luck.


Learning Finance with Mathematica

## Background My math background is strong by CS standards, probably normal by mathematica standards. (i.e. familiarity with real analysis, linear algebra, managed to read the proof of the prime number theorem :-) ) The goal here is NOT to start a hedge fund of sorts; it's mainly to pick up the basics of financial / stock market background (but it's much more fun when I'm playing with real data / writing programs rather than just reading a textbook.) I want to play around with learning the basics of finance (and writing some serious code in Mathematica). Ideally, I want to "learn by doing" -- i.e. rather than just read textbook formulas, I would like to:   * play with real world stock data   * implement the various definitions / algorithms / functions and see how they work Looking around, the best I have found is this book: Computational Financial Mathematics using MATHEMATICA®: Optimal Trading in Stocks and Options Seems like the most highly recommended However, since I'm clueless, I would like to get some feedback (and suggestions for other resources to use for learning.) Thanks!


Import Spreadsheet Data and DeleteCases of empty cells &/or choosing a Range to import

I am importing Excel spreadsheet data into Mathematica. Here is what the data looks like, notice the cell Q1 with "sdf": ![enter image description here](http://i.stack.imgur.com/kQ7rU.png) I import this data by specifying the Spreadsheet location, sheet name, top 9, left 7, drop the Header Row and **delete empty values** :               Dataset1 =        DeleteCases[        Drop[Import[           "c:\\GraphingSoftware\\Book2.xlsx", {"Sheets", "Sheet2"}][[9 ;;, 7 ;;]], 1], ""];          FullForm[Dataset1]          List[List[126.7, 55.3, 113.8, 96.9, 47.8, 74.6, 71.9, 55.2, "", "", ""]      The results contain the emtpy cell values upto the "sdf" column. I want to be able to remove empty values with the `DeleteCases` function but it doesn't work. The documentation doesn't indicate if you can specify the number of columns and that would be really useful. To save the day I simply want to delete empty cells or even better specify the number of columns so empty columns aren't included. Help as always is much appreciated.


Complex queries to MS SQL Server

I'm using DatabaseLink to query MS SQL Server with SQLExecute which works totaly fine, for ex.:               SQLExecute[conn, "declare @dt date;     select * from ttable where date=@dt"]      However the problem starts when i try to use table variable and try to return it, for ex.:               SQLExecute[conn, "declare @dt date;     declare @tab table(     var1 int     date date)     insert into @tab     select * from ttable where date=@dt;     select * from @tab"]      It returns the number of rows and not the table. Is there a way to solve that? It seems that Mathematica returns results for the 'insert' statement, not the final results.


Exporting a sequence of graphs as video efficiently

I have a sequence of graphs that are being created within Mathematica which I'm exporting to create an animated plot of the graph, as follows. ![animation example](http://i.stack.imgur.com/uM411.gif)               startTime = 0;     endTime = 5;     secondsPerFrame = 1/30;          sampleData = {#, #^3 - 5*#^2 + #} & /@ Range[startTime, endTime, secondsPerFrame];     {tList, xList} = sampleData\[Transpose];          timeInformationLocation = {0.2 + Min@tList, 0.9*Max@xList};     timeInformation =         Graphics[Text[           "Time: " <> ToString[NumberForm[N[#1], {10, 2}]] <> " s",            timeInformationLocation, {-1, 0}, BaseStyle -> {Black, 16}]] &;           evaluationInitialTime = AbsoluteTime[];           graphListForExport =         ParallelTable[         Show[ListPlot[Select[Transpose[{tList, xList}], #[[1]] < tdummy &],            PlotRange -> {1.1*{0, Max@tList}, 1.1*{Min@xList, Max@xList}},            AxesOrigin -> {0, 0}, AxesLabel -> {"time / s", "position / m"},            LabelStyle -> {Black, 16}, ImageSize -> 440,            PlotMarkers -> {Automatic, 6}],           timeInformation[tdummy]], {tdummy, startTime + secondsPerFrame,           endTime, secondsPerFrame}];      Print[Row[{"List of graphs completed at ", AbsoluteTime[] - evaluationInitialTime}]];           SetDirectory[NotebookDirectory[]];      Export["sample.mov", graphListForExport];           Print[Row[{"Export completed at ", AbsoluteTime[] - evaluationInitialTime}]];      Unfortunately, exporting the images is very slow; for the sample code above to export 150 frames, my system takes ~9s to generate the list of graphs, but another ~90s to export the list into the .mov format. > The question is, how can I optimize exporting a list of `Graphics` as a > video? There are several things which possibly could be done to improve the code. Firstly, when making the list of graphs, I could have chosen to use `Graphics` instead, which is likely to be faster. However, as most of the time seems to be taken up in the export step, I would like to focus on that first. Since I would be processing the video in other software afterwards, I considered encoding the video in another format. However, while saving the video as `.avi` leads to some performance improvements (~60s for export versus ~90s), it is still rather slow. Other formats seem to be even slower than .mov, although I don't have the hard numbers for this specific example. I also attempted to export the graphs immediately as a list of images that I could string together again via `ffmpeg`. Again, there was no significant performance improvement, and considering the additional work that has to be done to produce the final video, I'm not sure whether it is worth it. Halirutan suggested in chat to rasterize the images first, and YvesKlett added to that by pointing out that the process of rasterization could in fact be parallelized. However, when I attempt to rasterize the images in my system my system crashed. The two approaches I used to try to rasterize the image were inserting a `Rasterize` within my `ParallelTable` and inserting the code `graphListForExport=Rasterize\@graphListForExport`. For my final application, I will be exporting about 30s worth of graphs at 60fps, which means a total of 1800s. Each export takes about an hour, meaning that modifying elements in the video is very time-consuming. I'm running Mathematica 9.0 on a system with a Dual Core 1.86 Ghz CPU, and 2.50 GB of RAM.


ReplaceRepeated seemingly omits some rules

Is there a simple way in Mathematica to prevent rule reordering? Let me give an example:               a -> b //. {b -> c, (x_ -> y_) -> (x -> Expand[y])}     (* a -> b *)      though               a -> b /. {b -> c}     (* a -> c *)      works fine, of course. (I think that) _Mathematica_ has determined that the second rule in expression 1 is more specific than the first rule and so has ordered it first. But, in the `ReplaceRepeated`, _Mathematica_ now never checks the first rule. I realize that there are ways to rewrite this so that it works fine but is there a simple way to tell _Mathematica_ not to reorder the rules? It seems like there should be.


Using Element[]

Can the Element[] function only be used for the domains given in the documentation? I am trying to use it to determine if a value is contained in a previously defined list. Thanks!


Is there a way to plot the derivative of an implicit function in mathematica?

After having read the manuals and searched extensively, I could not find a way to do the following. Suppose you have an implicit equation of the form $y^4 + y^5 = x$, and $y$ is a function of $x$. Now, using `ContourPlot`, one can easily graph y against x. However, I would like to know if there is a method to graph `y'` against `x` (i.e. $dy/dx$ against `x`). I haven't come across any such thing yet.


Using Map in a function definition

I want to calculate the hessian of a matrix. So each element gets replaced by a 2 by 2 matrix.               hessian[im_, s_] :=        {{gD[im, 2, 0, 2], gD[im, 1, 1, 2]}, {gD[im, 1, 1, 2], gD[im, 0, 2, 2]}};      Now `im = My matrix`. I want to modify my hessian function in some way (using `Map`) such that when I calculate the hessian of `im`, 1 element at a time is calculated by `gD`. At this time `gD` works on the entire `im` matrix. How do I do this? Any help (preferable code) will be very helpful. I am new to _Mathematica_ , struggling, and very frustrated.


How to change the format of all inline cells

`DefaultNewInlineCellStyle` only take effect for newly generated inline cells. for example                   Cell[TextData[{Cell[BoxData[FormBox[RowBox[{RowBox[{"f","",RowBox[{"(","x",")"}]}],"","=","",RowBox[{"a","",FormBox[SubscriptBox["f","1"],StandardForm],"",RowBox[{"(","x",")"}]}]}],TraditionalForm]],"DisplayFormula"],",",Cell[BoxData[FormBox[RowBox[{RowBox[{"g","",RowBox[{"(","x",")"}]}],"","=","",RowBox[{"r","",FormBox[SubscriptBox["g","1"],StandardForm],"",RowBox[{"(","x",")"}]}]}],TraditionalForm]],"DisplayFormula"],",",Cell[BoxData[FormBox[RowBox[{RowBox[{"h","",RowBox[{"(","x",")"}]}],"","=","",RowBox[{"s","",FormBox[SubscriptBox["h","1"],StandardForm],"",RowBox[{"(","x",")"}]}]}],TraditionalForm]],"DisplayFormula"],","}],"Text"]      Here, for some reasons, $f(x),a,f_1(x)$ in Notebook are not in an consistent style. Choose them, set same font/clear format/apply an stylesheet does not take effect, because of different values of `StandardForm` and `TraditionalForm` and other. If I do the following               SetOptions[$FrontEnd,DefaultNewInlineCellStyle->{"Section",FontFamily->"Mathematica",Background->Red}]      How to make the previous inline cells,or further, all inline cells in the notebook the same formatting style?


Create list via checkboxes

I am trying to achieve the following: Three (dynamically updated) `Checkboxes` (a, b and c) can be toggled on or off individually. Depending on their status, a resulting list shall be set to `{a,b,c}`, `{a,c}`, `{b,c}`, etc. I am currently using the following code:               {"a:" Checkbox[Dynamic[a]],      "b:" Checkbox[Dynamic[b]],       "c:" Checkbox[Dynamic[c]],      Dynamic[{If[a, "a",], If[b, "b",], If[c, "c",]}]}      But this yields, depending on the setting, a list of the kind `{a,b,Null}`, etc. - that is, if a checkbox is set to `False`, the list element is set to `Null` rather than left out entirely. Is there any way to achieve my goal in a not-so-cumbersome way (i.e., avoiding something like a 8-cases `Piecewise` or `Which` function)? Thanks in advance!


Different Chapters in Different Files

I was wondering if there is a command to change the counter to adjust its numbeing to having different chapters saved as separate files. This seems possible with page numbers but not section numbers.


How could I use Mathematica to remove finger tips that appear in images?

I used my photo camera to "scan" a heavy dictionary. I tried to have flat images by pressing the margins of the pages with my fingers. The color of the background is (normally) black and my fingers have different colors from the color of the page margins. My questions is: Is it possible to apply Mathematica photo tools to automatically remove the finger tips from the scanned pages? For experiments, you can freely use the following photo               img = Import["http://i.stack.imgur.com/oY9cp.jpg"]      ![photo](http://i.stack.imgur.com/oY9cp.jpg)


Where will I put packages?

Recently,I got _WebMathematica_. Initially I searched _WebMathematica_ documentation in _Mathematica_ documentation, but it doesn't return any results. For this I read tutorials; finally I placed the `webMathematicaDocumentation` folder in the following link.               FileNameJoin[{$InstallationDirectory, "AddOns", "Applications"}]      After that, I reopen _Mathematica_ and search for _webMathematica_ functions in the _Mathematica_ documentation center. It shows all the results. Out of all functions, I read `HTMLTableForm` description, if you want to call this function, first you should evaluate the `MSP HTML` package. This package corresponds to _webMathematica_ layout. So I copied all the packages, which are under `webMathematica\WEB- INF\Applications` and placed them in `FileNameJoin[{$UserBaseDirectory, "Applications"}]`. Again, I reopen _Mathematica_ , directly searched for `HTMLTableForm` and evaluated `MSP HTML` package. It's working fine. But my doubt was, is this a good way for placing all the packages in `Application` folder. Or is there an efficient way?


Hodrick–Prescott filter (one-sided version)

I am interested in implementing Hodrick–Prescott filter (HP filter) on my time series data in _Mathematica_. I know that there is already a version of two-sided original filter for _Mathematica_ (see Demo 5161), however wanted to know if anyone has implemented the one-sided version of the filter and would like to share? So far I found only an implementation for Matlab.


How to generate 2D FEM mesh in Mathematica?

To generate 3D mesh TetGen can be easily used. Are there similar functions (or a way to use TetGen) to generate 2d mesh? I know that such functionality can be easily implemented but I would like to use a Mathematica provided function, as I need to experiment with number of nodes in elements and so on. I just want to solve PDE using FEM not really to play around with mesh generation.


Incorrect numerical derivative of function that uses FindRoot

I am trying to plot the derivative of function `g[x]` below where `g[x]` is defined as the root of another equation. However, I am getting nonsensical answers for the derivative. Any advice would be much appreciated! Simplified code is below:               jRa[T3_] := 10^-5/(1 + 5*10^-8/T3)           jRb[x_, T3_] :=       x*1.3*10^-4/(10^-4 +           x*(1 + 10^-6/(10^-5 - T3)))          g[x_?NumericQ] := (T3 /.          FindRoot[{jRa[T3] == jRb[x, T3]}, {{T3, 10^-7}},           MaxIterations -> 1000])/Ttot          s1 = Plot[(g[x]), {x, 10^-7, 2*10^-5}, PlotRange -> All]          s2 = Plot[g'[x], {x, 10^-7, 2*10^-5}, PlotRange -> All]          g'[.9*10^-5]


Changing the tick labels in a BarLegend

In the following plot, the colors mean the phase, so I need to label the color bar not in integers, but in increments of $\pi$. I searched, but could not find how to change the ticks. Does anyone have an idea?               ListDensityPlot[         Table[ArcTan[Cos[x + y], Sin[x + y]], {x, 0, 10, 0.01}, {y, 0, 1.2, 0.01}],          DataRange -> {{0, 10}, {0, 1.2}}, PlotLegends -> Automatic, ColorFunction -> Hue]      ![](http://i.stack.imgur.com/PyLhk.png)


global variables in compile statement

sorry for posting multiple questions about compile, but this is giving me some headache lately. This time my question is about using globally defined variables in a compile statement. The problem is that when I define a compiled function that uses a global variable like this:               a = 1; (*global variable*)     GlobalVariableCompile = Compile[{{n, _Integer}}, For[i = 1, i < n, i++, a + Cos[i*Pi] + Sin[i*Pi]]];      The function is way slower then the noncompiled version:               GlobalVariable[n_] := For[i = 1, i < n, i++, a + Cos[i*Pi] + Sin[i*Pi]];      which can be easily verified by calling for example:               AbsoluteTiming[GlobalVariableCompile[100000];]     AbsoluteTiming[GlobalVariable[100000];]      What is the reason for this and how can I fix it? **My current solution** : My solution right now is to define an additional parameter of the compiled function and pass the global variable `a`, then everything is very fast as expected (way faster than the noncompiled version):               GlobalVariableCompile = Compile[{{n, _Integer},{a, _Real}}, For[i = 1, i < n, i++, a + Cos[i*Pi] + Sin[i*Pi]]];     AbsoluteTiming[GlobalVariableCompile[100000,a];]


Exporting XML Data

I am trying to convert a bunch of text files into structured XML files. Using string expressions I have extracted data, so I have:               title={"https://www.ometz.ca/event/abiletes-dentrevue-1-678/?langID=1"};`     date={2011,7,14,13,22,22.`};`     content=": text/html; charset=UTF-8 Ometz A community of services for life Employment Job Seekers Job Listings Job Seeker Registration Career Counselling Employers Cocktails & Conversation Candidate Profiles Employers - Submit a Job Posting ProMontreal Entrepreneurs Fund ProMontreal Entrepreneurs Mentors Calendar You & Yours Community Assistance Counselling Services Administered Funds Orthodox Community We";`      So far I have done the following to generate XML objects, for title, date, and content in turn. It is a bit messy but seems to work.               a = ExportString[       XMLElement[        "title", {}, {StringReplace[          ToString[title], {"{" -> "", "}" -> ""}]}], "XML"]          b = ExportString[       XMLElement[        "date", {}, {StringReplace[          ToString[date], {"{" -> "", "}" -> ""}]}], "XML"]          c = ExportString[XMLElement["body", {}, {content}], "XML"];      The output is thus:               <title>https://www.ometz.ca/event/abiletes-dentrevue-1-678/?langID=1</title>     <date>2011, 7, 14, 13, 22, 22.</date>     <body>: text/html; charset=UTF-8 Ometz A community of services for life Employment Job     Seekers Job Listings Job Seeker Registration Career Counselling Employers Cocktails &     Conversation Candidate Profiles Employers - Submit a Job Posting ProMontreal Entrepreneurs     Fund ProMontreal Entrepreneurs Mentors Calendar You & Yours Community Assistance     Counselling Services Administered Funds Orthodox Community We</body>      So far so good, but I need to get it exported to an XML file, say `text.xml`. For some reason I'm hitting a wall in how to get this working, despite reading docs & some supplementary material. How would you do this? (also, any advice on the above code is appreciated)


What's wrong with my code for finding primes?

From here I found a fast method to make prime list, the python version works well, but my _Mathematica_ version does not. Obviously ,`169` is not a prime number. What's wrong with my program?               '''Python code'''     n = 200     sieve = np.ones(n / 3 + (n % 6 == 2), dtype = np.bool)     sieve[0] = False     for i in xrange(int(n**0.5)/3+1):         if sieve[i]:             k=(3 * i + 1) | 1             sieve[      ((k*k)/3)      :: 2 * k] = False             sieve[(k * k + 4 * k - 2 * k * (i & 1))/3 :: 2 * k] = False         print ((3 * np.nonzero(sieve)[0] + 1) | 1)      * * *               (*Mathematica code*)     Clear["`*"];     n = 200;     p = ConstantArray[1, Quotient[n, 3] + Boole[Mod[n, 6] == 2]];     p[[1]] = 0;     Do[       If[p[[i]] != 0,          k = BitOr[3 (i - 1) + 1, 1];         p[[Quotient[k^2, 3] + 1 ;; -1 ;; 2 k]] = 0;         p[[Quotient[(k^2 + 4 k - 2 k BitAnd[i - 1, 1]), 3] + 1 ;; -1 ;; 2 k]] = 0;],       {i, 1, Floor[n^0.5]/3}];     res = BitOr[3 (Flatten@SparseArray[p]["NonzeroPositions"] - 1) + 1, 1];        Pick[res, PrimeQ @ res, False]


Changing the background color of one element in a Grid

Consider the following code:               Grid[Table[x, {4}, {7}], Background -> {4 -> LightRed}]      This highlights column 4: ![enter image description here](http://i.stack.imgur.com/3hg3h.png)               Grid[Table[x, {4}, {7}], Background -> {None, {4 -> LightRed}}]      This highlights row 4: ![enter image description here](http://i.stack.imgur.com/mszCW.png) How do you highlight an individual cell, say row 3, column 5?


Finding the midpoints of an ordered list of numbers

Suppose that I have an _ordered_ list of numbers. The numbers in the list may be evenly spaced, but they may not be. Here are two examples, `list1` and `list2`:               list1 = {0, 0.2, 0.4, 0.6, 0.8, 1};     list2 = {0, 0.3, 0.4, 0.7, 0.9, 1};      I would like to write a function to determine the midpoints (or "midvalues"). So, I would like to write `fun` such that with the following input I will obtain the following output:               fun[list1]     fun[list2]      > >     {0.1, 0.3, 0.5, 0.7, 0.9} >     {0.15, 0.35, 0.55, 0.8, 0.95} >   Is there any built-in way to do this in Mathematica 8? I am looking for a simple method. I came up with the following, which seems to work fine, but I am afraid I may be overcomplicating it:               midpoint[a_, b_] := (a + b)/2     fun[list_List] := Map[Apply[midpoint, #] &, Partition[list, 2, 1]]      where               fun[list1]     fun[list2]      gives > >     {0.1, 0.3, 0.5, 0.7, 0.9} >     {0.15, 0.35, 0.55, 0.8, 0.95} >   Do you have any suggestions to make this simpler?