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

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


How can I find the vertexes of a Polygon?

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`?


Mathematica 10 trial limitations

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?


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

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?


Importing a matrix from a text file

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.


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

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]      ]


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

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.


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

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?


Using NDSolve to solve Equation of Motion in cylindrical coordinates

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$.


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

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.


Kelvin per Kelvin Difference

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!


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

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?


ImageTransformation: polar to cartesian

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]


Radon function result's repeatability

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)


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

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}}


Hurwitz-Lerch transcendent

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}]


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

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?


Visual Studio 2013 Mathlink addtwo

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)


Improper mutiple integral

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?


Find positions of items in a list based on neighbours

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.


Need help with extracting columns from a table

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?


Multi-Selection dynamic menus

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)


Simple contour integral with a parameter gone wrong

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?


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

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!


Converting inequalities to intervals

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.


Performance of a Do-Loop of variable length

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`.


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

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.


How to combine different EventHandlers?

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       ]      ]


How to define a summation with function calling itself?

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.


Data paste in piecewise table

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)


Backsubstituting solution into FindRoot and Plot

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.


A fast way to compare interval

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 ?_


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

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.


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

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?


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

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/


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

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?


Piecewise Polynomial Interpolation

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$.


Graphics in Notebook Different from Graphics Expression?

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)


Strange behavior of Reduce with a cubic equation

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?


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

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.


Problem with strings imported from PDFs

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.


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

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.


Why is plot legend unsafe?

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)


Setting label in DendrogramPlot

