title: How to suppress undesirable kerning rules in math inline cells?

text: **Update** : (11/29/2012) Looks like Mathematica 9 has the same behavior. The following graphic shows how Mathematica kerns italic characters in an inline math formula cell ( **first row** ) where an \[InvisibleSpace] has been inserted between consecutive characters (which could represent either multiplication of terms or multi-indices depending on context) _vs._ in an ordinary, non-math text cell which was switched to italics using Ctrl-I ( **second row** ). ![enter image description here](http://i.stack.imgur.com/vC6qM.png) When the letters _ijk_ for example appear together in a subscript as indices, the spacing between the _i_ and the _j_ appears too wide relative to the distance between the _j_ and the _k_. **Original Q** : Is it possible to turn off this special kerning in math formula cells? **Updated Q** : (10/1/2012) A reasonable but nevertheless somewhat inconvenient method to work around this issue has been suggested below. Does anyone know the reason why the kerning rules for juxtaposing italic characters inside math formula cells are different from those for normal, non-math italic text? * * * For ease of copying:               Cell[TextData[{      "Text ",      Cell[BoxData[       FormBox[        RowBox[{        "a", "\[InvisibleSpace]", "b", "\[InvisibleSpace]", "c",          "\[InvisibleSpace]", "d", "\[InvisibleSpace]", "e",          "\[InvisibleSpace]", "f", "\[InvisibleSpace]", "g",          "\[InvisibleSpace]", "h", "\[InvisibleSpace]", "i",          "\[InvisibleSpace]", "j", "\[InvisibleSpace]", "k",          "\[InvisibleSpace]", "l", "\[InvisibleSpace]", "m",          "\[InvisibleSpace]", "n", "\[InvisibleSpace]", "o",          "\[InvisibleSpace]", "p", "\[InvisibleSpace]", "q",          "\[InvisibleSpace]", "r", "\[InvisibleSpace]", "s",          "\[InvisibleSpace]", "t", "\[InvisibleSpace]", "u",          "\[InvisibleSpace]", "v", "\[InvisibleSpace]", "w",          "\[InvisibleSpace]", "x", "\[InvisibleSpace]", "y",          "\[InvisibleSpace]", "z"}], TraditionalForm]],       FormatType->"TraditionalForm"],      " Text"     }], "Text"]


title: Calculate information entropy integral in infinite square well problem

text: In the context of information theory, **entropy** is a measure of _uncertainty_ of a random variable. In quantum mechanics, the uncertainty principle states that $\Delta x\Delta k \ge 1/2$. The same can be expressed in terms of information entropy as $S_x + S_k \ge 1 + \ln\pi$. The information entropy $S_x$ is defined as: $$ S_x = \int_{-\infty}^{\infty} {\rho(x) \ln\rho(x) dx} $$ where $\rho(x)$ is the probability density function of the variable $x$. In continuation[1,2,3] of my study of the infinite square well problem, I'd like to check whether the informational version of uncertainty principle holds. For that, I need to calculate $S_x$ and $S_k$, for various numbers of $n=1,2,3,\ldots$, and check if their sum is bounded, knowing the respective probability density functions for position $x$ and momentum $k$. Here is my code for $S_x$:               ClearAll["Global`*"];     (* The length of the well *)     L = 1;          (* The eigenfunctions, n=1,2,3,... u[n,x] is zero outside of [0,L] *)     u[n_, x_] := Sqrt[2/L] Sin[n π x/L]          (* Probability density function for the x(=particle position) variable *)     (* Again, the domain of ρ(n,x) is the [0,L] interval *)     ρ[n_, x_] := u[n, x]\[Conjugate] u[n, x]          integrand =       Simplify[-ρ[n, x] Log[ρ[n, x]],        n ∈ Integers && x ∈ Reals]          (* Out= -2 Log[2 Sin[n π x]^2] Sin[n π x]^2 *)          (* Integrate over [0,L] since we haven't defined u[n,x] outside of [0,L] *)     (* We could have defined it though and then we would be integrating from -inf to +inf *)     Integrate[integrand, {x, 0, L}]          (* Out= -(1/(6 n π))(π (6 n - I π + 6 I n^2 π + n Log[64] -            12 n Log[1 - E^(2 I n π)] + 6 n Log[Sin[n π]^2]) +         6 I PolyLog[2, E^(2 I n π)] -         3 (-1 + Log[2 Sin[n π]^2]) Sin[2 n π]) *)      At this point it's already obvious that the value of the integral cannot be determined, since the terms $\sin(n\pi)$ equal zero and $\ln{0}$ is undefined.               FullSimplify[%, n ∈ Integers]      > During evaluation of In[72]:= FullSimplify::infd: Expression Log[1-E^(2 I n > [Pi])] simplified to -[Infinity]. >> > > During evaluation of In[72]:= FullSimplify::infd: Expression Log[Sin[n > [Pi]]^2] simplified to -[Infinity]. >> > > During evaluation of In[72]:= FullSimplify::infd: Expression Log[2 Sin[n > [Pi]]^2] simplified to -[Infinity]. >> > > During evaluation of In[72]:= General::stop: Further output of > FullSimplify::infd will be suppressed during this calculation. >> > > Out[72]= Indeterminate My book says that $S_x = \ln(2L) - 1$. Any ideas on how to trick _Mathematica_ to calculate the integral ? **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? Calculate integral for arbitrary parameter n in infinite square well problem


title: Defining a non-linear optimization-problem

