NMaximize with matrix input

I defined function `f[x_, fixed_] := {...}`. Here `x` is an $M\times N$ matrix. I want to maximize $f$ with respect to $x$. I have three questions:   1. By default, `NMaximize` treats all variables as real. How can I inform _Mathematica_ that $x$ here is a real matrix?   2. I tried `FindMaximum`, by typing `FindMaximum[f[x, fixed],{x}]`, with `x` as a matrix. The weird thing is that in the process of `FindMaximum`, my function `f` did not evaluate `x`; it just kept `x` as a variable name without content. How to understand and fix this thing? BTW, my function `f` is not in the global context but in a private context.   3. Indeed, the function $f$ here is an approximate of its theoretical counterpart $f_0$. And I know $f_0(x)$ is maximized when $x\in A$. Here $A$ is a subset in Euclid space. My actual aim is to approximate the set $A$. Let $x^*$ be the $\arg\max$ of $f$ found by `Mathematica` somehow. Intuitively, I want to keep all $x'$ such that $|f(x')-f(x^*)|<\epsilon$ for a chosen $\epsilon$. How can I achieve this goal? I noticed that `NMaximize` has a option called `StepMonitor`, which might help.


How can I draw a 3D cross-section of a 3-torus embedded in 4D Euclidean space?

I have a $3$-torus ($\mathbf S^1\times\mathbf S^1\times \mathbf S^1$) embedded in 4D Euclidean space. How can I draw the cross-section of this $3$-torus cut by a 3D Euclidean space in an arbitrary direction? The equations are: $$\begin{align*} x &= (r + (t + d\cos\,a)\cos\,b)\cos\,c\\ y &= (r + (t + d\cos\,a)\cos\,b)\sin\,c\\ z &= (t + d\cos\,a)\sin\,b\\ w &= d\sin\,a \end{align*}$$ where $x,y,z,w$ are the orthogonal coordinates in 4D space, $r,t,d$ are the radii of three circles, and $a,b,c$ denote the angles of the point with respect to the three circles.


Symmetrical image transformation for a kaleidoscope-type image

