the different way for a drunken man go back home in determined number of steps

A drunken man walks in a two-dimensional grid.He can walk rigth(1),down(2),left(3),up(4).After determined number of steps,for example,6 steps,he has 400 ways go back home(the number of 1(2) equal to 3(4)，assume the number of 2(3) larger tan 1(3),then just 200 ways).               move = {1, 2, 3, 4};     AllWays[n_ /; EvenQ[n]] := {{1, 3} & /@ Range[#1], {2, 4} & /@ Range[#2]} & @@@        PadLeft[IntegerPartitions[n/2, {0, 2}]] // Flatten /@ # & // Permutations /@ # &         // Join @@ # &      so if 6 steps,we will get:               {{2, 4, 2, 4, 2, 4}, {2, 4, 2, 4, 4, 2}, << 196 >>, {4, 2, 3, 1, 3, 1}, {4, 2, 3, 3, 1, 1}}      we can plot arrow pictures for this.               rule = {1 -> {1, 0}, 2 -> {0, -1}, 3 -> {-1, 0}, 4 -> {0, 1}};     handle[list_] := With[{n = Length[list] - 1},         If[First[Subtract @@ #] == 0,            # + If[#[[1, 2]] < #[[2, 2]],{{0, 0.1}, {0, -0.1}}, {{0, -0.1}, {0,0.1}}],            # + If[#[[1, 1]] < #[[2, 1]], {{0.1, 0}, {-0.1, 0}}, {{-0.1, 0}, {0.1, 0}}]]         & /@ (Transpose[{list,If[First[#2 - #1 & @@ First[list]] == 0,          {{#, 0}, {#, 0}},{{0, #}, {0, #}}] & /@ Range[-0.05 n, 0.05 n, 0.1]}]           // Plus @@@ # &)]     ArrowPlot[moves_] :=          Gather[Partition[Accumulate[moves /. rule], 2, 1, 1],Sort[#1] == Sort[#2] &]          //handle /@ # & // Flatten[#, 1] &          //Graphics[{Arrowheads[Medium], Arrow[#]}, ImageSize -> {70, 70}] &      so ArrowPlot[{1, 1, 4, 2, 3, 2, 3, 4}] will get: ![enter image description here](http://i.stack.imgur.com/31D2j.jpg) But there are three types of equivalence. 1.Topologically equivalence For example,{1, 2, 3, 4, 3, 4, 2, 1} is equal to {1, 2, 3, 4, 3, 2, 4, 1},because the images is ![enter image description here](http://i.stack.imgur.com/vCBZs.jpg) 2.Translational equivalence For example,{1, 4, 1, 3, 3, 2} is equal to {4, 1, 3, 3, 2, 1},because they just have diffencnce origin,the images is ![enter image description here](http://i.stack.imgur.com/wUD6b.jpg) 3.Rotate or reflect equivalence For example,{1, 4, 1, 3, 3, 2} is equal to {1, 2, 3, 2, 4, 4},because the images is ![enter image description here](http://i.stack.imgur.com/xZFBX.jpg) Obviously in 6 steps,Length[AllWays[6]] just equal to 200.It just has 7 difference ways,the images is ![enter image description here](http://i.stack.imgur.com/MQLBK.jpg) but in 8(10) steps,Length[AllWays[8(10)]] equal to 3710(31752).and the difference ways just equal to 20+(100+),how to write a program to tally those?


Simplify looks ugly

I use `Simplify` mostly to make expressions look neat. However, _Mathematica_ often does not produce expression in, what I consider, the optimal way. Look at this: ![Mathematica expression](http://i.stack.imgur.com/nRnjb.png)               FullSimplify[      -((E^(-((t-μ1)^2/(2 σ1^2))) p w1)/(Sqrt[2 π] σ1))+      (E^(-((t-μ1)^2/(2 σ1^2))) p w2)/(Sqrt[2 π] σ1)-      (E^(-((t-μ2)^2/(2 σ2^2))) (1-p) w3)/(Sqrt[2 π] σ2)+      (E^(-((t-μ2)^2/(2 σ2^2))) (1-p) w4)/(Sqrt[2 π] σ2)]      Obviously, I would prefer the `Sqrt[2 Pi]` to appear next to the two `σ`'s. This is just one example of how `Simplify` sometimes does not do what I want. Any general tips?


Unexpected result from Flatten

Consider the following three evaluations involving `Flatten`:               Flatten[f[f[f[x, y], 1, 2], f[x, y]], Infinity, f]      > f[x, y, 1, 2, x, y] (* as expected *)               Flatten[List[f[f[x, y], 1, 2], f[x, y]], Infinity, f]      > {x, y, 1, 2, x, y} (* as expected *)               Flatten[List[List[f[x, y], 1, 2], f[x, y]], Infinity, f]      > {{f[x, y], 1, 2}, x, y} (* expected {{x, y, 1, 2}, x, y} *) I would like to know why my expectation was wrong.


Plotting a curve from the intersection points of a family of two curves

I have two state equations.               f1 = 1000. (12 - (1 - u) x2);     f2 = 1000. ((1 - u) x1 - 8/100 x2 );      I did two different stream plots for state-variables `x2` and `x1` on the x and y axis respectively. The first stream plot was based on `u = 0` and the second one was based on `u = 1`. Then I superimposed the stream plots using the command `Show[{plt0, plt1}]`.                plt0 = StreamPlot[Flatten[{f1, f2} /. u -> 0], {x2, 0, 30}, {x1, 0, 10},        StreamPoints -> 500, StreamScale -> Large,        StreamStyle -> {Blue, Thickness[0.001], Dotted}, Frame -> True,        FrameLabel -> {Row[{Subscript["x", 2], " - Capacitor  Voltage "}],          Row[{Subscript["x", 1], " - Inductor  Voltage "}]},        GridLines -> Automatic, GridLinesStyle -> Directive[Gray, Dashed],        BaseStyle -> {"Times", 24}, ImageSize -> 500]      ![enter image description here](http://i.stack.imgur.com/TpySO.png)                plt1 = StreamPlot[Flatten[{f1, f2} /. u -> 1], {x2, 0, 30}, {x1, 0, 10},         StreamPoints -> 500, StreamScale -> Large,         StreamStyle -> {Red, Thickness[0.001], Dotted}, Frame -> True,          FrameLabel -> {Row[{Subscript["x", 2], " - Capacitor  Voltage "}],           Row[{Subscript["x", 1], " - Inductor  Voltage "}]},         GridLines -> Automatic, GridLinesStyle -> Directive[Gray, Dashed],         BaseStyle -> {"Times", 24}, ImageSize -> 500]      ![enter image description here](http://i.stack.imgur.com/DYElp.png)                   Show[{plt0, plt1}]      ![enter image description here](http://i.stack.imgur.com/ehNLe.png) **Is it possible to draw a curve at the intersection points of the two superimposed streamplots and how?**


Problem with setting working precision in NIntegrate

I want to obtain a good numerical approximation (up to 10 decimal place would be ok for me) to an integral: $$ \int^{\infty}_{0} f(r)r^2dr $$ I am using the function $f(r)$, which is related to the function $$g(r)=-\frac{\sqrt[3]{3} \sqrt[3]{e^{-2 r}}}{\pi ^{2/3}}-\frac{\sqrt[3]{2 \pi }}{5 \sqrt[3]{e^{-2 r}} \left(\frac{3 \sqrt[3]{\pi } \sinh ^{-1}\left(\frac{2 \sqrt[3]{2 \pi }} {\sqrt[3]{e^{-2 r}}}\right)}{5\ 2^{2/3} \sqrt[3]{e^{-2 r}}}+1\right)}$$ by the relation $$ f(r)=-\frac{1}{4\pi}\nabla^2_{r,\theta,\phi} g(r) $$ Obviously, explicit integration is impossible. The product $f(r)r^2$ is well- behaved and integrable for sure. The function $f(r)$ decays faster than $\frac{1}{r^2}$. When I try to increase `WorkingPrecision` in `NIntegrate`, _Mathematica_ says the expression I am integrating itself is not specified so precisely. How can I overcome this? Any tips/ hints? I am asking for a general strategy to obtain a precise value of the integral:               NIntegrate[f[r]*4*π*r^2, {r, 0, y}, WorkingPrecision -> x]         where y and x are some numbers. P.S., I've been using _Mathematica_ for only two days.


Cross-correlation in SDEs

Is it possible to derive a cross-correlation function between a stochastic variable and a state-variable in an SDE, such as for the simple model here, or better between two state variables in a two variable (plus one stochastic variable) model:               sys = ItoProcess[{\[DifferentialD]n[t] == (ibar + rP p[t] - lN n[t] - u1 n[t])      \[DifferentialD]t + sd \[DifferentialD]w[t],      \[DifferentialD]p[t] == (u1 n[t] - (rP + lP) p[t]) \[DifferentialD]t},      {n[t], p[t]}, {{n, p}, {n0, p0}}, t, w \[Distributed] WienerProcess[0, sd]];      I am interested in the long-term limit of correlations between variables, starting from initial conditions that are equal to the means. For instance for the one variable case, I am able to compute expressions for the mean and variance (and autocorrelation, but not shown):               proc = ItoProcess[\[DifferentialD]n[t] == ( ibar - q n[t]) \[DifferentialD]t +             sd \[DifferentialD]w[t], n[t], {n, ibar/q}, t,             w \[Distributed] WienerProcess[0, sd]](*this is white noise*);          Mean[proc[t]]     Variance[proc[t]]      > Out[2]= ibar/q > > Out[3]= (E^(-2 q t) (-1 + E^(2 q t)) sd^4)/(2 q)                Limit[E^(-2 q t) (-1 + E^(2 q t)) /. q -> 1, t -> Infinity]      > Out[4]= 1 However, large outputs are generated for the two variable case. Is there a way to solve for variances (mean can be computed easily on paper) and the cross correlation between any of the variables (ibar + sd dw[t]/dt, n[t], p[t]) in the limit shown above? Is a symbolic approach possible? If not, are there approaches to approximate a function, either from numerical simulations, Taylor expansion or another technique? Suggestions and links to any existing resources are appreciated.


Finding integer partitions one at a time

I am writing a small program and I need to calculate integer partitions of a handful of numbers. In my code I just run IntegerPartitions[k,{n}] and then iterate through the results. Since I only use the result through this iteration I was wondering if there is an easy way to get integer partitions one at a time. This way I am hoping to reduce memory usage and if I am lucky also time. EDIT: Well yes, I should have given an example. So with IntegerPartitions[6,{3}] we get the result {{4,1,1},{3,2,1},{2,2,2}}, I get this and feed it in a loop and treat each one separately. The problem is that I don't need all of them at once, so when the numbers are big, this list becomes unnecessarily big itself. It would be ideal to implement the functionality of the function IntegerPartitions inside my loop and have only one of the partitions each time.


Evaluating a Recursive Expression

**Why does this raise an error**               P[0, x_] := 1          P[1, x_] := x          P[n_, x_] := ((2 n - 1)/n)*x*P[n - 1, x] - ((n - 1)/n)*P[n - 2, x]          Simplify[P[n, x]] /. n -> 2          (*$RecursionLimit::reclim: Recursion depth of 256 exceeded. >>*)      **But this does not**               P[0, x_] := 1          P[1, x_] := x          P[n_, x_] := ((2 n - 1)/n)*x*P[n - 1, x] - ((n - 1)/n)*P[n - 2, x]          Simplify[P[2, x]]           1/2 (-1 + 3 x^2)      **More generally how does one generate a list of 1000 polynomials from this recursion? All of the following still seem to raise errors.**               Unevaluated@P[n, x] /. n -> {2, 3}          Simplify[Unevaluated@P[n, x] /. n -> {2, 3}]          Simplify[Unevaluated@P[n, x]] /. n -> {2, 3}          {Unevaluated@P[n, x] /. n -> z} /. z -> {2, 3}      **If my questions indicate that I am not familiar with mathematica, it is because I am not. :-)**


How can I extract multiple spans from a list?

I know in _Mathematica_ , I can do               A = Range[100];     B = A[[50 ;; 60]]      B will then contain the 50th through 60th elements of A. Now, what if I wanted B to take 10th through 40th plus 60th through 80th. Can I do so in one expression such as               B = A[[10 ;; 40 + 60 ;; 80]]      Apparently the above code doesn't work. But I don't want to generate a separate list to do so. Is there a short-cut or elegant way of combining two or more spans in one `Part` expression? I hope ;; is treated as range. Also, typeing `Part`, i.e., [[]], really takes a lot of time to type. I wish _Mathematica_ 10 will shorten it to `< >` or `( )`.


PlotMarkers with black border

I notice that when I paste my graphs in word sometimes they are not very well readable. A colleague of mine send me a graph made with Sigmaplot. The first figure is made with Mathematica, the second one with SigmaPlot. I'm not be able to reproduce the black border in my PlotMarkers. Could you help me? ![Mathematica](http://i.stack.imgur.com/r3gYy.jpg) ![SigmaPlot](http://i.stack.imgur.com/KEM55.jpg)


Start indexing at 0 for RSolve without giving an initial value

I am trying to use RSolve with indexing beginning at 0. Whenever I enter a basic command such as to solve a difference equation such as $a_{n} = 2a_{n-1} + 1$:               RSolve[a[n + 1] - 2 a[n] == 1, a[n], n]      it gives the solution               {{a[n] -> -1 + 2^n + 2^(-1 + n) C[1]}}      Which is the solution if indexing begins at 1. I am interested in finding a solution where indexing begins at 0. I know that this can be achieved by giving an initial value for x[n], however I am looking for a way to get a solution without specifying an initial value. Is this possible? Perhaps we could specify the range of values for _n_? Thanks.


How to increase range in Plot without exceeding maximum bounds?

Does there exist some way to increase the plot range of following plot from `10^7` to new value `10^16`? It exceeds its maximum bounds, if range is increased further from `10^8`. Please help !               ParametricPlot[{{10*          Log10[(ρ^2*InverseGammaRegularized[n/2, 0.03] -               InverseGammaRegularized[n/2,                1 - 0.03])/(InverseGammaRegularized[n/2,                1 - 0.03]*ρ)] /. ρ -> 1.259,         Log10[n]}, {10*          Log10[(2*(InverseSurvivalFunction[NormalDistribution[0, 1],                     0.03] -                    InverseSurvivalFunction[NormalDistribution[0, 1],                     1 - 0.03])^2/n)^0.5 + (ρ - 1/ρ)] /. ρ ->           1.259, Log10[n]}}, {n, 1, 10^7}, AspectRatio -> 1/GoldenRatio]


Making mathematica do regulated integrals

Consider the integration, $\int _0 ^\infty dx\ x \tanh( \pi x) \sqrt {x^2 + a^2 } $ where $a$ is a real number. This integral is divergent. We note that an asymptotic expansion of the integrand about $x =\infty$ reveals it to have an expansion of the kind, $x^2 \tanh(\pi x) + \frac{a^2}{2} \tanh (\pi x ) + O(\frac{1}{x}) $ So we can think of "defining" the regulated value of the integral as the quantity that one gets after subtracting off the asymptotic divergence. Hence a possibly sensible definition is to say, $Limit _ {M \rightarrow \infty} \left [ \int _0 ^M dx \left ( x \tanh( \pi x) \sqrt {x^2 + a^2 } \right ) - \int_0 ^M dx \left ( x^2 \tanh(\pi x) + \frac{a^2}{2} \tanh (\pi x ) \right ) \right ]$ I believe that the above is a finite quantity.   * I would like to know how Mathematica can be gotten to compute this above quantity (may be numerically) for any given $a$ * * * If you are worried about motivations then you can think of QFT.


Problem with displayed coordinates in LogLinearPlot

I have a very weird problem that I don't usually get. I try to plot a set of equations using `LogLinearPlot` and the **Get coordinates** right-click menuitem is working just fine. However, when I change the parameter, I right click in the image to get the coordinate, however displayed coordinate value is inconsistent with the axis. I point at around 100 to 1000 but it gives me -0.02631. This problem does not always appear and it depends on the parameters I use (`ash`, `csh`, etc.). ![enter image description here](http://i.stack.imgur.com/E9c17.png) Can anyone please help me what might cause this issue? I never had this problem before. I am using _Mathematica_ v8. I'm sorry for dumping my code. It is given because I don't know how to make it simpler.               << "PlotLegends`"          bsh[ash_, Gs_, s0_] := ash/Gs*s0/100;     w[af_, nf_, mf_, ws_, \[Psi]_] := ws/(          (Log[Exp[1] + (\[Psi]/af)^nf])^mf);     e[ash_, csh_, w_, Gs_, s0_] := ash*(          ((((w/100)^csh)/(bsh[ash, Gs, s0]^csh)) + 1)^(1/csh));     s[af_, nf_, mf_, ws_, \[Psi]_, ash_, csh_, Gs_, s0_] := (          w[af, nf, mf, ws, \[Psi]]*          Gs/e[ash, csh, w[af, nf, mf, ws, \[Psi]], Gs, s0]);          Gs = 2.61; ws = 44.664; ll = 64; s0 = 98.373;     af = 1049; nf = 3.83; mf = 1.6; ash = 0.878; csh = 36.52;          LogLinearPlot[{       s[af, nf, mf, ws, \[Psi], 0.9, csh, Gs, s0],        s[af, nf, mf, ws, \[Psi], 2*ash, csh, Gs, s0],        s[af, nf, mf, ws, \[Psi], ash, csh, Gs, s0],        s[af, nf, mf, ws, \[Psi], 0.5*ash, csh, Gs, s0],        s[af, nf, mf, ws, \[Psi], 0.25, csh, Gs, s0]},      {\[Psi], 0.01, 1000000},      ImageSize ->400, AxesStyle -> Thick, PlotRange -> {0, 100},       LabelStyle -> {Bold, 14}, AxesLabel -> {"\[Psi]", "S"},       PlotLegend -> {"4ash", "2ash", "ash", "0.5ash", "0.25ash"},      LegendPosition -> {1.1, -0.4}, LegendTextSpace -> 1,      PlotStyle -> {Red, Thick, Dashed, Dotted, DotDashed}]


How to apply a function to a list of tuples

trialList = {{0, 24.701}, {1, 24.69}, {2, 24.733}};     f[x_] := x + 1;      I would like to apply the function `f` to only the second element of each tuple. How is this done? The actual list is 16,000 entries long. How do I iterate over the whole list applying the function to only the second entry of each tuple? I tried the following, but it does not do what I want:               {trialList[[1]], f[trialList[[2]]]} & @@@ trialList


Mathematica eps graphics and psfrag in LaTeX

I used to to use MathPSFrag in Mathematica to export graphics to EPS for inclusion in LaTeX files. However, with recent versions of Mathematica this does not seem to work very well anymore, see for example mathematica 8.0 and psfrag or LATEX and Mathematica. In the latter thread it was suggested to use Mathematica's native `Export function and then replace text, labels etc. using the pstool package. How ever, when I create and export a simple plot via               plot = Plot[x, {x, 0, 1}, AxesLabel -> {"x", "y"}]     Export[NotebookDirectory[] <> "plot.eps", plot]      and then run pdflatex --shell-escape on the file               \documentclass{article}       \usepackage{pstool}     \begin{document}         \psfragfig{plot}         {         \psfrag{x}{$\xi$}         \psfrag{y}{$\phi$}         }         \end{document}       I obtain a two-page PDF document with the lower part of the plot on the top of the second page and the top part missing; the first page is completely empty. I'd be grateful if somebody could point out what's going on. Also, the restriction to one-letter labels can be quite problematic. Have there been any developments since the two quoted threads about the best way to export graphics from mathematica into LaTeX? **Edit** : What I described above applies to Mma 9.0 on a 64-bit Linux Mint 15. When I export the plot on a Windows 7 computer, the PDF is created correctly. From this I infer that the problem does not lie with my latex installation, but with the way Mathematica exports the plot to eps. Is this known to be platform-dependent?


How to relate setter buttons with equations

I want to relate or connect a setter bar with a set of equations to graph them.               y1[x_] := f'[list[[1]]]*{x - list[[1]]} + f[list[[1]]]     y2[x_] := f'[list[[2]]]*{x - list[[2]]} + f[list[[2]]]     y3[x_] := f'[list[[3]]]*{x - list[[3]]} + f[list[[3]]]     y4[x_] := f'[list[[4]]]*{x - list[[4]]} + f[list[[4]]]     y5[x_] := f'[list[[5]]]*{x - list[[5]]} + f[list[[5]]]          Manipulate[       Plot[{f[x], y1[x], y2[x], y3[x], y4[x], y5[x]}, {x, -3, 3},          PlotRange -> 10],       {{aprox, y1, "Aproximation"}, {y1, y2, y3, y4, y5}, ControlType -> SetterBar}]


Expansion in Basis Functions

I am trying to create an expansion of the form               f[x,y]->Sum[Cn[x] y^n,{n,1,order}]      To replace the function `f` by the coefficients `cn`. Since the function `f` appears in a differential equation, it is useful to get this to work as a set of replacement rules for a pure function, such that the function `f` and all its derivatives are replaced. Something like this works:               f->((c0[#1]+c1[#1] #2+c2[#1]#2^2)&)      Curiously, this expression doesn't               f->(( Sum[c[[n]][#1] #2^n,{n,1,order}] )&)      (where `c` is a pre-defined vector of coefficients). The index `n` is not recognized in the context of defining the pure function (though the same expression defining `f[x,y]` would work). Similarly, if I have several functions and I am trying to define a collection of these replacement rules, this also does not work:               Table[ f[[i]]->f->((c0[[i]][#1]+c1[[i]][#1] #2+c2[[i]][#1]#2^2)&), {i,1,whatever}]      Somehow defining and manipulating a collection of pure functions with an index needs a different syntax. I am curious as for the logic of why this does not work, maybe then I'll understand how to fix it. Edit: Apologies for the vague question. I think the logic that I was missing is related to attributes of pure functions I was trying to use in replacement rules, as pointed out by acl below. This is related to this question: Using pure functions in Table


How to find the minimum of this constrained expression?

Let $x$, $y$, $z$ be three nonegative real numbers and $x^2 + y^2 + z^2 = 5.$ Find the minimum of the expression $$E=\dfrac{1}{2}x^2 y^2 + y^2 z^2 + z^2 x^2 + \dfrac{96}{x + y + z + 1}.$$ I tried               Minimize[{1/2 x^2 y^2 + y^2 z^2 + z^2 x^2 + 96/(x + y + z + 1),        x >= 0, y >= 0, z >= 0, x^2 + y^2 + z^2 == 5}, {x, y, z}]      What should I do find the minimum of this expression?


Using Mathematica to Solve for Electric Field from finite cylinder

For a cylinder that is of length L and radius s and possesses a charge distribution of sigma across only the cylinder part and not the endcaps, I am trying to calculate the Electric-field. The cylinder is positioned with its center at the origin and I am trying to find the electric field at a point $P = (x,y,z)$. I am not 100% sure if the formula that I've obtained is quite correct, but I would like to use _Mathematica_ to see if it is meaningful. The formula that I've gotten down to is: $$E_{x}(x,y,z)=ks\int_{\Theta=0}^{2\pi}\int_{z'=-L/2}^{L/2}\sigma(x,y,z)\frac{dz'\,d\theta\,(x-s\cos(\theta))}{((x-s\cos(\theta))^{2}+(y-s\sin(\theta))^{2}+(z-z')^{2})^{3/2}}$$ $$E_{y}(x,y,z)=ks\int_{\Theta=0}^{2\pi}\int_{z'=-L/2}^{L/2}\sigma(x,y,z)\frac{dz'\,d\theta\,(y-s\sin(\theta))}{((x-s\cos(\theta))^{2}+(y-s\sin(\theta))^{2}+(z-z')^{2})^{3/2}}$$ $$E_{z}(x,y,z)=ks\int_{\Theta=0}^{2\pi}\int_{z'=-L/2}^{L/2}\sigma(x,y,z)\frac{dz'\,d\theta\,(z-z')}{((x-s\cos(\theta))^{2}+(y-s\sin(\theta))^{2}+(z-z')^{2})^{3/2}}$$ Now regardless of whether this is actually correct, I do want to test it. Since L, x, y, z, s, k, and σ are all "known" quantities, then this should in theory should have a numerical solution at least. However, with _Mathematica_ , when I plug these equations in, taking σ to be constant, it just kind of sits there thinking for a very long time and does not come to any form of conclusion. Is there anyway that I can actually do this on _Mathematica_ numerically in terms of the parameters in a reasonable time and have it actually return something that can then be plotted? Sorry that I'm not the most familiar with how Mathematica operations. Sorry for the odd format on the integrals, the thing seemed to wrap it around to the next line and I am pretty unfamiliar with formatting on this site.


Dynamic generation of Buttons

## The Project I am trying to dynamically turn on/off the display of data for a circos-esque plot that I generated. ![Data Plot](http://i.stack.imgur.com/KRY3Z.png) ## The Code I have data stored in `mfData` and a compiled list of data about that in `mfIndex`, primarily used for how many data sets there are (number of sectors, etc.). Here are the steps that I have taken (3 & 4 are wrapped in `Dynamic[]`):   1. **Variables** \- I started the dynamic compilation of the code under the impression that I would need a variable for each sector set to True/False. So I generated n expressions and evaluated each to True to start off. `vars = Table[ToExpression[StringJoin["sector", ToString[n], "=True"]], {n, 1, Length[mfIndex]}]`   2. **Outer Rings** \- The rings are generated and wrapped in `Button[]` which switches the variable `oRings = Table[Button[{color, Tooltip[Rotate[ring[outer_radius, inner_radius, angular_size], angle, {0, 0}], "Text"]}, (Symbol[StringJoin["sector", ToString[m]]] = Symbol[StringJoin["sector", ToString[m]]] /. {True -> False, False -> True})], {m, 1, Length[mfIndex]}]`   3. **Choice** \- My hope was that the button directive would turn each variable to True/False when being clicked which would update pick and curves `pick = Pick[Range[Length[mfIndex]],vars]`   4. **Curves** \- The Bezier Curves are generated  `curves = Table[Table[BezierCurve[{pt1, pt2, pt3}],{n,1,Length[mfData[[n]]]}],{n,pick}]` ## The (Apparent) Problem There are no errors when evaluated, but when I click on one of the rings an error comes up (I tried using both `ToExpression[]` and `Symbol[]` in the Outer Ring evaluation)               Set::write: Tag ToExpression in ToExpression[sectorm] is Protected. >>     Set::write: Tag Symbol in Symbol[sectorm] is Protected. >>      Meaning that when the Outer Ring code is evaluated the variables aren't being processed into their proper form... "sectorm" instead of {sector1, sector2, etc...}. I know this is a bit long-winded to get to this question, but is there a better way to evaluate (compose) the variables? **Or** to accomplish the same thing or re-evaluating the display of data? (I can provide more explanation if necessary, I tried to reduce this a bit for simplicity's sake...)    * * * ## (Update) Minimal non-working example (I think that copied over correctly...)               ring[o_, i_, s_, p_] := Module[{q, oP, iP, cut}, q = (s)/(2 Pi); oP = Table[{o Cos[k q 2 Pi/p], o Sin[k q 2 Pi/p]}, {k, 1, p}]; iP = Table[{i Cos[k q 2 Pi/p], i Sin[k q 2 Pi/p]}, {k, 1, p}]; cut = Polygon[Flatten[{oP, Reverse@iP}, 1]]; Return[cut]];          cir[x_, r_] := {r*Cos[x], r*Sin[x]}          Dynamic[vars = Table[ToExpression[StringJoin["sector", ToString[n]]], {n, 1, 8}]];          Table[ToExpression[StringJoin["sector", ToString[n], "=True"]], {n, 1, 8}];          points1 = Table[{RandomReal[{0 + m*(Pi/4), Pi/4 + m*(Pi/4) - Pi/64}], RandomReal[{0 + (m + 2)*(Pi/4), Pi/4 + (m + 2)*(Pi/4)}]}, {4}, {m, 0, 7}];          points2 = Table[Table[{points1[[n, o, 1]], If[Abs[points1[[n, o, 2]] - points1[[n, o, 1]]] > Pi, (points1[[n, o, 1]] + points1[[n, o, 2]])/2 + Pi, (points1[[n, o, 1]] + points1[[n, o, 2]])/2], points1[[n, o, 2]]}, {o, 1, 8}], {n, 1, 4}];          Dynamic[outRing = Table[Button[Rotate[ring[1.1, 1.05, Pi/4 - Pi/64, 1000], Pi/4*(n - 1), {0, 0}], (ToExpression[StringJoin["sector", ToString[n], "=", ToString[Not[Symbol[StringJoin["sector", ToString[n]]]]]]])], {n, 1, 8}]];          Dynamic[pick = Pick[Range[8], Table[Symbol[StringJoin["sector", ToString[n]]], {n, 1, 8}]]];          Dynamic[inCurve = Table[Table[BezierCurve[{cir[points2[[o, n, 1]], 1], cir[points2[[o, n, 2]], 0.3], cir[points2[[o, n, 3]], 1]}], {n, pick}], {o, 1, 4}]];          Dynamic[Graphics[{outRing, inCurve}]]      ![Simple working example](http://i.stack.imgur.com/k9Nak.png)


Im trying to model balls in a box with NDsolve, but the balls keep escaping the box

This Code produces a box filled with balls at different positions with random charges on them and then calculates their motion according to Coulombs law. rendering the electric field as well as the potential at any point as a density plot along with it, it works just fine, but it doesnt seem to do the greatest of jobs at confining the balls to the box (it works about half of the time, i reccon if forces on a ball at the boundaries gets to big it accelerates past the "boundary trigger" if that makes any sense. I might be totally off too as always, any help is appreciated! ![enter image description here](http://i.stack.imgur.com/1zVuc.jpg) this is how the rendered plot should look like for a single instance in time               g = 1;     Tmax = 30;     n = 10;     pos = RandomReal[{-10, 10}, {n, 2}]     charge = RandomReal[{-10, 10}, n]          Graphics[      Table[       Disk[pos[[i]], 0.5]       , {i, 1, n}]      , PlotRange -> 10.5]          sol = NDSolve[       Flatten@Table[         {          With[{i = i}, {            (y[i])''[t] == -g + VectorField[x[i][t], y[i][t], t][[2]],            (y[i])'[0] == 0,            y[i][0] == pos[[i, 2]],            (x[i])''[t] == VectorField[x[i][t], y[i][t], t][[1]],            (x[i])'[0] == 0,            x[i][0] == pos[[i, 1]],            WhenEvent[y[i][t] == -10, y[i]'[t] -> -0.95*y[i]'[t]],            WhenEvent[y[i][t] == 10, y[i]'[t] -> -0.95*y[i]'[t]],            WhenEvent[x[i][t] == -10, x[i]'[t] -> -0.95*x[i]'[t]],            WhenEvent[x[i][t] == 10, x[i]'[t] -> -0.95*x[i]'[t]]            }           ]          }         , {i, 1, n}]       ,       Flatten@Table[         {          x[i], y[i]          }         , {i, 1, n}]       , {t, 0, Tmax}, PrecisionGoal -> 4]          Manipulate[Graphics[       Table[        With[{p = {x[i][t], y[i][t]} /. First[sol]},         {ColorData["TemperatureMap", (charge[[i]] + 10)/20], Disk[p, 0.5]}         ]        , {i, 1, n}]       , PlotRange -> 10.5, Background -> Black]      , {t, 0, Tmax}]      Fancy version:               PotentialAnimated[u_, v_, t_] :=       Block[{x, y},        Sum[charge[[i]]/         EuclideanDistance[{u, v}, {x[i][t], y[i][t]} /. sol[[1]]], {i, 1,          n}]]          VectorField[u_, v_, t_] :=       Block[{x, y},        Sum[charge[[i]]*({u, v} - {x[i][t], y[i][t]} /. sol[[1]])/          EuclideanDistance[{u, v}, {x[i][t], y[i][t]} /. sol[[1]]], {i, 1,          n}]]          Manipulate[      Show[{DensityPlot[         PotentialAnimated[x, y, t], {x, -10, 10}, {y, -10, 10},          ColorFunction -> "SunsetColors"], Graphics[         Table[          With[{p = {x[i][t], y[i][t]} /. First[sol]},           {ColorData["TemperatureMap", (charge[[i]] + 10)/20],             Disk[p, 0.5]}           ]          , {i, 1, n}]         , PlotRange -> 10.5, Background -> Black],         VectorPlot[{VectorField[x, y, t][[1]],           VectorField[x, y, t][[2]]}, {x, -10, 10}, {y, -10, 10}]}], {t, 0,        Tmax}]


How to Override the Head of a Symbol

I was wondering if it is possible to override the head of symbols/operators. As a motivating example if I run: ![example](http://i.stack.imgur.com/IHo4E.png) Then Ket will be returned. But lets say I want Bob to be returned instead of Ket. Is such a thing possible? To go a little bit further, I'd like: ![bob](http://i.stack.imgur.com/ugrvy.png)   to return BobKet and ![alice](http://i.stack.imgur.com/1Bi5s.png) to return AliceKet so that I could make a function that recognizes these heads like: ![function](http://i.stack.imgur.com/xH2fd.png) Thanks! Here are the corresponding lines of code `Head[Ket[\[Placeholder]]]` `Head[Ket[Subscript[x, B]]]` `Head[Ket[Subscript[x, A]]]` `combineBobAndAlice[b_BobKet, a_AliceKet] := Ket[{ {Subscript[b[[1, 1]], B], Subscript[a[[1, 1]], A]} }]`


Is there a simple example using OpenCLLink that shows performance advantages?

`OpenCLLink` allows _Mathematica_ to use the OpenCL parallel computing language. I have done some tests on simple examples, but so far, the CPU regularly outperforms the GPU. **Question:** What are some nice (inherently parallel) number crunching problems that use OpenCL code and `OpenCLLink` to show (with `AbsoluteTiming`) impressive performance benefits, that are not already in the documentation?


Using a complicated function as color function

I have an ellipsoid with parametric equations               lst = {10*Cos[u]*Sin[v], 3*Sin[u]*Sin[v], 2*Cos[v]};       I define a function               dam = Sqrt[(1296*Cos[u]^4*            Sin[v]^4)/(900*Cos[v]^2 + 36*Cos[u]^2*Sin[v]^2 +              400*Sin[u]^2*Sin[v]^2)^2 +               (3600*Cos[u]^2*            Sin[v]^2*(9*Cos[v]^2 + 4*Sin[u]^2*Sin[v]^2))/(900*Cos[v]^2 +              4*(9*Cos[u]^2 + 100*Sin[u]^2)*Sin[v]^2)^2];       and a color function as               colFun = Function[{u, v}, Hue[Rescale[dam, {0, 1}]]];       My ultimate goal is coloring the ellipsoid according to the values of               Rescale[dam, {0, 1}]      So, my question is why there is a big mismatch in the color rendering in the following plots               h = ParametricPlot3D[lst, {u, 0, 2*Pi}, {v, 0, Pi}, Mesh -> False,         ColorFunction -> colFun, ColorFunctionScaling -> False,         ImageSize -> 800];      g = Plot3D[Rescale[dam, {0, 1}], {u, 0, 2*Pi}, {v, 0, Pi},         Mesh -> False, ColorFunction -> colFun,         ColorFunctionScaling -> False, PlotRange -> All];      Row[{Show[h], Show[g, ImageSize -> 400]}]      From `g` we see that the edges of the ellipsoid should be colored with purple color since for the respective angles `{u, v}`, `dam` takes the highest values.


How do I convert an argument list to a list of arguments?

I think this is a basic question, but I am having difficulty finding the answer in the documentation. `Thread` is not what I am looking for, I think. Suppose that I have a function `f` that takes an unspecified number of arguments: **f[a, b, c, ...]** , defined by a declaration like `f[lists__] := ...`. Suppose that I have an argument list `{a, b, c, d}`. How can I obtain `f[a, b, c, d]` from `{a, b, c, d}`? Thanks.


prime-palindromic number selected from a list

I want to find all prime-palindromic numbers up to 5000. Prime-palindromic numbers are numbers that themselves and their reverse digits are both primes. For example, 31 is a prime-palindromic number because both 31 and 13 are prime. Here is my code, but it somehow does not work.                Select[Range@5000, PrimeQ[Join[FromDigits[Reverse[IntegerDigits[#]]], # ]] &]      ![enter image description here](http://i.stack.imgur.com/EChAO.jpg)


Unexpected behaviour plotting a PDE solution

I'm solving some coupled PDEs (Eb1 and Ef1) and what I plot for Eb1 appears to be correct. However, for some reason, when I go to plot Ef1, I get nothing. MWE is below (beginning is constants and functions needed to solve PDEs, relevant part near end)               (*Constants needed*)     a = 8.2314*10^-7; omega = 3.0318*10^7; Do2 = 2*10^-9; po = 106;     ro = 235*10^-6; micron = 1*10^-6; qm = 10^-4;     mic = 1*10^-6; De = 5.5*10^-11; eo = 100; j = 0.12; kmn = 4.7;     kme = 2.1; con = (a*omega)/(6*Do2); rl = Sqrt[(6*Do2*po)/(omega*a)];          (*Functions needed*)     rn = Piecewise[{{0, ro <=  rl}, {ro*(0.5 - Cos[(ArcCos[1 - (2*rl*rl)/(ro^2)] - 2*Pi)/3]), ro  > rl}}];          p[r_] = Piecewise[{{po + con*(r^2 - ro^2 + 2*(rn^3)*(1/r - 1/ro)), r > rn} , {0 , r <= rn}}];          q[r_] = qm*((kme/(kme + p[r]))*(p[r]/(kmn + p[r]))  + (kmn/(kmn + p[r]))*j);          (*Equations defined*)     eqnDe = D[Ef1[r, t], t] - De*(D[Ef1[r, t], r, r] + (2/r)*(D[Ef1[r, t], r])) + q[r]*Ef1[r, t];          eqnBo = D[Eb1[r, t], t] - (Ef1[r, t])*q[r];          (*Solving equations*)     x = NDSolve[{eqnBo == 0, Eb1[r, 0] == 0, eqnDe == 0, Ef1[r, 0] == 0, Derivative[1, 0][Ef1][rn, t] == 0, Ef1[ro , t] == eo},        Eb1, {r, rn, ro}, {t, 0, 14400}];      Then it's easy to plot Eb1 between rn and ro with this;               Plot[Eb1[r, 14400] /. x, {r, rn, ro}, PlotRange -> Automatic]      and I get this; ![enter image description here](http://i.stack.imgur.com/DXh3q.png) Yet when I try to flow Ef1 with a similar command I get absolutely nothing;               Plot[Ef1[r, 14400] /. x, {r, rn, ro}, PlotRange -> Automatic]      ![enter image description here](http://i.stack.imgur.com/C28qn.png) Similarly, I can't seem to evaluate Ef1 at a given value of $r$ or $t$ - any ideas what I'm doing wrong and why this is the case?


SIGSEGV error with 3D Plots

I originally asked this question here but didn't get a satisfactory answer. > I am using Mathematica 8.0.1.0 on Ubuntu 11.10. I created a 3D plot from an > `NDSolve` output and when I tried to move it about with my mouse, > Mathematica completely crashed and reported a `SIGSEGV` error. > > This error is totally reproducible. What is the reason for this? Is this > version of Mathematica not stable for Ubuntu 11.10? > > Any suggestions? It doesn't really matter what I try to plot. Manipulating said plot with my mouse crashes mathematica. `Plot3D[Sin[x + y^2], {x, -3, 3}, {y, -2, 2}]` for instance would crash if I moved the resulting plot around with my mouse pointer. Edit 1: The answer on stackoverflow "works". However, it makes mathematica run real slow for some reason. I have submitted a ticket (TS 3197 in case there is someone here from Wolfram mathematica....) to the people at wolfram and have also tried pressing the issue but haven't received an answer. Edit 2: Graphics card information available from `SystemInformation[]` in Mathematica. > Graphics Subsystem: OpenGL > > Typical Uses 3D graphics rotation > > Vendor Tungsten Graphics, Inc > > Renderer Mesa DRI Intel(R) Sandybridge Mobile Version 2.1 Mesa 7.11 > > Extensions 139 extensions > > Optimized 3D Transparency False > > Support Information > http://support.wolfram.com/mathematica/graphics/subsystems


How to handle a sparse array of lists

I have data in the form of a sparse array of lists. For example:               {{76, 17} -> {17803}, {24, 14} -> {18625, 311571, 440371, 818848,         2010244, 2317818}, {64, 99} -> {19421, 269349, 397997, 440343,         503977, 511172, 1600938, 1656131, 1849185, 1849187, 1974513,         2045184, 2065062, 2319929}}      The indices are pairs of integers in the range `{0,...,S}^2`. It seems as it is not possible to store this as a sparse array in Mathematica, as I get the error > SparseArray::valnl: "The value specified by the rule {76,17}->{17803} should > not be a List. " How would I create an object which provides:   * quick access to the list corresponding to an entry - for example something like `a[[i,j]]` (default is the empty list).   * create a (dense) matrix with the largest list element (default 0)   * create a (dense) matrix with the largest list element not bigger than a given constant **Update** : Example regarding the last point. If the constant would be 500000, than the entry for `{76,17}` should be `17803`, for `{24,14}` `440371`, for `{64,99}` `440343` and for all other it should be 0.


Swap first and last names in a list

Edited to fix an inconsistency in the given example data format. I'm trying to write a simple function to load in a csv list of names which is formatted as "Lastname Firstname Initial " and convert it to "Firstname Lastname". The following code works:               data = Import["class roll.csv", "CSV"]     names = StringCases[StringTrim@data, LetterCharacter ..][[;; , {2, 1}]]     names = StringJoin[#[[1]], " ", #[[2]]] & /@ names      but it feels a lot like a non-Mathematica type of way, i.e. I'm trying to break my old programming habits and learn how to implement this in more "native" Mathematica way. If you have any suggestions, alternatives, more efficient ways, ... you'd like to share that'd be much appreciated. Additional info in response to Ajasja's comment, the example data looks like:               ImportString["     lastname1 firstname2 Ii                                  lastname2 first2 Ii                                      lastna3 longfirstname2 Ii                                ", "CSV"]      the last/first/initials are separated by a space, and each line is padded with spaces to get it to an equal (but large) width. P.S. The [[-2;;1;;-1]] approach is very nice. Thank you all.


How to improve the typesetting of mathematical contents

Until I started diving into Mathematica, I was not using much computer software for symbolic computation. I did my analysis by hand on blank sheets, the calculations using Python or MATLAB, and the computer typesetting and presentations using LaTeX. Mathematica could be (at least) a great supplement to each of these steps. However, I am **frustrated by Mathematica's rendering of mathematical notation**. * * * I got Mathematica (8 on Mac OS X) to automatically display unreadable variable names in a nicer mathematical notation, but the output in notebooks is quite bad: ![Mathematica typesetting](http://i.imgur.com/xSir0.png) I take as reference the equivalent in LaTeX: ![LaTeX typesetting](http://i.imgur.com/JANnG.png)   * I have difficulties to _distinguish the`Overbar` of Mathematica from what is under_, as it is often too close to the letters.    * I find the _monospace font inappropriate_. The letters are too thick (they are not bold, but still disproportionately thick compared to lines in other mathematical elements, as seem in this screenshot). Or maybe it is the decorations and non-literal elements (integral sign, sqrt, overbars and fractions, brackets) that are not thick enough in comparison (particularly when increasing the font size, as seen in the linked example).    * The _spacing between tokens and symbols_ is unnaturally large, while it is _slightly insufficient between two separate symbols_ (e.g., spacing between `a` and `b` in `a b` as compared to `ab`).    * Also, maybe function names could benefit from having a slightly different style, although I am not certain of that.    * The default font size is too small, but _increasing the font size sufficiently to compensate for the poor typesetting makes information take more place than acceptable_ on the screen. * * * The official documentation on Math typesetting boasts Mathematica's "world most sophisticated tech", but it doesn't explain much about how to automatically adjust spacing or the fonts used. Is there another typesetting guide I'm missing? Maybe downloadable stylesheets that redefine spacings and make use of Computer Modern or other high quality fonts? I would not have time to write my own stylesheet, I have no idea how to even begin, so a ready-made one would be preferable. * * * **EDIT in response to answers** : Here is an example of `TraditionalForm` side-by-side with the equivalent LaTeX output. There are clearly some differences in spacing, not all bad. The LaTeX version is more crowded around the fraction bar, while the Mathematica version is a bit too tight between the integral sign and its upper limit. Operators like $+$ are a bit smaller in the Mathematica version, too. ![enter image description here](http://i.stack.imgur.com/OM355.png)


2D Markov Process

I have a homework project. I need to analyse a gambler's ruin where there are 6 possible outcomes of every wager with corresponding probabilities and payoffs and the gambler may vary the wager (say only 4 values). Am I correct in thinking the gambler's wealth (say 0 to 200 starting at 100) is a 2D random walk with unequal steps. The state space having bankroll on one axis and wager value on the other with bankroll increment determined by outcome, payoff and wager. I can easily simulate this in Excel (or Mathematica) but that won't provide the necessary ruin insight. I could do repeated simulations in Excel stopping at ruin and then derive an empirical PDF of ruin. Mathematica seems to have only 1D RW with equal steps


Why isn't Simplify completely simplifying my expression when it has all the necessary info?

I have a complex variable, and I'm trying to multiply it by its Conjugate[], which should give me a real number. So, I'm currently doing:               r = Simplify[(b/a)*Conjugate[b/a], {L, k1, kreal, kimag} \[Element] Reals]      Which is giving me:               (E^(-2 I kreal L) (-1 + E^(2 (kimag + I kreal) L)) (E^(2 kimag L) -       E^(2 I kreal L)) (k1^2 + (kimag - I kreal)^2) (k1^2 + (kimag +         I kreal)^2))/((-E^(2 I kreal L) (-k1 + I kimag + kreal)^2 +       E^(2 kimag L) (k1 + I kimag + kreal)^2) (E^(2 kimag L) k1^2 -       Conjugate[       E^(2 kimag L) (kimag - I kreal) (-2 I k1 + kimag - I kreal) +         E^(2 I kreal L) (-k1 + I kimag + kreal)^2]))      (I apologize for the poor formatting, I don't know how to do it so it looks nice here without editing a ton of latex.) Anyway, clearly this is not as simplified as it could be -- it knows that every variable in that expression is real and I multiplied a complex number by its complex conjugate, so the entire expression should be real and free of $i$'s or Conjugate[]'s, but it isn't. What am I missing? Thanks! edit: I realized I should have included a and b. a is intentionally undefined, but that shouldn't matter because it divides out from b:               (a (-1 + E^(2 I k2 L)) (k1^2 - k2^2))/(-k1^2 + E^(2 I k2 L) k1^2 - 2 k1 k2 - 2 E^(2 I k2 L) k1 k2 - k2^2 + E^(2 I k2 L) k2^2)      Where k2 is then defined as:               k2 = Simplify[kreal + I*kimag, {kimag, kreal} \[Element] Reals];      I've also tried just doing Simplify[] to the Conjugate[] of (b/a), which is confusing because it still has a Conjugate[] in the output:               Simplify[Conjugate[b/a], {L, k1, kreal, kimag} \[Element] Reals      Gives:               (E^(-2 I kreal L) (-1 + E^(2 (kimag + I kreal) L)) (k1^2 + (kimag + I kreal)^2))/(E^(2 kimag L) (k1^2 - kimag^2 + kreal^2) - Conjugate[E^(2 I kreal L) (-k1 + I kimag + kreal)^2 - 2 I E^(2 kimag L) (k1 (kimag - I kreal) + kimag kreal)])      Why? It knows that all the variables inside that Conjugate[] are real, so it should just flip the signs of the $i$ terms.


Keep kernel running for execution of scheduled task

How can I keep a kernel running until all scheduled tasks have completed? For example upon running the following script `bazinga.m`:               RunScheduledTask[Print["Bazinga!"], {5, 10}]      with               $ math -script bazinga.m      the kernel immediately exits and does not run the scheduled task at all. Setting `$IgnoreEOF` to `True` does not make a difference.


How can I make a transparent 3D Rectangle?

Sorry, I didn't mentioned clearly in my earlier post. I want to build a transparent `Rectangle`, within which I want to diffuse a certain color of my choice which is also transparent. After this, any objects that I place inside the transparent building should be visible in its assigned color. One of the things that I tried to do after making a rectangle shape with light colored walls was to place `Points` with `ImageSize-> {20, 20}` and different colors. For that purpose I wrote the following code.               w = 100;     l = 200;     h = 30;     f = Graphics3D[{Transparent,Polygon[{{0, 0, 0}, {w, 0, 0}, {w, 0, h}, {0, 0, h}}]},           Lighting -> {LightBlue}, Boxed -> False];     b = Graphics3D[{Transparent,Polygon[{{0, l, 0}, {w, l, 0}, {w, l, h}, {0, l, h}}]},           Lighting -> {LightBlue}, Boxed -> False];     s1 = Graphics3D[{Transparent,Polygon[{{0, 0, 0}, {0, 0, h}, {0, l, h}, {0, l, 0}}]},             Lighting -> {LightBlue}, Boxed -> False];     s2 = Graphics3D[{Transparent,Polygon[{{w, 0, 0}, {w, 0, h}, {w, l, h}, {w, l, 0}}]},             Lighting -> {LightBlue}, Boxed -> False];     sur = Graphics3D[{Transparent,Polygon[{{0, 0, 0}, {w, 0, 0}, {w, l, 0}, {0, l, 0}}]},               Lighting -> {LightBlue}, Boxed -> False];     top = Graphics3D[{Transparent,Polygon[{{0, 0, h}, {w, 0, h}, {w, l, h}, {0, l, h}}]},             Lighting -> {LightBlue}, Boxed -> False];     Show[{f, b, s1, s2, sur, top}]      I tried to set `Lighting` options for the 3D objects. However that does not seem to work. Can anyone help me? One another option that I was thinking of was to have something similar to a heat map.


Sum of positive terms gives negative answer

Mathematica evaluates `Sum[((n - y - 1)*(n - y)^2*n^y)/y!, {y, 0, n - 2}]` as `-2 e^n n`. This should not be a negative value. What am I doing wrong?


Making the TableForm output into two columns

I have a program that calculates Christoffel symbols for a given metric, and the output I'm getting now is such that I have every calculated symbol in one column like this: ![enter image description here](http://i.stack.imgur.com/Dqr43.png) I'd like that I could have that in two columns:   1. \Gamma^1_2,3=... \Gamma^2_1,3= ...   2. \Gamma^1_3,2=... \Gamma^3_1,3= ...   3. \Gamma^2_2,2=... \Gamma^3_1,2= ...   4. ... I looked at the documentation, and I tried something with that, but all I could do is to widen the spacing between \Gamma and the results -.-" Here's thee code:               Clear[coord, metric, inversemetric, affine, τ, r, θ, \     φ]          n := 4          coord := {τ, r, θ, φ}          metric :=       2 G J Ω[θ]^2*{{-(1 + (1 - Λ[\     θ]^2)), 0, 0, 2 r Λ[θ]^2}, {0, 1/(         1 + r^2), 0, 0}, {0, 0, 1, 0}, {2 r Λ[θ]^2,          0, 0, Λ[θ]^2}}          inversemetric := Simplify[Inverse[metric]]          affine :=       affine = Simplify[        Table[(1/2) Sum[           inversemetric[[μ, ρ]] (D[metric[[ρ, ν]],                coord[[λ]]] +               D[metric[[ρ, λ]], coord[[ν]]] -               D[metric[[ν, λ]], coord[[μ]]]), {ρ, 1,             n}], {ν, 1, n}, {λ, 1, n}, {μ, 1, n}]]          listaffine :=       Table[If[UnsameQ[affine[[ν, λ, μ]],           0], {Style[           Subsuperscript[Γ,             Row[{coord[[ν]], coord[[λ]]}], coord[[μ]]],            18], "=",           Style[affine[[ν, λ, μ]], 14]}], {λ, 1,          n}, {ν, 1, n}, {μ, 1, n}] // FullSimplify          TableForm[       Partition[DeleteCases[Flatten[listaffine], Null],         3]] // FullSimplify


Subscript and Part: What's going on in this example?

## Example I came across the following simple example from _A Beginner's Guide to Mathematica_ , by McMahon and Topa, which I believe was written circa version 5.2. (FWIW, I'm using v9.)               (* simple differential equation *)     eqn = (D[y[ x], x] == A);          (* solve the differential equation *)     result = DSolve[eqn, y[x], x];      Note to question readers: For the input below, fill in the `...` with `result` then hit (Ctrl + minus) to get a subscript, then type in `[[1,1,2]]` and evaluate the function. Sorry if this is a wonkish way to present the question, but I wasn't sure of the best way to handle the front-end representation of the original input. *)               (* extract a functional dependence *)     f[x_] := ...       Evaluating:               f[x]     (* -> A*x + C[1] *)      ## Question _Can someone point me to documentation on this behavior or explain it?_ Looking at expression form (Ctrl + e) makes it clear that the front-end is interpreting the subscripted input to make this happen, but I've never seen it before. Encountering this makes me wish developers would refactor the behavior so that one could easily apply functions other than Part in this manner.


Why does the first derivative of a piecewise continuous function have discontinuities?

I have this piecewise continuous function which is also continuously differentiable over time :               psi[t_] := Piecewise[{{(1 + t)^3 (-3 t^2 + t), -1 <= t <= 0},                           {(1 - t)^3 (3 t^2 + t), 0 <= t <= 1}}];      Now, for starters, when I `Plot` it, a discontinuity appears. This can easily be solved with a simple `Exclusions -> None` option in the `Plot`command. But then, when I calculate its first derivative over time using `D`, I obtain the following:               D[psi[t], t]      ![Mathematica session](http://i.stack.imgur.com/j239i.png) And then when I try to plot it : ![plot of the function](http://i.stack.imgur.com/SozG2.png)   * Is there something wrong with my original `psi[t_]`function? (Is it not continuous for _Mathematica_?)   * Why are the limits of definition of the first derivative modified?   * Why is the first derivative discontinuous? Now, the _easy_ solution would be to construct the first derivative using the results proposed by the `D` function and re-defining the definition domain... But I really want to understand this issue (if there is one).


Draw from HistogramDistribution with ParallelTable

I wanted to check something, but ran into troubles using HistogramDistribution in combination with ParallelTable. The code does the following: Compute a HistogramDistribution of some sample and use some function which draws from that HistogramDistribution. Here's a stripped down version of the code that reproduces my problem:               exampledist =        TruncatedDistribution[{0, 1.16},         HistogramDistribution[         RandomVariate[ExponentialDistribution[1], 1000], 3]];     SetSharedVariable[exampledist];          drawExample[n_] :=            Module[{draws = Table[0, {n}]},        (*check some stuff, do something*)        For[i = 1, i <= n, i++,         draws[[i]] = First[RandomVariate[exampledist, 1]];         ];        Return[draws];        ];          drawExample[3]     ParallelTable[Table[drawExample[3], {1}], {i, 1, 2}]      The output is: `{1.05817, 1.05732, 0.47069}` and ` {{{DataDistribution[<<"Histogram">>, {1000}], DataDistribution[<<"Histogram">>, {1000}], DataDistribution[<<"Histogram">>, {1000}]}}, \ {{DataDistribution[<<"Histogram">>, {1000}], DataDistribution[<<"Histogram">>, {1000}], DataDistribution[<<"Histogram">>, {1000}]}}} ` Why can't I use the distribution in ParallelTable? First I thought the definition isn't shared properly, so I added `SetSharedVariable`, but that didn't resolve it. Does anyone know what I am missing here? Thank you very much.


Using a user defined Mathematica package with MathLink

I'm trying to create a Java program that uses some methods from a mathematica package I've defined. When I run my java program though the output of the program acts as though the Mathematica methods were never defined. I believe my problem has to do with the way that i'm trying to include the Mathematica package in my java code. Here is the mathematica package (saved as test.m)               BeginPackage["test`"]          test::usage = "My test package."     myAdd::usage = "adds 2 numbers"     myPrint::usage = "prints 'print this out'"          Begin["test`"]     myAdd[x_, y_] := x + y     myPrint[] := "print this out"     End[]          EndPackage[]      Here is my Java program that tries to use the two methods (myAdd and myPrint) defined in this package.               package mathlinktest;          import com.wolfram.jlink.*;          public class MathlinkTest {                   public static void main(String[] args) {              KernelLink ml;         String[] mathLinkArgs = {"-linkmode", "launch", "-linkname", "C:\\Program Files\\Wolfram Research\\Mathematica\\8.0\\mathkernel"};              //create the mathlink         try          {             ml = MathLinkFactory.createKernelLink(mathLinkArgs);         }          catch (MathLinkException e)          {             System.out.println("Fatal error opening link: " + e.getMessage());             return;         }              try              {                 //discard initial InputNamePacket                 ml.discardAnswer();                      System.out.println("Getting Primality Proving...");                 ml.evaluate("<< \"PrimalityProving`\"");                 ml.discardAnswer();                      System.out.println("Result of ProvablePrimeQ[1093] (should be true):");                 System.out.println(ml.evaluateToOutputForm("ProvablePrimeQ[1093]",0) + "\n");                      System.out.println("Set Directory...");                 System.out.println(ml.evaluateToOutputForm("SetDirectory[\"C:\\\\Users\\\\cas120030\\\\Dropbox\\\\Acoustic Metamaterials\\\\Cory and Vivek Tinkering\\\\ImportFilePathTest\\\\src\\\\importfilepathtest\"]",0) + "\n");                      System.out.println("Get Test...");                 ml.evaluate("<< \"test`\"");                 ml.discardAnswer();                 System.out.println("");                      System.out.println("Result of 1+1 using Plus[1,1]: " + ml.evaluateToOutputForm("Plus[1,1]", 0) + "\n");                      System.out.println(ml.evaluateToOutputForm("myPrint[]", 0) + "\n");                      System.out.println("testFuntion output: 1 + 2 = " + ml.evaluateToOutputForm("myAdd[1, 2]", 0) + "\n");                     }              catch (MathLinkException e)              {                 System.out.println("MathLinkException occurred: " + e.getMessage());             }              finally {                 ml.close();             }                  }     }      The File paths are correct as far as I know (they go to the right directories for the files and they are formatted correctly with the correct number of escape characters). When the program runs I get this as the output:               Getting Primality Proving...     Result of ProvablePrimeQ[1093] (should be true):     True          Set Directory...     C:\Users\cas120030\Dropbox\Acoustic Metamaterials\Cory and Vivek Tinkering\ImportFilePathTest\src\importfilepathtest          Get Test...          Result of 1+1 using Plus[1,1]: 2          myPrint[]          testFuntion output: 1 + 2 = myAdd[1, 2]      As you can see, the method calls to myAdd and myPrint are just printed out as if they were never defined in the mathematica. I thought this meant that I had defined them wrong or was using them incorrectly but I made a Mathematica notebook that was able to import and use both methods just fine using the same mathematica calls as I used here. My next thought was that importing packages was different in MathLink than with in a notebook so I included that section in the code that imports the Primality Proving package of mathematica and tests a function out of it. For reference I am using java 1.6 and Mathematica 8 on a machine running Windows 7. Sorry for the mountain of text, I wanted to give as thorough idea of what was going on as I could. Anyone have a clue what's up?


Plot3D fails to display a function I've defined

w = 100 π;     vra1[t_] := 0.8 Sin[w t];     vrb1[t_] := 0.8 Sin[w t - 2 π/3];     vrc1[t_] := 0.8 Sin[w t + 2 π/3];     ia[t_, θ_] := 7.2 Sin[w t - θ];     ib[t_, θ_] := 7.2 Sin[w t - θ - 2 π/3];     ic[t_, θ_] := 7.2 Sin[w t - θ + 2 π/3];     v0[t_, θ_] :=        Sign[vra1[t]] ia[t, θ] + Sign[vrb1[t]] ib[t, θ] + Sign[vrc1[t]] ic[t, θ];     Plot3D[v0[t, θ], {t, 0, 0.02}, {θ, -π, π}]      `Plot3D` does not dispaly the surface `v0[t, θ]`; it only shows the three dimensional axes. Please help me.


Evaluation order control

This question is related to Evaluation order of Button[]'s action Concusion was, `Button[]'s` actions are evaluated in preemptive link so "the code that needs to be run for the new cells to be created and formatted needs to wait until the preemptive evaluation has finished". To deal with it we only have to add `Method -> "Queued"` for `Button`. I've thougth that in case:               Button[ "X", x = 3; Pause @ 1; y = 4]     Dynamic @ x     Dynamic @ y      where cells for `x` and `y` are created before pushing `Button` I don't have to use `Method -> "Queued"`. However it seems I have to because `Pause` is again evaluated at the first place. This is not a big problem since I know how to deal with it but I like to know why something works not the way I thought it would. There is something more: What if I'm working with customized `button` based on `EventHandler`, let's take basic case:               SetAttributes[ GButton, HoldRest]     GButton[ob_, proc_] := DynamicModule[{},       EventHandler[        Framed[ob, Alignment -> Center],            {"MouseDown" :> (proc)}, PassEventsUp -> False,        PassEventsDown -> False]];      This kind of `button` works as a standard `Button` but how can I add anything that works as `Method -> "Queued"` in `Button`? I need something opposite to `PreemptProtect` function.


Page breaks within input cells

I am trying to print a notebook that begins with a lengthy piece of code that takes up almost an entire page. Because of my heading, it doesn't quite fit on Page 1, so Mathematica inserts a line break before the cell, leaving a ton of white space on Page 1, as shown below. ![Line break before cell](http://i.stack.imgur.com/lAlaB.jpg) However, if I add a few lines, such that the input cell takes up more than one page, Mathematica is forced to insert a page break somewhere in the cell, so it does this: ![Line break within cell](http://i.stack.imgur.com/b7AVd.jpg) This looks much nicer. I want to tell Mathematica to insert page breaks whenever a cell runs off the bottom of the page, rather than only inserting page breaks within cells when it is absolutely necessary. **My attempt at a solution:** I've tried to modify the Printout stylesheet with               Cell[StyleData[All, "Printout"],       ShowAutoStyles->True, ShowSyntaxStyles->True, Magnification->0.8,      PageBreakWithin->True]      (The second line is for colored syntax printing, irrelevant to my question.) This doesn't seem to change the default behavior. I also tried, as a less-than-elegant solution, manually inserting a page break in the input cell. This is not a satisfactory solution since it splits the cell into two input cells. **EDIT (working solution, but not ideal):** I have at least figured out how to do this on a cell-by-cell basis.   1. Highlight the cell that needs a page break.   2. Press Ctrl+shift+O to open the Option Inspector, and in the dropdown menu for "Show option values", choose Selection.   3. Navigate to Cell Options->Page Breaking and set the PageBreakWithin option to True. Click Apply and close the Option Inspector. By choosing the location of the next page break strategically, I can then achieve the behavior I want. However, I would still be interested in a more general solution (rather than repeating the above steps over and over) if one exists.


How can one popup menu be used to add another?

I'm trying to construct a GUI that changes depending on what's chosen in certain popup menu's. For example: The default state of the menu is condition one, but when the first PopupMenu is selected other menu configurations are displayed. To keep the GUI simple each popup menu has a function attached and the menu change allows the user to use a different set of functions. Data input is done by importing so non of these menus provide variable input to functions. I have reviewed this code: Manipulate with a variable number of sliders but have not been able to figure out how to modify it to produce the results I need. Thanks very much for your help! Bad code example follows:               DynamicModule[{n = 1},      Column[{Dynamic[     Grid[Table[       With[{i = i}, {i,          PopupMenu[          Dynamic[data[[i]]], {a -> "one menu" ,            b -> "Add another Menu" }], Dynamic[data[[i]]]}], {i,         n}](*Table*)]](*Dynamic*)}, Center](*Column*)]      I would like the menu to produce a second menu when "Add another Menu" is selected. So for example "Add another menu" is selected and it produces a "New Menu" Popup Menu below it, but remains showing the "Add another menu" selection and does not revert back to "one menu".


Find the a factor of an integer which is nearest to another integer

If I know two integers $n$ and $m$ and $m < n$, how can I find two different integers $x$ and $y$ that are nearest to $m$, and satisfy `Mod[n,x]==Mod[n,y]==0` ? For example,               f[720,8] ==> {8,9}     f[720,20] ==> {18,20}      If $n$ is small, we can brute force to test whether an integer is a factor of $n$, and find the nearest two of the factors:               twoNear[n_Integer, m_Integer] := Module[{ls, sortls},       ls = Select[Range[1, n], Mod[n, #] == 0 &];       sortls = Sort[Transpose[{ls - m, ls}], Abs[#1[[1]]] < Abs[#2[[1]]] &];       Sort@sortls[[1 ;; 2, 2]]      ]          twoNear[720,8]     twoNear[720,20]     (*{8, 9}*)     (*{18, 20}*)      but how to deal with problems such as `n=20!, m=1*^9` , `n=40!,m=1*^20` ?


How to combine one or more rotated graphics objects?

I wish to produce an image with more than one composite graphics objects which have been modified using _Rotate_. I feel this should not be difficult, but haven't yet found a solution. A simple example using only _Disk_ illustrates the problem.               e1 = Rotate[Graphics[Disk[{0, 0}, {1/3, 1/4}]], \[Pi]/3];     e2 = Rotate[Graphics[Disk[{0, 0}, {1/3, 1/4}]], \[Pi]/7];      The following attempt fails:               Show[e1,e2]      > > Show::gcomb: Could not combine the graphics objects in Show[] How should this best be achieved ?


Is it possible to set a timeout for LinkWrite[]?

This came up in relation to this answer Is it possible to set a timeout for `LinkWrite`? `LinkWrite` seems to block until the sent data is read on the other end of the link. Can it block indefinitely or does it have a long timeout? If it doesn't have a default timeout, is it possible to set one? ### An example Let's create two new kernels in the front end (this might overwrite your existing kernels, but it will be reversed after restarting the front end):               SetOptions[$FrontEndSession,       EvaluatorNames -> {"Local" -> {"AutoStartOnLaunch" -> True},         "K1" -> {"AutoStartOnLaunch" -> False},         "K2" -> {"AutoStartOnLaunch" -> False}}]      Then open two new notebooks, and in the first one evaluate               SetOptions[EvaluationNotebook[], Evaluator -> "K2"]          link = LinkCreate["alink"]          LinkWrite[link, "boo"]      In the second one evaluate               SetOptions[EvaluationNotebook[], Evaluator -> "K1"]          link = LinkConnect["alink"]          LinkRead[link]      `LinkWrite` in the first one will only return after `LinkRead` has finished evaluating in the second one. * * * If the answer is that it's not possible to set a timeout, that can be reasonable too. I was wondering about this: suppose we're running a long parallel calculation, and we interrupt the main kernel to enter a subsession and inspect the state (`Evaluation -> Interrupt -> Enter subsession`). Is it possible that one of the parallel kernels will time out while trying to send the result, and the calculation won't be able to resume after returning from the subsession?


Research positions of lists of varying size

I'm new to the site and I am French, so I ask your indulgence for my future mistakes in English. I would like to optimise the following code :               Proc1V1[x_] :=       Block[             {ListO = x, F°1B1, F°1B1oneseq, F°2B1, F°2B1oneseq, F°3B1, F°4B1, F°1B2,               Res1V1},                   F°1B1 = Table[                       Partition[ListO, j, 1],                       {j, 1, Length[ListO], 1}                      ];              F°1B1oneseq = Partition[ListO, 1, 1];              F°2B1 = Sort[                      Tally [                             Flatten[F°1B1, 1]                            ],                       #1 [[2]] > #2 [[2]] &                     ];              F°2B1oneseq = Tally[F°1B1oneseq][[All, 1]];              F°3B1 = Sort[                      F°2B1 [[1 ;; (Position[F°2B1[[All, 2]], 1][[1, 1]])-1]][[All, 1]],                      Length[#1] > Length[#2] &                     ];              F°4B1 = Join[                      TakeWhile[F°3B1, Length[#] > 1 &],                       F°2B1oneseq                     ];              F°1B2 = Table[                       Position[ F°1B1[[ Length[ F°4B1 [[i]]] ]],F°4B1 [[i]]],                       {i, 1, Length[F°4B1], 1}                     ];              Res1V1 = {F°1B2, F°4B1}        ];      After applying `AbsoluteTiming` on the different steps of my algorithm, `F°1B2` appeared to be the longest step in the calculation. So I focus on it. The algorithm acting at `F°1B2` is responsible for determining the positions of the various lists of numbers stored in `F°4B1` and contained in `F°1B1`. It may be noted here that `ListO` is a simple list of integers or reals. For example:               ListO = {1, 2, 3, 4, 5, 6, 7}      I've tried using `Compile` but this does not work if it has to deal with lists of different size. I know that finding an alternative to the `Position` is a recurring topic on StackExchange but I have yet to find a reliable solution to replace `F°1B2` by a faster algorithm, especially because `Proc1V1` is the first algorithm to a broader set and therefore it is difficult to change the structure of the data it produces.       _Edit n°1_ * * * To better understand my project, I will give an overview of the context. My goal is to make an algorithm to detect and store the sequences detected in an ordered list of number (Real or Integer number). To start, I got used to test my code with : `ListTest= IntegerPart [ RandomReal [ 10,50 ] ] ;` Therefore, `Proc1V1` must detect the different sequences contained inside `ListTest`. It is important to note here that a set of numbers will be considered as a sequence, if it appears at least twice in `ListTest` and if it is length is greater than 1. To do this (it’s probably perfectible but I have not found better yet), the algorithm I did create partitions of different lengths in the starting list `ListTest`. These partitions are compared and sorted at `F°2B1`. All other operations are responsible for ensuring that the definition of the sequences as I defined above is respected. If all operations are relatively fast, the operation performed under `F°1B2` turns long . For the rest of the algorithms which I wrote it, I need that `Proc1V1` provide me the positions of these sequences inside `F1B2` and obviously the sequences identified.       _Final Edit_ * * * **Tested functions** Proc1V1 : see above. `Proc1V1alt1[list_]:= {#[[1,2]],#[[All,1]]}&/@ ReplaceList[list,{a___,x__,___}:>{Length@{a}+1, {x}}]~GatherBy~Last~Cases~{_,__};` `Proc1V1alt2[list_]:= {#[[1,2]],#[[All,1]]}&/@ (Join@@Table[{i,list[[i;;j]]},{i,Length[list]}, {j,i,Length[list]}])~GatherBy~Last~Cases~{_,__};` `Proc1V1alt3[list_]:= Block[ {bigL=list,z1,z2,z3,z4,z5,z6,z7,minlength}, minlength=1; z1=Flatten[Position[#,True]]& /@Rest@ListCorrelate[bigL,bigL,1,x,SameQ,List];   z2=Split[#,(#1+1===#2)&]&/@z1; z3=DeleteCases[z2,q_List/;Length[q]<minlength,{2}]; z4=DeleteCases[MapIndexed[w[#2,#1]&,z3],w[_,{}]]; z5=Flatten[z4/.w[{u_},q_List]:>Map[w[bigL[[#]],First[#]+{0,u}]&,q]]; z6=Split[Sort[z5],First[#1]===First[#2]&]; z7={#[[1,1]],Union@@(Last/@#)}&/@z6 ];` `Proc1V1alt4`: See Rasher's post. With : `Proc1V1` : personal function.   `Proc1V1alt1` : Mr Wizard's function n°1.   `Proc1V1alt2`: Mr Wizard's function n°2.   `Proc1V1alt3` : Wouter's function.   `Proc1V1alt4` : Rasher's function **Test code** `ValeurPerfTemps= Table[ AbsoluteTiming[ func[IntegerPart[RandomReal[10,i]]] ][[1]], {i,50,500,1} ];` `ListLinePlot[ValeurPerfTemps]` **Result** ![enter image description here](http://i.stack.imgur.com/zW25p.jpg)   ![enter image description here](http://i.stack.imgur.com/VNITe.jpg)   ![enter image description here](http://i.stack.imgur.com/q0vVI.jpg)   ![enter image description here](http://i.stack.imgur.com/qQPOx.jpg)   ![enter image description here](http://i.stack.imgur.com/4Txbn.jpg) **Conclusion** In the context of my original question, the function n°2 of Mr. Wizard is the most suitable. Nevertheless, it is important to note that my function Proc1V1 takes place in a set of algorithm, and some of which are specifically dedicated to the elimination of sequences "encapsulated" (ex : 123 is contained in 11234). Actually I will use Rasher's function, which is very fast. Thank you all for your help.       _Benchmark_ * * * On my computer :   Proc1V1[{3, 0, 1, 0, 3, 2, 2, 0, 3, 0, 1, 3, 0, 2, 3, 3, 0, 0, 1, 2}]   give   {{{{1}, {9}}, {{4}, {8}}, {{2}, {10}, {18}}, {{1}, {9}, {12}, {16}}, \ {{1}, {5}, {9}, {12}, {15}, {16}}, {{2}, {4}, {8}, {10}, {13}, {17}, \ {18}}, {{3}, {11}, {19}}, {{6}, {7}, {14}, {20}}}, {{3, 0, 1}, {0, 3}, {0, 1}, {3, 0}, {3}, {0}, {1}, {2}}}


Threading a compiled function over multiple arguments of different lengths

I am interested in threading a compiled function over multiple argument lists of different lengths. I will explain this in two steps: Suppose f is some function. Then one can define another function,               ppost[arg_, context_] := Apply[f[arg, ##] &, context]      which can be used as               In[2]:= ppost[a, {b, c}]          Out[2]= f[a, b, c]      or in a more complex scenario let,               In[3]:= argList = {{a1, b1}, {a2, b2, c2}};          In[4]:= mList = {{m1, n1}, {m2, n2, o2}};          In[5]:= contextList = {mList, y, z}          Out[5]= {{{m1, n1}, {m2, n2, o2}}, y, z}      We can thread the function over the argList and the contextList as follows:               In[6]:= Thread[ppost[argList, contextList]]          Out[6]= {f[{a1, b1}, {m1, n1}, y, z],               f[{a2, b2, c2}, {m2, n2, o2}, y, z]}      The above works, as needed. Question: I need to do the same when f is a compiled function. As an example,               fc = Compile[{{arg, _Real, 1}, {c1, _Real, 1}, {c2, _Real}, {c3, _Real}},       c3*arg + c2*c1       ]          ppost1[arg_, context_] := Apply[fc[arg, ##] &, context]          In[9]:= nargList = {{1, 2}, {3, 4, 5}} // N;          In[10]:= nmList = {{6, 7}, {8, 9, 10}} // N;          In[11]:= ncontextList = {nmList, 50, 55} // N          Out[11]= {{{6., 7.}, {8., 9., 10.}}, 50., 55.}          In[12]:= ppost1[nargList[[1]], {nmList[[1]], 50, 55}]          Out[12]= {355., 460.}      So far, so good, but then the following does not work properly, and uses the uncompiled version.               In[14]:= Thread[ppost1[nargList, ncontextList]]          During evaluation of      In[14]:= CompiledFunction::cfta: Argument {{1.,2.},{3.,4.,5.}} at position 1      should be a rank 1 tensor of machine-size real numbers. >>          During evaluation of      In[14]:= Thread::tdlen: Objects of unequal length in      {{355.,460.},{565.,670.,775.}} cannot be combined. >>`          Out[14]= {{355., 460.}, {565., 670., 775.}}      So, how can I thread the compiled function over the arguments nargList, ncontextList?


Function to Determine Lucky Numbers

Given a list of the form `{1, 3, 5, 7, ...}`, the lucky numbers are obtained by looking at the first list element after 1 (so 3 in this case), and deleting all list elements whose position in the list is a multiple of the number after 1. So, if we do this to `Range[1, 100, 2]`, the result would be:               {1, 3, 7, 9, 13, 15, 19, 21, 25, 27, 31, 33, 37, 39, 43, 45, 49, 51,      55, 57, 61, 63, 67, 69, 73, 75, 79, 81, 85, 87, 91, 93, 97, 99}      This is done iteratively, so that the list element two positions to the right of 1 in the resulting list (in this case, 7) becomes the new number. List elements whose position in the list is a multiple of that number are then deleted, and so on. The numbers that remain are the "Lucky Numbers", and in the case of `Range[1, 100, 2]`, they are:               {1, 3, 7, 9, 13, 15, 21, 25, 31, 33, 37, 43, 49, 51,      63, 67, 69, 73, 75, 79, 87, 93, 99}      The function I defined to determine these lucky numbers is as follows:               luckyNumbers[z : {1, __?OddQ}] :=       Module[{i = 2},        FixedPoint[Delete[#, Partition[Range[#[[i]], Length[#], #[[i++]]], 1]] &, z]      ]      As far as I know, it works as expected. I'm looking for criticism with regards to efficiency and things of that nature. What would you, the StackExchange community, have done differently?


Numbered symbols

I work with an exterior algebra over $R^n$. I have the basis $\\{1,\omega_i\\}_{i=1}^n$ in this algebra, and my differential operator is defined as $$d\omega_k=\sum_{i>j>0,i+j=k} (i-j)w_i\wedge w_j.$$ As you see, my sum depends directly on the indexes of the elements of the basis. I surely can define the wedge and the differential operator in _Mathematica_ , and they will calculate the derivative for any polynome I want. My problem is to find a good way to describe the elements of the basis, which will permit me use these formulas easily. It can not be just the integers $1, .. n$ for every element $\omega_1, .. \omega_n$, because _Mathematica_ will multiply them as normal numbers, not treating them as elements of the exterior algebra; it cannot be just symbols such as `w1`, `w2`, ... because I cannot easily extract the numbers from them to calculate the derivatives (or I just don't know how). I tried to represent them with `{1}`, `{2}`, and so on. I also used noncommutative multiplication with additional relations as the exterior multiplication. Example of what my notebook can calculate:               In[30]:= d[{5} ** {4}]     Out[30]= {4} ** {3} ** {2} + 2 {5} ** {3} ** {1}      That's nice. I defined multiplication and differentiation without problems, except for one small thing -- multiplying by a scalar. For example, consider the expression $2\omega_4+\omega_5$. In this notation it appears as `2 {4} + {5}`. Mathematica proceeds to `{8} + {5}` and then to `{13}`, which is completely wrong.               In[31]:= 2 {4} + {5}     Out[31]= {13}        This only happens when working with dimension 1. For higher grades everything's fine because _Mathematica_ 's multiplication doesn't misbehave when working with non-commutative elements:               In[32]:= 2 {4} ** {3} + 6 {5} ** {2}     Out[32]= 2 {4} ** {3} + 6 {5} ** {2}          In[33]:= (2 {4} ** {3} + 6 {5} ** {2}) ** {3}     Out[33]= -6 {5} ** {3} ** {2}        But this is still not what I want -- lower dimensions are important to me, so my question is: how do I represent the basis elements without these problems? I can try to partially clear `Times`, but I don't think this is best way, as the multiplication of lists may be vital later in the code.


Matrix operations performed with column-vectors

We have 3 matrices: `m1`, `m2` and `b`. We want to apply matrix operations (dot or sum) in a particular way: we want to treat the columns of `m2` and `b` separately as a _vectors_ and `m1` as a matrix. `m1` is a (9*9) matrix:               m1 = {{0, 0.25, 0, 0.25, 0, 0, 0, 0, 0}, {0.25, 0, 0.25, 0, 0.25, 0, 0, 0,0},           {0, 0.25, 0, 0, 0, 0.25, 0, 0, 0}, {0.25, 0, 0, 0, 0.25, 0, 0.25, 0,0},           {0, 0.25, 0, 0.25, 0, 0.25, 0, 0.25, 0}, {0, 0, 0.25, 0, 0.25, 0, 0,0, 0.25},           {0, 0, 0, 0.25, 0, 0, 0, 0.25, 0}, {0, 0, 0, 0, 0.25, 0, 0.25, 0, 0.25},           {0, 0, 0, 0, 0, 0.25, 0, 0.25, 0}}      ![enter image description here](http://i.stack.imgur.com/3UVsB.png) `m2` and `b` are (9*15) and (9*9) matrices, respectively, with the elements:               m2 = {{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},          {0, 0, 0, 0, 0, 0, 0, 0, 0,0, 0, 0, 0, 0, 0},           {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},           {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},             {0, 0, 0,0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},            {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},           {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,0},            {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},          {0, 0, 0, 0, 0,0, 0, 0, 0, 0, 0, 0, 0, 0, 0}}          b = {{1.5, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 1, 0, 0, 0, 0, 0, 0, 0},         {0, 0, 1.5, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0},         {0, 0, 0,0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0},         {0, 0, 0, 0, 0, 0, -1.5, 0, 0}, {0, 0, 0, 0, 0, 0, 0, -1, 0},          {0, 0, 0, 0, 0, 0, 0, 0, -1.5}}      We want to be able to extract any column of `m2` and `b` as a _vector_ ![enter image description here](http://i.stack.imgur.com/ToSKB.png) ![enter image description here](http://i.stack.imgur.com/mSVpf.png) in a such way, that we will be able to form the product `m1` with any extracted _vector_ of `m2` and add it to an extracted column of `b` in the following way:               column[2][m2] = m1.column[1][m2] + column[1][b]          column[3][m2] = m1.column[2][m2] + column[2][b]          column[4][m2] = m1.column[3][m2 ]+ column[3][b]          column[i][m2] = m1.column[i - 1][m2] + column[i - 1][b]      and so on. Finally we wanted to populate the matrix m2 with the newly calculated elements instead of zeros.


Turn list of edges into a polygon function

I have a list of coordinates that define the edges of a polygon and I would like to get a function defining the area Inside out if it (The polygon is convex and the points are in order) So that for example: `List[{0, 2}, {4, 2}, {.5, 0}]` Becomes: `Boole[(y < 2 && 7y > 4x-3 && Y > 2-4x)]` I found the Polygon function to accept lists but I don't know how to turn it into a function. I guess there is some easy way to do that as it's a quite common thing but I fail to find it.


QR Code in shopping cart handle

This week, the market people from my work wanted to put QR codes in shopping cart handles, but when they tested it, the QR code did not work. I noted that the cylindrical curvature (even small) distorted the image, and the cell phone can't read it. ![diagram](http://i.stack.imgur.com/7HVKU.png) Here is some test QR code: ![qrCode](http://i.stack.imgur.com/FHvNV.png) I thought that this would be a nice thing to do with _Mathematica_ , to try to figure out how I could print the QR code into some way that when attached to the cylindrical form, it would be like a normal square, at least at some angles. I tried to simulate how it would be plotted in the handle using `Texture`, and I get this:               qrCode = Import["http://i.stack.imgur.com/FHvNV.png"];     RevolutionPlot3D[{1, t}, {t, 0, 20}, Mesh -> None, PlotStyle -> Texture[qrCode],                      TextureCoordinateScaling -> False, Lighting -> "Neutral", ImageSize -> 100]      ![cylinder with QR code](http://i.stack.imgur.com/WEyn0.png) Here is some code from the docs for `Texture` that I tried to adapt, without success:               RevolutionPlot3D[{1, t}, {t, 0, 1}, PlotStyle -> Texture[qrCode], Mesh -> None,                      TextureCoordinateFunction -> ({#3, #2} &), Axes ->  False,                      Lighting -> "Neutral", ImageSize -> 300, AspectRatio -> 1]      ![texture](http://i.stack.imgur.com/OleNA.png) Does anyone know how I can distort the QR code, in a way? I believe that it's equivalent to projecting the texture onto the surface, and then using the projected image. **update:** This problem is very similar to this, the difference is that we are in the cylinder, and this anamorphic illusion example is in the plane.


Defining functions with special cases

I'm trying to define a function `myFunc` with a special case:               myFunc[x_, y_] = (x^2 - y) Log[x^2 - y];     myFunc[x_, x_^2] = 0;      This seems to work in limited cases only:               In[1] := myFunc[x, x^2]     Out[1] = 0      But if I put in numbers, or anything else, it fails. How would I fix this?               In[2] := myFunc[2.1, 2.1^2]     Out[2] = Indeterminate          In[3] := myFunc[a^2, a^4]     Out[3] = Indeterminate      I am more interested in making case with numbers to work. What should I do?


Error when extending 1-dimensional PDE to 2 dimensions

I want to calculate how magnetic flux is trapped in a superconductor near the interface superconductor/vacuum. This problem already was solved analytically by J. Pearl for cylindrical symmetry (if interested, see: “Structure of Superconductive Vortices near a Metal‐Air Interface” by J. Pearl, 1966). So my idea is, to begin with the numerical solution of this special problem and to compare it with the given analytical solution. The general PDEs I want to solve are: (first eq. for z<0 (vacuum) and second for z>0 (superconductor)) ![The PDEs for z<0 \(vacuum\) and z>0 \(superconductor\)](http://i.stack.imgur.com/C8O56.jpg) For z--> +infinity, we are far away from the interface at z=0, and thus the z-dependency of f2 should disappear. Setting Phi0=Lambda=1, f=f2, the second equation reduces to:               pde1 = D[1/r*D[r*f[r], r], r] - f[r] + 1/(2*Pi*r) == 0;      The boundary conditions with the boundaries “start” and “stop” are known from physics:               bc1 = {f[start] == 0, f[stop] == 1/(2*Pi*stop)};      So the first script for calculating the one-dimensional special case z-->+infinity is:               Clear["Global`*"];     start = 1/1000;     stop = 20;     wp = 50;     pde1 = D[1/r*D[r*f[r], r], r] - f[r] + 1/(2*Pi*r) == 0;     bc1 = {f[start] == 0, f[stop] == 1/(2*Pi*stop)};     solf = NDSolveValue[{pde1, bc1}, f, {r, start, stop}, WorkingPrecision -> wp];     Plot[solf[r], {r, start, stop}, PlotRange -> All]      The result fits perfectly to the analytical solution! Now, I want to extend the problem to two dimensions. For this, I replace f(r) by g(r,z), leading to the new pde2 (which has the same structure as pde1):               pde2 = D[1/r*D[r*g[r, z], r], r] - g[r, z] + 1/(2*Pi*r) == 0;      The boundary conditions are generalized to two dimensions in a manner that should produce the same result as in the one-dimensional case, since g[r,z] is forced to reproduce the one-dimensional solution at each border. ( **Important: This type of boundary conditions can’t be solved by the method of lines and thus requires the FEM-method which is implemented since Mathematica 10, so it doesn’t run in earlier versions!** )               bc2 = {g[start, z] == solf[start], g[stop, z] == solf[stop], g[r, zborder] == g[r, -zborder] == solf[r]};      For each value of z, the result found by NDSolve should therefore be equivalent to the one-dimensional case (--> invariant in z-direction). The script for the two-dimensional extension is:               Clear["Global`*"];     start = 1/1000;     stop = 20;     zborder = 10;     wp = 50;     pde1 = D[1/r*D[r*f[r], r], r] - f[r] + 1/(2*Pi*r) == 0;     pde2 = D[1/r*D[r*g[r, z], r], r] - g[r, z] + 1/(2*Pi*r) == 0;     bc1 = {f[start] == 0, f[stop] == 1/(2*Pi*stop)};     bc2 = {g[start, z] == solf[start], g[stop, z] == solf[stop], g[r, zborder] == g[r,-zborder] == solf[r]};     solf = NDSolveValue[{pde1, bc1}, f, {r, start, stop}, WorkingPrecision -> wp];     solg = NDSolveValue[{pde2, bc2}, g, {r, start, stop}, {z, -zborder, zborder},    WorkingPrecision -> wp];     Plot3D[solg[r, z], {r, start, stop}, {z, -zborder, zborder}, PlotPoints -> {100, 30}]     Plot[{solg[r, 0], solf[r]}, {r, start, stop}, PlotRange -> All]      ![Solution of the 2D-extension](http://i.stack.imgur.com/Ge0me.jpg) ![Comparison of the 1D and 2D-solution](http://i.stack.imgur.com/zoAtS.jpg) For whatever reason, solg[r,0] differs significantly from solf[r]. Since the difference between the two solutions increases with zborder, I assume it is caused by some numerical inaccuracy/instability. But increasing/decreasing WorkingPrecision shows no significant influence. Are there some ideas where this deviation comes from and how to avoid it?


Why is the CTRL + / not working?

I've learned how to use this shortcut to input fractions in the 2D form, it worked nice on my notebook but I can't make it on my desktop. Any tip on what could be happening?


Evaluating standard functions of general quaternions symbolically

Mathematica can easily compute exponentials and logarithms of concrete quaternions:               Needs["Quaternions`"]          Exp[Quaternion[1.3, 3.5, -0.7, 0.9]]     Log[Quaternion[1.3, 3.5, -0.7, 0.9]]      > Quaternion[-3.14824, -1.79206, 0.358412, -0.460816] > > Quaternion[1.36196, 1.17075, -0.23415, 0.301051] Even for exact numbers:               Exp[Quaternion[1, 3, 7/2, -5]]      > Quaternion[E Cos[Sqrt[185]/2], (6 E Sin[Sqrt[185]/2])/Sqrt[185], ( 7 E > Sin[Sqrt[185]/2])/Sqrt[185], -2 Sqrt[5/37] E Sin[Sqrt[185]/2]] But it seems to be unable to expand this for the general quaternion:               Exp[Quaternion[a, b, c, d]]      > E^Quaternion[a, b, c, d] I've tried using `Simplify`, `FunctionExpand`, `ToQuaternion` on this, but still it doesn't give a `Quaternion` object. But there does exist a closed form for such functions. I can, of course, define such functions myself, like:               exp[q_]=With[{v=q-Re[q]}, Exp[Re[q]](Cos[Abs[v]]+v/Abs[v]Sin[Abs[v]]) ];     ln[q_]=Log[Abs[q]]+(q-Re[q])/AbsIJK[q] ArcCos[Re[q]/Abs[q]];      But is there a way to get Mathematica itself expand these functions of general quaternions, without me having to redefine them all?


Mathematica's external controllers?

While reading the Manipulate reference I've noticed this line: ![enter image description here](http://i.stack.imgur.com/5Gyqw.jpg) What are the available external devices for that? Some months ago I was thinking on what would be needed to use a MIDI Controller such as The BitStream 3X above Into Mathematica. ![enter image description here](http://i.stack.imgur.com/08Y83.jpg) With my limited knowledge, I thought I could make Max/MSP receive the midi messages and write them down on a txt file, and then Mathematica would read it and use it for controlling something useful, I've asked to a friend - who have a degree on C.S. - how this could be accomplished, he said me I would need to use the system DLL's for that. The questions are:   * What are these controllers?    * How would it be possible to transform the MIDI signals into Mathematica? **Bonus?** : I also have a KORG Kontrol 49 in my table. It's a MIDI controller - does not produce sound, only MIDI signals. - It's possible to translate some MIDI messages (such as button presses) into keystroke emulation through Bome's MIDI Translator. This is by no means contradictory, translating keyboard keys into keystroke emulation is easy, the only thing I kinda have no clue on how I could do it is how to make a MIDI hardware slider control a Mathematica Slider. I've posted this last section because it could be useful for someone.


How to insert or use the PackageTemplate?

In the system resource file `MiscStrings.tr` there is a template:               @@resource PackageTemplate     Notebook[{     Cell[BoxData[         RowBox[{"BeginPackage", "[", "\"\<\[Placeholder]`\>\"", "]"}]], "Code"],     Cell[BoxData[         RowBox[{"Begin", "[", "\"\<`Private`\>\"", "]"}]], "Code"],     Cell[BoxData[         RowBox[{"End", "[", "]"}]], "Code"],     Cell[BoxData[         RowBox[{"EndPackage", "[", "]"}]], "Code"]     }]      I suppose there is also an automatic way to insert or use this template. What is it?


Map a 3D plot into plane

I have a 3D plot like:               Ds=     1 - I ((0.602499 Sqrt[1 - 0.075076/(I si + sr)])/(         0.550556-I si - sr) + (         0.101418 Sqrt[1 - 0.075076/(I si + sr)])/(         1.17669-I si - sr) + (         5.66507 Sqrt[1 - 0.075076/(I si + sr)])/(         2.23017-I si - sr) + (         0.920849 Sqrt[1 - 0.075076/(I si + sr)])/(         3.18056-I si - sr) + (1/(64 \[Pi]))         Sqrt[1 - 0.075076/(           I si + sr)] (-1365.06 +             1/(-0.075076 + I si + sr)              4 (30.8579 Log[1 + 0.31441 (-0.075076 + I si + sr)] +                189.838 Log[1 + 0.448396 (-0.075076 + I si + sr)] +                3.39856 Log[1 + 0.849842 (-0.075076 + I si + sr)] +                20.1899 Log[1 + 1.81635 (-0.075076 + I si + sr)])));          Plot3D[Re[Ds], {sr, -.3, .3}, {si, -0.3, .3}]      I want to draw a 2D plot in which `Re[Ds]` is a vertical axes and sr is a horizontal one. Or its better to say I want to view my 3D plot in certain planes.


Enhancing GraphUtilities' GraphEdit

One thing I use _Mathematica_ for is building molecular graphs. Until now, I've been content with generating an adjacency matrix from SMILES data, and passing that to `AdjacencyGraph`. That works well for small cyclic graphs, but the method fails my expectations when the molecules are polycyclic. I want all the edges to be of unit length, but none of the `GraphLayout` option values permit that. ![Undesired layout](http://i.stack.imgur.com/h1Gfv.png) **GraphEdit** The `GraphUtilities` package contains an interactive graphing function. It enables one to draw any graph, and outputs the relevant data to reconstructing it. It would be of great help if I could pre-define graphs for `GraphEdit` to use, that could be copied any number of times inside the applet, while retaining their shapes. This screenshot (from _ChemDraw_) illustrates what I'm looking for: ![enter image description here](http://i.stack.imgur.com/ZVOkG.png) Also, directly passing a `Graph` object to `GraphEdit` doesn't work:               GraphEdit[CycleGraph[6]]          (* GraphEdit[{1 \[UndirectedEdge] 2, 2 \[UndirectedEdge] 3, 3 \[UndirectedEdge] 4,          4 \[UndirectedEdge] 5, 5 \[UndirectedEdge] 6, 6 \[UndirectedEdge] 1}] *)      Can I add such functionality to `GraphEdit`?


Force VectorPlot3D to show One arrow

I am plotting a curl, and I only want VectorPlot3D to show one arrow, I have tried adjusting VectorPoints-> 1, but the plot show's no arrows at all. Is 2 the minimum VectorPoints I can have? If I cannot make use of VectorPlot3d in this way, how can I use the Arrow function to point in the direction of a vector field at a certain point? Thank-you


How can I change mouse hover behavior for hyperlinks in a notebook?

When I create a `Hyperlink` to a _Youtube_ video in a text cell the link is colored blue like it would be in a browser. However, the mouse cursor does not change when it hovers over a link. This causes my students to think that the link doesn't work or isn't really a link. To them it just looks like I have blue colored text.


Get unevaluated option value?

This is kind of a follow-up to this question. I want to be able to define a function that takes an option, and then, inside the function, retrieve and test the _unevaluated_ value of the option. For example, I'd like to be able to define the following (this is obviously a silly example, but nonetheless): a function that accepts an expression and an option, `Power`, that should be allowed the values `one` and `two`. It should plot the appropriate power (first or second) of the given expression. So one way of doing this is               SetAttributes[plotIt, HoldAll];     Options[plotIt] = {Power -> one};     plotIt[f_, OptionsPattern[]] := Module[{},        Switch[OptionValue[Power],         one, Plot[f, {x, 3, 5}],         two, Plot[(f)^2, {x, 3, 5}]         ]        ];      which works just fine, except that what is being tested is the _evaluated_ `one` and `two`. Thus if those are defined variables in the current environment that happen to have the same value, invocations of this function will always use the first branch of the switch statement. I've tried various ways to extract the name of the option value, without success. And even if I do so, I'm not sure how to refer to it in the various branches of the switch statement. Thanks.


Finding a Moore neighborhood connected path of bright pixels along the contour of a text character

I have a simple image, for example a blowup of a Times New Roman character like 'R' saved as a PNG. I then perform the following operations to extract a minimum representation of the contour lines around the character:               MorphologicalComponents[Thinning[EdgeDetect[Import["http://li.c-b.co/is/image/LandOfNod/Letter_Giant_Enough_R_232459_LL/$web_zoom$&wid=550&hei=550&/1308310656/not-giant-enough-letter-r.jpg"]]]] // Colorize      (The image in the picture is the best I could do looking around for an example on the Internet...) I'd now like to find a way to pull out an ordered set of coordinates representing the center of pixels connected through their Moore neighborhoods. The hope is that this will yield a polygon representation of the character for 'R'. Is there a simple way to do this that doesn't require me having to compute a Hamiltonian path or cycle?


Fourier series of interpolating function result of NDSolve

I am having a tough time formulating the _right_ question but here goes. I know that solving the pde as in here gives me an interpolating function. I understand that the interpolating function object is different from the interpolating polynomial. So if I wanted to approximate the interpolating function through `FourierSinSeries`, I don't quite get how I might go about it. I can't just do: `FourierSinSeries[InterpolatingFunction[{{0.,...},{0.,...},{0.,TMax}},<>],x,4]` I tried that it didn't quite give me a series expansion. # Edit: Here's what I tried to do to get fourier coefficients describing my interpolating function. ## Mathematica code:               Off[NDSolve::ibcinc];     k=0.0677;     {xMin,xMax}={-(\[Pi]/k),\[Pi]/k};     TMax=2500;     uSol[t_,x_]=u[t,x]/.NDSolve[{\!\(     \*SubscriptBox[\(\[PartialD]\), \(t\)]\(u[t, x]\)\)==-100 \!\(     \*SubscriptBox[\(\[PartialD]\), \(x\)]\((     \*SuperscriptBox[\(u[t, x]\), \(3\)]\      \*SubscriptBox[\(\[PartialD]\), \(x, x, x\)]u[t, x])\)\)+1/3 \!\(     \*SubscriptBox[\(\[PartialD]\), \(x\)]\((     \*SuperscriptBox[\(u[t, x]\), \(3\)]\      \*SubscriptBox[\(\[PartialD]\), \(x\)]u[t, x])\)\)-5 \!\(     \*SubscriptBox[\(\[PartialD]\), \(x\)]\((     \*SuperscriptBox[\((     \*FractionBox[\(u[t, x]\), \(1 + u[t, x]\)])\), \(2\)]\      \*SubscriptBox[\(\[PartialD]\), \(x\)]u[t, x])\)\),u[0,x]==1-0.1 Cos[k x],     (*Piecewise Function for INITIAL CONDITION*)     (*u[0,x]== Piecewise[{{-0.1,-\[Pi]/k<= x<-\[Pi]/(10 k)},{ Cos[x],-\[Pi]/(10 k)<= x<= \[Pi]/(10 k)},{-0.1,\[Pi]/(10 k)<x<= \[Pi]/k}}],*)          (u^(0,1))[t,xMin]==0,     (u^(0,1))[t,xMax]==0,     (u^(0,3))[t,xMin]==0,     (u^(0,3))[t,xMax]==0          (*(u^(0,3))[t,xMin]==0,     (u^(0,3))[t,xMax]==0*)},     u,{t,0,TMax},{x,xMin,xMax},MaxStepSize->0.1,MaxSteps->100000,Method->{"BDF", "MaxDifferenceOrder"-> 5}][[1]]      ## Fourier series: Since I now have `uSol` which, my fourier coeffs should be:               I1 = NIntegrate[uSol[0.1 TMax, x], {x, xMin, xMax}] (*I1 at time=0.1 TMax*)     a0 = (1/(2*xMin))*I1     an = NIntegrate[uSol[0.1 TMax, x] Cos[n \[Pi] x/xMax], {x, xMin, xMax}]     bn = NIntegrate[uSol[0.1 TMax, x] Sin[n \[Pi] x/xMax], {x, xMin, xMax}]      Using `NIntegrate` errors out with:               NIntegrate::inumr: The integrand Cos[0.0677 n x] <<1>>[250.,x] has evaluated to non-numerical values for all sampling points in the region with boundaries {{-46.4046,-46.3046}}. >>      However, using `Integrate` instead of `NIntegrate` gave me just the input as symbols. Neither is the coefficient. So what am I missing? There has to be a simpler way of figurijng out the fourier coeffs of an interpolating function. can I export data out of mathematica into .csv or some other format which is not dependent on mathematica to be interpreted?


Differential Equation in Complex Plane and Parametric Plot

I would like to solve $dx/dt=\sqrt{1 + (I x)^3}$, where x is complex, for some initial condition like $1 - 5 I$ and plot the imaginary part of the solution versus the real part. (A somewhat similar problem was posted earlier in different topic) I have used this code:               s = NDSolve[{x'[t] == (1 +(I x[t])^3)^0.5, x[0] == 1 -5 I}, x[t], {t, 0, 10}];     ParametricPlot[Evaluate[{Re[x[t]], Im[x[t]]} /. s1], {t,0,10}]      and I have tried it for different initial points, the results are not satisfactory. I expect to obtain closed contours for every initial condition in the lower half plane of complex plane, excatly like this: ![enter image description here](http://i.stack.imgur.com/U3MD4.png) (As a side and not very important remark x plus, minus and zero are where the square root vanishes) I appreciate if one could help me to fix it! P.S.: Can this problem be due to branch points?


Defining a function to determine when convergence is guaranteed

I'm investigating how many iterations are needed for a particular orbit to reach a fixed point of a function. Since I have many functions to test, I want to define a function in Mathematica that will take as its input   1. the function I want to test   2. the seed or starting point of the iteration   3. total number of iterations to carry out. Since the orbit never actually reached the fixed point, I am considering any point that comes within a millionth of the actual fixed point to have reached the fixed point. I have defined the following function               iterationsteps[function_, seed_, steps_] := Length[      Select[FixedPointList[function, seed, steps] - FixedPoint[function, seed], # >= 1*10^(-6)]]      But whenever I try to run it on some test values, it just ends up running for ages and never returns anything. I'd be extremely grateful is someone can point me in the right direction. Thank you! \Edit: Some troubleshooting and the helpful answers below revealed that the problem was caused by FixedPoint.               iterationsteps[function_, seed_, steps_] :=      Length[Select[     FixedPointList[function, seed, steps] -      FixedPoint[function, seed,      SameTest -> (Abs[#1 - #2] < 1*^-6 &)], # >= 1*10^(-6) &]]