text: Consider the following non-linear optimisation problem:               WeeklyCapacity = Table[Subscript[maxCapa, t], {t, 6}];     WeeklyDemand = Table[Subscript[weeklyD, i], {i, 10}];     CycleTimes = Table[Subscript[CT, i], {i, 10}];          (*Exemplary data:     WeeklyCapacity = Table[189*7.5, {t, 6}];     WeeklyDemand = Table[RandomInteger[{2000, 5000}], {i, 10}]     CycleTimes = (1/#) & /@ Table[RandomInteger[{40, 125}], {i, 10}]     *)          ProductionProgram =        Table[Subscript[x, i, t], {i, 10}, {t, 6}];     CapaDemand = Transpose@ProductionProgram.CycleTimes;          MinVarProductionProgram = Variance/@ ProductionProgram;     ConstraintDemand =        Map[# == 0 &, Total /@ ProductionProgram - WeeklyDemand];     ConstraintCapa = Map[# <= 0 &, Total /@ CapaDemand - WeeklyCapacity];      A company produces `i` different products and at the end of a week (six working days) has to meet a weekly demand (`WeeklyDemand`). The production manager knows how many pieces of each product can be produced within one hour (`CycleTimes`) and is limited to a maximum capacity of hours per day (`WeeklyCapacity`). The optimal production program (`ProductionProgram`) can be calculated as follows:   1. The variance of the production program of each product must be minimised (see `MinVarProductionProgram`).   2. The production program of each product has to meet its total demand per week (`ConstraintDemand`)   3. The production program must not exceed the available max. capacity (`ConstraintCapa`). `MinVarProductionProgram` represents a non-linear function. Hence I was thinking about a Lagrangian relaxation approach.


title: Annoying FrontEnd bugs in Mathematica 10

text: Recently I installed _Mathematica 10_ on _Windows 8 x64_ machine. Before that I had a prerelease version of _Mathematica 10_ installed on my laptop. I observed very annoying bugs in the FrontEnd on both machines: at some random moment during editing a notebook, some keybord shortcuts (e.g. `Ctrl+Z`, `Ctrl+C`, `Ctrl+S` etc) start doing things completely different from they are supposed to do: change the notebook stylesheet, open new windows, comment out the selected text etc. The menu items corresponding to those shortcuts do the same crazy things. To save the current notebook I have to invoke `NotebookSave[]` function because there is no way do it using graphical interface. Restarting _Mathematica_ solves the problem for a while, but soon it reappears. Does anybody else observe this behavior?


title: How many iterations of Newton's method are needed to achieve a given precision?

text: Consider using Newton's method to solve the equation $arctan(x) = 0$. Using an initial guess of $x_0 = 1/2$ produces a sequence that converges rapidly. After $8$, iterations, $x_8$ is accurate to well over 2000 decimal places. > (i) Verify with a computer that $x_8$ is a solution accurate to over $2000$ > decimal places. I was just learning Newton's Method and saw this problem. I think I might be going ahead but it seems good to know. Here is my attempt: (Sorry if I'm wrong. I am just really interested in this problem)                        In[1]:newton1[function_, variable_, initial_, iterations_] :=                    Module[{p, f, x},                    Subscript[p, 1] = initial;                    f[x_] := function /. variable -> x;                    Do[                    Subscript[p, i] =                     Subscript[p, i - 1] -                     f[Subscript[p, i - 1]]/f'[Subscript[p, i - 1]];,                    {i, 2, iterations}];                    Subscript[p, iterations]                    ]                         In[1]:Timing[approx = newton1[arctan(x)=0, x, 1/2, 8]]                         Out[1]:{0.826805, Indeterminate}      or I was wondering if the program could be this:                             In[1]: f[x_] := arctan[x] = 0;                        In[1]: mynewton[function_, variable_, initial_, iterations_] :=                          Module[{f, x, p},                          f[x_] := function /. variable -> x;                          Subscript[p, 1] = initial;                          Do[                          Subscript[p, i] =                           Subscript[p, i - 1] -                           f[Subscript[p, i - 1]]/f'[Subscript[p, i - 1]];,                          {i, 2, iterations}];                          Table[Subscript[p, i], {i, 1, iterations}]                          ]                        In[1]: N[mynewton[f[x], x, 1/2, 8], 8]                        Out[1]: {0.50000000, Indeterminate, Indeterminate, Indeterminate, \                           Indeterminate, Indeterminate, Indeterminate, Indeterminate}      Again sorry if I am wrong. I am really interested in learning this part of the program. I will be able to continue to other questions like this after help with this one on my own. I really did try. I was studying various types of Newton's Programs but can not figure this one out. Can someone please help write the input?


title: Quadruple-precision (128 bit) arithmetic

text: Is it possible to force Mathematica to perform computations with hardware supported quadruple-precision? The following test suggest, that all of the computations with fixed precision, different than `$MachinePrecision=15.9546`, are performed via the same arbitrary precision algorithm. Am I right? Is it possible to speed up 34 digit accurate computations?               num = RandomInteger[{1, 100}, 5 10^5];     First@AbsoluteTiming[       Sin[N[num]];     ]     (* ==> 0.273485 *)          {#, First@AbsoluteTiming[      Sin[N[num, #]];]} & /@ Range[32, 36]          (* ==>     {{32, 10.224581}, {33, 9.942714}, {34, 10.043138},     {35, 9.856203}, {36, 9.929918}}     *)


title: What format to use to store expressions in database?

text: I am storing lists of expressions into a MySQL database. Each list is of form               {_String, {_String, _Real}, _Real}      What data format should each column of the database table be? I am thinking `TEXT`, `TEXT`, `FLOAT`. Any suggestions? I need to be able to import values back to Mathematica (with `SQLExecute[]`, `SQLSelect[]`, etc.) and be able to work with expressions in Mathematica program.


title: Replace expressions by self defined symbols

text: I have a list of expressions like the following:               {{X00 ** X10 + X01 ** X10 - X10 ** X01 - X10 ** X00 },       {X01 ** X10 - X10 ** X01 - X02 ** X10},       {X00 ** X12 -  X12 ** X00}, {X01 ** X12 - X12 ** X01}, {X02 ** X13}}      where all `Xij` are just symbols. Now suppose we define an expression like               [X0j,X1k] := X0j ** X1k - X1k ** X0j.      Is it possible to let Mathematica substitute all terms in the list that look like the right side of the last expression by its left side? If necessary I can change the `Xij`'s in the list to something else.


title: Visualizing how the zeros for this function change as its input parameter changes?

text: I'm trying to explore how the zeros of a certain parameterized function change as its parameter changes.               dh[n_, k_, a_] :=      dh[n, k, a] = Sum[Binomial[k, j] dh[Floor[n/(m^(k - j))], j, m + 1], {m, a, n^(1/k)}, {j, 0, k - 1}]     dh[n_, 1, a_] := Floor[n] - a + 1     dh[n_, 0, a_] := 1     bn[ z_, a_] := bn[z, a] = Product[ (z - k), {k, 0, a - 1}]/a!     dd[n_, z_] := Sum[bn[z, a] dh[n, a, 2], {a, 0, Log[2, n]}]      The function I'm exploring here is dd[n_,z_]. n is the parameter I want to vary, and is a whole number $>= 1$. The zeros are all values of z such that dd[n,z] = 0. There should be $\log_2 n$ zeros for a given n. Now, I already know that I can see the zeros for an isolated value of n as               zeros[n_] := List @@ NRoots[ dd[n, z] == 0, z][[All, 2]]      For example, if I try zeros[30], I get {-16.1801, -1.66598 - 0.772391 I, -1.66598 + 0.772391 I, -0.0879758} I also know that I could visualize those zeros as               RootLocusPlot[1/dd[30, z], {k, 0, 1}]      But both of these techniques only address single values of n at a time. What I really want is to see how the zeros change as n changes, particularly for different scales of ranges for n. Does Mathematica have any tools to help me do that?


title: Adjusting Stylesheet Output Format

text: ![enter image description here](http://i.stack.imgur.com/BSRuw.png)I'm using one of _Mathematica_ 's built-in stylesheets, "Standard Report". When I enter an expression into an input cell and evaluate it, the input is shown with a white background, while the output has a grey background. However, when I generate a plot, the numbers on the axes have white boxes around them, which looks stupid next to the grey background. How would I get rid of these white boxes? Thanks!


title: Calculating groupwise mean in Mathematica

text: I have a huge panel data with more than 2.5 million observations and more than 15000 groups. I want to calculate group-wise mean and I also need Id variable in my result. This is what I have done.               dat = {{2, .1, .2}, {2, .2, .4}, {2, .3, .6}, {2, .4, .8}, {5, 1,          2}, {5, 2, 4}, {7, 20, 10}, {7, 40, 20}, {7, 60, 30}, {7, 80,          40}, {7, 100, 50}, {10, 30, 50}};          results =  Table[N[Mean[Select[dat, #[[1]] == i &]]], {i, {2, 5, 7, 10}}];       But it is taking too long time. How can we make it quicker. Also, I want to calculate group-wise max value of second column. Any help is greatly appreciated.


title: Color mixing or blend

text: Color mixing seems not only one type. Here is RGB_color_model I wrote this one:               coord = 1/2*{{1, -Sqrt[3]/3}, {0, 2 Sqrt[3]/3}, {-1, -Sqrt[3]/3}};     color = {Red, Green, Blue};     MapThread[       Graphics[{##}, PlotRange -> 2, Background -> Black] &, {color,         Disk /@ coord}];     Plus @@ (ImageData /@ %) // Image     Clear[coord, color]      ![enter image description here](http://i.stack.imgur.com/aRkuY.jpg) Another type of mixing is :               {#, Graphics[{#, Disk[]}, ImageSize -> 50]} & /@       DeleteDuplicates[Blend /@ Permutations[{Red, Blue, Green}, {2}]]      ![enter image description here](http://i.stack.imgur.com/q0ALR.jpg) So How can I get the following like this ? ![enter image description here](http://i.stack.imgur.com/iavED.jpg)


title: How to fix this memory leak

text: I am using halirutan's code in this thread to unflatten a list. It works very well but the problem is that the Module's local function `f` is not deleted when the function returns the output and I consequently end up with hundreds of thousands of copies of the symbol of the form `f$xxxx`, which eventually crashes Mathematica. I tried other solutions from the same thread, but they don't seem to work. Is there any workaround?


title: Some Characters From Custom Font Do Not Show Up

text: I'm using version 8.0.4.0 on a Mac, and recently made my own .otf and .ttf fonts at PaintFont.com. The font can be based on pretty much anything, including handwriting, and covers everything from alpha-numerics, symbols, alphabets from other languages, punctuation, and ligatures. This can be very useful if you want your figures and text to look a little more personalized. The good news is, when I use something like:               Text[Style["This is the text I want in a different font.", FontFamily->"Example Font"]]      basic alpha-numerics, capitals and lowercase, work just fine, but certain symbols, including ! @ # % ^ * ( ) ~ - = + [ ] { } ; : | < >, Greeks, and so forth, show up simply in Mathematica's default font, even though I have characters for my font that definitely work (I've tested them in Word, etc.). Just an example, if I type:               Text[\[CapitalSigma]]      I get a capital sigma in **default font** , even though I definitely have that symbol in my own font. Is there any reason why Mathematica would accept certain characters from a font and not others? Are these characters "reserved" somehow by Mathematica and are "unformatable"? Thanks!


title: How to make a plot of function over 24 orders of magnitude?

text: Assume these parameter definitions first:               P0 = 325000000000000000000000000000000/1289899878039;     th = 22 10^-7;     alpha = 15*^6;     p0value = 0.0000697013247924021100000;     Lh = 5 10^-9;     d = 80 10^-9;     A = -2.8490639736294850547486980507937310695688037435690471`40.25650391588118*^\     14;     B = 1.1760120752241583305643404927085980980404601631188207268`37.\     974790074939705*^26;      Define two functions               tmp[x_] := A E^(x/Lh) + B E^(-x/Lh) + p0value ;     tmp2[x_] := -(alpha P0 th)/(1 - alpha^2 Lh^2) E^(-alpha x);      Subtracting them at x=d yields the small number p0value               tmp[d] - tmp2[d]      > 0.000069701324792402 I want the plot of `tmp[x] - tmp2[x]` to have a value of p0value (0.0000697013247924021100000) at `x = d` and not to stop at $10^{20}$.               LogPlot[{tmp[x] - tmp2[x]}, {x, 0, d}, PlotRange -> {{0, d}, {10^-5, 10^25}}]      ![Mathematica graphics](http://i.stack.imgur.com/ExnDN.png) I tried `MeshFunctions` but without success. Can anyone give me a hint?


title: Testing a certain function over multiple levels

text: I regularly want to test if a certain function, here foo, gives the expected result when mapping it over n - level - matrices. My naive approach is to write:               m1 = Range@3;     m2 = {m1, m1};     m3 = {m2, m2};     m4 = {m3, m3};      Then I test:               Map[foo, m1, {ArrayDepth@m1 - 1}];     (* ... *)     Map[foo, m4, {ArrayDepth@m4 - 1}];      The m1-case correctly gives:               foo[{1, 2, 3}],      and the m4-case correctly gives:               {{{foo[{1, 2, 3}], foo[{1, 2, 3}]}, {foo[{1, 2, 3}],         foo[{1, 2, 3}]}}, {{foo[{1, 2, 3}],         foo[{1, 2, 3}]}, {foo[{1, 2, 3}], foo[{1, 2, 3}]}}}      (foo should always map over the innermost level). I am now looking for a more elegant and automated solution, possibly a oneliner like:               (m[#] = BuildLevels[Range@3,4]) & /@ Range@4      but don' t know how to implement it in a short and efficient way. Thanks in advance for your help.


title: How can I pack circles of different sizes into a spiral?

text: Given a list of circles of different areas, I need to arrange them tangentially in order of increasing area and spiraling outward. An example of the type of packing I'm attempting is shown by the orange circles in the figure below: ![enter image description here](http://i.stack.imgur.com/Pl1du.png) Is there a concise way to calculate the centers of the circles?


title: Set-generating macro unexpectedly reaches recursion limit

text: One moment I decided to assign symbolic names to all special spaces since they all look the same when put literally in FrontEnd editor, more or less like `""` or `" "`. I wrote the following macro:               Block[{Set}, Set @@@     ( MapAt[         Composition[Symbol         , StringReplace[#, "[" | "]" | "\"" | "\\" ] -> ""]& ]       , #, {1}] & /@       Select[         {ToString@FullForm@#, #} & /@         FromCharacterCode /@ (-1 + Range[2^16])       , StringMatchQ[First@#, ___ ~~ "Space]\""] &] ) ];      that checks all Unicode chars recognised by Mathematica as “smth-Space”, fetches symbol names and performs the assignments. After macro expansion I expect to get               Block[{Set}, Set @@@     { { NonBreakingSpace, " " }     , {       ThickSpace, " " }     , {        ThinSpace, " " }     ,            (…rest)        }]      However, while the expression in round brackets does evaluate to correct table of symbols and various spaces if evaluated independently, and `Set@@@` on it works perfectly well, the whole macro `Block[{Set}, …]` starts throwing lots of errors, from `$RecursionLimit` and `ToExpression`. (Being a bit too hasty, I put it into pre-loaded packages — naturally, it made Kernel crash every time I attempted to start it.) That said, `Block[{set}, set@@@(…) /. set -> Set]` works OK, but the question remains: what causes the problem in the original macro? This is not the first time I make assignment with `Block[{Set}, Set@@@table];`, and I would like to keep doing it further. The issue is surprising. The only explanation I see is that `Block`ing `Set` somehow interferes with evaluating the expression in round brackets (the one meant to evaluate to the table). But this behaviour is quite unexpectable unless I miss something obvious, and there also does not seem to be a way to trace the evaluation. 1) Is there a way to `Trace` the evaluation? 2) What really causes the problem? (In case it is possible to find out at all without cracking the kernel.)


title: Include a CDF file in sites.google

text: I have a website on sites.google and I also have blog on wordpress. I would like to include some CDF files on them. How can it be done?


title: The same value of VertexSize for vertices in different graphs causes different vertices size

text: I generated some graphs. The smallest vertices in the 1st graph should be the same size as the smallest vertices in the second graph. The smallest vertices have the same size (`VertexSize` value is the same) in each graph. When I generate those graphs the size of the smallest vertices seems different: ![graph 1](http://i.imgur.com/AnvNAQj.png) ![graph 1](http://i.imgur.com/tXMiZ2l.png) Those 2 graphs in cdf: dropbox link . The size of graphs is set to 'Large'. How it can be fixed? I need that to do some animation. Thanks!


title: Listing over multiple inputs (tensor rank > 1) in a compiled function

text: I'm trying to optimize the solution given by Michael E2 to my previous problem (Efficiently determining if 3D points are within a surface composed of polygons) which I figured would be relatively straight forward to do with `Compile` but I'm having trouble listing over two inputs to a compiled function. Starting with Michael's code:               data = Flatten[        Table[{x, y, z, x^2 + y^2 + z^2 + RandomReal[0.1]},          {x, -2, 2, 0.2}, {y, -2, 2, 0.2}, {z, -2, 2, 0.2}], 2];          plot = ListContourPlot3D[data, Contours -> {1}, Mesh -> None];          polygonCoords =        Cases[Normal[plot[[1]]], Polygon[x_, ___] :> x, {0, Infinity}];          g = Graphics3D[{Opacity[.09], EdgeForm[Opacity[.3]],         Polygon[#,            VertexColors -> Table[Hue[RandomReal[]], {Length[#]}]] & /@          Cases[Normal[plot[[1]]], Polygon[x_, ___] :> x, {0, Infinity}]},        Lighting -> "Neutral", ImageSize -> 400, Axes -> True];          side[{P_, Q_, R_, ___}, X_] := Det@Differences[{X, P, Q, R}];     insideQ[polyhedron_, point_] := And @@ Positive[side[#, point] & /@ polyhedron];          points = RandomReal[{-1.5, 1.5}, {1000, 3}];     insideQ[polygonCoords, #] & /@ points; // AbsoluteTiming      Too slow: 0.5 sec for 1000 points and I have millions. I inlined the formula for the `det` and replaced `And` + `Positive` with `Min` + `UnitStep`:               sideC = Compile[{{poly, _Real, 2}, {X, _Real, 1}},         Block[{p1 = poly[[1, 1]], p2 = poly[[1, 2]], p3 = poly[[1, 3]],           q1 = poly[[2, 1]], q2 = poly[[2, 2]], q3 = poly[[2, 3]],           r1 = poly[[3, 1]], r2 = poly[[3, 2]], r3 = poly[[3, 3]],           x1 = X[[1]], x2 = X[[2]], x3 = X[[3]]},          UnitStep[-p3 q2 r1 + p2 q3 r1 + p3 q1 r2 - p1 q3 r2 - p2 q1 r3 +            p1 q2 r3 + p3 q2 x1 - p2 q3 x1 - p3 r2 x1 + q3 r2 x1 +            p2 r3 x1 - q2 r3 x1 - p3 q1 x2 + p1 q3 x2 + p3 r1 x2 -            q3 r1 x2 - p1 r3 x2 + q1 r3 x2 + p2 q1 x3 - p1 q2 x3 -            p2 r1 x3 + q2 r1 x3 + p1 r2 x3 - q1 r2 x3]         ], CompilationTarget -> "C", RuntimeAttributes -> {Listable},         Parallelization -> True, RuntimeOptions -> "Speed"];          insideQC[polyhedron_, point_] := Min@sideC[polygonCoords[[All, ;; 3]], point]      This lists over all the polygons. Lets test it,               insideQC[polygonCoords, #] & /@ points; // AbsoluteTiming      Now this is over 10x faster, 0.04 seconds. Compiling this again, because of the `CompiledFunctionCall` provides only a tiny speed improvment. I think it should be faster to list over both the list of polygon coordinates and the points. I suspect this question is related: Threading a compiled function over multiple arguments of different lengths, specifically ruebenko's last answer which works fine on MMA 9 on Win7 x64, It should be possible? Why doesn't this work:               sideC[polygonCoords, points]      Shouldn't this list over both inputs? How can I make this work? I tried to force inline-ing of the compiled function definition but it doesn't appear to be supported?               insideQC =        Compile[{{polyhedron, _Real, 3}, {points, _Real, 2}},         Min@sideC[polyhedron, #] & /@ points, CompilationTarget -> "C",         RuntimeOptions -> "Speed",         CompilationOptions -> {"InlineCompiledFunctions" -> True,           "InlineExternalDefinitions" -> True},         RuntimeAttributes -> {Listable}, Parallelization -> True];      _Compile::cfinll: "The CompiledFunction could not be inlined because its use requires threading with the Listable runtime attribute."_


title: How to dynamically toggle curves on/off in a crowded Plot?

text: When multiple curves appear in a single plot, it is useful to interactively turn certain curves on or off to visually compare smaller numbers of curves. It is trivial to put a quick dynamic together, as in this toy example               funcs = {Sin[x], Cos[x], Tanh[x]};      checked = ltexts = {"sin", "cos", "tanh"};      Column[{TogglerBar[Dynamic[checked], ltexts],         Dynamic[Block[{sel},           sel = Sort[checked /. Thread[ltexts -> Range[Length[ltexts]]]];            Plot[funcs[[sel]], {x, 0, 3*Pi}, PlotLegends -> ltexts[[sel]]]]]}]      ![Trivial example of curve toggling, output from the code above](http://i.stack.imgur.com/7rDLo.png) This approach, is a one-off solution. I am looking for a more elegant solution that can be applied to any plot, with a user interface that is a natural to the problem. The buttonbar above the plot is not a natural interface. Clicking on the curve or legend would be a natural action to toggle a curve's visibility. I intend to answer my own question, which I humbly propose as a reusable solution, but I would like to ask the community for improvements or enhancements.


title: Any command for group products?

text: Is there any Mathematica command or well known technique to take the direct product between two symmetric/permutation groups?


title: Summation for a function having singularity

text: I need to do summation of this function with Mathematica.               For[t=0,t<500,t++;Sum[-Q*Log[Q],{k,-Infinity,Infinity},{n,-Infinity,Infinity}]]          Q= Q1+Q2+Q3      where               Q1= 1/(Sqrt[(0.2+ 0.2 k)^2] Sqrt[       k^2]) ((0.0220725+ 0.0220725 k) Sqrt[k^2]          Erf[Sqrt[(0.2+ 0.2 k)^2]] -         0.110363 Sqrt[(0.2+ 0.2 k)^2]          k Erf[0.2 Sqrt[k^2]]) (0.886227 Erf[0.8 E^(-0.0004 t) - 0.2 n] +         0.886227 Erf[0.2- 0.8 E^(-0.0004 t) + 0.2 n])          Q2=1/(Sqrt[(0.2+ 0.2 k)^2] Sqrt[       k^2]) ((0.0220725+ 0.0220725 k) Sqrt[k^2]          Erf[Sqrt[(0.2+ 0.2 k)^2]] -         0.110363 Sqrt[(0.2+ 0.2 k)^2]          k Erf[0.2 Sqrt[k^2]]) (-0.886227 Erf[          0.8 E^(-0.0004 t) + 0.2 n] +         0.886227 Erf[0.2+ 0.8 E^(-0.0004 t) + 0.2 n])          Q3=(Erf[0.2+ 0.2 n] -         1. Erf[0.2 n]) (0.0271938 Erf[(0.2+              0. I) - (0.\[VeryThinSpace]+ 0.8 I) Sqrt[            E^(-0.0004 t)] + (0.2+ 0. I) k] +         0.0271938 Erf[(0.2+              0. I) + (0.+ 0.8 I) Sqrt[            E^(-0.0004 t)] + (0.2+               0. I) k] - (0.+ 0.0271938 I) Erfi[          0.8 Sqrt[            E^(-0.0004 t)] - (0.+               0.2 I) k] + (0.+ 0.0271938 I) Erfi[          0.8 Sqrt[E^(-0.0004 t)] + (0.+ 0.2 I) k])      The problem is because `Q` cannot be defined at certain k,Sum cannot be done. (For example, when I try to sum `Sum[-Q*Log[Q],{n,-55,55},{k,-55,55}]` at t=0, the error message is "Power::infy: "Infinite expression 1/Sqrt[0] encountered", "indet: Indeterminate expression 0.ComplexInfinity encountered." Is there a way that i can sum except the points where -Q*Log[Q] cannot be defined? Thanks.


title: How to obtain from a list, the different data that is in it, and the times that appear each one?

text: Are there an easy way to do... from               historyobjetivot = {20, 20, 30, 40, 34, 20, 34};      obtain two lists: - One with the each diffrent item number in the original list,i.e, {20,30,40,34} - Other with the number of times that appear in the list {3,1,2,1} Or any similar to do a PieChart


title: Errors while computing some terms of the Euler–Maclaurin formula

text: Here is an issue I came across while I was applying one of the well-known versions of   Euler–Maclaurin formula. I try to realize why _Mathematica_ goes wrong with this code below               NIntegrate[-((π Cot[(π x)/100] Csc[(π x)/100])/100) (x - Floor[x] - 1/2), {x, 1, 99}]      and yields > >     4.91483 >   Could you give me a hand to understand what is going on?


title: FullSimplify giving unexpected result

text: When I perform a `FullSimplify` on the list $$ \left\{-\sqrt{5-2 \sqrt{6}},\sqrt{5-2 \sqrt{6}},-\sqrt{5+2 \sqrt{6}},\sqrt{5+2 \sqrt{6}}\right\} $$ I get $$ \left\{\sqrt{2}-\sqrt{3},-\sqrt{2}+\sqrt{3},-\sqrt{5+2 \sqrt{6}},\sqrt{2}+\sqrt{3}\right\} $$ Note the third expression did not get simplified to $-\sqrt{2}-\sqrt{3}$ for some reason. Is this a bug or does Mathematica's complexity function genuinely consider $-\sqrt{5+2\sqrt{6}}$ simpler than $-\sqrt{2}-\sqrt{3}$? My expression in input form:               {-Sqrt[5 - 2*Sqrt[6]], Sqrt[5 - 2*Sqrt[6]], -Sqrt[5 + 2*Sqrt[6]], Sqrt[5 + 2*Sqrt[6]]} //        FullSimplify


title: How to find an asymptote of a logarithmic curve

text: An exponential decay curve has been plotted asymptoting at approximately x=30 (correct for what I am looking at) How can I find the exact value from the curve? I was hoping to be able to use something similar to the `FindMinimum` function, or draw a line along the asymptote and find the intersection with the x-axis. This is the function used to plot the curve:                   Plot[((5/Log[2])*Log[(80046.8 - ((0.79) (101325 + (1030*9.81*d))))/((313545. + 2.17341d) - ((0.79) (101325 + (1030*9.81*d))))]), {d, 0, 60}, AxesLabel -> {Depth - m, Time - mins}]


title: Using Table with arbitrary number of variables

text: Let $P=\{p_1,...p_n\}$. I would like a way to implent Table[Expression,{$p_1$,lim},{$p_2$,lim},...,{$p_n$,lim}] where n and lim are parameters defined by the user. Any ideas?


title: Issue in displaying a rotated PolarPlot with Show

text: I can use `PolarPlot` to generate a plot; however, I would like to rotate the plot by 90 degrees and then output the result using Show. Here is the code               Y20 =        PolarPlot[          Abs[Sqrt[5/(16*Pi)]*(3*Cos[Theta]^2 - 1)],           {Theta, 0, 2*Pi},           Ticks -> None       ]     Show[Rotate[Y20, Pi/2]]      > ![enter image description here](http://i.stack.imgur.com/IyEMk.png) and the error > >     Show::gtype: Rotate is not a type of graphics. >   If I wrap `Rotate` with `Graphics` the error message I get is > >     Graphics is not a Graphics primitive or directive. >   Any comments will be welcomed.


title: Plotting two-variable function as function of one variable with manipulate for both variables

text: I have a function g(x,y) and would like to plot it as g(x) with a slider to vary y. What I currently have is a g(x,y) plotted as g(x) but with y as a parameter which I can adjust:               Manipulate[Plot[g[x,y],{x,0,10}],{y,0,10}]      That works fine, but now I'd like to be able to vary the upper value of the x-axis so that we can adjust how much of the graph we see (or how much of the x-axis we see). This is what I've tried (but didn't work):               Manipulate[Plot[g[x,y],{x,0,Manipulate[x,{x,0.1,10}]}],{y,0,10}]


title: DynamicModule/Dynamic CheckboxBar Slow for Large Lists

text: I am trying to create a dynamic construct that takes a large list of expressions and allows the user to interactively select any number of entries for further manipulation. This is what I have envisioned so far:               Construct[largeListOfEntries_] := DynamicModule[{loadButton, viewPane, testlabels,       valuesPicked, dsFunction, buttonPressed = False},     loadButton = Button["Load Initial List", buttonPressed = True;      testlabels = largeListOfEntries[[;; , 2]]];     viewPane = Panel[      Pane[       Dynamic@If[buttonPressed != False,                  CheckboxBar[Dynamic[valuesPicked],                               MapThread[#1 -> #2 &, {Range[Length@testlabels], testlabels}],                              Appearance -> "Vertical"],                 "Load List..."],       ImageSize -> {500, 340}, ImageSizeAction -> "Scrollable", Scrollbars -> {True, True}],      Style["Sample Pane", 12, Bold, Purple]];     dsFunction = Button["Modify Selected Element",                          Print[largeListOfEntries[[valuesPicked, 1]]]];          Column[{loadButton, viewPane, dsFunction}]]      Given a large list such as this:               largeListOfEntries = {#, "label"} & /@ RandomReal[1, 3000]     Construct[largeListOfEntries]      > ![enter image description here](http://i.stack.imgur.com/KHfxi.png) I would then be able to select any number of elements that I want and apply the downstream function to them (for example purposes here the function just prints the value of the selected element). Everything appears to be working but for large lists simply the act of **clicking the`Checkbox` takes a really long time**. I suspect this is due to the fact that `DynamicModule` stores all the values at the `FrontEnd` and with large lists it can get really slow. If i simply use `Module` or keep the everything global then the process is significantly faster but I need to localize my variables and from what I've read using `Module` with `Dynamic` objects is not recommended and my `Dynamic` variables become red indicating conflict. Is there something that I'm fundamentally doing wrong that is having such a drastic impact on performance? * * * **EDIT (03.18.14)** As Kuba pointed out it is possible to see the hit in performance simply by using:               largeListOfEntries = RandomReal[1, 3000];      CheckboxBar[Dynamic@valuesPicked,largeListOfEntries]      Indicating that the issue may be directly associated with `Dynamic` variables in `CheckboxBar`. However if that construct is then wrapped with a `DynamicModule`, the performance hit is even worse than before, so the `Module` itself is also contributing.


title: How to eliminate the zero real part of a purely imaginary number?

text: In _Mathematica 9_ , a purely imaginary number, e.g. `0.9 I`, will display as `0\. + 0.9i` in the output form. How can I eliminate the real part `0.` in the output form?


title: Function to naming columns

text: I often import files from excel or csv files and they come in a format like this:               {{"He", "She", "It", "We"}, {8.57167, 0.406351, 1.68575,        5.55309}, {9.16751, 2.57632, 9.20212, 9.8879}, {8.49497, 5.72921,        8.92677, 8.17118}, {3.78541, 2.35875, 4.94475, 3.56491}}      With dimensions in this case {5,4}, I then want to name the columns by the first row. In this case it would mean that row one would be called he, and is equal to `{8.57167, 9.16751, 8.49497, 3.78541}`. I have tried several ways to do this but some how i keep getting different errors. It should be a very simple and efficient solution. This would mean that i want {8.57167, 9.16751, 8.49497, 3.78541} to be shown every time i enter he into mathematica, also if the word starts with a capital as it does for all words in this case I would like it to be transformed from He to he and She to she etc.


title: Problem ListLinePlot with 2 data sets

text: I am trying to plot 2 data sets with ListLinePlot and my problem is that no graph shows up. When I plot a single data set i.e. `ListLinePlot[Aluminium]` it looks great, like this: ![enter image description here](http://i.stack.imgur.com/L4rSN.jpg) But when I try to plot **two** data sets with `ListLinePlot[{Aluminium, Steel}]` I just get axis: ![enter image description here](http://i.stack.imgur.com/blQXr.jpg) I'm new to Mathematica and I'm not sure how it interprets the data but here's a sample of a single data set: > {{{-0.00396837, 0.00690848}, {-0.00396786, 0.00696155}, {-0.0039628, > 0.00775434}, {-0.00394408, 0.0105445}, {-0.00392182, 0.0141262}, > {-0.00390765, 0.0165268}, {-0.00389855, 0.0180618}, {-0.00389247, 0.019202}, > {-0.0038864, 0.0203702}}} and a second data set: > {{{-0.0343947, 0.006893}, {-0.0343942, 0.00694899}, {-0.0343897, > 0.00805173}, {-0.0343755, 0.0114375}, {-0.0343644, 0.0144129}, {-0.0343553, > 0.0165506}, {-0.0343477, 0.0177545}, {-0.0343401, 0.0187138}, {-0.0343345, > 0.0196253}, {-0.034329, 0.0209271}, {-0.0343239, 0.0220682}, {-0.0343193, > 0.0230841}, {-0.0343153, 0.0240036}, {-0.0343123, 0.024847}, {-0.0343092, > 0.0257369}, {-0.0343057, 0.0266416}, {-0.0343021, 0.0275453}, {-0.0342986, > 0.0284322}, {-0.0342956, 0.0293173}}}


title: Bug in ListVectorPlot?

text: Trying to evaluate the following expression kills my kernel (Mathematica 8.0.0.0):               ListVectorPlot[{{{0.04039190555`,0.00897597901`},{0.1094840396`,-0.4878660114`}},{{0.01346396852`,-0.02692793703`},{-0.4484770638`,-0.2210618086`}},{{-0.01346396852`,0.02692793703`},{0.4484771099`,0.2210617151`}},{{0.04039190555`,0},{6.015064858999999`*^-7,-0.5`}},{{-0.04039190555`,0},{-8.376467958999999`*^-7,0.5`}},{{0.04039190555`,0.004487989505`},{0.05578099204`,-0.4968787387`}},{{0.04039190555`,-0.004487989505`},{-0.0557801133`,-0.4968788373`}},{{-0.04039190555`,-0.004487989505`},{-0.05578124893`,0.4968787098`}},{{-0.04039190555`,0.004487989505`},{0.05577990379`,0.4968788608`}},     {{0.03141592654`,0.004487989505`},{0.0717709292`,-0.4948221233`}}     }]      Is this a bug?


title: Distribute and analyze large datasets

text: I need to analyze very large datasets, and they obviously don't fit in a computer memory. I need to produce some statistics on these datasets, and this brings me here: How can I make some statistical analysis on **distributed** datasets? I imagine _Mathematica_ may split (hopefully _automagically_ ) data over many kernels, being local or remote. Anyone had any experience?


title: Output a symbol from Module or Block

text: I have troubles to output an entire symbol, a function in this case, from a module or a block. For instance                myf = Block[{f}, f[3] = 33; f[4] = 4; f]      Then I want to get the values of `f` from the module valorization, but I get                In[531]:= myf[3]           Out[531]= f(3)      instead I would like to get the value that I have put in the module, in this case `                "desired behaviour"           In[531]:= myf[3]           Out[531]= 33      I might be asking a RTFM question, but I do not see it answered anywhere. Thanks for your help, Roberto


title: WeatherData for the 15th day of each month

text: Suppose we have               WeatherData["Helsinki", "MeanTemperature", {{2007, 1, 1}, {2012, 12, 31}, "Day"}]      How we can have data just for 15th day of each month?


title: Is it possible to use Find with wild cards?

text: When making global changes to code and variables Find is a great resource. Is there a way to use Find with wild cards to find and replace any non numerical elements or to find and replace only numbers?


title: Get path to end nodes in directed (partially cyclic) graph

text: I have a large directed graph containing small loops. I would like to extract all paths to all end nodes (no `VertexOutComponent`) with a given path length $n$. I have written a function which works, but I would like to know if anybody knows a more "elegant" and sufficient way to perform this task. Please see my minimum working example and the function I am using. In this case, vertices 3 and 4 are end nodes. ![graph](http://i.stack.imgur.com/xq39Y.png)               g=Graph[{1,2,3,4},     {DirectedEdge[1,2],DirectedEdge[1,1],DirectedEdge[2,1],DirectedEdge[2,2],DirectedEdge[2,3],DirectedEdge[2,4]},     {GraphLayout->"SpringEmbedding",ImagePadding->20,VertexLabels->{"Name"},VertexLabelStyle->{Directive[RGBColor[1,0,0],Bold,20]}}];          route[g_,sp_,n_]:=Block[{ep,m,bag},     ep=Cases[{#,VertexOutDegree[g,#]}&/@VertexList[g],{_,0}][[All,1]];     m=1;bag={{sp}};     While[m<n,         bag=Flatten[Thread[Append[#[[1]],#[[2]]]]&/@(Thread[List[bag,(VertexOutComponent[g,Last[#],1]&/@bag)]]),1];         bag=DeleteCases[bag,_?(MemberQ[ep,Last[#]]&&SameQ@@Take[#,-2]&)];         m++;     ];     Cases[bag,_?(MemberQ[ep,Last[#]]&)]     ];      You will get:               route[g, 1, 6] =     {{1,1,1,1,2,3},{1,1,1,1,2,4},{1,1,1,2,2,3},{1,1,1,2,2,4},     {1,1,2,2,2,3},{1,1,2,2,2,4},{1,1,2,1,2,3},{1,1,2,1,2,4},     {1,2,2,2,2,3},{1,2,2,2,2,4},{1,2,2,1,2,3},{1,2,2,1,2,4},     {1,2,1,1,2,3},{1,2,1,1,2,4},{1,2,1,2,2,3},{1,2,1,2,2,4}}      All routes are 6 steps long and end in vertices 3 or 4. _Is there a build-in function or any other code I can use to get this output efficiently?_ My real world data are graphs containing approx. 80 vertices, 5 to 10 loops with 5 to 10 vertices and 5 to 10 end nodes. You can try:               SeedRandom[1];g=RandomGraph[{80, 120}, DirectedEdges->True];     route[g,2,17]      which gives a list of 110807 routes in 16 seconds (on my PC). Thanks!


title: Generate regularly spaced points from the surface of simplexes

text: I need to generate regularly spaced samples (points) from the surface of unit simplexes with 2 or greater vertices or end points. I can generate random samples pretty straightforwardly:               sampleSimplex[sampleSize_, vertices_] :=       Module[{s},        s = RandomReal[ExponentialDistribution[2], {sampleSize, vertices}];       Map[Normalize[#, Total] &, s]]          Graphics3D[Point /@ sampleSimplex[1000, 3], ImageSize -> 150,       BoxStyle -> Directive[LightGray], ViewPoint -> {Pi, Pi/2, 2}]      ![simplex samples](http://i.stack.imgur.com/N1chl.png) This works nicely and enables me to specify the number of samples and the number of vertices, but as I stated above I want to generate regularly spaced points, kind of like a `Mesh` on a 3D plot (but not limited to 3 dimensions). I can also do it for 2 vertices pretty simply:               sampleSimplexWith2Vertices[sampleSize_] := Module[{temp},       temp = N[Range[0, 1, 1/sampleSize]];       Transpose[{temp, Reverse[temp]}]]          sampleSimplexWith2Vertices[10]          {{0., 1.}, {0.1, 0.9}, {0.2, 0.8}, {0.3, 0.7}, {0.4, 0.6}, {0.5,        0.5}, {0.6, 0.4}, {0.7, 0.3}, {0.8, 0.2}, {0.9, 0.1}, {1., 0.}}          ListPlot[%, ImageSize -> 200]      ![enter image description here](http://i.stack.imgur.com/OongL.png) but I seem blocked in thinking about a solution that extends further. Any suggestions for how to approach this problem appreciated. I recognize that this may appear too narrow in scope or that it seems more like a conceptual problem of how to think about the problem more than how to implement an idea in Mathematica. I can withdrawal the question, if either of those seems like the consensus. I hoped that the approaches I've tried so far and those the question might draw would have sufficient general interest to merit some responses. * * * In the interest of improving the question I wanted to incorporate @Rahul_Narain's idea from his comment:               sampleSimplexWith3Vertices[pointsPerSide_] := N@Select[        Flatten[         Table[{x, y, 1 - x - y}, {x, 0, 1, 1/pointsPerSide}, {y, 0, 1,            1/pointsPerSide}], 1], #[[3]] >= 0 &]          sampleSimplexWith3Vertices[10];      ![enter image description here](http://i.stack.imgur.com/924MG.png) This works for 3 vertices, where one specifies the number of points per side. But, how does one generalize this for an arbitrary number of vertices (dimensions)? I've thought that `Table` would give one way to go about this, but wouldn't generalizing this with `Table` need a way to change just about everything between its brackets?


title: How to draw Fractal images of iteration functions on the Riemann sphere?

text: Prof. McClure, in the work "M. McClure, **Newton's method for complex polynomials.** A preprint version of a “Mathematical graphics” column from _Mathematica in Education and Research_ , pp. 1–15 (2006)", discusses how _Mathematica_ can be applied to iteration functions for obtaining the basins of attraction (or their fractal images). Below, I provide his code for the fractal image of the polynomial $p(z)=z^3-1$:               p[z_] := z^3 - 1;     theRoots = z /. NSolve[p[z] == 0, z]     cp = Compile[{{z, _Complex}}, Evaluate[p[z]]];     n = Compile[{{z, _Complex}}, Evaluate[Simplify[z - p[z]/p'[z]]]];     bail = 150;     orbitData = Table[        NestWhileList[n, x + I y, Abs[cp[#]] > 0.01 &, 1, bail],         {y, -1, 1, 0.01}, {x, -1, 1, 0.01}     ];     numRoots = Length[Union[theRoots]];     sameRootFunc = Compile[{{z, _Complex}}, Evaluate[Abs[3 p[z]/p'[z]]]];     whichRoot[orbit_] :=        Module[{i, z},        z = Last[orbit]; i = 1;       Scan[If[Abs[z - #] < sameRootFunc[z], Return[i], i++] &, theRoots];       If[i <= numRoots, {i, Length[orbit]}, None]      ];     rootData = Map[whichRoot, orbitData, {2}];     colorList = {{cc, 0, 0}, {cc, cc, 0}, {0, 0, cc}};     cols = rootData /. {       {k_Integer, l_Integer} :> (colorList[[k]] /. cc -> (1 - l/(bail + 1))^8),       None -> {0, 0, 0}     };     Graphics[{Raster[cols]}]      ![Newton-Raphson fractal](http://i.stack.imgur.com/Rd9q2.png) My main question is here. He nicely obtained the fractal images on the complex plane, while it would be an interesting challenge to obtain these images on the Riemann sphere, e.g. ![Newton-Raphson fractal on the Riemann sphere](http://i.stack.imgur.com/jFPjV.jpg) It seems the complex plane in this case has been replaced by a sphere, but how? I will be thankful if someone could revise the code given above for obtaining such beautiful fractal images on the Riemann sphere. Any tips and tricks will be fully appreciated as well.


title: Optimal image quality using Rasterize Function

text: Based on previous posts about plotting two y axes on the same x axis, I wrote this function:               plotyy[x_, y1_, y2_] := Module[{xy1, xy2, p1, p2},       xy1 = Table[{x[[i]], y1[[i]]}, {i, Length[x]}];       xy2 = Table[{x[[i]], y2[[i]]}, {i, Length[x]}];       p1 = ListLinePlot[xy1, ImagePadding -> 25,          Frame -> {True, True, False, False}, Axes -> False];       p2 = ListLinePlot[xy2, ImagePadding -> 25, Axes -> False,          Frame -> {False, False, False, True},          FrameTicks -> {None, None, None, All}, PlotStyle -> Red];       Rasterize[Overlay[{p1, p2}], RasterSize -> 600, ImageSize -> 600]]      which takes three lists with the same length and plots y1 and y2 on x. I've values for image quality by `RasterSize` and `ImageSize` for using the plot in my report but for different plots it may need different values for those two options. How can I can set the optimum values for `RasterSize` and `ImageSize` in my function? Thanks, Amin.


title: Color scheme used by Colorize?

text: The `Colorize` function is often used to display the results produced by `MorphologicalComponents`:               i = ImageTake[        ExampleData[{"TestImage", "Mandrill"}], {1, -1, 10}, {1, -1, 10}];     b = Binarize[i, .5];     mc = MorphologicalComponents[b];     Colorize[mc]      ![mandrill taken](http://i.stack.imgur.com/CiP97.png) The colors represent the integer index values of each foreground component, so the magenta area is 2, the black background is 0, 42 is browney-orange, 19 is violet, and - well, my question is, what is this color scheme? I'm working on images like the following, to try to understand morphological images, but a legend-type approach might be better:               Show[      ArrayPlot[mc,       Epilog -> {         MapIndexed[{Text[Style[#1, 10, Gray],             Reverse[#2 - {.5, .5}]]} &,          Reverse[mc],          {2}]}, PlotRangePadding -> 0],      Colorize[mc]      ]      ![labeled](http://i.stack.imgur.com/cjQAJ.png) # Update Thanks to stefan's amazing detective work, I've got a way to list the colors, although this isn't available until you run `Colorize` once or set up the colors another way first:               colorizeColors[n_] :=       Part[RGBColor[N@#1/256, N@#2/256, N@#3/256] & @@           Image`ColorOperationsDump`hashcolor[#1] & /@ Range[1, 100], n]     Graphics[Table[{colorizeColors[x], Rectangle[{x, 0}, {x + 1, 1}],         White, Text[x, {x + 0.5, -.5}]}, {x, 1, 30}], Background -> Black,       ImageSize -> 800]       ![colorize legend](http://i.stack.imgur.com/NoiP7.png)


title: Formulas for combining ChebyshevT coefficients?

text: I have two 5th-order (6th-order?) Chebyshev approximations:               f1[x_] = Sum[a[n]*ChebyshevT[n,x],{n,0,5}]     f2[x_] = Sum[b[n]*ChebyshevT[n,x],{n,0,5}]      and f1[1] == f2[-1]. I now "combine" these functions so f1's domain is mapped to [-1,0] and f2's domain is mapped to [0,1]. The Chebyshev approximation of this combination is:               coeff[n_] := coeff[n] = 2/Pi*(      Integrate[f1[x*2+1]/Sqrt[1-x^2]*ChebyshevT[n,x],{x,-1,0}] +      Integrate[f2[x*2-1]/Sqrt[1-x^2]*ChebyshevT[n,x],{x,0,1}]     )      (coeff[0] actually should be divided by 2, but that doesn't affect my question) Mathematica won't give me a general formula here (getting rid of "coeff[n_] :=" fails), but I believe there is one. What is it? I tried using "f1[1] == f2[-1]" to simplify, but it doesn't help. I calculated coeff[0] through coeff[12]. The multiplier for each of the a[i] is below (the b[i] are easily calculated from the a[i]). I noticed the multiplier is of the form (a+b*Pi)/c (for a,b,c all integers) for the first few entries in each sequence (ie, i < j in some sense), and then become a/Pi for integer a. The first sequence (for a[0]) has alternating 0's and may be a special case (and is also easy to solve). I tried using oeis.org on the numerators and denominators to no avail.               Expand[Table[D[coeff[i],a[j]],{j,0,5},{i,0,12}]] // TeXForm      $ \left( \begin{array}{ccccccccccccc} 1 & -\frac{2}{\pi } & 0 & \frac{2}{3 \pi } & 0 & -\frac{2}{5 \pi } & 0 & \frac{2}{7 \pi } & 0 & -\frac{2}{9 \pi } & 0 & \frac{2}{11 \pi } & 0 \\ 1-\frac{4}{\pi } & 1-\frac{2}{\pi } & -\frac{4}{3 \pi } & \frac{2}{3 \pi } \ & \frac{4}{15 \pi } & -\frac{2}{5 \pi } & -\frac{4}{35 \pi } & \frac{2}{7 \pi } & \frac{4}{63 \pi } & -\frac{2}{9 \pi } & -\frac{4}{99 \pi } & \frac{2}{11 \pi } & \frac{4}{143 \pi } \\ 5-\frac{16}{\pi } & 4-\frac{38}{3 \pi } & 2-\frac{16}{3 \pi } & -\frac{22}{15 \pi } & \frac{16}{15 \pi } & -\frac{2}{21 \pi } & -\frac{16}{35 \pi } & \frac{58}{315 \pi } & \frac{16}{63 \pi } & -\frac{122}{693 \pi } & -\frac{16}{99 \pi } & \frac{202}{1287 \pi } & \frac{16}{143 \pi } \\ 25-\frac{236}{3 \pi } & 21-\frac{66}{\pi } & 12-\frac{188}{5 \pi } & 4-\frac{182}{15 \pi } & -\frac{44}{35 \pi } & \frac{10}{7 \pi } & -\frac{28}{45 \pi } & -\frac{34}{105 \pi } & \frac{76}{165 \pi } & \frac{38}{693 \pi } & -\frac{964}{3003 \pi } & \frac{14}{429 \pi } & \frac{1492}{6435 \pi } \\ 129-\frac{1216}{3 \pi } & 112-\frac{5278}{15 \pi } & 72-\frac{3392}{15 \pi \ } & 32-\frac{3518}{35 \pi } & 8-\frac{2624}{105 \pi } & -\frac{254}{315 \pi } & \frac{64}{45 \pi } & -\frac{1334}{1155 \pi } & \frac{64}{495 \pi } & \frac{8482}{15015 \pi } & -\frac{2752}{9009 \pi } & -\frac{4054}{15015 \p\ i } & \frac{1856}{6435 \pi } \\ 681-\frac{32092}{15 \pi } & 605-\frac{5702}{3 \pi } & 420-\frac{9236}{7 \pi } & 220-\frac{4838}{7 \pi } & 80-\frac{15836}{63 \pi } & 16-\frac{2258}{4\ 5 \pi } & -\frac{316}{693 \pi } & \frac{86}{77 \pi } & -\frac{1132}{819 \pi } & \frac{310}{429 \pi } & \frac{1228}{4095 \pi } & -\frac{1822}{3003 \pi } & \frac{788}{13923 \pi } \\ \end{array} \right) $


title: Working with means and variances

text: My goal is to work out on the following equation: $$Mean(P)(1-Mean (P))\left (h + (1 - 2 h) (1 - \frac {Var (P)} {Mean (P) (1 - Mean (P))}) (1 - Mean (P)) + \frac {Var (P)} {Mean (P) (1 - Mean (P))} (1 - h) \right)$$ where $P$ is a sample, $Mean(P)$ is the `Mean` value of the sample $P$: $Mean(P) = 1/n \sum_{i=1}^n p_i$. $Var(P)$ is the `Variance` of the random variable $P$. How can I `Simplify` this kind of equation with _Mathematica_? I thought I could eventually define a sequence of $p_i$ of undefined length and work with it. Is something similar feasible? Here is the _Mathematica_ code:               Mean[P](1-Mean[P])( h + (1-2h)(1-(Variance[P])/(Mean[P](1-Mean[P])))*       (1-Mean[P]) + (Variance[P])/(Mean[P](1-Mean[P])) (1-h))


title: Sum over all permutations

text: I have n variables and a function that has all of them as variables. n-3 of them in terms of the entries of two lists. The possible entries in the lists $\alpha$ and $\beta$ range from {2,...n-2}. Now I want to sum over all possible permutations of these n-3 elements (aka $P_{n-3})$, i.e. $$f=\sum_{\alpha,\beta \in P_{n-3}}A[1,\alpha,n-1,n]S[\beta,\alpha]A[n,\beta,n-1,1]$$ with A and S some other functions. How do I program this into mathematica. I thought about writing f as a pure function. But then how to implement this sum over permutations? Thanks for any advice!


title: StringCases functionality on a varying rows of data

text: There is a string in this form:               <12> cfg <15.21>  bhg    v<(24)>    e<65>   True     <12> cfg <15.21>  bhg    v<33>      e<(77)> False     <83> fff <67>     bhg     < >       e<(43)> True     <11> fff <14.21>  bff    v<(1.42)>  e<44>   True     <76> cfg <76.3>   fff     < >       e<21>   True     <98> cff <34>     rrs    v<33>       < >    True      The point is the numbers in the parenthesis indicate negative numbers and there are as well some missing values. I need to refine this string in a form to get a vector of output in this form:               {{12,15.21,-24,65,T},{12,15.21,33,-77,F},{83,67,-43,-43,T},     {11,14.21,-1.42,44,T},{76,76.3,NA,21,T},{98,NA,33,NA,T}}      What I did is to apply this:               Partition[StringCases[list, NumberString],4]      But as some rows have different structure then it is not working. And also this is not able to capture the negative numbers, and even this is neglecting the last column!! How is it possible to manage this?


title: Is it possible to take data from external database for the CDF embedded in webpage?

text: I have embedded my CDF in facebook.The data for the CDF should be taken from facebook server or my server dynamically.I tried out but its not working in dynamic code iam not able to access the data at all from both servers.Now i have the doubt is it possible to access data for the CDF from external databases.


title: Strange results while nesting scope constructs?

text: I did a handful of tests with `Block`, `With`, and `Module` and had a couple of _new_ surprises. First, I explicitly nested all pairs, producing the following nine tests, naively expecting 37 in each case:               {Block[{x=42}, Block[ {x=37},x]],      Block[{x=42}, With[  {x=37},x]],      Block[{x=42}, Module[{x=37},x]],      With[ {x=42}, Block[ {x=37},x]],      With[ {x=42}, With[  {x=37},x]],      With[ {x=42}, Module[{x=37},x]],      Module[{x=42},Block[ {x=37},x]],      Module[{x=42},With[  {x=37},x]],      Module[{x=42},Module[{x=37},x]]}      > During evaluation of In[48]:= Block::lvset: Local variable specification > {42=37} contains 42=37, which is an assignment to 42; only assignments to > symbols are allowed. >> > > Out[48]= {37, 37, 37, Block[{42 = 37}, 42], 37, 37, 37, 37, 37} The surprise is that `With...Block...` produces a collision, but `With...With...` and `With...Module...` don't. UNLESS, I try the test this way               With[{heads={Block,With,Module}},       Table[heads[[i]][{x=42},heads[[j]][{x=37},x]],{i,3},{j,3}]]      > During evaluation of In[49]:= Block::lvset: Local variable specification > {42=37} contains 42=37, which is an assignment to 42; only assignments to > symbols are allowed. >> > > During evaluation of In[49]:= With::lvset: Local variable specification > {42=37} contains 42=37, which is an assignment to 42; only assignments to > symbols are allowed. >> > > During evaluation of In[49]:= Module::lvset: Local variable specification > {42=37} contains 42=37, which is an assignment to 42; only assignments to > symbols are allowed. >> > > Out[49]= {{37, 37, 37}, {Block[{42 = 37}, 42], With[{42 = 37}, 42],   >  Module[{42 = 37}, 42]}, {37, 37, 37}} in which case ALL the `With...` cases produce collisions. I thought I was starting to understand MMA's scoping constructs :( **EDIT** : in case my question wasn't clear, I'd be grateful for the following explanations in more detail than the documentation offers: (1) why `x` collides in the explicit `With...Block...` case, (2) why `x` collides in two more cases when the nesting constructs are built using `Table` instead of explicitly. it occurred to me late to include `Function` and `Table` in the mix of scoping constructs, since they also give temporary bindings to variables. But I haven't tried that yet.


title: Speed Up SphericalPlot3D

text: I was wondering if I could speed up `SphericalPlot3D`? I tried editing `PlotPoints`, and `MaxRecursion`, but when I wrap `SphericalPlot3D` with `Manipulate` it fails. I don't want to set `ContinuousAction` to `False`.               Manipulate[ SphericalPlot3D[{r, 0, rmax}, {\[Phi], 0, phi \[Pi]},        {\[Theta], 0, theta \[Pi]}, SphericalRegion -> True, PlotRange -> 4,        Mesh -> 2, Ticks -> None],        {theta, 0.07, 1}, {phi, 0.07, 2}, {rmax, 0.07, 4}, SaveDefinitions -> True]      I wanted to layer a whole bunch of shells together to make a solid. {r, 0,rmax} specifies what range of shells' radii I want to create


title: How to switch between different CDFs in CDF Player?

text: I recently got a Mac. It has CDF Player, but not _Mathematica_. How do I get CDF Player to switch between different CDFs on OS X Lion? ## Edit I forgot to mention that I want to know how to switch between CDFs when in Full Screen mode. There must be a hot key for that. For that matter.... What's the best way to switch from Full Screen to a window with menus?


title: Dynamically change the variables plotted against in Plot3D

text: This question posed by @Cam is the closest I can find to my question but I feel that the answers don't really guide me in the way in which I'd like to proceed.... How do I dynamically change Manipulate controls? Ultimately I'd like to be able to do this with Manipulate or Dynamic however for now I'd just be satisfied to get this working in a very manual way. If I can get it going manually then adding Dynamic will (hopefully) be the easy part. I have a multivariate polynomial in (say) n variables but for simplification purposes let's call it 4 variables. I'd like to be able to use Plot3D to view the value of the function against two of the four variables but rather than specifying the variables explicitly, I'd like to be able to use some form of replacement rule to define which variables to plot against. Conceptually speaking, I would like something like the following to work:               axes = {{w, 0, 20}, {x, -3, 3}, {y, -2, 2}, {z, -1, 1}};          w = 25;     x = -3;     y = -2;     z = 3;     Plot3D[Sin[w^(1/2) + x + y^2 + z^3], axes[[1]], axes[[3]]]      One of the important things here is that the `axes` variable contains both the variable to be plotted and its range. Unless I'm mistaken, the responses in the post referenced above seemed to tackle a similar problem by substituting the variable names in the function to match the range specifications which I find confusing and hard to read, not to mention difficult to then sub in the correct ranges.


title: Using NVIDIA 3D Shutter Glasses with Mathematica

text: Mathematica has great capabilities to display 3D Graphics rendered to the 2D screen. This should make it perfectly suited to use the Graphics3D system together with an NVIDIA Graphics card, a 3D capable monitor with high frame rate and a 3D shutter glass (e.g. the NVIDIA 3D Vision sets). Now if it comes down to documentation the situation is less clear. I just found a nice Visual Studio Implementation How to control stereo-frames separately with C#? (NVIDIA 3D shutter glasses) for getting a simple 3D application (which is actually just testing that you can render two different colors for the left and the right eye), but nothing in the Mathematica documentation or on the web. Wouldn't it be nice to have the full 3D power of Mathematica with built-in support to show the Graphics3D output on a 3D Vision system? Any idea how to migrate the C# sample code to Mathematica and use the Graphics3D output to generate the stereo image pairs dynamically? Any other idea of implementation is of course welcome too!


title: Checking whether a number can be composed from the cube of its digit

text: How to check whether or not the sum of the cube of each digit of a number is equal to the number itself? In the following code, I tried to return the number in question whenever it matches the condition.               In[191]:= Func[x_]:=If[Total[Map[#^3& ,IntegerDigits[x]]]==x,x,0];     Func[300]      > Out[192]= 300 Apparently the checking seems to be wrongly done. What caused this issue? How to fix it?


title: Two problems with NDSolve when using Method -> Projection

text: I tried to solve a system first order differential equations together with a constraint equation. I use the `Method -> Projection` to check if the constraint holds at each step. However, two problems occur: The first problem is that I get the messages: > General::ovfl: Overflow occurred in computation. and General::unfl: > Underflow occurred in computation, I do not know how to handle these messages. The second problem is that I get the message: > NDSolve::nlnum: "The function value {Overflow[], Overflow[], Overflow[], > Overflow[]} is not a list of numbers with dimensions {4} at {t, u[t], x[t], > y[t], z[t]} ... I have attached the image of the code with the given explanations in (**) for convenience. I would appreciate it if anyone would give me some help.               Needs["DifferentialEquations`NDSolveProblems`"];     Needs["DifferentialEquations`NDSolveUtilities`"];     Needs["DifferentialEquations`InterpolatingFunctionAnatomy`"];      ( _Defining constant parameters_ )               θ = 0.182; w = 0; ρi = 4.2; xi = 0.0; ui = 8.71; adot = \     -6.4; zi = 26.57; om = 11.72; ti = 0.0; ts = 10000;      ( _Defining an invariant quantity that must hold true during the \ dynamical evolution of the system_ )                ina = -Exp[-3 x[t]]/(      2 (2 om + 3)) (om/6*y[t]^2 - u[t]^2*z[t]^2 + u[t]*y[t]*z[t]) +       u[t]*Exp[3 x[t]] (-16*π*ρi*Exp[3 (1 + w) (xi - x[t])])      ( _Defining the system of first order differential equations to be \ solved numerically_ )                 eqs = {x'[t] +        Exp[-3 x[t]]/(       2 (2 om + 3)*       u[t]) (om/3*y[t] +         u[t]*z[t] + θ (y[t] - 2 u[t]*z[t]) z[t]) - (θ*        Exp[3 x[t]]/u[t]) (-16 π*ρi*        Exp[3 (1 + w) (xi - x[t])]) == 0,       u'[t] + Exp[-3 x[t]]/(2 (2 om + 3)) (y[t] - 2 u[t]*z[t]) +       6 θ*      Exp[3 x[t]]*(-8 π (1 - w)*ρi*        Exp[3 (1 + w) (xi - x[t])]) == 0,       y'[t] - Exp[       3 x[t]]*(48 π*ρi*(1 - w)*Exp[3 (1 + w)*(xi - x[t])]) ==      0, z'[t] -       Exp[-3 x[t]]/(2 (2 om + 3) u[t]) (y[t] - 2 u[t]*z[t])*z[t] +       Exp[3 x[t]]/u[t] (-16 π*ρi*Exp[3 (1 + w)*(xi - x[t])]) ==      0}      (*Defing initial conditions: *)               ics = {u[ti] == ui, x[ti] == xi, z[ti] == zi,      y[ti] == -(1/(3 zi*θ + om))       3 (6 adot* E^(2 xi)*ui + ui*zi - 2 ui*zi^2*θ +        96 E^(6 xi)* π *θ *ρi +        4 adot* E^(2 xi) *ui *om +        64 E^(6 xi)* π*θ *ρi* om)}      (*Defining variables to be evaluated: *)                vars = {x, x', x'', u, u', y, z}      (*Using the NDSolve Command: *)               g = NDSolve[{eqs, ics}, vars, {t, ti, ts},      Method -> "StiffnessSwitching",      Method -> {"Projection", Method -> "ExplicitRungeKutta",      "Invariants" -> ina == 0}, InterpolationOrder -> Automatic,      WorkingPrecision -> MachinePrecision]      ![This image is a print screen of the code together with codes for convenience](http://i.stack.imgur.com/4fCoi.png)


title: How can I specify the arrowhead size in printers points?

text: Is there any way to specify the size of an arrowhead in printer's points? I'm looking for something that would have similar functionality to `AbsolutePointSize`, `AbsoluteThickness`, or `AbsoluteDashing`, except for Arrowheads. The best I have come up with is to use something like `Arrowheads[1.5/???]`, where `???` is the width of the `Graphics` object. However, this doesn't work if I don't know the width of the graphic. I've played around with using `Offset` or `Scaled`, but I haven't been able to get them to work for this purpose. **Edit:** Thanks for the suggestions so far. A few comments:   1. So far I have been using `ImageSize` combined with the `Arrowheads[1.5/???]`, but this is annoying for two reasons. First, it makes it impossible to set the height of the graphic using `ImageSize -> {{10000},{hmax}}`. Second, it means that I have to pass the ImageSize as a parameter through a series of functions that I have written.   2. The sizes `Tiny`, `Small`, `Medium`, and `Large` are exactly what I'm looking for, except that they don't seem to work with custom arrowhead graphics. In particular, the specification `Arrowheads[{{Medium, 1/2, Graphics[Line[{{-1, 1}, {1, 0}, {-1, -1}}]]}}]` within a `Graphics` command followed by an `Arrow` produces the following mysterious error: `Encountered "Graphics[Line[{{-1, 1}, {1, 0}, {-1, -1}}]]" where a Graphics was expected in the value of option Arrowheads.` **Edit 2:** Problem solved! As Brett suggests below, it works to use offset coordinates:                   MyArrows = Arrowheads[{{0.000001, 0.5,         Graphics[Line[{Offset[{-4.5, 5.4}], Offset[{4.5, 0}], Offset[{-4.5, -5.4}]}]]         }}]      When using this approach, it seems to work better on curved lines to specify a very small arrowhead size such as 0.000001. Here is some sample output using the arrowhead style above: ![Sample picture](http://i.stack.imgur.com/w0m4Z.png)


title: X-Y scatter plot with coloring dependent on Z value

text: I have an array of $(x,y,z)$ triples (array dimensions: N x 3), from which I can make a 2D scatterplot of $(x,y)$ values:               t = Table[{Sin[i], Cos[i], i}, {i, 0, 2 \[Pi], N[\[Pi]/20]}];     ListPlot[t[[All, 1 ;; 2]]]      Now, I want to color each point according to its $z$ value. I can find how to do so by creating a series of `Disk`s and putting them all into a `Graphics`, but then I have to take of absolutely all the formatting. Yet, I can't see how to leverage `ListPlot` options, such as `ColorFunction`, to achieve my goal. What would you suggest?


title: Using patterns in ReplaceAll to extract elements from tuples at arbitrary depths

text: Please consider the following: I need to extract from `MyList` all last parts of each 3-tuple.               MyList={              {{0.`, 2, 5}},              {{0.`, 1, 8},{10.`, 10, 10},{10.`, 6, 2.5}},              {{0.`, 1.25, 10},{0.`, 8.9, 100}}            };      I tried to apply the following but it did not work:               MyList /. {a_Number, b_Number, c_Number} :> c      Please note, that `a`,`b` and `c` must be of `Number`, otherwise the last 3-tuple of `MyList[[2]]` would be extracted to, since it `MyList[[2]]` itself represents a 3-tuple. The result must be:               {{5},{8,10,2.5},{10,100}}


title: Comparing Mathematica expressions like diff

text: I am looking for a way to compare (or "diff") two Mathematica expressions, similarly to how to diff utility can compare two text files and report the differences. Has anyone already written such a thing? Do you know of existing implementations? I wanted to check before trying to implement it. The Workbench's MUnit tester has something like this but I'm not sure how to invoke it separately from the testing UI. Also, I'd need something that works on held expressions as well. * * * To answer @Rojo's question: A first and simplest implementation would detect "point-differences". Assuming that the two expressions have identical structure, it would detect the leaf that differs. For example, if the expressions are               Hold@{1, f[2, g[3, 4^5]]}          Hold@{1, f[2, g[3, 4.^5]]}      it would report that the difference is at position `{1, 2, 2, 2, 1}` (because `4 =!= 4.`) A second and improved version (what I'm really looking for) would also handle additions and deletions, i.e. in               {1,2,3,4,5}          {1,2,4,5}      it would be able to match up the `4,5` part and understand that only `3` has been deleted. This would of course work also if `1,2,...` are compound expressions and not atoms, and would also work at deeper levels. I need something that works on _expressions_ and not on text, and respects the expression structure. (E.g. an atomic expression should be treated as an atom and not a set of characters. Line breaks, spaces and different notation forms such as `f@x` and `f[x]` should be handled or ignored appropriately.)


title: Band-pass filter an image

text: Ok so i have some HR-TEM images. In this technique fringes appear whereever a crystalline structure is present. This fringes are separated by a certain distance depending on the material, this is our wavelength. I would like to enter a wavelength range defined by two values, say .50 to .55 nm or in pixels. The output should be that all but these freqeuncies as defined by the WL should be filtered out of the image, a band-pass. So here's an example using some commercial software: ![Example of what i want](http://i.stack.imgur.com/gi0kV.jpg) I guess the approach is to Fourrier transform, filter out, and fourrier back. My attempt wasn't even close to getting a result... Thanks!


title: Feedback on my Subscript code

text: I have written a code, and I need a little feed back.. I want to make the `Subscript` distributive across (1) addition and (2) multiplication to mimic short-hand for added vectors. For example, in $(p+2k)_i=p_i+2k_i$ the LHS is short-hand for RHS, where the index is not allowed to be on the coefficient 2. Finally, I need exception, where the numeric quantity 0 should be allowed to take an index: that is, $0_i$ should not go to $0$. My code is:               Clear[Subscript];          Subscript[Plus[a_, b___], idx_] :=        Subscript[a, idx] + Subscript[b, idx];          Subscript[Times[a_, b___], idx_] :=        Times[Subscript[a, idx], Subscript[b, idx]];          Subscript[a_?NumberQ, idx_] /; a != 0 := a;      What I did was to define `Subscript` as functions, which is already built-in Symbol in Mathematica. The code seems to really work, but I don't know if I deserve a pat-on-the-back for being clever, or be reprimanded for overwriting a built-in Symbol (or for any other bad coding behavior). Also, is there any obvious way anyone can see this piece of code going wrong? Thanks!!


title: Method Shrinkwrap Messes up editting Graphics

text: If you try resizing or moving the `Inset` in the following interface, the `Graphics` becomes incredibly jerky and borderline unusable.               Graphics[{LightGray, Disk[],       Inset[        Graphics[{Rectangle[]}, ImageSize -> 200,          Method -> {"ShrinkWrap" -> True}]]       }]      Now if I remove `Method -> {"ShrinkWrap" -> True}` the interface (`Drawing Tools`) works fine but a border is added around the `Graphic`               Graphics[{LightGray, Disk[],       Inset[         Graphics[{Rectangle[]},           ImageSize -> 200]]       }]      Is there a way to Shrinkwrap or effectively remove the border without destroying the ability to edit `Graphics`? As an alternative, might there be a way to embed the `Inset` data directly into the `Graphics`. Currently it only serves the purpose of adding an `ImageSize` value to the `Inset` Graphics.


title: Create a new list under conditions from an existing one

text: I have an external file (data.out) which I read it with Mathematica using               data = ReadList["data.out", Number, RecordLists -> True];      This file contains three columns `(x,y,f)` of thousands of data. Here is a small sample of it:               0.30000000        0.00000000      0.1679035061279048E+02     2.30000000        0.50000000      0.1195447110986367E+01     0.10000000        0.00000000      0.2179035061279048E+02     5.80000000        2.50000000      0.7195447110986367E+01     3.00000000        0.00000000      0.4679035061279048E+02     7.90000000        7.50000000      0.1195447110986367E+01     4.70000000        2.00000000      0.8679035061279048E+01     1.20000000        4.50000000      0.2195447110986367E+01      Now I want to use Mathematica in order to manipulate the `data` list creating a new one `dataMod` which will have this structure `(x,y,f,f1)`. Obviously, there is a new element `(f1)` in the `dataMod` list. Well, if $0\leq f < 5$, $f1$ should be a random number in the interval $10^{-4}< f1 \leq \sqrt2$, if $5\leq f < 7$, $f1$ should be a random number in the interval $10^{-7}\leq f1 \leq 10^{-4}$ and if $f \geq 7$ then $f1$ should be a random number in the interval $10^{-12} < f1 < 10^{-7}$. Any ideas how to do this?


title: Syntax for FrontEnd`SelectionSetStyle

text: I know `FrontEnd`SelectionSetStyle` is undocumented, but its name suggests it does what I need. What is its syntax? I have already tried several variations of the following button on some selected code in an input cell.               Button["set",        FrontEnd`SelectionSetStyle[FontColor, RGBColor[{1, 0, 0}]];       Print[CurrentValue["SelectionData"]]]      * * * **Update** Using the kernel, the following code does what I need:               Button["set",       SetOptions[NotebookSelection[InputNotebook[]], FontColor -> RGBColor[{0, .7, .5}]];       Print[CurrentValue["SelectionData"]]]      I assume that `FrontEnd`SelectionSetStyle` can change the font color of the selection while using the front end only. If so, what is its syntax?


title: Simplifying an expression containing radicals

text: Now I'm trying to use _Mathematica_ to simplify an expression like this: $P \sqrt{-P + \sqrt{M^2 + P^2}} + \sqrt{(M^2 + P^2) (-P + \sqrt{M^2 + P^2})} - M \sqrt{P + \sqrt{M^2 + P^2}}$ where $P,M>0$ It should be zero, obviously. But _Mathematica_ cannot do this simplification. Is there any technique that will help _Mathematica_ to deal with this kind of expression?


title: Gradually coloring edges in terms of their vertices colors

text: In order to color `Edges` in a `Graph` after applying a function such as `VertexDegree` I did the following code (on _Mathematica 8.0.4_ ):               g = GridGraph[{4, 4},VertexLabels->"Name",ImagePadding->10,DirectedEdges->True];     (* highlight is taken from the documentation of VertexDegree *)     highlight = Table[       Style[VertexList[g][[i]],         ColorData["TemperatureMap"][VertexDegree[g][[i]]/Max[VertexDegree[g]]]],       {i, VertexCount[g]}];     edgeList = EdgeList@g;     Flatten@Table[{edgeList[[i]] -> (       Function[Evaluate@         Line[#, VertexColors -> {highlight[[edgeList[[i, 1]], 2]],             highlight[[edgeList[[i, 2]], 2]]}]])},       {i,Length@edgeList}];          HighlightGraph[SetProperty[g, EdgeShapeFunction -> %], highlight]      giving me: ![Graph with colored edges](http://i.stack.imgur.com/yzmhv.png) which is basically what I was waiting for in terms of what it should look like. Although since I'm using `Line[#, VertexColors -> {Color1, Color2}]` the fact that the `Edges` are either `Directed` or `Undirected` is not preserved in the `Graph`. **Thus my question is:** Is there a way to preserve the `DirectedEdge`/`UndirectedEdge` property and to gradually color the `Edges` in terms of its two vertices?


title: Extract a List of Co-ordinates from a List of Complex Solutions

text: Let's say I have this list of solutions from a previous computation:               {      {x -> -9.640491283722653` - 5.790987589334252` I},       {x -> -9.640491283722653` + 5.790987589334252` I},      {x ->  0.`- 14.792128645445802` I},      {x ->  0.`+ 14.792128645445802` I},      {x ->  9.640491283722653`- 5.790987589334252` I},      {x ->  9.640491283722653`+ 5.790987589334252` I}     }      Now, how do I extract a list of coordinates from them? Like               {      {-9.640491283722653`, - 5.790987589334252`},      {-9.640491283722653`, + 5.790987589334252`},      {0.`,- 14.792128645445802`},      {0.`,+ 14.792128645445802},      {9.640491283722653`,- 5.790987589334252`},      {9.640491283722653`,+ 5.790987589334252` }     }


title: How to grab CellTags from a Cell?

text: I am in the process of creating a palette for a specialised "Save as HTML". For context please see this. How can I grab the CellTags from a Cell[...] object? This is my first iteration, aka testing code:               PaletteNotebook[      Module[{action, create},       create := NotebookCreate[];       action[nb_] := Module[{found, out, cell},         out = create;         SelectionMove[nb, Before, Notebook];         found = NotebookFind[nb, "Input", Next, CellStyle];         If[found != $Failed,          cell = NotebookRead[nb];          NotebookWrite[out, OptionValue[cell, CellTags]] (* 1 *),          NotebookWrite[out, "Not found"]          ];         ];       Button[Style["Blog it", 12, FontFamily -> "Times"],        action[InputNotebook[]],        Appearance -> "Palette"]       ]      ]      At the moment it just dumps data into a temporary empty notebook if it finds the Input cell, but the code at (* 1 *) does not print the CellTags the cell has in the `InputNotebook[]`. I am thinking that `OptionsPattern[]` may be the answer, but I am not sure how to use it. I tried               ...     cell = NotebookRead[nb];     tags = cell /. Cell[__, OptionsPattern[]] :> OptionValue[CellTags];     NotebookWrite[out, tags],     ...      but it doesn't work either.


title: What is the formula for this numerical series?

text: I'm developing a questions game. My goal is that the score for each correct answer will increase as the user answers more questions. Initially there are 15 points for each correct answer. Every 4 questions adds 2 points to the previous value. In terms of numerical series would be something like:               15 15 15 15 17 17 17 17 19 19 19 19 21 21 21 21.      I trying to find the formula for this numerical serie but I have not had success. If anyone sees in this numerical series a "challenge" and wants to help me find the formula I will be very grateful.


title: Equation in implicit form

text: This is simple example:                v = {1.48622576, 1.53444276, 1.42299438}      v/(v + 1)      Out[1]:= {0.597784, 0.605436, 0.587288}      In the above case expression v/(v + 1) is in explicit form. I would like to find k for v = {1.48622576, 1.53444276, 1.42299438} wherein                Log(0.5(1-k))/Log(0.5(1+k))=v (expression in implicit form)


title: How to find longest monotonic sequence?

text: I have a list, for example               list = {2, 1, 3, 5, 4, 6}      How to find longest ascending sequence of this list? There are two meanings of this question:   1. Find the largest subset that $$ X_{i_1} < X_{i_2} < \ldots < X_{i_{n-1}} < X_{i_n} $$ where $$ i_1 < i_2 < \ldots < i_{n-1} < i_n $$   2. Find the largest subsequence that $$ X_i < X_{i+1} < \ldots < X_{j-1} < X_{j} $$


title: Compiled version of user-defined function

text: I have a function for parameter estimation with these codes:               iparam1[u_, data_] := Module[{t, dif, bini, binit},       t = (Mean[Transpose[data]] - Mean[Mean[Transpose[data]]])/         StandardDeviation[Mean[Transpose[data]]];       bini = N[Log[(1 - Mean[u])/Mean[u]]];       Which[4 <= bini, binit = 4, -4 >= bini, binit = -4, -4 < bini < 4,         binit = bini];       dif = b /. FindRoot[Lb[1, b, 0, t, u], {b, binit, -4, 4}];       dif]      For using this function, below functions are pre-requisite:               p3[a_, b_, c_, t_] := c + (1 - c)/(1 + Exp[-1.7*a*(t - b)])     p2[a_, b_, t_] := 1/(1 + Exp[-1.7*a*(t - b)])     w[a_, b_, c_,        t_] := (p2[a, b, t]*(1 - p2[a, b, t]))/(p3[a, b, c,           t]*(1 - p3[a, b, c, t]))     Lb[a_, b_, c_, t_, u_] := (1 - c)*(-a)*       Sum[(u[[i]] - p3[a, b, c, t[[i]]])*w[a, b, c, t[[i]]], {i, 1,          Length[t]}]      I had trouble with writing compiled equivalent of my function with `CompilationTarget -> "C"`. FYI,`a`,`b`,`c` and `t` are reals.In `iparam1`, the `data` is a matrix of 1s & 0s and `u` is a column of `data`.The output of `iparam1` is a parameter (i.e. `dif`) for given column. I searched for examples but I couldn't find out to write the complied version. Any help is appreciated. **UPDATE:** I have been noticed that `FindRoot` is not compilable.Is there a solution for making my function `iparam1` faster?


title: Output from Wolfram language in Python

text: I have a Python program which will run a script in the Wolfram language and then return to the main program. Is it possible to return values/variables to the main program? This is the code in Python running the Wolfram language code:               os.system('wolfram  -script file.wl')      Then in file.wl, for example, I can run a command such as 1+1, which will give me an output of 2. Can I then use this value 2 in the rest of my Python program?               e.g. print (ans)


title: ListPlot - plotting values with different range

text: I have three tables: `L, S` and `U`. In first table I have values from range `(0,1)`, in second from `(0,2*10^27)` and in the third one from `(0,50)`. No I want to plot all this three tables (tables have the same domain) together. But because of a very different range, I see for example only values for `U`, and rest are just like a small points very near to axes x. I was trying to use `ImageCompose`, because I have mathematica 7, so I can't use `Overlay`, but this functions are only for two plots. Is any other solution how can I plot this three functions together and make the plot more legible?


title: How can I find the range of my function

text: I am trying to find the range of `(3 Sin[x] - 3)/(2 Cos[x] + 10)`, I tried this,               Function[x, (3 Sin[x] - 3)/(2 Cos[x] + 10)]@ Interval[{-Infinity, Infinity}]      _Mathematica_ returned `Interval[{-(3/4), 0}]`, but WolframAlpha returned `-5/8 <= y <= 0`. I'm sure Wolfram | Alpha is right What's wrong with my _Mathematica_ code?


title: Trouble to assign solution of differential equation to a function

text: I have written a function to Solve the following differential equation ![enter image description here](http://i.stack.imgur.com/qsOju.png) where the number n (called in my code Nphoton) is a variable. Nevertheless I have troubles to assign the solutions `sol` of the differential equation to functions `funCa0`, `funCb0` ... The code               Do[         ToExpression[           "fun" <> ToString[vec[[i]]] <> "=Evaluate[" <>             ToString[vec[[i]]] <> "[t]/.sol][[1]]"];         , {i, 1, Length[vec]}         ];      returns the error message `ReplaceAll::reps: {sol} is neither a list of replacement rules nor a valid dispatch table, and so cannot be used for replacing. >>` I do not understand this message, what is wrong with `sol`? My entire function is (it can be run simply by pasting it):               funoscillation[Nphoton_, intialAtomState_, NphotonInitial_, g0_, g1_,wSP_, w0_] :=        Module[{g0li, g1li, Delta, Omega, vec, funvec, eqns, sol, funPlot,          solReal, end},        g0li = Conjugate[g0];        g1li = Conjugate[g1];             Delta = wSP - w0;        Omega = wSP + w0;             If[Nphoton - 1 < NphotonInitial,          Print["ATTENTION: no intial state provided"]; Goto[end];];        vec = {};        funvec = {};     Do[       AppendTo[vec, ToExpression[StringJoin["Ca", ToString[i]]]];       AppendTo[funvec,         ToExpression[StringJoin["funCa", ToString[i]]]]       , {i, 0,    Nphoton - 1}];     Do[       AppendTo[vec, ToExpression[StringJoin["Cb", ToString[i]]]];       AppendTo[funvec,         ToExpression[StringJoin["funCb", ToString[i]]]]       , {i, 0,    Nphoton - 1}];             eqns = {};        Do[         If[i == 0,          AppendTo[eqns,            ToExpression[            "Ca" <> ToString[i] <> "'[t]==-I " <> ToString[g0] <>              " Sqrt[" <> ToString[i] <>              "+1] Exp[-I " <> ToString[Delta] <> " t] Cb" <>              ToString[i + 1] <> "[t]"]];                  AppendTo[eqns,                ToExpression[                 "Cb" <> ToString[i] <> "'[t]==-I " <> ToString[g1] <>              " Sqrt[" <> ToString[i] <>                    "+1] Exp[-I " <> ToString[Omega] <> " t] Ca" <>              ToString[i + 1] <> "[t]"]];             ];                If[i > 0 && i < Nphoton - 1,             AppendTo[eqns,                ToExpression[                 "Ca" <> ToString[i] <> "'[t]==-I " <> ToString[g0] <>              " Sqrt[" <> ToString[i] <>                    "+1] Exp[-I " <> ToString[Delta] <> " t] Cb" <>              ToString[i + 1] <>                    "[t]-I " <> ToString[g1li] <> " Sqrt[" <> ToString[i] <>              "] Exp[I " <> ToString[Omega] <> " t] Cb" <>                    ToString[i - 1] <> "[t]"]];                  AppendTo[eqns,                ToExpression[                 "Cb" <> ToString[i] <> "'[t]==-I " <> ToString[g1] <>              " Sqrt[" <> ToString[i] <>                    "+1] Exp[-I " <> ToString[Omega] <> " t] Ca" <>              ToString[i + 1] <>                    "[t]-I " <> ToString[g0li] <> " Sqrt[" <> ToString[i] <>              "] Exp[I " <> ToString[Delta] <> " t] Ca" <>                    ToString[i - 1] <> "[t]"]];             ];                If[i == Nphoton - 1,             AppendTo[eqns,                ToExpression[                 "Ca" <> ToString[i] <> "'[t]==-I " <> ToString[g1li] <>              " Sqrt[" <> ToString[i] <>                    "] Exp[I " <> ToString[Omega] <> " t] Cb" <>              ToString[i - 1] <> "[t]"]];                  AppendTo[eqns,                ToExpression[                 "Cb" <> ToString[i] <> "'[t]==-I " <> ToString[g0li] <>              " Sqrt[" <> ToString[i] <>                    "] Exp[I " <> ToString[Delta] <> " t] Ca" <>              ToString[i - 1] <> "[t]"]];             ];                , {i, 0, Nphoton - 1}];                   Do[                If[i == NphotonInitial ,           If[intialAtomState == b,            AppendTo[eqns, ToExpression["Ca" <> ToString[i] <> "[0]==0"]];            AppendTo[eqns, ToExpression["Cb" <> ToString[i] <> "[0]==1"]];];           If[intialAtomState == a,            AppendTo[eqns,              ToExpression["Ca" <> ToString[i] <> "[0]==1"]];                AppendTo[eqns, ToExpression["Cb" <> ToString[i] <> "[0]==0"]];],                AppendTo[eqns, ToExpression["Ca" <> ToString[i] <> "[0]==0"]];           AppendTo[eqns, ToExpression["Cb" <> ToString[i] <> "[0]==0"]];               ];                , {i, 0, Nphoton - 1}];             sol = NDSolve[eqns, vec, {t, 0, 10}];             Do[         ToExpression[           "fun" <> ToString[vec[[i]]] <> "=Evaluate[" <>             ToString[vec[[i]]] <> "[t]/.sol][[1]]"];         , {i, 1, Length[vec]}         ];             Print[funvec];        Print[funCa0];        funPlot = Abs[(# & /@ funvec)]^2;             Plot[funPlot, {t, 0, 10}, PlotLegends -> vec, PlotRange -> All]             ];          funoscillation[2, a, 1, 1*0, 1, 2 Pi, 2 Pi]


title: Counting Real roots

text: I'm interested on how to count the number of real roots of a random polynomials in an instant, how to put the result in a table and how to plot it in a graph.I generated 1 million random polynomials following Gaussian Distribution with mean 0 and variance 1. I used this command               r:=GaussianDistribution[0,1]     y=randompol[n_,i_]:=Sum[r x^{j},{j,0,n}]     Solve[y==0,x]     CountRoots[y,x]      But the command Countroots does not apply for it says that the above generated random polynomials is not univariate. But it seems awkward that when I manually paste the generated random polynomial to the CountRoots command instead of using link, it works! But I want to do it in 1 million random polynomials and it is not practical for me to do so. I already used `y//Tableform` and `Remove[{}]` because I thought that the problem is braces since the random polynomials generated using this command `y=randompol[n_,i_]:=Sum[r x^{j},{j,0,n}]` is inside a brace while the `CountRoots` command does not require braces, but i Failed and it did not work. please help me...


title: saving outputs of loop

text: I am stuck on a problem. I have outputs generated at every iteration of a do loop. However, I want to save the outputs in some other file format, like text file etc, in such a way that i must be able to use any output from iteration later. But the more I am searching about it, the more I am getting confused. Please guide in this respect. Like I read the options 'import', 'export', 'sow', 'reap', 'get' etc but i need simple description. Please guide me in this respect.   I quote the example as   I have some initial $a$ as $V0 +\Delta V*\Delta t/T$. Then I update the value of $\Delta t $ by having an increment of value $T/ntmax$ and define $b$ as $V0 +\Delta V*\Delta t/T$ . And then I have to multiply both $a$ and $b$ as $Exp[b]*Exp[a]$   I have to repeat this process until $\Delta t $ $/T$ reaches equal to $T$, as shown in the below loop.               Do[      a = V0 + ΔV*Δt/T;      Δt = Δt + T/ntmax;      b = V0 + ΔV*Δt/T;      f = Exp[b]*Exp[a],      {Δt, T/ntmax, T, T/ntmax}]      As during each iteration I will obtain the new value of $f$. I have to plot few values of $f$. However, I want to keep the record of all, so that I may be able to plot any one of them.


title: Projecting curves of intersection onto a plane

text: Referring to this page, Plotting implicitly-defined space curves How can I project the curves of intersection onto the x-y plane?


title: StreamPlot in Mathematica

text: A $2\times 2$ linear ODE system can be visualized by `SteamPlot` in _Mathematica_. For example               StreamPlot[{y, y - x}, {x, -3, 3}, {y, -3, 3}]      which gives ![enter image description here](http://i.stack.imgur.com/OPVJc.png) Or               StreamPlot[{y, -3 y - x}, {x, -3, 3}, {y, -3, 3}]      which returns ![enter image description here](http://i.stack.imgur.com/W4Zwl.png) Here is my **question** : How can I draw a pair of eigenvectors (like arrows in this answer) in the graph?


title: Quickly calculating the mean / median of a function over an interval

text: I'd like to calculate the Mean or Median value of a function over some interval $[a,b]$. However, I can't seem to find how to do this in help. Specifically I'd like to have something that works like the following:               f = x;     funcMean[f,{x,0,1}];     out :> 0.5;      The way to actually do this is to compute the integral:               1/(b - a) * NIntegrate[f, {x, a, b}, WorkingPrecision -> 20]      But I suspect there's a built-in function to do that same? What about for calculating the Median over the same interval?


title: What is the correct way to use Compiled function in Table and Plot without slow down?

text: On V 9.01 on windows 7, all 64 bit. I am sure I am missing something simple here, but I used all the tricks of the trade that I know about, and read docs, and do not see anything that helps. Here is a compiled function made to speed up some computation. When this function is put inside `Plot` or `Table` it resort back to being slow at the speed of the original uncompiled function speed. Using `Evaluate` gives an error. Here is a MWE (This function takes about one minute to evaluate and compile, sorry that is what I am using, but it is only one line, and takes one minute to compile)               ClearAll[f, g, g0, x, b, a];     f = Function[{##} /. {x_, b_, a_} :>Piecewise[{{Exp[-b*(-Log[x])^a], 0. < x <= 1.}}]];     g = InverseFunction[f, 1, 3];     g0 = Compile[{{x, _Real}, {a, _Integer}, {b, _Integer}}, g[x, a, b]]      ![Mathematica graphics](http://i.stack.imgur.com/LQ24u.png)               Timing[g0[.1, 3, 2]]     (* {0.156001, 0.416409} *)      and               Timing[g0[#, 3, 2] & /@ Range[0, 1, .1]]      ![Mathematica graphics](http://i.stack.imgur.com/AT4Ff.png) It is fast now. Uncompiled version takes more than 60 seconds for each one computation. But when in a table, it becomes slow again, using the original version? or for some other reason               Table[Timing[g0[x, 3, 2]], {x, 0, .1, .1}]     (* {{61.308393, 0.00258519}, {61.323993, 0.416409}} *)      `Evaluate` gives error and still slow               Table[Evaluate[g0[x, 3, 2]], {x, 0, .1, .1}]     (*CompiledFunction::cfsa: "Argument x at position 1 should be a      "machine-size real number " *)      Direct use of Table is too slow, same as above.               Table[g0[x, 3, 2], {x, 0, .1, .1}]      Same issue with `Plot`. Can't use `Evaluate` and if I do not, it is slow. Using `Compiled-False` did not help (since `g0` is already compiled), it is still slow               Plot[g0[x, 3, 2], {x, 0, 1}, Method -> {Compiled -> False}]; (*slow*)     Plot[g0[x, 3, 2], {x, 0, 1}, Method -> {Compiled -> False}, Evaluated -> False];      Plot[g0[x, 3, 2], {x, 0, 1}, Evaluated -> False]; (*slow*)      **How can one use Compiled function in`Table` and `Plot` without it being slow?** Is it one of those `HoldRest`, `HoldFirst` issues or I am missing something more basic here?


title: Factor vector out of a matrix

text: I am wondering how to factor `a[1],a[2],...,a[4]` out of `sim` so that I can write `sim` as the form of a matrix times column vector `a`. (`a[1],a[2],...,a[4]` are the component of vector `a`) ? My ultimate goal is to compute the `Omega` when the determinant of the matrix is zero.               Nmax = 4;     x[0][t] = 0;     x[Nmax + 1][t] = 0;          T = 1/2 Sum[m[i] x[i]'[t]^2, {i, 1, Nmax}];     U = 1/2 Sum[k[i] (x[i][t] - x[i - 1][t])^2, {i, 1, Nmax + 1}];          L = T - U;          EL[q_] := D[L, q] - D[D[L, D[q, t]], t]          eigen = Table[EL[x[i][t]], {i, 1, Nmax}] // MatrixForm;          x[i_][t_] = a[i] E^(I \[Omega] t);          sim = eigen /. t -> 0      ![enter image description here](http://i.stack.imgur.com/E2CuU.jpg)


title: transformation patterns don't work with constants

text: I want to do the reverse of PowerExpand and convert 2*Log[x+y] to Log[(x+y)^2]. The rule:                t_ Log[x_] -> Log[x^t]      works for `a Log[y], a Log[Pi], Pi Log[a], 2 Log[a], a Log[2]` but not for `2 Log[Pi], Pi Log[2], Pi Log[EulerGamma]`. Entering:               Pi Log[Pi] /. Pi Log[Pi] -> Log[Pi^Pi]      Returns:               Pi Log[Pi]      instead of:               Log[Pi^Pi]


title: Match a sequence of integers

text: I would to match a pattern                p1 = 0,0,1,0,0      to the elements in listA. The elements are a boolean sequence that may look like this                {{0, 0, 1, 0, 0, 1, 0, 1, 1, 0, 0, 1, 0, 0}, {0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0}}      Every where p1 matches the sequence I want to change that part into                p2 = .5, .5, 1, .5, .5      that will change listA into                {{.5, .5, 1, .5, .5, 1, 0, 1, 1, .5, .5, 1, .5, .5},   {0, 0, .5, .5, 1, .5, .5, .5, .5, 1, .5, .5, 0, 0}}      Thanks!


title: Panel help with little program

text: I'd like to show the output of this program into one large `Panel`, but when I surround this code with `Panel[ ]`, it doesn't seem to work. Why is that?               listA = {};     listB = {};     "Verzameling A : " InputField[Dynamic[Null, AppendTo[listA, #] &]]           "Verzameling B : " InputField[Dynamic[Null, AppendTo[listB, #] &]]               listAShow := Sort[ DeleteDuplicates[listA]];     listBShow := Sort[ DeleteDuplicates[listB]];          "Verzameling A =" Dynamic[listAShow]     "Verzameling B =" Dynamic[listBShow]          unie := Union[listAShow, listBShow];     doorsnede := Intersection[listAShow, listBShow];          toonOpl = False;     Row@{Checkbox[Dynamic[toonOpl]], "Toon bewerkingen"}     Dynamic[If[toonOpl,       Column@{         Row@{"Unie van A en B = ", unie}         , Row@{"Doorsnede van A en B = ", doorsnede}         }, {}]]          Button["Reset alles", listA = {}; listB = {}]      Thanks all!


title: StandardForm on Graph edges

text: The `Graph` command displays edge labels in `TraditionalForm`. I instead want to use `StandardForm`. I tried `EdgeLabelStyle -> Directive[StandardForm, Background -> White]`, but of course it does not work. So how to do it, acting on `EdgeLabelStyle`? Edit: Comment to @Sjoerd examples Your Binomial example is somewhat misleading, since Binomial has an intrinsic TraditionalForm version. What we are seeing in the graph is a sort of hybrid of Standardform (for n and k) and TraditionalForm for the parenthesis (I think). This is the proof: ![Mathematica graphics](http://i.stack.imgur.com/mXV9D.png) As you see, even though I used braces in the notation, I still get the parenthesis in the graph (from the internal TraditionalForm), but the n, k are indeed in StandardForm. This shows that the "StandardForm" in EdgelabelStyle does something, but it is not enough. Perhaps it is possible to play with BaseStyle? The same thing happens if you use MakeBoxes (without ToString).