I've been trying to write a little kaleidoscope-type manipulate, using images rather than graphics, and using `ImageTransformation` as a way in. However, I'm starting to suspect that my approach isn't going to work. Before I abandon it, though, I thought I'd ask here if it can be rescued:               im = ImageResize[ExampleData[{"TestImage", "Mandrill"}], 100]          Manipulate[      ImageTransformation[          ImagePad[im, {{x, -x}, {-x, x}}, Padding -> "Reversed"],          Function[{pt}, {ArcTan[-#2, #1] & @@ pt, Norm[pt]}],         DataRange -> Automatic, PlotRange -> {{-2, 2}, {-2, 2}},         Padding -> "Reversed"], {x, 0, 100, 5}]      ![a manipulated mandrill](http://i.stack.imgur.com/F2VW6.png) While the results are OK, it isn't symmetrical, and I'm not sure that the transform can be corrected to make it so? (Strictly speaking this is a teleidoscope, rather than a kaleidoscope...)


Alternative ways to implement a triangular recursion

Triangular recursions are a class of algorithms that frequently turn up in computational mathematics. These recursions are expressible in the general form $$T_k^{(n)}=f(T_{k-1}^{(n)},T_{k-1}^{(n+1)})$$ for some function $f$ and initial values $T_0^{(n)}$. The "triangular" adjective is easily visualized if the $T_k^{(n)}$ are arranged in an array: $$\begin{array}{}T_0^{(0)}&T_1^{(0)}&T_2^{(0)}&T_3^{(0)}\\T_0^{(1)}&T_1^{(1)}&T_2^{(1)}&\\T_0^{(2)}&T_1^{(2)}&&\\T_0^{(3)}&&&\end{array}$$ Due to the nice theory behind triangular recursions, it is known that such algorithms can be implemented using only a one-dimensional scratch array instead of a two-dimensional array. So much for theory. I shall now give various examples of triangular recursions that occur in computational practice, as implemented in _Mathematica_ , with the underlying triangular recursion flanked by `(* ------ *)` comment lines. Here is the Akiyama-Tanigawa algorithm for the Bernoulli numbers, with the redefinition $B_1=\frac12$:               myBernoulliB[n_Integer] := Module[{atArray = 1/Range[n + 1]},            (* ------ *)       Do[        atArray[[j]] = j (atArray[[j]] - atArray[[j + 1]]),        {k, n + 1}, {j, k - 1, 1, -1}];       (* ------ *)            First[atArray]]          myBernoulliB /@ Range[0, 20]     {1, 1/2, 1/6, 0, -(1/30), 0, 1/42, 0, -(1/30), 0, 5/66}          BernoulliB[Range[0, 20]]     {1, -(1/2), 1/6, 0, -(1/30), 0, 1/42, 0, -(1/30), 0, 5/66}      Here's the Neville-Aitken algorithm for polynomial interpolation:               iPolyVal[pts_?MatrixQ, x_] := Module[{n = Length[pts] - 1, xa, ya, temp},       {xa, ya} = Transpose[pts];            (* ------ *)       Do[        temp = (x - xa[[j]])/(x - xa[[k]]) - 1;        ya[[j]] = ya[[j + 1]] + (ya[[j + 1]] - ya[[j]])/temp,        {k, n + 1}, {j, k - 1, 1, -1}];       (* ------ *)            First[ya]]          iPolyVal[{{0, 1}, {1/3, 1}, {1/2, 1/2}, {3/4, -1}, {1, 0}}, 1/4]     161/160          InterpolatingPolynomial[{{0, 1}, {1/3, 1}, {1/2, 1/2}, {3/4, -1}, {1, 0}}, 1/4]     161/160      Here's (a simplified version of) de Casteljau's algorithm for splitting Bézier curves:               bezierChop[BezierCurve[pts_?MatrixQ, opts___], u_?NumericQ] :=       Module[{n = Length[pts]},        BezierCurve[Transpose[            Function[{vec}, Block[{ta = vec},                  (* ------ *)             Do[              ta[[j]] = u ta[[j + 1]] + (1 - u) ta[[j]],              {k, n - 1}, {j, k, 1, -1}];             (* ------ *)                  ta]] /@ Transpose[pts]]]] /; 0 < u < 1          Graphics3D[{AbsoluteThickness[5],        BezierCurve[{{0, 0, 0}, {1, 1, 1}, {2, -1, 1}, {3, 0, 2}}],        Directive[Blue, AbsoluteThickness[3]],        Translate[        bezierChop[         BezierCurve[{{0, 0, 0}, {1, 1, 1}, {2, -1, 1}, {3, 0, 2}}],          1/3], {0, 0, 1/10}]}, Boxed -> False]      ![Bézier curve truncated with the de Casteljau algorithm](http://i.stack.imgur.com/gefrR.png) There are many more examples of situations that make use of triangular recursions, such as Romberg quadrature, divided differences for interpolating polynomials, the Levin transformation for summing series, the Cox-de Boor algorithm for B-splines... etc. Having shown that they are important, note that the common core of the algorithms that use triangular recursions is a double-index `Do[]` loop working on a preset scratch array, modifying elements as needed. That should be sufficient preamble. My question now is: **are there alternative methods (e.g. non-procedural methods) for implementing triangular recursions?**


How to correct my code for solving the Josephus problem?

### Problem Decription Recently, I have been reading the book _Schaum's Outline of Mathematica (2nd Edition)_ , where I encounted the problem: > Flavius Josephus was a Jewish historian of the first century. He wrote about > a group of ten Jews in a cave who, rather than surrender to the Romans, > chose to commit suicide, one by one. They formed a circle and every other > one was killed. Who was the lone survivor? **The author's solution:**               list = Range[10];     While[Length[list] > 1, list = Rest[RotateLeft[list]]];     list      > {5} However, I know it is not efficient to use the procedural methods such as `Do`, `While`, etc. Rather, I want use a functional method like `NestWhile`, `Nest`, or `FixedPoint` to solve the problem. **My solutions:** Method 1:               list = Range @ 10;      NestList[Rest@RotateLeft[#] &, list, 9]      > >      {{1, 2, 3, 4, 5, 6, 7, 8, 9, 10}, >       {3, 4, 5, 6, 7, 8, 9, 10, 1}, >       {5, 6, 7, 8, 9, 10, 1, 3}, >       {7, 8, 9, 10, 1, 3, 5}, >       {9, 10, 1, 3, 5, 7}, >       {1, 3, 5, 7, 9}, >       {5, 7, 9, 1}, >       {9, 1, 5}, >       {5, 9}, >       {5}} >   Furthermore,this method has a flaw that I must give the the number of iterations. In fact, sometimes that is unknown. Method 2:               list = Range @10;     FixedPoint[If[Length@# != 1 &, Rest @ RotateLeft[#] &], list]      Unfortunately, method 2 doesn't work. Method 3:                list = Range @ 10;      NestWhileList[Rest @ RotateLeft[#] &, list, Length@list != 1]      > >     {{1, 2, 3, 4, 5, 6, 7, 8, 9, 10}} >   So my question is: what is a good way to do it?


Use boundaries of one plot for another

I am writing some code in which I combine a `ParametricPlot[]` with a `RegionPlot[]`. _Mathematica_ is very good at figuring out appropriate bounds for the `ParametricPlot[]`, and I would like to reuse the same bounds for creating the `RegionPlot[]`. How can I tell _Mathematica_ to reuse the bounds?


Unexpected result for Coefficient[]

Is this just me being stupid, or is this a known bug in Mathematica?               Coefficient[2 x + 2 y, x + y]      gives 0, while               Coefficient[2(x + y), x + y]      gives 2. The documentation says that it should work whenever the expression is expanded or not... I can see the problem with Coefficient[x-y, x + y] but if all coefficients in _expr_ and _form_ are positive, then surely there is a well-defined largest number k, such that `expr-k*form` have non-negative coefficients? And this is what I'd expect.               Coefficient[expr,form]       EDIT: In my case,               PolynomialReduce[expr,{form},vars][[1,1]]      does the thing I want. This computes _k_ such that _expr-k form_ is minimal in some sense.


Variable scope similar to other languages

Mathematica, unlike many other languages, defines the variables in the global scope unless it is explicitly asked to define a variable in a local scope, _e.g._ , using `Module`, `With`, or `Block`. My question is how to define a scoping construct which defines the variables locally by default unless otherwise stated. For instance:               x = 1;     y = 1;     Scope[{x (* specify global variables here *) },       x = 2;       y = 2;       a = 0;       (* x and y both equal to 2 and a is 0 here *)     ]     (* x equals to 2, y equals to 1, a is undefined here *)      How can one define a function `Scope` as demonstrated above?


Volume within parameter space

Imagine a parameter space with variable `0<p<1`, `0<e1<1/2` and `0<e2<1/2`. There are certain conditions on the parameters in some situations. For example `p<e1` or `(p)(e1)/((p)(e1)+(1-p)(1-e2))<e1/e2` How can I determine the volume of the parameter space which satisfies these (and other) conditions? I would like to determine them algebraically, and not via a numerical simulation of plotting points within parameter space. I also do not want to solve any complex equations myself. I simply want a function which gives me the result easily. Does this exist? Update: The suggestion below works very well in many cases, however, I seem to have hit a problem. Try to evaluate: `NIntegrate[Boole[0<p<1&&0<e1<1/2&&0<e2<1/2&&e1<e2&&0<e3<1/2&&0<(e3-e2 e3-e1 p-e3 p+e1 e3 p+e2 e3 p)/((1-e1-2 e3+e1 e3+e2 e3) (-1+p))<1&&0<(-e1+e1 e3+e2 e3)/(1-e1-2 e3+e1 e3+e2 e3)<1&&40/100<(((e3-e2 e3-e1 p-e3 p+e1 e3 p+e2 e3 p)/((1-e1-2 e3+e1 e3+e2 e3) (-1+p)))(e3+p-2 e3 p)+(1-((e3-e2 e3-e1 p-e3 p+e1 e3 p+e2 e3 p)/((1-e1-2 e3+e1 e3+e2 e3) (-1+p))))(1-e3))],{p,0,1},{e1,0,1/2},{e2,0,1/2},{e3,0,1/2},WorkingPrecision->20]` This gives something like 0.036. Try now to weaken the condition by lowering 50/100 to 40/100. The results becomes 0....


Overscript distance

When I write:               Overscript[PQ, \[RightVector]],       the arrow is placed too close to the `P` and `Q`. Is there a way to modify the default distance used by `Overscript`?


Force Dispatch to generate dispatch tables

Dispatch creates hash tables only for lists of length larger than 3. Is there any way to force MMA to create hash tables even for lists of length smaller than 4?               Table[Head@Dispatch@Table[Rule[a[i], i], {i, n}], {n, 5}]     (* {List, List, List, Dispatch, Dispatch} *)


Why is ToRadicals[] not able to handle all cases? Is there a workaround?

The documentation for the function `ToRadicals` says: > ♦ There are some cases in which expressions involving radicals can in > principle be given, but `ToRadicals` cannot find them. I'm concerned only with cases where the argument to `ToRadicals` is a single `Root` object with a single polynomial function with integer coefficients and no parameters, and an explicit root index. * * * Here is an example when _Mathematica_ cannot find an expression in radicals:               ToRadicals[Root[-1 - #1^2 - #1^3 + #1^4 + #1^6 &, 2]]      But actually the expression exists: $$\frac1{\sqrt[3]{36}}\left(\frac3{\sqrt{\beta\phantom{.}}}+\frac\beta2\right),\ \text{where}\ \beta=\sqrt[3]{2\,\ \alpha}-8\sqrt[3]{\frac3\alpha\phantom{}},\ \alpha=9+\sqrt{849}.$$ * * * Another example is               ToRadicals[Root[6 + 25 #1 - 25 #1^3 + 5 #1^5 &, 5]]      where the expression in radicals is $$\sqrt[5]{\frac{-3+4\sqrt{-1}}5}+\sqrt[5]{\frac{-3-4\sqrt{-1}}5}$$ * * * What is the nature of this restriction? Is the problem known to be undecidable in general? Or is it extremely computationally expensive? Can we write an implementation of `ToRadicals` that is able to find an expression in radicals in all cases when it is possible? Or, at least, in much more cases then the built-in `ToRadicals` does?


Can Epilog be used with ParametricPlot3D

This command:               ParametricPlot3D[{Cos[t], Sin[t], t}, {t, 0, 2 \[Pi]},          Epilog -> {Arrow[{{0, 0, 0}, {Cos[\[Pi]], Sin[\[Pi]], \[Pi]}}]}]      Produces the message: > Coordinate {0, 0, 0} should be a pair of numbers, or a Scaled or Offset > form.


How can I use shared libraries in LibraryLink code and ensure Mathematica will find them?

I need to use shared libraries in some LibraryLink code. The shared library is installed in a custom location because it was also compiled by myself. When I try to load functions from the LibraryLink library, I get `LibraryFunction::libload` errors because Mathematica is not able to find the shared library. What is the solution to this problem?


Why am I getting a kernel crash on Chop?

First post, hopefully I figure out the formatting easily. Please forgive me if this posts ugly. I am having a (repeatable) problem where when I run my code everything works fast and the output is displayed but the program has some error in which it erases the kernel (maybe that's not the correct term). Basically all my variables reset and _Mathematica_ goes back to being as if I just opened the software. For context, this is the output of a secular variation model               (0.0057300369 - 0.0071475265 I) E^((-8.2717832*10^-25 +  6.6290151*10^-9 I) t) -     (0.0000981431 +  0.0001437239 I) E^((-3.7695835*10^-29 +  1.4229429*10^-9 I) t) +     (0.000072401667 -   0.000092434689 I) E^((0. +   2.6555734*10^-8 I) t) +     (0.000092742725 -   0.000015933052 I) E^((4.0245734*10^-26 + 3.1934271*10^-10 I) t)      Those real pieces in the exponential are really zero except for some numerical error. I want to `// Chop` it. When I do however, my machine makes a "dong" sound (standard Mac error sound) and _Mathematica_ or the kernel resets. I would guess it is repeatable for anyone else to try as well. I completely quit _Mathematica_. Reopen then copy paste the block above into a new window. A chop at the end of it has the same result. It spits out the right answer, but this is just a step in a loop, so I need all my variables and such to stay defined. Any reason someone can see that this is happening? ### Edit My guess is _Mathematica_ just needs a real component in the exponential. Don't know why, though. Take that bit above and use `// ComplexExpand //Chop` gives it in an equivalent form in sines and cosines.


How do I extract the middle element(s) of a given list? Here is some code that works, but seems a little too long:               extract[x_] :=            Part[x, If[IntegerQ[#], {#}, {Floor[#], Ceiling[#]}] & @ Median[Range[Length @ x]]]      Here is another, shorter routine, but for a list of even length, it only gives one value, not two. I think two values would be better for even lists:               extract[x_] := Part[x, Quantile[Range[Length @ x], 1/2]]      So is there concise, efficient code that will return two elements for a list of even length?


Creating a standalone (executable) from mathematica code

I have written a small mathematica code to input a ".csv" file and output the data in a specific format, in a ".txt" file. I would like to give this program as an executable to my friend as she doesn't have mathematica installed. I've seen how one creates ".exe" from mathematica. However the process doesn't seem to work for me. Can anyone kindly help. Here is the mathematica code:               content=Drop[Transpose[Import["~/Downloads/19162.csv"]],2];          sorted=GatherBy[DeleteCases[DeleteCases[Flatten[content],""],"="],StringTake[#,StringPosition[#,"="][[1]][[1]]]&];          tab=OutputForm[TableForm[sorted]];          Export["~/Downloads/19162.txt",tab]      I would like the executable to input a file (in ".csv") format and output the text file in the "~/Downloads/" folder (of course the choice of the folder isn't important here).


FillingStyle Thickness Distorting ListPlot image

I'm trying to create a histogram using `ListPlot` using the `Filling->Axis` and `FillingStyle -> {{LightGray, Thickness[.1]}}` as options. However, when I use this the columns are actually higher than the value in the lists. Below is an example                  n = 6;        p = 0.5;        (*calculate probabilities *)        list = Table[          c = Binomial[n, k];          d = p^k (1 - p)^(n - k);          {k, c* d}, {k, 0, n}]                  (*FillingStyle Thickness results in additional height being added to \        top of each column*)        ListPlot[(list),          Joined -> False,         Axes -> True,         FrameTicks -> {Table[i, {i, 0 , n, 1}],            Table[i, {i, 0, 0.3, 0.05}]},         FrameLabel -> {"Successes k", "Probability"},         Frame -> {True, True, False, False},         PlotStyle -> Automatic,         Filling -> Axis,         FillingStyle -> {{LightGray, Thickness[.1]}},         ImageSize -> 6*72 ]      Does anyone have a suggestion for a solution for this problem while still using `ListPlot`? Thanks, Mike


Not evaluating all cells unless I explicitly evaluate each one?

I'm running a Mathematica (version 8) notebook. In one of the first few cells, it is supposed to plot some data. It uses a couple functions that are defined in an above cell. If I do Evaluation-> Evaluate Notebook (which should evaluate the whole notebook, starting from the top, right?), it goes through and seems to evaluate it (the bars at the right turn from highlighted to regular as it goes down the notebook), but it doesn't produce the plot, or several other results that should output to the screen (they don't have a semicolon). However, if I go down from the top and manually hit shift+enter for each cell in order, it produces what it's supposed to. Am I doing something dumb? What's going on? Thanks!


Finding y given x from an interpolating function

I would like to put a dot on the point of a curve that has a specific y value but I don't know the x value. A simple example of my code is               eqns = {y''[t] + y[t] == 3 a Sin[y[t]], y[0] == y'[0] == 1};     pfun = ParametricNDSolveValue[eqns, y[1] + y[2], {t, 0, 5}, {a}];     Plot[pfun[a], {a, -2, 2}]      ![enter image description here](http://i.stack.imgur.com/kjNg7.png) So say I want to find the x at which y=3. How? Once I have the two coordinates I know how to add the dot. I guess I'm confused because the interpolating function gives you the y given the x, and I can't figure out how to do the inverse. Also any suggestions of tutorials on how to use interpolating functions would be great. Thanks!


Challenge: Creating Compilable Permutations Function

As Mathematica's implemented `Permuations` function is not compilable I tried to write my very own Permutations implementation, called `PermutationsNew`, which I want to compile later on. Unfortunately the only implementation I came up with so far uses recursive programming and looks like this:               PermutationsInternal = Function[{list, listfixed}, If[Length[list] == 1, Join[listfixed, list], Table[PermutationsInternal[Drop[list, {i}], Append[listfixed, list[[i]]]], {i, Length[list]}] ]];     PermutationsNew[list_] := Flatten[PermutationsInternal[list, {}], Length[list] - 2]      The implementation seems to work fine, but because of the recursive structure I cannot come up with any approach that can be compiled, because mathematica has trouble compiling the lists encountered in `PermutationsInternal`. Does anybody have an idea on how to compile the above approach or can offer me an idea for a different compilable solution?


How to transform the polynomial in this way?

I have two functions `f` and `g` and a polynomial                poly=p[1,1]+2*p[1,2]-3*p[1,3]-p[2,1]+p[2,2]-p[4,3]      and I want to transform the `poly` into                f[1,1]+2*f[1,2]+3*g[1,3]+g[2,1]+f[2,2]+g[4,3]      Generally, I want to transform $$poly = \sum (-1)^{\tau_{i,j}} a_{ij}*p[i,j]$$ into $$\sum_{\tau_{i,j}=0} a_{ij}*f[i,j] + \sum_{\tau_{i,j}=1} a_{ij}*g[i,j]$$ What's the most elegant and efficient way?


How can I change the keyboard shortcut for switching the active window?

The default keyboard shortcut (on Windows at least) for switching focus to the next window is Ctrl+F6, and for switching to the previous windows it's Shift+Ctrl+F6. How can I change this to Ctrl+Tab and Shift+Ctrl+Tab respectively (or some other pair of combinations which is not used by default)?


Use output from Plot3D as an object in Graphics3D that I can transform

I'm trying to draw up an optical system where I can show an example of wavefront error on an exit pupil. It would be great if I could take the results of a 3D function from Plot3D and use it as a graphics object that I could transform to fit into my Graphis3D drawing. Below is some code that does not work but it shows a very simple case of what I would like to be able to do.               pic = Plot3D[Sin[x] Sin[y], {x, -5, 5}, {y, -5, 5},              RegionFunction -> Function[{x, y, z}, x^2 + y^2 <= 20]];          Graphics3D[{Rotate[pic, \[Pi]/4, {1, 1, 1}],              Arrow[{{0, 0, 0}, {5, 5, 5}}]}]


How do I create an ellipse bubble chart?

I have some data that I would like to plot as a bubble chart. The data is formatted as {{val1_mean,val1_sd,val2_mean,val2_sd},{val1_mean,......}}. What I would like to do is plot a bubble chart where the x/y location of the bubble is val1_mean,val2_mean and the width/height of the bubble is val1_sd,val2_sd. So far I've been able to do circular bubble charts with the inbuilt function but am a bit lost as to how to make the bubbles ellipses instead of circles. Here's the code I've written so far;               bubleData={{1.88308*10^6, 1024.85, 149446., 6636.62}, {1.98345*10^6, 15022.5,      126966., 7071.75}, {1.94677*10^6, 9281.83, 131930.,      7435.15}, {1.88308*10^6, 1024.85, 127423., 8718.36}};     BubbleChart[bubbleData[[All, 1 ;; 3]],ChartStyle -> Directive[Opacity[0.5]]]      ![enter image description here](http://i.stack.imgur.com/iE8CY.png)


Arcs of rotation for angles

1. How can I draw trigonometric angles of any radian measure associated with the unit circle, complete with the x-axis and y-axis?    2. How can I draw arcs of rotation inside positive or negative angles?   3. Is there a method for drawing arcs inside angles of more than one rotation? Here is a link showing what I would like to draw: http://hotmath.com/hotmath_help/topics/coterminal-angles.html


Efficient Data Entry / Manipulation with Many Datasets

I currently have a simple task of graphing many different datasets (26 here, with many different instances where I'll need to do, say, 26 different ones from the same template). I'm trying to minimize the amount of "name changing" I'll have to do manually, as the treatment of each dataset is virtually identical aside from the names and (obviously) individual data points being graphed. For example, I have a large table (specifically imported using ExcelRead with ExcelLink) with: `data = {{DataSetName1, m1, m2, m3,m4},{DataSetName2, m1, m2, m3, m4},...}` etc. for all 26 datasets and their measurements 1 - 4 as a function of time. Next I have to extract each datasets information individually using `time=[5, 10, 20, 1440]` for the time intervals my data is taken at, `DataSet1raw = Rest[Part[data, 2, 1;;5]` and then `DataSet1 = Transpose[{time, DataSet1raw}]` `DataSetList = {"DataSet1Name","DataSet2Name","...", "DataSet26Name"}` to finally yield the time-series `{{t1, m1},{t2, m2}, ...}` form and a list of the names of each set. Combining the list of time-series (& names respectively) to graph in thirds for ease of viewing, `AllSets = {DataSet1, DataSet2, ..., DataSet26}` `FirstCollection = Take[AllSets, 1;;9]` `SecondCollection = Take[AllSets, 10;;18]` `FinalCollection = Take[AllSets, 19;;26]` After doing this individually for 26 numbered data sets (such as NB1,NB2,NB3, etc., all of which contain name-specific components previously used), it is finally in the form where I can graph the datasets easily using: `ListLogLinearPlot[FirstCollection, Legending, etc.]` So, my question is a general one of how to optimize this process. Currently I'm leaning towards generalizing the terms like I've done above, and trying to use a simple process of "Specific name = generic name," but suspect my lack of general organizational Mathematica familiarity (and coding in general) has me complicating much of this process. Thank you for taking the time to respond! Update: After investigating further as to how to possibly simplify the process, I've at least found in the documentation a means of possibly doing the renaming of each drug iteration (26 times here) by a series of `ToString` and `ToExpression` functions, in case anyone else is facing a similar dilemma.


How do I draw a triangle given the lengths of the sides?

I know, of course, how to draw a triangle in the plane given the vertices:               Graphics[Polygon[{{1, 0}, {0, Sqrt[3]}, {-1, 0}}]]      But I'm not sure how to simply draw a triangle if all I care about is the length of the sides. (I'm happy to place one of the vertices at the origin and place one of the sides on the non-negative side of the x-axis, but that doesn't really matter.) Is there a straightforward way? This raises the additional question, "how do I draw a triangle in Mathematica, given three angles?" (Say I want to it to reside somewhere in the unit circle.)


How to import and visualize a network stored as an edge list in CSV file?

I'm extremely new to Mathematica, and I'm trying to import an edgelist representing a network, but I think I'm missing something major. **Here is my process so far just to import and visualize the data:**               SetDirectory["C:\\path\\to\\files"]     net = Import["data.csv"]     GraphPlot[net]      **The format of my data is as follows:**               A, B     A, C     B, D     C, E     C, F     C, G     D, F      I've imported a couple of different networks, and they all end up looking the same. I'm sure that I'm missing some major step, most likely in declaring that this is an edgelist.


What is the quickest way to convert a lot of SQLDateTime[] objects to DateLists

I often run database queries that return sets of {date, datum} objects. A hypothetical query looks like               testData = SQLExecute[commodDB, "select date,price from commoddb.tbcommodprices     where futurePrefix='XB'"];      and the results look like               {{SQLDateTime[{2005, 10, 3}], 188.88}, {SQLDateTime[{2005, 10, 4}],      184.53}, {SQLDateTime[{2005, 10, 5}],      176.5}, {SQLDateTime[{2005, 10, 6}],      172.}, {SQLDateTime[{2005, 10, 7}] . . . etc}      To do anything useful with these, I need to convert the SQLDateTime[] objects into Mathematica datelists. With the example above, this can be done with               Map[{#[[1]][[1]], #[[2]]} &, testData]      But this takes longer than I would like; I feel as though this conversion is trivial and should be basically instantaneous, but for typical queries (which admittedly return thousands of results), the conversion takes half a second or more. Can anybody suggest a quicker way to convert my SQLDateTime[]s into DateLists? Thanks.


How to calculate the following integral of the multiplication of two Bessel functions?

This integration has an analytical solution and its behavior is described by 1/r^2 function, but Mathematica gives some weird oscillating answer. Can anybody explain this and help me overcome this issue.               R  = 1500;     f[r_] := NIntegrate[BesselJ[2, r*k]*BesselJ[1, R*k], {k, 0, Infinity},AccuracyGoal -> 12]     sol = Table[Abs[f[r]]^2, {r, R, 2000, 10}];     ListLinePlot[sol, PlotRange -> All]


Implementing a safe ValueQ that does not evaluate its argument

_Mathematica_ has a built-in function `ValueQ`. Quoting the docs, > `ValueQ[expr]` gives `True` if a value has been defined for `expr`, and > gives `False` otherwise. > > ... > > `ValueQ` gives `False` only if `expr` would not change if it were to be > entered as _Mathematica_ input. This works nicely with symbols that only have `OwnValues`:               x = Print["boo!"]     ValueQ[x]          (* ==> True *)      It doesn't work so nicely with functions, though:               f[x_] := Print[x]     ValueQ[f[1]]          (*          1      ==> True     *)      This gives `True`, but also evaluates `f[1]` completely, printing `1`. This is clearly dangerous, and it is important to be aware of this. Unfortunately, the docs make no mention of this under the "Possible Issues" section! Why this happens is clear if we look at the implementation of `ValueQ` for non-symbols:               ValueQ[expr_] := ! Hold[Evaluate[expr]] === Hold[expr]      **Question:** Is it possible to implement a more robust version of `ValueQ`, which does not evaluate its argument in an unexpected an possibly dangerous way?


Efficient code for building a big list

I would like replace the following code               With[{n = 5},       Flatten[         Table[Join @@ NestList[Abs@Differences@# &, {a, b, c, d, e}, n - 1] // Evaluate,            {a, #}, {b, #}, {c, #}, {d, #}, {e, #}] &[n (n + 1)/2], n - 1]]; // AbsoluteTiming     (*{0.551032, 759375}*)      with this               With[{n = 5},       Join @@ NestList[Abs@Differences@# &, #, n - 1] & /@          Tuples[Range[n (n + 1)/2], n]]; // Timing      but the second method is much slower than the first. How can I make it fast?


Modified definition of Sin does not work in Plot

I don't know if this issue has been discussed before, if anyone know any related post, please let me know, thank you :) `Unprotect` the function `Sin` and create a new definition for it:               Unprotect[Sin];     Sin[x_] := x^2;      Because `x_` matches any expression, then I think (naively) the system definition of `Sin` would never be applied.               {Sin[2], Sin[1.2], Sin[Sin]}     (*        {4, 1.44, Sin^2}     *)      Every thing works as expected except for `Plot`:               Plot[Sin[x], {x, 0, Pi}]      ![enter image description here](http://i.stack.imgur.com/6XmSH.jpg) I think it's related to the internal computation of `Plot`, I checked the mass output of `Trace` and found nothing useful. I know it's stupid to modify a system symbol this way, but could you please give me some explanation? Thanks in advance.


Speeding up multilinear PRA branch-and-bound algorithm with worst-case exponential time scenario with respect to basic events

The algorithm is a branch-and-bound algorithm that calculates dominances for PRA, probalistic risk assessment. The task was to find faster ways to do it in numerical software such as Matlab but we found it extremely hard, more here. Now I am trying to find ways to speed it up in symbolic softwares such as Mathematica. The algorithm uses multilinearity but not with respect to constant term. The worst case time scenario with respect to basic events is exponential. This does not mean that it is exponential with respect to minimal cut sets. It is a method to analyse the impact of epistemic uncertainty about event probabilities in fault tree analysis. The algo is based on a theorem in multilinear optimization according to which the extreme values of multilinear function $f: HR \rightarrow \mathbb R$ are attained at the vertices of HR where HR is a hyperrectangle in $\mathbb R^n$. Basically the idea of this algo is to traverse the corners in the hyperrectangle. So: > **what kind of methods would you use to speed up this kind of recursive > algorithm?** **Algorithm**               Algo[f0_, lb0_, ub0_] :=        Module[{f = f0, lb = lb0, ub = ub0, monomials, fp, fm, bvar, blb,          bub}, If[f == 0 || f == 0.0, Return[True]];        monomials = f // MonomialList;        fp = Select[monomials*1.0*D, (First[#] >= 0) &] /. {D -> 1};        fm = Select[monomials*1.0*D, (First[#] < 0) &] /. {D -> 1};        If[Plus @@ (fp /. lb) + Plus @@ (fm /. ub) >= 0, Return[True]];        If[Plus @@ (fp /. ub) + Plus @@ (fm /. lb) < 0, Return[False]];        bvar = Variables[f] // First;        blb = Select[lb, ((# // First) == bvar) &];        bub = Select[ub, ((# // First) == bvar) &];        Algo[(f /. blb), lb, ub] \[And] Algo[(f /. bub), lb, ub]];      **Example how to use this function**               Algo[Subscript[p, 1] + Subscript[p, 2] - Subscript[p, 1] Subscript[p, 2],       Table[Subscript[p, i] -> 0.01, {i, 7}], Table[Subscript[p, i] -> 0.04, {i, 7}]]


Replace one order of derivative inside higher one

How could I replace for example:               Derivative[2][f][x]      by               Derivative[1][g][x]      where               g[x]=Derivative[1][f][x]      ? But doing this in a manner that work for all cases (all combinations of mixed derivates and multiple variables)?


Adding subscripts to variables

I know I can define               vars = Map[Subscript[x, #1] &, {"tem", "pressure", "hum", "lat", "alt", "space", "corner"}]      and               vars = Array[Subscript[x, #1] &, {8}]      But how can I add both kinds of subscripts in my "x"s to get something like x"tem""1", x"tem""2", and so on? Based on the answer I got here, I tried to write general form in this way.I am quite sure there would be much better interactive way to do that.This is just starter version of mine:               Outer[Subscript[x, Subscript[#1, #2], Subscript[#3, #4],      Subscript[#5, #6], Subscript[#7, #8]] &, {"a", "b"}, {1, 2, 3,      4}, {"i", "j"}, {1, 2, 3, 4}, {"m", "n"}, {1, 2}, {"A", "B", "C",      "D"}, {1, 2, 3, 4, 5, 6, 7}];


double integration

I want to evaluate a double integral, but the limits of one integral is a function of the second. Like this               A[(b_)?NumberQ] :=        Pi - 2*b*g*         NIntegrate[          1/Sqrt[g^2 - b^2*g^2*y^2 - 4*y^12 + 4*y^6], {y, 0,            Solve[g^2 - b^2*g^2*y^2 - 4*y^12 + 4*y^6 == 0, y, Reals][[2]] -             0.00001}];      NIntegrate[2*(1 - Cos[A[b]])*b, {b, 0, 100000}]      The upper limit of the first integral is an polynomial equation that depends on `b` and the second integral is in `b` for `g = Sqrt[0.1]`, I have the value `5.3`.


DynamicModule inconsistent behavior; was: DynamicModule persistent UI changes

**Update** : I'll restate the question in hopefully more terse and clearer terms. To illustrate the issue, run this and save the resulting notebook:               CreateDocument[       DynamicModule[        { ultimateAnswer = 42,         x = False},        Pane@Row@{           Checkbox[Dynamic[x]], " Notebook modified ",Checkbox[Dynamic[Refresh["ModifiedInMemory" /. NotebookInformation[], UpdateInterval -> 0.1]]]}]       , WindowSize -> {320, 80}, WindowElements -> {}, WindowToolbars -> {}, WindowFrameElements -> {"CloseBox", "DocumentIcon", "ResizeArea"}];      ![saved](http://i.stack.imgur.com/Es4KC.png) Add a cell and close the notebook: ![modified](http://i.stack.imgur.com/zNsxZ.png) Reopen it, play a few with the checkbox: ![re- modified](http://i.stack.imgur.com/p9b2c.png) Lastly, be sure the checkbox is on, and close the notebook. Note that there's no external or internal clue about the notebook saved state. What will the _Front End_ do? What should it do? Shouldn't the checkbox remain checked when you re-open the notebook? **Primary question** : Should the _Front End_ close the window without any warning the notebook has been modified? Note that in this contrived example, the flag var is there to illustrate the issue, but perfectly could also be another near it with the result of a 7.2 billion years computation. **Secondary-- nice-to-have,-- question** : in case this issue bothers you, how would you resolve the problem in a nice, elegant, concise Mathematica way? **Bonus question** : you classify this as   1. you're-very-very-picky-and-a-little-paranoid, irrelevant   2. very minor   3. mild curiosity   4. serious  Now seriously, I've actually been bitten by this, and have spent significant time looking for a solution. If you attempt any involved GUI work, it's probable you won't notice this during development because the notebook morphs a lot. Only at the end, you clean up nice to discover all your persistent changes aren't being saved. You must then notify users that they have to save even though the window says nothing has changed. * * * **Old post** : The documentation of `DynamicModule` states: > Symbols specified in a DynamicModule will by default have their values > maintained even across Mathematica sessions. So, any change in `DynamicValues` vars able to persist should be reflected somehow. In particular, notebook saved state should be modified in this case, as if the user had created a new cell. As a contrived example, evaluate this:               CreateDocument[       DynamicModule[{x = False},        Pane@Row@{           Checkbox[Dynamic[x]],            " Notebook modified ",           Checkbox[            Dynamic[Refresh["ModifiedInMemory" /. NotebookInformation[], UpdateInterval -> 0.1]]]}]       , WindowSize -> {230, 80}, WindowElements -> {}, WindowToolbars -> {},       WindowFrameElements -> {"CloseBox", "DocumentIcon", "ResizeArea"}];      Observe the resulting notebook, in particular the **close button** and **document icon**. The first `Checkbox` is backed by a `DynamicModule` var, second one monitors if there're unsaved changes. ![Toying with DynamicModule backed UI](http://i.stack.imgur.com/kNciz.png) Adding a new cell (1st-2nd images) triggers the normal **UI** clues of unsaved data: in OSX, the filled **close button** and the **grayed-out document icon.**   Changing the checkbox (3rd-4th images), though, doesn't change the **UI** nor, more importantly, the internal document state. In fact, you can close the document without **FE** prompting to save it and observe subsequently that the first checkbox doesn't remember its setting. If you want **UI** persistence, you must force the saving. Other widgets behave similarly. The culprit here is surely `DynamicModule`, not the widgets or `Dynamic`. This is probably well known, and I see two explanations here. One, a bug/glitch (tested on Mathematica 9.0.1/OSX 10.9.2); two, this behavior is by design or tough to implement by the **FE**. Note that window resizing or zoom doesn't modify the notebook saved state also, even though the document metadata has changed. My take is the second case seems somewhat inconsistent from a **UX** point of view. The old controversy of data vs metadata remains unresolved and impractical, but in my opinion `DynamicModule` vars should be considered full data citizens. `DynamicModule` _raison d'être_ is session persistence. Some the strong points of **Mathematica** are the homoiconic, literate programming aspects, the unholy mix of code/data/metadata/application/IDE/document, and arguably `DynamicModule` vars are so data as any user-entered expression. If you make a Cell/Show Expression, it's easily observable that the `DynamicModule` vars are being modified and do change the cell expression:               Cell[BoxData[      DynamicModuleBox[{$\     CellContext`x$$ = True},        PaneBox[        TemplateBox[{CheckboxBox[       ...      Whether it's a bug or designed behaviour, I believe **WRI** won't change this in the near future. But I like my notebooks reflecting `DynamicModule` state changes. As a newbie, I see two quick'n'dirty very unsatisfactory solutions:   * Track the vars and save programmatically the document,              Checkbox[Dynamic[x,(x=#;FrontEndTokenExecute["Save"])&]]      or              Checkbox[Dynamic[x,(x=#;NotebookSave[])&]]      But, it's the user who should choose how and when to save the document, not the application.   * Create/delete ghost content, e.g.,              With[{nb = EvaluationNotebook[], scr = AutoScroll -> False},         SelectionMove[nb, After, Cell, scr];         NotebookWrite[nb, Cell["", "Text"], All, scr];         NotebookDelete[nb, scr]];      Ugly, and ungainly, and error-prone, not only for the fake changes, but for the selection resetting. I haven't found a way to fully restore the selection state (and this is something the **FE** does well: dynamic interactivity usually respects the selection point.) My question, then: is there a more elegant (concise, convenient) way to mark the notebook as changed so both UI and internal notebook state reflect the fact?


Creating a list from other lists and varying the number of elements that get added

Suppose I have                listA = {M, F}      and               ListB = {a,b,c}      I want to make a new               listC = {{Ma, Mb, Mb, Mb, Mc, Mc}, {Fa, Fb, Fb, Fb, Fc, Fc}}       Where I tell Mathematica how many copies of a particular element to make in listC. `Outer[]` seems like a good start but it returns the combined elements as a two item list. For example I get `{M, a}` instead of `M a`.


How does one get Mesh lines at 0 in ParametricPlot3D?

The following is in the documentation (MMA 10) under ParametricPlot3D -> Options -> Mesh :               ParametricPlot3D[{(2 + Cos[v]) Cos[u], (2 + Cos[v]) Sin[u],        Sin[v]}, {u, 0, 2 Pi}, {v, 0, 2 Pi}, Mesh -> 10]      You'll see that the lines for u=0 and for v=0 are missing. These can be restored by using `Mesh->Full`, but then the number of lines will be the default, 15. I'd also like to have the number of lines be different in the two directions, with each one containing 0, but Mesh->{Full,10}, e.g., gives an error. Here is the image in the documentation: ![missing mesh lines](http://i.stack.imgur.com/rYXpt.jpg) **Update:** While the answer below works as requested, it does not work for tubes. See this example:               ParametricPlot3D[{(2 + Cos[v]) Cos[u], (2 + Cos[v]) Sin[u],        Sin[v]}, {u, 0, 2 Pi}, {v, 0, 2 Pi}, Mesh -> 10,       BoundaryStyle -> Tube[.03], MeshStyle -> Tube[.03]]      ![enter image description here](http://i.stack.imgur.com/DVX9N.jpg)


Question about InputAutoReplacements

I have a question about `InputAutoReplacements`.               SetOptions[$FrontEndSession,         InputAutoReplacements -> {"spa" ->                  RowBox[{"〚", "\[SelectionPlaceholder]", "〛"}] } ]      It works, but always adds in spacing automatically. How can I get it fixed? Thanks! ![enter image description here](http://i.stack.imgur.com/wL9wy.jpg) Xiang Li


Numerical partial derivative

For a one-variable numerical function, it's simple to calculate the derivative at a point with `Derivative` as Szabolcs has pointed out before:               f[x_?NumericQ] := x^2     f'[3.]     (* 6. *)      But this fails for partial derivatives:               g[x_?NumericQ, y_?NumericQ, z_?NumericQ] = x y z + x^2 y^2 z          Derivative[1, 0, 0][g][1., 1., 1.]     (* 3. *)          Derivative[1, 1, 1][g][2., 3., 4.]     (* Unevaluated: Derivative[1, 1, 1][g][2., 3., 4.] *)      `ND` seems to only handle the one-dimensional case. Using `SeriesCoefficient` simply returns the (scaled) `Derivative` expression:               SeriesCoefficient[g[x, y, z], {x, 2., 1}, {y, 3., 1}, {z, 4., 1}]     (* Derivative[1, 1, 1][g][2., 3., 4.] *)      I'd prefer not to clutter my code with finite difference formulas, since this functionality must be in _Mathematica_ somewhere; where is it? **EDIT:** The closest I've found so far is `NDSolve`FiniteDifferenceDerivative`, but that works on grids and it's a hassle to use for other purposes. Anyone know of a convenient C/Java library that links well with _Mathematica_ and handles all kinds of numerical differentiation? **EDIT2:** Does `Derivative` have accuracy control? (step size or anything)               Clear @ f     f[x_?NumericQ] = Exp[x];     Array[Abs[Derivative[#1][f][1.] - E] &, {8}]      $$\left( \begin{array}{c|c|c} \text{n} & \text{seconds} & \text{error} \\ \hline 5 & 0.123 & 6.77\times 10^{-7} \\ 6 & 0.297 & 0.0000484 \\ 7 & 0.592 & 0.0127 \\ 8 & 1.05 & 1.11 \\ \end{array} \right)$$


How to define a vector with automatically added symbolic elements with subscripts

I want to define a vector lets say **k** containing elements Symbolize[Subscript[ _k_ , 1]], _k2_ , _k3_ ... etc. When I define lets say _k4_ . I want the symbol automatically added to vector k. Something like below but not working at all.               k /: {k, Symbolize[      ParsedBoxWrapper[      SubscriptBox[      StyleBox["v", FontFamily -> "Courier New", FontWeight -> "Plain",         FontSlant -> "Italic"], "_"]]]} :=      AppendTo[k, Subscript[v, _]];      My Question is; 1) How can I symbolically define elements (with sub scripts) automatically added to a vector. 2) If I assign values to symbols, How can I get elements values only and symbols only. **EDIT 1**               Symbolize[Subscript[k, _]]       Command Symbolizes all subscripts of **k** e.g. _k1_ (`Subscript[k, 1]`), _k2_ (`Subscript[k, 2]`) etc. This is fine. What I want is collect _k1, k2 k3_ in a set (List) **k** with out additional commands or additional functions. Just as soon as sybolize sub scripted ones it should add it self to set k (sort of pattern maching as in `Subscript[k, _]`). When I call k it should give me the list { _k1, k2, k3_ }. @Mr. Wizards answer gives the list but as calling function `ksym`. Sort of what I need but not exactly. @halirutan answer is also interesting but I don' t want to define additional functions or operators (may be as minimum as possible). **EDIT 2** Its sort of bag or set; no order is required, only _k1,k3_ can be given and _k2_ can be missing. **EDIT 3**               << Notation`     (*below line symbolizes all subscripted k_]*)     Symbolize[ ParsedBoxWrapper[        SubscriptBox["k", "_"]]]      somewhere here I need additional code that all _k_ _ are added to k once its been defined. For example:               {Subscript[k, 1], Subscript[k, 2], Subscript[k, 3]} = {1, 2, 3}      after that when I ask k it should give me `{Subscript[k, 1], Subscript[k, 2], Subscript[k, 3]}` as @Mr.Wizard suggested `ksym[] := HoldForm @@@ UpValues[k][[All, 1]]` and for values `kval[] := UpValues[k][[All, 2]]` should work. But, what I' m missing in @Mr.Wizard example is that one needs to define symbols as;               k /: Subscript[k, 1] = "val1";     k /: Subscript[k, 2] = "val2";     k /: Subscript[k, 3] = "val3";      what I need is once I write `{Subscript[k, 1], Subscript[k, 2], Subscript[k, 3]} = {1, 2, 3}` I should be able to get k vector and `{Subscript[k, 1], Subscript[k, 2], Subscript[k, 3]}` is appended automatically to k.


Is there a way to "lock" some cells in a notebook?

Is there a way to "lock" some cells in a notebook so they can't be edited? It's usually input cell that's documenting some functionality. I'd like other readers of the notebook to be able to execute them but not changing them.


Export animation of a Manipulate autorun sequence?

I've got a Manipulate that does a vector field plot. Basically a function that returns a list of Graphics objects and a couple of sliders:               Manipulate[      Show[ReleaseHold[s[v, r1, r1 + s2] ]]      , {{r1, 1.}, 1., 2.5 }      , {{s2, 1.}, 1., 2.5 }      , {{v, 1.}, 0., 2.5 }      ]      Once I set the sliders in a position that I like, I discovered the neat feature "Paste Snapshot" that samples my slider position values, that I can use to save the resulting image to a file. I've just discovered the autorun feature of Manipulate, which is a neat visualization tool. Is there a way save the autorun output showing the image and the sliders all animated in a list, so that I can run Export[ "filename.avi", %] as if I had a plain old table of images?


How to solve a Differential Equation with DSolve with Function Coefficient?

Suppose I have               v[x_] = (1.453 Sech[x + 1])^2 + I  Sech[x + 1] Tanh[x + 1]      And I have to solve the equation:               mu1 u1[x] - u1''[x] - v[x] u1[x] == 0      for `u1[x]`. The conditions that are given are:               u1[-2] == 1, u1'[-2] == 0 .      I have tried `DSolve` but it shows errors: > Solve::inex: Solve was unable to solve the system with inexact coefficients > or the system obtained by direct rationalization of inexact numbers present > in the system. Since many of the methods used by Solve require exact input, > providing Solve with an exact version of the system may help. How can I Solve this equation in Mathematica symbolically?


Extracting a range of data from a table

I have text file with data in 2 columns. I have imported it using the following line               c = Import["ab", "Table"];      This text file has a large amount of data, and I need only a certain range. What I mean is, if my data runs for example from `-10 to +10`, I need only from `-5 to +5` and its corresponding values. So I naively tried this               Plot[c, {-5, 5}]      which is clearly wrong, and its little wonder that I am getting an error message. Not sure what to do. Please help!


Is it possible to print more than last line with Get (<<) without using Print commands?

I want to run my _Mathematica_ scripts from the terminal and I want it to print lines like MATLAB would. That is, suppress output by ending a line with `;`, and otherwise print the output of the line. `Get` (`<<`) only prints the last line. Without using Print[var] and saving variables after every line... Is this possible?


How to find 4 unknowns?

There are 4 unknowns constants: `a`,`b`,`c`,`p`. The variable is `phi` and the result is `d`. For `phi={13,23,45,73}` the results are `d={32.08754292290807,32.1136624112758,32.1728430675844,32.2430287624866}` The equation is:               (c/0.3048*((1+(a*p/(b*c))*(sin(phi*pi/180))^2))/sqrt(1-sqrt(1-b^2/a^2)*     ((sin(phi*pi/180))^2))) = d      How can I solve it in Mathematica?


Lowering the degree of an polynomial with an assumption that the polynomial has a factor x^2+ax+b

Let's assume $ x^{10}+x^5+1 $ has a factor $x^2+ax+b$ Then, If $x^2=-ax-b$, $ x^{10}+x^5+1 =0$. If we successively apply $x^2=-ax-b$ to $ x^{10}+x^5+1 $, we can make $ x^{10}+x^5+1 $ to degree 1, such as $ mx +n $ and it should be that $m=0, n=0$ So having it on my mind, I tried,               x^10+x^5+1 //. x^2-> -a x -b      Didn't work.               x^10+x^5+1 //. x_^2-> -a x -b      Didn't work. So, any suggestions? Thanks ahead!


FourierTransform and Partial Derivatives?

I have a function of three variables $f(x,y,z)$, and it obeys a linear partial differential equation. I'm checking my by-hand calculations with Mathematica. I want to convert the PDE into the Fourier-spectral domain, but Mathematica isn't playing nice. I find the following behavior baffling.               FourierTransform[D[f[x, y, z], x], {x, y, z}, {kx, ky, kz}]      > `-I kx > FourierTransform[FourierTransform[FourierTransform[f[x,y,z],x,kx],y,ky],z,kz]`               FourierTransform[D[f[x, y, z], y], {x, y, z}, {kx, ky, kz}]      > `FourierTransform[Derivative[0, 1, 0][f][x, y, z],{x,y,z},{kx,ky,kz}]`               FourierTransform[D[f[x, y, z], z], {x, y, z}, {kx, ky, kz}]      > `FourierTransform[Derivative[0, 0, 1][f][x, y, z],{x,y,z},{kx,ky,kz}]` Essentially, it's like Mathematica uses $\mathcal{F}\left[\frac{\partial f}{\partial x}\right]=-i k_x \mathcal{F}\left[f\right]$ for the first argument $x$, but does not use the same rules/identities for partials w.r.t. second and third arguments, i.e. $\mathcal{F}\left[\frac{\partial f}{\partial y}\right]$ and $\mathcal{F}\left[\frac{\partial f}{\partial z}\right]$ are not simplified. What's going on here? **How can I force Mathematica to do this simplification for the other variables?**


Keeping Quotation Marks in Output

I am running into the following seemingly simple problem. I have this code:               testphrase="i love you";     input=ToLowerCase[StringSplit[testphrase, Whitespace]]      It outputs, `input={i,love,you}` However, I want to use input elsewhere in my program as `"i","love","you"`. So the behaviour I am looking for is as such: `input={"i","love","you"}` I know if I paste input, the quotation marks show up around it. I know the issue resides somewhere in `ShowStringCharacters`, as I've read that documentation, but I'm getting mixed up in the different behaviour between pasting it, manually inputting it, and calling on it in Mathematica. My program will only work if the output is formatted in three words with quotation marks, and won't work if the quotation marks aren't there. --- edited to add --- The solution below looks like it should work, but I am still getting odd behaviour. Here is my whole code. The follow example outputs to count the number 111, as it should.               trigrams={{{"i", "don", "t"}, 211}, {{"i", "can", "t"},        186}, {{"you", "don", "t"}, 175}, {{"don", "t", "know"},        137}, {{"oh", "oh", "oh"}, 111}};     Clear[trigramHash];     (trigramHash[Sequence @@ #1] = #2) & @@@ trigrams;     count = trigramHash["oh","oh","oh"]; trigramHash[___] = 0;       Yet this still outputs zero.               test = InputForm[ToLowerCase[StringSplit["oh oh oh", Whitespace]]];     trigrams = {{{"i", "don", "t"}, 211}, {{"i", "can", "t"},          186}, {{"you", "don", "t"}, 175}, {{"don", "t", "know"},          137}, {{"oh", "oh", "oh"}, 111}};     Clear[trigramHash];     (trigramHash[Sequence @@ #1] = #2) & @@@ trigrams;     count = trigramHash[test]; trigramHash[___] = 0;      Even though, on the face of it, test should work - it is outputting as "oh","oh","oh".


Unexpected behavior of subtraction with approximate numbers

I'm using the `Table` command to generate a list of values:               FullForm /@ Table[10. - x, {x, 2.7, 2.8, .1}]      and I get the following result:               {7.3`,7.199999999999999`}      Why do I get `7.199999999999999'` instead of 7.2? Moreover, if I try to calculate the `Complement` of `{7.2}` in this list, I get `{7.2,7.3}`, which is not what I would expect. At the same time, using the `Complement` option `SameTest->(#1==#2&)` gets me `{7.3}`. This behavior is observed in Mathematica 7/8/9, and even on WolframAlpha. P.S. I know that using `Range[7.3,7.2,-0.1]` would be clearer, I'm just curious about the aforementioned problem.


Frame or EdgeForm disappearing out of PlotRange

I am trying to obtain a thin frame around the bars in this chart but it's proving rather tricky. Can anyone suggest a solution?               size = {3, 12, 8, 0.5, 7, 5, 6, 7, 3, 4, 2};          bar[i_] := Inset[Graphics[{EdgeForm[{Thin, Black}],         FaceForm@LightBlue, Rectangle[{0, -1/2}, {size[[i]], 1/2}]},        PlotRange -> {{0, size[[i]]}, {(-1/2), 1/2}}],       {1, -(Length[size] - i + .5)}, {Left, Center}, size[[i]]];          Graphics[{LightYellow, Rectangle[{0, 0}, {15, -(Length[size] + 1)}],       Array[bar, Length[size]]},      PlotRange -> {{0, 15}, {0, -(Length[size] + 1)}}]      ![enter image description here](http://i.stack.imgur.com/mmzBt.png) A second version has the same problem:               bar[i_] := Inset[Graphics[{LightBlue,         Rectangle[{0, -1/2}, {size[[i]], 1/2}]},        PlotRange -> {{0, size[[i]]}, {(-1/2), 1/2}},        Frame -> True, FrameTicks -> None, ImagePadding -> 0],       {1, -(Length[size] - i + .5)}, {Left, Center}, size[[i]]];      **Edit** Thanks to Heike's comment I have something I can use:               size = {3, 12, 8, 0.5, 7, 5, 6, 7, 3, 4, 2};          bar[i_] := Rectangle[{1, -(i - 1)}, {size[[Length[size] + 1 - i]] + 1, -i}];          Graphics[{LightYellow, Rectangle[{0, 0}, {15, -(Length[size] + 1)}],       EdgeForm[{Thin, Black}], FaceForm@LightBlue,       Array[bar, Length[size]]},      PlotRange -> {{0, 15}, {0, -(Length[size] + 1)}}]      ![enter image description here](http://i.stack.imgur.com/eLgDK.png)


String replacement to make the TeXForm output beautiful

This question is inspired by this question: How to convert the symbol $d$ in Integrate into $\mathrm{d}$?. Although it’s not a big problem, the `TeXForm` can be modified manually to “standard” form, I’m curious why _Mathematica_ ’s `TeXForm` won’t change the differential d to $\mathrm{d}$ automatically. There are some detailed situations to pay attention to.   * The integrand or the integration argument may contain some variables having letter “d”(Such as: det, adcda, etc.) or even “d” itself.(Although it’s ugly to do so.)   * Mathematica will automatically change alpha to $\alpha$.   * Single-character symbol names are given in _italic_ font, while multiple character names are given in roman font. I’ve written some lines of codes to do this. But I think the code is ugly and can’t handle the situation with integration argument’s name exactly “d”. Here is my code.               cTeXForm[expr_, arg__] := Module[{       (*temp saves the original TeXForm*)       temp = ToString@TeXForm@HoldForm[Integrate[expr, arg]],      (*var saves the integration argument and reverse the order to keep up with the integral symbol*)       var = ToString /@ TeXForm /@ Reverse@(Flatten /@ ({#} & /@ {arg}))[[;; , 1]], pos, range, betweenQ, loc},       (*locate the position of differential d*)       pos = StringPosition[temp, "d"][[;; , 1]];       range = StringPosition[temp, var];       betweenQ[n_] := Catch@(Scan[If[#[[1]] <= n <= #[[2]], Throw[0], n] &, range];Throw[1]);       loc = {#, #} & /@        Pick[pos, betweenQ[#] & /@ pos, 1][[-Length@var ;; -1]] ;       (*replace and output*)       CopyToClipboard@OutputForm@StringReplacePart[temp, "\\mathrm{d}", loc]]      Here is the test (although no beautiful):               cTeXForm[x^2 alpha d baded, {x, 1, 2}, {alpha, 2, 3},baded]      And here is the output of my code $$\int _1^2\int _2^3\int \alpha \text{baded} d x^2\mathrm{d}\text{baded}\mathrm{d}\alpha \mathrm{d}x$$ So the question is how to **precisely** change the differential d to $\mathrm{d}$? Are there any other ways to do this? (`RegularExpression`, rule- based replacement etc. I’m not familiar with these.) Any advice about the string manipulation or using `TeXForm` is welcomed.


Count and plot the number of solutions in an interval

I have equations depending on one or more parameters and I want to find and plot regions in the parameter space in which there is a specific number of solutions. For definiteness let's consider a simple case               -3 + 3 mu2 - 6 q mu2 - 8 q^3 mu4 + 4 q^4 mu4 + q^2 (3 mu2+ 4 mu4) == 0      where I want to find and/or plot regions in the space `(mu2,mu4)` in which the equation has `0, 1,...,4` solutions with `0 < q < 1`. Note that I want to use the same method also for non-polynomial equations (and possibly systems of equations).


How can I add any points in Manipulate?

(* 5.3  1 *)     X = {x, 1 - x}     Y = {y, 1 - y}     A = {{2, -1}, {0, 1}}     B = {{-3, 3}, {1, -2}}     f1[x_, y_] = X.A.Y     f2[x_, y_] = X.B.Y     (* Print["Pago del Row Player en Eq-> ",f1[3/5,1/2]]     Print["Pago del Col Player en Eq-> ",f2[3/5,1/2]] *)     Manipulate[           ParametricPlot[{f1[x, y], f2[x, y]}, {x, 0, 1}, {y, 0, 1},        PerformanceGoal -> "Quality",            Epilog -> {Red, PointSize -> .036, Point[{f1[p, q], f2[p, q]}]}],           Style["Representación de los pagos de Prisionero 1(abscisas) y \     Prisionero 2 (ordenadas) en el Dilema del Prisionero", 11, Bold],      Delimiter,           Style["Prisionero 1 juega la estrategia mixta(p,1-p), con el valor \     de p indicado a continuación", 10, Darker@Blue],      {{p, 0}, 0, 1, Appearance -> "Open"},      Delimiter,           Style["Prisionero 2 juega la estrategia mixta(q,1-q), con el valor \     de q indicado a continuación", 10, Darker@Orange],      {{q, 0}, 0, 1, Appearance -> "Open"},      Delimiter,           Style["Valores MAXIMIN", 11, Bold, Darker@Black],      (*Style["Valor Maximin para Norm: 5/6",10,Darker@Gray],      Style["Valor Maximin para Cliff: 5/6",10,Darker@Gray],*)           Delimiter,      Style["Estrategias de Equilibrio", 11, Bold, Darker@Black],      Delimiter,      Style["Nota.- Los años de carcel son los valores absolutos de lo \     indicado en los ejes. Se indican en negativo porque es algo \     malo/negativo", 10, Darker@Black],      Style["Creado por Rafael Sanmartín( rafaorly@gmail.com )", 10,        Darker@Black],           ControlPlacement -> Left, SaveDefinitions -> True           ]      ![Mathematica graphics](http://i.stack.imgur.com/OVg3t.png) I tried to add any point after `Epilog`, but I can't. I want to add, for example, the points $(2,-3)$, $(-1,3)$, and $(0,1)$ or $(f_1(0.5), f_2(0.5))$ and $(f_1(0.4), f_2(0.3))$.


Unset variable by its name given as a string

Unlike the function Clear, the function Unset does not work for string patterns. Given the name of a variable as a string, how can you unset the corresponding variable? Example: Given:               x = 10;      trying to unset later:               Unset[Symbol["x"]]      results in               Unset::write: Tag Symbol in Symbol[x] is Protected. >>      Using `With`:               With[{var = Symbol["x"]}, Unset[var]]      results in               Unset::usraw: Cannot unset raw object 10. >>      Note that `Clear["x"]` is not an option, because it also removes all `DownValues` associated with `x`.


Symbolic manipulation of functional form

I have a functional polynomial expression of the form:               expr = f[x] + f[x] g[w] + Conjugate[f[y]] g[z] +            Conjugate[g[z]] + g[w] + f[x] f[y] g[w] + 1 +            Conjugate[a] f[t] + Conjugate[b] Conjugate[c]      I would like to write a function that selects terms that are up to linear (i.e. zero and first order) in the functions `f` and `g`, eg. in my case the correct output would be:               1 + f[x] + Conjugate[g[z]] + g[w] + Conjugate[a] f[t] +     Conjugate[b] Conjugate[c]       Note that the functions are complex, and the conjugate terms are also considered. I basically just want to neglect second-order terms and higher.


Organise data in table

I have a large amount of data available (in excel), which is not very organised. I can do this by copy paste, but I am trying to do this using mathematica. Hopefully someone can help me. I imported the data, and it is now organised in a matrix that looks like this:               test = {{{dog, 5}, {"", ""}, {"", ""}}, {{cat, 7}, {dog, 2}, {"", ""}}, {{dog,3},{horse, 2}, {cat, 1}}, {{horse, 7}, {cat, 2}, {dog, 1}}};     TableForm[test]      So on day one, they counted 5 dogs, but no other animals, on day 2 they counted 7 cats, and 2 dogs, day 3: one horse, 2 cats etc.. To analyse this data I want to create a table that gives for each day, the amount of animals but then organised in columns per animal (even if the animal is not present at that day) like this:               result = {{"dog", "cat", "horse"} , {5, "", ""}, {2, 7, ""}, {3, 1, 2}, {1, 2, 7}};     TableForm[result]      I tried somethings using `pick` and `sort` but could not figure out how to do this. Of course this example is very simple, but the real data are for a 978x15 table (and does not involve animals ;) )


Check if integer has even number of digits

I want to check if a number has an even or odd number of digits. `10` would be even because it has 2 digits `300` would be odd because it has 3 digits `986786` would be even, because it has 6 digits Seems like I would be dividing it by a power of 10, is that right?


Finding fourier transform of data and hence frequencies

I looked at all the other questions related to mine before posting this, and they didn't solve my problem. I have a large data set which can be downloaded from here. I'm using the following code to plot the DFT:               data = ToExpression @ Import["http://ge.tt/api/1/files/3dvZMs61/0/blob?download"];     ListPlot[Abs[Fourier[data]], Joined -> True, AxesOrigin -> {0, 0}]      ![enter image description here](http://i.stack.imgur.com/apHNw.gif) As far as I can tell, there is no pronounced single or countable number of frequencies in this data set. However, if I just plot the data, I get:               ListPlot[data, AxesOrigin -> {0, 0}]      ![enter image description here](http://i.stack.imgur.com/3CPpJ.gif) Here it is evident that there is a subtle periodic character, whose frequency is what I want. Why am I not getting that frequency as a peak in the first plot?


How to collect expressions from cells created by Print?

I have a notebook where evaluation of a certain cell produced hundreds of adjacent output cells using `Print`. I need to create a list containing all expressions from those output cells as elements, and assign the list to a variable **without re-running the evaluation**. Could you suggest a way to automate this process to avoid manually copying all expressions?


No menu in Mathematica 10 under Ubuntu 14.04

I have recently installed latest _Mathematica_ 10 on Ubuntu 14.04. **Problem:** no menu available in global menu. Is there are any fix for this? The problem appear only when run from Unity launcher. When new window created via `Ctrl` + `N` the menu shows normally. Screenshot: ![enter image description here](http://i.stack.imgur.com/Thdrm.png)               AbsoluteOptions[EvaluationNotebook[], WindowElements]      > >     {WindowElements -> {"StatusArea", "MemoryMonitor", >        "MagnificationPopUp", "HorizontalScrollBar", "VerticalScrollBar", >        "MenuBar"}} >


Logic behind Flatten and Append to in Module

I have a list(kicks), and a function(fix). I am aware of the problem using Loop and Append or AppendTo. My question is why does the Flatten produce the desired output. List:               kicks = {6.28992, 1.78953, 4.67832, 3.85717, 4.15561, 7.9862, 8.02365,              2.62077, 5.89348, 6.50246}      Function:                fix[list_] := Module[{xos, comp, ct},         comp = {};         xos = If[list > 7, AppendTo[comp, list]];         ct = Flatten[comp]]          fix[#] & /@ kicks               Output: {{}, {}, {}, {}, {}, {7.9862}, {8.02365}, {}, {}, {}}      Desired output:               {7.9862, 8.02365}      I want to understand why Flatten in this case does not work, and how to solve it while using Module.


Are there any plans to develop Wolfram OS? Google has developed Chrome OS/Chromium OS dedicated to easy and fast access to the web. Valve has developed Steam OS that created primarily for playing video games and provide huge performance boost because of tight integration of the OS with a computer's hardware. Both of the OS's are delivered as pre-installed OS on the special machines such as Chromebooks and Valve Machines. Since Mathematica is "integrated all-in-one platform", there can be a lot of benefits to have own OS - Wolfram OS that can be the defacto platform for computations and research and provide significant performance improvements over the standard OS's. I think a lot of hardware manufacturers will be interested in delivering scientific-oriented computers - Wolfram Machines.


Communication between local kernels

this is my first post but you have already helped me so many times that I have to start by saying thanks a lot! I have a really long calculation to do, and I have used the Evaluation->Kernel configuration options to create 2 new local kernels and divided the task in three groups of little ones. The problem is that I don't know how to share the information between different notebooks running on different local kernels. Can you help me? Thanks again anyway.


Is there a free version of the Springer book "Mathematical Statistics with Mathematica"?

Is there a free version of the Springer book: $$\text{Mathematical Statistics with Mathematica}$$ by Rose and Smith ... available on the internet?


WhenEvent for several variables

I want to solve a system of nonlinear two differential equations (say, in $\theta(x,t)$ and $\phi(x,t)$ with `NDSolve`, but I want to stop the evaluation when one of the functions ($\phi(x,t)$) reaches zero, or, for instance, a certain value $\bar{\phi}$. Because then I would like to study how, where and (of course) when this pinch- off happens. What is the best way of doing this, in your opinion? Putting a constraint before running `NDSolve`? I tried with WhenEvent, adding a line `WhenEvent[\\[Phi][x, t] == 0, Plot[\\[Phi][x, T], {x, 0, L}]` in the code, but it gives me               NDSolve::litarg:     To avoid possible ambiguity, the arguments of the dependent variable in  WhenEvent     (...)should literally match the independent variables      Here is the link to the shortest code I can manage to give: https://www.dropbox.com/s/4t5o53lppb2itk8/mma3.nb


How to connect a checkbox with part of the graphics?

I'd like to have a checkbox in a `Manipulate` expression, governing whether part of the graphics is displayed or not. For instance, assume that I have a surface with two planes:               Show[Plot3D[x^2+y^2,{x,-1,1},{y,-1,1},PlotStyle->Opacity[0.5]],       ParametricPlot3D[{0, u, v}, {u, -1, 1}, {v, -1, 1}, PlotStyle -> Opacity[0.5], Mesh -> None],       ParametricPlot3D[{u, 0, v}, {u, -1, 1}, {v, -1, 1}, PlotStyle -> Opacity[0.5], Mesh -> None]]      Now I'd like to wrap it in a `Manipulate` with two checkboxes, enabling or disabling the planes. Currently, I'm doing something like this:               Manipulate[      Apply[Show,        Join[{Plot3D[...]},         If[xzero, {ParametricPlot3D[{0, u, v}, {u, -1, 1}, {v, -1, 1},            PlotStyle -> Opacity[0.5], Mesh -> None]}, {}],         If[yzero, {ParametricPlot3D[{u, 0, v}, {u, -1, 1}, {v, -1, 1},            PlotStyle -> Opacity[0.5], Mesh -> None]}, {}]]],     {{xzero, True, "x=0"}, {True, False}}, {{yzero, True, "y=0"}, {True,         False}}]      but somehow feel it's overly complicated. What is the right way to do this?


Catching and debugging numerical errors in compiled functions

I have a compiled function (that was created using the second method of this question). Basically it's using a compiled closure. The problem is that for some parameter values it does not evaluate. Here is a small example:               (*just some function that has a singularity at x=5*)     f = Compile[{{x, _Real, 0}, {a, _Real, 0}}, Sin[a*x*Pi/180]/(x - 5)        , RuntimeOptions -> {"Speed", "EvaluateSymbolically" -> False}];          (*The wrapper just increments the x values by diff. Aa is the      variable that is supposed to be inlined in the closure*)     Block[{Aa},       With[{wrapper =           Compile[{{x, _Real, 0}, {diff, _Real, 0}},            Evaluate@f[x + diff, Aa]]},        min = Compile[{{xs, _Real, 1}, {Aa, _Real, 0}, {diff, _Real, 0}},          First@Sort[wrapper[#, diff] & /@ xs]          , CompilationOptions -> {"InlineCompiledFunctions" -> True,             "InlineExternalDefinitions" -> True,             "ExpressionOptimization" -> True},           RuntimeOptions -> {"Speed"}](*compile*)        ]       ];          (*The warning is harmeless*)     (*CompiledFunction::cfsa:Argument diff+x at position 1 should be a machine-size real number. >>*)          (*The function is compiled*)     Needs["CompiledFunctionTools`"]     CompilePrint[min]                       3 arguments             9 Integer registers             11 Real registers             3 Tensor registers             Underflow checking off             Overflow checking off             Integer overflow checking off             RuntimeAttributes -> {}                  T(R1)0 = A1             R0 = A2             R1 = A3             I7 = 0             I6 = -5             I3 = 1             R6 = 3.141592653589793             I5 = 180             Result = R7          1   I2 = Length[ T(R1)0]     2   I8 = I7     3   T(R1)1 = Table[ I2]     4   I4 = I7     5   goto 20     6   R3 = GetElement[ T(R1)0, I4]     7   R2 = R1     8   R5 = R2 + R3     9   R4 = R0     10  R8 = I5     11  R9 = Reciprocal[ R8]     12  R8 = R6 * R9     13  R9 = R4 * R5 * R8     14  R8 = Sin[ R9]     15  R9 = I6     16  R10 = R5 + R9     17  R9 = Reciprocal[ R10]     18  R8 = R8 * R9     19  Element[ T(R1)1, I8] = R8     20  if[ ++ I4 < I2] goto 6     21  T(R1)2 = Sort[ T(R1)1]]     22  R7 = Part[ T(R1)2, I3]     23  Return      But then here are the use cases:               (*everything works OK even though the singularity is in the arguments*)     min[{1,5,5},1,0]     (*=> -0.0043631*)      But for some arguments it does not:               (*But if all the arguments are singularites: BLAM!*)     min[{5,5,5},1,0]          (*=> CompiledFunction[{x,a},Sin[(a x \[Pi])/180]/(x-5),-CompiledCode-][5,Aa] *)      > >        CompiledFunction::cfne: Numerical error encountered; proceeding with > uncompiled evaluation. >> >        CompiledFunction::cfse: Compiled expression Aa should be a machine- > size real number. >> >        CompiledFunction::cfex: Could not complete external evaluation at > instruction 2; proceeding with uncompiled evaluation. >> >   Questions:   * Why is this working if some of the arguments give division by zero, but does not evaluate if all of the arguments are incorrect?   * **How can one debug such problems?** There is nothing obviously wrong at instruction 2 in the compiled output...   * How to guard against and/or catch such errors in compiled code?


The dangers of SaveDefinitions --- should this really happen?

I have been bitten hard by `SaveDefinitions -> True`. I'll describe in detail what happened below. My questions are: Is this a bug? What is the most convenient workaround? * * * Consider a definition issued like this:               Block[{x, y}, f[x_, y_] = x + y;]      Why didn't I use `:=` instead? Because the expression that stands in place of `x+y` in my actual problem is computed (symbolically) within the `Block` so (numerical) evaluations of `f` are going to be sufficiently fast. We can check the definition:               ?f      > f[x_,y_]=x+y Now let's give `x` a value ...               x = 1      ... and test that `f` still works as expected:               f[0, 0]      > 0 (* as expected *) Let's use `f` in `Manipulate` with `SaveDefinitions -> True` ...               Manipulate[f[a, b], {a, -1, 1}, {b, -1, 1}, SaveDefinitions -> True]      ... and check that it works again:               f[0, 0]      > 1 (* oops!! *)               ?f          f[x_, y_] = 1 + y      The definition of `f` has been rewritten _and changed to something else_ as a side effect of `SaveDefinitions`. What is the morale? Probably that `SaveDefinitions` and `Set` are not safe to use together. Note that what happened here is different form the situation when the definition of `f` is overwritten just because a notebook containing a manipulate with SaveDefinitions has been opened. * * * My current workaround is to use the following hack to "neutralize" the `HoldAll` attribute of `SetDelayed`:               Block[{x, y},      (f[x_, y_] := #) &[x + y];]      Alternative suggestions are welcome.


Accessing files in different directories

I have a problem that I am trying to work on. My Folder structure is like this.   * Application(MainDirectory)   * AppData( Secondary directory where files are Design.m, Layout.m, and Evaluation.m)   * Data(Another directory where datafiles are excel cheets, csv sheets, etc) The design.m file calls for an `listTabValues = Import[FileNameJoin[{DirectoryName[NotebookDirectory[], 1], "data", "VariableNames.xlsx"}]]` to access data in the files of the Data folder. I have a notebook in the Application(Main Directory) where I do `Get[FileNameJoin[{NotebookDirectory[], "AppData", "Design.m"}]]` to get the contents of the Design.m file. The problem is when I evaluate in this manner, the `NotebookDirectory[]` is set to the Application(Main Directory) and the design takes the same value and not the AppData directory as the `NotebookDirectory` where the Design.m files resides and the data access fails. Any way to wok around this?


Mathematica automaticly evaluates some cells

Is there a command or a trick to tell Mathematica to not automaticly evaluate some cells? I use the `NMinimize` function to calculates some coordinates and then use that data with `Manipulate`. When I run `NMinimize`, Mathematica automaticly runs `Manipulate`.


PDF exports of ArrayPlot's are fuzzy (OS X)

[The following problem occurs on OS X; I don't know if it also occurs with other OS's.] If I produce a `Graphics` object with `ArrayPlot`, right-click on it, choose "Save Graphic As...", and save it as a PDF file, the resulting PDF graphic is absurdly fuzzy/blurry (which is particularly perverse, considering that it is among the simplest kind of graphics (all solid-color squares with vertical and horizontal edges). For example, in the PNG screenshot below, one such figure is shown in the Mathematica GUI (on the left), and the PDF file exported as described above (and displayed at "Actual Size" magnification with the Preview app) is shown on the right: ![original vs PDF](http://i.stack.imgur.com/iJDtl.png) (Actually, the screenshot of the original on the left looks fuzzier to me than what I actually see on the screen, but that degree of fuzziness is nothing compared to what the PDF looks like.) As I understand it PDF is the native graphics format for OS X. It should be possible (not to say trivial) to save this _very_ simple graphic as a PDF in a way that preserves all the edges and corners to infinite resolution. Does anyone know how? PS: FWIW, I did try displaying the `Graphics` object above with `Style[#, Antialiasing->False]&`, but this change had no effect, either on the resulting PDF nor on the object's appearance in the Mathematica GUI.


Defining a function that handles Dynamic arguments similar to Built-ins

Firstly please note that I'm using simply `Dynamic` behavior to illustrate my question, I'm not asking how to move a `Disk` or make a `Slider`. When defining custom functions that allow interactive changing of variables I have almost always gotten by with just setting the attribute `HoldFirst` and giving the variable as a first argument and wrapping `Dynamic` where appropriate in the code defining the controller for example:                SetAttributes[mySlider, HoldAll]       mySlider[var_, range_] := Slider[Dynamic[var], range]       DynamicModule[{a = 0.4},       {mySlider[a, {0, 1}], Dynamic[a]}      ]      But I feel that this is somewhat clashing compared to the interfaces of the build-in controllers and would like to have a similar interface such as those, namely changing such a definition to:                mySlider2[var_Dynamic, range_] := Slider[var, range]      DynamicModule[{a = 0.4},      {mySlider2[Dynamic[a, Temporary], {0, 1}], Dynamic[a]}]      Which in a sense allows the full specification of Dynamic to be used, here showing for example the use of a `Temporary` setter. For this simple example the change is rather painless, however the problem arises in situations where the code doesn't just pass on variables but needs to split them out in some way, for instance this manual implementation of a movable disk:                myMovableDisk[Dynamic[r_, {fstart_, f_, fend_}]] :=        EventHandler[Dynamic@Disk[r, 1],{        {"MouseDown", 1} :> fstart[MousePosition["Graphics"], r],        {"MouseDragged", 1} :> f[MousePosition["Graphics"], r],        {"MouseUp", 1} :> fend[MousePosition["Graphics"], r]       }]      Now this matches the longest definition, but I would rather like not to have to provide multiple definitions for `myMovableDisk[Dynamic[r_, { f_, fend_}]]`,`myMovableDisk[Dynamic[r_, f_]]` and such. So my way of doing this was to set `HoldAll` and just provide rewriting calls to other definitions:                myMovableDisk[Dynamic[r_]] := myMovableDisk[Dynamic[r, {None, Automatic, None}]]      myMovableDisk[Dynamic[r_, {f_}]] := myMovableDisk[Dynamic[r, {None, f, None}]]      myMovableDisk[Dynamic[r_, f_]] := myMovableDisk[Dynamic[r, {None, f, None}]]      myMovableDisk[Dynamic[r_, {f_, fend_}]] := myMovableDisk[Dynamic[r, {None, f, fend}]]      myMovableDisk[Dynamic[r_, Temporary]] := myMovableDisk[Dynamic[r, {None, Temporary, Automatic}]]      To me this seems like a less elegant solution to allow normal dynamic interactivity, and I have yet to actually define how for instance a Temporary setter should work. I was wondering if there was an easier way to carry out such definitions, something akin to just accepting a `_Dynamic` argument and then query it to get the values of `fstar`,`f` and `fend` in the code actually defining `myMovableDisk`? Additionally I wonder if there is a write up of something like an interface definition for `Dynamic`, in essence answering what a function accepting `Dynamic[var]` should live up to of expectations in order to mirror a build-in function, since I'm really just working against the help page.


Poor quality Rasterize output when Background -> None

I am attempting to generate partially transparent images for PNG `Export`, but seem to run to the following issue. If I `Rasterize` a simple piece of `Graphics` with `Background -> None` (transparent) it looks worse:               rings = Image[         Rasterize[          Graphics[{Black, Disk[], White, Disk[{1, 1}/64, 1 - Sqrt[2]/64]}],            Background -> #, RasterSize -> 400, ImageSize -> 400]] & /@ {None, White}      > ![enter image description here](http://i.stack.imgur.com/ho1BD.png) First version appears jagged, as a circle drawn using a too simple polygon would do. I can verify this with `ImageDifference`:               ImageAdjust[ImageDifference @@ (RemoveAlphaChannel[#, White] & /@ rings)]      > ![enter image description here](http://i.stack.imgur.com/JZsO6.png) Jagged pattern is clearly visible. How to use `Rasterize` with `Background -> None` (or anything similar generating an alpha-channel image) and achieve good output quality without resorting to generating primitives such as `Disk` using hand-crafted code? **Clarification:** I want alpha channel on the output to behave as it does on `Rasterize[..., Background -> None]`. That is, the image having conceptually three regions: transparent background, black outer disk and white (non-transparent) inner disk. (These screenshots were taken on Mathematica 9.0.1.0 running on OS X 10.8.4.)


Solve differential equation with undetermined constants making the assumption that the constants are positive

I want to solve:               eqn = D[f[w], {w,2}] + (3/2 c^2 k Exp[c w] - 9/4 c^2  k^2  Exp[2 c w]) f[w] +  m^2 f[w]          sol = DSolve[eqn == 0, f[w], w]      with the assumption that `m`, `c` and `k` are positive. How do I add this assumptions?


How to find (numerical) value of a derivative at point?

I have the following function:               f[0, 0] = 0     f[x_, y_] := Exp[-(x^2 + y^2)^(-1)]      How do I find its partial derivatives at any given point, including $(0,0)$? This doesn't work (obviously, I guess):               point={0,0}     D[f[x, y], x] /. x -> point[[1]] /. y -> point[[2]]


Import[] exception possibly caused by ToString[] behaviour which I cannot explain

Let me just start by pointing out I'm a new StackExchange user as well as a new Mathematica user (started today!) I mention this as a context to my ineptitude :) I am attempting to read through a list with the names of files I want to open, import data from them and plot that data. Here is the code I'm trying to use:               testfiles = ({"aspirina.txt", "silicio.txt", "silicio20.txt",         "silicio20luz.txt", "tio2.txt", "vidro.txt", "vidro2.txt"})          Do[{data = Import[path <> ToString[i, StandardForm], {"Table"}],        Print[path <> ToString[i, StandardForm]],        Print[ListLinePlot[data]]}, {i, testfiles}]          (*     Out[500]= {aspirina.txt, silicio.txt, silicio20.txt, silicio20luz.txt,       tio2.txt, vidro.txt, vidro2.txt}     *)      > >     Import::nffil: File not found during Import. >> >     ~/Desktop/TCOEM/Espetros Raman/aspirina.txt >   etc. The directory and file names are correct, so much so that when I try this directly by just typing the exact same directory I get the desired result. Firstly, I changed the `FormatType` setting of `ToString[]` to `StandardForm` because the default (`OutputForm`) would give me an extra whitespace on either side of the full stop in the file names. Why does it do this? Secondly, why is it that even when `Print[]` seems to indicate the directory is correct I get the exception saying the file cannot be found during Import? I specifically did not format the names of the files in the testfiles list individually as strings (using "" around each one) to allow for the case where I have hundreds of such files and just want to copy and paste their names via whatever file manager I happen to be using. Any help will be greatly appreciated!


How to use NIntegrate in a function using parameters from a list

I would like to use `NIntegrate` in a function with some parameters from a list. I simplified my problem for this forum. The list of parameters is as follows:               aH = {aH1, aH2};     pars = {aH1 -> 2., aH2 -> 3.};      Normal integration works fine. The next function gives numerical output for numerical values of t and T.               f[t_, T_, k_Integer]:=Exp[-Integrate[aH[[k]],{u,t,T}]]      Now I would like to define the function using `NIntegrate`               f[t_?NumericQ, T_?NumericQ, k_Integer, aH1_?NumericQ] := Exp[-NIntegrate[aH[[k]], {u, t, T}]]      Unfortunately, this does not give numerical output when trying to evaluate by:               f[0., 1., 1, 2.]      Does anyone know how to solve this? Your help is much appreciated. Best regards, Frits


(Centered) Automatic Numbering of Figures

I want to create a figure caption cell style that prefixes a **centred** figure caption with Figure X, where X is an incremental number I have seen two methods for automatically numbering figures: Method 1: Use a CellDingbat to place the label in the left margin of the notebook               Cell[StyleData["FigureCaptionLeft"],      CellDingbat->Cell[        TextData[{"Figure ",           CounterBox["FigureCaptionNumbered"], "."}]],      TextAlignment->Left,      CounterIncrements->"FigureCaptionNumbered",      CellMargins->{{115,0},{0,0}},      MenuSortingValue->10000]      Method 2: Use CellFrameLabels to place the label above, below, left or right of the cell frame. Using this method I have not been able to obtain cell frame label and the caption on the same line.               Cell[StyleData["FigureCaptionCentred"],      CellMargins->{{65, 0}, {0, 0}},      CellHorizontalScrolling->True,      CellFrameLabels->{{None, None}, {None,          Cell[          TextData[{"FIGURE ",             CounterBox["FigureCaptionNumbered"], "."}]]}},      CellFrameLabelMargins->{{0, 0}, {0, 0}},      TextAlignment->Center,      CounterIncrements->"FigureCaptionNumbered"]      The image should illustrate the captions created from the described styles and my desired caption ![Screenshot of the two methods and my desired caption](http://i.stack.imgur.com/Ki19V.png) Any ideas on how to create a style which prefixes centred text with a automatically generated number (with the number and text on the same line)?


How to write equal subset

I have a unique set `S={1,1,3,3,3}` but from this unique set I can create many combinations like `{1,3,3,3,1}, {3,3,1,3,1}, ...` I want to write a generalized formula to represent this. From the below formula I have already tried to find the total combinations:               5!/(2!*3!)      where 5 is the total number of elements in the set and number of 1's are 2 and number of 3's are 3. But I want to write this formula in a generalized way.


How can I create a class of matrices programmatically?

I am trying to figure out how to create a function that can create the matrix pattern below, where: `f[1]` returns `{{1}}` `f[2]` returns `{{1,2,2}}`, i.e., inserts 2 cells to the back `f[3]` returns `{{3,3,3}, {{1,2,2}}}`, i.e., inserts a row of size 3 in front `f[4]` returns `{{4,4,3,3,3}, {4,4,1,2,2}}`, i.e., inserts 2 new cells in front of both rows `f[5]` returns `{{4,4,3,3,3}, {4,4,1,2,2}, {5,5,5,5,5}}`, i.e., inserts a row of size 5 at the back and `f[12]` returns               {      {12, 12, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11},      {12, 12, 8, 8, 7, 7, 7, 7, 7, 7, 7, 10, 10},      {12, 12, 8, 8, 4, 4, 3, 3, 3, 6, 6, 10, 10},      {12, 12, 8, 8, 4, 4, 1, 2, 2, 6, 6, 10, 10},      {12, 12, 8, 8, 5, 5, 5, 5, 5, 6, 6, 10, 10},      {12, 12, 9, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10}     }      The function attaches `n` number of cells to the current matrix at every iteration in a counter clockwise direction. The odd number cells can be done by inserting a row of size `n`. for example `Insert[{{1, 2, 2}}, ConstantArray[3, 3], 1]` However I am stuck on the even numbered blocks because they would need to be inserted on multiple rows. Can someone please point me to where I can find how to create such a function?


Create set of equations by replacing constant values

Say I have an equation:               eq = ax + by + c == 0      and I want to run `NSolve` on a set of equations of this form, for example:               NSolve[{5x + 7y - 6, 9x - 2y + 3}]      How can I use the single definition of `eq` above to do this, by replacing `a`, `b` and `c` with the required values? It is ok to write it manually in NSolve for a simple example as above, but the real equation I will be doing this with has many more terms, and I will be solving a set of 8 equations! Overall it'd be great if I could take a single equation like `eq` above, and then a list of the values that I want to be used (eg. a list of values for `a`, a list of values for `b` and a list of values for `c`) and then generate a list to pass to `NSolve`. This is probably a fairly simple question, but I'm a beginner with Mathematica (although an experienced programmer in many other languages), so I'm not sure how to approach it. I suspect there may be a built-in function that will do this (or something like it) - is that the case?


Apply UpValues before Listability

I'm trying to modify `Plus` but am running into trouble with it being `Listable`:               ClearAll[f, g, h]     Attributes[f] = {Listable};     h /: f[x_h, l_List] := 0     h /: g[x_h, l_List] := 0     f[h[1], {1, 1}]   (* {f[h[1], 1], f[h[1], 1]}, not OK I want 0 *)     g[h[1], {1,1}]    (* 0 as expected *)      How can I make the UpValue (or equivalent) have higher priority than the listability? **EDIT:** I ended up wanting to do this again and figured I'd fix the `Plus` properly. Here it is working using Sashas answer and Mr.Wizards `$Pre` method:                   $Pre =.         ClearAll[myPlus]; Attributes[myPlus] = {Orderless};         Unprotect[InterpolatingFunction]; UpValues[InterpolatingFunction] = {};         InterpolatingFunction /:           myPlus[y_InterpolatingFunction[t_Symbol], l_List] :=           Interpolation[            MapThread[List, {y["Grid"], l + # & /@ y["ValuesOnGrid"]}],             InterpolationOrder -> First[y["InterpolationOrder"]]][t]         myPlus[other__] := +other         $Pre = Function[x, Unevaluated@x /. Plus -> myPlus, HoldAllComplete];         Protect[InterpolatingFunction];              y = Interpolation[Table[{i, RandomReal[{0, 1}, 2]}, {i, 1, 10}]];         ParametricPlot[{y[t], y[t] - {1, 1}}, {t, 1, 10}]


From notebook,how can I change variable value with in .m file dynamically?

I wrote a function named `Testing`.               BeginPackage["TestPackage`"]     Testing[tabNames_] :=            (               DynamicModule[                             {                                 tabIndex = 0,                                 displayPanel = 0                             },                             (                                 {                                 Column[{                                         (*Setter Bar Part*)                                         (                                             Dynamic[                                                     SetterBar[                                                                                Dynamic[tabIndex],                                                               (Table[(i -> tabNames[[i]]), {i, 1, Length[tabNames]}]),                                                               {ImageSize -> {110, 50}}                                                              ]                                                     ]                                         ),                                     (*Setter bar IS Closed here*)                                     (*middle Panel Part*)                                     Dynamic[                                                 Panel[                                                          displayPanel                                                     ]                                                ]                                     }                                 ], Dynamic[tabIndex]}(*Final PAnel IS Closed here*)                             )                     ]       )       EndPackage[]      I saved the above code in `.m` file. `.nb` file code                  functionCalling = Testing[{a, b, c, d}];        notebookList = {1, 2, 3, 4, 5};        TestPackage`displayPanel =Dynamic[(Part[notebookList, (TestPackage`tabIndex + 1)])];        Dynamic[Part[functionCalling, 2, 1]]      I want to track the `TabIndex` value dynamically,If you click on any `setterButton`. depending upon the `TabIndex`value,I will find the element from the `notebookList` and assign to `displayPanel`. after assignment,the updated `displayPanel` value should be displayed dynamically in notebook. for this purpose,I wrote the above code in a `.nb` file.But that code is not working How can I solve this issue? Please help me?


Numerical Integration as Model for Nonlinear Fit

I'm trying to do a fit for parameters of a function within an integral but I'm getting errors when I try and run it. Essentially I want the following fit to work out:               model[a_, b_, x_] := Sum[NIntegrate[totalνLayer[p, m] (a (1 - b^-p)),                                        {p, 0.2, 10}], {m, x - .45, x + .45, .02}]          nlm = NonlinearModelFit[data, model[a, b, x], {a,b}, x, Weights -> 1/errors^2]      Where `totalνLayer` is a function I defined earlier. I just want the fit values for `a` and `b` and their covariance matrix, but I'm clearly doing something wrong. Any help is much appreciated! For those who care, all of the necessary code is below:               amp[x_] := 47.5111 - 1.79354 Abs[x]     μ[mrad_] := 5.449517720787487 Exp[-0.0693211022591832 Abs[mrad]]     σ[mrad_] := 1.7679270770338407 Exp[-0.12510841305113626 Abs[mrad]]     γ[x_] := 2.5587996836804026 Exp[-0.20766051151975093 Abs[x]] + 0.5696086481954964     ω[mrad_] := 7.63444841081276 Exp[-0.08637416159312404 Abs[mrad]]     lin[mrad_] := 0.9648001654360766 - 0.10434481940699446 Abs[mrad] + 0.003062473453032527 Abs[mrad]^2          crossSection[x_] := -600.089 + 1201.5577451256304 x - 1751.9101332336447` x^2 + 1899.988095515613` x^3 - 1556.709382526493` x^4 + 974.3641634962205` x^5 - 468.5129814014657` x^6 + 172.90071370757002` x^7 - 48.48328424613457` x^8 + 10.067733931487915` x^9 - 1.4558045159248463` x^10 + 0.1215353564558521` x^11 -0.00009554527467999401` x^12 - 0.001211849211458331` x^13 + 0.00009244381215772915` x^14 + 6.85533417357146`*^-6 x^15 - 1.3215490607411126`*^-6 x^16 - 1.213701585221995`*^-8 x^17 + 1.4963340473233928`*^-8 x^18 - 6.405376189932708`*^-10 x^19 - 1.3047056106410797`*^-10 x^20 + 2.0016864863803638`*^-11 x^21 - 1.2643359066392302`*^-12 x^22 + 4.036927989211094`*^-14 x^23 - 5.368234695690585`*^-16 x^24 + 214.8882519560799` x^-1 - 54.26505937368572` x^-2 + 9.480463574208194` x^-3 - 1.1135829819290948` x^-4 + 0.08354380635765371` x^-5 - 0.0036045838406917876` x^-6 + 0.0000678896567028218` x^-7      And the definition of `totalνLayer`:               totalνLayer[x_, mrad_] := .3*3.78*10^-5*810^2*5 (amp[mrad] Exp[-(x - μ[mrad])^2/(                               2 σ[mrad]^2)] + lin[mrad] x + (amp[mrad] γ[mrad]^2)/(                               4 (γ[mrad]^2/4 + (x - ω[mrad])^2)))/(                               crossSection[x] 10^-38*1*6300*6.022*10^23)      And the data:               data = {{0, 1185.2847069383793`}, {4, 780.6026466248076`}, {8, 493.5502399832769`},              {12, 312.1838499130911`}, {16, 193.16881196193143`}, {20, 113.41366552793787`},             {24, 64.20654682074144`}};          errors = {132.12627600307064`, 90.55918065608893`, 60.884899393246535`,              41.88064141772561`, 29.076284534300132`, 20.049728493077968`,               13.950371635495452`};      And last but not least the model and fit:               model[a_, b_, x_] := Sum[NIntegrate[                                totalνLayer[p, m] (a (1 - b^-p))*10^-38*1.4*150*6.022*10^23,                                {p, 0.2, 10}],                              {m, x - .45, x + .45, .02}]          nlm = NonlinearModelFit[data, model[α, β, x], {α, β}, x, Weights -> 1/errors^2]      I apologize for all of the weird numbers and functions; this is neutrino data from my research.


What is the best way to save a large graph object, allowing it to be reloaded quickly in a new kernel?

I generated a very large graph, too large to simply display and manipulate with copy/paste operations. How can I somehow save the graph to a file to allow it to be rapidly reloaded after I quit out of the kernel and restart Mathematica?


How to create an interactive map of the 50 states showing certain data in tool tips boxes for health care policy development?

To create a means of displaying information about the distribution of primary care providers, the population density and the average yearly Medicare expenditure per enrollee for each state, I would like to create a US map with the state boundaries indicated, and then display a tool tip box containing the data for that state when the cursor hovers over that state. `CountryData["UnitedStates"]` does not have a map that includes the state boundaries. In addition, I would like to colorize the states to indicate the value of a given parameter for that state, such as age-adjusted average yearly cost per Medicare Enrollee, by reference to a color scale. I have not been able to find the _Mathematica 9_ code for an interactive US map in the Mathematica demonstrations and I am interested in suggestions or working code that I could use. My level of proficiency with _Mathematica 9_ is somewhere between beginner and intermediate, so I appreciate the details that might not be necessary for explaining the solution to an experienced user.