3x+1 on arithmetic chains, tree pruning and NestList

Given the following function `Collatz`:               Collatz[Subscript[m_, d_] /;  EvenQ[m] && EvenQ[d]] := Subscript[m/2, d/2]     Collatz[Subscript[m_, d_] /;  OddQ[m] && EvenQ[d]] := Subscript[3 m + 1, 3 d]     Collatz[Subscript[m_, d_] /;  OddQ[d]] :=          Collatz /@ {Subscript[m, 2 d], Subscript[m + d, 2 d]}      The immediate question that crops up, once `Collatz` is made `Listable` to handle the branching - is to manage the trajectories. This includes identifying and filtering cycles (ie, periodic orbits) from the transition graph. The first 5 iterates given the initial state `Subscript[1,1]` (the chain of natural numbers 1,2,3...) is:               Column@ NestList[Collatz,Subscript[1, 1],5]          (* Out[1]= Subscript[1, 1]     {Subscript[1, 2],Subscript[2, 2]}     {Subscript[4, 6],Subscript[1, 1]}     {Subscript[2, 3],{Subscript[1, 2],Subscript[2, 2]}}     {{Subscript[2, 6],Subscript[5, 6]},{Subscript[4, 6],Subscript[1, 1]}}     {{Subscript[1, 3],Subscript[16, 18]},{Subscript[2, 3],{Subscript[1, 2],Subscript[2, 2]}}} *)      Any suggestions for functional approaches to filter out cycles, in other words, states that are repeated in the output of `NestList` but are not observable at the level of a single call to `Collatz`? In the above simulation, `Subscript[1,1]` should be filtered out after the 2nd iteration. Recall, vertices of the transition graph are the chains `Subscript[n,d]` while the arcs link inputs of `Collatz` with its output chain(s).


3d graphic for publication

Journals are very strict and some of them require special formats. They suggest the .tiff or .jpg format for graphics with many colors. I have problem how to export, for example, this figure consists of 4 smaller but to have optimized quality (Labels to be with correct size of fonts, viewable) and not with large file size.               plot1 = Plot3D[Sin[4 x]*Cos[4 y], {x, -2, 2}, {y, -2, 2},      PlotLabel -> "number 1, gamma, s=1,q=2", AxesLabel -> {x, y},      ColorFunction -> "NeonColors"];          plot2 = Plot3D[Sin[3 x]*Cos[4 y], {x, -2, 2}, {y, -2, 2},      PlotLabel -> "number 1, gamma, s=2,q=2", AxesLabel -> {x, y},      ColorFunction -> "NeonColors"];          plot3 = Plot3D[Sin[2 x]*Cos[4 y], {x, -2, 2}, {y, -2, 2},      PlotLabel -> "number 1, gamma, s=3,q=2", AxesLabel -> {x, y},      ColorFunction -> "NeonColors"];          plot4 = Plot3D[Sin[1 x]*Cos[4 y], {x, -2, 2}, {y, -2, 2},      PlotLabel -> "number 1, gamma, s=4,q=2", AxesLabel -> {x, y},      ColorFunction -> "NeonColors"];          GraphicsGrid[{{plot1, plot2}, {plot3, plot4}}, Frame -> True]


Using ListPlot and Joined, how to keep markers in colour but make all joining lines gray?

I want to create a `ListPlot` with three sets of data, where the data in each set are joined by a line. This is an example:               ListPlot[{{1, 2, 3, 5, 8}, {2, 3, 6, 9, 10}, {4, 5, 7, 10, 12}},       PlotMarkers -> {Automatic}, Joined -> {True}]      **Question:** How do I keep a unique marker and colour for each of the sets but specify that the joining lines be a single color (gray)?


NDSolve solution methods issue

I´m modelling a biological reaction thorugh a set of differential equations.               Modelo = NDSolve[{{dX[t]/dt == muapp*X[t] - 0.005*X[t], X[0] == Xo2},     {dSg[t]/dt == -Qs + 0.005*(100 - Sg[t]), Sg[0] == Sgo2},     {dAce[t]/dt == Qace - 0.005*Ace[t], Ace[0] == Aceo2},     {dBut[t]/dt == Qbut - 0.005*But[t], But[0] == Buto2},     {dAct[t]/dt == Qact - 0.005*Act[t], Act[0] == Acto2},     {dEt[t]/dt == Qet - 0.005*Et[t], Et[0] == Eto2},     {dSb[t]/dt == Qsb + 0.005*(2 - Sb[t]), Sb[0] == Sbo2}}, {X, Sg, Ace, But, Act, Et, Sb}, {t, 0, 400}, Method ->DOPRI];      Using NDSolve the system is solve with no problems. however, since this is a biological reaction, none of the solutions must be >0. I have already adjusted the parameters so that this condition is met and it works fine in matlab and modelmaker, but when solving it with mathematica X goes >0 between 200 < t< 400. In matlab I use ode15s, because is stiff at some points, but it works just as well with ode45 and ode23s, so i sat NDsolve parameters to those that mathematica tutorials say to be the same as ode45 in matlab:               DOPRIamat = {{1/5}, {3/40,9/40}, {44/45,-56/15,32/9}, {19372/6561,-25360/2187,64448/6561,-212/729}, {9017/3168,-355/33,46732/5247,49/176,-5103/18656}, {35/384,0,500/1113,125/192,-2187/6784,11/84}};     DOPRIbvec = {35/384, 0, 500/1113, 125/192,-2187/6784, 11/84, 0};     DOPRIcvec = {1/5, 3/10, 4/5, 8/9, 1, 1};     DOPRIevec = {71/57600, 0, -71/16695, 71/1920, -17253/339200, 22/525, -1/40};     DOPRICoefficients[5, p_] := N[{DOPRIamat, DOPRIbvec, DOPRIcvec, DOPRIevec}, p];     DOPRI = {"ExplicitRungeKutta", "DifferenceOrder" -> 5, "Coefficients" -> DOPRICoefficients, "StiffnessTest" -> False};      But still i get x<0. Is it possible to modifie NDSolve to work as ode15s in matlab? or can it at least be modified to keep it from giving negative values? thanks for your help, i leave down the script i use in mathematica. Mathematica               Xo2 = 1.0605;     Sgo2 = 43.9316;     Sbo2 = 3.5023;     Aceo2 = 0.3437;     Buto2 = 2.5299;     Acto2 = 1.0589;     Eto2 = 0.2334;     ksg = 154.060527452649;     kibut = 7.00180294979766;     ksgb = 13.6974233244128;     ksb = 1.10465168560025;     ksgact = 36.1766330476263;     ksget = 2.48715131190954;     ksgsb = 0.500075731973805;     ksba = 0.398637629396357;     kaa = 13.8244477511478;     kd = 0.00478170792619247;     m = 1.04817713477516;     maxx = 0.213696652849562;     maxbut = 0.150892601110339;     maxact = 0.778875361557128;     maxet = 0.0329313766102578;     maxsb = 0.131139790008708;     maxace = 0.142882096617404;     Ybutx = 1.22938023298761;     Yactx = 0.129135371286816;     Yetx = 0.0759697564493146;     Ysbx = 1.01875350101917;     Yacex = 2.10990339926643;     Yxsg = 0.284627874526466;     Ybutsg = 0.819985406580864;     Yactsg = 0.851780607333819;     Yetsg = 0.598346992105451;     Ysbsg = 0.995215479964112;     Yaceact = 0.973079461528239;     Ybutsb = 0.839985001333182;     Yacesb = 0.525389668809545;     mux = maxx*(Sg[t]/(ksg + Sg[t]))*(1 - (But[t]/kibut)^m);     muapp = mux - kd;     mubut = maxbut*(Sg[t]/(ksgb + Sg[t]))*(Sb[t]/(ksb + Sb[t]));     muact = maxact*(Sg[t]/(ksgact + Sg[t]));     muet = maxet*(Sg[t]/(ksget + Sg[t]));     musb = maxsb*(Sg[t]/(ksgsb + Sg[t]));     muace = maxace*(Sb[t]/(ksba + Sb[t]))*(Act[t]/(kaa + Act[t]));     Qs = X[t]*((mux/Yxsg) + ((mubut*Ybutx)/Ybutsg) + ((muact*Yactx)/Yactsg) + ((muet*Yetx)/Yetsg) + ((musb*Ysbx)/Ysbsg));     Qace = muace*X[t]*Yacex;     Qbut = mubut*X[t]*Ybutx;     Qet = muet*X[t]*Yetx;     Qact = X[t]*(muact*Yactx - ((muace*Yacex)/Yaceact));     Qsb = X[t]*(musb*Ysbx - ((mubut*Ybutx)/Ybutsb) - ((muace*Yacex)/Yacesb));


NIntegrate Warning / Error Messages

I am doing:                 NIntegrate[Sin[Exp[(x^4)]], {x, 2, Infinity}, PrecisionGoal -> 12]      It prints out a host of warnings, but also shows the results as: $$-0.0113737$$ This is a highly oscillatory integral and weirdness happens to the numerical routines as they are doing their thing. For example:   * integration with LevinRule failed.   * converging too slowly; suspect one of the following: singularity, value of the integration is 0, highly oscillatory integrand, or WorkingPrecision too small   * "NIntegrate failed to converge to prescribed accuracy after 9 recursive bisections in x near {x} = {4.531228269745986`}"   * ... You can see a plot as:                Plot[Sin[Exp[(x^4)]], {x, 2, 5}]      As an aside, the same input (exactly) using WA, produces: $$-0.00644455$$ Are those warnings/errors telling me not to trust the result as it is suspect?


Simplifying complex expression with Mathematica

I want do get the imaginary part of               Exp[I*t]/(1-Exp[I*t])      I've tried to do this               Im[ComplexExpand[Exp[I*t]/(1-Exp[I*t])]]       but the result still contains               Im[Cos[t]/((1 - Cos[t])^2 + Sin[t]^2) -         Cos[t]^2/((1 - Cos[t])^2 + Sin[t]^2) -         Sin[t]^2/((1 - Cos[t])^2 + Sin[t]^2)]       which in fact is 0 (t is a real variable). How can I convince _Mathematica_ to get rid of this part of the expression?


Behaviour of out (%%...%) with comments

Can please someone explain to me the diffrent behavior of this code               (6 - 3);     (5 - 3);     (4 - 3);     {%%%, %%, %}          Out= {3, 2, 1}      and this one               a;     b;     c;     (6 - 3);(*comment*)     (5 - 3);(*comment*)     (4 - 3);(*comment*)     {%%%, %%, %}          Out= {a, b, c}      ? I thought it should be the same. Do the comments block the outputs to be used with %? EDIT: I found a working case ... even if one adds spaces between the comments.               a;     b;     c;     (6 - 3);     (* comment *)     (5 - 3);     (* comment *)     (4 - 3);     (* comment *)     {%%%, %%, %}          Out= {3, 2, 1}


Modifying elements of a matrix after construction

Suppose I have constructed a matrix with all elements as a constant (say 1):               N=4;     A=ConstantArray[1, {N, N}];      Now I want to make A(2,3)=23 and A(4,3)=43. Can I modify such elements once the matrix is constructed? Thank you.


Plot more points only in specific region of plot

