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

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


title: manipulate a social networking

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


title: Unexpected results from NDSolve

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


title: How to find near circular objects in an image

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


title: MovingAverage[] and Fit[] with data containing DateLists

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


title: DSolve problem with system of linear ODEs

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


title: ParametricRegion question - a bug report

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


title: Integral calculation in Mathematica

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


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

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


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

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


title: Expectation of GeometricBrownianMotionProcess

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


title: How can I remove double quotes in CDF?

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


title: Inconsistency in Histogram's "Probability" Binsize

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


title: Are these nested Tables necessary?

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


title: How can I display the numbers on the ordinate axis as exponentiation?

text: I create a Plot and I need to insert the values on the ordinate axis as exponentiation. For example if I have a value equal to 20000, view as 20x10^3. Here the code:               Data = {{1, 94252}, {2, 18361}, {3, 4310}, {4, 1007}, {5, 227}, {6, 53}, {7, 13}, {8,         4}, {9, 1}}          PlotData = ListPlot[Data, Frame -> True,        FrameStyle -> {{Thickness[0.005], Thickness[0.005]}, {Thickness[0.005],           Thickness[0.005]}}, PlotStyle -> RGBColor[0, 0, 0], Axes -> False,        FrameLabel -> {x, y}, PlotRange -> {{0, 10}, {-5000, 100000}}]      Thanks everyone for the help


title: How can I find the vertexes of a Polygon?

text: I made a polygon with the following vertexes :               p = {{0, 0, 0}, {0, 0, 300}, {0, 300, 300}, {0, 300, 0}};(*Vertices of the polygon*)     myGraphics=Graphics3D[{Polygon[p]}, Boxed -> False, Lighting -> {Gray}];      How can I find the vertexes of `myGraphics`?


title: Mathematica 10 trial limitations

text: I just installed the mathematica 10 trial on OS X Mavericks. Everything seems to be working fine, except that I cannot use `Export` or any kind of functions involving an export process. The error message I get is:               Export["test.txt", "this is a test"]      > General::unavail: Export is not available in this version of the Wolfram > Language. Is this a limitation of the trial? Are there other limitations?


title: Why do For[] loop variables in different functions interfere?

text: I had something along the lines of:               Func1[x_]:=(For[i=1,i<somenum,i++,             Func2 [ x[[i]] ]     ];)          Func2[a_]:=(For[i=1,i<anothernum,i++,                    Print[ToString[i]] ];)      And found that the i from the loop in Func1[] was being incremented by the loop in Func2[]. This was really surprising to me: I assumed, being local variables for defined at different points in the stack, they wouldn't know about each other. Changing the i in Func1[] to k fixed everything. Is this usual/normal?


title: Importing a matrix from a text file

text: I have a $4 \times N$ matrix in a .txt file of the form: > -17.071 137.567 16.554 0.65 > > -16.873 136.138 16.934 0.7 > > -15.397 135.738 16.894 0.7 > > -14.7 135.982 15.9 0.6 > > ... ($N-4$ additional row entries) Where the numeric values in each row are separated by a space. How would I read this matrix in, and parse it in the following manner:               {        {-17.071, 137.567, 16.554, 0.65},       {-16.873, 136.138, 16.934, 0.7},       {-15.397, 135.738, 16.894, 0.7},       {-14.7, 135.982, 15.9, 0.6},       ...     }      Evaluating               Import[PATH\\MATRIX.txt]]       Only returns the printed contents of the file.


title: Draw only the top of the boundary of a function in Plot3d

