Reloading package after accidental Remove[] of symbol

I was using `Needs["PlotLegends"]` By chance I removed `ShowLegend` by `Remove[ShowLegend]` How do I get back this function without restarting the kernel? Applying `Needs["PlotLegends"]` again seems not to help.


Lists of coefficients of derivatives

I want to extract two separate lists of coefficients of derivatives. If I have, for example,               cl= A1*D[P[x, y], {x, 1}] + A2*D[P[x, y], {x, 2}] +          A3*D[Q[x, y], {y, 3}] + A4*D[Q[x, y], {y, 1}];      I want to extract the lists `{A1, A2}` and `{A3, A4}` but do not want to type all the derivative expressions into command `CoefficientList`. I want to extract these lists programmatically because of I have a very long list of derivatives in my actual problem, which I thought was too long to post here. The following seems to work, but how can I do it without typing in the list of derivatives?               Coefficient[cl, {D[P[x, y], {x, 1}], D[P[x, y], {x, 2}]}]     Coefficient[cl, {D[Q[x, y], {y, 3}], D[Q[x, y], {y, 1}]}]      Longer example                cl2=B1*Derivative[0, 1, 0][R][x, y, z] +       B2*Derivative[2, 0, 0][R][x, y, z] +       B4*Derivative[2, 1, 3][V][x, y, z] +       B3*Derivative[3, 2, 1][R][x, y, z] + B5*Derivative[4, 1, 5][V][x, y, z] + B0*V[x, y, z]  + B00*R[x, y, z];      I need list of coefficients and list of derivatives parallel to know for which derivative is appropriate coefficient. But if I have zero derivatives, they don't appear in the list?


Front end typing lag

Under Windows 7 I frequently get serious keyboard lag. My home machine (Windows XP) NEVER lags. I was able to improve things somewhat by running Mathematica as Administrator, but this only went so far. The machine is very powerful, has tons of memory. The symptom is that any keypress or mouse click takes a second or two before anything happens. It is EXTREMELY annoying. You click the left arrow key, wait, click arrow key again, wait, click arrow key again, wait,... eventually you get to the place you need to be. If you hold the arrow key down, the system hangs then 5 seconds later the cursor appears 4 words over. Other applications running on the same computer at the same time show no effect. Word, Excel, even total memory hogs like Adobe Illustrator run and respond immediately to keystrokes. Only Mathematica is displaying this lag. I guess I can use a assembly language debugger to find out where the loop is that is lagging it out, but I am hoping somebody can save me the agony of doing this.


Binary decision diagrams (BDD)

I would like to use Mathematica to help me simplify a given Binary Decision Diagram (i.e. pick the optimal variable ordering). I don't seem to find anything at all on the topic, although it is something everyone with a little CS background knows very well. Given MMA's ability of dealing with graphs and boolean functions the task seems feasible, but I wouldn't want to waste a long time to solve a problem that is already solved. Is anybody aware of MMA resources on the matter?


Is it possible to export a live CDF document to PDF in the browser?

I am creating a computable document format (CDF) to embed in an HTML page. I would like to have a button that can be clicked to create/save a PDF of the CDF fromt he browser. The idea is that a person would be able to manipulate the document, enter in specific values for equations and graphs, and then be able to download the resulting visualization as a PDF. For starters I have created a simple sin plot and then added a button at the bottom for exporting the document. I am not sure what would go in the Export expression or if the export expression is even the correct approach to doing this. Here is my code:               sinplot =        Manipulate[Plot[Sin[a x + b], {x, 0, 6}], {a, 1, 4}, {b, 0, 10}];     nb = CreateDocument[        {Cell["Sin Curve Simulation", "Section"],         ExpressionCell[sinplot],         Button["Export Graph", Export[ ... ]]}];      Ideas of how to get this working?


Can BreadthFirstScan be modified?

I would like to obtain a "slick" implementation of A*-search algorithm on Graph objects, using the built-in BreadthFirstScan (if that is possible at all). I noticed that BreadthFirstScan is static in the sense that once a graph g is given to, `BreadthFirstScan[g, StartNode, {"DiscoverVertex -> func}]` 'func' cannot alter g as need be and hence cannot run the course of the A*-search algorithm. I know of one solution to A* algorithm on Mathematica.se, but it seems too verbose. Is it possible to use BreadthFirstScan? My rough guess is that it is not, but I want to confirm. To summarize my question is this: "Is there a way to make BreadthFirstScan alter its path?" I know that Throw can be used inside the execution of BreadthFirstScan, but it only jumps out of an "event" (e.g., "DiscoverVertex"), not alter the path of traversal for the graph.


How to solve this trigonometric system of equations numerically?

How can the following trigonometric system of equations be solved numerically?               sys= {      1 - Cos[theta1] - 2/3 Sin[phi + π/6] == 0.227746,       h + 2/3 Cos[phi + π/6] - Sin[theta1] == -0.714585,      -1. - Cos[theta2] - 2/3 Sin[phi - π/6] == (3 Cos[psi2])/4,       2/5 + h + 2/3 Cos[phi - π/6] - Sin[theta2] == (3 Sin[psi2])/4,       0.635187 Cos[phi - π/6 - psi2] + 2/3 Cos[1.78586 + phi] Sin[psi2] == 0     }      `NSolve` does not return a solution even after waiting for a long time:               NSolve[N[sys], {phi, h, theta1, theta2, psi2}]


Insert a 2D graph in a 3D graph

I have this question: Suppose I have some two dimsensional graphic element, say "flower" (i.e. a picture of a flower) in a _Mathematica_ notebook. I want to insert this figure, say at a specific point such as `(1,1,2)` in a 3-dimensional plot such as given by               Plot3D[x^2+y^2,{x,-2,2},{y,-2,2}]      I tried `Epilog` command with inset within the above Plot3D command, but was not succesful. For example, I tried:               Plot3D[x^2+y^2,{x,-2,2},{y,-2,2},Epilog->{  Inset[flower,{1,1,2}]  } ].        The problem is possibly that `Inset` command only allows 2D coordinates. Can someone please help me to achieve this task?   Thank you for any help in advance Best Regards, Tim


Syntax colouring when using Symbolize

I need to use symbols with suffixes in order to make my code readable in relation to the Eurocodes. To do this I use `Symbolize` from the `Notation`` package, but have noticed that the syntax colouring does not work on symbols created in this way. This makes checking the code more difficult. Is there a way of getting the syntax colouring to work or am I doing something wrong? Here is a toy example which seems to work if you copy and paste and then change it to Standard Form (`Control`-`Shift`-`N`). Note the W is shown black whereas the subscript is shown in blue. All the other symbols are shown blue even after they are defined.               Symbolize[     ParsedBoxWrapper[     SubscriptBox["\[Gamma]", "M0"]]];     Symbolize[     ParsedBoxWrapper[     SubscriptBox["M",      RowBox[{"c", ".", "y", ".", "Rd"}]]]]; Symbolize[     ParsedBoxWrapper[     SubscriptBox["W",      RowBox[{"el", ".", "y"}]]]];          Subscript[M, c.y.Rd] = 50;     Subscript[W, el.y] = 0.05;     Subscript[\[Gamma], M0] = 1.2;          \[Sigma] = Subscript[M, c.y.Rd]/(Subscript[W,       el.y]/Subscript[\[Gamma], M0])      1199.9999999999998 ![Here is an image of what I mean](http://i.stack.imgur.com/nMjnn.png)


How to solve a non-linear integral equation?

I have a non-linear integral equation that I'd like to solve with _Mathematica_ : $$ \int_{0}^{1} \mathrm{d}x \frac{B(x) v}{(B(x) + B(v))^2} = 1$$               Solve[Integrate[B[x] v / (B[x] + B[v])^2, {x, 0, 1}] == 1, B[v], {v}]      This problem comes up in an exotic problem from auction theory where I want to find the optimal bidding function `B[v]` for `v` in `[0,1]`. Is there any way to get a solution to this problem in _Mathematica_? Closed-form solutions are preferred (duh!) but a plot of a numerical one is also OK.


Controlling TreePlot (and GraphPlot) layout issue

A continuing battle with Mathematica involves graphics heavy with text labels. For example, the following expression renders so that the `"Lifecycle properties..."` node completely hides the arrow from the `"NonFunctional"` node. Any options to space these nodes apart?               TreePlot[{           "Software Engr" -> "Specification",           "Software Engr" -> "Implementation",           "Specification" -> "Functional",           "Specification" -> "NonFunctional",           "Functional" -> Style[ "What the system \n must do", Bold],           "NonFunctional" ->             Column[{ Style["Lifecycle properties:", Bold], "Interoperability",               "Usability", "Scalability", "Safety", "Expandability",               "Flexibility", "Robustness", "Modularity"}]           },          Top, "Software Engr",          VertexLabeling -> True,           PlotStyle -> {FontFamily -> "Helvetica", FontSize -> 14},          EdgeRenderingFunction -> ({GrayLevel[0.5], Arrow[#1, 0.2]} &)          ]      A related issue is that although `Export` renders a PDF of this exactly as it appears in notebook, right-clicking on the cell and using `"Save Selection As..."` makes the above mentioned nodes overlap. It's a mess. Imagine dealing with larger graphs


No output for N[Limit[Integrate[Sin[x]^n/(Sin[x]^n + Cos[x]^n), {x, 0, Pi/2}], n -> Infinity]]

Is my input below correct? I've received no response from Mathematica.               N[Limit[Integrate[Sin[x]^n/(Sin[x]^n + Cos[x]^n), {x, 0, Pi/2}], n -> Infinity]]      Thank you in advance for your feedback!


How do I simplify an embedded sub-expression without affecting other sub-expressions?

I have an expression which is very large and which has several sub-expressions with head `Conjugate`. What I want to do is simplify the `Conjugate[...]` sub- expressions without affecting other sub-expressions. The first method I considered is was the `Transformationfunctions` option of `Simplify`. I wrote:               Simplify[expr,Transformationfunctions->{Conjugate}]      Well, `Conjugate` does indeed disappear, but the result is wrong. For example (with `$Assumptions` set so all variables are considered real)               FullSimplify[Conjugate[        t1 (2 Cos[(Sqrt[3] kx)/2] Cos[ky/2] + Cos[ky]) +         I t1 (-2 Cos[(Sqrt[3] kx)/2] Sin[ky/2] + Sin[ky])],        Transformationfunctions->{Conjugate}]      gives               t1 (2 Cos[(Sqrt[3] kx)/2] Cos[ky/2] + Cos[ky]) +      I t1 (-2 Cos[(Sqrt[3] kx)/2] Sin[ky/2] + Sin[ky])      The second method I considered is to use `ComplexExpand //@ Conjugate`. Since all the variables in my expression are declared real variables, `Conjugate[expr]` will become `ComplexExpand //@ Conjugate[expr]`. To make such this substitution, I could use search-and-replace and evaluate-in-place, but as I have said, the expression is large, so I don't want to do it that way. Instead I did the following:               largeexpr /. Conjugate -> ComplexExpand //@ Conjugate      But this did not work. Here `largeexpr` is an expression containing sub-expressions with head `Conjugate`. For example,               Sqrt[t1^2]+Conjugate[        t1 (2 Cos[(Sqrt[3] kx)/2] Cos[ky/2] + Cos[ky]) +         I t1 (-2 Cos[(Sqrt[3] kx)/2] Sin[ky/2] + Sin[ky])]       So can anyone point out what I did wrong? Or suggest a better solution?


How to apply function on list of lists with different sizes

