Elementwise, compilable min function

I am trying to implement efficiently a transfer-matrix like algorithm. On each iteration, I have two vectors $x=\{x_1,\dots,x_n\}$, $y=\{y_1,\dots,y_n\}$ with real numbers and I need to compute the vector $\{\min(x_1,y_1),\dots,\min(x_n,y_n)\}$. I tried four approaches for computing it:   1. Uncompiled `MapThread[Min,{listX,listY}]` call   2. Compiled `MapThread[Min,{listX,listY}]` call   3. Uncompiled `Random`Private`MapThreadMin[{listX,ListY}]` call   4. Compiled `Random`Private`MapThreadMin[{listX,ListY}]` call (Code see below). The resulting timings were: 4.5s (for 1), 3.5s (for 2), 1.5s (for 3) and 4 reverted to uncompiled evaluation, giving 6.3s. So my questions are:   1. Is the uncompiled `Random`Private`MapThreadMin[{listX, ListY}]` call the fastest way to evaluate the element-wise minimum of two lists, or does anybody have a better idea?   2. Why does the example using `Random`Private`MapThreadMin[{listX, ListY}]` fail to compile? My code examples are:               it1[wd_, len_] :=          Module[{pot1, fval},          pot1 = RandomVariate[NormalDistribution[], {len, wd}];         fval = ConstantArray[0., wd];         Do[fval = MapThread[Min, {RotateLeft[fval], fval}] + pot1[[k]];, {k, 1, len}];         Return[fval]];          it2 := Compile[{{wd, _Integer}, {len, _Integer}},         Module[{pot1, fval},          pot1 = RandomVariate[NormalDistribution[], {len, wd}];         fval = ConstantArray[0., wd];         Do[fval = MapThread[Min, {RotateLeft[fval], fval}] + pot1[[k]];, {k, 1, len}];         Return[fval]]];          it3[wd_, len_] :=          Module[{pot1, fval},          pot1 = RandomVariate[NormalDistribution[], {len, wd}];         fval = ConstantArray[0., wd];         Do[fval = Random`Private`MapThreadMin[ {RotateLeft[fval], fval}] + pot1[[k]];, {k, 1, len}];         Return[fval]];          it4 := Compile[{{wd, _Integer}, {len, _Integer}},         Module[{pot1, fval},          pot1 = RandomVariate[NormalDistribution[], {len, wd}];         fval = ConstantArray[0., wd];         Do[fval = Random`Private`MapThreadMin[ {RotateLeft[fval], fval}] + pot1[[k]];, {k, 1, len}];         Return[fval]]];      And to obtain the timing values, I used               Table[it1[20, 10] // First, {10000}]; // AbsoluteTiming     Table[it2[20, 10] // First, {10000}]; // AbsoluteTiming     Table[it3[20, 10] // First, {10000}]; // AbsoluteTiming     Table[it4[20, 10] // First, {10000}]; // AbsoluteTiming      Thank you in advance!


Speed up adding Poisson noise to an image

I'm simulating some images corrupted with Poisson noise, but I'm encountering a few problems with performance. According to the documentation on `ImageEffect`, one can add Poisson noise according to the following rule: ![enter image description here](http://i.stack.imgur.com/jfWZz.png) Loading up an example image, and running the code:               man256 = ImageAdjust[ImageResize[ExampleData[{"TestImage", "Man"}], {256, 256}]];     ImageAdjust[ImageEffect[man256, {"PoissonNoise", 0.8}]] // AbsoluteTiming          (* 10.839 seconds *)      Subsequently running it again in the same kernel, it only takes 0.196 seconds. Meanwhile, the Gaussian noise effect:               ImageAdjust[ImageEffect[man256, {"GaussianNoise", 4.}]] // AbsoluteTiming          (* 0.014 seconds *)      And then running it again once more, it only takes 0.006 seconds. I tried defining my own functions for adding Poisson and Gaussian noise for comparison. Note that I define the amount of Poisson noise slightly differently to the Mathematica method (in a way that actually makes more sense to me).               addPoissonNoise[x_, peak_] :=       Block[{imagedata},        imagedata = peak*ImageData[x];        Map[If[# == 0., 0., RandomVariate[PoissonDistribution[#]]] &, imagedata, {2}]        ];          addGaussianNoise[x_, sig_] :=       Block[{imagedata},        imagedata = ImageData[x];        Map[# + RandomVariate[NormalDistribution[0., sig]] &, imagedata, {2}]        ];          ImageAdjust[Image[addPoissonNoise[man256, 40.]]] // AbsoluteTiming     (* 6.495 seconds *)          ImageAdjust[Image[addGaussianNoise[man256, 4.]]] // AbsoluteTiming     (* 0.007 seconds *)      So on an initial run, my code is faster than the built-in code in both cases. But on subsequent runs, it's slower than the built-in code. Considerably slower in the case of Poisson noise. The Gaussian example is only for comparison - it's the Poisson noise I'm more interested in, and speeding up the **initial** run of the code, as ~10 seconds is considerably slower than I'd like, and in reality my images are bigger than 256x256 pixels. Is there any way to speed-up the corruption of an image with Poisson noise? **Update #1** Replacing `Map` with `ParallelMap` speeds up my Poisson noise function, but it's still quite slow (taking about 1.89 seconds on my machine). Avoiding multiple calls to `RandomVariate` is hard to avoid, I think. It's a shame `PoissonDistribution` can't be compiled (Which Distributions can be Compiled using RandomVariate). **Update #2** There's this question: Why is Poisson Random Deviate Generation so slow? (For info, this is with v10 on Win8.1)


How to pick out the element in a list of lists which satisfies a particular condition?

I have got a list:               lis:={     {{1, 2, 3, 4}},     {{1, 2, 3}, {4}},     {{1, 2, 4}, {3}},     {{1, 2}, {3, 4}},     {{1, 2}, {3}, {4}},     {{1, 3, 4}, {2}},     {{1, 3}, {2}, {4}},     {{1, 4}, {2, 3}},     {{1}, {2, 3, 4}},     {{1}, {2, 3}, {4}},     {{1, 4}, {2}, {3}},     {{1}, {2, 4}, {3}},     {{1}, {2}, {3, 4}},     {{1}, {2}, {3}, {4}}     };      and I would like to pick out those lists which satisfy the following condition:               list == Mod[list+2,4,1]      but, they should be "equal" as a set of lists, not in a "element to element" way. For example, `{{1,2},{3,4}}` is a list satisfied the condition, since `Mod[{{1,2},{3,4}}+2,4,1]` is `{{3, 4}, {1, 2}}`, which is not equal to `{{1,2},{3,4}}` since the "position" is not right, but we should regard it as equal in the sense of set, since they are both the set of `{1,2}` and `{3,4}`. An example which not satisfied our condition is that `{{1,2,3},4}`, since `Mod[{{1, 2, 3}, 4} + 2, 4, 1]` is `{{3, 4, 1}, 2}`, as a set they are not equal, one is the union of `{1,2,3}` and `{4}`, but the results is the union of `{1,3,4}` and `{2}`. Can I use a pattern to sort out the one satisfied my condition in the list? I would like to make it work with any list.


How to write beveled fractions?

How to write beveled fractions like ${}^a/_b$? In contrast to $\frac{a}{b}$ and $a/b$ (see this question).


Is It Possible To Replicate Tab Stop Behaviour (or Even PageFooter Behaviour but in Regular Cell)

I am trying to insert a (text) cell into a notebook that replicates the behaviour of tab stops in MS Word, for example. Put differently, I have two strings and I want the one string to align on the left side of a page and the other string to align on the right side of the page _but on the same line_. I thought it may perhaps be possible using some version of:               Cell[         TextData[{                 Cell["First String",TextAlignment->Left], " \t ",                 Cell["Second String",TextAlignment->Right]         }], "Text"]      Of course, this doesn't work. In fact, I have realised that I can't use regular menu formatting commands to create the effect I want in a cell (so that I could look at the raw expression and see how it is done). Perhaps it can't be done? **However** I do know, for example, that one can set the `PageFooters`/`PageHeaders` option in the stylesheet for a notebook and that this option is preset to accept a list like `{{ll,lc,lr},{rl,rc,rr}}` where the first list is for left-facing pages and the second for right-facing pages and the three elements in each list correspond to left alignment, center alignment and right alignment of text in the footer (essentially what I want to do in a regular cell). Any suggestions?


Help in NIntegration Methods - Takes too long, why?

I have this code. It is a triple integral, and using the automatic method gives me a wrong answer for $T=0.1$ (the correct answer is $5.44$, while I got $3.73$ ). I've tried to change the integral method to `GaussKronrodRule`, but it takes too long (until now, hours) and also I received a message > Return::nofunc: Function Module not found enclosing > Return[False,Module].Parallel`Developer`QueueRun::hmm: Received unexpected > result . And for $T > 1$ gives the correct results, in the automatic method mode. I think it is a problem in the method of `NIntegrate`, right ? 1) How can I solve that ? 2) In Fortran, I have a gausslegendre method. Is this option available in _Mathematica_?               σ = 0.6;          minroot[g_?NumericQ,b_?NumericQ]:=     Module[{rts,r},        rts=r/.Solve[1-(b/r)^2-g^-2*(2/15*σ^9 (1/(r-1)^9-1/(r+1)^9-9/(8r)                     (1/(r-1)^8-1/(r+1)^8))-σ^3 (1/(r-1)^3-1/(r+1)^3-3/(2r)                     (1/(r-1)^2-1/(r+1)^2)))==0,r];       rts=Select[rts,With[{nval=N[#,100]},Im[nval]==0&&nval>0]&];       Max[rts]];          aA[g_?NumberQ,b_?NumberQ,i_]:=Pi-2 b         NIntegrate[         1/(r^2*Sqrt[1-(b/r)^2-g^-2*(2/15* σ^9 (1/(r-1)^9-1/(r+1)^9-9/(8r) (1/(r-1)^8-1/(r+1)^8)) -         σ^3 (1/(r-1)^3 - 1/(r+1)^3-3/(2r) (1/(r-1)^2-1/(r+1)^2)))]),            {r,minroot[g,b],Infinity},         Exclusions->             {r^2*Sqrt[1-(b/r)^2-g^-2*(2/15*σ^9 (1/(r-1)^9-1/(r+1)^9-9/(8r) (1/(r-1)^8- 1/(r+1)^8))-             σ^3 (1/(r-1)^3-1/(r+1)^3-3/(2r) (1/(r-1)^2-  1/(r+1)^2)))]==0},         MaxRecursion->i,Method->{Automatic,"SymbolicProcessing"->0}];          qQ[g_?NumberQ,i_]:=       NIntegrate[2*(1-Cos[aA[g,b,i]]) b,                 {b,0,10},                  MaxRecursion->i, Method-> {Automatic,"SymbolicProcessing"->0}];          o[T_,i_,j_]:=       (1/T^3) NIntegrate[(g^5*qQ[g,i])/E^(g^2/T),                 {g,0,Infinity},                 MaxRecursion->j,                 Method->{Automatic,"SymbolicProcessing"->0}];


Orthogonalizing without normalizing

Is there a way to make `Orthogonalize` do the normal Gram-Schmidt procedure without normalizing the result? As far as I've understood this was possible with Mathematica 5.2. One way would be to just multiply with the norms but being complicated expressions the whole thing would be easier without normalizing in the first place.


How to export 3D graphics to Collada (.dae) format?

I'm looking for a way to export 3D graphics objects to the Collada (`.dae`) format. I need an automated way, i.e. using Blender to manually convert from another format is not a good solution. I'm sure all of the following is not possible at the same time, but ideally:   * Aspect ratio (`BoxRatios`) should be preserved   * Colours should be preserved (if possible)   * Visible bounding box should be preserved (if possible)   * Initial view point should be preserved when opening the file in a viewer (if possible)   * Supporting `Polygon` and `Cuboid` is sufficient. * * * Information that would help me implement this myself:   * Which formats that Mathematica supports can theoretically handle most of the requirements above? Out of these, which one does Mathematica have the best support for?   * Are there command line programs or other Mathematica-controllable tools that can convert a Mathematica-exportable format to Collada?


How can I solve an equation with symbolic coefficients?

I want to try to solve the following                a x^(17/6) - b x^2 - 1 == 0      where `a` and `b` are variable coefficients (which are very small and positive). I cannot get an analytic solution (not surprised), but `NSolve` is not doing the job for me. I am a novice to Mathematica; is anyone able to do `NSolve` for `x` on Mathematica and get a numerical result?


Collect terms in a sum

Suppose I have this expression                   Sum[F[i, j] KroneckerDelta[j, k], {j, 1, 3}]               (* F[i, 1] KroneckerDelta[1, k] + F[i, 2] KroneckerDelta[2, k] +                 F[i, 3] KroneckerDelta[3, k] *)      Is it possible for _Mathematica_ to present the contracted result               F[i,k]      ?


Subtracting results of NDSolve

I have 2 variables as a results from the `NDSolve[]` which are `ua` and `uw`. This is how I do it, and I got the result for `ua` and `uw` just fine and I can plot them.               eq1 = Derivative[2, 0][uw][z, t]*cwv -      Derivative[0, 1][ua][z, t]*cw == Derivative[0, 1][uw][z, t];          eq2 = Derivative[2, 0][ua][z, t]*cav -      Derivative[0, 1][uw][z, t]*ca == Derivative[0, 1][ua][z, t];          ic1 = {uw[zmax, t] == ui + p0, uw[z, tmin] == ui};          ic2 = {ua[z, tmin] == uatm};          sol2 = NDSolve[Flatten[{eq1, eq2, ic1, ic2}], {uw, ua}, {z, zmin, zmax}, {t, tmin,      tmax}, MaxSteps -> Infinity, MaxStepSize -> dt/step, InterpolationOrder -> All];`      However, I want to subtract the two variables such that: `result = (ua-101)-uw` and I failed. I use this as a code to subtract `result = ua[z, t] /. sol2 - 101 - uw[z, t] /. sol2;` Can someone please tell me the reason why it is failed and what should I do to fix this? The complete code is given as follows:               kw = 1*10^(-10);(*m/s*)          ka = 8*10^(-13);(*m/s*)          gw = 10;(*kN/m^3*)          m2w = 2.41*10^(-4);(*coefficient of compressibility of water phase with respect to matric suction*)          m1w = 0.8*10^(-4);(*coefficient of compressibility of water phase with respect to axial stress*)          m2a = 1.11*10^(-4);(*coefficient of compressibility with air phase with respect to matric suction*)          m1a = 0.37*10^(-4);(*coefficient of compressibility of air phase with respect to axial stress*)          p0 = 200;(*applied pressure -kPa*)          tmin = 0;(*minimum or time when the pressure is applied*)          tmax = 5000;(*latest inspected time*)          zmin = 0;(*top elevation*)          zmax = 0.02;(*bottom elevation*)          uatm = 101;(*kPa-atmospheric air pressure*)          step = 1000;(*The higher the step, the higher the accuracy*)          ui = -300;(*Initial matric suction*)          temp = 300;(*temperature in kelvin*)          wa = 28.97;(*kg/kmol*)          s = 0.7887;          n = 1.0696/(1 + 1.0696);          (*CALCULATION*)          r = 8.31432;(*Universal gas constant in j/(mol K*)          g = 9.8;(*gravity acceleration-m2/s*)          da = ka/g;          cwv = kw/(gw*m2w);          cw = ((1 - m2w/m1w)/(m2w/m1w));          ca = (m2a/m1a)/(1 - (m2a/m1a) - (1 - s)*n/(uatm*m1a));          cav = (da/(wa/(r*temp)*uatm))/(m1a*(1 - m2a/m1a) - (1 - s)*n);          dt = tmax - tmin;          (*Assuming that dua/dt is insignificant, Consolidation equation for unsaturated soil is duw/dt=cwv(d^2uw/dy^2)*)          eq = Derivative[2, 0][uw][z, t]*cwv == Derivative[0, 1][uw][z, t];          ic = {uw[zmax, t] == ui + p0, uw[z, tmin] == ui};          sol = NDSolve[Flatten[{eq, ic}], uw, {z, zmin, zmax}, {t, tmin, tmax},MaxSteps -> Infinity, MaxStepSize -> dt/step,InterpolationOrder -> All]          is = 300;(*ImageSize*)          Plot3D[uw[z, t] /. sol, {z, zmin, zmax}, {t, tmin, tmax}, PlotRange -> All, AxesLabel -> {z, t, uw[z, t]}, BoundaryStyle -> Thick, ImageSize -> 500]          Column[Manipulate[Plot[uw[z, t] /. sol, {z, zmin, zmax}, PlotRange -> All, AxesLabel -> {z, uw[z, t]}, ImageSize -> is], {t, tmin, tmax}], Manipulate[Plot[uw[z, t] /. sol, {t, tmin, tmax}, PlotRange -> All, AxesLabel -> {t, uw[z, t]}, ImageSize -> is], {z, zmin, zmax}],  Manipulate[Plot[{uw[z, tmin] /. sol, uw[z, t1] /. sol, uw[z, t2] /. sol, uw[z, t3] /. sol, uw[z, t4] /. sol, uw[z, tmax] /. sol}, {z, zmin,zmax}, AxesLabel -> {z, uw[z, t]}, ImageSize -> is], {t1, tmin + dt/300, tmin + dt/51}, {t2, tmin + dt/50, tmin + dt/16}, {t3, tmin + dt/15, tmin + dt/3}, {t4, tmin + dt/3, tmin + dt/1}]]               (*Assuming that dua/dt is significant*)     eq1 = Derivative[2, 0][uw][z, t]*cwv -      Derivative[0, 1][ua][z, t]*cw == Derivative[0, 1][uw][z, t];          eq2 = Derivative[2, 0][ua][z, t]*cav -      Derivative[0, 1][uw][z, t]*ca == Derivative[0, 1][ua][z, t];          ic1 = {uw[zmax, t] == ui + p0, uw[z, tmin] == ui};          ic2 = {ua[z, tmin] == uatm};          sol2 = NDSolve[Flatten[{eq1, eq2, ic1, ic2}], {uw, ua}, {z, zmin, zmax}, {t,tmin,tmax}, MaxSteps -> Infinity, MaxStepSize -> dt/step, InterpolationOrder -> All];               (*Coupled equation version*)     Column[Plot3D[uw[z, t] /. sol2, {z, zmin, zmax}, {t, tmin, tmax}, PlotRange -> All,AxesLabel -> {z, t, uw[z, t]}, BoundaryStyle -> Thick, ImageSize -> 500],      Plot3D[ua[z, t] /. sol2, {z, zmin, zmax}, {t, tmin, tmax}, PlotRange -> All, AxesLabel -> {z, t, ua[z, t]}, BoundaryStyle -> Thick, ImageSize -> 500]]          Column[Manipulate[Plot[uw[z, t] /. sol2, {z, zmin, zmax}, PlotRange -> Full, AxesLabel -> {z, uw[z, t]}], {t, tmin, tmax}],Manipulate[Plot[uw[z, t] /. sol2, {t, tmin, tmax},PlotRange -> Full, AxesLabel -> {t, uw[z, t]}], {z, zmin,zmax}]]Column[Manipulate[Plot[ua[z, t] /. sol2, {z, zmin, zmax}, PlotRange ->Full,AxesLabel -> {z, ua[z, t]}], {t, tmin, tmax}],Manipulate[Plot[ua[z, t] /. sol2, {t, tmin, tmax}, PlotRange -> Full, AxesLabel -> {t, ua[z, t]}], {z, zmin, zmax}]]          Column[Manipulate[Plot[{uw[z, tmin] /. sol2, uw[z, t1] /. sol2, uw[z, t2] /. sol2,uw[z, t3] /. sol2, uw[z, t4] /. sol2, uw[z, tmax] /. sol2}, {z, zmin, zmax}, AxesLabel -> {z, uw[z, t]}, PlotRange -> Full, AxesLabel -> {z, uw[z, t]}], {t1, tmin + dt/1000, tmin + dt/51}, {t2, tmin + dt/50, tmin + dt/16}, {t3, tmin + dt/15,tmin + dt/3}, {t4, tmin + dt/3, tmin + dt/1}], Manipulate[Plot[{ua[z, tmin] /. sol2, ua[z, t1] /. sol2, ua[z, t2] /. sol2, ua[z, t3] /. sol2, ua[z, t4] /. sol2, ua[z, tmax] /. sol2}, {z, zmin, zmax}, AxesLabel -> {z, ua[z, t]}, PlotRange -> Full], {t1, tmin + dt/500, tmin+ dt/51}, {t2, tmin + dt/50, tmin + dt/16}, {t3, tmin + dt/15, tmin + dt/3}, {t4, tmin + dt/3, tmin + dt/1}]]          (*Comparison*)          Manipulate[Plot[{uw[z, t] /. sol, uw[z, t] /. sol2}, {t, tmin, tmax},PlotRange -> All, AxesLabel -> {t, uw[z, t]}], {z, zmin, zmax}];          (*Matric Suction*)          result = ua[z, t] /. sol2 - 101 - uw[z, t] /. sol2;     Plot3D[result, {z, zmin, zmax}, {t, tmin, tmax}, PlotRange -> All, AxesLabel -> {z, t, \[Psi][z, t]}, BoundaryStyle -> Thick, ImageSize -> 500]    `      Regards,


Why can't FindInstance find a solution to this equation?

FindInstance[680 == 1/3 2^m (-1 + 4^v), {m, v}, Integers]      `FindInstance` seems to be unable to find the integer solution $ {m = 3,v = 4} $ in the equation above (failing with the message:               FindInstance::nsmet : The methods available to FindInstance are insufficient to find     the requested instances or prove they do not exist.      Is there are technique that can be used to find integer solutions to equations like the above?


Addition of Matrices

How can I add the Matrices created by this:               SeedRandom@0;     Table[RandomInteger[{0, 34}, {2, 2}], {2}, {5}] // MatrixForm      > $\left( \begin{array}{ccccc} \left( \begin{array}{cc} 32 & 33 \\ 22 & 15 \\ > \end{array} \right) & \left( \begin{array}{cc} 3 & 30 \\ 34 & 4 \\ > \end{array} \right) & \left( \begin{array}{cc} 14 & 24 \\ 28 & 10 \\ > \end{array} \right) & \left( \begin{array}{cc} 10 & 12 \\ 21 & 31 \\ > \end{array} \right) & \left( \begin{array}{cc} 33 & 5 \\ 15 & 0 \\ > \end{array} \right) \\ \left( \begin{array}{cc} 9 & 13 \\ 22 & 31 \\ > \end{array} \right) & \left( \begin{array}{cc} 26 & 22 \\ 1 & 9 \\ > \end{array} \right) & \left( \begin{array}{cc} 31 & 15 \\ 28 & 13 \\ > \end{array} \right) & \left( \begin{array}{cc} 27 & 15 \\ 16 & 8 \\ > \end{array} \right) & \left( \begin{array}{cc} 23 & 13 \\ 33 & 25 \\ > \end{array} \right) \\ \end{array} \right)$


How to splice together several instances of InterpolatingFunction?

I have a set of `InterpolatingFunction` returned by `NDSolve` which are valid over different (but overall continuous) domains. How do I splice them together into one single InterpolatingFunction over all the domains? `Piecewise` seems to promising, but I can't manage to return the piecewise function from another function then use it later the same way as `InterpolatingFunction`. I guess there is also the brute force way of generating a grid of points using the original set of `InterpolatingFunction` then interpolating points again, but that's very elaborate and CPU-consuming, not to mention potentially inaccurate if the interpolation grid is not chosen properly. Thoughts? * * * Thanks to the answer from Mr. Wizard, this is the solution I ended up using:               JoinInterpolatingFunction[intervals_List, flist_List] :=       Module[{getGrid},       getGrid[f_InterpolatingFunction, min_?NumericQ,          max_?NumericQ] := {{min, f[min]}}~          Join~(Transpose@{f["Grid"] // Flatten, f["ValuesOnGrid"]} //             Select[#, (min < #[[1]] < max) &] & )~Join~{{max, f[max]}} // N;       Interpolation[        Table[getGrid[flist[[i]], intervals[[i]], intervals[[i + 1]]], {i,             Length@flist}] // Flatten[#, 1] & //          DeleteDuplicates[#, (#1[[1]] == #2[[1]]) &] &,         InterpolationOrder -> 2]]      `JoinInterpolatingFunction[{I1,I2,..,In},{func1,func2,...func(n-1)}]` gives an `InterpolatingFunction` that takes values of `func1` between [I1,I2], `func2` between (I2,I3], ... `func(n-1)` between (I(n-1),In].


How can I calculate a limit with a free variable?

For example, when I evaluate               Limit[(1 + x^n + (x^2/2)^n)^(1/n), n -> Infinity]      _Mathematica_ does not output any result. When I evaluate               Plot[Limit[(1 + x^n + (x^2/2)^n)^(1/n), n -> Infinity], {x, -10, 10}]      a piecewise graph is output. But I want to get the function, not only the graph. How can I do it?


Using FortranForm

I need to use in Fortran, matrices that I create in Mathematica, therefore, I need to format them, so that Fortan can understand them. I focus on the simplest example: Let's say I have tha matrix A created in Mathematica               A = {{1, 1}, {1, 1}};      Then, I am supposed to use FortranForm               FortranForm[A]      which gives as an output               List(List(1,1),List(1,1))      My question is, what do I do with this now? This cannot be the input file to Fortran, since this should be only numbers as far as I am aware. It could be that, the input file to Fortran is the out put of               List(List(1,1),List(1,1))      but this is nothing in Mathematica, so it does not give any output. Any help please?


List reversion inspired by Python

In python, if you wish to reverse a list, here is the trick:               range(10)[::-1]  => [9, 8, 7, 6, 5, 4, 3, 2, 1, 0]      Note: `list[start:end:steps]` is the slice method in python. The above code omitted the first two arguments. It rings a bell in _Mathematica_ :               Part[list, Span[start, end, step]] <=> list[[start;; end;; step]]      However this isn't gonna work in MMA (or not yet? since mine is still MMA 7)               Range[10][[;; ;; -1]]      > `Part::take:` Cannot take positions 1 through -1 in {1,2,3,4,5,6,7,8,9,10}. > >>   >  `Part[{1, 2, 3, 4, 5, 6, 7, 8, 9, 10}, 1 ;; All ;; -1]` This error message gave clues to what happened. When step length is negative, the start index should be greater than the end one - no matter in python or MMA syntax. The problem why this didn't work lies in the omitted arguments. MMA filled them with **1** and **All** and then got stuck. By contrast python smartly exchanged the two. My actual question in this is: **How can I can look into the default values /optional arguments of a built-in function like`Span`?** I can't find it in the documentations. * * * Give another look at the fun code: `range(10)[::-1]` My implementation of this it to modify the definitions               Unprotect[Span, Part];     Part[x_List, Span[1, All, k_]] /; k < 0 := Part[x, Span[All, 1, k]];     Protect[Span, Part]          (*behold lol*)          Range[10][[;; ;; -1]]     (* {10, 9, 8, 7, 6, 5, 4, 3, 2, 1} *)      To clear the modifications:               Unprotect[Span, Part]; Clear[Span, Part]; Protect[Span, Part]      or               CompoundExpression@@ Through[{Unprotect, Clear, Protect}[Span, Part]]


A While Loop with two different steps/iteration

I'd like to know if there is a possibility to solve an equation in a while loop with 2 different steps. I want the step to be small at the beginning and bigger after a certain value of sigma (sigma is the parameter that changes). I don't have an exemple and didn't find anything near it here. It would look like : `If[sigma<0.5,iteration=0.05 Then[While[Solve[hat==0, x], Else[While[Solve[hat==0, x], with iteration 0.1]]]` "hat" is a system of equation (long to obtain and I can't copy everything); I want to know if it is possible, otherwise I'll just put the results together on a plot. Thanks!


Make all new cells have a specific style as a function of the Mathematica installation

I would like all new input and output cells, in fact all new cells including section headers and such, to have a specific stylistic property (`CellBracketOptions -> {"Color" -> MyFavoriteColor}`). This is easy enough to do with `CurrentValue[$FrontEnd,...]=...`. However, I want this behavior to be exhibited only by _new_ cells created in a specific Mathematica installation. I.e. a notebook generated elsewhere should look like it would in a default Mathematica FrontEnd, and only new cells created in this Mathematica installation should have the new property. My use case here is that I have a notebook that I would like to use for collaborations, where each person would be assigned a color, and when they use their copy of Mathematica the cells they enter would automatically have a distinctly colored cell bracket. When exchanging this notebook, the cells authored by each user would be readily identifiable by their cell bracket color.


Problem with plotting a function with NIntegrate

Why does the following `Plot3D` command never terminate?               m=0.8;i=5.6;w=100*Pi;     vma[t_, v0_] := m Sin[w t] + v0;     vmb[t_, v0_] := m Sin[w t-2*Pi/3] + v0;     vmc[t_, v0_] := m Sin[w t+2*Pi/3] + v0;     ia[t_, theta_] := i Sin[w t + theta];     ib[t_, theta_] := i Sin[w t + theta-2*Pi/3];     ic[t_, theta_] := i Sin[w t + theta+2*Pi/3];     in[t_, theta_,v0_] := -(Sign[vma[t, v0]] vma[t, v0] ia[t, theta] +        Sign[vmb[t, v0]] vmb[t, v0] ib[t, theta] +        Sign[vmc[t, v0]] vmc[t, v0] ic[t, theta]);     vc1[theta_?NumericQ, v0_?NumericQ] := 280 + 1/(2*4700*^-6) *        NIntegrate[in[t, theta, v0], {t, 0, 0.3}];     Plot3D[vc1[theta,v0], {theta,-Pi, Pi}, {v0, -0.2, 0.2}]


Is it possible to use some short form in Postfix

## example 1 * * * we can use `Information` , but can not use `?`               Sin // Information          Sin // ?      ## example 2 * * * we can use `StringJoin` but cannot use `<>`               "aa" <> 1 <> 2 <> "Ab" <> 123 <> "aend" /. <>-> ~~          "aa" <> 1 <> 2 <> "Ab" <> 123 <> "aend" /. StringJoin -> StringExpression          (*         aa~~1~~2~~Ab~~123~~aend     *)


Plotting data with ListPlot where the coloration of the data depends on its position in an array?

Imagine I have some data in a list I'd like to plot using `ListPlot` in _Mathematica 9_ , for example:               ListPlot[Table[{i, Cos[i]}, {i, 1, 10^3}]]      How can I specify that the data points should be colored according to a linearly scaling interval from one `RGB` value to another (e.g. `Red --> Blue, Green --> Red`, etc.) depending on the point's index in the array? Can we do something similar using `ListPointPlot3D`?               ListPointPlot3D[Table[{i, Cos[i], Sin[i]}, {i, 1, 10^3}]]


Nonlinear least squares on a GPU with Mathematica 9

Update: A Mathematica wrapper for (https://github.com/zitmen/cuLM) should allow for us to directly implement the Levenberg-Marquardt algorithm in CUDA for nonlinear least squares fitting. In a previous question of mine (here) I asked how one could best use _Mathematica_ 's model fitting capabilities to fit a 2D Gaussian to a set of data.   Two very nice answers were provided by Rahul Narain (who directly computed a mean and covariance matrix for my example data and then used `MultinormalDistribution[]`) and Sjoerd C. de Vries (who used `NonlinearModelFit`). **Questions:**   * Could these methods be adapted to work on a GPU core in _Mathematica 9_ (perhaps via `CUDALink`)?    * Is there some way of using _Mathematica_ to do GPU-based nonlinear least squares (or some other fitting strategy) to accomplish this?


Button's command is not evaluated in iteration

I wish I didn't feel like a newbie after several months, but... If I enter the following:               Table[ Button[ "Number: " <> ToString @ i, Print @ i], {i, 1, 5}]      this creates a list of buttons, labelled `Number: 1`, `Number: 2`, etc. but pressing each button only prints `i`, not the number corresponding to the button. I assume this is standard newbie-doesn't-understand `Mathematica` stuff, but would appreciate any explanation of how to change the behaviour so that each button prints the value of `i`.


Variable scoping problem when mapping over delayed replacement

This is something that got me curious while I was playing around with _Mathematica_. Consider the following (contrived) example:               Clear[x,y];     {{1, 2}, {3, 4}, {5, 6}} /. {x_, y_} :> {x, #} & /@ {y, y^2, y^3}     (* {{{1, 2}, {3, 4}, {5, 6}}, {{1, 4}, {3, 16}, {5, 36}}, {{1, 8}, {3,      64}, {5, 216}}} *)      No problems there. Now suppose `y` has been defined globally, so               y = 10;     {{1, 2}, {3, 4}, {5, 6}} /. {x_, y_} :> {x, #} & /@ {y, y^2, y^3}     (* {{{1, 10}, {3, 10}, {5, 10}}, {{1, 100}, {3, 100}, {5, 100}}, {{1,      1000}, {3, 1000}, {5, 1000}}} *)      The problem is that y gets evaluated to 10 before getting mapped to the delayed rule's rhs. I realised I could do               {{1, 2}, {3, 4}, {5, 6}} /. {x_, y_} :> {x,       ReleaseHold[#]} & /@ Thread[Hold[{y, y^2, y^3}]]     (* {{{1, 2}, {3, 4}, {5, 6}}, {{1, 4}, {3, 16}, {5, 36}}, {{1, 8}, {3,      64}, {5, 216}}} *)      which looks kinda complicated, but works. So, is there any better way to "shield" the `y` in the list being mapped over, from the global variable `y`? I sort of randomly tried   Module[{y}, {{1, 2}, {3, 4}, {5, 6}} /. {x_, y_} :> {x, #} & /@ {y, y^2, y^3}] but in this case the temporary variable's name(?) got substituted               (* {{{1, y$119596}, {3, y$119596}, {5, y$119596}}, {{1, y$119596^2}, {3,         y$119596^2}, {5, y$119596^2}}, {{1, y$119596^3}, {3,         y$119596^3}, {5, y$119596^3}}} *)


Is there any way to make this numerical integral evaluate faster?

k = 100;     \[Delta]pz = 0;     ks = 1.18;     int[x0_?NumericQ, X_?NumericQ] := NIntegrate[ 2 Sqrt[\[Pi]] E^(-x^2/2) E^(-(x - X)^2/2) r/Sqrt[(x - x0)^2 + r^2]E^(-ks Sqrt[r^2 + (x - x0 )^2])BesselJ[0, Sqrt[(X + 2*k)^2 + \[Delta]pz^2] r], {x, -10, 10}, {r, 0, 10}, PrecisionGoal -> 3, AccuracyGoal -> 8, MinRecursion -> 1]      The evaluation of int[0,0] takes around 6 seconds. I would like to considerably reduce this time. Here is the plot of the integrand               (*plot*)     Plot3D[Evaluate[2 N[Sqrt[\[Pi]], 30] E^(-x^2/2) E^(-(x - X)^2/2) r/Sqrt[(x - x0)^2 + r^2]E^(-ks Sqrt[r^2 + (x - x0 )^2])BesselJ[0, Sqrt[(X + 2*k)^2 + \[Delta]pz^2] r] /. {x0 -> 0, X -> 0}], {x, -5, 5}, {r, 0, 10}, PlotRange -> All]      ![plot](http://i.stack.imgur.com/vgthv.jpg) which has a series of oscillating peaks. What is the best method to integrate this kind of function?


Menu item “Interrupt Evaluation…” missing in V10

The menu item “Interrupt Evaluation…” seems to have disappeared in Mathematica 10 on OS X. Well, this is a bummer. I personally use _Mathematica_ for very long calculations, and I was using this function frequently to “pause” a calculation just the time to do another CPU-intensive task. Any chance this can reappear in an update?


Strange 3D plot behavior

**Two Part Question** Part 1: As you can see from the data and plot below, the plot does not accurately display the data sets but adds lines beyond and in different dimensions. Both u and v datasets are in {0,1} range, but v doesn't plot correctly. Why this strange behavior? What did I miss here? Part 2: How can I fill the lines to the Axis to make a 3D form from the correctly plotted lines making a more elegant looking plot? Thanks!               u = {{0, -0.44331262664448756`}, {0.0196`, -0.9779703843580401`},{0.0392`, -0.761419676160835`},      {0.0588`, -0.7410082141786067`},{0.0784`, -1.1337733424705565`}, {0.102`, -1.0486362396635585`},     {0.149`, -0.2251024797836343`}, {0.2`, -1.2871097065127457`},{0.251`, -0.9511305495415456`},      {0.302`, -0.8164066459261932`},{0.349`, -0.7856901292758733`}, {0.4`, -0.8996334304312015`},     {0.451`, -0.6566406380705825`}, {0.498`, -0.27392146117227734`},{0.549`, -0.2943716563989507`},     {0.6`, -0.005103507205728164`}, {0.651`, 0.1514427552803399`}, {0.698`, 0.5919523857004505`},      {0.749`, 1.485852053899006`}, {0.8`, 1.1930387245891183`}, {0.851`, 0.771890328176178`},      {0.898`, 0.13245346840587424`}, {0.949`, -0.06005129796635145`}, {0.9804`,-0.6909201620317884`},      {1, -2.886054510422592`}};          v = {{0, 1.7277993371975775`}, {0.0196`,0.7046147676309067`}, {0.0392`,-0.14324752873255964`},      {0.0588`,-0.278024151638645`}, {0.0784`, -0.2257145006115291`}, {0.102`,-0.8323709054502082`},      {0.149`, -0.0840232633295912`}, {0.2`,-0.8432031344867141`}, {0.251`, -1.052961606965508`},      {0.302`,-1.0016400464038844`}, {0.349`, -0.47166441886878907`}, {0.4`,-0.5634900663427977`},      {0.451`, -0.8219157180967107`}, {0.498`,-0.599958880780993`}, {0.549`, -0.1889940612199048`},      {0.6`,-0.3952379660987937`}, {0.651`, -0.26706893123602526`}, {0.698`,0.5833238256280904`},      {0.749`, 0.9884089479900493`}, {0.8`, 0.721317446974723`}, {0.851`,-0.07891186493267366`},      {0.898`, -1.202139489716314`}, {0.949`, -1.4943329078699996`}, {0.9804`,-2.3465771005766967`},      {1, -2.852635384504043`}};          results = ListPointPlot3D[{v /. {x_, y_} :> {x, y, 0}, u}, PlotStyle -> {Blue, Orange},AxesOrigin ->      {0, 0, 0}, Boxed -> True, BoxRatios -> {1, 1}, Ticks -> Automatic, AxesStyle -> Black,      PlotRange -> All, ImageSize -> 280] /. Point -> Line      ![3D Plot Error](http://i.stack.imgur.com/zWNSF.jpg)


Can Mathematica solve $x^{b^2} + ax^b -1 = 0$ for $x$ with $a>0$, $b>1$?

I have a problem that I can't seem to solve neither analytically nor with Mathematica. Namely, I have the expression $$x^{b^2} + ax^b - 1= 0,$$ which I want to solve for $x$ with $a>0$, $b>1$. But I can't find a method in Mathematica that would provide an answer to this without specifying $a$ and $b$ (for example, Solve, Root, FindRoot and Reduce don't work). I am quite new to the software, however, so I was wondering whether I am just missing something or can this equation truly not be solved in general using it?


Can you form a list with elements which are terms from an equation?

Is there a command that takes an equation as an input and creates an output with a list of terms in the original equation? Something like:               Input: Foo[ (1+a) x+ (2.5-b) y^2+ 3 c z^{1.3}]          Output: { (1+a) x ,  (2.5-b) y^2 ,  3 c z^{1.3} }


Parse website data that requires interaction with a form (POST)

I want to analyse Chilean elections data available in the official website. What I have returns the data for president (numbers are strings, to be parsed later).               Import["http://www.eleccionservel.cl/ELECCIONES2013/vistaPaisPresidente", "Data"][[2, 2, 2, 2, 2 ;; 10, {1, 3, 4}]]      But to get the data for congress, the website does not have a direct URL and the data by districts needs to be selected by clicking in links that look like this               <a href="#" onclick="javascript:doSubmit('409','D');"> Distrito 9 </a>      Which in turn runs               function doSubmit(a,b){document.consultarForm.codigo.value=a;document.consultarForm.nivel.value=b;document.consultarForm.submit()}     <form id="diputado" name="consultarForm" action="/ELECCIONES2013/diputado" method="POST">      I have tried unsucessfully the following               url="http://www.eleccionservel.cl/ELECCIONES2013/diputado";     Import[url, "Data", "RequestMethod" -> "POST", "RequestParameters" -> {   "codigo" -> "409",   "nivel" -> "D",   "division" -> "POLITICA",   "codigoPadre" -> "409",   "codigoCircunscripcion" -> "409",   "codigoColegio" -> "D"   }]      Not sure if `"RequestParameters"` should refer to the "name" or the "id" of the form. Is there a chance to get this data with _Mathematica_ in an elegant and simple way, or should I be looking to a different tool?


How to display data in a Dynamic Pane?

How to display data in a Dynamic Pane   without exponents? Some data:               data = Range[1, 1000];        Slider data has to be added to data:               Slider[Dynamic[n], {0, 10000000}]        A Dynamic Pane:               Dynamic[Pane[Pane[TableForm[n + data],100], ImageSize -> {200, 200}, Scrollbars -> True]]        Plane numbers without exponents are wanted in the Pane.   . **UPDATE** Build a file with 10.000 records.   (File could have an arbitrary number of records)   Make each record a string 50 bytes in length.   The content of the records does not matter. The method gives a Slider and a Pane.   The Slider allows to pre-set to a rough record position   in file. It sticks always to a record boundary.   The Panes Scrollbars allow to see through the   chunk of records loaded into the pane. The Question is: How to modify the working of Module[] so its functionality is   preserved and the display of the StreamPosition value avoided. This value is visible right above the Slider object.   Only the Slider, the Pane and the Panes   content should be visible.               (* txt data file 10.000 fixed length records 50 bytes each *)       infil = "C:\\Users\\User\\Desktop\\test 10T fixed.txt";            (* a stream onto the file *)       str = OpenRead[infil, BinaryFormat -> True];            (* a table to build up the shown record numbers *)       panebias = Range[1, 200];            (* a table with a delimiter sign to separate the Pane panels        first and second column *)       deli = Table["|", {200}];            (* the last StreamPointerPosition to go to fit the last record       into the pane. 10.000 records times records bytes plus 2 bytes       for taking into account BinaryFormat *)       last = 10000*52 - 200*52;            (* preset the Slider position for its StreamPosition *)       n = 0;            Module[{},      Column[       {Dynamic[SetStreamPosition[str, n]],        Slider[Dynamic[n], {0, last, 52}, ImageSize -> 450,          Appearance -> Small],        Pane[Grid /@           Dynamic[Transpose[{n/52 + panebias, deli,              ReadList[str, Record, 200]}]],         ImageSize -> {450, 200}, Scrollbars -> True]}       ]      ]        ![enter image description here](http://i.stack.imgur.com/x5V6n.jpg)


Minimize user defined function

I have a user defined function h[i_,j_] and I would like to find its minimum value over all integers $1 \leq i \leq 100$ and $1 \leq j \leq 100$ and $j \leq i$. I would just like Mathematica to try all the possibilities rather than attempt any symbolic minimization. How can you do that?


Elegant manipulation of the variables list

I have a list of global variables (some of them are indexed variables), for example:               varsH = Hold[U0[1], U0[2], B0, V0[1], V0[2]]      Or (if it is easier to handle) I can have them as a `List` of `Strings`:               varsS = {"U0[1]", "U0[2]", "B0", "V0[1]", "V0[2]"}      Now I need to be able to do the following things **knowing only the position** ( _i_ ) of the variable in the list:                 1. Assign new value to the variable (the variable can already have a value)       2. Clear the variable       3. Get the current value of the variable       4. Get the name of the variable as `String`      Additionally, I need to be able to                 5. Clear all the variables at once      What is the most elegant approach to this task? I know, it would be easier to have all the variables just as one indexed variable but I need names of the variables to be explicit. By the term "elegant" I mean that every of the listed things should be written as short as possible (for a solution without helper functions). If there is no elegant way to avoid use of helper functions, they should be as clear as possible. P.S. It is known that the variables should always be numerical or undefined.


How can I find if the number of subsets for a list is very large?

I'm trying to find the following;               Subsets[Range[2, 2300], {4}]      but my computer gave the following error: > `Subsets::toomany:` The number of subsets (1160942293126) indicated by > «input» is too large; it must be a machine integer." What is your advice?


Fastest way to measure Hamming distance of integers

I am looking for a fast and robust way to calculate the Hamming distance of integers. The Hamming distance of two integers is the number of matching bits in their binary representations. I expect that clever methods can easily outpace `HammingDistance` as it works on vectors instead of integers and on any vector not just binary. My naive bitwise method is faster than `HammingDistance` but I'm pretty sure that it can be further optimized. While compilation would help, it won't work on big integers ($\ge 10^{19}$). Nevertheless, I am interested in compiled solutions!               max = 10^10;     n = Length@IntegerDigits[max, 2];     data = RandomInteger[{0, max}, {100000, 2}];     m1 = Map[HammingDistance[IntegerDigits[First@#, 2, n],            IntegerDigits[Last@#, 2, n]] &, data]; // AbsoluteTiming     m2 = Map[Total@IntegerDigits[BitXor @@ #, 2] &, data]; // AbsoluteTiming     m1 === m2      > >     {0.967202, Null}   >     {0.624001, Null} >     True >   It would be nice to work entirely on the binary representations, and I thought that using `DigitCount` on `BitXor` would help, but it gave a cruel 3x slowdown compared to the `HammingDistance` version. **Edit** As an answer to Kirma's comment: I have to calculate the pairwise distance matrix for a set of integers (highly related is Szabolcs's post: Fastest way to calculate matrix of pairwise distances), in the (simplest and most didactive) form:               Outer[hamming[#1, #2], Range[2^20], Range[2^20]]      Now in this case my main problem is of course memory not speed, but it would be nice to see solutions that scale well with this problem. I understand that it is another question, but I want to encourage everyone to post their solutions even if they require vectors or matrices of integers as input.


Why does Mathematica fail to series expand this simple expression?

I wanted to expand the function $(x+2)^{x+2}$ around $x = -1$, that is, using               Series[(x + 2)^(x + 2), {x, -1, 2}]      and _Mathematica_ returns the same expression. Why does this happen? The first term of a series expansion is simply $1^1 = 1$. However, I cannot even get this, from               Series[(x + 2)^(x + 2), {x, -1, 0}]      ![](http://i.stack.imgur.com/fC9Oo.png)


Calculating the recursion at the Fourier domain

I would like to calculate the following recursion with mathematica $$f_n(x)=\int_{B}^{A}f_{n-1}(x-\omega)f(\omega)\mbox{d}\omega\quad\quad f_1(w):=f(w)$$ This is simply the convolution of $f$ with itself in the range $(B,A)$. I think it is possible to rewrite this in ordinary convolution form as $$f_n(x)=\int_{B}^{A}f_{n-1}(x-\omega)f(\omega)\mbox{d}\omega=\int_{-\infty}^\infty f_{n-1}(x-\omega)f(\omega)1_{\{B<\omega<A\}}\mbox{d}\omega\\=\int_{-\infty}^\infty f_{n-1}(x-\omega)g(\omega)\mbox{d}\omega\quad\mbox{with}\quad g(\omega)=f(\omega)1_{\{B<\omega<A\}}$$ which says that $f_n$ is obtained by convolving $f_{n-1}$ with $g$ $$f_n=f_{n-1}(*)g$$ this corresponds to multiplication at the Fourier domain $$F_n=F_{n-1}G$$ For $n=2$ we have $F_2=F_{1}G=FG$. For $n=3$, $F_3=F_{2}G=F_{1}GG=FG^2$, continuing like this we get $$F_n=F G^{n-1}$$ First of all I wonder if what I have done is correct or is there something missing or incorrect? Next I wrote a code in mathematica as follows to implement this for $n=3$. I wanted it for all $n$ but it didnt work. Here is the code:               Needs["FourierSeries`"]     opts = {Method -> {Automatic, "SymbolicProcessing" -> None},AccuracyGoal -> 8}     a = 2;     b = -2;     f1[x_] := Evaluate@PDF[NormalDistribution[2, 2], x]     g1[x_] := f1[x]*(UnitStep[x - b]*UnitStep[-x + a])     ff1[u_] = FourierTransform[f1[x], x, u, FourierParameters -> {1, 1}]     gg1[u_] = FourierTransform[g1[x], x, u, FourierParameters -> {1, 1}]     den[x_?NumericQ] := NInverseFourierTransform[ff1[u]*gg1[u]^2, u, x,FourierParameters -> {1, 1}, Evaluate@opts]     NIntegrate[den[x], {x, -8, b}, Evaluate@opts]     0.00463943 - 1.7541*10^-18 I      The result should however be $0.00397888$. For $n=2$ namely when               den[x_?NumericQ] := NInverseFourierTransform[ff1[u]*gg1[u]^1, u, x,FourierParameters -> {1, 1}, Evaluate@opts]     NIntegrate[den[x], {x, -8, b}, Evaluate@opts]     0.0105702 + 9.00034*10^-18 I      I get the correct result.. I am really confused. Can anybody see what is the problem here? Thank you very much in advance.


Does Mathematica have a command analogous to ode45 of MATLAB?

Does anybody know if _Mathematica_ has an analogue of MATLAB's `ode45` command? I need to solve a second order coupled ODE system of equations.


problem with exporting transparent object to pdf in version 9

Here is the code:               Export["~/Downloads/1234.pdf", Graphics3D[{Lighter[Black], Opacity[0.5],         Polygon@Table[{Cos[x], Sin[x], 0}, {x, 0, 2 \[Pi], 0.01}]}]]      in version 8, I get ![enter image description here](http://i.stack.imgur.com/T068V.png) in version 9, I get ![enter image description here](http://i.stack.imgur.com/4Ra4V.png) why the color is different and also there are gridlines in the plot? Is there a way to fix the color and the gridlines in version 9?


RegionPlot3D Error

I have the following command:               RegionPlot3D[       Log[p1/(1 + p2)] > 0, {p1, 0, 0.5}, {p2, 0.5, 1}, {C, 0, 1}]      and my _Mathematica_ 9 gave me the following error message: > RegionPlot3D::boolf: "Log[p1/(1+p2)]>0 must be a Boolean function." I have no idea why `Log[p1/(1+p2)]>0` is not a Boolean function. It just looks like an innocent inequality that should work in `RegionPlot3D`. Note: I have simplified the inequality so it does not involve `C`, but in the original version it does contain `C`.


Generate encoding from nested list

Taking reference of Huffman code algorithm,                list={{{{{{}, {{x7, 4}, {1, {{f, 3}}}, {0, {{q, 1}}}}},         {{x8,9}, {1, {{b, 5}}}, {0, {{x7, 4}}}}},          {{x9,12}, {1, {{e, 6}}}, {0, {{a, 6}}}}},          {{x10,19}, {1, {{h, 10}}}, {0, {{x8, 9}}}}},          {{x11,31}, {1, {{x10, 19}}}, {0, {{x9, 12}}}}}      This is in midway of creating the `Huffman code` for any string. x* represents the new node made from two smallest nodes and 4 next to it represents the sum of the frequencies of the two child nodes under it. **Information on structure of list:** > > {{parent_node,fre1},{code,{{child_node1,freq2}}},{code,{{child_node2,freq3}}}} > > freq1 = freq2 + freq3               {{x7, 4}, {1, {{f, 3}}}, {0, {{q, 1}}}}       > x7 is parent of f and q > > 4 = 3 + 1 This unique node(x7) is added in list, sorted and operation repeated again. I am facing problem with creating a final output as Huffman codes for each character, for example, **h = 11, a = 00** walking from top to bottom. Final result could be `{{h,11},{a,00}}` and with other characters.


How can I read in specific information from a TeX-file?

I have several TeX-files and they contain information of the form * * *               \commandnameA{Bob}     blabla     \commandnameB{It wasn't Bob}     \commandnameC{2012}     bla     \commandnameD{$\frac{1}{3}$}     \commandnameE{\commandnameF{It was Bob!}}     \commandnamefilename{29}      * * * Is it possible to read in that information via Mathematica? Like for example in a list `{Bob,It wasn't Bob,2012,$\frac{1}{3}$,\commandnameF{It was Bob!},It was Bob!,29}` The purpose would be to use the enumaration of the files (here 29) together with the other content of the files to further calculate statistics and generate graphics about these bunch of TeX-files as a whole.


Using the error messages that gets generated while executing

While executing code it is normal to get the messages like shdw,argx etc. I wanted to know if there is anyway i can store all these messages into a array or a variable so that i can pinpoint where the error occurred. The scenario is that i have written few functions in webmathematica and deployed the files on the server. So in future if there are any issues with those functions i want to use the errors(messages) and convert these errors into diff user defined http requests(in turn used to send a mail containing these messages).


Reading non-tabular data with NaN-s from file

A NaN stands for an entry that is not a number/undefined/missing/infinite/etc. On my machine the C code `printf("%f", 0/0.)` produces `-1.#IND00` which is the standard Windows representation of an indeterminate float. I have to read in a data file containing:   1. either a fixed number of floating-point reals per line with possible NaN-s OR   2. a variable number of floating-point reals per line, as NaN-s are omitted during file-generation. Unfortunately, _Mathematica_ is unable to read and convert such NaN-s silently to `Indeterminate` or `Missing[]` with e.g. `ReadList[..., Table[Number, {10}]]`. Also, _Mathematica_ is unable to read a variable number of `Number`-s per line (until a `\n` is encountered). Seems like one cannot avoid the rather slow string-based import:               StringSplit /@ ReadList[file, String] /. "-1.#IND00" -> Indeterminate // ToExpression      **Is there a FASTER way to read in such irregular data?** Aassume `test.dat` contains the followings (the real case has 100K lines and ~1000 entries per line.):               1.0        0.0        3.0     4.0        -1.#IND00  -1.#IND00     5.0        6.0        -1.#IND00          (* ==> {{1., 0., 3.}, {4., Indeterminate, Indeterminate}, {5., 6., Indeterminate}} *)


Prevent iterator name from being confused with symbol passed into function body

I have a massive amount of code with lots of `Table` and `Sum` inside a `Module`. Each with their own iterators, and I have completely lost track of all of them. But if the user calls the function with an argument matching the name of the iterator, the code no long works as intended. An example is this function that is supposed to return a list of three repeated symbols:               function[x_] :=      Module[{},       answer = Table[x, {i, 1, 3}];       Return[answer];     ]      For example:               function[a]     (*{a,a,a}*)      But this can be broken by               function[i]     (*{1,2,3}*)      Obviously, `Table` is confusing the input `x=i` with its own iterator `i`. What is the fool-proof fix for this? Is there a solution without:   1. Finding the names of all the iterators and listing them all as private variables inside `Module`?   2. Finding all the iterators and renaming them `longAndComplicated1`, `longAndComplicated2`, etc.?


Can't Plot Fourier Series

I have been trying to plot fourier series but the plot is allways empty. I guess there is something wrong in my code but i dont know exactly what is it. Looking here for some previous questions/answers I plotted the function in a lot of different ways but none of them worked. Can someone help me with this :) ? ![enter image description here](http://i.stack.imgur.com/0OiNs.png) fx[n_, t_] := !( *UnderoverscriptBox[([Sum]), (i = (-n)), (n)](((Exp[ I*(((-1)*ima))*[Pi]]*((I*1 + ima*[Pi])) - 1))* Exp[I*ima*[Pi]*t])) psums = Table[fx[n, t], {n, 1, 10}]; Plot[Evaluate[psums], {t, -4, 4}]


Is it possible to define custom compound assignment operators like ⊕= similar to built-ins +=, *= etc?

I would like to do something like this:               In[1]:= ToExpression["\"\\[CirclePlus]\""]     Out[1]= ⊕          In[2]:= list_ ⊕ element_ := Append[list, element];          In[3]:= a = {1, 2};          In[4]:= {a = a ⊕ 3, a}     Out[4]= {{1, 2, 3}, {1, 2, 3}}             In[5]:= {a ⊕= 4, a}          (* Desired result: Out[5]= {{1, 2, 3, 4}, {1, 2, 3, 4}} *)     (* Actual result: syntax error *)          Syntax::sntxf: "a⊕" cannot be followed by "=4".      Is it possible to workaround this error and make the compound assignment operator `⊕=` work? * * * Another example: I would like to create a new infix operator `@@@@` (or other) to express `Apply[f,expr,{2}]` in a short form like `f @@@@ expr`. If precisely this is not possible what are the valid "names" I could use?


Output resets when after closing/reopening the file

I've been having an issue in a project I am working on for a demonstration that involves a manipulate containing buttons that influence local variables. In essence, the problem is demonstrated by this piece of code:               Manipulate[DynamicModule[{T = 5},          Dynamic[Panel[Row[{T, Spacer[50], Button["T", T = T + 1]}]]]], {x,      1, 4}]      Before Closing: ![enter image description here](http://i.stack.imgur.com/cK2dE.png) After Reopening: ![enter image description here](http://i.stack.imgur.com/tSt3z.png) It works fine as far as functionality, but when I try to create a thumbnail and snapshot with the output, the values displayed are not saved if I close and reopen the file (in the case of this program, the display of of T would be reset to 5). How can I get around this?


How hide symbolic definition of a function?

How can the actual definition of a function be hidden from a user? I want the user of a notebook to be able to evaluate a real-valued function f of a real variable at any particular numeric input yet not be able to see the symbolic expression that defines it. E.g.:               f[x_]:=Exp[-x] Cos[2x]      Of course I know I want to hide the definition of `f` in a package, say `func.m` consisting of something like the following:               BeginPackage["func`"]     f::usage = "f[x] gives the value of the secret function f at x";          Begin["`Private`"]     f[x_]:=Exp[-x] Cos[2x]     SetAttributes[f,{ReadProtected,Locked}]     End[]          EndPackage[]      This package file would be `Encode`d and put into the same directory as a notebook, say `work.nb` where the user will work with the hidden definition. And this notebook would include, in an Initialization cell:               SetDirectory[NotebookDirectory[]]     Get["func`"]      But after that cell is evaluated, still evaluating               f[x]      unfortunately reveals the symbolic definition of `f`. Is it possible somehow to hide the symbolic definition yet be able to evaluate `f` at arbitrary numeric input?


Why wouldn't ReplaceAll (/.) work with this list of number?

The answer to this might be simple, but why would `ReplaceAll` return such a weird result when replacing a number in a list of numbers:               {1, 2, 3, 4}/.2 -> 5     (* {5., 10., 15., 20.} -> 5 *)      even though it does fine with this?               {1, 2, 3, 4} /. x_ /; x == 2 -> 5     (* {1, 5, 3, 4} *)      As far as I know, `2` after `/.` represents a pattern that matches the number 2. For example, these both work:               Cases[{1, 2, 3, 4}, 2]     (* {2} *)          Position[{1, 2, 3, 4}, 2]     (* {{2}} *)      All the examples of `ReplaceAll` in the documentation seem to replace only symbols, and I couldn't find a similar questions on SE, hence this question.


Creating histogram?

How can i create histogram of these variables that would show the depth of sensors when temperature is 0 Degree Celsius. Time function is 0 min, 50 min, 100 min, 150 min, 200 min, and 250 min and depth of sensors in ground is 10cm, 20cm, 30cm, 40cm, and 50cm. The first number indicates the running time in minutes, followed by a 5 sensors temperature readings, first is in 10cm depth and last in 50cm               Mydata= {{0, -0.65625`, 0.4375`, 0.625`, 0.75`, 1.6875`},     {50, -0.71875`, 0.4375`, 0.5`, 0.8125`, 1.5`},     {150, -0.78125`, 0.34375`, 0.5625`, 0.8125`, 1.5625`},     {200, -0.8125`, 0.46875`, 0.53125`, 0.65625`, 1.5`},     {250, -0.8125`, 0.375`, 0.53125`, 0.6875`, 1.5`}};


Evaluating selected expression using keyboard shortcut

Imagine that in this toy code I want to evaluate just the selected (blue) expression: ![enter image description here](http://i.stack.imgur.com/4vSS2.png) To get as output result: {09/14,09/15,09/16,09/17,09/18,09/19,09/20} There is some shortcut to do this? I'm looking for something like `Command`+`Shift`+`Enter` (Mac). But I don't want it to evaluate in place, but as an output. Maybe something that I can put into KeyEventTranslations.tr Today I have to copy the code to outside the module, or comment the rest of it. In this toy code it's a easy task, but for bigger code it's very annoying to do.


Drawing a torus not bounding a solid torus

I am trying to make a "pretty" picture of a torus in $\mathbb{R}^3$ which does not bound a solid torus. The standard way of constructing such a thing is to first take a non-trivial torus knot:               f[t_, s_] := {(2 + Cos[s]) Cos[t], (2 + Cos[s]) Sin[t], Sin[s]} -                   {2,0, 0}      ParametricPlot3D[f[t, 3 t/2], {t, 0, 4 Pi}]      This is the trefoil knot (the minus $\lbrace2,0,0\rbrace$ will be explained shortly). We then take a tubular neighborhood around this knot:               Needs["VectorAnalysis`"]     df[t_] := Evaluate[D[f[t, 3 t/2], t]]     v1[t_] := CrossProduct[df[t], {0, 1, 0}] // Normalize     v2[t_] := CrossProduct[df[t], v1[t]] // Normalize     ParametricPlot3D[     f[t, 3 t/2] + Cos[\[Theta]] v1[t] + Sin[\[Theta]] v2[t],     {t, 0,4 Pi}, {\[Theta], 0, 2 Pi}, Mesh -> None]      (I checked beforehand that the derivative is never in the $\lbrace0,1,0\rbrace$ direction.) Now I define the composition of a stereographic projection to $S^3$, and one back to $\mathbb{R}^3$. The key is that the latter map can be from _any_ point, so I simply pick one that lies on my knot! [This is why I subtracted $\lbrace2,0,0\rbrace$ before: it ensures the origin lies on the knot, and gives this composition a very easy form.]               s3Proj[v_]:=v/(Norm[v]^2)     ParametricPlot3D[s3Proj[     f[t, 3 t/2] + Cos[\[Theta]] v1[t] + Sin[\[Theta]] v2[t]],     {t, 0,4 Pi}, {\[Theta], 0, 2 Pi}, Mesh -> None]      The problem is (I don't know how to include the picture) that Mathematica is not drawing this torus the way I want. By looking at the "general shape", I know it is the right torus, but for some reason Mathematica is "flaying" the ends of this torus out. I think the problem is due to the fact that any such torus has to travel "inside" itself (basically tracing the knot and then "exiting" itself again), and Mathematica gets confused in how to draw that. Is there some way to "clean up" this plot? Or maybe someone knows another way to draw an attractive version of this torus? [My browser is acting up and I cannot tag this question; please feel free to tag it for me.]


Jumps on a Plot animation

The following code:                Table[       Plot[Sin[a], {a, 0, i}, PlotRange -> {{i - 3600, i}, {-1, 1}},         ImageSize -> 800, AspectRatio -> 0.2, Frame -> True,         PlotRangePadding -> 0, GridLines -> Automatic,         FrameLabel -> {{Style["SOME TEXT - m", 13],            None}, {Style["Time - s", 13], Style["THE TITLE", 13, Bold]}},         Axes -> False],       {i, 1, 10000, 100}       ]      Generates jumpy labels, ticks and frames: ![enter image description here](http://i.stack.imgur.com/5T9mk.gif) How can I get a less vibrating plot (not referring to the plotted line itself...) **EDIT:** The following is closer to my real case, and `ImagePadding` doesn't work:               Dynamic@ListLinePlot[Table[Sin[a], {a, i - 3600, i}],        PlotRange -> {{i - 3600, i}, {-1, 1}}, ImageSize -> 800,        AspectRatio -> 0.2, Frame -> True, PlotRangePadding -> 0,        GridLines -> Automatic, PlotStyle -> Thick,        FrameLabel -> {{Style["Something", 13],           None}, {Style["Time - s", 13], Style["SOMETHING", 13, Bold]}},        Axes -> False, ImagePadding -> 50]     Do[Pause[0.1]; i = a, {a, 10, 1000000}]


Do you know of any web-based university course that is entirely Mathematica based?

Does anybody known of a web-based university course entirely built with _Mathematica_? I mean one where the whole course (lectures/labs/exams) is presented in _Mathematica_ FrontEnd form. My point is that _Mathematica_ is very user-friendly, supporting the principle "if you can visualize this data/process, you must do it". I suppose this feature makes _Mathematica_ very attractive for wide use in university courses, if not now then in the near future. So I am looking for exising examples. Any links?


Simple 3D graphic

How can I make a simple 3D graphic as in the following image? ![Figure](http://s10.postimage.org/exfxxtgh5/3d_figure.jpg)   I know it is simply a sphere and a circle with several joining lines but I dont know how to make such simple one. I can use `ParametricPlot3D` to draw the sphere $(\cos[u]\cos[v],\cos[u]\sin[v],\sin[u])$ for $-\pi\leq u,v\leq\pi$ and the circular orbit which can be taken as the intersection of the sphere with a twice radius and the plane $y+z=0$ or $x-y+z=0$. But I can not simplify the figure, i.e., making the sphere transparent so that the data can be put inside it and etc.


How to efficiently fill in matrix values?

I would like to efficiently fill in or assign values to matrix m: m={   {a[1,1],a[1,2],a[1,3],a[1,4]},   {a[2,1],a[2,2],a[2,3],a[2,4]},   {a[3,1],a[3,2],a[3,3],a[3,4]},   {a[4,1],a[4,2],a[4,3],a[4,4]}}; a[1,1] to a[4,1] to be equal to 1. a[1,2] to a[4,2] to be equal to another column of value: ![enter image description here](http://i.stack.imgur.com/E7nRV.png) a[1,3] to a[4,3] to be equal to another column of value: ![enter image description here](http://i.stack.imgur.com/RxmJg.png) and a[1,4] to a[4,4] to be evaluated based on the matrix locations of the other a[1,1] to a[4,3] cells as in excel cell format of : a[1,4] = a[1,1]*a[2,3]+ etc etc but as soon as those dependencies are replaced with actual numbers, for example a[1,1] is now no longer symbolic but actual values, then how to symbolically do those evaluations based on cell locations similar to Excel as I will reuse this matrix again? Maybe use Table or something to evaluate and then join them together into a large matrix ?


M9 performance regression for Fold?

I noticed an over 10x performance drop on Mathematica v9.0.1 (as Oleksandr R. commented, also v8) compared with v7.01 for this code:               SetSystemOptions["CatchMachineUnderflow" -> False];     AbsoluteTiming@       Fold[{(#[[1]] Sin[10.5])/(#2 + 1), #[[2]] + Tan[#[[1]]]} &,        {Sin[10.5], 1.0}, N@Range[10^6]]       I got `{0.184287, {0., 0.105747}}` on v7, but got `{2.311755, {0., 0.105747}}` on v9. Note that the Do[...] version of above code needs about 2 seconds. Thus I suspect that on v9 the Fold code is not properly auto-compiled. Is this a regression? (Also is there a way to see if auto-compile worked or not?) **Additional information** I compared that in v7 and v9 the CompileOptions are the same (except that v9 has some options that are not present in v7):               SystemOptions[CompileOptions]      > {"CompileOptions" -> {"ApplyCompileLength" -> [Infinity], > "ArrayCompileLength" -> 250, "AutoCompileAllowCoercion" -> False, > "AutoCompileProtectValues" -> False, "AutomaticCompile" -> False, > "BinaryTensorArithmetic" -> False, "CompileAllowCoercion" -> True, > "CompileConfirmInitializedVariables" -> True, > "CompiledFunctionArgumentCoercionTolerance" -> 2.10721, > "CompiledFunctionMaxFailures" -> 3, "CompileDynamicScoping" -> False, > "CompileEvaluateConstants" -> True, "CompileOptimizeRegisters" -> False, > "CompileParallelizationThreshold" -> 10, "CompileReportCoercion" -> False, > "CompileReportExternal" -> False, "CompileReportFailure" -> False, > "CompileValuesLast" -> True, "FoldCompileLength" -> 100, > "InternalCompileMessages" -> False, "ListableFunctionCompileLength" -> 250, > "MapCompileLength" -> 100, "NestCompileLength" -> 100, > "NumericalAllowExternal" -> False, "ProductCompileLength" -> 250, > "ReuseTensorRegisters" -> True, "SumCompileLength" -> 250, > "SystemCompileOptimizations" -> All, "TableCompileLength" -> 250}} To compare, I also tried the following code, where the performance on v7 and v9 are roughly the same (v9 is on average 5% more slowly though).               AbsoluteTiming@Fold[# + Sin[#2] &, 1.0, Range[10^6]]      A difference is that here the first argument of function in Fold is a number, and in the problematic example, the first argument is a list. PS: I noticed this issuee during a discussion at About auto-compiling and performance between Do and Fold . But considering this regression issue is a different question, I ask here separately.


Get domain for a given function (including e.g. singularities)

I am new to Mathematica and this is probably a simple question, but I can't figure it out at the moment...               f[x_]:=1/(x-3)      Clearly the vertical asymptote is at `x->3`, as`1/0` is undefined. I would like some kind of function that's output is simply:               3      I need to know where the function is undefined. Some functions give me: `{{x->3}}` and things like that, but I can't work with that. Any help would be great.


NDSolve::ndsz:At t==0.000039576, step size is effectively zero

I adjusted my code accordinly to the advice I got. However I still have a problem with this code which now looks like this:               NDSolve[{       D[y[r, f, t], r, r] + (1/r)*D[y[r, f, t], r] + (1/r^2)*          D[y[r, f, t], f, f] == (1/1.27*10^-4)*D[y[r, f, t], t],        y[r, f, 0] == 0,        y[0.01, f, t] == 0,        (D[y[r, f, t], r] /.          r -> 2*10^-6) == -(1/(3.14*10*10^-6*318))*(1 - Cos[2*2*3.14*t/2])           Piecewise[{{t 10, t < 1/10}, {1, True}}],        (D[y[r, f, t], f] /. f -> 2*3.14) == -(10/238)*y[r, 2*3.14, t],        (D[y[r, f, t], f] /. f -> 3*3.14/2) == 0},       y, {r, 2*10^-6, 10^-2}, {f, 3*3.14/2, 2*3.14}, {t, 0, 1},        MaxStepFraction -> 1/60]      When I run it, I get the following error message: > NDSolve::ndsz: At t==0.000039576, step size is effectively zero; singularity > or stiff system suspected Please, anyone can help me with this?


How can I convert a complex number a+b I to the exponent form A Exp(I phi)?

When I have an expression such as:               (1/4 + I/4) ((1 - 2 I) x + Sqrt[3] y)       it is hard to get an intuition of the number. So I want to convert it to the complex exponent notation: $\frac{1}{2} \sqrt{\frac{5}{2}} e^{-\frac{i \pi }{12}} x+\frac{1}{2} \sqrt{\frac{3}{2}} e^{\frac{i \pi }{4}} y$ and I also want to convert $(-1)^{1/4}$ to $\exp \left(\frac{i \pi }{4}\right)$. How can I do it with _Mathematica_?


How to make MapAt work with Span?

`Span` (`;;`) is very useful, but doesn't work with a lot of functions. Given the following input               list = {{"a", "b", "c"}, {"d", "e", "f",         "g"}, {"h", {{"i", "j"}, {"k", "l"}, {"m", "n"}, {"o", "pp"}}}}      We would like               MapAt[Framed, list, 1 ;; 2]     MapAt[Framed, list, {{1, 1}, {2, 2 ;; 3}, {3, 2, 1 ;; 3, 1}}]      to work as expected ![enter image description here](http://i.stack.imgur.com/vwOtu.png) Here is my first go at it:               SpanToRange[Span[x_:1,y_:1,z_:1]] := Module[{zNew = z},         If[x>y && z==1, zNew = -1];             Range[x, y, zNew]         ] /; And[VectorQ[{z,y,z}, IntegerQ],         And @@ Thread[{z,y,z} != 0]]          helper = Function[list,         Module[{li=list},             If[FreeQ[li, Span], li,             li = Replace[li,s_ /; Head[s] =!= Span :> {s}, {1}];             li = li /. s:_Span :> SpanToRange[s];             Sequence @@ Flatten[                 Outer[List, Sequence @@ li],                 Depth[Outer[List, Sequence @@ li]]-3]]         ]     ];          protected = Unprotect[Span, MapAt];     Span /: MapAt[func_, list_, s:Span[x_:1,y_:1,z_:1]]:= MapAt[func,       list, Thread[{SpanToRange[s]}]];     MapAt[func_, list_, partspec_] /; !FreeQ[partspec, Span] := Module[{f,p = partspec},         MapAt[func, list, Join[helper /@ p]]     ];     Protect[Evaluate[protected]];      But this is far from finished, and the extended down values should support all valid uses of `Span` such as               MapAt[Framed, list, 3 ;;]     MapAt[Framed, list, ;; ;; 2]     MapAt[Framed, list, ;; 10 ;; 2]


Mathematica Solve function does not solve double exponential

I am trying to solve:               Exp[-a Exp[-x/b] - c Exp[-x/d]] == Y      to x, and using the command               Solve [Exp[-a Exp[-x/b] - c Exp[-x/d]] == Y, x]      Mathematica says me that it can't do it: > "Solve::nsmet: This system cannot be solved with the methods available to > Solve". I believed the problem was in introducing the terms or constants b and d, and maybe adding the assumptions that there are constants or parameters larger than 0 it works. But I see that solve doesn't accept Assumptions as parameters. Than trying to put any set of constants (example: 1,2,3,4) for a, b, c and d I got the same error. Somebody can help me to understand why it not works and how to solve this equation? Thank you very much.


How to speed up mouse events?

Grids of dynamic objects responding to mouseovers seem to be quite slow in general, for instance:               Grid[Table[       Mouseover[Framed[" ", Background -> Blue],         Framed[" ", Background -> White]], {i, 50}, {j, 50}],       Spacings -> {0, 0}]      How can this lagging be avoided?


Using ReplaceAll to replace a head

Why would this work to replace the head `b` with `newHead`:               b[c, d] /. head_[arg__] :> newHead[arg]     (* newHead[c, d] *)      but when `b` is nested within another head `a`, only `a` is replaced using the same rule:               a[b[c, d]] /. head_[arg__] :> newHead[arg]     (* newHead[b[c,d]] *)      Using `ReplaceRepeated` (`//.`), and `HoldPattern` did not help:               a[b[c, d]] //. head_[arg__] :> newHead[arg]     a[b[c, d]] /. HoldPattern[head_[arg__]] :> newHead[arg]     a[b[c, d]] //. HoldPattern[head_[arg__]] :> newHead[arg]     (* newHead[b[c, d]] *)      * * * **My question is** : Is there any way to replace both `a` and `b` with `newHead` using a transformation rule?


Automatically growing lists as in MATLAB?

Is there a way to add elements to a list at positions outside the current list's length? Something equivalent to the following MATLAB code snippet:               x = [1,2,3];     x(5) = 5      which returns:               x =               1     2     3     0     5


BarLegend changes in Version 10

Apparently, `BarLegend` in version 10 displays tick legends in scientific notation when they are smaller in magnitude than 0.01. For instance,               BarLegend[{"Rainbow", {-.015, .015}},      LabelStyle -> Directive[Black, Bold, FontSize -> 12]]      creates the object ![enter image description here](http://i.stack.imgur.com/v3640.png) How can I change the tick labels to decimal notation, as they would have appeared in version 9? By the way, the `Bold` directive evidently is being ignored. Is there a work- around for this?


Understanding Pie Chart Annulus generation and alternate style using Disk[]

# Background I have been working with a set of data for some time now and I recently decided to change the format. The data is a tree-styled listing of hierarchical names and positions. ![Normal Look](http://dl.dropbox.com/u/24370169/trees2_nonames.PNG) (* Names have been removed. *) My goal is to take the tree and convert it into a different form, something like one of these: ![Ring Look](http://dl.dropbox.com/u/24370169/trees_nonames.PNG) (* Once again, name has been removed from Tooltip *) I am currently doing this with the `Disk[]` primitive, but this requires me to build it up from the ground (outside) instead of the top (inside) so that they stack properly and the inner layers are visible. # The Question The `PieChart[]` method built into _Mathematica_ provides an option for removing a portion of the chart (the annulus of the circle) using `SectorOrigin->{{pos,sense}, r_inner}`. Unfortunately the `Disk` primitive does not have the same ability (as far as I can tell...) so I looked at the full code for the creation of a simple donut chart:               PieChart[{1,1}, SectorOrigin->{Automatic,1}]//FullForm      The full form code explains that the PieChart creates the sectors as point listed polygons instead of as something a little more simple. Is there a better way to go about removing the center portion of a `Disk[]` without generating a list of points and joining them as a polygon? I ask this question because it seems that this should be an option for `Disk[]` and I'm curious to know if I have missed something. The end result should allow me to generate the sectors of the Sunburst Chart above without having to pay attention to the order in which it was generated (no centers means the chart wouldn't require a certain stacking order). ## Also As a side note : I considered using `Circle` with the `Thickness` option:                Graphics[{Thickness[0.05],Circle[{0,0},1,{0,Pi}]}]      but the generated output is not partitioned properly and gives more of a U shape than a pie sector. # A module I used when coming up with the idea Unfortunately the data does not have even divisions, so the model represented here isn't good for the data (nor does it use the data to create the chart), but it may help you understand how I stumbled onto the question. I can't seem to believe that _Mathematica_ doesn't have that option built in to one of the primitives               Manipulate[ Module[ {makeDisk, tree, partitions, color, range},            range = {lowerlim, upperlim, upperlim - lowerlim};            (* Plotting Colors *)       color = {RGBColor[32/255, 0/255, 64/255], RGBColor[64/255, 0/255, 127/255], RGBColor[128/255, 0/255, 255/255], RGBColor[96/255, 0, 191/255], RGBColor[115/255, 0/255, 229/255]};            (* Applying colors 1 - top level, 2,3 - even levels, 4,5 - odd levels *)       colorApplied[level_, division_] := If[level != 1, If[EvenQ[level], If[EvenQ[division], color[[2]], color[[3]]], If[EvenQ[division], color[[4]], color[[5]]]], color[[1]]];            (* Function to make disks *)       makeDisk[level_, divisions_] := Module[{fan},          partitions = divisions^(level - 1);          fan = Table[{EdgeForm[Thick], colorApplied[level, i], Disk[{0, 0},level,lowerlim + Partition[Table[(n*range[[3]])/partitions, {n, 0, partitions}], 2, 1][[i]]]},{i, 1, partitions}];         Return[fan]         ];            (* Tree Construction *)       tree = Append[Drop[Table[makeDisk[(levels - level + 1), divisions], {level, 1, levels}], -1], {EdgeForm[Thick], color[[1]], Disk[{0, 0}, 1, {lowerlim, upperlim}]}];            (* Display Graphic *)       Show[Graphics[tree]]            ],           (* Manipulate components *)      {{levels, 2, "Depth"}, 2, 15, 1},      {{divisions, 2, "Subgroups"}, 2, 10, 1},       {{lowerlim, 0, "Bound1"}, 0, (upperlim - Pi/6),  Pi/6},       {{upperlim, 2 Pi, "Bound2"}, (lowerlim + Pi/6), 2 Pi, Pi/6},       TrackedSymbols :> Manipulate      ]      # Using Polygon to create a Graphic Primitive Yes, I could create a polygon primitive to generate the ring...               ring[outter_, inner_, size_, res_] :=        Module[{p, q, outterPoints, innerPoints, partition},        p = res;        q = (size)/(2 Pi);        outterPoints =          Table[{outter Cos[ k q 2 Pi/p], outter Sin[ k q 2 Pi/p]}, {k, 1,            p}];        innerPoints =          Table[{inner Cos[ k q 2 Pi/p], inner Sin[ k q 2 Pi/p]}, {k, 1, p}];        partition =          Polygon[Flatten[{outterPoints, Reverse@innerPoints}, 1]];        Return[partition]        ];      Then running using this, or something similar.                Graphics[ring[2, 1, Pi/2, 3000]]      to generate this: ![Ring section](http://dl.dropbox.com/u/24370169/ring%20primitive.png) Then I could either rotate or change the primitive for the specific positioning, but I'd prefer if there were some way to do it based on the built-in functions of _Mathematica_.


Make ControlActive respond faster within Animate

The following code uses Animate to create an animation that displays as {t, "Inactive"} when paused, and {t, "Active"} when running:               Animate[ControlActive[{t, "Active"}, {t, "Inactive"}], {t, 0, 10}]      ![Paused animator not yet refreshed](http://i.stack.imgur.com/FKZoY.png) However, ControlActive is strangely slow to refresh when the animation is paused. Try it by evaluating the above and pressing the pause button. It takes around 1 second for {t, "Inactive"} to replace {t, "Active"}. In constrast, ControlActive is very responsive within Manipulate. Try moving the slider here after evaluating this:               Manipulate[ControlActive[{t, "Active"}, {t, "Inactive"}], {t, 0, 10}]      The difference seems to hinge on the Animator control. For example ControlActive becomes slow again when using that control with Manipulate:               Manipulate[ControlActive[{t, "Active"}, {t, "Inactive"}], {t, 0, 10, Animator}]      Any ideas on why ControlActive refreshes more slowly within Animate or how to tweak it?


extract x and y axis from plot

I am trying to write a function that read what is the FrameLabel of a plot and translates that to filesystem friendly name, that, for instance does not contain "/" or greek characters and so on ... The goal is to get a function that exports a plot to PDF and automatically gives it a meaningful file name of the type XAxisLabel_YAxisLabel_PlotLabel.pdf Here is what I got so far. 1) a translation for unwanted character and strings:                 FileSystemFriendly={\left->,\right->,\text{->,$->,\{->,\}->, ->,\->,{->,}->,/->.over.,>->.gt.,<->.lt.,=->.eq.}      2) a function that actually takes the plot and looks for the labels                 PlotAutoExport[inputplot_]:=Module[{res,respath},           res=Export[StringReplace[ToString[TeXForm[FrameLabel/. inputplot[[2]]]],FileSystemFriendly]<>__<>StringReplace[ToString[TeXForm[PlotLabel/. inputplot[[2]]]],FileSystemFriendly]<>.pdf,inputplot];           Print[File put in,respath=Directory[]<>/<>res];           Button[Open it!,SystemOpen[respath]]         ]      This is giving some acceptable results so far, which means that the filenames are usable on a regular filesystem. However the typical name is plenty of garbage, for instance for a very simple label I still get `(beginarraycc1-Cumulative&Nonep_T,j_ 3&Noneendarray)__PlotLabel` which has lots of stuff that I do not know where it comes from. I could chase and remove one by one the unwanted stuff but I feel like I am not doing it the right way. Hence I wanted to ask for some advice. Thanks for sharing your knowledge, Roberto


Are solid spherical harmonics implemented in Mathematica?

In certain applications, solid spherical harmonics can be very useful. They are essentially the usual, 'surface' spherical harmonics, with the appropriate power of the radius inserted: $$S_l^m(x,y,z)=r^l Y_l^m(\theta,\phi).$$ They are particularly useful because, for integer $l$ and $m$, they are homogeneous polynomials of degree $l$ in $x$, $y$ and $z$, and do not therefore require any ugly square roots or inverse trigonometric functions. The first few such functions are as follows: $$ \begin{array}{ccc} \frac{1}{2 \sqrt{\pi }} & 0 & 0 \\ \frac{1}{2} \sqrt{\frac{3}{\pi }} z & -\frac{1}{2} \sqrt{\frac{3}{2 \pi }} (x+i y) & 0 \\ -\frac{1}{4} \sqrt{\frac{5}{\pi }} \left(x^2+y^2-2 z^2\right) & -\frac{1}{2} \sqrt{\frac{15}{2 \pi }} z (x+i y) & \frac{1}{4} \sqrt{\frac{15}{2 \pi }} (x+i y)^2 \\ \end{array} $$ More generally, though, it is useful to be able to implement a spherical harmonic when the natural input is the cartesian components of the argument. Is this implemented in Mathematica? There is nothing very obvious at all in the documentation, though maybe it is hidden away in some third-party package. If there isn't a built-in function, is there some specific reason for that?


How to add texture to solid Graphics3D object such as cylinder?

I'd like to add texture to a `Cylinder` inside `Graphics3D`. I can't see how to use `FaceForm` and tell it to use `Texture`. The problem is `Texture` needs `TextureCoordinateFunction`. I saw few solutions, but many use `ParametricPlot3D`, which I could use, but I need a solid `Cylinder`, so I would have to do the top/bottom faces manually. For example, using the solution in Applying an ArrayPlot as a texture to the surface of a cylinder I could do               mplt = MatrixPlot[Table[Sin[x y/100], {x, -10, 10}, {y, -10, 10}],         ColorFunction -> "Rainbow", Frame -> False, ImagePadding -> 0,         PlotRangePadding -> 0];     p = ParametricPlot3D[{ Cos[theta], Sin[theta], rho}, {theta, -Pi, Pi}, {rho, 0, 3},         PlotStyle -> Directive[Specularity[White, 30], Texture[mplt]],         TextureCoordinateFunction -> ({#1, #3} &), Lighting -> "Neutral",         Mesh -> None, PlotRange -> All, TextureCoordinateScaling -> True];          Graphics3D[First@p]      ![Mathematica graphics](http://i.stack.imgur.com/g5d2V.png) But what I want is to add texture to outside surface of                 Graphics3D[Cylinder[{{0, 0, 0}, {0, 0, 3}}, 1], Axes -> True]      ![Mathematica graphics](http://i.stack.imgur.com/LwQJk.png) There is solution here for 2D objects How to texturize a Disk/Circle/Rectangle? since one can find the `VertexTextureCoordinates` are easy to do for these. I think what is needed here is to tell `FaceForm` to use `Texture`? but do not know how to go about this. Version 9.01


Compile without hardcoding

My question is how to pre-compile the rules1, rules2 and result parts of the following Module code without hard-coding the many (and changing number of) variables and rather complicated equations:                   fn[pars_]:=Module[{rules1,rules2,rules3,result},         rules1=[externalvars1->pars];         rules2=Join[rules1, externalrules/.rules1];         rules3=Join[rules2, externalfunction[externalvars2/.rules2]];         result=externalvars3/.rules3]      Thanks. (PS I have studied Mathematica's Compile tutorial and Rob Knapp's 2011 Presentation)


Did Mathematica 9 remove some previously available stylesheets? If so, how can I customize a currently available style sheet to be like a previous one or get previous version's stylesheet back? I frequently used the natural beige color stylesheet (Format > StyleSheet > Creative > NaturalColor), but Mathematica 9 seemed to have removed it. Also, how do I check which stylesheet is currently employed?


How to select all initialization cells?

Is there an easy way to select all initialization cells (and only those) in a Mathematica notebook?


How to get only the real solutions of an equation?

Is there any simple way to get only the real solutions of the eq. x^3-1=x? I've tried:               Solve[x^3-1==x,x]      But it gives the complex ones, too. I have Mathematica 5.2


How do I run scripts on networked computers directly from Mathematica?

The answer to an earlier question, Computers running Wolfram Lightweight Grid Manager won't fall asleep, left me with a new problem. To review, I have a computing environment comprised of:   * 27" iMac with dual cores running Mac OS X 10.6.8 and   * 2 XServes each with 2 quad cores running Max OS X Server 10.6.8   * All networking by ethernet to a Time capsule. As this question has more general application than the earlier question, I thought it merited its own post. ... I need to launch and shut down a service (in my case _Wolfram Lightweight Grid Manager_ but this really applies to any service, program, or application) which needs to run on a server (or more generally, any other machine) attached to my network (or again more generally, any network to which one has authorized access). So, ideally I'd like to do the following:   * Access and log on to (a) remote computer(s) on a local network _directly from Mathematica_ ;    * Launch a script on the remote computer that will in turn launch Wolfram Lightweight Grid Manager;    * Launch available kernels;    * Run parallel processing code;    * Close remote kernels; and    * Launch a script on the remote computer to close Wolfram Lightweight Grid Manager. * * * Can I do all of this from within Mathematica? How? * * * `Run[]` enables one to run a command line program: ![Run\[\] example](http://i.stack.imgur.com/NnXzj.png) But how do I get to a remote machine, especially as it does not likely have a fixed IP address? ;-( I would appear to need a way to identify machines on the network (I do have machine names and log on credentials). I've very rarely done this sort of thing. * * * Could a script launched locally by the `Run[]` function access the remote machines and launch a script on them? * * * That would make it easy. References or examples welcome. My Unix script never amounted to much, so any guidance welcome. It also, occurs to me that one could do this via JLink, but as the little I knew of Java has generally drifted out of my memory a more direct solution would do me better.


Create a torus with a hexagonal mesh for 3D-printing

I am new to _Mathematica_ , and I'm looking for a way to create patterns on the surface of 3D objects. One thing I have not been able to do is create a hexagonal mesh on a torus. What I would like to have is a hexagonal mesh that has a certain thickness (so it would be 3D printable). So far, I have been able to create the torus itself. I am not sure of how to create the hexagonal pattern on the surface and the process of mapping it onto the torus.               ParametricPlot3D[{Cos[t] (3 + Cos[u]), Sin[t] (3 + Cos[u]), Sin[u]},       {t, 0, 2 Pi}, {u, 0, 2 Pi}]      ![Mathematica graphics](http://i.stack.imgur.com/cD6Fm.png)


How to make a notebook that will be window maximized when open?

I use               CreateDocument[cells, opts]       to create a notebook. When the notebook is open, it has a small default windows size and I need to manually maximize it every time. Is there a good way to have it maximized by default?


Is it possible to export a graph as graphic to Excel?

It is straightforward to export lists to Excel with `Export`. Can I export a graphic image, too? This does not work:               g = CompleteGraph[4];     fnOut = "Output1.xls";     Export[fnOut, {"Sheet1" -> g}]      Maybe I need to transform `g` in some way?


How to process .vtk file

I want to extract the cluster of points inside 3D box, is there any way one can do this in _Mathematica_?


Substituting Symbol font for Mathematica's custom font in exported plots and other graphics

Mathematica includes some custom fonts that allow you to use a wide range of mathematical symbols in output. For example, one can write:               testdata = FoldList[0.99 #1 + #2 &, 0.,       RandomVariate[StableDistribution[1, 1.3, 1, 0, 0.5], 100]]     version1 = ListLinePlot[testdata,       PlotLabel -> "Shocks are StableDistribution, \[Beta]=1"]      The resulting graphic will show a nice beta ($\beta$) in the plot label, and the Mathematica-specific font will embed correctly in a PDF file, for example. ![enter image description here](http://i.stack.imgur.com/bPXS1.png) That's fine if your target format is PDF, or if the other users of the graphic have the Mathematica fonts installed. But what if you want to include the graphic in a PowerPoint for Windows files, and therefore need to use WMF or EMF format, but you can't guarantee that the viewers of the PowerPoint file have the Mathematica fonts installed? Is there a way to use the ubiquitous Symbol font instead?


GroupBy several keys while keeping the Dataset as a Table (List of Associations)

Assume you import data from a Table source of the following format.               << GeneralUtilities`; fields = {"Country", "Region", "BU", "Year",      "Date", "Sales"};     organization = {{"Argentina", "LATAM", "Americas"}, {"SouthAfrica",          "Africa", "EAME"}, {"Brazil", "LATAM", "Americas"}, {"Japan",          "Japan", "APAC"}, {"Australia", "ASEAN", "APAC"}, {"Germany",          "Europe", "EAME"}};     SeedRandom[0];     list = Flatten[        Table[Join[          organization[[i]], {year, DateObject[{year, month, 1}],            RandomInteger[{100, 1000}]}], {i, 6}, {year, 2004,           2013}, {month, 1, 6, 5}], 2];     sales = Dataset[AssociationThread[fields, #] & /@ list]      ![enter image description here](http://i.stack.imgur.com/HI4Q6.png) I would like to summarize the data at the year level. If working with a database, an SQL command of the following format would allow you to create a dataset that is still flat. > SELECT sales.Country, sales.Region, sales.BU, sales.Year, Sum(sales.Sales) > AS SumOfSales FROM sales GROUP BY sales.Country, sales.Region, sales.BU, > sales.Year; ![enter image description here](http://i.stack.imgur.com/gSz8E.png) Using               sales[GroupBy@Key["Country"], GroupBy@Key["Region"],       GroupBy@Key["BU"], GroupBy[Key["Year"]], Total, "Sales"]      Creates a multilevel hierarchical data structure, which is not as simple to operate as a table type of dataset. ![enter image description here](http://i.stack.imgur.com/jcrzq.png) Is there a way to operate (total,mean, median,etc) on a dataset by grouping on several keys of interest while keeping the dataset flat the same way as done with the SQL procedure?


How to store value in a For loop

I am using two `For` loops. When the inner loop finishes, I don't want to print but I want to store the result from the inner loop in some variable so that I can call that variable in the future. That result will come in the form of a list. For example, in the 1st iteration,it is returning some value, e.g. {2,4}. in the 2nd iteration,it is returning {3,4}. But I don't want to print them every time. I want some variable to store {{2,4},{3,4}}. How to do that? Here I am retrieving all the data except Null.               tab={{{"option1", "option3", "option4", "optio", "Null",              "Null"}, {"option2", "option5", "option6", "option7", "Null", "Null"},               {"option", "op", "Null", "Null", "Null", "Null"}}};          For[j = 1, j <= Length[tab[[1]]], j++,       For[i = 1, i <= Length[Rest[tab[[1, j]]]], i++,          If[TrueQ[(Rest[tab[[1, j]]][[i]]) == "Null"], count++, count = 0]]      Print[     Table[Rest[tab[[1, j]]][[i]], {i,1, (Length[Rest[tab[[1, j]]]] - count), 1}]] ]


How can I compute the representation matrices of a point group under given basis functions?

Take the $C_{3v}$ point group for example:               Rot[θ_] := RotationMatrix[θ]     E0 = IdentityMatrix[2];     C1 = Rot[2π/3];     C2 = C1.C1;     σ1 = ReflectionMatrix[Rot[2π/3].{1, 0}];     σ2 = C1.σ1.Inverse[C1];     σ3 = C2.σ1.Inverse[C2];     C3v = {E0, C1, C2, σ1, σ2, σ3};      So $C_{3v}$ has the following 6 elements: $ \left\{ \begin{pmatrix} 1 & 0 \\ 0 & 1 \\ \end{pmatrix}, \begin{pmatrix} -\frac{1}{2} & -\frac{\sqrt{3}}{2} \\ \frac{\sqrt{3}}{2} & -\frac{1}{2} \\ \end{pmatrix}, \begin{pmatrix} -\frac{1}{2} & \frac{\sqrt{3}}{2} \\ -\frac{\sqrt{3}}{2} & -\frac{1}{2} \\ \end{pmatrix}, \begin{pmatrix} \frac{1}{2} & \frac{\sqrt{3}}{2} \\ \frac{\sqrt{3}}{2} & -\frac{1}{2} \\ \end{pmatrix}, \begin{pmatrix} \frac{1}{2} & -\frac{\sqrt{3}}{2} \\ -\frac{\sqrt{3}}{2} & -\frac{1}{2} \\ \end{pmatrix}, \begin{pmatrix} -1 & 0 \\ 0 & 1 \\ \end{pmatrix} \right\} $ For given basis functions $\{f_n(\mathbf{r})\mid n=1\cdots N\}$, there is a representation $\{D(g)\mid g\in C_{3v}\}$, in which the $N\times N$ matrix $D(g)$ is defined as $$ f_i(g^{-1}\mathbf{r})=\sum_{j=1}^N f_j(\mathbf{r})D_{ji}(g)$$ where $\mathbf{r}=$`{x,y}` . If the basis functions are just monomials, e.g. $$f_1(\mathbf{r})=x^2,~~f_2(\mathbf{r})=y^2,~~f_3(\mathbf{r})=xy$$ I can compute the representation matrices using the `Coefficient` function               f1[{x_, y_}] := x^2     f2[{x_, y_}] := y^2     f3[{x_, y_}] := x y     basis = {f1, f2, f3};     Rep[g_] := Block[{i, j, ig, x, y, r},        ig = Inverse[g]; r = {x, y};       Table[Coefficient[basis[[j]][ig.r], basis[[i]][r]], {i, 3}, {j, 3}]       ]     repC3v = Rep /@ C3v;     MatrixForm /@ repC3v      This gives the following results: $$ \left\{\begin{pmatrix} 1 & 0 & 0 \\ 0 & 1 & 0 \\ 0 & 0 & 1 \\ \end{pmatrix},\begin{pmatrix} \frac{1}{4} & \frac{3}{4} & \frac{\sqrt{3}}{4} \\ \frac{3}{4} & \frac{1}{4} & -\frac{\sqrt{3}}{4} \\ -\frac{\sqrt{3}}{2} & \frac{\sqrt{3}}{2} & -\frac{1}{2} \\ \end{pmatrix},\begin{pmatrix} \frac{1}{4} & \frac{3}{4} & -\frac{\sqrt{3}}{4} \\ \frac{3}{4} & \frac{1}{4} & \frac{\sqrt{3}}{4} \\ \frac{\sqrt{3}}{2} & -\frac{\sqrt{3}}{2} & -\frac{1}{2} \\ \end{pmatrix},\begin{pmatrix} \frac{1}{4} & \frac{3}{4} & \frac{\sqrt{3}}{4} \\ \frac{3}{4} & \frac{1}{4} & -\frac{\sqrt{3}}{4} \\ \frac{\sqrt{3}}{2} & -\frac{\sqrt{3}}{2} & \frac{1}{2} \\ \end{pmatrix},\begin{pmatrix} \frac{1}{4} & \frac{3}{4} & -\frac{\sqrt{3}}{4} \\ \frac{3}{4} & \frac{1}{4} & \frac{\sqrt{3}}{4} \\ -\frac{\sqrt{3}}{2} & \frac{\sqrt{3}}{2} & \frac{1}{2} \\ \end{pmatrix},\begin{pmatrix} 1 & 0 & 0 \\ 0 & 1 & 0 \\ 0 & 0 & -1 \\ \end{pmatrix}\right\} $$ However, if the basis functions are general functions, not monomials, how can I get the coefficient $a_i$ of function $f_i(\mathbf{r})$ in the transformed function $f_k(g^{-1}\mathbf{r})=\sum_i a_i f_i(\mathbf{r})$? For example, if               F1[{x_, y_}] := (x + I y)^2     F2[{x_, y_}] := (x - I y)^2     F3[{x_, y_}] := (x + y)^2      How can I get the representation matrices under this basis? NOTE: I mean a general method, not just a transformation from basis f1~f3 to F1~F3.


Get tab key to indent a block of code

Is there some way I can change _Mathematica_ keyboard behavior so I could select a block of text/code, press `tab`, and the selection would be indented to right? Similarly, I would like `shift`+`tab` to produce indenting to the left. If it were possible to get this behavior just for multi-line string text, or just in code cells, that would be great, too.


Code to draw geometry doesn't run

I'm new to Mathematica and have no background whatsoever in programming, although I will teach myself soon. I was wondering if one of you programming pros could help me out. I received a code from an online source. The code is supposed to draw some form of geometry (ie: remove faces from say a cube and make a shell/pipe structure out of its edges) I was under the impression that I had to copy/paste the code in the browser and enter it for it to run. However it doesn't seem to do anything. I'm wondering if the code was meant for an old version of Mathematica, has errors in or perhaps I just don't know how to get it running. Would really appreciate if someone could help me until I get my head around Mathematica/coding.               edgeIndicesOfFace[face_] :=       Select[Transpose[{face, RotateLeft[face]}], (#[[1]] < #[[2]]) &];      edgeIndices[gc_] := Apply[Join, Map[edgeIndicesOfFace, gc[[1, 2, 1]]]];     edges[gc_] := Map[vertices[gc][[#]] &, edgeIndices[gc], {2}];           translateVertices[name_, scale_, xyz_] :=        Map[(xyz + #) &, scale vertices[PolyhedronData[name]]];          strut[name_, scale_, edge_] :=       cHull[Join[translateVertices[name, scale, edge[[1]]],         translateVertices[name, scale, edge[[2]]]]];          edgeModel[name_, nameVertex_, scale_] :=       Apply[Join, Map[strut[nameVertex, scale, #] &, edges[PolyhedronData[name]]]];          view[edgeModel["Cube", "Cube", .2]]          Manipulate[      view[edgeModel[big, small, scale]], {big, PolyhedronData[All]}, {small,        PolyhedronData[All]}, {scale, 0.001, 1}]


Simulating Theatre puzzle

I have been trying to simulate the process of the theatre puzzle from the _Joy of X_ (Strogatz). The puzzle, and some relevant material are here. My simplistic coding for this process follows:               seatchoice[u_] := Module[{r, s}, r = RandomReal[]; s = RandomChoice[u];         If[And[MemberQ[u, s + 1], MemberQ[u, s - 1]],           If[r <= 0.5, Complement[u, {s, s + 1}],Complement[u, {s - 1, s}]],            If[MemberQ[u, s + 1], Complement[u, {s, s + 1}],            If[MemberQ[u, s - 1], Complement[u, {s - 1, s}],             If[And @@ (# >= 2 & /@ Differences[Sort[u]]), u,              If[Length[u] == 0, u,               seatchoice[u]]]]]]];      emptyfraction[v_] := N@Length[FixedPoint[seatchoice, Range[v]]]/v;      I have consistently found despite simulations for 100, 1000,2000 seats (recursion and iteration limits are exceeded for large inputs) that expectations are consistently approx 0.124 (versus expected approx 0.135) with narrowing bounds with increasing sample size or sample number. Further, the closed form for the expectation of number of empty seats suggests this approaches limit from above. **Question:** Is this related to dependencies/other in my coding of puzzle; related to pseudorandom number generation in Mathematica; other issues A visualization from my code is appended. ![enter image description here](http://i.stack.imgur.com/fIkL8.gif)