How to make a plot on top of other plot?

I want to plot two functions. One should appear on top of the other. The x axis has the same values for both functions, but should appear twice (the second- upper I want to be dashed). y axis should change to dashed type (when it reaches a little more than the highest value for the first function), start from zero again and have a different frame label. Here is just a simple example how can I present the graphs:               Needs["PlotLegends`"]     Plot[{Sin[x], Cos[x]}, {x, 0, 2 \[Pi]},       PlotStyle -> {Red, {Black, Dashed, Thick}},       BaseStyle -> {FontFamily -> "Times", FontSize -> 16},       Frame -> {True, True, False, True},       FrameLabel -> {"x", "y", "", "y1"},       FrameStyle -> {Directive[18], Directive[18], Directive[18], Directive[18, Dashed, Thick]},       PlotLegend -> {Style["Sin(x)", 14], Style["Cos(x)", 14]},       LegendPosition -> {1.05, 0.1}, LegendSize -> {0.4, 0.3},       LegendShadow -> 0.005, LegendTextSpace -> 4, ImageSize -> 550]      But I don't want the functions to be together. Let's say cos(x) in example should be above sin(x) and y1 should start above the end of y (at value y= 1.2). I also want to have another (dashed) x axis, which is at value y=1.2 (y1=0). ![enter image description here](http://i.stack.imgur.com/undUI.png) **EDIT:** Thank you for all answers. I tried all of them and come to my final code:               AA = Plot[barvilo, {\[Lambda], 337, 717}, PlotRange -> {0, 1.8},         PlotStyle -> {Black, Dashed, Thick},         BaseStyle -> {FontFamily -> "Times", FontSize -> 16},         Frame -> {True, True, False, False}, ImageSize -> 1200,         FrameLabel -> {"", "Absorbanca [p.e.]"},         FrameStyle -> {Directive[18, Dashed], Directive[18, Dashed]},         PlotLegend -> Style["\[Alpha](N719)", 14],         LegendPosition -> {1.1, -0.15}, LegendSize -> {0.3, 0.2},         LegendShadow -> 0.005, LegendTextSpace -> 2,         ImagePadding -> {{60, 30}, {50, 30}}];     BB = Plot[{a, b, c, d}, {\[Lambda], 337, 717}, PlotRange -> {0, 1.9},         PlotStyle -> {Red, Orange, Black, Purple},         BaseStyle -> {FontFamily -> "Times", FontSize -> 16},         Frame -> {True, True, False, False},         FrameLabel -> {"Valovna dolžina [nm]",           "Spektralna gostota sevanja [W/\!\(\*SuperscriptBox[\(m\), \     \(2\)]\)nm]"}, FrameStyle -> {Directive[18], Directive[18]},         Filling -> {1 -> {{4}, {Lighter[Yellow], Opacity[0.02]}},           4 -> {Axis, {Lighter[Yellow], Opacity[0.06]}}},         ImagePadding -> {{60, 30}, {50, 30}},         PlotLegend -> {Style["AM1,5G", 14], Style["AM1,5G + TrPt", 14],           Style["AM1,5G + TrEl", 14], Style["AM1,5G + TrPtEl", 14]},         LegendPosition -> {1, 0.1}, LegendSize -> {0.4, 0.3},         LegendShadow -> 0.005, LegendTextSpace -> 4, ImageSize -> 1200];     izracun =        Graphics[Text[         StyleForm["269,37 W/\!\(\*SuperscriptBox[\(m\), \(2\)]\)",           FontSize -> 16], {550, -900}, {-1, -1}]];     izracun1 =        Graphics[Text[         StyleForm["490,22 W/\!\(\*SuperscriptBox[\(m\), \(2\)]\)",           FontSize -> 16], {160, -970}, {-1, -1}]];     Show[GraphicsColumn[{AA, BB},        Spacings -> {0, -380}], izracun, izracun1]      I am satisfied with it but I need to save it. Why is it not possible to save it, when I select it (Save selection as)? I can save like this just separate graphs (AA and/or BB). When I tried the code in the link bellow, the result is in the right form to save with _Save graphic as_. But this code is to complicated for me. http://mathematica.stackexchange.com/a/6882/6357 I can use print screen option .. Is there a better way to save it?


Calling a dll from Mathematica

I would like to call the following function from Mathematica               ps3000aOpenUnit     PICO_STATUS ps3000aOpenUnit     (        short * handle,        char * serial     )      I define the DLLFunciton in Mathematica:               ps3000OpenUnit =  DefineDLLFunction["ps3000aOpenUnit", "PS3000a.dll", "short", {"short[]", "char[]"}]      I get following error when executing               ps3000OpenUnit[handle, serial]     NET::methodargs: Improper arguments supplied for method named ps3000aOpenUnit.      What is wrong with my code? Thanx for helping me in advance.


How can I define a 3D version of the built-in VoronoiDiagram (VoronoiMesh in V10) function?

Can anybody point me in a direction that will guide me to extend the VoronoiDiagram function in Mathematica to handle 3D (three dimensional) situations (i.e. points in 3D)? Any help will be greatly appreciated. **Update** The current `VoronoiMesh` function in **V10** still does not compute 3D Voronoi diagrams, which is strange since both the `DelaunayMesh` and `ConvexHullMesh` functions work with 3D data sets. I guess the waiting continues.... For the Wolfram Research employees, any ideas on why this was omitted and timeframe for when this functionality will be included in _Mathematica_?


Doing an Interpolation through a list of lists into a single function

Suppose I have a list of lists, i.e.               list = Table[{x, x^ k}, {k, 1, 10}, {x, 0, 1, 0.05}];      and I want to interpolate each of the lists by a function using `Interpolation` (or another appropriate function). Is there a way to create a function of `k` and `x`, i.e               Table[interpFunct[k] = Interpolation@list[[k]],{k,1,10}]      so I have `interpFunct[1,x]`, `interpFunct[2,x]`, etc. available? I know I can interpolate the surface but the mesh is not structured, which leads to new difficulties that have nothing to do with my needs. Any advice will be very helpfull.


How do I cut down on file size of exported eps without losing quality?

I need to import the following to eps so that I can put it into my TeX file. The problem is two-fold: the exported file looks terrible (unlike the Mathematica output), and secondly, the file size is huge (over 1 MB), making it take forever to render in the pdf file.               potential1 =        Plot3D[-3600. h^2 + 0.02974 h^4 - 5391.90 s^2 + 0.275 h^2 s^2 + 0.125 s^4, {h, -400, 400},          {s, -300, 300}, PlotRange -> {-1.4*10^8, 2*10^7}, ClippingStyle -> None,          MeshFunctions -> {#3 &}, Mesh -> 10,  MeshStyle -> {AbsoluteThickness[1], Blue},          Lighting -> "Neutral", MeshShading -> {{Opacity[.4], Blue}, {Opacity[.2], Blue}},          Boxed -> False, Axes -> False]     Export["pot1.eps", potential1, ImageSize -> 500]      The Mathematica output (in png) is ![enter image description here](http://i.stack.imgur.com/bKldN.png). I can't use png in LaTeX. I tried to export in pdf, but I'm running into an error: "Cannot determine size of graphic in pot1.pdf (no BoundingBox)."


Solving determinant of a Kronecker product of matrices gives a numerical error - why?

I am doing the following steps (code at the end of the post):   1. I start with a 2x2 matrix (smatrix), which is a function of a single variable (u2). I want to set the determinant of this matrix (smatrix) to zero, therefore solving for u2.    2. There are two real solutions (sols), which Solve (or NSolve) delivers. These are exact, as the determinant is the order 2 polynomial in the variable (u2). It might be important that the coefficients of this polynomial are on the order of 10^-10.   3. I make a 4x4 matrix (matrix2) which is just the earlier 2x2 matrix two times on the diagonal (KroeneckerProduct). Its determinant is then the determinant of the first matrix squared.   4. I solve the new determinant to be zero, now getting different solutions. They are complex. Moreover, when plugging in the old and the new solutions into the new determinant, I see that the new solutions apparently are more accurate (by 10^4!). I have tried playing around with global `WorkingPrecision`, but it does not seem to change anything. Can somebody explain to me what goes wrong here? Moreover, what should I change in my code to retain the exact results? Thanks a lot!               smatrix = {{1. - 2.96392/u2,  0.0000196744/ u2},                {1. - 2.96392/u2, -2.11737*10^-10 + 0.0000196746/u2}};     sols = (smatrix // Det) // Solve[# == 0, u2] &      > {{u2 -> 0.987752}, {u2 -> 2.96981}}               (smatrix // Det) /. sols[[1]]      > 0.               matrix2 = KroneckerProduct[({          {1, 0},          {0, 1}         }), smatrix];     (matrix2 // Det) // Solve[# == 0, u2] &      > {{u2 -> 0.987752 - 4.12625*10^-6 I} , {u2 -> 0.987752 + 4.12625*10^-6 I} , > {u2 -> 2.96981 - 0.000012998 I} , {u2 -> 2.96981 + 0.000012998 I} }               (matrix2 // Det) /. %[[1]]      > 3.85186*10^-34 - 1.84553*10^-36 I               (matrix2 // Det) /. sols[[1]]      > 3.15024*10^-30


StringMatchQ error messages printed to console while main notebook is sitting idle

> **Possible Duplicate:**   >  Strange ::usage behavior in v9 I'm currently finishing up a _Mathematica_ vector calculus package (MMA9.0 on Mac Os X), but have had a persistent problem that I haven't been able to get rid of. Basically, the message > StringMatchQ::strse: "String or list of strings expected at position 1 in > StringMatchQ[$Failed,"ToCanonical*"]" persistently appears in the console (Messages notebook). `ToCanonical*` can be replaced with another function name, depending on what is called. As is standard, 3 messages are printed before a `General::stop` message is printed. This behavior only happens on some function executions (i.e. evaluating the same line will sometimes produce it and sometimes not) and often does not start until a dozen or so function calls have been made after loading the package. In addition, after the messages start appearing, they sometimes continue even when nothing in the notebook is being evaluated. The messages seem to have no adverse consequences other than causing Mathematica to pause for 5-10 seconds before doing anything useful, a behavior that persists even if the relevant message is turned off with `Off`. With the goal of figuring out what's going on, here are a couple of more specific questions I have that may provide some insight.   1. What is the difference between messages printed to the console and those printed to the user's notebook? From the Preferences/Messages window it seems that the messages are probably "User log interface messages," but I couldn't find any information on why these would be generated.   2. Is there a way to generate a list of all MMA functions that can generate `$Failed`? I do not use `$Failed` anywhere in the package so it must be being generated by an internal function.  I'm sorry for the rather general question, but am currently completely stuck. Any suggestions would be very much appreciated!


Consistently annoying error messages in Mathematica 9

> **Possible Duplicate:**   >  Strange ::usage behavior in v9 Has anyone had any issues with a function, let's call it Function, which worked in Mathematica 8 getting the error message StringMatchQ::strse: "String or list of strings expected at position 1 in StringMatchQ[!($Failed, \"Function*\")]" This message occurs not after the function is evaluated, but instead a dialogue box appears if one uses the backspace key while typing the arguments of the function.


Use Mathematica as a terminal

I love how notebooks work in Mathematica. You can edit code in real time and hit Ctrl+Shift to run it. Additionally you copy and paste different cells around to organize and test ideas. Search and replace, plot/visualization,etc.. are built into the system. My question: **How could you adequately adapt Mathematica to use as a terminal replacement?** If not (this might get transferred to stackoverflow.com) is there a terminal editor that exists that works like Mathematica's notebook interface?


Passing f[x][[1]] to FindRoot

`FindRoot` seems to fail for most examples of the form               f[x_?NumericQ] := {x - 3 , x^3};     FindRoot[f[x][[1]], {x, 3}]      > >     {x -> 0.} >   I expected `{x -> 3}`. The same occurs for `FindMinimum`, even for this case               FindMinimum[{f[x][[1]], x > 1}, {x, 3}]      > >     {1., {x -> 1.}} >   What is going here guys? I'm using _Mathematica_ 9.0.1.0 for Linux x86.


On the definition of the associated Legendre polynomials

_Mathematica_ computes for n = 1,2,...:               (-1)^n (LegendreP[n, -1, -3]/Sqrt[2])      > >     -I, -3 I, -11 I, -45 I, -197 I, ... >   _Maple_ computes for n = 1,2,...:               (-1)^n*LegendreP(n, -1, -3)/sqrt(2)      > >     1, 3, 11, 45, 197, ...   >   Question: Is there a bug or just different definitions? **Edit:** Which one conforms with the (standard) definition in the _Handbook of Mathematical Functions_ respectively with the definition in DLMF?


Solving cubic equation for real roots

I'm looking to solve the following cubic equation for x: $\beta\, x^3 - \gamma \,x = c$. I have plugged in some sample values ($\beta = 2$, $\gamma = 5$ and $c = 2$). When I try to solve this equation using mathematica's Solve[] function, I get one real root and 2 complex roots. However, I have tried plotting the equation for these values, and can clearly see there should be 3 real roots. How can I obtain them. I am sure the roots are real, but mathematica gives me back complex roots. Thanks.


How to Sort on row by row basis?

Say I have matrix ![original](http://i.stack.imgur.com/A0mVQ.png) how to sort on row by row basis to get: ![sorted](http://i.stack.imgur.com/HNE7P.png)


Summing along rows or columns of a matrix

I have a list of rows in database such as               {{a,b,c}, {d,e,f},{g,h,i}}      I want to be able to add each row across and each column down (like a spreadsheet). In other words be able to pick columns and rows and add down or across.   Could you point me in the right direction?


Exporting Graphics3D is not complete

When I export the result defined as the variable `pot1` to pdf, the lower contour plot isn't showing. How do I fix this?               potential1 =        Plot3D[-3600. h^2 + 0.02974 h^4 - 5391.90 s^2 + 0.275 h^2 s^2 + 0.125 s^4,         {h, -400, 400}, {s, -300, 300},  PlotRange -> {-1.4*10^8, 2*10^7},          ClippingStyle -> None, MeshFunctions -> {#3 &}, Mesh -> 10,          MeshStyle -> {AbsoluteThickness[1], RGBColor[0, 0, 1]},          Lighting -> "Neutral", MeshShading -> {{RGBColor[0, 0, 1]}, {RGBColor[1, 1, 1]}},          Boxed -> False, Axes -> False];     potContPlot1 =        ContourPlot[-3600. h^2 + 0.02974 h^4 - 5391.90 s^2 + 0.275 h^2 s^2 + 0.125 s^4,         {h, -400, 400}, {s, -300, 300}, PlotRange -> {-1.4*10^8, 2*10^7},          ClippingStyle -> None, MeshFunctions -> {#3 &}, Contours -> 10,          ContourStyle -> {{AbsoluteThickness[1], RGBColor[0, 0, 1]}},          ContourShading -> {{RGBColor[.5, .5, 1]}, {RGBColor[.7, .7, 1]}},          Axes -> False, Frame -> False];     potFace1 =          Graphics3D[{EdgeForm[], Texture[potContPlot1],             Polygon[{{-400, -200, -2.0*10^8}, {400, -200, -2.0*10^8}, {400, 200, -2.0*10^8},                {-400, 200, -2.0*10^8}},               VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]}];     pot1 = Graphics3D[{potential1[[1]], potFace1[[1]]},         Lighting -> "Neutral", BoxRatios -> {1, 1, .7}, Boxed -> False]     Export["pot.pdf", pot1]


Generating Suffixes

I am doing a large Matrix calculation in which I need to generate symbols first like $F^{\mu\nu}$ I would like to get $\mu\nu = 00, 11, 22, 33$ and so on. I need to have the symbols before I can assign anything. Is there way to achieve this?


How to create a neon light effect in Mathematica?

I tried to use `Glow` to create a neon light effect on a torus object. The result shown on the left of the picture below looks quite different from the real one on the right. Is there a way to obtain a better result?               (* Assuming the .obj file located in the root of c: *)     model =  Import["c:\\torus.obj"] ;      Graphics3D[{Glow[Cyan], First[model ] }, Boxed -> False ,      Background -> Black       ]      ![enter image description here](http://i.stack.imgur.com/vlTwC.jpg)


"ClosingActions" option for FrontEnd`AttachCell

I'm looking to find the possible values for the `ClosingActions` options `FrontEndAttachCell`. I have found `SelectionDeparture` and `ParentChanged` so far. Moreover, is there a general method to determine the options for "undocumented" functions such as this one?


Find the number of nonzero elements

How do you find the number of elements in a matrix that are non-zero. For instance, the following matrix has 5 nonzero elements.               {0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 1, 0, 0, 0, 0, 0, 1}


Full width of graphics in GraphicsColumn

I have a list of graphics which are all the same width, and I would like to combine them into a single Graphics object that has them all stacked on top of each other, column-style, without changing their widths. The help page for GraphicsColumn lists `Alignment->Full` as the option that would do that, but I'm having some trouble implementing it. To take one of the examples in the help page, entering               GraphicsColumn[Table[Graphics[Disk[], ImageSize -> 10 i], {i, 1, 5}],        Alignment -> Center, Frame -> All]      will produce the following column. ![enter image description here](http://i.stack.imgur.com/PkQzE.png) I would expect changing `Alignment->Center` to `Alignment->Full` to provide a column with five circles of equal width. Instead, it returns the error message > GraphicsGrid::optv: "Value of option Alignment->Full in GraphicsGrid[{{ > [...] },{ [...] },{ [...] },{ [...] },{ [...] }},Alignment->Full,Frame->All] > is not valid. " This seems to me to be a bug, which came up here/here, and which I will report shortly. I am running Mathematica 9.0.1.0 on Linux x86 (64-bit), Ubuntu 12.04.3 LTS; I also observe the error on Mathematica 9.0.0.0 over Widows 7. ### In the meantime, is there a practicable workaround? * * * To provide a bit more detail: the circles above are a MWE; my actual problem is more complicated. I have a table of similar plots, some of which have "stuff" on top added in using `FrameTicks`. A MWE that's closer to my actual situation is               GraphicsColumn[{       ContourPlot[x^2 - y^2, {x, -2, 2}, {y, -2, 2}, ImageSize -> 200,         PlotLabel -> Graphics[Circle[], ImageSize -> 100]],       ContourPlot[x^2 - y^2, {x, -2, 2}, {y, -2, 2}, ImageSize -> 200]       }]      ![enter image description here](http://i.stack.imgur.com/XJ4lB.png) * * * The objects in the question are a MWE, my actual problem is more complicated. I have a table of objects which are _already_ the same widths (and therefore the same `ImageSize`s), but they have different aspect ratios. Setting their `ImageSize`s constant would not do anything. Perhaps a more representative example of my situation is:               GraphicsColumn[Table[Graphics[Rectangle[{0, 0}, {1, i}]], {i, 1, 5}],        Alignment -> Center, Frame -> All]


Assign variable's value programmatically

Not easy to explain what I'm looking for, so please sorry if I'm not so short. Having many variables to be managed in several different combinations, I need to automate the assignment of preset values for those variables. So, I have some saved preset data to be assigned to variables but because this is very frequent in my source code, I want to make it automatically, without to name variables in each piece of code. So I would use a variable to keep the whole list of variables. Export is very easy, the problem is for Import. Here is an example:               vars = {"a", "b", "c", "d", "e", "f", "g", "h"};     Export["data.csv", Transpose[{vars, ToExpression[vars]}]]      I have to use the strings to list the variables otherwise the names will be replaced by variables' values before to export. And I have to save also the name of variables because files have to be exported to other software and be human readable. So the problem is when I have to import back the saved data. Normally I should write               {a, b, c, d, e, f, g, h} = Import["data.csv"][[All, 2]]      but (here is the problem) I would write               ToEpxression[vars] = Import["data.csv"][[All, 2]]      so to have assignments in just one line and without naming all variables in each piece of code. Of course, `ToExpression[vars]` doesn't work because it automatically replaces variables names with their values. So, my question: Is there a combination of `Hold`, `Unevaluated`, `Defer`, or similar constructs so to automatically create the list $\\{a, b, c, d, e\\}$ (unevaluated) as left-hand site of the Set statement. Sorry for not being more clear and thanks in advance.


Functions defined via inverse Laplace transform - plotting issue

I need to define a function $k(t,c_1,\alpha_1,c_2,\alpha_2)$ in the following manner:               Clear[c1, c2, a1, a2, p1, p2, q, Q] (*clearing symbol assertions - just in case*)     p1[t_, c1_, a1_] := c1 (1 - E^(-a1*t))      p2[t_, c2_, a2_] := c2 (1 - E^(-a2*t))      q[t_, c1_, a1_, c2_, a2_] := p1[t, c1, a1] + p2[t, c2, a2]     Q[s_, c1_, a1_, c2_, a2_] :=        FullSimplify[ LaplaceTransform[ q[t, c1, a1, c2, a2], t, s]]     k[t_, c1_, a1_, c2_, a2_] :=        FullSimplify[          InverseLaplaceTransform[ 2s^2 Q[s, c1, a1, c2, a2]/(1 - 2s Q[s, c1, a1, c2, a2]),                                   s, t]]      Now, if I execute the following code:               cmax := 1     amax := 1     tmax := 10     Manipulate[ k[t, c1, a1, c2, a2],                  {t, 0, tmax}, {c1, 0, cmax}, {a1, 0, amax},                  {c2, 0, cmax}, {a2, 0, amax}]      _Mathematica_ produces proper output, in a way that a concrete numerical value is returned. However, if I execute                Manipulate[ Plot[k[t, c1, a1, c2, a2], {t, 0, tmax}],                   {c1, 0, cmax}, {a1, 0, amax}, {c2, 0, cmax}, {a2, 0, amax}]      then I get no result - only plot axes are printed, regardless of the parameters or plot range. Interestingly, if in the last expression explicit form of $k$ is inserted, everything works perfectly. What do I do wrong?


How to construct a graph from a list of edges

I have a list of pairs of numbers, representing connections between objects in the real world. Each number is the identifier of an object, there are gaps in the range from the smallest number to the largest number.               43,292     22,11     932,11     292,22     etc...      I need to visualise how all of the objects are related. I intended to create a graph representation of that network.


Why is NDSolve solving in term of two 1st order ODE slower than 2nd order?

As mentioned in the documentation for NDSolve it's often convenient to reduce a 2nd order ODE to a system of first order equations. When I do this however I seem to see a significant speed reduction in finding the solution. Is there any reason this would be the case? **An Example:** Some definitions:               rstar[r_] := r + 2 M Log[r/(2 M) - 1];     M=1;     rinf=10000;     rH = 200001/100000;     r0 = 10;     wp=30;     ac=wp-8;     \[Lambda][l_] = l (l + 1);      Take the equation                eq[\[Omega]_,l_] := \[CapitalPhi]''[r] + (2 (r - M))/(      r (r - 2 M)) \[CapitalPhi]'[       r] + ((\[Omega]^2 r^2)/(r - 2 M)^2 - \[Lambda][l]/(        r (r - 2 M))) \[CapitalPhi][r] == 0;      Solve it with certain ICs:               init=-0.0000894423075560122420468703835499 +      0.0000447222944185058822813688948339 I;     dinit=-4.464175354293244250869336196691640386266791`30.*^-6 -       8.950483248390306670770345406047835993931665`30.*^-6 I;           sol := \[CapitalPhi] /.       Block[{$MaxExtraPrecision = 100},       NDSolve[{eq[1/10, 1], \[CapitalPhi][rinf] ==          init, \[CapitalPhi]'[rinf] == dinit}, \[CapitalPhi], {r, r0,         rinf}, WorkingPrecision -> wp, AccuracyGoal -> ac,        MaxSteps -> \[Infinity]]][[1]];      **Now as set of first order equations** It turns out this system can be written as a first order set in terms of a related dependent variable $r^*$, and an effective potential $V$. Some more definitions:               init2=-0.8944230755601224204687038354990773373534 +      0.4472229441850588228136889483392836606307 I;     dinit2=-0.04472224961131835705979008430399621833410 -      0.08944221816744666391325700074861130268693 I;          r[rs_] := 2 (M + M ProductLog[E^(-1 + rs/(2 M))]);     V[rs_, \[Omega]_,l_] := \[Omega]^2 - (1 - (2 M)/r[rs]) (\[Lambda] [l]/(r[rs])^2 + (2 M)/(r[rs])^3);     rsH = N[rstar[rH], wp];     rsinf = N[rstar[rinf], wp];     rs0 = N[rstar[r0], wp];      Solve the first order system                 sol2 :=  {R, Rp} /.        NDSolve[{Rp[rs] == R'[rs], Rp'[rs] == -V[rs, 1/10, 1] R[rs],        R[rsinf] == init2, Rp[rsinf] == dinit2}, {R, Rp}, {rs, rsinf,        rs0}, WorkingPrecision -> wp, AccuracyGoal -> ac,        MaxSteps -> \[Infinity]][[1]];      Now run:                sol // AbsoluteTiming      sol2 // AbsoluteTiming      I find that sol2 takes roughly three times as long, and for even large $\omega,\ell$ this time difference gets more pronounced


How can I connect shortcut keys to Button

I want to connect a shortcut key (ctrl + c) to a `Button` in my application. To that purpose I wrote some code using `EventHandler`. When the mouse button is clicked it's working fine, but the ctrl + c key press isn't working.                EventHandler[ Button["Click"],        {          {"KeyDown", "c"} :>MessageDialog["This is button"],           "MouseClicked" :>MessageDialog["This is button"]        }      ](*EventHandler Function is closed*)


Mathematica: summing over n abstract indices

This probably has a one line answer, but I'm totally stuck. I have two tensors, i.e. two objects that depend on NN abstract indices which i've labelled `i[m] (m=1,...,NN)`. I want to keep NN general for now. Each index `i[m]` ranges over the values `{1,2}`. I want to sum over all the `i[m]`s, i.e.               Sum[a[i[1],...,i[NN]] * b[i[1],...,i[NN]], {i[1],1,2},{i[2],1,2},...,{i[NN],1,2}]      The only problem I have is finding a general expression that generates the "array" {i[1],1,2},{i[2],1,2},...,{i[NN],1,2} in the summation. I tried Table but that gives me an array of the form               {{i[1],1,2},{i[2],1,2},...,{i[NN],1,2}}      and I can't get rid of the outer brackets.


How can I make notebook cell's background become transparent? And can be saved as html with the translucent or transparent effect? One of the use is in HTML files, the background of cell hides the background of the web page's background. I wish there would be some setting in Mathematica and could be changed to HTML with transparent background, if no such direct manipulation, then should post process the HTML source file. Also, it it possible to make an Image as the background of the Notebook? something like the part effect of some slideshow stylesheet?


Which group of points connects more strongly?

I have two groups of points, and the lenth of them may be different.I want to know which group of points connects more strongly, are there any existing algorithms for this? Here are two groups of points, group1 has 13 points, group2 has 10 :               group1={{8, -2}, {10, -2}, {6, -2}, {9, -1}, {5, -2}, {5, -3}, {9, -2}, {7, \     -1}, {7, -3}, {7, -3}, {2, -1}, {9, -4}, {2, -2}};     group2={{9, -3}, {3, -4}, {10, -3}, {10, -4}, {12, -2}, {8, -4}, {7, -1}, \     {9, -1}, {8, -2}, {13, -3}};      ![enter image description here](http://i.stack.imgur.com/hhxX3.png) First I prefered to caculate the average point of each group, than get summation of all the distances between each point and the average one. But look at the picture, the most left one labeled "far away" of the yellow group is a particular case, it should contribute less to the result. Now I'm stuck here. This may be a mathematical problem, but I'm going to solve it in mma, so I post it here.Thanks guys. **Edit:** All the points are on integer coordinates.


RSquared Mathematica Excel incoherence

I've done a NonLinearRegression with this data               {{0.245, 0.0917011}, {0.25, 0.0894304}, {0.25, 0.108895},       {0.25, 0.111991}, {0.251, 0.0898849}, {0.251, 0.107753},      {0.254, 0.114524}, {0.254, 0.121882}, {0.255, 0.130478},      {0.255, 0.186865}, {0.256, 0.108817}, {0.256, 0.128742},      {0.256, 0.131999}, {0.257, 0.150797}}      The model is a simply parabola:               y=a x^2+b x +c      The coefficiets are:                a= 317.459      b=-154.723      c= 18.9415      Then I've done the same with Excel and the coefficients are the same, but `R^2` is not the same. In Mathematica I've got `R^2=0.97` and Excel tells me `R^2=0.45`. Why there is this incoherence?


RevolutionPlot3D: but NOT revolving about the z axis

I want to demonstrate generating a solid of revolution by revolving a planar region about, say, a horizontal axis. However, `RevolutionPlot3D` doesn't seem to have an option for revolving a curve about something other than the $z$ axis. I'm curious how you all would handle this. Here's a simple example:               theta0 = Pi;     Manipulate[       GraphicsRow[{         Plot[x^2, {x, 0, 1}, PlotStyle -> {Thick, Black}, Filling -> Axis],         Rotate[RevolutionPlot3D[Sqrt[x], {x, 0, 1}, {t, theta0 - .001, T},         PlotRange -> {{-1, 1}, {-1, 1}, {0, 1}}, BoxRatios -> 1,          Boxed -> False, Axes -> False, ViewPoint -> {0, -2, 1}], -Pi/2]       }],     {T, theta0, theta0 + 2 Pi}]      ![enter image description here](http://i.stack.imgur.com/nlGje.png) My questions:   1. Is there a "better" way to showcase revolving about a horizontal axis of revolution than what I've done with `Rotate`?   2. Is it possible to generate the higher quality, finished surface of revolution while the slider bar is moving instead of only when the slider is released?   3. How do I prevent the vertical tick labels on the far left edge as well as the graphic on the far right edge from being clipped? (I tried `Spacings` and `ImagePadding`.)   4. How do I vertically align the horizontal axis of revolution of the right graphic with the horizontal axis of the left graphic? **Edit:** I had a follow up question but I will spin that off as a separate question.


How to revolve a surface about a line other than the $x,y,z$ axes?

I just started working with _Mathematica_ 8 and I'm having trouble revolving a function the way I want. I have to revolve the function $x^2/4 +2$ and $y= 0$ around $y=6$ to form an ashtray, but I can't find how to do it. EDIT: So far I've got :               RevolutionPlot3D[{{f[x] - 6}, {-6}}, {x, 0, 6}, RevolutionAxis -> x]      And for clarification, this is the complete surface I'm revolving (Or trying to) https://www.dropbox.com/s/irpaw37nayox414/Capture.PNG Now I just need to revolve the explicit functions "x=0" from 0 to 2 and "x=5" 0 t0 6


Revolve A Function Around the Y axis?

I am seeking to revolve the are between the functions function $d(x) = Exp(x)$ and $e(x) = 4 - x^2$ around the line $x = 2$. I am using `RevolutionPlot3D`, so I thought it best to use the Y axis instead. Here is the modified code:               d[x_] := E^(x + 2)     e[x_] := 4 - (x + 2)^2          RevolutionPlot3D[{{d[x]}, {e[x]}}, {x, -1.96464 - 2, 1.05801 - 2},                      RevolutionAxis -> "Y"]      However, I find that the code does not produce the revolution that I am seeking. Is there a syntax error or an error in my methodology? Any push in the right direction would be quite helpful.


How to graph the revolution of solid limited by 2 points in x axis

I'm learning how use this program. And I have problem with how graph the solid of revolution.Here i write one exercise.   y=2-1/2x, y=0,x=1,x=2; about the x-axis. This is the graph also the volume ![enter image description here](http://i.stack.imgur.com/13ImD.jpg) x=1 and x=2 limited the size of the graph and I don't know how do that in Wolfram Mathematica. The steps i think are: RevolutionPlot3d [2-1/2x,{x,0,4},{y,0,4}] ....


Solving a System of four equations (with logs)

I am trying to solve a system of four equations in four variables. I have read a number of threads on similar issues and tried to follow the suggestions. But I think it is a bit messy because of the logs and cross products here. This is the exact system:               7*w = (7*w+5*x+2*y+z) * ( 0.76 + 0.12*Log[w] - 0.08*Log[x] - 0.03*Log[y] -                 0.07*Log[7*w+5*x + 2*y + z]),        5*x = (7*w+5*x+2*y+z) * ( 0.84 - 0.08*Log[w] + 0.11*Log[x] - 0.02*Log[y] -                 0.08*Log[7*w+5*x + 2*y + z]),             2*y = (7*w+5*x+2*y+z) * (-0.45 - 0.03*Log[w] - 0.02*Log[x] + 0.05*Log[y] +                 0.12*Log[7*w+5*x + 2*y + z]),                     1*z = (7*w+5*x+2*y+z)*(-0.16 + 0*Log[w]- 0*Log[x] - 0*Log[y] + 0.03*Log[7*w+5*x + 2*y + z])      This is an extension of a consumer demand system and we, theoretically, know that there exists a unique solution to this system that is positive. **Trys**   * Solve & NSolve : As there should be a solution I tried these, but neither works. I guess that the system has too many logs to handle.   * FindRoot : I started with an initial value of (14,15,10,100) which I get from my data. FindRoot returns the last value (which does not satisfy my system) and the following message. > FindRoot::lstol: The line search decreased the step size to within tolerance > specified by AccuracyGoal and PrecisionGoal but was unable..... ` I tried different initial values, including the value returned by FindRoot. I tried to analyze the pattern of the solution value at each step. I didn’t see any pattern, but noticed that the z values become negative early in the process. So, I put bounds on the values. This just stops the code at the minimum value of 0.1. I also tried an exponential system instead of log - same issues.               Reap[FindRoot[{            7*w == (7*w+5*x + 2*y + z)*(0.76 + 0.12*Log[w] - 0.08*Log[x] - 0.03*Log[y] -                  0.07*Log[7*w+5*x + 2*y + z]),            5*x == (7*w+5*x + 2*y + z)*(0.84 - 0.08*Log[w] + 0.11*Log[x] - 0.02*Log[y] -                  0.08*Log[7*w+5*x + 2*y + z]),            2*y == (7*w + 5*x + 2*y + z)*(-0.45 - 0.03*Log[w] - 0.02*Log[x] + 0.05*Log[y] +                 0.12*Log[7*w + 5*x + 2*y + z]),            z == (7*w + 5*x + 2*y + z)*(-0.16 + 0*Log[w] -0*Log[x] -0*Log[y] +                  0.03*Log[7*w + 5*x + 2*y + z])},           {{w, 14, 0.1, 500},{x, 15, 0.1, 500},{y, 10, 0.1, 500}, {z, 100, 0.1, 500}},            EvaluationMonitor :> Sow[{w, x, y, z}] ]]        * FindMinimum : As we can write this problem as a minimization problem, I tried this (following the suggestion here). The value returned did not converge the system or equations to zero. I tried with only the first two equations, and that sort of converged to zero.              {g1,g2,g3, g4} = {                7*w - (7*w+5*x+2*y+z)* (0.76+0.12*Log[w]-0.08*Log[x]-0.03*Log[y] -                       0.07*Log[7*w + 5*x + 2*y + z]),                5*x - (7*w +5*x+2*y+z)*(0.84-0.08*Log[w]+0.11*Log[x]-0.02*Log[y] -                       0.08*Log[7*w + 5*x + 2*y + z]),                2*y - (7*w+5*x+2*y+z)*(-0.45-0.03*Log[w]- 0.02*Log[x] + 0.05*Log[y] +                       0.12*Log[7*w+5*x+2*y+z]),                1*z - (7*w+5*x+2*y+z)*(-0.16+0*Log[w]-0*Log[x] - 0*Log[y] +                       0.03*Log[7*w+5*x+2*y+z])};          subdomain = 0 < w < 100 && 0 < x < 100 && 0 < y < 100 && 0 < z < 100;     res = FindMinimum[{Total[{g1,g2,g3,g4}^2],subdomain},{w,x,y,z}, AccuracyGoal->5]             {g1,g2,g3,g4}/.res[[2]]      Hope this is engaging enough for the experts here! Any ideas how I should find the solution or why can’t I? It’s the first time I am using Mathematica, and unfortunately the first time I am empirically solving a system/optimizing! Thanks a lot.


Mathematica-To-MATLAB Dictionary!

Is there a dictionary to translate _Mathematica_ functions and commands to _MATLAB_?


"do ... while" loop equivalent in Mathematica

Have I missed something or is there no built-in which mimics the behaviour of _do ... while_ loop? I am looking for a construct that evaluates `procedure` **once** and then repeatedly evaluates it while `test` is not fulfilled. I'm ended up using:               While[procedure; test, {}]      But clearly the second argument is redundant, so I have a feeling that I'm missing something. Maybe not, but I just want to be sure :)


Compile function which calls other functions to C

I have a function which calls other functions and I would like to compile it to C code. For example:               foo[p_] := 0.7 Exp[-p^2]     f[a_, n_] :=       Module[{s, p, i}, s = 0; p = a;        For[i = 0, i < n, i++, s += foo[p]; p *= a;]; s]      Now if I do               cf = Compile[{{a, _Real}, {n, _Integer}}, f[a, n]]      and print the C code with               Needs["CompiledFunctionTools`"]     CompilePrint[cf]      the output is               R1 = MainEvaluate[ Hold[f][ R0, I0]]      which is obviously not desired. When I try `Compile[{{a, _Real}, {n, _Integer}}, Evaluate@f[a, n]]`, it just gives a function which returns 0...


ReadList with header and foot lines

I want to do some large data analysis, and i want to be able to import files in a fast way. I tried Import, but it is quite slow; ReadList takes half the time. This is the code I was using:               files = FileNames["Path\\*.dat"];     a = Table[Delete[Import[file, "Table", "HeaderLines" -> 38], {{-1}, {-2}}], {file,files}];      They are files with 38 header lines and 2 foot lines which i dont want. My question is how to import the same files using ReadList and ignoring those unwanted lines, or another approach to improve import performance.


How can one write a robust ListableQ function?

I would like to have a test that determines if a particular function is Listable. In the case of Symbols this is merely a matter of checking `Attributes`. `Function` definitions with the `Listable` attribute are a bit more involved but quite easy. **However I specifically want to test for _inherent listability_ in as many cases as possible.** For example consider the function from **Case #4** in Alternatives to procedural loops and iterating over lists in Mathematica:               (3 - #)/(7 * #) &      This function is _inherently listable_ :               fn = (3 - #)/(7*#) &;     Map[fn, {1, 2, 3}]     fn @ {1, 2, 3}      > >     {2/7, 1/14, 0} >     {2/7, 1/14, 0} >     * One must consider Functions with multiple arguments, both the `Slot` and named parameter type.   * Ideally the test would handle pattern-based (DownValues) functions to the extent that is possible.


Show that three given vectors lie on a line, a plane, or span 3-space

Given three vectors, `{2, 0, 0}`, `{0, 2, 2}`, `{2, 2, 3}`, how could I see if they are all on the the same line, plane, or all of r3 in _Mathematica_? I can graph them all, like:               data = {{1, 2, 3}, {3, 4, 5}, {5, 6, 7}};     Graphics3D[Arrow[{{0, 0, 0}, #}] & /@ data]      but how can I say take two of them, draw a plane from them, and visually see the 3rd vector in relation to the plane?


Is it possible to insert an animated image into Mathematica notebook?

I find it very convenient to use Mathematica notebooks to **organise** the codes + results. I was wondering if it is possible to **insert** an **animated image** (say an animated gif) in the middle of a notebook. (I tried dragging and dropping an animated gif into a notebook, the gif itself was created using Mathematica. Mathematica **Import[]** s it and I see a bunch of images in the notebook). This suggests, one solution namely using a **Manipulate[]** or **Animate[]** , with those bunch of images. But is there an **less tedious and more elegant way**? Thanks!


Make the code shorter for solving Fizz buzz

Here is Fizz buzz > Write a program that prints the integers from 1 to 100. But for multiples of > 3 print "Fizz" instead of the number and for the multiples of 5 print > "Buzz". For numbers which are multiples of both 3 and 5 print "FizzBuzz". I found the python version is much shorter, so I decided to write a short one, I have wrote several version               Table[If[# != {}, Row@#, n] &@({Fizz}[[Sign[n~Mod~3] + 1 ;;]]~Join~{Buzz}[[Sign[n~Mod~5] + 1 ;;]]), {n, 100}]          StringJoin@{If[#~Mod~3 == 0, "Fizz", ""], If[#~Mod~5 == 0, "Buzz", ""]} /. "" -> # & /@ Range@100          d = Divisible; Range@100 /. {_?(#~d~15 &) -> FizzBuzz, _?(#~d~3 &) -> Fizz, _?(#~d~5 &) -> Buzz}      Can you show a more shorter one?


How to identify patterns in a tensor-polynomial and replace appropriate symbol?

I want to write a function `tensorReplace[input]` that takes a tensor polynomial in $r_i$ such as $r_i r_j r_k+r_i q_j q_k +q_i q_j q_k$ , and replaces each monomial with a function `f[{idx}]` using the rule $r_i\rightarrow f(\\{i\\})$, $r_i r_j\rightarrow f(\\{i,j\\})$, _etc._ leaving the $q$'s and another other symbols untouched. So for in the example above, if my input is $$r_i r_j r_k+r_i q_j q_k +q_i q_j q_k\,,$$ I am shooting for an output $$f(\\{i,j,k\\})+f(\\{i\\})q_i q_j+q_i q_j q_k\,.$$ I also need to allow the possibility where a vector with same index is squared (repeated in a monomial) given the obvious $r_i^2\rightarrow f(\\{i,i\\})$. I don't know how to even begin, because my input could be an arbitrarily high order polynomial in $r$, with many terms.


Addition of sparse array objects

I have been having some trouble with the addition of large (but very sparse) matrices using SparseArray. Here is the simplest example to illustrate the issue. First, I will define diagonal matrices with random boolean entries:               Do[A[i] = DiagonalMatrix@SparseArray@RandomChoice[{0, 1}, 10^4];, {i,1, 5}]      Now I add them:               AbsoluteTiming[Sum[A[i], {i, 1, 5}];]      In my system (Mathematica 9 in Mac OS) this operation takes 2.39 seconds. Next I implement this sequentially, adding one matrix to another at each step:               B = 0;     AbsoluteTiming[Do[B += A[i], {i, 5}];]      This operation takes in my machine 0.001226 seconds (!). This seems to be independent of the method used to sum; all the following choices take approximately the same time:               Sum[A[i], {i, 1, 5}]     Total@Table[A[i], {i, 1, 5}]     Plus @@ Table[A[i], {i, 1, 5}]     A[1] + A[2] + A[3] + A[4] + A[5]      Of course, what I am really interested are non-diagonal matrices with non- trivial entries. Even though I could continue to use the aforementioned "sequential" approach, this behaviour is puzzling for me and I would really like to understand it. Any help would be appreciated. Thank you in advance. Gabriel


How can I expand a inequality with Abs

I want               Abs[x] + Abs[y] <= 1      to be convert to               x + y <= 1 && x + y >= -1 && x - y <= 1 && x - y >= -1        How could I get it with Mathematica?


How to combine two usages of # into one and speed up the code?

I have a function _num_ with two variables, _matf_ and _matg_. How can I combine the _last two_ lines of code below into one? The code is aimed to find out the maxiaml count _bel_ when we give each $i3 = 1,\cdots,5$ a value $f[[i3]]$ and each $i4 = 1,\cdots,5$ a value $g[[i4]]$. How can I speed up this code? Any help or suggestions will be appreciated.                FG = Tuples[{0, 1, 2, 3}, 5];      num[matf_, matg_] :=         Module[{f = matf, g = matg},           bel = 0;          For[i3 = 1, i3 <= 5, i3++,             For[i4 = 1, i4 <= 5, i4++,               If[Mod[IntegerPart[(i3 + i4)/2 - 1], 5] == Mod[f[[i3]] + g[[i4]], 5], bel++];            ];          ];          bel        ];     num2[f_] := Max[num[f, #] & /@ FG]     Max[num2[#] & /@ FG]      Here is an example to explain what does _num_ do.               Bell = {};     f = {0, 0, 1, 3, 4};     g = {1, 3, 2, 4, 1};     For[i3 = 1, i3 <= 5, i3++,        For[i4 = 1, i4 <= 5, i4++,         If[Mod[IntegerPart[(i3 + i4)/2 - 1], 5] ==         Mod[f[[i3]] + g[[i4]], 5],        AppendTo[Bell, {f[[i3]], g[[i4]], i3, i4}]];];];     Bell     Bell // Length      The output is                 {{4, 3, 5, 2}, {4, 4, 5, 4}}       2      which means that if we assign each $i3 = 1,\cdots,5$ the i3th element in _f={0, 0, 1, 3, 4}_ and $i4 = 1,\cdots,5$ the i4th element in _g={1, 3, 2, 4, 1}_ , then there is only $i3=5$ (the correspondig value is 4) $i4=2$ (the correspondig value is 2) or $i3=5$ (the correspondig value is 4) $i4=4$ (the correspondig value is 4) satisfy the condition _Mod[IntegerPart[(i3 + i4)/2 - 1], 5] == Mod[f[[i3]] + g[[i4]], 5]_.


Running MathKernel from Emacs brings cursor to end of line

When I start `MathKernel` from the `Emacs` shell, there are always extra spaces inserted so the cursor goes to the far right side of the screen. For example               % emacs -q M-x shell /Applications/Mathematica.app/Contents/MacOS/MathKernel      produces               Mathematica 9.0 for Mac OS X x86 (64-bit)       Copyright 1988-2013 Wolfram Research, Inc.     In[1]:=                                                                       |<-      where I am using `|<-` to show where the cursor is after the 70 whitespace characters are inserted after `In[1]:=`. Does anyone knows why such a thing happens and how to prevent it?


How do I place a graphical marker (box, circle, ...) in a MatrixPlot?

I'm trying to locate minima / maxima in matrices on a heat map. So I have my 2D matrix and did a `MatrixPlot`, ![my matrix plot](http://i.stack.imgur.com/84jU7.png) and I can find the position of the smallest value. My question: how do I place a graphical marker at that position? Like a box to outline field (7,6)? Completely stumped.


How to make the GroupOpeners visible in the SlideShow regime?

I am preparing a presentation on Mathematica and realized that though I made the GroupOpeners visible in the working regime (through the OptionInspector), they are invisible in the regime of the slide show. My question: how to make the GroupOpeners visible both in the Working and SlideShow regimes? Mma 9.0.1 WinXP and Win7. Later edit: 1) There is a possibility to use the OpenerView. But this makes all constructs a bit too heavy.   2) I apologize for a wrong term I used. It is not presentation, but a slide show regime where I need to have the openers. Now I corrected it.


Financial number format

How can I change this function:               nFormat=NumberForm[#,{\[Infinity],2},NumberPoint->",",NumberSeparator->".",DigitBlock->3,ExponentStep->10]&;      So when I use it like:               nFormat/@{10.01,10.1,0.1}//Column      > 10,01 > > 10,10 > > 1.000.000.000,00*10^(-10) The last number `1.000.000.000,00*10^(-10)` get the format equals to `0.10`?


Evaluating an If condition to yield True/False

I would like to decide whether an option passed to my custom function has the value `Automatic` or something else. This is my attempt:               f[x_, OptionsPattern[{DataRange -> Automatic}]]:=          Module[{opt = OptionValue[DataRange]},{x, If[opt == Automatic, True, opt]}];      However,               f[x, DataRange -> 20]      produces               {x, If[20 == Automatic, True, opt$540]}      rather than the expected               {x, 20}      What do I need to change?


Else branch of If expression doesn't print

> **Possible Duplicate:**   >  Evaluating an If condition to yield True/False I am trying to print `1` when `a` is found and `0` when it is not, but my code doesn't print `0`. Why? Here it is:               list = {a, b, a, a, c};     Do[If[list[[i]] == a, Print[1], Print[0]], {i, 5}]


How to use Select to exclude a single element which I can control?

I have code which inserts an expression into lists that I need to remove. I can insert anything I want, a string, variable, or number, into the lists. Suppose I insert the number 13 as my blacklisted element and have a list like               l={12, 14 y, 13, 13 x, 13 x -y}        I then implement               Select[l, # != 13 &]      but the output is               12        My desired output in this case would have been               {12, 14 y, 13 x, 13 x -y}      I've created a working solution that doesn't feel as elegant as it could be, with now a string blacklist element "13"               Select[{12, 14 y, "13", 13 x, 13 x - y}, Not@StringMatchQ[ToString[#], "13"] &]      which gives the desired output. Is it possible to refine the original attempt at a solution to work a bit more simply?


Testing a List inside of an Table if it is != 0

I'm new to mathematica so I hope this is not a too stupid question, but I couldn't find a solution in the mathematica documentation. I've got a normal table, initialized with "0" as entries. In the first element, I want to put a List of few numbers. I tried to build a minimalistic example as follows:               visitedNodes = Table[0,{i,1,5}]     visitedNodes[[1]] = List[1,2,3]      so visitedNodes = {{1,2,3},0,0,0,0}. Now I test:               For[i=1, i <= Length[visitedNodes], i++,         If[visitedNodes[[i]] != 0,              a = 5;   (* like: "do something" *)             Print["I'm in!"];         ];     ];      Since it's a "List Object", for me it's != 0, but guess I have to test it on somewhat else... but on what? :) Thank you a lot, this site also helped me already a lot =). Edit: The question is, that the If statement for i=1 should be like "Yes, a List[1,2,3] is not equal 0, since it's the first element of visitedNodes", but it does not. So why is it like that?


How would I add together any list of arguments as a pure function?

Let's say I have a list of arguments, of any length. How would I add them all together?               f = Evaluate[Plus @@ Array[Slot, 3]] &     f[1, 2, 3]      This would add together 3 numbers, but how would I add together any amount of numbers?


Extract data from plots in papers including error bars

I would like to know how to extract data from plots in a paper and, also, how to do that in a way that include **error bars**. I know there are specific softwares to do that, e.g. Plot Digitizer, which also work for scanned graphs. But I want to "digitize" inside Mathematica, so I don't need external softwares. Furthermore, the plots in a paper can be a bit polluted. An example of a graph to digitize follows below. The desired points are the black points including **error bars**. ![enter image description here](http://i.stack.imgur.com/hoeHR.jpg)


How to improve this code for solving the "Mr.S and Mr.P" puzzle?

> **Mr.S and Mr. P puzzle** — "Formalization of two Puzzles Involving > Knowledge", McCarthy, John (1987) > > We pick two numbers $a$ and $b$, such that $a\geq b$ and both numbers are > within the range $(2,99)$. We give Mr.P the product $a b$ and give Mr.S the > sum $a+b$. Then following dialog takes place: > > **Mr.P:** I don't know the numbers   >  **Mr.S:** I knew you didn't know. I don'tknow either.   >  **Mr.P:** Now I know the numbers   >  **Mr.S:** Now I know them too > > Can we find the numbers $a$ and $b$? I tried to do this, but it is very slow. I am sure there must be a simpler way.               Clear[pool, f1, f2, f3];     pool = Join @@ Table[{i, j}, {i, 2, 99}, {j, 2, i}];          f1[x_] := Length@Select[pool, Times @@ # == x &] != 1     f2[x_] := Length@Select[pool, Plus @@ # == x &] != 1     f3[x_] := And @@ (f1 /@ (Times @@@ Select[pool, Plus @@ # == x &]))     f4[x_] := Length@Select[Select[pool, Times @@ # == x &], f3[#[[1]] + #[[2]]] &] == 1     f5[x_] := Length@Select[Select[pool, Plus @@ # == x &], f4[#[[1]]*#[[2]]] &] == 1          Select[pool,        f1[#[[1]]*#[[2]]] && f2[#[[1]] + #[[2]]] && f3[#[[1]] + #[[2]]] &&          f4[#[[1]]*#[[2]]] && f5[#[[1]] + #[[2]]] &] // Timing


Extracting text from cells, preserving non-ASCII characters

Consider the following setup, based on this answer by WReach:               eval = (ToString[#] &)          CellPrint[      Cell[TextData["őúű"], "Program",        Evaluatable -> True,              CellGroupingRules -> "InputGrouping",       CellEvaluationFunction -> eval]]      This will create a cell that, when evaluated, will simply output its own contents, converted to a string. My goal is to preserve non-ASCII characters during this conversion. Notice that with the example contents I included, I get this string as output               "\[ODoubleAcute]\[UAcute]\[UDoubleAcute]"      This is not the same as the input, `"őúű"`. The difference is not just in display, it's actually a different string as you can verify using `StringLength` or exporting the string to a file. What I need to get is:               "őúű"      i.e. a string of length 3. How can I get this? * * * EDIT: Inspecting the cell expression shows that it does indeed contain the 39-character string `"\[ODoubleAcute]\[UAcute]\[UDoubleAcute]"`. So the key to the solution may be figuring out how to convert this to a unicode string containing those characters. EDIT 2: I found the following way to convert named characters in a string `str` to actual unicode characters. But this is undocumented, I don't know where it may go wrong, and I'm sure there must be something better ...               First@FrontEndExecute[FrontEnd`ExportPacket[Cell[str], "InputText"]]


Generating a vector of dummy variables

So I'm the situation of needing analytical solutions to a family of equations of the form Ax=b, where A is an nxn matrix. I've written a function that does what I want, but I'm currently using a bit of a hack to generate arbitrary (dummy) variable names for the n-vector 'x' :               Map[Clear, Table["x" <> ToString[j], {j, n}]];     x = ToExpression[Table["x" <> ToString[j], {j, n}]];      Can anyone suggest a more elegant way of accomplishing this task?


Extracting variables from an expression

I'm looking for a way to extract a list of variables from an expression, for example with an input like:               Leff= (mc dm^2 + mc/12*(h^2 + 3 R^2) + ma da^2 + ma/12 La^2)/(mc dm + ma da)      I want this output:               {mc, dm, ma, da, La, h, R}.      The built-in _Mathematica_ function `Variables` can do this but doesn't work with more complex expressions containing trascendental functions. Any help would be very appreciated.


Generating a list of symbolic coefficients

I am trying to do something which I assume should be very simple: I want to generate a list with symbolic coefficients that looks like this:               A = {a0, a1, a2, a3, ... , a20};      And I mean to do this a lot up to an arbitrary number, so I wouldn't want to type them all. So of course when I set one of them, say `a1 = 5`, then it should be updated in the list, so now:               A = {a0, 5, a2, a3, ... , a20};      I might just be missing an obvious _Mathematica_ command here that does this... Is there a way to do such a thing?


Understanding the computation of the geometric median

In the Wolfram Demonstration Fermat Point for Many Points, it appears that the geometric median is being calculated for an arbitrary set of five manipulable points. How might one extend this demonstration to computing the median of an arbitrary list of points?


How manipulate rasterized Graphics3D objects combined with non-rasterized objects

I am trying to construct a building with a manipulated sliding roof and other objects that can be manipulated. I have found that the manipulation of translations and rotations of graphics groups of polygons proceeds too slowly, so I have rasterized the moving objects to speed things up, but it seems the rasters don't manipulate, or they don't work in Show. I get the error _Show::gcomb: Could not combine the graphics objects in Show[slider,stationaryObj]. >>_ This script abstracts the essentials of my attempt by creating a stationary Cuboid in color Gray and a list of rasterized translated Cuboids that represent the sliding object in Brown. The sliding object should slide along the top of the stationary object. The sliding is supposed to be accomplished by manipulating the presentation of successive translated and then rasterized images from a list. The program does not work. The question is, what am I missing, or is there a better approach?               Clear["Global`*"]          (* dimensions of two-by-four in inches *)     thkns = 1.5;     wdth = 3.5;     len = 12;          (* two by four of length 12 inches *)     slidingObj = Cuboid[{0, 0, 0}, {thkns, len, wdth}];          (* a stationary base on which the two by four should slide *)     stationaryObj = Rasterize[Graphics3D[{Gray, Translate[slidingObj, {0, 0, - wdth}]}]]          slidingImages = Table[     Rasterize[Graphics3D[{Brown, Translate[slidingObj, {0, s, 0}]}]],{s, Range[5]}];          Manipulate[slider = slidingImages[[s]], {s, Range[5]}];          Show[ slider, stationaryObj] // Dynamic      Following suggestions in the comments, I rasterized stationaryObj and removed the semi-colon from the Manipulate function (though I kept it here). The "could not combine objects" error persists. I tried moving stationaryObj inside a list with slidingImages[[s]] in Manipulate.               Manipulate[     slider = {stationaryObj, slidingImages[[s]]}, {s, Range[5]}];          Show[slider]      This produced the error message _Show::gtype: Symbol is not a type of graphics._ Using just               Manipulate[{stationaryObj, slidingImages[[s]]}, {s, Range[5]}]      without the Show function does not produce an error message, but it also doesn't combine the Graphics. The suggestions by @halirutan deleted the Rasterize, which seem to be needed for the more complicated objects I am working on outside this page, as they move slowly. However, @halirutan's second script worked with Rasterize added. The following works as desired:               With[{thkns = 1.5, wdth = 3.5, len = 12},       With[{slidingObj = Cuboid[{0, 0, 0}, {thkns, len, wdth}]},        Manipulate[        Rasterize[         Graphics3D[{Gray, Translate[slidingObj, {0, 0, -wdth}], Brown,            Translate[slidingObj, {0, s, 0}]},           PlotRange -> {Automatic, {0, len + 10}, Automatic}]], {s, 0, 10}]]]      But I might have been too hasty in accepting this answer. I do need to combine several different shapes in a single screen in which only two objects will be manipulated. I now realize that the script makes use of only one object.


cross-correlation with time lag

I have two lists with some data.               a={1,2,3,4,5}     b={5,4,3,2,1}      Now I want to compute the cross correlation of the two lists with a time lag of 1, like it is mentioned on wikipedia: https://en.wikipedia.org/wiki/Cross- correlation The only function I found in mathematica is **CorrelationFunction** , but this one seems to only compute the autocorrelation of a lists with itself. So I was wondering if there is another function or how do do this. Can anybody help me out?


I have a problem for solving this integral

Integrate[(      0.657721 (1 - (1 - u2) x)^2.547 (1 + (1 - u2) x - u2 x)^2.547` (1 -          0.176` ((1 - u2) x)^1.2`) (1 -          0.176` (-(1 - u2) x + u2 x)^1.2`))/(((1 -            u2) x)^0.056` (-(1 - u2) x + u2 x)^0.056`), {u2, 0, 1},       Assumptions -> 0 < x < 1, GenerateConditions -> False]


How to build and operate a master Notebook?

Suppose you have some notebooks, they work for a family of related tasks, each one doing a certain task. Lets say Notebook 1 gets two inputs from its variables `in11` and `in12`, and produces one output to `out1`. The other Notebook 2 gets two inputs from its variables `in21` and `in22`, and produces one output to `out2`. How can we set up a kind of master notebook where just the decision to select a specific   task should be made, the assignments to the variables are made, and the result of the calculation is shown. The two working notebooks themselves should be in the same folder on your disk, and a call from the open master notebook pipes them their respective inputs and outputs.


How can I get Google search results with Mathematica?

I am trying to write a function that, starting from a string, returns the Google search hits on that string (the format and other stuff, I still have to decide). I have looked around and have found nothing that works (the wsdl-thing for Google search referenced by the docs, with WebServices, is retired and returns 404). Any hints, except scraping the result page by hand?


How do you define an affine transformation that is translated by itself?

This one should be simple, but I can't figure it out. I would like to define a transformation (function) such that $r$ maps to $m.r + r$ The help file on AffineTransformation says that               AffineTransformation[{m,v}]      maps $r$ to $m.r + v$ so for example               tt = AffineTransform[{d*IdentityMatrix[2], {a, b}}]     tt[{x,y}]     {a+dx,b+dy}      But how would I define a transformation such that it would return               tt[{x,y}]     {x+dx,y+dy}      for any ${x,y}$? And that it could be applied to graphics objects, e.g,               Graphics[GeometricTransformation[Rectangle[], tt[d]]      where I have added a function argument `d` which is a parameter of the transformation function.


Plotting a complex valued function over a circular region

I would like to apply some complex valued function to some region in the plane, say, a circle of radius $R$ centred at $k$. How can I do this?


How to force native styling of controls?

While preparing a dynamic module, I discovered a weird behaviour of Mathematica's controls when you rotate them:               Rotate[Button["Toto", Null], 0]     Rotate[Button["Toto", Null], 0.01]     Rotate[Button["Toto", Null], 0.02]      ![enter image description here](http://i.stack.imgur.com/6CPkE.png) The first non-rotated button has standard Mac OS styling. The last one, for large enough rotation, uses a non-native styling, which is somewhat ugly. But the real surprise is that controls with small enough rotation are displayed with native styling (and it _is_ actually rotated, not just rounded down to the case of the non-rotated button). My point of view is that, while I can live with the ugliness of non-native buttons, I'd rather have uniformity between all my controls. So, my question is two-fold:   * How can I force rotated controls to be displayed with native styling?   * If that's not possible, how can I force non-rotated controls to be displayed with non-native styling?


Autoupdate Dynamic Variable and Selectable

Does there exist a technique to construct a `Cell` that allows you to both auto update a Dynamic variable and allows you select the code while the variable is being updated? For example ![enter image description here](http://i.stack.imgur.com/PTJFK.png) Generated from the following code               a = 0;     task = CreateScheduledTask[        a = a + 1        , 1];     StartScheduledTask[task];     Print@Button["RemoveScheduleTask", RemoveScheduledTask[task]];     InputField[Dynamic[a], Number]     Dynamic[a]      Now if I select 100 in the `InputField` my selection gets unhighlighted as soon as the variable gets updated, meaning I don't get enough time to edit the variable. Now if I select the 100 in the second `Cell` and attempt to change the value nothing changes because of the nature of how Mathematica works. The data I am working with is multiline so I would prefer if there was some way to modify the `Cell` output so that I could update the variable while the scheduled task runs in the background. The above is a simplified issue of the issue, but illustrates the functionality quiet clearly. **Question: How do I update a varaible's value if is constantly being updated?**


Defining a sequence slot programmatically

This question is related to: Composition of functions using slots `Slot` (#) interfering with evaluation Consider a toy example:                list1 = { {a1, b1, c1, d1}, {a2, b2, c2, d2}, {a3, b3, c3, d3} };      I’d like to take elements from the list as follows example:               {#1, #2}@@@ list1      But I’d like to able to define #1, #2 programmatically. I tried:               n=1;     {Slot@Evaluate[n], Slot@Evaluate[n + 1]} & @@@ list1      But it gives me an error… Answers appreciated. **Even better if the answer uses the # notation rather than the Slot function.**


Graph Creation in Mathematica: TSP

I'm trying to create the following graph in _Mathematica_ ![](http://i.stack.imgur.com/djYXI.png) Where do I start? I'm specifically trying to make a graph so that I can use it in `TravelingSalesman[g]`, for `g` a graph. This is what I have:               g := Graph[{1 \[UndirectedEdge] 2, 1 \[UndirectedEdge] 3,         1 \[UndirectedEdge] 5, 1 \[UndirectedEdge] 4,         4 \[UndirectedEdge] 5, 4 \[UndirectedEdge] 3,         4 \[UndirectedEdge] 2, 3 \[UndirectedEdge] 5,         3 \[UndirectedEdge] 2, 2 \[UndirectedEdge] 5},        EdgeWeight -> {4, 5, 6, 3, 4, 5, 6, 7, 2, 7}]      Calling               TravelingSalesman[g]      I get the following result:               Table::iterb: Iterator {Combinatorica`Private`i$828,V[Graph[{1\[UndirectedEdge]2,1\[UndirectedEdge]3,1\[UndirectedEdge]5,1\[UndirectedEdge]4,4\[UndirectedEdge]5,4\[UndirectedEdge]3,4\[UndirectedEdge]2,3\[UndirectedEdge]5,3\[UndirectedEdge]2,2\[UndirectedEdge]5},EdgeWeight->{4,5,6,3,4,5,6,7,2,7}]]} does not have appropriate bounds. >>          Join::heads: Heads Combinatorica`Private`Double and Table at positions 1 and 2 are expected to be the same. >>          Join::heads: Heads Combinatorica`Private`Double and Table at positions 1 and 2 are expected to be the same. >>          Join::heads: Heads Combinatorica`Private`Double and List at positions 1 and 2 are expected to be the same. >>          General::stop: Further output of Join::heads will be suppressed during this calculation. >>          Table::iterb: Iterator {V[Graph[{1\[UndirectedEdge]2,1\[UndirectedEdge]3,1\[UndirectedEdge]5,1\[UndirectedEdge]4,4\[UndirectedEdge]5,4\[UndirectedEdge]3,4\[UndirectedEdge]2,3\[UndirectedEdge]5,3\[UndirectedEdge]2,2\[UndirectedEdge]5},EdgeWeight->{4,5,6,3,4,5,6,7,2,7}]]} does not have appropriate bounds. >>          Table::iterb: Iterator {V[Graph[{1\[UndirectedEdge]2,1\[UndirectedEdge]3,1\[UndirectedEdge]5,1\[UndirectedEdge]4,4\[UndirectedEdge]5,4\[UndirectedEdge]3,4\[UndirectedEdge]2,3\[UndirectedEdge]5,3\[UndirectedEdge]2,2\[UndirectedEdge]5},EdgeWeight->{4,5,6,3,4,5,6,7,2,7}]]} does not have appropriate bounds. >>          General::stop: Further output of Table::iterb will be suppressed during this calculation. >>          Range::range: Range specification in Range[V[Graph[{1\[UndirectedEdge]2,1\[UndirectedEdge]3,1\[UndirectedEdge]5,1\[UndirectedEdge]4,4\[UndirectedEdge]5,4\[UndirectedEdge]3,4\[UndirectedEdge]2,3\[UndirectedEdge]5,3\[UndirectedEdge]2,2\[UndirectedEdge]5},EdgeWeight->{4,5,6,3,4,5,6,7,2,7}]]] does not have appropriate bounds. >>          TravelingSalesman::ham: The graph must contain a Hamiltonian cycle for a traveling salesman tour to be found. >>


Removing the white space around plots when using customized FrameTicks

I'm using the `CustomTicks` package, which is part of the `LevelScheme` package, for styling the `FrameTicks` in my plots. On some sides of the plot frame, I want to have `FrameTicks` without tick labels. The problem is that I get extra white space in the place where the tick labels used to be. (Here, I have produced the plots with `LightGray` background in order to highlight the cropping problem.)               Needs["CustomTicks`"]          plot = Plot[x, {x, 0, 1},       Frame -> True,        FrameTicks -> {LinTicks[0, 1, ShowTickLabels -> False],LinTicks[0, 1]},       Background -> LightGray     ]      ![Plot with unwanted white space](http://i.stack.imgur.com/wXe0y.png) I think that the problem arises because the nonlabeled ticks are created as `""`, as can be seen in `FullForm[plot]`. How can I achieve a result similar to `Plot[x,{x,0,1},Frame->True]`, i.e., a tight cropping of the plot around its frame (see below) with customized `FrameTicks`? I do not want to rasterize my plot; thus, `ImageCrop` is not an option.               Plot[x, {x, 0, 1},       Frame -> True,       Background -> LightGray     ]      ![Correct cropping but with default FrameTicks](http://i.stack.imgur.com/FZhmD.png)


problem solving a simple integral equation

I'm looking for a function q(x) so that integral( q(t) , t , x, x+2*pi/3) == a*sin(x)+b Could anyone help me on this one? Thx in advance


Detecting a nonlinear edge in a 2D point pattern

Following an earlier post here, I have generated a point pattern on the unit square $[0,1]\otimes[0,1]$, which is described by a piecewise constant intensity function constructed so that (in expectation) $2/3$ of the points will fall within a circle of radius $\sqrt{0.1}$ centered on $(0.5,0.5)$. This piecewise intensity function manifests as a visible change in the density of points, forming an "edge" or "boundary" along this circle. Now, using only the point pattern and no knowledge of the intensity function underlying the process, I am interested in how one could detect this edge, get a formula describing it (assuming we don't know it's a circle with given radius and center...it has to be general) and superimpose the inferred boundary on a `ListPlot` illustrating the point pattern. My initial ideas are dividing the x and y axes into bins, or getting a CDF in the x and in the y directions and taking partial derivatives in both directions. Here's the code for the list plot:               n = 0;     list = {};     r := RandomReal[];     coin := RandomChoice[{True, False}];          While[n < 10000, {x, y} = {r, r};      If[((x - .5)^2 + (y - .5)^2 <= .1 || coin), AppendTo[list, {x, y}];      n++];]          ListPlot[list, PlotStyle -> {PointSize[.005]}, AspectRatio -> 1]


MySQL or PostgreSQL? Using Mathematica only I need to choose one

Installing either MySQL or PostgreSQL. My concern is just with Mathematica. I am going to be using it to store a good bit of basic data but the main thing is fast image retrieval and comparison using Mathematica as the comparing engine. Anyone have experience with any of this? Thoughts, directions or more questions?


Is there a hotkey for the drop down selection/information?

I am more used to typing then using the mouse. I was wondering if there were hotkeys for the drop down list and the info button? What I mean is what I have marked in the picture below. ![Array drop down](http://i.stack.imgur.com/Yq5xl.png) ![Array drop down](http://i.stack.imgur.com/VARMk.png) When I type open square bracket it appears, and I can press the down arrow to get the list. But I can't make it reappear without deleting characters, and I don't know how to trigger the information button. Can anyone point me to how to do this?


How can I calculate the perimeter of an equation-defined curve？

This is how the curve looks like:               img = ContourPlot[                       1/x + 3/4 (((y - 1/Sqrt[3])/x)^2 + 1) Exp[                       ArcTan[(y - 1/Sqrt[3])/x] - Pi/6] == 0,                {x, -3, 1},                 {y, -(1/5), 4},            PlotPoints -> 70 ]      ![enter image description here](http://i.stack.imgur.com/jQPH3.jpg) @xzczd comes up with a (kinka hacky!) solution, which extract the coordinates forming that curve:               Total[EuclideanDistance @@@        Partition[First@Cases[Normal@img,                              Line[a_] :> a, Infinity], 2, 1]           ]            (* 9.85614 *)      Is there any better way to do this?


Partitioning a superset of coordinates into subsets that generate continuous curves

Consider the data set corresponding to recorded trajectories for a particle:               PairSet = {{108.892, 171.947}, {111.137, 165.402}, {108.899, 171.874}, {108.945,171.857}, {108.924, 171.864}, {108.884, 171.873}, {108.88, 171.843}, {108.89, 171.87}, {108.885, 171.851}, {108.955, 172.041}, {109.343, 172.278}, {108.946, 172.044}, {108.975, 172.115}, {111.287, 165.828}, {111.316, 165.817}, {111.332, 165.64}, {111.45, 165.793}, {111.413, 165.761}, {108.909, 172.09}, {108.93, 172.079}, {108.958, 172.182}, {109.011, 172.185}, {109.002, 172.181}, {111.192, 165.535}, {111.176, 165.526}, {111.175, 165.509}, {111.174, 165.525}, {111.166, 165.513}, {111.165, 165.501}, {111.161, 165.54}, {108.963, 172.128}, {108.968, 172.095}, {111.341, 165.686}, {111.362, 165.69}, {108.932, 171.696}, {108.944, 171.723}, {108.948, 171.731}, {110.933, 169.149}, {110.944, 169.123}, {110.954, 169.095}, {111.285, 165.491}, {111.278, 165.505}, {111.287, 165.492}, {111.278, 165.446}, {109.027, 171.606}, {109.021, 171.606}, {108.841, 171.503}, {108.864, 171.464}, {108.847, 171.469}, {108.866, 171.31}, {110.938, 165.172}, {109.026, 171.374}, {111.237, 165.29}, {111.248, 165.311}, {111.375, 165.291}, {111.395, 165.292}, {111.38, 165.301}, {111.392, 165.312}, {108.851, 171.421}, {109.099, 171.436}, {109.076, 171.388}, {109.111, 171.272}, {109.126, 171.294}, {108.944, 170.892}, {108.928, 170.883}, {111.312, 164.951}, {111.346, 164.942}, {111.346, 164.952}, {111.372, 164.95}, {108.738, 171.068}, {108.736, 171.087}, {108.746, 171.101}, {108.736, 171.069}, {108.738, 171.078}, {108.76, 171.063}, {108.751, 171.057}, {111.149, 164.876}, {108.881, 171.343}, {108.856, 171.099}, {108.62, 171.223}, {109.003, 171.17}, {109.007, 171.185}, {109.016, 171.179}, {108.935, 171.132}, {108.991, 171.296}, {111.094, 164.747}, {110.841, 164.757}, {110.884, 164.754}, {111.039, 165.13}, {110.77, 164.802}, {110.783, 164.826}, {111.142, 164.938}, {108.651, 171.395}, {108.652, 171.399}, {108.647, 171.399}, {108.659, 171.395}, {108.648, 171.398}, {108.658, 171.397}, {108.578, 171.345}, {108.554, 171.335}, {111.051, 164.885}, {111.058, 164.899}, {111.055, 164.9}, {111.156, 165.11}, {111.178, 165.167}, {111.196, 165.151}, {111.177, 165.157}, {110.952, 164.798}, {110.907, 164.989}, {110.922, 165.013}, {110.932, 165.012}, {110.902, 164.98}, {108.896, 171.168}, {108.88, 171.175}, {111.102, 164.846}, {111.067, 164.887}, {111.067, 164.888}, {108.648, 171.394}, {108.648, 171.377}, {108.641, 171.375}, {107.69, 174.79}, {107.642, 174.85}, {107.627, 174.829}, {107.644, 174.877}, {111.122, 164.697}, {108.848, 171.054}, {111.01, 164.69}, {111.01, 164.692}, {110.746, 164.674}, {110.768, 164.676}, {110.975, 164.747}, {110.963, 164.738}, {108.965, 171.145}, {109.041, 171.139}, {108.884, 170.805}, {109.147, 170.753}, {109.032, 170.858}, {108.835, 170.681}, {111.088, 164.242}, {111.126, 164.256}, {110.601, 168.27}, {110.954, 164.199}, {108.832, 170.403}, {108.883, 170.49}, {110.98, 164.164}, {110.964, 164.111}, {108.765, 170.363}, {108.813, 170.506}, {108.793, 170.518}, {107.659, 174.865}, {111.342, 164.143}, {111.132, 164.165}, {109.124, 170.116}, {109.117, 170.133}, {111.91, 164.068}, {111.976, 164.061}, {108.765, 170.258}, {109.286, 170.032}, {109.28, 170.019}, {109.287, 170.019}, {109.09, 169.663}, {111.225, 163.281}, {109.332, 169.637}, {109.326, 169.594}, {109.353, 169.607}, {109.343, 169.608}, {109.337, 169.565}, {111.197, 163.28}, {111.213, 163.269}, {111.216, 163.275}, {111.203, 163.264}, {109.034, 169.885}, {109.026, 169.906}, {111.536, 163.575}, {111.49, 163.534}, {111.228, 163.495}, {111.39, 163.298}, {111.384, 163.283}, {111.445, 163.063}, {111.472, 163.108}, {111.4, 163.212}, {111.37, 163.221}, {111.342, 163.259}, {110.185, 163.519}, {111.249, 163.328}, {109.135, 167.653}, {109.055, 169.794}, {111.196, 163.518}, {111.17, 163.487}, {111.048, 163.661}, {111.044, 163.666}, {108.701, 170.581}, {108.698, 170.618}, {108.711, 170.635}, {110.894, 164.58}, {110.908, 164.587}, {110.893, 164.575}, {110.895, 164.57}, {108.835, 171.427}, {108.779, 171.484}, {108.799, 171.484}, {108.783, 171.468}, {110.824, 165.108}, {110.828, 165.108}, {110.812, 165.127}, {108.397, 171.888}, {108.426, 171.897}, {108.706, 171.69}, {108.667, 171.786}, {108.615, 171.807}, {108.549, 172.089}, {108.561, 172.094}, {108.55, 172.11}, {108.562, 172.11}, {108.58, 172.18}, {108.592, 172.226}, {108.576, 172.232}, {108.566, 172.22}, {108.572, 172.233}, {108.572, 172.228}, {108.59, 172.254}, {108.589, 172.25}, {108.577, 172.249}, {108.589, 172.246}, {108.588, 172.249}, {108.609, 172.5}, {108.559, 172.793}, {110.494, 166.216}, {108.446, 171.122}, {108.381, 171.131}, {110.422, 166.838}, {110.432, 166.819}, {110.406, 166.852}, {110.401, 166.827}, {110.446, 166.846}, {110.566, 166.88}, {110.544, 166.864}, {110.552, 166.886}, {107.959, 172.963}, {107.968, 172.983}, {108.013, 172.978}, {107.98, 173.003}, {108., 172.99}, {108.004, 172.986}, {107.991, 172.959}, {107.982, 173.021}, {107.947, 173.016}, {108.021, 173.086}, {108.003, 172.968}, {107.996, 173.051}, {108.012, 173.012}, {107.967, 172.971}, {107.977, 172.994}, {107.964, 173.044}, {107.997, 173.044}, {108.014, 173.001}, {110.322, 167.291}, {110.691, 167.434}, {110.66, 167.429}, {110.544, 167.344}, {110.569, 167.402}, {108.088, 173.691}, {108.107, 173.677}, {110.533, 167.449}, {110.539, 167.447}, {108.212, 173.801}, {110.576, 167.628}, {108.131, 173.963}, {108.111, 173.969}, {110.11, 167.837}, {110.291, 167.796}, {110.296, 167.817}, {110.295, 167.82}, {110.289, 167.811}, {108.208, 173.96}, {108.073, 174.004}, {108.081, 174.057}, {107.847, 174.163}, {110.365, 167.818}, {110.356, 167.844}, {107.833, 174.322}, {107.985, 174.4}, {107.97, 174.467}, {108.057, 174.418}, {110.317, 168.33}, {110.284, 168.327}, {110.313, 168.326}, {109.963, 168.459}, {109.96, 168.424}, {107.616, 174.794}, {107.617, 174.79}, {110.08, 168.919}, {107.833, 174.947}, {107.844, 174.938}, {109.614, 168.861}, {109.822, 168.763}, {109.804, 168.759}, {109.93, 169.046}, {109.925, 169.035}, {109.929, 169.025}, {109.77, 168.641}, {109.773, 168.636}, {109.757, 168.638}, {107.534, 174.886}, {107.8, 175.148}, {109.848, 168.929}, {109.839, 168.937}, {107.656, 174.944}, {107.676, 174.944}, {107.327, 175.152}, {107.688, 174.778}, {107.636, 175.091}, {107.62, 175.103}, {107.638, 175.11}, {109.77, 168.778}, {109.762, 168.755}, {107.376, 174.939}, {107.371, 174.936}, {109.459, 168.727}, {111.82, 166.633}, {109.48, 168.559}, {109.462, 168.546}, {109.47, 168.553}, {109.64, 168.266}, {109.591, 168.279}, {108.609, 171.012}, {107.228, 174.63}, {107.247, 174.615}, {109.842, 168.014}, {109.745, 168.066}, {109.78, 168.074}, {109.99, 168.346}, {107.722, 174.066}, {109.67, 167.676}, {107.37, 174.28}, {107.378, 174.261}, {107.542, 174.208}, {107.576, 174.236}, {107.56, 174.239}, {107.567, 174.223}, {109.702, 167.667}, {107.272, 173.779}, {109.666, 167.402}, {109.602, 167.377}, {109.745, 167.237}, {109.671, 167.249}, {109.087, 167.369}, {107.71, 173.134}, {107.673, 173.173}, {109.811, 166.979}, {109.847, 166.96}, {109.845, 166.976}, {109.85, 166.959}, {109.863, 166.922}, {107.568, 172.868}, {107.659, 172.918}, {107.884, 173.044}, {110.114, 165.957}, {110.133, 165.984}, {110.147, 165.98}, {107.929, 172.094}, {107.959, 172.093}, {110.358, 165.823}, {108.221, 171.547}, {110.215, 165.408}, {110.219, 165.102}, {110.37, 165.374}, {110.421, 165.402}, {107.914, 171.519}, {110.399, 164.974}, {110.396, 164.987}, {108.294, 171.308}, {110.588, 164.718}, {111.676, 167.232}, {110.278, 164.873}, {108.114, 171.214}, {108.053, 171.228}, {108.042, 171.209}, {108.23, 170.952}, {108.48, 170.917}, {108.426, 170.943}, {110.812, 164.669},{107.51, 174.18}, {108.6, 176.258}, {108.764, 170.599}, {108.651, 170.367}, {108.782, 170.467}, {111.037, 164.138}, {110.811, 164.195}, {110.821, 164.195}, {108.854, 170.189}, {108.881, 170.175}};      Running ListPlot on PairSet generates a fairly noisy plot: ![enter image description here](http://i.stack.imgur.com/rsfWW.png) However, we see something surprising if (treating the elements of PairSet as $(x,y)$ coordinates) we plot the $x$ and $y$ values separately: Plot for $x$-values: ![enter image description here](http://i.stack.imgur.com/2FN8M.png) Plot for $y$-values: ![enter image description here](http://i.stack.imgur.com/YwkxB.png) Here, we can clearly see we have inadvertently tracked a pair of particles instead of a single particle. We can also find instances where three or more seperate trajectories can be distinguished. Is there some manner to automatically decompose PairSet (or the hypothetical TriSet, etc.) into lists of values:                ParticleList = {Particle1, Particle2}      ...corresponding to each of two or more curves, s.t. these trajectories can be independently fit and averaged?


Strange behavior of Integrate

I'm trying to calculate the following integral using _Mathematica 9.0.1.0_                a11=Integrate[Abs[Sin[b+x]],{x,0,2*\[Pi]}]      This should be a simple problem; however, it took _Mathematica_ a very long time to obtain the answer, which is **4**. I asked a colleague to do it with _Maple_ , the answer is obtained instantly. I thought may be this has something to do with the fact that _Mathematica_ treats everthing as Complex value, so I rewrote the programm as               a1=Integrate[Abs[Sin[b+x]],{x,0,2*\[Pi]},Assumptions->{Element[{b,x},Reals]}]      Unfortunately, it took _Mathematica_ even more time to run this command. What's more unfortunate is that the obtained answer is **wrong** :               4 Abs[Sin[b]] Cot[b]      Does anybody know what's wrong here?