How can I improve my code for drawing a tree?

This code draws a tree, but it's not in the functional style.               tree[set_, m_] :=        Module[{θ, mz, my, temp, k, i, p1, p2, a, b, c, d, e, f},        θ = Pi/6;        mz = {{Cos[θ], -Sin[θ]}, {Sin[θ], Cos[θ]}};         my = {{Cos[-θ], -Sin[-θ]}, {Sin[-θ], Cos[-θ]}};        temp = set;        p1 = {};(*store branch*)        p2 = {};(*store leaf*)        For[k = 1, k <= m, k++, p2 = {};         For[i = 1, i <= Length[temp], i++, a = temp[[i, 2]];          b = temp[[i, 1]];          c = 1/3*a + 2/3*b;          d = c + mz.(a - b)*(1/3);          e = c + my.(a - b)*(1/3);          AppendTo[p1, {Brown, Thickness[0.035/k], Line[{b, c}]}];          AppendTo[p2, {c, a}];          AppendTo[p2, {c, d}];          AppendTo[p2, {c, e}];          ];         temp = p2;         ];             Show[Graphics[{p1, {RGBColor[0.1, 0.42, 0.17], Line[p2]}},           Axes -> 1, PlotRange -> {{-0.2, 0.2}, {-0.2, 1.}}]]];          tree[{{{0., 0.}, {0., 1.}}}, 7]      ![Mathematica graphics](http://i.stack.imgur.com/pU5bT.png) A friend of mine tried rewrite it with `Nest`, but it worked slower than the original code.               (leaf = Nest[Apply[Transpose[{Table[(2 #1 + #2)/3, {3}],                 {RotationTransform[-5 Pi/6, (2 #1 + #2)/3][#1],                RotationTransform[                 5 Pi/6, (2 #1 + #2)/3][#1], #2}}] &, #, {-3}] &,                  {{{0, 0.}, {0, 1}}}, 7];        Graphics[Map[{RGBColor[0.1, 0.42, 0.17], Line[#]} &, leaf, {-3}]]) // AbsoluteTiming      ![Mathematica graphics](http://i.stack.imgur.com/w1Jp2.png) I think `Nest` is slower than loops. How do I rewrite it to make it faster? If possible, use `Fold`, `Nest` or similar functional constructs.


Convolving data set with gaussian profile

I have a spectrum looking like List, and I want to convole it with a gaussian of the form               PDF[NormalDistribution[μ, σ], x]      (where σ also depends on x). The raw spectrum is convolved with the (gaussian) instrument profile. So I assume I should use `ListConvolve` rather then using Fourier transformations. `ListConvolve` takes two lists as its arguments, so I need to define my kernel. I tried               ker = Table[PDF[NormalDistribution[μ, C*x], x], {x, 4021, 4024, 0.05}]     ListConvolve[ker, data]      But the result doesn't seem correct. There must be a Gauss-function for every data point to get to the new dataset. Is there a better way to get the convolution done? I hope I could make my problem clear to everyone.


Why won't Mathematica obtain eigenvectors for this symmetric matrix?

The matrix is a real symmetric 4x4:               ({{0, Sin[x + y], Sin[z + y], Sin[x + z]},       {Sin[x + y], 0, Sin[x - z], Sin[z - y]},       {Sin[z + y], Sin[x - z], 0, Sin[y - x]},       {Sin[x + z], Sin[z - y], Sin[y - x], 0}})      Mathematica can find the eigenvalues fine, and they are degenerate for x, y, and/or z equal to zero. No eigenvectors can be found: Eigenvectors::eivec0: Unable to find all eigenvectors. And it seems to me that Mathematica should be able to handle the degeneracy, but I would be interested to know why it is encountering trouble. Is there some obvious property about this matrix that I am not accounting for (such as restricting values of x, y, z for the trigonometric functions) or is there something I can do inside of Mathematica to specify some starting point for an eigenvalue?


Plotting blends of colors over lists of lists in 3D

I have a list of lists containing spectral data, many thousands of points long. Each sublist contains 13 parts, and I need to plot them in 3D with a blend of RGB colors derived from the spectral data. So no problem until I get to coloring the plots. How can I use the list of 13 RGB triplets to create a blend to color each list plot? Here are two datasets, one for a plot and one for the corresponding colors:               spectral = {{{48.76`, 63.49`, 72.76`, 76.78`, 78.02`, 78.96`, 79.73`,       80.41`, 81.21`, 81.83`, 82.39`, 83.03`, 83.56`, 84, 84.42`,       84.53`, 84.69`, 84.74`, 84.55`, 84.73`, 84.56`, 84.47`, 84.31`,       84.25`, 84.09`, 83.81`, 83.67`, 83.58`, 83.39`, 83.05`, 82.76`,       82.49`, 82.35`, 82.33`, 82.16`, 82.06`}, {42.08`, 57.42`, 67.24`,       72.1`, 73.91`, 75.4`, 76.73`, 77.54`, 77.96`, 77.76`, 77.04`,       75.64`, 74.02`, 72.55`, 71.15`, 70.15`, 70.04`, 69.92`, 69.35`,       69.21`, 69.33`, 69.99`, 70.29`, 70.17`, 69.92`, 69.77`, 70.09`,       70.87`, 71.69`, 72.08`, 71.95`, 71.48`, 70.77`, 70.14`, 69.89`,       70.46`}, {42.03`, 56.78`, 66.37`, 70.92`, 72.63`, 74, 75.27`,       76.02`, 76.44`, 76.32`, 75.7`, 74.46`, 72.96`, 71.53`, 70.1`,       69.06`, 68.94`, 68.84`, 68.22`, 68.03`, 68.19`, 68.93`, 69.25`,       69.12`, 68.84`, 68.71`, 69.1`, 69.89`, 70.76`, 71.15`, 71.03`,       70.59`, 69.92`, 69.35`, 69.18`, 69.79`}, {39.03`, 53.63`, 63.5`,       68.37`, 70.26`, 71.8`, 73.19`, 73.93`, 74.24`, 73.92`, 72.91`,       71.04`, 68.78`, 66.59`, 64.33`, 62.75`, 62.43`, 62.19`, 61.25`,       60.78`, 61.04`, 62.1`, 62.66`, 62.45`, 62.06`, 61.91`, 62.52`,       63.73`, 65.08`, 65.81`, 65.78`, 65.28`, 64.36`, 63.57`, 63.44`,       64.42`}, {31.22`, 46.21`, 57.41`, 63.54`, 66.14`, 68.43`, 70.44`,       71.39`, 71.38`, 70.37`, 68.2`, 64.36`, 59.76`, 55.23`, 50.36`,       46.94`, 45.98`, 45.24`, 43.14`, 41.64`, 42.14`, 44.33`, 45.51`,       45.06`, 44.19`, 44.02`, 45.32`, 47.88`, 50.81`, 52.62`, 52.78`,       52.06`, 50.5`, 49.01`, 49.26`, 51.58`}, {26.44`, 40.79`, 52.46`,       59, 61.93`, 64.58`, 66.88`, 67.92`, 67.76`, 66.38`, 63.6`,       58.72`, 52.92`, 47.21`, 41.06`, 36.78`, 35.48`, 34.49`, 31.86`,       29.83`, 30.43`, 33.14`, 34.6`, 34.03`, 32.93`, 32.74`, 34.34`,       37.51`, 41.2`, 43.52`, 43.79`, 42.96`, 41.05`, 39.21`, 39.61`,       42.46`}, {22.15`, 36.49`, 49.02`, 56.44`, 59.88`, 62.99`, 65.73`,       66.93`, 66.45`, 64.57`, 60.92`, 54.74`, 47.62`, 40.78`, 33.58`,       28.71`, 27.21`, 26.08`, 23.15`, 20.89`, 21.54`, 24.47`, 26.08`,       25.45`, 24.24`, 24.08`, 25.86`, 29.41`, 33.6`, 36.35`, 36.72`,       35.8`, 33.66`, 31.63`, 32.2`, 35.6`}, {20.01`, 33.94`, 46.53`,       54.05`, 57.59`, 60.8`, 63.56`, 64.79`, 64.3`, 62.28`, 58.44`,       51.89`, 44.29`, 36.94`, 29.19`, 23.96`, 22.35`, 21.13`, 18.05`,       15.69`, 16.37`, 19.42`, 21.11`, 20.41`, 19.13`, 18.95`, 20.8`,       24.56`, 29.03`, 31.97`, 32.39`, 31.44`, 29.18`, 27.01`, 27.62`,       31.29`}, {18.84`, 32.74`, 45.29`, 52.81`, 56.47`, 59.72`, 62.63`,       63.89`, 63.37`, 61.31`, 57.38`, 50.67`, 42.9`, 35.39`, 27.53`,       22.23`, 20.58`, 19.35`, 16.25`, 13.85`, 14.51`, 17.54`, 19.22`,       18.53`, 17.25`, 17.06`, 18.91`, 22.67`, 27.19`, 30.17`, 30.61`,       29.66`, 27.37`, 25.16`, 25.81`, 29.51`}, {18.4`, 32.15`, 45.16`,       53.05`, 56.88`, 60.39`, 63.55`, 64.83`, 64.16`, 61.86`, 57.5`,       50.25`, 42.03`, 34.26`, 26.29`, 21.02`, 19.39`, 18.18`, 15.16`,       12.84`, 13.47`, 16.4`, 18, 17.31`, 16.04`, 15.85`, 17.63`,       21.31`, 25.79`, 28.79`, 29.22`, 28.25`, 25.92`, 23.72`, 24.38`,       28.08`}, {17.83`, 31.87`, 44.91`, 53, 56.88`, 60.41`, 63.52`,       64.85`, 64.22`, 61.88`, 57.5`, 50.17`, 41.77`, 33.79`, 25.52`,       20.04`, 18.35`, 17.08`, 13.94`, 11.54`, 12.2`, 15.23`, 16.93`,       16.21`, 14.92`, 14.73`, 16.6`, 20.44`, 25.11`, 28.25`, 28.72`,       27.72`, 25.33`, 23.07`, 23.77`, 27.65`}, {17.54`, 31.72`, 45.01`,       53.08`, 57, 60.61`, 63.78`, 65.09`, 64.41`, 62.05`, 57.6`,       50.13`, 41.53`, 33.28`, 24.72`, 19.04`, 17.29`, 15.99`, 12.78`,       10.36`, 11.05`, 14.16`, 15.9`, 15.16`, 13.82`, 13.64`, 15.58`,       19.54`, 24.4`, 27.63`, 28.12`, 27.11`, 24.64`, 22.28`, 23.06`,       27.08`}, {17.39`, 31.68`, 45.1`, 53.25`, 57.15`, 60.74`, 63.93`,       65.22`, 64.55`, 62.22`, 57.77`, 50.24`, 41.55`, 33.19`, 24.5`,       18.73`, 16.96`, 15.64`, 12.41`, 10, 10.71`, 13.83`, 15.58`,       14.83`, 13.47`, 13.31`, 15.26`, 19.27`, 24.16`, 27.44`, 27.9`,       26.86`, 24.37`, 22, 22.75`, 26.82`}}};       color={{{0.73, 0.73, 0.7}, {0.63, 0.64, 0.68}, {0.62, 0.63, 0.67}, {0.57, 0.59, 0.66}, {0.44, 0.48, 0.65}, {0.36, 0.41, 0.63}, {0.3, 0.35,0.62}, {0.26, 0.32, 0.61},      {0.25, 0.31, 0.6}, {0.24, 0.3,0.61}, {0.23, 0.29, 0.61}, {0.22, 0.28, 0.61}, {0.22, 0.28, 0.61}}};       Using ListPlot3D for the plots, How can I plot these colors as blends over ListPlot3d?


FindFit for a differential equation model with multiple variables?

