title: How to make an unremovable modal window?

text: Is there any way to securely stick a notebook window (e.g. a dialog) on screen that it cannot be closed/removed/hidden by any of the standard OS shortcuts, like `Alt``F4` or `Alt``Tab` under Windows? The ideal solution would allow me to specify a range of key-combinations that can be used, and block any other, though it would not be a problem to block _all_ keyboard input, as there are other ways to close a modal dialog. I have a feeling that this cannot be done entirely from under _Mathematica_ , though I'll give it a go. You can experiment with the following example:               CreateDialog[{TextCell["Click OK to close"], DefaultButton[]}, Modal -> True]      **Purpose** : I'm doing some experimentation on humans in _Mathematica_ , and since this species is known by its extensive explorative behaviour (i.e. pushing all buttons) and the ability to ruin everything, I want to make the experiment-gui foolproof so that they can't remove it from the screen. This is a must, as it could happen that they hit `Alt``F4` (accidentally or intentionally) and quit at the middle of a test, rendering any saved data useless.


title: DeleteCases on list of Strings

text: Consider the following:               data={"AB","CD","AF"};      Now I would like to delete all String from `data` which starts with "A". Result: `{"CD"}`


title: Symmetric difference of a sample of lists

text: Consider the following:               list1={a,b,c,d};     list2={c,d,e,f};     list3={g,d,c,h};      Now I would like to get the symmetric difference. Hence, the result must be `{a,b,e,f,g,h}` (whether the result is sorted or not is irrelevant) BTW: Using `Complement[list1,list2,list3]` returns `{a,b}`, since `Complement` only "gives the elements in `e_all` which are not in any of the `e_i`." (Mathematica Documentation Center)


title: Approximating an ornamental curve