I have the code shown at the bottom of this question which generates a 3D plot. There are locations where the two surfaces you see form cones and touch at infinitesimally small points. These points always occur at z=1 and I have to use many PlotPoints to resolve this touching. I will be generating thousands of these plots (to form a movie) so need to plot each one as quickly as possible. I would imagine a lot of time would be saved if I used a large number of points only in the regions of interest. Is there a way I can use a large PlotPoints density in a rectangular box that spans the x and y domain but has a small height and is vertically centred around z=1 where I know these points occur (but I don't know their x or y)? ![](http://i.stack.imgur.com/Az35Q.jpg)               (*The lattice vectors*)     a1 = {Sqrt[3], 0};     a2 = {Sqrt[3]/2, 3/2};          (*Omega/w_0*)     Omega = 0.01;          wp[qx_, qy_, r_] := Module[{},       q = {qx, qy};            (*Nearest neighbour vectors*)       {d1, d2, d3} = # - r & /@ {{0, -1}, {Sqrt[3]/2, 1/2}, {-Sqrt[3]/2, 1/2}};            (*The c_j's*)       {theta, phi} = {0, 0};       {c1, c2, c3} = (1 - 3 Sin[theta]^2 Cos[ArcTan[#[[1]], #[[2]]] - phi + Pi/2]^2)/           Norm[#]^3 & /@ {d1, d2, d3};            modfq =         Sqrt[c1^2 + c2^2 + c3^2 + 2 c1 c2 Cos[q.(d1 - d2)] +           2 c1 c3 Cos[q.(d1 - d3)] +  2 c2 c3 Cos[q.(d2 - d3)]];       {Sqrt[1 + 2 Omega modfq], Sqrt[1 - 2 Omega modfq]}       ]          r = {0, 0};          Timing[      With[{plotopts = {Mesh -> None, PlotStyle -> Opacity[0.7],           Ticks -> {{-Pi, 0, Pi}, {-Pi, 0, Pi}, Automatic},           PlotPoints -> 100, ViewPoint -> {1.43, -2.84, 1.13},           ViewVertical -> {0., 0., 1.}}},       plot1 =         Plot3D[wp[qx, qy, r][[1]], {qx, -Pi, Pi}, {qy, -Pi, Pi}, plotopts];       plot2 =         Plot3D[wp[qx, qy, r][[2]], {qx, -Pi, Pi}, {qy, -Pi, Pi}, plotopts];       ]      ]     plot =       Show[plot1, plot2, PlotRange -> {0.96, 1.04},        Ticks -> {{-Pi, 0, Pi}, {-Pi, 0, Pi}}, LabelStyle -> Medium,        BoxRatios -> {2, 2, 3}, BoxStyle -> Opacity[0.4]]      Note: This question could be a duplicate of here, but from what I gathered it was about feeding it a list of points rather than a region? I could be wrong.


ParallelMap returns incorrect results over Map

I've written a function to pull in the useful column of a large data file:               ImportNthColumn[fname_, n_] := With[{       command = "!awk '{ print $" <> ToString[n] <> " }' "      },       Flatten@Import[command <> fname, "Table"]     ]      and I'd like to apply this function to pull in data from every subdirectory, like so:               ImportNthColumnFromDirectories[dirs_, fname_, n_] := With[{       targets = Map[# <> "/" <> fname&, dirs]     },       Map[ImportNthColumn[#,n]&, targets]     ]      When I use `ImportNthColumnFromDirectories` with a serial map, everything works perfectly. When I use `ParallelMap`, however, the data in the _first_ and _last_ elements of `dirs` import correctly but all other iterations return a zero-length list. What could cause this strange behavior?


Show Progressbar after pressing a button

I've recently struggling with Buttons. So I understand Buttons have the form `Button["text",action]`. Now I want the `action` to be some sort to function defined to show a progress bar, so I can achieve the effect of showing a progress bar after pressing the button, **inside** a 'Panel' of `DynamicModule` for example. (One answer pointed below can display the progress bar but it is displayed after `DynamicModule`, making it invisible if the content of `DynamicModule` is a full page) Here is the simple code I have:               DynamicModule[{i = 0},        Button["Show Bar", i++; SomeFunction[]]]      and the definition of some function:               SomeFunction[] := Monitor[Table[1; Pause[0.1], {j, 1, 10}],        ProgressIndicator[j, {0, 11}]]      If I run `SomeFunction[]` by itself, the progress bar shows nicely. If I click the button, though, I didn't see any thing. Any idea why? (Because I didn't specify how to display the output of the function?). Thanks.


Density plot of asymptotic behaviour of a linear system

Good morning, I have an ODE linear system $\dot{\vec f} = A \vec f$ depending parametrically to two real parameters, s and p. I'd like to get a density map of the solutions of $f_A/(f_A+f_B)$ at $t=20$, in the space of parameters ${s, p} \in [0; 1]$. I post my try:               rA = 2.1     rB = 1.0     fA := ParametricNDSolveValue[{A'[ t] == (rA - 1 + p) A[ t] + s B[t], B'[t] == (1 - p) A[t] + (rB - s) B[t], A[0] == 2, B[0] == 2}, A, {t, 0, 20}, {{s, p} \[Element] Reals}]     fB := ParametricNDSolveValue[{A'[ t] == (rA - 1 + p) A[ t] + s B[t], B'[t] == (1 - p) A[t] + (rB - s) B[t], A[0] == 2, B[0] == 2}, B, {t, 0, 20}, {{s, p} \[Element] Reals}]     DensityPlot[fA[s][p]/(fA[s][p] + fB[s][p]), {s, 0, 1}, {p, 0, 1}]      ![Here there's what I get](http://i.stack.imgur.com/1G0db.jpg) The plot I obtain can't be what I need, as I never ask Mathematica to evaluate the functions at $t=20$. I'm really new to Mathematica and I've the impression to be missing something really basic about its semantics. I hope to learn from your help, thank you in advance!


How can I prevent a compiled function from using uncompiled evaluation?

I write a code that creates a compiled function, and then call that function over and over to generate a list. I run this code on a remote server via a batch job, and will run several instances of it. Sometimes when I make changes to the code, I make a mistake, and inside the compiled function is an undefined variable, such that when the function is called I get the following error messages (repeated several times)                CompiledFunction::cfse: Compiled expression w should be a machine-size complex number.           CompiledFunction::cfex: Could not complete external evaluation at instruction 18; proceeding with uncompiled evaluation.      This causes massive memory usage (which puts me on the system administrator's bad side), and the results are garbage if since there was a mistake in the code. Is there any way to force the code to abort and quit the program rather than proceed with uncompiled evaluation?


GUI and Dynamic update problems

I have made many functions that connect to a MySQL database perform operations then export exel spreadsheet. I also import spreadsheet data into the database. I would like to get many of these function into a simple GUI that allows me to do many of these functions easily. I have run into many problems with my little GUI. I have tired to create the simplest code that demo's some of these issues.                Clear[pmWorkHorseTest]      Options[pmWorkHorseTest] = {};      pmWorkHorseTest[opts : OptionsPattern[pmWorkHorseTest]] := Module[{},          CreateWindow[CreateDialog[       Column[{        DynamicModule[{x = 0, t = False, wait, ts, te},         TabView[{                "Method Example" -> Column[{              Row[{                     Button["Start", t = True; x = 0; While[t, x++],                  Method -> "Queued", Enabled -> Dynamic@Not@t],                     Button["Stop", t = False, Method -> "Preemptive",                  Enabled -> Dynamic@t],                Button["Stop", t = False, Method -> "Preemptive"],                     Button["Stop", t = False, Method -> "Preemptive",                  Enabled -> Dynamic@Not@Not@t],                "x=",                Dynamic[Refresh[x, UpdateInterval -> 0]]}]              }],                "Queued/Preemptive Pause" -> Column[{              PopupMenu[Dynamic@wait, Range[10]],              Row[Button[ToString[#], wait = #] & /@ Range[10]],                   Row[{"wait =",                 Dynamic[Refresh[wait, UpdateInterval -> 0]]}],              Row[{                     Button["Queued", Pause[Evaluate@Dynamic@wait],                  Method -> "Queued"],                     Button["Preemptive", Pause[Dynamic@wait],                  Method -> "Preemptive"]                }],                   Row[Button["Q: " <> ToString[#], ts = AbsoluteTime[];                   Pause[#]; te = AbsoluteTime[],                   Method -> "Queued"] & /@ Range[10]],                   Row[Button["P " <> ToString[#], Pause[#],                   Method -> "Preemptive"] & /@ Range[10]],              Row[{"Time wasted ->", Dynamic[te - ts]}]              }]                 }](*End Tabview*)          ],(*End DynamicModule*)              DefaultButton["Done", DialogReturn[]]         }]       ], WindowTitle -> "AutoPM Work Horse",       DynamicEvaluationTimeout -> 5]      ];               pmWorkHorseTest[];       Questions:   * I would like to toggle the `Enabled` state of button as things change. The "Start" button works as expected. But the "Stop" buttons do not. I would have expected the first "Stop" button to toggle its state. But notice that the last "Stop" button does work when I do something silly `Enabled -> Dynamic@Not@Not@t` (The middle "Stop" button is to stop when the others do not work.) What is the best way to mange state?   * One of my buttons calls a function that gets data from the database then writes out a spreadsheet. This takes some time. The function by itself works find but the button times out. I have tried `Method -> "Queued"`. Which with the database/spreadsheet function does nothing. With `Method -> "Preemptive"` it times out. I've tried changing `DynamicEvaluationTimeout` but I can't get that to work either. In the example code on the "Queued/Preemptive Pause" tab I try to use buttons that use "Preemptive" and "Queued" where I can pick the `Pause[]` time. No matter what I have tired I cannot seam to change the Time out time. What is the best way to deal with functions that take a long time?   * Also in the "Queued/Preemptive Pause" why can't I use the `Dynamic` value of `wait` to set the `Pause[wait]` time?


Plotting Geodesics in Kerr

I'm interested in plotting the trajectories of null geodesics near a rotating black hole (given by the Kerr solution) which involves a system of first order differential equations. **Some Context** (not entirely necessary): Kerr spacetimes are stationary and axially symmetric, that is, the metric (denote it by $g$) is independent of $t$ and $\phi$ (with the remaining two coordinates being $r$ and $\theta$). Because of the existence of these two Killing fields I'm really only interested in "projection" of the trajectories in the $(r, \theta)$-plane. Now by using conservation laws the equations of motion for a null geodesic are given by $$ \rho^4 \dot{r}^2 = E^2r^4 + (a^2E^2 - L_z^2 - \mathscr{L})r^2 + 2Mr(\mathscr{L} + (L_z - aE)^2) - a^2\mathscr{L} \tag{1}$$ $$\rho^4\dot{\theta}^2 = \mathscr{L} + (a^2 E^2 - L_z^2\csc^2\theta)\cos^2\theta \tag{2}$$ $$ \rho^2\dot{\phi} = \frac{2aMrE + (\rho^2 - 2Mr)L_z\csc^2\theta}{\Delta}$$ $$ \rho^2\dot{t} = \frac{\Sigma^2E - 2aMrL_z}{\Delta}$$ Where $\dot{x^\mu}$ denotes differentiation w.r.t. some affine parameter $\lambda$. We have that $E, L_z$ and $\mathscr{L}$ are constants, $a$ and $M$ are the Kerr parameters such that $0 < a^2 < M^2, M> 0$ ($M$ is usually taken to be 1) and $$\rho^2 = r^2 + a^2\cos^2\theta, \quad \Delta = r^2 + a^2 - 2Mr$$ (at the moment I can't quite recall what $\Sigma$ is, but it's not particularly important since I'm really only interested in equations (1) and (2)). Now as disgusting as all of these equations, together, may look, as mentioned above I'm really only interested in the $(r, \theta)$ motion, i.e. in equations (1) and (2). These two equations can be rewritten slightly by dividing both of them by $E^2$, yielding $$ \frac{\rho^4}{E^2} \dot{r}^2 = r^4 + (a^2 - \xi^2 - \eta)r^2 + 2M(\eta + (\xi - a)^2))r - a^2\eta \tag{3}$$ $$\frac{\rho^4}{E^2}\dot{\theta}^2 = \eta + a^2\cos^2\theta - \xi^2\cot^2\theta \tag{4}$$ The only restriction placed on the constants $E, \eta$ and $\xi$ is that $\eta > 0$. This is the system of coupled ODE's whose solutions I'd like to numerically approximate and plot. **My Problem** : I wish to plot the solutions of the above system of coupled ODE's (given by (3) and (4)). My thought regarding how to go about plotting these curves was to use `NDSolve` in the following way               M := 1     a := 0.8     e := 1     rminreal := M + Sqrt[M^2 - a^2]     \[Eta] = 3M     \[Xi] = 3.5          R1[t_] := (r[t]^2 + a^2 Cos[\[Theta][t]]^2)^2/e^2 r'[t]^2 - r[t]^4 - (a^2 - \[Xi]^2 - \[Eta]) r[t]^2  + 2 M ((a - \[Xi])^2 - \[Eta]) r[t] - a^2 \[Eta]          T1[t_] := (r[t]^2 + a^2 Cos[\[Theta][t]]^2)^2/e^2 \[Theta]'[t]^2 - (\[Xi]^2/Sin[\[Theta][t]]^2 - a^2) Cos[\[Theta][t]]^2          sol = NDSolve[{R1[t] == 0, T1[t] == 0, r[0] == 2, \[Theta][0] == Pi/4}, {r, \[Theta]}, {t, 0, 5}, MaxSteps -> 500000]          Piece = 4     EndPt = sol[[Piece]][[1]][[2]][[1]][[1]][[2]]     ParametricPlot[{{rs Cos[t \[Pi]/EndPt], rs Sin[t \[Pi]/EndPt]} , Evaluate[{r[t] Cos[\[Theta][t]], r[t] Sin[\[Theta][t]]} /. sol[[Piece]]]}, {t, 0, EndPt}, AspectRatio -> 1]      Here `rminreal` is the event horizon of the black hole. There seems to be a few things that tend to go wrong when I try and run the code. (1) The first thing is that the output tends to come in pieces, so instead of simply getting back two interpolatingfuncitons (one for `r` and one for `\\[Theta]`) Mathematica returns a list of four pairs of interpolating functions, for example: ![enter image description here](http://i.stack.imgur.com/RJhRc.png) This seems like it can be remedied by increasing `MaxSteps`, but `MaxSteps` is already rather large and the program takes a while to evaluate anyway. (2) Putting aside the chopping off of the domain and only getting back pieces of a solution, more often than not when I try to plot the solutions I get nothing back, that is, I get the plot of the event horizon but nothing from the interpolating function, specifically, the parameters and initial conditions used above yield nothing when plotted. (3) Also from time to time (that is, for certain choices of constant $\eta$ and $\xi$) Mathematica throws up and error saying that the step size is essentially zero and its stopping the calculation. I'm wondering if anybody knows why these things are happening and if there's is a way aroung them or if there's something i've done incorrectly (or inefficiently)? I'm pretty new when it comes to using Mathematica so I definitely welcome any constructive criticism regarding my writing of the code. Moreover, I'm wondering have I gone about setting up the equations correctly? It seems as though there may be intricacies regarding `NDSolve` that I'm unaware of, and if there are better ways of going about plotting these solutions; I would appreciate feedback on how to do it. It seems as though the the system of ODE's, itself, is pretty benign which is why I fear that I've probably botched something here. Any feed back is much appreciated


How can I add drop shadows and specular highlights to 2D graphics?

I thought I'd share some code in the form of a self-answered question, but other answers are of course welcome. Drop shadows are a familiar visual effect, giving the impression of a graphical element being raised above the screen. Simple specular highlights can also add a suggestion of depth. Here are examples of a flat graphic, the same graphic with a drop shadow, and with a shadow plus hightlights too. ![enter image description here](http://i.stack.imgur.com/FcWRt.png) ![enter image description here](http://i.stack.imgur.com/4pFyL.png) ![enter image description here](http://i.stack.imgur.com/V0aiX.png) How can I create these effects in _Mathematica_? Related questions:   * Torn edge paper effect for images   * How can I make a 2D line plot with a drop shadow under the line?


Problems with Manipulating a piecewise function

I'm having problems with changing some parameters with "manipulate" in a piecewise function. The code i'm working with is:               f[x_] := -x /; x <= 0     f[x_] := 3 x + x^2 /; 0 < x <= 3     f[x_] := (-3 x + 28 + n) /; x > 3     Manipulate[Plot[f[x], {x, -5, 15}], {n, 0, 15, 1}]          The problem is that if I leave the n the last part of the function won't even show up. Is there any easy way to fix this or is some extensive coding needed?


How to format the outputs of several properties of ComponentMeasurements?

I know someone may have asked similar questions but the solution doesn't work to me. My code is like this:               a = ComponentMeasurements[       MorphologicalComponents[rb], {"Centroid" , "Area"}, #2 > 60 &]       My output is               {1 -> {{134.861, 140.779}, 65.5}, 2 -> {{168.362, 140.052}, 62.5}}      How can I make the output be `{{134.861,140.799},{168.362,140.052}}`?


Why is Poisson Random Deviate Generation so slow?

I am generating Poisson deviates for some numerical work. Mathematica 9.0.1 is very slow in generating these random numbers, as can be seen below.               In[1]:= nobs = 100000;          In[2]:= AbsoluteTiming[      m = RandomReal[{1, 5}, nobs];      m1 = Map[RandomVariate[PoissonDistribution[#]] &, m];      ]          Out[2]= {10.194500, Null}          In[3]:= Mean[m1] // N          Out[3]= 2.99884      I need fast Poisson deviates for any vector m (i.e., it does not need to contain Uniform draws). The above is very slow for serious numerical work. A comparable function in Julia, is significantly faster, as can be seen below.               function pois(nobs::Integer)              m1=rand(Uniform(1,5), nobs)              for i in 1:nobs                 m1[i]=rand(Poisson(m1[i]))              end              m1     end          In [16]: @time draws=pois(nobs);          elapsed time: 0.005883954 seconds (800200 bytes allocated)      Is there any way one can speed up the Mathematica Poisson random number generation? Compilation does not work, unfortunately, and none of the distribution functionality is vectorized automatically. Hopefully, future versions will address this aspect.


How do I speed up a plotting of NIntegrate when repeated multiple times inside Plot?

I am studying a set of functions (many of which I know only as a definite integral) and I have assembled into a list. Here is a sample:               Clear[functionsToPlot, totalFunctions]     functionsToPlot[x_] := {       (*1*) NIntegrate[0.3/(z + 2) Sqrt[z^2 + 2.0 z + 0.7]/((z - 1)^2 + 1.1), {z, 0, x}],       (*2*) NIntegrate[.03/(z + 2) Sqrt[z^2 + 2.5 z + 1.50 x]/((z - 1)^2 + .03), {z, 0, x}],       (*3*) 0.5*Sqrt[x + 0.5]/x        };      What I need is to make a plot of each curve _divided by the total_ :               totalFunctions[x_] := Total[functionsToPlot[x]]          Plot[Evaluate[functionsToPlot[x]/totalFunctions[x]], {x, 0, 3}]      ![enter image description here](http://i.stack.imgur.com/PoNpC.png) But the **problem** is that it takes forever. I'm certain the `Plot` routine is doing the numerical integrals _twice_ (once in the numerator, and again for the denominator). Is there a way to teach _Mathematica_ to form the total as it computes the various curves in the numerator as it produces the plot in realtime (or to make the task run more efficiently)?


How can I import sound from within a Manipulate expression?

I want to import sound from a file, record, and import sound.               Manipulate[{       (*Audio Import Browse*)       Audiopath1 =          FileNameJoin[{$UserDocumentsDirectory, "Audio.wav"}]},        Column["Audio File (.wav) "          {Row[{InputField[Dynamic[Audiopath1], String, Enabled -> False],             FileNameSetter[Dynamic[Audiopath1], "Open", {".wav" -> {"*.wav"}}]}]}],      (*Audio Record*)"Audio \Record",       Button["Record", Sound[SystemDialogInput["RecordSound"]]]]


ColorFunction based on data

I have a list of numbers, and I would like to plot them using ArrayPlot (which is easy, usually :)). I would like to be able to color the elements of the plot based on the average of the list: one color if the number is above average, another if it is below. I have tried a couple of things, but so far, no joy. First thing I tried is have a module around the colorFun defined by me and the ArrayPlot, to calculate the mean, since I don't want it to be kernel-wide (many other plots will come with the same technique), and then define, inside the module, the colorFun:                 Module[       {a, mean, colorFun},         a = RandomInteger[{0, 100}, 100];         mean = Mean[a];         colorFun[z_] := If[z <= mean, Red, Blue];         ArrayPlot[List@a, ImageSize -> Full, ColorFunction -> colorFun]       ]      but this didn't work, since the plot would return all in the same color. It's actually not clear to me why. I also tried to move colorFun in the form:               colorFun[z_]=RGBColor[{ , , }]          with 2 functions of z and mean for two elements and 0 for the third. The idea of using this approach instead of the if is that I could blend the colors (the further from the average, the more intense/bright the color I am plotting with). Any ideas? Thanks!


Proving the hairy ball theorem using xAct

I would like to formally prove the hairy ball theorem in Mathematica, initially just for $S^2$, and then see about generalizing. An approach I thought about to use the xAct package to define $S^2$ and then derive a contradiction from $$ \begin{align} x^i x_i &= 1 \text{ (unit norm)} \\ \nabla_i x^i &= 0 \text{ (divergence free)}\\ \nabla_{[i} x_{j]} &= 0 \text{ (curl free)} \end{align} $$ on $S^2$. This will turn into a rats nest of Christoffel symbols on multiple charts, but with Mathematica that should not be a problem. Is this a reasonable approach? Also I am new to xAct, what do I need to do to set up $S^2$ in xAct? Is that what xCoba is for? * * * ### Edit I have made some progress. It looks like I can define $S^2$ with:               Needs["xAct`xCoba`"]     DefManifold[S2, 2, {a, b, c, d, e, f, g, h}]     DefMetric[1, metric[-a, -b], CD, {";", "\[Del]"}, PrintAs -> "g"]          (* Using stereographic projection or Riemann sphere chart*)     DefChart[RS, S2, {0, 1}, {u[], v[]}]     MatrixForm[metricarray = 4/(1 + u[]^2 + v[]^2)^2 {{1, 0}, {0, 1}}]     MetricInBasis[metric, -RS, metricarray]     DefTensor[x[a], S2] (* the "hair" vector field*)     MetricCompute[metric, RS, All, CVSimplify -> Simplify]      This at least partially works:               In[69]:= RicciScalarCD[] // ToValues          Out[69]= 2          In[71]:= RicciCD // TensorValues          Out[71]= FoldedRule[{RicciCD[{1, -RS}, {0, -RS}] ->         RicciCD[{0, -RS}, {1, -RS}]}, {RicciCD[{0, -RS}, {0, -RS}] ->         4/(1 + u[]^2 + v[]^2)^2, RicciCD[{0, -RS}, {1, -RS}] -> 0,        RicciCD[{1, -RS}, {1, -RS}] -> 4/(1 + u[]^2 + v[]^2)^2}]      I will need to add a second chart and to get a complete atlas, but I want to do some work with what I have first I would like to evaluate general tensor expresions in the given chart. As first step I would like evaluete the norm of a vector: $$ x^a x_a \leadsto 4((x^u)^2 + (x^v)^2)/(u^2 + v^2 +1) $$ * * * ## Edit I have figured out how to do the above               In[1132]:=      metric[-a, -b] x[a] x[b] // ToBasis[RS] // TraceBasisDummy // ToValues          Out[1132]= (4  x[{0, RS}]^2)/(1 + u[]^2 + v[]^2)^2 + (      4  x[{1, RS}]^2)/(1 + u[]^2 + v[]^2)^2      but I still am not able to get values plugged in for Christoffel symbols. My attempt to simplify $\nabla_{[a}x_{b]}$:               In[1249]:=      (CD[-c][metric[-b, -a] x[a]]) // CovDToChristoffel //          SeparateBasis[RS] // TraceBasisDummy // Antisymmetrize // ToValues          Out[1249]= 1/2 (-(1/((1 + u[]^2 + v[]^2)^2))         4  xAct`xTensor`Basis[-a, {0, RS}]             xAct`xTensor`Basis[-c, {           0, RS}]  (xAct`xTensor`Basis[-b, {0, RS}]                xAct`xTensor`Basis[{0, -RS}, a]                ChristoffelCD[{0, RS}, {0, -RS}, {0, -RS}]   x[{0, RS}] +             xAct`xTensor`Basis[-b, {1, RS}]                xAct`xTensor`Basis[{0, -RS}, a]                ChristoffelCD[{0, RS}, {1, -RS}, {0, -RS}]   x[{0, RS}] +             xAct`xTensor`Basis[-b, {0, RS}]                xAct`xTensor`Basis[{1, -RS}, a]                ChristoffelCD[{1, RS}, {0, -RS}, {0, -RS}]   x[{0, RS}] +             xAct`xTensor`Basis[-b, {1, RS}]                xAct`xTensor`Basis[{1, -RS}, a]                ChristoffelCD[{1, RS}, {1, -RS}, {0, -RS}]   x[{0, RS}] -             xAct`xTensor`Basis[-b, {0, RS}]   ChristoffelPDRS[             a, {0, -RS}, {0, -RS}]   x[{0, RS}] -             xAct`xTensor`Basis[-b, {1, RS}]   ChristoffelPDRS[             a, {1, -RS}, {0, -RS}]   x[{0, RS}] +             xAct`xTensor`Basis[-b, {0, RS}]                xAct`xTensor`Basis[{0, -RS}, a]                ChristoffelCD[{0, RS}, {0, -RS}, {1, -RS}]   x[{1, RS}] +             xAct`xTensor`Basis[-b, {1, RS}]                xAct`xTensor`Basis[{0, -RS}, a]                ChristoffelCD[{0, RS}, {1, -RS}, {1, -RS}]   x[{1, RS}] +             xAct`xTensor`Basis[-b, {0, RS}]                xAct`xTensor`Basis[{1, -RS}, a]                ChristoffelCD[{1, RS}, {0, -RS}, {1, -RS}]   x[{1, RS}] +             xAct`xTensor`Basis[-b, {1, RS}]                xAct`xTensor`Basis[{1, -RS}, a]                ChristoffelCD[{1, RS}, {1, -RS}, {1, -RS}]   x[{1, RS}] -             xAct`xTensor`Basis[-b, {0, RS}]   ChristoffelPDRS[             a, {0, -RS}, {1, -RS}]   x[{1, RS}] -             xAct`xTensor`Basis[-b, {1, RS}]   ChristoffelPDRS[             a, {1, -RS}, {1, -RS}]   x[{1, RS}] +             xAct`xTensor`Basis[-b, {0, RS}]                xAct`xTensor`Basis[{0, -RS}, a]  xAct`xTensor`PD[{0, -RS}][     x[{0, RS}]] +             xAct`xTensor`Basis[-b, {0, RS}]                xAct`xTensor`Basis[{1, -RS}, a]  xAct`xTensor`PD[{0, -RS}][     x[{1, RS}]] +             xAct`xTensor`Basis[-b, {1, RS}]                xAct`xTensor`Basis[{0, -RS}, a]  xAct`xTensor`PD[{1, -RS}][     x[{0, RS}]] +             xAct`xTensor`Basis[-b, {1, RS}]                xAct`xTensor`Basis[{1, -RS}, a]  xAct`xTensor`PD[{1, -RS}][     x[{1, RS}]]) - (1/((1 + u[]^2 + v[]^2)^2))        4  xAct`xTensor`Basis[-a, {1, RS}]            xAct`xTensor`Basis[-c, {          1, RS}]  (xAct`xTensor`Basis[-b, {0, RS}]               xAct`xTensor`Basis[{0, -RS}, a]               ChristoffelCD[{0, RS}, {0, -RS}, {0, -RS}]   x[{0, RS}] +            xAct`xTensor`Basis[-b, {1, RS}]               xAct`xTensor`Basis[{0, -RS}, a]               ChristoffelCD[{0, RS}, {1, -RS}, {0, -RS}]   x[{0, RS}] +            xAct`xTensor`Basis[-b, {0, RS}]               xAct`xTensor`Basis[{1, -RS}, a]               ChristoffelCD[{1, RS}, {0, -RS}, {0, -RS}]   x[{0, RS}] +            xAct`xTensor`Basis[-b, {1, RS}]               xAct`xTensor`Basis[{1, -RS}, a]               ChristoffelCD[{1, RS}, {1, -RS}, {0, -RS}]   x[{0, RS}] -            xAct`xTensor`Basis[-b, {0, RS}]   ChristoffelPDRS[            a, {0, -RS}, {0, -RS}]   x[{0, RS}] -            xAct`xTensor`Basis[-b, {1, RS}]   ChristoffelPDRS[            a, {1, -RS}, {0, -RS}]   x[{0, RS}] +            xAct`xTensor`Basis[-b, {0, RS}]               xAct`xTensor`Basis[{0, -RS}, a]               ChristoffelCD[{0, RS}, {0, -RS}, {1, -RS}]   x[{1, RS}] +            xAct`xTensor`Basis[-b, {1, RS}]               xAct`xTensor`Basis[{0, -RS}, a]               ChristoffelCD[{0, RS}, {1, -RS}, {1, -RS}]   x[{1, RS}] +            xAct`xTensor`Basis[-b, {0, RS}]               xAct`xTensor`Basis[{1, -RS}, a]               ChristoffelCD[{1, RS}, {0, -RS}, {1, -RS}]   x[{1, RS}] +            xAct`xTensor`Basis[-b, {1, RS}]               xAct`xTensor`Basis[{1, -RS}, a]               ChristoffelCD[{1, RS}, {1, -RS}, {1, -RS}]   x[{1, RS}] -            xAct`xTensor`Basis[-b, {0, RS}]   ChristoffelPDRS[            a, {0, -RS}, {1, -RS}]   x[{1, RS}] -            xAct`xTensor`Basis[-b, {1, RS}]   ChristoffelPDRS[            a, {1, -RS}, {1, -RS}]   x[{1, RS}] +            xAct`xTensor`Basis[-b, {0, RS}]               xAct`xTensor`Basis[{0, -RS}, a]  xAct`xTensor`PD[{0, -RS}][     x[{0, RS}]] +            xAct`xTensor`Basis[-b, {0, RS}]               xAct`xTensor`Basis[{1, -RS}, a]  xAct`xTensor`PD[{0, -RS}][     x[{1, RS}]] +            xAct`xTensor`Basis[-b, {1, RS}]               xAct`xTensor`Basis[{0, -RS}, a]  xAct`xTensor`PD[{1, -RS}][     x[{0, RS}]] +            xAct`xTensor`Basis[-b, {1, RS}]               xAct`xTensor`Basis[{1, -RS}, a]  xAct`xTensor`PD[{1, -RS}][     x[{1, RS}]]) + (1/((1 + u[]^2 + v[]^2)^2))        4  xAct`xTensor`Basis[-a, {0, RS}]            xAct`xTensor`Basis[-b, {          0, RS}]  (xAct`xTensor`Basis[-c, {0, RS}]               xAct`xTensor`Basis[{0, -RS}, a]               ChristoffelCD[{0, RS}, {0, -RS}, {0, -RS}]   x[{0, RS}] +            xAct`xTensor`Basis[-c, {1, RS}]               xAct`xTensor`Basis[{0, -RS}, a]               ChristoffelCD[{0, RS}, {1, -RS}, {0, -RS}]   x[{0, RS}] +            xAct`xTensor`Basis[-c, {0, RS}]               xAct`xTensor`Basis[{1, -RS}, a]               ChristoffelCD[{1, RS}, {0, -RS}, {0, -RS}]   x[{0, RS}] +            xAct`xTensor`Basis[-c, {1, RS}]               xAct`xTensor`Basis[{1, -RS}, a]               ChristoffelCD[{1, RS}, {1, -RS}, {0, -RS}]   x[{0, RS}] -            xAct`xTensor`Basis[-c, {0, RS}]   ChristoffelPDRS[            a, {0, -RS}, {0, -RS}]   x[{0, RS}] -            xAct`xTensor`Basis[-c, {1, RS}]   ChristoffelPDRS[            a, {1, -RS}, {0, -RS}]   x[{0, RS}] +            xAct`xTensor`Basis[-c, {0, RS}]               xAct`xTensor`Basis[{0, -RS}, a]               ChristoffelCD[{0, RS}, {0, -RS}, {1, -RS}]   x[{1, RS}] +            xAct`xTensor`Basis[-c, {1, RS}]               xAct`xTensor`Basis[{0, -RS}, a]               ChristoffelCD[{0, RS}, {1, -RS}, {1, -RS}]   x[{1, RS}] +            xAct`xTensor`Basis[-c, {0, RS}]               xAct`xTensor`Basis[{1, -RS}, a]               ChristoffelCD[{1, RS}, {0, -RS}, {1, -RS}]   x[{1, RS}] +            xAct`xTensor`Basis[-c, {1, RS}]               xAct`xTensor`Basis[{1, -RS}, a]               ChristoffelCD[{1, RS}, {1, -RS}, {1, -RS}]   x[{1, RS}] -            xAct`xTensor`Basis[-c, {0, RS}]   ChristoffelPDRS[            a, {0, -RS}, {1, -RS}]   x[{1, RS}] -            xAct`xTensor`Basis[-c, {1, RS}]   ChristoffelPDRS[            a, {1, -RS}, {1, -RS}]   x[{1, RS}] +            xAct`xTensor`Basis[-c, {0, RS}]               xAct`xTensor`Basis[{0, -RS}, a]  xAct`xTensor`PD[{0, -RS}][     x[{0, RS}]] +            xAct`xTensor`Basis[-c, {0, RS}]               xAct`xTensor`Basis[{1, -RS}, a]  xAct`xTensor`PD[{0, -RS}][     x[{1, RS}]] +            xAct`xTensor`Basis[-c, {1, RS}]               xAct`xTensor`Basis[{0, -RS}, a]  xAct`xTensor`PD[{1, -RS}][     x[{0, RS}]] +            xAct`xTensor`Basis[-c, {1, RS}]               xAct`xTensor`Basis[{1, -RS}, a]  xAct`xTensor`PD[{1, -RS}][     x[{1, RS}]]) + (1/((1 + u[]^2 + v[]^2)^2))        4  xAct`xTensor`Basis[-a, {1, RS}]            xAct`xTensor`Basis[-b, {          1, RS}]  (xAct`xTensor`Basis[-c, {0, RS}]               xAct`xTensor`Basis[{0, -RS}, a]               ChristoffelCD[{0, RS}, {0, -RS}, {0, -RS}]   x[{0, RS}] +            xAct`xTensor`Basis[-c, {1, RS}]               xAct`xTensor`Basis[{0, -RS}, a]               ChristoffelCD[{0, RS}, {1, -RS}, {0, -RS}]   x[{0, RS}] +            xAct`xTensor`Basis[-c, {0, RS}]               xAct`xTensor`Basis[{1, -RS}, a]               ChristoffelCD[{1, RS}, {0, -RS}, {0, -RS}]   x[{0, RS}] +            xAct`xTensor`Basis[-c, {1, RS}]               xAct`xTensor`Basis[{1, -RS}, a]               ChristoffelCD[{1, RS}, {1, -RS}, {0, -RS}]   x[{0, RS}] -            xAct`xTensor`Basis[-c, {0, RS}]   ChristoffelPDRS[            a, {0, -RS}, {0, -RS}]   x[{0, RS}] -            xAct`xTensor`Basis[-c, {1, RS}]   ChristoffelPDRS[            a, {1, -RS}, {0, -RS}]   x[{0, RS}] +            xAct`xTensor`Basis[-c, {0, RS}]               xAct`xTensor`Basis[{0, -RS}, a]               ChristoffelCD[{0, RS}, {0, -RS}, {1, -RS}]   x[{1, RS}] +            xAct`xTensor`Basis[-c, {1, RS}]               xAct`xTensor`Basis[{0, -RS}, a]               ChristoffelCD[{0, RS}, {1, -RS}, {1, -RS}]   x[{1, RS}] +            xAct`xTensor`Basis[-c, {0, RS}]               xAct`xTensor`Basis[{1, -RS}, a]               ChristoffelCD[{1, RS}, {0, -RS}, {1, -RS}]   x[{1, RS}] +            xAct`xTensor`Basis[-c, {1, RS}]               xAct`xTensor`Basis[{1, -RS}, a]               ChristoffelCD[{1, RS}, {1, -RS}, {1, -RS}]   x[{1, RS}] -            xAct`xTensor`Basis[-c, {0, RS}]   ChristoffelPDRS[            a, {0, -RS}, {1, -RS}]   x[{1, RS}] -            xAct`xTensor`Basis[-c, {1, RS}]   ChristoffelPDRS[            a, {1, -RS}, {1, -RS}]   x[{1, RS}] +            xAct`xTensor`Basis[-c, {0, RS}]               xAct`xTensor`Basis[{0, -RS}, a]  xAct`xTensor`PD[{0, -RS}][     x[{0, RS}]] +            xAct`xTensor`Basis[-c, {0, RS}]               xAct`xTensor`Basis[{1, -RS}, a]  xAct`xTensor`PD[{0, -RS}][     x[{1, RS}]] +            xAct`xTensor`Basis[-c, {1, RS}]               xAct`xTensor`Basis[{0, -RS}, a]  xAct`xTensor`PD[{1, -RS}][     x[{0, RS}]] +            xAct`xTensor`Basis[-c, {1, RS}]               xAct`xTensor`Basis[{1, -RS}, a]  xAct`xTensor`PD[{1, -RS}][     x[{1, RS}]]))      xAct knows the metric components in the RS so it should also know the Christoffel symbol component, so what do I need to make it use them?


Density plot of city data

I try to solve a bit tricky problem. I want define line (or vector) between some geographical points with weights (for example how many transactions has been done between these cities). I tried this way:               c1 = CityData["Paris", "Coordinates"] ;     c2 = CityData["London", "Coordinates"];     c3 = CityData["Hong Kong", "Coordinates"];          ListDensityPlot[{{c1, c2, 5}, {c2, c3, 1}}]      Where 5 and 1 in ListDensityPlot are weights. When I evaluate this code I always get error message. Is it possible to make this simalution? Thank you very much.


Interpolating and plotting a surface for a sparse set of 3d data points

I have a set of $(x,y,z)$ coordinates which sparsely cover a surface, e.g.:               data = {{51, 15, 0.1}, {300, 11, 0.99}, {140, 22, 0.123}, {54, 12, 0.66}, ...};      What is a good general method, in _Mathematica_ 9, of interpolating and plotting a surface for this sparse data set? `Graphics3D[BSplineSurface[data]]` doesn't seem to get the job done; the output is a planar rectangle.


Probability Distribution of a Multivariate Hypergeometric distribution and maximum probability

Hello to all Mathematica Users! I have this question: Consider a box which contains 69 balls. 17 red, 1 white, 29 blue and 22 green balls. There will be picked 7 balls randomly, without putting the balls back to the experiment. My question is: How do I create a probability distribution of all the possible combinations and to visualize it? And then I would like to find the combination with the higher probability and the mean. I know that I have to use "Multivariate Hypergeometric distribution", and I know how to compute the probability of a particular combination, but not how to find the more probable combination and the mean of the whole distribution.


Constrain movement of Locator

Continuing the discussion started in the thread here, I've tried to recreate the code from scratch. I thus looked to constrain the movement of a locator to the graph defined by               f[t_] := t {Cos[10 t], Sin[10 t]}      If the locator is at point pt, then               Table[{t,Norm[f[t] - pt]}, {t, 0, 2, 0.001}]      is a list of couple {t, distances}, which can be sorted with `Sort` and the t-value can be found back using               First[First[Sort[Table[     {t, Norm[f[t] - pt]}     , {t, 0, 2, 0.001}], (#1[[2]] < #2[[2]]) &]]]      Changing the variable pt by `#` to create a Pure Function used by the second argument of the `Locator` command, I tried the code               Show[      ParametricPlot[f[t], {t, 0, 2}]      ,      Graphics[{        Locator[ptt,         ptt =          (f[First[First[Sort[Table[                 {t, Norm[f[t] - #]}                 , {t, 0, 2, 0.001}], (#1[[2]] < #2[[2]]) &]]]]) &         ]        }]      ]      which doesn't work at all. I think there is an error due to expansions of some sorts, but don't know where. Any help with this? The answer found in the link above is working, of course, but I'm trying to find something "shorter", if possible. All help, as always, very much appreciated!


Must Run Cell Twice to Display Values

What is going on here?               Print[InputField[]]     CellPrint[TextCell["my\"text", "Text", ShowStringCharacters -> True]]      ![enter image description here](http://i.stack.imgur.com/CyahW.png) If I insert the above code into a blank notebook and run it, only the second cell seems to appear. If I run the code a 2nd time, both Cells are displayed. How do I correct the code, so the `InputField` will be displayed the 1st time the code is run? I am running Mathematica 8 on Windows 7.


Replace with position and order number

# question * * * conversion1 : Convert `"[AA]AB[AA]BB[AA]B[AA]CCC"` to `"[A1A2]A3B1[A4A5]B2B3[A6A7]B4[A8A9]CCC"` conversion2 : Convert `"[AA]AB[AA]BB[AA]B[AA]CCC"` to `"[A1A2]AB1[A3A4]B2B3[A5A6]B4[A7A8]CCC"` where `A` is sensitive to `"[]"` In conversion 2, both `A` and `B` (even `C`, though no more `B` or `C` in `"[]"`) could be sensitive to `"[]"`, we can control them. And we can ignore the string in `"[]"`. # my tries * * * case1: String               sample1 = "[AA]AB[AA]BB[AA]B[AA]CCC"; pos = StringPosition[sample1, "A"];     StringReplacePart[sample1, ToString /@ pos, pos]      > >     (* >      [{2, 2}{3, 3}]{5, 5}B[{8, 8}{9, 9}]BB[{14, 14}{15, 15}]B[{19, 19}{20, > 20}]CCC >     *) >   case2 List               sample2 = Characters @ sample1; pos = Position[sample2, "A"];     ReplacePart[sample2, Thread[Rule[List /@ pos, "A" <> # & /@ ToString /@ Range[Length @ pos]]]]      > >     (* >      {[,A1,A2,],A3,B,[,A4,A5,],B,B,[,A6,A7,],B,[,A8,A9,],C,C,C} >     *) >   # How about the case with multiple patterns. * * * case 3               pos = Position[sample2, "A" | "B"];      This is not good               ReplacePart[sample2, Thread[Rule[List /@ pos, ToString /@ Range[Length @ pos]]]];          posList = Position[sample2, #] & /@ {"A", "B"};      good for A and B separately               ReplacePart[sample2, Thread[Rule[List /@ posList[[1]], "A" <> # & /@ ToString     /@ Range[Length @ posList[[1]]]]]]      > >     (* >      {[,A1,A2,],A3,B,[,A4,A5,],B,B,[,A6,A7,],B,[,A8,A9,],C,C,C} >     *) >                 ReplacePart[sample2, Thread[Rule[List /@ posList[[2]], "B" <> # & /@ ToString     /@ Range[Length @ posList[[2]]]]]]      > >     (* >      {[,A,A,],A,B1,[,A,A,],B2,B3,[,A,A,],B4,[,A,A,],C,C,C} >     *) >   How to combine those to get the result `{[,A1,A2,],A3,B1,[,A4,A5,],B2,B3,[,A6,A7,],B4,[,A8,A9,],C,C,C}` or more elegant way to do this? Either string or list case is needed, and both of them in aswer is better.


ZTest result not making sense

I'm using version 10. I'm having difficulty with understanding why I'm getting some output from the ZTest function. Here is the code for my specific example.               In[1]:= data = {553.`, 552.`, 567.`, 579.`, 550.`, 541.`, 537.`, 553.`, 552.`, 546.`, 538.`, 553.`, 581.`, 539.`, 529.`};          In[2]:= ZTest[data, 20, 540, "TestStatistic"]          Out[2]= 9.81495      Now, I write my own z statistic calculation based on the definition. $$Z = \frac{\bar{X}-\operatorname{E}[X]}{\sigma(X)/\sqrt{n}}.$$               In[3]:= myZTest[data_List, s_, m_] := (Mean[data] - m)/(s/Sqrt[Length[data]])          In[4]:= myZTest[data, 20, 540]          Out[4]:= 2.19469      My understanding of how ZTest works is that `Out[2]==Out[4]`, what gives? Do I misunderstand the definition? Edit: I've checked my example with the wolfram alpha z test calculator and the result agrees with Out[4].


How to convert a notebook cell to a string retaining all formatting, colorization of identifiers etc?

I have an opened _Mathematica_ notebook containing several cells. Suppose, I am interested in one of them -- it may contain a complete or incomplete expression (e.g. with syntax errors, highlighted unbalanced brackets etc), possibly with embedded graphics, some of the identifiers automatically colorized by _Mathematica_ Front End according to their meaning (undefined symbols, `Block` locals, `Module` locals, conflicting names...) and some possibly having a manually changed style (font, size, color etc). I need to get a `String` whose content represents the content of this cell with highest possible fidelity (recall that _Mathematica_ strings preserve formatting and support arbitrary embedded expressions including graphics). The string should mimic the structure and be editable to the same extent as the original cell (so it should not, for example, contain just a graphical image depicting the cell). Could you please suggest how to do this?


How to set image DPI?

For publications usually images in TIFF format are required in high resolutions. Where can I change settings for images that are being saved (using RMB click "Save Graphic As..."), so I don't need to post process them in Illustrator?


How to represent and manipulate abstract indexed vector (or tensor) expressions?

I have a couple abstract indexed quantities, both differential elements $dx = dx^\mu e_\mu + x^\mu de_\mu$ $du = du^\mu e_\mu + u^\mu de_\mu$ I can compute the expression $(dx + du) \cdot (dx + du) - dx \cdot dx$ manually on paper, contracting the products appropriately and taking the differences. However, evaluating that end result for specific parameterizations and basis representations becomes messy (I've done only the 3D Euclidian cartesian and cylindrical coordinate cases). This seems to be a perfect opportunity for a symbolic computation engine, but I'm having trouble starting. The mathematica book hints that tensor expressions can be represented by lists, but an expression of the above form does not require any specific dimensionality, and can still be symbolically manipulated (on paper). If I use a list, does that list not have to have specific dimension? For example, I'm guessing that I could use an explicit 3D representation for the upper index coordinates like so:               x = { x1, x2, x3 }     u = { u1, u2, u3 }      then define a metric tensor for the lower index coordinates. I don't know how I'd represent the basis vectors $e_\mu$ in Mathematica though, even if I restricted myself to 3D Euclidean spaces. Is this sort of computation within the scope of Mathematica, and if so, how does one setup the variables?


Speeding up Position for finding the indices of a small number of integer elements in a large matrix

I have a large $100 \times 4000$ element matrix composed of integer elements, `testMatrix`, and I was to use `Position` to find the indices of integers larger than some threshold value `thresholdValue`. The following works:               Position[testMatrix, x_ /; x >= thresholdValue, 2]      However it takes over $\approx 150$ milliseconds to execute. Given that the number of positions is typically around $10^3$, is there a way to achieve a significant speedup for this procedure?


Extracting variables from Hold expression

For example I have some global assignments `x=1;y=2;z=3` and an expression `Hold[x*y/z]`. How can I now extract variables `{x,y,z}` from this expression, do some manipulations with them and substitute their values back? The point is to be able to this without providing variable names by hand inside of `Block` like so:               Block[{x,y,z},       ..     ]


Delete pairs from a list

I have a data set in which I need to remove all matched pairs of entries - not just the first entry that is duplicated but both entries. To add to the complexity, the pairs must be between different columns of the data set. So if I generate an example data set as follows:               SeedRandom[2]     dataSet =        Table[{DatePlus[Take[DateList[], 2], i], RandomInteger[{1, 30}],          RandomInteger[{1, 30}]}, {i, 50}];     Grid[%]      To yield a data set of:                   {      {{2014, 6, 2}, 8, 4},      {{2014, 6, 3}, 5, 4},      {{2014, 6, 4}, 7, 4},      {{2014, 6, 5}, 0, 1},      {{2014, 6, 6}, 0, 4},      {{2014, 6, 7}, 3, 7},      {{2014, 6, 8}, 3, 0},      {{2014, 6, 9}, 2, 7},      {{2014, 6, 10}, 8, 7},      {{2014, 6, 11}, 3, 6}     }      I want to remove any rows in which a value in column 2 matches a value in column 3 (please ignore the date column [[1]] as it is not relevant at the moment). If a match is found between values in column 2 and 3 then both entries should be removed. Zero entries should be ignored and left in the data set so the resultant data set would look like:               {      {{2014, 6, 2}, 8, 4},      {{2014, 6, 3}, 5, 4},      {{2014, 6, 5}, 0, 1},      {{2014, 6, 6}, 0, 4},      {{2014, 6, 8}, 3, 0},      {{2014, 6, 9}, 2, 7},      {{2014, 6, 10}, 8, 7},      {{2014, 6, 11}, 3, 6}     }      Note that the actual data set only has a non-zero entry in one of the two columns for a row but it was too difficult for me to reproduce this easily for this example data. I am unable to get DeleteDuplicates to do what I want so am stumped as to what to do. * * * * * * My apologies, it looks like my earlier edits did not stick. I'll reformat the data to remove the ambiguity (note goal posts are not moving - just additional clarification of the data). Generate example data:               SeedRandom[2]     dataSet =        Table[{Junk, RandomInteger[{0, 8}], RandomInteger[{0, 8}]}, {i,          10}];     Grid[%]               {      {Junk, 8, 4},      {Junk, 5, 4},      {Junk, 7, 4},      {Junk, 0, 1},      {Junk, 0, 4},      {Junk, 3, 7},      {Junk, 3, 0},      {Junk, 2, 7},      {Junk, 8, 7},      {Junk, 3, 6}     }      Output:               {      {Junk, 8, 4},      {Junk, 5, 4},      {Junk, 0, 1},      {Junk, 0, 4},      {Junk, 3, 0},      {Junk, 2, 7},      {Junk, 8, 7},      {Junk, 3, 6}     }      Hopefully that removes the ambiguity of the first column and enables us to concentrate on columns 2 and 3. I do apologise for the confusion. I will go through all the answers as I'm sure there are already some that demonstrate a good solution.


Funny behavior of Ellipsoid function

From its description I thought that the normalizations of the directions `d_i` of the semi-axes did not matter when using the `Ellipsoid` function. Indeed, the following two commands give the same output:               Needs["MultivariateStatistics`"];     Graphics[Ellipsoid[{0, 0}, {1, 1}, {{0, 1}, {1, 0}}], Axes -> True]     Graphics[Ellipsoid[{0, 0}, {1, 1}, {{0, 100}, {100, 0}}], Axes -> True]      However, if the normalization of the two directions is different, I get a funny behavior. Basically, the radii are multiplied by the normalization of the first direction vector. Use for example:               Graphics[Ellipsoid[{0, 0}, {1, 1}, {{0, 100}, {1, 0}}], Axes -> True]      Does anyone know what is going on?


What are recommended guidelines for developing packages?

This might be of general interest – I have different questions regarding naming conventions, contexts, subcontexts, shadowing, etc., but I do feel that they are closely related, thus I don't really want to split this post into three.   1. **Naming**   What is the best method to name the package file, the package context, the directory of package files (or a more complex hierarchy of these files)? Which of these names **must** be the same? I got confused several times before, and though I always manage to solve a situation, I don't feel like I have a good understanding on how these things work.   2. **Shadowing**   When there are interrelated packages with different contexts where some symbols appear in all of these contexts then - when calling contexts in the same session - usually shadowing messages appear. This is useful, when such symbols have different definitions and are unintentionally named the same way, but not, in the following case. If someone has a newly introduced function _option_ , like `Verbose`, which doesn't have an `OwnValue`, then it is totally unnecessary to invoke shadowing messages, as no call of `Verbose` could do any harm. There still might be difference in the overall description of `Verbose` in two packages (even when all `OwnValues`, `DownValues`, etc. are the same), for example their usage messages might differ, as different functions would utilize the `Verbose` option in the different packages. What is the best way to deal with these things? Should a `Common.m` package be introduced, and all the related packages be moved under a common context-name and/or directory? Do they have to be in the same directory?   3. **Grouping and sub-contexts**   Following point 2, when is it useful to introduce sub-contexts (e.g. `myContext`format`` and `myContext`content``)? Should these be split into different files? How should these files be named? Is it necessary then to include a `Common.m` too or is it just for convenience? What should be kept in `Common.m`?


Cellular Automata Neighborhood as Node connections

Can I use the CellularAutomation[] function where the neighborhood is defined by the connections between nodes? For example, if 1 -> 2, 1 -> 3, 1 -> 8, 1 ->1, then the neighborhood of node 1 is the nodes 2,3,8,1. Here is what I have to start with:               Manipulate[     nodes = Sort@Flatten@Table[Range@n, {k}];     rand = RandomInteger[{1, n}, n*k];     rules = MapThread[Rule, {nodes, rand}];     colors = RandomInteger[{0, 1}, n] /. {0 -> Black, 1 -> Red};     GraphPlot3D[rules,      VertexRenderingFunction -> ({colors[[#2]], EdgeForm[Black],       Sphere[#, .1], If[colors[[#2]] === Black, Yellow, White],       Style[Text[#2, #1], FontWeight -> Bold, FontSize -> 12]} &)],      {n, 1, 20, 1}, {k, 1, 8, 1}, {step, 0, 100, 1}]


Applying Notation rules retroactively to a notebook

Suppose I define a new notation rule like               Notation[OverBar[x_] ⟺ mean[x]]      If I already have some notebooks that were written using `OverBar` directly, is there a way to tell _Mathematica_ to reinterpret the notebooks using the new rule and reparse all instances of `OverBar` as `mean`.


How to find the magnitude of a vector?

I'm doing this exercise in Wagner's book (p.78) ![Mathematica graphics](http://i.stack.imgur.com/IpzqR.png) , and this is my attempt:               Clear[curvature];          (*Define curvature function *)     curvature[x_, y_, z_] := Module[{s, v, T},       s = {x, y, z};       v = D[s, t];       T = v/Norm[v];       Simplify[Norm[D[T, t]/Norm[v]]]]          (* Apply function to Cos[t],Sin[t],t *)     curvature[Cos[t], Sin[t], t]      ![Mathematica graphics](http://i.stack.imgur.com/9H8z7.png) As you could see I did not get the expected answer (1/2) when applying my curvature function. It also would not reduce even when a value for t was substituted:               curvature[Cos[t], Sin[t], t] /. t -> 4      ![Mathematica graphics](http://i.stack.imgur.com/jfRBB.png) However, following Wagner's solution where he defines a separate magnitude function does work:               Clear[curvature];          (* Define function to find magnitude of a vector *)     mag[vec_] := Sqrt[vec.vec]          (* Define curvature function *)     curvature[x_, y_, z_] := Module[{s, v, T},       s = {x, y, z};       v = D[s, t];       T = v/mag[v];       Simplify[mag[D[T, t]/mag[v]]]]          (* Apply function to Cos[t],Sin[t],t *)     curvature[Cos[t], Sin[t], t]      ![Mathematica graphics](http://i.stack.imgur.com/L5B62.png) It seems pretty clear that using Norm to find the magnitude of a vector does not work in this case. More specifically, using Norm doesn't seem to simplify trigonometric results unless the t is substituted               Norm[{Cos[t], Sin[t]}]     Norm[{Cos[t], Sin[t]}] /. t -> 4 // Simplify      ![Mathematica graphics](http://i.stack.imgur.com/IDd4U.png) I'm very fuzzy on my matrix knowledge so I'd really appreciate an explanation on why Norm doesn't seem to return the expected answer in this case. Also, is there any other way to find a vector's magnitude that will give the correct answer without defining a new function?


A problem involving classification of data

Toady, I encountered a problem while trying to classify certain data. I have the coordinates of six points.               data = {{0.349661, 0.380297}, {0.858156, 0.8442}, {0.906745, 0.171579},      {0.0847783, 0.277227}, {0.198453, 0.40206}, {0.941614, 0.347187}};      I want to perform some operation on the x coordinate. The operation is as follows. If the x coordinate in one of the following ranges               {{0.0423892, 0.141616}, {0.141616, 0.274057}, {0.274057, 0.603909},       {0.603909, 0.882451}, {0.882451, 0.924179}, {0.924179, 0.959049}}      The new x coordinate will have the value 1, 2, 3, 4, 5, 6 respectively. I tried the following:               judge = {{0.0423892, 0.141616}, {0.141616, 0.274057}, {0.274057, 0.603909},         {0.603909, 0.882451}, {0.882451, 0.924179}, {0.924179, 0.959049}};     Which[Sequence @@             Flatten@Table[{judge[[i, 1]] < # < judge[[i, 2]] &, i}, {i, 1, 6}]] /@      data[[All, 1]]      However, it failed. I discovered the mistake was               Table[{judge[[i, 1]] < # < judge[[i, 2]] &, i}, {i, 1, 6}]      I got > >     {{judge[[i, 1]] < #1 < judge[[i, 2]] &, 1}, >      {judge[[i, 1]] < #1 < judge[[i, 2]] &, 2}, >      {judge[[i, 1]] < #1 < judge[[i, 2]] &, 3}, >      {judge[[i, 1]] < #1 < judge[[i, 2]] &, 4}, >      {judge[[i, 1]] < #1 < judge[[i, 2]] &, 5}, >      {judge[[i, 1]] < #1 < judge[[i, 2]] &, 6}} >   rather than > >      {{judge[[1, 1]] < #1 < judge[[1, 2]] &, 1}, >       {judge[[2, 1]] < #1 < judge[[2, 2]] &, 2}, >       {judge[[3, 1]] < #1 < judge[[3, 2]] &, 3}, >       {judge[[4, 1]] < #1 < judge[[4, 2]] &, 4}, >       {judge[[5, 1]] < #1 < judge[[5, 2]] &, 5}, >       {judge[[6, 1]] < #1 < judge[[6, 2]] &, 6}} >


Deleting duplicates from matrix

I have a 4x4 symmetric matrix that is obtained by solving some equations. I tried deleting duplicates with `DeleteDuplicates`, but that's not working with nested lists (elements of those lists that are the same). So I have this $$\begin{pmatrix} a_{11} & a_{12} & a_{13} & a_{14} \\ a_{21} & a_{22} & a_{23} & a_{24} \\ a_{31} & a_{32} & a_{33} & a_{34} \\ a_{41} & a_{42} & a_{43} & a_{44} \\ \end{pmatrix}\to a_{nm}=a_{mn}\to \begin{pmatrix} a_{11} & a_{12} & a_{13} & a_{14} \\ 0 & a_{22} & a_{23} & a_{24} \\ 0 & 0 & a_{33} & a_{34} \\ 0 & 0 & 0 & a_{44} \\ \end{pmatrix}$$ I'd like to be able to remove lower triangle of a matrix but only if they are the same. How to do that?


NDSolve fails to solve vector-valued function x'[t] == a . x[t] + u . b

I get no solution when I run the following command:               NDSolve[{       x'[t] ==          0. {{0}, {0}, {1.}} + {{0, 1., 0.}, {0, 0., 1.}, {0., -0.156816, -0.523512}} . x[t],       x[0] == {0, 0, 0}},        x, {t, 0, 1}]      The kernel just keeps running forever until I kill it. If I remove the `0\. {{0}, {0}, {1.}}` term, then it works fine. I'd appreciate your help with this issue.


Importing data to make a DateListPlot

I am having a hard time trying to import some text data for later use in `DateListPlot`. My first field in my data is a date of the format "yyyymmdd". I tried to use both `ReadList` and `Import`, but I cannot get `DateListPlot` to understand that my date is truly a date.               data =       Import["/path/to/data.txt", "Table", "DateStringFormat" -> {"Year", "Month", "Day"}] //Short      > >     {{20131217, 123123.}, <<50>>, {20140313, 321321.}} >                 DateListPlot[data, Filling -> Axis]      > DateListPlot::ntdt: The first argument to DateListPlot should be a list of > pairs of dates and real values, a list of real values, or a list of several > such lists. >> With `ReadList` I tried to see if I could use `StringSplit`, but that didn't seem to work either. Any pointers would be most appreciated. Edit: I added some more data.               data = Import[     "/path/to/file.txt",      "Table", "DateStringFormat" -> {"Year", "Month", "Day"}] //TableForm          {      {20131217, 114812.},      {20131220, 114192.},      {20131221, 114192.},      {20131223, 114192.},      {20131224, 114504.},      {20131226, 115408.},      {20131227, 115165.}     }


WhenEvent and partial derivatives

Can `WhenEvent` be used to reset the conditions on a PDE at a given time? How would the syntax of that be? This is the code I`m using               r = 2;     d2 = 1;     l = 5;     sol = NDSolve[{Derivative[0, 1][n][x, t] ==                    d2 Derivative[2, 0][n][x, t] + r*n[x, t]*(1 - n[x, t]),                    n[x, 0] == 0.1*x*(1 - x/l), n[0, t] == 0, n[l, t] == 0,                    WhenEvent[t == 50, n[x, t] -> 0]}, {n}, {x, 0, l}, {t, 0, tmax}]


Finding residues of multi-dimensional complex functions

Say I have a function $f$ of $n$ complex variables, $\{ z_i \}_{i=1}^{i=Nc}$. And then I want to contour integrate the expression such that for each $z_i$ its an integration on an unit circle about the origin in the complex plane: $$\oint_{\cal C}\cdots \oint_{\cal C} f(z_1,\cdots, z_n) d z_1 .. d z_n$$ I would guess that in some sense this should pick out the "residue" of the n-dimensional complex function $f$. (...I am not exactly sure of a residue interpretaton for such contour integrations on the complex plane...) I would like to know how to set this up in Mathematica (..hopefully as a residue finding problem..)


Using single replacement rule to convert algebraic expression

I have been trying this problems for hours and cannot find any helpful clues. How can I convert $Sinh[3\theta]+Sinh[\theta]$ to a rational function of x given $2Sinh[\theta] = x-x^{-1}$ by using only a **SINGLE** pattern replacement rule. I guess what single means is that we are only allowed to use one arrow. My question is twofold:   1. I have one method but unsure of its correctness, also although I know the method but I am unable to write the code.   2. If my method is wrong, what is the correct one? This is the best method that I can think of. My method is as follows:   Since we have the hyperbolic trig formula, we can use the rule (I will use Q instead)               Sinh[a Q] -> (x^a - x^-a)/2      I have tried many ways, and below are the 2 best ones that I think are the closest to the correct answers:               In: f := {Sinh[a Q] + Sinh[Q]} /. Sinh[a Q] -> (x^a - x^-a)/2;     In: {Sinh[3 Q]] + Sinh[Q]} // f        > `Out: {1/2 (-x^-a + x^a) + Sinh[Q]}[{Sinh[Q] + Sinh[3 Q]}]`               In: {Sinh[#1 Q] + Sinh[#2 Q]} /. Sinh[# Q] -> (x^# - x^-#)/2 &[3, 1]        > `Out: {1/2 (-(1/x^3) + x^3) + Sinh[Q]]}` I always have troubles putting the rules into one entity such that it will replace every coefficient of Q, including 1. The output that I am looking for (using my method) is               Sinh[3Q] + Sinh[Q] = x^3 - x^-3 + x - x^-1        Many thanks.


Symbolic integration in real domain only ( assumptions and ComplexExpand don't work)

`Integrate[m^2/((x - m^2)^2 + y^2), m]` mathematica gives me a complex-valued reuslt, but maple 17 gives me what I want. ![maple result](http://i.stack.imgur.com/TXAz5.png) I tried using assumptions, but it doesn't work. In MMA, is there a general way to do integrations in real domains, just like maple. Can this wrap bulit-in command proposed by Todd Gayley (see: http://stackoverflow.com/questions/4198961/what-is-in-your-mathematica-tool- bag ) do the trick?               Message[args___] := Block[{$inMsg = True, result},         "some code here";         result = Message[args];         "some code here";         result] /; ! TrueQ[$inMsg]      Perhaps the reason for the complex-valude result is the invovled power calculation during the integration, so maybe what I really need is a general way to do symbolic power calculation in real domains? ComplexExpand doesn't work as in the post integration on real domain only!. thanks :)


Speeding up inversion of symbolic matrices by invoking caching

Is it possible to reduce the computation time taken to find inverse of symbolic matrices **USING CACHING TECHNIQUES** accessible (if any)? I am trying to compute inverse of symbolic matrices of size 12x12. I see that when the timing recudes drastically when I repeat the calculation.               For[i= 1, i <= 10, i++,      AbsoluteTiming[         K1inv = Simplify@Inverse[K1];         ][[1]] // Print      ]      gives output timings               21.6312373     2.9041661     1.2300704     1.2350706     1.2360707     1.2270702     1.2260701     1.2340706     1.2630723     1.3620779      Is there a way to USE the CACHING to speedup the computations of such matrices in general? This link on SE points in that direction, but not answers the caching aspect **EDIT 1:** To be precise, the question is,   * is there any predicatable takeaway from the caching - i.e. something that I can count on (in terms of time-saving)?   * Is there anything I can do as a user to speedup further operations.  This question arises since I am not aware of how exactly caching helps - does it extend to only the EXACT SAME matrix (wherein memoization would solve it) OR does the caching speedup inversions of the SAME ORDER (i.e. for ANY other matrix of 12x12) OR would it speedup ANY ORDER less than the current order OR anything else ?


Computing Correlations and p-values

I have two vectors $A$ and $B$ of length (say) $50$ or so, and I want to determine whether there is any correlation between their entries. I computed their correlation directly and found it to be positive, but I also wanted to compute a $p$-value to confirm the implication that the entries are not completely independent. However, when I asked _Mathematica_ to compute the following: > >     PearsonCorrelationTest[A, B, "TestDataTable"] >   It gave an answer, but it also gave the following warning: > PearsonCorrelationTest::nortst : "At least one of the p-values in {0.508..., > 0} resulting from a test for normality, is below 0.025. The tests in > {"PearsonCorrelation"} require that the data is normally distributed. I couldn't find any further documentation on what _Mathematica_ was doing. What assumptions on the vectors $A$ and $B$ is required for `PearsonCorrelationTest` to give a sensible answer?


Safe values of $\mu$ and $\sigma$ when randomly sampling from a Log-Normal Distribution?

I believe I'm obtaining overflow errors when randomly sampling from a log- normal distribution with the command:               RandomVariate[LogNormalDistribution[μ, σ], 1]      Specifically, I can obtain an accurate looking distribution with values of $\mu \approx 1$ and $\sigma \approx 1$, but I get significant outliers for values of $\mu > 10$ and $\sigma > 10$. Why would this occur? Isn't it true that the ratio $\dfrac{\mu}{\sigma}$ should govern the probability of obtaining values $\gg \mu$? What values of $\mu$ and $\sigma$ will give accurate values properly reflecting a random sample from `LogNormalDistribution`?


Beginner's question: Gap between FrameLabel and BarChart

I have a BarChart (Mathematica 9.0.1)               BarChart[{1, 2, 3},     ChartLabels -> (Rotate[Text[Style[#, FontSize -> Scaled[0.05]]], -Pi/2]     & /@{abcdabcd,abcdabcd, abcdabcd})]      ![enter image description here](http://i.stack.imgur.com/VLHWN.png) and would like to add a vertical label to the y-axis. I tried               BarChart[{1, 2, 3},     ChartLabels -> (Rotate[Text[Style[#, FontSize -> Scaled[0.05]]], -Pi/2]     & /@ {abcdabcd, abcdabcd, abcdabcd}),     FrameLabel -> {None, "y-axis"},     Frame -> {False, True, False, False}]      and it's perfect except for a gap between the two axes (which is somehow extremely ugly with the actual data): ![enter image description here](http://i.stack.imgur.com/1NSGg.png) I tried using Labeled, but then the label is positioned too low (i want it at the center of the y-axis):               Labeled[BarChart[{1, 2, 3},     ChartLabels -> (Rotate[Text[Style[#, FontSize -> Scaled[0.05]]], -Pi/2]     & /@ {abcdabcd, abcdabcd, abcdabcd})],     {Rotate[Style["y-axis", FontFamily -> "Helvetica"], Pi/2]}, {Left}]      (Can't post > 2 links) Any help would be most appreciated!


How to get a solution for the following equation?

When I try to solve this equation using Mathematica:               Solve[Exp[b*x]-c*(x^2)-a*x-1 == 0, x] /. {a -> 6.336, b -> 8, c -> 32}      I don't get any result and this error message: > Solve was unable to solve the system with inexact coefficients or the system > obtained by direct rationalization of inexact numbers present in the system. > Since many of the methods used by Solve require exact input, providing Solve > with an exact version of the system may help. > > Out[60]= Solve[-1 + E^(8 x) - 6.336 x - 32 x^2 == 0, x] I also tried Reduce and Nsolve instead of Solve with no luck!! Note that I don't get even the obvious solution of x==0. Although I would like to have a solution with x!=0.


Using Derivative with list in curly brackets

I'd like to make a formula for a sum containing `Derivative` where the number of arguments in the latter depends on an input parameter n. Also involved is a list `c` calculated before and a function `f` that has n inputs. Here's the version for n=2               c[[1,2]]*Derivative[c[[1,1,1],c[[1,1,2]]]][f][z1,z2]+     c[[2,2]]*Derivative[c[[2,1,1],c[[2,1,2]]]][f][z1,z2]+     c[[3,2]]*Derivative[c[[3,1,1],c[[3,1,2]]]][f][z1,z2];      And here for n=3:               c[[1,2]]*Derivative[c[[1,1,1],c[[1,1,2],c[[1,1,3]]]][f][z1,z2,z3]+     c[[2,2]]*Derivative[c[[2,1,1],c[[2,1,2],c[[2,1,3]]]][f][z1,z2,z3]+     c[[3,2]]*Derivative[c[[3,1,1],c[[3,1,2],c[[3,1,3]]]][f][z1,z2,z3]+     c[[4,2]]*Derivative[c[[4,1,1],c[[4,1,2],c[[4,1,3]]]][f][z1,z2,z3]+     c[[5,2]]*Derivative[c[[5,1,1],c[[1,1,2],c[[5,1,3]]]][f][z1,z2,z3]+     c[[6,2]]*Derivative[c[[6,1,1],c[[6,1,2],c[[6,1,3]]]][f][z1,z2,z3];      And so on. I was thinking about how I can make this more general and I think I can almost get it working using `sum`, doing something like (for n=4)               Sum[c[[i,2]]]*Derivative[Table[c[[i,1,j]],{j,1,4}]][f][z1,z2,z3,z4],{i,1,24}];      The problem with this is that `Table` outputs a list with curly brackets, and this won't work with `Derivative`, as seen from e.g. running               f[x_,y_]=x^2+5*x*y;     Derivative[1,1][f][x,y]     Derivative[{1,1}][f][x,y]      The first way works but not the second. Trying to get rid of the brackets I've tried `Flatten` with different inputs but that seems to only remove brackets inside brackets; I can't get rid of the outermost ones. Does anyone know a way to get rid of the brackets from a `Table`, or use `Derivative` with a list in curly brackets? Or maybe a better way to do the whole thing?


Defining a new matrix product of matrix function

Suppose I have two matrices A, B, whose entries are functions of x. Suppose they are 2*2. In the product, each entry is of the form $\sum_k A_ik B_kj$. There are two summands corresponding to k=1,k=2. I want to evaluate the two summands at some point, say x=5, and pick out the larger summand as a function of x to form a new matrix c, I write the codes as follows. I think the mistake is in the data type of c,               A[x_]={{x,2x},{3,4}};     B[x_]={{x,x^2},{4,5}};          (*first create a matrix c whose entries are set to 0*)          For[i=1,i<3,i++,            Forj=1,j<3,j++, c[x_][i][j]=0     ]     ];               For[i=1,i<3,i++,            For[j=1,j<3,j++,              For[k=1,k<3,k++,                 If[ c[5][i][j]<A[5][[i,k]]*B[5][[k,j]],                c[x][i][j]=A[x][[i,k]]*B[x][[k,j]],                c[x][i][j]=c[x][i][j]              ]           ]         ]       ];               Table[c[x][i][j], {i,10},{j,10}]//MatrixForm      In the output, you can see that the (2,2) entry is the resulting matrix is wrong.


How do I show the combined plot from the do-loop?

I have a do-loop to do the calculations from a set of data and plot the graphs with different results, that was obtained from the calculations. I was able to get multiple graphs but I want to ListPlot the different graphs in one plot. Basically, I just want one graph by the end of do-loop plotting the results. * * * `a = 0; b = 1; Do[a++; b++;``t[a]; t[b];` `Do[temp[i] = Transpose[t[i]]; counter[i] = temp[i][[1]]; totaltime[i] = temp[i][[2]]; id[i] = temp[i][[3]]; edge[i] = temp[i][[4]]; area[i] = temp[i][[5]], {i, a, b}];` `VT = Table[Null, {i, 1, z}]; (*VT={reduced area with time}*)` `Do[j = Flatten[Position[id[a], id[b][[i]]]][[1]]; If[edge[b][[i]] == edge[a][[j]], V = (area[b][[i]] - area[a][[j]])/scale; VT[[i]] = {totaltime[a][[j]], V}], {i, 1, z}];`   `minE = Min[edge[b]]; maxE = Max[edge[b]];` `Table[T[i] = Take[VT], {i, 1, m - 1, 1}]; Print[T[i]] Print[ListPlot[{T[i]}, Frame -> True, PlotRange -> {minE - 6 - 1, maxE - 6 + 1}, Axes -> False, GridLines -> {None, Table[i, {i, minE - 6, maxE - 6}]}, PlotLabel -> StringJoin["Interval = ", ToString[interval]]]] , {i, 1, m - 1, 1}]` I have edited the code. I'm new to this so please forgive me for the mistakes. I know that ListPlot can plot multiple sets in one plot like"ListPlot[{data1,data2,...}, Frame -> True," However I have like hundreds of output data and that's where I can't seems to do. My code above gives multiple plots and I just want one output plot.


Cannot get specific value from NDSolve (multiple functions)

I am trying to solve six connected differential equations. This is my code:               Clear[Solution,P1,P2,P3,Pbar1,Pbar2,Pbar3,tmax];     tmax=2;     Solution=NDSolve[Rationalize @ {     P1'[t]==-0.01 0.99995 P2[t]-Pbar2[t] P3[t]+Pbar3[t] P2[t],     P2'[t]==-0.01(-0.99995 P1[t]-0.01 P3[t])-Pbar3[t] P1[t]+Pbar1[t] P3[t],     P3'[t]==-0.01 0.01 P2[t]-Pbar1[t] P2[t]+Pbar2[t] P1[t],          Pbar1'[t]==0.01 0.99995 Pbar2[t]+P2[t] Pbar3[t]-P3[t] Pbar2[t],     Pbar2'[t]==-0.01(-0.99995 Pbar1[t]-0.01 Pbar3[t])+P3[t] Pbar1[t]-P1[t] Pbar3[t],     Pbar3'[t]==-0.01 0.01 Pbar2[t]+P1[t] Pbar2[t]-P2[t] Pbar1[t],          P1[0]==0,P2[0]==0,P3[0]==1,Pbar1[0]==0,Pbar2[0]==0,Pbar3[0]==1},          {P1[t],P2[t],P3[t],Pbar1[t],Pbar2[t],Pbar3[t]},{t,0,tmax}]      No errors and I get the normal output. There is something wrong with it, because the plot doesn't look like I want it to. That is not your problem, but when I try to check the solution by:               P3[0]/.Solution      I get               {P3[0]}      when I expect to get               {1}      or something like that. Does anyone know what's wrong?


How to translate and scale an image via ImageTransformation

Is there a way to translate and scale a 2D image simply by using `ImageTransformation[]` and `TransformationFunction[]`? I know how to scale (it's included in `TransformationFunction[]`), but I don't know how to translate, or, even harder, translate AND rotate. Again, I'd really like to stick to the functions `ImageTransformation[]` and `TransformationFunction[]`.


Formatting an equation on a plot

I am trying to label a plot with an equation. The problem is that Mathematica formats things _almost_ well but not exactly. The parenthesis are of the wrong size, and the powers are not high enough. For example:               testplot = RegionPlot[x^2 + y^3 < 2, {x, -2, 2}, {y, -2, 2}];     Overlay[{testplot,              Text[(10^-3/\[Beta])^2  (("1")/g') < 2, BaseStyle -> {FontSize -> 18}]},              Alignment -> {0.9, 0.85}            ]      I need the equation to look like it would on Latex, but here is what I get instead: ![Mathematica evaluates the expression instead](http://i.stack.imgur.com/Z9mBL.gif) I tried putting the equation between "" but the parenthesis would be the wrong size and the powers are off. Just like this: ![Formatting the equation as text](http://i.stack.imgur.com/ND436.png) Any suggestions? Thanks! L.


Solving huge equations

I have this expression: $d=-\frac{\sqrt{\frac{780 (f+130) \left(5 d^2 (13 c+f+130)-5 d (c (f+1300)-325 (f+160))+125 \left(2 (2 c+725) f+5 f^2+104000\right)+13 d^3\right) \left(5 d^2 (52 c+17 f+2600)+5 d \left(c (61 f+5200)+5 \left(f^2+290 f+20800\right)\right)-25 c f (f+80)+52 d^3\right) \left(300 c^2 (13 d-f)+5 c \left(208 d^2+d (121 f-2600)-5 \left(f^2+1280 f+156000\right)\right)+d \left(52 d^2+5 d (17 f+2600)+25 \left(f^2+290 f+20800\right)\right)\right)}{\left(5 d (13 c+f-130)-5 ((c+100) f+13000)+13 d^2\right)^3}+\left(-\frac{13 \left(5 d^2 (52 c+17 f+2600)+5 d \left(c (61 f+5200)+5 \left(f^2+290 f+20800\right)\right)-25 c f (f+80)+52 d^3\right)^2}{4 \left(5 d (13 c+f-130)-5 ((c+100) f+13000)+13 d^2\right)^2}+\frac{(25 (5 f+728)-780 c) \left(5 d^2 (52 c+17 f+2600)+5 d \left(c (61 f+5200)+5 \left(f^2+290 f+20800\right)\right)-25 c f (f+80)+52 d^3\right)}{4 \left(5 d (13 c+f-130)-5 ((c+100) f+13000)+13 d^2\right)}+975 c (f+80)\right)^2}+\frac{13 \left(5 d^2 (52 c+17 f+2600)+5 d \left(c (61 f+5200)+5 \left(f^2+290 f+20800\right)\right)-25 c f (f+80)+52 d^3\right)^2}{4 \left(5 d (13 c+f-130)-5 ((c+100) f+13000)+13 d^2\right)^2}+\frac{195 c \left(5 d^2 (52 c+17 f+2600)+5 d \left(c (61 f+5200)+5 \left(f^2+290 f+20800\right)\right)-25 c f (f+80)+52 d^3\right)}{5 d (13 c+f-130)-5 ((c+100) f+13000)+13 d^2}-\frac{125 f \left(5 d^2 (52 c+17 f+2600)+5 d \left(c (61 f+5200)+5 \left(f^2+290 f+20800\right)\right)-25 c f (f+80)+52 d^3\right)}{4 \left(5 d (13 c+f-130)-5 ((c+100) f+13000)+13 d^2\right)}-\frac{4550 \left(5 d^2 (52 c+17 f+2600)+5 d \left(c (61 f+5200)+5 \left(f^2+290 f+20800\right)\right)-25 c f (f+80)+52 d^3\right)}{5 d (13 c+f-130)-5 ((c+100) f+13000)+13 d^2}-975 c f-78000 c}{104 \left(-\frac{5 d^2 (52 c+17 f+2600)+5 d \left(c (61 f+5200)+5 \left(f^2+290 f+20800\right)\right)-25 c f (f+80)+52 d^3}{4 \left(5 d (13 c+f-130)-5 ((c+100) f+13000)+13 d^2\right)}-15 c\right)}$ The raw mathematica input for this is:               d == -(((13*(52*d^3 + 5*(52*c + 17*f + 2600)*d^2 + 5*(c*(61*f + 5200) + 5*(f^2 + 290*f + 20800))*d - 25*c*f*(f + 80))^2)/       (4*(13*d^2 + 5*(13*c + f - 130)*d - 5*((c + 100)*f + 13000))^2) +       (195*c*(52*d^3 + 5*(52*c + 17*f + 2600)*d^2 + 5*(c*(61*f + 5200) + 5*(f^2 + 290*f + 20800))*d - 25*c*f*(f + 80)))/       (13*d^2 + 5*(13*c + f - 130)*d - 5*((c + 100)*f + 13000)) -       (4550*(52*d^3 + 5*(52*c + 17*f + 2600)*d^2 + 5*(c*(61*f + 5200) + 5*(f^2 + 290*f + 20800))*d - 25*c*f*(f + 80)))/       (13*d^2 + 5*(13*c + f - 130)*d - 5*((c + 100)*f + 13000)) -       (125*f*(52*d^3 + 5*(52*c + 17*f + 2600)*d^2 + 5*(c*(61*f + 5200) + 5*(f^2 + 290*f + 20800))*d - 25*c*f*(f + 80)))/       (4*(13*d^2 + 5*(13*c + f - 130)*d - 5*((c + 100)*f + 13000))) - 78000*c - 975*c*f +       Sqrt[(-((13*(52*d^3 + 5*(52*c + 17*f + 2600)*d^2 + 5*(c*(61*f + 5200) + 5*(f^2 + 290*f + 20800))*d - 25*c*f*(f + 80))^2)/            (4*(13*d^2 + 5*(13*c + f - 130)*d - 5*((c + 100)*f + 13000))^2)) + ((25*(5*f + 728) - 780*c)*(52*d^3 + 5*(52*c + 17*f + 2600)*d^2 +              5*(c*(61*f + 5200) + 5*(f^2 + 290*f + 20800))*d - 25*c*f*(f + 80)))/(4*(13*d^2 + 5*(13*c + f - 130)*d - 5*((c + 100)*f + 13000))) +           975*c*(f + 80))^2 + (780*(f + 130)*(13*d^3 + 5*(13*c + f + 130)*d^2 - 5*(c*(f + 1300) - 325*(f + 160))*d +            125*(5*f^2 + 2*(2*c + 725)*f + 104000))*(52*d^3 + 5*(52*c + 17*f + 2600)*d^2 + 5*(c*(61*f + 5200) + 5*(f^2 + 290*f + 20800))*d -            25*c*f*(f + 80))*(300*(13*d - f)*c^2 + 5*(208*d^2 + (121*f - 2600)*d - 5*(f^2 + 1280*f + 156000))*c +            d*(52*d^2 + 5*(17*f + 2600)*d + 25*(f^2 + 290*f + 20800))))/(13*d^2 + 5*(13*c + f - 130)*d - 5*((c + 100)*f + 13000))^3])/     (104*(-15*c - (52*d^3 + 5*(52*c + 17*f + 2600)*d^2 + 5*(c*(61*f + 5200) + 5*(f^2 + 290*f + 20800))*d - 25*c*f*(f + 80))/        (4*(13*d^2 + 5*(13*c + f - 130)*d - 5*((c + 100)*f + 13000))))))      I want to solve for $d$ for real solutions. I'm using               Solve[Out[19], d, Reals]      It seems to run for ages - will it complete? Is this the way I should be doing it?


How to do Cases with multiple related patterns?

I would like to write a function similar to `Cases`, but can search for a group of related patterns together. For example,               casesList[f[x] g[x] + f[y] + g[y]/f[z], {f[a_], g[a_]}]      > {{f[x], g[x]}, {f[y], g[y]}} By "related patterns", I mean that in the above example `a_` matches the same `x` for both `f` and `g` at the first list, and matches `y` at the second list. Note that here the input `{f[a_], g[a_]}` could be any other patterns. As another example,               caseList[D[f[x,y],x] + D[f[x,y],y] + D[g[x,y],x] + D[g[x,y],y],         {D[f_[x_,y_],x_], D[f_[x_,y_],y_]}]      > {{Derivative[1, 0][f][x, y], Derivative[0, 1][f][x, y]}, {Derivative[1, > 0][g][x, y], Derivative[0, 1][g][x, y]}} Is there a simple way to do this? Thanks! **EDIT:** To further clarify the question, I'd like to compare the situation with Cases for a list. For example,               Cases[{{f[a], f[b]}, {f[c], f[c]}}, {f[a_], f[a_]}, Infinity]      > {{f[c], f[c]}}               Cases[{{f[c], f[c]}}, {f[a_], f[b_]}, Infinity]      > {{f[c], f[c]}} In the above two examples, `Cases` does exactly what I want. However, more generally the expressions which match `f[a_]` does not necessarily stays in a list structure, but rather may be at elsewhere in the expression. This is the major difficulty I met.


Simplifying expression to evaluate limit as $y\rightarrow 0$

I often end up with a function that contains the term $1/(1 + x^2/y^2)$, and I need to evaluate this in the limit $y\rightarrow 0$. By hand, I can rewrite this as $y^2/(y^2 + x^2)$, but how can I tell _Mathematica_ to make such a simplification? I have tried using `1/(1 + x^2/y^2) // Simplify` and `Expand`, but neither work as intend (actually, they doesn't change anything).


Discrete Fourier Transform and data manipulate

I solve a system od ODE and i save the discrete solution (i.e.: x,y,vx,vy, or a subset of it) in a file. Then i try to call the DFT on this file but the problem is that i must have also the time in the file to make some analysis for instance something like: {t,x} or {t,vy} !               Clear["Global`*"];     m = {X, Y, Vx, Vy} /. NDSolve[{            Derivative[1][X][t] == Vx[t],            Derivative[1][Y][t] == Vy[t],            Derivative[1][Vx][t] ==              2 Vy[t] +               X[t] - ((1 - mu) (mu + X[t]))/((mu + X[t])^2 + Y[t]^2)^(              3/2) - (mu (-1 + mu + X[t]))/((-1 + mu + X[t])^2 + Y[t]^2)^(              3/2),            Derivative[1][Vy][t] == -2 Vx[t] +               Y[t] - ((1 - mu) Y[t])/((mu + X[t])^2 + Y[t]^2)^(3/2) - (              mu Y[t])/((-1 + mu + X[t])^2 + Y[t]^2)^(3/2),            X[0] == 0.56, Vx[0] == 0., Y[0] == 0.,             Vy[0] == 0.929168} /. {mu -> 0.000954}, {X, Y, Vx, Vy}, {t, 0.,            100.}, MaxSteps -> 100000][[1]];     data1 = Table[Evaluate[m[[#]][t] & /@ {1, 2}], {t, 0., 100., 0.1}]; (*here i put x and y *)     dataX = Table[Evaluate[m[[#]][t] & /@ {1}], {t, 0., 100., 0.1}]; (*only x*)     dataY = Table[Evaluate[m[[#]][t] & /@ {2}], {t, 0., 100., 0.1}]; (*only y*)          Export["Cor56.dat", data1];     data2 = Import["Cor56.dat"];     data1 == data2     ListPlot[Transpose@dataX, Filling -> None]     ListLinePlot[Abs[Fourier[dataX]]]     ListPlot[Transpose@dataY, Filling -> None]     ListLinePlot[Abs[Fourier[dataY]]]     Graphics[Point[data2]];      So the question is, how to put also the time in the file to use the DFT routine on the file? Thanks.


Evaluating an expression assuming a value for a variable only in the local context

Imagine we wish to evaluate some expression like `NIntegrate[x^2*q,{x,0,100}]` assuming some value for `q` like `q = x`. How can we do this such that:               MakeLocalAssignmentOrAssumption[q = x, NIntegrate[x^2*q,{x,0,100}]]     Print[q]      Returns:               2.5*10^7     q      In other words, how can we assume that `q = x` ONLY in the context of evaluating the `NIntegrate` expression?


Assign the Background rule in Grid (the positions can be described by a integer function)

For example, this code               Grid[Transpose[Table[{n, n^2}, {n, 1, 10}]], Frame -> All,      Background -> {{1 -> Red, 4 -> Red, 9 -> Red}}]      produces ![enter image description here](http://i.stack.imgur.com/wldsN.png), in this case, the columns has column number being a square integer, i.e the 1,4,9,16,25...etc. columns This second code does the same job:               rule = {};     Do[If[IntegerQ[Sqrt[i]], AppendTo[rule, i -> Red]], {i, 1, 10}]     Grid[Transpose[Table[{n, n^2}, {n, 1, 10}]], Frame -> All, Background -> {rule}]      or better               rule = {};     Do[AppendTo[rule, i^2 -> Red], {i, 1, 10}]     Grid[Transpose[Table[{n, n^2}, {n, 1, 10}]], Frame -> All, Background -> {rule}]      I wonder if there is a way to specify a rule, in the 3rd way, inside Grid[] directly.


Implementing a Beeswarm plot in Mathematica

I am looking for a Beeswarm plot implementation in Mathematica. Consider the following data:               data = {RandomVariate[NormalDistribution[], 100], RandomVariate[NormalDistribution[], 100]};      Let’s visualize the data as a simple 1D scatter plot:               disperse = 0.1     ListPlot[MapIndexed[{#2[[1]] +       RandomReal[{-disperse, disperse}], #1} &, data, {2}],       PlotStyle -> {Red, Green, Blue}, PlotMarkers -> {"\[CircleDot]"},       Axes -> None]      We get the following 1D scatter plots (sometimes known as “Stripcharts”). In this example the vertical coordinate of points corresponds to `data` while the horizontal one is random. ![1-D Scatterplot or Stripchart](http://i.stack.imgur.com/wlXTi.png) Sometimes it would make sense to look at the distribution of the data in addition to the data points i.e. look at all of the data points in individually in a non-overlapping manner. A Beeswarm plot does exactly this. For instance, the data in a stripchart could be re-arranged in a pleasing manner so that one would be able to understand the underlying data without resorting to statistical analysis. For instance, the figure below demonstrates some sample **Beeswarm** plots. ![Sample Beeswarm plot](http://i.stack.imgur.com/uNLBy.png) Another property of a beeswarm plot is that individual data points can be colored individually allowing for the user to understand further delineation of data. The plot below shows an example of a beeswarm plot where subsets of data are colored differently. ![Beeswarm plot with individually colored markers](http://i.stack.imgur.com/4Qr5r.png) I would like to put it up to the Mathematica gurus to advise on the best manner to generate such charts. Sample working code, of course, would be great!


Effective matrix power like algorithm

## First example Suppose you want to calculate the 6th power of some matrix $A$. The brute force attempt of doing this is considering $$(((AA)A)A)A)A$$ which requires a total of 5 matrix multiplications. However, this can be improved on by smart grouping of the matrices, for example $$((AA)A)((AA)A)$$ requires only 3 multiplications, since when the value of say $AA$ is known from the left parenthesis, it does not have to be recomputed on the right hand side. Using this type of caching can save a lot of computational power (logarithmic scaling?). ## Second example A lot more computation is necessary if we're not multiplying matrices but differential forms, since each multiplication requires the calculation of a whole lot of permutations in addition to the multiplication of the components. For example, the Liouville form in classical mechanics is $$\omega^n\propto\underbrace{\omega\wedge\omega\wedge\cdots\wedge\omega}_{n~\text{factors}}$$ where each $\omega$ is a 2-form. ## The question Since this already smells like a good application of Mathematica's "`x := x =`" trickery, I would like to solve this problem in general: **How do I divide the operations up in a smart way such that I have to do as little computational steps as possible, and how do I implement this in Mathematica?** Note that matrices were only an example application (otherwise the answer would be `MatrixPower` of course), I sumbled upon that problem a couple of times in the past in very different situations, and had to resort to possibly very ineffective implementations. ## Mathematical statement Take an associative algebra $\mathcal A$. How can $a^n$ with $a\in\mathcal A,~n\in\mathbb N$ be calculated using as little computations as possible?


Position of a particular substring in an imported HTML file

data4 = {{"050318", "111529"}}          Do[      ID2 = data4[[i, 2]];      s = Import["http://www.swift.ac.uk/xrt_curves/00" <> ID2, "Text"];      s = StringSplit[s, "\n"];      line = Position[s, "Flux Light Curve"],      {i, 1, Length[data4]}]      The `StringSplit` works properly, but when I want to identify the position it gives line `{}` empty I expect instead a number like `{{106}}` for example Even when I try with               Do[      ID2 = data4[[i, 2]];      s = Import["http://www.swift.ac.uk/xrt_curves/00" <> ID2, "Text"];      s = StringSplit[s, "\n"];      line = StringPosition[s, "Flux Light Curve"],       {i, 1, Length[data4]}]      it gives me not a single line, but many empty ones.


Is there a way to output histogram x and y data without using the Histogram chart function?

I have a large list of data (3.2 million real numbers), and I would like to plot a histogram of it. The built-in `Histogram` function is very nice, but on my computer, it is often extremely slow when trying to chart histograms of lists that are very long (~1 million real numbers). So, I would like to pre-bin the data, put it into `{x, y}` form (i.e., a list of ordered pairs), and plot it with `ListPlot` -- with the hope that this will be a workaround to using `Histogram[list, PerformanceGoal -> "Speed"]` directly. The `BinCounts` function is very nice: it takes a list, followed by a bin specification, and outputs the number of elements found within each bin. For example, consider one of the examples given in the documentation:               BinCounts[{1, 3, 2, 1, 4, 5, 6, 2}, {0, 10, 1}]     (* {0, 2, 2, 1, 1, 1, 1, 0, 0, 0} *)      where the bin specification $\{x_\min, x_\max, \text{dx}\}$ tells Mathematica to use bins which satisfy the relation $${x_\min + (i-1) \text{ dx} \leq x < x_\min + i \text{ dx}}$$ for bin $i$. But, while `BinCounts` efficiently and effectively outputs the "y" values (the counts), it does not output the "x" values (the bin positions). This is probably the case because there is some ambiguity in the term "bin position," especially for lists containing a small number of elements. But, for a list of many elements, the term "bin position" becomes less important, I think. Is there any way to automatically print both the "x" and the "y" values for a "histogram" to be plotted using `ListPlot`? Or should I write my own function? I can write my own function, but I just wanted to ask, because it seems somewhat odd that there does not seem to be a way to use `Histogram` to simply output the data (and suppress display of the fancy, time- and memory-consuming chart graphic). As far as what to use as the working "bin position," I guess that I would like to use the midpoint of the bounds of each bin. I guess this would be $$\frac{(x_\min + (i-1) \text{ dx}) + (x_\min + i \text{ dx})}{2} = \frac{1}{2}(2x_\min + (2 i - 1) \text{ dx})$$.


Head and everything except Head?

I have been working on picking expressions apart using `Head` and `Part` and encountered a little mystery. Consider the canonical example               a + b + c      which has `FullForm`               Plus[a, b, c]      We expect, then, `(a+b+c)[[0]] === Plus === Head[a+b+c]` to be `True`, and it is. But then, we would expect `(a+b+c)[[1;;3]]` would be `{a, b, c}`, wouldn't we? But it isn't. The following is true:               (a + b + c)[[1;;3]] === (a + b + c)      Somehow, `[[1;;3]]`, which is supposed to pick off elements `1` through `3` of its argument and put them in a `List`, _doesn't_ get rid of the `Head`, which is element `0`! The questions are, then (and I will be grateful for hints and answers!)   1. Why doesn't `(a + b + c)[[1;;3]]` get rid of `(a + b + c)[[0]]`, the `Head`?   2. What is the right way to get rid of the `Head`?   3. `(a + b + c)[[0;;3]]` produces `0`. I would expect it to produce `{Plus, a, b, c}`. Instead, it produces `0`. This just deepens the mystery for me! Why?


Correctly substituting a matrix into a scalar equation

I am having trouble correctly substituting a matrix into an (originally) scalar equation. For example:               A = {{3, 1}, {1, 2}}     cp = CharacteristicPolynomial[A, x]      which produces x^2-5x+5 It is known that the characteristic polynomial must be equal to zero. Using:               cp /. {x -> A}      We obtain `{{-5, 0}, {0, -5}},` but the correct answer is `{{0, 0},{0, 0}}` or,               MatrixPower[A, 2] - 5 A + 5 IdentityMatrix[2]      I have toyed with the idea of using `CoefficientList` and an `If` statement inside of a `For` loop, then matching the coefficients with their respective `MatrixPower` and multiplying the final `CoefficientList[A, x, 0]` by the identity matrix. But, this seems unnecessarily complex and not general enough to work for all characterist polynomial forms. Can anyone think of an elegant way to raise the matrix to the correct power using `MatrixPower` and also only multiply the constant term by the identity matrix?


Problems Computing (in a reasonable amount of time) Solutions to a System of Inequalities

For my Cryptography research I am interested in finding solutions to the following inequalities in terms of $r$ and $s$, where $p$ is some fixed constant. $$\begin{align} 2^{p - s + 4} + 2^{p - r} + 2^{p - r - s + 4} + 13/4 < 2^{p - 8} \\ 2^{p - r + 4} + 2^{p - s + 8} + 2^{p - r - s + 8} + 13/4 < 2^{p - 4} \end{align}$$ I have tried the following computation:               Solve[2^(p - s + 4) + 2^(p - r) + 2^(p - r - s + 4) + 13/4 < 2^(p - 8) &&      2^(p - r + 4) + 2^(p - s + 8) + 2^(p - r - s + 8) + 13/4 < 2^(p - 4), {r, s}]      Unfortunately, it is taking forever to compute (literally days), so does anyone have any ideas? Thanks!