How to output an expression to an external file in "plain text" format without breaking lines?

Given a pretty long expression, such as               a={-11 ψ^2 λ[1]+6 ψ λ[2],35 ψ^2 λ[2],11 ψ^2 λ[1]^2-11 ψ^2 λ[2]-6 ψ λ[1] λ[2],ψ^2 λ[1]^2-ψ^2 λ[2]-ψ λ[1] λ[2]+λ[2]^2,-λ[1]^3+2 λ[1] λ[2],-3 ψ λ[1]^3+6 ψ λ[1] λ[2]+λ[1]^2 λ[2]-λ[2]^2,-ψ λ[1]^3+λ[1]^4+2 ψ λ[1] λ[2]-3 λ[1]^2 λ[2]+λ[2]^2}      `a >> tmp` would output the expression of `a` to an external file `tmp`. But I don't like the format in this output. It breaks lines, and contains extra spaces between operators of "+-*/". In fact, in _Mathematica_ , selecting an expression, we could do **(right click)** > **Copy as** > **Plain Text** , and then we could paste it to any external text editor without any problem. Is it possible to specify the output stream using this "Plain Text" format above?


What is the simplest way to determine which call to a superfunction has generated a Message?

I have a complicated function which contains many calls to `NIntegrate`, `NSolve`, `FindRoot` and other superfunctions in many places. My function is organized in such a way that every call to a superfunction is assigned to unique `Block`ed variable. Sometimes these functions produce `Messages` but it is not obvious which call has generated the message. I wish to find a straighforward way to know which call has generated the message. It would be great to include this information in the `Message` itself but just printing this information before/after the `Message` would be sufficient. I know that there is undocumented function `Internal`HandlerBlock` which seemingly can do such tasks but I do not know how to restrict it to handle only _printed_ messages. For example,               Internal`HandlerBlock[{"Message",        If[MatchQ[#, Hold[_, True]], Print[#]] &},       NIntegrate[Cos[20000 x]/Sqrt[x], {x, 0, 1}]]      Produces many prints but only one of them corresponds to the actually printed one `Message`.


Constructing variable names from a string

I have groups of descriptive variable names and dont want to write explicit code for each group, e.g. (and this is a contrived simplification)               EnergySensorALow[1]=somefuncALow[#]& /@ lstSensorA;     EnergySensorAHigh[1]=somefuncAHigh[#]& /@ lstSensorA;     EnergySensorBLow[1]=somefuncALow[#]& /@ lstSensorB;     EnergySensorBHigh[1]=somefuncAHigh[#]& /@ lstSensorB;      etc. I want create a function that should work as follows:               fnew[sensorType_String]:=                                 "EnergySensor"+sensorType+"Low[1]"="somefunc"+sensorType+"Low"[#]& /@                                "lstSensor"+sensorType;      So the function will take an input String, e.g. "A" and then refer to an existing variable name **EnergySensorALow[1]** , which it will set equal to an existing function **somefuncALow[#] &** and map this over an existing list **lstSensorA** The code will also be run periodically when the sensor values update, and each time the function needs to be applied to the list and stored in the appropriate "EnergySensor" variable name. The variable index[n] makes it easy to use the data in a Manipulate and select which dataset needs to be plotted, I prefer not to add additional indexes to accomplish the functionality I need. Any suggestions?


How to align grid dividers of inner grids in a grid?

How to have the vertical dividers of inner grids aligned to each other in the following?               Grid[{     {"12",Grid[{{"1","2"},{"foo","bar"}},Dividers-> All]},     {"xxxx",Grid[{{"1","2"},{"foooo","barbar"}},Dividers-> All]}     },     Dividers-> All     ]      ![enter image description here](http://i.stack.imgur.com/hBr2Y.png)


The difference between "SymbolicProcessing" -> 0 and restricting the function definition to numeric values only

The Documentation tells us that there are two ways to disable symbolic processing of the integrand by the `NIntegrate` function when it is known that it just slows down the computation. One way is documented and heavily used on the Documentation page "NIntegrate Integration Strategies" and some other Documentation pages:               Method -> {Automatic, "SymbolicProcessing" -> 0}      Another approach is to define the integrand as a "black-box" function and this way is recommended in the "Possible Issues" section of the `NIntegrate` documentation page. Let us compare:               f[x_] := Nest[Sin[# + Sin[2 #]] &, x, 20]     NIntegrate[f[x], {x, 0, 1},        Method -> {Automatic, "SymbolicProcessing" -> 0}] // Timing          (* => {2.797, 0.947747} *)          g[x_?NumericQ] := Nest[Sin[# + Sin[2 #]] &, x, 20]     NIntegrate[g[x], {x, 0, 1}] // Timing          (* => {0.032, 0.947747} *)      One can see the two-order speedup of the "black-box" over the `Method` option. What is the reason? Are there cases when the `Method` option have advantages over the "black-box" approach? In which cases it is recommended to use one or another?


What is the natural way of using Dataset to get a FittedModel?

The new Dataset in Mathematica 10 is a great addition to the language, potentially reducing the convenience gap with R. Given this, I would like to understand what the equivalent simple or natural workflow in Mathematica is for a model fit. In R, one can set up a data frame by columns (`c` creates a vector):               dataset=data.frame(days=c(1,2,6,8),area=c(3,6,8,2),frequency=c(1,4,4,2),height=c(2,3,11,6))      which is displayed like this:                 days area frequency height     1    1    3         1      2     2    2    6         4      3     3    6    8         4     11     4    8    2         2      6      You can then fit a model using a model formula:               fit=lm(height~days+area,data=dataset)      You could view the coefficients, for example, with `coef(fit)`               (Intercept)        days        area       -2.8167116   0.9198113   0.9278976      In Mathematica one option that occurs to me is:               dataset = Dataset[MapThread[Association, Thread /@ {"days" -> {1, 2, 6, 8},      "area" -> {3, 6, 8, 2}, "frequency" -> {1, 4, 4, 2}, "height" -> {2, 3, 11, 6}}]]     LinearModelFit[dataset[[All, {"days", "area", "height"}]] // Normal // Values,      {days, area}, {days, area}]      The specific questions are:   1. What is a more natural way to create the Dataset in Mathematica? I find it helpful to have the data specified by columns and for the column name to be near the data, but if that idiom is not natural in Mathematica, that would be good to know.   2. Is there a simpler way to do the fit, perhaps one as straightforward as the R approach? Specifying the column names is important for experimentation and model selection when the number of potential variables is large. Given some comments below, here are some clarifications:   * In R the data frame is a core structure and it is manipulated in many ways e.g. by combining data frames, adding new columns, modifying existing columns etc. My underlying interest is to understand to what extent Dataset can play this role. I think the column view is pretty important for this.   * Functional wrappers can be written to suit an individual's way of doing things. However, I am interested to know if there is any fundamental or natural way of approaching this in Mathematica. There is clearly a natural way to do it in R.


Better code for two variable fractal interpolation functions

I am trying to write code for 2-variable fractal interpolation functions using two iterated function systems and two starting functions (both $y(x)=x$) which creates a sequence of piecewise defined functions using iterated functions systems(IFS) that converges to an element of the single superfractal. There is randomness involved so each run generates a different attractor. I am not familiar with most of _Mathematica_ 's built in features, so the best I could do involved too many if-statements. The code is very long due to the fact that at each stage of the iteration process (and for each function in the chosen IFS) one of the two previous stage's functions is used. The code plots the first four stages of the two sequences of functions. There must be an easier way and any help would be much appreciated.               {a1, b1} = {.25, .4}; {a2, b2} = {.28, .22}; {a3,        b3} = {.3, .26}; {a4, b4} = {.32, .1}; {a5, b5} = {.7, .8}; {a6,        b6} = {.73, .6}; {a7, b7} = {.78, .8}; {a8, b8} = {.8, .6};     {c1, d1} = {.20, .45}; {c2, d2} = {.25, .3}; {c3,        d3} = {.28, .45}; {c4, d4} = {.32, .2}; {c5, d5} = {.6, .75}; {c6,        d6} = {.7, .65}; {c7, d7} = {.8, .7}; {c8, d8} = {.83, .6};     y0[x_] := x; z0[x_] := x;          If[RandomInteger[] == 0,     If[RandomInteger[] == 0,       f1[x_] := b1*y0[x/a1],       f1[x_] := b1*z0[x/a1]];      If[RandomInteger[] == 0,       g1[x_] := (b2 - b1)*y0[(x - a1)/(a2 - a1)] + b1,       g1[x_] := (b2 - b1)*z0[(x - a1)/(a2 - a1)] + b1];      If[RandomInteger[] == 0,       h1[x_] := (b3 - b2)*y0[(x - a2)/(a3 - a2)] + b2,       h1[x_] := (b3 - b2)*z0[(x - a2)/(a3 - a2)] + b2];      If[RandomInteger[] == 0,       i1[x_] := (b4 - b3)*y0[(x - a3)/(a4 - a3)] + b3,       i1[x_] := (b4 - b3)*z0[(x - a3)/(a4 - a3)] + b3];      If[RandomInteger[] == 0,       j1[x_] := (b5 - b4)*y0[(x - a4)/(a5 - a4)] + b4,       j1[x_] := (b5 - b4)*z0[(x - a4)/(a5 - a4)] + b4];      If[RandomInteger[] == 0,       k1[x_] := (b6 - b5)*y0[(x - a5)/(a6 - a5)] + b5,       k1[x_] := (b6 - b5)*z0[(x - a5)/(a6 - a5)] + b5];      If[RandomInteger[] == 0,       l1[x_] := (b7 - b6)*y0[(x - a6)/(a7 - a6)] + b6,       l1[x_] := (b7 - b6)*z0[(x - a6)/(a7 - a6)] + b6];      If[RandomInteger[] == 0,       m1[x_] := (b8 - b7)*y0[(x - a7)/(a8 - a7)] + b7,       m1[x_] := (b8 - b7)*z0[(x - a7)/(a8 - a7)] + b7];      If[RandomInteger[] == 0,       n1[x_] := (1 - b8)*y0[(x - a8)/(1 - a8)] + b8,       n1[x_] := (1 - b8)*z0[(x - a8)/(1 - a8)] + b8];       y1[x_] :=        If[0 <= x < a1, f1[x],         If[a1 <= x < a2, g1[x],          If[a2 <= x < a3, h1[x],           If[a3 <= x < a4, i1[x],            If[a4 <= x < a5, j1[x],             If[a5 <= x < a6, k1[x],              If[a6 <= x < a7, l1[x], If[a7 <= x < a8, m1[x], n1[x]]]]]]]]],           If[RandomInteger[] == 0,        o1[x_] := d1*y0[1/c1*x],        o1[x_] := d1*z0[1/c1*x]];      If[RandomInteger[] == 0,        p1[x_] := (d2 - d1)*y0[(x - c1)/(c2 - c1)] + d1,        p1[x_] := (d2 - d1)*z0[(x - c1)/(c2 - c1)] + d1];      If[RandomInteger[] == 0,        q1[x_] := (d3 - d2)*y0[(x - c2)/(c3 - c2)] + d2,        q1[x_] := (d3 - d2)*z0[(x - c2)/(c3 - c2)] + d2];      If[RandomInteger[] == 0,        r1[x_] := (d4 - d3)*y0[(x - c3)/(c4 - c3)] + d3,        r1[x_] := (d4 - d3)*z0[(x - c3)/(c4 - c3)] + d3];      If[RandomInteger[] == 0,        s1[x_] := (d5 - d4)*y0[(x - c4)/(c5 - c4)] + d4,        s1[x_] := (d5 - d4)*z0[(x - c4)/(c5 - c4)] + d4];      If[RandomInteger[] == 0,        t1[x_] := (d6 - d5)*y0[(x - c5)/(c6 - c5)] + d5,        t1[x_] := (d6 - d5)*z0[(x - c5)/(c6 - c5)] + d5];      If[RandomInteger[] == 0,        u1[x_] := (d7 - d6)*y0[(x - c6)/(c7 - c6)] + d6,        u1[x_] := (d7 - d6)*z0[(x - c6)/(c7 - c6)] + d6];      If[RandomInteger[] == 0,        v1[x_] := (d8 - d7)*y0[(x - c7)/(c8 - c7)] + d7,        v1[x_] := (d8 - d7)*z0[(x - c7)/(c8 - c7)] + d7];      If[RandomInteger[] == 0,        w1[x_] := (1 - d8)*y0[(x - c8)/(1 - c8)] + d8,        w1[x_] := (1 - d8)*z0[(x - c8)/(1 - c8)] + d8];       y1[x_] :=        If[0 <= x < c1, o1[x],         If[c1 <= x < c2, p1[x],          If[c2 <= x < c3, q1[x],           If[c3 <= x < c4, r1[x],            If[c4 <= x < c5, s1[x],             If[c5 <= x < c6, t1[x],              If[c6 <= x < c7, u1[x], If[c7 <= x < c8, v1[x], w1[x]]]]]]]]]]          If[RandomInteger[] == 0,      If[RandomInteger[] == 0,       f1[x_] := b1*y0[x/a1],       f1[x_] := b1*z0[x/a1]];      If[RandomInteger[] == 0,       g1[x_] := (b2 - b1)*y0[(x - a1)/(a2 - a1)] + b1,       g1[x_] := (b2 - b1)*z0[(x - a1)/(a2 - a1)] + b1];      If[RandomInteger[] == 0,       h1[x_] := (b3 - b2)*y0[(x - a2)/(a3 - a2)] + b2,       h1[x_] := (b3 - b2)*z0[(x - a2)/(a3 - a2)] + b2];      If[RandomInteger[] == 0,       i1[x_] := (b4 - b3)*y0[(x - a3)/(a4 - a3)] + b3,       i1[x_] := (b4 - b3)*z0[(x - a3)/(a4 - a3)] + b3];      If[RandomInteger[] == 0,       j1[x_] := (b5 - b4)*y0[(x - a4)/(a5 - a4)] + b4,       j1[x_] := (b5 - b4)*z0[(x - a4)/(a5 - a4)] + b4];      If[RandomInteger[] == 0,       k1[x_] := (b6 - b5)*y0[(x - a5)/(a6 - a5)] + b5,       k1[x_] := (b6 - b5)*z0[(x - a5)/(a6 - a5)] + b5];      If[RandomInteger[] == 0,       l1[x_] := (b7 - b6)*y0[(x - a6)/(a7 - a6)] + b6,       l1[x_] := (b7 - b6)*z0[(x - a6)/(a7 - a6)] + b6];      If[RandomInteger[] == 0,       m1[x_] := (b8 - b7)*y0[(x - a7)/(a8 - a7)] + b7,       m1[x_] := (b8 - b7)*z0[(x - a7)/(a8 - a7)] + b7];      If[RandomInteger[] == 0,       n1[x_] := (1 - b8)*y0[(x - a8)/(1 - a8)] + b8,       n1[x_] := (1 - b8)*z0[(x - a8)/(1 - a8)] + b8];       z1[x_] :=        If[0 <= x < a1, f1[x],         If[a1 <= x < a2, g1[x],          If[a2 <= x < a3, h1[x],           If[a3 <= x < a4, i1[x],            If[a4 <= x < a5, j1[x],             If[a5 <= x < a6, k1[x],              If[a6 <= x < a7, l1[x], If[a7 <= x < a8, m1[x], n1[x]]]]]]]]],           If[RandomInteger[] == 0,        o1[x_] := d1*y0[1/c1*x],        o1[x_] := d1*z0[1/c1*x]];      If[RandomInteger[] == 0,        p1[x_] := (d2 - d1)*y0[(x - c1)/(c2 - c1)] + d1,        p1[x_] := (d2 - d1)*z0[(x - c1)/(c2 - c1)] + d1];      If[RandomInteger[] == 0,        q1[x_] := (d3 - d2)*y0[(x - c2)/(c3 - c2)] + d2,        q1[x_] := (d3 - d2)*z0[(x - c2)/(c3 - c2)] + d2];      If[RandomInteger[] == 0,        r1[x_] := (d4 - d3)*y0[(x - c3)/(c4 - c3)] + d3,        r1[x_] := (d4 - d3)*z0[(x - c3)/(c4 - c3)] + d3];      If[RandomInteger[] == 0,        s1[x_] := (d5 - d4)*y0[(x - c4)/(c5 - c4)] + d4,        s1[x_] := (d5 - d4)*z0[(x - c4)/(c5 - c4)] + d4];      If[RandomInteger[] == 0,        t1[x_] := (d6 - d5)*y0[(x - c5)/(c6 - c5)] + d5,        t1[x_] := (d6 - d5)*z0[(x - c5)/(c6 - c5)] + d5];      If[RandomInteger[] == 0,        u1[x_] := (d7 - d6)*y0[(x - c6)/(c7 - c6)] + d6,        u1[x_] := (d7 - d6)*z0[(x - c6)/(c7 - c6)] + d6];      If[RandomInteger[] == 0,        v1[x_] := (d8 - d7)*y0[(x - c7)/(c8 - c7)] + d7,        v1[x_] := (d8 - d7)*z0[(x - c7)/(c8 - c7)] + d7];      If[RandomInteger[] == 0,        w1[x_] := (1 - d8)*y0[(x - c8)/(1 - c8)] + d8,        w1[x_] := (1 - d8)*z0[(x - c8)/(1 - c8)] + d8];       z1[x_] :=        If[0 <= x < c1, o1[x],         If[c1 <= x < c2, p1[x],          If[c2 <= x < c3, q1[x],           If[c3 <= x < c4, r1[x],            If[c4 <= x < c5, s1[x],             If[c5 <= x < c6, t1[x],              If[c6 <= x < c7, u1[x], If[c7 <= x < c8, v1[x], w1[x]]]]]]]]]]          If[RandomInteger[] == 0,      If[RandomInteger[] == 0,       f2[x_] := b1*y1[x/a1],       f2[x_] := b1*z1[x/a1]];      If[RandomInteger[] == 0,       g2[x_] := (b2 - b1)*y1[(x - a1)/(a2 - a1)] + b1,       g2[x_] := (b2 - b1)*z1[(x - a1)/(a2 - a1)] + b1];      If[RandomInteger[] == 0,       h2[x_] := (b3 - b2)*y1[(x - a2)/(a3 - a2)] + b2,       h2[x_] := (b3 - b2)*z1[(x - a2)/(a3 - a2)] + b2];      If[RandomInteger[] == 0,       i2[x_] := (b4 - b3)*y1[(x - a3)/(a4 - a3)] + b3,       i2[x_] := (b4 - b3)*z1[(x - a3)/(a4 - a3)] + b3];      If[RandomInteger[] == 0,       j2[x_] := (b5 - b4)*y1[(x - a4)/(a5 - a4)] + b4,       j2[x_] := (b5 - b4)*z1[(x - a4)/(a5 - a4)] + b4];      If[RandomInteger[] == 0,       k2[x_] := (b6 - b5)*y1[(x - a5)/(a6 - a5)] + b5,       k2[x_] := (b6 - b5)*z1[(x - a5)/(a6 - a5)] + b5];      If[RandomInteger[] == 0,       l2[x_] := (b7 - b6)*y1[(x - a6)/(a7 - a6)] + b6,       l2[x_] := (b7 - b6)*z1[(x - a6)/(a7 - a6)] + b6];      If[RandomInteger[] == 0,       m2[x_] := (b8 - b7)*y1[(x - a7)/(a8 - a7)] + b7,       m2[x_] := (b8 - b7)*z1[(x - a7)/(a8 - a7)] + b7];      If[RandomInteger[] == 0,       n2[x_] := (1 - b8)*y1[(x - a8)/(1 - a8)] + b8,       n2[x_] := (1 - b8)*z1[(x - a8)/(1 - a8)] + b8];       y2[x_] :=        If[0 <= x < a1, f2[x],         If[a1 <= x < a2, g2[x],          If[a2 <= x < a3, h2[x],           If[a3 <= x < a4, i2[x],            If[a4 <= x < a5, j2[x],             If[a5 <= x < a6, k2[x],              If[a6 <= x < a7, l2[x], If[a7 <= x < a8, m2[x], n2[x]]]]]]]]],           If[RandomInteger[] == 0,        o2[x_] := d1*y1[1/c1*x],        o2[x_] := d1*z1[1/c1*x]];      If[RandomInteger[] == 0,        p2[x_] := (d2 - d1)*y1[(x - c1)/(c2 - c1)] + d1,        p2[x_] := (d2 - d1)*z1[(x - c1)/(c2 - c1)] + d1];      If[RandomInteger[] == 0,        q2[x_] := (d3 - d2)*y1[(x - c2)/(c3 - c2)] + d2,        q2[x_] := (d3 - d2)*z1[(x - c2)/(c3 - c2)] + d2];      If[RandomInteger[] == 0,        r2[x_] := (d4 - d3)*y1[(x - c3)/(c4 - c3)] + d3,        r2[x_] := (d4 - d3)*z1[(x - c3)/(c4 - c3)] + d3];      If[RandomInteger[] == 0,        s2[x_] := (d5 - d4)*y1[(x - c4)/(c5 - c4)] + d4,        s2[x_] := (d5 - d4)*z1[(x - c4)/(c5 - c4)] + d4];      If[RandomInteger[] == 0,        t2[x_] := (d6 - d5)*y1[(x - c5)/(c6 - c5)] + d5,        t2[x_] := (d6 - d5)*z1[(x - c5)/(c6 - c5)] + d5];      If[RandomInteger[] == 0,        u2[x_] := (d7 - d6)*y1[(x - c6)/(c7 - c6)] + d6,        u2[x_] := (d7 - d6)*z1[(x - c6)/(c7 - c6)] + d6];      If[RandomInteger[] == 0,        v2[x_] := (d8 - d7)*y1[(x - c7)/(c8 - c7)] + d7,        v2[x_] := (d8 - d7)*z1[(x - c7)/(c8 - c7)] + d7];      If[RandomInteger[] == 0,        w2[x_] := (1 - d8)*y1[(x - c8)/(1 - c8)] + d8,        w2[x_] := (1 - d8)*z1[(x - c8)/(1 - c8)] + d8];       y2[x_] :=        If[0 <= x < c1, o2[x],         If[c1 <= x < c2, p2[x],          If[c2 <= x < c3, q2[x],           If[c3 <= x < c4, r2[x],            If[c4 <= x < c5, s2[x],             If[c5 <= x < c6, t2[x],              If[c6 <= x < c7, u2[x], If[c7 <= x < c8, v2[x], w2[x]]]]]]]]]]          If[RandomInteger[] == 0,      If[RandomInteger[] == 0,       f2[x_] := b1*y1[x/a1],       f2[x_] := b1*z1[x/a1]];      If[RandomInteger[] == 0,       g2[x_] := (b2 - b1)*y1[(x - a1)/(a2 - a1)] + b1,       g2[x_] := (b2 - b1)*z1[(x - a1)/(a2 - a1)] + b1];      If[RandomInteger[] == 0,       h2[x_] := (b3 - b2)*y1[(x - a2)/(a3 - a2)] + b2,       h2[x_] := (b3 - b2)*z1[(x - a2)/(a3 - a2)] + b2];      If[RandomInteger[] == 0,       i2[x_] := (b4 - b3)*y1[(x - a3)/(a4 - a3)] + b3,       i2[x_] := (b4 - b3)*z1[(x - a3)/(a4 - a3)] + b3];      If[RandomInteger[] == 0,       j2[x_] := (b5 - b4)*y1[(x - a4)/(a5 - a4)] + b4,       j2[x_] := (b5 - b4)*z1[(x - a4)/(a5 - a4)] + b4];      If[RandomInteger[] == 0,       k2[x_] := (b6 - b5)*y1[(x - a5)/(a6 - a5)] + b5,       k2[x_] := (b6 - b5)*z1[(x - a5)/(a6 - a5)] + b5];      If[RandomInteger[] == 0,       l2[x_] := (b7 - b6)*y1[(x - a6)/(a7 - a6)] + b6,       l2[x_] := (b7 - b6)*z1[(x - a6)/(a7 - a6)] + b6];      If[RandomInteger[] == 0,       m2[x_] := (b8 - b7)*y1[(x - a7)/(a8 - a7)] + b7,       m2[x_] := (b8 - b7)*z1[(x - a7)/(a8 - a7)] + b7];      If[RandomInteger[] == 0,       n2[x_] := (1 - b8)*y1[(x - a8)/(1 - a8)] + b8,       n2[x_] := (1 - b8)*z1[(x - a8)/(1 - a8)] + b8];       z2[x_] :=        If[0 <= x < a1, f2[x],         If[a1 <= x < a2, g2[x],          If[a2 <= x < a3, h2[x],           If[a3 <= x < a4, i2[x],            If[a4 <= x < a5, j2[x],             If[a5 <= x < a6, k2[x],              If[a6 <= x < a7, l2[x], If[a7 <= x < a8, m2[x], n2[x]]]]]]]]],           If[RandomInteger[] == 0,        o2[x_] := d1*y1[1/c1*x],        o2[x_] := d1*z1[1/c1*x]];      If[RandomInteger[] == 0,        p2[x_] := (d2 - d1)*y1[(x - c1)/(c2 - c1)] + d1,        p2[x_] := (d2 - d1)*z1[(x - c1)/(c2 - c1)] + d1];      If[RandomInteger[] == 0,        q2[x_] := (d3 - d2)*y1[(x - c2)/(c3 - c2)] + d2,        q2[x_] := (d3 - d2)*z1[(x - c2)/(c3 - c2)] + d2];      If[RandomInteger[] == 0,        r2[x_] := (d4 - d3)*y1[(x - c3)/(c4 - c3)] + d3,        r2[x_] := (d4 - d3)*z1[(x - c3)/(c4 - c3)] + d3];      If[RandomInteger[] == 0,        s2[x_] := (d5 - d4)*y1[(x - c4)/(c5 - c4)] + d4,        s2[x_] := (d5 - d4)*z1[(x - c4)/(c5 - c4)] + d4];      If[RandomInteger[] == 0,        t2[x_] := (d6 - d5)*y1[(x - c5)/(c6 - c5)] + d5,        t2[x_] := (d6 - d5)*z1[(x - c5)/(c6 - c5)] + d5];      If[RandomInteger[] == 0,        u2[x_] := (d7 - d6)*y1[(x - c6)/(c7 - c6)] + d6,        u2[x_] := (d7 - d6)*z1[(x - c6)/(c7 - c6)] + d6];      If[RandomInteger[] == 0,        v2[x_] := (d8 - d7)*y1[(x - c7)/(c8 - c7)] + d7,        v2[x_] := (d8 - d7)*z1[(x - c7)/(c8 - c7)] + d7];      If[RandomInteger[] == 0,        w2[x_] := (1 - d8)*y1[(x - c8)/(1 - c8)] + d8,        w2[x_] := (1 - d8)*z1[(x - c8)/(1 - c8)] + d8];       z2[x_] :=        If[0 <= x < c1, o2[x],         If[c1 <= x < c2, p2[x],          If[c2 <= x < c3, q2[x],           If[c3 <= x < c4, r2[x],            If[c4 <= x < c5, s2[x],             If[c5 <= x < c6, t2[x],              If[c6 <= x < c7, u2[x], If[c7 <= x < c8, v2[x], w2[x]]]]]]]]]]          If[RandomInteger[] == 0,      If[RandomInteger[] == 0,       f3[x_] := b1*y2[x/a1],       f3[x_] := b1*z2[x/a1]];      If[RandomInteger[] == 0,       g3[x_] := (b2 - b1)*y2[(x - a1)/(a2 - a1)] + b1,       g3[x_] := (b2 - b1)*z2[(x - a1)/(a2 - a1)] + b1];      If[RandomInteger[] == 0,       h3[x_] := (b3 - b2)*y2[(x - a2)/(a3 - a2)] + b2,       h3[x_] := (b3 - b2)*z2[(x - a2)/(a3 - a2)] + b2];      If[RandomInteger[] == 0,       i3[x_] := (b4 - b3)*y2[(x - a3)/(a4 - a3)] + b3,       i3[x_] := (b4 - b3)*z2[(x - a3)/(a4 - a3)] + b3];      If[RandomInteger[] == 0,       j3[x_] := (b5 - b4)*y2[(x - a4)/(a5 - a4)] + b4,       j3[x_] := (b5 - b4)*z2[(x - a4)/(a5 - a4)] + b4];      If[RandomInteger[] == 0,       k3[x_] := (b6 - b5)*y2[(x - a5)/(a6 - a5)] + b5,       k3[x_] := (b6 - b5)*z2[(x - a5)/(a6 - a5)] + b5];      If[RandomInteger[] == 0,       l3[x_] := (b7 - b6)*y2[(x - a6)/(a7 - a6)] + b6,       l3[x_] := (b7 - b6)*z2[(x - a6)/(a7 - a6)] + b6];      If[RandomInteger[] == 0,       m3[x_] := (b8 - b7)*y2[(x - a7)/(a8 - a7)] + b7,       m3[x_] := (b8 - b7)*z2[(x - a7)/(a8 - a7)] + b7];      If[RandomInteger[] == 0,       n3[x_] := (1 - b8)*y2[(x - a8)/(1 - a8)] + b8,       n3[x_] := (1 - b8)*z2[(x - a8)/(1 - a8)] + b8];       y3[x_] :=        If[0 <= x < a1, f3[x],         If[a1 <= x < a2, g3[x],          If[a2 <= x < a3, h3[x],           If[a3 <= x < a4, i3[x],            If[a4 <= x < a5, j3[x],             If[a5 <= x < a6, k3[x],              If[a6 <= x < a7, l3[x], If[a7 <= x < a8, m3[x], n3[x]]]]]]]]],           If[RandomInteger[] == 0,        o3[x_] := d1*y2[1/c1*x],        o3[x_] := d1*z2[1/c1*x]];      If[RandomInteger[] == 0,        p3[x_] := (d2 - d1)*y2[(x - c1)/(c2 - c1)] + d1,        p3[x_] := (d2 - d1)*z2[(x - c1)/(c2 - c1)] + d1];      If[RandomInteger[] == 0,        q3[x_] := (d3 - d2)*y2[(x - c2)/(c3 - c2)] + d2,        q3[x_] := (d3 - d2)*z2[(x - c2)/(c3 - c2)] + d2];      If[RandomInteger[] == 0,        r3[x_] := (d4 - d3)*y2[(x - c3)/(c4 - c3)] + d3,        r3[x_] := (d4 - d3)*z2[(x - c3)/(c4 - c3)] + d3];      If[RandomInteger[] == 0,        s3[x_] := (d5 - d4)*y2[(x - c4)/(c5 - c4)] + d4,        s3[x_] := (d5 - d4)*z2[(x - c4)/(c5 - c4)] + d4];      If[RandomInteger[] == 0,        t3[x_] := (d6 - d5)*y2[(x - c5)/(c6 - c5)] + d5,        t3[x_] := (d6 - d5)*z2[(x - c5)/(c6 - c5)] + d5];      If[RandomInteger[] == 0,        u3[x_] := (d7 - d6)*y2[(x - c6)/(c7 - c6)] + d6,        u3[x_] := (d7 - d6)*z2[(x - c6)/(c7 - c6)] + d6];      If[RandomInteger[] == 0,        v3[x_] := (d8 - d7)*y2[(x - c7)/(c8 - c7)] + d7,        v3[x_] := (d8 - d7)*z2[(x - c7)/(c8 - c7)] + d7];      If[RandomInteger[] == 0,        w3[x_] := (1 - d8)*y2[(x - c8)/(1 - c8)] + d8,        w3[x_] := (1 - d8)*z2[(x - c8)/(1 - c8)] + d8];       y3[x_] :=        If[0 <= x < c1, o3[x],         If[c1 <= x < c2, p3[x],          If[c2 <= x < c3, q3[x],           If[c3 <= x < c4, r3[x],            If[c4 <= x < c5, s3[x],             If[c5 <= x < c6, t3[x],              If[c6 <= x < c7, u3[x], If[c7 <= x < c8, v3[x], w3[x]]]]]]]]]]          If[RandomInteger[] == 0,      If[RandomInteger[] == 0,       f3[x_] := b1*y2[x/a1],       f3[x_] := b1*z2[x/a1]];      If[RandomInteger[] == 0,       g3[x_] := (b2 - b1)*y2[(x - a1)/(a2 - a1)] + b1,       g3[x_] := (b2 - b1)*z2[(x - a1)/(a2 - a1)] + b1];      If[RandomInteger[] == 0,       h3[x_] := (b3 - b2)*y2[(x - a2)/(a3 - a2)] + b2,       h3[x_] := (b3 - b2)*z2[(x - a2)/(a3 - a2)] + b2];      If[RandomInteger[] == 0,       i3[x_] := (b4 - b3)*y2[(x - a3)/(a4 - a3)] + b3,       i3[x_] := (b4 - b3)*z2[(x - a3)/(a4 - a3)] + b3];      If[RandomInteger[] == 0,       j3[x_] := (b5 - b4)*y2[(x - a4)/(a5 - a4)] + b4,       j3[x_] := (b5 - b4)*z2[(x - a4)/(a5 - a4)] + b4];      If[RandomInteger[] == 0,       k3[x_] := (b6 - b5)*y2[(x - a5)/(a6 - a5)] + b5,       k3[x_] := (b6 - b5)*z2[(x - a5)/(a6 - a5)] + b5];      If[RandomInteger[] == 0,       l3[x_] := (b7 - b6)*y2[(x - a6)/(a7 - a6)] + b6,       l3[x_] := (b7 - b6)*z2[(x - a6)/(a7 - a6)] + b6];      If[RandomInteger[] == 0,       m3[x_] := (b8 - b7)*y2[(x - a7)/(a8 - a7)] + b7,       m3[x_] := (b8 - b7)*z2[(x - a7)/(a8 - a7)] + b7];      If[RandomInteger[] == 0,       n3[x_] := (1 - b8)*y2[(x - a8)/(1 - a8)] + b8,       n3[x_] := (1 - b8)*z2[(x - a8)/(1 - a8)] + b8];       z3[x_] :=        If[0 <= x < a1, f3[x],         If[a1 <= x < a2, g3[x],          If[a2 <= x < a3, h3[x],           If[a3 <= x < a4, i3[x],            If[a4 <= x < a5, j3[x],             If[a5 <= x < a6, k3[x],              If[a6 <= x < a7, l3[x], If[a7 <= x < a8, m3[x], n3[x]]]]]]]]],           If[RandomInteger[] == 0,        o3[x_] := d1*y2[1/c1*x],        o3[x_] := d1*z2[1/c1*x]];      If[RandomInteger[] == 0,        p3[x_] := (d2 - d1)*y2[(x - c1)/(c2 - c1)] + d1,        p3[x_] := (d2 - d1)*z2[(x - c1)/(c2 - c1)] + d1];      If[RandomInteger[] == 0,        q3[x_] := (d3 - d2)*y2[(x - c2)/(c3 - c2)] + d2,        q3[x_] := (d3 - d2)*z2[(x - c2)/(c3 - c2)] + d2];      If[RandomInteger[] == 0,        r3[x_] := (d4 - d3)*y2[(x - c3)/(c4 - c3)] + d3,        r3[x_] := (d4 - d3)*z2[(x - c3)/(c4 - c3)] + d3];      If[RandomInteger[] == 0,        s3[x_] := (d5 - d4)*y2[(x - c4)/(c5 - c4)] + d4,        s3[x_] := (d5 - d4)*z2[(x - c4)/(c5 - c4)] + d4];      If[RandomInteger[] == 0,        t3[x_] := (d6 - d5)*y2[(x - c5)/(c6 - c5)] + d5,        t3[x_] := (d6 - d5)*z2[(x - c5)/(c6 - c5)] + d5];      If[RandomInteger[] == 0,        u3[x_] := (d7 - d6)*y2[(x - c6)/(c7 - c6)] + d6,        u3[x_] := (d7 - d6)*z2[(x - c6)/(c7 - c6)] + d6];      If[RandomInteger[] == 0,        v3[x_] := (d8 - d7)*y2[(x - c7)/(c8 - c7)] + d7,        v3[x_] := (d8 - d7)*z2[(x - c7)/(c8 - c7)] + d7];      If[RandomInteger[] == 0,        w3[x_] := (1 - d8)*y2[(x - c8)/(1 - c8)] + d8,        w3[x_] := (1 - d8)*z2[(x - c8)/(1 - c8)] + d8];       z3[x_] :=        If[0 <= x < c1, o3[x],         If[c1 <= x < c2, p3[x],          If[c2 <= x < c3, q3[x],           If[c3 <= x < c4, r3[x],            If[c4 <= x < c5, s3[x],             If[c5 <= x < c6, t3[x],              If[c6 <= x < c7, u3[x], If[c7 <= x < c8, v3[x], w3[x]]]]]]]]]]                              If[RandomInteger[] == 0,      If[RandomInteger[] == 0,       f4[x_] := b1*y3[x/a1],       f4[x_] := b1*z3[x/a1]];      If[RandomInteger[] == 0,       g4[x_] := (b2 - b1)*y3[(x - a1)/(a2 - a1)] + b1,       g4[x_] := (b2 - b1)*z3[(x - a1)/(a2 - a1)] + b1];      If[RandomInteger[] == 0,       h4[x_] := (b3 - b2)*y3[(x - a2)/(a3 - a2)] + b2,       h4[x_] := (b3 - b2)*z3[(x - a2)/(a3 - a2)] + b2];      If[RandomInteger[] == 0,       i4[x_] := (b4 - b3)*y3[(x - a3)/(a4 - a3)] + b3,       i4[x_] := (b4 - b3)*z3[(x - a3)/(a4 - a3)] + b3];      If[RandomInteger[] == 0,       j4[x_] := (b5 - b4)*y3[(x - a4)/(a5 - a4)] + b4,       j4[x_] := (b5 - b4)*z3[(x - a4)/(a5 - a4)] + b4];      If[RandomInteger[] == 0,       k4[x_] := (b6 - b5)*y3[(x - a5)/(a6 - a5)] + b5,       k4[x_] := (b6 - b5)*z3[(x - a5)/(a6 - a5)] + b5];      If[RandomInteger[] == 0,       l4[x_] := (b7 - b6)*y3[(x - a6)/(a7 - a6)] + b6,       l4[x_] := (b7 - b6)*z3[(x - a6)/(a7 - a6)] + b6];      If[RandomInteger[] == 0,       m4[x_] := (b8 - b7)*y3[(x - a7)/(a8 - a7)] + b7,       m4[x_] := (b8 - b7)*z3[(x - a7)/(a8 - a7)] + b7];      If[RandomInteger[] == 0,       n4[x_] := (1 - b8)*y3[(x - a8)/(1 - a8)] + b8,       n4[x_] := (1 - b8)*z3[(x - a8)/(1 - a8)] + b8];       y4[x_] :=        If[0 <= x < a1, f4[x],         If[a1 <= x < a2, g4[x],          If[a2 <= x < a3, h4[x],           If[a3 <= x < a4, i4[x],            If[a4 <= x < a5, j4[x],             If[a5 <= x < a6, k4[x],              If[a6 <= x < a7, l4[x], If[a7 <= x < a8, m4[x], n4[x]]]]]]]]],           If[RandomInteger[] == 0,        o4[x_] := d1*y3[1/c1*x],        o4[x_] := d1*z3[1/c1*x]];      If[RandomInteger[] == 0,        p4[x_] := (d2 - d1)*y3[(x - c1)/(c2 - c1)] + d1,        p4[x_] := (d2 - d1)*z3[(x - c1)/(c2 - c1)] + d1];      If[RandomInteger[] == 0,        q4[x_] := (d3 - d2)*y3[(x - c2)/(c3 - c2)] + d2,        q4[x_] := (d3 - d2)*z3[(x - c2)/(c3 - c2)] + d2];      If[RandomInteger[] == 0,        r4[x_] := (d4 - d3)*y3[(x - c3)/(c4 - c3)] + d3,        r4[x_] := (d4 - d3)*z3[(x - c3)/(c4 - c3)] + d3];      If[RandomInteger[] == 0,        s4[x_] := (d5 - d4)*y3[(x - c4)/(c5 - c4)] + d4,        s4[x_] := (d5 - d4)*z3[(x - c4)/(c5 - c4)] + d4];      If[RandomInteger[] == 0,        t4[x_] := (d6 - d5)*y3[(x - c5)/(c6 - c5)] + d5,        t4[x_] := (d6 - d5)*z3[(x - c5)/(c6 - c5)] + d5];      If[RandomInteger[] == 0,        u4[x_] := (d7 - d6)*y3[(x - c6)/(c7 - c6)] + d6,        u4[x_] := (d7 - d6)*z3[(x - c6)/(c7 - c6)] + d6];      If[RandomInteger[] == 0,        v4[x_] := (d8 - d7)*y3[(x - c7)/(c8 - c7)] + d7,        v4[x_] := (d8 - d7)*z3[(x - c7)/(c8 - c7)] + d7];      If[RandomInteger[] == 0,        w4[x_] := (1 - d8)*y3[(x - c8)/(1 - c8)] + d8,        w4[x_] := (1 - d8)*z3[(x - c8)/(1 - c8)] + d8];       y4[x_] :=        If[0 <= x < c1, o4[x],         If[c1 <= x < c2, p4[x],          If[c2 <= x < c3, q4[x],           If[c3 <= x < c4, r4[x],            If[c4 <= x < c5, s4[x],             If[c5 <= x < c6, t4[x],              If[c6 <= x < c7, u4[x], If[c7 <= x < c8, v4[x], w4[x]]]]]]]]]]          If[RandomInteger[] == 0,       If[RandomInteger[] == 0,        f4[x_] := b1*y3[x/a1],        f4[x_] := b1*z3[x/a1]];       If[RandomInteger[] == 0,        g4[x_] := (b2 - b1)*y3[(x - a1)/(a2 - a1)] + b1,        g4[x_] := (b2 - b1)*z3[(x - a1)/(a2 - a1)] + b1];       If[RandomInteger[] == 0,        h4[x_] := (b3 - b2)*y3[(x - a2)/(a3 - a2)] + b2,        h4[x_] := (b3 - b2)*z3[(x - a2)/(a3 - a2)] + b2];       If[RandomInteger[] == 0,        i4[x_] := (b4 - b3)*y3[(x - a3)/(a4 - a3)] + b3,        i4[x_] := (b4 - b3)*z3[(x - a3)/(a4 - a3)] + b3];       If[RandomInteger[] == 0,        j4[x_] := (b5 - b4)*y3[(x - a4)/(a5 - a4)] + b4,        j4[x_] := (b5 - b4)*z3[(x - a4)/(a5 - a4)] + b4];       If[RandomInteger[] == 0,        k4[x_] := (b6 - b5)*y3[(x - a5)/(a6 - a5)] + b5,        k4[x_] := (b6 - b5)*z3[(x - a5)/(a6 - a5)] + b5];       If[RandomInteger[] == 0,        l4[x_] := (b7 - b6)*y3[(x - a6)/(a7 - a6)] + b6,        l4[x_] := (b7 - b6)*z3[(x - a6)/(a7 - a6)] + b6];       If[RandomInteger[] == 0,        m4[x_] := (b8 - b7)*y3[(x - a7)/(a8 - a7)] + b7,        m4[x_] := (b8 - b7)*z3[(x - a7)/(a8 - a7)] + b7];       If[RandomInteger[] == 0,        n4[x_] := (1 - b8)*y3[(x - a8)/(1 - a8)] + b8,        n4[x_] := (1 - b8)*z3[(x - a8)/(1 - a8)] + b8];        z4[x_] :=         If[0 <= x < a1, f4[x],          If[a1 <= x < a2, g4[x],           If[a2 <= x < a3, h4[x],            If[a3 <= x < a4, i4[x],             If[a4 <= x < a5, j4[x],              If[a5 <= x < a6, k4[x],               If[a6 <= x < a7, l4[x], If[a7 <= x < a8, m4[x], n4[x]]]]]]]]],            If[RandomInteger[] == 0,         o4[x_] := d1*y3[1/c1*x],         o4[x_] := d1*z3[1/c1*x]];       If[RandomInteger[] == 0,         p4[x_] := (d2 - d1)*y3[(x - c1)/(c2 - c1)] + d1,         p4[x_] := (d2 - d1)*z3[(x - c1)/(c2 - c1)] + d1];       If[RandomInteger[] == 0,         q4[x_] := (d3 - d2)*y3[(x - c2)/(c3 - c2)] + d2,         q4[x_] := (d3 - d2)*z3[(x - c2)/(c3 - c2)] + d2];       If[RandomInteger[] == 0,         r4[x_] := (d4 - d3)*y3[(x - c3)/(c4 - c3)] + d3,         r4[x_] := (d4 - d3)*z3[(x - c3)/(c4 - c3)] + d3];       If[RandomInteger[] == 0,         s4[x_] := (d5 - d4)*y3[(x - c4)/(c5 - c4)] + d4,         s4[x_] := (d5 - d4)*z3[(x - c4)/(c5 - c4)] + d4];       If[RandomInteger[] == 0,         t4[x_] := (d6 - d5)*y3[(x - c5)/(c6 - c5)] + d5,         t4[x_] := (d6 - d5)*z3[(x - c5)/(c6 - c5)] + d5];       If[RandomInteger[] == 0,         u4[x_] := (d7 - d6)*y3[(x - c6)/(c7 - c6)] + d6,         u4[x_] := (d7 - d6)*z3[(x - c6)/(c7 - c6)] + d6];       If[RandomInteger[] == 0,         v4[x_] := (d8 - d7)*y3[(x - c7)/(c8 - c7)] + d7,         v4[x_] := (d8 - d7)*z3[(x - c7)/(c8 - c7)] + d7];       If[RandomInteger[] == 0,         w4[x_] := (1 - d8)*y3[(x - c8)/(1 - c8)] + d8,         w4[x_] := (1 - d8)*z3[(x - c8)/(1 - c8)] + d8];        z4[x_] :=         If[0 <= x < c1, o4[x],          If[c1 <= x < c2, p4[x],           If[c2 <= x < c3, q4[x],            If[c3 <= x < c4, r4[x],             If[c4 <= x < c5, s4[x],              If[c5 <= x < c6, t4[x],               If[c6 <= x < c7, u4[x],                If[c7 <= x < c8, v4[x], w4[x]]]]]]]]]];          GraphicsRow[{Show[Plot[y1[x], {x, 0, 1}],         PlotRange -> {{0, 1}, {0, 1}}],        Show[Plot[z1[x], {x, 0, 1}], PlotRange -> {{0, 1}, {0, 1}}]},       ImageSize -> {Large}]     GraphicsRow[{Show[Plot[y2[x], {x, 0, 1}],         PlotRange -> {{0, 1}, {0, 1}}],        Show[Plot[z2[x], {x, 0, 1}], PlotRange -> {{0, 1}, {0, 1}}]},       ImageSize -> {Large}]     GraphicsRow[{Show[Plot[y3[x], {x, 0, 1}],         PlotRange -> {{0, 1}, {0, 1}}],        Show[Plot[z3[x], {x, 0, 1}], PlotRange -> {{0, 1}, {0, 1}}]},       ImageSize -> {Large}]     GraphicsRow[{Show[Plot[y4[x], {x, 0, 1}],         PlotRange -> {{0, 1}, {0, 1}}],        Show[Plot[z4[x], {x, 0, 1}], PlotRange -> {{0           , 1}, {0, 1}}]}, ImageSize -> {Large}]


Ways to access lists inside lists

I have gone through some reference material but I am not getting really good links that will help me grow understanding of `pure functions,patterns and list manipulations combined together`. Most of the examples referred in documentation are for single list(without sublists). For example, say from a list I wanted to pick first element of every sublist, say,`fi = FactorInteger[12]`so I used               Table[fi[[i, 1]], {i, 1, Length[fi]}]      I try to do everything with `Table`. Though it should be achievable via other simple ways too. Can someone please put some examples where one can get to learn how to access data from lists of sublists and how to decompose it. This might sound pretty trivial to lot of people but I couldn't find books and links either that can give insight into combining these Mathematica features together.


Using ImplicitRegion to define an ellipse around Multinormal distribution for integration

I have both a 2D 'MultinormalDistribution', and also a single xy point, and I would like to be able to calculate the probability of this point (given the multinormal distribution) and also plot an ellipse with the same probability as this point around the mean of the distribution. So far I have defined the Multinormal (xy) distribution like:               bvn = MultinormalDistribution[{-3.89764, 1.29137}, {{0.08369444426^2, 0}, {0, 0.0175124^2}}]      I also have the fixed point in this xy plane, at -3.98529, 1.30482. Previously (thanks to help from users ubpdqn and Karsten 7 in a previous question) I approached this by essentially doing two-tailed Gaussian integrals in both of the normal distributions that make up the multinormal distribution, which gave me the probability inside a square, represented visually with:               Plot3D[PDF[bvn, {x, y}], {x, -4.5, -3.5}, {y, 1.2, 1.4}, PlotRange -> All,    MeshFunctions -> {#1 &, #2 &}, Mesh -> {{xl = -3.98529, xu = -3.80999}, {yl = 1.27792, yu = 1.30482}}]      ![enter image description here](http://i.stack.imgur.com/aR3CB.png) I realize now that this square isn't exactly what I want, and instead I want to define an ellipse of constant probability around the mean, consistent with this xy point. ubpdqn suggested several approaches to performing the integration in the square, including:               NIntegrate[PDF[bvn, {x, y}], {x, xl, xu}, {y, yl, yu}]      and:               reg = ImplicitRegion[xl < x < xu && yl < y < yu, {x, y}]      NIntegrate[PDF[bvn, {x, y}], {x, y} \[Element] reg]      I have attempted to modifiy this implicit region such that it becomes an ellipse centered on the mean of the multinormal distribution (-3.89764, 1.29137), and bounded by the xy point like this:               xl = -3.98529;     yl = 1.27792;     xc = -3.89764;     yc = 1.29137;     reg2 = ImplicitRegion[((x - xc)^2/xl^2) + ((y - yc)^2/yl^2) == 1, {x,y}];     NIntegrate[PDF[bvn2, {x, y}], {x, y} \[Element] reg2]      Although this isn't yielding a sensible answer so it is clear to me that I'm doing something wrong. If anyone could suggest a modification to my approach I would be very grateful.


How do I constrain variables to a user-defined domain in ArgMax?

I am trying to `ArgMax` a function over `x`, but `x` is only defined between `[0,1]` How do I do that? I have tried:               ArgMax[f1[x], x ∈ [0,1]]      But it gave me an error. "{x}[Element]" cannot be followed by "[0,1]".


How can I generate a legend for a BubbleChart?

Is there a way to make a nice disk radius legend (with linear or log scale) for a BubbleChart[]? Something like the following example should be built in! ![enter image description here](http://i.stack.imgur.com/4hNYK.png)


An recurrence equation that can be solved in version 7 but not in version 8

A friend of mine showed me this code sample:               RSolve[{a[n] == a[n - 5] + 1, Sequence @@ Table[a[i] == 1, {i, 5}]}, a[n], n] // Timing      It's solved by version 7 in about 40s, while in version 8 it keeps running for more than 10 minutes… is it a bug?


How to change FieldSize to be the same as dropdown menu width in PopupMenu?

I've tried the following code to change the `FieldSize` but I can't make it equal the actual value of `MenuSize` and I tried to remove first `Delimiter` but I can't.               ActionMenu["PopupMenu",       Flatten@Table[{Delimiter, lable1}, {ittration3, 1, 3}],       Appearance -> "PopupMenu", Enabled -> True,       Background -> RGBColor[0.235, 0.486, 0.768], FieldSize -> 6]      And please tell me how to change the background color of the field.


How to use this Lorentzian function fit my data, I tried NonlinearModelFit, it always resulted with an error

The data is uploaded to Ideone http://ideone.com/ktIbVk , my code is :               data = ReadList["-10dBm.txt", {Number, Number}];     model = a/((b - f)/c)^2 + d;     result = NonlinearModelFit[data, model, {a, b, c, {d, 0}}, f];     result1 = result["ParameterTable"];     fitplot1 = plot[result[f], {f, 4.124, 4.133}];      the error is :               NonlinearModelFit::cvmit:     Failed to converge to the requested accuracy or precision within 100 iterations      Any ideas?


How can I remove edges from my DiscretePlot?

By default, `DiscretePlot` displays "edges" along the sides and, prominently, align the top when `ExtentSize -> Full` is set. For example               DiscretePlot[{0.0273981, 0.0161957, 0.0164603, 0.0200524, 0.0235201,         0.0291751, 0.0203139, 0.00744914, 0.0206204, 0.0215697, 0.0841179,         0.0243641, 0.0200671, 0.0262562, 0.0268045, 0.0398572, 0.030682,         0.0279297, 0.0266079, 0.0303529, 0.0301269, 0.030297, 0.0111498,         0.0292085, 0.0334679, 0.0300855, 0.0264582, 0.0237181, 0.0287921,         0.0267715, 0., 0.0278168, 0.0267868, 0.0206096, 0.0223239,         0.0178952, 0.00802177, 0.020115, 0.0227009, 0.0238601}[[x]], {x, 1,        40}, PlotRange -> Full, ExtentSize -> Full, PlotStyle -> Gray]      produces ![](http://i.stack.imgur.com/XQOdC.png) How can I eliminate these features so that the bars are colored and shaded evenly throughout.


How can I control the behavior of a Manipulate with check boxes and radio buttons?

I've been stuck for a long time on this problem, and I really would appreciate if somebody helps me move in the right direction. I have two functions and each can take one of two forms. I am interested in seeing the sum of these functions. I would like to see a single plot all the time instead of the configuration I show in the code posted below. I want two checkboxes (one for AU and one for TU. If one of these boxes is checked, then I want to be able to choose with radio buttons which form (AU1 or AU2) is plotted. So my `Manipulate` should have two check boxes and beneath of each two radio buttons. The plot should always show the functions if both check boxes are checked. For example, if AU1 and TU2 are checked, I want to see AU1 + TU2, but if TU is not checked, I only want to see AU1. The radio buttons select which form of of AU or TU is used to form the sum when both functions are checked. Is my problem with `Control@...`? I tried things like:               Style[Control@{{x, 1, ""}, {3 -> "AU1", 1 -> "AU2"}, ControlType -> RadioButtonBar}, Blue]       but that didn't get me anywhere. I think there are two things:   1. I need to rethink the structure I built with `If` expressions.   2. I need to know how to build a structure with checked check boxes being able to enable and disable radio buttons. Here is my code and an image:                Manipulate[         Show[          If[f11, {Plot[ ( Exp[-p]), {p, 0, 1},             PlotStyle -> {Thickness[0.006], Red}, PlotPoints -> 200,             AxesLabel -> {p, U}]}, {}],          If[f12, {Plot[ (3 *p), {p, 0, 1},             PlotStyle -> {Thickness[0.006], Red}, PlotPoints -> 200,             AxesLabel -> {p, U}]}, {}],           If[f21, {Plot[ (-4) (p - 3), {p, 0, 1},             PlotStyle -> {Thickness[0.006], Green}, PlotPoints -> 200,             AxesLabel -> {p, U}]}, {}],           If[f22, {Plot[3, {p, 0, 1}, PlotStyle -> {Thickness[0.006], Green},             PlotPoints -> 200,            AxesLabel -> {p, U}]}, {}],          If[f41, {Plot[  Exp[-p] + (-4) (p - 3), {p, 0, 1},             PlotStyle -> {Thickness[0.006], Orange}, PlotPoints -> 200,             AxesLabel -> {p, U}]}, {}],          If[f42, {Plot[ (3 *p) + (-4) (p - 3), {p, 0, 1},             PlotStyle -> {Thickness[0.006], Orange}, PlotPoints -> 200,             AxesLabel -> {p, U}]}, {}],          If[f51, {Plot[( Exp[-p]) + 3 , {p, 0, 1},             PlotStyle -> {Thickness[0.006], Blue}, PlotPoints -> 200,             AxesLabel -> {p, U}]}, {}],          If[f52, {Plot[ (3 *p) + 3, {p, 0, 1},             PlotStyle -> {Thickness[0.006], Blue}, PlotPoints -> 200,             AxesLabel -> {p, U}]}, {}],        PlotRange -> All, ImageSize -> 450],             {{f11, False, Style["(AU_1)", 12, Bold, Red]}, {True, False}},        {{f12, False, Style["(AU_2)", 12, Bold, Red]}, {True, False}},        {{f21, False, Style["(TU_1)", 12, Bold, Green]}, {True, False}},        {{f22, True, Style["(TU_2)", 12, Bold, Green]}, {True, False}},        {{f41, True, Style["(AU_1 + TU_1)", 12, Bold, Orange]}, {True,False}},        {{f42, False, Style["(AU_2 + TU_1)", 12, Bold, Orange]}, {True,False}},        {{f51, False, Style["(AU_1 + TU_2)", 12, Bold, Blue]}, {True, False}},        {{f52, False, Style["(AU_2 + TU_2)", 12, Bold, Blue]}, {True, False}},             AppearanceElements -> "ResetButton",        ControlPlacement -> Left]      ![](http://i.stack.imgur.com/l1hj6.png)


How can I change a list to a sequence without destroying nested list

I defined a function `f` like               f[x___, y_] := something;      and if `x`s and `y` are all number, when I use this function, I would input like this:               f[1, 5, 3, 6, 3]      For this, `x = Sequence[1, 5, 3, 6]` and `y = 3`. Suppose that I have a list `l = {1, 5, 3, 6}`. Then I might use `f` like               f[l /. List -> Sequence, 3]      using `ReplaceAll` to convert `List` to `Sequence`. It is very good way to convert I think. But, the problem is, when I want to input               f[1, {5, 3}, 6, 3]      which is given by `l = {1, {5, 3}, 6}`, if I use `/.`, `ReplaceAll`, `{5, 3}` is also converted into the sequence so the whole input becomes `f[1, 5, 3, 6, 3]`, not `f[1, {5, 3}, 6, 3]`. I have searched several alternative functions like `Replace` which includes a `levelspec` option. But `Replace` can not convert `List`. How can I convert without loss of inside lists?


Time-efficient creation of matrix

I have expressions like               xx1=FF[1, 1] GG[1, 1] + FF[1, 1] GG[2, 2] + FF[2, 2] GG[2, 2]     xx2=2*FF[1, 2] GG[1, 1] + FF[1, 1] GG[1, 2] + FF[2, 2] GG[2, 2]      and I want to transform it to special matrices               CreateMatrix[xx1] (* {{1, 1}, {0, 1}} *)     CreateMatrix[xx2] (* {{0, 1, 0}, {2, 0, 0}, {0, 0, 1}} *)      The logic of `CreateMatrix` is that we construct a grid like this (here using elements from `xx1`):               {{FF[1, 1] GG[1, 1], FF[1, 1] GG[2, 2]},       {FF[2, 2] GG[1, 1], FF[2, 2] GG[2, 2]}}      and if say `FF[1,1] GG[1,1]` exists in the expression then its coefficient takes the place of `F[1,1], GG[1,1]` in the grid. Elements that exist in the grid but not in the expression are taken to be zero. My code works, but is slow (it runs a double-for-loop to fill the matrix):               CreateMatrix[state_] := (       ElementsFF = Union[Cases[state, _FF, {0, Infinity}]];       ElementsGG = Union[Cases[state, _GG, {0, Infinity}]];       MatrixSize = Length[ElementsFF];       startTime = AbsoluteTime[];       If[MatrixSize > 0,        dM = IdentityMatrix[MatrixSize];        For[k = 1, k <= MatrixSize, k++,         For[l = 1, l <= MatrixSize, l++,           dM[[k, l]] = state /. {ElementsFF[[k]]*ElementsGG[[l]] -> 1};           ];         ];        Block[{FF}, FF[__] = 0; dM = dM];        Print["After MatrixConstr: " <> ToString[AbsoluteTime[] - startTime]];         startTime = AbsoluteTime[];,        dM = 0;        ];       Return[dM];       )          xx1= FF[1, 1] GG[1, 1] + FF[1, 1] GG[2, 2] + FF[2, 2] GG[2, 2]     CreateMatrix[xx1]      A small part of the code is already optimized from an earlier partial question. > Can you create a faster algorithm for the given problem? **Comparison** I test with three huge matrices (those which I need later). _My original approach_   * {136.7564571, 51.4342097, 20.0780016} seconds _kguler's solution_   * {123.7996434, 46.8804843, 19.1074500} seconds _Mr.Wizard's solution1_   * {123.3144573, 47.5587309, 18.2832670} seconds _Mr.Wizard's solution2_   * {0.0510345, 0.0315209, 0.0255171} seconds (!!!)


Manipulate crashes after running 4 minutes

The following code generates the familiar 3D-plot:                   Manipulate[      Plot3D[Sin[x a] - Cos[y ], {x, -10, 10}, {y, -10, 10},        ColorFunction -> "TemperatureMap"], {a, -2, 2, 0.1}]      However approximately 4 minutes after pressing the play-button, Mathematica 10.0.0 crashes. I noticed the memory usage increased to about 3GB and then crashed. (I run on a MacBook Pro 2.6 GHz, 16 GB) Can anyone replicate this problem ?


Can TemporalData be used as a container for TimeSeries and TimeSeries Metadata

When I create two `TimeSeries` with some `MetaInformation` I can combine them into one `TemporalData` object. But I lose the `MetaInformation` for the `TimeSeries` objects.               ts1 = TimeSeries[{{1, 2}, {2, 5}, {3, 7}, {4, 3}}, MetaInformation -> {"signaalnaam" -> "CR1HAH90", "Eenheid" -> "m^3"}]     ts2 = TimeSeries[{{1, 4}, {2.5, 2}, {4, 4}}, ResamplingMethod -> {"Interpolation", InterpolationOrder -> 0}, MetaInformation -> {"signaalnaam" -> "CR1HAH98", "Eenheid" -> "m^2"}]          td = TemporalData[{ts1, ts2}]      In `td` the `MetaInformation` of `ts2` is gone. Is this by design?


Obsolete AstronomicalData - how to convert to PlanetData

As of _Mathematica_ version 10, `AstronomicalData` is obsolete, deprecated in favor of `PlanetData`, `CometData`, `MinorPlanetData`, `PlanetaryMoonData`, `ExoplanetData`, `StarData`, `GalaxyData`, `NebulaData`, `PulsarData`, and friends. (It still works, but who knows how long for?) There are also many other changes, such as units/quantities, and DateObjects, which I'm struggling with for the first time. How would I update code like this:               Table[AstronomicalData["Jupiter", {"Declination", x}],         {x, DayRange[{2014, 1, 1}, {2014, 1, 31}]}]      to produce a series of simple numbers, because in version 9, this code produced this:               {22.5875, 22.6058, 22.6241, 22.6423, 22.6603, 22.6782, 22.6960,       22.7136, 22.7310, 22.7483, 22.7653, 22.7822, 22.7988, 22.8152,       22.8314, 22.8474, 22.8631, 22.8785, 22.8937, 22.9086, 22.9233,       22.9377, 22.9518, 22.9656, 22.9791, 22.9924, 23.0053, 23.0179,       23.0302, 23.0422, 23.0539}      So far, using version 10 I've managed to get as far as this:               Table[PlanetData["Jupiter",         EntityProperty["Planet",             "Declination", {"Date" -> DateObject[x]}]],         {x, DayRange[{2014, 1, 1}, {2014, 1, 31}]}]      but it still produces a list of things which don't look or act like numbers: ![odd output](http://i.stack.imgur.com/8pbS0.png)


Result of Integrate depends on order of integration although the domain is rectangular

The following:               Mass/(2 J)       Integrate[(-2 Rotation (r^2 (r - Mass) (1 - 3 Cos[θ]^2) - Rotation^2 (r Cos[θ]^2 (3 - Cos[θ]^2) -        Mass (1 + Cos[θ]^2) (2 - Cos[θ]^2))))/(r^2 + Rotation^2 Cos[θ]^2)^2 Sin[θ], {r, r1, ∞}, {θ, 0, π},        Assumptions -> r1 > 0 && Rotation >= 0 && Mass > 0]      yields > >     (1/(6 J r1^2 Rotation^2))Mass (r1 Rotation (12 r1^3 + >     8 r1 Rotation^2 - 3 Mass (6 r1^2 + π r1 Rotation + 2 Rotation^2)) + >     6 Mass r1^2 Rotation^2 ArcTan[r1/Rotation] + 6 (-2 r1^3 (r1^2 + > Rotation^2)+ >     Mass (3 r1^4 + 3 r1^2 Rotation^2 - Rotation^4)) ArcTan[Rotation/r1]) >   in v.9.0.1 and > >     (1/(6 J r1^2 Rotation^2))Mass (2 r1^2 (6 r1^2 Rotation + 4 Rotation^3 - > 3 π r1 (r1^2 + Rotation^2)) + >     3 Mass (-2 r1 Rotation (3 r1^2 + Rotation^2) + π (3 r1^4 + 2 r1^2 > Rotation^2 - Rotation^4)) + >     6 (r1^2 + Rotation^2) (2 r1^3 + Mass (-3 r1^2 + > Rotation^2))ArcTan[r1/Rotation]) >   in v.10.0.0. If I switch the order of integration, v.9.0.1 says that the integral diverges and v.10.0.0 does not return after tens of minutes. Numerical integration indicates that this integral converges. According to Fubini's theorem, the order of integration should not matter for rectangular domain. Why does the result depend on the order of integration? This is related to Mathematica 10 fails to calculate integral that Mathematica 9 can handle. In that case, Mathematica 10 fails to calculate the integral unless I change the order of integration. In this case, the result is wrong if I change the order of integration.


How can I prevent kets to from growing too large?

In `TraditionalForm`, _Mathematica_ formats kets incorrectly in certain expressions. For example, if used in a summation with indices indicated, a ket becomes too "tall" (red) compared to the rest of the expression: ![see the big ket](http://i.stack.imgur.com/qUDhK.png) Is there a way to prevent this gigantism? * * *               Cell[BoxData[      FormBox[       RowBox[{        RowBox[{         RowBox[{          RowBox[{           RowBox[{            RowBox[{             RowBox[{              RowBox[{"\[LeftBracketingBar]", "\[Psi]"}], "\[RightAngleBracket]"}], "=",              RowBox[{              SubscriptBox["\[Delta]", "0"],               RowBox[{"\[LeftBracketingBar]",                SubscriptBox["d", "0"]}]}]}], "\[RightAngleBracket]"}], "+", "\[Ellipsis]", "+",            RowBox[{            SubscriptBox["\[Delta]",              RowBox[{"N", "-", "1"}]],             RowBox[{"\[LeftBracketingBar]",              SubscriptBox["d",               RowBox[{"N", "-", "1"}]]}]}]}], "\[RightAngleBracket]"}], "=",          RowBox[{          UnderoverscriptBox["\[Sum]",            RowBox[{"i", "=", "0"}],            RowBox[{"N", "-", "1"}]],           RowBox[{           SubscriptBox["\[Delta]", "i"],            RowBox[{"\[LeftBracketingBar]",             SubscriptBox["d", "i"]}]}]}]}],         StyleBox["\[RightAngleBracket]",         FontColor->RGBColor[1, 0, 0]]}], TraditionalForm]], "DisplayFormula"]


Revolution plot with 2 variable

I'm having trouble with RevolutionPlot3D with two variables. I have this parabola                ContourPlot[0 == y^2 + x + y + 5, {x, -15, 5}, {y, -10, 10}, AxesLabel -> {x, y, z}]      but when I try to do RevolutionPlot3D with the equation               RevolutionPlot3D[{(y^2 + y + x + 5)}, {y, -5, 5}, {x, -5, 5},                      RevolutionAxis -> {1, 0, 0}, PlotRange -> All, AxesLabel -> {x, y, z}]      it won't work, because x should be an Theta. How can I have something similar to               RevolutionPlot3D[{(y^2 + y + 5)}, {y, -5, 5}, {\[Theta], 0, 2 \[Pi]},                       RevolutionAxis -> {1, 0, 0}, PlotRange -> All, AxesLabel -> {x, y, z}]      with a second variable?


Play in Linux causes mathematica to freeze

It seems that when I run `Play` in Mathematica, something as basic as               Play[Sin[440 * 2 π * t], {t, 0, 1}]      the output generates correctly. However, when I actually hit the sideways triangle to play the sound, the user interface freezes, and I have to kill Mathematica. This isn't an issue where everything works but the sound doesn't play. It freezes and I have to kill the program. I tried emulating OSS using ALSA by running `aoss mathematica` (I have `alsa- oss` installed.) The sound still didn't play, but several errors appear on standard out/error:               ALSA lib pcm.c:2239:(snd_pcm_open_noupdate) Unknown PCM cards.pcm.rear     ALSA lib pcm.c:2239:(snd_pcm_open_noupdate) Unknown PCM cards.pcm.center_lfe     ALSA lib pcm.c:2239:(snd_pcm_open_noupdate) Unknown PCM cards.pcm.side     bt_audio_service_open: connect() failed: Connection refused (111)     bt_audio_service_open: connect() failed: Connection refused (111)     bt_audio_service_open: connect() failed: Connection refused (111)     bt_audio_service_open: connect() failed: Connection refused (111)     ALSA lib pcm_dmix.c:961:(snd_pcm_dmix_open) The dmix plugin supports only playback stream      **Does anyone know how I can get my sound to play in Mathematica 9.0.1, given that I tried emulating oss in alsa and it still doesn't work? Thanks.** Note: I'm looking for a solution that makes Mathematica compatible with notebooks someone sends me. I found solutions that use `$SoundDisplayFunction` to play the sound using alsa rather than display a sound dialog, but this doesn't work for notebooks I receive from people with working sound.


Does Mathematica compute free-form-input on Wolfram servers?

I've just started to use _Mathematica_ and I'm using the free-form input a lot. The computation time for simple problems seems to take a lot of time and my CPU isn't really used at all. I first thought that the f-f-input would be transferred to a Wolfram server, converted into the _Mathematica_ programming language and computed on my PC. Is that really the case? I didn't find anything about this on the _Mathematica_ website and I'd like to know how that and Wolfram Alpha-queries in _Mathematica_ 9 works.


Define a second name for a function

I'm working with an own package of functions. During development I noticed, that my naming scheme is not that clever; for example some of my functions are starting with capital letters. But I have several files working with that package, that I would like to be able to use further on with as few as possible. So my idea is, to write a small package named `loadOldNams`or something like that, providing the old function names additionally. Therefore I'm facing the following problem: Having a function with my new name - for simplification just `f`, e.g.               f[x_] := x^2;     f[x_, y_] := x^2 y^2;     f::usage = "A test usage text";      I would like to define a function having the old name (say `g`), such that all cases 'g[x], g[x,y]`and the`::usage`also work with`g`. Just `f=g;` or `f:=g;` won't work, so How do I get a function with the name `g` doing exactly the same as `f` (just having another name)?


How to export and import Graphs with additional data?

I'm trying to export and then later import graphs with additional data added such as `VertexLabels` and `EdgeLabels`. When I export a graph, such as the following, and then import it, I find that some information has been lost.               g=Graph[{1->2,2->3,3->1},VertexLabels->"Name",VertexStyle->Purple,VertexShapeFunction->"Diamond"];     Export["graph.gml",g];     r=Import["graph.gml"]      This will maintain some of the options, e.g. `VertexShapeFunction` and `VertexStyle`, but will lose `VertexLabels`.               PropertyValue[r,VertexLabels]      The above returns `{}`,showing that the data was not retained. I have tried .graphml and .gxl formats as well, with the same issues.               Import["graph.gml",{{VertexLabels}}]      The above returns the following error:               Import::noelem: The Import element "VertexLabels" is not present when importing as Graphlet. >>      What is the best way to export and then import graphs while retaining all additional data?


Solve 1-D function that has 2-D interpolating functions

I need some helps on NDSolve. Here are my equations:               k1 = 0.000192;     k2 = 0.000159;          Clear[x, y, z, h]     eqnf1 = {x'[t] == -k1*x[t]*y[t]/h[t] + k2*z[t],        y'[t] == 3*(-k1*x[t]*y[t]/h[t] + k2*z[t]),        z'[t] == k1*x[t]*y[t]/h[t] - k2*z[t],        h'[t] == -3*(-k1*x[t]*y[t]/h[t] + k2*z[t]),        x[0] == .001, z[0] == 0, y[0] == 0.2, h[0] == .001};          sol2 = NDSolve[eqnf1, {x, y, z, h}, {t, 0, 1000}][[1]]          X[t_] = x[t] /. sol2;     Y[t_] = y[t] /. sol2;     Z[t_] = z[t] /. sol2;     H[t_] = h[t] /. sol2;      I used this part to solve y[t], which will be using later for my other function. And here is 2nd part of my function:               Da = 1.33*10 - 4;     eqnm1 = {D[yc[x, t], {t, 1}] ==          Da* D[ D[yc[x, t], {x, 1}], {x, 1}] ,        yc[x, 0] == 0,         yc[0, t] == Z[t], (D[yc[x, t], {x, 1}] /. x -> 1) == 0};     solmem1 =       First[yc /. NDSolve[eqnm1, yc, {x, 10^-20, 1}, {t, 0, 1000}]]      Here I obtained another interpolating function, yc[x,t], which will be used in the last part of the problem that I'm not able to solve. The last part of the problem needs function from the 1st and 2nd parts - y[t] & yc[x,t] which both are interpolating functions. And the 3rd part is only 1D function, which is xs[t]. I tried               eqns1 = {xs'[t] == -k1*xs[t]*First[Evaluate[y[t] /. eqnf1]]/hs[t] +           k2*First[Evaluate[yc[x, t] /. x -> 1 /. solmem1]],        hs'[t] == -3*(-k1*xs[t]*First[Evaluate[y[t] /. eqnf1]]/hs[t] +             k2*First[Evaluate[yc[x, t] /. x -> 1 /. solmem1]]),        xs[0] == 0, hs[0] == 1};      But it has some errors that I think is caused by the 2nd part of the problem that is 2-D (ys[x,t]). Does anyone know how to solve xs(t) and hs(s)? TThanks


Extract desired solutions from Reduce

I have the function               a = 1 - 3 Sin[theta]^2 Cos[phi]^2;      which I solve for 'phi' when $a=0$               sol = Reduce[a == 0, phi]      which gives me the result ![](http://i.stack.imgur.com/x1Om6.png) How do I turn this output into a nice list of results for desired values of C[1], much like Solve[ ] would give me, so that I can use Plot[ ] and visualise the functions?


Highlighting Mathematica code in LaTeX document

I was thinking about the best way to include Mathematica code in a LaTeX document with a nice syntax highlighting. I have tried the packages listings and minted (with pygments), which both claim to include Mathematica syntax highlighting. There is also a separate Mathematica lexer for pygments on github. Having looked at the output from these packages, I'm not entirely happy. I was hoping to obtain a result resembling as closely as possible Mathematica's native syntax highlighting or the highlighting used here on mma.SE (is that halirutan's prettify extension?) My question is: What are users' preferred ways to include Mathematica code in LaTeX files that preserve syntax highlighting?


Protecting function definitions only for particular inputs

I would like to be able to define the values of a particular function for new inputs.               f[x1]=f1;     f[x2]=f2;      I would also like to be able redefine the values for most inputs.               f[x1]=f3;     f[x2]=f0;      But there are certain definitions I would like to protect.               f[x0]=f0;      Protect[f] protects all definitions and prevents me from defining the values for new inputs. I could set/remove/set the Protected attribute for f but that isn't any fun because there are very few definitions I would like protected, and many that get defined and redefined. My other thought would be to modify Set:               Unprotect[Set]     f::fixeddef="The definition of f for this value cannot be modified"     Set[f[x0],_]:=(Message[f::fixeddef]; $Failed)     SetAttributes[Set,Protected]      This doesn't completely work though:               f[x0]=f1 (* fails appropriately *)     {f[x0],f[x1]}={f3,f4} (* returns {f3,f4} instead of {f0,f4} *)      I assumed Set threads itself over nested lists, recursively calling Set until the lhs is a Symbol, but apprently I assumed wrong. How does Set work and how can I protect the function definitions only for particular inputs?


hyperlink in label

In a `FrameLabel` for `Manipulate`, I would like part of the string to be a hyperlink. Is this possible? I have tried various things (e.g. insert hyperlink, and the Hyperlink function) but nothing has worked.


How to control frame thickness in Grid object exported to .pdf?

I would like to export a _Grid_ object to a .pdf document (preferably as part of a notebook). Here's an example:               data = Notebook[        {Cell[          BoxData[           ToBoxes[            Grid[             {              {11, 22},              {33, 44}              },             Frame -> All,             FrameStyle -> Directive[Thickness[.1], Orange]             ](* end of Grid *)            ]           ]          ](* end of Cell *)         }];          Export[NotebookDirectory[] <> "grid.pdf", data];     SystemOpen[NotebookDirectory[] <> "grid.pdf"];      However, setting thickness of a grid in _FrameStyle_ has little to do with the outcoming table (only the upper line is ok). I've encountered a similar problem concerning _Dividers_ here: How to fix a PDF line rendering problem in V9 They say it's a bug appearing in MMA9 only (MMA8 is free of this problem. Sadly, it's not the version I get to use). Possible solution would be to export a _Notebook_ to .eps first, and then convert it to .pdf, which works for simple examples, however there are two reasons I can't use it. First - as I try to export my _Notebook_ to .eps, Mathematica crashes and quits to Windows (i use XP 32bit SP3). Secondly - I'd very much appreciate, if using programs other than MMA could be avoided. Is there another way of exporting a _Notebook_ to .pdf? Or meybe there's some unknown global option which can prevent aliasing? I will be grateful for any help. PS The thickness is broken only in .pdf - the notebook looks ok.


Difficulty finding Expectation of a special function

I have a special function given as: $${\rm f}\left(r\right) ={1 \over \beta\lambda}\,2^{r/\beta} \exp\left({\left[2^{r/\beta} - 1\right]K \over \lambda}\right)$$ I should find the Expectation of the random variable $r$. Mathematica was not able to solve the associated Integral function. So it returns: $$ \int_0^{\infty}\left\\{{1 \over \beta\lambda}\,2^{r/\beta} \exp\left({\left[2^{r/\beta} - 1\right]K \over \lambda}\right)\right\\}\ r\,{\rm d}r $$ Does anyone recognize how I can reduce this function so I can solve it further? ==== Edit ===== This is the code I tried:               Integrate[ r*fr, {r, 0, \Infinity}, Assumptions->{K>=1, \lambda >=0, \beta >=0}]


Strange result using NIntegrate with Max and PDF

This is really trivial and I appologise in advance if I have made a stupid error somewhere. I have been chasing down some strange results when using `NIntegrate` with integrands involving `Max` and `PDF`. A simple example follows.               f[x1_, x2_] := PDF[MultinormalDistribution[{0, 0}, {{1, .5}, {.5, 1}}], {x1, x2}];     NIntegrate[Max[Exp[x1] + Exp[x2] - 3, 0] f[x1, x2],      {x2, -Infinity, Infinity}, {x1, -Infinity, Infinity}]      This gave the answer 0.804628. However, when I tried MATLAB I got 1.2255. So I then used Monte Carlo.               Block[{rho = 0.5, data, rv1, rv2, paths = 1000000, sum, sumSquared, mean, var, stdError},      data = Table[        rv1 = Random[NormalDistribution[0, 1]];        rv2 = rho rv1 + Sqrt[1 - rho^2] Random[NormalDistribution[0, 1]];        Max[Exp[rv1] + Exp[rv2] - 3, 0], {i, paths}];      sum = Total[data];      sumSquared = Total[data^2];      mean = sum/paths;      var = (sumSquared/paths - mean^2) paths/(paths - 1);      stdError = Sqrt[var/paths];      {mean, stdError}     ]      One run of this gave {1.22509, 0.0031105}, agreeing with the MATLAB result. I have also noticed that if I replace `Max[Exp[rv1] + Exp[rv2] - 3, 0]` with `Exp[rv1] + Exp[rv2] - 3` the issue does not arise. Any idea what is going on here?


Whats Mathematica exactly is?

Is it a software to learn mathematics and programing? Or what? Sorry for my ignorance and my English. I'm not clear about what is.


Fourier Transform Help

I'm trying to do a Fourier Transform of the following Data, but I'm completely stuck. Here's what I've done so far:               data = Drop[data, 1];     dat = data /. {x_, y_, z_, w_} -> {x + y/12., 10 z};     ListLinePlot[Abs[Fourier[dat]], PlotRange -> {Automatic, {0, 40}}]      I don't understand why it keeps displaying this weird plot ![enter image description here](http://i.stack.imgur.com/i28k4.jpg) Anyone have any clue what I'm doing wrong? I'm just learning this Fourier thing so I'm real lost.


Computing Smith Normal form of a matrix with mod p coefficients

I would like to compute the Smith Normal form of a matrix with coefficients in GF(p). In particular, I am interested in GF(2). I have used the Smith normal form packages for integer and polynomial matrices before. Can these be adapted to work for matrices with finite field coefficients? Is there another way to compute the Smith normal forms mod p in Mathematica?


Generating a list of cubefree numbers

I am trying to generate a list of cubefree numbers (i.e. numbers when prime factorized contain no tripled factors) within a given range. Of `DivisorSigma`, `PrimeOmega`, `Divisors`, `PrimeNu` and `FactorInteger`, `FactorInteger` seems to me to be the best suited to the task (please feel free to suggest more suitable methods). For example,               FactorInteger[630]      outputs               {{2, 1}, {3, 2}, {5, 1}, {7, 1}}      From this, I would like _Mathematica_ to focus on the second number in each pair (the exponent) and determine which has the highest value. In this case, it is `{3,2}`, indicating that `630` is a cubefree number (i.e. - having no prime factor with a greater exponent than `2`). Is it possible to do this with a range of numbers, so that _Mathematica_ evaluates each number in this way within a range, and then outputs that list of numbers?


Internal self-test error MLParseStream|c|297

I have been plotting time-dependent vectors. Earlier I used the following plotting options:               CLB4D[t_] := {CLBx[t], CLBy[t], CLBz[t], t};          tempdata = Table[CLB4D[t], {t, 0, d, (0.01/\[Omega])}];     tempdata[[All, 4]] = Rescale[tempdata[[All, 4]], {0, d}];     clrfnct[x_, cf_] := ColorData[cf][1 - x[[4]]];     Graphics3D[{PointSize[0.013],      Point[#[[1 ;; 3]], VertexColors -> clrfnct[#, "SolarColors"]] & /@      tempdata, Opacity[0.01], Sphere[{0, 0, 0}]}, Boxed -> False,      Axes -> True, AxesLabel -> {x, y, z}]      where CLB4D[t] is the vector, specifying a point in 3D-space, with a color that corresponds to a time-coordinate. The components of this vector are defined in the same module, which then plots the answer. Actually, I have several different modules with different definitions for vectors that I am comparing. It worked well, but I wished to tweak the options to get a clearer plot (changing the visual appearance wasn't just my wish, either). I am happy with the following options:               CLB4D[t_] := {CLBx[t], CLBy[t], CLBz[t], t};          tempdata = Table[CLB4D[t], {t, 0, 2*pi/f, (2*pi/f)/150}];     tempdata[[All, 4]] = Rescale[tempdata[[All, 4]], {0, 2*pi/f}];     clrfnct[x_, cf_] := ColorData[cf][1 - x[[4]]];     Graphics3D[{PointSize[0.010],      Point[#[[1 ;; 3]], VertexColors -> clrfnct[#, "SolarColors"]] & /@      tempdata, Opacity[0.5], pic[[1]], pic2[[1]]}, Boxed -> False,      Axes -> False,      PlotLabel ->      Style["text and "<>ToString[variables_from_the_module], FontSize -> 16, FontFamily -> "STIX"],       ViewPoint -> {1.14, -3.09, 0.77}]      There, pic and pic2 are parametricplot3d's of unit circles, and the coordinate axes from 0 to 1. These are always plotted as a reference. The trouble is that whenever I have any plot that takes, say, 20 minutes or an hour from the local computer to calculate (or would take in the previous style), after evaluating it for a long while, Mathematica just freezes, and most of the time I have to kill it, or it crashes. Finally, it gave me the **Self-test error MLParseStream|c|297** instead of crashing. It fails to evaluate with both Linux and Mac. I got this message on a Mac. If the plot only takes for a couple of seconds to evaluate, it manages to do this. Sometimes it has managed to evaluate a heavier plot, but will crash when I try to save .nb or export the plot as a PDF. I have no idea what goes wrong, nor have I found out what the message is about. I have not changed any other definitions in the module. I also noticed that taking away the option "viewpoint" does not remove the problem. Any suggestions? I am using version 9 of Mathematica.


Using Refresh[..] with TrackedSymbols

This is a very basic question, but I don't understand the following behavior. The usage to `Refresh` reads > represents an object whose value in a Dynamic should be refreshed at times > specified by the options opts. Although the word _times_ was mentioned explicitly the examples suggest, that `Refresh` can also be used to restrict the `TrackedSymbols` in an expression inside `Dynamic`. Here is a basic example from the help, which works like a charm               Manipulate[      {x, Refresh[y, TrackedSymbols :> {x}]},      {x, 0, 1},      {y, 0, 1}     ]      ![Mathematica graphics](http://i.stack.imgur.com/kgYGd.png) When you move the `y`-slider, nothing happens because the second expression containing `y` is restricted to keep only track of `x`. When you then move `x`, the `y` values jumps to it's current value. Now, let's extend this example a bit               Manipulate[      {Refresh[{x, y}, TrackedSymbols :> {y}],        Refresh[{x, y}, TrackedSymbols :> {x}]},      {x, 0, 1},      {y, 0, 1}     ]      What I had hoped for was, that when I move the `x`-slider, only the `x`-value in the second `{x,y}` is updated because the first `{x,y}` tracks only `y`. Equivalent for the `y`-slider. Unfortunately, all values are always updated. Solutions to this is can be found at the end of the post, but first my question: **Can someone explain what I have missed in the documentation of`Refresh` and how this is supposed to be used?** Several solutions to the toy-example can be found. The most prominent one is to wrap each `Refresh` in `Dynamic`               Manipulate[{       Dynamic@Refresh[{x, y}, TrackedSymbols :> {y}],        Dynamic@Refresh[{x, y}, TrackedSymbols :> {x}]},        {x, 0, 1},        {y, 0, 1}     ]      This goes along with the suggestion of andre's answer, when I understood him right. Further solutions are               Manipulate[      {Dynamic[{x, y}, TrackedSymbols :> {y}],        Dynamic[{x, y}, TrackedSymbols :> {x}]},      {x, 0, 1},      {y, 0, 1}     ]          DynamicModule[{},      Column@{Dynamic[{x, y}, TrackedSymbols :> {y}],         Dynamic[{x, y}, TrackedSymbols :> {x}],        Slider[Dynamic[x]],        Slider[Dynamic[y]]     }]               DynamicModule[{},      Column@{Dynamic@Refresh[{x, y}, TrackedSymbols :> {y}],         Dynamic@Refresh[{x, y}, TrackedSymbols :> {x}],        Slider[Dynamic[x]],        Slider[Dynamic[y]]     }]      This leaves the question, when I have to use `Dynamic` anyway, why does the documentation suggest `Refresh` can do this alone. I still think I'm missing something.


ToNumberField won't recognize Root as an explicit algebraic number

In _Mathematica 9.0.1_ , it appears that `ToNumberField` will not always recognize a `Root` object as an explicit algebraic number.               ToNumberField[         Root[{ 1 - #1 + #1^2 - #1^3 + #1^4 - #1^5 + #1^6 &,                 #1^5 + #1^3 #2 + #1 #2^2 + #2^3 - #1 #2^3 + #1^2 #2^3 - #1^3 #2^3 + #1^4 #2^3                - #1^5 #2^3 - #1^4 #2^4 - #1^2 #2^5 - #2^6 &},  {6, 6}] ]      > >     ToNumberField::nalg: >     "Root[{1 -#1 + #1^2 - #1^3 + #1^4 - #1^5 + #1^6&, >             #1^5 + #1^3 #2 + #1 #2^2 + #2^3 - #1 #2^3 + #1^2 #2^3 -#1^3 #2^3 > + #1^4 #2^3 >            - #1^5 #2^3 - #1^4 #2^4 - #1^2 #2^5 - #2^6 &}, {6,6}] >       is not an explicit algebraic number. >>" >   A different root of the same polynomial works just fine:               ToNumberField[         Root[{1 - #1 + #1^2 - #1^3 + #1^4 - #1^5 + #1^6 &,                #1^5 + #1^3 #2 + #1 #2^2 + #2^3 - #1 #2^3 + #1^2 #2^3 - #1^3 #2^3 + #1^4 #2^3                - #1^5 #2^3 - #1^4 #2^4 - #1^2 #2^5 - #2^6 &},  {6, 1}] ]      > >     AlgebraicNumber[Root[1 + #1 + #1^2 + #1^3 + #1^4 + #1^5 + #1^6 &, 2], > {0, 1, 0, 0, 0, 0}] >   Is this a bug, and is there any way I can work around it? **Edit** : In case it matters, that first `Root` expression will `FullSimplify` to `1`.


ContourPlot refuses to show in-figure PlotLegends after turn on ContourShading

I would like to do a contour plot with a label inside the figure. For example, the following works well. Note there is a small "example" at the right bottom figure.               ContourPlot[Cos[x] + Cos[y], {x, 0, 4 Pi}, {y, 0, 4 Pi},       PlotLegends -> Placed["example", {0.8, 0.1}]]      ![enter image description here](http://i.stack.imgur.com/QHy0b.png) However, I don't want contour shading. But after I set `ContourShading -> None`, the PlotLegends disappeared.               ContourPlot[Cos[x] + Cos[y], {x, 0, 4 Pi}, {y, 0, 4 Pi},       PlotLegends -> Placed["example", {0.8, 0.1}], ContourShading -> None]      ![enter image description here](http://i.stack.imgur.com/NlPB8.png) Would you be so kind to see if it is a bug? And is there a workaround? (I am using Mathematica 9.0.1)


Defining regions for `Exclusions`

I have the following function I want to plot in 3D (For simplicities sake we can say $a=5,b=-1,c=3$.)               f[x_, y_, a_, b_,c_] := ((E^(b x) - E^(b y)) x)/((c E^(a b) + E^(b x)) (x - y))      However, when I plot it I get error messages for Intermediate values. To try to solve this I used `Exclusions`, but despite this I still get the same error messages.               Plot3D[{f[x, y,5,-1,3]}, {x, 9, 10}, {y, 9, 10}, Exclusions -> {x - y == 0}]      I thought I should maybe exclude the values `-0.1<=x-y<=0.1`, but I don't really know how to do it or if it works. Another thought I had was maybe use the conditions that result from using reduce. However, I'm not sure how to use the results to exclude intermediate values.               Reduce[f[x, y,5,-1,3] == 0, x]      Any suggestions on other ways to do it would be greatly appreciated.


FindRoot finds a solution not found by NSolve

I am trying to solve a polynomial equation of higher order with non-integer exponents. When the order of the system is greater than 4, FindRoot provides a correct solution that is not found by NSolve. Here is a minimal example: In:               Clear[k,sol1, a, G, j, l, equ];     a=0.3; G=4;     equ := k^(G(1 - a)) == (1-a)/G Sum[(G-j+1) a^(j-1) k^((G-j)(1-a)), {j, G}];     NSolve[equ, k]     sol1 = FindRoot[equ, {k, 1}]     equ /. sol1      Out:               {{k -> -0.0654054 + 0.0537165 I}, {k -> -0.0654054 - 0.0537165 I}}     {k -> 0.881805}     True      How can that be? Thanks for any help! PS: for G<4 everything is fine, for G>4 the same problem seems to persist


References on functions FindGraphPartition and FindGraphCommunties

Does somebody have some interesting references on the `FindGraphPartition` and `FindGraphCommunties[.., Method -> "Spectral"]` functions and their algorithms as implemented by _Mathematica_ 9.


Number of complex roots for the system of polynomials

I have a system of algebraic equations. For example: $$ \left\\{ \begin{aligned} x^2 y + 2 x y + 2 &= 0,\\\ y^3 + 2 x + 1 &= 0. \end{aligned} \right. $$ (In my problem the system contains 16 equations of degrees 1–3). I need to know the number of complex roots (the system in question has a finite number of roots). I believe, the number of roots can be determined using `GroebnerBasis`. But what is the most elegant way to do it?


When I can assume that all decimal digits returned by Mathematica are provably correct?

How to Control the Precision and Accuracy of Numerical Results   Arbitrary-Precision Numbers > _Mathematica_ works with exact numbers and with two different types of > approximate numbers: machine-precision numbers that take advantage of > specialized hardware for fast arithmetic on your computer, and arbitrary- > precision numbers that are correct to a specified number of digits. > > * * * > > To be sure of `n` correct digits, use `N[expr, n]`. > > * * * > > When you do a computation, _Mathematica_ keeps track of which digits in your > result could be affected by unknown digits in your input. It sets the > precision of your result so that no affected digits are ever included. This > procedure ensures that all digits returned by _Mathematica_ are correct, > whatever the values of the unknown digits may be. > > * * * > > _Mathematica_ automatically increases the precision that it uses internally > in order to get the correct answer Of course, this sounds very reassuring, but I still have some doubts that all decimal digits ever returned by _Mathematica_ when working with arbitrary- precision numbers are always provably correct, no matter what functions I invoked. What are those cases when I can be certainly sure all displayed digits are correct? * * * _Update:_   Here is an example when some incorrect decimal digits are returned when working with arbitrary-precision arithmetic:               a = 1`7     (* 1.000000 *)          a // Precision     (* 7. *)          d = Derivative[0, 1][StieltjesGamma][0, a]     (* -1.6450 *)          MachineNumberQ[d]     (* False *)          d // FullForm     (* 1.64501552391043694947251282378009083269`5.155856939311388 *)          d // Precision     (* 5.15586 *)      So, _Mathematica_ claims that at least 5 (hence, all) decimal digits of the result `-1.6450` are correct. But in fact, the exact result is `-Pi^2 / 6` that is `-1.644934...`, so only 3 digit are correct. I am also concerned that `Precision[...]` itself returns a machine-precision number, that is subject to uncontrolled error-accumulation that possibly can result in claiming more digits of precision in a number than there actually are. Can I assume that _Mathematica_ always errs on the safe side when computing a precision? * * * _Update 2:_   Another (gross) example:               a = 2`6     (* 2.00000 *)          Derivative[0, 1][StieltjesGamma][0, a]     (* 0.324 *)          d // FullForm     (* 0.32399522609896337580027385456880978489`3.339102855094484 *)          Precision[d]     (* 3.3391 *)      Here, one would expect that at least `0.32` are correct digits. But in fact, the exact result is `1 - Pi^2/6` that is `-0.644934...`. No correct digits, even the sign is wrong.


Smooth out contour in RegionPlot/ContourPlot

I would like to smooth out the jagged edges in the outermost contours in the following plot: ![Plot with jagged edges.](http://i.stack.imgur.com/bSsYx.jpg) I have data of values as a function of variables (x,y) in the form               data = {{{x1,y1},z1},{{x2,y2},z2},...};      The figure is produced by               data = << "data.dat";     fnct = Interpolation[data];         RegionPlot[{fnct[x, y] > 2, fnct[x, y] > 100, fnct[x, y] > 140}, {x, 10^-2, 10^1}, {y, 0, 3},MaxRecursion->5]      The outer edges seem jagged I guess because the data is not very good there. I need to fit a smooth contour instead. I've looked at some other questions like Smoothing ListContourPlot contours but that uses ListContourPlot which for me takes ages and produces a bad result even for the original figure. Any help appreciated. The data can be found here: https://dl.dropboxusercontent.com/u/34796693/data.dat


Creating ODBC connection on mac

Iam not able to create a ODBC connection on mac through mathematica even though i have created a connection successfully through ODBC Administrator. The error message iam getting was: JDBC::error: ""File input/output error conHR10.properties java.io.FileNotFoundException: conHR10.properties.new (Read-only file system)". ## Problems in detail: My back end was microsoft sql server(2012) which was in a windows 8 machine. My front end was mathematica which was in MAC PRO(OS X 10.9.3). Iam trying to connect to my database through LAN. Iam able to make a connection in MAC using ODBC Administrator. But when i try to use the connection in mathematica the error above keeps coming.


How can I find the boundary function in RegionPlot?

I have a problem with finding the function that gives the boundary curve in `RegionPlot` comamnd. I use the following code to make the regions in which two inequalities are held simultaneously               RegionPlot[{{x^3 - y^2 > 2 y && x^2 + y^3 > 2 x },                  {x^3 - y^2 < 2 y && x^2 + y^3 > 2 x }}, {x, -1, 1}, {y, -1, .1},                 PlotStyle -> {Green, Yellow}, BoundaryStyle -> {Black, Thick}]      ![enter image description here](http://i.stack.imgur.com/s7XLJ.jpg) Here we see a black thick curve between the green and yellow regions, I mean the boundary that separates these regions (I showed it with a red arrow) . Now, how can I find its equation or at least the list of points living on this curve?


Conceal GUI source code

I'm working with a simple software application written in _Mathematica_ , composing of several .nb and .m files. The application is centered around a simple mathematica GUI, which includes several numerical input fields and selection options, and produces output graphs. What I wish to do is keep this GUI, but somehow hide the source code so that a user (who would access the machine remotely) cannot edit or see the algorithm producing the GUI. I know two potential options may be converting to .CDF or recompiling the mathematica code into C. I'm interested in any other possibilities, but I have two specific questions based on these options:   * Can I export multiple .m and .nb files into a single .CDF, and if so would there be any way to view the algorithms underlying the GUI?   * If I compile the mathematica code into C, would it still be able to produce a GUI?


Sketch-type graphics with transparency and dashed hidden lines?

I'd like to create transparent graphs like the following from P1095, _Calculus_ 6th Ed, by James Stewart. Can _Mathematica_ accomplish this? By "transparent," I mean the ability to see the interior, intersection, boundaries etc. preferrably with dashed hidden lines. ![enter image description here](http://i.stack.imgur.com/GL2Pl.jpg) Would someone please explain how to do this for a function like \begin{cases} (4 - z^2) = x^2 + y^2, 2 \le z \le 4 \\\ x^2 + y^2 = 4, -2 \le z \le 2 \end{cases} http://reference.wolfram.com/mathematica/howto/AddTransparencyToPlots.html doesn't appear to be very helpful in that respect.


Plotting solutions of differential equations with different parameters

I want to plot x[t], when i manipulate w from 0.1 to 1.5. Here is what I've attempted, which does not work as expected.               c = 0.05; f = 0.7;     diffeq = {x''[t] + c x'[t] + Sin[x[t]] + F Cos[w t] == 0};     inicond = {x'[0] == 0, x[0] == 1};     eqnlist = Join[diffeq, inicond];     soln := NDSolve[eqnlist, x, {t, 0, 10}]     Manipulate[                 Plot[Evaluate[{x[t] /.soln}, {t, 0, 10}], PlotRange ->All, AxesLabel-> {t, x}],                {w, 0.1, 1.5, 0.1}]      What is the appropriate way to plot the numerical solution of a differential equation while varying a parameter?


Animating moving surface of torus

I would like to try to recreate something similar to Paolo Čerić's torus animation: ![](http://www.thisiscolossal.com/wp-content/uploads/2013/01/3.gif) I have isolated the moving surface torus section form this Wolfram Demonstration by Kevin Sonnanburg:               t = s; s = .001; θ = 0; Manipulate[     Show[{ParametricPlot3D[{Cos[u] (3 + Cos[t]), Sin[u] (3 + Cos[t]),      Sin[t]}, {u, Cos[θ] s - .5 + a,      Cos[θ] s + .5 + a}, {t, Sin[θ] s - .5 + b,      Sin[θ] s + .5 + b}, PlotPoints -> 4, PlotStyle -> Red,      PerformanceGoal -> "Quality", PlotPoints -> 6, Axes -> None,      Boxed -> False, Mesh -> None, PlotRange -> 4],      ParametricPlot3D[{Cos[     a + v Cos[θ]] (3 + Cos[b + v Sin[θ]]),      Sin[a + v Cos[θ]] (3 + Cos[b + v Sin[θ]]),      Sin[b + v Sin[θ]]}, {v, 0, s}, PlotPoints -> 20]},      PlotRange -> 4, ImageSize -> {200, 200}, ViewAngle -> π/10],     {{a, π, "shift X"}, 0, 6 π},     {{b, π, "shift Y"}, 0, 6 π},     AutorunSequencing -> {2, 3, 4}, SaveDefinitions -> True]      and have tried to apply a texture to the section, and extend it over the whole torus, but haven't made as much progress as I'd hoped.


Exporting data extensions in fits file

**Context** In Astronomy the de facto standard for images and data is FITS. I would like to export heterogenous data sets into a single fits file. **Attempt** I am interested in exporting into a fits file some data, say.                dat = Table[i, {i, 5}]      (* {1,2,3,4,5} *) and additionally some metadata, say a range of $\nu$s:                rnus = ("nu" <> ToString[#] -> 0.5 + # & /@ ( Range[5]))      (* {nu1->1.5,nu2->2.5,nu3->3.5,nu4->4.5,nu5->5.5} *) Following closely the documentation I can write:                Export["image.fits", {"Data" -> dat,       "Metadata" -> Join[rnus, {"Object" -> "something"}]}, "Rules"]      (* image.fits *) and read back accordingly both the data:                Import["image.fits", "RawData"][[1]]      (* {1,2,3,4,5} *) and the metadata:                 "NU1" /. Import["image.fits", "Metadata"]       "OBJECT" /. Import["image.fits", "Metadata"]      (* 1.5 _) (_ Something *) BUT, what I would like to do is to write different (large) tables of different sizes into a single fits file. So using a single keyword for each element is unrealistic. If the table were of the same size I could join them into a single list, as in                  Export["image.fits", {"Data" -> {dat,dat}}, "Rules"]           but in my case the tables are not of the same size. In principle the documentation says _"For FITS files that contain multiple images or data extensions, the above elements are taken to be lists of the respective expressions."_ **Question** How can I write multiple images or data extensions into a unique fits file? Or in other words, what does the documentation mean? **Update** As requested, here is an example of fits with an extension containing {1,2,3,4,5} and {1,2,3,4,5,6} : > https://dl.dropboxusercontent.com/u/659996/test.fits or it can be produced in python as               python     import pyfits     import numpy     data=numpy.array([1.,2.,3.,4.,5.])     pyfits.writeto("test.fits",data)     data=numpy.array([1.,2.,3.,4.,5.,6.])     pyfits.append("test.fits",data)     exit


Solution of an ODE in implicit form

For some non-linear ODEs there is only implicit form of solution using DSolve. For example               DSolve[(y[x] + x - 1)*y'[x] - y[x] + 2 x + 3 == 0, y[x], x]      gives implicit solution               Solve[2/3 (Sqrt[2]ArcTan[(-2 + (2 (2 + 3 x))/(-1 + x + y[x]))/(2 Sqrt[2])]-Log[((-1 + x +y[x])^2 (3 + ((2 + 3 x) (-2 + (2 + 3 x)/(-1 + x +y[x])))/(-1 + x + y[x])))/(2 + 3 x)^2]) == C[1] + 4/3 Log[2 + 3 x], y[x]]      I'm solving a non-linear second-order ODE that has 4 explicit solutions. The formulas for these solutions are gigantic so I would like to see it in the implicit form because I hope it might be simpler. Is there a way how to show the implicit form of solution of ODE even though the equation has the explicit solution? (Just to be specific - the equation I'm solving reads               DSolve[(1 + G (A + y[x])^3) y''[x] + 3*G (A + y[x])^2 (y'[x])^2 + R == 0, y[x], x]      where $A,G,R \in \mathbb{R}$.) Thank you for any kind of help.


Slow work of TimeSeriesWindow

I have financial data (list of time-values pairs). There are more than `13000` elements.               data = FinancialData["KO", "OHLCV", {1000, 12, 31}];      I need extract from there some part of data which fall into the time interval. These parts are much. I use function `TimeSeriesWindow`, but it`s too slow. For example on this data               TimeSeriesWindow[data,{{2013,8,22},{2013,8,26}}];//AbsoluteTiming     (*{0.618035,Null}*)      Is the any faster function with the similar functionality? Or how do that operations fater?


What does ImageSize -> 1 -> 1 mean?

On the page http://www.wolfram.com/language/gallery/blur-faces-in-an-image/ the example code has `ImageSize -> 1 -> 1`. I am unfamiliar with this chaining of rules... What does it mean? Note I know what `ImageSize` does, it is the TWO arrows that I don't understand.


Plot FindRoot for non-trivial function

I would like to plot the results of FindRoot over certain range of inputs. I tried to do this with the code:               Plot[Evaluate[FindRoot[f[m, b], {m, 1}][[1, 2]]], {b, 0,2}]      where I want to plot the roots of f[m,b] vs. b ranging over [0,2]. I'm not sure this code is working, because although I do get a plot, I also get this error: > FindRoot::nlnum: "The function value > {1.[VeryThinSpace]-(2.\Gamma[2.,0.,(1.[VeryThinSpace]+1. > b)/Sqrt[b]])/(1.[VeryThinSpace]+1.\b)}\n is not a list of numbers with > dimensions {1} at {m} = {1.`}." Note the function I'm trying to find the roots for is:               f[M_, b_] := 1 - (2 M Gamma[2, 0, (1/M + b M)/Sqrt[b]])/(1/M + b M)      Thanks!


How to break graph to fill in the gap in pdf

I've printed my notebook into a pdf. There is a huge gap in the left page, due to the fact that the graph in the right page isn't divided to fill in the gap. Is there a way to fix it, preferably without resorting to do something like:               drawOrbits[deq1];     drawOrbits[deq2];     drawOrbits[deq3];      Currently, although it may not be evident, I'm doing something like:               drawOrbits /@ {deq1, deq2, deq3};      and show the result via Grid[]. ![enter image description here](http://i.stack.imgur.com/rlapx.png)


Implementing nested subtotals

Inserting a nested subtotal in a spreadsheet is a facility that Excel performs very well.   But if a subset of this facility can be implemented in MMA for a table which needs it the hassle of its export/import will be avoided.   As an example I have the following 3-columns matrix, the first two columns of which I want subtotals values for. The matrix was sorted so that the rows I want subtotaled are grouped together:.               data = {{Pi, A, 15}, {Pi, B, 20}, {Pi, B, 10}, {Pi, C, 20}, {Pi/2, A,      1}, {Pi/2, B, 2}, {Pi/2, B, 3}, {Pi/3, B, 10}}      And I want this result in separate matrix from the input data.               result = {{π, A, 15}, {π, B, 30}, {π, C, 20}, {π,      "∑", 65}, {π/2, A, 1}, {π/2, B, 5}, {π/2,      "∑", 6}, {π/3, B, 10}, {π/3, "∑",      10}, {"∑", "∑", 81}} // MatrixForm      ![Mathematica graphics](http://i.stack.imgur.com/N4aUr.png) I came up with a partial result,and what remains is too challenging for me (it is wrong to group results only on breaks in column 2.)               {#[[1, 1]], "∑", Total[#[[All, 3]]]} & /@ SplitBy[data, First] (* subtotals col1 *)     { "∑", "∑", Total[#[[All, 3]]]} & /@ {data} (*grand total *)      I would like to have a generalised answer, valid for more than two columns for subtotals as in the example I gave here.


StreamPlot for Bifurcation Diagram

When we do a `StreamPlot`, I want to show the bifurcation when $a = 0$ transitions to $a >0$, but do not see a better way to do this than the following.                   Animate[StreamPlot[{1,-x^4 + 5 a x^2-4 a^2}, {y,-5,5}, {x,-4,4},                             PlotLabel -> Row[{"a = ", a}]], {a,-1,1}]      Is there a better way to show this bifurcation? Maybe an animated gif like this Bifurcation diagrams for multiple equation systems) (this is a system and my example is not a system)? **Update** To be more clear, the original system is $$x'(y) = -(x(y))^4 + 5a(x(y))^2 - 4a^2$$


Why does a heavy background slow LocatorPane from updating, even if only the locators are Dynamic?

I'm having some trouble getting a dynamic plot to operate efficiently, and I think I've tracked down at least part of the problem to some pretty weird behaviour on the part of `LocatorPane`. Take two different image backgrounds, which can be quite similar except for their size on disk:               image1 = ContourPlot[x^2-y^2, {x, -1, 1}, {y, -1, 1}, ImageSize -> 250];          image2 = ContourPlot[x^2-y^2, {x, -1, 1}, {y, -1, 1}, ImageSize -> 250, PlotPoints -> 200];      where the `ByteCount` of `image2` is, in this case, about twenty times bigger than that of `image1`, and now use these images as the background for a `LocatorPane`:               point = {0.4, 0};     Row[{       LocatorPane[        Dynamic[point],        image2        ],       Dynamic[point]       }]      which produces something like this ![enter image description here](http://i.stack.imgur.com/FJw0e.gif) As you can see, the version with the heavier background is a huge lot more sluggish than the lighter one (though this is much more evident if you run it yourself). **Why is this?** Both occurrences of `point` are inside a `Dynamic` command but the background is not, so I don't really see a reason for the background of the pane to be re-loaded every time the locators are changed. More importantly, **how can this be avoided?** I have a byte-heavy background which I would like to only calculate once and then display without it slowing me down. I should also note that raster-based solutions will most likely prove unsatisfactory, particularly because I want to deploy a fair bit of information in the tooltips associated with the background contours.


Extract coefficients of differential form in package RGTC

I am using the Package RGTC to do some calculations in Supergravity. It allows to define differential forms after specifying a co-frame. I am working in with the 10d coordinates $\\{t,x,y,z,r,\phi_1,\ldots,\phi_5\\}$ and the coframe $\\{dt,dx,dy,dz,d\phi_1,\ldots,d\phi_5\\}$ and have the 5-form $F_5=-\frac{4L^2}{(1+\frac{L^4}{r^4})^2 r^5}\sqrt{R^4+r_0^4}(1+\star)dt\wedge dx\wedge dy\wedge dz\wedge dr$   where $R$ and $r_0$ are constants. Computing the Hodge dual in the expression is not a problem, since there is a function Hstar[_] in the package that does the job. What I need to compute is $F_{MPQRS}F_N{}^{PQRS}$, i.e. I need to extract the components from the differential form in order to perform the contractions. The actual code is a bit cryptic, because the space-time I am considering is a bit complicated, but I will include it anyways: J is the Jacobian for changing from Cartesian to spherical coordinates, xSugra my set of coordinates and g3branes the metric tensor               << EDCRGTCcode.m     J = D[{Cos[ϕ1], Sin[ϕ1] Cos[ϕ2],      Sin[ϕ1] Sin[ϕ2] Cos[ϕ3],      Sin[ϕ1] Sin[ϕ2] Sin[ϕ3] Cos[ϕ4],      Sin[ϕ1] Sin[ϕ2] Sin[ϕ3] Sin[ϕ4] Cos[ϕ5],      Sin[ϕ1] Sin[ϕ2] Sin[ϕ3] Sin[ϕ4]\     Sin[ϕ5]}, {{ϕ1, ϕ2, ϕ3, ϕ4, ϕ5}}];     H[r_] := 1 + L^4/r^4;     f[r_] := 1 - r0^4/r^4;     xSugra = {t, x, y, z, r, ϕ1, ϕ2, ϕ3, ϕ4, ϕ5};     coFrame = {d[t], d[x], d[y], d[z], d[r], d[ϕ1], d[ϕ2], d[ϕ3],     d[ϕ4], d[ϕ5]};     d[L] = 0; d[r0] = 0;     g3branes =      ArrayFlatten[{{H[r]^(-(1/2)) DiagonalMatrix[{-f[r], 1, 1, 1}], 0,       0}, {0, H[r]^(1/2)/f[r], 0}, {0, 0,       FullSimplify[H[r]^(1/2) r^2 Transpose[J].J]}}];     simpRules = TrigRules;     RGtensors[g3branes, xSugra, coFrame]     F5 = Simplify[-((4 L^2)/(H[r]^2 r^5)) Sqrt[     L^4 + r0^4] (d[t]⋀d[x]⋀d[y]⋀d[z]⋀d[r] +       HStar[d[t]⋀d[x]⋀d[y]⋀d[z]⋀d[r]])]      where I have not included output. Maybe I am lucky and there is someone who has worked with this package or a similar one before. Cheers, physicus


automatic coloring of function names

Usually, when I define a function and then use it later, the function name is colored in black. But every once in a while, the function color is blue, both in its definition and when I use it later. The blue colored functions work as expected. I can't find any difference in the way I define them or any pattern. What does the blue coloring mean?


Add Pattern to List Removing Duplicates

Lets say I have a list of patterns               p={       HoldPattern[f[x___]] :> {x},       HoldPattern[f[a_,b_]] :> {a,b},       HoldPattern[f[a_,a_]] :> {a,a},       HoldPattern[f[x_]] :>x     }       what is the most elegant way to add another pattern to the list while removing all duplicates? For example let's say I what to add `f[c_,d_]:>code` then `f[a_,b_]` should be mapped as a duplicate but not `f[a_,a_]`.


Assigning colors to Graphics3D objects from an ordered list

I'd like to draw a set of spheres with colors assigned from a defined set. To provide an example, say I wish to draw a set of three spheres of radius 2 at the positions: {{6, 5, 10}, {1, 4, 20}, {2, 4, 15}}. I might write:               pos = {{6, 5, 10}, {1, 4, 20}, {2, 4, 15}};     Graphics3D[{Sphere[pos, 2]}]      If I define an ordered set of colors for the three spheres, e.g. SphereColors={Red,Blue,Red}, how can I use this list to color the spheres as desired using Graphics3D?