PDF for Gamma Distribution not what I expect

I have plotted the the PDF for a Gamma Distribution with various parameters (e.g. 3 and 5) using `Manipulate`:               Manipulate[       Plot[PDF[GammaDistribution[α, β], x], {x, -1, 20}],        { α, -1, 8}, { β, -1, 6}]      However, the plots that I get are quite different to what I get using R and which I know to be correct. For example the `PDF` with $\Gamma(3,5)$ should have a peak in the curve at 0.4. The plot that _Mathematica_ produces gives me a peak that is more like `11`. Does anybody have any ideas what I am doing wrong here?


NIntegrate returns zero for non zero integrand, 4d Integration

I am trying to calculate the following integral.               sigma1 = 10.0; sigma2 = 5.0; delta = 0.5;     t[x1_, y1_, x_, y_] := 100*HeavisideLambda[sigma1^-1*(x - x1), sigma2^-1*(y - y1)];     B2[x1_, y1_, x_, y_] := HeavisideTheta[(delta/2)^2 - (x - x1)^2, (delta/2)^2 - (y - y1)^2];     trans[x1_, y1_, x2_, y2_] :=         NIntegrate[B2[x1, y1, xz, yz]*t[xz, yz, xp, yp]*            (B2[x2, y2, xz, yz] - B2[x2, y2, xp, yp]),             {xp, x2 - 2.0*sigma1, x2 + 2.0*sigma1},             {yp, y2 - 2.0*sigma2, y2 + 2.0*sigma2},             {xz, x1 - 0.5*delta, x1 + 0.5*delta},              {yz, y1 - 0.5*delta, y1 + 0.5*delta},          WorkingPrecision -> 12, AccuracyGoal -> 8, MinRecursion -> 8, MaxRecursion -> 100];      I am interested in the value of the integral for the following inputs:               trans[0, 0, delta, 0]      Here is my problem: for values of delta greater than 0.5 (I tried 1.0, 0.9, 0.8, 07, 0.6, 0.515), the result is a negative number, and it takes some time for _Mathematica_ to come up with the result. For any value of delta smaller than 0.5, _Mathematica_ immediately returns 0, and doesn't give any hints about what is wrong. This is a part of a refinement study and I need to choose smaller and smaller values for delta. Do you know how I can make this work?


Bandpassing EEG's using Mathematica's Bandpass Function

Let's say we have an EEG signal approximated using a fractional Brownian motion:               EEG[hurst_,t_low,thigh_,tinc_]=RandomFunction[      FractionalBrownianMotionProcess[hurst], {tlow, thigh, tinc}, 1]      for some parameters hurst_, tlow_, thigh_, tinc_. The literature on EEG's state that alpha waves are obtained by using a bandpassing filter in the range 14-40 Hz, more or less...               data = EEG[0.4,0,1,0.01]     BandpassFilter[Flatten[data[[2, 1]]], {0.14, 0.40}];      My question is with regards to the BandpassFilter parameters. Does choosing 0.14 and 0.40 effectively yield the 14-40Hz range? Basically, what are the units of the BandpassFilter function in Mathematica


Plot: how to have the y-range automatically scale to min-max on the x-range?

I have a long list of {date,value}. I would like to use DateListPlot to plot only a subrange, from date1 to date2, with the range on the y-axis automatically chosen to be between the min and max value between those two dates (i.e. trivial automatic zooming). I am sure Mathematic will do it with a simple option choice, but I must be dumb and cannot find it. Can you help? Thanks. PS: here is simple code to show the issue using financial data:               spx = FinancialData["SP500", All];          DateListPlot[spx,       PlotRange -> {{{1987, 10, 1}, {1987, 11, 30}}, Automatic},       PlotLegends -> Placed[namesFrom83, {Left, Bottom}],       PlotLabel -> "1987"]


Alternative updating of a dynamic expression

I am looking for a solution to selectively update a dynamic expression `expr` which is dependent on multiple control variables `{x, y, ...}`. I need to update `expr` differently (using `xUpdate` and `yUpdate`) according to which controller is manipulated, i.e. which control variable triggers an update, but without including update code in any of the controllers! That is, `Dynamic[expr]` itself has to include the different update modes. **Question: Is there a method to update a dynamic expression differently depending on which parent-variable triggers an update?** ## 1\. Include update in controller The easy way would be to simply include the different update codes in the controllers, but as I said, this is not the desired way. The code is included here only for reference:               xUpdate[xin_, yin_] := {"x-trigger", yin + xin, yin};     yUpdate[xin_, yin_] := {"y-trigger", yin*10, yin};          x = y = 0; expr = yUpdate[x, y];     {Row@{"update x: ",         Slider[Dynamic[x, (x = #; expr = xUpdate[x, y]) &]]},       Button["Update y", y = RandomReal[]; expr = yUpdate[x, y]]}     Dynamic[expr]      This works as expected, but in my use case I cannot update `expr` directly from the controllers. I have to do it in a way that is restricted to the last line, i.e. the `expr` itself has to do the updating according to which controller was manipulated. ## 2\. Using `$ControlActiveSetting` An alternative method is to rely on the global value of `$ControlActiveSetting`:               xUpdate[xin_, yin_] := {"x-trigger", yin + xin, yin};     yUpdate[xin_, yin_] := {"y-trigger", yin*10, yin};          x = y = 0;         {Button["Update y", y = RandomReal[]],       Row@{"update x: ", Slider[Dynamic@x]}}     Dynamic[expr = If[$ControlActiveSetting, xUpdate[x, y], yUpdate[x, y]]; expr,       TrackedSymbols :> {x, y}]      This correctly differentiates between the two update modes, but it incorrectly reverts to `y-trigger` whenever the x-slider is released. This is unwanted behaviour. A second problem with this is that `$ControlActiveSetting` cannot differentiate between multiple sliders (i.e. imagine a third `z` controller). ## 3\. Intermediate solution a'la `$ControlActiveSetting` A global flag (`trigger`, substituting `$ControlActiveSetting`) is set to either `"x"`, `"y"` or `"z"`, depending on which controller is being manipulated. This works as expected and can be extended to any number of controllers, but has the problem that I still have to set `trigger` in each controller, which I want to avoid.               xUpdate[xin_, yin_, zin_] := {"x-trigger", yin + xin, yin, zin};     yUpdate[xin_, yin_, zin_] := {"y-trigger", yin*10, yin, zin};     zUpdate[xin_, yin_, zin_] := {"z-trigger", zin*20, yin - 1, zin};          x = y = z = 0;     trigger = "x";         {Button["Update y", trigger = "y"; y = RandomReal[]],       Row@{"update x: ", Slider[Dynamic[x, (trigger = "x"; x = #) &]]},       Row@{"update z: ", Slider[Dynamic[z, (trigger = "z"; z = #) &]]}}     Dynamic[Switch[trigger, "x", xUpdate[x, y, z], "y", yUpdate[x, y, z],        "z", zUpdate[x, y, z]], TrackedSymbols :> {x, y, z}]      But it brings me closer to my real question: **Question:** **Is there a way to check globally which control variable is being actively manipulated/changed in the front-end?** Surely `Dynamic[expr]` knows about it as it has the `TrackedSymbols` option, but I cannot access this information from inside the `Dynamic`. I think of something like `CurrentValue["ManipulatedVariable"]` or `CurrentValue["ActualDynamicUpdatingTrigger"]` (which are nonexistent).


Creating Correlation Table (and Working) With Missing Data

I am working with data that contains missing values (I have several variables (across the columns) and several observations (across the rows) in an excel spreadsheet). Example of the data structure:               obs var1 var2 ... var30     1    100  1     2    .    0     3    30   1     4.   20   .     ...      After importing the data:               names = Import["Example_Data.xls", {"Data", 1, 1}];          data = Drop[Import["Example_Data.xls", {"Data", 1}], 1]      I want to create a simple correlation table:               corrm = Correlation[data] //MatrixForm      **Questions:**   1. How can I calculate the Correlation here given that I have missing data?    2. More generally, how do I work with missing data in mathematica? I have previously worked with Stata where missing values are taken care of under the hood. With that said, will I get the same correlation values here if I simply remove the missing values as I would if I tried to calculate the correlation using a statistical package such as e.g. Stata?  **[EDIT]** For question #2 above I found the following entry useful (http://www.ats.ucla.edu/stat/stata/output/stata_corr_output.htm). It seems that the standard procedure for statistical programs such as Stata is to delete each observation containing a missing value for one or more of its variables. As such, I would appreciate a method for answering question #1 using a similar method. **NOTE:** After a preliminary search I found the following resources helpful (but they did not answer my questions): http://mathematica.stackexchange.com/questions/29159/correlation-with-missing- data http://reference.wolfram.com/language/howto/ReplaceOrRemoveInvalidOrMissingData.html


Matrix and random, weighted assignment of rows

I asked a question in this category previously but my problem has changed. On one hand, I have a large number of data files as _.dat_ format, and on the other hand, I have a matrix `A` which must be filled with these data. Each of rows of the `A` must be devoted to each of the data files BUT NOT WITH THE SAME CHANCE. Actually, my desire is to put each of data files in each row (after importing them) but in a RANDOM WAY. For example ( **just for example** here, there are 5 data files): (the number of the row of `A` is the same of the number of data files and the number of the column of that is fixed to 10). However, in the elements shown below, n has 11 because, as I will explain, I don't want to add the first element from a data file to the matrix.               m = {8, 1, 5, 3};     n = {6, 2, 7, 11, 3, 8, 10, 12, 14, 1, 4};     k = {10, 3, 6, 8, 2};     S = {7, 1, 9};     R = {9, 4, 6, 1, 5};      I mean, the `k` is the most significant relative the other elements and must have the highest chance of getting the first row of the matrix; For example with the weight 10 (just for example). After `k`, `R` (with the weight 9) must have the next highest chance to get the first row of the matrix. Then with decreasing chance: `m` with weight 8. `S` with weight 7, and so on. Every previously assigned weight of each data element is given in the first element of the element. For instance, `n` might be assigned to the second row even though `n` has the less chance than `R` to occupy the second row. As a matter of fact, the random generator, giving attention to the weights, will decide which data element to assign to which row.


How to transpose unequal lists

