Mutual Information involving two matrix states

I basically retrieved the following technique of evaluating the mutual information involving two matrices from this site at http://bmia.bmt.tue.nl/People/BRomeny/Courses/8C080/default.htm The original code was written for image-processing, but could perhaps apply to other areas as well. Mutual Information = H(A)+H(B)-H(AB), where H(X) is the entropy of X My question: How to do you generalize this to apply to a matrix of arbitrary elements (including decimals less than 1, and negative numbers)? Can this also be extended to matrix of any dimension (i.e. larger than 2?). The program follows as:               imA = ({        {0, 1, 3, 0},        {0, 0, 2, 5},        {3, 2, 0, 1},        {0, 0, 3, 4}       });           imB = ({        {1, 1, 0, 4},        {3, 0, 4, 5},        {0, 0, 2, 5},        {0, 1, 4, 5}       });           histogramA = BinCounts[Flatten[imA], {0, 6, 1}]     hA = Total[-(histogramA/nA) Log[histogramA/nA]] // N     nA = Total[histogramA]          histogramB = BinCounts[Flatten[imB], {0, 6, 1}];     nB = Total[histogramB];     hB = Total[-(histogramB/nB) Log[histogramB/nB]] // N     imAB = Transpose[{imA, imB}, {3, 1, 2}]     histogramAB = BinCounts[Flatten[imAB, 1], {0, 6, 1}, {0, 6, 1}];     nAB = Total[histogramAB, 2];     fh = Flatten[histogramAB]     fh2 = DeleteCases[fh, 0]     hAB = Total[-(fh2/nAB) Log[fh2/nAB]] // N     MI = hA + hB - hAB


How to make Excel-like data bars?

I would like to make a grid where each cell background is partially filled according to the numerical value being represented (on a scale from 0 to 1). Similar functionality to the one requested in this TeX.SE question. How can I achieve this with _Mathematica_?


Defer parts of the expression

Is there a way to Defer only parts of the expression? For example, I have               a=1;      and then I want the expression to be shown as`a = 1;`by using`Defer[a = Evaluate[a]]`,But the actual output is just               a = Evaluate[a]]      Is there away to only Defer part of an expression?


How can I get the color of overlapping disks to be equal in any order?