I want to create a dendrogram with the labels being a visual representation of the data. Something like this: ![What I wanna do](http://i.stack.imgur.com/slJvH.png) How can I do that in _Mathematica_? My attempt so far hasn't been very successful. The labels are all messed up.               Needs["HierarchicalClustering`"]     SeedRandom@2;     data = RandomVariate[NormalDistribution[], {10, 20}];     label = ListPlot[#, Axes -> False, Joined -> True] & /@ data;     DendrogramPlot[data, Orientation -> Right, LeafLabels -> label]      This is what I get from the code above: ![enter image description here](http://i.stack.imgur.com/2cexk.png)


Converting truth tables to boolean expressions

I have a truth table for a Boolean expression represented like this               table={{0, 0, 0, 0} -> 0, {0, 0, 0, 1} -> 0, {0, 0, 1, 0} ->      0, {0, 0, 1, 1} -> 0, {0, 1, 0, 0} -> 0, {0, 1, 0, 1} ->      0, {0, 1, 1, 0} -> 0, {0, 1, 1, 1} -> 1, {1, 0, 0, 0} ->      1, {1, 0, 0, 1} -> 1, {1, 0, 1, 0} -> 1, {1, 0, 1, 1} ->      1, {1, 1, 0, 0} -> 1, {1, 1, 0, 1} -> 1, {1, 1, 1, 0} ->      1, {1, 1, 1, 1} -> 0}      (all on one line) The table contains the values I want at the output given y4,y3,y2,y1 at the input, i.e.               {y4,y3,y2,y1} -> desiredOutput      What is the best way to transform this data into a form that can be then processed in terms of y with functions such as BooleanMinimize?


Trace of intersecting planes

I have a set of curved planes that intersect each other. I only want all the parts of all planes displayed that are above the intersecting traces. Further, I would like to highlight the intersecting traces. It sounds like a simple enough problem (maybe it is), but I couldn't finde any routine to do this. So, any help is welcome. Here is an example:                   inputData = {            {{0, .5, .5, 1200}, {0, 1, 0, 1500}, {.5, .5, 0, 1150}, {1/3, 1/3,               1/3, 1100}}            , {{0, 0, 0, 1650}, {0, .5, .5, 1200}, {1/3, 1/3, 1/3, 1100}, {.5,               0, .5, 1300}}            , {{1, 0, 0, 1650}, {1/3, 1/3, 1/3, 1100}, {.5, 0, .5,               1300}, {.5, .5, 0, 1150}}            };          coords[{A_, B_, C_}] := {A/2 + B, A Tan[Pi/3]/2};     newCoordinates[data_] := Table[        Join[coords[{data[[i, #, 1]], data[[i, #, 2]],              data[[i, #, 3]]}], {data[[i, #, 4]]}] & /@          Range@Length@data[[i]]        , {i, 1, Length[inputData]}        ];         data = newCoordinates[inputData];         quad = Fit[data[[#]], {1, x, y, x^2, x y, y^2}, {x, y}] & /@             Range@Length@data;              Plot3D[quad, {x, 0, 1}, {y, 0, 1}          , MeshFunctions -> {#3 &}          , RegionFunction ->            Function[{x, y, z},             0 < Sqrt[3] x - y && 1.72 > Sqrt[3] x + y && z > 1100]          , PlotStyle -> {Directive[Orange, Opacity[.5]],             Directive[Green, Opacity[.5]]}          , PlotRange -> {{0, 1}, {0, 1}, {0, 2000}}          , BoundaryStyle -> Thick          , BoxRatios -> {1.2, 1.2, 2}          , Boxed -> False          , Axes -> None          , ImageSize -> 500          ]


In a manipulatable graph, display x values of all intersections with one of the lines?

I'm doing a project about Moore's law, I'm trying to create a graph that which you can manipulate, but I want the x-values of the intersections with one the lines to be displayed; how would I go about doing this? This is what I have (the first formula is 'real', the rest are placeholders for the sake of having intersections):               j0=1980;     Manipulate[LogPlot[{tj0*2^((j - j0)/2), -(b*2^((j - j0)/1.5) - 1000),          -a*j + c}, {j, 1980, 2000},Frame -> True, PlotRange -> All, LabelStyle ->      {FontFamily -> "Helvetica", FontSize -> 15}, FrameLabel -> {"Year", "Transistor Count"}],     {{tj0, 100, "Transistor Count First Year"}, 100, 200}, {{b, 100, "b-Value"}, 100, 200},      {{a, 100, "a-Value"}, 80,  120}, {{c, 250000, "c-Value"}, 250000, 300000}]      ![enter image description here](http://i.stack.imgur.com/6nvgH.png) What I would like is something like this:               Manipulate[ If[(-M + M p + Ls z - Ls p z)/(-1 + z) <= M, Plot[{If[G <= M, (-G + M + G z - Ls z)/z], If[(-M + M p + Ls z - Ls p z)/(-1 + z) <= M, Exp[((1 - p)*Log[G] - p*Log[((M p - Ls p z)/z)] - (1 - p)* Log[((-M + M p + Ls z - Ls p z)/(-1 + z))])/-p]]}, {G, 0, 2000}, AxesLabel -> {" SubscriptBox[\"W\", \"G\"] ", " SubscriptBox[\"W\", \"B\"] "}, PlotRange -> {{0, 2500}, {0, 2500}}, AxesStyle -> Directive[Bold], LabelStyle -> Bold, Epilog -> {Thick, Dashed, Line[{{(-M + M p + Ls z - Ls p z)/(-1 + z), 0}, {(-M + M p + Ls z - Ls p z)/(-1 + z), (M p - Ls p z)/ z}}]}, Prolog -> {Thick, Black, Line[{{0, 0}, {2500, 2500}}]}, PlotStyle -> {{Thick, Blue}, {Thick, Purple}}, PlotLabel -> "Optimal Insurance Contract"], Plot[{If[G <= M, (-G + M + G z - Ls z)/z], G}, {G, 0, 2500}, AxesStyle -> Directive[Bold], AxesLabel -> {" SubscriptBox[\"W\", \"G\"] ", " SubscriptBox[\"W\", \"B\"] "}, PlotStyle -> {{Thick, Blue}, {Thick, Black}}, AxesOrigin -> {0, 0}, PlotRange -> {{0, 2500}, {0, 2500}}, AxesStyle -> Directive[Bold], Epilog -> {PointSize[Large], Red, Point[{M, M - Ls}]}, PlotLabel -> "Optimal Insurance Contract", LabelStyle -> Bold]], {{p, .5, "Probability of Bad State"}, .1, .9}, {{M, 1000, "Original Wealth"}, 500, 1250}, {{z, .52, "Insurance Premium"}, .3, .9}, {{Ls, 200, "Loss"}, 50, 900}, Text[Style[ "Wealth in the Good State = " Dynamic[ If[(-M + M p + Ls z - Ls p z)/(-1 + z) <= M, Dynamic[(-M + M p + Ls z - Ls p z)/(-1 + z)], M]], 12, "Label"]], Text[Style[ "Wealth in the Bad State = " Dynamic[ If[(-M + M p + Ls z - Ls p z)/(-1 + z) <= M, Dynamic[(M p - Ls p z)/z], M - Ls]], 12, "Label"]], Text[Style[ "Premium = " Dynamic[ If[(-M + M p + Ls z - Ls p z)/(-1 + z) <= M, Dynamic[M - (-M + M p + Ls z - Ls p z)/(-1 + z)], 0]], 12, "Label"]]]      ![enter image description here](http://i.stack.imgur.com/QWoTD.png) I'd like thick dashed lines to go down to the x-axes from the intersections of any of the lines with the first blue line and the x (or j value here) to be displayed like in the second example.


Creating a C++ project with Visual Studio 2010

I am trying to create a GUI using Microsoft Visual Studio C++ 2010 by calling _Mathematica_ in my codes. I have done everything step by step as mentioned here Then I wrote this code as mentioned in here The code is as below               #include <mathlink.h>     #include <stdio.h>          int main(int argc, char *argv[]) {          MLENV env;          MLINK link;          int errno;               env = MLInitialize(0);               link = MLOpenArgcArgv(env, argc, argv, &errno);               MLActivate(link);               return 0;     }      The error I get is:               1>------ Build started: Project: mathematica_link_attempt1, Configuration: Debug Win32 ------     1>main.obj : error LNK2019: unresolved external symbol _MLOpenArgcArgv@16 referenced in function _main     1>main.obj : error LNK2019: unresolved external symbol _MLActivate@4 referenced in function _main     1>C:\Users\arvindrajan\documents\visual studio 2013\Projects\mathematica_link_attempt1\Debug\mathematica_link_attempt1.exe : fatal error LNK1120: 2 unresolved externals      Any advice please?


Why does Rotate in PlotMarkers behave strangely?

While answering Change the inner color of markers I came across a behavior that may be a bug.   I would like to know if there is another explanation. First a basic example of normal behavior:               ListLinePlot[{Prime~Array~12, Fibonacci~Array~12},      PlotMarkers -> Graphics[{Brown, Rectangle[]}, ImageSize -> 13],      PlotLegends -> Automatic     ]      ![enter image description here](http://i.stack.imgur.com/RZv2d.png) Note that the markers are included in the legend. But now if I `Rotate` the `Rectangle`:               ListLinePlot[{Prime~Array~12, Fibonacci~Array~12},      PlotMarkers -> Graphics[{Brown, Rectangle[] ~Rotate~ (Pi/4)}, ImageSize -> 13],      PlotLegends -> Automatic     ]      ![enter image description here](http://i.stack.imgur.com/sEarW.png) The markers disappear from the legend. They do appear if I `Rotate` the entire `Graphics`, however the markers are not scaled as before and they clip:               ListLinePlot[{Prime~Array~12, Fibonacci~Array~12},      PlotMarkers -> Graphics[{Brown, Rectangle[]}, ImageSize -> 13] ~Rotate~ (Pi/4),      PlotLegends -> Automatic     ]      ![enter image description here](http://i.stack.imgur.com/D8Yxl.png)   1. Is use of `Rotate` in plot markers simply unsupported or is this a bug?   2. Is there a way to use rotated primitives for markers and not break the legend?


Piecewise function with a function as argument

I want to define a piecewise function, which has two arguments, one of which is a function of the other's piecewise argument. I am giving an example               X0 = 1.7635;     X1 = 4.4855;     γ[En_] := En/0.13957     β[En_] := Sqrt[γ[En]^2 - 1]/γ[En]     X[En_] := Log[10, β[En]*γ[En]]     f[En_, Evaluate[X[En_] _]] :=Piecewise[{{0, X[En] < X0}, {4*X[En], X[En] > X0}}]     PLot[f[En, Evaluate[X[En]]], {En, 0.001, 1000}]      Is it possible?


Why is `Cell` > `Convert To` > `InputForm` not invertible?

I sometimes post code to PhysicsSE, and I usually convert it to `InputForm` first before posting, in order to avoid pages and pages of `RowBox` and `Offset` fluff. I usually instruct the user to copy/paste it into a new notebook, and use `Cell` > `Convert To` > `StandardForm` in order to get everything properly formatted. Unfortunately, this does not always work. For example, consider the following `StandardForm` code:               Q = Sum[Array[a[10 k], {3}], {k, 4}] // MatrixForm // TeXForm      It looks fine, and in this case there isn't any need to convert to `InputForm`, but that's just because this is meant to be a minimal example. Now let's convert it to `InputForm` (on Mac OSX, this is performed via `Command`+`Shift`+`I`):               Q = \text {MatrixForm}\left[\sum _k^4 \text {Array}[           a (10 k), \{3\}] \r ight]      This is, of course, completely un-runnable, and executing `Cell`>`Convert To`>`StandardForm` fails to produce the original expression, let alone anything which is syntactically correct. Why is this? Is this a glitch with the front end's implementation of `Convert To`? Or am I doing something wrong? The very similar expression               Q = Sum[Array[a[10 k], {3}], {k, 4}] // MatrixForm      gets converted via `InputForm` to               Q = MatrixForm[Sum[charge[[k]]*f[position[[k]]], {k, 4}]]      which is, of course, correct; this makes me suspect that the front-end is getting tripped up by the sequence of two `//` operators. More generally, what do you recommend is the best way to copy and paste Mathematica code to StackExchange sites?


Why does Mathematica stop when run in the background in command line mode?

If I try to start a Mathematica script in the background from the command line, like this:               math -script someFile.m &      then the process gets automatically suspended. Here's a terminal transcript for clarifications: ![](http://i.stack.imgur.com/TvE9z.png) This happens both on Linux and OS X. Other programs don't typically stop when run in the background.   * Why does this happen?   * What can I do to prevent this?


How can define a set of nested parameters

I would like to know how I to define a function with a nested set of parameters (or whatever you would like to call it). For example, how would I get the following function `A`,               M = m1 + m2;     \[Eta] = m1*m2/(m1 + m2)^2     A[t_]:= M (\[Eta] / M * t)^(1/4);      Such that if I just evaluated `A[5.0]` for example it would return,               1.49535 M Power[\[Eta]/M, (4)^-1]      (i.e. a function of `M` and `\[Eta]`) or something similar, but not `A` as a function of `m1`, `m2`,               1.49535 Power[(m1 m2)/(m1+m2)^2, (4)^-1] (m1+m2)      But, at the same time, maintain a form that I could replace either `m1` and `m2` or `M` and `\[Eta]`, such that both               A[5.0] /. m1 -> 1 /. m2 -> 1     A[5.0] /. M -> 2 /. \[Eta] -> 1/4      would return `1.77828`.


Pathological behaviour when evaluating a sum

When I declare the function $f$ as follows:               f[n_] := Sum[x/Sum[Sqrt[y], {y, 1, x}], {x, 1, n}]/n      the input               Limit[f[n],n -> Infinity]      does not yield an answer, in fact the evaluation is terminated after a few seconds. If I now write               Limit[f[x], x -> Infinity]      I get an answer of $0$. Why is that, according to the manual entry of "Sum" we have > The iteration variable i is treated as local, effectively using Block. If it matters, I use the version 9.0.


How to order lexicographically the monomers of a parametrized polynomial?

I want to order lexicographically the monomials in a "parametrized polynomial", i.e. polynomials whose "symbolic bits" may be either "variables" or "parameters". For example:               In[1]:= Expand[(x + a y + a^2 z)^3] /. a^n_ -> a^Mod[n, 3]          Out[1]= x^3 + y^3 + 6 x y z + z^3 + 3 x^2 y a + 3 y^2 z a + 3 x z^2 a +  3 x y^2 a^2 +      3 x^2 z a^2 + 3 y z^2 a^2      In the polynomial above `x`, `y`, and `z` are intended as "variables", whereas `a` is intended as a "parameter". The documentation for _Mathematica_ states that monomials in a polynomial are ordered lexicographically by default, but if so, I don't understand why the two terms with `x^2` come after the `y^3` term in the polynomial above, for example. So my question is: how can I force a lexicographic ordering of the monomials with respect to the "variables" (i.e. `x`, `y`, and `z`). (In particular, for the polynomial above, the symbol `a` should be disregarded for the ordering.) For example, the desired ordering for the polynomial above would be               x^3 + 3 x^2 y a + 3 x^2 z a^2 + 3 x y^2 a^2 + 3 x z^2 a + 6 x y z + y^3 + 3 y^2 z a + 3 y z^2 a^2 + z^3


Mathematica won't simplify the expression with obvious common factor of a fraction

I have an expression obtain from an integral, which is:               Integrate[ϵ^2/Sqrt[(ϵ - u)^2 + Δ^2], ϵ] // FullSimplify      The denominator and numerator of the result have an obvious common factor:               Sqrt[Δ^2 + (u - ϵ)^2]      How can I let mathematica to cancel this common factor? I have tried `Cancel` and `Refine` all the variables to be positive.


Populating an array with outputs of a function

I have searched, but didn't find much help on my issue. I have an optical physics problem that I'm working on ..               apeture = 1*10^-6;     r = Range[100];     k = Range[100];     λ = 632.8 * 10^-9;     pal = Pi*(apeture/λ);     θr = (r - 50)*(Pi/90);     field = Array[0 &, {k, r}];     Intensity = 1*(Sin[pal*Sin[θr]]/pal*Sin[θr])^2      admittedly I am a newcomer to Mathematica but not to programming. I operate mainly in embedded C but "speak" Python, Java, and Ada as well. So please understand that my question is mostly about using Mathematica. What I need is a n x m matrix 100 entries square that the Intensity function maps onto down each row. When the matrix is populated, I create a copy of it, rotate it by pi/2 and add the two. Once done, I plot the result. This is to study the interference patterns of orthogonal single-slit diffraction (Mill's Cross effects). An Edit for Clarity: Once the initial conditions are set, I need to place a function output in each row of the matrix. The columns are identical (at first). Then, I perform a 90 degree rotation of the matrix (CW or CCW.. doesn't matter as long as the results are orthogonal) and add the two. The resultant is an interference matrix that can be plotted. My questions in this regard:   1. Do I need to write a loop to do this, or can I write a compound statement like I have seen in other programs (MathCAD and MATLAB) that will automatically propagate the values in the matrix?   2. After reading the various posts on matrix rotation, I'm not entirely convinced of the best method. Suggestions are appreciated. Thanks for your help!


Something is rotten in ... my function writing

Juju3[expr_] :=     (Solve[expr[[1]] == 0, expr[[2]] == 0, expr[[3]] == 0, {r, x, y}];     a = %[[1]];     b = %%[[2]];     c = %%%[[3]];     Which[a[[2, 2]] == 0 || a[[3, 2]] == 0, Speak["MOO"],a[[2, 2]] != 0 && a[[3, 2]] != 0, Speak["PEACE AND LOVE"]]     j = D[expr, {{r, x, y}}];     j     FullSimplify[j /.Solve[expr[[1]] == 0, expr[[2]] == 0,expr[[3]] == 0, {r, x, y}]] ;     FullSimplify[Eigenvalues[%[[1]]]]     FullSimplify[Eigenvalues[%%[[2]]]]     FullSimplify[Eigenvalues[%%%[[3]]]])      Then I tried:               Juju3[{i - l*r - ux*r*x - uy*r*y, -mx*x + ex*ux*r*x, -my*y + ey*uy*r*y}]      ,and it did not work whereas when I just use my code without creating a function it works very well. I am reading about building functions with Mathematica right now but I still want to post this because I do not know what I am doing wrong. Everything? Maybe! Because I am a noob ^^ But I am reading tutorials so please do not get angry :) Specifically I have been told by a user that one should put semicolon for things that one do not want the output of, and also that one should put parentheses when having a function with multiple lines, so I did do that here. PS: I shortened the function because I use **b** and **c** also in the same way as **a** but no need for it here I guess.