As the titel says I want to transpose a matrix containing rows of unequal length, to be able to transport them to excel (in row form, there are too many datapoint to write them in a cell. In another topic if found to use flatten : Transpose uneven lists However, this does not give me the right result: Example:               list = {{1, 2, 3, 4}, {1, 2, 3, 4}, {1, 2, 3}, {1, 2, 3}, {1, 2, 3, 4,5}, {1, 2, 3, 4, 5}};     Flatten[list, {{2},{1}}]      Results into:               {{1, 1, 1, 1, 1, 1}, {2, 2, 2, 2, 2, 2}, {3, 3, 3, 3, 3, 3}, {4, 4, 4, 4}, {5, 5}}      But the result I want is:               {{1, 1, 1, 1, 1, 1}, {2, 2, 2, 2, 2, 2}, {3, 3, 3, 3, 3, 3}, {4, 4,"" , "" , 4, 4}{,"" , "" , "" , "" , 5, 5}}      So I want to keep the rows together as they are, but only print them into columns. Is this possible?


Modelling Hysteresis with a Differential Equation

I want to implement the bulk ferromagnetic hysteresis model (mostly the Jiles- Atherton Model), see http://drum.lib.umd.edu/bitstream/1903/6043/1/PhD_99-1.pdf page 44 equation (30). The needed equations are $$ \delta = \text{sgn}(\dot{H})\\\\[1ex] H_\text{eff}=H+\alpha M \\\\[1ex] M_\text{an}(H_\text{eff})= M_\text{sat}\cdot\mathcal{L}(H_\text{eff}/a)\\\\[1ex] \delta_\text{M}=\begin{cases}0 & \dot{H}<0\text{ and }M_\text{an}-M>0\\\0 & \dot{H}>0\text{ and }M_\text{an}-M<0\\\1&\text{else}\end{cases}$$ and the main equation is $$ \frac{\text{d}M}{\text{d}H}=\frac{\frac{k\delta c}{\mu_0}\frac{\text{d}M_\text{an}}{\text{d}H_\text{eff}}+\delta_\text{M}(M_\text{an}-M)}{\frac{k\delta}{\mu_0}-\delta_\text{M}(M_\text{an}-M)\alpha-\frac{k\delta \alpha c}{\mu_0}\frac{\text{d}M_\text{an}}{\text{d}H_\text{eff}}}$$ Short explanation: $\delta$ takes into account wheter we are at the upper hysteresis branch or the lower one, $H_\text{eff}$ is needed to shift the Langevinfunction $\mathcal{L}(x)$ to achieve a hysteresis, $M_\text{an}$ is the anhysteretic Magnetization and $\delta_\text{M}$ is necessary to prevent unphysical behaviour. ## How I tried to implement it There were two approaches I tried: The first one is based on ParametricNDSolve, and, as I understand it, the values need to go from $0$ to $H_\text{max}$ (this is no problem and works) then down to $-H_\text{max}$ and up again to $H_\text{max}$ (this is the part I'm unsure how to achieve). My first guess was to define the function piecewise, with an implemented shift (Beware monster ugly function below!):               \[Micro]0 = 4 \[Pi]*10^-7;     BulkFerromagneticHysteresisModelComplete = ParametricNDSolveValue[{Mges'[Happlied] ==       Piecewise[{{((k*c/\[Micro]0)*             Msat (a/(Happlied + \[Alpha]*Mges[Happlied])^2 -                Csch[(Happlied + \[Alpha]*Mges[Happlied])/a]^2/a) +             Piecewise[{{0,                 Msat*Piecewise[{{#/3,                      Abs[#] < 10^-5}, {Coth[#] - 1/(#),                      True}}] &@((Happlied + \[Alpha]*Mges[Happlied])/                     a) - Mges[Happlied] > 0}, {1,                 True}}]*(Msat*                  Piecewise[{{#/3, Abs[#] < 10^-5}, {Coth[#] - 1/(#),                      True}}] &@((Happlied + \[Alpha]*Mges[Happlied])/                  a) - Mges[Happlied]))/((k/\[Micro]0) -             Piecewise[{{0,                 Msat*Piecewise[{{#/3,                      Abs[#] < 10^-5}, {Coth[#] - 1/(#),                      True}}] &@((Happlied + \[Alpha]*Mges[Happlied])/                     a) - Mges[Happlied] > 0}, {1,                 True}}]*(Msat*                  Piecewise[{{#/3, Abs[#] < 10^-5}, {Coth[#] - 1/(#),                      True}}] &@((Happlied + \[Alpha]*Mges[Happlied])/                  a) - Mges[Happlied])*\[Alpha] - (k*               c*\[Alpha]/\[Micro]0)*             Msat (a/(Happlied + \[Alpha]*Mges[Happlied])^2 -                Csch[(Happlied + \[Alpha]*Mges[Happlied])/a]^2/a)),          Happlied <           20000}, {((-k*c/\[Micro]0)*             Msat (a/(-Happlied +                  40000 + \[Alpha]*Mges[-Happlied + 40000])^2 -                Csch[(-Happlied +                  40000 + \[Alpha]*Mges[-Happlied + 40000])/a]^2/a) +             Piecewise[{{0,                 Msat*Piecewise[{{#/3,                      Abs[#] < 10^-5}, {Coth[#] - 1/(#),                      True}}] &@((-Happlied +                      40000 + \[Alpha]*Mges[-Happlied + 40000])/a) -                   Mges[-Happlied + 40000] > 0}, {1,                 True}}]*(Msat*                  Piecewise[{{#/3, Abs[#] < 10^-5}, {Coth[#] - 1/(#),                      True}}] &@((-Happlied +                     40000 + \[Alpha]*Mges[-Happlied + 40000])/a) -                Mges[-Happlied + 40000]))/((-k/\[Micro]0) -             Piecewise[{{0,                 Msat*Piecewise[{{#/3,                      Abs[#] < 10^-5}, {Coth[#] - 1/(#),                      True}}] &@((-Happlied +                      40000 + \[Alpha]*Mges[-Happlied + 40000])/a) -                   Mges[-Happlied + 40000] > 0}, {1,                 True}}]*(Msat*                  Piecewise[{{#/3, Abs[#] < 10^-5}, {Coth[#] - 1/(#),                      True}}] &@((-Happlied +                     40000 + \[Alpha]*Mges[-Happlied + 40000])/a) -                Mges[-Happlied + 40000])*\[Alpha] - (-k*               c*\[Alpha]/\[Micro]0)*                  Msat (a/(-Happlied +                  40000 + \[Alpha]*Mges[-Happlied + 40000])^2 -                Csch[(-Happlied +                  40000 + \[Alpha]*Mges[-Happlied + 40000])/a]^2/a)),          20000 < Happlied < 60000},{((k*c/\[Micro]0)*             Msat (a/(Happlied +                  40000 + \[Alpha]*Mges[Happlied - 80000])^2 -                Csch[(Happlied +                  40000 + \[Alpha]*Mges[Happlied - 80000])/a]^2/a) +             Piecewise[{{0,                 Msat*Piecewise[{{#/3,                      Abs[#] < 10^-5}, {Coth[#] - 1/(#),                      True}}] &@((Happlied -80000 + \[Alpha]*Mges[Happlied -80000])/a) -                   Mges[Happlied -80000] > 0}, {1,                 True}}]*(Msat*                  Piecewise[{{#/3, Abs[#] < 10^-5}, {Coth[#] - 1/(#),                      True}}] &@((Happlied -80000 + \[Alpha]*Mges[Happlied -80000])/a) -                Mges[Happlied -80000]))/((k/\[Micro]0) -             Piecewise[{{0,                 Msat*Piecewise[{{#/3,                      Abs[#] < 10^-5}, {Coth[#] - 1/(#),                      True}}] &@((Happlied -                      80000 + \[Alpha]*Mges[Happlied - 80000])/a) -                   Mges[Happlied - 80000] > 0}, {1,                 True}}]*(Msat*                  Piecewise[{{#/3, Abs[#] < 10^-5}, {Coth[#] - 1/(#),                      True}}] &@((Happlied -                     80000 + \[Alpha]*Mges[Happlied -80000])/a) -                Mges[Happlied -80000])*\[Alpha] - (k*               c*\[Alpha]/\[Micro]0)*                  Msat (a/(Happlied -                  80000 + \[Alpha]*Mges[Happlied - 80000])^2 -                Csch[(Happlied -                  80000 + \[Alpha]*Mges[Happlied -80000])/a]^2/a)),          60000 < Happlied < 100000}}],      Mges[0] == 0.0001}, {Mges}, {Happlied, 0, 100000}, {Msat, a,      k, \[Alpha], c}];      Unfortunately this doesn't work (I suspect because of `Mges[Happlied-80000]` respectively `Mges[-Happlied+40000]`? If yes, how can I workauround this?). **EDIT:** To be more precise, compiling the above shown works, proceeding with               modelcomplete[Msat_, a_, k_, \[Alpha]_, c_][Happlied_] := Through[BulkFerromagneticHysteresisModelComplete[Msat, a,        k, \[Alpha], c][Happlied], List] /; And @@ NumericQ /@ {Msat, a, k, \[Alpha], c, Happlied};      leads after several seconds (it looks as if it is already done for some time with compiling) to the error:               Mathematica Kernel for Windows has stopped working     Problem Event Name: APPCRASH     Application Name: MathKernel.exe     ...     Fault Module Name: mathdll.dll     ...      * * * Another possible approach is described in Computer-aided Analysis of Electric Machines: A Mathematica Approach from Vlado Ostovic, but the book is from the early 90s, so the code presented there doesn't work - the main idea is to use a periodic function to achieve the hyteresis effect. It seems I got the virgin curve working there as well:               Ms = 2*10^6;     a = 1100;     kon = 0.0004;     alpha = 1.6*10^3;     mu0 = N[4*Pi*10^(-7)];     c = 0.2;     Hmax = 8000;     omega = N[2*Pi];          eq = {Mges'[t] == (Ms (Coth[(Hmax*Cos[2 Pi t] + alpha Mges[t])/a] -            a/(Hmax*Cos[2 Pi t] + alpha Mges[t])) -         Mges[t])/((1 + c) (kon/mu0 -           alpha (Ms (Coth[(t + alpha Mges[t])/a] -                 a/(Hmax*Cos[2 Pi t] + alpha Mges[t])) - Mges[t]))) +      c/(1 + c) (Ms (a/(Hmax*Cos[2 Pi t] + alpha Mges[t])^2 -           Csch[(Hmax*Cos[2 Pi t] + alpha Mges[t])/a]^2/a)), Mges[0] == 0}          tests = NDSolve[eq, {Mges}, {t, 0, 1}]          Plot[Evaluate[Mges[t] /. tests], {t, 0, 1}, PlotRange -> All]      But instead of the `Mges[t]` it would be necessary to use `Mges[Hmax*Cos[2 Pi t]]`, sadly _Mathematica_ crashes if I try to use this expression. **EDIT:** To be more precise here: If I use `Mges[Hmax*Cos[2 Pi t]]` throughout `eq` I get the following error:               NDSolve::derivs: No derivatives of dependent variables were found in the equations. NDSolve is designed to solve differential or differential algebraic equations. Use NSolve or FindRoot to numerically solve algebraic equations. >>      I suspect this is due to Mathematica not recognizing `Mges[Hmax*Cos[2 Pi t]]` as $M(x)$ but as $M(f(x))$. * * * Does anyone have any idea how to overcome these obstacles? Thanks a lot in advance, I really appreciate any help!


Radial Random Walk

I'm trying to generate a spherical distribution of **radial** random walk points in 3D space. The following code works, but the random walk lines aren't radial. Why ? Where is my mistake ?               MinSprite := 0.006; (* min radius of sprites *)     MaxSprite := 0.03; (* max radius of sprites *)     SpriteOverlap := 0.75; (* min separation between sprites *)     IterationStep := 0.1;     NumberOfSteps := 20;     thickness = 0.09;     pointsmean = 20;     pointssd = 12;          SpriteSize[p_] := MinSprite + (MaxSprite - MinSprite)Norm[p];          SeedRandom[];     RandomWalk = Flatten[Table[{x,y,z}={dist Sqrt[1 - cosinus^2]Cos[phi],dist Sqrt[1 - cosinus^2]Sin[phi],dist cosinus};         {u,v, w}={0.0, 0.0, 0.0};         dist = RandomReal[{5,10}];         phi = RandomReal[{0,2Pi}];         cosinus = RandomReal[{-1,1}];         velocity = Abs[RandomReal[NormalDistribution[0,s]]];          Line[NestList[(         u+=velocity Sqrt[1 - cosinus^2]Cos[phi];         v+=velocity Sqrt[1 - cosinus^2]Sin[phi];         w+=velocity cosinus;         #+IterationStep{u,v, w})&,{x,y, z},NumberOfSteps]],{s,0.25,0.75,0.007}][[All,1]],1];          CloudsParticles = Flatten[Table[(#+RandomReal@LaplaceDistribution[0,thickness])&/@#,{Max[1,IntegerPart@RandomReal@NormalDistribution[pointsmean,pointssd]]}]&/@RandomWalk, 1];          max=Max[Norm/@CloudsParticles];     NormalizedParticles = CloudsParticles/max;          MinSeparation[p_] := SpriteOverlap SpriteSize[p];     KeepPoint[{p_,q_}] := Norm[p]<Norm[q]||Norm[p-q]>MinSeparation[p];     FilterOnce[pts_] := With[{nf=Nearest[pts]},Select[pts, KeepPoint[nf[#,2]]&]];     PointsCoords = FixedPoint[FilterOnce,NormalizedParticles];          ListPointPlot3D[PointsCoords,BoxRatios->{1,1,1},ImageSize->800,SphericalRegion->True,PlotStyle->{Blue,PointSize[Small]}]      Here's a sample of the output. As you can see, this isn't a radial distribution : ![This distribution isn't radial](http://i.stack.imgur.com/FhfTK.jpg) The mistake most probably lies in the **RandomWalk** declaration, but I can't see it. Anyone has an idea of what may be wrong ? Take note that I'm using _Mathematica 7.0_ only. **EDIT :** I must admit that this method isn't a clever way of defining a random distribution of points around radial lines. I'll have to do it differently.


Understanding Bilinear ImageResize

In trying to understand basic image transformations, I have attempted to code my own image resize function that uses bilinear interpolation. I checked my work against Mma's `ImageResize[...,Resampling->"Bilinear"]` command and the results are similar, but not the same. The following minimal example demonstrates how I do not fully understand Mma's algorithm. Let `im={{1,.5,0}}`, a `3x1` picture of grayscale values. "Common sense" and knowledge of bilinear interpolation tell me that resizing this image to `5x1` should give `{{1,.75,.5,.25,0}}`. However, `ImageData[ImageResize[Image[{{1, .5, 0}}], {5, 1}, Resampling -> "Bilinear"]]` returns `{{1,.8,.5,.2,0}}`. Resizing to a `6x1` gives `{{1., 0.875, 0.625, 0.375, 0.125, 0.}},` where the middle 4 terms are equally spaced at `.25` apart, but the first and last two elements are spaced `0.125` apart. Resizing to a `9x1` gives `{{1., 1., 0.833333, 0.666667, 0.5, 0.333333, 0.166667, 0., 0.}},` which further confuses me as the first and last two entries are repeated. These results are similar to what MATLAB produces, though Octave (I am told) produces what I think should be right - where all entries are equally spaced apart from `1` down to `0.` I checked with two image editing programs, and one gave results similar to Mma and one gave results similar, but not exactly the same, to my "common sense." Can anyone explain how _Mathematica_ is implementing bilinear interpolation?


InstallJava::fail error when importing an image with a Raspberry Pi

I'm trying to import an image in Mathematica on my Raspberry Pi. The code is simple but I get an error when importing:               $ wolfram     Wolfram Language (Raspberry Pi Pilot Release)     Copyright 1988-2014 Wolfram Research     Information & help: wolfram.com/raspi          In[1]:= SetDirectory["~/"];          In[2]:= i=Import["small.jpg"];      > >     InstallJava::fail: A link to the Java runtime could not be established. >   This is the image I'm trying to import: http://i.stack.imgur.com/zzSLr.jpg It's 1.5 MB large so the Pi should have no problem importing it. Why do I get this error and how can I prevent it? * * * UPDATE: I believe this is caused when the computer is running out of memory. I don't know a sure way to reproduce it but it keeps happening if I do other memory-intensive tasks on my Raspberry Pi. I'd like to know if there's a way to prefevnt this. and I got this error: > /opt/Wolfram/WolframEngine/10.0/SystemFiles/Kernel/Binaries/Linux- > ARM/WolframKernel: error while loading shared libraries: > /opt/Wolfram/WolframEngine/10.0/SystemFiles/Libraries/Linux- > ARM/libWolframEngine.so: cannot make segment writable for relocation: Cannot > allocate memory


Rotating & Trimming grids

I want to draw a graphic $20\times20$ grid, rotate it by $\theta$ around $(0,0)$, and trim off the part on the right of the y-axis, so I came up with               ImageTrim[Rotate[GraphicsGrid[Table["", {20}, {20}], Frame -> All], Dynamic[\[Theta]], {0, 0}], {-1000, -1000}, {0, 1000}];      But it gives no output, but an error message instead > ImageTrim::imginv: Expecting an image or graphics instead of [an oblique > orange square wich usually indicates something's wrong] What should I do?


How to plot the output of a calculation with a changing variable

The following code successfully manages to plot the cross-section, and give me the maximum depth of a weld pool, for a given set of parameters. What I would ideally like to be able to do is to plot a graph of how the the maximum depth of a weld pool varies with a parameter (ie. `v` between `0.915` and `1.5`). I think I am essentially looking to make a for loop so I can plug many different values for v in, However `Do` does not seem to work in this case. Any help would be greatly appreciated!               k = 15.75;     α = 5.79*10^-6;     T = 1015;     η = 0.6;     Q = 600;     v = 0.915;     y = 0;          g[x_?NumericQ] :=        Quiet[ FindRoot[T == (η Q)/(2 π k Sqrt[x^2 + y^2 + z^2])*Exp[                                                (-v (x + Sqrt[x^2 + y^2 + z^2]))/(2 α)],                         {z, -0.0001, -0.1, -0.0000001}][[1, 2]]]          p = Plot[ g[x], {x, -0.00001, -0.0037}, Filling -> Axis,      FillingStyle -> Orange, AspectRatio -> Automatic]          FindMinimum[g[x], {x, -0.001}][[1]]


Trouble understanding a piece of code found on Wolfram Blog

I am trying to go through this Wolfram Blog example: http://blog.wolfram.com/2009/02/12/flag-analysis-with-mathematica/ on country flag analysis. I am having a problem understanding the following piece of code:               countryColors =       (# -> Catch[Intersection[               StringSplit[                If[Head[#] === Missing, Throw[""], #]& @                 CountryData[#, "FlagDescription"]],               colorNames]]) & /@ CountryData[];      where `colorNames` is just a list of colors. I do not understand `&@` in the above piece of code. What I know is that `&` is used to define a pure function, and `@` is used as a Prefix. If, for example, the `If` yields true, then it returns a country name. What does it mean to have `&@` after that?


Does $x>0$ imply that $x\in\mathbb{R}$?

Let’s assume I input               Assuming[x > 0, expression]      Is it assumed by _Mathematica_ that $x$ is a real number? Or that the real part of $x$ is positive? Something else? A simple _Mathematica_ illustration would be welcome.


Functions, Options and Symbols

In the normal _Mathematica_ language, where no built-in symbols are redefined and no evil things happen, is it a valid assumptions, that no function symbol (`Plot`, `Print`, `Attributes`) is also an option name (like `PlotRange`, `ColorSpace`, `ImageSize`). Furthermore, is it save to assume that symbols carrying an `OwnValue` (`$MaxNumber`, `Pi`, `$Failed`) are in neither of the other two groups? To say it straight out: Does someone find a function, which is used as an option too?


How to partition a list in a specific way

I have a list:               a = {{1, 2, 3, 4, 1, 2, 3, 4}, {5, 6, 7, 8, 5, 6, 7, 8}};      Using `Partition` and `Map` I get:               Partition[#, 4]& /@ a      > >     {{{1, 2, 3, 4}, {1, 2, 3, 4}}, {{5, 6, 7, 8}, {5, 6, 7, 8}}} >   And now, I would like to get a list which looks like:                {{{{1, 2},{3, 4}}, {{1, 2},{3, 4}}}, {{{5, 6},{7, 8}}, {{5, 6},{7, 8}}}}      I tried to play around with `Partition` and `Map`, but I did not manage to create such a list. Of course there are easy ways to do it using `Do` loops and `AppendTo`, but I very much need to avoid `Do` loops. Does anybody see the way to create the list?


Speeding up mathematica by subsitituting numerical values

According to this Wolfram Blog post, one can speed up Mathematica code by substituting numerical values as soon as possible. How does one substitute before the main expression is evaluated? The following timings show the problem:               In[881]:= Timing[      meanFirstPassage[N[.95* tenDesigner + (1. - .95) tenRandomUser], si,        gi]]          Out[881]= {0.46267, 4.3469}          In[880]:= Timing[      meanFirstPassage[       N[k* tenDesigner + (1. - k) tenRandomUser /. k -> .95], si, gi]]          Out[880]= {2.77539, 4.3469}      When I use the function above in `Plot` it reverts to the slow version in which the inner expression involving `k` is symbolically evaluated. As noted by the response below, `With` does the trick. My main goal was to speed up `Plot`. Here is a self-contained example:               In[961]:= d = 100;     m1 = Table[RandomReal[], {d}, {d}];     m2 = N[Table[RandomInteger[], {d}, {d}]];          In[964]:= .95*m1 + (1. - .95)*m2; // AbsoluteTiming          Out[964]= {0.009045, Null}          In[965]:= k*m1 + (1. - k)*m2 /. k -> .95; // AbsoluteTiming          Out[965]= {0.059908, Null}          In[966]:= With[{k = .95}, k*m1 + (1. - k)*m2]; // AbsoluteTiming          Out[966]= {0.008615, Null}          In[967]:= Plot[Mean[k*m1 + (1. - k)*m2], {k, 0, 1}]; // AbsoluteTiming          Out[967]= {10.182414, Null}          In[968]:= Plot[With[{k = x}, Mean[k*m1 + (1. - k)*m2]], {x, 0., 1.}]; // AbsoluteTiming          Out[968]= {1.821481, Null}


Choosing $n$ equidistant points on a circle with given radius and center

I would like to have a function `circle` which takes two inputs: a tuple `{x,y}` and a real number `r` and outputs the cooridinates of points on the circumference of a circle that is centered at $(x,y)$ which has radius $r$. Importantly, I want the points to be equidistant on the circle. I tried to implement the procedure here described as Circle Point Picking. But I don't get equidistant points. Kindly help me. Here is the code I tried:               num = 20; r = 50;     circle = Module[{},       random = RandomReal[{-2, 2}, {num + 10, 2}];       random = Take[DeleteCases[random, #1^2 + #2^2 >= r^2 &], num];       Table[r {(x[[1]]^2 - x[[2]]^2)/(x[[1]]^2 + x[[2]]^2),           2 x[[1]] x[[2]]/(x[[1]]^2 + x[[2]]^2)}, {x, random}]       ]      The above code will output `num=20` points on a circle that are not equidistant on the circumference. Here is the output represented as a `ListPlot`:               ListPlot[circle]      ![](http://i.stack.imgur.com/zgcee.png) _Irrelevant as such for the question, but if anyone is curious:_ The context for getting equidistant points is that I want to embed a graph with _some_ vertices located on the points. If you instead know how to do this, kindly tell me. I cannot find a use for `CircularEmbedding` because I only want a circular embedding on some vertices of the graph, not all vertices. The only way I see is to explicitly give the vertex cooridinates as points on a circle.


Connecting to a remote machine

The simple answer is               ssh username@hostname      Enter your password and you are set. My problem is that I wish to connect to a computer in my university. There are several machines which everyone can access but before doing so we have to go through the login machine. So say the name of the login machine is login.school.edu Then I would do               ssh login.school.edu      From there then I would ssh to one of the several machine names               ssh ld00      They have 112 machines, so I can do ld00 through ld112. The reason I'm asking this is because I want to run the Mathematica Kernel in one of these machines but in the Kernel configuration it asks for the hostname. The hostname cannot be the login machine because this machine does not have Mathematica installed and this machine wasn't meant for computations. Any way I can bypass this? # Update: So it seems that those machines are not public in the internet. Now that I'm in the deparment I connected to the network and now I can do a simple               ssh username@hostname      The administrator of the machines did say something interesting: > I do not know what SSH implementation is currently part of MacOS. Under > OpenSSH (used on Linux machines) it is theoretically possible to make > creative use of the ProxyCommand directive to make it appear as if those > hosts are directly available to SSH. I cannot tell you how to do this, > however; I've only seen mention of it. So, does anyone know how to do this so that I can connect to the kernel from outside the school?


NumberOfSpanningTrees command not working correctly

I am attempting to use the Combinatorica `NumberOfSpanningTrees` command for all `n-cycle` graphs from 3 to 30. I am trying to get a table form showing whether it is true or false that `n-cycle` graphs have `n` spanning trees. However Mathematica does not seem to recognize the command. Am I am pre- loading the Combinatorica packages correctly?               << Combinatorica`     Table[{i, NumberOfSpanningTrees[CycleGraph[i]] == i}, {i, 3, 30}] // TableForm      The output I get is: ![enter image description here](http://i.stack.imgur.com/CqKsL.png) I have also tried loading Combinatorica using the `Needs["Combinatorica`"]. Any ideas?


Polar Differential Equation

I have a polar differential equation (this is the reduced variant) as: $$r' = 0, \theta' = 1$$ I figured out (from previous answers) that I can nicely convert this to Cartesian and use StreamPlot as:                 field = {0, 1};            TransformedField["Polar" -> "Cartesian", field, {r, \[Theta]} -> {x, y}]            StreamPlot[{-(y/Sqrt[x^2+y^2]),x/Sqrt[x^2+y^2]},{x,-2,2},{y,-2,2},        StreamColorFunction->"Rainbow"]      This generates the correct phase portrait and worked great. I was even able to animate it. My question now is how can this field (polar DEQ) be solved as a polar DEQ? Can't this be solved as such and plotted using polar plots to arrive at the same phase portrait? Am I missing something? I tried NDSolve without luck, so think I must be missing something basic here. Is something special required for polar type DEQs in Mathematica?


How to copy hyperlink addresses using the keyboard

I would like to copy the address of a hyperlink in _Mathematica_ using the keyboard. I found code for copying hyperlink addresses in `ContextMenus.tr`:               MenuItem["&Copy Address", FrontEndExecute[      {FEPrivate`FrontEndExecute[FrontEnd`CopyToClipboard[       CurrentValue[{ButtonBoxOptions, ButtonData}]]]      }     ], MenuEvaluator->None]      but using this to make a keyboard shortcut in KeyEventTranslations.tr as follows doesn't seem to work.               Item[KeyEvent["c", Modifiers -> {Control, Option}], FrontEndExecute[      FrontEnd`CopyToClipboard[ CurrentValue[{ButtonBoxOptions, ButtonData}]]]     ]      (`KeyEvent["c", Modifiers -> {Control, Option}]` didn't seem to work at all as a shortcut combination, but other combinations that worked for other actions didn't work for copying the hyperlink address.) One problem is that I'm not sure whether the hyperlink has to be selected or what.


Trying to model Heat flow trough different materials with NDsolve

What I'm trying to achieve is model of the heat flow, in this case for the simplest 1D case,its relatively easy to do for the steady state case, but when I try to do it with NDsolve so I get the distribution of heat over time,I fail to come up with a good way to connect the two differential equaions, I recently modeled a gravity field where the same differential equation is applied many times to different bodies, that I got to work, but I dont understand how to link "differeet" ODE/PDE's This is my code, so far, and I intend to display that solution with Manipulate and Plot: :ps I added the [] in u[1] and u[2] last minute to see if it changes anything before they were just called u1[] and u2[] respectively, it might be nonsensical but my original question remains thanks in advance!               heateqs = {D[u[1][x, t], t] == D[u[1][x, t], {x, 2}],         D[u[2][x, t], t] == 0.5 D[u[2][x, t], {x, 2}]};          bcs = {u[1][0, t] == 300, u[1][5, t] == u[2][5, t],         Derivative[1, 0][u[2]][10, t] == 0};          ics = {u[1][x, 0] == u[2][x, 0] == 0};          sol = NDSolve[{heateqs, bcs, ics}, u, {x, 0, 10}, {t, 0, 10}]          NDSolve::bcedge: Boundary condition u[1][5,t]==u[2][5,t] is not specified on a single edge of the boundary of the computational domain. >>


add a color bar legend to a 3D plot

This has a connection to the previous post here: puzzled with a color function Also, a recent post of mine appeared here: Create a color bar plot legend but I should have solved the problem with the color function before asking the question about color bar. If opening a new thread goes against the forums policies I apologize. Thanks to the answers I got, I have now what I wanted               h = ParametricPlot3D[lst, {u, 0, 2*Pi}, {v, 0, Pi}, Mesh -> False,          ColorFunction -> (Function[{x, y, z, u, v}, Hue[Rescale[dam, {0, 1}]]]),          ColorFunctionScaling -> False, ImageSize -> 800];     g = Plot3D[Rescale[dam, {0, 1}], {u, 0, 2*Pi}, {v, 0, Pi}, Mesh -> False,          ColorFunction -> (Function[{u, v, z}, Hue[Rescale[dam, {0, 1}]]]),          ColorFunctionScaling -> False, PlotRange -> All];     Row[{h, Show[g, ImageSize -> 400]}]      What I further want is to add a color bar to each plot. Something like               Legended[h, BarLegend[{colFun,{min,max}}]] (*version 9*)      which does not give the requested color bar. Also,               colourBar =        DensityPlot[y, {x, 0, 1}, {y, 0, 1}, AspectRatio -> 5,         PlotRangePadding -> 0,         FrameTicks -> {{None, Range[0, 1, 0.1]}, {None, None}},         ColorFunction -> colFun];     Row[{Show[gr1, ImageSize -> Large],        Show[colourBar, ImageSize -> Small]}] (*vesrion 8 alternative*)      does not work as well. Thanks in advance for any advice. Dimitris


Problem with #1's in DSolve

I've entered the following functions into my notebook, but the solution to them contains #1's that I can't seem to make any sense of. The functions are:               z := R[r, t]     P := D[R[r, t], t]     eqn := P^2 - (2 x[r])/z - 2 y[r] == 0      sol = DSolve[eqn, z, t]      and the solution returns the following:               {      {R[r, t] ->        InverseFunction[-((Log[Sqrt[#1] y[r] + Sqrt[y[r]] Sqrt[x[r] + #1 y[r]]] x[r])/         y[r]^(3/2)) + (Sqrt[#1] Sqrt[x[r] + #1 y[r]])/y[r] &][-Sqrt[2]t + C[1]]},       {R[r, t] ->        InverseFunction[-((Log[Sqrt[#1] y[r] + Sqrt[y[r]] Sqrt[x[r] + #1 y[r]]] x[r])/         y[r]^(3/2)) + (Sqrt[#1] Sqrt[x[r] + #1 y[r]])/y[r] &][Sqrt[2] t + C[1]]}     }      Any thoughts on the matter?


Best way to add KeyEvents and faster Quit

Many users have asked how to add `KeyEvent`s to speed/improve keyboard input. This is just a random example. The technique is always the same. It requires that you _manually_ modify `KeyEventTranslations.tr` (an important system file). It always struck me as a bit odd that even power users propose to manually do this. Surely this system file is loaded into _Mathematica_ at the start of a session (or not?), so it is perhaps possible to _programmatically_ add the necessary KeyEvents to an already running _Mathematica_ session. Of course in this case the new key bindings will only be temporary, but this might even be preferable in some cases. So the question is: is it possible to _programmatically_ add the necessary `KeyEvent`s to an already running _Mathematica_ session, without changing the `KeyEventTranslations.tr`? Alternatively: can we program _Mathematica_ to backup `KeyEventTranslations.tr` and programmatically modify it? I know this is possible, I just wonder if someone has done it. And perhaps automatically reload the new version so that it takes effect right away? * * * **The art of Quitting.** I take the occasion to post another item related to "saving keystrokes for your retirement": It recently came to my attention that many/most users when they want to quit the kernel, type `Quit[]`. Well...the good news are that you just need to type `Quit` (saving two keystrokes).


InterpolationOrder for ContourPlot

How do I acheive something like `InterpolationOrder` in `ListContourPlot` for `ContourPlot`? My main problem is I want to smooth the contours in `ContourPlot`. I have some points which I'm going to call data, which is 10,000 points and looks like this:               {{24.3,40.0},{29.2,56.0} ... }      I create this distance function:               D[x_,y_]=(#[[1]]-x)^2+(#[[2]]-y)^2&/@data      Now, my function is supposed to count the number of points within a certain distance of any x,y position and divide by the total number of points:               F[x_,y_,r_]:=Length[Select[D[x,y],(#<r^2)&]]/Length[data]      Now I can plot my function,               ContourPlot[F[x,y,5],{x,0,100},{y,0,100}]      The problem is my function is not naturally smooth. I know about `SmoothDensityHistogram` and `DensityHistogram`, but I like the more simple look of smoothed contours. Can anyone help with this?


Sample of the random times at which the random walk crosses the boundary

I defined a security boundary for a random walk:               p = 5000;(*steps*)     tc = 15;(*cube edge length*)     tp = 0.2;          random = Accumulate[     Join[{RandomReal[{-tc, tc}/2, 3]},      RandomVariate[NormalDistribution[0, tp], {p, 3}]]];          periodizedWalk = Mod[random, tc, -tc/2];     splitPeriodizedWalk =      Split[periodizedWalk, EuclideanDistance[#1, #2] < tc/2 &];          With[{cube = First[PolyhedronData["Cube"]]},      Graphics3D[{{Opacity[0.1], Scale[cube, tc]}, Line[random]},      Boxed -> False]]      and now i want to obtain a sample of the random times at which the random walk crosses the boundary for the first time. Something like this:               W = {}; For[i = 1, i <= 5000, i++,     PosFinal = {0, 0}; EME = 1;     While[True,     PosFinal = PosFinal + step[Random[]];     If[Norm[PosFinal] > 15, Break[]];          EME = EME + 1;     ];     W = Append[W, EME];     ]      but i want these two codes to be related. Would like some help please :)


HypergeometricPFQ

I am trying to get a simple but relatively ugly result out of the following summation, however, mathematica gives me an expression which includes HypergeometricPFQ. Obviously, I am doing something wrong, which is pretty classical for me. Can somebody please point me out what went wrong? The result should be an expression involving factorials and product (maybe). thank you!               a[j_, q_, k_] := (q! (j + q - 1)!)/((j! (q - j)!) (j - k + q - 1)!);     aa[i_, q_, k_] := a[i - q + k + 1, q, k];     b[j_, q_, k_] = (-1)^j Sum[aa[i, q, k]*aa[j - i, q, k], {i, 0, j, 1}]          ((-1)^j k! (j + k)! (q!)^2 HypergeometricPFQ[{-j, 1 + k,       1 + k - 2 q, -1 - j - k + q}, {-j - k, 2 + k - q, -j - k + 2 q},      1])/(j! (1 + k - q)! (1 + j + k - q)! (-1 - k + 2 q)! (-1 - j -        k + 2 q)!)


simplify assuming a variable equals zero

How can one simplify an expression by assuming that one of the variables is equal to zero? For instance, while `Simplify[%,a>0]` gives the desired output, `Simplify[%,a=0]` produces the following error:               $Assumptions::bass: 0 is not a well-formed assumption. >>


plot function against composite variable

How can one plot $f(x,y)$ as a pseudo-univariate function of $x/y$ (or some other composition of these variables) over the domain $a<\frac{x}{y}<b$. `Plot[f,{x/y,a,b}]` produces the following error               Plot::write: Tag Times in x/y is Protected. >>      The alternative is to redefine the function in terms of a single variable (i.e., replace all occurrences of `x/y` with a new variable `z`); however, I wish to avoid tedious manual redefinition if possible. **Edit:** As a simple example, consider the function $$f(x,y) = \frac{y^2}{x^2}\times\exp(x/y)+5\frac{x}{y}.$$ This function could be redefined as $$g(z)=\frac{\exp(z)}{z^2}+5z$$ where $z\equiv x/y$. One could redefine their function $f(x,y)$ as $g(z)$, but it would be more convenient if one could simply plot $f(x,y)$ against $x/y$ as a pseudo- univariate function.


rasterListContourPlot With PlotLegends in Mathematica 9

Jens Nöckel has write functions about (List) Contour Plots with rasterized shading in Mathematica: http://pages.uoregon.edu/noeckel/computernotes/Mathematica/rasterContourPlot.html It works well. But in Mathematica 9 it can not work with PlotLegends. How to modify? I can use Grid to combine a result of rasterListContourPlot with a legend, but this lost the link of the graphic with the legend.               rasgrap = rasterListContourPlot[RandomReal[1, {10, 10}], InterpolationOrder -> 3]     mylegend = BarLegend["LakeColors"];          Grid[{{rasgrap, mylegend}}]      rasterListContourPlot can be found in the above link.


Why do quote marks appear in output when saved with Save Selection As?

_Update:_ As Simon Woods astutely observed this problem only occurs when you select the cell _contents_ rather than the entire cell via the bracket. Those two tested this and reported, please check again selecting only the contents and see if the behavior appears. * * * In version 10 quote marks (i.e. `ShowStringCharacters`) appear in output when it is saved as an image using **Save Selection As...** :               CharacterRange["a", "z"]      Appearance in the Notebook: > {a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w, x, y, > z} When saved as a PNG: ![enter image description here](http://i.stack.imgur.com/jWDIq.png) These quote marks do not appear in export from version 7, at least as I had it configured. ### Why do they appear? ### Can I keep them from appearing?


MapThread gives different results from ToExpression when trying to assign variables from a list

I have the following data set:               data = {{"Jakarta","Surabaya","Bandung"},{1,2,3}}      and I'd actually like to assign the numerical values to the categorical data so that Jakarta = 1, Surabaya = 2 and Bandung = 3. If I use `MapThread[Set, {ToExpression[data[[1]]], data[[2]]}]`it works fine but when I try to assign the variables individually I keep on getting error messages:               ToExpression[data[[1, 1]]] = data[[2, 1]]     Set::write: "Tag ToExpression in ToExpression[Jakarta] is Protected."      However, `ToExpression[data[[1,1]]` works fine May I know why my second approach is not working?


How can I return the color at a coordinate in an image?

I have an imported and cropped image:               TestPicture = Import["filepath.jpg"];     TestPictureCropped = ImageCrop[TestPicture, Min[ImageDimensions[TestPicture]]];      How can I specify a coordinate in the image and return the color of the nearest pixel to the coordinate? Thanks for any help!


How to modularize custom controls for Manipulate?

**Background:** My `Manipulate` programs are becoming (too) long. I want to split them up in to independent modules, if at all possible. Take this program as a prototype:               Manipulate[        {i, 2 i, 3 i},        {{i, i, "i="}, -11, 11, 1},        Initialization -> {i = 0}     ]      Suppose this is in fact a custom control with parameters {`label, begin, end, step}`                  {{i, i, "i="}, -11, 11, 1},      Ideally I would be able to code something like               Manipulate[         {i, 2 i, 3 i},         = = = = CustomSlider[i, " i= " , -11, 11, 1 ]  = = = =         Initialization -> {i = 0}     ]      **Question:** So the question is about how to get a function to work as a control in a `Manipulate`, if that is at all possible? Any Ideas or other suggestions to handle my need of refactoring my `Manipulate` code?


Filter a list generated with Tuples

I generated with               Tuples[{{1, 2, 3, 4, 5}, {1, 2, 3, 4, 14}, {1, 2, 3, 4}, {1, 2, 3, 4},             {1, 5, 6, 7, 8}, {5, 6, 7, 8, 10}, {5, 6, 7, 8}, {5, 6, 7, 8}}]       elements like `{1,2,3,4,5,6,7,8}`, with all the possible combinations but I want to exclude elements with the same numbers in different places like `{1,1,3,4,5,6,7,8}` or `{1,2,3,5,5,6,7,8}`. How can I do that in a simple way?


Tuples without self-loop

I have a simple question coincerning the _Mathematica_ function `Tuple`. Currently, I apply the following code               x = {1, 2, 3};     Tuples[x, 2]      Obviously I get: ![enter image description here](http://i.stack.imgur.com/osE2C.png) How can I delete all self-loops from this list, i.e., delete `{1, 1}, {2, 2}, {3, 3}`? Is there a built-in function?


Finding parameters for first positive root of solution to differential equation to be equal to a desired value

I have a differential equation with parameters. The objective is to vary the parameters such that the first positive root of the solution is equal to a desired value `obj`. As the equation is very involved, I decided that I'd use `user1084363`'s question in Find all roots of an interpolating function (solution to a differential equation), which inspired the first part of my solution. Currently, my solution is to manually manipulate the parameter `k` to obtain the desired solution. For example, if I'd like the first root of the equation to be `1.6`, I would use the following line of code               obj=1.6;     Manipulate[Flatten[Reap[NDSolve[     {1.09 x''[t] - k* x'[t] + 1.1759 Sin[x[t]] == 0,  x[0] == Pi/3, x'[0] == 0}, x, {t, 0, 50},      Method -> {"EventLocator", "Event" -> x[t],"EventAction" :> Sow[t]}]]][[2]]-obj,      {k, 0.01, 0.1}]      and manually vary the value of `k` till I obtain a value of zero. However, this is quite time consuming and I was wondering whether there was a way to automate the process. My first thought was to use `Root`, with `k` as the variable, but this doesn't work as of now due to the presence of the differential equation.


Is there any way to collect only variables with a specific power?

Suppose I've got this:               In[13]:= Expand[(a + b) (b + c) (c + a)]          Out[13]= a^2 b + a b^2 + a^2 c + 2 a b c + b^2 c + a c^2 + b c^2      And I want to collect only terms involving a^2. In other words, I want the following output:               a^2(b + c) + a b^2 + 2 a b c + b^2 c + a c^2 + b c^2      How can I do this? If I use the following:               Collect[%, a^2]      Then it simply groups terms into the highest power of a, even if the highest term is less than 2. So it results in this:               In[14]:= Collect[%, a^2]          Out[14]= b^2 c + b c^2 + a^2 (b + c) + a (b^2 + 2 b c + c^2)      Ideally, I would like to extend this further to collect all a^2, b^2, and c^2 in one expression. So that running my command would transform the original fully expanded expression into the following:               a^2(b + c) + b^2(a+c) + c^2(a+b) + 2 a b c      In a single command. It this possible?


Why is MapIndexed better than mapping over a range?

### Background I'm working on an application in which I need to create and control two sets of locators. I know from reading the _Mathematica_ documentation and certain posts on _Mathematica_.SE that this means I can't base my application on a `Manipulate` expression. I have very little experience with interactive applications based on the dynamic objects that sit below `Manipulate`, so I searched "multiple locators" to see what I could learn. Quite a bit as it turned out. However, to keep this short, I'll just say I finally settled on a approach described by jVincent in his answer to this question. ### Question In my situation I am going to have one set of locators that are displayed as black squares and a second set displayed as red dots. The application will start out by showing no locators in its content pane. The user will create as many of each kind as he/she wants by clicking on buttons provided for the purpose. My adaptation of jVincent's code to my situation is as follows:                DynamicModule[{black = {}, red = {}},          Grid[{{            Framed@Graphics[               {Dynamic@MapIndexed[                   With[{i = #2[[1]]},                       Locator[Dynamic[black[[i]]],                         Style[\[FilledSquare], Black]]]&, black],                Dynamic@MapIndexed[                   With[{i = #2[[1]]},                      Locator[Dynamic[red[[i]]],                         Style[\[FilledCircle], Red]]] &, red]},               PlotRange -> {{0, 1}, {0, 1}}],            SpanFromLeft},            {Button["Add Black", AppendTo[black, RandomReal[1, 2]]],              Button["Add Red", AppendTo[red, RandomReal[1, 2]]]}}]]      ![two sets of locators](http://i.stack.imgur.com/VeEYm.png) The code works well. I have no complaints. One expression in the code surprises and intrigues me, however. This is:               {Dynamic@MapIndexed[         With[{i = #2[[1]]},             Locator[Dynamic[black[[i]]],               Style[\[FilledSquare], Black]]]&, black]      It's clear what this does: it creates a list of locators based on a list of locations (pairs of real numbers). It's clear that the `With` trick is needed to work around the `HoldFirst` attribute of `Dynamic`. What is clever and surprising -- I would have never thought of it -- is the use of `MapIndexed` to obtain the indexes that must be inserted into `black[[...]]`. What I would have thought of is:                {Dynamic@(With[{i = #},           Locator[Dynamic[black[[i]]], Style[\[FilledSquare], Black]]] &             /@ Range@Length@black)      which is much more banal but gets the job done. I wonder why jVincent chose `MapIndexed`? Is it really that more efficient than mapping over a `Range`? Or is there some other deeper advantage beyond my ability to fathom. I will say I don't think creating a range every time the expression in question is evaluated is much more expensive than what `MapIndexed` does to create the pairs it uses, but I could be wrong. I'm afraid I'm one those _Mathematica_ programmers who knows the value of everything but the cost of nothing (remembering an old joke made about Lisp programers).


Creating Recursive Sequences

Quite a simple question, I reckon, however, even quite an extensive search hasn't helped me. I want to define a recursively defined sequence that starts with defined `f[1]` and `f[2]` and distinguishes the input like so: `f[3k]`, `f[3k+1]`, `f[3k+2]`. Each of these would have its own expression. For further clarification, an example: $$ f(3n) = f(n)+1 $$ $$ f(3n+1) = f(n)+2 $$ $$ f(3n+2) = f(n)+3 $$ How does one go about that? I do know how to write simple recursion formulas on the level of Fibonacci or a factorial, it's only the distinguishing the input part. Also, this should be possible without any `if` statements, etc. Thanks for any help!


What technical obstacles prevent all Mathematica code compiling to C

The following represents an attempt at a very simple view of the levels in Mathematica code: ![enter image description here](http://i.stack.imgur.com/DB7Xi.png) We have had lots of questions about deployment and compiling Mathematica code to C. Some of these for speed, others for deployment. My interests go to deployment. While some have mentioned in various comments that compiling "symbolic code" presents a "hard" problem or that lots of Mathematica has lots of complicated things that make it difficult to compile, I don't have a clear grasp of what really stands in the way of Wolfram doing this. At some point all code that runs on a computer gets expressed at a machine code level. The C code to which some Mathematica code can compile clearly sits above this. The answers to How to specify Mathematica as a programming language? provide some context for thinking about all of this. I appreciate that Wolfram might have other business priorities. Those don't concern me in this question. To my mind the design of a programming language/tool as compiled or interpreted seems more like a business/marketing decision rather than a hard choice that completely locks a language into one or the other. Why should such a design choice limit a universal machine? I have wondered if everyone would regard such a question as this as out of scope here, but I do think someone could provide a specific answer and an answer would go a long way to understanding what we can do, what we could do, and perhaps what Mathematica will never enable us to do. So, simply and directly, I'd like to know what **technical obstacles** prevent all Mathematica code from compiling to C (byte-code would do too ;-)? ![enter image description here](http://i.stack.imgur.com/EdnEy.png)


Difference between Map[f[#] + g[#] &, {a, b, c}] and Map[f[x]+g[x]&, {a, b, c}]

Map[f[#] + g[#] &, {a, b, c}] vs Map[f[x]+g[x]&, {a, b, c}]      My question is: why is the output different?               Map[f[#] + g[#] &, {a, b, c}]          (* {f[a] + g[a], f[b] + g[b], f[c] + g[c]} *)      and               Map[f[x] + g[x] &, {a, b, c}]          (* {f[x] + g[x], f[x] + g[x], f[x] + g[x]} *)


Using a variable to tell Mathematica which existing variable to manipulate

I have an estimation routine I have coded up, I want now to do some tests on it where I pick a particular parameter and run the estimation for differing values of that parameter. What I want is to be able to specify the parameter name I am interested in changing at the top of the file and from then on just run a loop substituting different values into the chosen parameter. So for example I want something to the effect of               paramToVary = a;     paramValues = Range[0, 1, 1/20];          Do[MyEstimation[a, b], {paramToVary, paramValues}]      except this wont work as written, `paramToVary` takes the values of `paramValues` whereas I want these to be going into `a` instead. Any ideas on how to do this or alternative solutions?


Measure perimeter of black edge in Mathematica

I have a pattern like the one below. How could I measure the total length of the perimeter of the black/white edge? This would give me a measure of spatial frequency. Any tips would be great! Thanks! ![](http://i.stack.imgur.com/7jt0I.gif)


Why does Simplify with TimeConstraint return Removed[$$Failure]?

Bug existed in version 7 and is fixed in version 10.0.0 * * * I have a rather ugly _Mathematica_ expression (edit: shown below) that I would like to simplify with a time constraint; simplifying without a time constraint or memory constraint does not return as long as I've had the patience to wait (a couple of hours). The problem, which I have not seen before, is that when I execute               Simplify[ expression, TimeConstraint -> 3]      I get an output that contains things like > >     ...10000 E^(29599743/514000) Removed[$$Failure]... >   The only warning message I receive during execution is > >     Simplify::time: Time spent on a transformation exceeded 3.` seconds, >     and the transformation was aborted. Increasing the value of > TimeConstraint option may   >     improve the result of simplification >   Is this a known issue? I can't find anything about it. I expect when using `TimeConstraint` that I will not get the simplest answer back, but I also expect to get a usable answer (which this is not). If you think it would be helpful to see the expression I'm trying to simplify, I can post it here. The simplest example in which I've had this problem has a `LeafCount` of `651` and `ByteCount` of `17312`. **EDIT** On the suggestion of @JacobAkkerboom, I am adding some more information so someone can try to reproduce the effect. Here is a compressed version of `expression`. > > > expression=Uncompress["1:eJxTTMoPSmNiYGAoZgESATmlxWnMIB4rkAjJzE0thkhyAImgxJLM/LzEnMzEyQoMnsJAEUNzYzNDQ0MDS2NzUwMIgCgH6Q7IL08tKmYEslwzf////x/Vlsz/cCF0xSA+YUc84Q5hygwEKUV1PaZKT6CxnjxAEZgbwe5kJWQBJycDQ6bFLnV1NFdmcsEtRVEP8lAmEw4H4bNo/Xnbn5kNH34xYQ0OLBoMjgFtYmSE2YTP7MJrq5hIMlvgDobZ+DV8UAYGEzYNIG5AZuY/jKgn7Oqp3w4yeEoCRYxMTAxNDMyMkGMOWzIbTQODPg1AMjzBEG9YqMGYqc+AYdRoDA+NGAabUIk/8ghFiicfKBoNLUwQEQmOXmIdeyAW6liwiqo0RpjtzvnFGVjUg+QzL7ADLcCiEl+4gzWCEgo4GPxd0thQdGQm3sZRx5EQwqMJf0glfHgKCs7MIzKtIVSSktYg5SkzSRkrs/7wt/+eQkARYwNTQ3NTcwtDI7wNN4KJD57VCHtAnuvXf3CDDZZZsFhYiQhKUrItwcYiKI9kMoS80kINMLARhHVfff3nP7i9ixxeFAUbllQFKTHA3scaPqPlwNAoB9CSE85+DvakTrDUIBifoLaTJzeQMDQ2RU2ko2lnEKcdUkPkctGr/55iQBFjy9H+0XBIANgKDyxG/QQp/UKC3WiORRl/wdpYRyqd0GJptHU7YhMmeuuWzP4R9eq5QdBHJK/dDgDIdwSQ"]; >   As mentioned, I get the problem simply by running               Simplify[ expression, TimeConstraint -> 3 ]      (or any other value of `TimeConstraint` I've bothered to check) `expression` contains standard arithmetic operations, the constants `E` and `Pi`, the operations `Cosh` and `Sinh`, and three variables named `y`, `z`, and `OD` (and yes, I should make `OD` lower case, but it's hard for me to see optical depth as anything but capitals). **FURTHER EDIT** I have now reproduced the problem in an expression without a time constraint. The new `expression1` has a `LeafCount` of `186`, so it's not really that complicated. > > > expression1=Uncompress["1:eJxTTMoPSmNiYGAoZgESATmlxWnMIB4rkAjJzE0thkhyAImgxJLM/LzEnMzEyQoMnsJAEUNzYzNDQ0MDS2NzUwMIgCgH6Q7IL08tKmYEslwzf////x/Vlsz/cCF0xSA+QgaXI36KMDBkNmjAlMJdj6myeas0g6cQUMTY3MTU0NDc0ALhWhYC1oD1WZobGaCCzO03mRnAzq1E8wOaa1gJmc8P5JgaWpggG+7JiBwASEGDxXMHYoHBwAiUBauoSmOEWe+cX5yBRT1IPvMCO9ACLCrxhTdYIxdIGCTn70LYa4JAjq6JGSK0wZ4DxRuxnvugjOy5SoSTgzPziPQcQiUpnoOkTmaSojKz/vC3/5B0ZmBqaG5qbmFohDdXEEy48Lgl7AGZL6v/ZgYixQ4WCyvBviI5nRAsDkDJNZMh5JUWaoCBjSDs8quv//z35AGKWBhbWBqYQYKMvPCCJxc0WyH+hgYMM6YU8YFFMN0RKk/ABYenGFDEDCVbGKAkFDx+BAcXH6jQsLQ0QpRkhGPpJ9A7mV9IKFkE7gA1IEITpeDGWvQhhRuppSANiwoySzfio3woFPHklYIAG9m/tw=="]; >     Simplify[ expression1 ] >   This returns nearly instantly with three instances of `Removed[$$Failure]`. Since there is no `TimeConstraint` set here, I have no idea what the problem is. I submitted a help request to _Mathematica_ , and I'll let you know if they give any useful response. In the meantime, thoughts are most welcome. Especially if you can tell me if the problem exists (or not) in other versions of _Mathematica_. I am running 9.0.1 on Mac OS 10.8.3. Thank you to Mr. Wizard for verifying the problem exists in MMA 7 on Windows.


Expand expression into quotient of negative power series

I have a function T(z) ![enter image description here](http://i.stack.imgur.com/DN5ZX.png) and want to expand it to the following form: ![enter image description here](http://i.stack.imgur.com/Sc5lL.png) At the end I want to have a list of equations, which can calculate a0, a1, a2, b0, b1 and b2 with different values of h1, h2, w01, w02 and T. The variable z does not matter. In the code I replaced T(z) with f to not get confused.               f = (((1 - z^-1)/(1 + z^-1))^2 + 2*h1*Tan[(w1*T)/2]*((1 - z^-1)/(1 + z^-1)) + (Tan[(w1*T)/2])^2)/(((1 - z^-1)/(1 + z^-1))^2 + 2*h2*Tan[(w2*T)/2]*((1 - z^-1)/(1 + z^-1)) + (Tan[(w2*T)/2])^2)      At first I tried to expand f with the Mathematica-fuction _Series_ in the way it is described here: How to expand a function into a power series with negative powers?               Series[f, {z, Infinity, 2}]      But the result is not what I need.               (2 h1 tan((T w1)/2)+tan^2((T w1)/2)+1)/(2 h2 tan((T w2)/2)+tan^2((T w2)/2)+1)+((-4 h1 tan((T w1)/2)-4)/(2 h2 tan((T w2)/2)+tan^2((T w2)/2)+1)+(4 (2 h1 tan((T w1)/2)+tan^2((T w1)/2)+1) (h2 tan((T w2)/2)+1))/(2 h2 tan((T w2)/2)+tan^2((T w2)/2)+1)^2)/z+((4 (2 h1 tan((T w1)/2)+tan^2((T w1)/2)+1) (2 h2^2 tan^2((T w2)/2)-h2 tan^3((T w2)/2)+3 h2 tan((T w2)/2)-2 tan^2((T w2)/2)+2))/(2 h2 tan((T w2)/2)+tan^2((T w2)/2)+1)^3+(4 h1 tan((T w1)/2)+8)/(2 h2 tan((T w2)/2)+tan^2((T w2)/2)+1)+(4 (-4 h1 tan((T w1)/2)-4) (h2 tan((T w2)/2)+1))/(2 h2 tan((T w2)/2)+tan^2((T w2)/2)+1)^2)/z^2+O((1/z)^3)      I would like to have, more or less, one polynomial series in the enumerator and a second in the denominator. Thank you.


How can I draw a hyperboloid given its generatrix?

I want to see how a hyperboloid of revolution is generated by its generatrix, _i.e._ by rotating one (say the one passing point $(1,0,0)$ and $(0,1,1)$) of the skew lines around another (say the _z_ axis). My trial:               Manipulate[               Show[                    ParametricPlot3D[{Sqrt[t^2 + (t + 1)^2] Cos@\[Theta],                     Sqrt[t^2 + (t + 1)^2] Sin@\[Theta], 1 + t}, {t, -1, 1}, {\[Theta],                   0, \[Beta]}, BoxRatios -> {1, 1, 1},                    PlotRange -> {{-2, 2}, {-2, 2}, {0, 2}}],                     ParametricPlot3D[{1 - t, 1 + t, 1 + t}, {t, -1, 1}]], {\[Beta], 0.1,              2 \[Pi]}]      However, the generatrix $(1 - t, 1 + t, 1 + t)$ doesn't match the hyperboloid. So how can I do it correctly?


Daubechies scaling function

In _Mathematica_ in wavelet package with the following codes               Phi[x_, j_, k_] := 2^(j/2) WaveletPhi[DaubechiesWavelet[3], 2^(j) x - k]       _Mathematica_ computes `Phi` for various values of $x,j,k$. How does _Mathematica_ do this computation? My guess is cascade algorithm. If it is cascade algorithm, again how _Mathematica_ does this computation because until now i have seen cascade algorithm just for $j=0$ and $k=0$. If _Mathematica_ does not use cascade algorithm what is the algorithm?


How to plot contours in the faces of a cube

I'm trying to plot contours of a function `f[x,y,z]` on the faces of a cube as the example below, which represents the domain of this function. Is there a way to do it in _Mathematica_? The `ContourPlot3D` evaluates the contours along the domain and I just want them in the faces, colored by the function. ![enter image description here](http://i.stack.imgur.com/2Ggat.jpg)


Stiffness or Singularity

So trying to run some simulations based on a model I found in literature. I am by no means a _Mathematica_ expert, or a mathematician for that matter. Initial I was getting a `NDSolve:ndsz` error so I changed the `Method` to `StiffnessSwitching`. Now I am getting an underflow error, change the `StartingStepSize` to `1/10` and I get an overflow. Am I just an idiot or what? I'm pretty sure I have all the initial conditions correct from the journal article (which I presume works).               Needs["DifferentialEquations`NDSolveProblems`"];     Needs["DifferentialEquations`NDSolveUtilities`"];     Needs["FunctionApproximations`"];     Clear["Global`*"];     σ = 300;     er0 = 4.4*10^3;     σ0 = 33;     psi = .65;     hstar = 2 psi/(1 + 2 psi);     littleh = 7.2*10^4;     tmin = 0;     tmax = 1000000;     (* for 5 model*)     Cat = 67;     kp = 10^6;     kc = .33;     ϵf = .049;     R = 8.314;     Temp = 1350;     Q = 316000;          eqns = {      h'[t] == littleh/σ*(1 - h[t]/hstar)*er'[t],      er'[t] == er0 (1 + dd[t]) Exp[-Q/(R* Temp)]*Sinh[(σ*(1 - h[t]))/(σ0 (1 - dop[t]) (1 - doc[t]))],      dd'[t] == Cat*er'[t],  dop'[t] == kp/3 (1 - dop[t])^4 , doc'[t] == kc/ϵf*er'[t] ,      h[0] == 0.1, er[0] == 0.1, dop[0] == .4, doc[0] == .001, dd[0] == 10^10        };          sol = NDSolve[eqns, {h, er, dd, doc, dop}, {t, tmin, tmax},        Method -> "StiffnessSwitching", StartingStepSize -> 1/10]                    SetOptions[Plot, Frame -> True, FrameLabel -> {"Time (unit)", "Strain (unit)", "title"},        LabelStyle -> {FontFamily -> "Times", FontSize -> 20},        ImageSize -> 600];               Plot[{h[t] /. sol[[1]][[1]], er[t] /. sol[[1]][[2]]}, {t, tmin, tmax},        AxesOrigin -> {0, 0}, PlotStyle -> {{Black}, {Gray, Dashed}}]      > >     General::ovfl: Overflow occurred in computation. >> >     NDSolve::nlnum: The function value   {Overflow[], Overflow[], > 1.143906412473046*10^429, >     Overflow[], Overflow[]} is not a list of numbers with dimensions {5} at > {t, dd[t], >     doc[t], dop[t], er[t],h[t]} = {0.000871366, -2.8508*10^123, > -2.84047*10^122, >     7.65381*10^105, -4.26071*10^121, 6.32403*10^281}. >> >


Behavior of Commonest when there is an even split between the elements of the list it is given

How can I alter `Commonest` so that, when I give it an input of four zeroes and ones such as $\\{0,1,1,0\\}$, which has an even split in its elements, it returns the first element of the input list, which happens to be $0$ in the example?


mathematica apply list of functions to the same arguments

How can I apply list of functions to the same arguments? e.g. ApplyFun[{fun1,fun2,fun3},{arg1,arg2}] I looked here and could not find: https://reference.wolfram.com/mathematica/guide/ApplyingFunctionsToLists.html http://reference.wolfram.com/legacy/flash/ EDIT: "Through" is partial solution, because it cannot be used in expressions, where these functions are used without arguments.


Polynomial factorization over finite fields with non-prime order

One can easily factor a polynomial over finite fields of prime order, using `Factor` command:               Factor[1 + x^2, Modulus -> 2]     ===>  (1 + x)^2      Now, is it possible to do this over finite fields of non-prime order? As an example, $ x^2 + x + 1$ is reducible over GF(4), and can be decomposed as $(x-a)(x-a^2)$, where $a\not\in \\{0,1\\} $ is a field member. Problem is, members of non-prime order finite fields are not denoted by ordinary numbers; rather, they use either polynomial or vector notation.


Voronoi diagrams for generators other than points

Any suggestions how to determine Voronoi diagram for sites other than points, as e.g. in the picture below? Input is a raster image. ![enter image description here](http://i.stack.imgur.com/iab6u.png)


"Legended" not working with "Plot" or "LogLinearPlot"

Version 9 has a new option `Legended`, which I find appealing since it should allow me to add individual expressions/curves to a legend, but it doesn't seem to be working for expressions in `Plot` or `LogLinearPlot`. For example, I would like to plot $log(x)$ and $x sin(x)$ together but only have $log(x)$ appear in the legend, I try:               LogLinearPlot[{Legended[Log[x], "Log(x)"], x Sin[x]}, {x, 1, 100}]      and the curve for $Log(x)$ just disappears instead of appearing on it's own in the legend. If `Legended` is not supposed to be used with the "`Plot`..." family of symbols, then could someone suggest an alternative solution to my problem?


Proving (self) similarity with Mathematica - Reccurrence Plots, Similarity Plots etc

I posted this question in math.se but given the sheer tumultuous number of questions that keep appearing on math.se and also given that I am trying to accomplish this in Mathematica, I thought I'd post an alternate version of this question here. (I hope that's not totally unacceptable to quasi-reproduce my question from elsewhere). I do realize that I'll receive perhaps different flavors of an answer from math.se and mathematica.se. Simply put, given two sets of data (Discrete Fourier transform matrices in this case), how do I prove similarity in the data. ![](http://i.stack.imgur.com/KXRB1.png) ![](http://i.stack.imgur.com/ulYo7.png) Comparing the figure on the Left with that on the Right, I somehow have an inkling that theres similarity in the figures. What I have is DFT data for these figures too (just the top left corner of the DFT data, with the DC component removed), which looks so: ![](http://i.stack.imgur.com/m0GvI.png) ![](http://i.stack.imgur.com/bfuVJ.png) The DFT corner on the left is for the contour plot on the left and the one on the right is for the contour plot on the right. I did a bit of research and came up with these: self similarity matrix, Smith Waterman algorithm for gene sequencing, it is implemented in Mathematica (also see ref/SmithWatermanSimilarity), and a somewhat related question posted on Mathematica.SE several months ago. I understand that this is more math related than Math _ematica_ related but as I'd like to use Mathematica since I pre and post process my data in it, I thought I'd ...ask! `:)` I used the `MatrixPlot` to generate the plots from the data below. ## Here is DFT data for the figure on the **left** :               {{0, 0., 23.1306, 0., 4.63337, 0., 4.87462, 0., 1.13912, 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0.}, {0., 59.8403, 0., 11.402, 0., 0.,        0., 1.53024, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0.}, {23.3079, 0., 23.2309, 0., 3.80344, 0., 4.07117, 0., 1.07381,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 11.3638, 0.,        3.51212, 0., 4.17147, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0.}, {4.56479, 0., 3.80023, 0., 4.05799, 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0., 4.1947, 0.,        1.12046, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0.}, {5.12425, 0., 4.21734, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0.}, {0., 1.54858, 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {1.07898, 0.,        1.094, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0.}, {0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0.}, {0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0.}, {0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}}      ## And data for the figure on the **right** :               {{0, 0., 0.940723, 0., 2.95705, 0., 2.92228, 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0.}, {0., 18.867, 0., 7.68905, 0., 0., 0.,        1.61012, 0., 1.07367, 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0.}, {1.28581, 0., 12.1276, 0., 6.00817, 0., 0., 0., 1.7524, 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 8.01748, 0., 14.725, 0.,        0., 0., 1.05116, 0., 2.1411, 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0.}, {2.77763, 0., 6.2871, 0., 1.82885, 0., 1.65436, 0., 1.43276,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0.,        3.54584, 0., 1.45959, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0.}, {3.11339, 0., 0., 0., 1.89853, 0., 3.24873, 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0.}, {0., 1.83295, 0., 0., 0., 1.57703,        0., 1.14208, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0.,        0., 1.61293, 0., 1.32478, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0.}, {0., 1.02113, 0., 2.18193, 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0.976133, 0.,        0.931741, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0.}, {0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0.}, {0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0.,        0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0.}, {0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,        0., 0., 0., 0., 0.}}


2 non-linear equations with 2 unknowns which I cannot solve

I have the following equations and I would like to solve them in Mathematica **anyway**. Numerical results are very much welcomed. However, when I use the command `NSolve`, I get the following error message: The expression $b^{\frac{1}{2}\log (ab)}$ involves unknowns in more than one argument, so inverse functions cannot be used. Here are the equations that I want to solve:               NSolve[      {(Integrate[(E^(-x^2/2 + Log[a]^2/Log[a*b])*(E^(-(-1 + x)^2/2 + x^2/2))^(Log[a]/Log[a*b])*Log[E^(Log[a]^2/Log[a*b])*(E^(-(-1 + x)^2/2 + x^2/2))^(Log[a]/Log[a*b])])/       Sqrt[2*Pi], {x, 1/2 + Log[a^(-1)], 1/2 + Log[b]}] +      (a*Erfc[(1/2 + Log[b])/Sqrt[2]]*Log[a])/2)/((1 + Erf[(1/2 + Log[a^(-1)])/Sqrt[2]])/2 +      (E^((Log[a]^2*(1 + 2*Log[a*b]))/(2*Log[a*b]^2))*(-Erf[(-2*Log[a] + (1 + 2*Log[a^(-1)])*Log[a*b])/(2*Sqrt[2]*Log[a*b])] +       Erf[(-2*Log[a] + (1 + 2*Log[b])*Log[a*b])/(2*Sqrt[2]*Log[a*b])]))/(2*a^(1/(2*Log[a*b]))) + (a*Erfc[(1/2 + Log[b])/Sqrt[2]])/2) -       Log[(1 + Erf[(1/2 + Log[a^(-1)])/Sqrt[2]])/2 + (E^((Log[a]^2*(1 + 2*Log[a*b]))/(2*Log[a*b]^2))*       (-Erf[(-2*Log[a] + (1 + 2*Log[a^(-1)])*Log[a*b])/(2*Sqrt[2]*Log[a*b])] + Erf[(-2*Log[a] + (1 + 2*Log[b])*Log[a*b])/(2*Sqrt[2]*Log[a*b])]))/       (2*a^(1/(2*Log[a*b]))) + (a*Erfc[(1/2 + Log[b])/Sqrt[2]])/2] == 0.1,      (Integrate[(E^(-(-1 + x)^2/2 + Log[b]^2/Log[a*b])*Log[E^(Log[b]^2/Log[a*b])/      (E^(-(-1 + x)^2/2 + x^2/2))^(Log[b]/Log[a*b])])/     ((E^(-(-1 + x)^2/2 + x^2/2))^(Log[b]/Log[a*b])*Sqrt[2*Pi]), {x, 1/2 + Log[a^(-1)], 1/2 + Log[b]}] +       (b*(1 + Erf[(-1/2 + Log[a^(-1)])/Sqrt[2]])*Log[b])/2)/        ((b*(1 + Erf[(-1/2 + Log[a^(-1)])/Sqrt[2]]))/2 + (E^((Log[b]^2*(1 + 2*Log[a*b]))/      (2*Log[a*b]^2))*(Erf[(-1 + 2*Log[b]*(1 + Log[a*b]^(-1)))/(2*Sqrt[2])] -        Erf[(-1 + 2*Log[a^(-1)] + (2*Log[b])/Log[a*b])/(2*Sqrt[2])]))/        (2*b^(1/(2*Log[a*b]))) + Erfc[(-1/2 + Log[b])/Sqrt[2]]/2) -        Log[(b*(1 + Erf[(-1/2 + Log[a^(-1)])/Sqrt[2]]))/2 +         (E^((Log[b]^2*(1 + 2*Log[a*b]))/(2*Log[a*b]^2))*(Erf[(-1 + 2*Log[b]*(1 + Log[a*b]^(-1)))/(2*Sqrt[2])] -          Erf[(-1 + 2*Log[a^(-1)] + (2*Log[b])/Log[a*b])/(2*Sqrt[2])]))/(2*b^(1/(2*Log[a*b]))) + Erfc[(-1/2 + Log[b])/Sqrt[2]]/2] == 0.1},      {a, b}]      * * *               f0[x_] := 1/Sqrt[2*Pi*1^2]*E^(-(x + 0)^2/(2*1^2))     f1[x_] := 1/Sqrt[2*Pi*1^2]*E^(-(x - 1)^2/(2*1^2))          yl = -1.070751889428462     yu = 2.0707518894284505          a = 1/l[yl]     b = l[yu]          l[x] = f1[x]/f0[x]          Solve[-(1/2) (-1 + x)^2 + x^2/2 - Log[y] == 0, x]         \--> here I must find the inverse function of $l$ but I couldn't do that either, so then I did it half-manually, which is:               ll[x_] := 1/2 + Log[x]          NSolve[{(Integrate[a*InputForm[1/(E^(x^2/2)*Sqrt[2*Pi])]*Log[a], {x, ll[b], Infinity}] + Integrate[E^(Log[a]^2/Log[a*b])*InputForm[1/(E^(x^2/2)*Sqrt[2*Pi])]*             l[x]^(Log[a]/Log[a*b])*Log[E^(Log[a]^2/Log[a*b])*l[x]^(Log[a]/Log[a*b])], {x, ll[a^(-1)], ll[b]}])/          (Integrate[InputForm[1/(E^(x^2/2)*Sqrt[2*Pi])], {x, -Infinity, ll[a^(-1)]}] + Integrate[a*InputForm[1/(E^(x^2/2)*Sqrt[2*Pi])], {x, ll[b], Infinity}] +            Integrate[E^(Log[a]^2/Log[a*b])*InputForm[1/(E^(x^2/2)*Sqrt[2*Pi])]*l[x]^(Log[a]/Log[a*b]), {x, ll[a^(-1)], ll[b]}]) -          Log[Integrate[InputForm[1/(E^(x^2/2)*Sqrt[2*Pi])], {x, -Infinity, ll[a^(-1)]}] + Integrate[a*InputForm[1/(E^(x^2/2)*Sqrt[2*Pi])], {x, ll[b], Infinity}] +            Integrate[E^(Log[a]^2/Log[a*b])*InputForm[1/(E^(x^2/2)*Sqrt[2*Pi])]*l[x]^(Log[a]/Log[a*b]), {x, ll[a^(-1)], ll[b]}]] == 0.1,        (Integrate[b*InputForm[1/(E^((-1 + x)^2/2)*Sqrt[2*Pi])]*Log[b], {x, -Infinity, ll[a^(-1)]}] +            Integrate[(E^(Log[b]^2/Log[a*b])*InputForm[1/(E^((-1 + x)^2/2)*Sqrt[2*Pi])]*Log[E^(Log[b]^2/Log[a*b])/l[x]^(Log[b]/Log[a*b])])/l[x]^(Log[b]/Log[a*b]),             {x, ll[a^(-1)], ll[b]}])/(Integrate[InputForm[1/(E^((-1 + x)^2/2)*Sqrt[2*Pi])], {x, ll[b], Infinity}] +            Integrate[b*InputForm[1/(E^((-1 + x)^2/2)*Sqrt[2*Pi])], {x, -Infinity, ll[a^(-1)]}] +            Integrate[(E^(Log[b]^2/Log[a*b])*InputForm[1/(E^((-1 + x)^2/2)*Sqrt[2*Pi])])/l[x]^(Log[b]/Log[a*b]), {x, ll[a^(-1)], ll[b]}]) -          Log[Integrate[InputForm[1/(E^((-1 + x)^2/2)*Sqrt[2*Pi])], {x, ll[b], Infinity}] + Integrate[b*InputForm[1/(E^((-1 + x)^2/2)*Sqrt[2*Pi])],             {x, -Infinity, ll[a^(-1)]}] + Integrate[(E^(Log[b]^2/Log[a*b])*InputForm[1/(E^((-1 + x)^2/2)*Sqrt[2*Pi])])/l[x]^(Log[b]/Log[a*b]), {x, ll[a^(-1)], ll[b]}]] ==         0.1}, {a, b}]      * * * Please let me know if there is still something missing. **MORE NOTES:** 1- $y_u>y_l$ should be satisfied 2- $a,b>0$ and $ab>1$ 3- $l[x]$ monotone increasing. This means one can choose some densities $f0[x_]$ and $f1[x_]$ such that $l$ is monotone increasing. Because we need its inverse! According to these notes, is the solution unique? or are there still more roots if I change $f0[x_]$ and $f1[x_]$? Is there anyway to get a solution? I also tried `FindRoot` and `SolveAlways` which gave no result at all. Thank you very much in advance.


Placing text inside a region with RegionPlot

I am plotting many regions with RegionPlot. I would like to label each region as I plot it so that I get something that looks like figure made with the following code:               Show[       RegionPlot[x > y, {x, 0, 1}, {y, 0, 1}],       RegionPlot[x < y,  {x, 0, 1}, {y, 0, 1}],       Graphics[Text["B", {0.6, 0.2}]],       Graphics[Text["A", {0.2, 0.6}]]     ]      ![Example of labelled regions](http://i.stack.imgur.com/tzbMd.png) However, as the sets of inequalities are quite complicated and there are many regions, I would like to automatically determine a reasonable place to put each label so that it is in the middle of each region. Is there a simple way to do this? I could manually find a point within each region, but that would be a pain and wouldn't necessarily solve the problem of centering the text within the region.


Adjacency Matrix for an Undirected Graph

Here is an undirected graph                 m = Graph[{1 \[UndirectedEdge] 3, 2 \[UndirectedEdge] 3,         3 \[UndirectedEdge] 4, 4 \[UndirectedEdge] 5,         4 \[UndirectedEdge] 6, 5 \[UndirectedEdge] 7,         6 \[UndirectedEdge] 8}, GraphLayout -> "SpringEmbedding",        VertexLabels -> "Name", ImagePadding -> 10]      We can get the Adjacency Matrix as follows               g = AdjacencyMatrix[m]      The Normal Form of the sparse array g is as follows.               In[28]:= Normal[g]          Out[28]= {{0, 1, 0, 0, 0, 0, 0, 0}, {1, 0, 1, 1, 0, 0, 0, 0}, {0, 1,        0, 0, 0, 0, 0, 0}, {0, 1, 0, 0, 1, 1, 0, 0}, {0, 0, 0, 1, 0, 0, 1,        0}, {0, 0, 0, 1, 0, 0, 0, 1}, {0, 0, 0, 0, 1, 0, 0, 0}, {0, 0, 0, 0,        0, 1, 0, 0}}      The adjacency matrix does not appear to be correct for the graph m.


Restrict access to Lightweight Grid

When using the default configuration of the Lightweight Grid Manager, anyone connected to the same internal network where the grid severs are can launch kernels on the grid. What possibilities are there to restrict access to the Lightweight Grid, and how can these restrictions be enabled? Is IPFiler the only way?


FindShortestPath with negative weights isn't working

I have the following functions defined:               RandomTree[n_, opts:OptionsPattern[]] :=      TreeGraph[UndirectedEdge[RandomInteger[{1,#}], # + 1] & /@ Range[1, n - 1], opts]          RandomCycleTree[n_, opts:OptionsPattern[]] := Module[{tree, e},     tree = RandomTree[n];     e = RandomChoice[EdgeList[GraphComplement[tree]]];     GraphUnion[tree, Graph[{e}], opts]]          RandomCycleTreeWeighted[n_, opts:OptionsPattern[]] :=      RandomCycleTree[n, EdgeWeight -> RandomReal[{-1, 1}, n], opts]      If I execute:               FindShortestPath[RandomCycleTreeWeighted[10,      VertexLabels -> "Name", ImagePadding -> 10], 3, 7]      it returns unevaluated. Can anyone reproduce this and explain why it is happening? Note: I am using Mathematica 9. I also tried executing this in Mathematica 8.0 and it also didn't work.


How to rebuild original data from a histogram?

I have data in the following form. I have a list of values and a list of frequencies that indicate how often each value has occurred. Example list of values: `{5,7,4}` Example list of frequencies: `{1,2,3}` I would like to obtain the original data from which such a histogram was generated. Any suggestions on how to do this with _Mathematica_ ? Example: `{5,7,7,4,4,4}`


How do you remove noise to detect just the human voice?

How do you detect different sound frequencies and cut off parts in an audio file? Among instruments, how do you pick up the human voice?


Complex Region using Presentations Package

Just purchased the Presentations package. First sketched this region:               << Presentations`          Draw2D[      {Opacity[0.6],       ComplexRegionDraw[0 <= Re[z] <= 1, {z, -2 - 2 I, 2 + 2 I}]},      Frame -> True,      Axes -> True,      PlotRange -> 2,      FrameLabel -> {Re, Im},      PlotLabel -> z,      ImageSize -> 300      ]      And I got the image I wanted. ![today](http://i.stack.imgur.com/BRDhj.png) Next, I want to sketch the image of this region under the exponential function $w=e^z$. I tried this:               Draw2D[      {Opacity[0.6],       ComplexRegionDraw[Exp[z], {z, -2 I, 1 + 2 I}]},      Frame -> True,      Axes -> True,      PlotRange -> 2,      FrameLabel -> {Re, Im},      PlotLabel -> z,      ImageSize -> 300      ]      But I got a blank image. Any suggestions? Looks like I might have an idea.               f[z_] := Exp[z]          Draw2D[      {Opacity[0.6],       ComplexRegionDraw[0 <= Re[z] <= 1, {z, -2 - 2 I, 1 + 2 I},         PlotPoints -> 30] // ComplexMap[f]},      Frame -> True,      Axes -> True,      PlotRange -> All,      FrameLabel -> {Re, Im},      PlotLabel -> z,      ImageSize -> 300      ]      And the resulting image: ![today2](http://i.stack.imgur.com/zbGWX.png) Of course, what I really wanted was the image of the the strip with $0\le Re[z]\le1$ and $\infty\le Im[z]\le \infty$.               Draw2D[      {Opacity[0.6],       ComplexRegionDraw[0 <= Re[z] <= 1, {z, 0, 1 + 2 Pi I},         PlotPoints -> 30] // ComplexMap[f]},      Frame -> True,      Axes -> True,      PlotRange -> All,      FrameLabel -> {Re, Im},      PlotLabel -> z,      ImageSize -> 300      ]      And the resulting image. ![today3](http://i.stack.imgur.com/Z016O.png)


Problem with GlobalClusteringCoefficient

I have a simple problem, I would like to measure the global clustering coefficient for a random graph. Here is my code:               GlobalClusteringCoefficient[RandomGraph[DegreeGraphDistribution[       {2, 1, 1, 1, 1, 2, 1, 3, 3, 1, 1, 2, 2, 2, 2,1, 1, 1, 7, 3, 3, 3, 1, 2, 1}], 10000]]      This is just supposed to create 10000 random graphs, with each vertex in each graph having a fixed number of edges. The error I get is as follows: > GlobalClusteringCoefficient::graph: A graph object is expected at position 1 > in GlobalClusteringCoefficient I tried wrapping everything before the clustering function as follows:               Graph[[RandomGraph[DegreeGraphDistribution[       {2, 1, 1, 1, 1, 2, 1, 3, 3, 1, 1, 2, 2, 2, 2,1, 1, 1, 7, 3, 3, 3, 1, 2, 1}], 10000]]]      And it gives the same error. Anyone know how to convert the random graph generated into a graph object? EDIT: So I had in mind to create a For-loop which would go from `i = 1` until `10,000` \-- but this saved me a lot of computational power. Now I have this:               Mean[GlobalClusteringCoefficient /@        RandomGraph[DegreeGraphDistribution[         {2, 1, 1, 1, 1, 2, 1, 3, 3, 1, 1, 2, 2, 2, 2, 1, 1, 1, 7, 3, 3, 3, 1, 2, 1}], 10000]]      I get a value of `4587/86000`, which is almost too good to be true -- is this really calculating the mean of all 10000 cluster coefficients? I am a little surprised because I have been using _Mathematica_ for a total of one day, but this solved the issue far faster than R.


How do I plot a solution of a differential equation?

I am having trouble generating a plot for a solution to my differential equations. I always end up with just blank axes.               Clear["Global`*"]      Remove["Global`*"]     m x''[t] == -k m x'[t];     m y''[t] == -k m y'[t] - m g;     U == v Cos[\[Theta]];     V == v Sin[\[Theta]];     soln = DSolve[{m x''[t] == -k m x'[t], m y''[t] == -k m y'[t] - m g,        x[0] == 0, y[0] == 0, x'[0] == U, y'[0] == V}, {x[t], y[t]},       t][[1]] // Simplify;     soln     ParametricPlot[{x[t], y[t]}, {t, 0, 5}]      The solution comes out fine but the graph always comes out blank. I'm sure I'm making some rookie mistake somewhere and would appreciate if someone can point it out.


Changing parenthesis size for typography

I am using Mathematica to layout some mathematical formulas for publication. The guidelines specify that in case of nested parentheses the encompassing ones need to be bigger than the inner ones. So is there a way to make parentheses bigger easily? Below is an example of what I want. It is made by inserting an invisible column at the beginning of the grouping, but that creates a ugly gap in the formula. ![enter image description here](http://i.stack.imgur.com/QwKye.png)


How can I compare the previous value and the current value implemented during NestWhileList?

I am trying to write a part of my code. I am using NestWhileList. However, I couldn't find out the right syntax for testing. It should compare previous result and current result and continue if it is True. I want to do this, for instance :               NestWhileList[# + RandomInteger[{-5, 5}] &, 10, previousresult <= currentresult];      and If I have two test options for NestWhileList, for instance :                 NestWhileList[# + RandomInteger[{-5, 5}] &, 10, previousresult <= currentresult && previous result<0];      Is there a way to do it? **Second Question** (This question is not absolutely related to first question.) In addition, if I can't do that, i will try to create a list without testing. If I create list, how can I compare successive two component of list in a functional way? Any help is appreciated.


Speed up ContourPlot3D

I have two issues with the following code. (1) It executes too slowly. If I use "Speed" instead of "Quality" for PerformanceGoal, I get the speed but an undesirable delay in proper rendering of the contour. Perhaps the calculation of the expression to be contoured is the cause of the slowness. If so, can that be accelerated? (2) How can I make the z-axis vertical. Note its appearance with some jaggies.               Manipulate[           ContourPlot3D[         {z == 10*x*y*Exp[-x - y], z == k}, {x, 0, 6}, {y, 0, 6}, {z, 0, 3},          ContourStyle -> {Red, Opacity[0.9]},         AxesOrigin -> {0, 0, 0}, Boxed -> False, Mesh -> None,          PerformanceGoal -> "Quality",         MeshStyle -> Directive[Thick], AxesStyle -> Directive[Thick],          BoundaryStyle -> Directive[Blue], ContourStyle -> Opacity[0.8],         ViewPoint -> {-4, -8, 4}, ImageSize -> 2 {420, 370}],         {{k, 0.5, Text@Style["k", Italic, FontSize -> 18]}, 0, 1.35, 0.01,          Appearance -> "Labeled"}      ]


How can I colorize an imported model?

How can I colorize an imported model from for example 3ds max? I'm trying to find the way to colorize a 3D plot from an imported model with something like this:               ColorFunction -> Function[{x, y, z}, ColorData["GreenBrownTerrain"][z^2]]      But I don't know how. Thank you very much for your help.


More efficient matrix-vector product

Dear mathematica users, In my present research I am faced with a real dense $n\times n$ matrix $A$ where $n \geq 3000$ (hopefully even more). The coefficients of this matrix are fixed, but I will have to repeatedly multiply it by a variable vector: $Ax$. I am not complaining about Mathematica's speed to do the job, which seems quite nice, but since I will need to do this repeatedly for very many times, I was wondering if there was a way to optimise the process. Perhaps, declaring it in a With will help, but besides that I am out of ideas. Another alternative would be a low-rank approximation using SVD. My thoughts were: with the SVD I can write \begin{equation} A = \sigma_1 u_1 v_1^\text{T} + \sigma_2 u_2 v_2^\text{T} + \ldots \end{equation} so \begin{equation} Ax = (\sigma_1 v_1^\text{T}x) u_1 + (\sigma_2 v_2^\text{T})u_2 + \ldots \end{equation} As an example, using a rank 100 approximation to a $3000\times 3000$ matrix (which yields a Frobenius error of $\sim5-10\;\%$) I was able to reduce the computation time by a factor of roughly 3 or 4. I thank in advance for any positive feedback. Best regards, Gabriel Landi **Edit:** Forgot to say that $A$ is symmetric and has zero diagonal.


Efficiently extracting an array subset given a separate array

I have two arrays. The first array consists of tens of millions of rows and three columns with a string, a number, and a string.               array1 = {{string1, 145745, a}, {string2, 56546, a}, {string3, 56546, b},               {string3, 246, b}, {string7, 12355, a}, {string7, 12355, b}}      The second array has hundreds of thousands of rows but also consists of three columns but with a string, a number, and a number.               array2 = {{string1, 145745, 3.14324}, {string3, 56546, -0.34319}, {string7, 12355, 0.23535}}      In `array2`, the first two elements of each row matches the first two elements of a row (or, at most, two rows) in array1. In other words, `array2[[All,{1,2}]]` is a subset of `array1[[All,{1,2}]]`. The goal is to take from `array1` all the rows that have matching rows in `array2` (when comparing only the first two columns from each array). For example, from the two given arrays above, the final result would be               result = {{string1, 145745, a},{string3, 56546, b},{string7, 12355, a},{string7, 12355, b}}      The fastest command I've come up with is               m=Dimensions[array2][[1]];     Do[     Pick[array1,array1[[All,{1,2}]],array2[[i,{1,2}]]]//Sow     ,{i,m}     ]//Reap      but this is still too slow. This is a simple problem, but I am really looking for the fastest method possible. Any ideas? **EDIT** Previously, I erroneously had               array1 = {{string1, 145745, a}, {string2, 56546, a}, {string3, 56546, b},               {string3, 246, b}, {string7, **145745**, a}, {string7, 12355, b}}      which should have been               array1 = {{string1, 145745, a}, {string2, 56546, a}, {string3, 56546, b},               {string3, 246, b}, {string7, **12355**, a}, {string7, 12355, b}}      This has been corrected above.


CDF and personalized style

I recently created a custom stylesheet. I then created a notebook with the new style, confirmed that the notebook had adopted the style, and then saved a copy in CDF. But when I opened the CDF in Wolfram's CDF Player, the style had not been applied to the document. Does this mean that CDFs are not able to adopt the style of the original notebook if the style comes from a custom stylesheet? How can I embed the style into cdf?


Which ray-tracing software is compatible with Graphics3D?

I am interested in working alternative to _Mathematica_ 's FrontEnd for rendering `Graphics3D` produced by _Mathematica_. The requrements are:   * An ability to import `Graphics3D` objects exported from _Mathematica_ in any of 3D export formats supported by _Mathematica_.    * It seems that in most cases _Mathematica_ 's support of 3-rd party 3D geometry formats is incomplete ( _Mathematica_ does not export the complete scene description). So the second requirement is that recovering of dropped parts of the scene description would be as easy as possible. I am most interested in rendering polygonal surfaces computed by _Mathematica_ which are presented internally as `GraphicsComplex`. It will be very appreciated if an answerer show the complete way to render some simple _Mathematica_ -generated surface with several point light sources like this:               lightSources = {{"Point", Red, {1/2, 1, 1}},                      {"Point", Green, {1, 1/2, 1}},                      {"Point", Blue, {0, 0, 1}}};     pl = Show[       Plot3D[Sin[x*y*Pi^2], {x, 0, 1}, {y, 0, 1},         Lighting -> lightSources],        Graphics3D[{PointSize[Large],          Point[lightSources[[All, 3]],           VertexColors -> lightSources[[All, 2]]]}]]      ![plot](http://i.stack.imgur.com/Arypd.png)


Using patterns in pure functions

Pure functions may be handy if you don't want to assign your function a name. For example I would calculate $x(x-1)$ for some numbers $x$ by               In: #(#-1) & /@ {1, 2, 3}     Out: {0, 2, 6}      Is it possible to use patterns in this construction? For example something like               f[x_Integer] := x(x-1)      but then without defining a function f first.


Integrating a half-normal pdf

The pdf of a half normal distribution is: $\frac{\sqrt{2}}{\sigma\sqrt{\pi}}\exp\left(-\frac{x^2}{2\sigma^2}\right)$, $x>0$ $$\int_{0}^{\infty}\frac{\sqrt{2}}{\sigma\sqrt{\pi}}\exp\left(-\frac{x^2}{2\sigma^2}\right)\mathrm{d}x=\frac{1}{\sqrt{\sigma}}$$ This doesn't make sense, the integral should be equal to one, right? Mathematica code used to compute this:               Integrate[(Sqrt[2/Pi]/s)*Exp[-(x^2)/(2*s^2)], {x, 0, Infinity}, Assumptions -> Re[s^2] > 0]      What am I doing wrong?