When Graphics is used, necessarily the objects come in order. This affects which ones obscure others. When Opacity is not 1, it also affects the color. I would like the color of overlaps to depend only on the colors of the objects and their opacities and not on the order. Can this be done? For example, this simple code illustrates the problem:                Graphics[{Opacity[.5],       Inner[{#1, #2} &, {Red, Blue, Red}, {Disk[{0, 0}, 1],       Disk[{1, 0}, 1], Disk[{2, 0}, 1]}, List]}]      The result is this: ![Red Disk, Blue Disk, Red Disk with overlaps](http://i.stack.imgur.com/BxZuo.jpg) Further info in response to the wonderful answers received so far: I will use this in Manipulate with the disks (or perhaps rectangles) moving around at random. There will also be many of them, such as 1000. So time is important and thus using all permutations is out of consideration (for this particular application). I have now tested the suggestions. Unfortunately, rasterizing and computing with that takes much too long. If I sort, then that will not give what I want either. So no answer seems to work, sadly. In response to @Mr.Wizard, here is my example. It is not minimal, but you will want to experiment with various things, I think. In the end, it is not too bad; I used Opacity[0.1] to handle my aesthetic complaint.                   Manipulate[      If[startover == "start over",        current = PadRight[{}, nmparticles, {{-torus/2, 0}, {torus/2, 0}}];        startover = False];       While[run, Pause[1/rate];        If[Length[current] == nmparticles,         current =          Clip[current +            RandomVariate[            NormalDistribution[0, 1], {nmparticles, 2}], {-torus, torus}],         current =          PadRight[current, nmparticles, {{-torus/2, 0}, {torus/2, 0}}]]];       Dynamic@Show[        Graphics[{Opacity[.1],           Transpose[{Table[If[OddQ[i], Red, Blue], {i, Length[current]}],             Disk[#, 1] & /@ current}]},          PlotRange -> {{-torus, torus}, {-torus, torus}},          ImageSize -> {475, 475}]],       Style["             Diffusion",        Large], Delimiter, {{run, False, "run"}, {True,         False}}, {{nmparticles, 2, "number of particles"}, 1, 5000, 1,        Appearance -> "Labeled"},      {{rate, 10, "rate"}, 3, 1000, 1,        Appearance -> "Labeled"}, {{torus, 20, "half-size of box"}, 3, 100,        1, Appearance -> "Labeled"}, {{startover, False,         ""}, {"start over"}, ControlType -> Setter, Background -> LightRed},      ControlPlacement -> Right,       Initialization :> (current = {{-torus/2, 0}, {torus/2, 0}})]


Error when trying to run Mathematica 9 on Ubuntu 12.04 from the command line

When I type : mathematica or math on terminal, generates following error:               Traceback (most recent call last):     File "/usr/bin/test", line 8, in <module>     call([command,parameter])     File "/usr/lib/python2.7/subprocess.py", line 493, in call     return Popen(*popenargs, **kwargs).wait()     File "/usr/lib/python2.7/subprocess.py", line 679, in __init__      errread, errwrite)      File "/usr/lib/python2.7/subprocess.py", line 1249, in _execute_child      raise child_exception      OSError: [Errno 8] Exec format error  Mathematica front end executable      /usr/local/bin/SystemFiles/FrontEnd/Binaries/Linux-x86-64/Mathematica      not found. Your Mathematica installation may be incomplete or corrupted.      Mathematica front end executable      /usr/local/bin/SystemFiles/FrontEnd/Binaries/Linux/Mathematica not found.      Your Mathematica installation may be incomplete or corrupted.      Tried following:   1. Re-installing   2. installing lib32stdc++6   3. uname -a : returns : X86_64 machine


Unexpected behavior: CForm converts rationals to floating numbers

**One line question:** How to make `CForm[1/2]` generate `1/2` instead of `0.5`? (Thanks Nasser's comment!) * * * I've been using `CForm` to convert _Mathematica_ expressions to C codes for a long time. Although the built-in C strings are a little bit annoying (e.g., `Sqrt[2]` is translated to "Sqrt(2)" instead of "sqrt(2)"), it works. However, recently I found an even more annoying behavior which I cannot find a workaround so far. Consider converting the following simple piece extracted from a rather complicated expression               3/40007 + (2 test )/40007//CForm      > 0.00007498687729647311 + (2*test)/40007. which is totally bizarre! What I expect is simply > 3/40007. + (2*test)/40007. which is trivial yet crucial to my following work. (To be clear, I don't mean the presence of the decimal point is crucial! Rather, I mean the form of numbers should no be changed.) Can anyone come up with a solution, at least to tell `CForm` stop doing such a floating number conversion? Certainly I could manually rewrite this piece (or use `Together`) like this               (3 + 2 test)/40007 // CForm      > (3 + 2*test)/40007. But given that I have tons of complicated expressions to be converted, it is super inefficient for sure. Besides there's a possibility that `test = I`, and `3/40007 + (2 I)/40007 // Together` returns itself. PS. It is surprising that the discussions related to `CForm` and other C utilities are so rare on this site! Am I missing something?


What exactly is "ParameterErrors" of NonlinearModelFit?

I am trying to get what I call a "$\chi^2$ fit". This means taking a function $f(x,p)$ of the variable $x$ with a parameter $p$ and finding the value of $p$ that minimizes the "distance" from a data set $\\{x_i, d_i\\}$, i.e. minimizes the quantity $$\chi^2=\frac{\left(f(x_i,p) - d_i\right)^2}{d_i}$$ See this Yale course notes for a reference. You can find the value of the parameter $p$ with `NMinimize`, of course, or use `NonlinearModelFit`. I figured out that to get the same result, i.e. perform the same minimization, you need to use               nlm = NonlinearModelFit[data, 1 + p x^2, {p}, x, Weights -> (1/#2 &)]      where I have taken `f[x,p] = 1 + p*x^2` just to give an example This procedure is supposed to give you the best estimate of the parameter $p$ and an error is associated to to this estimate. I thought that `nlm["ParameterErrors"]` would give this error, but I do not find any documentation for this. Usually, for a one parameter estimation at 68% confidence level, the error comes from looking at the curve $\chi^2=1+\chi_\min^2$ where $\chi_\min^2$ is the value of the function $\chi^2$ for the parameter $p$ that minimizes $\chi^2$ (in other words the value at the best fit). By direct computation and confronting with `"ParameterErrors"` it seems that `"ParameterErrors"` does not give this type of error estimate. Now, is anybody aware of what exactly `"ParameterErrors"` does and how to instruct `NonlinearModelFit` to do what I need to do?


Orderless pattern matching of rule lists

I am looking for a compact way to specify a pattern to match a rule list with `MatchQ` that allows for enumerating the rules in the rule list in an arbitrary order. E.g. given:               ruleList1 = {"a" -> 10, "b" -> 2.2, "c" -> "str"}     ruleList2 = {"b" -> 2.2, "c" -> "str", "a" -> 10}      the following pattern will match both `ruleList1` and `ruleList2`               MatchQ[ruleList,  {___, "a" -> _, ___, "b" -> _, ___} | {___, "b" -> _, ___, "a" -> _, ___}]      Can this pattern be written in a more compact form (e.g., by using `OptionsPattern[]`)?


Importing a stack of images

I have a stack of images with the file names `C0001996_0000` , `C0001996_0001` etc. In total I have $600$ images. I would like to import the complete stack and then `Binarize` them (threshold `0.7)` and then export them. Could someone help me with the code for this?   At present I am importing a single image, binarizing it and then exporting.


Numerical solution of a differential equation with NIntegrate coefficients

I am trying to solve a linear ODE with a variable coefficient which is given in terms of an integral I can only do numerically. That is, I have an equation of the form $$ u'(t)=u(t)\int_0^t\sqrt{1+e^{-\tau^2}\sin(\tau)}d\tau, $$ where the integrand could be pretty much any well-behaved function - but which in general will cause _Mathematica_ to choke when given to `Integrate` and eventually say it can't do it. I know that such a lack of an analytic handle on the coefficients in the equation essentially disqualifies me from an analytic solution of the equation. However, given that I am, or should be, perfectly able to numerically compute this coefficient, _Mathematica_ ought to be able to numerically solve the equation. My initial guess as to how to do this would be to simply indicate the integral should be done numerically:               NDSolve[{D[u[t], t] == NIntegrate[          Sqrt[1 + E^tt^2 Sin[tt^2]], {tt, 0, t}] u[t], u[0] == 1}, u, {t, 0, 1}]      but this simply outputs the error `NIntegrate::nlim: tt = t is not a valid limit of integration. >>`. I've also tried with plain `Integrate` and setting `GenerateConditions->False`, but none of them work and they also take a long time to return their errors, which I assume is because they're trying to symbolically solve the integral - and I specifically _don't_ want that. Can someone provide a way to make _Mathematica_ understand it just needs to buckle down and calculate?


Parallelising the solving of polynomials

I'm working on finding solutions to a, not so very nice, system of equations. They are all polynomials of degree $4$ with $5$ parameters and all terms are of even order. I'll post the code on request, it's not that I don't want to post it, but it is rather lengthy and I thought I'd spare you the sight of it. I did solve a similar system of equations last week using `Reduce` but then I had three equations and three unknowns. It took the computer some time to solve the system, like $30$ minutes or such. Though it seems that the same procedure is now failing to produce a solution. I use the following code:               Reduce[equation1==1/4 && equation2==1/4 && equation3==1/4 && equation4==1/4,{x1, x2, x3, x4}, Reals]      I know that the system to be solvable. I understand that solving this system should take considerably more time. That's why I'm now wondering whether this problem could be parallelised in some way. I've read that reduce it isn't possible to parallelise `Reduce`, but perhaps there are some other means of parallelise the procedure? Or, well, is there means of making it run faster in general, of course?


Drawing graphics part by part

What I want to do is to draw graphics part by part, because I made a function that generates coordinates according to which I will draw graphics. The problem is that MMA does not operate as I expected. To figure out what I'm doing here's simplified example:               Graphics[{       a = 1;       Label[tag];       If[a < 3,        {Circle[{a, 1}, 1],         a = a + 1;         Goto[tag];},        {Text["It's finished", {0, 0}]}]       }]      And what I get as output is simply text "It's finished". But what I want as output is graphics with two circles with radii 1 and centers positioned at {1,1} and {2,1} together with text "It's finished". I figure out the way MMA thinks, and why it gives me this as output. But how can I accomplish my desired output? **Edit:** Here's the code, It's really messy and tips on how to neatly write code in MMA would be appreciated.                  Manipulate[              Graphics[{              (*calculating incident angle*)         α = ArcSin[H/R];         (*calculating x-coordinate where incident ray leaves prism*)         p = Sqrt[R^2 - H^2];         (*Drawing incident ray*)         {Red, Thick, Line[{{-2, H}, {p, H}}]},              (*Drawing prism*)         {Blue, Opacity[.5], Disk[{0, 0}, R, {0, Pi/2}]},              (*checking whether it's reflection or refraction*)         If[H < R/n,                 {(*refraction*)                 (*calculating x-coordinate where refracted ray hits surface*)                 l = (R^2 n)/(Sqrt[R^2 - H^2] n - Sqrt[R^2 - H^2 n^2]);                 (*Drawing refracted ray*)                 {Red, Thick, Line[{{p, H}, {l, 0}}]}                 },              {(*internal reflection*)                     (*calculating x-coordinate where after internal reflection ray hits \     surface*)                     new = H;                     k = 1;                 Label[tag];                 s = R Cos[α] - new/Tan[2 α];                     If[s <= R,                     {                     {Red, Thick, Line[{{p, new}, {s, 0}}]}                     },                            {                     θ = (2 k + 1) α - k Pi;                     f = R Cos[θ];                     h = R Sin[θ];                     k = k + 1;                     Line[{{{p, new}, {f, h}}}],                     new = h;                     p = f;                     Goto[tag];                     }                     ]                 }             ]                 }],              {{H, 3, "Height"}, 0.0001, R - 0.0001, Appearance -> "Labeled"},         {{n, 1.5, "Refraction"}, 1.001, 2, Appearance -> "Labeled"},         {{R, 10, "Radius"}, 0, 10, Appearance -> "Labeled"}                 ]


can I evaluate multiple cells at the same time?

my laptop has 2 cores, can I assign a core to evaluate one code, and the other core for another code in parallel instead of evaluating in sequence? thanks


How to prevent simplification of hypergeometric functions resulting from integrations?

Definite integrals from `0` to `Infinity` over a product of two hypergeometric (including exponential, trigonometric, hyperbolic, Bessel, etc) functions (optionally times a power of the integration variable) always result in a hygergeometric function (`HypergeometricPFQ` or `MeijerG`). With some experience, many important properties such as the asymptotic behavior at small or large argument can be immediately seen from the hypergeometric notation. Unfortunately, _Mathematica_ takes this nice, compact and very informative output and "simplifies" it into a combination of simpler functions, often resulting in rather lengthy outputs where all the useful information contained in the original hypergeometric notation is lost. How can I prevent this simplification?   Integrate should result in a `HypergeometricPFQ` or `MeijerG` without further simplification unless explicitly requested via `Simplify` or `FullSimplify`.


What's reliable way of finding declared but undefined functions/symbols in several interrelated packages?

I have many packages some of which use some of others. I have many symbols defined in them. Is there a reliable way of finding declared/exported but undefined functions/symbols in several interrelated packages?


How can I independently move vector components (in 2D)?

Here's what may well be a simple problem that I have been having difficulty with: There are two connected vectors, **v1** and **v2** , such that:   * **v1** begins at the origin and and ends at point _a1_   * **v2** begins at point _a1_ and ends at point _a2_ The default constraints are such that moving point _a1_ (via the locator at the arrowhead):   * Affects the length and direction of both _v1_ and v2,    * Does _not_ affect the position of _a2_. In other words, the resultant, **v1+v2** remains unchanged. Under other circumstances, this would be fine. However I want to implement the composition of vectors such that displacing _a1_ will affect neither the length nor direction or **v2**. To do so, moving _a1_ must move _a2_ so that _a1-a2_ remains invariant. I want to maintain the effect of "my" moving of _a2_ (It has no effect on **v1** and should not have any effect on **v1** ). In other words, changing **v1** should not change **v2** , and vice-versa. That's what I mean by "independent" components. The figure on the left is a "before" scenario. Notice that a1 is located at {3,-1}; a2 is located at {4,1}. The figure on the right shows the situation after a1 is displaced to {6,-1}. Notice that **v2** has stretched and rotated slightly in a clockwise direction. I would prefer that the **v2** would have been displayed like the dashed black arrow is displayed. That would correspond to the idea that we changed **v1** without changing **v2**. Any ideas about how this can be done? ![vectors](http://i.stack.imgur.com/IlZbE.png) Here is the code:               Manipulate[      Graphics[{PointSize[Large], Point[{0, 0}],      {Red, Arrow[{{0, 0}, a1}]}, Text["a1", Offset[{0, 15}, a1]],      {Dashed, Arrow[{a1, a1 + {5, -2}}](*,Text["a3",Offset[{0,-15},a2]]*)},      Blue, Arrow[{a1, a2}], Black, Text["a2", Offset[{0, 15}, a2]]},      PlotRange -> {{-8, 8}, {-8, 8}},     BaseStyle -> 16, Axes -> {True, True}],     {{a1, {-1, 3}}, {-4, -4}, {8, 8}, Locator},     {{a2, {4, 1}}, {-3, -3}, {6, 6}, Locator}]


ParallelMap and Sow/Reap - not behaving as expected?

**Is ParallelMap and Parallelize@Map expected to work with Sow and Reap construct.** _This is a rather brief toy code to find all Primes just to force the use of Sow/Reap inside Map_               Reap[Map[        If[PrimeQ@#, Sow@#] &,        Range[10]        ]][[2]]      and the output is, as expected               {{2, 3, 5, 7}}      But when I do               Reap[Parallelize@Map[         If[PrimeQ@#, Sow@#] &,         Range[1000]         ]][[2]]      I got the output               {}      And the same was the output when I ran               Reap[       ParallelMap[        If[PrimeQ@#, Sow@#] &,        Range[10]        ]       ][[2]]      **2 questions :** 1) How is this explainable ? 2) If this is the case, how do I efficiently I spawn parallel jobs which accumulate something ?


Strategies for avoiding and handling shadowing

When dealing with namespaces in Mathematica (`BeginPackage`, `$ContextPath` ...) one is unavoidably confronted with the problem of shadowing (see e.g. question 1, question2). What are good strategies to handle or avoid these problems? As a package developer, the most obvious strategy is to use unique names, but to be on the save side one would probably need to use very long names and prefixes like               MyPackageMyNameAndMyBirthday      This has drawbacks: the code will be harder to read than necessary, you still can't be sure about uniqueness and the names will be hard to remember and type, just to name some. (And yes, it spoils most of the fun and beauty of Mathematica). Thus I have used other strategies like using strings instead of symbols for option names. I just have learned that this also has drawbacks and of course it is not applicable to function names. Another problem is that as a user of a package, you can't control what the symbol names in these are: It might happen that you want to load two packages that define symbols with the same name. It might happen that you want to use a package written for an older version of Mathematica that defines a symbol with a name that meanwhile exists in the `System`` context. I have loaded packages (`Needs`) and explicitly removed the corresponding context from `$ContextPath` in such situations, but I feel that's somewhat hacky. Are there better ways to deal with this? (I found an article available by Wagner which discusses some ideas about the topic, but don't think it gives answers to the examples I gave)


How do you determine the optimal autocompilation length on your system

When you pack lists there is an overhead therefore packing a list with, say, 2 elements is likely to cost more than you get back in efficiency. Mathematica has default list lengths for which functions creating those lists will pack the list (i.e. if the list length is less than the numbers shown below the list will not be packed):               SystemOptions["CompileOptions"]          {"CompileOptions" -> {"ApplyCompileLength" -> \[Infinity],         "ArrayCompileLength" -> 250, "AutoCompileAllowCoercion" -> False,         "AutoCompileProtectValues" -> False, "AutomaticCompile" -> False,         "BinaryTensorArithmetic" -> False, "CompileAllowCoercion" -> True,         "CompileConfirmInitializedVariables" -> True,         "CompiledFunctionArgumentCoercionTolerance" -> 2.10721,         "CompiledFunctionMaxFailures" -> 3,         "CompileDynamicScoping" -> False,         "CompileEvaluateConstants" -> True,         "CompileOptimizeRegisters" -> False,         "CompileReportCoercion" -> False, "CompileReportExternal" -> False,         "CompileReportFailure" -> False, "CompileValuesLast" -> True,         "FoldCompileLength" -> 100, "InternalCompileMessages" -> False,         "ListableFunctionCompileLength" -> 250, "MapCompileLength" -> 100,         "NestCompileLength" -> 100, "NumericalAllowExternal" -> False,         "ProductCompileLength" -> 250, "ReuseTensorRegisters" -> True,         "SumCompileLength" -> 250, "SystemCompileOptimizations" -> All,         "TableCompileLength" -> 250}}      So, for example, if you make a list using `Table`               Developer`PackedArrayQ[Table[i, {i, 1, 249}]]     False          Developer`PackedArrayQ[Table[i, {i, 1, 251}]]     True      I am assuming that if you plotted the time to make uncompiled lists using `Table`, vs making compiled lists, the lines would intersect at ~250, beyond which packed lists become more efficient. Is that a correct interpetation of what the autocompilation length represents? I would expect that the optimal lengths for compilation (incl. packing) vary on system to system, therefore I want to know the best way to construct a set of tests to test that proposition, and to determine the optimal list length for packing for the functions listed above. **Edit** For clarity, as per Albert's comments, there are cases when the evaluations taking place prevent compilation so these discussions are redundant, i.e. compilation is prevented regardless of the default settings. But I am curious about the optimal list lengths in cases where compilation occurs.


Fitting points to tilted, off-center ellipse

I have 24 x-y points that are supposed to form an ellipse.               points={{31.4799,432.849},{-195.826,356.419},{210.029,121.779},{76.1586,-4.47992},{26.6061,-6.97711},{160.236,27.0398},{203.248,241.865},{-225.351,218.912},{-159.899,109.93},{-106.465,58.164},{-1.98952*10^-11,442.},{-229.146,324.489},{-31.4799,9.15114},{195.826,85.5807},{-210.029,320.221},{-76.1586,446.48},{-26.6061,448.977},{-160.236,414.96},{-203.248,200.135},{225.351,223.088},{159.899,332.07},{106.465,383.836},{-1.98952*10^-11,1.83076*10^-11},{229.146,117.511}};     points//ListPlot      ![points](http://i.stack.imgur.com/osA77.png) I want to numerically fit an ellipse around those points. I tried to use the NMinimize method with least-square shown in this Q&A but the issue in this problem is that x and y are related parametrically (through t), and not directly like that other problem was. Worse, the ellipse will be off-center and tilted, so I can't use the nice $$\left(\frac{x}{a}\right)^2+\left(\frac{y}{b}\right)^2=1$$ but had to use this equation I found on Wikipedia (surprisingly without citation!): ![ellipsewiki](http://i.stack.imgur.com/fXPZD.png) My strategy was to generate 24 X(t) equations and 24 Y(t) equations, or more specifically, X(t1), Y(t1), ..., X(t24), X(t24) with xc, yc, a, b in them. Then, I would use NMinimize to optimize all of the square differences between my points and the ellipse. I would eventually get back xc, yc, a, b, CurlyPhi, and every single t values from t1 to t24. I tried to find a more elegant way of using NMinimized for parametric equations, and I believe the multivariate examples of NMinimized in the documentation are not exactly parametric equations. See also the linked Q&A above for an example. Here's my code to find xc, yc, a, b, t1, ... , t24:               tList = ToExpression["t" <> ToString[#]] & /@ Range[1, 24];     equations = Join[        MapThread[#1 - xc - a Cos[#2] Cos[\[CurlyPhi]] +            b Sin[#2] Sin[\[CurlyPhi]] &, {points[[All, 1]], tList}],        MapThread[#1 - yc - a Cos[#2] Sin[\[CurlyPhi]] -            b Sin[#2] Cos[\[CurlyPhi]] &, {points[[All, 2]], tList}]];     solution = NMinimize[       #.# &[equations],       Join[tList, {xc, yc, a, b, \[CurlyPhi]}]]      ![equations](http://i.stack.imgur.com/v7Req.png) And this is what the ellipse looks like:               Show[           (* Tilted ellipse/disk drawn using Disk and Rotate *)      Graphics[       {Yellow,         Rotate[Disk[{xc, yc}, {Abs@a, b}], \[CurlyPhi]] /.          solution[[2, 25 ;; 29]]}],           (* Starting points *)      points // ListPlot,           (* Ellipse outline plotted by the 2 parametric equations *)      ParametricPlot[{xc + a Cos[t] Cos[\[CurlyPhi]] -           b Sin[t] Sin[\[CurlyPhi]],          yc + a Cos[t] Sin[\[CurlyPhi]] + b Sin[t] Cos[\[CurlyPhi]]} /.         solution[[2, 25 ;; 29]], {t, 0, 2 \[Pi]}, PlotStyle -> Red],           (* Point on ellipse corresponding to t1 to t24 *)      ListPlot[{xc + a Cos[#] Cos[\[CurlyPhi]] - b Sin[#] Sin[\[CurlyPhi]],            yc + a Cos[#] Sin[\[CurlyPhi]] + b Sin[#] Cos[\[CurlyPhi]]} /.           solution[[2, 25 ;; 29]] & /@ solution[[2, 1 ;; 24, 2]],        PlotStyle -> Red],           Axes -> True]      ![ellipse](http://i.stack.imgur.com/bhLQE.png) Even though I got what I want, I just feel that this is clunky way to solve the problem, not least because I don't need to solve for t1 to t24--I just needed xc, yc, a, and b. Another issue is that for some reason the value of my a (supposed to be the long axis) is negative and smaller in magnitude than the other axis*, and the rotate angle of the ellipse is crazy high (88.7 radian). I tried to apply some constrains to NMinimize (a>0 or 90 [Degree] < [CurlyPhi] < 150 [Degree]) but kept getting errors. ![NMinimized error](http://i.stack.imgur.com/81Px2.png) * ![ellipse wiki reference](http://i.stack.imgur.com/nEj9v.png) Lastly, I'd really appreciate any general comment to make my code better as I'm still a beginner in MMA (you probably could tell by my zeal of pure functions in this example; I've just been reading a chapter about them).


Dynamically choosing which Manipulate controls to use

I have some stuff I would like to manipulate, using two different kinds of control, one at a time, using another variable as a switch. These controls are similar in principle to               Evaluate@(Sequence @@ {{controlA1, 0, 0.8}, {controlA2, 0, 2}})      and               {controlB, {-1, -1}, {1, 1}}      Therefore I tried using the code               Manipulate[           If[ChooseControlMode,       stuffA,       stuffB],           {{ChooseControlMode, False, "Choose control mode: "}, {True -> "A",         False -> "B"}, PopupMenu},           Dynamic@If[ChooseControlMode,      Evaluate@(Sequence @@ {{controlA1, 0, 0.8}, {controlA2, 0, 2}}),        {controlB, {-1, -1}, {1, 1}}]           ]      However, for some reason MMA behaves as if what I meant to be my controls were actually simple text (and also splices the `Sequence` inside `If`, therefore preventing even this simple text from being displayed at the right time). I also tried using something like               ReleaseHold@Dynamic@If[ChooseControlMode,        Hold@(Evaluate@(Sequence @@ {{controlA1, 0, 0.8}, {controlA2, 0,                2}})),        Hold@{controlB, {-1, -1}, {1, 1}}]      In this case instead I run into error > Manipulate::vsform: Manipulate argument `ReleaseHold[...]` does not have the > correct form for a variable specification. How can I get MMA to treat my input as additional controls and thus display them with their standard input (i.e., two `Manipulator`s and a `Slider2D`)?


Collecting terms in an expression

I have an expression:               (C1*R*(10*k12*k21 - 20*k11*k22 - k21^2*Cos[4*t] + 10*k11^2 + 10*k12^2 + 3*k21^2 + 10*k22^2 -       4*k12*k21*Cos[2*t] - 2*k12*k21*Cos[4*t] + 4*k11*k21*Sin[2*t] + 2*k11*k21*Sin[4*t] -       4*k21*k22*Sin[2*t] - 2*k21*k22*Sin[4*t]))/32       and I would like to factor this in terms of squares of the `k`s. (e.g., `(k12^2 - k21^2)`, `(k22 - k11)^2`, `(k12 + k21)^2`, etc.) If the trigonometric identities can be simplified, then that's perfect. Any help would be appreciated.


Sum of roots of a trigonometric equation

The equation $$ \sin x + \sqrt{3} \cos x = 1,$$ where $x \in [-2\pi, 2\pi]$ has four roots $-\dfrac{3\pi}{2}$, $\dfrac{\pi}{2}$, $\dfrac{\pi}{2}$ and $\dfrac{11\pi}{6}$. Sum of roots of the given equation is $\dfrac{2\pi}{3}$. How do I tell Mathematica to do that? I tried               Solve[{Sin[x] + Sqrt[3]*Cos[x] == 1, -2*\[Pi] <= x <= 2*\[Pi]}, {x}]         **edit** from comment I repaired the given equation to               Solve[{Sin[x] + Sqrt[3]Cos[x] == 1, -2[Pi] <= x <= 2*[Pi]}, {x}]       and used               Simplify@Total[ x /. Solve[{Sin[x] + Sqrt[3] Cos[x] == 2, -2 Pi <= x <= 2 Pi}, {x}]],       and I got the answer               -4 [Pi] + 8 ArcTan[1/(2 + Sqrt[3])].        How do I get the answer -((5 [Pi])/3)?


g00 (metric tensor) not explicitly evaluated in FeynCalc

I am learning _Mathematica_ and `FeynCalc` by doing some basic cross section calculations. I have an issue with trace calculations: When I plug in for instance the interference term for `ee->tautau`, the result comes out with the `g00` component of the metric tensor explicitly written, i.e. not set to `1` as it should be. This means I have to manually remove it before the next step in the calculation. I have tried doing something like `MetricTensor[0,0]:=1`, but it did not help. I am probably missing some syntax, but can you point me to the correct way of doing it? Here is my code:               DiracSimplify[       Contract[e^2*gz^2/4/(s*(s - Mz^2 + Mz*Gammaz))/4*         Tr[GA[mu].(GS[q2] - M).GA[0].(cV - cA GA[5]).GA[0].GA[            nu].(GS[q1] + M)]*         Tr[GA[mu].(GS[p1] + m).GA[0].(cV - cA GA[5]).GA[0].GA[            nu].(GS[p2] - m)]]];


MATLAB to Mathematica: coneplot

Does Mathematica have a function, similar to the one called `coneplot` in MatLAB? Given some spatial coordinates $x, y, z$ and velocity components $v_x,v_y,v_z$, it is able to produce the following graphs: ![enter image description here](http://i.stack.imgur.com/tcFWG.gif) When I plot my data with `ListVectorPlot3D`, I don't get any arrows shown. Here is a sample data, in the form $((x,y,z),(v_x,v_y,v_z))$:               data={{{0., 0.847912, 9.48902}, {0., 0., 0.}}, {{0.00773322, -0.0110065,         9.09927}, {0., 0., 0.}}, {{-1.00008, -0.0623481, 9.49984}, {0., 0.,         0.}}, {{0., 0.847912, 10.8969}, {0., 0., 0.}}, {{0., 0.847912,         12.5007}, {0., 0., 0.}}, {{0., 0.847912, 14.1046}, {0., 0.,         0.}}, {{0., 0.847912, 15.5729}, {0., 0., 0.}}, {{0., 0.847912,         16.6107}, {0., 0., 0.}}, {{0., 0.847912, 17.3334}, {0., 0.,         0.}}, {{0., 0.847912, 18.0983}, {0., 0., 0.}}, {{0., 0.847912,         18.8639}, {0., 0., 0.}}, {{0., 0.847912, 19.9409}, {0., 0.,         0.}}, {{0., 0.847912, 21.3189}, {0., 0., 0.}}, {{0., 0.847912,         22.822}, {0., 0., 0.}}, {{0., 0.847912, 24.6036}, {0., 0.,         0.}}, {{0., 0.847912, 26.2343}, {0., 0.,         0.}}, {{-1.08457, -0.0217237, 10.6779}, {0., 0.,         0.}}, {{-1.11085, -0.0731095, 12.19}, {0., 0.,         0.}}, {{-1.1131, -0.0651947, 13.7893}, {0., 0.,         0.}}, {{-1.10496, -0.0720509, 15.108}, {0., 0.,         0.}}, {{-1.12255, -0.0365039, 16.0888}, {0., 0.,         0.}}, {{-1.12699, -0.00227834, 16.8818}, {0., 0., 0.}}, {{-1.15057,         0.0126093, 17.6497}, {0., 0., 0.}}, {{-1.13931, -0.015588,         18.4211}, {0., 0., 0.}}, {{-1.03192, -0.0742988, 19.1016}, {0., 0.,         0.}}, {{-1.24186, -0.0317904, 19.9972}, {0., 0.,         0.}}, {{-1.14942, -0.0360112, 20.9677}, {0., 0.,         0.}}, {{-1.09896, -0.0167395, 21.9511}, {0., 0.,         0.}}, {{-1.117, -0.0452791, 23.2337}, {0., 0.,         0.}}, {{-1.1522, -0.056303, 24.8936}, {0., 0.,         0.}}, {{-1.09607, -0.110654, 26.195}, {0., 0.,         0.}}, {{0.103537, -0.0647147, 26.6637}, {0., 0., 0.}}, {{0.,         0.847912, 41.3051}, {0., 0., 0.}}, {{-0.012139, -0.0295375,         40.9221}, {0., 0., 0.}}, {{-0.857944, -0.0671514, 41.3642}, {0.,         0., 0.}}, {{0., 0.847912, 42.4678}, {0., 4.67035*10^-7, 0.}}, {{0.,         0.847912, 43.5378}, {0., 0., 0.}}, {{-0.979967, -0.033538,         42.2371}, {0., 0., 0.}}, {{-1.14769, -0.0351505, 43.0033}, {0., 0.,         0.}}, {{-0.979351, -0.0342237, 43.8374}, {0., 0.,         0.}}, {{-1.23767, -0.0499179, 44.5971}, {0., 0.,         0.}}, {{-1.13972, -0.0000850668, 45.3128}, {0., 0.,         0.}}, {{-1.12545, -0.00826265, 46.0778}, {0., 0.,         0.}}, {{-1.1223, -0.0359113, 46.8929}, {0., 0.,         0.}}, {{-1.12465, -0.055138, 47.8623}, {0., 0.,         0.}}, {{-1.09846, -0.0144483, 49.0776}, {0., 0.,         0.}}, {{-1.10899, -0.0625359, 50.4507}, {0., 0.,         0.}}, {{-1.14579, -0.108309, 52.0417}, {0., 0.,         0.}}, {{-1.12848, -0.01126, 54.0108}, {0., 0.,         0.}}, {{-1.11299, -0.0970175, 55.2159}, {0., 0., 0.}}, {{0.,         0.847912, 44.6206}, {0., 0., 0.}}, {{0., 0.847912, 45.3961}, {0.,         0., 0.}}, {{0., 0.847912, 46.2075}, {0., 0., 0.}}, {{0., 0.847912,         47.3219}, {0., 0., 0.}}, {{0., 0.847912, 48.6172}, {0., 0.,         0.}}, {{0., 0.847912, 50.0586}, {0., 0., 0.}}, {{0., 0.847912,         51.6502}, {0., 0., 0.}}, {{0., 0.847912, 53.7857}, {0., 0.,         0.}}, {{0., 0.847912, 55.2595}, {0., 0.,         0.}}, {{0.119852, -0.0804816, 55.6719}, {0., 0.,         0.}}, {{1.38231, -0.0646805, 9.63683}, {0., 0.,         0.}}, {{3.08676, -0.0356642, 10.2185}, {0., 0., 0.}}, {{3.98277,         0.0329428, 10.6312}, {0., 0., 0.}}, {{1.64587, 0.847912,         10.1128}, {0., 0., 0.}}, {{2.94532, 0.847912, 10.6054}, {0., 0.,         0.}}, {{3.0844, 0.847912, 26.2343}, {0., 0., 0.}}, {{6.37314,         0.847912, 26.2343}, {0., 0., 0.}}, {{8.83598, 0.847912,         26.2343}, {0., 0., 0.}}, {{2.68672, -0.0254293, 26.6613}, {0., 0.,         0.}}, {{5.13989, -0.0481681, 26.6588}, {0., 0.,         0.}}, {{7.07074, -0.0263853, 26.6521}, {0., 0., 0.}}, {{8.87196,         0.0308362, 26.6941}, {0., 0., 0.}}, {{0.908045, -0.0256653,         41.2951}, {0., 0., 0.}}, {{0.90812, -0.0305627, 42.1266}, {0., 0.,         0.}}, {{1.09331, -0.0723344, 42.9721}, {0., 0.,         0.}}, {{1.03446, -0.06788, 43.5403}, {0., 0.,         0.}}, {{1.9443, -0.0212229, 43.8278}, {0., 0., 0.}}, {{2.52323,         0.00655421, 44.1426}, {0., 0., 0.}}, {{1.47266, 0.847912,         44.0959}, {0., 0., 0.}}, {{1.47266, 0.847912, 44.6541}, {0., 0.,         0.}}, {{3.48462, 0.847912, 55.2595}, {0., 0., 0.}}, {{9.45979,         0.847912, 55.2595}, {0., 0., 0.}}, {{15.9244, 0.847912,         55.2595}, {0., 0., 0.}}, {{20.8183, 0.847912, 55.2595}, {0., 0.,         0.}}, {{24.5798, 0.847912, 55.2595}, {0., 0., 0.}}, {{27.9807,         0.847912, 55.2595}, {0., 0., 0.}}, {{4.19646, -0.079758,         55.6822}, {0., 0., 0.}}, {{9.8436, -0.111618, 55.6824}, {0., 0.,         0.}}, {{17.6324, -0.0328765, 55.6789}, {0., 0.,         0.}}, {{23.6589, -0.044735, 55.6773}, {0., 0.,         0.}}, {{27.8005, -0.0722351, 55.6708}, {0., 0., 0.}}, {{2.94532,         0.847912, 11.1635}, {0., 0., 0.}}, {{2.62106, -0.0129568,         44.6594}, {0., 0., 0.}}, {{3.34577, -0.0199615, 44.9502}, {0., 0.,         0.}}, {{3.9942, 0.0362858, 45.2367}, {0., 0., 0.}}, {{2.27968,         0.847912, 44.96}, {0., 0., 0.}}, {{2.94532, 0.847912,         45.2124}, {0., 0., 0.}}, {{2.94532, 0.847912, 45.7705}, {0., 0.,         0.}}, {{4.30519, -0.0509312, 11.19}, {0., 0., 0.}}, {{5.04605,         0.847912, 11.9598}, {0., 0., 0.}}}


How do I place vertical GridLines in front of horizontal ones?

By default horizontal GridLines are placed in front of vertical GridLines:               style = Directive[#, AbsoluteThickness[5]] &;     Graphics[Circle[], Frame -> True, ImagePadding -> 1, GridLines -> Automatic,          GridLinesStyle -> style /@ #] & /@ {{LightGray, Black}, {Black, LightGray}} // GraphicsRow      ![Mathematica graphics](http://i.stack.imgur.com/Bxm7H.png) **How can I place the vertical lines in front so that they appear uninterrupted?** I do not wish to resort to manually drawing `Line` expressions.


Tips for efficiently solving large system coupled (nonlinear) ODEs

I'm trying to solve a system of nonlinear, coupled ODEs, where the governing equation for the $n-th$ ODE is of the form: $\sum_k^M Q_{nk} \ddot{a}_k -\sum_{\ell}^M\sum_k^M S_n(\ell,k) \dot{a}_{\ell} \dot{a}_k + \frac{1}{2}U_n = 0 $ where $Q_{nk}=\frac{1}{2}\sum_{j=1}^MP_{jn}P_{jk}$, with $P_{jn}=\frac{1}{\sqrt{m}n}(a_{n-j}+a_{j+n}-a_ja_n)$, (and $a_{n-j}=0$ for $j>n$), $S_n(\ell,k)=-\frac{1}{2}\left(\frac{\partial Q_{k\ell}}{\partial a_n}-\frac{\partial Q_{n\ell}}{\partial a_k}-\frac{\partial Q_{nk}}{\partial a_{\ell}}\right)$ and $U_n=\frac{\partial}{\partial a_n} \frac{1}{2\pi} \int_0^{2\pi}\left\\{ \left(-\sum_{j=1}^M \left(\frac{a_j^2}{2j}-\frac{a_j}{j}\cos j\theta \right)\right)^2*\left(1+\sum_{j=1}^M a_j \cos j\theta \right) \right\\}d\theta$. Note, $(Q_{k\ell}, S_N(k,\ell), U_n)$ are all polynomials (of maximum order 4) in the dependent variables $a_i(t)$ and M is the total number of dependent variables under consideration (i.e $a_j\equiv 0$ for $j>M$). I have been able to solve for low M cases (i.e. M less than 10) using NDSolve. For fixed initial conditions, I have been increasing M and finding a significant increase in computation time. I'm wondering if there are any obvious ways to decrease computation time that I have overlooked. (Ideally, for the system I'm trying to model, I'd like to increase the number of dep. variables to around 200. I'm new to Mathematica, and I'm sure I'm making some 'rookie mistakes' that are costing me in computation time. Also, if I'm barking up the wrong tree, that is I should be using a different platform, I'd like to find out before I invest too much effort into this project.) Some questions I have on basic problem set-up: i) Is it more efficient to isolate the dependent variables in question. That is, have equations of the form $\ddot{a}_i =...$ versus $\sum_k^M Q_{nk} \ddot{a}_k =...$? ii) Is it worth fully simplifying the governing equations (i.e. using FullSimplify[]) before executing the NDSolve command? iii) Should I rewrite each second order ODEs as a pair of first order ODEs? Any advice on this would be greatly appreciated. Thanks, Nick Here is the code:               M = 10; (*Number of modes*)     f[r_, s_] := If[r > s, 0, 1]; (*Will ensure we have no negative modes*)     α[i_, t_] := If[i <= M, A[i, t], 0]; (*Truncate series at Mth mode*)     A[0, t_] := 1; (*By definition*)          P[m_, n_, t_] :=      1/Sqrt[m*n^2]*(f[m, n]*α[n - m, t] + α[n + m,      t] - α[m, t]*α[n, t]) ;            Q[n_, l_, t_] := 1/2 Sum[P[m, n, t]* P[m, l, t], {m,1,M}] ;           S[n_, k_, l_, t_] :=      1/2 (D[Q[k, l, t], A[n, t]] - D[Q[n, l, t], A[k, t]] -      D[Q[n, k, t], A[l, t]]);           F[t_] := 1/(2 π) Integrate[     Sum[((A[j, t]*Cos[j*ξ])/j -             A[j, t]^2/(2j)),{j,1,M}]^2*      (1+Sum[1+A[j, t]*           Cos[j*ξ],{j,1,M}]), {ξ, 0, 2π}];      U[n_, t_] := D[F[t], A[n, t]];     Table[A[j, t_] = B[j][t], {j, 1, M}]; (*Redefine dep variables so that independent     variable is distinguished from dep var index*)     Gov[n_, t_] := Sum[B[l]''[t]*Q[n,l,t],{l,1,M}]-Sum[Sum[S[n,k,l,t]B[k]'[t]B[l]'[t],      {k,1,M}],{l,1,M}]+1/2U[n,t];          eqns = {Table[Gov[j, t] == 0, {j, 1, M}], B[1][0] == 0.3, B[2][0] == 0.1, Table[B[j][0] ==   0, {j, 3, M}], Table[B[j]'[0] == 0, {j, 1, M}]};          TenMode = NDSolve[eqns, Table[B[n][t], {n, 1, M}], {t, 0, 10}]      I apologize for any errors in the code since I had some issues parsing from the symbolic notation present in my editor to a code that would be easily copied into this forum.


Performance: Collapsing repeated contiguous rows & cols from a matrix

In this answer I needed to remove contiguous zero-valued cols and rows from a matrix, _leaving only two of them in place_ , no matter what the original number was. I made up this code:               m = RandomVariate[BinomialDistribution[1, 10^-3], {400, 400}];      rule = {h__, {0 ..}, w : {0 ..}, {0 ..}, t__} -> {h, w, w, t};     mClean = Transpose[Transpose[m //. rule] //. rule];     Dimensions@mClean      But it is way too slow.   I'm pretty sure this code can be enhanced. Any better ideas?


How do I make a 3DPlot using cylindrical coordinates?

I'm trying to plot a function of the form $z(r,\theta)$ where $r \in [0, R]$ for a finite R, $\theta \in [0,2\pi[$, and z is the third coordinate, a function of the first two. I couldn't find anything to do it natively, so I went back to Cartesian coordinates. But the result does not satisfy me, because the range of x is a function of y, a consequence of the constraint $ x^2+y^2 < R^2$. Is there already something in _Mathematica_ to handle this kind of plot?


Set the style of a cell

I know it's possible to programmatically change options on the selection in a notebook. I'd like to create a button that lets me change the style of a cell. It's a style that doesn't have a keyboard shortcut, "ItemParagraph" Something like               SetOptions[NotebookSelection[SelectedNotebook[]], CellStyle->"ItemParagraph"]      but CellStyle is for NotebookFind. Is there some way to do this? I just couldn't find the cell option I needed. I checked the Options for Cell but there are hundreds and I couldn't see anything that looked right...


Plot result from the function of NDSolve

I have a solution that I got from NDSolve which are ua and uw.               eq1=Derivative[2, 0][uw][z, t]*cwv-Derivative[0,1][ua][z,t]*cw == Derivative[0, 1][uw][z, t];     eq2=Derivative[2, 0][ua][z, t]*cav-Derivative[0,1][uw][z,t]*ca == Derivative[0, 1][ua][z, t];          ic1 = {uw[zmax, t] == ui + p0, uw[z, tmin] == ui};     ic2 = {ua[z, tmin] == uatm};     sol2 = NDSolve[Flatten[{eq1, eq2, ic1, ic2}], {uw, ua}, {z, zmin, zmax}, {t, tmin,      tmax}, MaxSteps -> Infinity, MaxStepSize -> dt/step, InterpolationOrder -> All];          result = (ua[z, t] /. sol2) - (atm[z, t]) - (uw[z, t] /. sol2);      I manage to solve this equation and I can plot "result" by using Plot3D.               Plot3D[result, {z, zmin, zmax}, {t, tmin, tmax},             PlotRange -> All, AxesLabel -> {z, t, "result"[z, t]},             BoundaryStyle -> Thick, ImageSize -> 500]      However, I also wants to plot this equation by using manipulate command in Plot but I failed. Here is how I do it               Manipulate[Plot[result, {t, tmin, tmax}, PlotRange -> Full,                      AxesLabel -> {t, "result"[z, t]}], {z, zmin, zmax}]      or by using this code               Manipulate[result[z,t], {t, tmin, tmax}, PlotRange -> Full,                 AxesLabel -> {t, "result"[z, t]}], {z, zmin, zmax}]      Can someone please tell me how to plot "result" by using manipulate command?I can do it for each ua[z,t] and uw[z,t] For the complete set of code               kw = 1*10^(-10);(*m/s*)     ka = 8*10^(-13);(*m/s*)     gw = 10;(*kN/m^3*)     m2w = 2.41*10^(-4);(*coefficient of compressibility of water phase with respect to matric suction*)     m1w = 0.8*10^(-4);(*coefficient of compressibility of water phase with respect to axial stress*)     m2a = 1.11*10^(-4);(*coefficient of compressibility with air phase with respect to matric suction*)     m1a = 0.37*10^(-4);(*coefficient of compressibility of air phase with respect to axial stress*)     p0 = 100;(*applied pressure -kPa*)     tmin = 0;(*minimum or time when the pressure is applied*)     tmax = 5000;(*latest inspected time*)     zmin = 0;(*top elevation*)     zmax = 0.02;(*bottom elevation*)     uatm = 101;(*kPa-atmospheric air pressure*)     step = 1000;(*The higher the step, the higher the accuracy*)     ui = -400;(*Initial matric suction*)          temp = 300;(*temperature in kelvin*)     wa = 28.97;(*kg/kmol*)     s = 0.7887;     n = 1.0696/(1 + 1.0696);     (*CALCULATION*)     r = 8.31432;(*Universal gas constant in j/(mol K*)     g = 9.8;(*gravity acceleration-m2/s*)     da = ka/g;(*function varies with matric suction, havent been defined yet*)     cwv = kw/(gw*m2w);     cw = ((1 - m2w/m1w)/(m2w/m1w));     ca = (m2a/m1a)/(1 - (m2a/m1a) - (1 - s)*n/(uatm*m1a));     cav = (da/(wa/(r*temp)*uatm))/(m1a*(1 - m2a/m1a) - (1 - s)*n);     dt = tmax - tmin;          eq1 = Derivative[2, 0][uw][z, t]*cwv - Derivative[0, 1][ua][z, t]*cw == Derivative[0, 1][uw][z, t];     eq2 = Derivative[2, 0][ua][z, t]*cav - Derivative[0, 1][uw][z, t]*ca == Derivative[0, 1][ua][z, t];          ic1 = {uw[zmax, t] == ui + p0, uw[z, tmin] == ui};     ic2 = {ua[z, tmin] == uatm};     sol2 = NDSolve[Flatten[{eq1, eq2, ic1, ic2}], {uw, ua}, {z, zmin, zmax}, {t, tmin,tmax}, MaxSteps -> Infinity, MaxStepSize -> dt/step, InterpolationOrder -> All];          Column[Plot3D[uw[z, t] /. sol2, {z, zmin, zmax}, {t, tmin, tmax}, PlotRange -> All, AxesLabel -> {z, t, uw[z, t]}, BoundaryStyle -> Thick, ImageSize -> 500], Plot3D[ua[z, t] /. sol2, {z, zmin, zmax}, {t, tmin, tmax}, PlotRange -> All, AxesLabel -> {z, t, ua[z, t]}, BoundaryStyle -> Thick, ImageSize -> 500]]          Column[Manipulate[Plot[uw[z, t] /. sol2, {z, zmin, zmax}, PlotRange -> Full, AxesLabel -> {z, uw[z, t]}], {t, tmin, tmax}],Manipulate[Plot[uw[z, t] /. sol2, {t, tmin, tmax}, PlotRange -> Full, AxesLabel -> {t, uw[z, t]}], {z, zmin, zmax}]]          Column[Manipulate[Plot[ua[z, t] /. sol2, {z, zmin, zmax}, PlotRange -> Full, AxesLabel -> {z, ua[z, t]}], {t, tmin, tmax}],Manipulate[Plot[ua[z, t] /. sol2, {t, tmin, tmax}, PlotRange -> Full, AxesLabel -> {t, ua[z, t]}], {z, zmin, zmax}]]          Column[Manipulate[Plot[{uw[z, tmin] /. sol2, uw[z, t1] /. sol2, uw[z, t2] /. sol2, uw[z, t3] /. sol2, uw[z, t4] /. sol2, uw[z, tmax] /. sol2}, {z, zmin, zmax}, AxesLabel -> {z, uw[z, t]}, PlotRange -> Full, AxesLabel -> {z, uw[z, t]}], {t1, tmin + dt/1000, tmin + dt/51}, {t2, tmin + dt/50, tmin + dt/16}, {t3, tmin + dt/15,tmin + dt/3}, {t4, tmin + dt/3, tmin + dt/1}], Manipulate[Plot[{ua[z, tmin] /. sol2, ua[z, t1] /. sol2, ua[z, t2] /. sol2, ua[z, t3] /. sol2, ua[z, t4] /. sol2, ua[z, tmax] /. sol2}, {z, zmin, zmax}, AxesLabel -> {z, ua[z, t]}, PlotRange -> Full], {t1, tmin + dt/500, tmin + dt/51}, {t2, tmin + dt/50, tmin + dt/16}, {t3, tmin + dt/15, tmin + dt/3}, {t4, tmin + dt/3, tmin + dt/1}]]          atm[z, t] = uatm     result == (ua[z, t] /. sol2) - (atm[z, t]) - (uw[z, t] /. sol2);     Plot3D[result, {z, zmin, zmax}, {t, tmin, tmax}, PlotRange -> All, AxesLabel -> {z, t,"result"[z, t]}, BoundaryStyle -> Thick, ImageSize -> 500]     Manipulate[result, {t, tmin, tmax}, PlotRange -> Full, AxesLabel -> {t, "result"[z, t]}], {z, zmin, zmax}]      Regards Martin Wijaya


Using graphics primitives to draw a cross as inset in graphics

I would like to draw a cross as an inset in a Graphics environment. I tried the following:               Graphics[{Inset[Style["\[Cross]", 100], {0, 0},{Center,Center}], Circle[]},           Frame -> True]      ![Inset of cross in circle](http://i.stack.imgur.com/vYuvb.png) Unfortunately, the `{Center,Center}` command for specifying the exact point of the cross that is drawn at the `{0,0}` position does not use the intercept of the two parts of the cross. Is there an easy way to produce a cross using graphics primitives rather than special characters? I have not done much with graphics yet and would really appreciate your help.


Selection of the position of the variable

I defined a function `funloglogplot` to make a loglogplot of a function (`function1`) depending on several variables               funloglogplot[function1_, xmin_, xmax_, numpoints_] :=        Module[{list1, listRe, listIm},              list1 = {#1, function1[eps1, 1, #1, R1ideal, R2, ordre]}& /@               logspace[xmin, xmax, numpoints];              listRe = {#1[[1]], Re[#1[[2]]]}& /@ list1;              listIm = {#1[[1]], -Im[#1[[2]]]}& /@ list1;              ListLogLogPlot[{listRe, listIm}, Joined -> True]              ]      Nevertheless I would like to be able to choose the variables I am using for the plot (in this case I plot `function1` as a function of its 3rd argument and I would like to be able to select the argument).   Can anyone see a solution?


Measuring the percentage of a given color in an area?

Given this image I would like to measure how much (in percentage relative to the square area) of each black delimited square is filled with green:               i = Import["http://i.imgur.com/62buGws.png"]      ![enter image description here](http://i.stack.imgur.com/8gBm6.png) I am a bit lost with the usage of the image processing functions. It seems like `MorphologicalPerimeter`and `PixelValuePositions`or `ImageData`could be useful. If I can find a way to detect each square then it is a matter of calling `ImageData` on that area and count the number of green pixels. Any tips please?


ImageSize as absolute (metric) value

I have wondered more and more often lately how the size of an image is handled when displayed or exported. The documentation implies that the via `ImageSize` the size could be set in printer points (per inch). That does however not correspond with the displayed graphics (for instance `ImageSize-> {72 1, 72 1 }`) does not render a generic plot with the expected size of one inch square. (UI magnification at 100%) I am using Mathematica 9 on OS X 10.9 and usually use .eps for exporting plots (since .pdf export doesn't really work that well with fonts and all)


Can CUDAVolumetricRender be combined with other 3D graphics?

I have volumetric data, which I can render using `CUDAVolumetricRender[]`. However, I cannot seem to find a way to combine it with other 3D graphics, such as adding a bounding box, axes, labels, etc. How is `CUDAVolumetricRender[]` supposed to be customized? It returns a `DynamicModule`, which is pretty opaque.


How to make a volume CUDA rendering isometric?

I just realized that the output of `CUDAVolumetricRender[]` uses (quite marked) perspective, which I do not want (for scientific data representation, it can be very misleading). How do I turn it off? (i.e. make it use an isometric projection)


Is it possible to style multiple Plot or ListPlot curves using a color gradient?

I am using Mathematica 8. In Mathematica, there is a default `PlotStyle` coloring in `Plot` and `ListPlot`. For example, suppose I have a series of nine functions stored in the list `functions`. Mathematica styles the different curves in a cyclic way (I think that the default is cycles of **"blue", purple, dark yellow, green** ), as in this example:               functions = Table[a*Cos[x], {a, 0.2, 1, 0.1}]     Plot[functions, {x, 0, 2 Pi}]      > >     {0.2 Cos[x], 0.3 Cos[x], 0.4 Cos[x], 0.5 Cos[x], 0.6 Cos[x], 0.7 Cos[x], > 0.8 Cos[x], >      0.9 Cos[x], 1. Cos[x]} >   > > ![plot1](http://i.stack.imgur.com/Z46qR.png) This is nice, but now suppose that I want to color the multiple curves using some sort of gradient (perhaps one of the gradients in `ColorData`). Is this possible in `Plot` and `ListPlot`? I could do this somewhat manually. For example, if I wanted a blue gradient, I could write the following (although this choice of colors could somehow be improved):               Plot[functions, {x, 0, 2 Pi}, PlotStyle -> {        Lighter[Lighter[Lighter[Lighter[Blue]]]],        Lighter[Lighter[Lighter[Blue]]],        Lighter[Lighter[Blue]],        Lighter[Blue],        Blue,        Darker[Blue],        Darker[Darker[Blue]],        Darker[Darker[Darker[Blue]]],        Darker[Darker[Darker[Darker[Blue]]]]        }]      > ![plot2](http://i.stack.imgur.com/mGczA.png) However, this becomes complicated if I have many curves or if I want to use a more complex gradient such as rainbow (e.g., `ColorData["Rainbow"]`), temperature map (e.g., `ColorData["TemperatureMap"]`), etc. Do you have any suggestions?


How does bandwidth selection work for low-variance dimensions with KernelMixtureDistribution?

I am puzzled because this toy example (in Mathematica 8)               dist = KernelMixtureDistribution[{{0, 1}, {0.0, 0}, {0, -1}},"Silverman",                                       MaxMixtureKernels -> All];     DensityPlot[PDF[dist, {x1, x2}], {x1, -3, 3}, {x2, -3, 3}]      ![enter image description here](http://i.stack.imgur.com/xrcCl.gif) produces a density estimate with quite a large extent in x-direction although it has zero standard deviation. I would not have been surprised if that had produced an error because it should be a delta impulse in x-direction and I don't know if that can be represented by Mathematica. But this result does not make sense. If I change it to               dist = KernelMixtureDistribution[{{0, 1}, {0.01, 0}, {0, -1}},"Silverman",                                      MaxMixtureKernels -> All];     DensityPlot[PDF[dist, {x1, x2}], {x1, -3, 3}, {x2, -3, 3}]      ![enter image description here](http://i.stack.imgur.com/0t2Oz.gif) the result is a very thin distribution as expected. The behaviour is similar for Silverman's and Scott's rules of thumb. **Can someone shed some light on how the standard deviations are interpreted here? Is this a bug maybe ?**


Differentiating with respect to vectors of unspecified length

Given a function defined by               f[x_,y_] := Sum[ x[[i]] (g[y[[i]]] - g[Total[y]] - Log[x[[i]]]), {i, 1, Length[x]}]      I can easily calculate the derivative for a fixed `n` by               D[f[{x1, x2, x3}, {y1, y2, y3}], {{x1, x2, x3}}]      which yields               {-g(y1 + y2 + y3) + g(y1) - log(x1) - 1,      -g(y1 + y2 + y3) + g(y2) - log(x2) - 1,      -g(y1 + y2 + y3) + g(y3) - log(x3) - 1}      I want to differentiate w.r.t. `x` in the general case, by something like this:               D[f[x, y], x]      yielding something like this:               {-g(Total[y]) + g(y[[i]]) - Log[x[[i]]], {i, 1, Length[x]}}      Is this possible? Ideally it chains with `Solve` as well so that I can write something like:               Solve[D[f[x, y], x] == Table[0, {Length[x]}], x]      and get something like               {{x[[i]] -> E^(-g(Total[y]) + g(y[[i]]) - 1), {i, 1, Length[x]}}


HighlightGraph with style

In this picture you see a graph. The shortest path between vertex 5 and vertex 3 is highlighted in red. Instead I want blue highlighted edges of thickness 10.               HighlightGraph[WheelGraph[6, EdgeStyle -> Directive[Black,AbsoluteThickness[10]]],      PathGraph@FindShortestPath[WheelGraph[6], 5, 3],       GraphHighlightStyle -> {"Red", AbsoluteThickness[10]}]      ![a](http://i.stack.imgur.com/aZ1c9.png) I tried this. The thickness went to 10, but why is the highlighted path not blue?                 HighlightGraph[WheelGraph[6, EdgeStyle -> Directive[Black, AbsoluteThickness[10]],       VertexSize -> 0], PathGraph@FindShortestPath[WheelGraph[6], 5, 3],       GraphHighlightStyle -> {"Blue", AbsoluteThickness[10]}]      ![b](http://i.stack.imgur.com/d9Ykm.png)


ListPlot coloring by density of points

I have a set of points on a circumference:               points = Map[Normalize, RandomReal[{-1, 1}, {3000, 2}]]      And I want to plot them and color the plot according to the density of points. You see, `ListPlot[points]` will just give me that, a simple plot, on which I can't see the distribution of the points on the circle. Maybe there is an option? I hope you guys can understand what I'm asking. **Edit/Follow-up** I used `SmoothDensityHistogram[points, ColorFunction -> "Rainbow"]` ![This is what it looks like](http://i.stack.imgur.com/hWd6a.png) Now, it's not really what I'm looking for. I kind of wanted it to look like the original plot, just the circumference.


Symmetric sum and Muirhead's Inequality

I was able to find some reference for symmetric polynomials but not for the _symetric sum_ (see http://en.wikipedia.org/wiki/Muirhead%27s_inequality#Symmetric_sum- notation_tricks ) Please could anyone tell if there is an implementation of the symmetric sum in Mathematica? Any other tools (packages) to deal with Muirhead's inequality? Thanks!


How to relate memory usage with occupied positions of SparseArrays?

What is the relation of memory usage of a SparseArray   and the number of its occupied positions? Let's say you build a 100.000.000 by 10 element SparseArray.   And fill the two position 1/1 and 100.000.000/10 with a value.               num = 999999;       idSparse = SparseArray[{{1, 1} -> num, {100000000, 10} -> num}]        There are two elements in the Array. Memory usage is:               ByteCount[idSparse]       400000968        Disk usage is:               Export["idSparse.rsa", idSparse];       FileByteCount["idSparse.rsa"]       380


Why does Expand not work within a function?

I'm writing this fairly simple function:               hermite[0, x] = 1;     hermite[1, x] = 2 x;     hermite[n_, x_] := (       hermite[n, x] = 2 x*hermite[n - 1, x] - 2 (n - 1) hermite[n - 2, x];       Expand[hermite[n, x]]       )      But the `Expand` command is ignored. Yet, when I do               Expand[hermite[10, x]]      The result is expanded like I wish. Why is it not working when I put the same command inside a function? I'd like to do it in the function; it would be cleaner.


How can I import images from a Microsoft SQLServer database?

I have a table with binary data (images) in Microsoft SQlServer. I want to import that data and convert it into `Image` format. I wrote the following code, but it's not working.               (* demoSqlConn points to connectionId in between MM and DB and Images       points to Table name in Db *)     binarydata = SQLSelect[demoSqlConn, "Images"];     convertedData = FromCharacterCode[binarydata[[1, 1]]];     image=ImportString[convertedData, "JPEG"]      After evaluating this code, I get the following error: > The front end encountered an error while processing a "NotebookPredictions" > packet. For testing purposes, I evaluated `binarydata` separately. It returns a list like {{FFD8FFE000104A46494600010201006000600000FFEE000E41646F6265006400000\ 00001FFE1135D4578696600004D4D002A0000000800070132000200000014000000620\ 13B000200000007000000764746000300000001000400004749000300000001003F000\ 09C9D00010000000E00000000EA1C00070000080C00000000876900040000000100000\ 07D000000E7323030393A30333A31322031333A34363A343200436F726269730000059\ 003000200000014000000BF9004000200000014000000D392910002000000033534000\ 0929200020000000335340000EA1C0007000007B40000000000000000323030383A303\ 33A31342031333A35393A323600323030383A30333A31342031333A35393A323600000\ 5010300030000000100060000011A00050000000100....}}. So, I'm getting the data, the problem is converting it.


How to show wireframes on imported Object / Mesh (.obj file)

I've managed to import a Wavefront (.obj) file and store it in a variable like so:               model = Import[         "/path_to_object/my.obj",          "Graphics3D",          Lighting -> {             {"Ambient", RGBColor[{0.212, 0.168, 0.2}]},             {"Directional", RGBColor[{0.8, 0., 0.}], ImageScaled[{2, 0, 2}]},             {"Directional", RGBColor[{0., 0.8, 0.}], ImageScaled[{2, 2, 2}]},             {"Directional", RGBColor[{0., 0., 0.8}], ImageScaled[{0, 2, 2}]}         }     ]      The output shows no black edges that you would normally see with `Graphics3D` objects, sort of like a "wireframe overlay". I've tried to call the `Graphics3D` function on `model` in this way:               Graphics3D[{AbsoluteThickness[2], AbsoluteDashing[{5, 5}], model}]      But I get the error:               Graphics is not a Graphics3D primitive or directive.      I've also tried adding more arguments to the `Import` function but I get the error:               Import::argt: Import called with 3 arguments; 1 or 2 arguments are expected.      Any ideas on how this can be accomplished? I saw that there is the command `Mesh->All`, but because I'm not that well versed with Mathematica yet, I don't know exactly how to apply a `Mesh` command to an imported `Graphics3D` object.


Efficient matrix multiplication

I have a list of vectors vecs={vec1,vec2,...,vecN} where veci is a list with length N. Now I have a matrix N*N called mat. I would like to efficiently get all the numbers veci.mat.veci for i=1 to N in a list. How do I do it?


Move the Animation Controls in a Manipulate Slider

Quick formatting question: How can I move the animation controls for a slider from underneath it to say, on the side? For example, I have this: ![Slider Bars](http://i.imgur.com/KIlAZ6Y.jpg) But I would like all of those controls to be on the right side of each slider, instead of underneath the slider. And actually, if there is a way to just have an input field for the value of each variable, that would great too! I know you can set Appearance -> "Labeled" but this does not allow you to change the value, only observe it. Thanks!


Autocomplete not working on Mma9 on Linux

I started using Mathematica 9 on Ubuntu 12.10 and, sometimes, autocomplete doesn't work. The suggestions window shows up for just a fraction of second, and quickly disappears. Do you have any idea on how I can sold this problem? Thanks in advance!


How can I efficiently and uniformly sample the set of vertices a fixed edge-wise distance away from a chosen vertex?

I have a large graph $G$, which may be either directed or undirected. How would I use `DepthFirstScan[]` or `BreadthFirstScan[]` to efficiently and uniformly sample the set of vertices a fixed shortest distance of $D$ away from some vertex $v_i \in V$?


NDSolve complains about missing derivatives of dependent variables in Mathematica 9

In _Mathematica_ 8               NDSolve[{x[t] == 1, x[0] == 1}, x[t], {t, 0, 10}]      solves fine and returns               {{x[t]->InterpolatingFunction[{{0.,10.}},<>][t]}}      while _Mathematica_ 9 raises > NDSolve::derivs: No derivatives of dependent variables were found in the > equations. NDSolve is designed to solve differential or differential > algebraic equations. Use NSolve or FindRoot to numerically solve algebraic > equations. >> I get the point, but is there maybe a way to restore the old behavior via `NDSolve`'s options system?


Problem with working precision

I have tried to resolve the problem of the following link How can I solve precision problem I can tell the problem described in that link shortly here, It's no mater how many precision is there after decimal(.) the result should be 2 or 3 precision after decimal as per user requirement.e.g               N[10/3]     3      Output should be as per user wish precision as 2.               3.33     3.00      There I found `NumberForm[]` function as a solution, since the `NumberForm[]` function is wrap up the result, I can't get the result as number out of it. I tried like this               NumberForm[N[10/3],{4,2}]     NumberForm[3, {4, 2}]      Output am getting is               3.33     3.00      But when I try to do further operation, it's not computing               NumberForm[N[10/3], {4, 2}] + 1     NumberForm[3, {4, 2}] + 1      Output               1+3.33     1+3.00      I tried other way also which follows               ToExpression[ToString[NumberForm[3, {4, 2}]]]      OutPut               3.      but I need output as 3.00. Help me to find the solution.


build and estimate a time series process

I want to generate an EGARCH process. My problem is that I do not see how to create new processes beyond those available. The process itself is : $$\epsilon(t) = \sigma(t) \eta(t)$$ $$\log(\sigma(t)^2 ) = w + b\log(\sigma(t-1)^2) + c\eta(t-1) + d \lvert\eta(t-1)\rvert$$ Notice that I want to use `RandomFunction` to generate the simulated values. Then I'd like to estimate it using the `EstimatedProcess` to estimate the parameters. I want to experiment with false models..


Performance of numerical optimization with triple integral

I'm trying to solve a numerical optimisation that looks something like this:               Joint[X_, Y_, Z_] := PDF[MultinormalDistribution[{0, 0, 0}, {{1, 1/2, 1/2}, {1/2, 1, 1/2}, {1/2, 1/2, 1}}], {X, Y, Z}]          Cond[z_] := ConditionalMultinormalDistribution[MultinormalDistribution[{0, 0}, {{1, 1/2}, {1/2, 1}}], {z}, {2}]          zstar[y_?NumberQ] := z /. FindRoot[1 - CDF[Cond[z], y] == .3, {z, y - 0.1}]          cap[y1_?NumberQ, y2_?NumberQ] := (1/2)*SurvivalFunction[BinormalDistribution[{0, 0}, {1, 1}, (1/2)], {y1, zstar[y1]}] + (1/2)*SurvivalFunction[BinormalDistribution[{0, 0}, {1, 1}, 1/2], {y2, zstar[y2]}]          q[y_?NumberQ] := NIntegrate[X*Joint[X, Y, Z] , {X, -∞, ∞}, {Y, y, ∞}, {Z, zstar[y], ∞}]          NMaximize[{(1/2)*q[y1] + (1/2)*q[y2], cap[y1, y2] == .1}, {t1, t2}]      The definition of `ConditionalMultinormalDistribution` follows this post This numerical optmization problem is computationally very expensive and I would like to improve its performance


Issue with ListDensityPlot when using logarithmic scale

I have got some frequency response data from a speaker measured with different incident angles between speaker and microphone taken in an anechoic chamber. The data can be found here. The whole experiment consists of measurement series at 5 different angles which are `{0°, 30°, 60°, 90°, 180°}` ![plot of measurement series](http://i.stack.imgur.com/E3DoZ.jpg) I individually import (and save them in a variable) with:                importlist[path_] :=       ToExpression @ Partition[Flatten @ Drop[Import[path, "Words"] , 2], 2]      and process them (downsampling and rearranging) with the following functions to get a list suitable for `ListDensityPlot`               downsampleFunction[list_, n_, pos_] :=      Downsample[pos @ Transpose @ list, n]          combineFunction[list_, angle_, downsampleBy_] :=      Thread[{downsampleFunction[list, downsampleBy, First], angle,      downsampleFunction[list, downsampleBy, Last] }]           listcombineFunction[listoflists_, listofangles_, downsampleBy_] :=      Flatten[Table[     combineFunction[listoflists[[i]], listofangles[[i]],      downsampleBy ], {i, 1, Length@listoflists}], 1]      If now plotted with something like               ListDensityPlot[     listcombineFunction[     {list0FR, list30FR, list60FR, list90FR, list180FR},      {0°, 30°, 60°, 90°, 180°}, 1000]]      I get a nice looking plot but in linear scale. Since this is frequency response data (and I would like to show that directivity is a matter that becomes (more) relevant at higher frequencies) I would rather prefer a logarithmic frequency (horizontal) axis. If I change my processing functions by adding a `Log10@` in front of my frequency range data like done here:               combineFunction2[list_, angle_, downsampleBy_] :=      Thread[{Log10 @ downsampleFunction[list, downsampleBy, First], angle,      downsampleFunction[list, downsampleBy, Last] }]           listcombineFunction2[listoflists_, listofangles_, downsampleBy_] :=      Flatten[Table[     combineFunction2[listoflists[[i]], listofangles[[i]],      downsampleBy ], {i, 1, Length@listoflists}], 1]      and plot the results I get a ugly graphics glitch (I guess some interpolation issue due to the accelerated changes forced by the logarithm?). An example with corrected ticks and different styling options: ![example image](http://i.stack.imgur.com/fHdTq.jpg) P.S.: I noticed another glitch concerning the 45° rotated frame labels. Does anybody know a fix for the behaviour? If I try the same code with another example the font looks somewhat thinner but not as aliased as in the sample picture above. Example for "desired" behaviour:                LogLinearPlot[Log10[x], {x, 1, 1000},       FrameTicks -> {Flatten[      Table[{d 10^e, Rotate[d 10^e, 45 Degree]}, {e, Floor[Log[10, 35]],      Ceiling[Log[10, 22000]]}, {d, 1, 5, 1}], 1], Automatic},       Frame -> True, ImageSize -> 600]


How can I export graph as PDF with metadata such as Title and Author fields

I want to export figure from Mathematica in PDF format. Also I want to include Author and Title fields into the PDF. For example, to include Author field, I use the following code:               pp = Plot[{x^2}, {x, -1, 1}]     Export["plot-example.pdf", pp, "Author" -> "Dmitry"]      However, when I open generated PDF file in PDF viewer, the "Author" field is not filled. How should I specify Export call to include Author and Title fields in the generating PDF file?


Is there any way to automatically evaluate selection in new window or new notebook?

Sometimes when you have long code you need to check some part of this code. the way I am using currently is to selected the part that I want and then copy it to new notebook and then evaluate it there. this process becomes annoying when repeated several times. is there a better way to automatically evaluate selection in new notebook without need to go through copy paste procedure? **Update :** Thanks to halirutan for his suggestions. But one of my concerns is to evaluate selection within the cell in to another window. For example: ![enter image description here](http://i.stack.imgur.com/blSaS.jpg) how to evaluate the selection without manually copy and paste. If the cell itself contain long content, then the only way to debug the cell is be copying part by part and pasting into another notebook and evaluate as a whole new cell.


Why does Part behave like it transposes lists?

From the documentation of `Part`: > `Part[expr,i,j,...]` is equivalent to `expr[[i]][[j]]...` So I would expect that, if `t = Table[i + 3 j, {j, 0, 2}, {i, 1, 3}]`, i.e. t = $\begin{pmatrix}1&2&3\\\4&5&6\\\7&8&9\end{pmatrix}$,               t[[1;;2]][[1]]     (* {1, 2, 3} *)       would be equivalent to               Part[t, 1 ;; 2, 1]     (* {1, 4} *)      but it's not...


How to display the support supp(f) of a piecewise function z = f(x,y)?

I'm wondering how to display the support $\mathrm{supp}(f)$ of a piecewise surface $z = f(x,y)$. As an example, let's consider the following piecewise function (and plot it):               f[x_, y_] = Piecewise[{{1, 0 <= x <= 1 && 0 <= y <= 1}}];     g[x_, y_] = Integrate[f[x - t, y - t], {t, 0, 1}];     Plot3D[g[x, y], {x, -0.5, 2.5}, {y, -0.5, 2.5}, PlotRange -> Full]      ![enter image description here](http://i.stack.imgur.com/Gasp5.png) My first thought was to use a contour plot for this purpose, such as               ContourPlot[g[x, y] == .05, {x, -0.5, 2.5}, {y, -0.5, 2.5}]      ![enter image description here](http://i.stack.imgur.com/0qT6M.png) But this is of course only an approximation of the support. How do I display the actual support of my piecewise function? ### Edit The proposed solution in the comments below works great, the result looks as follows: ![enter image description here](http://i.stack.imgur.com/oubOk.png)


Why won't Parallelize speed up my code?

What reasons are there that can cause parallelized Mathematica code not to run with full performance?


Shared variable impacting speed?

I am using a shared variable as a progress indicator ( via `SetSharedVariable[counter]` and then `Dynamic[counter]`), to keep track of a parallel computation. However, there seems to be a massive overhead just because I ask ParallelTable to increment the counter:               AbsoluteTiming[ParallelTable[(counter++; myCompiledFunction),{i,1000}];]          (* {6.580984, Null} *)      But the same exact computation without the counter is about 50 times faster:               AbsoluteTiming[ParallelTable[myCompiledFunction,{i,1000}];]          (* {0.129618, Null} *)      Does anybody know why, and if there is a solution? Note: this does not happen if I use `Table`, but then I cannot take advantage of all my cores.


How to avoid unpacking from Language`ExtendedFullDefinition

Consider this code:               LaunchKernels[];     On["Packing"]          a = RandomReal[{0., 1.}, {64, 30000}];          ParallelMap[Fourier, a]; // AbsoluteTiming      > Developer`FromPackedArray::unpack: Unpacking array in call to > Language`ExtendedFullDefinition. Developer`FromPackedArray::unpack: > Unpacking array in call to MemberQ. >>               (*{1.853567, Null}*)          Map[Fourier, a]; // AbsoluteTiming      > Developer`FromPackedArray::punpackl1: Unpacking array with dimensions > {64,30000} to level 1.               (*{0.289122, Null}*)      How to avoid the unpacking and get some speedup by parallelization? **Update** By avoiding the `MemberQ` unpack (`fix` function copied from here), we can get about 2X speedup, but still slower than the non-parallel version :               memberQ[list_, form_] := Or @@ (MatchQ[#, form] & /@ list)     ClearAll[fix]     SetAttributes[fix, HoldAll]     fix[expr_] := Block[{MemberQ = memberQ}, expr]          fix@ParallelMap[Fourier, a]; // AbsoluteTiming      > Developer`FromPackedArray::unpack: Unpacking array in call to > Language`ExtendedFullDefinition. >>               (*{0.564126, Null}*)      **Update 2** Using the `ParallelTable` can eliminate unpacking and can actually get speedup first run               fix[        ParallelTable[         Fourier[a[[n]]], {n, 1, Length[a]}]]; // AbsoluteTiming     (*{0.215288, Null}*)      second run               fix[        ParallelTable[         Fourier[a[[n]]], {n, 1, Length[a]}]]; // AbsoluteTiming     (*{0.092006, Null}*)      Questions:   1. What is this `Language`ExtendedFullDefinition` and why I always get this warning? How to avoid unpacking from it? I'm using version 9.   2. Can you give more evidence on "Fourier is so fast that you loose any time you gain in the overhead of parallelism"?   3. If the slow is because of parallel over head, why `ParallelTable` is 5X faster than `ParallelMap`? Thanks a lot!


Function pattern to support listed and non-listed arguments

I often want to write functions that take as an argument either a) a rule or b) a list of rules. As an example, when using `Replace` with just one rule, it does not matter whether you give it as a list or not:               Replace[Range[10], 7->"seven", {1}]     Replace[Range[10], {7->"seven"}, {1}]      will both work as expected. Now, if I wanted to set this up, I would use the listed form throughout the function body, and add a second function pattern to actually rewrite the non- listed Rule into a List:               Replace[expr_, rules_Rule, levelspec_] := Replace[expr, {rules}, levelspec]     Replace[expr_, rules_List, levelspec_] := the function body...      Is there a way to write a pattern which matches both forms and returns the listed one? It is, of course, not too hard to write the function body in a way that it supports both forms. But actually I would like to have it done in the pattern already, so I will not have to take special care of it and can easily extend existing functions to support this feature.


ParallelEvaluate: Evaluation Rules and Increment

I'm trying to understand how `ParallelEvaluate` works, considering the two following snippets:               count = 1;       SetSharedVariable[count];       ParallelEvaluate[count++]        > >     Out[320]= {1, 2, 3} >   Whereas if I do:               count = 1;       SetSharedVariable[count];       ParallelEvaluate[count = count + 1]        > >     Out[329]= {2, 2, 2} >   The output, as seen above, is quite different. The first case is mostly from the docs for SetSharedVariable. My confusion is because in the docs for the increment operator, the statements `k++` and `k = k+1` are mentioned to be the same. Therefore, could someone please explain why the parallel kernels treat the two situations differently?


how to store output of a function in a table for future use

I am new to _Mathematica_ and if this is a simple query - please excuse me for the same. I am trying to solve a equation which is a function of two variables. From the solution, I need to store the values of two variables, satisfying this equation into a table to be used for further calculation. The code is as given below :               Remove[Global]          x = 2 r Cos[v + u + γ] - r Cos [(2 v) + u + γ]        (*x coordinate*)     Nxu = D[x, u]     Nxv = D[x, v]     Nx = Nxu Nxv                                          (*normal to x*)          y = 2 r Sin[v + u + γ] - r  Sin[(2 v) + u + γ]        (*y coordinate*)     Nyu = D[y, u]     Nyv = D[y, v]     Ny = Nyu Nyv                                          (*normal to y*)          z = p u                                               (*z coordinate*)     Nzu = D[z, u]     Nzv = D[z, v]     Nz = Nzu Nzv                                          (*normal to z*)          re = 27.5     r = 16.5     g = ArcCos[((5 r^2) - (re^2))/(4 r^2)]     p = 108/(2 π)     γ = 45° 2 Pi / 360     A = 50 + r     γc = 46° 2 Pi / 360          Equation of meshing      EM [u_, v_] = Simplify[(A - x + p Cot[γc]) Nz + (A Cot[γc]) Ny + z Nx ]          ug[thet_] := With[{u = thet}, NSolve[EM[u, v] == 0 && 0 <= v <= g, v, Reals]]     Map[ug, Range[0, 2 Pi, 0.01]]


Why FullSimplify doesn't work here?

Since the emphasis of this question is on finding a workaround, I decided to post this question with an emphasis on the _explanation_ of the behavior of Mathematica. The Bessel function satisfies the following identity: $$J_{-n}(z)=(-1)^n J_n(z),\qquad n\in\mathbb Z$$ Accordingly:               In[2]:= FullSimplify[(-1)^n*BesselJ[n, z] == BesselJ[-n, z], n ∈ Integers]     Out[2]= True      However:               In[3]:= FullSimplify[(-1)^n*BesselJ[n, z] - BesselJ[-n, z], n ∈ Integers]     Out[3]= -BesselJ[-n, z] + (-1)^n BesselJ[n, z]    (*result expected : 0*)      doesn't work as expected. Some workarounds were suggested in the previous question, such as using `ToString` as the `ComplexityFunction` (in this answer):               FullSimplify[(-1)^n*BesselJ[n, z] - BesselJ[-n, z],  n ∈ Integers,                   ComplexityFunction -> (StringLength @ ToString @ # &)]      My question is: Why `FullSimplify` with no specified option value for `ComplexityFunction` (thus using the default `LeafCount`) doesn't simplify $J_{-n}(z) - (-1)^n J_n(z)$ to zero (with $n\in\mathbb Z$)?


How to generate a random binary tree with a given number of vertices and with a given shape, namely compact or elongated

I tried to generate a random binary tree with a `Table` of `RandomInteger` and to give a shape with a `LayerSizeFunction`, but the degree of the node equal to 2 is not respected. I try also by `KaryTree`, but I'm not able to do it. The folloing figures show an example of network compact and elongated, with 60 vertices, respectively: ![This one is an example of compacted tree](http://i.stack.imgur.com/apqzy.jpg) ![This one is an example of elongated tree](http://i.stack.imgur.com/fbf2B.jpg) Here is my attempt:               SeedRandom@0     TreePlot[Table[i -> RandomInteger[{0, i - 1}], {i, 1, 20}],        MultiedgeStyle -> None, SelfLoopStyle -> None,        LayerSizeFunction -> (1 # &)]      ![Mathematica graphics](http://i.stack.imgur.com/ZR2Y3.png)


Why is ^^ff not the same as ^^ToExpression["ff"]?

I want to convert a hexadecimal string to a decimal (base 10) number:               16^^ff     16^^ToExpression["ff"]      The 1st line returns the correct answer of 255, while the 2nd line gives an error. Why doesn't it work?


Implementing a function which generalizes the merging step in merge sort

One of the key steps in merge sort is the merging step. Given two sorted lists               sorted1={2,6,10,13,16,17,19};     sorted2={1,3,4,5,7,8,9,11,12,14,15,18,20};      of integers, we want to produce a new list as follows:   1. Start with an empty list `acc`.   2. Compare the first elements of `sorted1` and `sorted2`. Append the smaller one to `acc`.   3. Remove the element used in step 2 from either `sorted1` or `sorted2`.   4. If neither `sorted1` nor `sorted2` is empty, go to step 2. Otherwise append the remaining list to `acc` and output the value of `acc`. Applying this process to `sorted1` and `sorted2`, we get               acc={1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20}      _Added in response to Rojo's question: We can carry out this procedure even if the two lists are not pre-sorted. So`list1` and `list2` below are not assumed to be sorted._ If there were a built-in function `MergeList` which carries out this process, it would probably take three arguments `list1`, `list2`, and `f`. Here `f` is a Boolean function of two arguments used to decide which element to pick. In the case of merge sort, `f = LessEqual`. I feel that `MergeList` is a fundamental list operation, so **Question 1: Is there such a built-in function or one very close to that?** If I were to write such a function in Scheme, I would use a recursive definition equivalent to the following:               MergeList[list1_,{},f_,acc_:{}]:=Join[acc,list1];     MergeList[{},list2_,f_,acc_:{}]:=Join[acc,list2];     MergeList[list1_,list2_,f_,acc_:{}]:=      If[       f@@First/@{list1,list2},       MergeList[Rest[list1],list2,f,Append[acc,First[list1]]],       MergeList[list1,Rest[list2],f,Append[acc,First[list2]]]      ]      _Sample output with unsorted lists:_               In[2]:= MergeList[{2,5,1},{3,6,4},LessEqual]     Out[2]= {2,3,5,1,6,4}      My impression is that recursive solutions tend to be inefficient in Mathematica, so **Question 2: What would be a better way to implement`MergeList`?** If you have tips about converting loops into their functional equivalents, feel free to mention them as well.


Modular arithmetic - efficiently calculating the remainders of factorials

When working on this question regarding the divisibility of the sum of factorials, I decided to write some code to test "small values" of the problem using the following code.               f[p_] := Total[Mod[#!, p] & /@ Range[p - 1]];     Table[Mod[f@Prime@i, Prime@i], {i, 1, 500}]      Basically, what the code does is sum up all the factorials $$1!+2!+3!+\dots+(p-1)!$$ and find the remainder modulo $p$, for prime $p$. Unfortunately, my code as written takes a very long time to run. Checking the first 500 primes takes 88.280966 seconds on my computer, but checking the first 2000 primes took me about 4 hours. Is there any way to improve the code, or is it already the best we can do? As for optimizations not involving the code, I used Wilson's Theorem, which states that for all primes $p$, $$(p-1)!\equiv-1 \bmod p$$ Using the above theorem, we can modify the code as follows.               h[p_] := Total@Flatten[{Mod[#!, p], PowerMod[(# - 1)!*(-1)^(#), -1, p]} & /@ Range[(p - 1)/2]];     Table[Mod[h@Prime@i, Prime@i], {i, 1, 500}]      This is considerably faster than the previous code, since checking the first 500 primes takes only 25.896166 seconds. However, checking the first 2000 primes still takes an inordinately long time.


How to approximate a given WAV file with trigonometric series?

I'd like (together with a few people) to prepare a presentation about Fourier series for middle/high school students. I thought it might be quite cool to play a violin sound from, say, a WAV file, then approximate it by the first one, two, three etc. terms of the corresponding Fourier series. Assuming that I have the WAV file (and it is just one note with known frequency), how could I do this? This can be distilled to two problems: (1) transforming WAV to a list of data (and that is the easy part) and (2) finding the Fourier series of the function, whose sample is that list. AFAIK, `FourierSeries` expects a function and not a list, and it seems that `Fourier` won't help me here. I could transform the list into a function by writing a function doing, say, linear interpolation of the data in the list by hand, but this seems overly complicated. Any ideas?


Adding and subtracting from elements in a list

I'm trying to solve an aparently simple problem. Given a list of length `n`, `{a1,b1,c1,d1...}` I want to perform two simple operations, and form a new list from each one: `{a1+1,b1-1,c1,d1...}`, `{a1,b1+1,c1-1,d1...}`, `{a1,b1,c1+1,d1-1...}` and so on, and `{a1-1,b1+1,c1,d1...}` and so on. The list elements must not be greater or less than certain values after the addition or substraction. In `{a1+1,b1-1,c1,d1...}`, `{a1,b1+1,c1-1,d1...}`, `{a1,b1,c1+1,d1-1...}` each element must be constrained: `a1<max` and `b1>0`, `b1<max` and `c1>0`, etc. Using this lists I finally use the original list and the `n` new lists to get a list of the form: `{Join[list,new1],Join[list,new2],...}` To solve this problem I wrote a code that although works, takes a very long time to calculate for several sets of list `{{a1,b1,c1,d1...}, {a2,b2,c2,d2...}...}`. Here I post an example using only a list with two sublists, with four elements each one: `{{1, 2, 0, 2}, {2, 2, 1, 1}}`               lst1 = {{1, 2, 0, 2}, {2, 2, 1, 1}};     dim = Partition[Range[Length@First@lst1], 2, 1];     list = li[]; (*to save the "composed" lists*)          (lst = #;     lst2 = Partition[lst, 2, 1];          lst31 = MapThread[If[#1 < 2 && #2 > 0, {#1 + 1, #2 - 1}, {#1, #2}] &,Transpose@lst2];     lst41 = Union@MapThread[ReplacePart[lst, {#1[[1]]-> #2[[1]], #1[[2]]-> #2[[2]]}]&, {dim,lst31}];          lst32 = MapThread[If[#1 > 0 && #2 < 2, {#1 - 1, #2 + 1}, {#1, #2}]&,Transpose@lst2];     lst42 = Union@MapThread[ReplacePart[lst, {#1[[1]]-> #2[[1]], #1[[2]]-> #2[[2]]}]&, {dim, lst32}];          lst61 = Join[lst, #] & /@ lst41;     lst62 = Join[lst, #] & /@ lst42;     lst6 = Union@Join[lst61, lst62];     list = li[list, lst6];     ) & /@ lst1;          list = List @@ Flatten@list      Any advice to improve the performance of the code would be greatly appreciated! **Edit** Based on comments, I tried to explain better the second part of my problem giving a numerical example. **Edit 2** I have added a more precise description about the constraints of the elements of the lists.


Get value for a variable from user inside a module

I am writing a module. When I run the module, I want it to ask for a variable, like I can in other programing languages such as C++ or Python. For example, in C++:               int i;     cout << "Please enter an integer value: ";     cin >> i;      I want something similar to the above in _Mathematica_.


How to take input from user?

Since I'm new to _Mathematica_ I want to have a Notebook which takes inputs from user and returns average of the inputs entered and plots it on x-y coordinate. How can I do this?


How to display operations on list elements

When applying some arithmetic operation on two lists, I'd like to display the actual operations between the elements of each list. For example, `{1, 1} + {1, -1}` would display `{1 + 1, 1 - 1}`. With simple operations, I could just use `Trace` and pick out the part with the right form:               Trace[{1, 1} + {1, -1}, {_Plus, _Plus}]     (* {{1+1,1-1}} *)      However, this becomes really cumbersome in more complex operations. Even worse, some operations don't even show element-by-element operations within `Trace`.               Trace[{{1, 2}, {3, 4}}.{{5, 6}, {7, 8}}]     (* {{{1,2},{3,4}}.{{5,6},{7,8}},{{19,22},{43,50}}} *)      This is what I actually want to display: ![Mathematica graphics](http://i.stack.imgur.com/zyOrJ.png) Of course I could programmatically display the element operation of the matrix multiplication above, but I have to do the same for every other matrix operations. * * * **My question is:** Is there a straightforward way to display operations on elements of two lists? Please feel free to add your own examples and make it as general as you want to.


how to write string to file without Quotation mark

I am trying to Write String to file, something like this:               Write["test.txt", "This is a test"];      when I opened the file I found that the string was written with the Quotation mark " like this: "This is a test" how can I write only the string text? **Note:** "This is a test" is part of matrix and I can't manually type it like this:               Write["test.txt", This is a test];


NDSolve problem with matrix valued function

I got a strange problem when using `NDSolve` to solve a matrix value function               σ[t] = {{σx[t], σxy[t]}, {σyx[t], σy[t]}}      when I try to solve it in a compact form. Here is the initialization code:               Clear[t]     F = {{1, t}, {0, 1}};     LL = D[F, t].Inverse[F];      DD = 1/2 (LL + Transpose[LL]);     WW = 1/2 (LL - Transpose[LL]);     U = MatrixPower[Transpose[F].F, 1/2];     R = F.Inverse[U];     Ω = Simplify[D[R, t].Transpose[R]];     λ = 1;     μ = 1;      Now Ω is a 2 x 2 matrix with variable t. When I directly specify the form of σ, and I can get the problem solved:               σ = ({{σx[t], σxy[t]},{σyx[t], σy[t]}});     sol = NDSolve[{         D[σ, t] == (λ*Tr[DD])*IdentityMatrix[2] + 2 μ*DD + Ω.σ + σ.Transpose[Ω],         (σ /. t -> 0) == ({{0, 0}, {0, 0}})       },      {σx, σy, σxy, σyx},      {t, 0, 5}]      However, if I try to define `{σx[t], σxy[t]},{σyx[t], σy[t]}}` as a single `σ[t]`, which is more elegant, there will be problem:               Clear[σ];     func[X_?ArrayQ] := (λ*Tr[DD])*IdentityMatrix[2] + 2 μ*DD + Ω.X + X.Transpose[Ω];     sol = NDSolve[{         D[σ[t], t] == func[σ][t]],          σ[0] == ({{0, 0},{0, 0}})       }, σ, {t, 0, 5}]      The problem lays in the fact that the variable t in matrix Ω is not treated as the same as the t inside the `NDSolve`. Can you help me fix this?


multiple sequential definitions, defining own set function

I want to define a function for doing multiple definitions, where I apply the same function `f` to all values, and definitions are done not at the same time but after each other. A simple example: the function I want is `multiDef`, where               multiDef[{{a, 1}, {b, 2}, {c, a}}, f]      should be identical to the sequence of assignments               a = f[1];     b = f[2];     c = f[a];      A simple attempt, with slightly different syntax, is               multiDef[list1_List, list2_List, fct_] /; Length[list1] == Length[list2] :=        list1 = fct /@ list2      Aside from the different syntax the problem here is that it will not set `c` to `f[f[1]]`, but to `f[a]` (or to `f[5]` if we had `a = 5` before running this).


Specifying parameters for the Ticks option

I'm trying to use `Ticks` option with `ListLinePlot` to put ticks at 1, 2, 3, 4, 5, 6, and 7 on the x-axis the points and at 1, 2, 3, 4, and 5 on the y-axis, but all I get is 1 on the y-axis.               Ticks->{{1, 2, 3, 4, 5}, {1, 2, 3, 4, 5}}


Generate Random 3D Network using GraphPlot3D and loop

Instead of writing all this out I want to do the same thing with a loop and be able to manipulate n and k. The idea is to create a randomly generated network where n is the number of nodes and k is the number of connections between each node. I've gotten close using `While` and `Table` but haven't quite figured out how to make it work. Any suggestions?               Manipulate[          GraphPlot3D[{1 -> RandomInteger[{1, n}],             1 -> RandomInteger[{1, n}], 1 -> RandomInteger[{1, n}],              1 -> RandomInteger[{1, n}], 1 -> RandomInteger[{1, n}],              1 -> RandomInteger[{1, n}], 1 -> RandomInteger[{1, n}],              1 -> RandomInteger[{1, n}], 1 -> RandomInteger[{1, n}],             2 -> RandomInteger[{1, n}], 2 -> RandomInteger[{1, n}],              2 -> RandomInteger[{1, n}], 2 -> RandomInteger[{1, n}],              2 -> RandomInteger[{1, n}], 2 -> RandomInteger[{1, n}],              2 -> RandomInteger[{1, n}], 2 -> RandomInteger[{1, n}],             3 -> RandomInteger[{1, n}], 3 -> RandomInteger[{1, n}],              3 -> RandomInteger[{1, n}], 3 -> RandomInteger[{1, n}],              3 -> RandomInteger[{1, n}], 3 -> RandomInteger[{1, n}],              3 -> RandomInteger[{1, n}], 3 -> RandomInteger[{1, n}],             4 -> RandomInteger[{1, n}], 4 -> RandomInteger[{1, n}],              4 -> RandomInteger[{1, n}], 4 -> RandomInteger[{1, n}],              4 -> RandomInteger[{1, n}], 4 -> RandomInteger[{1, n}],              4 -> RandomInteger[{1, n}], 4 -> RandomInteger[{1, n}],             5 -> RandomInteger[{1, n}], 5 -> RandomInteger[{1, n}],              5 -> RandomInteger[{1, n}], 5 -> RandomInteger[{1, n}],              5 -> RandomInteger[{1, n}], 5 -> RandomInteger[{1, n}],              5 -> RandomInteger[{1, n}], 5 -> RandomInteger[{1, n}],             6 -> RandomInteger[{1, n}], 6 -> RandomInteger[{1, n}],              6 -> RandomInteger[{1, n}], 6 -> RandomInteger[{1, n}],              6 -> RandomInteger[{1, n}], 6 -> RandomInteger[{1, n}],              6 -> RandomInteger[{1, n}], 6 -> RandomInteger[{1, n}],             7 -> RandomInteger[{1, n}], 7 -> RandomInteger[{1, n}],              7 -> RandomInteger[{1, n}], 7 -> RandomInteger[{1, n}],              7 -> RandomInteger[{1, n}], 7 -> RandomInteger[{1, n}],              7 -> RandomInteger[{1, n}], 7 -> RandomInteger[{1, n}],              7 -> RandomInteger[{1, n}],             8 -> RandomInteger[{1, n}], 8 -> RandomInteger[{1, n}],              8 -> RandomInteger[{1, n}], 8 -> RandomInteger[{1, n}],              8 -> RandomInteger[{1, n}], 8 -> RandomInteger[{1, n}],              8 -> RandomInteger[{1, n}], 8 -> RandomInteger[{1, n}]      },         VertexRenderingFunction -> ({White, EdgeForm[Black], Sphere[#, .1],        Black, Text[#2, #1]} &), Boxed -> False], {n, 1, 8, 1}, {k, 1, 8, 1}]


Patternmatching sets

**How to match set-patterns against sets?** A set (in the mathematical sense) is a list of elements without repetition and order of elements does not matter. For example, we have a pattern set `{3, 1}` that should match sets `{1, 3}`, `{1, 2, 3}`, `{1, 2, 3, 4}` and so on. Note, that the list-length of the pattern is not relevant: any set that contains elements 3 and 1 should match the pattern. So far, this is simple subset testing - but there are two problems:   1. Since order **does** matter for the patternmatcher, one has to write e.g. `Cases[sets, {___, 3, ___, 1, ____}|{___, 1, ___, 3, ____}]` which causes a combinatorial expansion for an increasing number of element-wise matches. Thus I used `MemberQ` instead of structural patterns.   2. I would like to use more complicated patterns, like: "Find all sets that contain 1 and 3 but not 2!". I have a working solution, but it is neither effective nor elegant in my opinion. It involves a Boolean description of the pattern (`And` to include all listed elements, `Or` to include any listed element, `Not` to exclude an element), but I am not sure it is the right way to do it. The function simply wraps each element that apperas in the pattern into `MemberQ`, so the Boolean expression translates to a logical combination of `MemberQ` and `Not@MemberQ` calls.               setCases[sets_List, patt_] := Module[{elem = Union @@ sets},        Cases[sets, _?((patt /. x_ /; MemberQ[elem, x] :> MemberQ[#, x]) &), {1}]        ];      Define a list of sets, and a list of patterns for testing:               sets = Subsets[{1, 2, 3, 4}];          patterns = {1, \[Not] 1, 1 \[And] \[Not] 2, 1 \[Or] \[Not] 2,         1 \[Or] 2 \[Or] 3, 1 \[And] 2 \[And] 3,         1 \[And] \[Not] 2 \[And] \[Not] 3, 1 \[Or] (2 \[And] \[Not] 3),         1 \[And] \[Not] (2 \[And] 3), 1 \[And] \[Not] (2 \[Or] 3),         1 \[And] \[Not] (2 \[Or] (3 \[And] \[Not] 4)),        \[Not] 1 \[And] \[Not] 2 \[And] \[Not] 3 \[And] \[Not] 4}          Grid[{#, setCases[sets, #]} & /@ patterns, Alignment -> Left,       Background -> {None, {{LightGray, White}}}, Spacings -> {1, 1}] // TraditionalForm      ![Mathematica graphics](http://i.stack.imgur.com/EXFC7.png) Let's examine one case closer, by displaying the ultimate pattern that is tested:               (1 \[Or] 2) \[And] \[Not] 3 /. x_Integer :> MemberQ[#, x]      > >     (MemberQ[#1, 1] & || (MemberQ[#1, 2] &)) && ! (MemberQ[#1, 3] &) >   As one can see, the function is far from being economic: alternatives could have been gathered under one `MemberQ` (`MemberQ[#, 1]& || MemberQ[#, 2]&` is equivalent to `MemberQ[#, 1|2]&`) and I think that `Except` should be used as well, though have no idea how. I am interested in robust, fast solutions. **Note** : Do NOT try to simplify the logical patterns, as:               Simplify[And[1, 2]] ==> 2     Simplify[And[0, 1]] ==> False


Coloring Bifurcation Diagram

I have the following Pitchfork bifurcation:               f[x_, r_] := r x - x^3      I was able to find some nice code on this site to draw up the Logistic Map. I have the following snippet (maybe there is a better solution) to draw the bifurcation diagram, but was wondering if it can be colored to represent the stable from unstable branches? ( saved the file, then modified it). We have three stable branches and one unstable branch. The unstable branch is [0, +r], see: ![enter image description here](http://i.stack.imgur.com/0pqFu.png) Is there a way to show the three branches as a solid blue line and the unstable branch as a dashed red line? Also, can we label the axes as $r$ and $x$, and the branches as stable and unstable? Here is the code snippet that drew the above bifurcation diagram (is there an easier way).                  CClear[NotComplexQ];        NotComplexQ[c_Complex] := False;        NotComplexQ[c_] := True            CartProd[l_] := Outer[List, l[[1]], l[[2]]]            ArreglaLista[l_] := Select[Map[(x /. #) &, Flatten[l]], NotComplexQ]           Points = Flatten[        Map[CartProd,         Table[{{r}, ArreglaLista[NSolve[f[x, r] == 0, x]]}, {r, -1, 2,         0.05}]], 2]           ListPlot[Points]