I'm trying to figure out how to use `FindFit` with a multivariable differential equation model and data. I've successfully made it work for the one-variable version of the model by following the example on the Help page:               DNA = 10;          model[ a_?NumberQ, b_?NumberQ, c_?NumberQ, d_?NumberQ, f_?NumberQ,             g_?NumberQ, Km1_?NumberQ, Km2_?NumberQ, Km3_?NumberQ, NTP0_?NumberQ] :=        (model[a, b, c, d, f, g, Km1, Km2, Km3, NTP0] =           First[MG /. NDSolve[{ MG'[t] == a*DNA*NTP[t]/(Km1 + NTP[t]) - b MG[t],                                NTP'[t] == -f*a*DNA*NTP[t]/(Km1 + NTP[t]) -                                 d MG[t] NTP[t]/(Km2 + NTP[t]) - c NTP[t]/(Km3 + NTP[t]),                                 GFP'[t] == g*d MG[t] NTP[t]/(Km2 + NTP[t]),                                NTP[0] == NTP0, MG[0] == 0, GFP[0] == 0},                              {MG, NTP, GFP}, {t, 0, 800}, Method -> StiffnessSwitching]]);          fit = FindFit[ data, {model[a, b, c, d, f, g, Km1, Km2, Km3, NTP0][t],                             a > 0, b > 0, c > 0, d > 0, f > 0, g > 0,                             Km1 > 1000, Km2 > 1000, Km3 > 1000, NTP0 > 100000},                     {{a, 6.8}, {b, 0.012}, {c, 247}, {d, 1.54}, {f, 19.6}, {g, 22.2},                      {Km1, 352200}, {Km2, 127882}, {Km3, 5134.5}, {NTP0, 611628}}, t]      where the data looks like:               data = {{1.65, 111}, {4.65, 141}, {7.65, 130}, {10.65, 247}, {13.65, 301},              {16.65, 395}, {19.65, 444}, {22.65, 652}, ...};      But now I'd like to do it with `DNA` being an additional variable included in the data like:               newdata = {{1.65, 10, 111}, {4.65, 10, 141}, {7.65, 10, 130}, ..., {1.65, 5, -4},                {4.65, 5, 118}, {7.65, 5, 86}, {10.65, 5, 85}, {13.65, 5, 110}, ...};      so that I could fit multiple curves with different values of `DNA` simultaneously. I imagine that this is something that's possible, but I'm not sure on the syntax. Anyone have any thoughts on this? \------ EDIT -------- so now I've tried to follow the example that bobthechemist gave on the linked page, but I think I'm getting hung up on the syntax:               model[ c_?NumberQ, d_?NumberQ, f_?NumberQ, Km1_?NumberQ, Km2_?NumberQ, Km3_?NumberQ,      Km4_?NumberQ ][ DNA_?NumberQ, t_?NumberQ] :=      (model[c,d,f, Km1,Km2,Km3,Km4][t,DNA] =  First[MG/.ParametricNDSolve[{     MG'[t,DNA]==a*DNA*NTP[t,DNA]^n/(Km1^n+NTP[t,DNA]^n)b(Km4^n/(Km4^n+NTP[t,DNA]^n))MG[t,DNA],     NTP'[t,DNA]==-a*f*DNA*NTP[t,DNA]^n/(Km1^n+NTP[t,DNA]^n)-d*MG[t,DNA]NTP[t,DNA]^n/(Km2^n+NTP[t,DNA]^n)-c NTP[t,DNA]^n/(Km3^n+NTP[t,DNA]^n),     NTP[0]==NTP0,MG[0]==0}/.{n->1,b->0.012,a->3.5,NTP0->1500000},{MG,NTP},{t,0,800},{DNA},Method->StiffnessSwitching]]);          fit=FindFit[newdata10,{model[c,d,f, Km1,Km2,Km3,Km4][t,DNA],c>0,0<d,0<f,Km1>100000,Km2>100000,Km3>100000,Km4>100000},{{c,91.0400},{d,8.4986},{f,0.000018697},{Km1,1000100},{Km2,5005020},{Km3,5000150},{Km4,7000000}},{t,DNA},Method->"NMinimize"]      gives a whole bunch of errors. perhaps this kind of problem is a bit beyond someone with my limited grasp of Mathematica syntax \------ EDIT 2 -------- a more complete set of data:               data = {{2.65,5,86}, {5.65,5,85}, {8.65,5,110}, {11.65,5,153}, {14.65,5,187}, {17.65,5,293}, {20.65,5,321}, {23.65,5,320}, {26.65,5,402}, {29.65,5,355}, {32.65,5,593}, {35.65,5,589}, {38.65,5,653}, {41.65,5,687}, {44.65,5,752}, {47.65,5,858}, {50.65,5,882}, {53.65,5,933}, {56.65,5,1033}, {59.65,5,1043}, {62.65,5,1144}, {65.65,5,1178}, {68.65,5,1239}, {71.65,5,1264}, {74.65,5,1317}, {77.65,5,1452}, {80.65,5,1449}, {83.65,5,1465}, {86.65,5,1480}, {89.65,5,1500}, {92.65,5,1529}, {95.65,5,1531}, {98.65,5,1676}, {101.65,5,1626}, {104.65,5,1632}, {107.65,5,1699}, {110.65,5,1560}, {113.65,5,1651}, {116.65,5,1756}, {119.65,5,1767}, {122.65,5,1715}, {125.65,5,1716}, {128.65,5,1715}, {131.65,5,1732}, {134.65,5,1705}, {137.65,5,1740}, {140.65,5,1759}, {143.65,5,1698}, {146.65,5,1653}, {149.65,5,1628}, {152.65,5,1677}, {155.65,5,1711}, {158.65,5,1608}, {161.65,5,1670}, {164.65,5,1481}, {167.65,5,1563}, {170.65,5,1562}, {173.65,5,1588}, {176.65,5,1540}, {179.65,5,1480}, {182.65,5,1462}, {185.65,5,1424}, {188.65,5,1446}, {191.65,5,1412}, {194.65,5,1380}, {197.65,5,1341}, {200.65,5,1338}, {203.65,5,1263}, {206.65,5,1244}, {209.65,5,1237}, {212.65,5,1164}, {215.65,5,1050}, {218.65,5,1109}, {221.65,5,1041}, {224.65,5,1071}, {227.65,5,908}, {230.65,5,940}, {233.65,5,1013}, {236.65,5,913}, {239.65,5,976}, {242.65,5,886}, {245.65,5,847}, {248.65,5,819}, {251.65,5,784}, {254.65,5,818}, {257.65,5,815}, {260.65,5,807}, {263.65,5,704}, {266.65,5,705}, {269.65,5,816}, {272.65,5,758}, {275.65,5,757}, {278.65,5,633}, {281.65,5,708}, {284.65,5,675}, {287.65,5,632}, {290.65,5,617}, {293.65,5,621}, {296.65,5,594}, {299.65,5,558}, {2.65,10,130}, {5.65,10,247}, {8.65,10,301}, {11.65,10,395}, {14.65,10,444}, {17.65,10,652}, {20.65,10,701}, {23.65,10,840}, {26.65,10,922}, {29.65,10,1074}, {32.65,10,1154}, {35.65,10,1209}, {38.65,10,1326}, {41.65,10,1470}, {44.65,10,1628}, {47.65,10,1600}, {50.65,10,1679}, {53.65,10,1759}, {56.65,10,1856}, {59.65,10,1887}, {62.65,10,2057}, {65.65,10,2078}, {68.65,10,2182}, {71.65,10,2128}, {74.65,10,2034}, {77.65,10,2257}, {80.65,10,2337}, {83.65,10,2362}, {86.65,10,2330}, {89.65,10,2423}, {92.65,10,2471}, {95.65,10,2440}, {98.65,10,2388}, {101.65,10,2544}, {104.65,10,2436}, {107.65,10,2538}, {110.65,10,2402}, {113.65,10,2406}, {116.65,10,2423}, {119.65,10,2365}, {122.65,10,2345}, {125.65,10,2391}, {128.65,10,2412}, {131.65,10,2375}, {134.65,10,2309}, {137.65,10,2321}, {140.65,10,2389}, {143.65,10,2212}, {146.65,10,2211}, {149.65,10,2276}, {152.65,10,2188}, {155.65,10,2112}, {158.65,10,2223}, {161.65,10,1980}, {164.65,10,2046}, {167.65,10,2045}, {170.65,10,2022}, {173.65,10,1933}, {176.65,10,1901}, {179.65,10,1925}, {182.65,10,1829}, {185.65,10,1873}, {188.65,10,1840}, {191.65,10,1855}, {194.65,10,1752}, {197.65,10,1682}, {200.65,10,1639}, {203.65,10,1752}, {206.65,10,1784}, {209.65,10,1661}, {212.65,10,1608}, {215.65,10,1563}, {218.65,10,1462}, {221.65,10,1563}, {224.65,10,1543}, {227.65,10,1448}, {230.65,10,1376}, {233.65,10,1384}, {236.65,10,1383}, {239.65,10,1340}, {242.65,10,1263}, {245.65,10,1362}, {248.65,10,1201}, {251.65,10,1206}, {254.65,10,1220}, {257.65,10,1185}, {260.65,10,1164}, {263.65,10,1133}, {266.65,10,1154}, {269.65,10,1115}, {272.65,10,1122}, {275.65,10,1028}, {278.65,10,1049}, {281.65,10,1042}, {284.65,10,960}, {287.65,10,1011}, {290.65,10,940}, {293.65,10,927}, {296.65,10,877}, {299.65,10,888}};      in each triplet of numbers, the first is the time, second is the DNA parameter value, and the third is the value of the function.


Delayed evaluation of assignment

I have a set of PDE's that depend on parameters. They depend on many parameters, but for simplicity we can here assume that they depend only on one, say `a`. I want to solve them for many parameter sets, using something of the form `With[{a=1},NDSolve[...]]` But since I have many sets of parameters, and it is very inconvenient to enter them each time, I want to have something like               p1 = {a=1};     p2 = {a=Pi+4};     ...     With[p1,NDSolve[...]]     With[p2,NDSolve[...]]      This clearly doesn't work because evaluating `p1={a=1}` assigns a value for `a`, and I don't want that (because I want to continue doing symbolic manipulations in other parts of the notebook). `SetDelayed` and `RuleDelayed` don't seem to work neither. Any ideas? _**EDIT_** I was asked to improve the description of my problem, so I try (and, on the way, thank all the people who tried to help). The situation is this. I have a notebook that contains many formulas, which depend on many parameters. For example, I have                f[x_]:= Sin[a x^b];      g[x_]:= a/x +Exp[-b]x;      diffEq={x'[t]==f[x[t]] x[t]^2-x/g[x[t]], x[0]==123};      I want to do symbolic manipulations on the formulas, so I don't want to assign numerical values to `a,b`. At the same time, I want to to solve the differential equation `diffEq`, and for this I want numerical values, and I want to solve it for different sets of paramters `a,b`. So I want to have variables which are assignments, something like               ass1={a->1,b->3};     ass2={a->123,b->Pi};     ass3={a->-32,b->1241203853};     ...      So that I could easily do               With[ass1,NDSolve[...]]     With[ass2,NDSolve[...]]     ....      and play around with the variables. I hope this better describes what I want to do.


Plotting multiple lists of complex numbers

The user #Nasser showed an elegant way to plot complex numbers:               data = Table[RandomReal[{-1, 1}] + I RandomReal[{-1, 1}], {30}];          p = ListPlot[{Re[#], Im[#]} & /@ data,         AxesOrigin -> {0, 0},         PlotRange -> {{-1.2, 1.2}, {-1.2, 1.2}},         ImagePadding -> 40,         AspectRatio -> 1,         Frame -> True,         FrameLabel -> {{Im, None}, {Re, "complex plane"}},         PlotStyle -> Directive[Red, PointSize[.02]]];          Show[p, Graphics@Circle[{0, 0}, 1]]      How can I change this code so that an input of multiple lists is possible and they are plotted each in a different color?


Trouble with fonts when exporting a 2D-plot to vector formats

I've set up my plot to look exactly how I like it. At least it does so on screen. Upon export though, only the bitmap formats look the same. For PDF and EPS, the FontSize seems to get ignored and the lines aren't outlined so when downscaling the whole plot the lines get thicker in relation. Isn't there a simple way to just render the whole thing as a proper PDF with everything (including fonts) outlined and at correct size?! EDIT: So there were two different problems I ran into: First was Adobe Illustrator somehow couldn't display all the text that Mathematica output into the PDF. Therefore the option to outline from within Mathematica is very convenient. Second was my (newbish) mistake to specify the font size with `Scaled[0.02]` wich was clearly not what I wanted. I now changed it to fixed point sizes.


How to obtain non-trivial solution of equal ratios

How can I obtain a non-trivial solution of the following: $$\frac{a}{b+c}=\frac{b}{c+a}=\frac{c}{a+b}$$ The answer is $a=b=c=1$.


Have transformation rules to be explicitly set?

I think this problem is not the hardest one, but I can't hit on it. I want to NSolve an equation. For this equation I use a transformation rule "ampTimes". First I used it like this:               ampTimes = {tf -> .03, th -> .002}     NSolve[E^(th/t) + E^((tf + th)/t) == 2 E^(tf/t) /. ampTimes, t, Reals]      > >     {tf -> 0.03, th -> 0.002} >     {{t -> 0.00288552}} >   and it worked. I get a solution for `t`. Due to clearity, I switched to this expression:               ampTimes = {tf -> (.315 - .285), th -> (.287 - .285)}     NSolve[E^(th/t) + E^((tf + th)/t) == 2 E^(tf/t) /. ampTimes, t, Reals]      > >     {tf -> 0.03, th -> 0.002} >     {} >   The output for `ampTimes` stays the same, but I didn't get a solution for my equation. I thought, the transformation rule may couldn't handle the difference, so I changed it to               (.315 - .285);     (.287 - .285);     ampTimes = {tf -> %%, th -> %}     NSolve[E^(th/t) + E^((tf + th)/t) == 2 E^(tf/t) /. ampTimes, t, Reals]      > >     {tf -> 0.03, th -> 0.002} >     {} >   Again, the output fpr `ampTimes` seems right, but I didn't get a solution. It wouldn't be a problem to use the transformation rule explicitly, but as said, wouldn't be supporting for clearity. Plus the problem get me and I realy want to know WHY it doesn't work the way I thought. EDIT: I guess it has something to do with the precision.


How to I display the value of my plot function?

I've plotted a function that varies with respect to time. It's inside a manipulate box, which can vary the time. And I'd like to display the value of the function at the time on the slider on my plot. I've seen it done before, but I've been trying unsuccessfully for the last 40 or so minutes to find out how. Any ideas?


What is the fastest way to replace all zeros in a matrix?

In the following matrix `m` every 0 should be replaced with a 1:               m = {{0,1,2},{5,0,3},{8,0,0}}      Desired result:               m' = {{1,1,2},{5,1,3},{8,1,1}}      What is the fastest way to do this for a matrix with 200-1000 elements?


Navigation a la XPath for Mathematica notebooks

In Mathematica, notebooks (in fact all expressions) have a tree-like structure. In this regard, they are similar to XML files. For XML, one can travel through the document structure using tools like XPath. What would be the equivalent in Mathematica so that beginning with `NotebookSelection` one navigates towards the outermost `Notebook` until one reaches a parent that matches certain pattern (say `Cell[__,”Input”,___]`). If the pattern is reached, the selection is enlarged; otherwise, the selection stays the same. To make the problem more interesting: is it possible to do it without changing the selection (the highlighted region should stay the same unless enlarged to avoid flickering) and without copying the notebook to a hidden one (the original notebook might be really large)? Any pointers will be appreciated.


Uniformly distributed n-dimensional probability vectors

What's the right way to generate a random probability vector $p={p_1,\ldots,p_n} \in {(0,1)}^n$ where $\sum_i p_i=1$, uniformly distributed over the $(n-1)$-dimensional simplex? What I have is               Intervals = Table[{0, 1}, {i, n}]     RandomPoint := Block[{a},         a = RandomVariate[UniformDistribution[Intervals]];         a/Total[a]];      But I am unsure that this is correct. In particular, I'm unsure that it's any different from:               RandomPoint := Block[{a},         a = Table[Random[], {i, n}];         a/Total[a]];      And the latter clearly will not distribute vectors uniformly. Is the first code the right one?


How does Mathematica understand branchcuts of the complex logarithm? [Part 2]

I observe that the answer generated by the first integration is not in any simple way related to the next two answers. (some simple jump of i 2\pi across the branchcut of the logarithm is not helping either - as discussed in the previous question _Mathematica_ puts the branchcut of the function $log(z^2 +4)$ as being along the positive imaginary axis starting at 2i ) Can someone help understand what _Mathematica_ is doing mathematically?               Integrate [ Exp[I p] Log [ (3 Exp [I p])^2 + 4] , {p, 0, π}]      > >      2/3 I (-6 + π + 4 ArcTan[3/2] + Log[2197]) >                 Integrate [ Exp[I p] Log [ (3 Exp [I p])^2 + 4] , {p, 0, π/2}]      > >      -2 + I π + 4/3 ArcTanh[3/2] + Log[5] +  1/3 I (-6 + 4 ArcTan[3/2] + > Log[2197]) >                 Integrate [ Exp[I p] Log [ (3 Exp [I p])^2 + 4] , {p, π/2, π}]      > >     1/3 I ((-6 - 6 I) + π + 4 ArcTan[3/2] + 5 I Log[5] + Log[2197]) >


How to make text flash for a short period

How could I display text that flashed red for a half second or so and then reverted to black? (Or was put in bold and reverted to normal, etc.)


Defining new Cellular Automata rule

I want to define a new Cellular Automata rule as follows               {{1, _, 1} -> 0, {1, _, 0} -> 1, {0, _, 1} -> 1, {0, _, 0} -> 0}      where _ represents Blank in mathematica. How can I code this in mathematica?


Minimize: How to work with specific numeric types

This is a question about the use of symbols in `Minimize` and how to persuade _Mathematica_ to treat them in a specific way (as integers or rationals) that I have not been able to achieve, but analysis of the results of `Minimize` suggests ought to be possible. The context is this: I have the following equation and wish to find the minimum value of `t0` in closed form for a, b in terms of vx, vy, vz _without numeric values_ (as you will see below I can find a minima for specific numeric values of `vx`, `vy`, `vz`).               t0 = g (-vz Cos[a] - vy Cos[b] Sin[a] - vx Sin[b] Sin[a])      In the code block below, you will see in part 1 an attempt to do this symbolically in terms of the ratio `c/d` assigned to the key variables `vx`, `vy`, `vz`; `Minimize` will not do it. In part 2 `vx`, `vy` and `vz` are given a specific exact numerical values and `Minimize` then delivers a result. However, inspection of the result clearly shows (thanks to the relative primaility of the numerators of `vx` etc.) that _Mathematica_ is handling the numerators separately. **Code**               Block[{g, vx, vy, vz, t0, mint,  a, b , c, d},      t0 = g (-vz Cos[a] - vy Cos[b] Sin[a] -           vx Sin[b] Sin[a]); (* eqn to minimize *)       g = 1/Sqrt[1 - (vx^2 + vx^2 + vx^2)]; (* common initialisation *)      (* Part 1 *)      vx = vy = vz = c/d; (* would like vx etc. elements of Rationals... how? *)      mint = Minimize[{t0, 0 <= b < 2 Pi, 0 <= a < Pi}, {b, a},         Reals]; (* fails *)      Print["t0 minimum = ", mint];      mint = Minimize[{t0, 0 <= b < 2 Pi, 0 <= a < Pi, ,          c ∈ Integers, d ∈ Integers}, {b, a},         Reals]; (* fails *)      Print["t0 minimum = ", mint];      (* Part 2 *)      vx = 7/100; vy = 3/100;       vz = 11/100; (* all v made specific rationals *)      mint = Minimize[{t0, 0 <= b < 2 Pi, 0 <= a < Pi}, {b, a},         Reals]; (* succeeds *)      Print["t0 minimum = ", mint];      ]      **Result of Part 2:** > >     t0 minimum = {(1/Sqrt[9853])100 (-(11/100) Cos[2 ArcTan[1/58 >                         (-11 Sqrt[58]+Sqrt[10382])]]-3/100 >                     Cos[2 ArcTan[1/7 (-3+Sqrt[58])]] Sin[2 ArcTan[1/58 >                         (-11 Sqrt[58]+Sqrt[10382])]]-7/100 Sin[2 ArcTan[1/7 > (-3+Sqrt[58])]] >                     Sin[2 ArcTan[1/58 (-11 Sqrt[58]+Sqrt[10382])]]), >                     {b -> 2 ArcTan[1/7 (-3+Sqrt[58])], >                      a -> 2 ArcTan[1/58 (-11 Sqrt[58] + Sqrt[10382])]}} >   where the coefficients are clearly related to the values of the denominators `vx` etc. as follows:               58 = 7^2 + 3^2     10382 = (7^2+3^2+11^2) * (7^2 +3^2)      **Question** Is it possible to perform the minimisation symbolically and if so, how? Can one declare `vx` etc. as `Rationals` directly or by assignment as the ratio of two `Integers`? I have tried including equivalent constraints within `Minimize` (one example given in code above), but to no effect. I also tried defining a function accepting appropriate `Integers` and `Reals`, also without success.               f[a_Real, b_Real, c_Integer, d_Integer] :=       g (-vz Cos[a] - vy Cos[b] Sin[a] - vx Sin[b] Sin[a]);      vx = vy = vz = c/d;     Print["Minimize by defined function of integers = ",       Minimize[{f[a, b, c, d], 0 <= b < 2 Pi, 0 <= a < Pi}, {b, a},        Reals]];      I believe that the answer to this may also have a bearing on the use of `Solve` and simialr functions.


How to enable-dynamics on CDF's on web?

Went through the wizard to export cdf /w embed code: ![deployment](http://i.stack.imgur.com/lAr7d.png) The positions and sizing are correct, but there's no interactive side to it: ![bubblechart](http://i.stack.imgur.com/TTUKq.png) data I'm using:               {{"acerbic", 3, 5, 1.3*10^6}, {"acetic", 3, 7, 213000}, {"acetonic",        1, 4, 2000}, {"achromatic", 3, 6, 16000}, {"acidic", 3, 6,        500}, {"acoustic", 3, 7, 2000}, {"acrobatic", 3, 6,        3000}, {"acrostic", 4, 8, Null}, {"acrylic", 3, 5,        220000}, {"acyclic", 6, 8, 270000}, {"adiabatic", 6, 7,        40000}, {"aerobatic", 3, 6, 2000}, {"aerobic", 7, 4,        1.6*10^6}, {"aerodynamic", 7, 7, 160000}, {"aeronautic", 2, 2,        5000}, {"aesthetic", 5, 3, 500}, {"agnostic", 3, 5,        5000}, {"agoraphobic", 7, 3, 200000}, {"agronomic", 3, 5,        5000}, {"alcoholic", 2, 1, 1000}, {"alembic", 2, 1,        20000}, {"algebraic", 6, 3, 5000}, {"algorithmic", 5, 2,        2500.}, {"aliphatic", 7, 2, 13000}, {"allegoric", 5, 2,        1000}, {"allelic", 8, 5, 2400.}, {"allergenic", 8, 5,        48000}, {"allergic", 8, 3, 1000}, {"allotropic", 7, 6,        3000}, {"almanac", 6, 7, Null}, {"alphabetic", 7, 2,        Null}, {"alphanumeric", 6, 7, 1000}, {"altruistic", 4, 7,        7000}, {"amnesiac", 5, 6, 4000}, {"amnesic", 6, 5,        500}, {"amniotic", 4, 2, 500}, {"amoebic", 2, 1, 1000}, {"anabolic",        4, 7, Null}, {"anachronistic", 4, 7, 1500.}, {"anaerobic", 3, 5,        10000}, {"anagrammatic", 8, 10, Null}, {"analgesic", 3, 7,        60000}, {"analytic", 7, 7, 3000}, {"anamorphic", 2, 6,        3000}, {"anapestic", 3, 5, 90000}, {"anaphoric", 6, 4,        1000000}, {"anarchic", 7, 5, 12000000}, {"anarchistic", 4, 4,        50000}, {"anatomic", 2, 2, 30000}, {"androgenic", 2, 4,        60000}, {"anechoic", 3, 4, 50000}, {"anemic", 2, 1,        200000}, {"anesthetic", 2, 6, 40000}, {"angelic", 3, 6,        44000}, {"anharmonic", 4, 7, Null}, {"animistic", 3, 5,        100000}, {"anionic", 3, 7, 2.2*10^6}, {"anisotropic", 3, 6,        2.8*10^6}, {"anorectic", 6, 1, 60000}, {"anorexic", 5, 6,        4000}, {"antagonistic", 1, 5, 550000}, {"antarctic", 3, 4,        320000}, {"anthropic", 5, 5, 8000}, {"anthropocentric", 2, 5,        10000000}, {"anthropogenic", 1, 5, 12000000}, {"anthropometric", 3,        6, 103000}, {"anthropomorphic", "", "", Null}, {"antibiotic", "",        "", Null}, {"antic", "", "", Null}, {"anticlimactic", "", "",        Null}, {"anticyclonic", "", "", Null}, {"antidemocratic", "", "",        Null}}      And the code:               label = Tooltip[{##2},          Grid[{{"Name", #}, {"Usability ", #2}, {"Relevancy", #3}, \     {"Market Size", #4}}, Frame -> All, Alignment -> Left]] &;     BubbleChart[label @@@ data, ChartStyle -> 24];      this is the live url


What replaced ListWaveform?

My old _Mathematica_ code used `ListWaveform` to produce a sound file from a table of amplitudes and frequencies; this seems to no longer exist. What replaced it?


How to binarize a matrix

I have this matrix               A = {{17/25, 3/25, 5/25, 0, 0}, {5/18, 5/18, 7/18,1/18, 0}, {4/21, 9/21, 4/21, 0, 4/21},         {0, 0, 3/4, 1/4, 0}, {3/4,1/4, 0, 0, 0}}      And i would like to have this matrix binarize, i wanted it to be like this               {{1, 1, 1, 0, 0}, {1, 1, 1,1, 0}, {1, 1, 1, 0, 1}, {0, 0, 1, 1, 0}, {1, 1, 0, 0, 0}}      Is any function in mathematica that does that? Or I have to programmate it? If so can un help me please? Thanks (:


How to manipulate lists of parameters?

Suppose I have a function of a variable `f`, depending on some other parameters `a` and `b`, for example: `fun[f_,a_,b_] := Sin[a*f] + Cos[b*f]` I can plot and manipulate this function for some independent values of the parameters `a` and `b`: `Manipulate[Plot[fun[f,a,b], {f, 0, 10}], {a,0,5},{b,0,5}]` ![enter image description here](http://i.stack.imgur.com/YD0A2.png) Now, suppose I would like to give discrete values to these parameters, and change both at the same time. For example,I define two points: `A = Sequence[1,1];` and `B = Sequence[4,2];` I can do this plots: `Plot[fun[f,A], {f, 0, 10}]` or `Plot[fun[f,B], {f, 0, 10}]` but when I try to combine them, in order to include the possibility to manually choose between 'A' or 'B', `Manipulate[Plot[fun[f, X], {f, 0, 10}], {X, A, B}]` I obtain an empty plot... Instead, I would like to get a plot with two button, 'A' and 'B', corresponding to two different pairs of values for the parameters a and b. I tried to use `List[ ]` instead of `Sequence[ ]`, but it failed to work too! I also tried `Row[ ]`, adding some braces but nothing happened... :( What should I do? Where is the problem with my code? Thank you all in advance!


Finding first instance of a relationship between elements in two lists

Suppose I have two lists, say:               A = {1,5,10,200,50,7}     B = {4,3,19,78}      For each element in A, I would like to find the index of the first element in B which exceeds that element, (or 0 if none do) i.e. :               result = {1,3,3,0,4,3}      Clever syntax much appreciated!


NSolve for system of polynomial equations

I would like to find all the solutions to the following system of 8 polynomial equations for the variables `w1, w2, w3, w4, w5, w6, w7, w8`               eqs = {1/162 (-1 + 2^(1/3))^3 (-27 w1^3 - 27 w1^2 w3 + 54 w1 w2 w3 +          18 w1 w3^2 + w3^3 - 216 w1^2 w4 + 216 w1 w2 w4 -          72 w1 w3 w4 - 108 w1^2 w5 + 54 w1 w2 w5 - 72 w1 w3 w5 +          36 w2 w3 w5 - 3 w3^2 w5 - 144 w1 w4 w5 + 72 w2 w4 w5 -          24 w3 w4 w5 - 27 w1 w5^2 - 9 w3 w5^2 - 24 w4 w5^2 - 2 w5^3) - 1/2 w1 Log[2] == 0,             -(1/54) (-1 + 2^(1/3))^3 (27 w1^2 w2 - 18 w2^3 + 18 w1^2 w3 +          18 w1 w2 w3 - 36 w2^2 w3 + 12 w1 w3^2 - 9 w2 w3^2 + 2 w3^3 +          72 w1 w2 w4 - 72 w2^2 w4 + 24 w2 w3 w4 - 18 w1^2 w5 +          54 w1 w2 w5 - 18 w2^2 w5 + 18 w2 w3 w5 + 2 w3^2 w5 +          24 w2 w4 w5 - 12 w1 w5^2 + 15 w2 w5^2 - 2 w3 w5^2 - 2 w5^3) - 1/2 w2 Log[2] == 0,              1/54 (-1 + 2^(1/3))^3 (27 w1^2 w2 - 9 w1^2 w3 + 18 w1 w2 w3 +          18 w2^2 w3 - 9 w1 w3^2 + 33 w2 w3^2 + 5 w3^3 - 72 w1^2 w4 +          72 w1 w2 w4 - 144 w1 w3 w4 + 120 w2 w3 w4 - 40 w3^2 w4 -          63 w1^2 w5 + 36 w1 w2 w5 + 18 w2^2 w5 - 96 w1 w3 w5 +          48 w2 w3 w5 - 26 w3^2 w5 - 24 w2 w4 w5 - 32 w3 w4 w5 -          6 w1 w5^2 - 9 w2 w5^2 - 15 w3 w5^2 + 8 w4 w5^2 + w5^3 -          27 w1^2 w6 - 54 w1 w2 w6 + 54 w2^2 w6 - 54 w1 w3 w6 +          18 w2 w3 w6 - 15 w3^2 w6 + 72 w1 w4 w6 - 72 w2 w4 w6 +          24 w3 w4 w6 + 54 w1 w5 w6 - 54 w2 w5 w6 + 6 w3 w5 w6 +          24 w4 w5 w6 + 9 w5^2 w6 + 72 w1^2 w7 - 144 w1 w2 w7 +          72 w2^2 w7 + 48 w1 w3 w7 - 48 w2 w3 w7 + 8 w3^2 w7 +          48 w1 w5 w7 - 48 w2 w5 w7 + 16 w3 w5 w7 + 8 w5^2 w7) - 1/2 w3 Log[2] == 0,              1/108 (-1 + 2^(1/3))^3 (9 w1^2 w3 + 3 w1 w3^2 + w3^3 -          18 w1^2 w4 + 18 w2^2 w4 + 12 w1 w3 w4 + 24 w2 w3 w4 +          18 w3^2 w4 - 144 w1 w4^2 + 120 w2 w4^2 - 56 w3 w4^2 +          27 w1^2 w5 + 18 w1 w3 w5 + 6 w2 w3 w5 + 6 w3^2 w5 -          60 w1 w4 w5 + 36 w2 w4 w5 - 28 w3 w4 w5 - 32 w4^2 w5 -          6 w1 w5^2 + 6 w2 w5^2 - 3 w3 w5^2 - 14 w4 w5^2 - w5^3 +          6 w3^2 w6 - 24 w3 w4 w6 + 24 w4^2 w6 - 18 w1^2 w7 -          36 w1 w2 w7 + 36 w2^2 w7 - 60 w1 w3 w7 + 36 w2 w3 w7 -          18 w3^2 w7 + 96 w1 w4 w7 - 96 w2 w4 w7 + 32 w3 w4 w7 +          36 w1 w5 w7 - 36 w2 w5 w7 - 4 w3 w5 w7 + 32 w4 w5 w7 +          6 w5^2 w7 + 216 w1^2 w8 - 432 w1 w2 w8 + 216 w2^2 w8 +          144 w1 w3 w8 - 144 w2 w3 w8 + 24 w3^2 w8 + 144 w1 w5 w8 -          144 w2 w5 w8 + 48 w3 w5 w8 + 24 w5^2 w8) - 1/2 w4 Log[2] == 0,              1/54 (-1 + 2^(1/3))^3 (9 w1^2 w3 + 12 w1 w3^2 + 3 w2 w3^2 +          3 w3^3 + 72 w1^2 w4 + 72 w1 w3 w4 + 16 w3^2 w4 + 9 w1^2 w5 +          9 w1 w2 w5 + 33 w1 w3 w5 + 12 w2 w3 w5 + 16 w3^2 w5 -          84 w1 w4 w5 + 48 w2 w4 w5 - 32 w3 w4 w5 - 36 w1 w5^2 +          15 w2 w5^2 - 16 w3 w5^2 - 12 w4 w5^2 - 5 w5^3 - 27 w1^2 w6 +          54 w1 w2 w6 + 18 w1 w3 w6 + 18 w2 w3 w6 + 9 w3^2 w6 -          72 w1 w4 w6 - 24 w3 w4 w6 - 81 w1 w5 w6 + 27 w2 w5 w6 -          33 w3 w5 w6 + 12 w4 w5 w6 - 54 w1 w6^2 + 27 w2 w6^2 -          18 w3 w6^2 - 144 w1^2 w7 + 108 w1 w2 w7 - 120 w1 w3 w7 +          48 w2 w3 w7 - 24 w3^2 w7 + 12 w1 w5 w7 - 24 w2 w5 w7 +          4 w3 w5 w7 + 4 w5^2 w7 + 72 w1 w6 w7 - 36 w2 w6 w7 +          24 w3 w6 w7) - 1/2 w5 Log[2] == 0,             -(1/162) (-1 + 2^(1/3))^3 (-9 w1 w3^2 - 9 w2 w3^2 - 8 w3^3 -          72 w1 w3 w4 - 48 w3^2 w4 - 27 w1 w2 w5 - 9 w1 w3 w5 -          18 w2 w3 w5 - 18 w3^2 w5 + 36 w1 w4 w5 + 48 w3 w4 w5 +          54 w1 w5^2 - 27 w2 w5^2 + 39 w3 w5^2 - 12 w4 w5^2 - 2 w5^3 +          108 w1 w3 w6 - 108 w2 w3 w6 + 18 w3^2 w6 + 432 w1 w4 w6 -          216 w2 w4 w6 + 288 w3 w4 w6 + 243 w1 w5 w6 - 81 w2 w5 w6 +          207 w3 w5 w6 - 36 w4 w5 w6 - 27 w5^2 w6 + 81 w2 w6^2 +          54 w3 w6^2 - 216 w4 w6^2 - 162 w5 w6^2 - 54 w6^3 +          216 w1^2 w7 - 108 w1 w2 w7 + 360 w1 w3 w7 - 144 w2 w3 w7 +          120 w3^2 w7 - 108 w1 w5 w7 + 72 w2 w5 w7 - 36 w3 w5 w7 -          12 w5^2 w7 - 648 w1 w6 w7 + 324 w2 w6 w7 - 360 w3 w6 w7 +          216 w6^2 w7) - 1/2 w6 Log[2] == 0,               1/108 (-1 + 2^(1/3))^3 (w3^3 + 12 w1 w3 w4 + 12 w2 w3 w4 +          8 w3^2 w4 + 96 w1 w4^2 + 64 w3 w4^2 + 15 w1 w3 w5 +          9 w3^2 w5 + 84 w1 w4 w5 + 12 w2 w4 w5 + 68 w3 w4 w5 -          32 w4^2 w5 + 30 w1 w5^2 + 6 w2 w5^2 + 29 w3 w5^2 -          40 w4 w5^2 - 14 w5^3 + 27 w1^2 w6 + 54 w1 w3 w6 +          15 w3^2 w6 + 36 w1 w4 w6 + 36 w2 w4 w6 + 36 w3 w4 w6 -          96 w4^2 w6 + 63 w1 w5 w6 + 18 w2 w5 w6 + 63 w3 w5 w6 -          144 w4 w5 w6 - 60 w5^2 w6 + 27 w1 w6^2 + 45 w3 w6^2 -          72 w4 w6^2 - 81 w5 w6^2 - 54 w6^3 + 90 w1^2 w7 +          36 w1 w2 w7 + 144 w1 w3 w7 + 36 w2 w3 w7 + 58 w3^2 w7 -          480 w1 w4 w7 + 192 w2 w4 w7 - 256 w3 w4 w7 - 336 w1 w5 w7 +          120 w2 w5 w7 - 196 w3 w5 w7 + 32 w4 w5 w7 + 14 w5^2 w7 -          396 w1 w6 w7 + 72 w2 w6 w7 - 252 w3 w6 w7 + 288 w4 w6 w7 +          204 w5 w6 w7 + 180 w6^2 w7 + 336 w1 w7^2 - 168 w2 w7^2 +          168 w3 w7^2 - 168 w6 w7^2 - 648 w1^2 w8 + 432 w1 w2 w8 -          720 w1 w3 w8 + 288 w2 w3 w8 - 192 w3^2 w8 + 144 w1 w5 w8 -          144 w2 w5 w8 + 48 w3 w5 w8 + 24 w5^2 w8 + 864 w1 w6 w8 -          432 w2 w6 w8 + 432 w3 w6 w8 - 216 w6^2 w8) - 1/2 w7 Log[2] == 0,              1/324 (-1 + 2^(1/3))^3 (3 w3^2 w4 + 9 w2 w4^2 + 3 w3 w4^2 +          52 w4^3 + 12 w3 w4 w5 + 48 w4^2 w5 + 6 w3 w5^2 + 30 w4 w5^2 +          8 w5^3 + 54 w1 w4 w6 + 18 w3 w4 w6 - 9 w4^2 w6 +          27 w1 w5 w6 + 9 w3 w5 w6 + 18 w4 w5 w6 + 27 w5^2 w6 +          27 w4 w6^2 + 54 w5 w6^2 + 27 w6^3 + 36 w1 w3 w7 +          12 w3^2 w7 + 180 w1 w4 w7 + 36 w2 w4 w7 + 132 w3 w4 w7 -          204 w4^2 w7 + 144 w1 w5 w7 + 18 w2 w5 w7 + 108 w3 w5 w7 -          228 w4 w5 w7 - 108 w5^2 w7 + 108 w1 w6 w7 + 108 w3 w6 w7 -          216 w4 w6 w7 - 252 w5 w6 w7 - 216 w6^2 w7 - 468 w1 w7^2 +          108 w2 w7^2 - 276 w3 w7^2 + 264 w4 w7^2 + 180 w5 w7^2 +          360 w6 w7^2 - 112 w7^3 + 324 w1^2 w8 + 432 w1 w3 w8 +          144 w3^2 w8 - 1296 w1 w4 w8 + 648 w2 w4 w8 - 648 w3 w4 w8 -          648 w1 w5 w8 + 216 w2 w5 w8 - 360 w3 w5 w8 + 36 w5^2 w8 -          648 w1 w6 w8 - 432 w3 w6 w8 + 648 w4 w6 w8 + 432 w5 w6 w8 +          324 w6^2 w8 + 1728 w1 w7 w8 - 864 w2 w7 w8 + 864 w3 w7 w8 -          864 w6 w7 w8) - 1/2 w8 Log[2] == 0}      I tried               NSolve[ eqs, {w1, w2, w3, w4, w5, w6, w7, w8}, Reals]      because I am interested only in real solutions for `w1, ..., w8` but it takes a very long time without producing an output. Do you have any suggestions to overcome this problem?


Parallel computing NInverseFourierTransForm

I am running the code below, and it works perfectly. I have some function in Fourier space, and I take the numerical `InverseFourierTransform`. However, I will have to repeat this calculation often, and therefore I want to use `ParallelTable`. I've tried this, by replacing `Table` in the code below by `ParallelTable`. I am running the code on a computer with 8 kernels. Surprisingly, using `ParallelTable` doesn't speed up the calculation. I simply find almost the same computation time (not roughly a factor 8 difference)! Can anybody explain to me what the reason for this is? I've tested the `ParallelTable` with commands like                 ParallelTable[Pause[1]; f[i], {i, 4}] // AbsoluteTiming      and for this case it works fine, but not for the `NInverseFourierTransform`.               ClearAll["Global`*"];     f[q_] := Sqrt[2/Pi]*(-Sinc[q] + Cos[q]);     k[q_] := Sqrt[Pi/2]/Abs[q];     a = 10^-2;     b = 10^-2;     Needs["FourierSeries`"]     hfourierdomain[ω_] = a*f[ω]*k[ω]/(1 + b*ω^2*k[ω]);     displ = Table[{j, NInverseFourierTransform[hfourierdomain[ω], ω, j]}, {j, -5, 5, 1/60}];


Discriminant of Characteristic Polynomial

I'm doing a calculation which finds the characteristic polynomial of a matrix with rather complex entries and then determines the discriminant of that polynomial. For smaller matrices up to around 7x7 it finishes evaluating the Discriminant command within a few hours, but at a 10x10, which is what I need, it takes days to evaluate. Running in parallel won't work for the built in Discriminant command. I was wondering if there was a more efficient way to evaluate the discriminant of high-order polynomial, as I know my code is basic.                   CPHH = Collect[CharacteristicPolynomial[HH, x],x]];         DD = Discriminant[CPHH, x, Method -> SylvesterMatrix];         Simplify[DD, TimeConstraint -> Infinity]      If the rest of the code would be useful in determining a solution I'd be happy to post it


computation of gradient vector field in 3D using GradientOrientationFilter

I want to compute a 3D gradient vector field of an `Image3D` object using the built-in GradientOrientationFilter function in _Mathematica_. From the documentation I extracted the example for computing the gradient vector field for the 2D case and put it into a module:               computeGradientField2D[image_Image] := Module[        {dims, dirs, magnitudes},             dims = ImageDimensions[image];        dirs = ImageData[GradientOrientationFilter[image, 5]];        magnitudes = ImageData[GradientFilter[image, 5]];         MapThread[#1 {-Sin[#2], Cos[#2]} &, {magnitudes, dirs}, 2]        ];      For drawing the vectors I also use the method from the documenation:               Show[ImageAdjust@img,       ListVectorPlot[       MapIndexed[{{#2[[2]], dims[[2]] - #2[[1]]}, #1} &, or, {2}],        VectorColorFunction -> (Yellow &), VectorPoints -> Fine],       ImageSize -> 256]      This gives me the following output for a grayscale image of cell nuclei (left: raw image, right: raw image with overlayed vector field): > ![enter image description here](http://i.stack.imgur.com/CU22p.png) ![enter > image description here](http://i.stack.imgur.com/uEdW6.png) So far so good. Now I am struggeling with the computation of the gradient vector field for `Image3D` objects. My current function looks like the following:               computeGradientField3D[image_Image3D] := Module[        {img, dims, dirs, magnitudes},        dims = ImageDimensions[image];        dirs = ImageData[GradientOrientationFilter[image, 5]];        magnitudes = ImageData[GradientFilter[image, 5]];         MapThread[#1 {Cos[#2[[1]]], Sin[#2[[1]]] Cos[#2[[2]]],             Sin[#2[[1]]] Sin[#2[[2]]]} &, {magnitudes, dirs}, 3]        ];      I am particularly not sure about the last line with the `MapThread` where the orientations of the vectors are created and multiplied with the magnitudes. The documentation of `GradientOrientationFilter` contains the following information about how to interprete the orientation angles: > ![enter image description here](http://i.stack.imgur.com/ZB9EV.png) **Questions:** **1\. Am I misinterpreting the documentation?** **2\. How do I visualize the gradient vector field in the end ( _e.g._ using `ListVectorPlot3D`)?**


When event and "stop integration"

I am using NDSolve, to solve for an equation. At some point, I want it to stop integrating and keep a constant value for the solution from the point it stopped changing. I tried setting the derivative of the solution to 0 (using whenevent), but it won't let me. So I tried using "stop integration" in the "when event", which basically makes the curve diverge. UNLESS I set the value of a function to the function itself (f[x]->f[x]) which for some reason makes IT STAY constant. But, from that point on, none of the conditions I set for whenevent are ever met again (I would like that the integration continues after uf[t]>uc[t]. Can someone explain to me what is going on? How could I resolve this problem?, Is there a better way to do that?               uf[t_] := U/\[Pi] + U/2 Sin[t] - (2*U)/\[Pi] Sum[1/((2 n - 1) (2 n + 1))*Cos[2 n*t],{n, 50}];          a = Last[         NDSolve[{uf[t] == R c uc'[t] + uc[t], uc[0] == 0,                  WhenEvent[uf[t] - uc[t] < 0 && t != 0, {"StopIntegration", uc[t] -> uc[t]}],                  WhenEvent[uf[t] - uc[t] > 0, "RestartIntegration"]}, uc, {t, 0, 10}]          //. Rule -> List // Flatten];


Dynamically apply a function fed by Input[]

Here is a bit of code:               funlist = {Plot,ListPlot};     Input[Panel[PopupMenu[Dynamic@whichfun, funlist], "blabla"],Dynamic@whichfun]      The idea here is to select what function you want to use (`Plot` or `ListPlot` in that case) and to give the expression you want to be evaluated by this function (for example `x,{x,0,1}` for `Plot`). I have been struggling with this code for a few hours so if anyone has an idea. I am aware that something like:               PopupMenu[Dynamic@whichfun, funlist]     InputField[Dynamic[expr], String, ContinuousAction -> True]     Dynamic@(whichfun @@ (ToExpression@expr))      with `InputField` fed by `{x, {x, 0, 1}}` would work.


Operations on expressions within Hold

I want to convert `{Hold[1 + 2], Hold[3 + 4], Hold[5*6]}` into `Hold[{1 + 2, 3 + 4, 5*6}]`. I have tried               {Hold[1 + 2], Hold[3 + 4],  Hold[5*6]} /. {Hold[a_], Hold[b_], Hold[c_]} -> Hold[{a, b, c}]      > >     Hold[{1 + 2, 3 + 4, 5 6}] >   Is there a simpler way?


Problem With NDsolve trying to simulate n-body-gravity problem

Im Trying to model a cloud of point masses that act according to gravity, what im strugeling with is the exclusion of cases where euclidian distance = 0, If I try to do it with an If statement in my forces function, NDsolve complains about too many dependant variables I think, but I think its rather a fault in my usage/understanding of NDsolve Any help is appreciated edit: im aware that the equations arent yet in working order               n = 20;     g = 1;     pos = RandomReal[{-10, 10}, {n, 3}];     masses = RandomReal[{1, 50}, n];     Tmax = 20;          Forces[xp_, yp_, zp_] :=       Sum[       masses[[i]]/        EuclideanDistance[{xp, yp, zp}, {x[i][t], y[i][t], z[i][t]}]^2       , {i, 1, n}]          Graphics3D[      Table[       Sphere[pos[[i]], ((masses[[i]]*4)/(3*Pi))^(1/3)/5]       , {i, 1, n}]      , PlotRange -> 11.5]          sol = NDSolve[       Flatten@Table[         {          (x[i])''[t] == Forces[x[i][t], y[i][t], z[i][t]][[1]]/masses[[i]],          (y[i])''[t] == Forces[x[i][t], y[i][t], z[i][t]][[2]]/masses[[i]],          (z[i])''[t] == Forces[x[i][t], y[i][t], z[i][t]][[3]]/masses[[i]],          (x[i])'[0] == 0,          (y[i])'[0] == 0,          (z[i])'[0] == 0,          x[i][0] == pos[[i, 1]],          y[i][0] == pos[[i, 2]],          z[i][0] == pos[[i, 3]]          }         , {i, 1, n}]       ,       Flatten@Table[         {          x[i][t], y[i][t], z[i][t]          }         , {i, 1, n}]       , {t, 0, Tmax}]


What is the order of faces on a D20? How can I optimize the order of faces on a D-n?

I am creating a customizable D20 for 3D printing using OpenSCAD, with the following code:               factor=5;     $fn=10;     PHI=(1+sqrt(5))/2;     //Taken from: http://en.wikipedia.org/wiki/Icosahedron#Cartesian_coordinates     //Specifically: http://en.wikipedia.org/w/index.php?title=Icosahedron&oldid=568753314#Cartesian_coordinates     POINTS =    [   [0,-1,-PHI] , [0,-1,+PHI] , [0,+1,-PHI] , [0,+1,+PHI] ,                     [-1,-PHI,0] , [-1,+PHI,0] , [+1,-PHI,0] , [+1,+PHI,0] ,                          [-PHI,0,-1] , [+PHI,0,-1] , [-PHI,0,+1] , [+PHI,0,+1]                  ]*factor;          FACES =[    [1,3,11],[1,11,6], [1,6,4], [1,4,10],[1,10,3],                  [3,5,7], [3,7,11], [3,5,10],[11,6,9],[11,7,9],                 [0,6,9], [0,6,4],  [0,8,4], [10,8,4],[10,8,5],                 [2,8,5], [0,2,9],  [0,2,8], [7,2,9], [5,2,7]];          function normal(n) =     //Calculates the position of the center of the nth face (also called the normal vector of the face)         POINTS[FACES[n][0]]/3 +         POINTS[FACES[n][1]]/3 +         POINTS[FACES[n][2]]/3 ;          //spheres at each vertex     hull(){         for(i=[1:12]){             translate(POINTS[i-1]) sphere(.0001);             }         }      An icosahedron has 12 vertices given by POINTS, and the faces (triangles) are formed by the triplets in FACES where each number i is the i-th element in the list POINTS. OpenSCAD uses the C convention where the first element is 0, not 1. Typical dice are numbered so that for an N-sided die, the number on a given side, and the number on an opposite side add up to N+1. How can I tell Mathematica to find the order of faces so that "ONE" should be placed at the face given by FACES[[1]], and all the other numbers should have the N+1 property above. For a given solid that would work as a die, is there another condition I have to apply? e.g. is it necessary or optimal to enforce or check that the sum of numbers around a given vertex (or edge?) is not more than a certain amount than the sum from another vertex or edge? From this picture (https://en.wikipedia.org/wiki/Dice#mediaviewer/File:6sided_dice.jpg) it seems that on a normal D6 that there is a vertex that is adjacent to 4,5,6 and therefore the opposite vertex is adjacent to 1,2,3. Here are the data in Mathematica format:               PHI=(1+Sqrt[5])/2;     POINTS = { {0,-1,-PHI} , {0,-1,+PHI} , {0,+1,-PHI} , {0,+1,+PHI} ,{-1,-PHI,0} , {-1,+PHI,0} , {+1,-PHI,0} , {+1,+PHI,0} , {-PHI,0,-1} , {+PHI,0,-1} , {-PHI,0,+1} , {+PHI,0,+1} };     FACES ={ {1,3,11},{1,11,6}, {1,6,4}, {1,4,10},{1,10,3}, {3,5,7}, {3,7,11}, {3,5,10},{11,6,9},{11,7,9}, {0,6,9}, {0,6,4}, {0,8,4}, {10,8,4},{10,8,5}, {2,8,5}, {0,2,9}, {0,2,8}, {7,2,9}, {5,2,7}};


Mathematica gives wrong result while Wolfram|Alpha is correct

![Mathematica and Wolfram|Alpha output](http://i.stack.imgur.com/nIJ08.png) Why does _Mathematica_ and _Wolfram|Alpha_ give different results based upon the same code? I know _Wolfram|Alpha_ 's `7.85` is correct.


How to create a list of pre-defined functions?

I would like to create a list of Cauchy distribution pdf's, having different locations of their maxima, and being multiplied by different factors; then I'd like to calculate those functions' values for different values of `x`. I have searched on the Internet and tried various things, and I seem to be able to set up the list, but then I fail miserably when it comes to actually using the functions on arguments. Here's some code:               pos     = RandomReal[10,2]     factors = RandomInteger[{1,5},{2}]          gamma1 = 0.5          peaks = Table[factors[[i]]*PDF[CauchyDistribution[pos[[i]],gamma1],x], {i,1,2}]     Print[ peaks ]     Print[ peaks[0.1][[1]] ]      This gives me               SetDelayed::noval: Symbol peaks in part assignment does not have an immediate value.          SetDelayed::noval: Symbol peaks in part assignment does not have an immediate value.     {3.183098861837907/(1 + 4.*(-6.1318667717670134 + x)^2), 0.6366197723675814/(1 + 4.*(-1.3741656250222944 + x)^2)}     0.1      How can I use each element of my array `peaks` like an individual function? (I'm an absolute Mathematica-beginner, so in advance: sorry for the noob- question...)


Automatizing PSfrag export

I'm in the early phase of creating a Mathematica function (or package) that exports graphics such that they can be used with $\LaTeX$'s PSfrag. ## The goal Ideally, the function should take a graphic created in Mathematica, replace all text elements with labels and export the labeled graphic along with a text file containg the corresponding `\psfrag` commands. It should be possible to do all the layouting in Mathematica, preserving as much of the style, font size/weight/color and positioning of the text in the graphic. The only things that should be affected are the font family (so that everything appears in $\LaTeX$ font) and the typesetting of mathematical expressions. * * * ## Problem 1: Placing text in EPS Consider a plot that somewhere has the number 10000 as a tick (or frame tick). If you export this plot to EPS, and then import it again, the resulting Mathematica `Graphics` object features two text elements `10` and `000`. This makes replacing single numbers with PSfrag quite a lot harder than one would think. Is there a way to force Mathematica to insert `10 000` as a single text element? * * * ## Problem 2: Extracting frame ticks As a first try, I tried extracting all `Ticks` or `FrameTicks`from a graphic using `AbsoluteOptions`. This works nicely for many cases, but I encountered some strange behavior. Consider the two plots               frPlot1 = Plot[x^2, {x, 0, 1000}, Frame -> True, FrameTicks -> True];     frPlot2 = Plot[x^2, {x, 0, 1000}, Frame -> True, FrameTicks -> All];      Their output looks just as one would expect from reading the documentation of `FrameTicks`:               True    tick marks placed automatically on bottom and left edges     All     tick marks placed automatically on all edges      Determining the ticks for `frPlot1` using `AbsoluteOptions[frPlot1, FrameTicks]` works just fine. But trying the same with `frPlot2` results in an error:               Ticks::ticks: All is not a valid tick specification.      How can `All`not be a valid specification when the documentation states that it is? * * * ## Future Problems Depending on the answers to the two questions above, there will probably arise some new questions. I will keep this post updated. I can also post the code of my first try with automatizing the tick extraction, if that is wanted.


How to further process a 2 dimensional list created with tuples

I created with `Tuples[{{USD, EUR, JPY}, {UP, DOWN}}]` the following result: `{{USD, UP}, {USD, DOWN}, {EUR, UP}, {EUR, DOWN}, {JPY, UP}, {JPY, DOWN}}` I want to further have a 3 dimensional list of all combinations - but the same currency does not appear twice. Example output `{{{USD, UP}, {EUR, UP}, {JPY, UP}}, {{USD, UP}, {EUR, UP}, {JPY, DOWN}}, {{USD, UP}, {EUR, DOWN}, {JPY, UP}}, {{USD, UP}, {EUR, DOWN}, {JPY, DOWN}}, ... {{USD, DOWN}, {EUR, DOWN}, {JPY, DOWN}}}` Is there a simple way to do it?


High Contrast Syntax-Highlighting

I have a neurological disorder which causes me to have migraines if I look at a white computer screen. To combat this, I have put the following at the top of all of my Mathematica notebooks:               SetOptions[EvaluationNotebook[],     Background -> RGBColor[0.0, 0.0, 0.0],     FontColor -> RGBColor[1.0, 1.0, 1.0],     FontSize -> 16     ]      This turns the background black and the letters white. However, Mathematica's built-in Syntax highlighting does not change. In order to read the Syntax Highlighing I have to manually go into: In Edit -> Preferences -> Syntax Coloring -> Other:   * Comments -> Megenta   * Strings -> Light Yellow   * Global -> Bright Blue In Edit -> Preferences -> Syntax Coloring -> Local Variables;   * The local variables of Module With -> Bright Green;   * Function arguments and patter names -> Bright Green;   * Variables made special by use in arguments -> Sky Blue; The above commands permanently change the syntax highlighting. If possible, I would like to be able make the above changes in the Mathematica Notebook so that the changes only affect the notebook I am working in. So, my question is... QUESTION: Rather than do the above steps manually, is there a command I can put at the top of the file that will make these changes for me?


How do I determine astronomical transit times?

_Mathematica_ , through the "legacy" _Scientific Astronomer_ package, used to have the ability to easily determine accurate transit times of astronomical objects simply, with `Culmination[object, neardate]`; but now lacks this feature. Is there a way to use `AstronomicalData` to do this?


How to see abstract syntax tree of Wolfram Language expression

I mean, suppose I have this expression: 2 + 2 I want to get something like this: Plus[2, 2] as an output. I've tried FullForm, but this just evaluates 2+2 and returns 4. Is this even possible?


No Tukey Test on ANOVA package

I'm trying to use the ANOVA package and have mathematica display the Tukey PostTest, but all I get is this:               ANOVA[Tratamientos, PostTests -> Tukey]          ANOVA::nottest: Tukey is not a valid PostTests entry, and will be ignored. Valid PostTests entries are Bonferroni, Tukey, StudentNewmanKeuls, Duncan, and Dunnett. >>      Any advice? Am I missing something? Thanks in advance


Selecting a Point that has the Lowest Absolute x/y-coordinate From a List of Points

Given that there is a set of points, for example, `{{3,4,2},{5,2,-1}}`. How do I go about selecting the point that has the lowest absolute x, y or z-coordinate from the list? In this case, the point selected should be `{{5,2,-1}}` as 1 is the lowest absolute value among all the points. Would the command `Select[{{3,4,2}, {5,2,-1}}, ...]` be good enough to perform such operation? Specifically, my understanding is that `Select[{{3,4,2}, {5,2,-1}}, ...]` is useful for selecting each individual point that satisfies certain condition stated in the command, so the question is whether it would be possible to compare 2 different points to select the desired point under the `Select[...]` operation. Or would there be a better alternative to getting the desired point?


Density plot for data with a wide dynamic range

I'm generating some figures for a paper. One of them has a pattern like the following figure:               DensityPlot[      Abs[Exp[-Sqrt[x^2 + y^2]/5] BesselJ[0, Sqrt[x^2 + y^2]]], {x, -20,        20}, {y, -20, 20}, ColorFunction -> "SunsetColors",       PlotPoints -> 100, PlotRange -> All, PlotRangePadding -> 0,       FrameTicksStyle ->        Directive[FontFamily -> "Arial", 12, Plain, Thick],       ImageSize -> {Automatic, 150}]      ![modulated Bessel beam](http://i.stack.imgur.com/OAawn.png) Since the magnitude in the middle could be much higher than that in the outer region, some rings cannot be seen if I print it. In addition, since the pattern represents magnitude, I prefer a kind of "hot" color map to render these data. How can I solve the problem such that the pattern can be seen clearly on a printed copy?


Computing the bounding boxes for Text objects

Regardless of `AspectRatio`, the `Text` boxes overlap.               TreeForm[#, AspectRatio -> 1/3, ImageSize -> 700]& @      Cases[        Import["http://www.weather.gov/data/current_obs/KOAK.xml", "XMLObject"],        XMLElement[tag:_, _, value:_] :> (tag -> value), Infinity     ]      ![Mathematica graphics](http://i.stack.imgur.com/mmbNF.png) More generally, I've asked Wolfram Research, Inc. about exposing bounding box coordinates for `Text` objects so that layout manager or engine can test overlap or compute tilings or disjoint positioning, but it appears to be complicated by the various `Text` options. Does anyone know how to at least conservatively approximate the `Text` bounding box?


Why doesn't Cases match all instances of XMLElement, given Infinity levelspec?

Why doesn't `Cases` match all instances of `XMLElement`, given `Infinity` levelspec?               Column@ Cases[     Import["http://www.weather.gov/data/current_obs/KOAK.xml","XMLObject"],     XMLElement[tag:_,_,value:_]:> (tag-> value),Infinity     ]           (* ==>     credit->{NOAA's National Weather Service}     credit_URL->{http://weather.gov/}     url->{http://weather.gov/images/xml_logo.gif}     title->{NOAA's National Weather Service}     link->{http://weather.gov}     image->{XMLElement[url,{},{http://weather.gov/images/xml_logo.gif}],XMLElement[title,{},{NOAA's National Weather Service}],XMLElement[link,{},{http://weather.gov}]}     suggested_pickup->{15 minutes after the hour}     suggested_pickup_period->{60}     location->{Oakland, CA}     station_id->{KOAK}     latitude->{37.7}     longitude->{-122.22}     observation_time->{Last Updated on Apr 11 2012, 12:53 pm PDT}     observation_time_rfc822->{Wed, 11 Apr 2012 12:53:00 -0700}     weather->{Mostly Cloudy}     temperature_string->{60.0 F (15.6 C)}     temp_f->{60.0}     temp_c->{15.6}     relative_humidity->{62}     wind_string->{Southwest at 13.8 MPH (12 KT)}     wind_dir->{Southwest}     wind_degrees->{220}     wind_mph->{13.8}     wind_gust_mph->{0.0}     wind_kt->{12}     wind_gust_kt->{0}     pressure_string->{1014.2 mb}     pressure_mb->{1014.2}     pressure_in->{29.95}     dewpoint_string->{46.9 F (8.3 C)}     dewpoint_f->{46.9}     dewpoint_c->{8.3}     windchill_string->{58 F (14 C)}     windchill_f->{58}     windchill_c->{14}     visibility_mi->{10.00}     icon_url_base->{http://weather.gov/images/fcicons/}     two_day_history_url->{http://www.weather.gov/data/obhistory/KOAK.html}     icon_url_name->{bkn.jpg}     ob_url->{http://www.weather.gov/data/METAR/KOAK.1.txt}     disclaimer_url->{http://weather.gov/disclaimer.html}     copyright_url->{http://weather.gov/disclaimer.html}     privacy_policy_url->{http://weather.gov/notice.html}     current_observation->{XMLElement[credit,{},{NOAA's National Weather Service}],XMLElement[credit_URL,{},{http://weather.gov/}],XMLElement[image,{},{XMLElement[url,{},{http://weather.gov/images/xml_logo.gif}],XMLElement[title,{},{NOAA's National Weather Service}],XMLElement[link,{},{http://weather.gov}]}],XMLElement[suggested_pickup,{},{15 minutes after the hour}],XMLElement[suggested_pickup_period,{},{60}],XMLElement[location,{},{Oakland, CA}],XMLElement[station_id,{},{KOAK}],XMLElement[latitude,{},{37.7}],XMLElement[longitude,{},{-122.22}],XMLElement[observation_time,{},{Last Updated on Apr 11 2012, 12:53 pm PDT}],XMLElement[observation_time_rfc822,{},{Wed, 11 Apr 2012 12:53:00 -0700}],XMLElement[weather,{},{Mostly Cloudy}],XMLElement[temperature_string,{},{60.0 F (15.6 C)}],XMLElement[temp_f,{},{60.0}],XMLElement[temp_c,{},{15.6}],XMLElement[relative_humidity,{},{62}],XMLElement[wind_string,{},{Southwest at 13.8 MPH (12 KT)}],XMLElement[wind_dir,{},{Southwest}],XMLElement[wind_degrees,{},{220}],XMLElement[wind_mph,{},{13.8}],XMLElement[wind_gust_mph,{},{0.0}],XMLElement[wind_kt,{},{12}],XMLElement[wind_gust_kt,{},{0}],XMLElement[pressure_string,{},{1014.2 mb}],XMLElement[pressure_mb,{},{1014.2}],XMLElement[pressure_in,{},{29.95}],XMLElement[dewpoint_string,{},{46.9 F (8.3 C)}],XMLElement[dewpoint_f,{},{46.9}],XMLElement[dewpoint_c,{},{8.3}],XMLElement[windchill_string,{},{58 F (14 C)}],XMLElement[windchill_f,{},{58}],XMLElement[windchill_c,{},{14}],XMLElement[visibility_mi,{},{10.00}],XMLElement[icon_url_base,{},{http://weather.gov/images/fcicons/}],XMLElement[two_day_history_url,{},{http://www.weather.gov/data/obhistory/KOAK.html}],XMLElement[icon_url_name,{},{bkn.jpg}],XMLElement[ob_url,{},{http://www.weather.gov/data/METAR/KOAK.1.txt}],XMLElement[disclaimer_url,{},{http://weather.gov/disclaimer.html}],XMLElement[copyright_url,{},{http://weather.gov/disclaimer.html}],XMLElement[privacy_policy_url,{},{http://weather.gov/notice.html}]}     *)


PieChart with radial coloring/color function

I am trying to visually compare multiple functions that depend on a single argument running from $0$ to $1$. They describe a radial property and so I thought it would be nice to use a kind of `PieChart` plot where the function values are used as a color function to fill the pie. The best I could come up with is the following:                SectorPlot[func_List, label_List, colorrange_: {0, 66.7},        opts : OptionsPattern[]] /; Length[func] == Length[label] :=       Module[{div, len, sectors, size, wedge, colorbar},      len = Length[func];      sectors = makesectors[len];      size = 300;      colorbar[colorFunction_: Automatic, range_: colorrange, divs_: 25] :=      DensityPlot[y, {x, 0, .1}, {y, First@range, Last@range},      (* Remove possible PlotRange specification from the options,       which would mess up the bar*)      Evaluate[      FilterRules[{opts},        Cases[Options[DensityPlot], Except[PlotRange -> _]]]],      AspectRatio -> 10,      PlotRangePadding -> 0,      PlotPoints -> {2, divs},      MaxRecursion -> 0,      FrameTicks -> {None, Automatic, None, None},      ColorFunctionScaling -> False,      ColorFunction -> colorFunction];      (* now the pie function*)      wedge[fun_, {minangle_, maxangle_}, lab_] := Show[{      ParametricPlot[{v Cos[u], v Sin[u]}, {u, minangle, maxangle}, {v,         0, 1},       Evaluate[FilterRules[{opts}, Options[ParametricPlot]]],        ColorFunction -> (ColorData[{"Rainbow", colorrange}][fun[#4]] &),       ColorFunctionScaling -> False,       Mesh -> False,       ImagePadding -> All,       BoundaryStyle -> Directive[Thick, Black],       Frame -> False,       Axes -> False,       PlotRange -> {-1.2, 1.2},       Background -> Transparent],       Graphics@Text[        Style[lab, Bold, FontFamily -> "Times"], {         1.1 Cos[Mean[{minangle, maxangle}]],         1.1 Sin[Mean[{minangle, maxangle}]]},        {         -Cos[Mean[{minangle, maxangle}]],         -Sin[Mean[{minangle, maxangle}]]}        ]}];      Row[{      Show[Table[       wedge[func[[i]], sectors[[i]], label[[i]]], {i, 1, len}],      ImageSize -> {Automatic, size},       ImagePadding -> 20],       Show[colorbar[ColorData[{"Rainbow", colorrange}], colorrange],       ImageSize -> {Automatic, size},       ImagePadding -> 20]}]]      I used the answers to this post to set up the colorbar in a `Row`. Here is an example.               SectorPlot[{       (60 Sin[4.3 # + 0.3]) &,       (50 Sin[12 # + 0.1]) &,       (66 Cos[7.3 # + 0.3]) &,       (60 Tan[1.2 #]) &,       (60 Cos[23.5 # - 0.1]) &},       {"1", "2", "3", "4", "5"}, {0, 70},       BoundaryStyle -> Directive[Thick, Darker@Gray],        PlotRange -> {-1.2, 1.2}]      ![output](http://i.stack.imgur.com/9n1fL.png) Everything looks OK, but it looks like a lot of effort given the fact that we have very powerful `PieChart` functionalities. Imagine I have to provide longer labels:                SectorPlot[{       (60 Sin[4.3 # + 0.3]) &,       (50 Sin[12 # + 0.1]) &,       (66 Cos[7.3 # + 0.3]) &,       (60 Tan[1.2 #]) &,       (60 Cos[23.5 # - 0.1]) &},      {"12345678901234567890", "12345678901234567890",        "12345678901234567890", "12345678901234567890",        "12345678901234567890"}, {0, 70},      BoundaryStyle -> Directive[Thick, Darker@Gray], PlotRange -> {-2, 2}]      ![output](http://i.stack.imgur.com/3FxzL.png) Note the rescaled pie chart. I am sure I could pimp my function a lot more to handle this automatically, all suggestions are welcome. But my main question would be: Is there an easier way that uses the built-in `SectorChart`, `PieChart`, etc. commands together with a radial color function? (of course I still need the colorbar.)


How to match a sequence of complex patterns?

I have list with the form `{{a1,b1}->{x1,y1},{a2,b2}->{x1,y2},...}` where the `{ai,bi}`'s can be `{}`. I know the elements of the list can be matched by `{___} -> {_, _}`, but I don't know how to match a list of this form. So how can I match it? **UPDATE** : I meant a pattern test: To test whether a list is in this form


Only final result from NDSolve

Finally I started to play with differential equations in _Mathematica_. And I have faced the problem, which seems too me so basic that I'm afraid this question is going to be closed soon. However, I've failed in finding solution here or in documentation center. **My question is: how to set that`NDSolve` will not save whole `InterpolationFunction` for the result?** I'm only interested in final coordinates or for example each 100th. Is there simple way to achieve that? * * * Anticipating questions:   * I know I can do something like `r /@ Range[0.1, 1, .1] /. sol` at the end, but still, there is whole interpolating function in memory. I want to avoid it because my final goal is to do N-Body simulation where N is huge and I will run out of the memory quite fast. What is important to me is only the set of coordinates as far in the future as it can be, not intermediate values.   * I can write something using `Do` or `Nest` but I want to avoid it since `NDSolve` allows us to implement different solving methods in handy way.   * I saw WolframDemonstrations/CollidingGalaxies and it seems there is an explicit code with `Do` :-/   * Another idea would be to put `NDSolve` into the loop but this seems to be not efficient. Could it be even compilable? * * * Just in case someone want to show something here is the sample of code to play with:               G = 4 Pi^2 // N ;          sol = NDSolve[{                    r''[t] == -G r[t]/Norm[r[t]]^3,                    r[0] == {1, 0, 0},                    r'[0] == {0, 2 Pi // N, 0}                   },                   r,                   {t, 0, 1}, Method -> "ExplicitRungeKutta", MaxStepSize -> (1/365 // N)                  ]           ParametricPlot3D[Evaluate[r[t] /. sol], {t, 0, 1}]            (* Earth orbiting the Sun. Units: Year/AstronomicalUnit/SunMass           in order to express it simply*)


Does OpenCL/Cuda memory leak if not Unloaded? Problem with allocating/loading GPU memory in Module

The GPU memory manager documentation is not too clear, does GPU memory leak if not explicitly unloaded or if the symbol that holds the reference to the GPU memory gets collected, the GPU memory gets freed too? In my experience, MemoryInUse doesn't grow if I keep loading GPU memory (but losing the symbols, e.g., the memory is in temporary variables), but MathKernel.exe memory usage does! My problem in this matter is that I have to allocate GPU memory in Module[] temporary variables, so I don't have (well know) any way of unloading it manually afterwards... Is there a way to add a "destructor" to Mathematica symbols, so I can manually call Unload when the symbol is reclaimed? This MathKernel behaviour is observed on Mathematica 8.0


DirectAgglomerate not working for Large Matrices

I am trying to graphically display a distance matrix with similar elements visually clustered into groups. My original matrix has the elements in a random order so the first thing I do is to change the ordering of those elements using `DirectAgglomerate`               Needs["HierarchicalClustering`"]          ClusteringPermutation[distanceMatrix_, linkage_] :=       Module[{indices, cluster},         indices = Range[Length @ distanceMatrix];         cluster = DirectAgglomerate[distanceMatrix, indices, Linkage -> linkage];         Reverse @ ClusterFlatten[cluster]       ]      My overall function to permute the matrix then looks like this:               PermuteMatrix[distanceMatrix_, linkage_] :=       Module[{newOrder},         newOrder = ClusteringPermutation[distanceMatrix, linkage];         distanceMatrix[[newOrder, newOrder]]     ]      Given an example matrix:               sampleMatrix =        {{1, 1, 0, 0, 1}, {1, 1, 0, 0, 1}, {0, 0, 1, 1, 0}, {0, 0, 1, 1, 0}, {1, 1, 0, 0, 1}};     PermuteMatrix[sampleMatrix, "Single"]      > >     {{1, 1, 0, 0, 0}, {1, 1, 0, 0, 0}, {0, 0, 1, 1, 1}, {0, 0, 1, 1, 1}, {0 > ,0, 1, 1, 1}} >   The matrix is now rearranged with the similar clusters being together. I then plot the result as a heat map while applying the same permutation to the element labels. Everything works fine until I get to matrices over `250 x 250` in size. In this case, the _Mathematica_ kernel crashes for some reason when evaluating `DirectAgglomerate`. Is this the limitation of the function or am I doing something clearly wrong? Any help would be greatly appreciated. I am definitely no expert on clustering; perhaps there is a completely different way to go about this? UPDATE (09.10.13) Tried to use `MinimumBandwidthOrdering` as suggested by bill s but quickly ran into issues with larger matrices where groups of similar samples were broken up. Here's an example:               mSubset={{0, 0, 0.272352, 0, 0.272364, 0.272261, 0, 0.272269}, {0, 0,      0.272501, 0, 0.272514, 0.272411, 0, 0.272419}, {0.272352, 0.272501,      0, 0.272038, 0, 0, 0.272158, 0}, {0, 0, 0.272038, 0, 0.272049,      0.271947, 0, 0.271955}, {0.272364, 0.272514, 0, 0.272049, 0, 0,      0.272169, 0}, {0.272261, 0.272411, 0, 0.271947, 0, 0, 0.272068,      0}, {0, 0, 0.272158, 0, 0.272169, 0.272068, 0, 0.272075}, {0.272269,     0.272419, 0, 0.271954, 0, 0, 0.272075, 0}}          permutedMatrixOrig = PermuteMatrix[msubset, "Single"]     {r, c} = MinimumBandwidthOrdering[msubset, Method -> "Sloan"];     {r2, c2} = MinimumBandwidthOrdering[msubset, Method -> "RCMD",      RefinementMethod -> None];     {ArrayPlot[msubset],      ArrayPlot[permutedMatrixOrig],      ArrayPlot[msubset[[r, c]]],      ArrayPlot[msubset[[r2, c2]]]}      ![MatrixImage](http://i1161.photobucket.com/albums/q504/mikachu12/MatrixExample_zps517644fb.png) I have tried playing around with the method and refinement options but was still unable to fully group all my samples. I have also noticed that for very large matrices my indices for rows and columns were different - could this have something to do with my matrices not being fully symmetrical?


Export multiple graphics into same file

I have a plot and a table that I am trying to plot in a single file together. I have a "working" example, but it is not perfect. I export a list, but it keeps the commas and brackets, that is the only problem so far. Export[dir, {plot, table}]; I have tried using CreateDocument, but this comes with formatting issues that are unacceptable. Plot being cut off etc. I know a way that works, but it is not automated. Manually merging the output cells for plot and table, then saving the selection as. **Update w/ solution:** As per mfvonh's suggestion I used row and it solved my problem. Export[dir, Row[{plot, table}]]


TimeConstrained dynamic change of maximum time

I would like to run a time consuming function:               TimeConstrained[f[x],maxseconds]      and be able to change maxseconds during running (increasing or decreasing max time) using a slider. Ideally when i decrease maxseconds below the time it has already consume it will stop. I could implement such a functionality inside f but i would have to do this for all f i want to create , so this way is out of the question. Thanks in advance, Theodore.


Error in using EventLocator in NDSolve

I have a problem in using EventLocator in Mathematica 9. However, this error doesn't show up in Mathematica 8 on my labtop. My code is,               η=G[x[n],y[n]];          pde = {x''[n] == -(1 - (x'[n]^2 + y'[n]^2)/(4*x[n]^2))*(3*x'[n] +              2*x[n]^2*\!\(     \*SubscriptBox[\(\[PartialD]\), \(x[n]\)]V\)/V) + (x'[n]^2 - y'[n]^2)/          x[n], y''[n] == -(1 - (x'[n]^2 + y'[n]^2)/(4*x[n]^2))*(3*y'[n] +              2*x[n]^2*\!\(     \*SubscriptBox[\(\[PartialD]\), \(y[n]\)]V\)/V) +           2*(x'[n]*y'[n])/x[n]};     bc = {x[0] == saddle, y[0] == 0.01, x'[0] == 0, y'[0] == 0};     Sol = NDSolve[{pde, bc}, {x, y}, {n, 0, 1000}, MaxSteps -> 50000,        AccuracyGoal -> Automatic,        Method -> {"EventLocator", "Event" -> η - 1,          "EventCondition" -> (n > 60)}]      The error message is, > NDSolve::evboo: The value of the event function at n = 61.76853457162405` > was not True or False. When not True, the value will be considered as False. > >> This is quite strange as there is no problem in running this on Mathematica 8.


merge daily and hourly time series data

I have two lists of time series data. One of the lists is daily and is formatted like this;               daily={{{2011, 7, 1, 6, 0, 0.}, 284606., 16735.3}, {{2011, 7, 2, 6, 0, 0.},      285283., 16669.9}, {{2011, 7, 3, 6, 0, 0.}, 287529., 16445.5}}      And another list which is hourly;               hourly={{{2011, 7, 1, 6, 0, 0.}, {3, 861, "", 2 ""}}, {{2011, 7, 1, 7, 0,      0.}, {3, 270, "", 2 ""}}, {{2011, 7, 1, 8, 0, 0.}, {3, "", "",2 ""}}}      I would like to merge the two list so the two values in the daily list repeat in the corresponding hourly list. For the data given the result would look like this;               merged={{{2011, 7, 1, 6, 0, 0.},3, 861, "", 2 "", 284606., 16735.3},        {{2011, 7, 1, 7, 0,0.}, 3, 270, "", 2 "", 284606., 16735.3},     {{2011, 7, 1, 8, 0, 0.}, 3, "", "",2 "", 284606., 16735.3}}}      I would like to match the two sets by the year-month-day data. The time part of the daily data can be ignored. I ended up coding a for loop that iterated through both lists to do the merge (after several attempts at doing this in a more elegant way). What I'm looking for is the proper way to do this in Mathematica, not a For loop that I could have done in C. Any help would be greatly appreciated. Finding the intersection of two date lists


Monochrome PNG (and GIF) Export

Is there a way to `Export` expressions to a monochrome PNG? I have tried the `ColorQuantize` function which is mentioned in comments to this question. However, the resulting PNG image of `ColorQuantize[TraditionalForm[MyExpression], 2]` is still of depth 24b. GIF file's depth appears to be 2, which is OK but it still looks like a cheat, and yes, PNG is more desired in my case. Rasterizing formulas before exporting also seems to be an unnatural hack that could and should be avoided in some way. I could `Export` my expressions to PDF and then GhostScript them (say, via `Run`) using GhostScript's _pngmono_ device but _Mathematica_ 's current PDF Export is quite buggy. (It doesn't even print \\[Bullet] correctly; TraditionalForm is lost, etc.) Printing selection to PDF and GhostScripting the result would do the thing for me… but there seems to be no way to do it ‘in a background mode’ using _Mathematica_ commands.


A matrix-vector cross product

I want to do a cross product involving a vector of Pauli matrices $\vec \sigma = \left( {{\sigma _1},{\sigma _2},{\sigma _3}} \right)$; for example, $\vec \sigma \times \left( {1,2,3} \right)$.               s:= Table[PauliMatrix[i], {i, 1, 3}];     Cross[s,{1,2,3}]      The code above will not work. The only way I can think of is to use the method which I have just learned from Mr. Wizard:               ReleaseHold @ Block[{PauliMatrix}, Hold @@ {Cross[s,{1, 2, 3}]}]      But I feel uncomfortable writing such long code to realize such a simple cross product. Is there any better way or not? * * * **Update** J.M. give the method               Cross[Unevaluated /@ PauliMatrix[Range[3]], {a,b,c}]      But it turns out that when one of the a,b,c is zero, the code will give error. a Remedy is given by J.M in his comment. But I am asking here why it gives right answer when a b c are all nonzero while failed with a zero component?


Using transfer function model to generate state space model

I am trying to generate the state space model for the following system: ![enter image description here](http://i.stack.imgur.com/rPXbw.png) However, the following code does not generate the state space model I expect:               tf = TransferFunctionModel[{{1/s}, {1/(s + 2)}}, s]     ssm = StateSpaceModel[tf]      What I'm expecting is $A = \begin{bmatrix} -2 & 0 \\\ 1 & 0 \end{bmatrix}$ $B = \begin{bmatrix} 0 \\\ 1 \end{bmatrix}$ $C = \begin{bmatrix} 0 & 1 \\\ 1 & 0 \end{bmatrix}$ $D = \begin{bmatrix} 0 \\\ 1 \end{bmatrix}$ but what I'm getting is $A = \begin{bmatrix} 0 & 1 \\\ 0 & -2 \end{bmatrix}$ $B = \begin{bmatrix} 0 \\\ 1 \end{bmatrix}$ $C = \begin{bmatrix} 2 & 1 \\\ 0 & 1 \end{bmatrix}$ $D = \begin{bmatrix} 0 \\\ 0 \end{bmatrix}$ The state equations are: $$\dot{x_1}(t) = -2 x_1 (t) + w_1 (t) $$ $$\dot{x_2}(t) = x_1(t) + u(t)$$ $$y_1(t) = x_2(t)$$ $$y_2(t) = \dot{x}_2(t)$$ where $w_1(t)$ denotes the white noise added to the system, and $x_2(t)$ denotes the system error, $e$. How should I enter my transfer function model to generate such a state space model?


gridlines in a plot

Please, someone to help me to abbreviate this commmand > ContourPlot[{x^2 - 2 y^2 == 1, x^2 - 5 y^2 == 1, x^2 - 10 y^2 == 1}, {x, > -15, 15}, {y, -15, 15}, GridLines -> {{-15, -14, -13, -12, -11, -10, -9, -8, > -7, -6, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, > 14, 15}, {-15, -14, -13, -12, -11, -10, -9, -8, -7, -6, -5, -4, -3, -2, -1, > 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15}}] This deploys: ![enter image description here](http://i.stack.imgur.com/k6woL.png)


Plotting data that lands on the axis

I have a data point that lands right on the Y axis, which corresponds to the index of refraction of some sample. the x axis is the mole fraction of chloroform of my samples. How do I get the first data point to look sensible (ie, not directly on the axis). I think it looks funny like this.               Needs["ErrorBarPlots`"];     moleFraction[molesA_, molesB_] = molesA/(molesA + molesB);     molesChloroform = {0.125, 0.100, 0.0625, 0.0375, 0};     molesAcetone = {0, 0.027, 0.068, 0.0952, 0.136};     molefrac = moleFraction[molesChloroform, molesAcetone];     calibrationIndexOfRefraction = {1.440, 1.421, 1.395, 1.380, 1.351};     errorBars = {0.1, 0.1, 0.1, 0.1, 0.1};     newList = Partition[Riffle[molefrac, calibrationIndexOfRefraction], 2];     test = Thread[{newList, ErrorBar[errorBars[[1]], 0]}]     ErrorListPlot[test, PlotRange -> {{0, 1.2}, {1.30, 1.45}},       Frame -> True]      ![My Plot](http://i.stack.imgur.com/MJRfK.jpg)


Aligning Text Using Spaces While Maintaining Pretty Print

To help illustrate my problem, consider the following cell: ![Goal](http://i.stack.imgur.com/F3DvF.png) First thing to notice is that there is syntax highlighting. Second, I can pretty print mathematics; that is, I see $x^2$ instead of `x^2`. Finally, the equal signs are aligned "nicely." I will expand on what I mean by "nicely" in a second. As of now, I have no idea how to create the cell I illustrated above. Let me elucidate what I mean by this. By default the "Style of newly typed cells" is `Input` and the "Format type of new input cells" is `StandardForm` (in V9 you can see this in the Preferences -> Evaluation menu). ![menu](http://i.stack.imgur.com/whMbt.png) To create a cell that is similar, but not exact, to the cell I have shown above, I need to type the following: `variable` `Space` `=` `Space` `1` `;` `Enter` `var` `Space x 13` `=` `Space` `x` `Ctrl + 6` `2` `→` `;` This produces the following. Notice that the equal signs are not quite aligned. ![standardform](http://i.stack.imgur.com/ud7zJ.png) Hitting `Space` 13 times is not what I call a "nice" way of aligning the equal signs. What I expect, is to hit `Space` 6 times to align the equal signs since this is a monospace font. **Question:** Is there a way to modify the FrontEnd so that the sequence of keyboard commands: `variable` `Space` `=` `Space` `1` `;` `Enter` `var` `Space x 6` `=` `Space` `x` `Ctrl + 6` `2` `→` `;` produces the first image above and I am able to evaluate it? Let me explain what I have tried so far. **(Attempt 1)** Changing "Format type of new input cells" to `InputType`. Using the second set of keyboard commands above, I get what is desired, but evaluating the cell gives me an error.               MakeExpression::boxfmt: InputForm in MakeExpression[FormBox[RowBox[{RowBox[{variable,=,1}],;}],InputForm],InputForm] is not a box formatting type. A box formatting type is any member of $BoxForms. >>      **(Attempt 2)** Changing "Format type of new input cells" to `Raw InputType`. I try using the second set of keyboard commands above and can align the equal signs, but I lose the ability to pretty print math and lose syntax highlighting. I am able to evaluate the cell. ![rawinputform](http://i.stack.imgur.com/wEzEU.png) **(Attempt 3)** Keeping "Format type of new input cells" as `StandardForm`. I use the first set of keyboard commands to produce the third image. Then I highlight the cell bracket and convert to `InputForm` (via `Shift + Ctrl + I`). This gives the following. ![converted](http://i.stack.imgur.com/EnqKR.png) I can then add a few spaces to align the equal signs. ![aligned](http://i.stack.imgur.com/9iT4U.png) Then I change the `x^2` to a $x^2$. Unlike in **(Attempt 1)** , I can evaluate this cell. Even though this gives me what I desire, it is a tedious way to go about it.


Compiled DiagonalMatrix

The standard function DiagonalMatrix cannot be compiled, so I tried writing my own:               diagMat = Compile[{{vec, _Real, 1}},                       Module[{size = Length[vec], matr},                              matr = Table[0, {size}, {size}];                              Do[matr[[i, i]] = vec[[i]], {i, size}];                              matr]     ];      While this function works, it does not compile. (I check this by doing Export["test.c",diagMat] , is there a simpler way to do this? ) It gives the error message: > CCodeGenerate::wmreq: The expression > Function[{vec,iCompile$67,matrCompile$68},Block[{i=iCompile$67,matr=matrCompile$68},{matr[[i,i]]=vec[[i]],i,matr}]] > requires Mathematica to be evaluated. The function will be generated but can > be expected to fail with a nonzero error code when executed. >> I'm not sure what's wrong here, as all the functions I use are compilable. Thanks


Variance/Standard Deviation with a Constant Vaule

When applying variance (`Variance[10]`) or standard deviation (`StandardDeviation[10]`) to a constant value in Mathematica, Should the return be zero ? What I get from `StandardDeviation[10]` is the error saying that `standardDeviation::rectt: Rectangular array expected at position 1 in StandardDeviation[10]`. How do I fix it ?


How to speed up Manipulate with Graphics3D

How do I speed up the Manipulate of the Graphics3D objects here? It is currently painfully slow, and I'm at a loss. I have reviewed many other posts and implemented what I could based on them, but it has had minimal effect on the speed. I have tried implementing:   * Reducing the angles used to 10 degree steps   * Memoization   * Dynamic (applied at various levels to various functions)   * Initialization code for Manipulate   * TrackedSymbols option for Manipulate   * Using With (both inside and outside Manipulate for the functions currently in Initialization) I am building a demonstration of the rotation of vectors through the Euler angles. I have excluded the last rotation because the speed is already so slow. (Apologies in advance for posting the entire code and the poor formatting here and there, which I've chosen to leave as is so that it can be copied and pasted into Mathematica.)               Manipulate[      Graphics3D[{        (* Size a graphics box to make visualization area constant *)           graphicsBox,             (* Original coordinate axes *)        origCoordAxes,             (* Vectors rotated once *)        vectorsRotatedOnce[ψ],             (* Vectors rotated twice *)             vectorsRotatedTwice[ψ, θ],             (* Plane surface first rotation *)             planeSurfaceFirstRotation[ψ],             (* Plane surface second rotation *)             planeSurfaceSecondRotation[ψ, θ]        },       BoxStyle -> Directive[Opacity[.1]],       ViewVertical -> {0, 0, -1},       ViewPoint -> {-12, -10, -5}       ],           {{ψ, 60}, 1, 91, 10},      {{θ, 40}, 1, 91, 10},           Initialization :> (        x0 = {2, 0, 0};        y0 = {0, 2, 0};        z0 = {0, 0, 2};        x1[ψ_] := x1[ψ] = RotationMatrix[ψ Degree, z0]. x0;        y1[ψ_] := y1[ψ] = RotationMatrix[ψ Degree, z0]. y0;        z1[ψ_] := z1[ψ] = RotationMatrix[ψ Degree, z0]. z0;        x2[ψ_, θ_] := x2[ψ, θ] = RotationMatrix[θ Degree, y1[ψ]]. x1[ψ];        y2[ψ_, θ_] := y2[ψ, θ] = RotationMatrix[θ Degree, y1[ψ]]. y1[ψ];        z2[ψ_, θ_] := z2[ψ, θ] = RotationMatrix[θ Degree, y1[ψ]]. z1[ψ];             graphicsBox = Sequence[          EdgeForm[None], Opacity[0],          Cuboid[{0, 0, 0}, {1.25, 1.25, 1.25}],          Cuboid[{0, 0, 0}, {-1.25, -1.25, -1.25}]           ];             origCoordAxes = Sequence[          Black, Opacity[.25],          Arrow[Tube[{{0, 0, 0}, {1, 0, 0}}, 0.005]],          Text[Style["\!\(\*SubscriptBox[\(x\), \(0\)]\)", Black, Large], {1.2, 0, 0}],          Arrow[Tube[{{0, 0, 0}, {0, 1, 0}}, 0.005]],          Text[Style["\!\(\*SubscriptBox[\(y\), \(0\)]\)", Black, Large], {0, 1.2, 0}],          Arrow[Tube[{{0, 0, 0}, {0, 0, 1}}, 0.005]],          Text[Style["\!\(\*SubscriptBox[\(z\), \(0\)]\)", Black, Large], {0, 0, 1.2}]          ];             vectorsRotatedOnce[ψ_] := vectorsRotatedOnce[ψ] =          Sequence[           Red, Opacity[1],           Arrow[Tube[{{0, 0, 0}, x1[ψ]}, 0.01]],           Text[Style["\!\(\*SubscriptBox[\(x\), \(1\)]\)", Black, Large], (1.2 x1[ψ])],           Text[Style["ψ", Lighter@Blue, Large], ((1/3) ( x1[ψ] + x0))],           Green,           Arrow[Tube[{{0, 0, 0}, y1[ψ]}, 0.01]],           Text[Style["\!\(\*SubscriptBox[\(y\), \(1\)]\)", Black,  Large], (1.2 y1[ψ])],           Text[Style["ψ", Lighter@Blue, Large], ((1/3) ( y1[ψ] + y0))],           Blue,           Arrow[Tube[{{0, 0, 0}, z1[ψ]}, 0.01]],           Text[ Style["\!\(\*SubscriptBox[\(z\), \(1\)]\)", Black,Large], (1.2 z1[ψ])]               ];             vectorsRotatedTwice[ψ_, θ_] :=          vectorsRotatedTwice[ψ, θ] =          Sequence[           Lighter@Red, Opacity[.3],           Arrow[Tube[{{0, 0, 0}, x2[ψ, θ]}, 0.01]],           Text[ Style["\!\(\*SubscriptBox[\(x\), \(2\)]\)", Black, Large], (1.2 x2[ψ, θ])],           Text[ Style["θ", Lighter@Green, Large, Opacity[1]], ((1/3) ( x2[ψ, θ] + x1[ψ]))],           Lighter@Green,           Arrow[Tube[{{0, 0, 0}, y2[ψ, θ]}, 0.01]],           Lighter@Blue,           Arrow[Tube[{{0, 0, 0}, z2[ψ, θ]}, 0.01]],           Text[Style["\!\(\*SubscriptBox[\(z\), \(2\)]\)", Black,Large], (1.2 z2[ψ, θ])],           Text[Style["θ", Lighter@Green, Large,  Opacity[1]], ((1/3) ( z2[ψ, θ] + z1[ψ]))]           ];             planeSurfaceFirstRotation[ψ_] :=          planeSurfaceFirstRotation[ψ] =          Sequence[           Opacity[.2],           Directive[Blue, Glow[Blue], Specularity[0]],           Dynamic@Rotate[surfaceX2[ψ Degree][[1]], 0, {0, 0, 1}],           Dynamic@Rotate[surfaceX2[ψ Degree][[1]], π/2, {0, 0, 1}]           ];             planeSurfaceSecondRotation[ψ_, θ_] :=          planeSurfaceSecondRotation[ψ, θ] =          Sequence[           Opacity[.2],           Directive[Green, Glow[Green], Specularity[0]],           Dynamic@Rotate[Rotate[surfaceX2[θ Degree][[1]], ψ Degree, {0, 0, 1}],              3 π/2, x1[ψ]],           Dynamic@Rotate[Rotate[surfaceX2[θ Degree][[1]], ψ Degree - π/2,{0, 0, 1}], 3 π/2, x1[ψ]]           ];             surfaceX2[α_] := surfaceX2[α] =          ParametricPlot3D[{r Cos[u], r Sin[u], 0}, {u, 0, α}, {r,             0, 1.5},           Mesh -> None,           Axes -> None,           Boxed -> True,           Lighting -> {{"Ambient", Blue}},           PerformanceGoal -> "Speed"           ];        ),      TrackedSymbols :> {ψ, θ}      ]


Transform fancy usage messages in 1D string

When we look at the usage messages of built-in functions nowadays (not in the good old times, when they were a simple descriptions) we see that although they look pretty in the front end, it is really hard to get a simple, one- dimensional string representation. Just try this and see yourself               ToString[Integrate::usage]      This is completely useless when one seeks for a simple string form. When you look at the _Wolfram Workbench_ you may have noted, that they _do_ provide simple string usage messages even for built-in functions. **Question:** Is it possible to create/extract/steal simple, non-formatted usage messages for **all** (or almost all) built-in functions **automatically**? With _automatically_ I mean having one function which works for almost all usage messages. To give an example, the `Integrate` help message of the _Workbench_ looks like this: > Integrate[f,x] gives the indefinite integral Integral f dx. > Integrate[f,{x,xmin,xmax}] gives the definite integral Integral _xmin ^xmax > f dx. Integrate[f,{x,xmin,xmax},{y,ymin,ymax},...] gives the multiple > integral Integral _xmin ^xmaxdxIntegral _ymin ^ymaxd y ... f. > > Attributes: {Protected,ReadProtected} Options: > {Assumptions,GenerateConditions,PrincipalValue}


ContourPlot with parameter

I have an equation for function `F[x,y]==0` which first argument `x` is real and another, `y`, is complex. All constants in equation are real. I define `y` as `y=a+I*b`. I need to plot `Im[y]` as function of `x`. (in other words, I need a plot of `b` as function of `x`. The equality for `F` for `a` and `b` and `x` can be solved only using `FindRoot` function. Here's how I tried to plot what I need:               ContourPlot[{{Im[F] == 0, Re[F] == 0}}, {b, 0.1,        10^8}, {x, 0.1, 10^16}]      But nothing is plotted. Any ideas? Thank you for help! * * * Here is the function and constants:               e2 = 5     e3 = 1     omega1 = 1.1242*10^(16)     omega2 = 4.5896*10^(15)     omega3 = 5.5927*10^(15)     e1 = 1 - omega1^2/x^2     c = 3*10^8     k1 = Sqrt[y^2 - x^2/c^2 e1]     k2 = Sqrt[y^2 - x^2/c^2 e2]     k3 = Sqrt[y^2 - x^2/c^2 e3]     h = 5*10^(-9)     y = a + I b     F = ((k2/e2 + k1/e1)*(k3/e3 + k2/e2))/((k1/e1 - k2/e2)*(k3/e3 -             k2/e2)) - Exp[-2 k2 h]      Here is my attemption to plot roots I that I tried with FindRoot. But I am not sure it plots all roots correctly and I don't even know where to search for them:                findPoint[i_] :=       Evaluate[Function[        Assuming[a \[Element] Reals && b \[Element] Reals,          FindRoot[{(Re[F] /. x -> (10000*i)) ==             0, (Im[F] /. x -> (10000*i)) == 0}, {{a, 0.5}, {b, 0.2}}]]]]     list1 := Table[b /. findPoint[i][[1]], {i, 1, 2000}]     list2 := Table[10000*i, {i, 1, 2000}]     PointDone := Inner[List, list1, list2, List]     Show[{Graphics[Point[PointDone], Axes -> False, AspectRatio -> 1/2,         Frame -> {{True, False}, {True, False}}, FrameTicksStyle -> 18]}]      Here is a plot I got.. ![enter image description here](http://i.stack.imgur.com/Mqjhq.png)


How to Maximize[Log[n]^(1/Log[n]), n]

I am new to Mathematica and am trying to work out how to use Maximize.               Maximize[Log[n]^(1/Log[n]),n]      Should give a solution at $e^e$. However in Mathematica you don't get anything. What's the right way to do this?


Control parameters of different styles of DistributionChart

Using `DistributionChart`, you can choose among several styles aka `ChartElementFunction`:               ChartElementData["DistributionChart"]          {"Density", "DensityQuantile", "FadingQuantile",      "GlassQuantile", "HistogramDensity", "LineDensity", "PointDensity",       "Quantile", "SmoothDensity"}      Is there a way to control their parameters? The documentation does not seem to say. * * * The problem is that the defaults are less than optimal for my data. Consider these: Using `SmoothDensity`: ![SmoothDensity](http://i.stack.imgur.com/VpyTN.png) Using `HistogramDensity`: ![HistogramDensity](http://i.stack.imgur.com/ZdRmQ.png) Using `LineDensity`: ![LineDensity](http://i.stack.imgur.com/xPq13.png) Clearly, `SmoothDensity` grossly misrepresents the data (just compare with the `LineDensity` version); the violins should all look like the ones for 2 and 9. `HistogramDensity` does a better job but its resolution is horrible; there are 100 data points per size, about 70 of which fall into the upper class -- that should be plenty of points to draw more bars. I would like to tell `HistogramDensity` to use more/smaller bins, and/or `SmoothDensity` to smooth less. How is this possible?


How to obtain differential equations of motion using Lagrangian dynamics?

I'm confused to find a set of differential equations of motion of a pair of masses, `m1` and `m2` joined by a spring of constant `k`. The unstretched length of the spring is `L`, and the initial conditions are; `x1[0]=0, x2[0]=L+a, x1'[t]=0, x2'[t]=0`. `x1[t]` and `x2[t]` are the positions of the masses `m1` and `m2` at any time `t`. I used Lagrangian dynamics to find the differential equations of motion, but I'm not sure my codes are correct. And I have no idea where I need to put the initial conditions to find the differential equations. Can someone help me?               Needs["VariationalMethods`"];     T = 0.5*m1*x1'[t]^2 + 0.5*m2*x2'[t]^2;     V = 0.5*k*(x2[t] - x1[t] - L);     lag = T - V;     eqn[n_] = EulerEquations[lag, {x1[t], x2[t]}, t];


Mapping a function that assigns values to a list over a different list

I'm trying to get used to Mathematica's approach to programming and list manipulation, and am struggling with one thing. Say that I have a function `f` which takes a list of two values and returns a list of two values. I also have a list of doubles, `c = {{1, 2}, {1, 3}, {1, 4}, {2, 3}, {2, 4}, {3, 4}}`. For each double in `c`, I want to return a list of four values: two of them zero, and the ones with corresponding indices in `c` should be defined by applying the function `f` to the double in `c`. Let me show some examples. For the value `{1,3}`, I would like to return `{ f[{1,3}][[1]], 0, f[{1,3}][[2]], 0 }`, and for `{2,3}`, I would like `{ 0, f[{2,3}][[1]], f[{2,3}][[2]], 0 }`. I am completely stumped by this problem when I try to find a nice solution using `Map` and other standard Mathematica list operations. The approach that I've tried was to map over `c` trying to assign values to a list of zeroes depending on the values in `c`, but I'm lost as to how I would accomplish that. I can basically do what I want with a loop:               result = {};     Do[      list = {0, 0, 0, 0};      list[[x[[1]]]] = f[x][[1]];      list[[x[[2]]]] = f[x][[2]];      AppendTo[result, list],     {x, c}]      but I would like to learn a better approach. Here, I don't even know how to perform the operation inside the `Do` loop more elegantly, because something like               Map[(list[[x[[#]]]] = f [x][[#]])&, {1,2}]      does not work. I would appreciate any suggestions and help with this problem.


Exporting to quicktime in linux version?

In _MMA_ (8.0.0/Linux), I tried to to create an animation using the command               Export["s4s5mov.mov", listOfFigures]      and got the output ![enter image description here](http://i.stack.imgur.com/bFWPP.png) Doing a little research, one can read in the Documentation Center that ![enter image description here](http://i.stack.imgur.com/woicu.png) And I was wondering **if there is some way to overcome this limitation _within MMA_**. **EDIT** Here is a sample code of the inverted animation problem:               movingP = Table[Show[         ParametricPlot[{Sin[x], Cos[x]}, {x, 0, 2 \[Pi]}, AxesLabel -> {x, y}],         Graphics[{Red, PointSize[Large],               Point[{Sin[(n \[Pi])/8], Cos[(n \[Pi])/8]}]}]         ], {n, 0, 15}]          Export["~/Desktop/point.avi", movingP]      will produce an avi like this: ![enter image description here](http://i.stack.imgur.com/JPkLa.gif) (The gif has been tampered to look like the avi)