Extract data from NDSolveValue result

Okay this is a very newbie question. I have coded a sample problem that solves the heat diffusion equation on an annulus. Here's what I have:               Dom = ImplicitRegion[x^2 + y^2 >= 1 && x^2 + y^2 <= 5, {x, y}];     C = {DirichletCondition[u[x, y] == 200., x^2 + y^2 == 1], DirichletCondition[u[x, y] == 0., x^2 + y^2 == 5]};          result = NDSolveValue[{\!\(\*SubsuperscriptBox[\(\[Del]\), \({x, y}\), \(2\)]\(u[x, y]\)\) ==  0, C}, u, {x, y} \[Element] Dom];      I can plot the data as a contour plot. All that is good. Now, say I want to get the mean of the temperature. How I do that? I imagine the data is contained in the variable 'result', but it is very opaque to me.


The most external subexpression with given pattern

Suppose there is a deep expression with several instances of some `_f`. I want to get the most external case of `_f` from it (I also want to get the first instance of one, in a traditional _Mathematica_ 's sense of “the first”). Initially I tried `Cases[expr, _f, Infinity, 1]` but it actually turned out to be the internal subexpression. I probably should have expected that but was nevertheless a bit surprised. (Not that I'm saying the principle of the least astonishment was broken, though.) What is the proper way to get the external `_f`? (Sure, it could be more general than `Blank@something` but it probably doesn't matter.) An example:               In[1]:= deepExpression =             "External Head"[               "Just a filler"@"Just a filler, too",               "Head of interest"[                 "This should be the first part of the result",                  "Head of interest"@"But it is too deep"],               "Head of interest"@"But it is too late"];      The first naive attempt:               In[2]:= First@Cases[deepExpression, Blank@"Head of interest", Infinity, 1]     Out[2]= "Head of interest"["But it is too deep"]      Another unsuccessfull one:               In[3]:= Last@Cases[deepExpression, Blank@"Head of interest", Infinity]     Out[3]= "Head of interest"["But it is too late"]      Then I tried coordinate approach (minimizing sum of indices in `Position`):               In[4]:= minimumWRTTotal =              allPositions \[Function]              Select[allPositions              , And @@ ((arbitraryPosition \[Function]                         Total@# <= Total@arbitraryPosition) /@ allPositions) &];          In[5]:= findExternalByPosition[expr_, pattern_] :=              Part[expr             , ## & @@                First @ minimumWRTTotal @               Position[expr, pattern, Infinity]]          In[6]:= findExternalByPosition[deepExpression, Blank@"Head of interest"]     Out[6]= "Head of interest"["This should be the first part of the result",                                "Head of interest"["But it is too deep"]]      And I'm still not sure if it actually does what I need (a usual case for everything that is coordinate-based). Yet another approach:               In[7]:= FirstOrSkip = Quiet[First@# /. _First -> (## &[])] &;          In[8]:= parseForExternal[a_?AtomQ, pattern_] :=              Switch[a, pattern, a, _, ## &[]]          In[9]:= parseForExternal[notAnAtom_, pattern_] :=              Switch[notAnAtom             , pattern , notAnAtom             ,    _    , FirstOrSkip[parseForExternal[#, pattern] & /@ notAnAtom]]          In[10]:= parseForExternal[deepExpression, Blank@"Head of interest"]     Out[10]= "Head of interest"["This should be the first part of the result",                                 "Head of interest"["But it is too deep"]]      I'll probably use the last one but is there any better way? I feel there must be a very simple built-in way to do it that I overlook. `parseForExternal` in its present form probably does some unnecessary job with long expressions that have positives in the beginning, and I'd prefer to avoid that. In case it's true, and there's also no built-in algorithm, how do I make `parseForExternal` more efficient? Also, if anybody can clearly see if minimizing elements from `Position` w.r.t. to `Total` actually does the job, please comment on that.


Mathieu function periodicity problem

According to the documentation, the Mathieu characteristic function generates parameter a: > The characteristic value Subscript[a, r] gives the value of the parameter a > in y′′+(a-2q cos(2z))y=0 for which the solution has the form e^(i r z) f(z), > where f(z) is an even function of z with period 2π. However, I get the function `f` that are periodic of π instead of 2π. Here is the construction of the periodic function f (followed from Input 76 on page 1105 of The Mathematica Guidebook for Symbolics):               f[k_, q_, z_] := (MathieuC[MathieuCharacteristicA[k, q], q, z] + I Sign[k] MathieuS[MathieuCharacteristicB[k, q], q, z])/Exp[I k z]     Plot[{Abs@f[3, -1, z], Abs@f[1/3, -1, z]}, {z, -2 π, 2 π}, Axes -> False, Frame -> True, GridLines -> {π/2 Range[-3, 3, 2], {}}]      ![enter image description here](http://i.stack.imgur.com/Od5UT.png) So why does the periodic function `f` have period of π instead of 2π ?


Arranging "ranked" nodes of a graph symmetrically

I have Markov chains with a pair of absorbing states taken from the $n$-length strings formed from `{"H","T"}` for `n` at least 3 (generally 3 or 4), for example               {"HHH", "HHT", "HTH", "HTT", "THH", "THT", "TTH", "TTT"}      and with other states with names "leading up" to those states through the addition of either `"H"` or `"T"` to the end of the name of the previous state, from an initial state of `""`. For example the chain for the pair states `"TTH"` and `"HTT"` would have states               {"", "H", "T", "HT", "TT", "HTT", "TTH"}      I would like to represent the Markov chain for the transitions among these states as a graph with the nodes arranged according to their length as, for example in ![](http://i.stack.imgur.com/yZt0O.png) but `Graph` does not arrange nodes this way by default, ![](http://i.stack.imgur.com/lWnU7.png) and I can't figure out how to achieve a finer control over the node arrangement beyond what is offered by `GraphLayout` (though in some cases, as for this example, choosing `"LayeredDrawing"` comes close). Is there a way that I can use the node names to order and align the arrangement of nodes in a `Graph` so that they appear as they do in the first figure: first `""`, then 1-length node names, then 2-length node names, etc.? * * * Ideally the approach should be able to take something like               mp = DiscreteMarkovProcess[1, ( {          {0, .5, 0, 0, .5, 0, 0},          {0, .5, .5, 0, 0, 0, 0},          {0, .5, 0, .5, 0, 0, 0},          {0, 0, 0, 1, 0, 0, 0},          {0, .5, 0, 0, 0, .5, 0},          {0, 0, 0, 0, 0, .5, .5},          {0, 0, 0, 0, 0, 0, 1}         } )];     Graph[mp, VertexLabels -> {1 -> "", 2 -> "H", 3 -> "HT", 4 -> "HTT", 5 -> "T",  6 -> "TT", 7 -> "TTH"}]      and use `VertexLables` to automatically position the nodes in the `Graph` (the numbering and ordering of nodes is not guarantee, only the names). This should also work for "degenerate" cases such as ![](http://i.stack.imgur.com/3mLxv.png) and for longer absorbing states such as ![](http://i.stack.imgur.com/d6dxe.png)


Deployment to the Cloud not working

I am really trying to get my head around Cloud Deployment and Programming cloud, and the more I use it, the more I think it is a fantastic product. At least in principle. I successfully deployed a range of Manipulate 'applications' to the cloud and they work neatly. Now I wanted to do something more challenging and produces a little larger code (40 kb Mathematica nb). I tested the principle elements in a cloud deploy and it works. However, the more complex program doesn't work. I tried a tedious amount of possibilities – it doesn't work. This is especially frustrating, as there is no feedback at all what the problem is. I just get a white webpage with nothing on it. I can get it to work when compacting the program, but obviously that doesn't help in the long run. It's not a complicated program and on Mathematica it works without any delays. I've no idea why it won't deploy to cloud, i.e. it seems to deploy, but the webpage remains blank, no matter how long I wait. Any help much appreciated! OK, below is the code. I'm a user, not a programmer, so apologies for any too complicated stuff. The code usually executes within the programming cloud environment. But it doesn't update when I change something in the Manipulate output shell. On the website, the Manipulate output shell never appears. As said above, it works with less complex programs that are basically similar to the one below.               (*---- Befehlsdefinition>extractData ----*)          extractData[exal_, name_, opt_: 0] :=         Switch[opt           , 0, Rest@exal[[Position[exal, name][[1, 1]]]]           , 1, Rest@exal[[All, Position[exal[[1]], name][[1, 1]]]]           ];     (*---- Befehlsdefinition>extractData ----*)                   (*---- Directory,Import,etc. ----*)       data = CloudGet["Complementarity/chdmtxdata"];     cCData = CloudGet["Complementarity/ccdata"];         (*---- Directory,Import,etc. ----*)               (*---- Some required data extractions etc. Start ----*)          cIData = cCData[[1 ;; 2]];     metGroups = DeleteDuplicates@extractData[data, "Group", 1];     elmentList = {"H", "He", "Li", "Be", "B", "C", "N", "O", "F", "Ne",         "Na", "Mg", "Al", "Si", "P", "S", "Cl", "Ar", "K", "Ca", "Sc",         "Ti", "V", "Cr", "Mn", "Fe", "Co", "Ni", "Cu", "Zn", "Ga", "Ge",         "As", "Se", "Br", "Kr", "Rb", "Sr", "Y", "Zr", "Nb", "Mo", "Tc",         "Ru", "Rh", "Pd", "Ag", "Cd", "In", "Sn", "Sb", "Te", "I", "Xe",         "Cs", "Ba", "La", "Ce", "Pr", "Nd", "Pm", "Sm", "Eu", "Gd", "Tb",         "Dy", "Ho", "Er", "Tm", "Yb", "Lu", "Hf", "Ta", "W", "Re", "Os",         "Ir", "Pt", "Au", "Hg", "Tl", "Pb", "Bi", "Po", "At", "Rn", "Fr",         "Ra", "Ac", "Th", "Pa", "U"};     headerRow = data[[1]];     components = extractData[data, "Component Type", 1];     availableComponents = DeleteDuplicates@components;     group = extractData[data, "Group", 1];     (*---- Some required data extractions etc. End ----*)               (*---- Formats Start ----*)          stdStyle[txt_] :=       Style[txt, Darker@Gray, 14, FontFamily -> "Helvetica"]          stdFrame[obj_] := Framed[obj       , Background -> GrayLevel[.95]       , FrameStyle -> GrayLevel[.95]       , RoundingRadius -> 5]     (*---- Formats End ----*)                    screenoutput[chondriteGroup_, component1_, component2_, yaxisElement_,        xaxisElement_] := Module[{},       (*---- CC Data Start----*)            xCI = extractData[cIData, xaxisElement, 1];       yCI = extractData[cIData, yaxisElement, 1];       cILine = Plot[yCI/xCI x, {x, 0, 30}         , PlotStyle -> {Dashed, Darker@Gray}         ];            xCC = extractData[cCData, chondriteGroup][[         Position[cCData[[1]], xaxisElement][[1, 1]] - 1]];       yCC = extractData[cCData, chondriteGroup][[         Position[cCData[[1]], yaxisElement][[1, 1]] - 1]];       (*---- CC Data End----*)                 (*---- Result List Start----*)            yElement = extractData[data, yaxisElement, 1];       xElement = extractData[data, xaxisElement, 1];       ref = extractData[data, "Reference", 1];       doi = extractData[data, "doi", 1];       metName = extractData[data, "Meteorite Name", 1];            resultListComp1 =         DeleteCases[         If[components[[#]] == component1 && group[[#]] == chondriteGroup &&              NumberQ@xElement[[#]] &&              NumberQ@yElement[[#]], {xElement[[#]], yElement[[#]],              ref[[#]], doi[[#]], metName[[#]]}] & /@           Range[Length[data] - 1], Null];       resultListComp2 =         DeleteCases[         If[components[[#]] == component2 && group[[#]] == chondriteGroup &&              NumberQ@xElement[[#]] &&              NumberQ@yElement[[#]], {xElement[[#]], yElement[[#]],              ref[[#]], doi[[#]], metName[[#]]}] & /@           Range[Length[data] - 1], Null];       (*---- Result List End----*)                 (*---- Plot Data Start----*)            comp1LPData1 = resultListComp1[[All, 1]];       comp1LPData2 = resultListComp1[[All, 2]];       comp2LPData1 = resultListComp2[[All, 1]];       comp2LPData2 = resultListComp2[[All, 2]];       (*---- Plot Data End----*)                 (*---- ListPlot Start----*)            dataPlot =         ListPlot[{Transpose[{comp1LPData1,             comp1LPData2}], {{Mean@comp1LPData1, Mean@comp1LPData2}},           Transpose[{comp2LPData1, comp2LPData2}], {{Mean@comp2LPData1,             Mean@comp2LPData2}}, {{xCC/10^4, yCC/10^4}}, {{xCI[[1]]/10^4,             yCI[[1]]/10^4}}}         , Frame -> True         , FrameLabel -> {Row[{xaxisElement <> " (wt.%)"}],            Row[{yaxisElement <> " (wt.%)"}]}         , FrameStyle ->           Directive[14, Darker@Gray, FontFamily -> "Helvetica"]         , PlotMarkers -> {"\[FilledCircle]", {"\[CircleTimes]", 20},            "\[Bullet]", {"\[CirclePlus]", 20}, {"\[FivePointedStar]",             20}, {"\[FivePointedStar]", 20}}         , PlotStyle -> {Darker@Green, Red, Blue, Red, Orange, Gray}         , PlotRange -> {{0, Automatic}, {0, Automatic}}         , ImageSize -> 500         ];       (*---- ListPlot End----*)                 (*---- Histogram Start----*)       histograms = Row[{          Histogram[{comp1LPData1, comp2LPData1}           , Frame -> True           , FrameStyle ->             Directive[14, Darker@Gray, FontFamily -> "Helvetica"]           , FrameLabel -> {Row[{xaxisElement <> " (wt.%)"}], "Frequency"}           , ChartStyle -> {Darker@Green, Blue}           , ImageSize -> 350           ]          , Spacer@50          , Histogram[{comp1LPData2, comp2LPData2}           , Frame -> True           , FrameStyle ->             Directive[14, Darker@Gray, FontFamily -> "Helvetica"]           , FrameLabel -> {Row[{yaxisElement <> " (wt.%)"}], "Frequency"}           , ChartStyle -> {Darker@Green, Blue}           , ImageSize -> 350           ]          }]       ;       (*---- Histogram End----*)                 (*---- Info Sheet Start ----*)       infoSheet = stdFrame@stdStyle@Grid[{            {"Number of " <> component1 <> ": ", Length@resultListComp1}            , {"Number of " <> component2 <> ": ", Length@resultListComp2}            , {Spacer[{0, 1}]}            , {Style["Included Meteorites", Bold]}            , {Style[              Grid[{{Column[                  Prepend[DeleteDuplicates@resultListComp1[[All, 5]],                    Style[component1, Bold]]], Spacer@3,                  Column[Prepend[DeleteDuplicates@resultListComp2[[All, 5]],                    Style[component2, Bold]]]}}, Alignment -> Top], Blue]}            }, Alignment -> Left];       (*---- Info Sheet End ----*)                 (*---- Reference Sheet Start ----*)            refDOIListComp1 =         DeleteDuplicates@         Transpose[{resultListComp1[[All, 3]],            resultListComp1[[All, 4]]}];       finalRefComp1 =         If[refDOIListComp1[[#, 2]] == "", refDOIListComp1[[#, 1]],            Hyperlink[refDOIListComp1[[#, 1]],             "http://dx.doi.org/" <> refDOIListComp1[[#, 2]]]] & /@          Range@Length@refDOIListComp1;       refDOIListComp2 =         DeleteDuplicates@         Transpose[{resultListComp2[[All, 3]],            resultListComp2[[All, 4]]}];       finalRefComp2 =         If[refDOIListComp2[[#, 2]] == "", refDOIListComp2[[#, 1]],            Hyperlink[refDOIListComp2[[#, 1]],             "http://dx.doi.org/" <> refDOIListComp2[[#, 2]]]] & /@          Range@Length@refDOIListComp2;            infoRef = stdFrame@stdStyle@Grid[{            {Style["Data From", Bold]}            , {Spacer[{0, 5}]}            , {Grid[{{Column[                 Prepend[finalRefComp1, Style["Chondrules", Bold]]],                 Spacer@3,                 Column[Prepend[finalRefComp2, Style["Matrix", Bold]]]}},               Alignment -> Top]}            }];       (*---- Reference Sheet End ----*)                 (*---- Screen Output Start ----*)       Grid[{         {Show[dataPlot, cILine], Spacer@10, infoSheet}         , {Spacer[{0, 15}]}         , {histograms, SpanFromLeft}         , {Spacer[{0, 15}]}         , {infoRef, SpanFromLeft}         }, Alignment -> Top]       (*---- Reference Sheet End ----*)       ]               (*----------------------------*)     (*-------- Manipulate --------*)     (*----------------------------*)     Manipulate[      screenoutput[chondriteGroup, component1, component2, yaxisElement,        xaxisElement]           , {{chondriteGroup, "CV", "Group"}, metGroups,        ControlType -> PopupMenu}      , {{component1, "Chondrule", "Component 1"}, availableComponents,        ControlType -> PopupMenu}      , {{component2, "Matrix", "Component 2"}, availableComponents,        ControlType -> PopupMenu}      , Delimiter      , {{yaxisElement, "Mg", "y-axis"}, elmentList,        ControlType -> PopupMenu}      , {{xaxisElement, "Si", "x-axis"}, elmentList,        ControlType -> PopupMenu}           , ControlPlacement -> Left      , Deployed -> True      , SaveDefinitions -> True      ]


What is a "Region" in Mathematica 10?

"Region" seems to be a very important concept in Mathematica's latest version. Where can one find the more thorough introductory details about the concept of `Region` instead of just the shattering examples in the document?


Preforming Operations on Input Fields

I'm setting up a CDF document (in mathematica 9) that takes a cone and plots a point on it. The input required from the user is the radius of the cone at the base, the height of the cone, and two of the three coordinate values for the point on the cone. ie. You tell the program its a cone with base radius 100, height 100, X=50 and Z=50 and it calculates that Y is zero to proceed with the rest of the program. I'm currently using input fields for all of these values (code to follow) and am trying to use buttons to update the values in the fields. So you could enter the radius, the base, X and Y and then press the Z button to populate the field. What I've tried to do is this:                   xButton[initialY_,initialZ_, coneBase_, coneHeight_]:=         Button["X",            checkInitialXInitialY[initialY,initialZ,coneBase,coneHeight]               ]         yButton[initialX_,initialZ_, coneBase_,coneHeight_]:=         Button["Y",             checkInitialXInitialY[initialX, initialZ, coneBase, coneHeight]               ]         zButton[initialX_,initialY_, coneBase_,coneHeight_]:=\         Button["Z",              checkInitialXInitialZ[initialX,initialY,coneBase,coneHeight]               ]          (*Input Box *)     initialXInputProperties={initialX=xButton[initialY,initialZ,coneBase,coneHeight],"Unit"->"Length","Unit"->"Length","Tooltip"->"Distance from the y-axis."};     initialXInputMessage="initialX should be a number.";     initialYInputProperties={initialY=yButton[initialX,initialZ,coneBase, coneHeight], "Unit"->"Length","Unit"->"Length","Tooltip"->"Distance from the x-axis"};     initialYInputMessage="initialY should be a number";     initialZInputProperties={initialZ=zButton[initialX,initialY,coneBase,coneHeight],"Unit"->"Length", "Unit"-> "Length","Tooltip"->"Height from apex "};     initialZInputMessage="initialZ should be a positive number";          SetAttributes[initialPointInputBox, HoldAll];     initialPointInputBox   [initialX_,initialXValidQ_,initialY_,initialYValidQ_,initialZ_,initialZValidQ_, coneBase_,coneHeight_] :=     inputColumn[{         inputColumnTitle[{"Intersection of centerline of cylinder and cone"}],         {"",Image[E0819Ainputs2,ImageSize->450]},         inputField[initialX, initialXInputProperties],         warningMessage[!initialXValidQ,initialXInputMessage],         inputField[initialY, initialYInputProperties ],         warningMessage[!initialYValidQ, initialYInputMessage],         inputField[initialZ, initialZInputProperties],         warningMessage[!initialZValidQ, initialZInputMessage]     }];      The information about the cone is collected in an earlier input box and all of the variables are declared as dynamic in dynamic module. The code shown above turns the labels for the X,Y, and Z input boxes into buttons, but when I click them it doesn't repopulate the input fields. The function checkInitialXInitialY returns the missing Z value and checkInitialXInitialZ returns the missing Y value (or X if the Y value was passed to the function) Any thoughts?


Apply function to output of previous function

I am trying to write a function that takes 3 tuples. Each tuple contains two lists which are first divided. This results in 3 lists. Then I want to take the Mean of all the columns. I can do this in two steps:               d = Divide[#1, #2] & @@@  { {{1, 2, 3}, {4, 5, 6}}  , {{7, 8, 9}, {10,       11, 12}} , {{13, 14, 15}, {16, 17, 18} } }     Mean[d]      However I would like to put this all on one line. I have tried a couple different things all smilar to               Mean[#] & @ Divide[#1, #2] & @@@  { {{1, 2, 3}, {4, 5, 6}}  , {{7, 8, 9}, {10,       11, 12}} , {{13, 14, 15}, {16, 17, 18} } }      The problem is the mean is not applied to the entire list but rather one level inside, which does not give the desired output. the desired out put is:               {47/80, 608/935, 25/36}


How do Forms affect the interpretation of Expressions?

Below are three formats for representing an undirected edge between vertices a and b:               ClearAll[a, b]     a \[UndirectedEdge] b     FullForm[a \[UndirectedEdge] b]     InputForm[a \[UndirectedEdge] b]      Here's a screenshot of the output (to be clear about it's appearance): ![output1](http://i.stack.imgur.com/HTvtZ.png) Now let's look at some other `Form`s:               a \[UndirectedEdge] b     OutputForm[a \[UndirectedEdge] b]     StandardForm[a \[UndirectedEdge] b]     TraditionalForm[a \[UndirectedEdge] b]      ![output2](http://i.stack.imgur.com/KwQ4a.png) `Part works on the FullForm and InputForm as expected:               FullForm[a \[UndirectedEdge] b][[1, 2]]     InputForm[a \[UndirectedEdge] b][[1, 2]]          (* out *)     b     b      But Part does not return consistent results for other cases:               a \[UndirectedEdge] b[[1, 2]]     (a \[UndirectedEdge] b)[[1, 2]]     OutputForm[a \[UndirectedEdge] b][[1, 2]]     StandardForm[a \[UndirectedEdge] b][[1, 2]]     TraditionalForm[a \[UndirectedEdge] b][[1, 2]]      ![output3](http://i.stack.imgur.com/YIAUA.png) Can anyone help explain why Part gives different results? In particular, why doesn't it respond to all of the cases as if they were the FullForm version? * * * **Edit** In retrospect, I realize that I was both (a) miscounting levels and (b) oblivious to the role of Forms as wrappers of expressions. The second issue is touched on by this contribution by R.M


Find all values of the paramaters $m$ for which the equation has four roots smaller 2

I want to find all values of the paramaters $m$ for which the equation $$t^4 + (2 m - 1) t^2 - 18 m - 72=0$$ has four real distinct solutions less than 2. Put $t = x^2$, I tried               Clear[f];     f[x_] := x^2 + (2 m - 1) x - 18 m - 72;     d := Discriminant[f[x], x];     sol = Solve[f[x] == 0, x];     x1 = x /. sol[[1]];     x2 = x /. sol[[2]];     Reduce[{d > 0, x1 > 0, x2 > 0, x2 < 4}, m]      > -6 < m < -4 How can I reduce my code?


Revolving the area between two functions about an axis

I'm trying to graph the revolution of the area between two functions about an axis, but I'm new to Mathematica, and not sure how to proceed. My area is defined by               Plot[{x^2,x},{x,-5,5}, Filling -> {1->{2}}]      Just to clarify, the figure I'm looking is 3-dimensional, and could loosely be called a toroid. How could I model this in 3D?


'Play' button in Manipulation and slow evaluations

I'm trying to create animation of some discrete process using Manipilate: `Manipulate[**Some graphics based on very slow computations, each step is calculated slowly then the previous**], {Step, 1, 1000, 1}]` It works fine if I move Step slider with the mouse. But if I click the 'Play' button, animation starts but a lot of steps are missing. For example, I see the picture corresponding the 1st step, then the 13th, then 51st... And sometimes I even get '$Aborted'. Manipulate options like `ContinuousAction -> False` don't make any change. How can I make Manupulate display all the steps, one by one, with "Play' button?


Factorizing polynomials over fields other than $\mathbb{C}$

I'd like to take a polynomial in $\mathbb{Z}_5[x]$ of the form $ax^2+bx+c$ and factor it into irreducible polynomials. For example: Input...               x^2+4      Output...               (x+1)(x-1)      Note that this factorization only makes sense in $\mathbb{Z}_5[x]$ I am also interested in identifying cases which are already irreducible. For example: Input...               x^2+2      Output...               Polynomial is irreducible.      * * * So, is there a way to limit Mathematica, especially functions like `Solve` to fields other than $\mathbb{C}$?


Tweaking Solve for systems of polynomial equations

I am trying to solve the following system of $6$ quadratic equations in $6$ variables:               system =        { 1/144 (Sqrt[3] x (Sqrt[5] + 1) + 2Sqrt[3] (t1 + t2 - 1) + 4 Sqrt[3] t1         - 2Sqrt[3] t2 + 2 Sqrt[3] (x - 1))^2 + 1/16 (x (Sqrt[5] + 1) - 2t1 - 4t2 - 2x + 4)^2       + 1/9 (x (Sqrt[3] - 3Sqrt[1/2 Sqrt[5] + 7/6]) + 3(x - 1) Sqrt[1/2 Sqrt[5] + 7/6])^2 == s,        1/144 (Sqrt[3] x (Sqrt[5] + 1) + 2Sqrt[3] (x - 1) + 2Sqrt[3] (Sqrt[5] + 1))^2        + 1/16 (x (Sqrt[5] + 1) - 2x + 2)^2 + 1/9 (x (Sqrt[3] - 3Sqrt[1/2 Sqrt[5] + 7/6])        + 3*(x - 1) Sqrt[1/2 Sqrt[5] + 7/6] - Sqrt[3] + 3 Sqrt[1/2 Sqrt[5] + 7/6])^2 == s,         1/36 (Sqrt[3] (t1 + t2 - 1) + 2 Sqrt[3] t1 - Sqrt[3] t2 - Sqrt[3] (Sqrt[5] + 1))^2        + 1/4 (t1 + 2t2 - 1)^2 + 1/9 (Sqrt[3] - 3Sqrt[1/2 Sqrt[5] + 7/6])^2 == s,          1/144 (Sqrt[3] (u1 + u2 - 1) (Sqrt[5] + 1) - 2Sqrt[3] (t1 + t2 - 1)       - 4Sqrt[3] t1 + 2 Sqrt[3] t2 + 2Sqrt[3]u1 - 4Sqrt[3] u2)^2 +          1/16 ((u1 + u2 - 1) (Sqrt[5] + 1) - 2t1 - 4t2 - 2u1 + 2)^2 +          1/9 ((u1 + u2 - 1)(Sqrt[3] - 3Sqrt[1/2 Sqrt[5] + 7/6])        + 3u1 Sqrt[1/2 Sqrt[5] + 7/6] + 3u2 Sqrt[1/2 Sqrt[5] + 7/6])^2 == s,          1/144 (Sqrt[3] (u1 + u2 - 1) (Sqrt[5] + 1) + Sqrt[3] x (Sqrt[5] + 1)        + 2Sqrt[3] u1 - 4 Sqrt[3] u2 + 2Sqrt[3] (x - 1))^2 +          1/16 ((u1 + u2 - 1)(Sqrt[5] + 1) - x (Sqrt[5] + 1) - 2u1 + 2x - 2)^2       + 1/9 ((u1 + u2 - 1)(Sqrt[3] - 3Sqrt[1/2 Sqrt[5] + 7/6])        + x (Sqrt[3] - 3Sqrt[1/2 Sqrt[5] + 7/6]) + 3u1 Sqrt[1/2 Sqrt[5] + 7/6]       + 3u2 Sqrt[1/2 Sqrt[5] + 7/6] + 3(x - 1)Sqrt[1/2 Sqrt[5] + 7/6])^2 == s,          1/144 (Sqrt[3] (u1 + u2 - 1)(Sqrt[5] + 1) + 2Sqrt[3] u1       - 4Sqrt[3] u2 - 2Sqrt[3](Sqrt[5] + 1))^2 + 1/16 ((u1 + u2 - 1)(Sqrt[5] + 1) - 2u1)^2        + 1/9 ((u1 + u2 - 1)(Sqrt[3] - 3Sqrt[1/2 Sqrt[5] + 7/6])        + 3u1 Sqrt[1/2 Sqrt[5] + 7/6] + 3u2 Sqrt[1/2 Sqrt[5] + 7/6] +           Sqrt[3] - 3Sqrt[1/2 Sqrt[5] + 7/6])^2 == s};      Unfortunately _Mathematica_ does not give a solution:               Solve[ system, {s, t1, t2, u1, u2, x}]      It ran for about an hour and it didn't finish.   Numerically the system can be solved with `NSolve`.   I am looking for the solution, where all the variables (`{s, t1, t2, u1, u2, x}`) are positve.   Numerically it should be this one:               {s -> 1.8156, t1 -> 0.290762, t2 -> 0.352453,       u1 -> 0.332044,  u2 -> 0.0729072, x -> 0.645495}      Is there a way to obtain the exact solutions?   Things I tried that didn't work:   * setting the domain to `Reals`. (Then even `Nsolve` doesn't find a solution)   * adding an extra inequality `s > 0`.   * eliminating the variable `s` by hand, which gives a system of $5$ quadratic equations with $5$ variables.


Transparent background of content in a dialog window

Why dialogs created with `CreateDialog` cannot correctly show content with transparent background? The following example generates a plot, with white background, though it should be gray, as that is the default color of the dialog window of Windows. If, however, I move a window in front of the dialog covering it halfway or totally, the background reverts to the default panel- gray (see figures below).               CreateDialog[DocumentNotebook[        Plot[Sin@x, {x, 0, 2 \[Pi]}, Frame -> True, Axes -> False,          Background -> None, ImagePadding -> 30, ImageSize -> 300]        ]];      ![Mathematica graphics](http://i.stack.imgur.com/Pg6Uk.png) (Left: the new dialog as it appears. Middle: covering the dialog halfway with another window, then removing the covering window. Right: Covering the window fully, and then revealing.) The following approach does not work either:               Background -> Directive[Red, Opacity[0]]      This behaviour is more emphasized if the content is dynamic:               CreateDialog[DocumentNotebook[Column@{          Slider@Dynamic@n,          Dynamic@Plot[Sin@x, {x, 0, n \[Pi]}, Frame -> True, Axes -> False,             Background -> None, ImagePadding -> 30, ImageSize -> 300]          }]];      While it appears first with white background, even mouse movements cause it to turn into the desired gray color. My problem is that I have a gui, where a plot is created and updated in real time. I would like to have its background to be the color of the underlying panel, but it continuously switches between white and gray during updating. Any idea how to overcome this?


How to make Epilog render behind the main plot

Consider this example:               data = Table[{i, i + 20 Sin[RandomReal[-i, i]][[1]]}, {i, 1, 1000}];     Plot[x, {x, 0, 1000}, PlotStyle -> {Red, Thickness[0.01]},        Epilog -> {PointSize[0.02], Point[data]}]      ![enter image description here](http://i.stack.imgur.com/WSdQH.jpg) It can be seen that the points are rendered over the main plot and makes it invisible. How to control the layers of plot so that to send a layer backward or to bring it forward.


Programmatically writing to a notebook in TraditionalForm

I'm trying to get a Cell to appear in TraditionalForm when using `NotebookWrite`. Here is the closest I can get:               nb = CreateDocument[];     NotebookWrite[nb, Cell["Hello", "Section"]];     NotebookWrite[nb, Cell[BoxData@ToBoxes@TraditionalForm@"HI", "Text"]];      I get the following: ![nb output](http://i.stack.imgur.com/J9E3f.png) What do I need to do to get "HI" to appear in TraditionalForm? **Edit:** Here's a better example:               nb = CreateDocument[];     NotebookWrite[nb, Cell[BoxData[ToBoxes[Sin[x]^2]], "Output"]];      gives ![](http://i.stack.imgur.com/I2SjF.png) whereas I'd like the output to look like ![](http://i.stack.imgur.com/koJBx.png) Is there a specific option I need?


Is the source code available for examples in the "Mathematica Cookbook" by Sal Mangano?

I looked around a bit and didn't seem to find it. Not as obvious as Wrox books make it, for example. I came across a pdf of the book online [I paid for the paperback] but pasting the code from the pdf resulted in a bunch of incorrect character substitutions. Any info on a resource for this?


Get interval of series

It seems to be a stupid question but I wonder how to get an interval of a series expansion. The current series command               Series[f, {x, x0, n}]      only give series expansion up to $x^n$, where I want something like               Series[f, {x, x0, h, t}]      which gives me the series expansion from $x^h$ to $x^t$. Obviously I can get it by doing               Series[f, {x, x0, t}] - Series[f, {x, x0, h-1}]      However, I believe that it takes longer time than it should take.


Find if element exists in N-dimensional array

I was wondering if there was a more elegant way of finding whether an element exists in an N-dimensional array. The way I would do it is:                inArrayQ[a_,el_] := If[Length@Position[a,x_/;x==el]==0,False,True];      But this seems rather cumbersome. I am surprised there is no built-in Mathematica function that does this, but if not, is there a better way to write such a function?


What is the syntax to conditionally suppress plotting in version 9?

In _Mathematica_ 7 it is very easy to conditionally suppress plotting of individual lines using `If`:               Plot[{       If[x^2 < 2, x^2],       If[Exp[x] > x^2, Exp[x]],       If[False, x]                (* check recommended by Rahul *)      },      {x, -2, 2},      PlotStyle -> Thick, Frame -> True]      ![enter image description here](http://i.stack.imgur.com/fu16v.png) Or more verbosely using `Piecewise` and `Indeterminate`:               Plot[{       Piecewise[{{x^2, x^2 < 2}}, Indeterminate],       Piecewise[{{Exp[x], Exp[x] > x^2}}, Indeterminate],       Piecewise[{{x, False}}, Indeterminate]      (* check recommended by Rahul *)       },      {x, -2, 2},      PlotStyle -> Thick, Frame -> True]      ![enter image description here](http://i.stack.imgur.com/fu16v.png) It is reported that neither method works in **version 9.0.0** (at least on OSX.) Furthermore it is reported that my attempt using `ConditionalExpression` also fails:               Plot[{       ConditionalExpression[x^2, x^2 < 2],       ConditionalExpression[Exp[x], Exp[x] > x^2]       },      {x, -2, 2},      PlotStyle -> Thick, Frame -> True]      Plotting a zero is reported to "work" but that is hardly a solution:               Plot[{       Piecewise[{{x^2, x^2 < 2}}],       Piecewise[{{Exp[x], Exp[x] > x^2}}]       },      {x, -2, 2},      PlotStyle -> Thick, Frame -> True]      ![enter image description here](http://i.stack.imgur.com/qk3Tl.png) **1\. Is this indeed a bug in version 9.0.0?** **2\. Is there a workaround for the affected systems?**


How can I solve an exponential inequality in Mathematica?

I would like to solve the equation:               A Exp[m t + s Sqrt[t] x - 1/2 s^2 t] >= K      with respect to `x` (which is in the exponent) using _Mathematica_. All parameters are positive. Of course, the answer is easy to get by hand. However, for some reason I could not figure out how to do it with _Mathematica_. What I tried gave me some error messages. Also, I would like the solution to be expressed without all those conditionals. That is, I want the answer in which all the parameters satisfy whatever they need to satisfy so that the generic solution holds, I would greatly appreciate help in figuring out how to do this.


Limit of sequence

I tried to calculate the following limit $$\lim_{n\to\infty}n\sin(2\pi en!)$$ Mathematica gets               In[1]:= Limit[n*Sin[2 Pi*n!*Exp[1]], {n -> Infinity}]               Out[1]= {Interval[{-\[Infinity], \[Infinity]}]      But by the following link the answer is $2\pi$. I'm confused. http://math.stackexchange.com/questions/76097/what-is-the-limit-of-n-sin-2-pi- cdot-e-cdot-n-as-n-goes-to-infinity I think the limit is zero.               ListPlot[Table[n Sin[2 Pi E Factorial[n]], {n, 0, 300}]]


Integration and Parallel Computing in Mathematica

In mathematica, how would I use parallel computing (or paralleltable) to compute the integrals of $x^2$, $x$, $3x$ from $x=0$ to $10$ just like in the first answer of http://superuser.com/questions/315337/how-to-make-commands-in- mathematica-8-use-all-cores? After entering the three functions into a table, I'm not sure how to tell Mathematica to integrate the functions. I understand that parallel computing is not the most efficient method, but once I realize how to do this, I can extend it to a much more complicated series of functions. The motivation of this question is that I have a complicated function (see below) that takes a very, very long time to integrate (after two hours, the function still had not integrated). I'm hoping to break this function up into a group of slightly less complicated functions and utilize parallel computing to compute the integrals. If I can't do this, is there a way to let mathematica use all four cores on my computer to compute the integral, but not using parallel computing? Thank you.               (Sin[q - x] ((0.476497 - 0.401956 I) - (0.476497 + 0.598044 I) Tanh[             0.933024 (q - x)]) +         Cos[q - x] ((0.401956 + 0.504489 I) + (0.598044 + 0.504489 I) Tanh[             1.06598 (q - x)])) (Sin[          q + x] ((0.476497 - 0.401956 I) - (0.476497 - 0.598044 I) Tanh[             0.933024 (q + x)]) +         Cos[q + x] ((0.401956 - 0.504489 I) + (0.598044 + 0.504489 I) Tanh[             1.06598 (q + x)]))      Note: I plan to integrate x between -10 and 10 where p and q are arbitrary variables so I can then plot the result as a contour map.


Is there a way to have a Tooltip for non-editable raster graphics produced by MakeBoxes?

I have a function which produces a large object I would like to hide. Formatting is of course an option but I'm hoping for something a little more meaningful using raster graphics and `Tooltip`. Also, `Format` doesn't allow the object to be copied and pasted while retaining the internals of the object whereas `MakeBoxes` does. Here is some sample code that produces what I want without the `Tooltip`.               f /: MakeBoxes[dat : f[args_], fmt_] :=      TagBox[ToBoxes[Rasterize@RandomImage[1, {100, 100}]],       InterpretTemplate[f[args] &], Editable -> False, Selectable -> True,        SelectWithContents -> True]          f[1]      This produces the raster graphic with a `Tooltip` but the graphic is now editable/resizable.               f /: MakeBoxes[dat : f[args_], fmt_] :=      TagBox[ToBoxes[        Tooltip[Rasterize@RandomImage[1, {100, 100}], "tooltip"]],       InterpretTemplate[f[args] &], Editable -> False, Selectable -> True,        SelectWithContents -> True]          f[1]      Is there a way to have both a `Tooltip` and the non-editable raster graphic?


Why is my animation so slow?

I have an animated plot of the kind               Manipulate[      plot1 = ParametricPlot3D[randomsample[s], {s, 0, t},                                PlotStyle -> Red,                               Evaluated -> True];      plot2 = ListPointPlot3D[coord3D[t]];      Show[plot1,           plot2,           AxesOrigin -> {0, 0, 0},            PlotRange -> {{-3, 3}, {-3, 3}, {-3, 3}},           ImageSize -> Large,           AspectRatio -> 1,           ViewPoint -> viewpoint,            PlotLabel -> Style["time " <> ToString[NumberForm[t, {4, 2}]] <> " whatevers", 20]]      ,      {t, 0, 15, ControlType -> Animator},      {{viewpoint, {Infinity, 0, 0}},       {{3, 3, 1} -> "3D",        {Infinity, 0, 0} -> "Front",        {0, 0, Infinity} -> "Top",        {0, Infinity, 0} -> "Side"}}]      making use of source data such as               coord3D0 = RandomReal[{-1, 1}, {450, 3}];     ρ0 = Norm /@ coord3D0;     θ0 = RandomReal[{0, 2 Pi}, 450];     vθ = RandomReal[{-10, 10}, 450];     θ[t_] = vθ/ρ0 t + θ0;     kvectors = Normalize /@ MapThread[        Cross,        {Evaluate[Normalize /@ RandomReal[{-1, 1}, {450, 3}]], coord3D0}];     coord3D[t_] = Simplify@Chop[        coord3D0*Cos[θ[t]] + MapThread[Cross, {kvectors, coord3D0}] Sin[θ[t]] + MapThread[#1 (#1.#2) &, {kvectors, coord3D0}] (1 - Cos[θ[t]])];     randomsample[t_] = RandomSample[coord3D[t], 30];      The point is, it works, but it runs _reeeeeeally_ slow on my laptop. Now my question is threefold:   1. How can I make it run faster?   2. Did I do something specifically wrong or have I somehow run into Mathematica's limitations as regards 3D animated plotting? Could it be that this is not the way I'm supposed to be combining plots inside a `Manipulate`?   3. What _are_ Mathematica's "practical" limitations in this respect? I.e., how can I make a reasonable guess as whether an animated plot will be able to run smoothly? How much is too much? **EDIT:** The problem seems linked to the `ParametricPlot3D` code, since the `ListPointPlot3D` runs smoothly by itself, while the parametric plot doesn't. Heretofore I have tried using a `RegionFunction` specification and an `Exclusion` specification in place of its dynamic upper limit, both unsuccessfully.


Error when using rule as a list index - { i, x[[i]] } /. i -> 5

I can't seem to use a rule to index a vector.               x = Range[10];     { i, x[[i]] } /. i -> 5      I get the following error when evaluating the above code, even if the next cell shows the correct result:               Part::pspec: Part specification i is neither an integer nor a list of integers.


Dual-Grid Graph Paper With Mathematica?

Is there a slick way to generate the dual-grid graphs such as you can see on pages 7, 9, and 10 of this article, or this one? I've searched, but found nothing. Thanks in advance...


How to recover a graph without instructions to produce it?

I have an output graph on a saved notebook that I cannot reproduce with my data (I messed up the instructions). Can I take that graph, insert it in a new notebook and modify it? (I'm thinking about axes, labels, fonts, etc.)


How can I set id attribute of elements when I export an SVG file?

Suppose I have a _Mathematica_ graphic such as               g = Graphics[{Disk[{-1, 0}, 1/2], Rectangle[]}]      ![square and circle](http://i.stack.imgur.com/rZkyv.png) I would like to be able to export this graphic from _Mathematica_ as a SVG file. I also want to set attributes for the SVG elements that represent the circle and the square. Is this possible? I create my SVG file with               ExportString[g, "SVG"]                    <!DOCTYPE svg PUBLIC \"-//W3C//DTD SVG 1.1//EN\" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd\">     <svg version='1.1' xmlns='http://www.w3.org/2000/svg' xmlns:xlink='http://www.w3.org/1999/xlink'>       <g transform='translate(-74.000000, -13.000000)'>         <g transform='matrix(1.000000, 0.000000, 0.000000, 1.000000, 0.000000, 0.000000)' clip-path='url(#cp1)'>           <clipPath id='cp1'>             <polygon points='-2.2518e+15,-2.2518e+15 -2.2518e+15,2.2518e+15 2.2518e+15,2.2518e+15 2.2518e+15,-2.2518e+15 '/>           </clipPath>           <rect fill='rgb(100%,100%,100%)' stroke='none' x='74' y='13' width='360' height='222' />         </g>         <g transform='matrix(1.000000, 0.000000, 0.000000, 1.000000, 0.000000, 0.000000)' clip-path='url(#cp2)'>           <clipPath id='cp2'>             <polygon points='74,13 74,235 434,235 434,13 '/>           </clipPath>           <ellipse fill='rgb(0%,0%,0%)' opacity='1' stroke='none' cx='150' cy='158' rx='68.928' ry='68.928' />           <polygon stroke='none' opacity='1' fill-rule='evenodd' fill='rgb(0%,0%,0%)' points='287.964,157.749 287.964,19.8928 425.82,19.8928 425.82,157.749 ' />         </g>       </g>       <defs></defs>     </svg>"      I would like the ability to insert an id attribute in the `<polygon>` and `<ellipse>` tags. I have already tried using the `Annotation` but that didn't produce any difference in the result. My real application has many more graphical objects that I plan to control from JavaScript.


How to draw a gene regulatory state space diagram in Mathematica

Is it possible to draw in Mathematica a state space diagrams like these two?! ![enter image description here](http://i.stack.imgur.com/ZsD94.png) I tried a lot but since I am fairly new to Mathematica, I could not reproduce the desired result.


The limit of a product to infinity

What is the difficulty with this question to Mathematica? Is it just a problem with Mathematica v.8.0   or all versions are in trouble with it? Or is something wrong with my input?               Limit[Product[(1 + t/n^3)^(1/t^(1/3)), {n, 1, Infinity}],  t -> Infinity]


Manipulating an arbitrary-precision ContourPlot

I have a function, say               minimizeme[ω_][β_][ϵ_] = ϵ^2 ω-Log[2 (Cosh[2 β]+Cosh[2 β ϵ])]/(2 β);      I want to make a high-precision dynamic `ContourPlot` of it using:               plottricrit[ω_] := ContourPlot[      D[minimizeme[ω][β][ϵ], ϵ] == 0,      {β, 0.5, 1.0},      {ϵ, -3, 3},      Evaluated -> True,       ContourStyle -> Thick,       RegionFunction -> Function[         {β, ϵ},          minimizeme[ω][β][ϵ] < minimizeme[ω][β][0]],      ImageSize -> Large,       PerformanceGoal -> Accuracy,      WorkingPrecision -> 60]          Manipulate[plottricrit[ω],{ω,0.217`60,0.22545`60}]      However, I keep running into a `ContourPlot::precw` message which tells me that > The precision of the argument function (...) is less than > `WorkingPrecision`. I have tried several ways to set the right precision (i.e., using `With` to inject a higher `$MachinePrecision`, using `SetPrecision`, using `Rationalize`, etc.), but I can't seem to get rid of this error. What is the right way to deal with it?


Remove overlapping red and green color

How to remove overlapping red and green color regions, leaving only red ones? ![enter image description here](http://i.stack.imgur.com/hSBJW.png)


Generating a topological space diagram for an n-element set

Over on StackOverflow I asked a similar question for the n=3 case, but the answer given doesn't easily generalize. How can I make a diagram such as this: ![Finite Topological Spaces](http://i.stack.imgur.com/dBIAg.png) But for a general n-element space instead?


Setting up and solving system of equations

Consider the following code:               m = 4;     n = 3;     TraditionalForm[Sum[(-1)^(i + 1) * Binomial[n, i] * x^(m * i), {i, 0, n}]] ==      TraditionalForm[Collect[Sum[(-1)^(j + 1) * Binomial[n, j] * x^j, {j, 0, n}] *      Sum[Subscript[a, i] * x^i, {i, 0, n * (m - 1)}], x]]      ![output](http://i.stack.imgur.com/DyBad.jpg) From this I would like to match the coefficients in each term in the two polynomials and thereby get n*m+1 equations and solve them for the n*(m-1)+1 `a_i`'s. **Update** After using bill s's answer, I get the following:               Solve[CoefficientList[        FullSimplify[         Sum[(-1)^(i + 1)*Binomial[n, i]*x^(m*i), {i, 0, n}] -           Sum[(-1)^(j + 1)*Binomial[n, j]*x^j, {j, 0, n}]*           Sum[a[i]*x^i, {i, 0, n*(m - 1)}]], x] == 0,       Table[a[i], {i, 0, n*(m - 1)}]]      ![output2](http://i.stack.imgur.com/xUAq9.jpg) Now, I would like to write out the equation but the following attempt fails:               Sum[a[i - n]*x^i, {i, n, n*m}]      ![output3](http://i.stack.imgur.com/a3rGk.jpg) Only the `a[i]`s are printed, not the values of the, which have been computed with the previous chunk of code.


Mathematica not plotting whole logarithmic function

I am trying to use the following input               Plot[Log[E,x+1],{x,-50,50},PlotRange->50]      however the output is: > ![plotted function](http://i.imgur.com/SVxpatz.png) How can I adjust it so the line goes down to the PlotRange mark specified. Or is this a limitation of mathematica?


How to improve the performance of this code

I have implemented a code in Mathematica 9 to simulate a scattering problem, and I got really disappointed about its performance when compared to Matlab. Since I am a newbie in Mathematica, would someone give me clues here?               ClearAll["Global`*"];     integrand[k_, P0_, P1_, rho_, l_] = Module[{x, h},        x = P1*l + P0*(1. - l) - rho;        h = HankelH2[0, Norm[x, 2]*k];        h        ];     innerInt[k_, P0_, P1_, rho_] := Module[{d, r, v, x},        d = Norm[P0 - P1, 2];(* distancia entre os pontos *)        v = integrand[k, P0, P1, rho, x];        r = NIntegrate[v, {x, 0, 1}]*d;        r        ];     solveSystemCylinder[segsStart_, segsEnd_, Ei_, k_, eta_] :=        Module[{colocPts, r, x, t, eiVals},        colocPts = (segsStart + segsEnd)/2;        t[x_] := MapThread[innerInt[k, #1, #2, x] &, {segsStart, segsEnd}];        r = Map[t, colocPts];        eiVals = Map[Ei[#, k] &, colocPts];        N[LinearSolve[r, eiVals]]        ];     Ei[p_, k_] := Exp[I*k*First[p]];          k := 2*Pi/Lambda;     Lambda := 1;     raio := Lambda;     eta := 1;     ND := 30;(* num de divisões *)     pts := N[raio*{Cos[#], Sin[#]} & /@ (Range[0, ND]*(2*Pi/ND))];     pts2 := ({0, 2*Lambda} + #) & /@ pts;     allPts := Join[pts, pts2];          startPts := Take[pts, Length[pts] - 1];     endPts := Take[pts, -(Length[pts] - 1)];          startPts2 := Take[pts2, Length[pts2] - 1];     endPts2 := Take[pts2, -(Length[pts2] - 1)];          (*resolve*)     Js = solveSystemCylinder[Join[startPts, startPts2],         Join[endPts, endPts2], Ei, k, eta];


Searching for closest entry in a table

I have a large table of triplets whose structure is:               list=Table[{a,b, RandomReal[]}, {a,1,100}, {b,1,100}]      I would like to search through the list by looking for the closest entry labeled by `{a,b}` to a given input `{x,y}` and return the associated third item in the triplet. To give an example, if I have               {x, y} = {10.2, 5.1}      I would like to return the triplet               {10, 5, c}      Where `c` is the associated random real in the table. I have tried using `Nearest`, but the structure of the table does not seem compatible with search.


Code hanging inside a For loop

I'm pretty new to _Mathematica_ (and functional programming in general). I'm working on some code to find winners (maximal values) in a list. The code I have that is hanging is this line.               For[i = 1, 1 <= Length[WinnerList] + 1, i++,         If[WinnerList[[i]] == winner, AppendTo[WinnerIndexList, i],]]      Basically, my code goes through a list, and adds the index `i` from that list to a second list, if the i-th entry is a 'winner'. My code hangs, but I get the correct output if I abort my code. Any ideas?


How can I understand the result Mathematica returns from DSolve?

I have solved an ODE using `DSolve`, but I have a problem with understanding the solution. In general the solution is in the form:               InverseFunction[[many expressions using # and #1]&][g x+C[1]]      where `g` is constant What does `#1` and `&` mean and what does `InverseFunction` mean in this context?


CustomTicks and small ranges

_**UPDATE_** While the self-posted answer below (`TickLabelStyle->TraditionalForm`) works for most things, it also has the following effect: Integers are given periods in the label. That is, if the ticks would be at `{1,2,3,4}`, the labels are given as `{"1.","2.","3.","4."}` instead of the more pleasing `{"1","2","3","4"}`. Is there a better form or formatting function to use in this case? * * * I'm using the CustomTicks package from LevelScheme, and am having problems with displaying things when the range is very small ($10^{-11}$). For example, with default Mathematica:               ListPlot[{RandomReal[#], RandomReal[#]} & /@ (Range[100] 10^-10),       Frame -> True, Axes -> False]      Gives ![Mathematica graphics](http://i.stack.imgur.com/gjGe4.png) While the equivalent, reproducible CustomTicks equivalent is:               ListPlot[{RandomReal[#], RandomReal[#]} & /@ (Range[100] 10^-10),       Frame -> True, Axes -> False,       FrameTicks -> {LinTicks, LinTicks, StripTickLabels@LinTicks,         StripTickLabels@LinTicks}]      which gives: ![Mathematica graphics](http://i.stack.imgur.com/67jnI.png) Erk. I must be missing something from the documentation, but I can't seem to find the right options. I want to eventually set more options for LinTicks (such as Tick length, etc), but this is a minimal example, and once this is solved, I can work on adding those options. I can also double check that the range is set correctly by doing things slightly more by hand:               In[11]:= data = {RandomReal[#],           RandomReal[#]} & /@ (Range[100] 10^-10);     xRange = {Min@data[[All, 1]], Max@data[[All, 1]]}     yRange = {Min@data[[All, 2]], Max@data[[All, 2]]}          Out[12]= {3.82894*10^-11, 9.18792*10^-9}          Out[13]= {5.96584*10^-12, 9.54224*10^-9}               In[14]:= ticks = FrameTicks -> {         LinTicks[xRange[[1]], xRange[[2]], MajorTickLength -> {0, 0.015},      MinorTickLength -> {0, 0.005}],         LinTicks[yRange[[1]], yRange[[2]], MajorTickLength -> {0, 0.015},      MinorTickLength -> {0, 0.005}],         StripTickLabels@LinTicks[xRange[[1]], xRange[[2]]],         StripTickLabels@LinTicks[yRange[[1]], yRange[[2]]]     }      Output omitted, but the range from LinTicks is correct. The x axis is $2\times 10^{-9}$ to $9\times 10^{-9}$, so they should output fine.               ListPlot[data, Frame -> True, Axes -> False, ticks]      Gives ![Mathematica graphics](http://i.stack.imgur.com/7GZPW.png) Any ideas?


DisplayFormula not working as expected

How do I use the styles `"DisplayFormula"` and `"DisplayFormulaNumbered"`? Why is there no margin (or empty space) around the formula? Why does the latter **not** display numbers? How to set those styles to do what one expects?


local variable naming & symbolic argument

I'm stuck here with my variable assignment in this scenario               AntennaPower[measure_, antenna_] :=       Module[{{x1, x2, sd1} = measure, {xa, ya} = antenna},       N[ sd1*(4*Pi*((xa - x1)^2 + (ya - y1)^2)/1000)]]          AntennaPower[{2000, 0, 1/2}, {5, 60}]     Error message is Module::lvset: Local variable specification {{x1,x2,sd1}={2000,0,1/2},{xa,ya}={5,60}} contains {x1,x2,sd1}={2000,0,1/2}, which is an assignment to {x1,x2,sd1}; only assignments to symbols are allowed. >>


Why won't Manipulate work with symbols generated by Symbol?

Suppose I am provided with two data lists. (Assume for the moment that they are lists of integers.) I would like a function that generates bar charts that I can manipulate. Here is what I have:               f[dL1_List, dL2_List] :=       Module[{dL1SymList, dL2SymList},        dL1SymList = (Symbol["dL1" <> ToString[#]] &) /@ dL1;        dL2SymList = (Symbol["dL2" <> ToString[#]] &) /@ dL2;        (          Manipulate[Grid[{              {               BarChart[dL1SymList, PlotLabel -> "dL1"],               BarChart[dL2SymList, PlotLabel -> "dL2"]               }              }], ##] &          ) @@         Join[          MapThread[({{#1, #2}, 0.0, 10*#2} &), {dL1SymList, dL1}],          MapThread[({{#1, #2}, 0.0, 10*#2} &), {dL2SymList, dL2}]          ]        ];          f[Range[1, 5], Range[1, 5]]      However, while this does not produce any error, it does not display bar graphs either. Can you please help me understand where I am going wrong? Thanks in advance for your help.


Import DCD (CHARMM/NAMD binary trajectory) file

How can one import the coordinates stored in a binary CHARMM/NAMD DCD file? This is the structure of the file:               HDR     NSET    ISTRT   NSAVC   5-ZEROS NATOM-NFREAT    DELTA   9-ZEROS     `CORD'  #files  step 1  step    zeroes  (zero)          timestep  (zeroes)                             interval     C*4     INT     INT     INT     5INT    INT             DOUBLE  9INT     ==========================================================================     NTITLE          TITLE     INT (=2)        C*MAXTITL                     (=32)     ==========================================================================     NATOM     #atoms     INT     ==========================================================================     X(I), I=1,NATOM         (DOUBLE)     Y(I), I=1,NATOM              Z(I), I=1,NATOM              ==========================================================================      A sample pdb and dcd file is here. A C plugin for reading the DCD can be found here. As with any file format without a rigid formal specification there is a lot of variation and different edge cases... * * * Surprisingly googling did not turn up any ready made recipes. I'm hoping somebody has something on the shelf:) Of course this is trivial to implement using `BinaryReadList`, so if nobody else answers, I will answer this question myself, there by still making it useful to the community.


Custom setting of HOME and END keys on mac

Is there a way to set the `HOME` and `END` keys on a Mac's keyboard to jump the cursor to the line's beginning and end respectively? I tried to apply a global solution, as suggested for example here, but this didn't help. Is there a way to do it internally in mathematica?


geometric construct in GeoRegionValuePlot doesn't work?

As stated in the documentation of `GeoRegionValuePlot`: > The _reg_ can be Entity objects such as countries corresponding to extended > geographic regions, or geometric constructs with GeoPosition coordinates. However, the code as follows doesn't work:               GeoRegionValuePlot[{GeoDisk[GeoPosition[{48, 5}], 100000] -> 3.4, GeoDisk[GeoPosition[{49, 6}], 200000] -> 5.4}, Frame -> True]      result: ![enter image description here](http://i.stack.imgur.com/cCoaz.png) Obviously, _Mathematica_ recognized the GeoDisk as a GeoPosition rather than a geometric construct. Is this a bug? Or is there anything I happened to miss?


3D isosurface plotting

I have a matrix of data of the form of 3 vectors R, Z, M1, M2, M3 ..., cylindric coordinates representing a measurement M of an axisymmetric hypersonic flow at the position R, Z (I don't measure along the theta coordinate).               http://pastebin.com/eDGZaFuT (not enough rep to post the link, sorry)      or get the file directly http://cl.ly/3e0e2M3U313n/download/He%2014K%20HD.pit I have a very nice graph with the ListContourPlot function on which I'm able to do all my calculations. http://cl.ly/image/1430170n1o0u As you can see, the flow is mostly axysymmetric with the core at a precise temperature and well defined boundary layers, and ± values of R give the same X according to my precision of measure. I am interested in plotting a pseudo-4D graphic, that would make several semitransparent 3D isosurfaces, for exemple in that case, 3 "cones" corresponding to surfaces `T = 15, T = 14,T = 13` I tried defining function to draw a surface in a 3D polar plot, with a fixed R value (as a first approximation) and theta-inpendant, then combing these with `Show`, but it's not working. I also tried several other methods I found on this site, but I've been unable to make them work (either not what I'm looking for or not applicable because I have a list of points and not a function). I'm debuting in _Mathematica_ , so the following code may seem very ugly (but it works! and it's mine!) ;) Any help in plotting this would be greatly appreciated. Here are my functions to plot the data in 2D so far.               fileimport=Import["~/Downloads/N2 83K.pit","table"];     (* get measure paramters, import data *)     ysteps = Part[fileimport[[2]], 1];     ymin = Part[fileimport[[2]], 2];     δy = Part[fileimport[[2]], 3];     xsteps = Part[fileimport[[3]], 1];     xmin = Part[fileimport[[3]], 2];     δx = Part[fileimport[[3]], 3];     gas = Part[fileimport[[5]][[1]]];     rawdata = Drop[fileimport, 7];     (* generate surfaces,, find core of flow *)     MachMatrix = Transpose[{rawdata[[All, 2]], rawdata[[All, 1]],rawdata[[All, 4]]}];      TemperatureMatrix = Transpose[{rawdata[[All, 2]], rawdata[[All, 1]], rawdata[[All,5]]}];     DensityMatrix=Transpose[{rawdata[[All, 2]], rawdata[[All,1]],rawdata[[All,7]]*10^16}];     Flowmatrix = {TemperatureMatrix, DensityMatrix, MachMatrix};     Findcore[row_] := (Abs[row[[2]]] < .03);     (* user parameters for plot *)     inter = 1;     ratio = 2/3;       size = 800;     (* plotmap makes the 2D plot of map parameter matrix *)     plotmap[map_] :=        ListContourPlot[Flowmatrix[[map]],          ColorFunction -> ColorData["TemperatureMap"], PlotLegends -> Automatic,          GridLines -> {Table[m, {m, xmin, xsteps, δx}], Table[n, {n, ymin, ysteps, δy}]},          InterpolationOrder -> inter, AspectRatio -> ratio,          ImageSize -> size, Contours -> 200, ContourStyle -> None,          Method -> {"GridLinesInFront" -> True}]     TabView[{"Temperature" -> plotmap[1], "Density" -> plotmap[2], "Mach" -> plotmap[3]}]      I have more functions to compute other properties of the flow, but that's the graph I would like to obtain the surfaces from.


What is wrong with my simple plot?

What is the problem with plotting the imaginary part of this equation?                s = {y[x]^4 - I0 .03 y[x]^3 - 0.0196 y[x]^2 + I 0.03 y[x] - x^2 +       16 == 0};      sol = Solve[s, y[x], x];      Plot[Evaluate[Im[y[x]] /. sol], {x, 0, 1}]


Manipulate and OpenerView

I have discovered a problem with `OpenerView`. My opener views always close when I change the value of the manipulator control in my `Manipulate`. A simple example:               Manipulate[       Column[        {OpenerView[{"plot1", Panel@Plot[x^2, {x, -10, 2}]}, False],          OpenerView[{"plot2", Panel@Plot[x^2 + 3 x, {x, -10, 2}]}, False],          Plot3D[Sin[ n x y], {x, -2, 2}, {y, -2, 2}]}],      {n, 1, 10, 1}]      ![enter image description here](http://i.stack.imgur.com/fdkYf.jpg) I tried the option `ContentSize` in the `Manipulate` and `ImageSize` in the `OpenerView`, but both failed. My question is what options do I need to add to make the interface to keep the state of the opener views unchanged when I change the value of the slider for `n`?


How to create these famous surfaces in topology with the desired color effects?

It was said such real objects of famous topological surfaces were plotted by the cooperation between mathematician Richard Palais and artist Luc Benard, and published as the cover page of _Science_ magazine (issue on Sept 22 in 2006): The cover page of _Science_ , Sept 22, 2006 Comments by Rachel Thomas ![enter image description here](http://i.stack.imgur.com/ijaGb.jpg) How to create such surfaces with the same color, rendering, lighting and opacity effects via Mathematica? ( **answers with only similar rendering results for these surfaces one by one are also acceptable if the same rendering effects as the samples are too difficult to realize** ) Another similar question with anwser can be seen from this link: another topological surface example with answer **Surface information are** : Klein bottle; symmetric 4-noid; breather surface; Boy surface; Sievert-Enneper surface. It was said these surfaces in the figure were created via 3D-XplorMath software. **EDITS:** unfortunately it is voted as `on hold`; but I personally believe Mathematica's rendering should be powerful enough to realize such effects( at least more powerful than the open source 3D-XplorMath The author on MathOverflow); Here I add two of the surfaces obtained and rendered which are already good enough; There are documents on these surfaces from this link: documents on surfaces There are five different surfaces; I have found four of them; but only three as below look beautiful; so I will not post others here; ![Klein bottle](http://i.stack.imgur.com/toktc.gif) ![breather surface](http://i.stack.imgur.com/pN8qv.gif)               Clear["Global`*"]; (* Sievert-Enneper surface *)     \[Phi] := -u/Sqrt[c + 1] + ArcTan[Tan[u] Sqrt[c + 1]]     a := 2/(c + 1 - c Sin[v]^2 Cos[u])     r := a Sqrt[(c + 1) (1 + c Sin[u]^2)] Sin[v]/Sqrt[c]     Clear[x, y, z, p]; p =       ParametricPlot3D[{x = r Cos[\[Phi]] - 2, y = r Sin[\[Phi]],          z = ((Log[Tan[v/2]] + a (c + 1) Cos[v])/Sqrt[           c])} /. {c -> .4}, {u, -Pi/2, Pi/2}, {v, 0, Pi},        PlotPoints -> {30, 30},        PlotStyle ->         Directive[Opacity[0.65], LightPurple, Specularity[White, 20]],        Mesh -> None, RegionFunction -> Function[{x, y, z}, Abs[z] < 2.2],        Axes -> False, Boxed -> False]      ![Sievert-Enneper surface](http://i.stack.imgur.com/RgjH3.gif)


Dramatic increase in memory consumption and performance drop with ParallelMap

Consider the following toy problem:               Q = 10^9;     A = Table[RandomInteger[10], {Q}];     Developer`PackedArrayQ@A     B = Map[N[Sin[#]] &, A]; // AbsoluteTiming     Developer`PackedArrayQ@B     MemoryInUse[]     MaxMemoryUsed[]          True     {105.901936, Null}     True     16022521160     24022519456      But using ParallelMap even with custom memberQ gives the following:               Q = 10^9;     A = Table[RandomInteger[10], {Q}];     Developer`PackedArrayQ@A     withModifiedMemberQ[expr_] :=        Module[{doneQ, unmatchable},         Internal`InheritedBlock[{MemberQ}, Unprotect[MemberQ];         (*Can uncomment this if we want to print out the MemberQ calls:mq:         MemberQ[args___]/;(Print@HoldForm[mq];True):=mq;*)         MemberQ[list_, patt_Symbol, args___] /; ! TrueQ[doneQ] :=           Block[{doneQ = True},            MemberQ[Unevaluated[              list] /. _List?Developer`PackedArrayQ -> {unmatchable},             Unevaluated[patt], args]];         Protect[MemberQ];         expr]];     SetAttributes[withModifiedMemberQ, HoldAllComplete];     B = withModifiedMemberQ@         ParallelMap[N[Sin[#]] &, A]; // AbsoluteTiming     Developer`PackedArrayQ@B     MemoryInUse[]     MaxMemoryUsed[]          True     {533.782398, Null}     True     24027869336     48030873944      We see: 5x drop in performance, 2x increase in max memory usage. Why is it happening? How can it be avoided, while keeping the computation parallelized? Edit: the code of the real life example can be found here. Same problems observed.


Hashing by Equals instead of SameQ

I have some numerical code involving complex numbers representing points on a plane. Some of these are equal but not identical, ie > >     {Exp[2 Pi I (-1./10)], ..., Exp[2 Pi I (9./10)]} >   I want to make (the equivalent of) a dictionary mapping each to its coordinate in the list (because using Position repeatedly would take too long). But both Downvalues and matching rules (with a Dispatch table) match based on the form of the expression rather than its value (and Hash hashes based on the form of the expression as well).   Eg, if > {a == b, a===b}   >  ==> {True, False}   >  then > > f[a] = 1; {f[a], f[b]}   >  {1, f[b]} Is there some way to associate the points with their position (with faster than O(n) lookup) based on their value? I feel like there should also be some way to do it using rounding, but I haven't gotten it to work.


Plot differential equation system in a complex way

Based on this differential equation system: $$\begin{align*} \dot{x}&=f(x,y)\\\ \dot{y}&=g(x,y) \end{align*}$$ where $$\begin{align*} f(x, y)&=x^2+y^2-25\\\ g(x, y)&=x^2-y^2-7 \end{align*}$$ I have to show how these two differential equations (I've named them `xdot` and `ydot`) when they are equal $0$. I have to show with arrow symbols like on this picture: ![the correct painting](http://i.stack.imgur.com/9Wvd7.png) The closest to the picture is this plot with lane curves. However I must show it with arrows like i have on the picture. Is this possible in Mathematica, if yes, how?               Clear[x, y, xdot, ydot, curves, zerocurves, specielarrows]     xdot = x^2 + y^2 - 25;     ydot = x^2 - y^2 - 7;     xmin = -6;     xmax = 6;     ymin = -6;     ymax = 6;     curves = 30;     specielarrows = {{{6, 0}, Directive[Orange, Thick]}};     {Append[specielarrows, curves]};          (* plots *)     zerocurves =       ContourPlot[{xdot == 0, ydot == 0}, {x, xmin, xmax}, {y, ymin, ymax},        ContourStyle -> {Directive[Red, Thick], Directive[Blue, Thick]},        Frame -> False, Axes -> True, AxesLabel -> {x, y}]                 lanecurves =       VectorPlot[{xdot, ydot}, {x, xmin, xmax}, {y, ymin, ymax},        StreamPoints -> {Append[specielarrows, curves]},        StreamStyle -> Green, VectorStyle -> Black, Axes -> True,        Frame -> False, AxesLabel -> {x, y}]          Show[zerocurves, lanecurves]


How to Print to the Console

**Background:** Using the settings under Edit-> Preferences->Evaluation I can redirect all the Print statments to the console. ![Settings dialog](http://i.stack.imgur.com/IEWWC.png) What I'd really like to do is redirect just some specific `Print` statements to the console. I know I can print to another notebook with something like:               PrintToNotebook[nb_, expr_] := (         SelectionMove[nb, After, Cell];         NotebookWrite[nb, Cell[BoxData[ToBoxes[expr]], "Print"]])       So perhaps this boils down to finding the "Console Handle"? **Question: How can I create a function (eg`PrintToConsole`) that behaves like `Print` but outputs to the console?** **EDIT** Turns out the trick is in `MessagesNotebook[]`. This is what I'm currently using               ClearAll[PrintToConsole]     $OldLine = -1;         PrintToConsole[            expr_] := (SelectionMove[MessagesNotebook[], After, Cell];            NotebookWrite[MessagesNotebook[],              Cell[BoxData[ToBoxes[expr]], "Print",               CellLabel ->  "During evaluation of In[" <> ToString@$Line <> "]:=",           ShowCellLabel -> ($OldLine =!= $Line)]];        $OldLine = $Line;);     PrintToConsole[        expr__] := (SelectionMove[MessagesNotebook[], After, Cell];        NotebookWrite[MessagesNotebook[],          Cell[BoxData[ToBoxes[Row@{expr}]], "Print",           CellLabel -> "During evaluation of In[" <> ToString@$Line <> "]:=",              ShowCellLabel -> ($OldLine =!= $Line)]];            $OldLine = $Line;);


Preserving indentation when creating a new line (when editing in a package)

**Background:** This is the third question in a row of questions about how to make editing packages in the front-end much more bearable (the other two are here and here). It seems that the front end is quite extensible, so I may not have to start using Workbench yet :) When writing long blocks of code, proper indentation is invaluable. This is why most programming editors preserve the white space indentation when you enter a new line. So if you have three white spaces at the current line and press `Enter` to move to a new line, it will also have three white spaces. ![Example image](http://i.stack.imgur.com/Xm8wC.png) So my question is: **Is there a way to make the front-end preserve the white space indentation (when editing a package)?**


Using Manipulate Feature for Two ODE's

So I have not been able to find any examples of the Manipulate feature for two ODE's. I would like to plot a graph of x[t] vs. y[t] and manipulate the initial conditions, v and theta. Thank you very much for any help you can offer.               k=.313     g=9.81;     NDSolve[{x''[t] == -k x'[t] Sqrt[y'[t]^2 + x'[t]^2],      y''[t] == -k y'[t] Sqrt[y'[t]^2 + x'[t]^2] - g, x[0] == 0,      y[0] == 0, x'[0] == v Cos[theta], y'[0] == v Sin[theta]}, {x,      y}, {t, 0, 10}]


InputField does not update correctly

By fiddling with Vitaliy's solution for a small GUI, I've come accross this particular behaviour of `InputField`:               y = Null;     {InputField[Dynamic[y], String, ContinuousAction -> True],      InputField[Dynamic[y], Boxes, ContinuousAction -> True],      InputField[Dynamic[y], Expression, ContinuousAction -> True],      Dynamic@y}      While the first two fields update correctly as the user interacts with them (updating withouth hitting `Enter` or clicking outside of the `InputField`), the third one does not. Furthermore:               y = Null; x = False;     Column@{       InputField[Dynamic[y, (y = #; x = (# === "123")) &], String, ContinuousAction -> True],       InputField[Dynamic[y, (y = #; x = (# === 123)) &], Boxes, ContinuousAction -> True],       Dynamic@x       }      Typing `123` into the first field immediately yields `True`, but the same action with the second field does not work. Is it a bug or am I missing something?


How to plot complex values given by Solve

# Update               Solve[N[Table[BernoulliB[n, z], {n, 10, 10}] == 0]]      > >     {{z -> -0.5841145496910024` - 0.435309007896589` I}, <<4>>} >   I am then finding and replacing `z ->` with blank to get : > >     {{-0.5841145496910024` - 0.435309007896589` I}, <<4>>} >   I am then finding and replacing `` I}` with `}` to get : > >     {{-0.5841145496910024`-0.435309007896589}, <<4>>} >   I am then finding and replacing `'` with `,` to get : > >     {{-0.5841145496910024, -0.435309007896589}, <<4>>} >   **My question is** , is there a way of doing this without all of the find & replace business? * * * # Old I am generating a list from :               Solve[N[Table[BernoulliB[n, z], {n, 100, 100}] == 0]]      And then manually finding and replacing elements in the generated list such as `z ->` with `Blank`, then finding and replacing `, I}` with `}`, and so on. I am then producing a list plot form the resultant array. Is there a way of automating this process and producing a list plot directly?


How to specify DataRange in a ListPlot with an imported set of data

So I've been trying to import a large set of data (6900 point pairs) from an excel (.xls) file. The Exel file has 2 columns of numeric data. I've also been trying to plot this data, but when I do, it won't allow me to alter my DataRange. Here is a simplified version of my code:               Subscript[Elliptical\[ScriptCapitalL], \[Nu]] =       Import["EllipticalGalaxy.xls"][[3]]          ListPlot[Subscript[Elliptical\[ScriptCapitalL], \[Nu]],       DataRange -> {0, 10000}]      Actually, no matter which DataRange I specify, this will not alter the plot (i.e. the default way it is plotting doesn't even include all my points). My fix for this was to use PlotRange, instead, which actually works, **UNLESS** I use ListLogLinearPlot (or ListLogLogPlot, or ListLogPlot). Here is another sample of my code when I replace ListPlot with ListLogLinearPlot:               ListLogLinearPlot[Subscript[Elliptical\[ScriptCapitalL], \[Nu]],       PlotRange -> {{0, Log[10000]}, {0, 1}}]      This will alter the range of the plot, but not the domain... My 2 questions are: 1) Why won't DataRange work? 2) Why won't PlotRange work for the logarithmic axis?


Command to Show Full Output

I have some rather long output from a notebook I run on a remote server. There is a time limit on processes so I typically do `NotebookSave[]` after any important result. However, some of these results are truncated. I would like to force these (and only these) results to be fully expanded before the notebook saves. I am aware of the `Short` command and the option in preferences to define the maximum byte size of output. However, I really do not know how large (in bytes or lines) the output is going to be. (Yes, I could experiment but it seems like there should be an easier way.) I tried `Short[%,Infinity]` but that didn't work. Any thoughts?


Switching the plot variable when plotting a two-variable function as a single variable function with a parameter

I would like to make easy to change the variable for which I am making a set of plots. Say I want to plot Sin, Tan, Cos and other functions of the same argument. To quickly switch from plotting it as function of x or y I wanted to use a "dummy" plot variable var and assing it to y or x depending on the need.               x = 1; var = y;     Plot[Sin[x*y], {var, 1, 2}]     Plot[Tan[x*y], {var, 1, 2}]     Plot[Cos[x*y], {var, 1, 2}]     Unset[{x, y, var}];      Unfortunately this doesn't quite works because `var` in the range specification `{var,1,2}` is not evaluated. Any suggestions?


Can Manipulate controls have the option Appearance -> "Labeled" by default?

I was wondering if there's a way to tell Mathematica to use the option `Appearance -> "Labeled"` for all `Manipulate` commands by default. I use this option quite often and it would be very convenient if I could set it to be the default behaviour


Create sine function with random increase in phase

I am trying to simulate a signal that randomly increases its phase, so far I have tried two thing but neither worked. I usually use matlab but I want to learn some _Mathematica_ so I thought I would try this in _Mathematica_. My first try was               times = Table[i, {i, 0, 2, 0.05}];     function[source_, t_][fiIN_] :=          With[{fi = fiIN + 0.01*RandomReal[]},source*(1 + Sin[2 Pi*t + fi])];      Where I wanted to feed `fi` back into `fiIN` for each subsequent `t` value (in the list `times`). I did not know how to makes this work though so I went on with my second try:               fiupdate[fi_] := fiupdate[fi - 1] + 0.01*RandomReal[];      fiupdate[1] = 0;     fitimes = Range[Length[times]];      However this function does not remember the value of `RandomReal[]` for the earlier steps, so `fiupdate[10]` could be smaller than `[9]` or `[8]`. Also when using this function I get an error:               fis = fiupdate[fitimes];     $RecursionLimit::reclim: Recursion depth of 1024 exceeded      Im not sure how to make this work. Any help is appreciated. Thank you!


To how many terms must you compute the Taylor series of sin in order to make sure that it approximates the value of sin to within $10^{−32}$ anywhere on the real line. My attempt:$$Let\;f(x)=\sin(x),\;and\;let\;P_{k,c}\;represent \;the\;first\;k\;terms\;of\;the\;Taylor\;Series\;expansion\;of\;\sin(x)\;about\;the\;point\;x=c.\;Then\;by\;Taylor's\;Theorem:\\\|f(x)-P_{k,c}|=\left|\frac{f^{(k+1)}(y)(x-c)^{k+1}}{(k+1)!}\right|\;for\;some\;y\in(c,x)\\\\\implies|f(x)-P_{k,c}|<\left|\frac{(x-c)^{k+1}}{(k+1)!}\right|<10^{-32}\quad \forall\;k>n\;for\;some\;n\in\mathbb{N}$$ But how do I find the value of $n$ without resorting to brute force calculation. Please help.


Function or script which maxes out the CPUs?

I've been using Mathematica for awhile now and have never come even close to maxing out my CPU cycles. Are there any functions which consume lots of CPU cycles? Right now I am running a script which uses Parallelize and is consuming about 15%. Also, a related question -- is there any way to get Mathematica to use more CPUs? It'd be nice to get to my answers faster.


Performing operations on function lists

I am exploring the use of `Dynamic` variables for the `ViewPoint` and `ViewVertical` options in a `Graphics3D` object. I have the following code:               vp = {0, -5, 0}     vv = {0, 0, 1}     (* Cell break here to make changes in vp and vv a bit easier *)     img = Graphics3D[{Yellow, Cuboid[{0, 0, 0}, {1, 3, 1}], Blue,        Cuboid[{2, 1, 1}, {4, 2, 3}]}, SphericalRegion -> True,        Lighting -> "Neutral", ViewPoint -> Dynamic[vp],       ViewVertical -> Dynamic[vv]]     (* Another cell break, but hopefully making cut and paste easier by adding comments *)     {ViewVertical, ViewPoint} /. AbsoluteOptions[img]      There are two things that bother me:   1. The `AbsoluteOptions` line throws an error ViewPoint::nlist3 is not a list of numbers. I presume this is because the `Head` of vp is `Dynamic`. This error isn't thrown for ViewVertical, however, which I would expect should complain as well. Am I missing something, or can the `ViewVertical` error be safely ignored? (I don't like quieting errors for fear of covering up something later on down the line.)    2. Because of the dynamic head, operations on vv and vp require a bit of manipulation. For example, in the next bit of code, the first line doesn't work and the second line does, but obviously the dynamic evaluation has been lost: .               Norm[ViewVertical /. AbsoluteOptions[img]]     Norm[(ViewVertical /. AbsoluteOptions[img]) /. {Dynamic -> List}]      Again, I worry about my hack to change Dynamic into a List isn't the most elegant (or safe) way to gain access to these values. Furthermore, I envision wanted to maintain the Dynamic nature of the data manipulation. Any suggestions would be welcome. P.S. I have looked here for some guidance, and while helpful in framing the picture, I'm still a bit confused with the use of Dynamic in this case.


How to pop out of a subsection in a notebook

Let's say I have a section in a notebook, which I begin with a `cmd-4` keystroke. I type in some text and expressions, and now I want to introduce a subsection for some subordinate material. I type a `cmd-5`, write a title, build up my stuff, and now I want to pop out or "return" to the main stream of the section ("back to our regularly scheduled programming"). But I don't see a way to do that. The subsection fold-bars (on the right-hand side of the notebook display) seems to continue to the very end of the section or to the beginning of the following peer subsection. To close off the subsection, it seems I must create a new subsection.


how to generate repeatable Unique streams?

I need to label some data in arbitrarily nested ragged lists, with a stream of unique labels. It's very convenient if the labels are consecutive integers, starting at 0 or 1, and if I can produce the same stream every time I label a given data set. I can do this with recursive functions that thread around the current label in the parameter list and conventionally in every output (say the first element in a list, by convention; this is essentially an explicit simulation of the state monad of Haskell). It's cumbersome and ugly, so I'm looking for a better solution. `Unique` comes close to fitting the bill. In a fresh kernel, MMA version 9.0.1 on Mac 10.8.4, consider the following               Table[Unique[],{3}]           {$3, $4, $5}      Great. Let's try starting them at 1, following the documentation,               $ModuleNumber = 1;      Table[Unique[], {3}]          {$6, $7, $8}      Ooops, surprise! The following, which was my first attempt, produces an internal ENULL bugcheck               Block[{$ModuleNumber = 1},      Table[Unique[], {3}]]          Mathematica has detected an internal error:       vMessage ENULL          Please report this error as soon as possible to     support@wolfram.com giving as many details as possible     of the circumstances under which it occurred.      I can mimic the entire thing with my own global state variable and mimic of `Unique`, but thought I'd first check here for insight and advice.


Hierarchical clustering: convert Mathematica cluster hierarchy to NEWICK format

Can anyone tell me a clever way to convert the hierarchical clustering object, created, say, by `Agglomerate` or `DirectAgglomerate` (of the built-in hierarchical clustering package) to the so-called Newick (or New Hampshire) format used in biology? It would convert               Cluster[Cluster[     Cluster["A", Cluster["H", "J", 1.52217, 1, 1], 28.8538, 1, 2],      Cluster[Cluster["C", "E", 10.1371, 1, 1], "D", 22.0063, 2, 1],             47.1129, 3, 3], Cluster[Cluster["B", Cluster["G", "I", 2.5374, 1, 1],            5.73533, 1, 2],"F", 13.6197, 3, 1], 64.5168, 6, 4]          to               (((A:28.85378,(H:1.52217,J:1.52217):27.33162):18.25912,      ((C:10.13706,E:10.13706):11.86925,D:22.00630):25.10660):17.40389,      ((B:5.73533,(G:2.53740,I:2.53740):3.19793):7.88433,F:13.61966):50.89713)      the latter composed of branch lengths rather than nodal abscissae.


Specific initial sample points for 3D plots

`PlotPoints` lets you determine _how many_ sample points you want in each direction, but sometimes I want specific ones. For `Plot` you can give an argument like `PlotPoints->{None, pts}` to use `pts` as the initial points:               Show[      Plot[Sin[x], {x, -3 Pi, 3 Pi},       PlotStyle -> Red,       MaxRecursion -> 0,       PlotPoints -> {None, {-7.3, -5.2, -Pi, Pi, 3.8, 5}},       PlotRange -> {{-3 Pi, 3 Pi}, {-1, 1}}],      Plot[Sin[x], {x, -5 Pi, 5 Pi},PlotStyle -> Dashed]      ]      ![custom samples](http://i.stack.imgur.com/jks1N.png) Is this also possible for `Plot3D`? Whatever I try I end up with completely broken plots, anyone know the syntax of what I have stumbled into? **EDIT** `PlotPoints->{Automatic,pts}` seems to work, although about 2x as many points are used.               f[x_, y_] := Cos[y]^3 Sin[x]^2 + Cos[x] Sin[y]     pts3d = Reap[Plot3D[f[x, y], {x, -5, 5}, {y, -5, 5},                         EvaluationMonitor :> Sow[{x, y}]]][[-1, 1]];     opts = {{Automatic, "Automatic"},             {{None, pts3d}, "{None, pts3d}"},             {{Automatic, pts3d}, "{Automatic,pts3d}"},             {{Automatic, RandomReal[{-5, 5}, {5000, 2}]}, "{Automatic,Random}"}             };     Row[Plot3D[f[x, y], {x, -5, 5}, {y, -5, 5},         PlotPoints -> First@#,         PlotLabel -> Last@#,         ImageSize -> 200] & /@ opts]      ![plot](http://i.stack.imgur.com/ysmCN.png) Here are three plots with exactly the same points that look different:               {orig, {origpts}} = Reap[DensityPlot[f[x, y], {x, -5, 5}, {y, -5, 5},         EvaluationMonitor :> Sow[{x, y}]]];     {auto, {autopts}} = Reap[DensityPlot[f[x, y], {x, -5, 5}, {y, -5, 5},         PlotPoints -> {Automatic, RandomSample[origpts]},         MaxRecursion -> 0,         EvaluationMonitor :> Sow[{x, y}]]];     {none, {nonepts}} = Reap[DensityPlot[f[x, y], {x, -5, 5}, {y, -5, 5},         PlotPoints -> {None, RandomSample[origpts]},         MaxRecursion -> 0,         EvaluationMonitor :> Sow[{x, y}]]];          (* All give {} *)     DeleteCases[origpts, Alternatives @@ autopts]     DeleteCases[autopts, Alternatives @@ origpts]     DeleteCases[nonepts, Alternatives @@ origpts]          {orig, auto, none}      ![same but different](http://i.stack.imgur.com/lfuoG.png)


Error from BoundedDiagram

I cannot understand the meaning of the error > BoundedDiagram::notuniq: BoundedDiagram requires that boundary vertices lie > in unique Voronoi polygons. >> > > BoundedDiagram::nobd: Bounded diagram failed. >> When I try to run the following code, it gives me the above error.               Needs["ComputationalGeometry`"]     Boundary = {{-2, 2}, {2, 2}, {2, -2}, {-2, -2}};     points = {{-1, 0}, {1, 0}, {1, 1}};     BoundedDiagram[Boundary, points]     DiagramPlot[points]      Is it a problem with the code? Have i misunderstood `BoundedDiagram`? What I have posted here is a simplified situation. I am using more points in real work.


How can automatic ticks be made "outie"?

By default, `FrameTicks` stick into the data area in a way that is sometimes uncomfortable.               Plot[Cos[x], {x, 0, 10}, Frame -> True]      ![enter image description here](http://i.stack.imgur.com/YrX0O.png) I see that I can create "outie" ticks manually using               Plot[      Cos[x], {x, 0, 10}, Frame -> True,       FrameTicks -> {{{0, 0, {0, 0.01}}, {Pi, Pi, {0, .01}}, {2 Pi, 2 Pi, {0, 0.01}}, {3 Pi, 3 Pi, {0, 0.01}}}, {{-1/2, -1/2, {0, 0.01}}, {1/2, 1/2, {0, 0.01}}}, None, None}     ]      ![enter image description here](http://i.stack.imgur.com/KtZo1.png) But I want to use the automatic tick positions, sizes and labels. I can (kind of) achieve this so:               With[      {originalPlot = Plot[Cos[x], {x, 0, 10}, Frame -> True]},      Show[originalPlot,        FrameTicks -> AbsoluteOptions[originalPlot, FrameTicks][[1, 2]] /. {a_, b_, {c_, d_}, e___} :> {a, b, {d, c}, e}]      ]      ![enter image description here](http://i.stack.imgur.com/IfSU4.png) There are (at least) three problems with this approach:   1. Extra vertical-axis tick labels have been inserted; all vertical-axis ticks appear to have been converted to minor ticks.   2. Trailing decimal points have been added to the integer tick labels.   3. `FrameStyle` no longer affects the ticks, apparently because the `ReplaceAll` solution hardcodes the `FrameTicks` style before `FrameStyle` is applied: An example of correct application of `FrameStyle` (with default, "innie" ticks):               Plot[Cos[x], {x, 0, 10}, Frame -> True, FrameStyle -> Gray]      ![enter image description here](http://i.stack.imgur.com/IWfGW.png) An example of broken application of `FrameStyle`:               With[      {originalPlot = Plot[Cos[x], {x, 0, 10}, Frame -> True, FrameStyle -> Gray]},      Show[originalPlot,        FrameTicks -> AbsoluteOptions[originalPlot, FrameTicks][[1, 2]] /. {a_, b_, {c_, d_}, e___} :> {a, b, {d, c}, e}]     ]      ![enter image description here](http://i.stack.imgur.com/HsbXo.png) How can this approach be improved to address these problems?


How to change the aspect ratio with drawing tool?

I'm drawing an image in editing an slide show with the drawing tools. But the aspect ratio of the created drawing seems fixed and not changeable with mouse dragging the border and corner as in other applications. How can I change this ratio?


Why does this pattern with Plus not work for numbers?

I have a very simple question about redefining basic built-in functions, such as `Plus`. I'm pretty sure someone must have asked a similar question around here, but I couldn't find one. Consider the following code:               Unprotect[Plus];     x_ + y_ := x y     Protect[Plus];      For symbols this works as expected:               x+y     (* ---> x y *)      For numbers, however, the new definition does not work:               1+2     (* ---> 3 *)      Of course I know that it is stupid to use something like this and that defining functions or using upvalues etc. is the way to go here, but I'm really interested in why this happens. Can the pattern for `Plus` be defined in such a way that it works for numbers as well? Is `Plus[1,2]` evaluated internally _before_ the pattern can be matched?


How to add fill color to a 2D Graphics object?

Problem / background: consider the following code snippet.               pnt[fig_, n_] := {fig[[1, n]], fig[[2, n]]}     hor := {.025, .1, .25, .4, .475, .525, .6, .75, .9, .975}     ver := {.05, .20, .80, .95}     fig4 := Transpose[{        {hor[[1]], ver[[2]], 1}, {hor[[2]], ver[[1]], 1}, {hor[[4]],          ver[[1]], 1}, {hor[[5]], ver[[2]], 1},        {hor[[1]], ver[[3]], 1}, {hor[[2]], ver[[4]], 1}, {hor[[4]],          ver[[4]], 1}, {hor[[5]], ver[[3]], 1},        {hor[[6]], ver[[2]], 1}, {hor[[7]], ver[[1]], 1}, {hor[[9]],          ver[[1]], 1}, {hor[[10]], ver[[2]], 1},        {hor[[6]], ver[[3]], 1}, {hor[[7]], ver[[4]], 1}, {hor[[9]],          ver[[4]], 1}, {hor[[10]], ver[[3]], 1},        {hor[[3]], ver[[2]], 1}, {hor[[3]], ver[[3]], 1},        {hor[[8]], ver[[2]], 1}, {hor[[8]], ver[[3]], 1}        }]     draw4A[fig_] := {       BezierCurve[{pnt[fig, 1], pnt[fig, 2], pnt[fig, 3], pnt[fig, 4]}],       BezierCurve[{pnt[fig, 5], pnt[fig, 6], pnt[fig, 7], pnt[fig, 8]}],       BezierCurve[{pnt[fig, 9], pnt[fig, 10], pnt[fig, 11], pnt[fig, 12]}],       BezierCurve[{pnt[fig, 13], pnt[fig, 14], pnt[fig, 15],          pnt[fig, 16]}],       Line[{pnt[fig, 1], pnt[fig, 4]}],       Line[{pnt[fig, 5], pnt[fig, 8]}],       Line[{pnt[fig, 9], pnt[fig, 12]}],       Line[{pnt[fig, 13], pnt[fig, 16]}]}     Graphics[draw4A[fig4]]      which draws four half-pie type of objects: ![enter image description here](http://i.stack.imgur.com/iC6N8.png) Question: I want to fill each part with a different, optional color different than that of the surrounding line. **How can I add this fill color?**


Recursive Integration

I'd like to evaluate the following recursive integration using _Mathematica_ $$ \ M(T) = \int_0^T\int_0^\infty e^{-\delta s}g(x,s)dxds\ +\int_0^T e^{-\delta s}f(s)M(T-s)ds\, $$ where $g(x,s)$ and $f(s)$ are statistical probability density functions. Since it's a recursive function, the initial condition is given by $M(0) = 0$. For simplicity we can assume $f(s)$ to be an exponential PDF and $g(x,s)$ to be a Farlie–Gumbel–Morgenstern Copula PDF. I am not interested in the closed form solution of $M(T)$, rather I am interested only in its numerical answer. This is what I've tried so far:               FGMExpExp = Exp[-2 (s + 10 x)] (36. - 18. Exp[s] + Exp[10 x] (-18.  + 19. Exp[s]));     Delta = 0.04; a = 10; b = 1;      M[0] = 0; (* Initial Condition *)          Mu[T_] := Mu[T] = NIntegrate[Exp[-Delta*s]*x FGMExpExp, {x, 0, 1.05}, {s, 0, T}] +          NIntegrate[b Exp[-(Delta + b)*(T - s)] Mu[s], {s,0, T}]   (* Defining the integration *)     Mu[1] (* The quantity we are interested in. Will change T=1 to T=5 later *)      Your help is greatly appreciated.


Why changing list's head takes time?

Consider               AbsoluteTiming[Range[10^7];][[1]]      > 0.035000 and               AbsoluteTiming[HoldComplete @@ Range[10^7];][[1]]      > 0.725000 Why it takes twenty times longer to change head than to create a list? Since `HoldComplete` doesn't evaluate arguments one would think that head changing should be fast.


I can't Plot the equation -(π/4) + x - 1/2 Sin[2 x] == 0

I'm starting with _Mathematica_ and I can't solve numerically the equation               -(π/4) + x - 1/2 Sin[2*x] == 0      using `NSolve` as well as I can't plot it correctly because when I do               eqn1 = x - (Sin[2*x]/2) - (Pi/4) == 0     Plot[eqn1, {x, -2, 2}]      it shows an empty window with nothing more than just the x and y axis.


Inverse of a polynomial in a polynomial ring

Let $N$ be a prime, and $q$ be a positive integer. Given a polynomial $f(x)$ in $R = \mathbb Z[x]/(x^N-1)$, I want to find another polynomial $f_q(x)$ in $R_q = \mathbb Z_q[x]/(x^N-1)$, such that $$f(x)f_q(x)=1 \pmod q$$ I want _Mathematica_ to tell me   1. whether the inverse polynomial $f_q(x)$ exists; and   2. if so, find $f_q(x)$. > Examples for $N=11$ and $q=32$ are cited from Wikipedia's entry on > NTRUEncrypt: > > $f(x) = -1 + x + x^2 - x^4 + x^6 +x^9 - x^{10}$ > > $f_q(x) = 5 + 9x + 6x^2 + 16x^3 + 4x^4 + 15x^5 + 16x^6 + 22x^7 + 20x^8 + > 18x^9 + 30x^{10}$


How can I efficiently ArrayFlatten a matrix of sparse matrices?

I have a matrix of sparse matrices that I want to convert to a sparse block matrix. So, basically I want what `ArrayFlatten` does, except that I want the output to be sparse. So e.g.:               sp = SparseArray[{{2, 2} -> 1.}, {50, 50}];     sparseArrayFlatten[      {       {sp, 0},       {0, -sp}       }]      should return `SparseArray[{{2, 2} -> 1., {52, 52} -> -1., {_, _} -> 0},{100,100}]`. Currently, I use `SparseArray@ArrayFlatten[...]`, but for large matrices, this is inefficient. (Sometimes `ArrayFlatten` _does_ return a sparse array, but I haven't completely figured out when. For example, if I remove the `-` sign above, or if I use `-> 1` instead of `-> 1.`, I get a sparse result.)


Optimizing List Multiplications

I've got a list manipulation optimization problem. Consider a two-dimensional nxm list `list1`, and a three-dimensional nxmxm list, `list2`. Is there a faster way of taking the following product?               Table[list1[[i]].list2[[i]].list1[[i]], {i, 1, length}]      I know that Table operators are notoriously slow, and this seems like there might be a built-in list-manipulation operator to accomplish the same thing, or something very similar.


How to get path and file name of a pasted image?

Say in Documentation Center -> ImageData -> EXAMPLES ->   Basic Examples you find an image of a planetary body (Mars?). Can one obtain the file source for this image wich is copied   into a Mathematica line? The image is originated for shure in   Mathematicas images samples somewhere in its folders.   What I mean however is to get the info rigth from the picture   in that Notebook.


Plotting geodesics of upper half plane

I want to solve (numerically) the geodesics of the upper half plane and plot. The results are quite known (i) straight lines parallel to $y$-axis and (ii) semicircles centered on the $x$-axis. Now the problem is how to solve the coupled ODEs. I tried with `NDSolve` but the results are not coming. Can you please write a code and help me. Here are the coupled ODEs: $$\begin{align*} \ddot{x} &= \frac{2\dot{x}\dot{y}}{y}\\\ \ddot{y} &= \frac{-\dot{x}^2+\dot{y}^2}{y} \end{align*}$$ Thanking you in advance.


Am I missing something in this integral?

I am trying to solve this simple integral:               Integrate[Cos[m*x]*Cos[mp*x], {x, 0, 2 \[Pi]},       Assumptions ->         Element[m - mp, Integers] && Element[m + mp, Integers] &&         m - mp != 0 && m + mp != 0]      which is zero. However, Mathematica gives:               1/2 (Sin[2 (m - mp) \[Pi]]/(m - mp) + Sin[2 (m + mp) \[Pi]]/(m + mp))      Why?, any tip? Thanks


How to provide data to users in a way similar to Mathematica's curated data

How can one go about implementing a custom data backend usable by _Mathematica_? For example something like `CountryData` or `FinancialData`? I would like to expose our data backend as a service with similar access logic used in the above mentioned data libraries.


How can I obtain the complex root of an equation with FindRoot

I want to obtain the complex roots of some equations that are similar,but each of them has a different condition. this difference is the value of `α` in these equations. When I try to obtain the complex roots, just the real part is close to correct value, but the imaginary part is identical for all of the equations, and an error message was returned every time. What is the reason for this? The coding has many special characters and fancy formatting, making it hard to post my code here, so I have posted images. The images show the main equation with `α = .1` and the results for `α = .1` `α = .2` and `α = .3`, respectively, and the error message I got. Here are the images: ![enter image description here](http://i.stack.imgur.com/oj957.png) ![enter image description here](http://i.stack.imgur.com/WE2Vu.png) ![enter image description here](http://i.stack.imgur.com/YzLGc.png) And here is the code:                Subscript[j, ν, 1][s_] = s*(SphericalBesselJ[0, s]) - 1*(SphericalBesselJ[1, s])      Subscript[j, 1][s_] = SphericalBesselJ[1, s]      Subscript[n, ν, 1][s_] = s*(SphericalBesselY[0, s]) - 1*(BesselY[1, s])      Subscript[n, 1][s_] = SphericalBesselY[1, s]      Subscript[h, 1][s_] = SphericalBesselJ[1, s] + I*(SphericalBesselY[1, s])      Subscript[h, ν, 1][s_] =         s*(SphericalBesselJ[0, s] + I*(SphericalBesselY[0, s])) -         1*(SphericalBesselJ[1, s] + I*(SphericalBesselY[1, s]))      α = .1      β = .95      Subscript[u, B][w_] =         .10114688*Sqrt[5.59` + 0.031098192`/((3.30216`- 0.000049206` I) - w)]      Subscript[u, C][w_] = .10114688* w Sqrt[3.7` - 81/((0. + 0.01728` I) w + w^2)]      Subscript[u, A][w_] = .10114688*Sqrt[1.777]*w      Subscript[u, D][w_] = .10114688*w           FindRoot[Det[{        {Subscript[j, 1][α Subscript[u, D][w]], -Subscript[j, 1][α Subscript[u, C][w]],          -Subscript[n, 1][α Subscript[u, C][w]], 0, 0, 0},         {((Subscript[u, C][w])^2)*Subscript[j, ν, 1][α Subscript[u, D][w]],          -((Subscript[u, D][w])^2)*Subscript[j, ν, 1][α Subscript[u, C][w]],          -((Subscript[u, D][w])^2)*Subscript[n, ν, 1][α Subscript[u, C][w]],          0, 0, 0},         {0, Subscript[j, 1][β Subscript[u, C][w]], Subscript[n, 1][β Subscript[u, C][w]],          -Subscript[j, 1][β Subscript[u, B][w]], -Subscript[n, 1][β Subscript[u, B][w]], 0},         {0, ((Subscript[u, B][w])^2)*Subscript[j, ν, 1][β Subscript[u, C][w]],          ((Subscript[u, B][w])^2)*Subscript[n, ν, 1][β Subscript[u, C][w]],          -((Subscript[u, C][w])^2)*Subscript[j, ν, 1][β Subscript[u, B][w]],          -((Subscript[u, C][w])^2)*Subscript[n, ν, 1][β Subscript[u, B][w]], 0},         {0, 0, 0, Subscript[j, 1][Subscript[u, B][w]],          Subscript[n, 1][Subscript[u, B][w]], -Subscript[h, 1][Subscript[u, A][w]]},         {0, 0, 0, ((Subscript[u, A][w])^2)*Subscript[j, ν, 1][Subscript[u, B][w]],          ((Subscript[u, A][w])^2)*Subscript[n, ν, 1][Subscript[u, B][w]],          -((Subscript[u, B][w])^2)*Subscript[h, ν, 1][Subscript[u, A][w]]}       }] == 0, {w, 4.6}]