text: So currently I have ![Graph](http://i.stack.imgur.com/lWmcl.png) via combining 3 Plot3D's in a show. My question is how can I make it so that the ONLY portion of that border highlighted green, is the "curving portion" in the xy plane, rather than the whole border...? Related Code: Code is a variation on               Show[Plot3D[{x^2 + y^2}, {x, 0, 1}, {y, 0, 1},        RegionFunction -> Function[{x, y, z}, x + y < 1]],       Plot3D[{0}, {x, 0, 1}, {y, 0, 1},        RegionFunction -> Function[{x, y, z}, x + y < 1],        BoundaryStyle -> Green]      ]


title: Plot exported in EMF format does not scale well in MS Word

text: I have been using _Mathematica_ for a short time now and never had a reason to learn about exporting vector graphics. However, I need to include some graphics in some work I'm doing in Word 2010. I save the plots as WMF and EMF and then import to word and then I save the Word document as a PDF. The problem is while 2D plots are scalable during zooming, 3D plots look awful. I have no idea why except that its 3D. I also have very little knowledge in vector graphics. Also I noticed that the file size with just one 3D plot is over 1MB. I have several PDF files with over 100 pages containing lots of 3D plots, non of which exceed 2MB. Please tell me how can I include 3D graphs in my document that are scalable when saved as PDF, just the way most professional looking publications look.


title: Calculating a minimum bounding box for a set of 3-space coordinates / spheres

text: I have a set of 3-space coordinates for the atoms of a molecule (I could also transform them into spheres with radii corresponding to the atoms they represent). I would like to place this molecule into the tightest possible 3D rectangular bounding box and determine the coordinates for the box vertices. Is there a graphics processing routine in Mathematica that will do this automatically for me, or do I need to implement an algorithm from the literature? To be more specific - I would like to obtain the minimum bounding box for my molecule allowing rotation etc. I was able to find a solution for the special case of the molecule I'm interested in using a sort of lame trick with a rotational symmetry. I'm asking this question because I'd like to have a general-case solution. One way to proceed would be for me to perform a set of random rotations, calculate the volume of the bounding box Mathematica generates, and keep going until I obtain a sufficiently tight fit. Is there a way to get the coordinates for the Graphics3D bounding box vertices?


title: Using NDSolve to solve Equation of Motion in cylindrical coordinates

text: I have a set of coupled differential equations which represents the equation of motion of a particle in cylindrical coordinates with the following Hamiltonian: $$ H=\frac{1}{2m} \left( p_r^2 + \frac{p_\phi^2}{r^2} + p_z^2 \right) + c \sqrt{\frac{r^2}{4 a^2} + \frac{z^2}{a^2} }, $$ where a and c are some arbitrary constant. From Hamilton's equations: $$ \dot{q_i} = \frac{\partial H}{\partial p_i} \\\ \dot{p_i} = - \frac{\partial H}{\partial q_i}, $$ we get: $$ \dot{r} = \frac{p_r}{m} \\\ \dot{\phi} = \frac{p_\phi}{m r^2} \\\ \dot{z} = \frac{p_z}{m} \\\ \dot{p_r} = \frac{p_\phi^2}{m r^3} - \frac{c r}{4 a^2 \sqrt{\frac{r^2}{4 a^2} + \frac{z^2}{a^2} }} \\\ \dot{p_\phi} = 0 \\\ \dot{p_z} = - \frac{c z}{4 a^2 \sqrt{\frac{r^2}{4 a^2} + \frac{z^2}{a^2} }} $$               hamiltonianCylindrical[r_,phi_,z_,pr_,pPhi_,pz_,m_,a_,c_]:=1/(2 m) (pr^2+pPhi^2/r^2+pz^2) + c Sqrt[r^2/(4 a^2)+z^2/a^2]          cylindricalTrajectory[r0_, phi0_, z0_, pr0_, pPhi0_, pz0_, m_, a_, c_,steps_]:=NDSolve[       {        r'[t]==D[hamiltonianCylindrical[r[t],phi[t],z[t],pr[t],pPhi[t],pz[t],m,a,c],pr[t]],         phi'[t]==D[hamiltonianCylindrical[r[t],phi[t],z[t],pr[t],pPhi[t],pz[t],m,a,c],pPhi[t]],         z'[t]==D[hamiltonianCylindrical[r[t],phi[t],z[t],pr[t],pPhi[t],pz[t],m,a,c],pz[t]],         pr'[t]==-D[hamiltonianCylindrical[r[t],phi[t],z[t],pr[t],pPhi[t],pz[t],m,a,c],r[t]],         pPhi'[t]==-D[hamiltonianCylindrical[r[t],phi[t],z[t],pr[t],pPhi[t],pz[t],m,a,c],phi[t]],         pz'[t]==-D[hamiltonianCylindrical[r[t],phi[t],z[t],pr[t],pPhi[t],pz[t],m,a,c],z[t]],        r[0]==r0,        phi[0]==phi0,        z[0]==z0,        pr[0]==pr0,        pPhi[0]==pPhi0,        pz[0]==pz0       },       {r[t], phi[t], z[t], pr[t], pPhi[t], pz[t]},       {t, 0, steps},       WorkingPrecision -> 20,       MaxSteps -> \[Infinity]     ]              For example, if I run the following:               Plot[       Evaluate[r[t]/.cylindricalTrajectory[1, 0, 2, 1, 0, 1, 1, 1, 1, 500]],       {t,0,500}     ]      I can see that r becomes negative, which is not possible in cylindrical coordinates. Therefore, I wanted to know how I can solve the set of differential equation with r>=0. **Update** I noticed something weird is happening (which I have seen before):               Plot[       Evaluate[r[t] /. cylindricalTrajectory[1, 0, 2, 1, 1, 1, 1, 1, 1, 1000]],       {t, 0, 1000},       ImageSize -> Large     ]      ![enter image description here](http://i.stack.imgur.com/phsc2.jpg) At around t=500, r(t) behaves unexpectedly. However, if I only plot from t=0 to t=600, the "hiccups" at t=500 disappear. Another question I have is how do I convert from Cartesian to Cylindrical, if I am correct, the following should be the transformation: $$ r = \sqrt{x^2 + y^2} \\\ \phi = arctan \left( \frac{y}{x} \right) \\\ z=z \\\ p_r = p_x cos \phi + p_y sin \phi \\\ p_\phi = m (x p_y - y p_x) \\\ p_z = p_z $$ The one I am not quite sure is $p_r$.


title: Using ReadList and Skip to read a file with periodic alternation of useful and useless data

text: I am trying a read a file that's arranged such that there's alternating set of rows containing data that I don't need and data that I need. So for my case the first n lines in the files are useless to me while the next m lines are data I need, and the next n lines are useless etc. Here is a sample.               TER     ENDMDL     REMARK    GENERATED BY TRJCONV     TITLE     Neat THF t=   6.00000     REMARK    THIS IS A SIMULATION BOX     CRYST1   32.503   32.503   32.503  90.00  90.00  90.00 P 1           1     MODEL       16     ATOM      1  O1  THF     1      19.380  32.070  27.250  1.00  0.00                 ATOM      2  CA1 THF     1      19.090  30.880  26.540  1.00  0.00                 ATOM      3  CA2 THF     1      19.460  33.170  26.380  1.00  0.00                 ATOM      4  CB1 THF     1      18.940  31.200  25.060  1.00  0.00                 ATOM      5  CB2 THF     1      19.190  32.710  24.950  1.00  0.00                 ATOM      6  T21 THF     1      18.950  30.900  25.460  1.00  0.00                 ATOM      7  T22 THF     1      19.290  33.050  25.300  1.00  0.00                 ATOM      8  O1  THF     2      31.020  24.150   7.910  1.00  0.00                 ATOM      9  CA1 THF     2      31.310  24.450   9.250  1.00  0.00                 ATOM     10  CA2 THF     2      31.450  22.850   7.570  1.00  0.00                 ATOM     11  CB1 THF     2      32.010  23.250   9.900  1.00  0.00                 ATOM     12  CB2 THF     2      32.100  22.200   8.790  1.00  0.00                 ATOM     13  T21 THF     2      31.810  23.710   9.890  1.00  0.00                 ATOM     14  T22 THF     2      31.950  22.220   8.310  1.00  0.00                TER     ENDMDL     REMARK    GENERATED BY TRJCONV     TITLE     Neat THF t=   6.00000     REMARK    THIS IS A SIMULATION BOX     CRYST1   32.503   32.503   32.503  90.00  90.00  90.00 P 1           1     MODEL       16     ATOM      1  O1  THF     1      19.380  32.070  27.250  1.00  0.00                 ATOM      2  CA1 THF     1      19.090  30.880  26.540  1.00  0.00                 ATOM      3  CA2 THF     1      19.460  33.170  26.380  1.00  0.00                 ATOM      4  CB1 THF     1      18.940  31.200  25.060  1.00  0.00                 ATOM      5  CB2 THF     1      19.190  32.710  24.950  1.00  0.00                 ATOM      6  T21 THF     1      18.950  30.900  25.460  1.00  0.00                 ATOM      7  T22 THF     1      19.290  33.050  25.300  1.00  0.00                 ATOM      8  O1  THF     2      31.020  24.150   7.910  1.00  0.00                 ATOM      9  CA1 THF     2      31.310  24.450   9.250  1.00  0.00                 ATOM     10  CA2 THF     2      31.450  22.850   7.570  1.00  0.00                 ATOM     11  CB1 THF     2      32.010  23.250   9.900  1.00  0.00                 ATOM     12  CB2 THF     2      32.100  22.200   8.790  1.00  0.00                 ATOM     13  T21 THF     2      31.810  23.710   9.890  1.00  0.00                 ATOM     14  T22 THF     2      31.950  22.220   8.310  1.00  0.00       so in this case the first 7 lines are data I don't need while the next 14 lines are important data I want to read. I know I can combine `Skip` and `Readlist`               str = OpenRead["file"];     Skip[str, String, 7]; coord = ReadList[str, {Word, Number, Word, Word}~Join~Table[Number, {6}], 14]      How can I do this repeatedly to read say 500 such data (i.e. ATOM 1 - 14, 500 times). I will like to write a function that can accept the number of such data I want to read. This entry is related but not exactly what I want. If there's already a similar question I'll be more than happy to delete this but I couldn't find any that suits my purpose. Please note that these files are really huge ~1GB.


title: Kelvin per Kelvin Difference

text: I'm trying to use Mathematica units more often, but I've run into the following problem:                   (*Define some unitful constants*)         q = UnitConvert[Quantity["elementary charge"]];         k = UnitConvert[Quantity["Boltzmann Constant"]];         T = Quantity[300, "Kelvin"];         V = Quantity[5, "Volt"];         (*Do a simple calculation*)         UnitConvert[(q V)/(k T)]      The above code outputs                   Quantity[193.409, ("Kelvins")/("KelvinsDifference")]      which really should just be 193.409, since the units cancel, but Mathematica insists on a distinction between absolute temperature and temperature differences. I understand that such a distinction is useful in conversions, but the above is quite a nuisance. Is there a way to prevent this? I'd rather not have to put in `QuantityMagnitude` calls every time I need to cancel some `Kelvins`. Thanks!


title: How to get zeroth-order (piecewise constant) interpolation of scattered data?

text: Given a collection of scattered data points in 2D and associated function values,               data = RandomReal[1, {100, 3}];      we can get a piecewise linear interpolating function simply by calling `Interpolation`:               interp = Interpolation[data];     Plot3D[interp[x, y], {x, 0, 1}, {y, 0, 1}, PlotRange -> {0, 1},       PlotPoints -> 50, ColorFunction -> "DarkRainbow"]      ![enter image description here](http://i.stack.imgur.com/zPi1L.png) The result of `Plot3D` is essentially the same as calling `ListPlot3D[data]` directly. I imagine the piecewise linear elements are the Delaunay triangulation of the data points. However, `ListPlot3D` also allows you to set `InterpolationOrder -> 0` to get a plot that is piecewise _constant_ over the Voronoi cells of the data points.               ListPlot3D[data, InterpolationOrder -> 0, PlotRange -> {0, 1},       ColorFunction -> "DarkRainbow"]      ![enter image description here](http://i.stack.imgur.com/G6iAp.png) I want to get the function corresponding to this plot, but `Interpolation` is of no help here: > Interpolation::udeg: Interpolation on unstructured grids is currently only > supported for InterpolationOrder->1 or InterpolationOrder->All. Order will > be reduced to 1. Is there an easy way to get the result I want, that is, an interpolating function which is piecewise constant on the Voronoi cells of scattered data?


title: ImageTransformation: polar to cartesian

text: I am working on something that requires the polar transformation of some images. I implemented this transformation with `ImageTransformation`:               img = Import["http://i.stack.imgur.com/9cV4T.jpg"]      ![enter image description here](http://i.stack.imgur.com/9cV4T.jpg)               {center, radius} = ComponentMeasurements[MorphologicalComponents[img, 0.2],          {"Centroid", "EquivalentDiskRadius"}][[1, 2]];     polar = ImageTransformation[img, center + {Cos[#[[1]]], Sin[#[[1]]]}*#[[2]] &,          {2 Pi radius, radius}, DataRange -> Full,         PlotRange -> {{0, 360 \[Degree]}, {1, radius}}]      ![enter image description here](http://i.stack.imgur.com/IFbaS.png) After some processing I would like to transform the image back into the original coordinate system. This step is where I ran into problems. The transformation of the coordinates isn't really the problem but I couldn't figure out how to center the transformation properly and what `PlotRange` I have to provide.   **So the question is how to reverse the transformation:**               ImageTransformation[img, center + {Cos[#[[1]]], Sin[#[[1]]]}*#[[2]] &,          {2 Pi radius, radius}, DataRange -> Full,         PlotRange -> {{0, 360 \[Degree]}, {1, radius}}]      One of my failed attempts:               ImageTransformation[imgNorm, {0, Pi radius} + {Sqrt[#[[1]]^2 + #[[2]]^2],          ArcTan[#[[2]]/#[[1]]]} &, {2 radius, 2 radius}, DataRange -> Full]


title: Radon function result's repeatability

text: I want to get a Hough transform of some edged image. When I compare the same transformation on the same image I got different results.               i = 0; While[i < 10, i++; Print[Radon[imgEdged, Method -> "Hough"] ==                     Radon[imgEdged, Method -> "Hough"]]]     True     True     True     False     True     True     False     False     False     True      Why isn't repeatability provided in result of this function? Update: imgEdged = ![edged image](http://i.stack.imgur.com/nnzdN.jpg)


title: What is most efficient way to convert system of equations to collection of functions?

text: I have the type of system M.x = b, where M is a known matrix and b is a known vector. M contains many parameters, call the entire parameter set 'a', so M => M[a]. I want to be able to efficiently evaluate x[a], i.e. x[a] is now a collection of functions with variables/parameters 'a'. How to do this in an optimal way? The system can become very large, so that (symbolic) evaluation of LinearSolve[M,b] will take a long time. Also note that x can have many elements, and one could be interested in just evaluating x[[i]] in which case it is redundant to evaluate all the other elements of x. EDIT the system can e.g. be defined by:               b = {1, 0, 0, 0, 0, 0, 0, 0, 0, 0}          M = {{1, 0, 0, 0, 1, 0, 0, 0, 1}, {-c21 - c31, 0, -I omge, 0, c12, 0,        I Conjugate[omge], 0, c13}, {0,        I (-dge + dse) - c1/4 - c12/2 - c2/4 - c21/2 - c31/2 - c32/        2, -I omse, 0, 0, 0, 0, I Conjugate[omge],        0}, {-I Conjugate[omge], -I Conjugate[omse], -I dge - c1/4 - c13/2 -         c21/2 - c23/2 - c3/4 - c31/2, 0, 0, 0, 0, 0,        I Conjugate[omge]}, {0, 0,        0, -I (-dge + dse) - c1/4 - c12/2 - c2/4 - c21/2 - c31/2 - c32/2,        0, -I omge, I Conjugate[omse], 0, 0}, {c21, 0, 0,        0, -c12 - c32, -I omse, 0, I Conjugate[omse], c23}, {0, 0,        0, -I Conjugate[omge], -I Conjugate[omse], -I dge - I (-dge + dse) -         c12/2 - c13/2 - c2/4 - c23/2 - c3/4 - c32/2, 0, 0,        I Conjugate[omse]}, {I omge, 0, 0, I omse, 0, 0,        I dge - c1/4 - c13/2 - c21/2 - c23/2 - c3/4 - c31/2,        0, -I omge}, {0, I omge, 0, 0, I omse, 0, 0,        I dge + I (-dge + dse) - c12/2 - c13/2 - c2/4 - c23/2 - c3/4 - c32/        2, -I omse}, {c31, 0, I omge, 0, c32,        I omse, -I Conjugate[omge], -I Conjugate[omse], -c13 - c23}}


title: Hurwitz-Lerch transcendent

text: I want to compute the following sum over primes: $$\sum\limits_{p \text{ prime}}\sum\limits_{k=1}^\infty(\log(p^k))\left(\frac{1}{2p^k} - \Phi[-1,1,p^k]\right),$$ where $\Phi[z,s,a]$ is the Hurwitz-Lerch transcendent. Can I compute it using _Mathematica_? Here is the code I used               Sum[log((Prime[n])^k) ( Prime[n])^(-k)/2-HurwitzLerchPhi[-1,1,Prime[n]^k]),                                              {k, 1, Infinity}, {n, 1, Infinity}]


title: Replacing parts of a held expression with held parts of another expression

text: I'm applying the Trott-Strzebonski technique in order to replace inside a held expression.               x = Hold[1 + 1, 2 + 2, 3 + 3];     y = Hold[foo@bar[2]];     y /. bar[j_] :> With[{eval = x[[j]]}, eval /; True]     (* Hold[foo[4]] *)      However, I'd like the replacing expression to remain held during substitution:               (* Hold[foo[2 + 2]] *)      The unwanted evaluation of `2 + 2` seemed to be occurring during the `Part` statement, `x[[j]]`. So, I tried using `Extract` instead:               y /. bar[j_] :> With[{eval = Extract[x, {j}, Unevaluated]}, eval /; True]     (* Hold[foo[Unevaluated[2 + 2]]] *)      I _thought_ `Unevaluated` would disappear as an argument of the `Set` function, but this was not so. (Perhaps I still don't quite understand `Unevaluated`.) I then thought of removing that head, `Unevaluated`, through another replacement, but that seems rather convoluted. Succinctly, how does one replace parts of a held expression with held parts of another expression?


title: Visual Studio 2013 Mathlink addtwo

text: I was needing to use Mathlink to call some c++ code so I thought I would learn from the basic examples but I am running into strange issue. Following the procedure outlined from the Mathematica Documentation Center I attempted to do the very simple addtwo.exe build. I followed as exactly as I could(since this was written for Visual Studio 2010 some of the names of things weren't exactly the same). When I did the portion where you build addtwo using the Visual Studio Command Line Tools it works great. However, when I try to do the method outlined at "Using the Integrated Development Environment Visual Studio 2010" I get that it isn't able to find the right libraries. And get the following:               1>------ Build started: Project: addtwo, Configuration: Debug Win32 ------     1>addtwo.obj : error LNK2019: unresolved external symbol _MLMain referenced in     function _WinMain@16     1>addtwo.obj : error LNK2019: unresolved external symbol _MLInitializeIcon     referenced in function _WinMain@16     1>C:\Users\themadcemist\Documents\Mathematica     Mathlink\addtwo\addtwo\Debug\addtwo.exe : fatal error LNK1120: 2 unresolved externals     ========== Build: 0 succeeded, 1 failed, 0 up-to-date, 0 skipped ==========      I have moved, as directed by the tutorial, all the libraries etc. to their respective folders in the path "C:\Program Files (x86)\Microsoft Visual Studio 12.0\VC" (so \bin \lib \include). I am guessing perhaps I don't have something set up correctly it just confuses me that it would work with the Command Line but not with the IDE method. (I am following the 32 bit tutorial from the website)


title: Improper mutiple integral

text: I would like to solve the following integral:               Integrate[y Erf[a Sqrt[x^2 + y^2]]/Sqrt[x^2 + y^2]                 Exp[-b ((x - c)^2 + y^2)], {x, -∞, ∞},               {y, 0, ∞}, Assumptions -> {a > 0, b > 0, c > 0}]      If I add such input in Mathematica, it takes ages to solve it and in the end it could not. The solution is obviously a function of a, b, and c. Any ideas, tricks how to tackle this problem?


title: Find positions of items in a list based on neighbours

text: How can I select items from a list where the selection criterion depends on the neighbouring items? For example select all indices where a change has occurred with respect to the previous element in the list:               u = {0,0,1,1,1,1,0,0,0,1,1,0,0,0,1};      Desired output:               r = {{3,+1},{7,-1},{10,+1},{12,-1},{15,+1}}      My current implementation looks like that:               process[u_] := Select[Table[If[u[[i]] != u[[i - 1]], {i, u[[i]] - u[[i - 1]]}, {}], {i, 2, Length@u}], Length@# != 0 &]      which is probably neither fast nor elegant and scales poorly when using multiple neighbours... In this example I only need one neighbour (the previous item), but I would be interested in a solution where I can check a bigger neighbourhood too.


title: Need help with extracting columns from a table

text: I'm trying to clean a dataset of unnecessary variables but I constantly get an error when doing so. Following an example where:               rawDataDiamonds = «dataSetDiamonds»;     dataDiamondsTemp = Delete[Transpose[rawDataDiamonds][[All,1]][[All,{1,2}]],1]      gives an output where only Price and Weight is shown, I tried to apply this for:               dataBundesliga = {{       "Football Club", "Marketvalue_2011", "Marketvalue_2012",         "Final Placement_2011", "Points_2011", "Mid_Season_Points_2011",         "Mid_Season_Points_2012"}, {       "FC Bayern München", 333000000, 415950000, 2, 73, 37, 42}, {       "Borussia Dortmund", 158000000, 229250000, 1, 81, 34, 30}, {       "FC Schalke 04", 130000000, 163250000, 3, 64, 34, 25}, {       "Bayer 04 Leverkusen", 138000000, 163900000, 5, 54, 26, 33}, {       "VfL Wolfsburg", 110000000, 132200000, 8, 44, 20, 19}, {       "Hamburger SV", 100000000, 104300000, 15, 36, 19, 24}, {       "VfB Stuttgart", 94000000, 91900000, 6, 53, 22, 25}, {       "Borussia Mönchengladbach", 67000000, 88350000, 4, 60, 33, 25}, {       "SV Werder Bremen", 113000000, 82150000, 9, 42, 29, 22}, {       "TSG 1899 Hoffenheim", 90000000, 77650000, 11, 41, 22, 12}, {       "Hannover 96", 65000000, 78650000, 7, 48, 23, 23}, {       "SC Freiburg", 55000000, 46650000, 12, 40, 13, 26}, {       "1.FSV Mainz 05", 50000000, 46000000, 13, 39, 18, 26}, {       "Eintracht Frankfurt", 46000000, 49400000, 999, 0, 0, 30}, {       "1.FC Nürnberg", 41000000, 41500000, 10, 42, 18, 20}, {       "FC Augsburg", 29000000, 39250000, 14, 38, 15, 9}, {       "SpVgg Greuther Fürth", 21000000, 30100000, 999, 0, 0, 9}, {       "Fortuna Düsseldorf", 22000000, 26850000, 999, 0, 0, 21}, {       "1.FC Köln", 59750000, 22950000, 17, 30, 21, 0}, {       "1.FC Kaiserslautern", 41900000, 26725000, 18, 23, 16, 0}, {       "Hertha Berlin", 45000000, 34850000, 16, 31, 20, 0}}          dataBundesligaTemp =       Delete[Transpose[dataBundesliga][[All, 1]][[All, {2, 5}]], 1]      But when doing so, I get the error > Part::partd: Part specification {Football > Club,Marketvalue_2011,Marketvalue_2012,Final > Placement_2011,Points_2011,Mid_Season_Points_2011,Mid_Season_Points_2012}[[All,{2,5}]] > is longer than depth of object. >> Part::partd: Part specification > All[[{2,5}]] is longer than depth of object. >> Can someone help me please to understand what I'm doing wrong?


title: Multi-Selection dynamic menus

text: I'm looking to create dynamic menus with multiple options, and would allow multiple selections. For example, mousing over an object (let's say a black circle of rad 1), a menu would popup at MousePosition[] with two options of "red" and "5". Selecting red would create a new circle, red with rad1, and selecting both would give a red circle of rad 5. How would I create temporary/dynamic menus similar to the standard right-click (disappears after clicking away), except with multi-selection? Edit: I got carried away with my end-goal example. All I am wondering is if Panel is the correct function to use here with multiple checkboxes (the documentation examples did not have what I expected). ![screenshot](http://i.imgur.com/GQksx.png)


title: Simple contour integral with a parameter gone wrong

text: I run into the following problem, I tried to evaluate a very simple integral:               Assuming[ a > 0  , Integrate[Sin[a*s]/(s - I)^2, {s, -Infinity, Infinity}]]      Mathematica claims the answer is zero, even though you can evaluate it by hand using residues to convince yourself that the answer is: $I\ a\ \pi\ e^{-a}$ What is weird, is that if you substitute some numerical value instead of `a` the answer is correct. Also if you switch the pole to be `+I` Mathematica gives an incorrect answer: $-2\ I\ a\ \pi\cosh(a)$ instead of simply minus the previous result. Anyone had a problem like this?


title: How can one draw a network with nodes and links in a grid shape?

text: I'd like to be able to use MMa's graphics to make something like this ![enter image description here](http://i.stack.imgur.com/m2zUo.gif) which I know must absolutely be possible (and probably easy) with MMa. I don't actually even need different colors (though that'd be nice!), but my problem is I don't even know what to search for, to learn. I tried googling "mathematica network graphics" and similar things but didn't find anything explaining how I can do it. Can someone point me in the right direction? Thank you!


title: Converting inequalities to intervals

text: I have an inequality, ie: 1.57116 < g < 14.1405 There will be a large set of similar inequalities, and I want to find the intersection of them all. I figured it would be easier to convert the inequalities to intervals first. Then find the intersection. Is there an easy way to convert inequalities to intervals as the inequalities are generated? Alternatively, a way to find the intersection of a group of inequalities.


title: Performance of a Do-Loop of variable length

text: If I'm changing a basis depending on a (non quadratic) matrix $\mathbf{M}\in\mathbb Z^{d\times k}$ and some $\mu\in\mathbb N^k$, i.e. i have an array `a` of the same dimensions as mentioned in $\mu$, that is also given as an input parameter and I want to adress another array `b` at the same time after multiplication with $\mathbf{M}$. Hence i do need some `Do`-loop to run through all values $t = (t_1,\ldots,t_k),\ 1\leq t_i \leq \mu_i$. Let's say `d=3; k=2; mM = {{1, 0}, {1, 1}, {1, 0}};` and `mu={512,1024}` Then my approach (that works) is something like               a = ConstantArray[0, mu]; (* Given as input for the function usually*)     b = ConstantArray[0, mM.mu]; (*to be computed/ "filled" with values *)     t1 = AbsoluteTiming[       Do[         b[[Sequence @@ ( mM.Table[Subscript[t, j], {j, 1, k}])]]           = a[[Sequence @@ (Table[Subscript[t, j], {j, 1, k}]) ]];       ,Evaluate[Sequence @@ Table[{Subscript[t, j], 1, mu[[j]]}, {j, 1, k}]]];     ]      Where the arrays in reality are of course not only zeros, usually they're not even sparse and i'm doing some computation not only the matching. But even for this (i think) relatively small input the time needed for evaluation is very long (65 seconds on my Core2Duo 2.4 Ghz / 8GB Ram / Mathematica 8.1), e.g. compared to a multivariate Fourier transform on `a` (which i do before that in less than a second). This one gets even worse, if $\mathbf{M}$ “spreads“ `a`further, but that might also be due to Memory, perhaps. In order to get that faster, I tried to extract the `Table` to be an Argument of an anonymous function (`# & [...]`), but that didn't gain any measurable time. Timing gets even worse, if i'm switching to my real application due to multiple access on the array `a` inside of `Do`. What I am searching for now is a time optimization of that `Do` loop, whose Range is kind of variable with respect to the input $\mu$ and any ideas on faster access on `a` and `b`.


title: How can I know if a pattern corresponds to a string pattern?

text: What would be the best way to detect if a pattern corresponds to a string pattern ? An invalid string pattern `p` would lead to an error in `StringMatchQ[string, p]` for example.


title: How to combine different EventHandlers?

text: Here are two very nice programs I got from the nice guys here helping me to solve my questions. The first one can be used to change the positions of the vertices and to delete the unwanted edges of a `RandomGraph`, the second one can be used to delete the unwanted vertices by double-clicking on them. Now I want to combine these functions into one single program. I failed to do so. Please help.               (*  Program one:          Edges can be deleted by double-clicking on them         Ctrl+Drag can joint two nodes     *)     DynamicModule[{rg, refreshed = True},      rg = RandomGraph[{5, 7}, DirectedEdges -> True];      edglst = EdgeList[rg];      vlst = VertexList[rg];      VPOS = VertexCoordinates /. AbsoluteOptions[rg, VertexCoordinates];      OVP = VPOS =         Rescale[#, 1 + Through[{Min, Max}[VPOS]], {0, 1}] & /@ VPOS;           eventhlers =        MapThread[        EventHandler[#, {"MouseDown" :>             If[CurrentValue["MouseClickCount"] == 2,               (epos = First@Position[edglst, #];              edglst = Drop[edglst, epos ];              eventhlers = Drop[eventhlers, epos ])]}] &, {edglst}];           EventHandler[g = Dynamic@Graph[vlst, eventhlers,          VertexCoordinates -> VPOS,          VertexSize -> {.02, .02},          VertexLabels -> "Name",          PlotRange -> 1,          EdgeStyle -> {Thick}],       {"MouseDown" :> (          If[CurrentValue["ControlKey"],           If[refreshed,            pos = MousePosition["Graphics"];            ind = Position[VPOS, Nearest[VPOS, pos][[1]]][[1, 1]];            tmp = ind;            vnumb = Length[vlst] + 1;            AppendTo[vlst, vnumb];            AppendTo[VPOS, pos];            AppendTo[edglst, ind <-> vnumb];            ind = vnumb;            refreshed = False;            ],           pos = MousePosition["Graphics"];           ind = Position[VPOS, Nearest[VPOS, pos][[1]]][[1, 1]];           ]),        "MouseDragged" :>         (          VPOS[[ind]] = MousePosition["Graphics"];          refreshed = True;          If[! CurrentValue["ControlKey"],           OVP = VPOS]          ),             "MouseUp" :>         (          If[CurrentValue["ControlKey"],           pos2 = MousePosition["Graphics"];           ind2 = Position[OVP, Nearest[OVP, pos2][[1]]][[1, 1]];           vnumb = Length[vlst];           vlst = Drop[vlst, -1];           VPOS = Drop[VPOS, -1];           edglst = Drop[edglst, -1];           If[! MemberQ[edglst, tmp \[DirectedEdge] ind2] ,             AppendTo[edglst, tmp \[DirectedEdge] ind2];                 eventhlers =              MapThread[              EventHandler[#, {"MouseDown" :>                   If[CurrentValue["MouseClickCount"] == 2,                    (epos = First@Position[edglst, #];                    edglst = Drop[edglst, epos ];                    eventhlers = Drop[eventhlers, epos ])]}] &, {edglst}];            ]           ])        },       PassEventsDown -> True       ]      ]               (* Second program: nodes can be deleted by double-clicking on them *)     DynamicModule[{rg},      rg = RandomGraph[{5, 7}, DirectedEdges -> True];      edglst = EdgeList[rg];      vlst = VertexList[rg];      VPOS = VertexCoordinates /. AbsoluteOptions[rg, VertexCoordinates];      VPOS = Rescale[#, 1 + Through[{Min, Max}[VPOS]], {0, 1}] & /@ VPOS;           Vnthlrs =        MapThread[        EventHandler[#, {"MouseDown" :>             If[CurrentValue["MouseClickCount"] == 2,              (ep = First@Position[vlst, #];              vlst = Drop[vlst, ep];              VPOS = Drop[VPOS, ep];              edglst =                Delete[edglst, Map[List, Position[edglst, #][[All, 1]]]];              Vnthlrs = Drop[Vnthlrs, ep])]}] &, {vlst}];           g = Dynamic@Graph[Vnthlrs,         edglst,         VertexCoordinates -> VPOS,         VertexSize -> {.02, .02},         VertexLabels -> "Name",         PlotRange -> 1,         EdgeStyle -> {Thick}         ]      ]      Finally, I figured out how to combine these two programs. For operations details, pls refer to the comments at the top of the combined program. It is now clear to me that multiple EventHandlers can be wrapped around each other and created dynamically in MM.               (* Combined program:       * Edges can be deleted by double-clicking on them(click right on the edge)       * Nodes can be deleted by double-clicking on them(double-click right on the top of the node)       * Drag the node to change its position (drag when close to the node, NOT on top of it)       * Ctrl+Drag the node (begin Ctrl+Drag just close to the node, NOT right on top of it)         to another node to joint them. *)          DynamicModule[{rg, refreshed = True},       rg = RandomGraph[{#, # + 4}, DirectedEdges -> True] & [ RandomInteger[{5, 7}]];      edglst = EdgeList[rg];      vlst = VertexList[rg];      vnumb = Length[vlst];      VPOS = VertexCoordinates /. AbsoluteOptions[rg, VertexCoordinates];      OVP = VPOS =         Rescale[#, 1 + Through[{Min, Max}[VPOS]], {0, 1}] & /@ VPOS;           (* double click to delete edge *)      eventhlers =        MapThread[        EventHandler[#, {"MouseDown" :>             If[CurrentValue["MouseClickCount"] == 2,               (epos = First@Position[edglst, #];              edglst = Drop[edglst, epos];              eventhlers = Drop[eventhlers, epos])]}] &, {edglst}];      (* double click to delete vertex *)      Vnthlrs =        MapThread[        EventHandler[#, {"MouseDown" :>             If[CurrentValue["MouseClickCount"] == 2,               (ep = First@Position[vlst, #];              vlst = Drop[vlst, ep];                   edglst =                Delete[edglst, Map[List, Position[edglst, #][[All, 1]]]];                   eventhlers =                MapThread[                     EventHandler[#, {"MouseDown" :>                     If[CurrentValue["MouseClickCount"] == 2,                       (epos = First@Position[edglst, #];                      edglst = Drop[edglst, epos];                      eventhlers = Drop[eventhlers, epos])]}] &, {edglst}];              VPOS = Drop[VPOS, ep];              OVP = VPOS;              Vnthlrs = Drop[Vnthlrs, ep])]}] &, {vlst}];      EventHandler[g = Dynamic@Graph[          Vnthlrs,          eventhlers,          VertexCoordinates -> VPOS,          VertexSize -> {.02, .02},          VertexLabels -> "Name",          PlotRange -> 1,          EdgeStyle -> {Thick}          ],       {        "MouseDown" :>         (          If[CurrentValue["ControlKey"],           If[refreshed,            pos = MousePosition["Graphics"];            ind = Position[VPOS, Nearest[VPOS, pos][[1]]][[1, 1]];            tmp = vlst[[ind]];            vnumb = vnumb + 1;            AppendTo[vlst, vnumb];            AppendTo[edglst, tmp \[DirectedEdge] vnumb];            AppendTo[VPOS, pos];                 (* double click to delete edge *)            eventhlers =              MapThread[              EventHandler[#, {"MouseDown" :>                   If[CurrentValue["MouseClickCount"] == 2,                     (epos = First@Position[edglst, #];                    edglst = Drop[edglst, epos];                    eventhlers = Drop[eventhlers, epos])]}] &, {edglst}];            (* double click to delete vertex *)            Vnthlrs =              MapThread[              EventHandler[#, {"MouseDown" :>                   If[CurrentValue["MouseClickCount"] == 2,                     (ep = First@Position[vlst, #];                    vlst = Drop[vlst, ep];                              edglst =                      Delete[edglst,                       Map[List, Position[edglst, #][[All, 1]]]];                              eventhlers =                      MapThread[                      EventHandler[#, {"MouseDown" :>                          If[CurrentValue["MouseClickCount"] == 2,                          (epos = First@Position[edglst, #];                         edglst = Drop[edglst, epos];                              eventhlers =                          Drop[eventhlers, epos])]}] &, {edglst}];                    VPOS = Drop[VPOS, ep];                    OVP = VPOS;                    Vnthlrs = Drop[Vnthlrs, ep])]}] &, {vlst}];            ind = Position[vlst, vnumb][[1]][[1]];            refreshed = False;],           pos = MousePosition["Graphics"];           ind = Position[VPOS, Nearest[VPOS, pos][[1]]][[1, 1]];]          ),             "MouseDragged" :> (VPOS[[ind]] = MousePosition["Graphics"];          refreshed = True;          If[! CurrentValue["ControlKey"], OVP = VPOS]),             "MouseUp" :> (          If[CurrentValue["ControlKey"],           pos2 = MousePosition["Graphics"];           ind2 = Position[OVP, Nearest[OVP, pos2][[1]]][[1, 1]];           tmp2=vlst[[ind2]];           vlst = Drop[vlst, -1];           edglst = Drop[edglst, -1];           VPOS = Drop[VPOS, -1];                (* double click to delete edge *)           eventhlers =             MapThread[             EventHandler[#, {"MouseDown" :>                  If[CurrentValue["MouseClickCount"] == 2,                    (epos = First@Position[edglst, #];                   edglst = Drop[edglst, epos];                   eventhlers = Drop[eventhlers, epos])]}] &, {edglst}];           (* double click to delete vertex *)           Vnthlrs =             MapThread[             EventHandler[#, {"MouseDown" :>                  If[CurrentValue["MouseClickCount"] == 2,                    (ep = First@Position[vlst, #];                   vlst = Drop[vlst, ep];                             edglst =                     Delete[edglst,                      Map[List, Position[edglst, #][[All, 1]]]];                             eventhlers =                     MapThread[                    EventHandler[#, {"MouseDown" :>                         If[CurrentValue["MouseClickCount"] == 2,                          (epos = First@Position[edglst, #];                         edglst = Drop[edglst, epos];                              eventhlers =                          Drop[eventhlers, epos])]}] &, {edglst}];                   VPOS = Drop[VPOS, ep];                   OVP = VPOS;                   Vnthlrs = Drop[Vnthlrs, ep])]}] &, {vlst}];                If[! MemberQ[edglst, tmp \[DirectedEdge] tmp2],            AppendTo[edglst, tmp \[DirectedEdge] tmp2];            eventhlers =              MapThread[              EventHandler[#, {"MouseDown" :>                        If[CurrentValue["MouseClickCount"] == 2,                     (epos = First@Position[edglst, #];                    edglst = Drop[edglst, epos];                    eventhlers = Drop[eventhlers, epos])]}] &, {edglst}];]]          )        }, PassEventsDown -> True       ]      ]      It seems the above program can be more user friendly if it allows people to add nodes. So here comes this new function to it.               (* Combined program:       * Edges can be deleted by double-clicking on them(click right on the edge)       * Nodes can be deleted by double-clicking on them(double-click right on the top of the node)       * Drag the node to change its position (drag when close to the node, NOT on top of it)       * Ctrl+Drag the node (begin Ctrl+Drag just close to the node, NOT right on top of it)         to another node to joint them.       * Shift+double-click at space to add new node    *)                     DynamicModule[{rg, refreshed = True},       rg = RandomGraph[{#, # + 4}, DirectedEdges -> True] &[RandomInteger[{5, 7}]];      edglst = EdgeList[rg];      vlst = VertexList[rg];      vnumb = Length[vlst];      VPOS = VertexCoordinates /. AbsoluteOptions[rg, VertexCoordinates];      OVP = VPOS =         Rescale[#, 1 + Through[{Min, Max}[VPOS]], {0, 1}] & /@ VPOS;           (*double click to delete edge*)      eventhlers =        MapThread[        EventHandler[#, {"MouseDown" :>             If[CurrentValue["MouseClickCount"] == 2,           (epos = First@Position[edglst, #];          edglst = Drop[edglst, epos];          eventhlers = Drop[eventhlers, epos])]}] &, {edglst}];           (*double click to delete vertex*)      Vnthlrs =        MapThread[        EventHandler[#, {"MouseDown" :>             If[CurrentValue["MouseClickCount"] == 2,               (ep = First@Position[vlst, #];              vlst = Drop[vlst, ep];              edglst =                Delete[edglst, Map[List, Position[edglst, #][[All, 1]]]];              eventhlers =                MapThread[                     EventHandler[#, {"MouseDown" :>                     If[CurrentValue["MouseClickCount"] == 2,                       (epos = First@Position[edglst, #];                      edglst = Drop[edglst, epos];                      eventhlers = Drop[eventhlers, epos])]}] &, {edglst}];              VPOS = Drop[VPOS, ep];              OVP = VPOS;              Vnthlrs = Drop[Vnthlrs, ep])]}] &, {vlst}];           EventHandler[       g = Dynamic@         Graph[Vnthlrs, eventhlers, VertexCoordinates -> VPOS,           VertexSize -> {.02, .02}, VertexLabels -> "Name", PlotRange -> 1,           EdgeStyle -> {Thick}],       {        "MouseDown" :>         (          If[CurrentValue["ControlKey"],           If[refreshed,            pos = MousePosition["Graphics"];            ind = Position[VPOS, Nearest[VPOS, pos][[1]]][[1, 1]];            tmp = vlst[[ind]];            vnumb = vnumb + 1;            AppendTo[vlst, vnumb];            AppendTo[edglst, tmp \[DirectedEdge] vnumb];            AppendTo[VPOS, pos];            (*double click to delete edge*)            eventhlers =              MapThread[              EventHandler[#, {"MouseDown" :>                   If[CurrentValue["MouseClickCount"] == 2,                      (epos = First@Position[edglst, #];                    edglst = Drop[edglst, epos];                    eventhlers = Drop[eventhlers, epos])]}] &, {edglst}];            (*double click to delete vertex*)            Vnthlrs =              MapThread[              EventHandler[#, {"MouseDown" :>                   If[CurrentValue["MouseClickCount"] == 2,                     (ep = First@Position[vlst, #];                    vlst = Drop[vlst, ep];                         edglst =                      Delete[edglst,                       Map[List, Position[edglst, #][[All, 1]]]];                         eventhlers =                      MapThread[                      EventHandler[#, {"MouseDown" :>                          If[CurrentValue["MouseClickCount"] == 2,                          (epos = First@Position[edglst, #];                         edglst = Drop[edglst, epos];                              eventhlers =                          Drop[eventhlers, epos])]}] &, {edglst}];                    VPOS = Drop[VPOS, ep];                    OVP = VPOS;                    Vnthlrs = Drop[Vnthlrs, ep])]}] &, {vlst}];            ind = Position[vlst, vnumb][[1]][[1]];            refreshed = False;],           (*Not Controlkey*)           If[! CurrentValue["ShiftKey"],            (*Not shiftkey*)            pos = MousePosition["Graphics"];            ind = Position[VPOS, Nearest[VPOS, pos][[1]]][[1, 1]],            (* shiftkey*)            If[CurrentValue["MouseClickCount"] == 2,             vRange = Range[Length[vlst] + 1];             NewN =               Take[vRange,                 Position[FreeQ[vlst, #] & /@ vRange, True][[1]] ][[1]];             AppendTo[vlst, NewN];             AppendTo[VPOS, MousePosition["Graphics"]];             OVP = VPOS;             (*double click to delete vertex*)             Vnthlrs =               MapThread[               EventHandler[#, {"MouseDown" :>                    If[CurrentValue["MouseClickCount"] == 2,                      (ep = First@Position[vlst, #];                     vlst = Drop[vlst, ep];                          edglst =                       Delete[edglst,                        Map[List, Position[edglst, #][[All, 1]]]];                          eventhlers =                       MapThread[                       EventHandler[#, {"MouseDown" :>                          If[CurrentValue["MouseClickCount"] == 2,                          (epos = First@Position[edglst, #];                         edglst = Drop[edglst, epos];                              eventhlers =                          Drop[eventhlers, epos])]}] &, {edglst}];                     VPOS = Drop[VPOS, ep];                     OVP = VPOS;                     vnumb = vnumb + 1;                     Vnthlrs = Drop[Vnthlrs, ep])]}] &, {vlst}];              ](*double clicked*)             ]           ](*Controlkey*)          ),             "MouseDragged" :> (VPOS[[ind]] = MousePosition["Graphics"];          refreshed = True;          If[! CurrentValue["ControlKey"], OVP = VPOS]),             "MouseUp" :> (          If[CurrentValue["ControlKey"],           pos2 = MousePosition["Graphics"];           ind2 = Position[OVP, Nearest[OVP, pos2][[1]]][[1, 1]];                vlst = Drop[vlst, -1];           edglst = Drop[edglst, -1];           VPOS = Drop[VPOS, -1];                (*double click to delete edge*)           eventhlers =             MapThread[             EventHandler[#, {"MouseDown" :>                  If[CurrentValue["MouseClickCount"] == 2,                    (epos = First@Position[edglst, #];                   edglst = Drop[edglst, epos];                   eventhlers = Drop[eventhlers, epos])]}] &, {edglst}];                (*double click to delete vertex*)           Vnthlrs =             MapThread[             EventHandler[#, {"MouseDown" :>                  If[CurrentValue["MouseClickCount"] == 2,                     (ep = First@Position[vlst, #];                   vlst = Drop[vlst, ep];                        edglst =                     Delete[edglst,                      Map[List, Position[edglst, #][[All, 1]]]];                        eventhlers =                     MapThread[                     EventHandler[#, {"MouseDown" :>                          If[CurrentValue["MouseClickCount"] == 2,                          (epos = First@Position[edglst, #];                         edglst = Drop[edglst, epos];                              eventhlers =                          Drop[eventhlers, epos])]}] &, {edglst}];                   VPOS = Drop[VPOS, ep];                   OVP = VPOS;                   Vnthlrs = Drop[Vnthlrs, ep])]}] &, {vlst}];           tmp2 = vlst[[ind2]];           If[! MemberQ[edglst, tmp \[DirectedEdge] tmp2],             AppendTo[edglst, tmp \[DirectedEdge] tmp2];                 eventhlers =              MapThread[              EventHandler[#, {"MouseDown" :>                   If[CurrentValue["MouseClickCount"] == 2,                     (epos = First@Position[edglst, #];                    edglst = Drop[edglst, epos];                    eventhlers = Drop[eventhlers, epos])]}] &, {edglst}];            ]])}, PassEventsDown -> True       ]      ]


title: How to define a summation with function calling itself?

text: I am new to Mathematica. I want to do this f(x)=summation f(t), summation is over t, where 1<=t<=x-1 and mod(x+1,t+1)=1, i.e. when x+1 is divided by t+1, remainder is 1 and f(1)=1. Should i use loop or something else and how? Thanks.


title: Data paste in piecewise table

text: How can I paste data copied from several lines into a piecewise table, without pasting it in a single cell? ![1st Step](http://i.stack.imgur.com/x8SCJ.png) ![2nd Step](http://i.stack.imgur.com/tsYHx.png) ![3rd Step](http://i.stack.imgur.com/b2ZMY.png)


title: Backsubstituting solution into FindRoot and Plot

text: I want to find roots from a transcendental equation using FindRoot as a function of a real parameter and then plot the solutions vs. the parameter. The following commands work perfectly:               equ[a_?NumericQ] := FindRoot[x == E^(-a x), {x, 1}][[1, 2]];          Plot[equ[a], {a, 0, 5}]      However, I actually have a much more complicated equation which is very sensitive on the starting value. Thus, starting from the second point, I want to set as the initial guess for each solution the value obtained on the previous point. The trick proposed here works for a `Table`:               sol = {x -> 0};     sols = Table[sol = FindRoot[a x == 1, {x, sol[[1, 2]]}], {a, 1, 10}]      > >     {{x -> 1.}, {x -> 0.5}, {x -> 0.333333}, {x -> 0.25}, {x -> 0.2}, {x -> > 0.166667}, >      {x -> 0.142857}, {x -> 0.125}, {x -> 0.111111}, {x -> 0.1}} >   However, when I tried to plot the solutions I followed the suggestion here: plotting output from FindRoot But the command               ListPlot[a /. sols]      only produced an empty graph. So, how do I accomplish this? I would rather be able to define a function of the roots in terms of the parameter a and then plot the function, but if I try something like               sol = {x -> 0};          equ[a_?NumericQ] := {sol = FindRoot[x == E^(-a x), {x, sol[[1, 2]]}]};          Plot[equ[a], {a, 0, 2}]      it will generate an empty plot again.


title: A fast way to compare interval

text: I have a list of intervall.   Some of these intervals are disjoint, some are overlapped and some are included in others. To leave no ambiguity about my explanation, you can see the following examples: {1, 2} and {3, 4} are disjointed.   {1, 3} and {2, 4} are overlaped.   {2,3} are included in {1,4}. I would like to identify any intervals in a list that are completely included in others.   For example: {2,3} are included in {1,4}   {2,4} are included in {1,4}   {1,3} are included in {1,4}   ect ..    **Objectives** * * * The goal is to get the list of positions of all intervals that are included in others in order to eliminate them. It's important to notice here that the list to study is always sorted. Example of list :               ListT = {{1, 8}, {2, 8}, {3, 8}, {4, 8}, {5, 10}, {6, 10}, {7, 11}, {8, 14}};      I already write an algorithm that I find too slow. It is unnecessary to expose here. So I write the followings algorithm :               Supone[x_] := If[x > 1, True, False];          Tentative1[ListT] :=       Block[             {Step2T1, Step3T1, Step4T1, Step5T1, Step6T1,Res},                   Step2T1 = Map[Interval[#] &, ListT];                   Step3T1 = Table[                              IntervalMemberQ[Step2T1[[i]], Step2T1[[j]]],                              {i, 1, Length@Step2T1, 1},                              {j, 1, Length@Step2T1, 1}                             ];                   Step4T1 = DeleteCases[Step3T1, False, Infinity];                   Step5T1 = Map[Count[#, True] &, Step4T1];                   Step6T1 = Position[Step5T1, _?Supone];                   Res = (Flatten@Step6T1) + 1                 ];      * * *               Tentative2[ListT_] :=       Block[             {Step2T2, Step3T2, Step4T2, Step5T2, Step6T2, Res},                   Step2T2 = Map[Interval[#] &, ListT];                   Step3T2 = Outer[IntervalMemberQ, Step2T2, Step2T2];                   Step4T2 = DeleteCases[Step3T2, False, Infinity];                   Step5T2 = Map[Count[#, True] &, Step4T2];                   Step6T2 = Position[Step5T2, _?Supone];                   Res = (Flatten@Step6T2) + 1;                 ];      * * *               Tentative3[ListT_] :=       Block[             {Step2T3, Step3T3, Step4T3, Step5T3, Step6T3,Res},                  Step2T3 =  Map[Interval[#] &, ListT];                  Step3T3 = Intersection[Step2T3,IntervalIntersection @@@ Subsets[Step2T3, {2}]];                  Step4T3 = Map[Position[Step2T3, #] &, Step3T3];                  Res = Flatten@Step4T3                 ];      * * *               IMQ[x_, y_] :=       Block[             {Memo, Res},              If[                x[[1]] <= y[[1]],                       If[x[[1]] <= y[[1]] && x[[2]] >= y[[2]], Memo = True, Memo = False];,                Memo = False;               ];              Res = Memo            ];          FBS =       Compile[               {{List, _Real, 2}, {Interv, _Real, 1}},               Module[                      {i, j, st, end, xmin, xmax, Restr, Testlog},                      xmin = Interv[[1]];                      xmax = Interv[[-1]];                      st = List[[All, 1]];                      end = List[[All, 2]];                      i = 1; While[end[[i]] < xmax, i++];                      j = 1; While[end[[-j]] > xmax, j++];                      Restr = List[[i ;; -j]];                      Testlog = Count[Map[IMQ[#, Interv] &, Restr], True];                      If[Testlog > 1, 1, -1]                     ],                 Parallelization -> True,                 "RuntimeOptions" -> "Speed"               ];          Tentative4[ListT_] :=       Block[             {Step2T4, Step3T4, Step4T4, Step5T4, Step6T4, Res},                   Step2T4 = ListT;                   Step3T4 = Position[Map[FBS[Step2T4, #] &, Step2T4], 1];                   Res = Flatten@Step3T4            ];      * * *               Tentative5[ListT_] :=       Block[             {Step2T5, Step3T5, Step4T5, Step5T5, Step6T5, Res},                   Step2T5 = ListT;              Step3T5 =                   Module[                          {a, b},                          {a, b} =Transpose[Outer[Plus, -Step2T5, Step2T5, 1], {2,3,1}];                          SparseArray[Total[UnitStep[a] UnitStep[-b]] -1]["AdjacencyLists"]                         ]                   ];      * * *               Tentative6[ListT_] :=       Block[              {Step2T6, Step3T6, Step4T6, Step5T6, Step6T6, Res},                   Step2T6 = ListT;              Step3T6 = Pick[                              Range@Length@Step2T6,                              Map[MemberQ[Step2T6, {x_, y_} /; x <= #[[1]] && y >= #[[2]] && ! (x == #[[1]] && y == #[[2]])] &, Step2T6]                            ]                 ];       * * *               GIMQ[x_, y_] :=       Block[             {Memo, Res},                   If[                      x[[1]] <= y[[1]],                           If[x[[1]] <= y[[1]] && x[[2]] >= y[[2]], Memo = True, Memo = False];,                           If[y[[1]] <= x[[1]] && y[[2]] >=  x[[2]], Memo = True, Memo = False];                     ];                   Res = Memo                 ];          LIP[List_, i_] :=       Module[              {j, Res},               j = i - 1;               If[                   j!= 0,                  If[ GIMQ[List[[i]], List[[j]]] == True, Res = 1;, Res = -1;],                  Res = -1;                 ];                Res             ];            Tentative7[ListT] :=       Block[             {Step2T7, Step3T7, Step4T7, Step5T7, Step6T7, Res},                   Step2T7 = ListT              Step3T7 = Position[Map[LIP[Step2T7, #] &, Range[1, Length@Step2T7, 1]], 1];              Res = Flatten@Step3T7                 ];      * * *               Tentative8[ListT] :=       Block[             {Step2T8, Step3T8, Step4T8, Step5T8, Step6T8, Res},                   Step2T8 = ListT              Step3T8 = Pick[                             Range[2,Length@Step2T8],                             IntervalMemberQ@@@Partition[Interval/@Step28,2,1]                            ]                 ];         **Timing** * * * With : `Length@List = 2000` `Tentative1[List, Integer]` -> 10.15 seconds (Personal n°1)   `Tentative2[List, Integer]` -> 6.46 seconds (Rasher's n°1)   `Tentative3[List, Integer]` -> 3.34 seconds (Rasher's n°2)   `Tentative4[List, Integer]` -> 5.42 seconds (Personal n°2)   `Tentative5[List, Integer]` -> 7.72 seconds (Simon Woods n°1)   `Tentative6[List, Integer]` -> 6,48 seconds (Rasher's n°3)   `Tentative7[List, Integer]` -> 0.48 seconds (Personal n°3)   `Tentative7[List, Integer]` -> 0.45 seconds (Simon Woods n°2)    **Benchmark** * * * For `ListT = {{1, 8}, {2, 8}, {3, 8}, {4, 8}, {5, 10}, {6, 10}, {7, 11}, {8, 14}};`   The result is : `{2, 3, 4, 6}`   So we can read this as : {2, 8}, {3, 8}, {4, 8} and {6, 10} are included in other intervals. Which ? We don't care... The objective is to obtain theirs positions. _The subject remains open. I'm interested in any solution that would be faster than the current one_. _Additional questions_ :   \- _Is it possible to use Compile on LIP ? How ?_   \- _What's the better ? use of Block or use of Module ?_


title: Cannot convert list of associations to dataset for length longer then 4

text: Situation: I initialize two ranges:               range1 = CharacterRange["a", "d"]     range2 = CharacterRange["a", "i"]      Create associations:               as1 = {Association@Map[# -> 1 &, range1]}     as2 = {Association@Map[# -> 1 &, range2]}      Create simple data sets:               Dataset[as1~Join~as1]     Dataset[as2~Join~as2]      While first is created normally. Second one seems to be corrupted.


title: Add values to a PlotLabel; use text characters for PlotMarkers in DiscretePlot3D

text: I have a plot like this:               Table[Plot[a*x^2/4, {x, 0, 5}, PlotLabel -> "a="  a], {a, 1, 5, 1}]      I want to label the plots as `a=1`, `a=2`, ..., but _Mathematica_ labels them as `a=`, `2a=`, .... How can I solve this problem? I also have another problem:               DiscretePlot3D[2 x + y, {x, {1, 4, .2}}, {y, {2, 6, .2}},         Filling -> None, PlotMarkers -> {"Sphere", .01}]      Why I can not use plot markers such as `*`, `\[FilledSquare]`, ... in this plot?


title: How do you get a list of filenames from a URL?

text: How would I get a list of filenames available at a URL? For example, list the files at: http://www1.ncdc.noaa.gov/pub/data/cmb/drought/weekly-palmers/2005/


title: Is it possible to build/simulate/extract data from a System Modeler model completely inside a notebook using the MathModelica language syntax?

text: See examples in: http://www.mathematica- journal.com/issue/v10i1/contents/MathModelicaPaper/MathModelicaPaper_2.html It seems to be ruled out by the statement (Chapter 2 intro): "The subset of the Modelica language described in this section can be used in the simulation models, not in general Mathematica programming." but I just want to make sure I understand what this is saying, for example, does "simulation models" refer to SystemModeler only, or to simulating from within a notebook using WSMLink?


title: Piecewise Polynomial Interpolation

text: Given some data pairs $(x_i,y_i)$, with $i=0,...,m$, and a degree $r$, I wish to build a piecewise polynomial function to interpolate these data. That interpolation should be continuous, and, on every interval $[x_k,x_{k+r}]$, with $k=0, r, 2r, ...$, should be a polynomial of degree $r$. This can be useful for example to represent the solution of a PDE obtained with finite element method of degree $r$. Because with $r=1$ there are no problem I'll refer to $r=2$. For example, given the following data pairs: $$ \\{ (0,0), (1,1), (2,0), (3,1), (4,0) \\} $$ I wish to get this result: ![](http://i.stack.imgur.com/vrHZg.png) **The resulting interpolation function need not to have continuous derivative at $x=2$.** I tried with Interpolation and various options:               Interpolation[{{0, 0}, {1, 1}, {2, 0}, {3, 1}, {4, 0}},       InterpolationOrder -> 2, Method -> "Hermite"]     Plot[%[x], {x, 0, 4}]      ![](http://i.stack.imgur.com/evUhj.png)               Interpolation[{{0, 0}, {1, 1}, {2, 0}, {3, 1}, {4, 0}},       InterpolationOrder -> 2, Method -> "Spline"]     Plot[%[x], {x, 0, 4}]      ![](http://i.stack.imgur.com/9toN5.png) As a reference, under _MATLAB_ , I can build a piecewise polynomial interpolation of arbitrary degree, in a some involved way, with `mkpp`, and later consume the interpolation with `ppval`. For piecewise linear interpolation there is a more simple and direct `interp1` function. Under _MATLAB_ I give to `mkpp` the values of the polinomials and their derivatives at $x_0, x_r, x_{2r}, ...$ and I get the expected result. Under _Mathematica_ this approach doesn't work:               Interpolation[{{{0}, 0, 2, -2}, {{2}, 0, 2, -2}, {{4}, 0, 2, -2}},       InterpolationOrder -> 2, Method -> "Hermite"]     Plot[%[x], {x, 0, 4}]      ![](http://i.stack.imgur.com/dqv4x.png) I considered using `Piecewise` and constructiong an `Interpolation` or a polynomial pure function for every interval $[x_k,x_{k+r}]$ but I suspect this become unmanageably complex when there are hundred or thousand of intervals. There is some builtin way, reasonably simple and fast, to get this result? Naturally I search a general way, for general data and general $r$. ## UPDATE @kguler answer is interesting but I need a way to generalize for every $r$.


title: Graphics in Notebook Different from Graphics Expression?

text: Consider the expression               TreeForm[a+b^2+c^3+d]      which displays as ![enter image description here](http://i.stack.imgur.com/W3ILi.png) This is a nice Graphics object, as I can prove by typing `//FullForm` after it, like this ![enter image description here](http://i.stack.imgur.com/7dEWy.png) and getting               Graphics[Annotation[       GraphicsComplex[        List[List[1.29777, 1.29777], List[0., 0.648886],         List[0.648886, 0.648886], List[0.324443, 0.], List[0.973329, 0.],         List[1.94      ...          List[Tooltip[           Inset[Framed[Style[Plus, "StandardForm", "Output", Rule[LineColor,       It has framed elements in it, as I can prove by either looking at the text above, or by typing ![enter image description here](http://i.stack.imgur.com/Wv0iQ.png) But, the `TreeForm` expression itself does not have any framed elements in it. For instance               TreeForm[a+b^2+c^3+d] /. (x_Framed :> Print[x])      produces the original graphic ![](http://i.stack.imgur.com/W3ILi.png) Somehow, the Notebook is not allowing me to capture and rewrite the expression form of the graphic -- the only way I know to access it is by cutting and pasting the graphical form of the object manually by mouse into the places where I need to manipulate it. This is no good. I need `SecretEvaluator`, such that               SecretEvaluator[TreeForm[a+b^2+c^3+d]] /. (x_Framed :> Print[x])      produces the same output as ![](http://i.stack.imgur.com/Wv0iQ.png)


title: Strange behavior of Reduce with a cubic equation

text: This equation: $(\frac{-a}{x})^2=\sqrt{\frac{1}{x}}$ at $a > 0$ and $x > 0$ has a clear solution $x=a^{4/3}$, doesn't it? However,               Reduce[(-(a/x))^2 == (1/x)^(1/2) && x > 0 && a > 0] // ToRadicals      yields > >     a > 0 && x == (-1)^(2/3) a^(4/3) >   where                ComplexExpand[(-1)^(2/3)]      > >     -(1/2) + (I Sqrt[3])/2 >   is a complex number, numerically `N @ %` yields `-0.5 + 0.866025 I`. Why?


title: A is fast, B is fast, but together they're Mathematica-crashing slow?

text: I'm trying to do something with finding solutions to a quantum mechanics problem with n wells. If there are 40 wells, I need to find the solution to an equation in the form:               {a,b}.MatrixPower[A,40].{c,d}      So, I use FindRoot and everything works out great, in a decent amount of time. The actual code used is something along these lines:               lowPropagator[        dist_, α_] :=  {{Cos[α dist],Sin[α dist]/α},                            {-α Sin[α dist], Cos[α dist]}};     highPropagator[        dist_, β_] := {{Cosh[β dist], Sinh[β dist]/β},                        {β Sinh[β dist],Cosh[β dist]}};     root[d_, n_, start_] :=        FindRoot[{α, 1}.          MatrixPower[lowPropagator[d, α].highPropagator[d,α], n - 1].          lowPropagator[d, \[Alpha]].{1,α},           {α,start}, MaxIterations -> 50       ];     Manipulate[      root[d, n,α0], {{d, 1}, 0, 5}, {{n, 2}, 1, 10,        1}, {{α0, 1}, 0, 5}]      It's responsive even for larger n. Then, I try to plot the equation. The plotting function is a large/complicated piecewise function, alternating between the form $f=A \cos(\alpha x)+B\sin(\alpha x)$, and $f=A \cosh(\beta x)+B\sinh(\beta x)$ (where beta is a function of alpha). The matrices "lowPropagator" and "highPropagator" allow me to find the function and its derivative at each point where the form of the piecewise function changes, so I can use a matrix inverse to solve for A and B, and then plug all of this into a giant Piecewise[]. So there's a lot of computation going on in the function. The function is in the form:               getWaveFunction[α_, β_, \[Rho]_, a_, b_, n_] := Module[{...},          ...         totalFunction[x_] :=          Piecewise[Table[{eqlist[[i]][x], x < wavePositions[[i]]}, {i, 1, 2 n}],           eqlist[[2 n + 1]][x]];       totalFunction[#] &       ];      So the function isn't trivial, but it still runs fast, faster than the root finding even, especially when n is high. (it's doing at least 2n matrix multiplications) However, when I do something like this:               plotIt[d_, n_, start_] := Module[{αnear, f},       αnear = root[d, n, start];       f = getWaveFunction[αnear, ..., d, n];       Plot[f[x], {x, -5, 5}]]      For some values, the function takes forever to draw the graph. The black evaluation bar doesn't pop up, so alt+. doesn't do anything. Basically, if I choose the input values incorrectly, most of the time Mathematica becomes completely unresponsive and I have to restart. I think Mathematica IS still running and calculating, because sometimes after 30 seconds or so it will return a result. Out of curiosity I left it running overnight with a different value and it was still frozen when I came back, so, something is not right. So the biggest issue is that these two functions are fast on their own, at ALL input values, but at certain input values the combination of the two takes forever. My question is, how can I fix this to make the function run at a decent speed, and if I can't, how can I make it fail gracefully so that the notebook doesn't crash? Relevant things:   * It fails at large n and large d or "dist".   * It IS taking a matrix with hyperbolic functions in it, to the nth power. So, the values can get pretty huge (understatement), and this is exactly what happens with the values at the crash. However, the root finding function on its own doesn't seem to crash at these values. Neither does the plotting function. It's only both together that causes problems.   * I figure evaluation might be the problem, maybe the root and/or the graph are trying to be found many times inside the plot function, but adding "//Evaluate" to the end of whatever f and αnear equal doesn't solve the problem. Let me know if I should post the full code. The relevant bits add up to ~180 lines, with a good amount of spacing/comments. The full code produces graphics like this: ![Solution of the time independent schrodinger equation](http://i.stack.imgur.com/Vqz1o.png) (The red line corresponds to the α result of FindRoot. The purpose of FindRoot is to find all solutions that are exponentially decaying on both sides of the graph, so the red line is exponentially decaying on both sides, but the dashed line [which corresponds to the "start" value in FindRoot] isn't a solution, since it diverges on the right side. I'm trying to find solutions to the time independent schrodinger equation, for a single particle, with n wells, and this is for the end of chapter 2 of "A First Course in Computational Physics" by DeVries [not homework, & the book doesn't ask for solutions this general].) * * * ## Update with full code So, I haven't been able to simplify the code to much significant extent. If I simplify it too much, to the point where it seems to work but isn't calculating what I want it to calculate, the problem seems to disappear! I do think the problem could be with evaluation though. If you comment out the "Show" at the end and just write "f2" in its place, (f2 is the function that is a result of getWaveFunction, with FindRoot passed in as an argument), it prints out, "totalFunction$30552[#1] &" (or some similar number on the end). Since totalFunction doesn't exist in the scope it's at... I'm guessing that this is an evaluation problem, where Plot re-evaluates something it doesn't really have to a bunch of times. Code: (And, keep in mind while running it, it can crash)               (* \[Alpha] is the frequency of open regions     \[Beta] is the coefficient of high energy regions (should be \     \[Beta]=Sqrt[vm2h-\[Alpha]^2])     \[Rho] is the height at the leftmost wall     a is the width of the open region     b is the width of the high energy regions     n is the number of wells.            This function returns a pure function, that is supposed to be the \     wavefunction \[Psi][x]. (does not depend on time)     *)     getWaveFunction[\[Alpha]_, \[Beta]_, \[Rho]_, a_, b_, n_] :=       Module[{left, eqLeft, eqRight, eqlist, lowPropagator,          highPropagator, lowInverseCoefficients, highInverseCoefficients,         waveRecursiveFunction,         waveValues,         wavePositions,         waveConstants,         totalFunction},             lowPropagator[          dist_] :=  {{Cos[\[Alpha] dist],              Sin[\[Alpha] dist]/\[Alpha]},   {-\[Alpha] Sin[\[Alpha] dist],            Cos[\[Alpha] dist]}};        highPropagator[          dist_] := {{Cosh[\[Beta] dist],            Sinh[\[Beta] dist]/\[Beta]}, {\[Beta] Sinh[\[Beta] dist],            Cosh[\[Beta] dist]}};             (* The wavefunction and its derivative can be represented as:        A.{aconst,bconst}={\[Psi],\[Psi]'},         so to solve for aconst and bconst you just take the inverse of the \     matrix A,         where A either corresponds to the low solution or the high solution.         *)        lowInverseCoefficients[          x_] := {{Cos[\[Alpha] x], -Sin[\[Alpha] x]/\[Alpha]}, {Sin[\     \[Alpha] x], Cos[\[Alpha] x]/\[Alpha]}};        highInverseCoefficients[          x_] := {{Cosh[\[Beta] x], -Sinh[\[Beta] x]/\[Beta]}, {-Sinh[\     \[Beta] x], Cosh[\[Beta] x]/\[Beta]}};             (* Define the leftmost point so that everything is centered around \     0 *)        left = -(n*(a + b) - b)/2;              (* waveValues is to be an array giving the values of the \     wavefunction an its derivative. ie:         waveValues[[1]]=={\[Psi][left],\[Psi]'[left]};             waveValues[[2]]=={\[Psi][left+\[CapitalDelta]x],\[Psi]'[        left+\[CapitalDelta]x]};        etc.             wavePositions is just the position of the nth change in height,         with wavePositions[[1]] being the start of the leftmost dip.             waveConstants holds the values of coefficients to equations. So,         you'll have each waveConstants[[        n]] be equal to some vector {aconst, bconst}.         Whether the equation is in the zero energy region or high energy \     region depends on whether n is odd or even respectively.         So if n is odd the constants correspond to the equation (aconst*        Cos[\[Alpha] x]+bconst*Sin[\[Alpha] x]),         and if n is even the constants correspond to the equation (aconst*        Cosh[\[Beta] x]+bconst*Sinh[\[Beta] x]).        *)        waveValues = wavePositions = waveConstants = Table[0, {q, 1, 2 n}];        waveRecursiveFunction[1] := (          waveValues[[1]] = {\[Rho], \[Rho] \[Beta]};          wavePositions[[1]] = left;          waveConstants[[1]] =            lowInverseCoefficients[left].{\[Rho], \[Rho] \[Beta]};          );        waveRecursiveFunction[j_] := (          (* fill out previous values *)          waveRecursiveFunction[j - 1];          If[Mod[j, 2] == 0,           (* j=2m,            so to the left of it is a zero region and to the right is a \     high energy region. *)           waveValues[[j]] = lowPropagator[a].waveValues[[j - 1]];           wavePositions[[j]] = wavePositions[[j - 1]] + a; (*            width of the high energy region is a. *)           waveConstants[[j]] = highInverseCoefficients[0].waveValues[[j]];           ,           (* j=2m+1,            so to the left of it is a high energy region and to the right \     is a zero energy region. *)           waveValues[[j]] = highPropagator[b].waveValues[[j - 1]];           wavePositions[[j]] = wavePositions[[j - 1]] + b;           waveConstants[[j]] =             lowInverseCoefficients[wavePositions[[j]]].waveValues[[j]];           ];          );        waveRecursiveFunction[2 n];                  eqlist =          Join[{Evaluate[(highInverseCoefficients[                 0].{\[Rho], \[Rho] \[Beta]}).{Cosh[\[Beta] (# - left)],                Sinh[\[Beta] (# - left)]}] & },          Table[If[Mod[m, 2] == 0,            (Evaluate[               waveConstants[[m]].{Cosh[\[Beta] (# - wavePositions[[m]])],                  Sinh[\[Beta] (# - wavePositions[[m]])]}]) &,            (Evaluate[               waveConstants[[m]].{Cos[\[Alpha] #], Sin[\[Alpha] #]}]) &            ], {m, 1, 2 n}           ]          ];             totalFunction[x_] :=          Piecewise[          Table[{eqlist[[i]][x], x < wavePositions[[i]]}, {i, 1, 2 n}],           eqlist[[2 n + 1]][x]];        totalFunction[#] &        (*Show[Plot[totalFunction[x],{x,left-1,-left+1},PlotRange->{-1,1}],        drawPotential[a,b,1,n]]*)        (*{Plot[totalFunction[x],{x,-4,4}],waveValues,wavePositions,        waveConstants,eqlist,totalFunction[x]}//Column*)                  ];     Manipulate[      Module[{f1, f2, \[Alpha]near, left, lowPropagator, highPropagator},       c = Rationalize[c];       d = Rationalize[d];       a = Rationalize[a];       \[Rho] = Rationalize[\[Rho]];       left = -(n*(a + d) - d)/2;        f1 = getWaveFunction[\[Alpha], Sqrt[c - \[Alpha]^2], \[Rho], a, d,          n];       lowPropagator[         dist_, \[Alpha]_] :=  {{Cos[\[Alpha] dist],             Sin[\[Alpha] dist]/\[Alpha]},   {-\[Alpha] Sin[\[Alpha] dist],           Cos[\[Alpha] dist]}};       highPropagator[         dist_, \[Beta]_] := {{Cosh[\[Beta] dist],           Sinh[\[Beta] dist]/\[Beta]}, {\[Beta] Sinh[\[Beta] dist],           Cosh[\[Beta] dist]}};       \[Alpha]near = FindRoot[{Sqrt[c - \[Alpha]v^2], 1}.           MatrixPower[            lowPropagator[a, \[Alpha]v].highPropagator[d,               Sqrt[c - \[Alpha]v^2]], n - 1]           .lowPropagator[a, \[Alpha]v].{1, Sqrt[c - \[Alpha]v^2]},          {\[Alpha]v, \[Alpha]}, MaxIterations -> 50] // Evaluate;            \[Alpha]near = (\[Alpha]v /. \[Alpha]near);       If[Abs[Im[\[Alpha]near]] < 0.00001, \[Alpha]near =          Re[\[Alpha]near], \[Alpha]near = 0];       If[\[Alpha]near > 0,         f2 = Evaluate[          getWaveFunction[\[Alpha]near, Sqrt[c - \[Alpha]near^2], \[Rho],            a, d, n]], f2 = 0 &];                 Show[Plot[f1[x],{x,left-1,-left+1},PlotStyle->Dashed],       Plot[f2[x],{x,left-1,-left+1},PlotStyle->Directive[Thick,Red],       Exclusions->None],       PlotRange->{-1.5,1.5}       ]                 ], {{\[Alpha], 2}, 0.001, Sqrt[c]}, {{c, 10}, 0.001, 20}, {{a, 1},        0.001, 10}, {{d, 0.2}, 0.001, 10}, {{\[Rho], 0.2}, 0, 1}, {n, 2, 10,        1}]


How do I display an expression with negative powers? Mathematica seems to always invert a term with a negative rational power. None of the following work:               Power[4,-3]     HoldForm[Power[4,-3]]     Unevaluated[Power[4,-3]]      The problem I am trying to solve is pretty simple. I have a function that takes an expression as an argument and returns two TextCells as a result. One text cell restates the expression and the other shows the simplified version of the expression. I currently call the function like this:               f[HoldForm[ x^2 + 3x + 5 == 0 ]]      Ideally, it will display the original expression with minimal formatting (it is nice for Abs[x] to be replaced with |x| for example, but I'd like to leave negative powers intact). **Edit:** I just wanted to add, that I have a list of expressions to which I apply the expression to produce an "exam" document and an "answer key" document. That is why I need some control over the formatting of the expression. To the extent that a technique can be embedded in the function, that is probably preferable to having to change all of the expressions. **Edit 2** : I'd like to thank everyone for their suggestions. As Xerxes points out in his comments, Mathematica does not differentiate between the following two inputs:               x^-1 // FullForm     (* Power[x,-1] *)          1/x // FullForm     (* Power[x,-1] *)      Given this, I think the only way to achieve my formatting goal is to differentiate the input forms. Here is what I came up with:               xPower /: MakeBoxes[xPower[x_, e_ /; e < 0], form_] :=          SuperscriptBox[MakeBoxes[x, form], MakeBoxes[e, form]]      xPower /: MakeBoxes[xPower[x_, e_ /; e < 0], form_] :=          SuperscriptBox[MakeBoxes[x, form], MakeBoxes[e, form]]     xTimes := Times     xPower := Power      Now, for my test case of `HoldForm[4^-3 \[Times] 1/2^-4]`, which Mathematica will by default rearrange to `1/4^3/2^4`, I can write:               HoldForm[xTimes[xPower[4,-3],xPower[2,-4]]]     (* 4^-3 \[CenterDot] 1/2^-4 *)      and,               xTimes[xPower[4,-3],xPower[2,-4]]     (* 1/4 *)      Using this paradigm, I need to use the alternate functions `xTimes` and `xPower` whenever I need to maintain the strict expression formatting. This seems like the minimum deviation necessary on the input side to achieve the desired result. Does this make sense? Or, I am in for some unexpected behavior down the road? Did I miss an easier approach? Or, something more Mathematica-ish.


title: Problem with strings imported from PDFs

text: I am currently working with a list containing around 20 strings which contain around 30,000 characters each. The strings are imported from PDFs and the list containing all the strings is assigned to a variable. So far so good. However, when I evaluate the list (e.g., evaluate variable, then evaluate subsequent output) I get the following error message:               Syntax::tsntxi: "<<1>>" is incomplete; more input is needed.     Syntax::sntxi: Incomplete expression; more input is needed .      I have tried the same procedure on other computers running Mathematica, but I get the same result. Unfortunately, I am unable to provide a minimum working example, so I'll be happy to provide any additional information that might help.


title: All possible solutions to the Matrix Equation (free variables appearing)

text: I am attempting to solve a system of linear equations using `LinearSolve[]` . In my case, the number of unknowns are more than constraints. I learnt that LinearSolve does not give me all solutions. However, I am also unable to use `Solve[]` to get all possible solutions. Here is my example:               InpMatrix={     {1,0,0,0,0,0,0,0,0,0,0,0},     {15,4,0,0,0,0,0,0,0,0,0,0},     {90,48,16,0,0,0,0,0,0,0,0,0},     {270,216,144,16,0,0,0,0,0,0,0,0},     {405,432,432,0,16,0,0,0,0,0,0,0},     {243,324,432,0,0,16,0,0,0,0,0,0},     {16,0,0,0,0,0,256,0,0,0,0,0},     {0,0,0,-16,-16,-16,47104,1024,0,0,0,0}     };          synd={{0},{0},{0},{0},{0},{0},{256},{1024}};          In[217]:= sol = LinearSolve[InpMatrix, synd]          Out[217]= {{0}, {0}, {0}, {0}, {0}, {0}, {1}, {-45}, {0}, {0}, {0}, {0}}      However, the solution I am looking for should be:               {{0}, {0}, {0}, {0}, {0}, {0}, {1}, {-45}, {0}, {30}, {15}, {0}}      Hence I tried to use `Solve[]` in the following way:               Solve[InpMatrix.var == synd, var]      But it gives me an error saying:               Solve::nsmet: This system cannot be solved with the methods available to Solve. >>           Solve[{     {1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},      {15, 4, 0, 0, 0, 0, 0, 0,  0, 0, 0, 0},      {90, 48, 16, 0, 0, 0, 0, 0, 0, 0, 0, 0},      {270, 216, 144, 16, 0, 0, 0, 0, 0, 0, 0, 0},      {405, 432, 432, 0, 16, 0, 0,  0, 0, 0, 0, 0},      {243, 324, 432, 0, 0, 16, 0, 0, 0, 0, 0, 0},      {16, 0, 0, 0, 0, 0, 256, 0, 0, 0, 0, 0},      {0, 0, 0, -16, -16, -16, 47104, 1024, 0, 0, 0, 0}     }.var == {{0}, {0}, {0}, {0}, {0}, {0}, {256}, {1024}}, var]      Could anyone kindly help me with correctly using `Solve[]` or any other functionality that yields all posible solutions ? Preferably I would general solution, a symbolic form with free variables.


title: Why is plot legend unsafe?

text: Every time I open a notebook contains a legend, I get the message warning that it's not safe. > The file contains potentially unsafe dynamic content. Why does this happen and how to fix it? ![enter image description here](http://i.stack.imgur.com/2qsUe.png)