text: ![ornamental curve](http://i.stack.imgur.com/htDn0.jpg) How do I go about approximating this ornamental curve? Note that the curve has somewhat variable thickness as typical in calligraphy, which I would also like to replicate. The excellent reference _Handbook and Atlas of Curves_ by E.V. Shikin (1995) contains many tempting directions, including curve families with singular points, but none that resemble this particular closed curve, and it doesn't deal with thickness. A single function describing the curve is desirable but piecewise definition and splines are acceptable.


title: Contourplot of complex Roots

text: Suppose I have this equation: $$ z^2 + 3z + (x^2 + y^2) = 0 $$ I want the real and complex contour plot of $z(x,y)$. Analytically, the real/imaginary boundary is separated by condition $x^2 + y^2 \leq \frac{9}{4}$ The regular contour plot only plots the real parts when I use findRoot:               eqn[x_, y_, z_] := z^2 + 3 z + x^2 + y^2 == 0     ContourPlot[       z /. FindRoot[eqn[x, y, z], {z, 1}], {x, 0, 2}, {y, 0, 2},       PlotLegends -> Automatic]      ![enter image description here](http://i.stack.imgur.com/wS7gg.png) The darkest purple represents the complex area. How do I obtain contour plots of real roots of z, imaginary roots of z? Also, if possible combine them into a single graph. Tried this different approach of letting $z = a + bi$, but doesn't work.                z = a + b I;      eqn[x_, y_, z_] := z^2 + 3 z + x^2 + y^2 == 0         ContourPlot[           z /. FindRoot[Im[eqn[x, y, z]], {b, 1}], {x, 0, 2}, {y, 0, 2},           PlotLegends -> Automatic]      Plots from **difficult problem** : First one is real, second one is imaginary root contour plot. ![enter image description here](http://i.stack.imgur.com/xZEJF.jpg) ![enter image description here](http://i.stack.imgur.com/817Qb.jpg)


title: Better way to check conservation in NDSolve

text: The partial differential equation in the `NDSolve` below is conservative (by construction) of $\int_{-1}^{+1} p(t,z)\ dz$ for all $t$.               tMax = 1;     sol = NDSolve[       {         Derivative[1, 0][p][t, z] == Derivative[0, 2][p][t, z],         p[0, z] == (1 - z^2)^2 *Exp[-1 z^2],         Derivative[0, 1][p][t, -1] == 0,         Derivative[0, 1][p][t, +1] == 0       },       {p},       {t, 0, tMax},       {z, -1, 1},       PrecisionGoal -> 1,       AccuracyGoal -> 2     ];      In order to check conservation, I find the percent difference between $\int_{-1}^{+1} p(t,z)\ dz$ and $\int_{-1}^{+1} p(0,z)\ dz$ for `timePoints = 20` values of `t` by repeated calls to `NIntegrate`.               timePoints = 20;     dt = tMax/timePoints;     int0 = p[0, z] /.       sol //         NIntegrate[#, {z, -1, 1}] & //           Flatten;          intPercentDif =        Table[         p[dt*i, z] /.           sol //             NIntegrate[#, {z, -1, 1}] & //               Flatten //                 100*(# - int0)/int0 & //                   First //                     {dt*i, #} &,         {i, 1, timePoints}       ];          ListPlot[       intPercentDif,       AxesLabel -> {"time", "integral percent difference [%]"}     ]      The plot shows that the error remains small for this case. This method is quite computationally demanding, and for my real problem, which is a more- complex set of coupled pdes, this check takes a very long time. I'd like to check every time I simulate the system, but this check takes longer than the simulation itself. **Is there a better way to check for conservation?**


title: In version 10 EvaluationCompletionAction "ShowTiming" no longer gives useful output; any solutions?

text: In version 10 using this Front End option no longer gives useful output:               SetOptions[$FrontEnd, EvaluationCompletionAction->"ShowTiming"]      In version 7 the time to evaluate and render would be printed in the window frame (status area) of the Notebook. In version 10 even a long evaluation prints a small value. I can _briefly_ see a larger number flash before it is overwritten by a small value.   1. Why is the useful timing being overwritten by an apparently meaningless one?   2. Is there a way to restore the old timing behavior? I am quite attached to this functionality. * * * As an example, evaluating this I can see a momentary flash of "Time: 3.xx seconds" before it is replaced with e.g. "Time: 0.06 seconds":               Plot[{BesselJ[1, x], BesselJ[2, x]}, {x, 0, 10},      PlotPoints -> 1*^5,       Filling -> {1 -> {2}}     ]


title: Elegant way to rearrange year/date table into time series/values

text: I often have data in the form of               YEAR    JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC     1950    -1.022  -1.146  -1.289  -1.058  -1.419  -1.36   -1.334  -1.05   -0.578  -0.395  -1.151  -1.248     1951    -1.068  -1.196  -1.208  -0.437  -0.273  0.48    0.747   0.858   0.776   0.75    0.729   0.466     1952    0.406   0.131   0.086   0.262   -0.267  -0.634  -0.231  -0.156  0.362   0.309   -0.34   -0.124     1953    0.024   0.379   0.263   0.712   0.84    0.241   0.416   0.253   0.524   0.092   0.049   0.314     -0.093  -0.312     and so on ...      I want to convert this into time/value tuples of the type that can be easily plotted using DateListPlot. I have written some very hackish code that does the job, but it feels messy and unsatisfactory. Does anyone know of an elegant 'Mathematica' way to do this?


title: Using NSolve in a function, selecting one indexed result and using it to plot another function containing a function containing the indexed result

text: I have a problem using the result pcvar[g] g e (0,1) in the plot cvar1. In the plot cvar I can use it. It must be somehow connected to clearing p in the definition of pcvar[g]. I am gratefull for any suggestions. Here's the code:               L = 0.1;     U = 1.9;     k = 2;     b = 1000;     c = 2;     z = 1;               sol1[g_] :=        NSolve[(1/(2*(U - L)*g)) (b*p^(-k) + (p - z)*(-k)*b*               p^(-k - 1)) ((L + (g*(p - c)/(p - z)) (U - L))^2 -               L^2) + (L + (g*(p - c)/(p - z))*(U - L)) b*            p^(-k) ((c - z)/(p - z)) == 0, p] // N;     pcvar[g_] := p /. sol1[g][[1]];               cslcvar[p_, g_] := Max[0, (g*(p - c)/(p - z))] // N;     vcvar[p_, g_] := L + cslcvar[p, g]*(U - L);          acvar[p_, g_] := b*p^(-k) vcvar[p, g] // N;          cvar[p_, v_, g_] :=        Piecewise[{{N[(p - c) (v*b /p^k) - (1/g) (p - z) (b /p^k) Integrate[              CDF[UniformDistribution[{L, U}], w], {w, L, v}]],           v <= InverseCDF[UniformDistribution[{L, U}],             g]}, {N[-(c - z) (v*b /p^k) + (1/g) (p - z) b/p^k Integrate[              w PDF[UniformDistribution[{L, U}], w], {w, L,                InverseCDF[UniformDistribution[{L, U}], g]}]],           v > InverseCDF[UniformDistribution[{L, U}], g]}}];          pcvar[0.1]     pcvar[0.2]          4.50312          4.72099          plotcvar[g_] := Plot[{cvar[pcvar[g], v, g]}, {v, L, U},        PlotRange -> {-50, 200},        LabelStyle -> Directive[14, Bold], PlotStyle -> {{Black, Thick}},        AxesLabel -> {"v",           "\!\(\*SubscriptBox[\(CVaR\), \     \(\[Alpha]\)]\)(\!\(\*SuperscriptBox[\(g\), \(A\)]\))"},         ImageSize -> {600, 500},        PlotLegends ->          Placed[LineLegend[{"\!\(\*SubscriptBox[\(CVaR\), \(\[Alpha]\)]\)(\     \!\(\*SuperscriptBox[\(g\), \(A\)]\)(v,\!\(\*SubsuperscriptBox[\(p\), \     SubscriptBox[\(CVaR\), \(\[Alpha]\)], \(\(A\)\(*\)\)]\),W))"},            LegendLayout -> {"Column", 4}], Top]];     Do[Print[plotcvar[u]], {u, 0.1, 0.9, 0.4}]          plotcvar1[g_] :=        Plot[{cvar[p, acvar[pcvar[g], g]/(b/p^k), g]}, {p, c, 10},        LabelStyle -> Directive[14, Bold],        PlotRange -> {-50, 200},        PlotStyle -> {{Black, Thick}},        AxesLabel -> {"p",           "\!\(\*SubscriptBox[\(CVaR\), \     \(\[Alpha]\)]\)(\!\(\*SuperscriptBox[\(g\), \(A\)]\))"},         ImageSize -> {600, 500},         PlotLegends ->          Placed[LineLegend[{"\!\(\*SubscriptBox[\(CVaR\), \(\[Alpha]\)]\)(\     \!\(\*SuperscriptBox[\(g\), \(A\)]\)(v,\!\(\*SubsuperscriptBox[\(p\), \     SubscriptBox[\(CVaR\), \(\[Alpha]\)], \(\(A\)\(*\)\)]\),W))"}], Top]];     Do[Print[plotcvar1[u]], {u, 0.1, 0.5, 0.2}]               cvar[3, acvar[pcvar[0.2], 0.2]/(b/3^k), 0.2]          15.6256          cvar[10, acvar[pcvar[0.2], 0.2]/(b/10^k), 0.2]          8.90173          acvar[pcvar[0.2], 0.2]          16.2983      Here's a simple example:               b = 1000;     c = 2;     k = 2;               sol1[g_] := NSolve[g*(p^3 - c) - b == 0, p] // N;     p1[g_] := p /. sol1[g][[3]];     a[g_] := p1[g]*(b /p1[g]^k) // N;     f[p_, v_, g_] := g (p - c) (v*b /p^k);          plot1[g_] := Plot[{f[p1[g], v, g]}, {v, 0.2, 1.8}];     Do[Print[plot1[u]], {u, 0.1, 0.9, 0.4}]          plot2[g_] := Plot[{f[p, a[g]/(b/p^k), g]}, {p, c, 10}];     Do[Print[plot2[u]], {u, 0.1, 0.9, 0.4}]      If I do not define p1 and a in terms of g, but explicitly choose a value, I can manually solve the problem and plot the graphs, but it should not be necessary.               b = 1000;     c = 2;     k = 2;     g = 0.2;          sol1 = NSolve[g*(p^3 - c) - b == 0, p] // N;     p1 = p /. sol1[[3]];     a = p1*(b /p1^k) // N;     f[p_, v_] := g (p - c) (v*b /p^k);          Plot[{f[p, a/(b/p^k)]}, {p, c, 10}]


title: Why do I get empty graph when adding 'Abs' function?

text: Can someone be so nice to provide some help for this particular situation? I try to plot a graph of a derivative which contains modulus. Without it the graph is drawn correctly: ![correct graph](http://i.stack.imgur.com/9zbmE.png) But when I wrap the expression in the `Abs` _Mathematica_ outputs an empty graph: ![empty graph](http://i.stack.imgur.com/oKseC.png) I looked for several answers related to empty graphs, but nothing seems to fit to my case. Thanks in advance.


title: How to request financial data from Yahoo's YQL?

text: How can I download historical data from Yahoo ? Although Mathematica's FinancialData function uses Yahoo it could be useful to have more control on how to retrieve data from Yahoo's YQL.


title: InverseSeries of multiple variables and multiple equations

text: **CONTEXT** Let us consider a bit of the Universe in which we draw spheres ![](http://i.imgur.com/uxX7ma3.png) (see a high resolution image here). Astronomers have shown that the density within these spheres could be predicted quite accurately: here is the measured (in red) and predicted (in green) distribution of the density within $50^3$ such spheres at half the age of the Universe: ![](http://i.imgur.com/VH5bct1.png). Our next purpose is to extend the theory to concentric two or more shells. In practice, in order to estimate the mildly nonlinear cosmic density of the Universe within concentric shells, I need to find perturbatively the Legendre Transform of a function of two variables in a singular regime (see below). > $$\phi(\lambda_1,\lambda_2)={\rm LT}(\psi(\rho_1,\rho_2))\equiv > \sup_{\rho_1,\rho_2}\left[\lambda_1 \rho_1+\lambda_2 > \rho_2-\psi(\rho_1,\rho_2)\right]$$ which in turns involves inverting the system $$\partial_\rho \psi =\lambda \quad \quad \quad (1) $$ for $\rho_1,\rho_2$ , and integrating for $\phi(\lambda_1,\lambda_2)$ the system $$ \quad \partial_\lambda \phi =\rho \,. \quad \quad (2) $$ This can in principle be done perturbatively. In my context, it needs to be done in the regime where ${\rm det}| \partial^2_\rho \psi|=0$. I.e. I am interested in Taylor expanding the Legendre transform of $\psi$ near a point (chosen to be zero for simplicity) where one of the eigenvalues of $\partial^2_\rho \psi$ is zero. In physical terms it corresponds to the rare event tail of the density of the Universe in these shells, if you care to know! **ATEMPT** Following this question I know how to do invert (1) for $\rho(\lambda)$ in 1D (one shell) for the _regular_                nn = 3;      ρofλr = InverseSeries[Series[ψ'[ρ], {ρ, 0,nn}]] /. ρ -> λ /. ψ'[0] -> 0 /.         Derivative[n_][ψ][0] :>  Subscript[ψ, n] // Normal      ![reg](http://i.imgur.com/pkabMQM.png) (note the division by `ψ''[0]`) and the _singular_ case (for which `ψ''[0]=0`)                nn = 3;       ρofλs = InverseSeries[Series[ψ'[ρ], {ρ, 0,nn}]/. ψ''[0]-> 0] /. ρ -> λ /. ψ'[0] -> 0 /.          Derivative[n_][ψ][0] :>  Subscript[ψ, n] // Normal      ![reg](http://i.imgur.com/jaHqhFR.png) note the square root. It is clear from this expansion that the Legendre transform, `ϕ[λ]` will have a very different algebraic form in the singular case compared to the regular case.                ϕ[λ_]=Integrate[ρofλ,λ]      But this is not enough for concentric shells: I need to be able to carry out such Legendre transform when one coordinate is singular. **SOLUTION to first order and for the regular case only** The following works for the regular case only. Let us expand the first system                  nn=1;        eqn = Thread[{λ1, λ2} ==         Series[{Derivative[1, 0][ψ][ ρ1,  ρ2],         Derivative[0, 1][ψ][ ρ1,  ρ2]}, { ρ1, 0,         nn}, { ρ2, 0, nn}]] // Normal;      and reoder it in power of `ϵ`                 eqn2 = eqn /.        Derivative[i_, j_][ψ][0,         0] -> ϵ^(i + j - 1) Derivative[i, j][ψ][0, 0] //       Series[#, {ϵ, 0, 1}] & // Simplify;      Solve for `ρ1,ρ2`                sol = Solve[Normal[eqn2], { ρ1,  ρ2}][[1]] /.       Derivative[n_, p_][ψ][__] :>  Subscript[ψ, n, p] //       FullSimplify;      We can then integrate the system (2):                eqn3 = {D[ϕ[λ1, λ2], λ1] == ρ1,D[ϕ[λ1, λ2], λ2] ==  ρ2} /. sol      ϕ[λ1, λ2]/. DSolve[eqn3,ϕ[λ1, λ2], {λ1, λ2}][[1, 1]] // Apart      ![](http://i.imgur.com/7YQGC2J.png) But this is not good enough because I am interested in a singular expansion, i.e. near a point where the Jacobian $\partial^2 \psi \partial \rho_i \partial \rho_j$ has zero determinant! (when the above first order solution becomes singular because `ψ02 ψ20 -ψ11^2 =0`) **QUESTION** I am interested in doing this in 2D (or 3D...) for the singular case, i.e. when the Jacobian $\partial^2_\rho \psi$ has one null eigenvalue. The main difficulty is that `InverseSeries` does not work for series of two variables. The gist of the problem is the following: assuming `x1`, `x2` `y1` and `y2` are small, how does one invert pertubatively                y1= x1+ x1^2 + x2^2 + x1 x2 + x2^3...      y2= x2^2 + x1^2 +x1 x2 + x1^3 +...       in order to write                x1= y1+...      x2= sqrt(y2)+...      This might sound like a technical question, but the core of the problem is fairly general: **how does one`InverseSeries` of multiple variables and multiple equations?** in Mathematica. Any suggestions would be very welcome!


title: Faster way to convert triangle list to edge list with no duplicates

text: I have a list of triangles returned by a Delaunay triangulator, in the following format:               triangles = {{1, 7, 9}, {11, 9, 5}, {1, 9, 6}, {6, 11, 4}, {11, 6, 9},                   {4, 11, 8}, {9, 7, 13}, {5, 13, 10}, {13, 5, 9}, {2, 13, 7},                   {13, 2, 10}, {8, 12, 3}, {12, 8, 5}, {10, 3, 12}, {12, 5, 10}, {5, 8, 11}}      The integers are point indices. I need to convert this triangle list into an edge list which has no duplicate edges. For example, the first triangle from the list has these three edges: `{{1,7}, {7,9}, {9,1}}`. My first naive approach was this:               trianglesToLines[tri_] :=        Union[Sort /@ Flatten[Partition[#, 2, 1, 1] & /@ tri, 1]]      This is not fast enough, unfortunately, so I came up with this ugly compiled alternative:               cf = Compile[{{tri, _Integer, 1}},       Module[{i, res},        res = Table[0, {2 Length[tri]}];        Do[         res[[6 i + 1]] = tri[[3 i + 1]];         res[[6 i + 2]] = tri[[3 i + 2]];         res[[6 i + 3]] = tri[[3 i + 2]];         res[[6 i + 4]] = tri[[3 i + 3]];         res[[6 i + 5]] = tri[[3 i + 1]];         res[[6 i + 6]] = tri[[3 i + 3]];,         {i, 0, Length[tri]/3 - 1}];        res        ]       ]          trianglesToLines2[tri_] := Union@Partition[cf@Flatten[Sort /@ tri], 2]      This is much faster but awfully ugly. Is there a better way to speed up the operation? I will accept an answer that is a bit slower than the compiled one if it is considerably more elegant. * * * Timings on my machine:               In[203]:= trianglesToLines[triangles]; // AbsoluteTiming     Out[203]= {1.302468, Null}          In[204]:= trianglesToLines2[triangles]; // AbsoluteTiming     Out[204]= {0.206924, Null}      Test data:               triangles = Import["http://ge.tt/api/1/files/4ulWlnb/0/blob?download", "WDX"];      * * * ### Summary and timings The fastest solution on a single core was Simon Woods's one. R.M.'s is just as fast when run on 4 cores. I included both a parallelized and a non-parallel version of R.M.'s function, as well as a Simon's with parallelized `Sort`.               (* original *)          trianglesToLines[tri_] :=       Union[Sort /@ Flatten[Partition[#, 2, 1, 1] & /@ tri, 1]]          (* original compiled *)          cf = Compile[{{tri, _Integer, 1}},         Module[{i, res}, res = Table[0, {2 Length[tri]}];         Do[res[[6 i + 1]] = tri[[3 i + 1]];          res[[6 i + 2]] = tri[[3 i + 2]];          res[[6 i + 3]] = tri[[3 i + 2]];          res[[6 i + 4]] = tri[[3 i + 3]];          res[[6 i + 5]] = tri[[3 i + 1]];          res[[6 i + 6]] = tri[[3 i + 3]];, {i, 0, Length[tri]/3 - 1}];         res]];          trianglesToLines2[tri_] := Union@Partition[cf@Flatten[Sort /@ tri], 2]          (* einbandi *)          trianglesToLines3[tri_] :=       Union@(Sort /@          Flatten[Function[x, x[[#]] & /@ {{1, 2}, {2, 3}, {3, 1}}] /@ tri,           1])          (* R.M. *)     With[{part = Compile`GetElement,         e = {{1, 2}, {2, 3}, {1, 3}}},        cfrm = Compile[{{tri, _Integer, 1}},          With[{t = Sort@tri}, Map[part[t, #] &, e, {2}]],          RuntimeOptions -> "Speed", RuntimeAttributes -> {Listable},          Parallelization -> False]];          trianglesToLinesRM[tri_] := Union[cfrm@tri~Flatten~1]          (* R.M. parallel *)          With[{part = Compile`GetElement, e = {{1, 2}, {2, 3}, {1, 3}}},        cfrmp = Compile[{{tri, _Integer, 1}},          With[{t = Sort@tri}, Map[part[t, #] &, e, {2}]],          RuntimeOptions -> "Speed", RuntimeAttributes -> {Listable},          Parallelization -> True]];          trianglesToLinesRMp[tri_] := Union[cfrmp@tri~Flatten~1]          (* Simon Woods *)          trianglesToLinesSW[t_] :=       Union@Flatten[{{#1, #2}, {#2, #3}, {#1, #3}} & @@          Transpose[Sort /@ t], {{1, 3}, {2}}]          (* Simon Woods; parallel Sort *)          cs = Compile[{{x, _Integer, 1}}, Sort[x], RuntimeOptions -> "Speed",         RuntimeAttributes -> {Listable}, Parallelization -> True];          trianglesToLinesSWp[t_] :=       Union@Flatten[{{#1, #2}, {#2, #3}, {#1, #3}} & @@          Transpose[cs[t]], {{1, 3}, {2}}]      **Timings on OS X** , quad-core i7 processor with hyperthreading:               In[13]:= (* original *)     trianglesToLines[triangles]; // AbsoluteTiming          Out[13]= {1.075996, Null}          In[14]:= (* original compiled *)         trianglesToLines2[triangles]; // AbsoluteTiming          Out[14]= {0.208128, Null}          In[15]:= (* einbandi *)     trianglesToLines3[triangles]; // AbsoluteTiming          Out[15]= {0.397399, Null}          In[16]:= (* R.M. *)     trianglesToLinesRM[triangles]; // AbsoluteTiming          Out[16]= {0.261082, Null}          In[17]:= (* R.M. parallel *)         trianglesToLinesRMp[triangles]; // AbsoluteTiming          Out[17]= {0.136793, Null}          In[18]:= (* Simon Woods *)         trianglesToLinesSW[triangles]; // AbsoluteTiming          Out[18]= {0.146266, Null}          In[19]:= (* Simon Woods; parallel sort *)         trianglesToLinesSWp[triangles]; // AbsoluteTiming          Out[19]= {0.111575, Null}      **Timings on Ubuntu 13.04** running on the same machine in VirtualBox with two assigned CPU cores. Note that all solutions run considerably faster (except the parallelized ones).               In[13]:= (*original*)     trianglesToLines[triangles]; // AbsoluteTiming          Out[13]= {0.869539, Null}          In[14]:= (*original compiled*)     trianglesToLines2[triangles]; // AbsoluteTiming          Out[14]= {0.188039, Null}          In[15]:= (*einbandi*)     trianglesToLines3[triangles]; // AbsoluteTiming          Out[15]= {0.317713, Null}          In[16]:= (*R.M.*)     trianglesToLinesRM[triangles]; // AbsoluteTiming          Out[16]= {0.197207, Null}          In[17]:= (*R.M.parallel*)     trianglesToLinesRMp[triangles]; // AbsoluteTiming          Out[17]= {0.150842, Null}          In[18]:= (*Simon Woods*)     trianglesToLinesSW[triangles]; // AbsoluteTiming          Out[18]= {0.119471, Null}          In[19]:= (*Simon Woods;parallel sort*)     trianglesToLinesSWp[triangles]; // AbsoluteTiming          Out[19]= {0.111481, Null}


title: Simulating a system of nonlinear ODEs?

text: I was trying to simulate a system of ODEs on Mathematica in an effort to try to understand how to muck around with Mathematica but for some reason the following lines of code do not yield any results; the code just seems to run without conclusion. Could anyone shed some light on why this is happening perhaps?               system = {x'[t] == x[t] + y[t], y'[t] == z[t], z'[t] == x[t] * y[t]};     sol = DSolve[system,{x,y,z},t]      Is it perhaps an erroneous call and/or usage of the DSolve command? Is it not meant for use on non-linear equations?


title: Solve for the intersection point of 3 surfaces

text: Basically, I have three 2-torus (tilted) in 3-dimensional Euclidean space. They are expressed by parametric equations:               torus1[a_, b_] = {5/6 (7 + 5.5 Cos[a]) Cos[b] - (2 Sin[a])/3 - (7 + 5.5 Cos[a]) Sin[b]/6,                       -(7 + 5.5 Cos[a]) Cos[b]/6 - (2 Sin[a])/3 + 5/6 (7 + 5.5 Cos[a]) Sin[b],                       -(7 + 5.5 Cos[a]) Cos[b]/6 + (10 Sin[a])/3 - (7 + 5.5 Cos[a]) Sin[b]/6};     torus2[a_, b_] = {5/6 (11 + 2. Cos[a]) Cos[b] - Sin[a] - 1/6 (11 + 2. Cos[a]) Sin[b],                       -1/6 (11 + 2. Cos[a]) Cos[b] - Sin[a] + 5/6 (11 + 2. Cos[a]) Sin[b],                       -1/6 (11 + 2. Cos[a]) Cos[b] - Sin[a] - 1/6 (11 + 2. Cos[a]) Sin[b]};     torus3[a_, b_] = {5/6 (7 + (4 + 2.5 Cos[a]) Cos[b]) - 1.25 Sin[a] -                       (4 + 2.5 Cos[a]) Sin[b]/6,                       (-7 - (4 + 2.5 Cos[a]) Cos[b])/6 - 1.25 Sin[a] -                       (4 + 2.5 Cos[a]) Sin[b]/6,                       (-7 - (4 + 2.5 Cos[a]) Cos[b])/6 - 1.25 Sin[a] +                       5/6 (4 + 2.5 Cos[a]) Sin[b]};      where `a` and `b` are some angular parameters run from $0$ to $2\pi$. I want to solve for the coordinates of the intersection point of these three tori. However, since they are not described by the canonical form $f(x,y,z)=0$, I don't know how to deal with them. I have tried to transform the parametric equation to the canonical form; however, it is too complicated to do even using _Mathematica_ (with `GroebnerBasis`). How can I solve the equation `torus1=torus2=torus3`?


title: How do I set the boundaries of the legend for a ListDensityPlot?

text: I have a 3-d array imported from a text file. One dimension represents time, and the other two represent space. It's basically an array of 2-d arrays of temperature values. I want to plot these values in a ListDensityPlot using the manipulate command to change the time I'm looking at. I did this with the following command: `Manipulate[ ListDensityPlot[data[[x]], PlotLegends -> Automatic, ColorFunction -> "Warm"], {x, 1, Length[data] - 1}]` where "data" is the variable containing the array. The only problem (apart from it being a little slow) is that every time I move the slider, the range of the legend adjusts based on the values currently shown in the plot. This means that as you slide the bar from start to finish, the change in plot does not accurately represent the data because the scale changes. How do I make the scale stay the same?


title: Creating an API or Widget based on a Mathematica notebook

text: I'm trying to create a matrix calculator and graph tools for our website and was wondering if there is a way to create Wolfram API or Widgets based on a _Mathematica_ notebook.


title: Abort during animation

text: I am running an animation with the following command:               files = FileNames[NotebookDirectory[] <> "*.dat"];      MTnumbers = FileNames[NotebookDirectory[] <> "MTnumbers.txt"];          data = Import[#, "Table"] & /@ files     MT = Import[#, "List"] & /@ MTnumbers               coords = {{#1 - (#3/2), #2 - (height/2)}, {#1 + (#3/2), #2 + (height/            2)}} & @@@ #[[All, 2 ;;]] & /@ data;          height = 2;          colors = {Blue, Blue, Blue, Blue, Blue, Blue, Blue, Blue, Blue, Blue,      Blue, Blue, Blue, Blue, Blue, Blue, Blue, Blue, Blue, Blue, Blue,      Blue, Blue, Blue, Blue, Blue, Blue, Blue, Blue, Blue, Blue, Blue,      Blue, Blue, Blue, Blue, Blue, Blue, Blue, Blue};     Animate[Graphics[{Sequence @@ {colors[[#]],         Rectangle @@ (coords[[#]][[t]])} & /@ MT[[1]]},     PlotRange -> {{-1000, 1000}, {-200, 200}},      ImageSize -> {1000, 200}], {t, Range[0, 7000]}]           Export["tubuli.avi", %];      As soon as I try to export this output Mathematica crashes. When I increase the number of rectangles to about 150 the simulation crashes without giving an output. Is my computer too weak or am I doing something wrong? EDIT: The data is in the following zip archive you just need the notebook and the data in the same folder and it should work. https://www.dropbox.com/s/iegdb1a031i4mn6/data.zip


title: Session logging of "\$Echo" and "\$Output" in Mathematica 10

text: I have difficulties with session logging and Mathematica 10. In previous versions, you could simply use `AppendTo[$Echo, logfile]` and `AppendTo[$Output, logfile]`. In Mathematica 10, appending to `$Echo` only works for cells in raw input format, as stated in the reference. Appending to `$Output` seems not working. Log file is always empty. My questions: a) How can I force all input cells to be in "raw input format", without converting the cells by the menu? b) What's wrong with my `AppendTo[$Output]`?               oldout = $Output;     logfile = OpenWrite[FileNameJoin[{$TemporaryDirectory, "math.log"}],         FormatType -> InputForm];     AppendTo[$Output, logfile];     AppendTo[$Echo, logfile];     First@logfile          (* tests, $Echo works, if cell is converted to raw input format *)     2+2     Expand[(a + b)^3]     Factor[z^5 - 1]     N[Pi, 24]     Close[logfile];     $Echo={};     $Output = oldout;     FilePrint[First@logfile]


title: How do I prevent exponents from being expanded when displaying text

text: I have a power of 2 in a list, and I want it to show as $2^{31}$ (2 with exponent 31), not 2147483648. I've tried this:               aa={2^31,1103515245,12345,12345}     Text[Style[aa[[1]]]]     Text[Style[HoldForm[2^31]]]      The first form shows 2147483648. The second form shows correctly, but not when it is in a list.


title: Defining conditional Notation rules

text: I am trying to define a notation rule so that for selected symbols subsripts will be equivalent to function parameters. My understanding of the docs suggests the following               << Notation`          sub[f_] := Notation[ParsedBoxWrapper[\(Subscript[\(f, \(\ x_\)\)]\)]          \[DoubleLongLeftRightArrow] ParsedBoxWrapper[\(f[x_]\)]]      The idea is to be able to do the following               sub[P]     Subscript[P, i] := F[i]     Subscript[P, a]      and have Mathematica treat it the same as               P[i] := F[i]     P[a]      But `Subscript[Q, i]` should remain as a just a subscript expression Mathematica throws the following error on the definition of `sub`:               Notation::expatnf: Pattern 'x' appearing in the external representation 'Notation`Private`identityForm[RowBox[{OverBar,[,x_,]}]]' cannot be filled since 'x' does not appear in the internal representation 'Notation`Private`identityForm[RowBox[{mean,[,x,]}]]'. >>      I would like to understand what the problem is and fix it. I am also interest in alternative approaches to achieving the same effect. I am also interested finding more documantation for the Notation package then is in the standard documentation, particularly extended examples and conceptual overviews. ** EDIT Here is what I get with Leonid's approach               In[1]:=     Remove[P, F]     Clear[Subscript, MakeExpression, makeExpression];      MakeExpression[expr_, form_] :=         With[{result = makeExpression[expr, form]},          result /; Head[result] === HoldComplete];      ClearAll[sub];      sub[f_] := With[{boxed = MakeBoxes[f]},          makeExpression[RowBox[{"Subscript", "[",              RowBox[{boxed, ",", arg_}], "]"}], form_] :=           MakeExpression[RowBox[{boxed, "[", arg, "]"}], form]];           In[6]:= sub[P]          In[7]:= Subscript[P, i]:= F[i]      I would really prefer the rule to be interpreted as `P[i] := F[i]`. I want the subscripts to be purely cosmetic. On my system the `Subscript[P, i]` on the LHS does not get interpreted that way:               In[8]:= DownValues[Subscript]          Out[8]= {HoldPattern[Subscript[P, i]] :> F[i]}          In[9]:= DownValues[P]          Out[9]= {}      The following shows that the parsing of the notation works, but I actually want the rendering to reverse the parsing when in StandardForm.               In[10]:= Subscript[P, a]          Out[10]= P[a]      However the `:=` definition does not work as kick in:               In[11]:= Subscript[P, i]          Out[11]= P[i]      Also the parsing code only works on code that was entered after the notation related code was evaluated. Expressions entered before the notation code was evaluated are not effected, even after restarting Mathematica. The following expression is in the same notebook but was in there from before Leonids answer and is identical to the first expression above:               In[12]:= Subscript[P, a]          Out[12]= Subscript[P, a]      In other words the notebook is somehow remembering which expressions were entered before the notation code and which were entered after even across Mathematica restarts.


title: Adjusting the vertices positions of a RandomGraph

text: By adopting the codes I got from the previous questions, here I intend to adjust the vertices positions of a RandomGraph. However, I only got an inactive graph, it even disappears suddenly when clicking on it. Again, what is wrong in these codes?               DynamicModule[{p, ind , vpos, VPOS},     rg = RandomGraph[{#, # + 4}] & [ RandomInteger[{5, 7}]];     edglst = EdgeList[rg];     vlst = VertexList[rg];     vcoord = VertexCoordinates /. AbsoluteOptions[rg, VertexCoordinates];          (vpos[#] = #2) & @@@ MapThread[UndirectedEdge, {vlst, vcoord}];     VPOS = Table[vpos[i], {i, vlst}];          EventHandler[      gg = Dynamic@         Graph[vlst, edglst, VertexCoordinates -> VPOS, VertexSize -> 0.08,           VertexLabels -> "Name", PlotRange -> All, EdgeStyle -> {Thick},           ImagePadding -> 10 ],            {"MouseDown" :>          With[{ set = VPOS , pos = MousePosition["Graphics"]},           ind = Position[set  , Nearest[set  , pos][[1]]][[1, 1]]],             "MouseDragged" :> (ReleaseHold[           Hold[Set][Hold[VPOS][[{1}, ind]], MousePosition["Graphics"]]])}        ]     ]      Following Kguler's suggestion, I found that the above code works fine just by changing the `MouseDragged` statement to m_goldberg's way, and followed by `PassEventsDown -> True`. Why setting `PassEventDown` to `True` is that crucial?               DynamicModule[{p, ind, vpos, VPOS},       rg = RandomGraph[{#, # + 4}] &[RandomInteger[{5, 7}]];      edglst = EdgeList[rg];      vlst = VertexList[rg];      vcoord = VertexCoordinates /. AbsoluteOptions[rg, VertexCoordinates];      (vpos[#] = #2) & @@@ MapThread[UndirectedEdge, {vlst, vcoord}];      VPOS = Table[vpos[i], {i, vlst}];      EventHandler[        gg = Dynamic@        Graph[vlst, edglst, VertexCoordinates -> VPOS, VertexSize -> 0.08,        VertexLabels -> "Name", PlotRange -> All, EdgeStyle -> {Thick},         ImagePadding -> 10], {"MouseDown" :>           With[{set = VPOS, pos = MousePosition["Graphics"]},            ind = Position[set, Nearest[set, pos][[1]]][[1, 1]]],            "MouseDragged" :> ( VPOS [[ ind]] = MousePosition["Graphics"]  )},            PassEventsDown -> True       ]     ]


title: Solving a system of two equations of third degree

text: I am trying to solve the following system of two equations for x and y. The solutions for x and y have to be positive and the parameters s and c are positive (to have a coherent interpretation of my problem). Could anyone please help me?               eq1 := (2 + 12*s)/(9*x^2) + (4*Sqrt[2*s])/(9*x^2*y) - (4*Sqrt[2*s])/( 9*x^3) - k          eq2 := (1 + 3*Sqrt[2*s] - 6*s)/(9*y^2) + (2*Sqrt[2*s])/(9*y^2*x) - (2*Sqrt[2*s])/(9*y^3) - k          Solve[{eq1 == 0, eq2 == 0}, {x, y}, Positive]


title: How to specify the ordering of elements in an (algebraic) group?

text: Is there a way to fully specify the ordering of elements in an algebraic group? (This ordering affects the output of several other group-theoretical operations.) For example, how can I set the ordering of elements in `SymmetricGroup[3]` to be precisely this               Cycles[{{}}],     Cycles[{{1, 2, 3}}],     Cycles[{{1, 3, 2}}],     Cycles[{{1, 2}}],     Cycles[{{1, 3}}],     Cycles[{{2, 3}}]      The docs say that one can control the ordering of group elements by specifying a suitable value for the `GroupActionBase` option, but I have not been able to come up with a value for this option that will result in the ordering shown above.


title: How to change the last plotstyle of a list

text: I'm using ListLinePlot to plot a list containing 10 lists, using the default colors:               ListLinePlot[myList]      I would like to be able to keep the default PlotStyle options for the 9 first lists, but not for the last one. I tried to do:               myStyle = Append[Table[{Automatic}, {9}], {Green,Thickness[0.01]}];     ListLinePlot[myList, PlotStyle -> {myStyle}]      but all the lists are plotted in {Green,Thickness[0.01]} What's the best way to do that?


title: Is it possible to monitor the sum of squared errors in a NonlinearModelFit or FindFit procedure during the process?

text: Since fitting procedures using `NonlinearModelFit` (or `FindFit) sometimes take very long, I would like to monitor the sum of squared errors _during_ the process (seeing it afterwards is well documented). Does someone know how to do this?


title: How to plot the 2-D graph of Abs[x]+Abs[x+y]==1?

text: _**Problem Description:_** **Today，I countered a integration problem that I must plot the 2-D graph of Abs[x]+Abs[x+y]==1.** I plots it step by step by hand: When x>=0, x+|x+y|=1                  y>=-x    2x+y=1        y<-x     y=-1      When x<0, -x+|x+y|=1                  y>=-x    y=1        y<-x     2x+y=-1      ![the 2-D graph of Abs\[x\]+Abs\[x+y\]==1?](http://i.stack.imgur.com/w1i5B.png) _**However,I want to use Mathematica to solve it._** Have a try:               Plot[y /. {Solve[Abs@x + Abs@(x + y) == 1, y]}, {x, -1, 1},      AspectRatio -> Automatic]      but the Mathematica give the warning information: “Solve::ifun: Inverse functions are being used by Solve, so some solutions may not be found; use Reduce for complete solution information. >>” So I think my solution has flaws.My question is how to revise it or give another method to solve it?


title: Large scale linear programming (Data imported from .mat file)

text: I tried to run a large scale linear programming with mathematica. I entered the code below:               Import["A,B.mat", "LabeledData"]     x = LinearProgramming[{0, 0, -1}, A, B, {{-1, 100}, {0, 100}, {0, 100}}];     c.x      where A, B are two large scale matrices. {{-1, 100}, {0, 100}, {0, 100}} are bounds of variabels of linear programming. The code doesn't work and I think there is sth wrong with importing matrices `A` and `B`. How can I fix that? **Edit** : Data file access from here


title: Separate an array in two arrays, the even and odd terms being separated in these two arrays

text: How can I separate the odd terms in one array and the even terms in another array,i.e., go from               a={1,2,3,4}      to `aeven={2,4}` and `aodd={1,3}` I thought of:               a={1,2,3,4}          s={}          For[i = 1, i <= 4, i++,       If[EvenQ[a[[i]]] == True, AppendTo[a[[i]], s]]]      but it does not work. Thankyou


title: How can I draw this plot?

text: How can I draw a plot like this one? I want to be able to specify the x-axis, y-axis, and z-axis ticks and the number of bars in the plot. ![enter image description here](http://i.stack.imgur.com/i4fgD.jpg)


title: Is there a way to see the result of NIntegrate's symbolic preprocessing?

text: `NIntegrate` can do a number of different types of symbolic preprocessing on the integrand before starting the numerical calculations, including changes of variables. Is there a way to find out what sort of symbolic preprocessing is being done and what is the precise integrand `NIntegrate` is actually evaluating? For example, is it possible to find out if it does any changes of variables, and if yes, exactly what changes it does? * * * Motivation: I'm trying to understand what goes wrong here: Why do I get a different value when I change the order of integration? The question describes a simple oscillatory numerical integral in 2D. `NIntegrate` gives different results depending on the order of integration variables, and no warnings. One result is wrong. Looking at the points sampled by `NIntegrate` it's clear that Mathematica does a different change of variables depending on the order of integration variables.


title: Solve gives a solution which is contradicted by an example

text: I have the problem as described in the title. Here is the code:               Remove["Global`*"]     L3 = 2 c1 + 4 c2 + Sqrt[24 c1^2 + 16 c1 c2 + 16 c2^2]     L4 = 1/2 (4 c1 + 8 c2 - 2 Sqrt[24 c1^2 + 16 c1 c2 + 16 c2^2])     Solve[{L3 == K3, L4 == K4}, {c1, c2}];     Set @@@ %[[1]];     K3 = 1; K4 = 2;     FullSimplify[{K3, K4}]     FullSimplify[{L3, L4}]      The output is               {1, 2}     {2, 1}      Since the equations that have been solved for are L3==K3, L4==K4, how can it be that when I specify values for K3,K4, I find L3 and L4 interchanged? What is this? There was not even a Warning Message (MMA 8). Any help is greatly appreciated.


title: Symbolically implementing the following product

text: I have two products I hope to compare symbolically and I am hoping to use `Mathematica` for this. They are as follows: $$ \prod_{1 \leq i < j \leq n} {(a_i + \cdots + a_{j-1}) + j - i \over j- i} \tag{1} $$ and $$ {\prod_{\ell = 1}^{n-1}\left(\prod_{j = \ell}^{n-1}\left[\sum_{i = 1}^j a_i + j - 1\right]\right) \over (n-1)!\cdot (n - 2)!\cdots 2!\cdot 1!} \tag{2} $$ However, I'm not very familiar with the `Mathematica` syntax required to do this. Regards


title: Pasting external PDF vector graphics without losing ability to export them

text: As in previous versions, _Mathematica_ 9 on Mac OS X (10.7.5 here) still has a problem with pasted `PDF` graphics that were copied from external applications such as `Preview.app` or `Skim.app` (I usually use the latter). To see the problem (I don't know if this also happens on other platforms than Mac), try the following:               Export["t.pdf", "Hello"];          SystemOpen["t.pdf"]      In the `PDF` viewer, activate the `select` tool, select all or part of the image and copy it to the clipboard (this is automatically copied in `PDF` format). Now in _Mathematica_ , type the line               Export["t1.pdf",  ];      and insert the copied `PDF` directly in the slot for the second argument by performing a `paste` from the clipboard. Evaluate the cell and then look at the result:               First@Import["t1.pdf"]      ![screen shot](http://i.stack.imgur.com/kwdj4.png) The result is empty. One can also observe that the pasted `PDF` in the above example looks like it's been rasterized and is being displayed at the wrong resolution. It actually isn't rasterized, but the display looks ugly and the export of such pasted `PDF` simply doesn't work. To fix this, I had written the following palette some time ago:               CreatePalette[Column[{Button["Convert PDF on clipboard",          Module[{pdf, out = "/tmp/MathematicaOutput.pdf",            prog = "from AppKit import *\nboard=NSPasteboard.generalPasteboard()\nresult = board.dataForType_(NSPDFPboardType)\nif result:\n\tresult.writeToFile_atomically_('**FILENAME**',1)\n\" | /usr/bin/python"},                  Run["printf \"" <>              StringReplace[prog, {"**FILENAME**" -> out}]];           CopyToClipboard[If[FileExistsQ[out], pdf = Import[out, "PDF"];             (*DeleteFile[out]*);             pdf[[1]], "No PDF"]];           ], Appearance -> "Palette"],         "Click before pasting externally generated PDF"}],        WindowTitle -> "Convert External PDF"];      After evaluating this, a palette is created that you have to click right after copying a `PDF` from an external application. If you then do the `paste` operation again in the following line:               Export["t2.pdf",   ];          First@Import["t2.pdf"]      > $\mathtt{Hell}$ The result is the expected `PDF`. There is another issue related to cropping of the `PDF`. The above results are obtained using `Skim`, but when using `Preview` the crop box is lost and the original bounding box is used. My question is: **Is there a simpler way to get pasted`PDF` from external applications on Mac to display properly in the notebook and then export correctly?**


title: Sorting lists of lists with string elements

text: I have a list of sublists. One element of each sublist is a string element. For example:               list = {{1, "banana", 3}, {3, "orange", 1}, {2, "apple", 2}};      When I sort by the first element of each sublist, an integer, I receive the results that I was looking for.               In[]=  Sort[list, #1[[1]] < #2[[1]] &]     Out[]= {{1, "banana", 3}, {2, "apple", 2}, {3, "orange", 1}}      Same for when I sort by the third element of each sublist, an integer again.               In[]=  Sort[list, #1[[3]] < #2[[3]] &]     Out[]= {{3, "orange", 1}, {2, "apple", 2}, {1, "banana", 3}}      Now, when I sort by the second element of each sublist, a string, I see results that are unexpected.               In[]=  Sort[list, #1[[2]] < #2[[2]] &]     Out[]= {{1, "banana", 3}, {3, "orange", 1}, {2, "apple", 2}}     expected: {{2, "apple", 2}, {1, "banana", 3}, {3, "orange", 1}}      I tried with `Order`, same unexpected result.               In[]=  Sort[list, Order[#1[[2]], #2[[2]]] &]     Out[]= {{1, "banana", 3}, {3, "orange", 1}, {2, "apple", 2}}


title: How to enforce numerical precision throughout a package

text: I developed a big package that does quite a bit of numerics. Is there a way to enforce that all numerical computations are done with a pre-defined accuracy? For example, can one use something like SetAccuracy[...] in the beginning of the package and then all functions automatically use that accuracy. Of course, one can wrap all functions with N[], but I wonder if that can be avoided. EDIT: As an example, I tried changing               BeginPackage["packageName`"];     ...      into               BeginPackage["packageName`"];     $MaxPrecision=10;     ...      but I noticed that the computations are still done with unlimited precision (unless N[] is used to wrap expressions).


title: How can I select elements that are true

text: I have a list of lists. For example,                list = {{0,1,0,1,true},{0,0,0,0,false},{0,1,1,1,true},{1,1,1,1,false},{2,2,2,2,false}}      I'd like to find all lists that have the fifth element set to `true`. I'm looking for a general method that works for any lists in this format. How can I do this? In the above example, the result that I'm looking for would be:                {{0,1,0,1,true},{0,1,1,1,true}}      Sorry for such a basic question. I looked through the documentation for lists, and couldn't find a way to do this. I'm still fairly new at _Mathematica_.


title: Problem with Plot of Solution for NDSolve

text: I'm trying to plot the solution of an equation using NDSolve. For some reason nothing shows up in the plot. I checked the output of the interpolating function and it doesn't look like there is anything wrong with the data - though I could be wrong - so I'm just trying to figure out what is going on.                    q2 = NDSolve[{u'[ϕ] == -Sqrt[3 - 2 u[ϕ] ArcSech[1/u[ϕ]]/Sqrt[u[ϕ]^2 - 1]],                        u[1.494706195984861] == 3.208921901232091},                        u, {ϕ, 1.494706195984861, 20}]      Then when I use PolarPlot to plot the function, nothing appears:               s2 = PolarPlot[Evaluate[1/u[ϕ] /. q2], {ϕ, 1.494706195984861, 14.708465676522565},                    PlotRange -> All, PlotStyle -> Thick]      Thanks in advance for any help.


title: alignment of plots

text: I want to align my plots like I did with `Gird[]`. But you cracks here are using these short forms all the time. So, is there a way to achive this result in a better way? Here 's my code:               plots = DateListPlot[CountryData[#, {"Population", {1800, 2020}}],           PlotLabel -> "population of " <> #,ImageSize->250] & /@ {"Poland", "Austria",          "Switzerland", "India"};          GraphicsGrid[{{plots[[1]], plots[[2]]}, {plots[[3]], plots[[4]]}},       ImageSize -> 500]      With this I'll get ![The result I get with Grid\[\]](http://i.stack.imgur.com/uZhcJ.png) But I want to do something like this               GraphicsColumn@plots      ![enter image description here](http://i.stack.imgur.com/SsKYH.png) I don't like the column but I hope there's a way my code could look like this. Thanks to Kuba's comment this part of my question is answered: "And btw, is there a way to change the `ImageSize` here?"


title: ExpToTrig transforms solution to 4th order ODE into unwanted form

text: _Mathematica_ gives the solution of the second order differential equation                DSolve[a y''[x] + b*y[x] == 0, y[x], x]      in trigonometric form > >     {{y[x] -> C[1] Cos[(Sqrt[b] x)/Sqrt[a]] + C[2] Sin[(Sqrt[b] > x)/Sqrt[a]]}} >   In the fourth order case, _Mathematica_ gives the solution in exponential form, which I tried to convert into trigonometric form                 ExpToTrig[DSolve[a y''''[x] + b*y[x] == 0, y[x], x]]      > >      {{y[x] -> >           C[1] Cos[((1 + I) b^(1/4) x)/(Sqrt[2] a^(1/4))] + >           C[3] Cos[((1 + I) b^(1/4) x)/(Sqrt[2] a^(1/4))] + >           C[2] Cosh[((1 + I) b^(1/4) x)/(Sqrt[2] a^(1/4))] + >           C[4] Cosh[((1 + I) b^(1/4) x)/(Sqrt[2] a^(1/4))] + >           I C[1] Sin[((1 + I) b^(1/4) x)/(Sqrt[2] a^(1/4))] - >           I C[3] Sin[((1 + I) b^(1/4) x)/(Sqrt[2] a^(1/4))] - >           C[2] Sinh[((1 + I) b^(1/4) x)/(Sqrt[2] a^(1/4))] + >           C[4] Sinh[((1 + I) b^(1/4) x)/(Sqrt[2] a^(1/4))]}} >   The problem is that I get a solution with hyperbolic functions, but I know that solution can be represented in purely trigonometric form. Another problem is that I get an imaginary part from multiplication of the constants `I C[1]` and `I C[3]`, which I wouldn't have a with trigonometric function solution. How can I transform the solution to a form having only trigonometric functions?


title: analysing data with MLF using (Oracle) Database connection

text: I'm testing the MLF package in Mathematica for datamining purpose. I start the databaseconnectivity with the following code:               Needs["DatabaseLink`"]      DatabaseExplorer[]`      Using the DatabaseExplorer I write the next syntax:               data = SQLExecute[        SQLSelect[         "mens", {"PRAXIS_ZUIDOOST_DEF_V1_BASK"}, {SQLColumn[           "PRAXIS_ZUIDOOST_DEF_V1_BASK.RIJNUMMER"],           SQLColumn["DEF_V1_BASK.VOLGNUMMEER"],           SQLColumn["DEF_V1_BASK.RIJ_VOLGNUMMEER"],           SQLColumn["DEF_V1_BASK.NUMMER"],           SQLColumn["DEF_V1_BASK.DATUM"],           SQLColumn["DEF_V1_BASK.TRANS_NR"],           SQLColumn["DEF_V1_BASK.ARTIKEL"],           SQLColumn["DEF_V1_BASK.PRODUCTOMSCHRIJVING"],           SQLColumn["DEF_V1_BASK.FAMILY"],           SQLColumn["DEF_V1_BASK.OMZET"],           SQLColumn["DEF_V1_BASK.AANTAL"]}, None,          SortingColumns -> None, Distinct -> False, MaxRows -> 100000,          Timeout -> None, ShowColumnHeadings -> True,          GetAsStrings -> False]];      The result looks like this: > {{"name", "MAAND", "POSTCODE_SPAARDER", "EERSTE_TRANSACTIEDATUM_JAREN", > "STARTDATUM_JAREN", "LEEFTIJD", "GESLACHT", "GHOST_IND", "INACTIEFCODE", > "SALDO", "GEZINSAANTAL", "AANTAL", "AFDELINGNUMMER", "AFDELINGOMSCHRIJVING", > "SUM_OMZET", "SUM_AANTAL", "GEOTYPE", "GEOTYPE3_KLAS", "LEVENSFAS2", > "LEVENSFAS2_KLAS", "K_WON_EIG2", "K_WON_EIG2_KLAS", > "PRI_WONIN2","PRI_WONIN2_KLAS", "TUINEN", "TUINEN_KLAS"}, <<27411>>, > {"137088000", "DEC", "1363XW", 4., 15., 50., "V", "no ghost", "active", > 34100., 1., 1., <<3>>, 1., Null, Null, Null, Null, Null, Null, Null, Null, > Null,Null}} I would like to analyse this table with MLF. Therefore I start the package with the next syntax:               Needs["mlf`"]      As far as I know, the only way to import this data is               data3 = LoadData[data, "Table"];      In the tutorial they write: "LoadData returns a reference to a data structure called DataSet, which is required for all the algorithms of mlf." LoadData only works with a external table. Anyone a suggestion how to cooperate DatabaseLink with MLF?


title: Mathematica Library Link : How to use non standard 'mint' e.g. 'unsigned int' or 'long long int'

text: I use Mathematica 8.0.4 on Mac OSX 64 bit, and gcc as C compiler. I am trying to write a LibraryLink function that deals with large positive integers i.e. greater than $2^{31}-1$. By dealing with, I mean two different cases:   1. My function takes a large integer as input and/or returns a large integer as output   2. My function takes standard integers as input and output by produces intermediate large integers and therefore should probably declare and use `unsigned int` or `long long int` integer types. How can I do this? For 1. the available functions (`MArgument_getInteger(Args[i])` and `MArgument_setInteger(Res,i)`) seem to handle 32 bit integers ranging from $-2^{31}$ to $2^{31}-1$ only (`mint`). Is there a way to transfer different types of integers? For 2. I have tried to declare/use `unsigned int` or `unsigned long` or `long long int` local variables in the C functions, but either it does not compile or the declaration is somehow ignored and the integer is in fact considered a `mint`. In the `WolframLibrary.h` file, I tried to change the definition of `mint` from `int` to `unsigned long` for example, without success. I would like to stick to the LibraryLink framework, because apart from this problem, I find it relatively predictable and easy to implement. I am aware of the MathLink functions `MLGetInteger64()` and `MLPutInteger64()`, but MathLink on my machine has proven desperately buggy. I copy-pasted entire examples from Minimal effort method for integrating C++ functions into Mathematica and associated conversations and often it just did not work. I thought that because MathLink is by nature asynchronous, it is very sensitive to low level communication protocols among processes forever out of control. Additionally, the reason I use LibrayLink is speed. MathLink brings an overhead that I suspect would slow down the process.


title: Finding long strings of identical digits in transcendental numbers

text: ### Introduction Describing the three main streams of present-day mathematical philosophy (formalism, Platonism and intuitionism) in a well-known book, The Emperor's New Mind, R. Penrose says: > ...it will perhaps be helpful if I refer to just a few of the problems. An > example often referred to by Brouwer concerns the decimal expansion of $\pi > = 3.141592653589793...$ > > Does there exists a succession of twenty consecutive sevens somewhere in > this expansion, i.e. $$\pi = 3.141592653589793...77777777777777777777...$$ > or does there not ? > > In ordinary mathematical terms, all that we can say, as of now, is that > either there does or there does not—and we do not know which! This would > seem to be a harmless enough statement. However, the intuitionists would > actually deny that one can validly say "either there exists a succession of > twenty consecutive sevens somewhere in the decimal expansion of $\pi$, or > else there does not"—unless and until one has (in some constructive way > acceptable to the intuitionists) either established that there is indeed > such a succession, or else established that there is none! A direct > calculation could suffice to show that a succession of twenty consecutive > sevens actually does exist somewhere in the decimal expansion of $\pi$, but > some sort of mathematical theorem would be needed to establish that there is > no such succession. No computer has yet proceeded far enough in the > computation of $\pi$ to determine that there is indeed such a succession. > One's expectation on probabilistic grounds would be that such a succession > does actually exist, but even if the computer were to produce digits > consistently at the rate of, say, $10^{10}$ per second, it would be likely > to take something of the order of between one hundred and one thousand years > to find the sequence! ### The actual problem Since the above seems rather a bit beyond the scope of average computers I would like to find every sequence of length at least 10 of consecutive identical digits in the first $10^{9}$ digits of the decimal expansion of $\pi$. The solution would be better if it could be easily extensible to a multiple of $10^{9}$ digits, say the first $10^{10}$ digits of $\pi$. We shouldn't restrict to the decimal digits of $\pi$, but preferable solutions should work with any finite numbers of digits any transcendental numbers, e.g. $e^\pi, {\sqrt 2}^{\sqrt 3}$, etc. Techniques like parallelization, compilation, GPU support etc. are acceptable to achive any possibly efficient solutions. ### A step by step method not fulfilling expectations In case of $\pi$ we could e.g. try something like a "step by step" approach:               l2 = Split[ First @ RealDigits[Pi, 10, 10000000, -20000000]];     Position[ Length /@ l2, Max @ (Length /@ l2)]     l2[[#]] & /@ Flatten @ %     (* {{4193044}}     {{7, 7, 7, 7, 7, 7, 7, 7, 7}} *)      and               l4 = Split[ First @ RealDigits[Pi, 10, 10000000, -40000000]];     Position[ Length /@ l4, Max @ (Length /@ l4)]     l4[[#]] & /@ Flatten @ %     (* {{5113613}, {5996894}}     {{6, 6, 6, 6, 6, 6, 6, 6, 6}, {8, 8, 8, 8, 8, 8, 8, 8, 8}} *)      Here we found only succsessions of length `9`, so it is not exactly what I wanted but it helps to understand why this method suffers from time and memory problems, often yielding               No more memory available.     Mathematica kernel has shut down.     Try quitting other applications and then retry.      A "step by step" is too time-consuming because Mathematica needs to compute first decimal digits every time we want to proceed to the next step and the access time depends roughly linearly on number of steps, e.g. :               tunit = First[ Split[ First @ RealDigits[Pi, 10, 1000, -10000]]; // AbsoluteTiming];     timeT = 1/tunit Table[ First @ AbsoluteTiming[ Split[ First @ RealDigits[Pi, 10, 1000, -6000k]];],                           {k, 60}];     ListLinePlot[timeT]      ![enter image description here](http://i.stack.imgur.com/S0qoL.gif) Maybe some `Reap` and `Sow` approach or whatever else?


title: How can I insert the current date in a text cell?

text: Ok I must be missing something. I have a section with the "last updated date" in a text cell, I'd like it to autoupdate. Is there a "insert current date" command hidden away in some menu?


title: Optimizing evaluation time

text: I have the following code and it takes like foreeeeever to evaulate:               Table[Table[{If[closeN[[x]] > Max@priceRange[[y]], 1,          If[closeN[[x]] < Min@priceRange[[y]], -1, 0]],         DateString /@ Extract[date, Position[closeN, closeN[[x]]]]}, {x, 1,         Length[closeN]}], {y, 1, Length[priceRange]}]      What it basically does is looking when a price is greater (assigns a 1), smaller (a -1) or in between (0) a priceRange. It also extracts the date of the prices from closeN. I always do it in this way, but I realize it might not be an optimal and fast way. Any ideas or assumptions how to optimize the evaluation time? here is a small subset:               date={{2000, 2, 2, 0, 0, 0.}, {2000, 2, 3, 0, 0, 0.}, {2000, 2, 4, 0, 0,            0.}, {2000, 2, 7, 0, 0, 0.}, {2000, 2, 8, 0, 0, 0.}, {2000, 2, 9, 0,            0, 0.}, {2000, 2, 10, 0, 0, 0.}, {2000, 2, 11, 0, 0, 0.}, {2000, 2,            14, 0, 0, 0.}, {2000, 2, 15, 0, 0, 0.}}             closeN= {0.9766, 0.9899, 0.9838, 0.981, 0.9861, 0.9933, 0.9852, 0.9808,         0.9791, 0.9816}          priceRange={{0.8273}, {0.8301}, {0.8394, 0.8354, 0.8363, 0.8393, 0.8383,        0.8396}, {0.8437, 0.8425, 0.8401, 0.844, 0.84, 0.8449, 0.8444,        0.8445}, {0.8494, 0.8491, 0.8485, 0.845, 0.8483, 0.8463, 0.8468,        0.8499, 0.8478, 0.8474, 0.8466, 0.8483, 0.8489}, {0.8532, 0.8546,        0.8517, 0.8507, 0.8545, 0.8541, 0.851, 0.8527, 0.8549, 0.8517,        0.8511, 0.8534, 0.8541, 0.8541, 0.8528}, {0.8587, 0.857, 0.8585,        0.8557, 0.8579, 0.8567, 0.8579, 0.8561, 0.8575, 0.8558, 0.8573,        0.8561, 0.8555, 0.8554, 0.8557, 0.855, 0.8581, 0.8596, 0.8598,        0.8559, 0.8582, 0.855, 0.8596, 0.8593}, {0.8639, 0.8601, 0.8646,        0.861, 0.863, 0.8612, 0.8635, 0.8608, 0.8611, 0.8617, 0.8606,        0.8631, 0.8608, 0.8608, 0.8636, 0.8618, 0.8622, 0.8621,        0.8638}, {0.867, 0.8695, 0.8687, 0.8685, 0.8655, 0.8677, 0.8662,        0.8657, 0.8695, 0.8652, 0.865, 0.8698, 0.8672, 0.8668, 0.8694,        0.8691, 0.866, 0.8693, 0.8655, 0.8699}, {0.8717, 0.8725, 0.8747,        0.8721, 0.8729, 0.8747, 0.8736, 0.8722, 0.8719, 0.8732, 0.8747,        0.8703, 0.8729, 0.871, 0.8742, 0.8736, 0.8706, 0.8704, 0.8717,        0.8747, 0.8726, 0.8713, 0.8723, 0.8747}}      here is whole the data (just copy it into mathematica and evaluate, then it should work): closeN: https://dl.dropboxusercontent.com/u/19921198/closeN.txt date: https://dl.dropboxusercontent.com/u/19921198/date.txt priceRange: https://dl.dropboxusercontent.com/u/19921198/priceRange.txt


title: how to differentiate formally?

text: I have been wrapping my head around this for a while now and I have not found a solution so far. I want to work with an arbitrary number of variables in mathematica and use some built in functions. To make things more specific for starters I want to do the following: Define a sum with n summands each containing a new variable x[i] (in the i-th summand):               sum[n_] = Sum[i*x[i], {i, 1, n}]      Then I want to differentiate the expression with respect to some x[i] like:               D[sum[n],x[2]]      Mathematica returns 0 instead of 2. If I supply a specific n like:               D[sum[2],x[2]]      everything works fine. I thought about using Assumptions for n, but with no success so far. How can I do that right?


title: How to make a multi-peak histogram fitting

text: I got a multipeak histogram from my data and want to fit it using a Gaussian Distribution function.               (f[x_, amplitude_, centroid_, sigma_] :=          amplitude Exp[-((x - centroid)^2/sigma^2)])      However, there are two peaks. How do I fit the histogram and get the two sets of values `{amplitude1, centroid1,sigma1}` and `{amplitude2, centroid2,sigma2}`?


title: Simplify equations with pattern assumptions

text: When simplifying an expression using `Simplify[expr, assumptions]`, the assumptions has to be explicit. Is it possible to simplify an expression with pattern assumptions? (`TransformationFunctions` can satisfy some of the needs, but it is not always functional as in the following examples.) For example               psimp[Sqrt[a[t]^2], a[m_] > 0]      > a[t]               psimp[f[x] (1 + a) (1 + b) == 0, f[a_] != 0]      > (1 + a) (1 + b) == 0               psimp[(d[t] + b[t] + c[t])^2 + (d[m] + b[m] + c[m])^3 + a[n] + x[n] //        Expand, {d[f_] + b[f_] + c[f_] == a[f], a[n] + x[n] == s}]      > s + a[m]^3 + a[t]^2               psimp[g[x, y]*Derivative[0, 1][f][x, y] + f[x, y]*Derivative[0, 1][g][x, y],       (g_)[x_, y_]*Derivative[0, 1][f_][x_, y_] + (f_)[x_, y_]*Derivative[0, 1][g_][x_, y_] == Defer[D[f[x, y]*g[x, y], y]]]      > D[f[x, y]*g[x, y], y]


title: Programmatically combine 2D contour plots with 1D projections

text: I regularly need to plot 2D and 1D data together. I want to be able to show a 2D contour plot with the projections along each of the axes. As it is now, I create the three plots separately and use Inkscape to combine them. The problem with this is twofold. First, it is cumbersome if I have to do it over and over. Second, I have to use my eyes to move the 1D plot so that its features line up properly with the 2D data. As a simple working example, consider this 2D array of data               xRange = {8, 19};          yRange = {6, 16};          twoDlist =        Table[Abs[         I/(ω1 - 14 + I) I/(ω2 - 11 + I) + (           I/3)/(ω1 - 8 + I/3) I/(ω2 - 16 + I)], {ω1,          yRange[[1]], yRange[[2]], .05}, {ω2, xRange[[1]],          xRange[[2]], .05}];      From this I generate the 2D and 1D plots.               topplot =        ListLinePlot[Total[twoDlist], Axes -> False, DataRange -> xRange,         PlotStyle -> {{Thick, Red}}, PlotRange -> {Full, All}];          rightplot =        ListLinePlot[Total /@ twoDlist, Axes -> False, DataRange -> yRange,         PlotStyle -> {{Thick, Red}}, PlotRange -> All];          contourplot =        ListContourPlot[twoDlist, DataRange -> {xRange, yRange},         ContourShading -> None, Contours -> 20,         PlotRange -> {Full, Full, All},         ContourStyle ->          Table[Blend[{Blue, Green, Yellow, Red}, n], {n, .05, 1, .05}]];      Now I would like to combine them in such a way to get an image like this one: ![enter image description here](http://i.stack.imgur.com/VetVn.png) How can I do this? Ideally, I want to end up with a plotting function that takes `twoDlist`, `xrange`, and `yrange` as arguments. Thanks in advance. ETA: So I saw the other thread (http://mathematica.stackexchange.com/q/2984/5) and while I thought that would answer my question it really didn't. There the 2D plot was an x-y scatter and the 1D plots were histograms. The first solution offered at that page answers the question in a specific way that isn't what I'm going for. They in essence created three graphics objects and then stuck their corners together. No matter how I mess with their function, I can't get it to give what I'm looking for. I can't really understand how the Graphics and Inset functions work together there, and the issue is compounded by the fact that I want tick labels on the contour plot directly, as in the image above. The second solution listed on that page just isn't for the data type that I have. That DenstityHistogram has such a cool option as "DistributionAxes" is great, but I need to build the equivalent for this data type. Here is the progress I've made after looking at that page. Basically I rescale the 1D data sets so that when they are plotted they are in the same region as the 2D plot. Then I wrap them in a Show command. With xRange, yRange, and twoDlist defined as above, this code               combinedplot[data_, xrange_, yrange_] :=           Module[{rightdata, topdata, xspan, yspan, dx, dy, contourplot, rightplot, topplot},      rightdata = Total /@ data;      topdata = Total[data];      xspan = (xrange[[2]] - xrange[[1]]);      yspan = (yrange[[2]] - yrange[[1]]);      dx = xspan/(Length[topdata] - 1.0);      dy = yspan/(Length[rightdata] - 1.0);      rightdata = (rightdata - Min[rightdata])/(Max[rightdata] -    Min[rightdata]);      rightdata = rightdata*(xspan/5.0) + xrange[[2]];      rightdata =  Transpose[{rightdata, Table[n, {n, yrange[[1]], yrange[[2]], dy}]}];      topdata = (topdata - Min[topdata])/(Max[topdata] - Min[topdata]);      topdata = topdata*(yspan/5.0) + yrange[[2]];      contourplot = ListContourPlot[data, DataRange -> {xrange, yrange}, ContourShading -> None, Contours -> 20, PlotRange -> {Full, Full, All},     ImagePadding -> {{Automatic, Scaled[0.05]}, {Automatic, Scaled[0.05]}},  ContourStyle -> Table[Blend[{Blue, Green, Yellow, Red}, n], {n, .05, 1, .05}], ImageSize -> 500, BaseStyle -> 30];           rightplot = ListLinePlot[rightdata, PlotStyle -> {{Red, Thick}}, Axes -> False, PlotStyle -> {{Thick, Red}}, PlotRange -> All];           topplot = ListLinePlot[topdata, PlotStyle -> {{Red, Thick}}, DataRange -> xrange, Axes -> False, PlotStyle -> {{Thick, Red}}, PlotRange -> All];           Show[contourplot, rightplot, topplot, PlotRange -> All]];          combinedplot[twoDlist, xrange, yrange]      generates this plot: ![enter image description here](http://i.stack.imgur.com/Y5FFm.png) which is _not quite_ what I'm looking for. In order for it to show the 1D plots, the PlotRange for the contour plot has to be extended, and then it displays tick marks out where they don't make any sense. This can be solved by using the CustomTicks package, but this only gets me here: ![enter image description here](http://i.stack.imgur.com/LEu3G.png) which again is not quite right. I want to end up with the 1D plots outside the frame of the 2D contour plot. Any suggestions? Thanks in advance.


title: Plotting 2D function and other 3D functions coincidently

text: `ContourPlot3D[{x^2 + y^2 == z, 2 y == z, x^2 + (y - 1/2)^2 == 1}, {x, -2, 2}, {y, -0.5, 1}, {z, 0, 2}]` The above isn't what I'm seeking. I'd like to plot $x^2 + (y - 1/2)^2 = 1$ in 2D, so as a circle on the xy-plane ($z = 0$), in the same graph as the other two functions that I'd like in 3D. How would I do this? halirutan's answer nearly resolves this, but his plot still contains $x^2 + (y - 1/2)^2 = 1$ in 3D for all $z$.   I want solely the trace in the xy-plane, for the combined plot of all 3 functions.


title: How to replace identical positions in two different lists

text: Assume that I have two lists like : `list1={1,2,3,4,5}; list2={a,b,c,d,e};` I want to replace some elements from `list1` into `list2` and make a new list, `NewList`. For example, I want to replace the elements of `list1` from position 1 and 5, with the elements of `list2` with the same positions. The result will be : `NewList={1,b,c,d,5};` Is there any way to do that ?!


title: Customizing individual labels in a pie chart

text: How do you individually rotate labels on a pie chart? For example, I have this chart detailing money composition.               Chart2 = PieChart[{10, 5, 22, 63}, ImageSize -> Large,        ChartLabels ->         Placed[{"Gold (10%)", "Silver (5%)", "Currency (22%)",           "Demand Deposits (63%)"}, "RadialCenter",          Rotate[#, 45 Degree] &], BaseStyle -> {FontSize -> 20}]      How can I alter my code to only rotate and change the fontsize of certain labels?


title: Using Button to display dynamic graphics

text: I have a `DynamicModule` with several graphic elements. I would like to create a button which would change a parameter and re-run the entire module. Say that we have               h := Plot[Sin[k*x], {x, 0, 10}]      with an initial value of `k = 1`. I want to create `Button["Increase k", k = k + 1; h]` that would run the plot (without using `Print[h]` as `h` is really a large `DynamicModule`).


title: UnitSimplify returns unexpected non-SI unit combination

text: I am trying to get units working in mathematica in the following expression for diffusion: $D = {K_B T}/{3 \pi \eta L}$ My code is as follows:               KB = Quantity[1.380650*10^-23, ("Meters")^2*"Kilograms"*("Seconds")^-2*("Kelvins")^-1];     T = Quantity[20 + 273.15, "Kelvins"];     eta0 = Quantity[8.9*10^-4, "Pascals"*"Seconds"];     L = Quantity[200*10^-9, "Meters"];          D = (KB*T)/(3*Pi*eta0*L)      This evaluates to: $2.41258\times10^{-12}\,\text{kg}\, \text{m}\text{/(}\text{s}^3\text{Pa})$ Which under `UnitSimplify` reduces to: $2.41258\times10^{-12}\,\text{V}/\text{T}\,\, ... \,\,(volts\,per\,tesla??)$ for diffusion coefficients I am expecting units of $meters^{2}/second$. Can anyone see whats gone wrong? Thanks


title: Fast method for combining two lists

text: I have two lists, `v1` and `v2`. Each element of the lists may be positive or negative. I want to create a list `v3` whose entry `i` is `v1[[i]]` if `v1[[i]]` is posive, but otherwise is `v2[[i]]`. The trivial way to implement this is to use a `For`-loop with `If`. Is there any faster way? I tried using logical operator:               vP = Boole[Positive[v1]];      vN = Boole[Negative[v2]];     v3 = vP v1 + vN v2;      I tought that using logical operations would be faster than going through indices, but instead it is slower. What would be a fast way to do this?


title: Best way to represent a joint distribution

text: The motivation for this question is producing a distribution that produces the gender and age of an individual when the distribution of ages depends on gender. Suppose I want a distribution which, when RandomVariate is applied to it, produces two values. The first value it produces is either 0 or 1 and the second value it produces is some real value between 0 and 65. But the second value is correlated with the first. By way of example, it might be the case that when the first value is 0, the second value tends to be lower than the when the first value is 1. I want the end product to be a distribution, so that one could apply things such as CDF to it. Obviously, the gender distribution can be modeled as a BernoulliDistribution. And, as it happens I know how to model the age distribution conditioned on the person being a male and the age distribution conditioned on the person being a female. But how do I put them together? I've looked at CopulaDistribution and, while conceptually it might be appropriate, I don't see the kind of kernel I would need. I have the feeling I am being stupid and that there is some obvious and elegant representation of this situation, but, at the moment, it escapes me. Help appreciated.


title: How can I get dotted boundaries on a RegionPlot?

text: How do I plot something like $$\{(x,y): 1 \leq x^2 + y^2 < 9\}?$$ I want to be able to make the boundary $x^2 + y^2 = 9$ dotted line and the unit circle filled and coloured region in between? I tried using               RegionPlot[1 <= x^2 + y^2 < 9, {x, -3.5, 3.5}, {y, -3.5, 3.5},        Frame -> False, AxesOrigin -> {0, 0}, Axes -> True]      But that gave me a bolded boundary on $x^2 + y^2 = 9$


title: Replacing variable in an equation with an Interpolating function polynomial and plotting residual

text: I was trying to plot the residual for the solution of my PDE. However, I was unsure about a couple of things.   1. I imported the data and created an Interpolation polynomial with `ListInterpolation`   2. I am trying to replace the dependant variable `h` in my equation with the interpolation polynomial, `solution` using `replace` or `/.`   3. I would need to plot this equation for different/consecutive steps in time to see what the residual looks like. (`residual = equation(t) - equation(t-1)`) Either all this or is there any way I could just generate the residual from some magic mathematica function? Should I be defining something as a function of time, which is one of the arguments (? is this the right word) in the interpolating function polynomial? The notebook and data files are **attached** for anyone's convenience. I can't seem to put my finger on the problem but I can't plot the residuals. I apologize if the question is sophomoric but I can't seem to master mathematica at all like other programming environments. # Minimum working example: ## Equation solver (script file)               #!/usr/local/bin/MathematicaScript -script          $HistoryLength=0;         $pwf=$InputFileName;     Needs["VectorAnalysis`"]     Needs["DifferentialEquations`InterpolatingFunctionAnatomy`"];     Clear[Eq0,EvapThickFilm,h,Bo,\[Epsilon],K1,\[Delta],Bi,m,r]     Eq0[h_,{Bo_,\[Epsilon]_,K1_,\[Delta]_,Bi_,m_,r_}]:=\!\(     \*SubscriptBox[\(\[PartialD]\), \(t\)]h\)+Div[-h^3 Bo Grad[h]+h^3 Grad[Laplacian[h]]+(\[Delta] h^3)/(Bi h+K1)^3 Grad[h]+m (h/(K1+Bi h))^2 Grad[h]]+\[Epsilon]/(Bi h+K1) + (r)D[D[(h^2/(K1+Bi h)),x] h^3,x] ==0;     SetCoordinates[Cartesian[x,y,z]];     EvapThickFilm[Bo_,\[Epsilon]_,K1_,\[Delta]_,Bi_,m_,r_]:=Eq0[h[x,y,t],{Bo,\[Epsilon],K1,\[Delta],Bi,m,r}];     TraditionalForm[EvapThickFilm[Bo,\[Epsilon],K1,\[Delta],Bi,m,r]];               L=79.5788; TMax=12500*100;     Off[NDSolve::mxsst];     Clear[Kvar];     Kvar[t_]:=  Piecewise[{{1,t<=1},{2,t>1}}]     (*Ktemp = Array[0.001+0.001#^2&,13]*)     hSol=h/.NDSolve[{     (*Bo,\[Epsilon],K1,\[Delta],Bi,m,r*)          EvapThickFilm[0,1*10^-6,1,0.001,1,2*0.025,0],     h[0,y,t]==h[L,y,t],     h[x,0,t]==h[x,L,t],     (*h[x,y,0] == 1.1+Cos[x] Sin[2y] *)     h[x,y,0]==1+(-0.05 Cos[2\[Pi] x/L] -0.05 Sin[2 \[Pi] x/L])(Cos[2\[Pi] y/L])     },     h,     {x, 0, L},     {y,0, L},     {t, 0, TMax},     Method->{"LSODA","MaxDifferenceOrder"->12},     MaxStepFraction->1/50,     PrecisionGoal->3     ][[1]]                         {TMin,TRup}=InterpolatingFunctionDomain[hSol][[3]];     hSolGridData=InterpolatingFunctionValuesOnGrid[hSol];     hSolCoords=InterpolatingFunctionCoordinates[hSol];     finalStep=InterpolatingFunctionCoordinates[hSol][[3]];     (*rupture=NumberForm[N[TRup/100],6];*)     rupture=TRup/100;          $parameterfile=StringJoin[$pwf,".dat"];     Export[$parameterfile, {0, 100, 0, 0.0001, 35.1, 7.02, 0, 3, 1, 5, SetPrecision[rupture,5]}];         $matfile=StringJoin[$pwf,".mat"];         Export[$matfile,hSolGridData];     (*Exports time step data*)     $timefile=StringJoin[$pwf,"_time",".mat"];     Export[$timefile,InterpolatingFunctionCoordinates[hSol][[3]]];          hGrid = InterpolatingFunctionGrid[hSol];     {TMin,TRup}=InterpolatingFunctionDomain[hSol][[3]];     Length[hGrid];     {nX,nY,nT}=Drop[Dimensions[hGrid],-1];          fac=0.98;               $epsfile0=StringJoin[$pwf,"_0",".eps"];     $pngfile0=StringJoin[$pwf,"_0",".png"];     $epsfileRup=StringJoin[$pwf,"_TRup",".eps"];     $pngfileRup=StringJoin[$pwf,"_TRup",".png"];     ic=Plot3D[hSol[x,y,0*TRup],{x,0,L},{y, 0, L},          PlotRange->{{0,L},{0,L},{0,3.5}},     BaseStyle->{FontWeight->"Plain",FontSize->18},     PlotPoints->65,     ColorFunction->GrayLevel     ];     Export[$epsfile0,ic,ImageSize->{350,350}];         Export[$pngfile0,ic,ImageResolution->350];     rupProfile=Plot3D[hSol[x,y,fac*TRup],{x,0,L},{y, 0, L},          PlotRange->{{0,L},{0,L},{0,3.5}},     BaseStyle->{FontWeight->"Plain",FontSize->18},     PlotPoints->65,     ColorFunction->GrayLevel     ];     Export[$epsfileRup,rupProfile,ImageSize->{350,350}];         Export[$pngfileRup,rupProfile,ImageResolution->350];          dataxy=Import[$matfile];         datat=Import[$timefile];               (*$epsfile0=StringJoin[$pwf,"_0_dft",".eps"];     $pngfile0=StringJoin[$pwf,"_0_dft",".png"];     $epsfileRup=StringJoin[$pwf,"_TRup_dft",".eps"];     $pngfileRup=StringJoin[$pwf,"_TRup_dft",".png"];     FDataFirst=Abs[Fourier[dataxy[[All,All,1]]]];     dftfirst=MatrixPlot[FDataFirst]*)      ## Data collection where I try to "replace" dependant variable with inter. polynomial               $HistoryLength = 0;     Needs["VectorAnalysis`"]     Needs["DifferentialEquations`InterpolatingFunctionAnatomy`"];     L = 79.5788;     dataxy = Import[        "/home/dnaneet/Desktop/residuals/L_lambda_max_1wl_zg_E_0001_Cos.\     mat"];     datat = Import[        "/home/dnaneet/Desktop/residuals/L_lambda_max_1wl_zg_E_0001_Cos_\     time.mat"];     solution = ListInterpolation[dataxy, {{0, L}, {0, L}, Flatten[datat]}];     trup = Max[Flatten[datat]]     tsrup = Ceiling[        0.95 Flatten[Position[Ceiling[Flatten[datat]], Ceiling[trup]]]];     ts = tsrup[[1]];          Clear[Eq0, FilmEqn, h, Bo, \[Epsilon], K1, \[Delta], Bi, m, r]     Eq0[h_, {Bo_, \[Epsilon]_, K1_, \[Delta]_, Bi_, m_, r_}] := \!\(     \*SubscriptBox[\(\[PartialD]\), \(t\)]h\) +         Div[-h^3 Bo Grad[h] +           h^3 Grad[Laplacian[h]] + (\[Delta] h^3)/(Bi h + K1)^3 Grad[h] +           m (h/(K1 + Bi h))^2 Grad[h]] + \[Epsilon]/(        Bi h + K1) + (r) D[D[(h^2/(K1 + Bi h)), x] h^3, x] /.        h -> solution[All, All, xtime]     SetCoordinates[Cartesian[x, y, z]];     FilmEqn[Bo_, \[Epsilon]_, K1_, \[Delta]_, Bi_, m_, r_] :=        Eq0[h[x, y, t], {Bo, \[Epsilon], K1, \[Delta], Bi, m, r}];          TraditionalForm[      FilmEqn[0, 10^-6, 1, 10^-3, 1, 0.05,        0]](*Eqn=Simplify[FilmEqn[0,10^-6,1,10^-3,1,0.05,0]];*)      The film plot should look like this: ![Plot obtained from Plot3D](http://i.stack.imgur.com/NhQoo.png) My interpretation of the **residual** Any thoughts or comments? > >     Plot3D[ >      solution[x, y, 100000] - solution[x, y, 99999], >      {x, 0, L}, >      {y, 0, L} >      ] >   ![Residual - the value is about 10^-6 ..ish](http://i.stack.imgur.com/tcxqm.png)


title: Determine the 2D-Fourier transform of an Image

text: I am new to Mathematica and using Version 8.0. I want to calculate the 2D-Fourier Transform of a digital image and see its Magnitude and Phase Spectrum, and reconstruct it.


title: semantics of `ContinuousAction` on a slider. Mouse release

text: I needed to make 2 slider inter-dependent. Slider `b` in this example can't be larger than slider `a`. When I move slider `b` and release the mouse it will snap back if it stopped at a value larger than current value of `a` slider. I noticed this works first time. But when I move the slider `b` again, it no longer snaps back. I found this is becuase I had `ContinuousAction -> False`. But this should not have this effect. This option says that _while I am sliding_ there should be no update to the Manipulate expression. So, once I have released the mouse, my snap logic code should execute each time. In this example below I show that it does not. Do you think this behaviour is correct? I think it is not. I needed to have the `ContinuousAction -> False` there for other reasons (I do not want large computation to occur while I am moving the slider, only when I release the slider). Here is an example that works. Notice no use of `ContinuousAction -> False`, hence the default is `True`               Manipulate[      {a, b},           Grid[{{         "a", Manipulator[Dynamic[a,{a = #; If[b > a, b = a]} &], {1, 10, 1}], Dynamic[a]         }, {         "b", Manipulator[Dynamic[b,{b = #; If[b > a, b = a]} &], {1, 10, 1}], Dynamic[b]         }}],      {{a, 5}, None},      {{b, 3}, None}      ]      You can move the slider `b` to the right as much as you want, release the mouse, and keep doing that. It will never go pass the value in `a`. Now see what happens with this example:                Manipulate[      {a, b},           Grid[{{         "a", Manipulator[Dynamic[a,           {a = #; If[b > a, b = a]} &], {1, 10, 1},ContinuousAction -> False], Dynamic[a]         }, {         "b", Manipulator[Dynamic[b,           {b = #; If[b > a, b = a]} &], {1, 10, 1},ContinuousAction -> False], Dynamic[b]         }}],      {{a, 5}, None},      {{b, 3}, None}      ]      Move the slide `b` again. The **first time** you'll notice the snaps back. But now try to move it again to the right, and you'll see it does not snap back again. The logic inside the Dynamics is not being called. **Question** : Do you think this behaviur is correct based on the help: `With ContinuousAction->False, updates are supplied only when the controls are in their final position, say as determined by the release of a mouse button.` For me, the above says one thing, and what I see is something else. What seems to happen is that Mathematica takes the second movement of the same slider as part of the first movement. Even though one has released the mouse in between. But these should be separate movement and not one continuous one. thanks


title: How can `SquareWave` be used as the input in `OutputResponse`?

text: I'd like to compute the response of a `TransferFunctionModel` when driven by a `SquareWave`. Here's a simple example,               or = OutputResponse[TransferFunctionModel[1/(s + 1), s], SquareWave[t], t];      which results in two copies of the error: > Reduce::nsmet: This system cannot be solved with the methods available to > Reduce. >> Oddly, `or` still gets set to               {(-1 + Piecewise[{{-E^t, Inequality[1/2, LessEqual, Mod[t, 1], Less, 1]}}, E^t])/E^t}      which looks like this: ![enter image description here](http://i.stack.imgur.com/4y4xB.png) and is the correct response of the system to `UnitStep[t]`, but multiplied by `SquareWave[t]`. How can `OutputResponse` be used to find the response of a `TransferFunctionModel` driven by a `SquareWave`?


title: Is there any way to define pure functions with optional arguments?

text: For example consider the following function:               Function[{u,v},u^2+v^4]      Is there anyway to define default values for the variables `u` and `v`? I know that this is possible for ordinary functions as follows:               f[u_:1,v_:0]:=u^2+v^4      But I am looking for a way to do this with pure functions defined by `Function[]`.


title: What is the fastest way to count square-free words?

text: ## Background A word is a string of letters in an alphabet. A square-free word has no adjacent repeating substring. For example, (in the ternary alphabet of {0,1,2}) the words 00, 012121, and 0212012021 are all not square-free because they contain repeated subwords, but a word like 1201021 or 0102012021 is square-free. Here is code to test if a string over the alphabet {0,1,2} is square-free, but it is too slow:               ReverseWord[w_String] :=             StringReverse[w];     PermuteWord[w_String] :=             StringReplace[w, {"0" -> "1", "1" -> "2", "2" -> "0"}];     SubWords[w_String, len_Integer] :=             Module[{i}, Union[Table[StringTake[w, {i, i + len - 1}],            {i, StringLength[w] - len + 1}]]];     NoSquare[w_String] /; Mod[StringLength[w], 2] == 0 :=             (StringTake[#, StringLength[#]/2] =!=StringTake[#, -StringLength[#]/2]) &[w];     SquareFree[w_String] :=             Apply[And, Table[Apply[And, Map[NoSquare, SubWords[w, k]]],                              {k, 2, StringLength[w], 2}]];          SquareFree["0101"] (* returns False *)     SquareFree["0102012021"] (* returns True *)      I'm sure there are some wizards out there that knows the fastest way to do this! Here is a big squarefree word to test your fast functions on:               benchmark = Uncompress@"1:eJzt0sEJgDAQRNGUoh3sbinagQ3Y/\     03ISYIQQoSvzJ5UIknm7azHue1lKcXcws2jPuP2bvUrHtdj8P92vd3n7fN7+3/9/rPnz/\     rQ9//7/Gl/Oj/dH9qf9sv5a/vT+en+0P60X85f25/OT/dH3Z/OT/dH3Z/OT/\     eH9qf9cv7a/nR+uj+0P+2X89f2p/PT/aH9ab+cv7Y/nZ/uj7o/nZ/uj7r/\     wP0uYjwiEQ==";      ## Problem The ultimate way to determine square-freeness of words is to enumerate them! So the real problem is to generate all ternary squarefree words of length n efficiently. Here was my original implementation: the function ExtendSquareFreeQ[w] checks if word w is squarefree assuming that StringTake[w, 1;;-2] is squarefree. Then, starting from the list AllSquareFree4, we build up the next AllSquareFree5, and so forth...               iExtendSquareFreeQ = Compile[{{str, _Integer, 1}},            Module[{sl = Length[str]/2 // Floor, i},               For[i = 2, i <= sl, i++,                  If[Take[str, {-2 i, -(i + 1)}] === Take[str, {-i, -1}],                      Return[False]]                  ];                 True                 ], CompilationTarget -> "C", RuntimeOptions -> "Speed",                  RuntimeAttributes -> {Listable}, Parallelization -> True                ];      ExtendSquareFreeQ[str_String] := iExtendSquareFreeQ[ToCharacterCode[str]];       DistributeDefinitions[ExtendSquareFreeQ];           ExtendAllSquareFree[list_] := Module[             {cand, sfcand},              cand = Flatten @ Map[                 Function[w,                     Function[s, StringJoin[w, s]] /@                      Complement[{"0", "1", "2"}, {StringTake[w, -1]}]                     ],                     list               ];               sfcand = ParallelMap[ExtendSquareFreeQ, cand];               Pick[cand, sfcand]           ];          AllSquareFree2 = {"01"};     temp = AllSquareFree2;     byteCounts = {};     times = {};     Monitor[Table[       {time, temp} = AbsoluteTiming[ExtendAllSquareFree[temp]];       temps = Compress@temp;       AppendTo[times, time];       AppendTo[byteCounts, ByteCount[temps]/1000000];, {n, 2, 111}],       ListPlot[{times, byteCounts}, Mesh -> Full,        PlotRange -> {Automatic, All}, Filling -> Axis,       AxesLabel -> {"n", None}, InterpolationOrder -> 2, Joined -> True,        PlotLabel -> Text@Row[{           "n: " <> ToString[n],           "count: " <> ToString[Length[temp]*6],           "time: " <> ToString[N[time, 2]] <> " s",           "mem: " <> ToString[N[byteCounts // Last, 2]] <> " mB"},           " | "]]]       But both the time and memory complexities are way too high for $n>60$. Is there a much more efficient way to perform this search? Perhaps storing the lists of strings in special data structures and traverse them in fancy ways? I'll take any solutions of linear or quadratic complexity, or that can reach $n >= 111.$ **The main difficulty is that when storing all the words of length 63 _Mathematica_ runs out of memory!** I was hoping for some brilliant optimized data structures, but I guess I might just have to use a tree...


title: Fitting data using a series of Sin and Cos

text: I have the following data representing the normal displacement caused by a normal load applied at the middle cross section of a cylinder: ![enter image description here](http://i.stack.imgur.com/QZEzP.png) I've made the data available here. I am trying to fit using the function: $$ w=\sum_{i=1}^{n} A_{i}\cdot sin(j\theta)+B_{i}\cdot cos(j\theta) $$ where $A_{i}$ and $B_{i}$ are the unknown amplitudes to be found. I am using `LeastSquares` for this task:               theta = data[[All, 1]];     w = data[[All, 2]];          num = Dimensions[theta][[1]];     n = 5;          m = Table[        Flatten[Table[{Sin[i1*theta[[i2]]], 0}, {i1, 1, n}]] +          Flatten[Table[{0, Cos[i1*theta[[i2]]]}, {i1, 1, n}]], {i2, 1,          num}];     x = LeastSquares[m, w];          f[t_] := Total[Flatten[Table[{Sin[i*t], Cos[i*t]}, {i, 1, n}]].x]     Plot[f[t], {t, -Pi, Pi}, PlotRange -> {{-1, 1}, {0, 0.030}}]      But it is resulting in an empty graphic: ![enter image description here](http://i.stack.imgur.com/ULsc8.png) Does anyone know what I am doing wrong?


title: Generating an ordered list of pairs of elements from ordered lists

text: I have a pair of ordered lists. I want to generate a new ordered list (using the same ordering) of length n by applying a binary operator to pairs of elements, one from each list, along with the index of each list's elements. For example, if I have two lists of real numbers in increasing order (sorted via Less),               l1 = {5.7832, 30.4713, 74.887, 139.04, 222.932, 326.563}          l2 = {3.481, 9.2816, 15.7112, 27.8226, 45.0379, 67.222, 94.3526}      and the binary operator is Plus, then if I ask for 5 elements, the result would be               {{9.26417, 1, 1}, {15.0647, 1, 2}, {21.4944, 1, 3}, {33.6058, 1, 4}, {33.9522, 2, 1}}      I've written code that achieves this but I'm looking for the most elegant, efficient, and general solution that would work with arbitrary lists and binary operators.


title: Is it possible to separately call the default value of a variable which isn't at the end of the sequence?

text: After reading this post I recalled an old question I once met. We know that we can set default values for variables of a function:               f[u_: 1, v_: 2, w_: 3] := u^2 + v^3 + w^4      We can use the default values like this:               f[]      > 90 like this:               f[u]      > 89 + u^2 and like this:               f[u, v]      > 81 + u^2 + v^3 However, what if I want to call the default value of a variable not at end separately? Something like               f[, v, w]      only gives > Null^2 + v^3 + w^4 while what I want to see is > 1 + v^3 + w^4 Of course it's easy to circumvent, but I still wonder if there's a more straight forward solution.


title: How can I influence the elements plotted in a BubbleChart depending on the tuple plotted?

text: In a BubbleChart, how can influence the elements plotted depending on a value in the tuple plotted? I want to create a BubbleChart from the following data:                lines = {{1, 10, 2}, {2, 15, 1}, {3, 27, 4}, {4, 35, 2}}      but instead of the bubbles, I want to draw a line as long as `z`.


title: How to force Dt[ ] to recognize dependencies

text: I want to differentiate a function `f[]` for which I don't have a specific expression. `f[]` depends on `x` and `y` and has parameters k1 and k2 in it. `x` and `y` depend on `t`,and not on `k1` nor `k2`. So when I use the total derivation operator `Dt[f, t]`, only `x` and `y` should be differentiated. But how can I say Mathematica that k1 and k2 are constant, without assigning values to them?


title: PlotRangePadding that's a fixed fraction of a plot's longest dimension

text: I am trying to produce plots of a region which can alternately become very long or very tall, and I would like to have some padding around it which is uniformly thick in both the horizontal and vertical directions. However, I'm having some trouble getting the correct settings for `PlotRangePadding` to achieve this. More specifically, I'm trying to get a padding between my plot and the surrounding Frame that is (say) 10% of the _longest_ dimension of my plot. This is what I might naïvely expect of a single setting fed to the option, which is meant to produce "the same padding in all directions", but giving it the corresponding setting,               Graphics[{Pink, Rectangle[{0, 0}, {1, 0.1}]},          PlotRangePadding -> Scaled[0.1], Frame -> True]      produces a padding of 10% of the relevant dimension in each direction. This is not very visually pleasing, as the long coordinate has too much padding and the short coordinate has too little padding: ![](http://i.stack.imgur.com/r1XzX.png) Is there a way to automatically achieve such a scaled uniform padding? Note that manually setting different settings for the different directions, such as `PlotRangePadding -> {Scaled[0.02], Scaled[0.2]}` is not an option, as my plots are dynamically generated, and may change from 'long' to 'square' to 'tall'. The coordinate ranges can also change dramatically from the few tenths to the few hundreds in each direction, so a static padding will not work.


title: How can I get the general term of this recurrence equations?

text: Following is the recurrence relation:               a[1] = 1;     a[n_] := a[n - a[n - 1]] + 1     Array[a, 28]      I tried to use `RSolve`, but it doesn't gives a correct answer.               Clear[a]     RSolve[{a[n] == a[n - a[n - 1]] + 1}, a[n], a]


title: Problem using NDSolve

text: This might be some simple mistake, but I am running out of ideas. I am trying to fit an ODE system to some data. This error keeps appearing > NDSolve::nlnum: "The function value {0.299812 - 0.000145006 a, 0.001 > -0.000145006 a} is not a list of numbers with dimensions {2} at {t, sa[t], > st[t]} = {0.000483352, 0.000145006, 1.}." The code is adapted to How do I find the best parameter to fit my data if the model is a interpolating function? :               data = {      {0.`, 34.84229229652888`}, {3.7448333333333332`, 29.004820470134124`},       {7.4896666666666665`, 22.762395022844483`}, {11.2345`, 16.82225654209896`}      }          Clear[kss, kdm, at, gof];          kss = 0.001; kdm = 0; at = 0.3;          eqs[kas_, k2s_, at_] := {       st'[t] == kss - k2s sa[t] - kdm st[t],       sa'[t] == kas (at - sa[t]) (st[t] - sa[t]) - k2s sa[t],       sa[0] == 0, st[0] == 1       }          gof[kas_, k2s_, at_] :=      (       soltry = st /. NDSolve[eqs[kas, k2s, at], {st, sa}, {t, 0, 100}] // First;       (soltry /@ data[[All, 1]]) - data[[All, 2]]/data[[1, 2]] // #.# &     )          NMinimize[{gof[1, a, 0.3], 0 < a < 5}, a]


In the documentation, it states that > The Laplace transform of a function $f(t)$ is defined to be $\int_0^{\infty > } f(t) e^{-s t} \, \mathrm{d}t$. But why can _Mathematica_ not get the Laplace transform of $\frac{1-\cos (t)}{t}$?               $Assumptions=s>0;          LaplaceTransform[(1-Cos[t])/t,t,s]     (* EulerGamma+LaplaceTransform[1/t,t,s]+1/2 Log[1+s^2] *)      and the integral does converge               Integrate[(1-Cos[t])/t Exp[-s t],{t,0,∞}]     (* 1/2 Log[1+1/s^2] *)      ?


title: FindMaximum of loglikelihood in Gaussian Process

text: I am trying to implement a Gaussian Process and have problems to maximize the loglikelihood because the function consists of a determinant of a matrix that is dependent of 2 variables and the product of the inverse of the matrix with 2 vectors. The full problem I am working on has 6 instead of 2 variables but I already fail with the 2. Do I have to use a different representation of the loglikehood? Maybe work with the partial derivatives of the loglikelihood with respect to the hyperparamters {h0,h1}? I think there are implementations of a GP in Matlab but not for Mathematica.                gpdata = {{-1.5, -1.8}, {-1., -1.2}, {-0.75, -0.4}, {-0.4,      0.1}, {-0.25, 0.5}, {0., 0.8}};          kernelfunction[i_, j_, h0_, h1_] :=       h0*h0*Exp[-(gpdata[[i, 1]] - gpdata[[j, 1]])^2/(2*h1^2)] +       KroneckerDelta[i, j]*0.09;          covariancematrix[h0_, h1_] =      ParallelTable[kernelfunction[i, j, h0, h1], {i, 1, 6}, {j, 1, 6}];          loglikelihood[h0_, h1_] := -0.5*     gpdata[[All, 2]].Inverse[covariancematrix[h0, h1]].gpdata[[All, 2]] -      0.5*Log[Det[covariancematrix[h0, h1]]] - 3*Log[2*Pi];          FindMaximum[loglikelihood[a, b], {{a, 1}, {b, 1.1}}]


title: Given x[u,v], y[u,v], and f[x,y] how do I find D[f,x] in terms of u,v?

text: I have two functions _x = x(u,v)_ and _y = y(u,v)_. The chain rule says that for a function f(x,y), _df/dx = df/du du/dx + df/dv dv/dx_ , and similarly _df/dy = df/du du/dy + df/dv dv/dy_. How do I get _Mathematica_ to give me _df/dx_ in terms of _u_ , _v_ , and _df/du_ , _df/dv_? I should point out that _x(u,v)_ and _y(u,v)_ are **not** easily invertible to give _u(x,y)_ and _v(x,y)_.


title: Numerical integration with OwnValues

text: Say I have a symbol with an `OwnValue`               a = y      And we define an integration like this               f[y_?NumericQ] := NIntegrate[a*z*y, {z, 0, 1}]      Then calling `f[1]` results in an error, probably because of the `HoldAll` attribute of `NIntegrate`. Using `Evaluate[a]` does not help. How can an integration like this be done correctly?


title: Menu bars on Palette windows don't work properly -- any workarounds?

text: After getting help from Rojo with Menu commands on Palettes and other windows without menu bars? I was able to create a Palette with a menu bar by:   1. Selecting the Palette and opening the **Option Inspector** with `Ctrl`+`Shift`+`O`   2. Setting `Editable -> True` and `WindowElements -> {"MenuBar"}` However the bar seems very glitchy:   * Sometimes it appears to be entirely disabled   * Then when I drag the window around or change focus a time or two it comes to life    * Then later becomes disabled again   * Sometimes it appears to be enabled (not grayed out) but I can't open any of the menus Further the menu commands themselves, when available, don't work right:   * Despite confirming that `Saveable -> True` the **Save** and **Save As...** items are disabled   * The **Palettes** > **Generate Notebook from Palette** item is also disabled; if not usable _here_ then where? Though I could not **Save** the Palette (Notebook) I captured its expression with `NotebookGet`:               Notebook[{Cell[        BoxData[ButtonBox["\"Beep!\"", Appearance -> Automatic, ButtonFunction :> Beep[],           Evaluator -> Automatic, Method -> "Preemptive"]], "NotebookDefault"]},       Editable -> True, WindowSize -> {700, 100},       WindowMargins -> {{Automatic, 51}, {266, Automatic}}, WindowFrame -> "Palette",       WindowElements -> {"MenuBar"}, WindowFrameElements -> {"CloseBox", "MinimizeBox"},       FrontEndVersion -> "10.0 for Microsoft Windows (64-bit) (July 1, 2014)",       StyleDefinitions -> "Palette.nb"]       ### Are other Windows users able to reproduce the series of bugs I described above? ### Has anyone figured out how to work with Palettes in Version 10 under Windows?