How can I animate a set of points imported from file?

I have an external program which generates a set of data - X points at the time t1, X points at the time t2 and so on. These points are stored in CSV file and I can change the format if necessary.   What is the easiest way to plot and manipulate them, so I can click "play" and see the dynamics of process? **UPD:**   For example, points at t1:               0.2 42.8     0.4 12.3     0.6 32.1     0.8 37.3      Points at t2:               0.2 44.2     0.4 17.8     0.6 39.0     0.8 30.1      It is always a constant number of points at any time (4 in example). I can export them to separate CSV files or in the one file and change format in any way necessary, like adding a new column.


Modular surface of tri-focal cassini curve ContourPlot3D missing feet

I am wondering why the following fails to cover the surface at points near k = 0.               c[z_] := (z + 1) (z - 1) (z + 1 + I);          ContourPlot3D[Abs[c[x + I y]] == k^3, {x, -2.5, 2}, {y, -2, 2},      {k, 0, 1.75}, Background -> White, AxesLabel -> {"x", "y", "k"}]      ![Mathematica graphics](http://i.stack.imgur.com/AFiPd.png) Furthermore, when the left hand side is complex expanded and the equation is rearranged with 2xy + k^3 on the right, the curve looks significantly different, with one large and one small foot, both touching at zero. Why is that?


$\TeX$ conversion, support for \hphantom

I'm trying to write some $\TeX$ conversion for a tensor with an upper and a lower index, but I would like the lower index to be displaced to the right by the width of the upper index. In (La)TeX I would write this as `W^I_{\hphantom{I} J}` ($W^I_{\hphantom{I} J}$). I tried to use the `Invisible` Mathematica command, which seems to be the counterpart of $\TeX$'s `\phantom`, but instead of getting a space I get the upper index repeated as a lower index. Here's the code I'm using now, which doesn't quite work:               w /: MakeBoxes[w[i_,j_],fmt_:StandardForm] := (*BUGGY*)     SubsuperscriptBox[MakeBoxes[W,fmt], RowBox[{MakeBoxes[Invisible[i],fmt], MakeBoxes[j,fmt]}], MakeBoxes[i,fmt]]      This does work in the notebook front-end, but not when converting to (La)TeX. What is the best way to achieve the result I'm after?


Printing intermediate calculations in an external file, while suppressing the output in the notebook

I'm trying to construct a text-file that contains all the operations that Mathematica performs when evaluating an expression. However, i'd like to suppress all output in the notebook in which I'm doing the calculations. For instance printing the operations for calculating the root of x^2 = 1 in Mathematica.txt is done as follows:               stream = OpenWrite["c:/Data/Mathematica.txt"];     AppendTo[$Output, stream];     Print[TracePrint[Solve[x^2 == 1, x]]];     Close[stream];     $Output = Most[$Output];      which gives the following output in my Notebook:               Solve[x^2==1,x]         Solve       x^2==1         Equal         (x^2)          Power      x     2     1      x      x^2==1     x^2==1     {{x->-1},{x->1}}     {{x->-1},{x->1}}      and the following output in Mathematica.txt                HoldForm[Solve[x^2 == 1, x]]       HoldForm[Solve]       HoldForm[x^2 == 1]        HoldForm[Equal]        HoldForm[x^2]         HoldForm[Power]         HoldForm[x]         HoldForm[2]        HoldForm[1]       HoldForm[x]       HoldForm[x^2 == 1]       HoldForm[x^2 == 1]         HoldForm[{{x -> -1}, {x -> 1}}]     {{x -> -1}, {x -> 1}}      Is there a way to _not_ get the first block of 'output'? Thanks a lot!


Adapting "Find and Replace" functionality to work with Patterns

I was thinking if there is something like Find and Replace (`Crtl`+`F`) functionality adapted to work with patterns. Probably not, but it seems possible to create this with some effort and skills in `low-level-notebook-programming`. **My question is:** if there is not such functionality bulid in, maybe someone have worked on this? Example of what I'm thinking it should be able to do:               Text["test string"]      ![enter image description here](http://i.stack.imgur.com/rdai1.png)               Style["test string", Bold]


DynamicModule with intermediate expressions

I am trying to generalize a `Manipulate` construct into a `DynamicModule` one to try and include smoother controls, but I seem to be running afoul of `Dynamic`'s compartmentalization of my intermediate variables inside what used to be a `Module`. More specifically, I used to have a construct of the form               Manipulate[      Module[{y},       y = f[x];       {x, g[y]}       ]      , {x, 0, 1}]      including (a large number of) intermediate expressions like `y=f[x]`, and which produced output like ![enter image description here](http://i.stack.imgur.com/A0kMx.png) I now want to move control of the variable `x` into the `Module` \- essentially, into a `LocatorPane` command - but I don't know what the correct translation of the code above should be. My naive attempt is to so something like               DynamicModule[{x, y},      y = f[x];      {Slider[Dynamic[x]], Dynamic[x], Dynamic[g[y]]}      ]      and this produces no errors but the output inside `g` fails to update: ![enter image description here](http://i.stack.imgur.com/nKczx.png) What is the correct generalization of the `Manipulate[Module[ ... ] ]` combination? I have tried inserting `Dynamic` commands in all possible combinations but I cannot seem to get them right. I know the answer is probably fairly basic, but I'm also a bit lost in the maze of tutorials for these commands. Obviously, simply doing `{Slider[Dynamic[x]], Dynamic[x], Dynamic[f[g[y]]]}` is not an option in my case. The intermediate calculations `f[x]` are quite a few and very verbose, and the 'displayable' function `g[y]` is actually several rather long and slow plotting commands. I need to do the central bit of the computation only once, and I do not want to repeat myself in giving it to the plotting commands. What am I missing here? It feels very basic but I can't seem to get it right.


Integrate and NIntegrate yield different results for double integral

Evaluating a double integral with bivariate normal distribution yileds widely different results depending on the method used. I define a bivariate normal distribution with {10, 3} and {8, 1.5} as mean and standard deviation for each and a correlation coefficient of 0.5.               f[x_ , y_] =        Simplify[PDF[MultinormalDistribution[{10,8}, {{9, 0.5 1.5 3}, {0.5 1.5 3, 2.25}}],          {x, y}]];     F[x_ , y_] =        Simplify[CDF[MultinormalDistribution[{10, 8}, {{9, 0.5 1.5 3}, {0.5 1.5 3, 2.25}}],          {x, y}]]     Fx[x_] = CDF[NormalDistribution[10, 3], x];      I wish to evaluate and plot a function ϕ which has the following definition :               ϕm[q_] =        (1/(1 - Fx[q]))*Integrate[Integrate[y*(x - q)*f[x, y], {x, q, 25}], {y, 2, 15}]      It can be done it in two ways. Either by using `NIntegrate` or by using the above double integral.               phim = Interpolation[ParallelTable[{q, ϕm[q]}, {q, 1, 25}]];     Plot[phim[q], {q, 2, 25}]      Using NIntegrate yields a completely different result.               ϕTs =        Table[         {n, 1/(1 - Fx[n]) NIntegrate[(x - n) y f[x, y], {x, n, 25}, {y, 2, 15}]},          {n, 1, 25, .5}];     ϕs = Interpolation[ϕTs, InterpolationOrder -> 1];     g2 = Plot[ϕs[x], {x, 1, 25}, AxesOrigin -> {0, 0}]      Why is that so?


Gram Schmidt Process for Polynomials

I want to implement the Gram Schimdt procedure to the vector space of polynomials of degree up to 5, i.e. I want to find an orthogonal basis from the set of vectors $v=(1,x,x^2,x^3,x^4,x^5)$. The inner product is defined as $$ \langle f,g\rangle=\int_{-\pi}^{\pi}f(x)g(x)dx. $$ The Gram Schimdt process is to first find $u$ such that \begin{align} &u_1=v_1\\\ &u_i=v_i -\sum_{j=1}^{i-1}\frac{\langle u_j,v_i\rangle}{\langle u_j,u_j\rangle}u_j,i\ge 1 \end{align} and then the orthogonal basis is found by letting $e_i=u_i/\|u_i\|$. I wrote the following code to find $u$, but it went to endless loop. I am an amatur in mathematica and don't know where I am wrong.               v = Function[x, Evaluate[x^#]] & /@ Range[0, 5];     u = v;     For[i = 2, i < 7, i++,       u[[i]] = Function[x,         v[[i]][x] -          Sum[Integrate[v[[i]][x]*u[[j]][x], {x, -Pi, Pi}]/            Integrate[u[[j]][x]^2, {x, -Pi, Pi}]*u[[j]][x], {j, 1, i - 1}]        ]      ]      I am reading Linear Algebra Done Right P108 and want to implement this by hand to deepen my understanding of this topic and I also want to learn more about mathematica functions. Thanks for any help.


How to find intersection of multiple lists excluding empty ones?

I have lists like               list1={1, 1, 2, 3}; list2={3, 1, 4}; list3={};      I want to find the intersection of all list. I tried the following way, but it's not working.               Intersection[Cases[{list1, list2,list3}, Except[{}]]]      I want output like this               {1, 3}       Fell free, if you want to edit my question.


Subvalue and level

I'm interested in the arguments of `f` in expressions like               f[a]@f[b]@f[c]      By argument I mean what is here `a`, `b` and `c`. I would like to know the arguments and in what order they appear. For example, the order of the arguments in                f[d]@(2 x f[b])@f[c]@f[q]      is                {d, b, c, q}      How can I find this from the above expression? I tried to use `Level[]`, but the Subvalue construction is hindering me.


Solving antisymmetric tensorial equation

Assume we have the following Tensor objects: \begin{equation} F_{i}{}^{j}\;and\;S_{ij}{}^{k}, \end{equation} where the components of $F$ are known, and we would like to solve for the components of $S$ if they satisfy the following equation \begin{equation} F^{l}{}_{i}S_{jl}{}^{k}-F^{l}{}_{j}S_{il}{}^{k}=0. \end{equation} $l$ is summed over, all the indices run from 1 to 4, and $S$ is symmetric in the lower indices. Can you please help in writing a Mathematica code for this. My attempt: First, suppose we know all the components of $F$, and they are given by \begin{equation} F= \begin{matrix} a & b & c & d\\\ e & f & g & h \\\ i & j & k & l \\\ m & n & o & p \end{matrix} \end{equation} Then I defined the components of $S$ by:               S[i_, j_, k_] := S[i, j, k]      The first term of the equation I defined it as:               SF[i_, j_, k_] := SF[i, j, k] = S[1, i, j].F[k, 1] +                                     V[2, i, j].F[k, 2] +                                      V[3, i, j].F[k, 3] +                                      V[4, i, j].F[k, 4];      As for the second term in the equation, I think it can be found using Transpose               FS[i, j, k] = Transpose[SF, {i, k}]      Then for example:               Solve[SF==FS,{S[i,j,k]},{i,4},{j,4},{k,4}]      is not working. I'm sure there is something wrong in my commands, but I can't figure out what it is. The functions $a$,$b$,$c$,... in the expression of $F$ are some complicated scalar functions of space coordinates.


How does Mathematica identify outliers?

I don't see anything in the documentation about how Mathematica identifies outliers (in a box plot for example). What definition is being used?


Enabling/disabling individual locators within a Manipulate

This post helped me out somewhat but it is missing a piece that I really need for something that I am working on that's more complex than what I've shown below. I want to disable a `Locator` when its corresponding tab is not selected, I've achieved this using the method in the link, however it is slow (not with this simple code), `ContinuousAction->False` doesn't affect it, and when I click anywhere within the plot range the `Locator` does not move there and I haven't been able to change this.               clip[pt : {x_, y_}, {xMin_, yMin_}, {xMax_, yMax_}] := {Clip[        x, {xMin, xMax}], Clip[y, {yMin, yMax}]}          Manipulate[      Switch[ctrl,       1, Show[        Graphics[{          {Thick, Line[{{-3, 0}, {point1[[1]], point1[[2]]}}]},          Locator[Dynamic[point1, (point1 = clip[#, {-3, -2}, {3, 2}]) &],            Enabled -> True]          }, PlotRange -> {{-3, 3}, {-2, 2}}]        ],       2, Show[        Graphics[{          {Thick, Red, Line[{{3, 0}, {point2[[1]], point2[[2]]}}]},          Locator[Dynamic[point2, (point2 = clip[#, {-3, -2}, {3, 2}]) &],            Enabled -> True]          },         PlotRange -> {{-3, 3}, {-2, 2}}]        ]       ],      {{ctrl, 1, ""}, {1 -> "black", 2 -> "red"}, SetterBar},      {{point1, {0, 1}}, None},      {{point2, {0, -1}}, None}]      I'm not sure if it's possible, or if there is a completely different way of going about enabling/disabling individual locators (that isn't super messy). I just want to do that and also be able to use options like `ContinuousAction->False` and be able to click anywhere within the plot range and have the locator "jump" there. What I've provided above is more or less what I learned from the other post, below is a short example of what I originally had.               Manipulate[      Switch[ctrl,       1, Show[        Graphics[{Thick, Line[{{-3, 0}, {point1[[1]], point1[[2]]}}]},          PlotRange -> {{-3, 3}, {-2, 2}}]        ],       2, Show[        Graphics[{Thick, Red, Line[{{3, 0}, {point2[[1]], point2[[2]]}}]},          PlotRange -> {{-3, 3}, {-2, 2}}]        ]       ],      {{ctrl, 1, ""}, {1 -> "black", 2 -> "red"}, SetterBar},      {{point1, {0, 1}}, Locator},      {{point2, {0, -1}}, Locator}]


Placing x-axes label below rather than at end of axes

By default Mathematica places the x-axis labels at the end of the axes like![enter image description here](http://i.stack.imgur.com/bUklD.jpg) Googling has suggested a way around this is to use `Frame`\- for example `Frame -> {True, True, False, False}, FrameLabel -> {"E/T", None}` which produces something like ![enter image description here](http://i.stack.imgur.com/nB2lv.jpg) Which is not too bad, but I do not want this vertical dividing line `x=0` and really would have preffered to keep the `y-axis` in the middle of the plot where this divider line now is. Can this be done? Is there a better way than this to move axes labels below?


permutation as product of transpositions

How can the permutation that takes`{-f, -i, i, -e}` into `{-e, -i, i, -f}` be realised as a sequence of nearest neighbour transpositions? In this case the succession could be               {{-e, i}, {-e, -i}, {-e, -f}, {-i, -f}, {i, -f}}      The transposition operation has the following peculiarity: the transposition `{-f, -i}` leaves `{-f, -i, i, -e}` unchanged since `-f` and `-i` are already in the right order. I'm interested in the (or a) shortest sequence of transpositions. Often there is more then one shortest sequence.


How to replace data in a list (tree) in a functional Mathematica way?

I have list containing 2D points in various groupings, i.e. points, lists of points (figures), lists of lists of points (patterns) and finally a list of patterns. The list also contains other data, i.e. Colors and other decorators. For (a simple!) example:               fig1 = {{0,0}, {1,0}, {0,1}}     fig2 = {{2,0}, {3,0}, {2,1}}     fig3 = {{4,0}, {5,0}, {4,1}}     li = {{fig1, Red}, {{fig2, fig3}, Blue}}      Now I would like to replace the points in the list with the result of a function applied to that point, for example a matrix multiplication. For the example we can use a simple function. `f[p:pnt2D] := 2p` or multiplication with `IdentityMatrix[2]` will do to illustrate. I am looking for a typical functional Mathematica way to attack this problem. Extract all the points from the list, apply the function and replace with the outcome. In such a way that it works for all sorts of (huge) lists. **How to replace data in a list (tree) in a typical Mathematica way, preferably using clear code?**


How to use the same colors in Epilog and Plot

How can you use the same colour to the data in `Epilog` as the data in the `ListLinePlot`? I am plotting 25 lists (4 in this question) on which I would need to mark each maximum. I would like the point marking the maximum to have the same colour as the line (if possible with a black exterior circle). ![enter image description here](http://i.stack.imgur.com/2wXtK.jpg) Is it possible?               a = {1, 3, 6, 3, 2};     b = {3, 2, 5, 6, 9};     c = {2, 7, 3, 1, 6};     d = {4, 2, 8, 8, 10};     am = {Position[a, Max[a]][[1, 1]], Max[a]}     bm = {Position[b, Max[b]][[1, 1]], Max[b]}     cm = {Position[c, Max[c]][[1, 1]], Max[c]}     dm = {Position[d, Max[d]][[1, 1]], Max[d]}     ListLinePlot[{a, b, c, d}, AxesLabel -> {"Iteraciones", "Objetivo"},       LabelStyle -> {24, Bold},       PlotStyle -> {{Thickness[0.01]}, {Thickness[0.01]}, {Thickness[          0.01]}}, Epilog -> {PointSize[0.04], Point[{am, bm, cm, dm}]}]


Can I use Map here rather than Table?

I've got something that works, but it seems like it would be "nicer" if I didn't have to use Table (or For, etc.). I've got 3 Excel files, each with multiple sheets. Each file also has a sheet called "Paste Here" that I don't want. Each sheet contains an array. I'm reading in the file names from the folder, then from each file I read in the sheet names. Now, I'd like to read the array from each sheet and store them all in a single (nested) list. I'm currently doing the following, which works fine:               Module[{pmlPath},     pmlPath = ParentDirectory[NotebookDirectory[]] <> pmlFolder;     fileNames = Select[FileNames["*.xlsm", pmlPath], StringCount[#, "~"] == 0 &];     sheetNames = DeleteCases[(Import[#, "Sheets"] & /@ fileNames), "Paste Here", {2}];     pmls = Table[Import[fileNames[[i]],             {"Sheets", sheetNames[[i, j]]}], {i,Length[fileNames]}, {j,Length[sheetNames[[i]]]}];     ];      It seems like I would have to use multiple slots to accomplish that, if it's possible, and I really don't know how to do that.


Export Graphics using Move in Optica

I am modeling an eye and am using `TurboPlot` and `DrawSystem`. I would like to export the graph, but using the `Move` function which returns a `Graphics`. When execute `Show[Graphics[%]]` I just get a graph, without the object and when I export get the following error: > >     Show::gtype: Optical System is not a type of graphic, >   And this leads me to the questions: **1)** Is there an alternative to the `Move` function, or similar to `Move`, which gives an option to `Export` a graph? **2)** Is there a function that will let me `Export` a graph even with the function `Move`?               colorscreen = CustomDeflections[Screen[0.9], Function[Ray[WaveLength -> .45]],                      AddTo -> ChangedRay];          myplot = DrawSystem[{ConeOfRays[20, NumberOfRays -> 7],         RefractiveIndex [1.5], Polarization [45],          Ray [WaveLength -> .45, AddTo -> NewRay],         Move[SphericalLens[{rr1, 5}, {rr2, -5}, 3, 0.5], {x, 5}, SaveDefinitions -> True],         Move[PinHole[0.5, 1.5], 7],         Boundary[{0, -4, -4}, {15, 4, 4}],         Move [Screen[5, " "], 15],         Move[Screen [1.5], 5], ColorView -> Long [Intensity],          Frame -> True, FrameTicks -> Automatic, SaveDefinitions -> True}];           Show[Graphics[%]]      > >     Move::pattern: The pattern HoldForm[colorscreen,1] is not recognized by > Move. >                  Export["myplot.jpg", myplot]


What is the formula Mathematica uses for ZetaZero?

What is the formula/algorithm _Mathematica_ uses for the `ZetaZero` command?


How can I randomly generate a unique, unused symbol?

In a previous question on collecting terms for a multivariable polynomial, I answered with a solution that required a unused symbol to be used for a temporary substitution and back substitution. It works and everything, but the problem is it depends on the behavior that a symbol is not defined. This is generally a bad idea because a user could have a legitimate use for the symbol we defined. It may even be in the polynomial in question. This sort of thing can also come up in other contexts, when there may be a need for a temporary symbol. I know I've needed this before and I've often had to think of something random to use. **Is there any way I can get a unique and guaranteed-never-used symbol name for these things?**


Infinite expression 1/0.^(1/4) encountered in NDSolve

I am trying to solve very simple system of coupled differential equations using the `NDSolve` function, but I am getting `"Infinite expression 1/0.^(1/4) encountered."` Any idea how to solve the problem? I was looking for solutions where people suggested to shift the `"Initial boundary point"` or by using the `Method -> {"Shooting", "StartingInitialConditions" ->.....`. Could not manage to resolve it. Thanks in advance. The code is as follows:               alphaphi = 2*10^-13;     MX = 1.15*10^-12;     Mphi = 10^13;     alphaX = 10^-2;     gstar = 200;     HubbleI = Mphi;     Mpl = 1.22*10^19;          phiI = (3/(8*Pi))*Mpl^2/Mphi^2 *HubbleI^2/Mphi^2;          T[x] = (30/(gstar*Pi^2))^(1/4)*Mphi*R[x]^(1/4)/x;     Xeq[x] = MX^3/Mphi^3 *(2*Pi)^(-3/2)*x^3*(T[x]/MX)^(3/2)*     Exp[-MX/T[x]];     c1 = Sqrt[3/(8*Pi)]*Mpl*alphaphi/Mphi;     c2 = c1*Mphi*alphaX/(MX*alphaphi);     c3 = c2*Mphi/MX;          sol = NDSolve[{D[phi[x], x] == -c1*x*phi[x]/Sqrt[phi[x]*x + R[x]],      D[R[x], x] ==       c1*x^2*phi[x]/Sqrt[phi[x]*x + R[x]] +        c2*x^-1*(X[x]^2 - Xeq[x]^2)/Sqrt[phi[x]*x + R[x]],      D[X[x], x] == -c3*x^-2*(X[x]^2 - Xeq[x]^2)/Sqrt[phi[x]*x + R[x]],      phi[1] == phiI, R[1] == 0, X[1] == 0}, {phi, R, X}, {x, 1, 10^5}];          Plot[Evaluate[{phi[x], R[x], X[x]} /. sol], {x, 1, 10^5},      PlotRange -> All]


Solving One Equation with Two Variables

I am trying to solve an equation with two variables. It is the last step in the process of using the method of undetermined coefficients to solve a nonhomogeneous differential equation. The equation is this: $$y''-5y'+6y=e^tcos(2t)+e^{2t}(3t+4)sin(t)$$ My first particular equation is $$Y(t)=e^t(Acos(2t)+Bsin(2t))$$ and I need to find A and B values that satisfy: $$y''-5y'+6y=e^tcos(2t)$$ Plugging $Y(t)$ into the equation gives: $$-2 e^t ((A+3B) cos(2 t)-(3 A + B) sin(2 t))=e^tcos(2t)$$ So A and B must satisfy: $$A+3B=-1/2$$ $$B-3A=0$$ And then A and B are easy to solve for. However, putting the equation into Solve[] gives an error:               Solve[{-2 Exp[t] ((a + 3 b) Cos[2 t] + (-3 a + b) Sin[2 t]) == Exp[t] Cos[2 t]}, {a, b}]      > Solve::svars: Equations may not give solutions for all "solve" variables. >> And the output just gives B in terms of A and t. This particular problem I can solve on paper, but others are much more complex. I need a way to solve an equation like this using Mathematica to save time. This is homework from Boyce Elementary Differential Equations 10, Section 3.5 #23. EDIT: Made variable names lower case


An issue with formulas typesetting in Grid & Column

I tried to construct a small sheet with text and equations presented in a convenient publishing form, using Column:               Column[{        Row[{"An integral:"}],        Row[{Integrate[f[x], x]}]     }] // TraditionalForm      But every time the integral sign appears in one of expressions inside the Column, Mathematica reduces its size in the output. In this particular case the output looks like ![Integral sign size is reduced in Column](http://i.stack.imgur.com/QVoY5.png) Without the Column (or Grid, which seems to have the same effect) wrapper, the integral sign looks convenient:               Row[{Integrate[f[x], x]}] // TraditionalForm      ![The integral sign has the appropriate size when it does not appear as the content of Column or Grid](http://i.stack.imgur.com/K5kXX.png) I tried to add `Pane` wrapper to the `Column` contents, and played with `ItemSize` option too, with no effect. Actually, I can't even figure out what exactly happens within the Column (or Grid) function that reduces the `\[Integral]` size. So, the question is: what causes the shrinking in Column and Grid, and is there a way to control it? I was thinking of using `GraphicsGrid` instead, but it seems look more like a hack than a proper solution—if it would help at all. Notes:   1. You can notice the same effect in a Standard Form too, it is just more clear in the Traditional output.   2. I'm using Mathematica 8 on Windows 7 Basic.


How to retroactively merge cell change history according to a merge interval

I recently noted that there is an option in the options inspector to set a merge interval for cell changes. This (I think) prevents a quick series of changes from spamming your notebook history with a bunch of times that can bloat the file size and make the history hard to inerpret. That's great moving forward, but my old heavily used notebooks already have a ton of these closely spaced change times. Is there some easy way to retroactively apply the merge interval to the notebook history? The only thing I came up with was to `grep` out the times (in `python` maybe?) and compare them, making appropriate deletions as the file is parsed. I kind of worry that letting a script tinker with the raw notebook text risks breaking things, which would be bad, since these are my most heavily used notebooks.


Running a Numerical Simulation on a System of Differential Equations with unique initial conditions

I have a system of differential equations as follows:               β*M*L^2*D[Θ[i,t],{t,2}]=M*g*μ*L*(-Sin[Θ[i,t]])+τ[Θ[i+1,t],Θ[i,t]], (*for i=1*)     β*M*L^2*D[Θ[i,t],{t,2}]=M*g*μ*L*(-Sin[Θ[i,t]])+τ[Θ[i-1,t],Θ[i,t]]+τ[Θ[i+1,t],Θ[i,t]], (*for i between 1 and n-1*)     β*M*L^2*D[Θ[i,t],{t,2}]=M*g*μ*L*(-Sin[Θ[i,t]])+τ[Θ[i-1,t],Θ[i,t]], (*for i=n*)      Basically, what the equation describes is a series of coupled oscillators from `0` to `n`, with the `i^th` oscillator being connected to the `(i-1)^th` and `(i+1)^th` ones with a spring. `τ[Θ[j],Θ[i]]` describes the torque exerted by the `j^th` oscillator on the `i^th`. **Edit** : My initial conditions for the systems are as follows.   * Initially, at time `t=0`, all the oscillators have:      * an angular position of 0, that is, `Θ[i,0]=0 for all i from 0 to n`     * and an angular velocity of 0, that is `D[Θ[i,t],{t,1}]=0 at t=0 for all i from 0 to n`   * Now, what I do next is to apply a force on the first oscillator causing it to accelerate and follow a certain path of motion over a specific initial time interval. For example, the force that I apply could cause it to complete to full rounds from time `t=0 to 20`; that is, the `Θ[0,t]=t/10*2π from t=0 to t=20`. As I apply this force, (some of) the other oscillators will move too as the first oscillator will exert a force on them through the spring which connects the oscillators.   * Finally, after time `t=20`, I no longer apply an external force on any of the oscillators and just allow it to oscillate based on the relations found in the differential equations. If you're interested to see all the function definitions and the constants, they can be found below:               (* providing values for all our variables. these variables describe one particular set of coupled oscillators *)     M=0.1;     L=0.2;     β=1;     μ=1;     k=100;     η=0.3;     γ=0.2;     α=1;     g=9.81     (* defining the torque τ. funcf and funcg are only used to make the expression for τ simpler.*)     funcg=(1-η/(2(1-Cos[#1-#2])+(γ/α)^2)^0.5)&;     funcf=#+Abs[#]&;     τ=Sin[#1-#2]*k*L^2*funcf[funcg[#1,#2]]&;      **Edit** : Since I was solving a physics question, I forgot to state that what I meant by `g` in the equations was the gravitational acceleration on earth 9.81 and nothing related to the function `g` which I was using as an intermediate function to make my expression of `τ` less complicated. I've modified this by writing the function g as `funcg`. After some work, I realized that the method suggested below of using `nodes` helped to simplify the code a great deal. Thanks, @Spawn1701D.


How to clear parts of a memoized function?

I have a function of two variables, e.g.:               f[a_, b_] := f[a, b] = something f[a - 1, b - 1] etc      With the above code I used the concept of memoization to speed up the computation. However, I have the problem that I run out of memory for large values of `a` and `b`. Since my recursion is not very deep, I would like to clear the memory from time to time; for example, I calculate `f[1000, 1000]` and then remove all values of `f[a, b]` for `a`, `b` between 1 and something close to 1000. However, I only found the `Clear`/`ClearAll` functions, which (unless I am missing something) clear everything indiscriminately. This is not what I want. Is there a built-in function that does not clear all values of `f[a, b]`, but just a specific range?


How to reject or repulse some points in a 3D cloud of particles?

I'm having an issue with a 3D distribution of points. The distribution is really nicely looking in _Mathematica_ , but it is used in an **OpenGL** astronomy program ( _Celestia_ ) to generate a nebula, with **sprites**. The problem is caused by a too high density of points at some locations in the distribution. The sprites are then adding, which turns into an ugly rendering. I need to lower the density of points at those locations **only** , and I really don't know how. I need to reject some points when the local density gets too high, or to add a short range repulsive force between the particles. Here's the code I'm currently using with _Mathematica 7.0_. That code was defined elsewhere on this forum (see Simulation of the Crab nebula)               MinRadius := 0.00; (* min radius of distribution *)     MaxRadius := 1.00; (* max radius of distribution *)     MinSprite := 0.003; (* min radius of sprites *)     MaxSprite := 0.07; (* max radius of sprites *)     Oblateness := 0.8; (* oblateness of the spherical distribution *)     NumberOfVoids := 1000;     NumberOfPoints := 20000;          SpriteSize[r_] :=       MinSprite + (MaxSprite - MinSprite)(r - MinRadius)/(MaxRadius - MinRadius);          voidpts = Select[RandomReal[{-1, 1}, {NumberOfVoids, 3}],        MinRadius <= Norm[#/{1, 1, Oblateness}] <= MaxRadius &];     pts = Select[RandomReal[{-1, 1}, {NumberOfPoints, 3}],        MinRadius <= Norm[#/{1, 1, Oblateness}] <= MaxRadius &];     nf = Nearest[voidpts];     DistributeDefinitions[nf];          pts = ParallelMap[Nest[0.9975 (# + 0.01 (# - First@nf[#])) &, #, 100] &, pts];          PlotColor = ColorData["SunsetColors"];          Graphics3D[{PointSize[0.005], {PlotColor[Norm[1.3 #]], Sphere[#, 0.005]} & /@ pts},        Boxed -> False, Background -> Black, Lighting -> "Neutral", SphericalRegion -> True]      The number of points generated at the intersection of several filaments is too large : there's too much points accumulated there, and this is a problem for rendering in _Celestia_ (too much sprites at the same location is very ugly). So is there a way to reduce or dilute these points ? I need a rejection mecanism when the local density gets higher than a certain value (depending on the local sprite size). **The shortest distance between points shouldn't be smaller than the local sprite size** (which is a function of distance to the origin). How can I add this as a constraint in the iteration process ? Take note that I'm working with _Mathematica 7.0_ only (I don't have access to newer versions), so please your suggestions must be compatible with this version.


Is there a way to teach integrate new solutions?

I have an integral which I can solve, but integrate cannot:               Integrate[ Exp[-b^2 m^2 x^2] Erf[c m (x+y)], {x, -Infinity, Infinity},        Assumptions -> b > 0 && c > 0 && m > 0 && y \[Element] Reals]      The solution is               Sqrt[Pi]/(b m) Erf[Sqrt[b^2/(b^2+c^2)] c m y]      but _Mathematica_ only returns the input (at least in version 7 which I am using). Now I have a calculation where this type of integral appears very often and I want integrate to recognize it and solve it. Using replacements does not work because it often appears in combinations that don't match the pattern directly, e.g. something like               Exp[-U1^2 m^2 - (X1^2 + X2^2) n^2)] n^2 m^3      * (Erf[(U1 + V1) n] - Erf[(U1 +V1- X1) n])(-(2/Sqrt[m^2 + n^2])      + Erfc[U1 n]/Sqrt[m^2 + n^2] + Erfc[V1 n]/Sqrt[2 m^2 + n^2])      where integration would be over `X1`, `U1` and `V1`. If I try replacements on this, _Mathematica_ does not recognize that the above pattern is hidden in this expression. Of course I can always do it by hand, but this is cumbersome. The most elegant solution would be to teach integrate how to do this, but I would also be happy with a newly defined function that recognizes the pattern and replaces it by the solution.


the more effective method to find 21 digits armstrong number

In recreational number theory, a narcissistic number (also known as a pluperfect digital invariant (PPDI), an Armstrong number(after Michael F. Armstrong) or a plus perfect number) is a number that is the sum of its own digits each raised to the power of the number of digits. For example,the three digits armstrong number: ![enter image description here](http://i.stack.imgur.com/dXNC5.jpg) Now I want to find the 21 digits armstrong number.I know the answer is {449177399146038697307, 128468643043731391252}. Better code to find Narcissistic number.In this post,they use brute force method to test all number.It is impossible to use this method to find 21digits armstrong number. My thought is just consider the count of numbers. For example, there are two 2, two 7,one 9.Since 2*2^5+2*7^5+1*9^5=92727,so {{2,2,1},{2,7,9}} is correct combination and 92727 is 5 digits armstrong number. My code is:               Clear["Global`*"]     n = 21;     counts = IntegerPartitions[n, 10];     test1 = Compile[{{counts, _Integer, 1}, {num, _Integer, 1}},          10.^(n - 1) < counts.num^(1. n) < 10.^n];     test2 = Compile[{{list, _Integer, 1}, {counts, _Integer, 1}, {num, _Integer, 1}},         Catch[          Do[If[Count[list, num[[i]]] != counts[[i]], Throw[False]], {i, Length[counts]}];               Throw[True]]];     f[counts_] := Module[{allpossible, allnum},       allpossible = Permutations@counts;       allnum = Subsets[Range[0, 9], {Length[counts]}];       Select[Join @@ Outer[List, allpossible, allnum, 1],           test1 @@ # && (test2[IntegerDigits[#1.#2^n], #1, #2] & @@ #) &]       ]     Length@counts     Monitor[#1.#2^n & @@@ Join @@ Table[f@counts[[i]], {i, %}], 1.i/%] // AbsoluteTiming      It will take about 6~10 minutes to find 21digits armstrong number.But the maximal armstrong number is 39 digits, so my code is not enough high efficiency.How can I increase of efficiency？


Deconvolution of Image3D object using ImageDeconvolve

I am trying to get the ImageDeconvolve function to work with `Image3D` objects. In the documentation of `ImageDeconvolve` it says: > ImageDeconvolve works with Image3D objects. But I can't get the function to work. I tried the following:               kernel = GaussianMatrix[{{7, 7, 7}, 2}];     Image3D@kernel // ImageAdjust      ![enter image description here](http://i.stack.imgur.com/YDMli.png)               img3d = Import["ExampleData/CTengine.tiff", "Image3D"]      ![enter image description here](http://i.stack.imgur.com/bkmCa.png)               ImageDeconvolve[img3d, GaussianMatrix[{{1, 1, 1}, 1}],       Method -> {"RichardsonLucy", "Preconditioned" -> True},       MaxIterations -> 16]      ![enter image description here](http://i.stack.imgur.com/p0MTT.png) Deconvolution seems to be applied only to the first plane. Is `ImageDeconvolve` just not working for `Image3D` or am I doing something wrong here? I also tried different algorithms, kernels and other options without success.


Plot axes invisible when projected

When I save plots made in Mathematica in PDF format and then insert them in a presentation (e.g., in Powerpoint), the plot axes are invisible in the picture created by the projector. Is there a way to impose a certain thickness to the axes?


Katz Centrality

I want to calculate the Katz Centrality of large graphs. The _Mathematica_ command to do that is KatzCentrality[g, $\alpha$] and it is also fast. However I realized that there is a mismatch between the result I get by using this command and that one I obtain by explicitly solving the system that gives me the Katz centralities $x={x_1,x_2,..,x_N}$ for each node. The Katz centrality is indeed defined as the solution of the system $x=(I-\alpha A)^{-1}\cdot \beta$, where I is the identity matrix, A the adjecency matrix, $\alpha$ is a paramter and $\beta$ is a vector, usally the unit vector, i.e. $\beta={1,1,...,1}$. Here is my code ($\alpha=0.01$, N=200):               rA = Partition[RandomChoice[{0, 0, 0, 0, 1}, 200*200], {200}];          kx1 = Inverse[IdentityMatrix[Length[rA]] - 0.01*rA].ConstantArray[1,      Length[rA]] // Sort;          kx2 = KatzCentrality[AdjacencyGraph[rA], 0.01] // Sort     In[53]:= Total[kx1 - kx2] == 0     Out[53]= False      What is the most precise method? Note that if I use this adjecency matrix (of data I'm analyzing) https://dl.dropboxusercontent.com/u/62056077/TestMatrix.m the differences are bigger. Thanks


How to select interactively datasets to plot with Manipulate

I'm using Manipulate to visualize three datasets:               Manipulate[ListPlot[WHAT -> what], {what, {dataset1, dataset2, dataset3}}]      Now with this solution I can only plot data for either dataset1, dataset2 or dataset3. What if I wanted to plot the data for BOTH dataset1 and dataset2 on the same graph? Or for all three datasets? An easy way such as checking boxes corresponding to the datasets would be nice, but I don't know how to integrate this with Manipulate.


How to identify segments of colour and compare

Imagine a wide screen image projected from more than one video projector. Each projector handles a segment of the screen. The overlapping areas are corrected for within each projector. Before adjustment, the images may differ in brightness and hue. Taking a picture of the screen showing a 'white' image, I will identify the screen with Hough line detection and correct the perspective, hopefully resulting in the image below. How do I then identify the number of segments and calculate the average of how they differ in brightness, hue and saturation? This information will then be used to adjust each projector and ultimately provide a uniform image across the whole screen. TIA Dave ![Example of screen requiring adjustment](http://i.stack.imgur.com/9BXlk.png)


NestList and Euler's method

I am new to mathematica and so just experimenting with various programming constructs. Recently have been looking at `NestList` and how I could use this to implement Euler's method.               Euler[a0_, b0_, steps0_, init0_] :=       Module[{a = a0, b = b0, steps = steps0, init = init0, t, y},       dt = (b - a)/steps;       f[{t0_, y0_}] := y0 Sin[t0];       euler[{t_, y_}] := {t + dt, y + dt f[{t, y}]};       NestList[euler, {a, init}, steps]       ]     approx = ListPlot[Euler[0, 2 \[Pi], 30, 1]]      I came up with this implementation but when I set the number of steps to > 20 the performance is very poor and the function never returns. I've tried it for a number of different functions and the results agrees with `DSolve`. Is it better to use For, Do, etc.? * * * I thought i would experiment a little more with NestList & Euler so i implemented a small example that shows how to solve a 2nd order ODE for a damped system. As noted above in this example if i set c,k,m to be an integer value vs a decimal then mathematica evaluates them differently giving very different performance characteristics.               Euler[a0_,b0_,steps0_,x0_,v0_]:=Module[{a=a0,b=b0,     steps=steps0,xinit=x0,vinit=v0},     dt= (b-a)/steps;     k=5.0;     m=2.0;     c=0.5;     f[{t_,x_,v_}]:=v;     g[{t_,x_,v_}]:= -x (k/m) -c v;      euler[{t_,x_,v_}]:={t+dt,     x+dt f[{t,x,v}],     v+dt g[{t,x,v}]};     NestList[euler,{a,xinit,vinit},steps]     ]     result =Euler[0,20,100000,1,1];     ListPlot [ {result[[All,2]],result[[All,3]]},PlotRange->All]      ![Damped Oscillations](http://i.stack.imgur.com/hPZTr.jpg)


Customizing display of partial differential equations

I am manipulating partial differential equations symbolically, and would like to get the easily readable form $\rho \frac{\partial v}{\partial t}$, leaving variables implicit. Based on suggestions from How to make traditional output for derivatives I started out with               Derivative /:        MakeBoxes[Derivative[α__][f1_][vars__Symbol], TraditionalForm] :=          Module[{bb, dd, sp},           MakeBoxes[dd, _] ^=            If[Length[{α}] == 1, "\[DifferentialD]", "∂"];           MakeBoxes[sp, _] ^= "\[ThinSpace]";           bb /: MakeBoxes[bb[x__], _] := RowBox[Map[ToBoxes[#] &, {x}]];           TemplateBox[{ToBoxes[bb[dd^Plus[α], f1]],            ToBoxes[Apply[bb,              Riffle[Map[bb[dd, #] &,              Select[({vars}^{α}), (# =!= 1 &)]], sp]]],              ToBoxes[Derivative[α][f1][vars]]}, "ShortFraction",              DisplayFunction :> (FractionBox[#1, #2] &),              InterpretationFunction :> (#3 &),              Tooltip -> Automatic]]      When functions appear outside of partial derivatives, they still appear as $v(t,x)$. Trying to fix this, I tried               supressVariable[f_Symbol] :=        f /: MakeBoxes[f[t, x], TraditionalForm] :=         InterpretationBox[ToBoxes[f], f[t, x]]     SetAttributes[supressVariable, Listable]     supressVariable[{v, ρ, p, f}];      This works fine for both               f[t, x] v[t, x] == 0 // TraditionalForm      and               ρ[t, x]*Derivative[0, 1][v][t, x] +         v[t, x]*Derivative[0, 1][ρ][t, x] +         Derivative[1, 0][ρ][t, x] == 0 // TraditionalForm      producing nicely readable equations. However, the simple               f[t, x] == 0 // TraditionalForm      gives error message > An unknown box name (ToBoxes) was sent as the BoxForm for the expression. > Check the format rules for the expression and I don't know what to do with this. Can anybody help me out?


How to solve this numerically?

May I ask what is the best way to evaluate               NSolve[{a^10 E^-a - b^10 E^-b ==         0, (362880 +             a (362880 +                a (181440 +                   a (60480 +                      a (15120 +                         a (3024 +                          a (504 +                          a (72 + a (9 + a))))))))) E^-a + (-362880 -             b (362880 +                b (181440 +                   b (60480 +                      b (15120 +                         b (3024 +                          b (504 + b (72 + b (9 + b))))))))) E^-b + 0.99 ==         0}, {a, b}]      I tried several methods but my machine refuse to produce anything. Is the computational complexity really this much?


Difference between @ and @@

I am confused by the commands `@` and `@@`. From the documentation, I learnt that `@@` is the function `Apply`. However, if I input `Cos@@5` the output is 5, while if I input `Cos@5`, I get `Cos[5]`. By this it seems that `@` rather than `@@` has the function of "apply". When I tried the function `Plus`, `Plus@@{1,2}` gave me 3 as desired, while `Plus@{1,2}` just gave me `{1,2}`. Could anyone help me with the difference (or relation) between `@` and `@@`?


Labeling SetterBar in Manipulate

This is the form of my list               list1 = {{1, 2}, {3, 4}};     list2 = {{5, 6}, {7, 8}};     list = {{list1, list2}};      I want to plot list1 and list2 in a ListPlot with Manipulate like this               Manipulate[ListPlot[list[[1,count]],PlotRange->{{0,10},All}],{count,{1,2->"Label 2"}}]      This works perfectly well. However if I want to label the SetterBar 1, too, like this               Manipulate[ListPlot[list[[1,count]],PlotRange->{{0,10},All}],{count,{1->"Label 1",2->"Label 2"}}]      There always occures the error Part::pspec: Part specification 1->Label 2 is neither a machine-sized integer nor a list of machine-sized integers. >> edit: I can't figure out how to solve this problem. I hope I posted this correctly, this is the first question I ask in this marvelous forum. Thanks for your help


Can I perform Terminology Extraction in Mathematica? More specifically, can I extract candidate terms from a corpus of text documents? The corpus is made up of different text types and formats. Mainly semi- structured data with usually only NP expressions (and sometimes just proper nouns). Also, some unstructured data. Can I preprocess this dataset in Mathematica so that I can perform the required information extraction?


PermuteSubgraph not working? (Combinatorica)

I am trying to write a code to perform the QAP partialling analysis (here's a paper to know more) but the part in which I "scramble" the graph with PermuteSubgraph does nothing, I am actually not pretty sure of how I should use this command, as the guide says almost nothing and no example could be found.. Let's say that I create a graph by writing its adjacency matrix and using the AdjacencyGraph command               Needs["Combinatorica`"]     a = {{0, 1, 0, 0, 0}, {1, 0, 1, 0, 0}, {0, 1, 0, 1, 1}, {0, 0, 1, 0,      1}, {0, 0, 1, 1, 0}};          ag = AdjacencyGraph[{1, 2, 3, 4, 5}, a, VertexLabels -> "Name"]      Problem is: according to what I found on the manual, it should be sufficient to write               PermuteSubgraph[ag, RandomSubset[Range[5]]]      to obtain some permutation of some random subgraph of my graph... But this does nothing!! Please notice that _what I would like to end with is the adjacency matrix of "each possible" permutation of the original graph_ , so if there is a way to obtain these "permuted adjacency matrices" without having to produce the graphs, that's a plus. (the quotes are because I will be dealing with really large networks, and then I may be able to take only a few of these permutations..) Thank you in advance for the help,   \- Stefano


How can I mend this broken heart?

Try to evaluate the following code:               ContourPlot3D[(x^2 + 9/4 y^2 + z^2 - 1)^3 == x^2 z^3 + 9/80 y^2 z^3,        {x, -6/5, 6/5}, {y, -6/5, 6/5}, {z, -6/5, 3/2},        Mesh -> None, Boxed -> False, AxesLabel -> {"x", "y", "z"},        PlotPoints -> 50, Axes -> False,        ContourStyle -> Directive[Red, Opacity[0.58], Specularity[Yellow, 30]],        AspectRatio -> 1.15, ViewPoint ->{-0.930, -3.137, -0.860}]      The resulted heart looks broken: ![enter image description here](http://i.stack.imgur.com/YC64r.png) Increase the `PlotPoints` value to up to `200` improves the appearance but does not solve it. What is happening?


Evaluation of notebook from chosen cell to end

There is option to evaluate the complete notebook but I wanted to know if its possible to evaluate notebook from some desired cell to end or some other desired cell following?


Defining a function with parameters as variables

I have an expression `V = (a[1] + a[2])b[1]`. How would I define a function of `a[1]`, `a[2]` and `b[1]`? I'm looking for something like this `f[a[1]_,a[2]_,b[1]_]=(a[1] + a[2])b[1]` but Mathematica isn't satisfied with that definition.


Notation package: parenthesis placement for SuperscriptBox

The question concerns the `Notation` package. I want to define notation for the function very similar to the built-in `Power[a,b]` function. I am trying to do it in the following way:               Needs["Notation`"];     Notation[ParsedBoxWrapper[SuperscriptBox["A_","B_"]]  \[DoubleLongLeftArrow] ParsedBoxWrapper[RowBox[{"MyPower", "[","A_", ",", "B_", "]"}]]]      It works fine with `MyPower[a,c]`, displaying `a^c`. However if the case of `MyPower[a+b,c]`, the result is `a+b^c`. The question is _how to make Mathematica to put parenthesis automatically, so I can get`a^c` in the first case and `(a+b)^c` in the second case_. I believe that the answer is about setting the precedence order using `TagBox` function with `SyntaxForm` argument. However, this function is rather ill- documented and I couldn't get it work. P.S. I would like to note that automatic parenthesis placement works fine for binary operations:               Needs["Notation`"];     Notation[ParsedBoxWrapper[RowBox[{"A_", " ", "plus"  , " ", "B_"}]] \[DoubleLongLeftRightArrow] ParsedBoxWrapper[RowBox[{"MyPlus", "[", RowBox[{"A_", ",", "B_"}], "]"}]]]     Notation[ParsedBoxWrapper[RowBox[{"A_", " ", "times" , " ", "B_"}]] \[DoubleLongLeftRightArrow] ParsedBoxWrapper[RowBox[{"MyMult", "[", RowBox[{"A_", ",", "B_"}], "]"}]]]     MyPlus[a, MyMult[b, c]] (* Returns a plus (b times c) *)     MyMult[MyPlus[a, b], c] (* Returns (a plus b) times c *)          Notation[ParsedBoxWrapper[RowBox[{"A_", " ", TagBox["plus", "", SyntaxForm -> "+"], " ", "B_"}]]\[DoubleLongLeftRightArrow]ParsedBoxWrapper[RowBox[{"MyPlus", "[", RowBox[{"A_", ",", "B_"}], "]"}]]]     Notation[ParsedBoxWrapper[RowBox[{"A_", " ", TagBox["times", "", SyntaxForm -> "a"], " ", "B_"}]]\[DoubleLongLeftRightArrow]ParsedBoxWrapper[RowBox[{"MyMult", "[", RowBox[{"A_", ",", "B_"}], "]"}]]]     MyPlus[a, MyMult[b, c]] (* Returns a plus b times c *)     MyMult[MyPlus[a, b], c] (* Returns (a plus b) times c *)


Slow evaluation of complicated Table

I have a system of recursive equations               x[t+1]:=f[x[t],p[t-1],a[t],a[t-1]];     p[t+1]:=g[p[t],x[t-1],a[t],a[t-1]];     a[t+1]:=h[x[t],p[t],a[t],a[t-1]];      I want to evaluate them for $t \in [0,10]$ with some initial conditions on all variables. I tried several possibilities like,               Table[{x[t+1],p[t+1],a[t+1]}, {t, 0, 10}]      or               {x[#+1],p[#+1],a[#+1]}&/@Range[0,10]      but all of them are extremely slow. The MWE of the above might be given as ` x[0] := 1; x[1] := 1; p[0] := 2; p[1] := 2; a[0] := 3; a[1] := 3; x[t_] := 2 p[t - 1] a[t - 1] - x[t - 1] a[t - 2]; p[t_] := 5 x[t - 1] a[t - 1] - p[t - 1] a[t - 2]; a[t_] := 10 x[t - 1] p[t - 1] + a[t - 1] a[t - 2];` So commands               Table[{t + 1, x[t + 1], p[t + 1], a[t + 1]}, {t, 0, 10}]      and               {# + 1, x[# + 1], p[# + 1], a[# + 1]} & /@ Range[0, 10]      generate output `{{1, 1, 2, 3}, {2, 0.00336319, -0.00719693, 0.010203}, {3, 0.0677008, -0.0172979, 0.010203}, {4, 2.38052, -0.0540507, 0.00932697}, {5, 66.8197, 11.1562, 0.00471539}, {6, -0.518014, 1.47135, 7454.52}, {7, 21936.5, -19307.7, 27.5292}, {8, -1.64589*10^8, 1.46949*10^8, -4.23523*10^9}, {9, -1.24473*10^18, 3.48536*10^18, -2.41863*10^17}, {10, -1.68596*10^36, 1.50527*10^36, -4.33833*10^37}, {11, -1.30607*10^74, 3.65712*10^74, -2.53782*10^73}}` but very slowly. I noticed that if I calculate values for $t \in [0,2]$ and then put values as initial conditions for `x[2], p[2], a[2]` manually and then redo the code for $t \in [0,3]$ and repeat, it works much much faster. Is there a way to automatize it?


extract line from position data

I got a picture like this, and what I want to do is to extract lines from the picture. ![borrenan](http://i.stack.imgur.com/mhbQl.png) what I have done now is               img = Import["http://euler.nmt.edu/mathwiki/images/e/ef/Borromean.png"]     PixelValuePositions[img, Blue, 0.5] // Point // Graphics      from which I get a list of positions of the blue curve like this: ![enter image description here](http://i.stack.imgur.com/SD23x.png) so my question is , how do I get a Line from the postion data I get above? what I want to get is not a circle function, but a list of points in good order.


ContourListPlot not evaluating all of interpolated area

I am trying to plot a contour for a matrix, but it seems not to be evaluating all the points. Here is the interpolated figure, followed by the MatrixPlot version itself. I used this colormap because otherwise it looks like the white parts are actually evaluated values, but here the white isn't in the colormap.               ListContourPlot[{{0.55, 0.62, 0.65, 0.668, 0.672, 0.67, 0.676, 0.67},      {0.56, 0.631, 0.659, 0.669, 0.673, 0.675, 0.677, 0.677},      {0.57, 0.637, 0.661, 0.671, 0.675, 0.675, 0.677, 0.677},      {0.6, 0.649, 0.665, 0.673, 0.675, 0.675, 0.677, 0.677},     {0.65, 0.669, 0.673, 0.675, 0.677, 0.677, 0.677,  0.677},      {0.71, 0.694, 0.685, 0.679, 0.677, 0.677, 0.677, 0.677},     {0.77, 0.718, 0.694, 0.683, 0.679, 0.677, 0.677, 0.677},      {0.807, 0.733, 0.7, 0.687, 0.681, 0.679, 0.677, 0.677},     {0.807, 0.7333, 0.7001, 0.68652, 0.6806, 0.67871, 0.67675, 0.67675}}, ColorFunction -> "BlueGreenYellow", PlotLegends -> Automatic, InterpolationOrder -> 2]      ![ListContourPlot](http://i.stack.imgur.com/wdvkR.png) ![ColorBar](http://i.stack.imgur.com/SENhs.png) When I plot the data using MatrixPlot I get: ![MatrixPlot](http://i.stack.imgur.com/7Lmtr.png) I have tried to change Method in ListContourPlot to different options without any sucess, but I'm not sure I understand the documentation for this.


Compute integral symbolically or numerically

I want to compute the integral of the following integrand               ((0.000245587 + 0.0000651908 I) E^(-I kx)        kx ky (kz^2 - 4 \[Pi]^2))/((kx^2 + ky^2) kz) - ((4.00033*10^-17 -          3.51178*10^-18 I) E^(-I kx) (kx^3 kz + kx ky^2 kz + kx^2 kz^2 +          4 ky^2 \[Pi]^2))/((kx^2 + ky^2) kz)      Where $k = 2 \pi$. For this I have the following code:               SetAttributes[withTransforms, HoldAll];     withTransforms[code_] :=       Block[{kx = k*Sin[a]*Cos[b],         ky = k*Sin[a]*Sin[b], kz = k*Cos[a]},        code]      And the symbolic integration:               IntoS[int_] :=       withTransforms[       Integrate[        int*k^2*Sin[a]*Cos[a], {a, 0, Pi/4}, {b, 0, 2*Pi}]]      And finally, the numerical:               IntoN[int_] :=       withTransforms[       NIntegrate[        int*k^2*Sin[a]*Cos[a], {a, 0, Pi/4}, {b, 0, 2*Pi}]]      Now, `IntoS`, the symbolic integration doesn't give a result within 5 minutes (after which I have aborted the evaluation) on my core 2 duo. I need to compute many of these integrals for a plot and if it takes several minutes already to evaluate one point that won't be very useful. Furthermore, `IntoN` throws > NIntegrate::slwcon: Numerical integration converging too slowly; suspect one > of the following: singularity, value of the integration is 0, highly > oscillatory integrand, or WorkingPrecision too small. at me. How do I integrate this function? **Edit** Scaling coefficients does not really work. I always get that some coefficients are quite large and others very small. This way, the integration never works. I can delete the "small" terms manually but that it not really automatic. **Edit 2:** Mathematica is unable to compute the following integral numerically:               (E^(I kx) kx ky (-1 + kz^2))/(Sqrt[2] (kx^2 + ky^2) kz)      Symbolically this integral is $0$. However, I do need the numerical computation as the symbolic computation can take quite long and I need to plot the end-result. This is a special case of the term               (E^(I (kx x + ky y + kz z)) kx ky (-1 + kz^2))/(Sqrt[2] (kx^2 +         ky^2) kz)      And I want to plot in $x$ (with $y, z = 0$ for example) and this integral is sometimes impossible to compute symbolically. **Edit 3:** I have "fixed" it by writing my own numerical method:               Trapezoidal2D[f_, {x_, a0_, b0_}, {y_, c0_, d0_}, m0_] :=            Module[{h = (b0 - a0)/m0, k = (d0 - c0)/m0, a = N[a0], b = N[b0],          c = N[c0], d = N[d0], i, j, m = m0, X, Y},        Subscript[X, k_] = a + i h;        Subscript[Y, j_] = c + j k;        Return[         1/4 h k (Function[{x, y}, f][a, c] + Function[{x, y}, f][b, d] +             Function[{x, y}, f][a, d] + Function[{x, y}, f][b, d] +             2 Sum[Function[{x, y}, f][Subscript[X, i], c], {i, 1,                m - 1}] +             2 Sum[Function[{x, y}, f][Subscript[X, i], d], {i, 1,                m - 1}] +             2 Sum[Function[{x, y}, f][a, Subscript[Y, j]], {j, 1,                m - 1}] +             2 Sum[Function[{x, y}, f][b, Subscript[Y, j]], {j, 1,                m - 1}] +             4 Sum[Function[{x, y}, f][Subscript[X, i], Subscript[Y,                j]], {i, 1, m - 1}, {j, 1, m - 1}])];];


How can I get Mathematica to solve an equation with multiple variables?

How can I get mathematica to solve the non-homogeneous differential equation with undetermined coefficients listed below? Solve $\ y''(t)+3y'(t) = 2t^4 $, using: $\ y_p(t) = t(A_0t^4+A_1t^3+A_2t^2+A_3t+A_4) $ where $\ y_p(t) $ is a particular solution incidentally, $\ y'(t) = A_4 + 2 A_3 t + 3 A_2 t^2 + 4 A_1 t^3 + 5 A_0 t^4 $ and $\ y''(t) = 2 A_3 + 6 A_2 t + 12 A_1 t^2 + 20 A_0 t^3 $ I'd like a solution that doesn't use `DSolve` because I can already solve the entire differential equation with that. I just need to see this particular part for verification of my work. Any suggestions?


How to handle keyboard events for unselected item in CDF?

How can I force the keyboard input to work for this cell without clicking on it after I evaluate or showing a blinking selection cursor? This is for running CDF games in a browser.               pos = {0, 0};     Manipulate[      EventHandler[       Framed@Graphics[{Disk[Dynamic[pos], 0.2]},          PlotRange -> 2], {"LeftArrowKeyDown" :> (pos -= {.1, 0}),         "RightArrowKeyDown" :> (pos += {.1, 0})}], SaveDefinitions -> True,       Paneled -> False, AppearanceElements -> None]


Document Creation: inserting a grid

This question is strongly related to: NotebookWrite Cell with Grid Let’s create sample chart               mydata = {{"Noise Density \n(\[Mu]g/\!\(\*SuperscriptBox[\(Hz\), \     \(0.5\)]\))", "Mean", "StDev", "Min", "Q1", "Median", "Q3",      "Max"}, {"X ", 5., 4., 21., 26., 29., 33., 35.}, {"Y ", 25., 5.,      18., 20., 25., 29., 34.}, {"Z ", 39., 4., 30., 38., 39., 40.,      47.}};               myChart =        Grid[mydata     , BaseStyle -> {FontFamily -> "Helvetica Neue"     , FontTracking -> "SemiCondensed", FontWeight -> “Thin”, FontSize -> 10}     , Frame -> True     , Dividers -> {{True, True}, {True, True}}     , Spacings -> {2, 1}     , Alignment -> {{Center, Left}, Right}     , Background -> {{1 -> LightGray}}]      The chart renders OK on evaluation: ![sample chart](http://i.stack.imgur.com/6nZ2h.png) However, when I try to write the chart to a new document:               CreateDocument[ ExpressionCell@myChart]      It inserts it as follows: ![Probelmatic chart](http://i.stack.imgur.com/aeOcY.png) **What is the correct method of writing a grid to a document?**


Is there a way to convert InlineCell to InputForm once and for all?

After asking a question about making InlineCell similar to Input, I realized that by typing `Shift`+`Ctrl`+`I` I really can manually convert every InlineCell to InputForm. So my new question is: Is there a way to make this conversion once and for all? Or is there a way to automate this conversion for all InlineCells? (maybe programmatically?)


What method does NDSolve use for solving PDEs?

What is `NDSolve`'s mode of operation? I use it to solve partial differential equations and never gave it too much thought. Recently, I came across this question. Accordingly, I used `Trace[...]` and realized that my 4th order, non linear partial differential equation was solved using an `LSODA` method. Further digging revealed that `LSODA` is a method for ORDINARY DIFF EQS which chooses between `Adams` and `BDF` methods to solve the problem. So... how in the first place did `NDSolve` convert my **PDE** to an **ODE**? Any references would be useful.


Skip other If conditions

I'm trying to write a code to "random" move in a matrix but it can't go to a certain position if it has a certain value (in this case I'm using the number 2). How do I make it to skip all other If conditions if one of them is found True? Another thing, is it possible to store the RandomChoise in a variable to be used later? Thank you               If[And[matrix[[i+1,j]]!=2,matrix[[i-1,j]]!=2,matrix[[i,j+1]]!=2,matrix[[i,j-1]]!=2], RandomChoice[{up,down,right,left}]]          If[And[matrix[[i+1,j]]!=2,matrix[[i-1,j]]!=2,matrix[[i,j+1]]=2,matrix[[i,j-1]]!=2], RandomChoice[{up,down,left}]]          If[And[matrix[[i+1,j]]!=2,matrix[[i-1,j]]!=2,matrix[[i,j+1]]!=2,matrix[[i,j-1]]=2], RandomChoice[{up,down,right}]]          If[And[matrix[[i+1,j]]!=2,matrix[[i-1,j]]=2,matrix[[i,j+1]]!=2,matrix[[i,j-1]]!=2], RandomChoice[{down,right,left}]]          If[And[matrix[[i+1,j]]=2,matrix[[i-1,j]]!=2,matrix[[i,j+1]]!=2,matrix[[i,j-1]]!=2], RandomChoice[{up,right,left}]]          If[And[matrix[[i+1,j]]=2,matrix[[i-1,j]]=2,matrix[[i,j+1]]!=2,matrix[[i,j-1]]!=2], RandomChoice[{right,left}]]          If[And[matrix[[i+1,j]]!=2,matrix[[i-1,j]]=2,matrix[[i,j+1]]!=2,matrix[[i,j-1]]=2], RandomChoice[{down,right}]]          If[And[matrix[[i+1,j]]!=2,matrix[[i-1,j]]=2,matrix[[i,j+1]]=2,matrix[[i,j-1]]!=2], RandomChoice[{down,left}]]          If[And[matrix[[i+1,j]]=2,matrix[[i-1,j]]!=2,matrix[[i,j+1]]!=2,matrix[[i,j-1]]=2], RandomChoice[{up,right}]]          If[And[matrix[[i+1,j]]=2,matrix[[i-1,j]]!=2,matrix[[i,j+1]]=2,matrix[[i,j-1]]!=2], RandomChoice[{up,left}]]          If[And[matrix[[i+1,j]]!=2,matrix[[i-1,j]]!=2,matrix[[i,j+1]]=2,matrix[[i,j-1]]=2], RandomChoice[{up,down}]]          If[And[matrix[[i+1,j]]=2,matrix[[i-1,j]]=2,matrix[[i,j+1]]!=2,matrix[[i,j-1]]=2], RandomChoice[{right}]]          If[And[matrix[[i+1,j]]=2,matrix[[i-1,j]]=2,matrix[[i,j+1]]=2,matrix[[i,j-1]]!=2], RandomChoice[{left}]]          If[And[matrix[[i+1,j]]!=2,matrix[[i-1,j]]=2,matrix[[i,j+1]]=2,matrix[[i,j-1]]=2], RandomChoice[{down}]]          If[And[matrix[[i+1,j]]=2,matrix[[i-1,j]]!=2,matrix[[i,j+1]]=2,matrix[[i,j-1]]=2], RandomChoice[{up}]]


Get value only from Position

If have the following command               Position[{a, b, a, a, b, c, b}, b]          (* Out[1]= {{2}, {5}, {7}} *)      Is it possible to get only a sequence of values instead of this list, like               Out[2]= 2, 5, 7      I'm interested in the values only and don't need the list structure.


How to change BarChart labels font?

The question seems trivial, but no sign of such thing in reference. Also TicksStyle does not work for labels. Thanks, Regards


How to change the format of FrameTicks

Here is a plot with the default frame ticks               S1 = Plot[Sin[x], {x, -7, 7}, Frame -> True, Axes -> False]      ![enter image description here](http://i.stack.imgur.com/Ejz2e.png) Now, if I define myself the range as well as the step separation of the left frame ticks by               S2 = Plot[Sin[x], {x, -7, 7},        Frame -> True,        FrameTicks -> {{Range[-1, 1, 0.2], Automatic}, {Automatic, Automatic}},        Axes -> False]      I get the following output ![enter image description here](http://i.stack.imgur.com/OVoxs.png) Well, there are two obvious issues. First of all, 0 should be not be shown in CPU accuracy. Moreover, all ticks should have the same number of decimal digits so, -1. should be -1.0, 1. should be 1.0 and 0 should be 0.0. How can I get this?


Evaluating the integral of $\cos (\theta )\cos\left[\tan ^{-1}\left(\frac{a^2 \tan (\phi )}{b^2}\right)\right]$

I am trying to evalute the following integral:               Integrate[Cos[θ] Cos[ArcTan[a^2/b^2 Tan[φ]]], {φ, 0, 2π}]      **I know that for $a=b$ I should get 0 out of the integral since I would be integrating something of the form $A \cos \phi d\phi$ completely around a circle.** The issue is that the answer for the equation above is: $\frac{4 b^2 \cos (\theta ) \cos ^{-1}\left(\frac{a^2}{b^2}\right)}{\sqrt{b^4-a^4}}$ Which, if I take the limit $a=b$ like this:               Limit[(4 b^2 ArcCos[a^2/b^2] Cos[θ])/Sqrt[-a^4 + b^4], b -> a]      Results in $4 \cos \theta$ which is typically not 0. It seems like the $\arctan$-$\tan$ combination is messing things up, but I am not sure. Can anybody explain why this happens and how I can get to the correct solution? [EDIT] I am already assuming $a>0$, $b>0$ and both $a$ and $b$ to be real. [EDIT 2] I only just fully understood what the comment of @b.gatessucks implies: I need to divide the integral in pieces and take care to shift the phase of $\tan$ appropriately. [EDIT 3] Physically the meaning of the argument of the $\cos$ looks like this: ![ellipse with annotation](http://i.stack.imgur.com/QRd2d.jpg) Where $\tan \psi = \frac{a^2}{b^2} \tan\phi$. So I know that $\psi$ should run from 0 to 360 deg


Is it possible to export an Animate and Plot in a grid together?

I have a code that produces an Animate graphic and two Plots in a Grid. I am able to export the Animate graphic using .avi, but do not know how or if its possible to export these together in one file. I have tried using               Export["animate1.avi",Grid[a1,a2]]      as it was the only thing I could think of that might work, but it didn't. Also looked through the documentation and StackExchange boards and couldn't find anything... Is this possible to do? And, if so, how is it done?


Only perform a symbolic differentiation once

I want to define a function that involves a differentiation step that _Mathematica_ can do easily, which might be of the form               f[a_,b_,z_,j_]:=D[Hypergeometric1F1[a, b, z^2], {z, 2 j}]      (This will not work when given numeric `z`, but that is only a small part of the problem.) I will be using this for a limited set of `j`'s quite intensively in `z`. It is therefore important to me that the symbolic differentiation only take place once, so that _Mathematica_ is not repeatedly trying to do the same symbolic manipulations when running over a plot or a numerical integration. What is the cleanest/most elegant way to do this?


How to plot data with error bars on a log scale in Mathematica 9?

I have data in the form                d={{x1,y1,dy1},{x2,y2,dy2},..{xn,yn,dyn}};       so the error bars are different for each coordinate pair. I want to plot on a logarithmic x-scale. Since I use Mathematica 9 the old library from Mathematica 6 with Errorlogplot does not seem to work. Kind regards Benjamin


Solving Rotational Equations of Motion

I'm trying to integrate the rotational equations of motion               jTime = 1.0;     jMass = {{2.6666, 0, 0}, {0, 2.6666, 0}, {0, 0, 2.6666}};     jForce = (time^2*{-1.0, 4.0, -10.0}) + {2.0, -4.0, 10.0}     jAccel = jForce . Inverse[jMass]     jVel0 = {1, 1, 1};     jOri0 = {1, 0, 0, 0}     solOri =        NDSolve[{         jOri''[time] == jAccel,          jOri'[0] == 0.5*Join[{0}, jVel0]*jOri0,          jOri[0] == jOri0},jOri,          {time, 0, jTime}]      But I get the error > NDSolve::ndincd: "Initial conditions for derivatives of the function > jOri[time] do not have consistent dimensions." Well, this makes sense. The angular acceleration and velocity are 3D vectors while the orientation is a quaternion. Its also a little tricky to go between an angular velocity and an orientation, so we can't expect _Mathematica_ to work that out by itself. My question is how to explain this to _Mathematica_? EDIT: I tried doing everything as Euler angles               jForce = Cross[{1.0, 0.0, 0.0}, {0.0, -0.5*[Pi], 0.0}]     jRot = RotationMatrix[Pi - jOri[time][[3]], {0, 0,    1}].RotationMatrix[jOri[time][[2]], {1, 0, 0}].RotationMatrix[Pi - jOri[time]   [[1]], {0, 0, 1}]     jAccel = jForce. Inverse[Transpose[jRot].jMass.jRot]     jOri0 = {0, 0, 0}     solOri = NDSolve[{jOri''[time] == jAccel, jOri'[0] == jVel0, jOri[0] == jOri0}, jOri, {time, 0, jTime}]      This was OK until I tried rotating the inertia tensor into the current frame. Now I have an error saying jOri[time][[2]] doesn't exist. This seems contrary to all my initial conditions being 3 vectors


How to automate x[i]→x_{i}?

I have several Mathematica expressions in which subscripts are expressed with square brackets. E.g. `x[12]` is meant to represent _x_ 12, etc. If I evaluate `TeXForm` on such an expression, `x[12]`, e.g., gets converted to `x(12)`. Is there a way to get it to produce the `x_{12}` form instead?


Confused behavior using Dispatch to sort one list relative to another

I have a need to sort the entries of one list into the same sequence as the entries in a reference list. Because I have rather large lists involving strings, I'm trying to use Dispatch to accomplish this quickly. Here is code that works correctly to provide an example of what I am doing:               list1={"q", "r", "p"}; (*reference list*)     list2={"r", "q", "p"}; (* needs sorted into same order as list1*)          list1rules=Thread[list1 -> Range[Length[list1]]]     listdispatch=Dispatch[list1rules]          updatedpositions=list2 /. listdispatch     list2[[updatedpositions]]          Out[2]= {"q" -> 1, "r" -> 2, "p" -> 3}          Out[3]= {"q" -> 1, "r" -> 2, "p" -> 3}          Out[4]= {2, 1, 3}          Out[5]= {"q", "r", "p"}      This code works as expected and allows me to extract the elements of list2 in the same order as list 1. My problem comes in when the strings are more complicated ... the behavior of the above seems to change. Here is an example of toy code that does not work as expected.               reflist={"AFFX-BioB-5_at", "AFFX-BioB-M_at",         "AFFX-BioB-3_at", "AFFX-BioC-5_at", "AFFX-BioC-3_at",         "AFFX-BioDn-5_at", "AFFX-BioDn-3_at", "AFFX-CreX-5_at",         "AFFX-CreX-3_at", "AFFX-DapX-5_at", "AFFX-DapX-M_at",         "AFFX-DapX-3_at", "AFFX-LysX-5_at", "AFFX-LysX-M_at",         "AFFX-LysX-3_at", "AFFX-PheX-5_at", "AFFX-PheX-M_at",         "AFFX-PheX-3_at", "AFFX-ThrX-5_at",         "AFFX-ThrX-M_at"}; (* reference list to be sorted against *)          seclist=RotateLeft[reflist, 4] (* list that should be sorted according to reflist *)     rules=Thread[reflist -> Range[Length[reflist]]]          dispatchthis=Dispatch[rules];     newpositions=seclist /. dispatchthis          seclist[[newpositions]]               Out[7]= {"AFFX-BioC-3_at", "AFFX-BioDn-5_at", "AFFX-BioDn-3_at", \     "AFFX-CreX-5_at", "AFFX-CreX-3_at", "AFFX-DapX-5_at", \     "AFFX-DapX-M_at", "AFFX-DapX-3_at", "AFFX-LysX-5_at", \     "AFFX-LysX-M_at", "AFFX-LysX-3_at", "AFFX-PheX-5_at", \     "AFFX-PheX-M_at", "AFFX-PheX-3_at", "AFFX-ThrX-5_at", \     "AFFX-ThrX-M_at", "AFFX-BioB-5_at", "AFFX-BioB-M_at", \     "AFFX-BioB-3_at", "AFFX-BioC-5_at"}          Out[8]= {"AFFX-BioB-5_at" -> 1, "AFFX-BioB-M_at" -> 2,       "AFFX-BioB-3_at" -> 3, "AFFX-BioC-5_at" -> 4, "AFFX-BioC-3_at" -> 5,       "AFFX-BioDn-5_at" -> 6, "AFFX-BioDn-3_at" -> 7,       "AFFX-CreX-5_at" -> 8, "AFFX-CreX-3_at" -> 9, "AFFX-DapX-5_at" -> 10,       "AFFX-DapX-M_at" -> 11, "AFFX-DapX-3_at" -> 12,       "AFFX-LysX-5_at" -> 13, "AFFX-LysX-M_at" -> 14,       "AFFX-LysX-3_at" -> 15, "AFFX-PheX-5_at" -> 16,       "AFFX-PheX-M_at" -> 17, "AFFX-PheX-3_at" -> 18,       "AFFX-ThrX-5_at" -> 19, "AFFX-ThrX-M_at" -> 20}          Out[10]= {5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, \     1, 2, 3, 4}          Out[11]= {"AFFX-CreX-3_at", "AFFX-DapX-5_at", "AFFX-DapX-M_at", \     "AFFX-DapX-3_at", "AFFX-LysX-5_at", "AFFX-LysX-M_at", \     "AFFX-LysX-3_at", "AFFX-PheX-5_at", "AFFX-PheX-M_at", \     "AFFX-PheX-3_at", "AFFX-ThrX-5_at", "AFFX-ThrX-M_at", \     "AFFX-BioB-5_at", "AFFX-BioB-M_at", "AFFX-BioB-3_at", \     "AFFX-BioC-5_at", "AFFX-BioC-3_at", "AFFX-BioDn-5_at", \     "AFFX-BioDn-3_at", "AFFX-CreX-5_at"}      You'll notice that the newpositions list does not contain the proper coordinates to rearrange seclist into the same sequence as the first. I am at a loss to understand this behavior, when the first code example works. Any thoughts? Thank you.


Using FindFit to fit $a\,b^t$: how to avoid introducing complex numbers?

I'd like to find a model $f(t)=a\,b^t$ which matches the following data               data = {{0.0, 100.0}, {0.02, 81.87}, {0.04, 67.03}, {0.06, 54.88},             {0.08, 44.93}, {0.10, 36.76}};      I tried this:               FindFit[data, a*b^t, {a, b}, t]      But that results in an error:               FindFit::nrlnum: The function value {-4.38571+0. I,<<4>>,136.386+<<1>>} is not          a list of real numbers with dimensions {6} at {a,b} = {95.6143,-626.386}. >>      The answer to the problem is $a \approx 100.01244$ and $b \approx 0.000045146$. Is there a way to use `FindFit[]` to get the correct answer? Should I be using some other function? This is from problem 3.4.85 in Calculus/Stewart 6E stated as follows: > The flash unit on a camera operates by storing charge on a capacitor and > releasing it suddenly when the flash is set of f. The following data > describe the charge remaining on the capacitor (measured in microcoulombs, > µC) at time (measured in seconds): > > ... > > Use a graphing calculator or computer to find an exponential model for the > charge.


Concatenate strings from different levels of list

After a lot of trouble I've finally come pretty close to what I want to do. I now have a list that looks like this:               {"turen", {{"as", {{"lä", {}}}}, {"al", {{"säd", {}}, {"jäs", {}}}}, {"aj", {{"lä", {}}, {"säl", {}}, {"säd", {}}, {"läs", {}}}}, {"sa", {{"lä", {}}}},        {"la", {{"säd", {}}, {"jäs", {}}}}, {"lä", {{"as", {}}, {"aj", {}}, {"sa", {}}, {"ja", {}}}}, {"ja", {{"lä", {}}, {"säl", {}}, {"säd", {}}, {"läs", {}}}},        {"sal", {}}, {"säl", {{"aj", {}}, {"ja", {}}}}, {"säd", {{"al", {}}, {"aj", {}}, {"la", {}}, {"ja", {}}}}, {"läs", {{"aj", {}}, {"ja", {}}}},        {"dal", {{"jäs", {}}}}, {"jäs", {{"al", {}}, {"la", {}}, {"dal", {}}}}, {"sälj", {}}, {"själ", {}}, {"läsa", {}}, {"ädla", {}}, {"dals", {}}, {"jäsa", {}},        {"sälja", {}}, {"ädlas", {}}}}      Now the last thing I need to do is pick out all strings on the fourth level and concatenate them with their ancestors. There aren't any fourth level elements in my example list because those lists are huge. But imagine there is. If I know how to do it for two levels I can probably do it for three or four as well. For example, if I concatenate up to the second level I should get a list that starts like               {"turen as lä","turen al säd" ...}


Calling IronPython code from Mathematica

I'd like to call some IronPython code from Mathematica using .NET/Link. The problem is that the code lives in .py files, yet from Mathematica I can only load .NET assemblies which are DLLs. So it looks like I will have to first load the IronPython .NET assembly, instantiate an IronPython language hosting environment, load the .py file into that and only then I'll be able to call the Python code. Has anybody done such a thing?


Finding maximum value with position from Table of values

I have this table of values, how do I find the maximum value? i.e. find $z_{max}(x,y)$               tt1 = Table[Solve[z^2 == x^2 y - z, z, Method -> Reduce], {x, 0, 5, 1}, {y, 0,          5, 1}]       By visual inspection, clearly max $z$ occurs at the most bottom right element in matrix, $z = \frac{1}{2}(-1 + \sqrt{501}) $ How do I get _Mathematica_ to read out the position and value of maximum z? I tried using:               Max[tt1]      but it didn't work..


Plot CSV-data; make statistical statements in Mathematica / WA

First, I'm quite new to Mathematica so sorry in advance if some questions seem to be trivial. I have a CSV-file which looks like this:               "perc","l1","l2","diff"     0.005,116,148,32     0.005,352,30,322     0.005,249,49,200     0.005,23,336,313     0.0051,130,89,41     0.0051,363,46,317     .     .     .      _perc_ is a percentage between 0…1; _l1_ and _l2_ are numbers, _diff_ is the difference between _l1_ and _l2_. Those are the first lines; the full set is ~150.000 lines long; with _perc_ from 0 to 1. I want to plot those data and WolframAlpha (and even GoogleDocs) do a good job here and I get a result like this (actually, this is not entirely correct; _perc_ should be plotted on **X** , _l1_ , _l2_ and _diff_ on **Y** ; I hope you know what I mean. ![](http://i.stack.imgur.com/F3I48.png) ![](http://i.stack.imgur.com/Ju35l.png) This, however, only works if my CSV is less than ~4000 rows. If it's bigger, WA fails and "does not know how to interpret the data"; same for Google Docs. So, I want to redo this in Mathematica, but I don't know how / it doesn't work. First, I import my CSV: `data = Import["data.csv", "Table", "HeaderLines" -> 1]` But then I fail with `ListPlot` because I don't know what options it needs to plot the data correspondingly to WA.


Truncate TreeForm to show only the top

For some expressions, `TreeForm` may grow very long. I'm only interested in the top levels of the expression. How can I get the tree form of only the first levels an expression? For example: how to get the first levels of this expression in tree form?               Nest[1/(1 + #) (1 - #) &, w, 5]      ![TreeLevel of the above expression](http://i.stack.imgur.com/1SpTG.jpg)


Export data to Excel with adjusted column size

I'm trying to export some data with formats into Excel. It works ok, but the columns size get not properly adjusted. I don't want to use some complicated solution based on this example. In my tests, I tried a code like that:               data = {{"Column 1", "Column 2"}, {1, 4}, {2, 5}, {3, 6}};     data[[1]] = Style[#, Bold, Red, FontSize -> 15] & /@ data[[1]]     Export["data.xlsx", data, "FormattedData"]      I get this result: ![enter image description here](http://i.stack.imgur.com/yvLJg.png) And I need something like this: ![enter image description here](http://i.stack.imgur.com/ZQ7Do.png) Some clue?


How can I fill-in this Pentagram?

This is my code:               Graphics[{EdgeForm[Yellow], Yellow, Polygon[Table[{Cos[t], Sin[t]}, {t, 0, 4 π, (4 π)/5}]]}]      which gives this: ![](http://i.stack.imgur.com/49EMD.png) but I want to get: ![enter image description here](http://i.stack.imgur.com/76wFB.jpg) How?


List all financial Assets data conditionally

I would like to get all the Financial Data that Mathematica respecting those constraints : The assets for which there are at least 20 years of daily price quotations. Or that have s price for each day the market has been open for at least 20 years. or The assets that have prices time resolution of 15 min available for at least 1 year. That is I wil have 4 Price in each hour that the market has been open for at least 1 year. Is it possible?


DiracDelta attributes

Is there any reason why `DiracDelta` isn't a `NumericFunction` but `DiracComb` is? I just ate a bug because of that inconsistency


Behavior of ImportString in Mathematica

I tried the following commands               ImportString[       "129,160,16,4       130,160,16,4", "Data"] // FullForm     (* Out= List[List["129,160,16,4"],List["130,160,16,4"]] *)          ImportString[       "129,160,16,4       130,160,16,4       131,160,16,4       132,160,16,4", "Data"] // FullForm          (* Out= List[List[129,160,16,4],List[130,160,16,4],List[131,160,16,4],List[132,160,16,4]] *)      Note that in the first case, the output is a list of strings, whereas in the second case the output is a list of list of numbers.   * Why is this so ?   * Can I force the first case to return integers as in the second case?


How to set different labelstyles for controls in manipulate?

Background:                Manipulate[       {jj, kk},       {{jj, 2, "Select j"}, 1, 11},       {{kk, 2, "Select k"}, 1, 11},       LabelStyle -> {Bold, Medium}      ]      In the example above the fonts of the labels "Select j" and "Select k" are, as expected, set to bold and medium size. **Question: Is there a way to set the labelstyle for each variable individually?**


Change elements on different positions within a list

How can I change the elements of a list, say on positions `{{1, 4}, {3, 1}, {2, 3}, {4, 4}}` in one go? Take this list for example:               In:= (m = Array[RandomInteger[9] &, {4, 4}]) // TableForm          Out= 0  6   2   8          3  8   8   0          3  7   4   1          4  8   2   4      This is how I want to the elements on the specified positions to change.               m[[1, 4]] = Style[m[[1, 4]], 14, Bold, Blue];          m // TableForm      ![Mathematica graphics](http://i.stack.imgur.com/nuly6.png) The result is that the 8 in the last element of the first row is now blue and bold (and bigger to stand out).


How to find an approximate solution in a region when Solve or NSolve does not work?

Consider the relation               x/Tan[Pi x] == y/Tan[Pi y]      `Solve` or `NSolve` can't give a solution for it. But if you choose a particular region say $1.3 \leq x \leq 1.9$ and $.1 \leq y \leq .7$, there can be an approximate solution of the form $y=f(x)$. One way to get that would be to use `ContourPlot`, extract the data and then use `Interpolate`.               c = ContourPlot[x/Tan[Pi x] == y/Tan[Pi y], {x, 1.3, 1.9}, {y, 0.1, 0.7}];     pts = First@Cases[Normal[c], Line[i__] -> i, Infinity];     f = Interpolation[pts];      Is there any other way to get an approximate solution ($y=f(x)$) in a given region for a given relation? Regarding this, I would be interested to know how `ContourPlot` works. Does it use any kind of root finding method to find all the points satisfy the relation and plot them? It that case will it be possible to use the same method to find an approximate solution as well?


Highlighting individual countries on a world map

Consider the following list of countries which I would like to highlight on a world map:               MyCountries={"Germany","Hungary","Mexico","Austria","Bosnia","Turkey","SouthKorea","China"};      From the documentation center (Country Data > Applications > Application 5), I know that               Graphics[{If[CountryData[#, "AntarcticNations"], Orange, LightBrown],          CountryData[#, "SchematicPolygon"]} & /@ CountryData[]]      works for all antarctic nations. I replaced `"AntarcticNations"` by `MyCountries` but it does not seem to work.


How to create this list more elegantly

There is list containing some $(i,j)$ values of indices. Now i want to create a matrix of dimension n $\times$ m whose entries are 1 for the indices corresponding to the given list otherwise its zero. For e.g if the list is as given below               list = {{1, 1}, {1, 2}, {2, 1}, {3, 3}};      And if $n=m=3$ then the output should be                {{1, 1, 0}, {1, 0, 0}, {0, 0, 1}}      I was able to do this as shown below but i believe this could be achieved with a shorter and a more elegant code. Maybe a one liner.                     cHeck[n1_, n2_] := Module[{flag = 0, list, i},                              list = {{1, 1}, {1, 2}, {2, 1}, {3, 3}};                              For[i = 1, i <= Length[list], i++,                                Which[{n1, n2} === list[[i]], flag = 1]                                  ];                             flag                                 ]      A[n_, m_] := Table[cHeck[i, j], {i, 1, n}, {j, 1, m}]           A[3, 3]       (*{{1, 1, 0}, {1, 0, 0}, {0, 0, 1}}*)


Background color of Code cell lost when convert a notebook file to pdf

Well, I have a notebook with the built-in stylesheet Preprint, which I'd like to convert it to pdf. Everything works well except for the code cells(I use the shortcut key alt+8 to create cells of code style) with gray background. the code cell in the notebook looks like this: ![enter image description here](http://i.stack.imgur.com/h1H5T.png) But, after saving my entire notebook to pdf, the gray background lost! This is a screen-shot of the same code cell above from my pdf viewer. ![enter image description here](http://i.stack.imgur.com/IeDyV.png) So, is there anyway to make the "code cell" in the exported pdf looks exactly the same as it is in the notebook? I mean, It should have gray background. Or am I missing something? Thank you.


manipulate a social networking

Clear["Global`*"];     Block[{source, target, weight},      source = {"aaa", "aaa", "BBB", "ccc", "ddd", "aaa", "aaa", "aaa",        "aaa", "aaa"};      target = {"ddd", "eee", "aaa", "aaa", "aaa", "fff", "ggg", "hhh",        "iii", "jjj"};      weight = {4.8, 4.4, 4.2, 4.1, 3.6, 3.3, 3.2, 3, 2.7, 2.6};      tree = Thread[source -> target];      weight = Rescale[weight, {Min[weight], Max[weight]}, {1, 4}];      Graph[Table[        Style[tree[[i]], AbsoluteThickness[weight[[i]]]], {i, 1,         Length[tree]}],       EdgeShapeFunction ->        GraphElementData[{"CarvedArrow", "ArrowSize" -> 0.01}],       VertexSize -> 0.1, ImageSize -> 500]      I want to draw the lines frome source[[i]] to target[[i]]. The thickness of lines ajusts according to weight[[i]]. The above codes have accomplished my basic needs. But now how to manipulate j to show the corresponding lines from source[[i]] to target[[i]] with vertex labels of target[[i]] with the vertex labels of target[[i]] only when j


Unexpected results from NDSolve

I am trying to solve a stiff reaction diffusion system with `NDSolve`. However, it does not produce the expected results. My problem is a spherical cell with 5 different species, of which only one can flow across the cell membrane. Initially the cell contains nothing of species 4 and 5 (only #5 can cross the membrane), and the idea is that the external concentration of #5 should increase instantaneously from 0 to outConc. However, when having this step-like increase the problem is not solved correctly by `NDSolve`, so a fix using a delay factor of `(1-Exp[t^2])` for the increase of the outer concentration. But this does not help all the way. Though the system has been solved now, and it looks rather good, there appear some negative values of the concentrations at small t:s. In an attempt to locate these, the "EventLocator" method was used, but this in turn gave an error about complex values. Which should not be there. Any ideas how to get a stable solution from the stiff problem? > NDSolve::evre: The value of the event function at t = 7.450580596923828`*^-6 > was not a real number. The event will be ignored in steps where it does not > evaluate to real numbers at both ends. My code so far:               permcoeff = 9.5*10^(-3); (* Membrane permeability of ButH [dm/s] *)     Btot = 2.84106*10^(-2); (* Total concentration of cell buffer [mol/L*)               Kbeq =  44.0945*10^(-9); (* Equilibrium constant for cell buffer [mol/L]*)     Kbuteq = 10^(-4.82); (* Eq constant for ButH [mol/L] *)     pH0 = 7.2; (* Initial pH-value *)     outConc = 20*10^(-3) ; (* Conc of ButH outside cell [mol/L] *)     radius = 5*10^(-3); (* [dm] *)     tmax = 50; (* [s] *)     delta = 10^(-10); (* Min value for radius [dm]*)     epsilon = 5*10^(-2); (* Distance from membrane of electrode [dm] *)          (* Coefficients of diffusion [dm^2/s] *)     dc = {       10^(-5),       6.5*10^(-8),       6.5*10^(-8),       2*9.2*10^(-8),       2*9.2*10^(-8)       };          (* Reaction rates      k3f - [H][B] - > [HB]     k3b - [HB] - > [H]+[B]     k4f - [H][But] - > [ButH]     k4b - [ButH] - > [H]+[But]     *)     k3f = 10^(10);     k3b = k3f*Kbeq;     k4f = k3f;     k4b = k4f * Kbuteq;          (* Concentrations      c1 - [H+]     c2 - [B-]     c3 - [HB]     c4 - [But-]     c5 - [ButH]     *)          (* Flux at outer boundary. Only ButH enters the cell *)     influx = {        0,        0,        0,        0,        -(1 - Exp[-t]) (c5[radius, t] - outConc)*permcoeff/dc[[5]]        };          (* Initial concentrations [mol/L] *)     cinit = {        10^(-pH0),        Kbeq*Btot/(10^(-pH0) + Kbeq),        10^(-pH0)*Btot/(10^(-pH0) + Kbeq),        0,        0        };          (* BC at membrane *)      bcMembrane = {        Derivative[1, 0][c1][radius, t] == influx[[1]],        Derivative[1, 0][c2][radius, t] == influx[[2]],        Derivative[1, 0][c3][radius, t] == influx[[3]],        Derivative[1, 0][c4][radius, t] == influx[[4]],        Derivative[1, 0][c5][radius, t] == influx[[5]]        };          (* BC at center *)      bcCenter = {        Derivative[1, 0][c1][delta, t] == 0,        Derivative[1, 0][c2][delta, t] == 0,        Derivative[1, 0][c3][delta, t] == 0,        Derivative[1, 0][c4][delta, t] == 0,        Derivative[1, 0][c5][delta, t] == 0        };          (* Initial conditions *)      initcond = {        c1[r, 0] == cinit[[1]],        c2[r, 0] == cinit[[2]],        c3[r, 0] == cinit[[3]],        c4[r, 0] == cinit[[4]],        c5[r, 0] == cinit[[5]]        };          (* RDEs to be solved *)      diffeqn = {        dc[[1]]*(2*D[c1[r, t], r]/r + D[c1[r, t], r, r]) -           k3f*c1[r, t]*c2[r, t] + k3b*c3[r, t] - k4f*c1[r, t]*c4[r, t] +           k4b*c5[r, t] == D[c1[r, t], t],        dc[[2]]*(2*D[c2[r, t], r]/r + D[c2[r, t], r, r]) -           k3f*c1[r, t]*c2[r, t] + k3b*c3[r, t] == D[c2[r, t], t],        dc[[3]]*(2*D[c3[r, t], r]/r + D[c3[r, t], r, r]) +           k3f*c1[r, t]*c2[r, t] - k3b*c3[r, t] == D[c3[r, t], t],        dc[[4]]*(2*D[c4[r, t], r]/r + D[c4[r, t], r, r]) -           k4f*c1[r, t]*c4[r, t] + k4b*c5[r, t] == D[c4[r, t], t],        dc[[5]]*(2*D[c5[r, t], r]/r + D[c5[r, t], r, r]) +           k4f*c1[r, t]*c4[r, t] - k4b*c5[r, t] == D[c5[r, t], t]        };          sol = NDSolve[        Join[diffeqn, bcMembrane, bcCenter, initcond], {c1, c2, c3, c4,          c5}, {r, delta, radius}, {t, 0, tmax},         Method -> {"EventLocator", "Event" -> {c2[r, t], c2[r, t]},           "Direction" -> {1, -1}},  PrecisionGoal -> 100,         MaxStepSize -> {0.001, 0.01}, MaxSteps -> 10^7];          Plot3D[Evaluate[c1[r, t] /. sol], {t, 0, tmax}, {r, delta, radius},       PlotPoints -> 50, PlotLabel -> "[H+]",       AxesLabel -> {"Time [s]", "Distance from center [dm]", "[mol/L]"}]


How to find near circular objects in an image

I have an image similar to the one shown below, and I need to find all the red circles and count them. How could I possibly extract them? I am trying to do this in _Mathematica_ for now, but eventually I have to implement the code in MATLAB R2011a with Image Processing Toolkit. ![enter image description here](http://i.stack.imgur.com/UwKVV.jpg)


MovingAverage[] and Fit[] with data containing DateLists

I have data which has the following appearance: `data = {{DateList, Real}, ..., {DateList, Real}}` It's easy to visualize the data by using `DateListPlot`. In addition to `DateListPlot`, I would also like to show a function which fits the data and the moving average of the data. I hope I described the problem clear enough.


DSolve problem with system of linear ODEs

I encounter a rather strange problem in Mathematica when trying to solve the following system of linear differential equations:               M:={{0,1,0},{0,-1,1},{2,0,-4}}     ODESys := X'[t] == M.X[t]     InCond := X[0] == {5,0,5/2}     DSolve[{ODESys, InCond}, X[t], {t, 0, 1000}]      Despite the fact that the system should have an existing and unique solution (the eigenvalues of M are all nondegenerate and the eigenvectors are linearly independent), the ouput from the above code is empty, giving the warning               DSolve::bvnul: "For some branches of the general solution, the given boundary conditions lead to an empty solution".      However, there should not exist different branches. Also when using NDSolve instead of DSolve, the code works like a charm. Any ideas why the above code does not work for DSolve will be highly appreciated.


ParametricRegion question - a bug report

It is just to report that the request:               ?ParametricRegion      does not return the expected definition. Instead I see this:                System`ParametricRegion          Attributes[ParametricRegion]={HoldAll,Protected}      it is Mma10.0.0 (PC, Win7)


Integral calculation in Mathematica

I need to calculate this integral using Mathematica: ∫ t^z * ln(t) dt from x to y with the assumptions that z is an integer and 0 < x < y * * * This is what I'm trying to do:               Integrate[t^z*ln (t), {t, x, y},       Assumptions -> z ∈ Integers, Assumptions -> 0 < x < y]      * * * And this is what I get:               ConditionalExpression[(ln (-x^(2 + z) + y^(2 + z)))/(      2 + z), (Re[x/(x - y)] >           1 || (x != 0 && x^2 != x y && Re[x/(x - y)] < 0 &&            Re[x/(-x + y)] > 0) ||          x/(x - y) \[NotElement]           Reals) && ((x \[Element]             Reals && ((Im[x] <=                 Im[y] && (Im[x] >= 0 || Im[y] <= 0 ||                  Im[y] Re[x] >= Im[x] Re[y])) || (Im[x] >=                 Im[y] && (Im[x] <= 0 || Im[y] >= 0 ||                  Im[y] Re[x] <= Im[x] Re[y])))) || (Im[x] >=             0 && (Im[y] >=               0 || (Im[x] <= Im[y] && (Im[y] Re[x])/Im[x] <=                 Re[y]))) || (Im[x] >=             Im[y] && (((Im[y] Re[x])/Im[x] <=                 Re[y] && (Im[x] <= 0 || Im[y] >= 0 ||                  Im[y] Re[x] <= Im[x] Re[y])) || (Im[x] <= 0 &&                Im[y] <= 0))) || (Im[x] <=             Im[y] && (((Im[y] Re[x])/Im[x] <=                 Re[y] && (Im[y] <= 0 ||                  Im[y] Re[x] >= Im[x] Re[y])) || (Im[x] <= 0 &&                Im[y] <= 0))))]      * * * I know that `ln(y^(2+z) - x^(2+z)) / (2 + z)` is not the right answer, so what did I do wrong?


How to automatically get rid of trig functions in an expression?

I have a large expression containing many terms like this:               Sin[1/2 ArcTan[(2 Log[5])/(Log[5]^2 - 2)]]      ![Sin\[1/2 ArcTan\[\(2 Log\[5\]\)/\(Log\[5\]^2 - 2\)\]\]](http://i.stack.imgur.com/mkXBD.png) where a trig function is invoked on a rational multiple of an inverse trig function. I want to expand trig functions such that this term turns into:               Sqrt[1/2 (1 - Sqrt[1 - (4 Log[5]^2)/(4 + Log[5]^4)])]      ![Sqrt\[1/2 \(1 - Sqrt\[1 - \(4 Log\[5\]^2\)/\(4 + Log\[5\]^4\)\]\)\]](http://i.stack.imgur.com/ScF59.png) It is tedious to manually convert all such terms, so I am looking for a function that is able to do this automatically. Could you help me with it?


I want to calculate the pixel values of an image and export to a standard format

After finishing a few tutorials, I thought I was ready to calculate the pixel values of a large (smaller numbers 20x20 used here) image and export to a standard format (.jpg) but my code doesn't work. I am clearly missing something important. I thought it might be best to see if someone would look at a small segment of the code and comment.               (* image calc *)     numrow = 20;     numcol = 20;          (* midpoint of image *)     midrow = N[numrow/2];     midcol = N[numcol/2];          (* azimuth angle of pixel from center point *)      (* mixed symbolic and numeric results *)     patfun[i_,j_] := N[ArcTan[i-midrow,j-midcol]];          (* spoke-like image *)     pat = Array[patfun[i,j], 20, 20];


Expectation of GeometricBrownianMotionProcess

I am trying to compute $$\mathbb E\left[\max\left(\frac{S_{1/2}+S_1}{2}-K,0\right)\right]$$ where $K=100$ and $S_t$ is a geometric brownian motion (with $S_0=100$, drift $r=0.05$ and volatility $\sigma=0.4$) which satisfies $$dS_t=rS_tdt+\sigma S_tdW_t \quad \text{for} \quad0\le t\le T=1$$ So I use               ClearAll["Global`*"]     r = 0.05;     sigma = 0.4;     S0 = 100;     NExpectation[Max[(S12 + S1)/2 - 100, 0],       {S12, S1} \[Distributed] GeometricBrownianMotionProcess[r, sigma, S0][{1/2, 1}]]      which gives               0.754031      But according to my lecture notes the value should be much higher, in fact, it should be $\approx14$ (or $\approx 15$). But what am I doing wrong? I suppose it might be due to the fact that $S_1$ and $S_{1/2}$ are not independent, but Mathematica probably assumes they are independent.


How can I remove double quotes in CDF?

I wrote a small code and deployed into `CDF`.                 CDFDeploy[SystemDialogInput["FileSave"], Style["This is my name"],WindowSize -> {100, 100}]      The `String`(This is my name) shows in double quotes ,whenever we have to open `CDF`. ![enter image description here](http://i.stack.imgur.com/F7HTR.png) How can I remove that double quotes in `CDF`?


Inconsistency in Histogram's "Probability" Binsize

**Context** Let me define a Probability distribution (following the documentation and with some connection to this question)                DD = ProbabilityDistribution[(Sqrt[2]/\[Pi]) (1/(1 + x^4)), {x, -\[Infinity], \[Infinity]}];      which is normalized properly `CDF[DD,1000]//N` (* 1 *), and looks like this                Plot[Evaluate[PDF[DD, x]], {x, -4, 4}, Filling -> Axis]      ![Mathematica graphics](http://i.stack.imgur.com/6BdjP.png) I am interested in drawing samples from this distribution If I let _Mathematica_ do his job:                Show[RandomVariate[DD, 1500] // Histogram[#, Automatic, "Probability"] &,       Plot[PDF[DD, x], {x, -5, 5}, PlotStyle -> Directive[Red, Thick]]]      I get this ![Mathematica graphics](http://i.stack.imgur.com/wxQRN.png) which strongly suggests it got the normalisation wrong. **Question** > Is this a known bug or a misunderstanding on how `Histogram` works on my > part? **Attempt** Now let me evaluate by hand its normalized histogram                hh = RandomVariate[DD, 15000]//BinCounts[#, {-5, 5, 1/4}] &;      h = 4 hh/Total[hh];      h = Transpose[{Table[i - 1/4, {i, -5 + 1/4, 5, 1/4}], h}];      I get this                Show[ListLinePlot[h, InterpolationOrder -> 0, PlotRange -> All, Filling -> Axis],       Plot[PDF[DD, x], {x, -5, 5}, PlotStyle -> Directive[Red, Thick]]]      ![Mathematica graphics](http://i.stack.imgur.com/M25oF.png) Turning back to the _Mathematica_ Automated procedure, if I force the binsize _and_ the corresponding Normalization, I get this               Show[RandomVariate[DD, 150000]//Histogram[#, {-5, 5, 1/4}, "Probability"] &,     Plot[PDF[DD, x]/4, {x, -5, 5}, PlotStyle -> Directive[Red, Thick]]]      ![Mathematica graphics](http://i.stack.imgur.com/LYgtu.png) But note the `1/4` factor in the `PDF` (corresponding to the binsize).


Are these nested Tables necessary?

In exploring this fish population game with my calculus students, I wrote some Mathematica code to search for the sequence of catches that would result in the maximal total population of fish (both in the pond and in the boats) after ten days. The code that I wrote works for this purpose, but I feel like the way that I implemented it is clunky--particularly all of those nested tables and the subsequent flattening. Also, this was my first time using Fold, and though it worked, I'm not sure it it's the best tool to use for this purpose. I'm not very experienced in Mathematica and so I'm hoping this stackexchange is an appropriate place to ask for critiques and suggestions for how this could be coded more succinctly. I'm looking to improve! Here's the code:               Pond[in_, take_] := Min[20, Floor[1.25 (in - 3 take)]]     Sort[      Flatten[       Table[Table[         Table[Table[           Table[Table[            Table[Table[             Table[Table[{3 (a + b + c + d + e + f + g + h + i + j) +                Fold[Pond, 20, {a, b, c, d, e, f, g, h, i, j}],               a + b + c + d + e + f + g + h + i + j, {a, b, c, d, e, f,                g, h, i, j}}, {j, 0, 3}], {i, 0, 3}], {h, 0, 3}], {g,            0, 3}], {f, 0, 3}], {e, 0, 3}], {d, 0, 3}], {c, 0, 3}], {b,       0, 3}], {a, 0, 3}], 9], #1[[1]] > #2[[1]] &]      Note: If the above crashes or takes too long to run, just change several of the variables so that they range from 3 to 3, rather than 0 to 3. And thanks!