Collect and simplify both the coefficents and the matched patterns

(This is a far tighter version of a previous question I asked) The problem with Collect is that while `Collect[exp, pattern, Simplify]` will simplify the coefficients, it does nothing to the matched patterns themselves. If one then calls `FullSimplify` on the result of the collection, it frequently undos the collect. This is especially important when collecting and matching with complicated non-integer exponents or exponentials. To solve this, what do you think of the following solution? Is there any way I could lose parts of the expression tree with this transformation?               CollectFullSimplifyImpl[exp_, pat_]:= If[MatchQ[#,pat], FullSimplify@#, #]& //@ Collect[exp, pat, FullSimplify];     CollectFullSimplify[exp_, pat_]:= FixedPoint[CollectFullSimplifyImpl[#, pat]&, exp]      I think I want to do a depth first MapAll so simplify the expressions from the bottom up if they are recursive and ensure that I don't undo the previous collections as I go through (i.e. calling FullSimplify on a higher level node could mean lower nodes no longer match the pattern). Why have a Fixed point? Want to allow the recollection//further simplification if the exponents have themselves simplified and could be combined, but having trouble finding a minimal example. Might be unncessary... *) To see the results, try the following tests:               exp = ((b - a)/a - b/a )x^(((b - a)/a) - (b/a)  )+(1 + a)x + (b - 1)x;     exp2 = ((b - a)/a - b/a )x^(((b - a)/a) - (b/a)  )+ x^x^((b - a)/a - b/a-1/x+x^((b - a)/a - b/a)); (* Test out the recursion *)     Print["Collect, then Collect with simplification, then CollectFullSimplify"]     Collect[exp, x^_]     Collect[exp, x^_, FullSimplify]     CollectFullSimplify[exp, x^_]          Print["Collect, then Collect with simplification, then CollectFullSimplify"]     Collect[exp2, x^_]     Collect[exp2, x^_, FullSimplify]     CollectFullSimplify[exp, x^_]      The following is the output               "Collect, then Collect with simplification, then CollectFullSimplify"          (*     ==> (1 + a) x + (-1 + b) x + (-(b/a) + (-a + b)/a) x^(-(b/         a) + (-a + b)/a)     *)          (* ==> (a + b) x - x^(-(b/a) + (-a + b)/a) *)          (*     ==> -(1/x) + (a + b) x          During evaluation of     *)          "Collect, then Collect with simplification, then CollectFullSimplify"          (*     ==> -x^(-(b/a) + (-a + b)/a) + x^x^(-(b/a) + (-a + b)/a - 1/x +        x^(-(b/a) + (-a + b)/a))     *)          (*     ==> -x^(-(b/a) + (-a + b)/a) + x^x^(-(b/a) + (-a + b)/a - 1/x +        x^(-(b/a) + (-a + b)/a))     *)          (* ==> -(1/x) + (a + b) x *)      One problem I have found is the following: `CollectFullSimplifyImpl[v[l][z_] , z^_]` becomes `v[l][Pattern[(If[MatchQ[#, z^Blank[]], FullSimplify[#], #]& )[z], Blank[]]]` This is ugly since I commonly want to call CollectFullSimplify on rules of the form `{v[l][z_] -> COMPLICATED STUFF`, and this wrecks it.


ReadList or any other command to read in blocks of very large numbers

I have a data file, data.txt, having following data:               3                                                         -0.2352894126386808187350075012389752796853e-1 0.2637308884075999426372690567963259521074e-30     0.1162118209477691344763370597452108929431e-2 -0.5392062060774676319404139679768941598284e-32          0.1993639851597459864147785133041034189591e0 -0.6630323032648363841595581393885521890515e-30     -0.3297790594809971083794788173889365177346e0 0.9104893688834152505592072881087608656528e-31          0.2855754609815511932435778845835014061846e2 -0.4206735153962858572318973522081457438191e-28     0.3384007339539669275065289685447274745546e2 0.4527037649170679926834370576825317093893e-28      i.e., the top integer digit which is the no. of blocks, then three blocks each of two rows. Each row has two numbers corresponding to real and imaginary parts. I am trying to read these data in Mathematica using               var = Table[x[i], {i, 1, 2}]          readoutputfile[fname_, var_] :=       Module[{stream, noofvariables, nooftotalsol},       stream = OpenRead[fname];       noofvariables = Length[var];       nooftotalsol = Read[stream, Number];       Print["Total no of real solutions is ", nooftotalsol];       Do[soltmp[l] = {};        Do[soltmp[l] =           Append[soltmp[l], Read[stream, {Number, Number}]], {i, 1,           noofvariables}],        {l, 1, nooftotalsol}];            Close[stream];            sol = Table[soltmp[i], {i, nooftotalsol}];       sol = Table[         Table[sol[[j, i]] /. {t_, y_} -> t + I y, {i, noofvariables}], {j,           nooftotalsol}];       ]      and then running               readoutputfile["data.txt", var]      But it is giving me error as > General::digit: "Digit at position 1 in > !(\"-0.2352894126386808187350075012389752796853\") is too large to be used > in base 10. ImportList etc. isn't helping me so far. Any better way of doing this? Thanks, John


FindRoot kills kernel

**Bug introduced in 7.0.1 or earlier. Persists through at least 10.0.0.** * * * I'm having problems with FindRoot killing the kernel. In my real application, I want to FindRoot on a black-box function containing an NDSolve that takes a list of unequal length lists as input and output. The goal is to find limit cycles of a forced system of differential equation. Sometimes it works, but other times it kills the kernel when I run it (beep, then dead kernel, no messages). The real example is horrible, but here's a minimal example:               f[xs_?(VectorQ[Flatten[#], NumericQ] &)] := {{Sin[xs[[1, 1]]]}};     Do[FindRoot[f[{{x}}] == {{x}}, {x, 0.3}], {1000}]      where the Do loop almost assures failure (Mathematica 10.0.0 on a Mac). Any idea why or how to fix it? For whatever reason, using a single level list seems OK, so maybe that's the solution.


Homotopy Visualization

I noticed that both the lower cased 'i' and the Apple logo  are topologically equivalent to the disjoint union of two closed discs. ![enter image description here](http://i.stack.imgur.com/B7Fka.png) I'd like to animate a homeomorphism from the left to the right, can this be done in Mathematica 10 with built in functions?


Mathematica as a normal programming language

I'm interested in Mathematica's core language for both practical development and as an object of computer science study. Actually, the former is more of a means to the latter. I would like to create complete applications, but mainly to get experience and ideas for creating my own language. I have many ideas for it already, and one of them is to explore Mathematica's unique M-expression syntax, rule-based programming, and other interesting semantics. To this end, I have two questions:   1. Is the language specification available anywhere? And are there any particularly significant resources on Mathematica _as a language_?   2. Are there any legal restrictions on applications created and/or compiled with Mathematica, and if so, do they differ between offerings?


Auto-completion doesn't work as my expectation in version 9.0

When I input the following line in version 8, and press `Ctrl`+`K` after `Re`, I can get a drop-down auto-completion list including `Rectangle`: ![enter image description here](http://i.stack.imgur.com/YFPJb.jpg) But the same input in version 9 gives me only one candidate: ![enter image description here](http://i.stack.imgur.com/xfXvY.jpg) and the short-cut key `Ctrl`+`K` seems not working. **Questions:** Is there any thing I missed? How can I get a drop-down auto-completion menu with a full candidates list? My operation system is Windows 7 64-bit.


How do I evaluate a symbolic integral involving Hermite polynomials?

I want to test a difficult integral : Integral on all reals of some complicated function involving the Hermitian polynomials, exponentials, squares, factorials, and being general considering any Hermitian polynomials. I know the answer (it's ridiculously short compared with the statement) and just wanted to check. But why _Mathematica_ doesn't calculate my integral ? (I'm quite new on the system and don't understand what causes the trouble) :               Integrate[(HermiteH[n, x/a]*Exp[-x^2/(2 a^2)]/((n!)^(1/2) (Pi a^2)^(1/4)))^2*x^2,               {x, -Infinity, Infinity},                Assumptions :> {Element[n, Integers], Element[a, Reals], a > 0}]      And getting as a result: > >       Integrate[(x^2 exp[-(x^2/(2 a^2))]^2 HermiteH[n, x/a]^2)/(Sqrt[a^2] > Sqrt[Pi] n!), >                 {x, -∞, ∞}, >                 Assumptions :> {n ∈ Integers, a ∈ Reals, a > 0}] >   What do I have to change to get an answer?


What do the elements of the Parallel Kernel Status screen mean?

I just managed to get my multiple kernels up and humming on a new multi-core machine, which I am quite happy about. I am slightly at a loss, though, about the meaning of the different parts of the Parallel Kernel Status monitoring screen, as the official documentation on it is quite sparse. ![enter image description here](http://i.stack.imgur.com/bxaDO.png) This screen is accessible from the Evaluation menu. Clicking on `Select Columns...` goes some way into clarifying some of the more mysterious elements: ![enter image description here](http://i.stack.imgur.com/WrFHN.png) In particular   * **CPU** gives the CPU time used so far by that kernel, and    * **RAM** gives the RAM it's currently using.   * The dots change color from green to red when a kernel starts calculation and back to green when it finishes. However, I have a few specific questions:   * What does the **Time** column measure?   * What does the **Elapsed** dialog measure?   * What exactly is the **speedup**? What is it comparing with?   * What are the green bars? Upon mouseover they grow tooltips with percentages with no indication of what they are. For the ones above I imagine the kernels are not really being used to their full potential; is that the case? (And, if so, is there a good resource for ideas on fixing that?)


How to use adaptive precision in matrix computations?

I wish to compute the pseudo inverse of rectangular (or square) matrices by the cubically method of Chebyshev given by $X_{k+1}=X_k(3I-AX_k(3I-AX_k))$ where $X_0=\frac{1}{\|A\|_F^2}A^*$. The procedure is simple as I wrote in the following sample example:               Clear["Global`*"]     SeedRandom[1234];     m = 400; n = 500;     Id = SparseArray[{{i_, i_} -> 1.}, {m, m}, 0.];     A = RandomReal[{-100, 100}, {m, n}];     X[0] = 1/Norm[A, "Frobenius"]^2 ConjugateTranspose[A];     max = 50; k = 1; stop = 1;     While[k <= max && stop > 10^-2, {         AX = A.X[k - 1];         X[k] = X[k - 1].(3 Id - AX.(3 Id - AX));         stop = Norm[X[k] - X[k - 1], "Frobenius"]/Norm[X[k], "Frobenius"];         }; k++]; // AbsoluteTiming          {(k - 1), Norm[Chop[X[k - 1] - PseudoInverse[A]], 1]}      Running the above piece of code, will produce the pseudo inverse in 12 number of iterationsin 1.8 seconds (in my computer). The only problem of the Chebyshev method is that it is **slow** at the beginning of the process. I mean the third order of convergence can only be seen in the last four iterations. On the other hand, my aim and question is to reduce the computational time/effort of implementing this method in MMA. Since the method is asymptotically stable, I think one way for reducing the computational time is to use **adaptive precision**. So, is there any way to apply adaptive precision in the implementation of the above piece of code? I mean, it would be too nice if we could run the method in Single Precision at the beginning of the process and then when the stopping termination ("stop") reaches a pre-tolerance, then we back to the machine precision (double precision)? Note that I used $SetAccuracy[exp,digits]$, but I think it is so costly for matrix-matrix multiplications and is not useful. Any idea that could be helpful is fully appreciated.


BipartiteMatching hangs with floating-point weights in Mathematica 7 (package Combinatorica)

I am trying to use Combinatorica's BipartiteMatching algorithm on a weighted graph. I need to use real numbers as weights. If I try the following               graph = CompleteGraph[1, 1]     graph = SetEdgeWeights[graph, {1}]     BipartiteMatching[graph]      it correctly gives the perfect matching {{1,2}}. But if instead I try this               graph = CompleteGraph[1, 1]     graph = SetEdgeWeights[graph, {1.}]     BipartiteMatching[graph]      (the only difference being the decimal point), it hangs, apparently forever. Am I missing something obvious? Any help would be much appreciated!


In a CDF can I suppress or avoid "This file contains potentially unsafe dynamic content..."

I created a CDF to distribute to a single trusted user who both knows and trusts me and everything I make for them. I downloaded the CDF player and the CDF to one of their computers. The CDF works great, **except** every time it runs the document displays the message: > This file contains potentially unsafe dynamic content..." ![Unsafe content message](http://i.stack.imgur.com/TpySj.png) I've found some discussion about this at the old site: Why do I get security warning message..., but I don't see anything specific or useful in the link for CDF distribution. The warning makes the user VERY NERVOUS and frankly appears slapdash and unprofessional. The blank gray field below it does nothing to inspire confidence. This makes for a very bad user experience. When one launches an app or an application (created with anything else), presumably one has already vetted its provenance. Launch an application and one should see the application, not a disturbing warning. Lots of applications use "dynamic content". An application should just work. Sorry to get on a soap box here (well maybe not that sorry). It just seems that if Wolfram wants Mathematica to have the functionality to make real stand alone applications, then what we build should actually look like real applications. _Question 1: Can one suppress this unfortunate message programmatically from within the CDF document or its Manipulate[]?_ When using Mathematica, one can place a notebook and probably a CDF in a trusted directory (see the above link), which avoids the display of this message. It just seems to defeat the purpose of a CDF and its great potential as a distribution platform to expect a user who does not have Mathematica to go to the trouble to figure out how to do that or even to have to do it. _Question 2: Can one even specify a trusted directory in the CDF Player?_ _Question 3: Does a CDF really need an installation program that would create a trusted directory and how could I do that?_ Premiere support had no solution to this. I still have a little bit of hope that someone here might.


Rearranging a simple algebraic equation

Suppose I have a simple algebraic equation like:               ChebyshevT[4, p] == 0      > >     1 - 8 p^2 + 8 p^4 == 0 >   and I want to solve for the term `p^4` by simple rearrangement:               p^4 == -(1 - 8 p^2)/8      How do I do that in _Mathematica_ ? And how can I then assign the solution to replace.


How to increase font-size of Text in ShowLegend

The default font-size of `Legend` text generated using `ShowLegend[]` is too small. How does one increase this? The code I am working with is:               Needs["PlotLegends`"]     LstTest = Flatten[Table[{i, j, (i + j)/200}, {i, 1, 100}, {j, 1, 100}], 1];     plTest = ListContourPlot[LstTest, Contours -> 9, ColorFunction -> "Rainbow"];     LMax = Max[LstTest[[All, 3]]]; LMin = Min[LstTest[[All, 3]]];          ShowLegend[plTest,                 {ColorData["Rainbow"][1 - #1] &,                  10,                  ToString[Round[LMax, 0.01]],                  ToString[Round[LMin, 0.01]],                  LegendPosition -> {0.6, 0}                }               ]      The `0.01` and `1.0` appear too small, and I would like to increase the font- size of these. Thanks for any help!


Camera Troubles in Mathematica

I'm trying to animate a torus being cut by a plane, so that as the plane enters the torus the part in front of the plane disappears (the idea is to show the cross section). That much I can do, but I can't seem to get the camera to behave. I'd like everything to stay the same size and position, but despite setting `ViewVector`, `ViewAngle`, and `ViewVertical` the scene becomes smaller as the animation progresses. Note that I chose the settings pretty arbitrarily. I am baffled as to why the camera view changes with these three options fixed. Here is the code (I produce the frames in a table, and then export them for the animation).               Table[Show[       ContourPlot3D[(1 - Sqrt[x^2 + (y + 1/2)^2])^2 + z^2 - 1/4 ==          0, {x, -2, 2}, {y, -2, 2 - 2 t}, {z, -2, 2}, Mesh -> False], (*The torus*)       ContourPlot3D[y == 2 - 2 t, {x, -2, 2}, {y, -2, 2}, {z, -2, 2},         Mesh -> False, ContourStyle -> {White, Opacity[.5]}],         (*The plane*)       Axes -> False, Boxed -> True, PlotRange -> All,       ViewVector -> {{5 Sqrt[6], 10 Sqrt[6], 5 Sqrt[6]}, {0, 0, 0}},        ViewAngle -> 3 Pi/50, ViewVertical -> {0, 0, 1}], {t, 0, 1, .5}]      And here is the result. ![Torus cross sections](http://i.stack.imgur.com/dAmjH.png) As you can see, the camera zooms out and seems to rotate slightly. Any idea how to fix this? (Edited to add `PlotRange -> All`)


Algorithm for parts integration

Sorry if this is a duplicate, I've searched how to do this to no avail. What I'd like to do is a function that integrates by parts $n$ times, i.e $$ \int u(x) v(x) dx = u \left(\textstyle{\int}v\right) - \displaystyle{\int} u' \left(\textstyle{\int}v\right)dx $$ where $\textstyle{\int}v$ is the primitive of $v$. I've done a very rustic function that does this,               parts[u_,v_]:=(#1 Integrate[#2,x] - Integrate[D[#1,x] Integrate[#2,x],x]&[u,v];      which performs well but, as you all can see has -at least- the mayor limitation that `u` and `v` should be given as functions of `x`. At least it works, for example               In[1]=  parts[Exp[-x],1/x^2]     Out[1]= -Exp[-x]/x - ExpIntegralEi[-x]      The thing is, I'd like to tell `parts` to operate $n$ times, for example \begin{align} \mbox{parts}\big(u,v,2\big) &= u v - \mbox{parts}\left(u',\textstyle{\int}v,1\right) \\\ \\\ \mbox{parts}\big(u(x),v(x),3\big) &= u(x)v(x) - u'\left(\textstyle{\int}v\right) + \mbox{parts}\big(u''(x),\textstyle{\iint}v,1\big) \end{align} and so on. I hope my question is clear.


Where did I go wrong with my implementation of finding a plane tangent to a surface?

I am working on finding the plane tangent to a paraboloid at a given point. ![author's solution:](http://i.stack.imgur.com/XAHoy.png) My code:               z[x_, y_] := 10 - x^2 - 2 y^2;     Subscript[z, x][x_, y_] := D[z, x];     Subscript[z, y][x_, y_] := D[z, y];     z[1, 2] + Subscript[z, x][1, 2] (x - 1) +      Subscript[z, x][1, 2] (y - 2)(*The plane tangent equation*)      However, it doesn't work. My question is: where did I go wrong?


Half kth term if n is even and k=n/2?

I am trying to write a function which will perform the equation in the attached image. So far, I have:               x[n_] :=      x[n] =       2^(1 - n) Sum[Binomial[n, k] T[n - 2 k], {k, 0, n/2}]          x[6]      which outputs: $ \frac{1}{32} (20 T(0)+15 T(2)+6 T(4)+T(6)) $ How can I write an `If[]` (or similar) statement to half the `kth` term when `n` is even and `k=n/2`? Thanks in advance! ![Equation 2.14](http://i.stack.imgur.com/NKC7G.png)


Open data file from CDFPlayer?

Using a CDF program running in CDF Player, is it possible to use a system dialog box, or even just an Import statement such as Import["*.CSV"], to import data from a text or comma separated file on a personal computer? I have browsed the forums and Wolfram documentation and it appears that it is not possible, but all the questions were a little bit different in one way or another. My own attempts have failed to produce a dialog box.


Plot rate of change in $x$ axis of list of points

I have a list of points, that may have clusters in some of the $x$ axis values, and my goal is to get a function that shows that graphically. Something like this, but the red function is "hand drawn", it's just for reference. ![frequency plot](http://i.stack.imgur.com/YKYL4.png) The high points of the red plot shows where the clusters are and the low points where are the points that are most isolated.


Integral of Lorentzian yields different results depending on when parameter assigments are made

I'm evaluating the integral of a Lorentzian, which I know equals one. First I define the function and evaluate the integral in two slightly different ways. Surprisingly, I do not get the right answer when I do symbolic integration first.               g[x_] := (a/(2*\[Pi]))/((x - x0)^2 + (a/2)^2);          Integrate[g[x], {x, -Infinity, Infinity}] /. {x0 -> 10} /. {a -> 4}      > Undefined               Integrate[g[x] /. {x0 -> 10} /. {a -> 4}, {x, -Infinity, Infinity}]      > 1 What is the issue here?


Strange Integrate behavior (a bug!)

The following two calculations should give the same result. After all, integration is a linear operation. ![enter image description here](http://i.stack.imgur.com/HoIYA.png) * * * I have pasted the code below in case you want to play with it.               Integrate[Integrate[v[x], x] -           Integrate[Integrate[v[x], x] * u'[x], x]/u[x], x]          Integrate[Integrate[v[x], x], x] -         Integrate[Integrate[Integrate[v[x], x] * u'[x], x]/u[x], x]


Histogram with variable bin size

Suppose I have some dataset,e.g.,               Histogram[RandomVariate[PoissonDistribution[2], 10000], 10]      which gives, $\hspace{2cm}$![enter image description here](http://i.stack.imgur.com/yb46O.jpg) How can I change the histogram such that it has variable bin size such, e.g., the first six bins have size 1 while the last two have size 2?


How to increase the size of the dot produced by OverDot[]

As the title says, I want to find a way to increase the size of the dot produced by `OverDot[]`. Here is a simple code               f = (x^2*px^2 - px^2*(px^2 - 1)) + (x^2 + px^2)/2 - 2*x^4;     cnt = {0.002, 0.015, 0.0312, 0.05, 0.15, 0.3, 0.45, 0.5612, 0.64, 0.73, 0.778};     xmin = 1.5;     C0 = ContourPlot[f, {x, -xmin, xmin}, {px, -xmin, xmin},      Contours -> cnt, ContourStyle -> {Black}, ContourShading -> False,      FrameLabel -> {"x", OverDot["x"]}, RotateLabel -> False,      Axes -> False, FrameStyle -> Directive[FontSize -> 22, FontFamily -> "Helvetica"],      PlotRange -> xmin, ImageSize -> 550]      which gives this output ![plot](http://i.stack.imgur.com/dePLk.png) We see, that even if I used a relative large fonts size (22), the dot above $x$ (`OverDot["x"]`) at the vertical axes is tiny and hardly visible if I print out this plot. So, my question: is there a way to increase the size of that dot? Many thanks in advance. **EDIT** Following @Hector suggestions I used `Overscript["x", Style["\[FilledSmallCircle]", FontSize -> 12]]` which gives ![plot2](http://i.stack.imgur.com/4rFKt.png)


Whitespace after number subscript

When I write something like this:               (Subscript[x, 0], f(Subscript[x, 0]))       I get some undesirable whitespace after each of the `Subscript[x, 0]`. The whitespace disappears or is at least significantly reduced, if I write e.g. `Subscript[x, i]` instead. This is a screen shot of the problem: ![Screen shot](http://i.stack.imgur.com/BGGbU.png) I have looked around the object inspector for a solution, but I haven't found one. It appears to be a font specific problem: If I use `Times` \- the problem goes away, but for most other fonts - it is there (I use `Georgia`). The raw cell looks like this:               Cell[TextData[Cell[BoxData[      FormBox[       RowBox[{"(",         RowBox[{         SubscriptBox["x", "0"], ",",          RowBox[{"f", "(",           SubscriptBox["x", "0"], ")"}]}], ")"}], TraditionalForm]],      FormatType->"TraditionalForm"]], "Text",      CellChangeTimes->{{3.590903299361623*^9, 3.590903306745799*^9}}]


Organise a graph's vertices into levels

I would like to organise a graph's vertices in levels. Consider               g = {       0 -> 1, 1 -> 2, 2 -> 3, 0 -> 4, 0 -> 5, 2 -> 6, 2 -> 7, 8 -> 3, 4 -> 9, 5 -> 9,        6 -> 9, 6 -> 10, 7 -> 10, 8 -> 10, 9 -> 11, 9 -> 12, 10 -> 11, 10 -> 12 };     Graph[g]      Using nested list of vertices such as `{{0, 1, 2, 3}, {4, 5, 6, 7, 8}, {9, 10}, {11, 12}}`, I would like to see graph with 4 levels wherein vertices 0, 1, 2, 3 placed in line on the top level, vertices 4, 5, 6, 7, 8 in line on the level below and so on. ![enter image description here](http://i.stack.imgur.com/ZoubU.png)


KolmogorovSmirnovTest[] On Frequency Data

I have two observed frequency data, let say               f1 = {100, 200, 150, 100, 50};     f2 = {110, 195, 160, 105, 40};      and i want to know whether these random samples belong to the same distribution using `KolmogorovSmirnovTest[]`. Since `KolmogorovSmirnovTest[]` takes raw data, i simulate them based on `f1` and `f2`.               data1 = {};     data2 = {};     k = 1;     Do[data1 = Join[data1, Table[k n, {f1[[n]]}]], {n, 1, Length[f1]}]     Do[data2 = Join[data2, Table[k n, {f2[[n]]}]], {n, 1, Length[f2]}]      The test gives the result               KolmogorovSmirnovTest[data1, data2]     0.99998      Is this correct procedure to perform KS on frequency data? I have changed `k` with any other number and got the same result. Thank you.


Getting Internal Self-Test Error

I have two questions related to this simple code:               CDFDeploy[SystemDialogInput["FileSave"],        Panel[Row[{Button[Text[Style["sav", FontSize -> Scaled[.2]]],ImageSize -> Scaled[.2]],            Button[Text[Style["save", FontSize -> Scaled[.2]]],ImageSize -> Scaled[.2]]}],           ImageSize -> Scaled[2]], WindowSize -> Scaled[2]]                    1. Sometimes, I am getting `Internal Self-Test Error`. Why?   2. I am able to scale `Button` size, `Fontsize` and `Panel`size in the Horizontal direction but not in the vertical direction. How to do this?


How to suppress Tooltip in built-in templates?

...or maybe switch the message. But I will be happy with no `Tooltip` at all. ![enter image description here](http://i.stack.imgur.com/Th4We.png) I've naively tried with               Block[{$PerformanceGoal="Speed"}, ...]      because it works in case of `Charts`` tooltips, but with no effect :)


Confused with HoldForm in Postfix notation

Why does the following code produce different result? In my mental model, they should be the same.               Table[With[{x = i^k}, HoldForm[x]], {k, 1, 5}]     With[{x = i^k}, HoldForm[x]] // Table[#, {k, 1, 5}] &      Output:               {i,i^2,i^3,i^4,i^5}     {i^k,i^k,i^k,i^k,i^k}


How to find the maximum value of an integer that satisfies some inequality

Consider the following Mathematica expression:               Reduce[2^j/(j + 1) <= 10, j, Integers]      which outputs:               j == 0 || j == 1 || j == 2 || j == 3 || j == 4 ||      j == 5 || j == 6 || (j \[Element] Integers && j <= -2)      Therefore, the maximum integer $j$ satisfying $\frac{2^j}{j + 1}$ is 6. I tried to using the `FindMaximum`, as follows:               FindMaximum[{j, 2^j/(j + 1) <= 10 && j \[Element] Integers}, j]      but it gives the following error:               FindMaximum::eqineq: "Constraints in {j\[Element]Integers,2^j/(1+j)<=10} are      not all equality or inequality constraints.      With the exception of integer domain constraints for linear programming,      domain constraints or constraints with Unequal (!=) are not supported."      My general question is: > How to solve inequalities like $\frac{2^j}{j + 1} \le c$ (for some constant > $c$) in Mathematica, over Integers?


GraphHighlightStyle with multiple datasets

I am trying to highlight several subgraphs of a graph using the following command:                HighlightGraph[        GridGraph[{10, 10}], {{1 \[UndirectedEdge] 2,          2 \[UndirectedEdge] 12}, {4 \[UndirectedEdge] 5,           5 \[UndirectedEdge] 15}}, GraphHighlightStyle -> "Thick"]      It turns out that there is no action of `GraphHighlightStyle` on how my subgraphs look like. Compare with, e.g.,                   HighlightGraph[ GridGraph[{10, 10}],               {{1 \[UndirectedEdge] 2,2 \[UndirectedEdge] 12}},                  GraphHighlightStyle -> "Thick"]      So what has to be changed so that `GraphHighlightStyle` actually worked on multiple datasets in `HighlightGraph`?


How to cancel floating point factors?

I am currently having problems with some floating points. I have a function, which gives as an intermediate result (for example)               -(10000. - 10000. a) E^(-16.4157 kp^2 x^0.277)/((-1. + a) a x^0.252525 xj^4.47047)      It gets passed through into another function, which will fill in the value `a = 1`. Then Mathematica reacts with a `1/Sqrt[0]` error. However, as you can see, the factor `(10000. - 10000. a)` should cancel with the factor `(-1.+ a)` in the denominator to give 10000, the result is thus well-defined. Do you have any idea how to let Mathematica cancel these factors out? I have tried `Simplify` and `FullSimplify` with `Assumptions -> a!=1` but it doesn't work. I cannot change much to the function itself, as it is an intermediate result (and it is just an example for this post; other intermediate results also occur, sometimes with the same problem, sometimes they work fine).


I need to remove a line from a ParametricPlot

What happens is that when I make this ParametricPlot:               ClearAll [f, g]           f2 [t_]:= t + 1 / t      g2 [t_]:= t - 1 / t      ParametricPlot [{f2 [t], g2 [t]}, {t, 0.00001, 20},       PlotRange -> {{0, 5}, {-4, 1}}, ImageSize -> 200]      ParametricPlot [{f2 [t], g2 [t]}, {t, -80, 80},       PlotRange -> {{-4, 4}, {-2, 4}}, ImageSize -> 200]       The graph of the parametric function appears and additionally appears a straight line through the origin. How I can remove it?


Finding the position of similar elements in a matrix

I want to find the position of the elements which are equal in a matrix. For example in the case of the following matrix: $m =\left( \begin{array}{cc} a & x \\\ x & a \\\ \end{array} \right)$               m = {{a, x}, {x, a}};      I want to get these two sets: > >     {{{1, 2}, {2, 1}}, {{1, 1}, {2, 2}}} >   How can I do that? Is there a built in function?


Creating sculptural forms using graphics primitives

This is a question based on this answer by halirutan. Some amazing images can be created with this code, and I was wondering whether it was possible to extend the principle to different shapes. I would like to create images based on the sculptures of Naum Gabo & Barbara Hepworth as shown below: ![](http://i.stack.imgur.com/7nesm.jpg) ![](http://i.stack.imgur.com/WM2sp.jpg) Below is an image made with halirutan's code, included to clarify the similarity: ![](http://i.stack.imgur.com/l3Auh.gif)               x = 50; drawMe@Table[Mod[i, x], {i, E x}]      My question is threefold really. Is it possible to : * extend this principle to other shapes? * extend this to 3D? * distort the shapes with a mesh distort or similar (see image below)? ![](http://i.stack.imgur.com/J4eUz.png)


Solving a system of difference equations in an exponential steady-state growth setting

I have a system of difference equations in an exponential steady-state balanced growth setting; all variables grow at the same steady-state rate, say, $g$. I use the notations as follows: Variable $X$ at time $t$ is denoted by $X(t)$. As any variable grows at the rate of $g$, $X(t)$ can be expressed as $X(t)=X(0)e^{tg}$, where $X(0)$ is the initial value of $X$. Now, my equations system is this:               X(t)=Y(t-a)     Z(t)=X(t-b)     Y(t)=pZ(t-c)      Variables with time notation are endogenous variables: $X$, $Y$, $Z$. Variables without time notation are exogenous: $a$, $b$, $c$, $p$ and also the initial values of the endogenous variables, $X(0)$, $Y(0)$, $Z(0)$ are exogenous. You can interpret these equations as saying that, as for the first equation, $X$ at any time is equal to $Y$ of $a$ periods ago. I would like to do two things using Mathematica: First, find a solution of the three endogenous variables $X(t)$, $Y(t)$, and $Z(t)$ expressed with exogenous parameters given in the model and with the growth rate $g$. Second, plugging successively one equation into another yields what can be called 'characteristic equation' of the system. I would like to generate the simplest expression of this characteristic equation. I know it will be consisted of $g$ and the other exogenous parameters. You can verify this by manually solving the model. (In this sense, in this model, $g$ is endogenously determined by the exogenous parameters.) Any help will be greatly appreciated!


install mathematica 9 on linux encounter "Glibc_2.4" not found

I tried install mathematica 9 on linux. The whole process is fine. After the installation. I type "mathematica", and came up following lines: > > /usr/local/Wolfram/Mathematica/9.0/SystemFiles/FrontEnd/Binaries/Linux-x86-64/Mathematica: > /lib64/tls/libc.so.6: version `GLIBC_2.4' not found (required by > /usr/local/Wolfram/Mathematica/9.0/SystemFiles/Libraries/Linux-x86-64/libML64i3.so) > > > /usr/local/Wolfram/Mathematica/9.0/SystemFiles/FrontEnd/Binaries/Linux-x86-64/Mathematica: > /lib64/tls/libc.so.6: version `GLIBC_2.4' not found (required by > /usr/local/Wolfram/Mathematica/9.0/SystemFiles/Libraries/Linux-x86-64/libQtCore.so.4) It seems that I need to update my Glibc. But I received warnings that update Gilbc is highly risky. What should I do? How to update Glibc safely?? Or should I return to low edition mathematica? my Glibc version is glibc-2.3.4-2.39. Which edition of mathematica can I install?


Extracting a single weakly connected component from a network of many weakly connected components?

Hello Mathematica friends! I've got a network with thousands of edges and vertices, but not all in one connected component. I'm trying to extract specific connected components from the network, and assign them as new variables.               g = Graph[{1 \[UndirectedEdge] 2, 2 \[UndirectedEdge] 3, 1 \[UndirectedEdge] 3, 4 \[UndirectedEdge] 5, 7 \[UndirectedEdge] 6, 8 \[UndirectedEdge] 6, 5 \[UndirectedEdge] 7, 7 \[UndirectedEdge] 8}]      I know it's a disconnected component because of:               WeaklyConnectedGraphQ[g]     False      I know there are two components:               Length[WeaklyConnectedComponents[g]]     2      I know how many vertices are in each component:               Length /@ WeaklyConnectedComponents[g]     {5, 3}      And I know what vertices are in each component:               WeaklyConnectedComponents[g]     {{7, 6, 5, 8, 4}, {3, 2, 1}}      What I don't know is how to a assign on of these components to a new variable to then proceed with analysis on just a single connected component?


How to evaluate Floor[1/2 + Arg[z]/(2π)] with Re[z] > 0

I want to do a series expansion of an expression containing `Gamma` functions with specific arguments. An example is the following:               Series[Gamma[I p/x + z /x], {x, 0, 0}, Assumptions -> {x > 0, p > 0, z > 0}]          (* (2^-Floor[1/2 + Arg[(I p)/x + z/x]/(2 π)]) ... *)      The result then depends on expressions containing Floor functions:                Floor[1/2 + Arg[(I p)/x + z/x]/(2 π)]      However, because I am assuming all variables to be positive (and nonzero) the Arg[] will not return any values outside the open interval (-π/2, π/2). Therefore, the `Floor` expresisons should simplify to just 0. Now I would like to know how I can get _Mathematica_ to do this simplification automatically. Maybe this is something that can be done by adding rules to `FullSimplify` with the option `TransformationFunctions`?


fourier issue arising from input miscommunication

xdomain = Table[i , {i, -10, 10, .1}];     ListPlot[InverseFourier[       Fourier[E^-#^2 & /@ xdomain]*E^#^2 & /@ xdomain]]      So I want to numerically fourier transform a function, multiply that fourier'd function by a second function, and then inverse fourier transform it. The code above doesn't work. I get a blank graph, I think, because it doesn't properly multiply the two vectors that I commanded to multiply. I'm not sure why I can't get {a,b,c}*{1,2,3} to multiply inside my fourier function, but I have tried putting evaluate functions in different spots inside to see if that would fix it.


Creating hyperlinks from a list of file names

Suppose I use `FileNames` to get a list of file names. I know that it's possible to make a hyperlink using this kind of pattern....               Cell[TextData[ButtonBox["Link Label", BaseStyle->"Hyperlink",                    ButtonData->{FrontEnd`FileName[{"Folder names"}, "FileName.nb",                                   CharacterEncoding -> "UTF-8"], None}]],         "Text"]      I would appreciate help with taking a list of file names and writing them as working hyperlinks in a specified notebook. To be clear, I'd like the hyperlink to open the file referred to by the hyperlink. I tried taking a file path, splitting it to get the parts, using that for the folder structure and the file name, but couldn't get it to work.


Heat Transfer equation by numerical methods

I want to solve the following heat conduction equation using numerical methods: D[u[x, t], t] -alpha*D[u[x, t], {x, 2}] == 0 u[x, 0] == 1/(1 + x^2)^0.25, u[-10, t] == u[10, t] == 0,               x0 = -10;     xn = 10;     dx = 0.1;     n = 200;     t0 = 0;     tn = 10;     dt = 0.01;     steps = tn/dt;     alpha = 0.2;      I define:               points = Table[-10 + i*dx, {i, 0, n}];          u[0] = Module[{i, l= {0}},  For[i = 1, i <= n - 1, i = i + 1;      AppendTo[l, 1/(1 + points[[i]]^2)^0.25]]; AppendTo[l, 0];l];              previous[dt_, dx_, u0_, alpha_] := Module[{i, ans},      ans = u0[[2]] + alpha*(dt/dx^2)*(u0[[3]] - 2 u0[[2]] + u0[[1]]); ans];      I aproximate the values of the following steps:               u[k_] := Module[{l,ans= {u[0]}}, For[j = 1, j <= k, j = j + 1, l = {0};      For[i = 2, i <= n, i = i + 1, AppendTo[l, previous[dt, dx, {ans[[j]][[i - 1]],      ans[[j]][[i]], ans[[j]][[i + 1]]}, alpha]]]; AppendTo[l, 0];      AppendTo[ans,l]]; ans[[k + 1]]]      However, it takes a lot of time to compute u[steps]=u[1000].And when want to plot the answer it gets stuck...               GraphicsGrid[Table[{Graphics[Table[{RGBColor[u[k][[i]], 0, 1 - u[k][[i]]],      Rectangle[{points[[i]] - dx/2, 0}, {points[[i]] + dx/2, 1}]}, {i, 1, n}]]},      {k, 0, steps, IntegerPart[1/dt]}]]      What is the problem? Is there a better way to define u[k]? Thank you for your help.


How to solve three equations with four unknowns iteratively?

I have three equations of the form $\quad \eta = f(N1L, N2L)$ $\quad N1L = g(\eta, R)$ $\quad N2L = h(\eta, R)$ I want to eliminate $\eta$, so that I can get $N1L$ and $N2L$ for a range of $R$. I copied my short program bellow (which can't be solved by the methods I know.) I really appreciate any help.               Clear["Global`*"]     T = 25 + 273.15;                          k = 1.3806488*10^-23;           theta = Degree 10;                   gama = 0.07199;                 Psat1 = 3.168*10^3;              PL = 101.325*10^3;                            vLinf = (1/997.0479)*18.015/1000;        L = 0.45;                   Vcontainer = L^3;           N1total = 3.049*10^27;     N1 = N1total/Vcontainer;                                        N2total = 3.67*10^22;                N2 = N2total/Vcontainer;                                       qc = 1.22*10^8;     w = 50*10^-6;      alfa = Degree 45;     KH = 1639.34*10^5/(10^3*6.02*10^23);             Vv[R_] := (Pi*R^3/3)*(2 -           3*Sin[theta - alfa] + (Sin[             theta - alfa])^3 + (Cos[theta - alfa])^3/Tan[alfa]);     Asv[R_] := Pi*R^2*(Cos[theta - alfa])^2/Tan[alfa];     Alv[R_] := 2*Pi*R^2*(1 - Sin[theta - alfa]);     H[R_] := R*(1 - Sin[theta - alfa] + Cos[theta - alfa]/Tan[alfa]);          (******************This is where my qyestion is:*******************************)          N1L[R_] := N1 - qc*(etha[R]*Psat1*Vv[R]/(k*T));          N2L[R_] := N2/(1 + qc*PL*Vv[R]/((N1L[R]*PL/KH)*k*T));          etha[R_] := Exp[vLinf*(PL - Psat1)/(k*T) - N2L[R]/N1L[R]];          Rc[R_] := 2*gama/(etha*Psat1 + PL*(N2L[R]/(N1L[R]*PL/KH)) - PL);         B[R_] := qc*(-2*gama * Vv[R]/Rc[R] +            gama*(Asv[R]* Cos [Degree (theta)] + Alv[R])) +         N1total*k*T*(N2/N1 - N2L[R]/N1L[R]) +         N2total*k*T*         Log[N1*k*T/(N1*k*T - qc*etha*Psat1*Vv[R] + qc*Vv[R]*KH)];          t1 = Table[{ R*10^6, Rc[R]*10^6}, {R, 10^-6, 10^-5, 10^-7}];     ListPlot[t1, Joined -> True, PlotStyle -> {Thick},       AxesLabel -> {Style["R(micrometer)", "Graphics", FontSize -> 13],         Style["Rc (micrometer)", "Graphics", FontSize -> 13]},       AxesOrigin -> {0, 0}, TicksStyle -> Directive[12]]


Transforming a huge rectangular table to Sparse Array

I am interested in the most efficient way to transform a huge rectangular array to a sparse array structure. Consider a numeric rectangular table that is rather sparse, with zero positions being set to Null rather than 0, which saves time and memory during the fill. The problem is that SparseArray function can not be directly applied to that kind of table. First, every Null should be replaced by 0, as can be seen in the following example:               Q = 100;(*the matrix dimension is QxQ.*)     f[p1_,p2_]:=If[PrimeQ[p1+p2],1,Null];(*the specific form of the matrix elements chosen for illustrative purposes only*)     mat=ParallelTable[f[p1,p2],{p1,Q},{p2,Q}];(*the matrix to be later compressed to SparseArray*)     mat0=mat/.(Null)->0;(*Here we replace Nulls with zeroes*)     sparse=SparseArray[mat0];(*Now the SparseArray may be applied*)      However, during such replacement procedure, the ByteCount[mat0] is dramatically increased, and at sufficiently large Q one runs out of memory. Besides, it does not seem logical to artificially inflate the matrix in order to be able to compress it afterwards. So, how can I transform a huge rectangular array full of Nulls to a sparse array structure, without replacing Nulls with zeroes? Thank you! P.S. Other ways to form a sparse array that I am aware of are getting too speed- and memory inefficient as Q is taken large (say, Q > 50000), e.g. this way               SparseArray @ Flatten[ParallelTable[{p1, p2} -> f[p1, p2], {p1,Q}, {p2,Q}] /. (_ -> Null) -> Sequence[]];      takes 100Gb of memory to form a sparse array of 10 Gb. P.P.S. One could ask, what's the need to compress a matrix that is already quite sparse? The SparseArray version takes less memory, anyway: ByteCount[sparse] is less than ByteCount[mat]. P.P.P.S. Above was the toy problem. The more realistic code is as follows:               << CompiledFunctionTools`     Compiler`$CCompilerOptions = {"SystemCompileOptions" ->      "-fPIC -Ofast -march=native"};     On[ Compile::noinfo]     n = 4;(*the number of electrons*)     Upp = 6;(*Upp is the upper occupied      quantum state*)     a = Subsets[Range[Upp], {n}];(*a is the set of all many-particle states*)     Q = Binomial[Upp, n];(*The number of many-particle states in a*)     (*Fast compiled function that compares two vectors and returns the positions of different elements.*)     VectorCompare =      Compile[{{v1, _Integer, 1}, {v2, _Integer, 1}}, Block[{i1 = 1, i2 = 1, d1 = Internal`Bag@Most[{0}],       d2 = Internal`Bag@Most[{0}]},     (*Run along the lists,recording differences as we go*)      While[i1 <= Length[v1] && i2 <= Length[v2],       Which[v1[[i1]] < v2[[i2]], Internal`StuffBag[d1, i1]; i1++,        v1[[i1]] > v2[[i2]], Internal`StuffBag[d2, i2]; i2++, True, i1++;        i2++]];     (*Fix up in case we ran off the end of one of the lists*)     While[i1 <= Length[v1], Internal`StuffBag[d1, i1]; i1++];     While[i2 <= Length[v2], Internal`StuffBag[d2, i2]; i2++];     {Internal`BagPart[d1, All], Internal`BagPart[d2, All]}],      "CompilationTarget" -> "C",      CompilationOptions -> {"ExpressionOptimization" -> True,       "InlineExternalDefinitions" -> True}, RuntimeOptions -> "Speed",      RuntimeAttributes -> {Listable}, Parallelization -> True];          CompareMatrix = SparseArray@     Developer`ToPackedArray[     ParallelTable[       If[p1 < p2, vc = VectorCompare[a[[p1]], a[[p2]]];         diff = Length@Flatten@vc;         Which[diff == 2, {vc[[1, 1]], vc[[2, 1]], 0, 0},          diff == 4, {vc[[1, 1]], vc[[2, 1]], vc[[1, 2]],           vc[[2, 2]]}]], {p1, Q}, {p2, Q}] /. (Null) -> {0, 0, 0, 0}];      The array I need could be built without any unnecessary zeros by running the following code:               CMB2 = Internal`Bag@Most[{0}];     CMB4 = Internal`Bag@Most[{0}];     Do[vc = VectorCompare[a[[p1]], a[[p2]]]; l = Length@Flatten@vc;      Which[l == 2,Internal`StuffBag[CMB2, {p1, p2, vc[[1, 1]], vc[[2, 1]]}],     l == 4,Internal`StuffBag[CMB4, {p1, p2, vc[[1, 1]], vc[[2, 1]], vc[[1, 2]], vc[[2, 2]]}]], {p1, 1, Q - 1}, {p2, p1 + 1, Q}];      If only it were parallelizable... Edit: The fastest and memory-efficient solution is as follows:               CM=Join @@ ParallelMap[Developer`ToPackedArray,     Table[vc=VectorCompare[a[[p1]],a[[p2]]];diff = Length@Flatten@vc;     Which[diff > 4, empty,      diff == 4, {p1,p2,vc[[1,1]],vc[[1,2]],vc[[2,1]],vc[[2,2]]},     True, {p1,p2,vc[[1,1]],vc[[2,1]],0,0}],     {p1,1,Q-1},{p2,p1+1,Q}]];      In essence, this closes the question.


Doing local FFT on huge 3D vector data cell mesh and visualizing it spatially?

**Simulation type:** I'm running a simulation with the OOMMF micromagnetics package http://math.nist.gov/oommf/ where are magnet is represented by a **mesh of 3 million cells** , it gets excited by a magnetic pulse, the single cells oscillate and data output for every cell is $x, y, z$ direction and absolute magnetic field value of every component over time, so a mini-magnet. Now I want to do a FFT on $m_z(t)$ **for every cell** and later visualize this magnet over time while cells with $m_z(t)$ showing common oscillation modes/eigenfrequencies get same color. **Data output format:** It is "data binary 4" and as said $x, y, z$ and absolute field value for every component is given for all time steps (below 300-500 time steps). Download an example of a time-step data file from the middle of the simulation: The manual says: > **The binary representations are IEEE floating point in network byte order > (MSB)**. To insure that the byte order is correct, and to provide a partial > check that the le hasn't been sent through a non 8-bit clean channel, the > first datum is a predened value: 1234567.0 (Hex: 49 96 B4 38) for 4-byte > mode, and 123456789012345.0 (Hex: 42 DC 12 21 83 77 DE 40) for 8-byte mode. > The data immediately follow the check value. The structure of the data > depends on whether the \meshtype" declared in the header is \irregular" or > \rectangular". **For irregular meshes, each data element is a 6-tuple** , > consisting of the x, y and z components of the node position, followed by > the x, y and z components of the field at that position. Ordering among the > nodes is not relevant. The number of nodes is specied in the \pointcount" > line in the segment header. For **rectangular meshes, data input is field > values only, in x, y, z component triples.** These are ordered with the x > index incremented first, then the y index, and the z index last. This is > nominally **Fortran order** , and is adopted here because commonly x will be > the longest dimension, and z the shortest, so this order is **more memory- > access ecient than the normal C array indexing of z, y, x.** The size of > each dimension is specied in the \xnodes, ynodes, znodes" lines in the > segment header. I use a rectangluar mesh here **Question:** The FFT can be done using something like MATHEMATICA or MATLAB for a single cell and ($m_z$/ number, time/number) data list .dat file, but a data binary 4 file for a single time step for 3 million cells is up to 20 MB big, workstation with 30 GB RAM and 12 Cores available. The manual above mentions FORTRAN (to my knowledge not so easy to learn language although very fast). What is the way to achieve the results I'm looking for and described above? From my point of view I face the problem to do the FFT in reasonable time with a script process for around 3 million cells and then transforming that data into a spectrogram (to see what different eigenfrequencies and higher harmonics exist, also this can be done by using the average $m_z$ (summed over all single cells) and simply FFT it) but also have a output format of that data binary 4 format after FFT that can be used to feed a visualization software that can read such mesh data and color code it, show single 2D slices of the 3D object. I read that MATHEMATICA can deal with binary 4 and offers high performance, but as this is completely new land to me, I first want to ask given above constraints and wishes, what is the best way and software/programming language to achieve this in **reasonable time (few weeks)**?


Fit an image within a Rectangle [] in Graphics

Based on the following Code (yet the white text in the image is added with PPT), I would like to have an image fit within one of the rectangle. For Example the image from there : http://dailytechgadgets.files.wordpress.com/2011/02/old-ferrari.jpg 2 main problem : Although I know about Texture[], I have not been able to use it in my rectangle, nor drawing the correct polygon, or the correct vertex coordinates. The image might not be of the same ratio, so I would like to crop it accordingly. I have not been able to yet without deforming the image. My Ideal OutPut below : ![enter image description here](http://i.stack.imgur.com/ZxLCi.png)               c0 = {RGBColor[23/85, 29/255, 142/255], RGBColor[244/255, 1, 59/255],            RGBColor[1, 0, 32/85], RGBColor[18/85, 72/85, 197/255]}          Graphics[{EdgeForm[Thickness[.005]], White,       Rectangle[{0, 0}, {160, 90}], Black, Opacity[.7],       Rectangle[{0, 0}, {80, 63}], White, Opacity[1],       Rectangle[{80, 0}, {160, 63}], Opacity[1],       Flatten@({Flatten@(Table[            RandomChoice[{GrayLevel[.15], c0[[#]]}], {3}] & /@           Range[2, 4, 1]),        MapThread[        Function[{Xs, Ys},          Rectangle[{Xs, Ys}, {Xs + 16, Ys + 9}]], {Flatten@          Table[Range[0, 32, 16], {3}],          Flatten@(Table[#, {3}] & /@             Range[63, 81, 9])}]}\[Transpose])},       Method -> {"ShrinkWrap" -> True}, ImageSize -> 500]


Can't use CUDA shared memory

CUDALink is properly installed and up to date, all built-in functions work fine, and all little functions I did worked fine... Until I tried using shared memory. The only example I found on the help doesn't work for more than one reason. It declares the memory without a type and my compiler complains. So that's a bad start. Anyway, I'm trying the most basic function I can, and I can't make it work. I would appreciate if anyone could tell me what's wrong, or if it works (or doesn't) for you, or give me an example that does work... Sample code I'm trying                   testf = CUDAFunctionLoad["__global__ void test(int* out)        {         extern __shared__ int smem[];            if(threadIdx.x==0)         {             smem[threadIdx.x]=7;             out[threadIdx.x]=3;         }else             out[threadIdx.x]=33;           }", "test", {{_Integer, "Output"}}, 16];      When I run it I get a _CUDAFunction::internal:`CUDALink` experienced an internal error. >>_ and then I need to restart the kernel to make `CUDALink` work again               testf[Range[16], 16]      Just commenting out the line with the `smem[threadIdx.x]=7` assignment makes it work. The compiler issues no warnings


How to automatically restart Mathematica kernel after out-of-memory error

I want to run a Mathematica code repeatedly, even after the kernel shuts down when it is out of memory, because I have designed my program to continue appending the data to a file. Currently, I have to restart the kernel manually every 10 minutes. Does anyone have an idea how one can automate this process? Thanks.


Apply 2 Styles within Text[]

Please consider :               aboveBox[info_, colors_] :=       Graphics[{colors, EdgeForm[Thick], Rectangle[{0, 0}, {26, 3}],         Text[Style[info, 18, Bold, Black, TextAlignment -> Center],              {26, 3}/2]}, ImageSize -> 300]      ![aboveBox\[\] output](http://i.stack.imgur.com/Hsj0u.png) Now I would like to have a second bit of text aside, with a different style. I know I could use 2 `Text[]`s, but I then struggle with the alignment. Is there a way to have two bits of text with different Style within the same `Text[]` Example of desired output : ![aboveBox\[\] with text in different styles](http://i.stack.imgur.com/611aJ.png)


How to plot vector function r(t) = i + j + t*k

How can I plot the vector function $r(t) = i + j + t\;k$, where _i, j, k_ are unit vectors, and _t_ is the parameter of the function r.


Running a Mathematica Notebook from command line and saving the output

I am working on a project that requires some calculations to be done in Mathematica. I don't know Wolfram language and I don't have the time to learn it (I am using a 30-day trial) so I have a python program that is generating a lot of .nb files. What I would like to do would be to be able to run this .nb files from command line and then save their outuput to a .txt, .png, .jpg, any format I can work with without having to open Mathematica, run the notebook and grab the data. The output of the notebook file is given by some calls to Print and also the following command               Show[Graphics[...], Graphics[...],            Graphics[...], Graphics[...], Axes -> False]      The ... were added for this question. I am hoping for a command like: mathematica-command -options file.nb > output_file I have Windows 8 and the latest Mathematica. Thanks in advance.


Error messages from compiling the Piecewise function

The following works               Compile[{{x, _Real}}, Piecewise[{{{0., 0.}, x > 5.}}, {1., 1.}]]      but if I enter the `Piecewise[...]` in the bracket style, I get two error messages > Compile::cif: The types of the two results in If[True,{1.,1.},0] are > incompatible because their ranks are different. Evaluation will use the > uncompiled function. >> > > Compile::cif: The types of the two results in > If[x>5.,{0.,0.},If[True,{1.,1.},0]] are incompatible because their ranks are > different. Evaluation will use the uncompiled function. >> It seems the bracket style input form of the `Piecewise` function is transformed into               If[x>5.,{0.,0.},If[True,{1.,1.},0]]      and `0` has a different type than `{1.,1.}`. Here is the screenshot: ![enter image description here](http://i.stack.imgur.com/UUQLa.png) `In[2]` works as expected, but when I type the bracket style of `Piecewise` in `In[3]`, it doesn't work. However, if I copy the output bracket style of `Piecewise` in `Out[2]` and put it in `In[4]`, it works again. Why this happens and how to fix it? Am I making stupid mistakes or what?


What's inside InterpolatingFunction[{{1., 4.}}, <>]?

I'm curious what's inside the `InterpolationFunction` object? For example:               InputForm[Interpolation[{1., 2., 3., 4.}]]     (*       InterpolatingFunction[         {{1., 4.}},          {4, 7, 0, {4}, {4}, 0, 0, 0, 0, Automatic},          {{1., 2., 3., 4.}},{Developer`PackedArrayForm, {0, 1, 2, 3, 4}, {1., 2., 3., 4.}},          {Automatic}]     *)      What do those arguments mean?


Cleaning the hyperlinked string from its hyperlink property

I need to rename a number of files. These are graphic jpg files, and I have an Excel table in which the initial names of these files are collected. For example, this is the name of one of these files taken from the table: 121026_DeviceData\63486504438_Osc.jpg My problem is that the above name in my Excel file is a hyperlink, rather than a string. By directly addressing this hyperliknk from Mathematica a notebook with a mess inside opens, instead of the desired image. My question is: How could I clean the text of this file name off from its hyperlink property, such that after the cleaning I get a pure string "121026_DeviceData\63486504438_Osc.jpg" instead of the hyperlink? Added later: I have found such an approach:               (hyperlinkText/.Hyperlink->String)[[1]]      that returns me a string: "121026_DeviceData\63486252521_Osc.jpg" With this the question is answered, though somebody might propose a better solution.


Text in columns

So far I've only seen the front end work in a one-cell-below-the-other manner, so I am probably not expecting much of this question, but here it goes. Is there any way to create a document with text arranged in columns? Perhaps a way to create a cell with two (or more) inline cells with fixed locations that grow as you type? Any ideas?


Parallelize evaluation of function with memoization

I have a complicated function that I need multiple times, so I want to memoize it and have the first evaluation done in parallel. Unlike in my example below it's not a continuous function, so interpolation is not an option. (In fact, it's values are also functions.) The naive approach clearly does not work, because the memoized value is then only known on the kernel it was evaluated on:               LaunchKernels[2];     f[x_] := f[x] = (Pause[3]; N[Sin[x]]); (*Expensive calculation*)     ParallelDo[f[x], {x, 3}];          ParallelEvaluate[AbsoluteTiming[f[1]]]          (* ==> {{3.000632, 0.841471}, {0.000024, 0.841471}} *)      I believe I found a workaround by doing something like this:               f[x_] := (Pause[3]; N[Sin[x]]); (*Expensive calculation - NO memoization*)     t = ParallelTable[f[x], {x, 3}];     Do[f[x] = t[[x]], {x,3}];      Using `SetSharedFunction[f]` before `ParallelDo` also yields a non-optimal result:               {{0.012051, 0.841471}, {0.012202, 0.841471}}      0.01 s is still a long time to look up a value (see above, it should be < 1 ms). Is there something more elegant or do I have to keep it like this? Edit: Just to be clear, the workaround above without Shared Functions works, it runs in parallel and the main kernel knows the values afterwards, but it strikes me as an ugly hack. I was wondering if there was an "official" solution.


Add contour lines to Graphics3D

I am writing the following code:               points = {{6, 2.12, .4738}, {8, 2.05, .5254}, {10, 1.99, .5520}, {12,          1.73, .5595}};     faces = {{1, 2, 4}, {2, 3, 4}};     colors = {32.4, 24.3, 19.2, 16.5};     color1 = (colors[[1]] - Min[colors])/(Max[colors] - Min[colors]);     color2 = (colors[[2]] - Min[colors])/(Max[colors] - Min[colors]);     color3 = (colors[[3]] - Min[colors])/(Max[colors] - Min[colors]);     color4 = (colors[[4]] - Min[colors])/(Max[colors] - Min[colors]);     pts = Map[toPoint, points];     Graphics3D[{GraphicsComplex[ points, Polygon[faces],         VertexColors -> {RGBColor[color1, 0, 1], RGBColor[color2, 0, 1],           RGBColor[color3, 0, 1], RGBColor[color4, 0, 1]}]},       BoxRatios -> {1, 1, 1/2}, Axes -> True, Lighting -> Automatic]      The result is successful, but lacks contour lines for a 3D effect. How can I add that feature? ![My image:](http://i.stack.imgur.com/kJj3n.jpg) Edit: pts is leftover code from something else. It does nothing. I am trying to get continuous mesh over the surface of both triangles to make them look more 3-dimensional. The two surfaces in the attached image are in different planes, but they share a common edge. I need contour lines or mesh to emphasize that these two surfaces are not in the same 2-dimensional plane.


What format can Image3D be exported to?

![3ds not working](http://i.stack.imgur.com/MPpmn.png) ![enter image description here](http://i.stack.imgur.com/tiacJ.png) I made a 3D image by stacking 2D images (Image3D command). When I tried to export it, 3DS and X3D are not working. What format can I export?


Combining two notebooks

I have a notebook which contain all the variables and defined functions. I want to do two tasks. As an example, I want to find the density and energy which have equations in terms of above mentioned variables and functions. If I write one code for these two tasks, it is a very large notebook. So, if I have separate notebooks for "variables and functions",density and energy, how can I connect each notebook so that they can run properly and give the result? Could anyone please help me to do this?


Why are some option values symbols, other strings?

Is there a rationale, beyond historical accident, why some _Mathematica_ option values are strings, while others are symbols? It seems natural that some value spaces, e.g. named color schemes, are so numerous and only applicable to `ColorData`, e.g. `ColorData["HTML"]` and so should be strings. On the other hand wouldn't it make more sense if `"XAxis"` in `PairedHistogram[..., BarOrigin -> "XAxis"]` were a built in symbol to be shared as an option value across composite graphics functions?


From ReadList[package,String] back to a Package

I read in a package as a list of strings Using ReadList ReadList["package1`", String] StringReplace can then be used on (e.g. mapped over) this list of strings. Is there anyway to save/export the result as a revised package (overwriting "package1`")


How do I create a histogram out of this datastructure: x[i] = value_i?

Here is my SSCCE:               a[1] = 2; a[2] = 3; a[3] = 6; Histogram[a]      This throws and error though. Here are my questions:   1. What kind of data type is a? Is it an Array? a List? So far as I can tell it's neither.    2. How do I get the above to work?


How to programmatically comment out multiple source files?

How to programmatically comment out the entire content of multiple `.m` source files assuming they start with correct Mathematica syntax? I need it to be robust so the content of the file can be anything as long as it's valid `.m` source file.


Is it possible to modify the tick marks in BarChart plot?

I need to specify the length of the tick marks on the x axis in a `BarChart` plot:               BarChart[      {{1, -2}, {2, -3}, {3, -4}},      BarSpacing -> {0, 1},      Axes -> True,      Ticks -> None,      TicksStyle -> Red]       ![enter image description here](http://i.stack.imgur.com/91rdN.png) I can modify the style settings for the tick marks on the x axis. However, I found no possibility to remove (see code above with the option `Ticks -> None` ) nor to give the specified positions of the tick marks. In particular, I want to specify the lengths in the positive and negative directions, like described in the `Ticks` description in the documentation center.


Why does the evaluation of this series fail?

The following series expression holds:               BesselJ[1,a x]BesselJ[1,b x]==a b (x^2)/4*Sum[(-1)^n*(a x/2)^(2n)*Hypergeometric2F1[-n,-1-n,2,b^2/a^2]/(n!Pochhammer[2,n]),{n,0,Infinity}]      Where `BesselJ[1,x]` is the Bessel function of the first kind of order 1. `Hypergeometric2F1[a1,a2,b1,x]` is Gauss hypergeometric function. `Pochhammer[2,n]` is the Pochhammer Symbol. This series expression can be found in e.g. Bateman Manuscript Project, Higher Transcendental Functions, Vol.2, and it holds without any constraints. For this series expression, if the relatively small parameters are chosen, e.g. `a=1`, `b=2.5`, `x=3`, and just replace the sum index `Infinite` with `100`, the product of Bessel functions gives `0.045857190997445` and the series gives `0.045857190997469`. They coincide well. However, for a relatively large `x`, the product of Bessel functions must be decreasing, e.g. `a=1`, `b=2.5`, `x=100`, the product of Bessel functions gives `0.003338005199477126`, but the series gives `6.410492282570008*10^131` which is apparently divergent. The reason of this divergence is unknown for me. It can't be better to increase the terms of the series expression or improve the precision of the Gauss hypergeometric function. Could anyone help? Thanks!


Add lists with unequal lengths together to create a matrix

I'm trying to create a stacked bar chart using raw data coming from a MySQL server. The result coming back from one query is:               {{SQLDateTime[{2011, 7, 23, 13, 0, 0.}], 74},       {SQLDateTime[{2011, 8, 11, 15, 35, 54.}], 1},       {SQLDateTime[{2011, 8, 18, 9, 28, 14.}], 49},       {SQLDateTime[{2011, 8, 24, 21, 45, 29.}], 1},       {SQLDateTime[{2011, 8, 31, 10, 0, 18.}], 1},       {SQLDateTime[{2011, 9, 8, 10, 6, 45.}], 5},       {SQLDateTime[{2011, 9, 14, 9, 35, 40.}], 10},       {SQLDateTime[{2011, 9, 15, 6, 27, 12.}], 1},       {SQLDateTime[{2011, 9, 21, 9, 47, 26.}], 6},       {SQLDateTime[{2011, 9, 29, 10, 5, 2.}], 3},       {SQLDateTime[{2011, 10, 6, 9, 34, 26.}], 3},       {SQLDateTime[{2011, 10, 24, 9, 31, 42.}], 1},       {SQLDateTime[{2011, 10, 27, 9, 52, 7.}], 2},       {SQLDateTime[{2011, 11, 25, 10, 53, 27.}], 2},       {SQLDateTime[{2011, 12, 1, 11, 0, 21.}], 3},       {SQLDateTime[{2011, 12, 6, 10, 49, 42.}], 3},       {SQLDateTime[{2011, 12, 8, 14, 38, 54.}], 1},       {SQLDateTime[{2012, 3, 27, 8, 10, 31.}], 1}}      I'm going to get ten similar sets of results. The difference will be that they don't contain all of the same dates. I need to create a matrix like so: The first row is a list of dates. Each result set will contain different dates and some will be the same and some not, think of this first row as a list of unique dates pooled together from all result sets. Should be ordered chronologically. Row number two lists the correponding values in each column. Look at my example result set above. Each date has a value corresponding to it. All of these values make up a row, with each element under its corresponding date. There will be dates in the first row for which there are no corresponding values in this particular result set, these elements should be zero. There will be one row for each result set plus the top row consisting of dates. How can I do this?


Transform recursion for coefficients into differential equation for generating function

Assume, one is given a linear recursion with polynomial coefficients for a sequence $(a_i)_i$, such as               a[i] == i a[i-1]      I would like to convert this recursion into a differential equation for the (formal) generating function $G(x)=\sum_{i}a_i x^i$. In my example above, direct manipulation leads me to the equation $$ G(x)=2x^2 a_1+x^2 G'(x)+xG(x) $$ which Mathematica can solve in terms of special functions. Interestingly, the power series with coefficients $i!$ (the solution to $a_i=i a_{i-1}$) doesn't converge for any $x$. Since I'm only interested in formal power series, however, I still believe that my question makes sense. I'm particular interested in a method that also works for higher order recursions with higher degree polynomial coefficients. Thanks. I would like to add that I am familiar with the functions GeneratingFunction[] and RSolve[] but neither seems to be of much help for this problem. **Edit 18 April 2014:** In version 9 the behaviour of `GeneratingFunction` appears to have changed in such a way that it doesn't directly solve this problem any longer. I therefore reactivate this question and ask for a way to transform a linear recursion with polynomial coefficients into a differential equation for the generating function.


How to construct this matrix fast?

I write a function which is a matrix as below:               mat[kx_, n_] := (        Clear[a, b, h];        h = Table[0, {i, 1, 2 n}, {j, 1, 2 n}];        a[m_] := 2 m - 1;        b[m_] := 2 m;        t1 = 1;        aa = 1;        Do[        h[[b[i], a[i]]] =          t1 (E^(I kx ((Sqrt[3] aa)/2)) + E^(-I kx ((Sqrt[3] aa)/2)));        h[[a[i], b[i]]] =          t1 (E^(I kx ((Sqrt[3] aa)/2)) + E^(-I kx ((Sqrt[3] aa)/2)));        If[i + 1 <= n, h[[b[i + 1], a[i]]] = t1, Null];        If[i - 1 > 0, h[[a[i - 1], b[i]]] = t1, Null];        , {i, 1, n}];        h)      I test the speed of the matrix construction               In[90]:= Table[mat[kx, 7], {kx, 0., 1., 1/3000}]; // AbsoluteTiming          Out[90]= {1.971113, Null}      the dimension of the `mat[kx,7]` is 14, so I test the following randomreal matrix               In[91]:= Table[        RandomReal[{0, 1}, {14, 14}], {kx, 0., 1.,          1/3000}]; // AbsoluteTiming          Out[91]= {0.027002, Null}      it is 100 times faster. **So I wonder if my`mat` function could be 100 times faster. I know my programming is poor, but I don't know how to code it elegent and efficient.So can somebody help me with it and point it out which is the most important factor that make my `mat` function so slow?**


Front-end glitch when interacting with dynamic content

This is now bugging me too much to ignore it anymore. When I interact with a notebook that has dynamic content, for example moving a slider, _Mathematica_ regularly brings other open notebook windows to the front. This means that while I am interacting with the given notebook, some other notebook (already opened, but in the background) pops up in the front, either blocking my view or just staying in the lower-left corner (if it was minimized before). The focus is not changed, so I can still interact with the content of the original notebook now in the back. When I continue manipulation, the front notebook disappears, just to reappear again a few seconds later. This is extremely annoying and happens "if the `Manipulate` [or other dynamic content] contains something that's computationally expensive" (Sjoerd's comment below, and I can confirm this), mostly when complex 2D or 3D plots are manipulated directly (e.g. 3D rotate with mouse) or indirectly (mouse driven slider changes parameters of dynamic plot). For example rotating the following 3D figure with the mouse causes the behaviour to present itself.               Plot3D[Sin[x + y^2], {x, -3, 3}, {y, -2, 2}]      Reproducibility is occasional, sometimes it happens fairly frequently, sometimes not at all. A more or less solid way to reproduce the error:   * open a fresh _Mathematica_   * open a new notebook (by e.g. `ctrl`+`N`; this will be the one that will pop to the front; this can be _any_ notebook window)   * open another notebook, paste above code   * evaluate code (dragging the 3D plot now won't trigger the glitch, or only very rarely)   * bring in front any other application, e.g. Firefox (though the glitch could happen even if no other application is running)   * get back to _Mathematica_ (by e.g. minimizing Firefox)   * dragging the 3D plot around for some time (~5-10 sec) has a high chance to trigger the glitch, which can manifest as short "jumps" of open Mathematica windows where one gets in the front for a fraction of a second) **Does anyone else experience this annoyance?** **What causes this behaviour?** * * * This is still reproducible under Mathematica 9.0.1, Windows 7.


wordpress wolframCDF plugin 2.0 stopped working

setup and tried a simple CDF document and it worked like a charm. That was a couple of months ago - now the post does not show evidence that the shortcode is working at all - the shortcode is in the post - yet, nothing on the view. This has occurred on two sites that I've place test posts with CDFs. I do not recall an update to WordPress or WolframCDF recently - and may well have misted something. I do not know how long the CDF plugin hasn't been working The post http://nomtbf.com/2013/04/weibull-vs-exponential-pdfs/ should have a obvious CDF under the get player button. any ideas on what's happening here and how to fix it? I've deleted the plugin and reinstalled. No love. I checked my machines player (most current) and did a reinstall, no love. Ideas? cheers, Fred http://wordpress.org/extend/plugins/wolfram-cdf-plugin/


Updating a tracked symbol inside Refresh?

I have some code inside a `Manipulate`, whose goal is to allow the user to edit the upper half of the matrix while keeping it symmetric at all time. The minimal code is the following:               Manipulate[      Refresh[         i = i + 1;         Do[Cmat[[i, j]] = Cmat[[j, i]], {i, 2, 6}, {j, 1, i - 1}];       , TrackedSymbols -> {Cmat}];      {i, Grid[Array[InputField[Dynamic[Cmat[[#1, #2]]], FieldSize -> 5, Enabled -> #1 <= #2] &, {6, 6}]]}      ,      Initialization :> (        i = 0;        Cmat = ConstantArray[0, {6, 6}];        )]      I added the `i` variable as a counter, and I expected it to be only incremented when I actually change the value of one of the `Cmat` elements. What actually happens is that `i` increases near the speed of the runloop, and that code actually hogs the CPU (one core of it, anyway). I suppose what happens is that the modification of the tracked value inside `Refresh` actually triggers `Refresh` itself, hence the loop. How can I prevent this? I thought restricting `TrackedSymbols` to the upper half of `Cmat` would do the trick, but it changes nothing. Is there a way, inside of `Refresh`, to change `Cmat` without it being tracked? The opposition functionality exists, in the form of `Update`.


Expand list of {{t1,x1},...} with new set of t's

I have a list of the form `data={{t1,x1}, {t2,x2},...}` and a list `newt = {nt1,nt2,...}` and I want to expand `data` to these new times to become `{{nt1,x(1)},{nt2,x(2)},{nt3,x(3)},...}` where `x(i)` is equal to the `xi` of whichever data point is preceding `nti`. I assume that `t1<=t2<=t3<=..`, `nt1<=nt2<=...` and the old times is a subset of the new ones. I did this the following way, but it is far too slow:               PadDataList[l_, grid_] :=       Module[        {lind = 1, len = Length@l},        MapIndexed[(           If[# > l[[lind, 1]] && lind < len, lind++];           {#, l[[lind, 2]]}           ) &,         grid         ]];     data = Sort[RandomReal[1, {50000, 2}], First@#1 < First@#2 &];     newgrid = Union@Join[data[[All, 1]], RandomReal[1, {50000}]];     AbsoluteTiming[PadDataList[data, newgrid];]     (* 0.4 seconds *)      Is there a cleverer and more efficient way to do this? I am using this together with another function that takes multiple lists like above and creates a new list with elements `f[nti,x(i),y(i),...]` Excuse the abuse of (i) syntax


Improving the performance of a package for working with rational functions

As _Mathematica_ gets slow for large symbolic calculations, the cost of putting terms over a common denominator (`Together`), in particular, gets too high. It occurred to me that, if one has a small number of variables, it should be much faster if we represent our expressions by arrays of their coefficients. I have implemented a small package that does this with an improvement of a factor of 10 in both speed and memory (in putting `Together` a sum of rational terms, more or less independent of the size of the sum), but it seems to me that I should be able to do better. I post my package here with the hope that someone might point out glaring performance bottlenecks. First, the public initializations, with their usability comments.               AA::usage = "DATA STRUCTURE AA[num,den] that stores polynomials as their tensor coefficients of a basis, multiplication is the tensor product"     PolytoAA::usage = "PolytoAA[poly_,vars_List] returns an AA[num_SparseArray,1]"     AAtoPoly::usage = "AAtoPoly[aa_AA,vars_] gives back a rational function of the polynomials num/den"      The actual code begins here, `PolProd` takes care of multiplying polynomials               SetAttributes[PolProd, Orderless]     PolProd[i__Integer] := Times @ i;     PolProd[sa__SparseArray] := Outer[Times, sa];       (*multiplying 2 polynomials is the tensor product in their vector space*)     PolProd[i__Integer, sa__SparseArray] := Times[i] Outer[Times, sa];          (*It would be cleaner and more object oriented to call two instances of polprod        on i and sa but it would force more pattern matching so it would be less efficient*)      This code performs the arithmetic operations on the `AA[num,den]` data structure               AA /: i_Integer*AA[num_, den_] := AA[i*num, den]      (*absorb all integer into AA, this means that the sum rule has to do less         pattern matching and is more efficient, overall more efficient?*)     AA /: AA[a_, a_] := 1     AA /: AA[0, _] := 0     AA /: AA[num1_, den1_]*AA[num2_, den2_] :=        AA @@ (PolProd[#1, #2]& @@@ {{num1, num2}, {den1, den2}})     AA /: AA[num1_, den_] + AA[num2_, den_] :=        AA[num1 + num2, den]       (*can't check for a SparseArray cos it might be an Integer,          by dimensional analysis we should get two arrays here though*)     AA /: AA[num1_, den1_] + AA[num2_, den2_] :=        AA[PolProd[num1, den2] + PolProd[num2, den1], PolProd[den1, den2]]       (*together rule, this a recursive implementation that doesn't treat the          sum of many AA all at once, this is intentional cause it minimises the          number of array outer products that are calculated and I believe it's          the more efficient but maybe not*)     AA /: aa_AA^n_Integer :=        If[n < 0, Reverse @ #, #]& @ (PolProd[Sequence @@ ConstantArray[#, Abs @ n]]& /@ aa)       (*this takes care of both efficiency of recursively pattern matching the          product rule on large n and dividing by AA*)     (*NOTICE THE WEIRD SYNTAX/BUG If[n<0, Reverse @ #, #]& @ THERE ARE TWO INTANCES OF @*)      I also post the the functions that go between `AA` and the polynomials for the sake of clarity and completeness               AAtoPoly[aa_AA,vars_] := #1/#2& @@ (aa /. l_SparseArray :>        Dot[l, Sequence @@ ConstantArray[vars, Depth[l] - 1 (*gives rank of the tensor*)]])     PolytoAA[expr_^n_, vars_List] := PolytoAA[expr, vars]^n     PolytoAA[expr : (_Times | _Plus), vars_List] := PolytoAA[#, vars]& /@ expr     PolytoAA[expr_,vars_List] /; PolynomialQ[expr, vars] :=        AA[Last[CoefficientArrays[expr, vars]](*num*), 1 (*den*)]      **BENCHMARKS** I define some random, small polynomials               vars = a /@ Range[10]     pols = Table[        a[RandomInteger[{1, 10}]] + a[RandomInteger[{1, 10}]], {20}] //        DeleteDuplicates     % // Length      > {a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8], a[9], a[10]} > > {a[1] + a[7], a[4] + a[6], a[2] + a[4], a[5] + a[9], 2 a[8], a[5] + a[6], > a[2] + a[9], a[4] + a[7], a[4] + a[9], a[7] + a[9], a[3] + a[7], a[2] + > a[6], a[1] + a[9], a[2] + a[3], a[7] + a[10], 2 a[2], a[3] + a[9]} > > 17 First I put them `Together` using my code               aa = PolytoAA[#, vars] & /@ pols;     togaa = Sum[aa[[i]]/aa[[i + 1]], {i, Length@pols - 1}] //        AbsoluteTiming     % // ByteCount      > > {0.8960513,AA[SparseArray[<274432>,{10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10}],SparseArray[<16384>,{10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10}]]} > > 18614128 and now without my implementation               togpols = (Sum[pols[[i]]/pols[[i + 1]], {i, Length@pols - 1}] //          Together) // AbsoluteTiming//     % // ByteCount      > {8.2054693,...} > > 34567480 I check that both give the same result               togpols2 = AAtoPoly[togaa // Last, vars](*//Simplify*);     Last[togpols] - togpols2 // Together      > 0


Composite graphics with Row, Column, data aggregation and layout control

This chromogram shown here represents data (mouse activity patterns during visits) for ~20 physicians in a study, each of which may have a variable number of visits in the study (physicians are color coded; also the last 2 digits in the XXX-YY). So each row represents one visit. Row and Column are used to layout the graphical elements including the XXX-YY annotation (the arrow is due to using Rule in key-value pairs). The query looks something like this:               Column[#,ItemSize->90]&@  PACE[VISITS] /.            v_String:>Row@{PROVIDERCOLOR@v ->  Graphics[VGr[v/.PACE[V1]],ChromoGrOptions]}      Taking the resulting expression as argument, how can the spacing be adjusted so that there is more space between distinct physicians' data? A method I want to avoid, if possible, is to restructure the data and call `Column` separately perhaps with different padding parameters. Though perhaps it's possible to apply `Map` or `Thread` or combinations, to effect that rewrite. Thoughts?


Integrate and ConditionalExpression Output

I am integrating some difficult functions and using the conditional output to place bounds on parameters to ensure integrability, but it seems that not all of the conditions are being returned. The following simple example illustrates the issue. When I perform the 1D integration               Integrate[Exp[b y], {y, 0, Infinity}]      I receive the correct output               ConditionalExpression[-(1/b), Re[b] < 0]      but when I perform the 2D integration               Integrate[Exp[a x + b y], {x, 0, Infinity}, {y, 0, Infinity}]      I only receive               ConditionalExpression[1/(a b), Re[a] < 0].      That is, the condition on the parameter `b` ensuring integrability is not returned. In this case does Mathematica only return the condition associated with the last integration step? Thanks...


Adding a thick curve to a regionplot

Suppose we have the following simple RegionPlot:               f[x_] := 1 - x^2     g[x_] := 1 - 0.5 x^2     RegionPlot[{y < f[x], f[x] < y < g[x], y > g[x]}, {x, 0, 2}, {y, 0, 2}]      ![enter image description here](http://i.stack.imgur.com/ZPGQG.jpg) Now I'm trying to change the curve defined by $y=g[x]$ into a thick black curve, while leaving all other boundaries in the plot unchanged. I've tried adding the region $y=g[x]$ and playing with the plotstyle, which didn't work, and I've tried BoundaryStyle, which changed _all_ the boundaries in the plot. Now I'm kinda out of ideas... Any help would be appreciated!


Calculate integral for arbitrary parameter n in infinite square well problem

I'm continuing[1,2] the study of an infinite square well in the context of quantum mechanics. Ultimate goal is to calculate the product $\Delta x\Delta k$, for various eigenstates, that is for various values of number $n$. I have finished with $\Delta x$, but I'm stuck with $\Delta k$.               ClearAll["Global`*"];     (* The length of the well *)     L = 1;          (* The eigenfunctions, n=1,2,3,... *)     u[n_, x_] := If[x <= 0 || x >= L, 0, Sqrt[2/L] Sin[n π x / L]]          (* The Fourier transform of eigenfunctions u[n,x] from the position        domain onto the momentum domain *)     φ[n_, k_] :=         Simplify[             FourierTransform[u[n, x], x, k, FourierParameters -> {0, -1}],             n ∈ Integers]          (* The probability density function η(n,k) *)     η[n_, k_] :=          FullSimplify[φ[n, k] \[Conjugate] φ[n, k],         {n ∈ Integers, k ∈ Reals}]          (* Calculate (Δk)^2 = <k^2> - <k>^2 = <k^2> *)     Integrate[         k^2 η[n, k], {k, -∞, +∞},         (* Edited: Was: {n ∈ Integers, n > 0}, but this edit didn't            fix the problem. *)          Assumptions -> n ∈ Integers && n > 0]      The problem is that _Mathematica_ can't calculate the last integral for any arbitrary $n$, although it can, correctly, calculate its value for hardcoded $n$s. Like $n=1,2,...$. **My question is** : Do you have any idea on how I could calculate it, perhaps by rewriting it a bit, or by using some other trick? In case it helps, the result should be $n^2\pi^2$. **Note** : Actually it can be calculated with Cauchy's residue theorem, but I'd like to avoid taking that route, if possible. Though, if it can't be done otherwise, I will post a solution with residual calculation so that this question has an answer. **Mathematica.SE related (to the physical problem) questions** : Is there a more mathematica-y way to label these plots? Why does FourierTransform converge while same integral manually written does not?


joining lists based on content

I have lists created by other processing steps, which are basically constituted by elements like this:               {a, b, c, {d,e,f}, g, h}  (*this is the typical element in the first list*)      and                {a, b, c, {d,e,f}, i, l} (*this one of the second*)      What I'd like to do to is: for each element in the first list, each time that `a,b,c,{d,e,f}` are the same, join the elements and obtain a list of elements like:                {a, b, c, {d,e,f}, g, h, i, l}.      `a,b,c,{d,e,f}` are guaranteed to be in the same position, but of course they vary in value and order, hence the matching. Any ideas? Additionally, it would be great to do this in a "fast and efficient" way, since the lists I'll deal with will be rather long. Thanks! EDIT: to make the question clearer.               list1= {{a,b,c,{d,e,f},10,21},{m,n,p,{r,s,t},14,64}}     list2= {{m,n,p,{r,s,t},12},{a,b,c,{d,e,f},16}}      I would like to obtain:               {{a,b,c,{d,e,f},10,21,16},{m,n,p,{r,s,t},14,64,12}}      Thanks!


Defining a curved region for NDSolve

I have an equation to solve using `NDSolve` which involves two parameters: $en$ and $k$. The equation produces a set of curves when $en$ is plotted against $k$. In order to isolate the curves, I have currently defined a load of rectangular regions for `NDSolve` to work within (which each contain part of only ONE curve - I get problems if there is more than one in a region). I do know however, that all the curves lie within curved regions defined by a parabola and my code would be much simpler if I could use regions such as $\left \\{ k,0,4 \right \\}, \left \\{ en, f1(k),f2(k) \right \\}$ where the $f$'s are the known parabolas as functions of $k$ . Is there any way to get `NDSolve` to work within a curved grid when finding the solutions? The code I have:               L = 8; Clear[k, en]; Clear[uall];      solution1 =      NDSolve[{-D[uall[x, en, k], x, x] + ((x - k)^2 - en(*+V[x]*)) uall[x,         en, k] == 0., uall[0, en, k] == 0,      Derivative[1, 0, 0][uall][0, en, k] == 1},      uall, {x, 0, L}, {en, 1.8, 3.6}, {k, -.1, 0.6}];      solution2 =      NDSolve[{-D[uall[x, en, k], x, x] + ((x - k)^2 - en(*+V[x]*)) uall[x,         en, k] == 0., uall[0, en, k] == 0,      Derivative[1, 0, 0][uall][0, en, k] == 1},      uall, {x, 0, L}, {en, .95, 2.}, {k, 0.57, 1.05}];      solution3 =      NDSolve[{-D[uall[x, en, k], x, x] + ((x - k)^2 - en(*+V[x]*)) uall[x,         en, k] == 0., uall[0, en, k] == 0,      Derivative[1, 0, 0][uall][0, en, k] == 1},      uall, {x, 0, L}, {en, .95, 1.5}, {k, .95, 2.7}];      solution4 =      NDSolve[{-D[uall[x, en, k], x, x] + ((x - k)^2 - en(*+V[x]*)) uall[x,         en, k] == 0., uall[0, en, k] == 0,      Derivative[1, 0, 0][uall][0, en, k] == 1},      uall, {x, 0, L}, {en, .9, 1.2}, {k, 2.5, 4.1}];     (*Set up previous calculations as function with k as an argument*)     Eofk1[k_] :=        en /. FindRoot[(uall[8, en, k] /. solution1) == 0, {en, 2.4}];     Eofk2[k_] :=        en /. FindRoot[(uall[8, en, k] /. solution2) == 0, {en, 2.00}];     Eofk3[k_] :=        en /. FindRoot[(uall[8, en, k] /. solution3) == 0, {en, 1.2}];     Eofk4[k_] :=        en /. FindRoot[(uall[8, en, k] /. solution4) == 0, {en, 1.001}];     (*Plot the dispersion en(k) by using the function defined in the \     relevant ranges*)     c1 = Plot[Eofk1[k], {k, -.05, .58},        PlotRange -> {{-0.05, 5.}, {0, 12.}},        PlotStyle -> {RGBColor[1, 0, 0]}];     c2 = Plot[Eofk2[k], {k, .58, 1.}, PlotRange -> {{-0., 5.}, {0, 12.}},        PlotStyle -> {RGBColor[1, 0, 0]}];     c3 = Plot[Eofk3[k], {k, 1.0, 2.6}, PlotRange -> {{0, 5}, {0, 12.}},        PlotStyle -> {RGBColor[1, 0, 0]}];     c4 = Plot[Eofk4[k], {k, 2.6, 4.0}, PlotRange -> {{-0., 5.}, {0, 12.}},       PlotStyle -> {RGBColor[1, 0, 0]}];     Show[c1, c2, c3, c4]


Counting the size of the minimum cut produced by MinCut of GraphUtilities`

I want to use the `MinCut` function of the `GraphUtilities`` package to find minimum cuts for a few graphs. I'm completely new to _Mathematica_ , so I took a look at the documentation of the function and the tutorial. Here's what I did:               Needs["GraphUtilities`"]     g = {1 -> 2, 2 -> 3, 3 -> 1, 2 -> 4, 4 -> 5, 5 -> 6, 6 -> 4};     c = MinCut[g,2]      After the second line, I'm getting an output representing the cut sets, such as               {{1,2,3}, {4,5,6}}       If I plot the output, I can determine from the figure the size of the cut. With a bigger graph, that is not feasible. Hence the question: > How can I easily count the size of cut, that is the number of edges between > the two sets, i.e. the number of crossing edges?


Euler's method for a 2nd order ODE

This is my first post on this site. Also, I'm new to _Mathematica_. I'm trying to solve my first problem with _Mathematica_. It's about solving a 2nd order differential equation. I dont have the explicit `F[t]` instead I have a list of values for `{t, F[t]}`                {{0, 1.00799}, {0.1, 1.09268}, {0.2, 1.18921}, {0.3, 1.25086}, {0.4, 1.32473},        {0.5, 1.36879}, {0.6, 1.39813}, {0.7, 1.41114}, {0.8, 1.39531}, {0.9, 1.3986},        {1., 1.39468}}      The equation I want to solve is               n = 5     h = 0.1     i = 0     y[0] = 1     yy[0] = 1     zi[0] = Table[i, {i, {1, 1}}]     T1 = {{0, 1.00799}, {0.1, 1.09268}, {0.2, 1.18921}, {0.3,         1.25086}, {0.4, 1.32473}, {0.5, 1.36879}, {0.6, 1.39813}, {0.7,         1.41114}, {0.8, 1.39531}, {0.9, 1.3986}, {1., 1.39468}}     Tij = Table[T1[[i, 2]], {i, 1, 11}]     ij = Table[T1[[i, 1]], {i, 1, 11}]     F[t_] := {y[t], (Tij[[t + 1]] - 9*yy[t] - 13*y[t])/5}     While[i < n, zi[i + 1] = zi[i] + F[i]*h; y[i + 1] = h + i;       yy[i + 1] = zi[[2]]; i = i + 1]


Is there a way to make the MemberQ function apply to a list?

Is there any way to ask a boolean question if the elements of the list {2,5} are in the list {1,2,3,4,5}?


How to toggle visibility of all the evaluatable cells (but not their output)?

I know that I can select individual evaluatable cells and disable their `Open` property (through `Cell > Cell Properties`), but is there a simple way to toggle the `Open` status of all evaluatable cells?


What is the default ColorFunction for Image3D?

What is the default `ColorFunction` for `Image3D`? I find it a bit confusing that the most intense colour is not shown where the highest values appear:               data = Table[        Exp[-3 (x^2 + y^2 + z^2)], {x, -1., 1, .01}, {y, -1.,          1, .01}, {z, -1., 1, .01}];          Image3D[data, ClipRange -> {{100, 200}, {0, 200}, {100, 200}},       ColorFunction -> Automatic] (* default colour function *)      ![enter image description here](http://i.stack.imgur.com/4V39D.png) Note that the bright yellow is not in the middle of the sphere. I wanted to understand what causes this effect (possibly some interplay of opacity and colours?). Otherwise I like the default. Did anyone try to reconstruct the default `ColorFunction` for `Image3D`?


FormCalc Troubleshooting

I was wondering if someone knows enough about the FormCalc package to help me out: I am using FeynArts to generate Feynman-diagrams for certain tree-level processes in my own model and FormCalc to calculate the squared amplitude of these processes, the problem is that when I make               CalcFeynAmp[Amp]      it gives > preparing FORM code in /home/safi/Dro/FormCalc/fc-amp-12.frm running FORM... > ReadForm::formerror: !(*StyleBox[!("Illegal position for 33\nIllegal > position for 23\nIllegal position for 34\nIllegal position for 24"), "MT"]) > $Aborted One solution for that as on ( http://www.feynarts.de/formcalc/trouble.html ) FormCalc Troubleshooting page is to run fc-amp-12.frm manually by Form comes with FormCalc to see where does the problem come from, but when I make :               ./tform fc-amp-12       it gives > ./tform: cannot execute binary file Have I typed the command correctly .. any suggestions ?


netlink ikernellink. How to ignore unread data

I use IKernelLink class. When I call evaluate method, I get an exception, because I have unread data. How can I ignore it?


How can I get the beautiful font used in the Demonstrations web site in my notebook?

This question may be off-topic (if it is, I will delete it), but: What is the name of that beautiful monospace font used in the Wolfram Demonstrations source code snippets ? ![enter image description here](http://i.stack.imgur.com/xfmDa.png)


StreamPlot,smooth curves

Using the StreamPlot I observed that when the streamline is a small circle, this line is not smooth. How can I increase the number of points along the streamline? For example, these are the magnetic lines at `(x,y)` due to vertical electric currents at `(x1,y1)`:               bx[x_, y_, x1_, y1_] := -(y - y1)/((x - x1)^2 + (y - y1)^2)^(3/2);     by[x_, y_, x1_, y1_] := (x - x1)/((x - x1)^2 + (y - y1)^2)^(3/2);          pts = Flatten[Table[{x, y}, {x, -2., 2., .21}, {y, -2, 2, 0.2}], 1];          StreamPlot[{1.7 bx[x, y, -1.2, 1.5] - 0.4   bx[x, y, -1.1, 1.1],                +1.7 by[x, y, -1.2, 1.5] - 0.4  by[x, y, -1.1, 1.1]},              {x, -2., -.5}, {y, 0.5, 2.},        PerformanceGoal -> "Quality", AspectRatio -> Automatic,        StreamPoints -> {pts, Automatic, Scaled[2]}, StreamScale -> None]      ![enter image description here](http://i.stack.imgur.com/uoSCn.png)


TetGenLink Assertion failure

Needs["TetGenLink`"];          TetraMaker[pts_, surface_, TetGenString_?StringQ] :=      Module[{inInst, outInst, coords, surface1, meshElements, facets},              inInst = TetGenCreate[];             TetGenSetPoints[inInst, pts];             facets = Partition[surface, 1];             TetGenSetFacets[inInst, facets];             outInst = TetGenTetrahedralize[inInst, TetGenString];             coords = TetGenGetPoints[outInst]; (* element point *)             surface1 = TetGenGetFaces[outInst]; (* element face *)             meshElements = TetGenGetElements[outInst]; (* element indices *)           {coords, surface1, meshElements}];           TetrahedraVolume =               Compile[{{coords, _Real, 2}, {elements, _Integer, 1}},               Block[{p}, p = coords[[elements]];                  1/6*Abs[Det[p[[{1, 2, 3}]] - p[[{2, 3, 4}]]]]],                    RuntimeAttributes -> {Listable}, RuntimeOptions -> "Speed"];                          {coords1, surface1, meshElements1} = TetraMaker[data01, polysurface1, "pqa.8"];       vb = Total[TetrahedraVolume[coords1, meshElements1]]       Graphics3D[GraphicsComplex[coords1, Polygon[surface1]]]      Error dialog appears when running code below:                {coords2, surface2, meshElements2} = TetraMaker[data02, polysurface2, "pqa.8"];       vb = Total[TetrahedraVolume[coords2, meshElements2]]      > Assertion failed! > > Program: ... File: M:\Builds\2615350\checkout\Mathematica...\tetgen.cxx > Line: 21962 > > Expression: dir !=COLLOSIONFACE > > For information on how your program can cause an assertion failure, see the > Visual C++ documentation on asserts > > (Press Retry to debug the application - JIT must be enabled) I am trying to calculate volume. I wonder if both data sets are similar then why does it not work for 2nd data set? Is there any way I can fix this error?


Calling variables with use of numbers in their names

I have got few huge matrices named by ascending numbers, e.g. `x1, x2, x3,...` and I need to do the same operation with all of them - to multiply their components, obtain the absolute value etc. As I am beginner with _Mathematica_ I usually copy the expression and rewrite indexes as `x1 -> x2`, but this is very lengthy. I would like to have only one expression with something like `xX`, where I just change `X` by index of particular matrix.


Filling a plotted line both below and above the line

I'm relatively new to _Mathematica_. I tried looking for a solution online but couldn't find anything. I want to fill a plotted line both above the line (one color) and below (another color). For example, the line might be given by `y = 1 - x` over domain (0, 1) and with range (0, 1). Any suggestions?


ParallelTable slowdown for a task involving ComponentMeasurements

I'm having trouble understanding a slowdown associated with code I'm running, which should be trivial to parallelize. My code looks something like this:               DistributeDefinitions[Movie];          List =        ParallelTable[        ComponentMeasurements[          {            MorphologicalComponents[EdgeDetect[Movie[[frame]]], Method -> "ConvexHull"],             Movie[[frame]]          },           "IntensityCentroid"][[All, 2]],         {frame, 1, 100}];      This works, but takes about 14.265 seconds to run on 12 cores. However, changing "ParallelTable" to just "Table" reduces the running time to about 2.791. Changing {frame, 1, 100} to {frame, 1, 10} still yields the same result that "Table" runs about 5x as fast as "ParallelTable". The "Movie" data set is a few gigs in size, but shouldn't that not matter if I'm applying "DistributeDefinitions" to it? * * * For a self-contained example, we can use the "Mandrill" example data image in Mathematica 9:               Movie = Table[ExampleData[{"TestImage", "Mandrill"}], {x, 1, 5000}];     DistributeDefinitions[Movie];     ParallelTable[       ComponentMeasurements[         {           MorphologicalComponents[EdgeDetect[Movie[[frame]]], Method -> "ConvexHull"],            Movie[[frame]]         },          "IntensityCentroid"][[All, 2]],        {frame, 1, 20}];      Running "ParallelTable" here takes about 6.85 seconds of time on a 12 core machine. Running "Table" 7.24 seconds. However, changing the number of frames in the movie from 5,000 to 10,000               Movie = Table[ExampleData[{"TestImage", "Mandrill"}], {x, 1, 5000}];      to               Movie = Table[ExampleData[{"TestImage", "Mandrill"}], {x, 1, 10000}];      yields the same `Table` computation time of 7.26 seconds and increases the `ParallelTable` computation time to 9.71 seconds.


on convergence in optimization

I am trying to solve a nonlinear programming problem using FindMinimum solver on Mathematica. When I execute, it is printing FindMinimum::eit: "The algorithm does not converge to the tolerance of 4.806217383937354`*^-6 in 500 iterations. The best estimated solution, with feasibility residual, KKT residual, or complementary residual of {0.00499384,0.00461499,2.68875*10^-6}, is returned" Can we still use this solution for when I calculate one of the constraints using printed data, it is outside the defined range?


Importing data into an array, column by column

I'm building a large matrix having different sized rows consisting of a few columns. The different columns are imported .txt files. Why can't I build the matrix column by column? For example, I thought I could populate the first column by evaluating               NumberConcentration [[All, 1]] =       Import["C:\\Users...NumberConcentration.txt", "Table"][[87]]      _Mathematica_ gives me an error saying this part of the array does not exist. > Set::partd: Part specification NumberConcentration[[All, 1]] is longer than > depth of object. >> Do I have to define intermediate values and then combine all of them to one matrix? Or is my syntax wrong?