I am not good with slot management when it comes to 2D lists. What is the correct way to map a function on list of lists of different length, where the function needs to act of each entry in each list and return the result in the same shape as the list of lists? Example:               data1 = {{1, 2}, {4, 5, 6}, {1}};     x = {80, 81, 82};      And I'd like the result to come out as               Clear[f]     result = .......           (*result={             {f[x,1],f[x,2]},             {f[x,4],f[x,5],f[x,6]},             {f[x,1]}            }     *)      The function `f` is defined to take as its first argument a 1D list, and its second argument a single number or single symbol as in `f[list_, n_]` I've tried MapThread, Scan, And many others, but keep getting slot[#] mismatches. ofcourse I can use `Table` command to force the iteration over the rows, or use `Do` but I want to learn how to do this without these. I wish WRI will have a course on slot management and threading. I would sign up for it.


ToExpression fails with long nested string expressions

Consider the following conversion from `String` to Mathematica Expression:               n = 10;     ToExpression[Table["{", {n}] <> Table["}", {n}]]      > >     {{{{{{{{{{}}}}}}}}}} >   Everything is fine. However, when the string is longer:               n = 510;     ToExpression[Table["{", {n}] <> Table["}", {n}]]      > >     ToExpression::sntx: Invalid syntax in or before "   >   >                              <<182>>   >                    ^". >     $Failed >   My actual string that I'm trying to convert is much longer, about 2 million characters. How can I convert it to a Mathematica expression? A short example is: > "{"GAME", {"version", "0.23.5"}, {"linkURL", ""}, {"Mode", "1"}, > {"PARAMETERS", {"FLIGHT", {"CanQuickSave", "True"}, {"CanQuickLoad", > "True"}}}, {"SCENARIO", {"name", "ScenarioDiscoverableObjects"}, {"scene", > "7, 8, 5"}, {"", "703987854"}, {"sizeCurve", {"key", "0 0 1.5 1.5"}, {"key", > "0.3 0.45 0.875 0.875"}}}}" **UPDATE** `Read`ing a `Stream` also fails:               n = 510;     string = Table["{", {n}] <> Table["}", {n}];     stream = StringToStream[string]     Read[stream, Expression]     Close[stream]      > >     Read::readt: Invalid input found when reading > {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{\[Ellipsis] > > }}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}} >      from > StringToStream[{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{\[Ellipsis] > > }}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}]. > >> >


256 Shades of Grey

I noticed that the following line,               Image[Table[x, {y, 1, 250}, {x, 30/256, 40/256, 0.02/256}],       Magnification -> 1]      results in the following image: ![enter image description here](http://i.stack.imgur.com/riUoH.png) In the preceding image, there are 10 vertical bars, each a different shade of grey; based on the range I used in `Table`, this means that there are 256 shades of grey when going from black to white (ie, 8-bit depth per channel). Similarly, this effect also shows up in full-color images. Is there a way to make the colors produced by `Image` have less of this "staircase effect"? This related question asks about boosting the channel depth beyond 8-bits per RGB channel, but the highest-voted answer does not appear to computationally scale well when applied to image sizes of $3000\times3000$ or larger.


Why is building a table of function values so much slower than just plotting the function?

Here is a function that take some time to evaluate:               n = 1000;     coeffs = RandomVariate[NormalDistribution[], n];     f[x_] := Sum[coeffs[[k]] Sin[k x]/k, {k, 1, n}];      If I just plot the function with 1000 sample points, it takes about 0.24 seconds on my machine:               Plot[Evaluate@f[x], {x, 0, 2 Pi}, PlotPoints -> n, MaxRecursion -> 0] // Timing      On the other hand, if I try to collect 1000 samples of the function into a table, it takes _five times as long_ :               Table[Evaluate@f[x], {x, 0, 2 Pi, 2 Pi/n // N}] // Timing      (Without the `// N` Mathematica tries to evaluate things symbolically, which is even slower.) What is going on, and how can I make the `Table` as fast as the `Plot`?


Can Mathematica functions have static variables?

In `C`, one can have variables that are declared `static`. These are not re- initialized every single time a function is called. I.e.:               int f(int inc)     {         static int x = 0;         return x += inc;     }      Then `f(0);f(1);f(2);` will return `0`,`1`, and `3`. Is this possible in _Mathematica_? One use that immediately comes to mind is having a compiled function stored as a static variable for use in a ME function.


substitution rules excluding subscripted variables

Suppose I have an expression containing `p`,`Subscript[p,1]`,`Subscript[p,2]`,etc. I want to replace `p` with a numerical value while keeping the other two variables intact. How can I do it? If I naively use `/.{p->0.5}` for example, I will get `Subscript[0.5,1]`, `Subscript[0.5,2]` as a result.


Do I need to clear all definitions whenever I experiment with new parameter values?

Do I have to clear all my definitions whenever I experiment with different parameter values for my model? For example, I have a simple model as follows:               w[t_]:=w[t]=w[t-1]+h     w[0]=0         h = 5      I want to do:               Table[w[t], {t, 0, 10}]      with varying h. But every time I change h, I have to clear the definitions with               Clear["Global`*"]      Otherwise, the result for w[t] remains the same. This practice is ok with this simple model. But when the model is pretty big, it really is time-consuming. I was expecting to get a new result directly by changing h. Any helpful comments in this direction?


Generating visually pleasing circle packs

EDIT: I want to thank you all guys for this unexpected intellectual and artistic journey. Hope you enjoyed as I did. I would like to generate a `circle pack` that mimics this: _(don't pay attention on numbers, and colors at all, at the moment I am interested in circle positions and radii only)_ ![enter image description here](http://i.stack.imgur.com/PnJ5y.jpg) or this: ![enter image description here](http://i.stack.imgur.com/It2s0.png) I am new in Mathematica, could you give me some guidance? Thnx. _EDIT: The question was strictly for planar case (and remains so), however I see @Jacob Akkerboom in his answer added a solution for 3D generalization (thanks!), and, speaking of that, I just want here to bring to your attention this picture:_ ![enter image description here](http://i.stack.imgur.com/OoAbX.png) _EDIT 2: There are some applications of circle packing in irregular shapes, like this: (author Jerome St Claire, handpainted)_ ![enter image description here](http://i.stack.imgur.com/Bm43F.png) _... and a font called Dotted: (author Maggie Janssen)_ ![enter image description here](http://i.stack.imgur.com/1men0.jpg) _... and some logos:_ ![enter image description here](http://i.stack.imgur.com/pcXYr.jpg) _... and these hypnotic images: (frompercolatorapp)_ ![enter image description here](http://i.stack.imgur.com/SPKKX.jpg) ![enter image description here](http://i.stack.imgur.com/oNa4Y.jpg) ![enter image description here](http://i.stack.imgur.com/agG2f.jpg)


Data of badly formatted file

Similar as in this question, I have to read in data from a file (exampleFile.txt) which is not so well formatted. Unfortunately, I cannot find a solution by myself. Since it is a bit complicated to describe in which part of the data I am interested in at the moment, you can see in the screenshot below where I have marked in orange the data of interest. ![enter image description here](http://i.stack.imgur.com/FyEgn.png) Here is the code I got so far:               originalData=Import[file,"Table"];(*Read in of data*)     lengthOriginalData=Length[originalData];     mainData=originalData[[38;;lengthOriginalData-4]];(*take bulk of data*)     mainData1=Position[mainData,"Ion"];(*Search for position all data of interest have in common*)     positionToDelte=Table[{2*i},{i,1,Length[mainData1]/2}];(*there are unnecessary positions*)     mainData2=Delete[mainData1,positionToDelte];(*delete unnecessary positions*)     mainData3=mainData[[mainData2[[All,1]]+3]];(*take the data of interest*)     emptyLine=Position   [mainData3,"======================================================================================================"];(*there are still unnecessary lines*)     emptyLine2=Table[{emptyLine[[i,1]]},{i,1,Length[emptyLine]}];     dataOfInterest=Delete[mainData3,emptyLine2];(*delete the unnecessary lines*)     arrayOfInterest=dataOfInterest[[All,1]];(*this is the array in which the data of interest are*)     arrayOfInterest1=StringReplace[arrayOfInterest,"³"->","];(*a try to get the data of interest out of this array*)      As you can test, I get almost all I want (perhaps not with the nicest methods). Actually, all I would need is that I can take in my `arrayOfInterest1` the right elements but somehow this does not work (I think the reason is that this is a string, but I need numbers).


Inheritance in Mathematica using pattern matching on UpValues

Edit: * * * I think in my original post, I missed emphasizing the main point. This is mainly a pattern matching question. If you're interested in the 'why' of this question, please read the original post below. The short question: Suppose I have a newly defined, unevaluated `Head`, called `NewHead`. I define a function associated with `NewHead` as (I add in the `x` & `y` to emphasize that the argument list can be arbitrary so long as it contains `n_NewHead`)               In[1]= NewHead /: func[x_, n_NewHead, y_] := n      This has               In[2]= UpValues[NewHead]     Out[2]= {HoldPattern[func[x_, n_NewHead, y_]] :> n}      I would like to use pattern matching so I can transform this `UpValue` list like               In[3]= UpValues[NewHead] /. (* Some pattern matching here resulting in: *)     Out[3]= {HoldPattern[func[x_, d_DerivedHead, y_]] :> func[x, d[[1]], y]}      The point is to make a 'class' `DerivedHead` that inherits all the functions of the 'class' `NewHead`. A `NewHead` object would be stored in `Part` 1 of a `DerivedHead` object. For an example, read the original post below. The thing I can't figure out is how to pattern match on `n_NewHead` (in **`Out[2]`** ) . The name of the pattern `_NewHead` can, in principle, be anything, and the argument list to `func` is similarly arbitrary. Any advice is appreciated! \- Seth Original post below: * * * I have read some posts here on object oriented programming as well as many pattern matching posts, but nothing (I have found) seems to address this case, so I thought I'd ask a question. I am trying to implement some features of object oriented programming in Mathematica, most notably inheritance. Imagine I have a polygon class with Head Poly created like               ToPoly[l : {{_, _} ..}] :=     Module[{},       If[Length@l < 3, Print["Poly object must have at least 3 points"]; Abort[]];       Poly @@ l     ]      It has functions associated with it like (note TagSetDelayed)               distance[{x1_, y1_}, {x2_, y2_}] := Sqrt[(x2 - x1)^2 + (y2 - y1)^2]     Poly /: Perimeter[p_Poly] :=     Module[{pts, ptsShift},       pts = List @@ p;       ptsShift = Join[{Last@pts}, Most@pts];       Total@MapThread[distance, {pts, ptsShift}]     ]     Poly /: Vertices[p_Poly] := Length@p      Now, I want to create a quadrilateral sub-class with Head Quad. Suppose a Quad can have a color associated with it. So we have               ToQuad[l : {{_, _} ..}, color_String] :=     Module[{},       If[Length@l =!= 4, Print["Quad object must have exactly 4 points"]; Abort[]];       Quad[ToPoly[l], color]     ]          Quad /: QuadColor[q_Quad]:=q[[2]]      At this point, I would like to be able to inherit Perimeter and Vertices from the Poly class. Since they have been defined with TagSetDelayed, I can see those definitions using               UpValues[Poly]          (* {HoldPattern[Perimeter[p_Poly]] :>          Module[{pts, ptsShift}, pts = List @@ p;          ptsShift = Join[{Last[pts]}, Most[pts]];          Total[MapThread[distance, {pts, ptsShift}]]],          HoldPattern[Vertices[p_Poly]] :> Length[p]} *)      Then, I want to define a function that assigns those UpValues to Quad like:               SuperClass[x_]:=x[[1]]     DefineDerivedClass[class_,superClass_]:=     Module[{},            (* Assign UpValues associated with superClass to class *)          ]      So, after this is called like               DefineDerivedClass[Quad,Poly]      I would have               UpValues[Quad]          (* {HoldPattern[Perimeter[q_Quad]] :>  Perimeter[SuperClass[q]],       HoldPattern[Vertices[q_Quad]] :> Vertices[SuperClass[q]],        HoldPattern[QuadColor[q_Quad]] :> q[[2]]} *)      The problem is that I cannot figure out the pattern matching to turn the UpValues of Poly into the correct form for Quad for a generic pattern sequence. I can use Part to get inside the HoldPattern, but I cannot match on the p_Poly part. So far, the only way I can figure out to do this is by converting the UpValue expressions into strings, but that is very inelegant. Any ideas? Thanks, Seth


How to change display of axis unit from radians to degrees in a plot

Is there a simple way, besides changing my function to use `Degree` as input, to display the x-axis in degrees in a plot of a function defined with its independent variable taking radians?


Expectation function does evaluate my expression

I am trying to evaluate the expression               Expectation[(B x (-6 b + 12 a n0 + B x + B^2 x^2))/(2 (6 a + B x + B^2 x^2)),        Distributed[x, BetaDistribution[α, β]]]      The evaluation runs for a few seconds and then _Mathematica_ displays the unevaluated expression without any error messages or any other output. Is this because this random variable transformation is too complex for _Mathematica_ to handle? If so, shouldn't some message be generated? ### Edit The same expression with an `UniformDistribution`               Expectation[(B x (-6 b + 12 a n0 + B x + B^2 x^2))/(2 (6 a + B x + B^2 x^2)),        Distributed[x, UniformDistribution[{α, β}]]]      completes and returns a formula.


Analytically solve the eigenvalue problem with infinite dimensions by Mathematica?

If I am given a symbolic expression of all the matrix elements in an infinite- dimensional space, e.g., the Hamiltonian of a quantum mechanical system, is it possible to get the symbolic expression for all of the eigenvalues by Mathematica? One of the simplest case is the Harmonic Oscillator in quantum mechanics, where the elements of Hamiltonian matrix can be written as: $$ H_{mn}=(n+\frac{1}{2})\delta_{mn} $$ where we all know that the eigenvalues are: $$ E_n=n+\frac{1}{2},( n=0,1,2,3,...) $$ but Mathematica seems not having any functions to find the eigenvalues given such conditions, since the dimension of the matrix is infinity.


Why can't I change the value of MaxRecursion in NIntegrate when integrating BesselJ?

I am trying to evaluate this integral numerically $$ \int_0^{\infty } J_0(q R) \tanh(q) \, \mathrm{d}q $$ for large values of $R$. This makes the integrand oscillate more quickly and _Mathematica_ gives incorrect answers. To deal with this I am trying to increase `MaxRecursion` in `NIntegrate`. Simply coding                With[{R = 50},             NIntegrate[BesselJ[0, q R ] Tanh[q], {q, 0, ∞},                       AccuracyGoal -> 12, PrecisionGoal -> 4, MaxRecursion -> 100]]      throws no errors but it also does not increase computation time or give the correct answer. If I set `MinRecursion` to a large value (larger than 9 - the default value in `NIntegrate`) in an attempt, I see an increase in computation time                With[{R = 50},             NIntegrate[BesselJ[0, q R ] Tanh[q], {q, 0, ∞}, AccuracyGoal -> 12, PrecisionGoal -> 4,                      MinRecursion -> 20, MaxRecursion -> 100]]      I get an error saying               NIntegrate::minmax: MinRecursion (20) is greater than MaxRecursion (9).      I find this very confusing as I implicitly set the value of `MaxRecursion` in the code and it is not 9. _Mathematica_ will allow my Min and Max Recursion if I delete the Bessel function and just have the `Tanh` in `NIntegrate`. My only thought is that this is some built-in property of `BesselJ`. _Mathematica_ will also evaluate the `BesselJ` to arbitrary precision so I see no reason to limit the number of numerical subdivisions. Does anyone know a workaround? P.S. Here is a some code which will quickly produce a plot of the integral as a function of $R$                f[R_?NumericQ] := Module[{},  NIntegrate [BesselJ[0, q R ] Tanh[q], {q, 0, ∞}]];      LogLogPlot[f[R], {R, 1, 250}, PlotPoints -> 10, MaxRecursion -> 1, AxesOrigin -> {0, 0}]      The code works up until $R$ is about 15 then gibberish for anything larger. Thanks.


Apply confusion in Do loop

I am trying to apply `InversePermutation` on a list of sublists of selected permutation elements. First I am trying to see if I am able to reach every element,               temp = {{Cycles[{}]}, {Cycles[{}], Cycles[(12)]}, {Cycles[{}],         Cycles[(13)]}}      So the code I have tried to print all is               k = 1; i = 1; Do[Do[Apply[Print, i], {i, k}], {k, temp}]      which gives $\\{\\}\\{\\}\\{1 2\\}\\{\\}\\{1 3\\}....$ it pics only content of `Cycle`. So, I changed it a bit as,               k = 1; i = 1; Do[Do[Apply[Print, {i}], {i, k}], {k, temp}]      Surprisingly it started to take all the contents with `Cycle` prefix along, giving $\\{\text{Cycles}[\\{\\}]\\}\\\ \left\\{\text{Cycles}[\\{\\}],\text{Cycles}\left[\left( \begin{array}{cc} 1 & 2 \\\ \end{array} \right)\right]\right\\}....$   What I could not understand is that putting `{i}` instead of `i` changed what ?   **Edit:** I am not able to replace this `Print` with `InversePermutation`.It doesn't respond if I replace Print with it. Can someone suggest what I am doing wrong?


What is the efficient way to code Successive Over-relaxation (SOR) method in Mathematica?

I have written a SOR method (SOR is this method) code using C-style procedural loops. However, I think there might be (much) better ways to achieve the same end in Mma avoiding these loops. So my question is: Is that feasible to code SOR method using functions like `Nest`, `Fold` that could be substantially more efficient? For example, the following is a simple set of multiline equations with tridiagonal matrix.(my original equations will have an larger coefficient matrix, like 100*100 tridiagonal sparse array.) ![](http://i.stack.imgur.com/h1VQV.png)   1. Let `listnew` be the list that stores the unknown $x_1,x_2,x_3,x_4,x_5$ after each time of iteration.   2. And `listold` correspondingly stores the unknowns before each time of iteration.   3. `b` stores right-hand side of the equation above.   4. `k` indicates the times of iteration.   5. `i` is the index of $x_i$.   6. `ϵ` is the pre-defined maximum error.   7. `error` indicates the maximum difference between `listnew` and `listold` after each iteration.   8. `ω` is the so-called relaxation factor. Then, my (dumb) code using `For` loop would be:               ϵ = 0.1;     ω = 1.5;     b = {1, 1, 1, 1, 1};     listnew = listold = Table[0, {i, 5}];     error = ϵ + 1;     For[k = 0, error > ϵ, k++,         listnew[[1]] = listold[[1]] - ω (b[[1]] + 4 listold[[1]] - listold[[2]])/4;         For[i = 2, i < 5, i++,              listnew[[i]] = listold[[i]] -                             ω (b[[i]] + 4 listold[[i]] - listnew[[i - 1]] - listold[[i + 1]])/4];         listnew[[5]] = listold[[5]] - ω (b[[5]] + 4 listold[[5]] - listnew[[4]])/4;         error = Max[Abs[listnew - listold]]; listold = listnew;]      I'm sorry if it looks so dumb...


Notebook keeps running when Solve for variable

This might be a simple question for the most of you, but I am very new to mathematica so please bear with me. I'll refer to the code below:               H = 10     T0 = 3600     Cd = 0.0573*Sqrt[1 + 0.148*U0]     Iv = 0.06*(1 + 0.043*U0)*(z/10)^-0.22     Solve[Utz == U0*(1 + Cd*Log[z/H])*(1 - 0.41*Iv*Log[T/T0]) && U0 > 0, U0]      I would like to Solve the above formula for U0, so I get U0=... with Utz, z and T as the variables. I only need solutions >0. However, the notebook keeps 'running' when I use this. I have also used input values for Utz, z and T, this works fine and the correct value for U0 is provided. Am I doing this correctly and does the Solve simply take a lot of time, or is there another explanation? Thanks in advance, Hans *Edit1: Thanks Sjoerd for your comment. The problem lies in the fact that Cd and Iv are both defined by variables U0 and z. That is why I want to incorporate those in the Solve for U0, something like?:               Solve[Utz == U0*(1 + (0.0573*Sqrt[1 + 0.148*U0])*Log[z/H])*(1 - 0.41*(0.06*(1 + 0.043*U0)*(z/10)^-0.22)*Log[T/T0]) && U0 > 0 && T > 0 && z/H > 0, U0]      However, again this results in 'running' process.


Problem with machine number precision in compiled functions

When I compile a very big function and give it input the function returns error. I realized that this is because the value of the function becomes smaller than the smallest machine number. Is it possible to tell MMA that when I compile a function if the output of the function becomes smaller than the smallest machine number it should return the smallest machine number or zero?


Selecting from Manipulate for ParametricPlot3D

, Referring to yesterday's "Switching parameter lines on/off in a 3D parametric plot" (Switching parameter lines on/off in a 3D parametric plot) From reply by Bob Hanlon for example, can we pick up some option combinations resulting in two separate 3D plots out of the above full Manipulate set, approximately indicated as :               GrU= {uMesh True,uMesh=18, v Mesh False,Surface, Boxed -> False} and          GrV= {vMesh True, vMesh=10,u Mesh False,WireFrame, Boxed-> True}      and then combine them into a single plot by:               Show[GrU,GrV]       How may it be done? The motivation for this query is qualitatively the following. If one cannot make a parametrization fully with 2 parameters u,v on a known surface which is undergoing a new parametric definition, sometimes one can start with a single parameter u on the surface while remaining on the surface and design/choose other new parameter v definition. The surface on which v is targeted, or going to be placed, can be a priori visualized while developing v. For example the sphere can be parametrized _either_ by a set of geodesics and parallel lines (latitudes,longitudes) _or_ by two sets of great circle geodesics. The above arose in finding a proper parametrization for Helmet Net. In the image there are Shown 2 sets of parallel circles, x-y, y-x are same but distance along arc of neighbor differential arcs is not same. It is not a _single_ parametrization. Distances are more at 45 degree location. Attempt is to make all distances between nodes same in parametrization.It should be sure if all points in either set coincide. ![HelmetNet](http://i.stack.imgur.com/H7onm.png)


Surface area of intersecting spheres

Given a sphere of radius 1 centered at the origin and $n$ spheres with radii $r_i$ centered at predefined coordinates, $c_i$, in space, I am after the surface area of the unit sphere that is not intersected by any of the surrounding spheres. E.g. given the coordinates               c = {{{1.2,0,0},1}, {{0,-1.7,0},1.2}, {{0.7,1,0},0.9}, {{-0.5,-0.5,-0.5},1}}      I am interested in the (potentially) visible blue surface area in the graphic generated by:               {Blue, Sphere[{0,0,0},1], Red, Sphere[#,#2]&@@@c} // Graphics3D      In principle, I can obtain this area by evaluating the following integral               fun = Function[{t,p},          Evaluate[ Times @@               (UnitStep[Total[({Sin[t]*Cos[p],Sin[t]*Sin[p],Cos[t]}-#)^2]-#2^2]& @@@ c)         ]     ]     NIntegrate[Evaluate[fun[t,p]*Sin[t]], {t,0,Pi}, {p,0,2Pi}] // AbsoluteTiming      However, this approach is slow (in particular for a large numbers of spheres), and has convergence issues. In an attempt to speed up the integral evaluation, I have devised the following code snippet, which is based on a naive (non-adaptive) application of the trapezoidal rule:               n = 1000;     theta = N@Pi/(n-1)*Range[0,n-1];     phi = 2*N@Pi/(2*n-1)*Range[0,2*n-1];     int1 = ConstantArray[1.,n];     int1[[{1,-1}]] = 0.5;     int2 = ConstantArray[1.,2*n];     int2[[{1,-1}]]=0.5;     (* Calculating ptsT is slow. However, it could be pre-calculated once ... *)     ptsT=Transpose[Outer[{Sin[#]*Cos[#2],Sin[#]*Sin[#2],Cos[#]}&, theta, phi], {3,2,1}];          (       lv = Transpose @         Fold[#1*UnitStep[Total[(ptsT - #2[[1]])^2] - #2[[2]]^2] &,              ConstantArray[1., {2 n, n}], c];       int1.((lv.int2)*Sin[theta]) *Pi/(n - 1) * 2*Pi/(2 n - 1)     ) // AbsoluteTiming      How can this calculation be sped up? I am also interested in increasing the number of surrounding spheres to approximately 50. The following code snippet will generate $n$ spheres, which might be useful in comparing the performance of different approaches:               coords[n_] := Transpose@{        1.1 * Table[           With[{y = (2*i + 1)/n - 1, phi = i*(Pi*(3 - Sqrt[5]))},                {Cos[phi]*#, y, Sin[phi]*#} &[Sqrt[1 - y*y]]           ],            {i, 0, n - 1}],        ConstantArray[0.3, n]}


Manipulate wrapping ParametricPlot3D - part spec longer than depth of object?

I have a system of parametric equations               s0 = {t0, 0. +2. Sin[θ] Sin[ϕ]-1. (0.5 t0+0.5 Sin[θ] Sin[ϕ]),      4. (0. +0.25 Cos[θ] Sin[ϕ]), 1. Cos[ϕ]}      If I plot them thus, with a set value of t0, e.g. t0=0               ParametricPlot3D[{ s0[[2]], s0[[3]], s0[[4]]}, {θ, 0,        2 Pi}, {ϕ, -1 Pi, Pi}, Axes -> True,       AxesLabel -> {"x", "y", "z"}, LabelStyle -> Directive[Large] ,       TicksStyle -> Directive[Medium], AxesOrigin -> Automatic,       PlotStyle -> Directive[Opacity[0.6]],       AxesEdge -> {{-1, -1}, {1, -1}, {-1, -1}},       ViewVertical -> {0, 0, 1}, ViewPoint -> Front]      everything is fine. If I then wrap the plot with Manipulate, where mint and maxt provide calculated limits and t0 is the manipulated variable               Manipulate[      ParametricPlot3D[{ s0[[2]], s0[[3]], s0[[4]]}, {θ, 0,         2 Pi}, {ϕ, -1 Pi, Pi}, Axes -> True,        AxesLabel -> {"x", "y", "z"}, LabelStyle -> Directive[Large] ,        TicksStyle -> Directive[Medium], AxesOrigin -> Automatic,        PlotStyle -> Directive[Opacity[0.6]],        AxesEdge -> {{-1, -1}, {1, -1}, {-1, -1}},        ViewVertical -> {0, 0, 1}, ViewPoint -> Front], {t0, 1.1*mint,        1.1*maxt}]      I receive part spec "longer than depth of object" for each of S0[2]...s0[[4]]. Main question: since it doesn't work, what am I doing wrong, and what should I have done? (why?) Bonus: if I also use PlotStyle -> Directive[Opacity[0.5]] in the plot ![simple shere with uneven shading due to opacity](http://i.stack.imgur.com/JCG5F.jpg) then the shading clearly shows uneveness and the lines are a bit jaggy too: how can the quality of the rendering be improved. Hope this is nice and easy for someone to answer... PS I am amazed by the knowledge and willingness to help of the contributors here, unfortunately don't have enough rep yet to be able to upvote some of the other answers I have made use of, e.g. Mr Wizard's reorder function, but I am _really_ glad & grateful for all this. **Update** @Chenminqi's solution works in isolation, but not in the context of my own code which is: (notes at end. NB I'm sure you will find this ugly and/or clumsy but I've only been using Mma for a few days)               Block[{setMagV, setVx, setVy, setVz, magv, v, vx, vy, vz, t, t1, t0, s0, s1,      θ, ϕ, γ, originPrimeFrame,        rearrangement, solns, mint, maxt, temp, spacetimePlot, pic},      setMagV = 0.5; setVx = setMagV; setVy = setVz = 0;       v = {vx, vy, vz};      originPrimeFrame = {t1, 0, 0, 0};      s0 = Simplify[        LorentzF[v].spatialShell[          originPrimeFrame, θ, ϕ]]; (* sphere in primed frame, \     xformed to unprimed *)      γ = 1/Sqrt[v.v]; (* replace gamma with vx, vy, vz *)      (* Print["Raw transformed sphere"]; \     Print[Reorder[MatrixForm@s0,srOrder]]; Print["s0[[1]] = ", s0[[1]]];*)     vx = setVx; vy = setVy; vz = setVz;       t1 = 0; (* assign values so  we can determine min and max t in \     unprimed frame*)      mint = Minimize[{s0[[1]],           0 <= θ < 2 Pi, -Pi <= ϕ < Pi}, {θ, ϕ},          Reals][[1]];       maxt = Maximize[{s0[[1]],           0 <= θ < 2 Pi, -Pi <= ϕ < Pi}, {θ, ϕ},          Reals][[1]];      (*Print["t0 minimum = ", mint,"t0 maximum = ", maxt];*)      (* clear assigned values so we can go back to symbolic processing *)      vx =.; vy =.; vz =.;       t1 =.; (* clear the values to recover the symbols for manipulation *)      rearrangement =        Solve[t0 == s0[[1]],         t1]; (*Print["rearrangement = ", rearrangement]*);       (* Whilst a test case elsewhere seemed to show {{actual \     substitution}} could be used directly, when used here *)      (* like that it flattens my list unless I first flatten \     rearrangement so it is only {} and not {{}} *)      s0 = ReplaceAll[s0, Flatten@rearrangement]; Simplify[s0];      (*Print["s0 after rearrangement = ", Reorder[MatrixForm@s0,srOrder], \     s0[[2]], s0[[3]], s0[[4]]];*)      (* We are now ready to plot x, y, z at specified times t *)      vx = setVx; vy = setVy; vz = setVz;      Print[s0[[1]], ", ", s0[[2]], ", ", s0[[3]], ", ", s0[[4]]];      pic = ParametricPlot3D[          Evaluate[Rest[s0] /. {t0 -> #}], {θ, 0,            2 Pi}, {ϕ, -1 Pi, Pi}, Axes -> True,           AxesLabel -> {"x", "y", "z"}, LabelStyle -> Directive[Large],           TicksStyle -> Directive[Medium], AxesOrigin -> Automatic,           PlotStyle -> Directive[Opacity[0.6]],           AxesEdge -> {{-1, -1}, {1, -1}, {-1, -1}},           ViewVertical -> {0, 0, 1}, ViewPoint -> Front,           PlotRange -> {{-4, 2}, Automatic, Automatic}] & /@         Range[0, 5, 0.5];      Manipulate[pic[[i]], {i, 1, Length[pic], 1}]      ]      _Notes_ : outline of the method... LorentzF[v] produces the 4D Lorentz transformation matrix, which is applied to spatialShell, which is a parametric specification of a sphere in polar coordinates centered on a particular point. {t, x, y,, z} = {t', x'+ sin(theta)sin(phi), y' = cost(theta)sin(phi), z'+ cos(phi). The velocity vector is given component values so that the min & max of t can be determined numerically for use as the limits in manipulate. In order to view the sphere at times t, t' is re-expressed in terms of t (using Solve, having unset the values to return to symbolic working) and substituted back into the equations, which are now becoming rather complex. [Note the ReplaceAll oddity in the comment]. The reorder function is that created by Mr Wizard elsewhere and has a standard set of symbols for consistent equations. At this point in s0 we have four equations, but are only interested in parts 2-4 for the spatial part we wish to plot for variable t (t0 in the code). I will also want to add sliders for v in the x, y, z directions later. Hope that helps PS The need for Chenminqi's code is obscure to me because I can't see why Manipulate doesn't work directly - it picks up all the other variable values OK, so why not t0? **Update2** Removing pic form the local variable list in Block allows the suggested code to work. I'd really appreciate some insight into the way Manipulate and Block are working such that the problems arose in the first place; I have something that works, but as a completely new user I am struggling to understand so that I can use the knowledge on another occasion. **Update 3** Code for LorentzF and spatialShell (Chenminqi request) Note Lorentz handles v = 0 and v>=c separately; if v=0 Mma objects to 0/0, invalid if v>=c so returns zeroes.               LorentzF[v_] := Module[{l, i, j, dim},        dim = Length[v] + 1;        If[NumericQ[Norm[v]] == True  && (Norm[v] == 0  || Norm[v] >= 1),         If[Norm[v] == 0,          l = Table[KroneckerDelta[i, j], {i, 1, dim}, {j, 1, dim}],          l = Table[0, {i, 1, dim}, {j, 1, dim}]],         If[dim < 2, l = {},          l = Table[0, {i, 1, dim}, {j, 1, dim}];          l[[1, 1]] = γ;          For[i = 2, i <= dim, i++,            l[[1, i]] = l[[i, 1]] = -γ v[[i - 1]]           ];          For[i = 2, i <= dim, i++,            For[j = 2, j <= dim, j++,             l[[i, j]] =              l[[j, i]] = (γ - 1) v[[i - 1]] v[[j - 1]]/v.v +                KroneckerDelta[i, j]            ]           ];           ]         ];        l        ];          spatialShell[origin4D_, θ_, ϕ_] := {origin4D[[1]],         Sin[θ] Sin[ϕ] + origin4D[[2]],         Cos[θ] Sin[ϕ] + origin4D[[3]],         Cos[ϕ] + origin4D[[4]]};


Can not launch Mathematica 8 on Lubuntu

I am trying to launch Wolfram _Mathematica 8_ Home Edition. The installation itself occurred without a hitch. Note: "..." indicates my machine name, username, etc. ### Linux Version ...$ uname -a Linux ... 3.5.0-25-generic #39-Ubuntu SMP Mon Feb 25 18:26:58 UTC 2013 x86_64 x86_64 x86_64 GNU/Linux ### Error Messages ...$ mathematica /usr/local/bin/mathematica: 237: /usr/local/bin/mathematica: /usr/local/Wolfram/Mathematica/8.0/SystemFiles/FrontEnd/Binaries/Linux/Mathematica: not found ...$ math /usr/local/bin/math: 166: exec: /usr/local/Wolfram/Mathematica/8.0/SystemFiles/Kernel/Binaries/Linux/MathKernel: not found ### Things I have tried I found someone who had the exact same error message come up, only it was on the Mint 10 system. Here is the link: http://forums.linuxmint.com/viewtopic.php?f=47&t=61409 The author seems to have dealt with the problem by installing a missing library. The only issue is that the author of the forum post declined to state what library was missing! I have tried making sure all my repositories are up- to-date using the Software Updater. Does anyone have suggestions for packages I can try installing using the Synaptic Package Manager? If Mathematica runs fine on Ubuntu 12, it must be an application or library that is missing on LUbuntu that is preventing the launcher from recognizing the file. Because I can assure anyone who asks that the files in question are all there. To wit: ...$ ls /usr/local/bin/mathematica /usr/local/bin/mathematica ...$ ls /usr/local/Wolfram/Mathematica/8.0/SystemFiles/FrontEnd/Binaries/Linux/Mathematica /usr/local/Wolfram/Mathematica/8.0/SystemFiles/FrontEnd/Binaries/Linux/Mathematica ...$ ls /usr/local/Wolfram/Mathematica/8.0/SystemFiles/FrontEnd/Binaries/Linux/Mathematica /usr/local/Wolfram/Mathematica/8.0/SystemFiles/FrontEnd/Binaries/Linux/Mathematica All the files above have 755 permissions, in case anybody is wondering about that. I can show the screen readout for that too, if anyone is still skeptical. I would appreciate any suggestions, although I would like them to involve getting Mathematica to run in LUbuntu. I would prefer to change my operating system only as a last resort.


How to make Mathematica simplify $\cos[(i + j + k)\pi]$ to $(-1)^{i+j+k}$?

We know that: $$ \cos\left[(i+j+k)\pi\right] = (-1)^{i+j+k} $$ for $i, j, k$ being positive integers. In _Mathematica_ I've tried:               FullSimplify[Cos[(i + j + k)*Pi], Assumptions -> Element[{i, j, k}, {Positive, Integers}]]      But it still returns the `Cos` function. Does anyone know how to perform this simplification?


How can I check which file is modified in specific directory?

I want to find which files are recently modified in a specific directory. For this purpose, I wrote a function named `Test`. The function's argument is `DirectoryPath`, and it returns file names whose file dates have been modified. In this example the functions runs once every five seconds. For this purpose I wrote the following code, but it shows all the file names that are in the directory. That means it doesn't check the `ModificationDate` with `lastModified`.               Test[directoryPath_] := Module[{taskId,        fileNames = FileNames["*", SystemDialogInput["Directory"]],        lastModified,        result},       (        lastModified = Table[{}, {Length[fileNames]}];        result = Table[{}, {Length[fileNames]}];        taskId =          CreateScheduledTask[          Table[(With[{             i = i,              modificationDate =                Table[FileDate[Part[fileNames, j], "Modification"],                 {j, 1, Length[fileNames]}]              },            (If[(Part[lastModified, i] === Part[modificationDate, i]),              (Part[result, i] =  ""),               (Part[lastModified, i] = Part[modificationDate, i];               Part[result, i] = Part[fileNames, i])])]),           {i, 1, Length[fileNames]}],          {OptionValue[ScanRate], \[Infinity]}];        StartScheduledTask[taskId];        {taskId, Dynamic[result]}        )]          Test[SystemDialogInput["Directory"]]      How can I solve this?


How to plot particular piecewise defined functions in mathematica

How to plot such functions in _Mathematica_? Let $a_0, p,g,c$ be any positive integers, defining: $$a_{n+1} = \begin{cases}\frac{a_n}{p} &, a_n \text{ divisible by p}\\\ ga_n +c &, a_n \text{ odd}. \end{cases}$$ PS I am new to _Mathematica_ , I am really sorry if my ignorance is borderline offensive.


Using Mathematica to derive the PDF of the normal distribution

I am trying to use _Mathematica_ , in this case in a well known and rather simple list of equations, but I get stuck whit _Mathematica_. Since I am just starting to use _Mathematica_ for mathematical purposes, I am aware that this might be to simple. However, I would like to get a good demonstration of how to proceed. I am trying to follow: This page Normal Distribution Here is what I have done so far.               D[f[x], x]          D[f, f] == -k (x - μ) \[DifferentialD]x          D[f, f] == -k (x - μ) \[DifferentialD]x     ∫\[DifferentialD]f/f == ∫(x - μ) \[DifferentialD]x          Log[f] == x^2/2 - x μ (     Log[f] == x^2/2 - x μ + Log[c]     Solve[Log[f] == x^2/2 - x μ + Log[c], f]      This is where I get stuck, and if you look at the page that I have linked, you see that this is not the answer given there. Could someone who is capable provide a step by step solution of how to derive this. I think it would be helpful for many people just starting to use _Mathematica_ for this purpose. I also think that having an example to look at would make it easier to find your own solutions later on in other cases.


Alternative to xor(A,B,C)

How can we make a comprehensive statement, which will correspond to the truth table of xor (A, B, C) (means that only true if exactly one of A,B,C is true) by combining logical operators AND (&), OR (|), XOR (xor) and NOT (!)?


Get correlation matrix when using FindGraphCommunities

Does somebody know how to get the correlation matrix when using `FindGraphCommunities` (Social Network analysis) using the "Spectra" option? Can somebody tell me as well where the package for Social Network analysis (to see construction of function) resides in the Wolfram file system? I checked in Combinatorica, but I don't find the functions of Social Network analysis. (Mathematica V9)


Define operator algebra

My objective is to work out commutators like this $$[f(x,y)\partial_x^2+g(x,y)\partial_x+h(x,y),a(x,y)\partial_x^2+b(x,y)\partial_x+c(x,y)]$$ or $$[f(x,y)\partial_x^2+g(x,y)\partial_x+h(x,y),a(x,y)\partial_y^2+b(x,y)\partial_y+c(x,y)]$$ by starting from simpler commutator identities, for example, using $$[\partial_x,f(x,z)]=f_x(x,z)$$ it is easy to derive $$[\partial^2_x,f(x,z)]=2f_x(x,z)\partial_x+f_{xx}(x,z)$$ and so on, until I get to the first two commutators that I want. But how can I do that with Mathematica? My difficulty is that I don't know how to teach Mathematica to use identities like the third equation to derive the fourth and up to the first two.


Text[] using Graphics

Graphics[{       Text[            Style["Jean", 14, Bold, "Helvetica", Black,          TextAlignment -> Right],{1, 1}],            Text[            Style["Claude", 10, "Helvetica", Bold, Black,             TextAlignment -> Right], {19, .8}]},           PlotRange -> {{0, 21}, {0, 2}}, ImageSize -> 300,      Method -> {"ShrinkWrap" -> True},      ImagePadding -> 2,      ImageMargins -> 0]      ![enter image description here](http://i.stack.imgur.com/HTBO6.png) **Now if i just try to add a small`Rectangle[]`, the `Text[]` disappear.**               Graphics[{       Rectangle[{18, 0}, {20, 2}],       Text[            Style["Jean", 14, Bold, "Helvetica", Black,          TextAlignment -> Right],{1, 1}],            Text[            Style["Claude", 10, "Helvetica", Bold, Black,             TextAlignment -> Right], {19, .8}]},           PlotRange -> {{0, 21}, {0, 2}}, ImageSize -> 300,      Method -> {"ShrinkWrap" -> True},      ImagePadding -> 2,      ImageMargins -> 0]      ![enter image description here](http://i.stack.imgur.com/GyxyQ.png)


How do I NOT change the input/output number when editing?

I tried to search for a topic on this, but didn't seem to find anything, so here goes. I'm pretty new to Mathematica, so there are a lot of things I don't know yet, but one thing is pretty annoying so far. If I type something, lets say 10 lines with functions, variables, matrices and so on, and I push SHIFT + Enter on each line to get an output. Then I can either give each function, plot etc. a name or some sort, so I can use it always. But I can also, at least I've seen, use %, and then it takes the last output, if I'm not mistaken, or else I can use %(number) to define which output I want to use. But, and now comes the problem, if I want to change something in a previous line, let's say a value in a matrix needs to be changed, and I SHIFT+Enter that line again to update the output. Then the input/output number changes, and the places where I have used the % command, and want to update as well, are now flawed because the input/output is not the same as before. As I said, I find it pretty annoying that I just can't change a tiny value without affecting the whole document. But maybe it's just because I'm a noob, and don't know how to do it ? Thanks in advance.


Improving performance in the generation of random (directed acyclic) graphs

I need to generate large (directed, acyclic, transitive) graphs. My code in Mathematica gets very slow for large numbers of vertices. I've tried a number of approaches and I can't find any significant improvements on speed. The graphs are generated as follows. You are given a list `aList` of size `nS` of randomly generated points (tuples of reals) and a boolean "edge function" `f` acting on pairs of such points. You then generate a graph with `nS` vertices labelled by integers `i = 1,...,nS` whose edges are found as follows: `f(aList[[i]],aList[[j]]) == True` $\iff$ `i->j`. The properties of `f` are always such that the resulting graph is a transitive DAG. Here an explicit example. My list of points (2-tuples in this case) is               nS = 1000;     aList = Sort[Table[{RandomReal[], RandomReal[]}, {nS}]];      and my edge function is               f[i_, j_] := aList[[j, 1]] - aList[[i, 1]] > Abs[aList[[j, 2]] - aList[[i, 2]]]      Now I want to generate my graph. I have thought of either finding all the `Rules` (edges) using Reap/Sow or computing an adjacency matrix, but all the approaches I have tried are very slow for large `nS`. Below my different approaches:               r1 =       Reap@Do[If[f[i, j], Sow[Rule[j, i]]],    {i, nS}, {j, i}]; // Timing     r2 = ParallelTable[If[f[i, j], Rule[j, i], ## &[]], {i, nS}, {j, i}]; // Timing     r3 = ParallelTable[If[f[i, j], 1., 0.],             {i, nS}, {j, i}]; // Timing          (*      {4.626997, Null}     {2.023294, Null}     {1.397499, Null}     *)      Each of these approaches is very slow for nS = 1000 already. To generate a boolean adjacency matrix this way in C++ takes me ~0.01 seconds instead of ~1.0 second. Is there some way to improve performance in Mathematica? Perhaps using Compile? I have tried tweaking different things without much success. I haven't given any background/motivation but if you'd like me to I'd be happy to explain.


The output is the same as Input when I add the boundary conditions to a PDE

I am trying to solve a PDE in the first order with specific boundary conditions. When I solve use DSolve without the boundary conditions, _Mathematica_ gives me an answer in an arbitrary function. When I put the boundary conditions, it doesn't solve it. Could someone please help me with this issue (word of caution: I am new to _Mathematica_ ). Thank you advance in time. Code:                pde = D[S[x, y, z], x] + D[S[x, y, z], y] + D[S[x, y, z], z] - A*S[x, y, z] - B == 0      Here A and B are known constants and S[x,y,z] is the solution I am looking for. Then I simply use               DSolve[{pde, S[0,y,z] ==0, S[x,y,0] ==0, S[x,0,z] ==0}, S[x,y,z] , {x,y,z}]      This returns me the output equivalent to the input! Thank you.


Wolfram Light Weight Grid and parallel computing

I have attempted to set up and use the Wolfram Lightweight Grid Manager so I can do parallel computing from Mathematica using 2 remote processors on another machine on my local network. My computing environment includes: Computers: Name: iMac 6   27" iMac, 3.06 GHz Intel Core 2 Duo; 4 GB 1067 MHz DDR3. Mathematica version: 8.0.1.0 Name: iMac 7 27" iMac, 3.06 GHz Intel Core 2 Duo; 4 GB 1067 MHz DDR3. Network: Apple Time Capsule -- note the 2 iMacs connect to the Time Capsule by hard wired ethernet connections. No internal firewall prevent access to "iMac 7". As my license supports 4 processors for parallel computing, it should enable me to identify the 2 remote processors and then distribute computations across them and the 2 on my main machine. I've installed Wolfram LightWeight Grid Manager on iMac 6, my main Mathematica machine. When I look at Preferences>>Parallel it looks like the following: ![Preferences](http://i.stack.imgur.com/23dTn.png) You can see that it identifies the kernels at IP address 10.0.10.22, my iMac 7 machine, but in the "Parallel Kernel Status" window only the kernels on iMac 6 appear as available. I run the following in a notebook to attempt to identify and launch the remote kernels:               SetSystemOptions["ParallelOptions" -> "MathLinkTimeout" -> 120]; (* SETTING AS ADVISED BY PREMIER SUPPORT *)          Needs["LightweightGridClient`"]          $ProcessorCount     ParallelEvaluate[$ProcessID]     ParallelEvaluate[$MachineName]     $MaxLicenseSubprocesses          2     {50948, 50950}     {"iMac-6", "iMac-6"}     4          RemoteServicesAgents[]     {"http://10.0.10.22:3737/WolframLightweightGrid/Manager"}          (* THE ABOVE SEEMS TO MAKE SENSE BECAUSE THE IP ADDRESS IF THE REMOTE MACHINE IS: 10.0.10.22 *)          $KernelCount          2          CloseKernels[] (* JUST TO GET A CLEAN START *)               LaunchKernels[] (* GIVES THE FOLLOWING ERROR *)          RemoteKernelOpen::lwgconnect: Unable to connect to http://10.0.10.22:3737/WolframLightweightGrid/Manager.  Check network connectivity and the spelling of the hostname or URL of the remote computer. Confirm that a Lightweight Grid Manager is running on the remote computer. >>          {KernelObject[17, "local"], KernelObject[18, "local"], $Failed, $Failed}      Apparently, Mathematica can see the 2 processors on my local machine (iMac 6 IP address: 10.0.10.3), but cannot reach the additional processors on the remote machine (iMac 7:IP address: 10.0.10.22). The Wolfram Lightweight Grid Manager opens up in a browser. It has a "Licensing" tab that asks for a login, but interestingly does not accept either the administrative login for the computer or any of the 2 user names and passwords that one has to set up when one installs and configures the Lightweight Grid Manager. The how to video (see link) doesn't make this clear. Not certain what to try next. Do I need to install some kind of grid client software on the remote computer? Do I need to login to the remote computer from the local one? Do I need to have Mathematica installed on the remote computer? I've gone through the documentation, and I have to say I have not found it the clearest that Wolfram has produced. I seem to have missed something. Does anyone have an idea of how to configure this so I can launch remote kernels and access them?


How to combine multiple functions into a single function, indexed bya new argument

I have a system of expressions (matrices) which correspond to increasing orders of precision in a theory. These expressions are quite complex (require about 40+ lines of code to produce) and are not of equal size (the dimension increases monotonically with the order in the theory). For this reason, I have resigned myself to not creating a single cell which produces all orders. Suppose I already have functions:               f1[x_, y_] = {{x, y}, {x y, x + y}}       f2[x_, y_] = {{x, y, 0}, {0, x + y, 0}, {1, x - y, x y}}         and I would like to produce a new function               g[(*something*),x_,y_]         such that               g[1,x_,y_] = f1[x_,y_]     g[2,x_,y_] = f2[x_,y_]        Can this be accomplished? Is there a way to form a conditional on the arguments of a function? Something like               g[j_,x_,y_]=If[j==1,f1[x_,y_],f2[x_,y_]]        This doesn't work, of course, because the first argument isn't actually assigned to j. I guess I'm more surprised it doesn't work to just define g[1,x_,y_] and g[2,x_,y_] individually as above, but it doesn't work.


Can this be written well, without loops?

Inspired by this question I would like to know if the following code can be written without explicit loops (For, While, etc.) in a clean, efficient and non-contrived way. I have been unable to do so.               max = 5000;     a = ConstantArray[0, max];     x = y = z = n = 1;     val := 2 (2 n^2+(y-2) (z-2)+x (y+z-2)+2 n (x+y+z-3));     For[x = 1, val <= max, x++,      For[y = 1, val <= max && y <= x, y++,       For[z = 1, val <= max && z <= y, z++,        For[n = 1, (r = val) <= max, n++,         a[[r]]++        ]; n = 1       ]; z = 1      ]; y = 1     ]      The output is the array `a`.


How to select elements with a specific style of a list?

Suppose I have a list:   ![my_list](http://i.stack.imgur.com/mLsYF.png)   where 3 'up's of the list are red(I've made it to Cell Expression as follows).               Cell[BoxData[     RowBox[{"{",      RowBox[{StyleBox["up", StripOnInput -> False,         LineColor -> RGBColor[1, 0, 0],         FrontFaceColor -> RGBColor[1, 0, 0],         BackFaceColor -> RGBColor[1, 0, 0],         GraphicsColor -> RGBColor[1, 0, 0],         FontColor -> RGBColor[1, 0, 0]], ",", "right", ",", "up", ",",        StyleBox["up", StripOnInput -> False,         LineColor -> RGBColor[1, 0, 0],         FrontFaceColor -> RGBColor[1, 0, 0],         BackFaceColor -> RGBColor[1, 0, 0],         GraphicsColor -> RGBColor[1, 0, 0],         FontColor -> RGBColor[1, 0, 0]], ",", "down", ",", "down", ",",        StyleBox["up", StripOnInput -> False,         LineColor -> RGBColor[1, 0, 0],         FrontFaceColor -> RGBColor[1, 0, 0],         BackFaceColor -> RGBColor[1, 0, 0],         GraphicsColor -> RGBColor[1, 0, 0],         FontColor -> RGBColor[1, 0, 0]], ",", "right", ",", "down",        ",", "left"}], "}"}]], "Output",      CellChangeTimes -> {3.6183594862091923`*^9}]      Then, how can I pick out those elements with style red? Or more, with a specific style?   I tried to use `Select[list, Style[#,Red] &]` and `Cases[list, Style[#,Red] &]`, but yield nothing.   Thank you!


Is it possible to have Mathematica move all terms to one side of an equation?

I have an inequality expression that I would like to express in terms of the relation of the parameters to zero. More simply, I want to have mathematica move all the terms to one side of the inequality so that it is expressed as $x - y \geq 0$. Currently it is expressed as $x \geq y$. The expressions inside $x$ and $y$ are much more complex, of course. Is this possible? It seems I need to provide some assumptions about the relations between variables, but it isn't clear to me how to do this.


Best way to transform text into number in a big array

I have a big array of data that I imported from a lot of XML files. To get the data, among other manipulations, I use this function:               Cases[xml,XMLElement[nodeName,_,a_]-> a,\[Infinity]]      When I get my final array, I have a lot of number fields that are as `String` and that I need to convert into `Number`. To do that I created this function:               clean[data_]:=Map[If[NumberQ@ToExpression[#],ToExpression[#],#]&,data,{-1}]       The problem is that I have strings with "??" characters, so if o use `clean` on it as for example:               clean[{"asd??asd", "123.3"}]      Mathematica try to interpret the first element as context ones. And I get:               Global`asd      How to avoid it? How can I improve my `clean` function, or the way I load de XML?


SemanticImport mis-interprets CSV

`SemanticImport` misinterprets rows with trailing blanks. Note the commas in the 2nd column: SemanticImport["https://docs.google.com/spreadsheet/pub?key=0Ati- pfGwn22sdGt1T3E4S3NFYWxmQXY2ZUJ0MmhXd2c&output=csv", Delimiters -> ",", HeaderLines -> 1] ![enter image description here](http://i.stack.imgur.com/cHGfq.png) `Import[...,Delimiters->","]//Dataset` doesn't recognize the header line identifiers as keys. (Note Google has deprecated csv web pub of gsheets)


Plot a table of ranges

I have table with values like:               t = {1.234 <= a <= 2.345, 3.42 <= a <= 5.67, ...}      and I want to plot this table, the `x axis` should be the number of element in table (first value, second value etc.) and the `y axis` should be values of `a` which satisfy the inequality


How to visualize 3D fit

I have a data set of `x,y,z` values and I fit a function of `x,y` to the data. This works, but I can't come up with a nice way to visualize the data. 3D plots are not very clear on paper and a contour plot of two data sets doesn't work either. What would be a clear and simple way to show the data and the fit?               data = Import["https://dl.dropbox.com/u/3538352/data.dat"];     fit = NonlinearModelFit[            data,             A*Exp[-(y - y0 - y1 Cos[2 (x/180*Pi)])^2/(w0 + w1 Cos[2 x/180*Pi])^2],            {A, {y0, 0.04}, {y1, 0.00}, {w0, 0.03}, {w1, 0.01}},            {x, y}           ];     Show[          ListPointPlot3D[data],          Plot3D[fit["BestFit"], {x, 0, 180}, {y, 0, 0.1}]         ]      **EDIT:** What I decided to do for now is using a `DensityPlot` of the data with the `ContourPlot` of the fit (similar to Rahul Narain's answer). This does not really show the quality of the model, so I will add other plots, candidates are   * residuals vs. predicted values (similar to chris's answer)   * distribution of residuals (chris's answer)   * Q-Q plot using `QuantilePlot[fit["FitResiduals"]]`   * the plot Rahul Narain suggested ![enter image description here](http://i.stack.imgur.com/LlTpY.png)


How to represent a list as a cycle

I want to select distinct cycles (represented by List). The cycle `{a, b, c, d}` must be the same as `{b, c, d, a}` or `{c, d, a, b}` or `{d, a, b, c}`. But is not equal to `{a, c, b, d}`. The distinct cycles from this set               {{a, b, c, d}, {a, b, d, c}, {a, c, b, d}, {a, c, d, b}, {a, d, b, c},       {a, d, c, b}, {b, a, c, d}, {b, a, d, c}, {b, c, a, d}, {b, c, d, a},       {b, d, a, c}, {b, d, c, a}, {c, a, b, d}, {c, a, d, b}, {c, b, a, d},       {c, b, d, a}, {c, d, a, b}, {c, d, b, a}, {d, a, b, c}, {d, a, c, b},       {d, b, a, c}, {d, b, c, a}, {d, c, a, b}, {d, c, b, a}}      must be `{a,b,c,d},{a,b,d,c},{a,c,b,d},{a,c,d,b},{a,d,c,b},{a,d,b,c}`. I want to know whether any two cycles are the same or not. The cycle I involve has length 14. For example,               {a1, a2, a5, a6, a7, b1, b2, b3, b4, b5, b6, b7, a3, a4}          {a1, a2, a3, a4, a5, a6, a7, b1, b2, b3, b4, b5, b6, b7}          {b1, b2, b3, b4, b5, b6, b7, a3, a4, a1, a2, a5, a6, a7}      How to code in Mathematica?


Labeling points of a list in plot

A list of georeferenced points is:               coord = {{3.54231*10^6, 5.43395*10^6}, {3.54235*10^6,        5.43395*10^6}, {3.54239*10^6, 5.43396*10^6}, {3.54231*10^6,        5.43398*10^6}, {3.54235*10^6, 5.43399*10^6}, {3.54239*10^6,        5.434*10^6}, {3.5423*10^6, 5.43402*10^6}, {3.54234*10^6,        5.43403*10^6}, {3.54238*10^6, 5.43404*10^6}, {3.54229*10^6,        5.43406*10^6}, {3.54233*10^6, 5.43407*10^6}, {3.54237*10^6,        5.43408*10^6}, {3.54228*10^6, 5.4341*10^6}, {3.54232*10^6,        5.43411*10^6}, {3.54236*10^6, 5.43412*10^6}}      I would like to label each point of this list with the number of the position of the point in this list. How can I do this?


How to assign graph-node label as node value?

I am facing the following problem: I need to work on several already-designed graphs, accessible in ".DOT" format. Mathematica can perfectly read these graphs, however because the nodes of the graphs only contains "IDs" instead of the actual textual data I'm interrested in. The data are stored in node- labels. So if I do a something like that:               argGraph = Import["http://www.arg.dundee.ac.uk/AIFdb/dot/4"]     VertexList[argGraph]      I only get a list of IDs: {"234", "235", "236", "237", "238", "239"} How can I easily reformat the graph so that the labels are assigned as node values ? The Graph looks like this: Graph Image and is a representation of this argument map: Argument Map Thanks a lot for your help.


Is there a way to access the (lexically) current colour inside Graphics?

Note that this is not a duplicate of the question over there. That one asks for a given point, while I'm asking about the lexical structure (which, of course, is not directly related to any point in the final graphics). What I want to know is whether there's a way to access the currently set colour. For example, let's assume I write the following function:               mydisk[p_,r_]:={EdgeForm[Darker[CurrentColor]],Disk[p,r]}      and then use it like this:               Graphics[{Red, mydisk[{0,0},1], Green, mydisk[{1,1},1]}]      it should be equivalent to               Graphics[{Red, {EdgeForm[Darker[Red]], Disk[{0,0},1]},               Green, {EdgeForm[Darker[Green]], Disk[{1,1},1]}}]      Is this possible, and if so, what would I write in the place of `CurrentColor`?


Why are some functions available without having to load their parent package?

Functions such as `GraphDistanceMatrix[]` or `AdjacencyMatrix[]` are available without invoking               Needs["GraphUtilities`"]      . Why isn't the whole package available when _Mathematica_ starts? Are the functions different after having loaded `GraphUtilities`?


Export Plots to $\LaTeX$

What is the quickest and best way to export a plot image from Mathematica to a $\LaTeX$ Editor? Is there something quicker than exporting it to an image and then including it in the $\LaTeX$ document?


How can this confetti code be improved to include shadows and gravity?

Here's some confetti:               Graphics@Table[{         RGBColor @@ RandomReal[{0, 1}, 3],         Translate[#, RandomVariate[NormalDistribution[], 2]] &@         Rotate[#, RandomReal[{0, 2 \[Pi]}]] &@         Scale[#, .1] &@         GeometricTransformation[             #,             ShearingTransform[                 RandomReal[{-45, 45}] Degree,                 {1, 0}, {0, 1}             ]         ] &@         Translate[Rectangle[], {-.5, -.5}]     }, {1000}]      ![enter image description here](http://i.stack.imgur.com/9Rd4x.png) How can this code be improved, for example, by including shadows, raytracing or the effects of gravity to make it more realistic?


How to fix broken InterpolatingFunction?

I have an `InterpolatingFunction` based on irregularly-gridded data, like this:               int=Interpolation[{{0,0,1},{1,0,1},{0,1,1},{1,1,1},{0.5,0.5,0}},InterpolationOrder -> 1]      > >     InterpolatingFunction[{{0.00075,0.00735},{0.00335,0.00555}}] >                 int[0.5,0.5]      > >     0. >   that I want to save in a file for later, using a recommendation from Szabolcs in a comment on this question:               Export["test.mmaz",Compress[int],"String"];      but importing it returns a broken function               intNew=Uncompress[Import["test.mmaz"]]      > > > InterpolatingFunction[{{0.,1.},{0.,1.}},{4,4225,0,{5,0},{2,2},0,0,0,0,Automatic},{NDSolve`FEM`ElementMesh[{{0.,1.},{0.,1.}},{NDSolve`FEM`TriangleElement[<4>]}]},{1.,1.,1.,1.,0.},{Automatic}] >   Not what I expected. Moreover, it does not evaluate with arguments:               intNew[0.5,0.5]      > > > InterpolatingFunction[{{0.,1.},{0.,1.}},{4,4225,0,{5,0},{2,2},0,0,0,0,Automatic},{NDSolve`FEM`ElementMesh[{{0.,1.},{0.,1.}},{NDSolve`FEM`TriangleElement[<4>]}]},{1.,1.,1.,1.,0.},{Automatic}][0.5,0.5] >   And yet               intNew == int      > >     True >   As far as I've seen this behaviour does not arise when using regularly-gridded data. I'm not aware of the full scope of the issue. What breaks the `InterpolatingFunction` on import? Is there a fix for an existing saved function? What is the correct way to store the function safely?


Specifying form in MemberQ

This seems like a very simple question, the answer to which should be obvious to me. So I won't be offended if this question is closed. But I'm having trouble figuring out the answer. I would like to write a function that returns `True` if a list contains one or more numbers greater than 1. Why does `MemberQ[{2, 1}, # > 1 &]` return `False`? Thanks.


Label Markers On ListPlot

I would like to make a scatter plot where each element corresponds to a certain energy. Each plot marker should have its corresponding element next to it. IE. The data point at -1.16187 should have "Sc" next to it. How can this be done?               data = {-1.16187, -1.48643, -3.31205, -0.541609, -4.18021, -4.79914,        -4.3378, -3.10561, -0.968065, -1.1105, -8.40646, 0, -1.61386,        -1.12215, -1.55604, -1.40126, -1.23439, -1.01761, -1.31265, -1.63032,        -1.4456, -0.944587, -1.45256, -1.49496, -1.38007, -1.12108, -1.04517};          elements = {"Sc", "Ti", "V", "Cr", "Mn", "Fe", "Co", "Ni", "Cu", "Zn", "Y",        "Zr", "Nb", "Mo", "Tc", "Ru", "Rh", "Pd", "Ag", "Hf", "Ta", "W",        "Re", "Os", "Ir", "Pt", "Au"};          p1 = ListPlot[{#} &@data, FillingStyle -> Thick,       PlotMarkers -> {Automatic, Medium}]


Complex result for Real vectors in VectorAngle

I was expecting a real angle using VectorAngle when passing real valued vectors, however I obtained a complex angle.               VectorAngle[{-2.7432000000000016`, 0.`, 0.`},{2.743199999999973`, 0.`, 0.`}]      returns               3.14159 - 2.10734*10^-8 I      I was expecting 3.14159 (pi) as this is essentially a half circle. My guess is the precision of the numbers results in the imaginary portion. 3 possible solutions are:   * using Round[result,10^-7], which works for this case, but future cases might have an imaginary part larger than 10^-8    * using Re[result], a better solution. Interestingly, using Round on the vectors to some sufficiently small value results in an exact solution. For example I rounded to the nearest 10^-100 and got the exact value of pi Going forward I'll probably just take the real part of the result, but is this the expected behavior in Mathematica for this function?


Get rid of "Testing Notebook" toolbar

I was messing around with different styles and tried the MUnit style. I converted back to Standard Report but I still see the toolbar for testing notebook. Is there a way to get rid of it? ![Want to get rid of this "toolbar"](http://i.stack.imgur.com/m8W1p.png)


Solving a system of nonlinear equations?

I'm relatively new to using Mathematica so I'm not sure if this is really even possible, but I figured it may be worth a try. In my Physical Chemistry class today, we were learning about acid/base equilibria, and for one particular problem it came to a point where we had a system of 6 unknowns in 7 equations, however these were nonlinear equations so simple calculator tools and matrices wouldn't be sufficient to calculate them. So I thought perhaps Mathematica would be powerful enough to be able to write a script of some sort to be able to solve them. The equations in question are as follows. Typically these variables are actually concentrations of some compound, but I've just replaced them with letters to make it simple: 1: x + y = 2z + a + b 2: x + c = 2(z + a) 3: 276 = (x^2)(z) 4: 5.7x10^-10 = [(y)(c)]/(x) 5: 9.8x10^-13 = [(b)(a)]/(z) 6: 9.25 = -log(y) 7: 1x10^-14 = y + c and we need to solve for x, y, z, a, b, and c. Can this really be done in a simple way? Thanks for any input!


Row-Reduced-Echelon-Form with Equation Parameters for Consistent Systems

I often do row-reduced-echelon-form (RREF) calculations that involve parameters using the _RowReduce_ command. Most times, I want to know which parameters make the system consistent. For example:                RowReduce[{{1, 2, 3, a}, {4, 5, 6, a^2}, {7, 8, 9, a^3}}]      Mathematica reduces this to its lowest form, which results in an inconsistent system because the last row is {0,0,0,1}. However, if you look at the details of the the steps it takes (using WA with rref {{1, 2, 3, a}, {4, 5, 6, a^2}, {7, 8, 9, a^3}}), it shows the point where you could see that choosing $a = 0$ or $a = 1$ would produce a consistent system with infinite solutions. Either of these values for $a$ makes the last row of the rref {0,0,0,0}. Is there a way to get Mathematica to show this reduction without losing that important fact or to state which values of the parameters make the system consistent? Maybe I should be using a different command or approach. It is also interesting that rref is able to successfully find the result for this two parameter example:                RowReduce[{{a, b, 1, 1},{1, a b, 1, b},{1, b, b, 1}}]


How to programmatically remove menu items

I would like to do the opposite of what is described here. So rather than add a menu item I would like to programmatically remove one (or more). So given a knowledge of the structure of the menu *.tr file ![enter image description here](http://i.stack.imgur.com/MKQAu.png) ...I am looking for something like `RemoveMenuCommands` such that if I wanted to remove **Format > Clear Formatting** I could enter something like this:               FrontEndExecute[RemoveMenuCommands[{"Format", "Clear Formatting"}]]      Does anyone have any thoughts?


What's wrong with my graph input?

So I saw this picture on my book and it was left as an exercise to figure out. ![enter image description here](http://i.stack.imgur.com/vbtyD.png) This is what I have so far, but I'm not sure where I went wrong.                Plot[{t^3 - t}, {t, -1, 1}, PlotStyle -> Blue, Exclusions -> {t == 1},Exclusions -> {t == -1}, Exclusions -> {s == 2/(3*Sqrt[3])},Exclusions -> {s == -2/(3*Sqrt[3])}, ExclusionsStyle -> {Pink}]             I think somewhere I should use Epilog for that red dot, but with my original input incorrect, I cannot go any further.


How to be faster at making a frequency list of increasing steps

I want to find propabilities of having a sequence in a list, by using frequencies. The case is that you will bet on an increase when the last event had an increased and bet on derease when the last event had a decrease. This is what I found. But I want to do it faster an with more a lot more data               imput = {395.13, 395.24, 391.25, 394.76, 395.15, 394.9, 396.31,        394.46, 394.8, 396.28, 397.66, 396.86, 394.48, 396.4, 396.14,        396.62, 395.58, 391.69, 387.08, 384.91, 388.26, 386.84, 384.7,        381.6, 377.44, 375.98, 380.49, 379.66, 385.17, 388.34}               growth = Ratios[imput] - 1      > >     {0.000278389, -0.0100951, 0.00897125, 0.000987942, -0.000632671, >      0.00357052, -0.00466806, 0.000861938, 0.00374873, 0.00348239, >     -0.00201177, -0.00599708, 0.00486717, -0.000655903, 0.00121169, >     -0.00262216, -0.00983366, -0.0117695, -0.00560608, 0.00870333, >     -0.00365734, -0.005532, -0.00805823, -0.0109015, -0.00386816, >     0.0119953, -0.0021814, 0.014513, 0.00823013} >   (I delete zeros, so I have a smooth list, but it is not necessary)               sign = Sign[growth]      > >     {1, -1, 1, 1, -1, 1, -1, 1, 1, 1, -1, -1, 1, -1, 1, -1, -1, -1, -1, >     1, -1, -1, -1, -1, -1, 1, -1, 1, 1} >                 direction = Drop[Prepend[sign, 0]*Append[sign, 0], -1]      > >     {0, -1, -1, 1, -1, -1, -1, -1, 1, 1, -1, 1, -1, -1, -1, -1, 1, 1, 1, >     -1, -1, 1, 1, 1, 1, -1, -1, -1, 1} >   (this is to see when we where right. the first time there is no prediction so we where wrong either way. The second time predicted an increase, since 380.49 was bigger then 375.98 and the last event had an increase, but returned a decrease (379.66). So the second time we lost. etc)               row = Quiet[       RecurrenceTable[{a[day + 1] ==           If[Part[Drop[direction, 1], day] > 0.5,            a[day] + Part[Drop[sign, 1], day], Part[Drop[sign, 1], day]],          a[1] == Part[sign, 1]}, a, {day, 1, Length[Drop[sign, 1]]}],        Part::pspec]      > >     {1, -1, 1, 2, -1, 1, -1, 1, 2, 3, -1, -2, 1, -1, 1, -1, -2, -3, -4, >     1, -1, -2, -3, -4, -5, 1, -1, 1} >   (I am not proud of this formula, so I hope someone has an easyer way for doing this. This finds the length of a sequence increase or decrease in a row. Where "-2" means the second decrease in a row.)               frequencyRow = Table[Count[row, Part[row, n]], {n, Length[row]}]          {9, 8, 9, 2, 8, 9, 8, 9, 2, 1, 8, 3, 9, 8, 9, 8, 3, 2, 2, 9, 8, 3, 2,      2, 1, 9, 8, 9}      (where this is the secon formula i dont like, which shows the frequency of the amount of times it increases or decreases on the places of the bet)               chanceRow = Round[frequencyRow/Length[row], 0.01]      > >     {0.32, 0.29, 0.32, 0.07, 0.29, 0.32, 0.29, 0.32, 0.07, 0.04, 0.29, >     0.11, 0.32, 0.29, 0.32, 0.29, 0.11, 0.07, 0.07, 0.32, 0.29, 0.11, >     0.07, 0.07, 0.04, 0.32, 0.29, 0.32} >   (where this is the chance of the event) Please help me polishing this, it does not matter if it is a totally different way as long as it is easier or fast, because I just really don't like the recurrence table (since I want to upgrade this project to a function like `chanceRow[x1_,x2_,x3_]:=` and the recurrence table then gets slow or shows errors)


Density map strange mapping of color

I tried to convince _Mathematica_ 8 to plot a density map of a function: $$f(x,y) = \frac{2(x^2 - y^2)-1}{(x^2 + y^2)^2}$$ with color scheme called "TemperatureMap". At $x = \pm 1$, $y = 0$ it's completely correct, but at $y = \pm 1$, $x = 0$, it shows white color, where, in fact, it should be blue. I'm only interested in the region $x^2 + y^2 > 1$, so I added the command: `ColorFunctionScaling -> False` and manually rescaled my function to take values only between 0 and 1: $$g(x,y) = \frac14 (3+f(x,y))$$ as I know where the maxima and minima occur in the region I'm interested in. The plot is even more strange, leaving almost no blue and, of course, at $x = 0, y = \pm 1$ it's white. Whole input I used was (PlotPoints so I can get higher quality plot, Exclusions so I can see where's the boundary of region I'm interested in):               DensityPlot[(3 + 2*(x^2 - y^2)/(x^2 + y^2)^2 - 1/(x^2 + y^2)^2)/       4, {x, -3, 3}, {y, -3, 3}, PlotPoints -> 100,       ColorFunction -> "TemperatureMap", Exclusions -> {x^2 + y^2 == 1},       ColorFunctionScaling -> True]      ![Mathematica graphics](http://i.stack.imgur.com/3SdZj.png) I expected a similar density map to the second image on this page. Instead the space approximately $(y/1.2)^2 + x^2 < 1$ is white. The region left of the white part is not exactly an ellipse, it looks like a ladyfinger. Where did I make a mistake? I tried to plot a constant function 0 and 1 while `ColorFunctionScaling` being false and it correctly showed whole plot blue and red respectively. I don't have the slightest clue what went wrong. I'd appreciate any help.


To write an array by varying two variables

I have a equation G=2X+Y, Now i changed X and Y together from 1 to 10 . I got various values Of G. I have done this by using Table command ,Now I want to plot a graph between G and X, i could not find any command to plot this.can you help me


Testing Equality Expression?

Even if in               Graph[{1 -> 2}] == Graph[{1 \[DirectedEdge] 2}]      the answer is `True` ; but why MMA doesn't show the result of the following expression?Neither `True` nor `False`.What is the reason?               {1 -> 2} == {1 \[DirectedEdge] 2}


Time approximation of decrypting RSA algorithm

I've written a function that encrypts a text using the RSA algorithm. It then decrypts it using prime factorization, and takes the time it took to decrypt it and puts it in a vector together with the length of the N variable in the RSA algorithm. I do this with a length of N from 28 to 61. I can then plot this is a graph, and try to estimate how long it would take to prime factorize an N length of 100 or larger. My problem is that I can find no suitable way to fit my values into a graph that then makes a reasonable approximation of the time it would take for say an N of the length of 100. I am using `Fit` and `FindFit`, but all of my results either end up negative for `Length[N] = 100`, or they end up something like 2 years, which is not a reasonable answer. These are my values with the length of N at index 1 and then the time in seconds at index 2.               {{28, 0.016}, {29, 0.}, {32, 0.062}, {33, 0.063}, {36, 0.062}, {37,        0.109}, {40, 0.187}, {42, 0.265}, {43, 0.281}, {45, 0.858}, {48,        4.04}, {50, 4.805}, {52, 7.941}, {54, 12.512}, {54, 11.497}, {57,        19.952}, {60, 103.803}, {61, 102.009}}      I can plot it as follows:               plot = ListPlot[TidN, PlotStyle -> Red];     a1 = a /. FindFit[TidN, a*b^x, {a, b }, x]     b1 = b /. FindFit[TidN, a*b^x, {a, b }, x]     modelplot = Plot[a1*b1^x, {x, 32, 100}, AxesLabel -> {x, y},        PlotRange -> {{20, 70}, {0, 50}}];     Show[modelplot, plot]      This results in the following: ![enter image description here](http://i.imgur.com/ISwEk.jpg) I then try to estimate the time it would take to factorize the length of an N of 100, like this:               a1*b1^100/(3600*24*365)      This gives the result in years, which isn't reasonable at all. It should, I believe, be more close to 100 years:               0.628951      How can I plot this better, and how can I find a function that estimates large numbers more easily? I can of course let my computer run and gather more data points from which I can establish a better function perhaps, but should this really be necessary since I already have 18 points to start from?


How do I avoid vector variables being treated as scalars in the course of replacements?

I often work with a mixture of symbolic and concrete values as I develop teaching materials. I introduce variables symbolically and then need to instantiate them to specific values while continuing to use the original variables. My `i` represents a vector `{1, 0, 0}` but I don't want to replace `i` with `{1, 0, 0}` _everywhere_ , just when convenient. Thus I lit upon the idea of using replacement rules rather than definitions. But things didn't work out too well:               {a, a + b} //. {a -> 4 i, b -> {0, -2, 2}, i -> {1, 0, 0}}     (* output: {{4, 0, 0}, {{4, 0, 0}, {2, -2, -2}, {6, 2, 2}}} *)      while I wanted this result instead:               {a /. {a -> 4 i}, (a /. {a -> 4 i}) + b} //. {b -> {0, -2, 2}, i -> {1, 0, 0}}     (* output: {{4, 0, 0}, {4, -2, 2}} *)      I now understand that `4 i` is treated as a constant in rewriting `a + b`:               {a, a + b} /. {a -> 4 i, b -> {0, -2, 2}}     (* output: {4 i, {4 i, -2 + 4 i, 2 + 4 i}} *)      I could attempt to control the substitution order by doing something like               {a, a + b} //. ({a -> 4 i, b -> {0, -2, 2}} /. i -> {1, 0, 0}) //. {i -> {1, 0, 0}}     (* output: {{4, 0, 0}, {4, -2, 2}} *)      But this is not very robust and won't work if substitutions are nested more deeply. I can prevent premature application of the problematic rule using conditions e.g.               {a, a + b} //. {a :> 4 i /; i ∈ Vectors[v], b -> {0, -2, 2}, i -> {1, 0, 0}}      But then the rule never gets used as the RHS of the rule is never rewritten. I don't really want to recast all the vector operators I might need following the example of this answer; this seems like overkill.   But I do already use a wrapper `bv[i]` which prints as `UnderBar[i]`. Can anyone suggest a lightweight solution? Could I make `Plus`, `Times` etc. (temporarily) _un_ -listable? BTW This issue is flagged in the documentation for `Assuming`, which does not help in this situation as `Plus` just goes ahead and uses its `Listable` attribute:               Assuming[v ∈ Vectors[2], v + {1, 2}]     (* output: {1 + v, 2 + v} *)


How can I make many runs of a simulation and plot all the results with one expression evaluation?

I have many cells, starting with this first cell:               mcRun = 20;     randomWalk[n_] := RandomVariate[NormalDistribution[0, 1], n];           RandVar = Table[randomWalk[5], {mcRun}];     Length[RandVar]      MatrixForm[RandVar[[1 ;; 10]]] (* only display first 10 *)     ListPlot[RandVar]      Then later in a 2nd cell:               CorRandVar = RandVar * 10;      Still later in a 3rd cell:               InvCor = CDF[NormalDistribution[], CorRandVar];      And there are many more cells that depend on the value of the initial parameter `mcRun` that I defined in the first cell. At the moment I use 'Evaluate Notebook' to get my results. I wait for one 'Evaluate Notebook' to complete, note down the result from running with `mcRun = 20` (20 monte carlo simulations), edit `mcRun = 20` to another value and repeat. So how could I automate what 'Evaluate Notebook' does and plot, for example, `InvCor` (or any function/value) as a function of the input parameter `mcRun`, say, from 20 to 20,000? ? Or better, how could I incorporate my simulation into a `Manipulate` to add interactivity?


How can Mathematica be used to detect an area surrounded by the most lines?

I have an array of lines that produce random shapes. These lines define edge boundaries from an array that I would like to use to reconstruct the main feature of the array. Can Mathematica find the points where most of these lines cross, and then define the largest area(s) inside these crossing points? I assume this will give me the main area(s) of the array to look at as in the example plot image. These lines are boundary lines and crossing too many reduces the accuracy of the area plot. There are 4 lines creating most boundaries. The first of those 4 is the line used in the plot below               lines={{{900., 703.449}, {590.556, 0.}}, {{900., 475.145}, {651.23, 0.}}, {{900., 286.849},      {660.333, 0.}}, {{900., 503.578}, {178.177,0.}}, {{0., 707.111}, {900., 689.133}}, {{231.482, 1093.}, {302.527, 0.}}, {{853.322, 1093.}, {568.821, 0.}}, {{513.461, 1093.},     {411.662, 0.}}, {{900., 521.686}, {514.729, 0.}}, {{280.141, 1093.}, {248.479, 0.}}, {{0., 183.582},      {900., 312.065}}, {{0., 648.073}, {900., 682.241}}, {{0.,110.149}, {900., 507.127}}, {{0., 402.186},      {900., 389.603}}, {{900., 605.326}, {324.743, 0.}}, {{706.587, 1093.}, {720.777, 0.}}, {{900., 86.9532},      {769.336, 0.}}, {{900., 539.768}, {610.491, 0.}}, {{900., 464.134}, {113.723, 0.}}, {{900.,428.16},      {47.3056, 0.}}, {{0., 1000.61}, {900., 988.023}}, {{316.911, 1093.}, {889.171, 0.}}, {{0., 337.878},      {900., 399.087}}, {{0., 492.562}, {900., 451.191}}, {{0.,344.122}, {900., 272.07}}, {{0., 151.791},      {900., 369.811}}, {{502.51, 1093.}, {352.038, 0.}}, {{0., 136.204}, {900.,460.163}}, {{177.623, 1093.}, {404.553, 0.}}, {{900., 234.416}, {665.35, 0.}}, {{900., 679.326}, {446.947, 0.}}, {{900., 1089.37}, {312.902, 0.}}, {{0., 652.435}, {900., 207.253}}, {{900.,115.841}, {712.418, 0.}}, {{900., 806.604}, {220.582, 0.}}, {{0., 783.297}, {900., 616.042}}, {{0., 1055.81}, {900., 938.313}}, {{300.376, 1093.}, {156.573, 0.}}, {{684.328, 1093.},      {770.733, 0.}}, {{0., 679.389}, {900., 733.378}}, {{900.,135.671}, {751.702, 0.}}, {{0., 1052.08},      {900., 822.61}}, {{900., 544.556}, {246.914, 0.}}, {{900., 879.237}, {32.7302, 1093.}}, {{0., 972.41},      {900., 956.231}}, {{0., 1026.6}, {900., 857.481}}, {{619.175, 1093.}, {818.911, 0.}}, {{0., 9.58286},      {900., 624.196}}, {{626.404, 1093.}, {555.359, 0.}}, {{772.244, 1093.}, {419.036, 0.}}, {{355.762, 1093.},      {105.964, 0.}}, {{900., 107.987}, {588.194, 1093.}}, {{806.666, 1093.}, {318.024, 0.}}, {{0., 86.1212},      {900., 760.554}}, {{279.164, 1093.}, {358.983, 0.}}, {{0., 27.23}, {900., 260.535}}, {{0., 169.335},      {900., 228.737}}, {{491.48, 1093.}, {96.8161, 0.}}, {{0., 404.323}, {900., 470.951}}, {{900., 681.523},      {342.039, 0.}}, {{732.078, 1093.}, {671.987, 0.}}, {{610.656, 1093.}, {406.405, 0.}}, {{0., 1069.95},      {900.,163.635}}, {{112.851, 1093.}, {397.351, 0.}}, {{0., 72.2908}, {900., 65.1008}}, {{644.998, 1093.},      {702.9, 0.}}, {{900., 720.816}, {203.947, 0.}}, {{549.162, 1093.}, {374.145, 0.}}, {{446.497, 1093.},      {434.49, 0.}}, {{0., 42.0853}, {900., 106.906}}, {{0., 743.122}, {900., 596.242}}, {{0.,630.275},      {900., 744.118}}, {{39.5396, 1093.}, {449.074, 0.}}};      ![Result Showing Largest Bounded Area](http://i.stack.imgur.com/aJZKD.jpg) Thanks for your help!


Savitzky-Golay Filter to smooth noisy data

I do have noisy data and want to smooth them by a Savitzky-Golay filter because I want to keep the magnitude of the signal. a) Is there a ready-to-use Filter available for that? b) what are appropriate values for m (the half width) and for the coefficients for 3000-4000 data points? Example data: data


1D Random Walk variant

I am making a notebook that is a variation to the traditional 1d random walk problem. The normal 1D random walk can be simulated easily by               Map[Accumulate, {RandomChoice[{-1, 1}, {100}]}] // Flatten      > {1, 2, 3, 4, 5, 4, 3, 4, 5, 6, 5, 6, 7, 6, 7, 6, 5, 6, 7, 8, 7, 8, 9, 8, 7, > 8, 9, 8, 7, 6, 5, 4, 3, 2, 1, 2, 1, 2, 3, 4, 5, 4, 3, 4, 5, 6, 7, 8, 7, 6, > 5, 4, 3, 2, 1, 2, 1, 0, 1, 0, -1, 0, -1, 0, -1, 0, 1, 0, -1, -2, -1, -2, -3, > -2, -1, 0, -1, -2, -1, 0, 1, 0, 1, 0, -1, 0, -1, -2, -1, -2, -1, 0, -1, 0, > 1, 0, 1, 0, 1, 2} As shown, this returns a list of positions along the x-axis for each of the 100 steps. However, instead of choosing a set number of steps, I would like to discontinue the walk when a certain points is reached. This, of course, would make the length of the list of locations vary between each run as it will take a different number of steps to reach x = 10, for instance. How can I do this (without a For loop)?


Random number generation with specific distribution

I am writing a program for solving the shortest path in travelling salesman problem, with a twist that there are multiple salesmen who partition the cities among themselves, thus creating two part problem, namely partitioning the graph among the salesmen and solving the salesman problem for each partition. I am using mathematica for this, at the moment. I am using genetic programming, IE. I generate random partitions combined with order of travel and then I breed the solution so that I weight the better solution more, thus allowing all solutions to be included and the diversity to stay good. The actual breeding itself is quite a complex procedure, but that is a question for another forum and another time. I have alpha version and it works, amazingly, but it is so slow. This would, hopefully, end in commercial use (a start-up firm asked me to look at this), so I need to speed it up before making the program more complex. I figured with small benchmarking that one problem is the generation of a random number that is needed in breeding. This breeding happens tens of thousands of times, but I tested my method randomNumber thus:               Timing[Do[randomNumber[50], {128}]]     {1.263, Null}          Timing[Do[randomNumber[50], {256}]]     {2.199, Null}      This is intolerable. So, I ask, what distribution I should use and how? I would like it to be discrete, generate numbers between 1 and some larger n, so that $\sum_{i=1}^n P(i) = 1$ and the probabilities to have the property $P(1)>P(2)>P(3)\cdots P(n)$ and I would also like to be able to control how fast the probabilities get smaller. At the moment I use this monstrosity:               randomNumber[n_] := (Floor[InverseFunction[HarmonicNumber, 1, 2][RandomReal[] HarmonicNumber[n, 1/3], 1/3]] // N) + 1      This has all the properties described above, I can even control the slope by changing the numbers in `HarmonicNumber[n, 1/3], 1/3]]`. But this method is too slow. I am clearly thinking too complex here. Any suggestions?