Using Part within a Compiled Command

I'm looking to define a multi-line function that makes use of the "Part" command. A **_toy_** example:               f = Compile[{x, y}, (z = Sqrt[x^2 + y^2];      sol = NMinimize[zz^2, zz];      z + sol[[1]])-sol[[2]]]      The core idea is simply that I want to be able to take various parts of a list, produced by a previous command within the compiled function. When I attempt to do so, I get an error message like:               Compile::part: "Part specification sol[[1]] cannot be compiled since the argument is not a tensor of sufficient rank. Evaluation will use the uncompiled function. "      The command works fine if I don't try to use Part (for example):               f = Compile[{x, y}, (z = Sqrt[x^2 + y^2];      sol = NMinimize[zz^2, zz];      z]      I've seen this "not a tensor" error before in compile, when defining arguments, and it appears to be a common (and answered) question. This does not seem to be. Any light you could shed would be appreciated! **-Edit (Workaround)-** Silva's answer helped me come up with a workaround:               f = Compile[{x, y}, (z = Sqrt[x^2 + y^2];      sol2 = NArgMin[zz^2, zz];      sol1 = sol2^2;      z + sol1 - sol2)]      Works with compile.


ParallelTable of ParametricNDSolve objects fail

There seems to be a problem with ParametricNDSolveValue togeteher with ParallelTable First we create a ParametricNDSolveValue object               f = ParametricNDSolveValue[{x'[t] == -a x[t], x[0] == 1}, (x[1] - 1)^2, {t, 0, 2}, {a}]     ParametricFunction[SequenceForm["<", ">"]]      Then we make a table of derivatives, which works fine.               Table[D[f[a], a], {2}]      Now we do the same thing in a ParallelTable, which gives a huge amount of errors.               ParallelTable[D[f[a], a], {2}]     Internal`Bag::intpm: Positive machine-sized integer expected at position 3 in Internal`Bag[{{#1,#2},{#3,#4}},#5,#6].     Thread::tdlen: Objects of unequal length in {0}+{0,0,0,0,0,0,0,0,0}+<<11>>+0& (<<33>>^(<<1>>))[0,<<8>>,{1.}]+(Internal`Bag^({{0,0},{0,1}},0,0))[{{t$8850,a$8849},{t,a}},1,2] (NDSolve`NDSolveParametricFunction^(0,{0,1},<<6>>,{},{0}))[0,{ParametricNDSolveValue,Internal`Bag[<2>]},<<6>>,{},{1.}] cannot be combined.      If we use Deriviative this works fine               ParallelTable[Derivative[1][f][a], {2}]      Is this a bug in ParametricNDSolve?


Is it possible to export equations from Mathematica to Corel with full Latex quality

I am wondering is there any possible solution to export equations from mathematica to corel x5. I was trying first to export a equations as pdf from mathematica and then to import .pdf to corel, but many characters are missed. Maybe someone had success with this kind of problem. Thanks in advance.


How to make a package for buttons

I am trying to make a `Package` for a piece of code though it's not needed here as it is very small. But my actual code here is a little bit different from that code. When I tried to make a package for `Button`. I found that the symbol `True` is protected. I have made a package with the function `Buttonfun`                BeginPackage["package`"]      Buttonfun[g1_,g2_]:= Button["     ",(g1=!g1;),Background->g2,Appearance->                                    "Frameless",Method-> "Queued"];      EndPackage[]      but when I call this with                 Buttonfun[q1,Orange]      from my notebook, it is showing error message symbol `True` is protected.


Error message: Coordinate index 0 is out of range for the enclosing GraphicsComplex

I am unable understand following error message: Coordinate index 0 is out of range for the enclosing GraphicsComplex. How to fix it? Attached data here: pts and polygons. See also end of question.                Graphics3D[GraphicsComplex[pts, Polygon@poly], Boxed -> False]      returns following error :                Coordinate index 0 is out of range for the enclosing GraphicsComplex.      Data:               pts={{0, 1, 2}, {1, 0, 3}, {4, 5, 6}, {5, 4, 7}, {8, 9, 10}, {9, 8,        11}, {12, 13, 14}, {13, 12, 15}, {16, 17, 18}, {17, 16, 19}, {20,        21, 22}, {21, 20, 23}, {24, 25, 26}, {25, 24, 27}, {28, 29,        30}, {29, 28, 31}};          polys= {{0, 1, 2}, {1, 0, 3}, {4, 5, 6}, {5, 4, 7}, {8, 9, 10}, {9, 8,        11}, {12, 13, 14}, {13, 12, 15}, {16, 17, 18}, {17, 16, 19}, {20,        21, 22}, {21, 20, 23}, {24, 25, 26}, {25, 24, 27}, {28, 29,        30}, {29, 28, 31}};


Given a list of 2D points, i.e.                {p1, p2, ..., pn}      the list may contain equal points, i.e. pi = pj. In this case it may also be true that a sublist of consecutive points has an equal somewhere in the list, i.e.:                pi=pj and p(i+1)=p(j+1).      I am looking for the longest of such sublists in the list. For example, in                { {0,0}, {1,0}, {1,1}, {0,1}, {2,0}, {3,0}, {3,1}, {2,1}, {1,0}, {1,1}, {4,0}}      the sublist I am looking for is               {{1,0}, {1,1}}       has length 2 and occurs twice. I am looking for an efficient way to ( functionally ) code this in Mathematica. Question: **How to find the longest matching sublists in a list?** Answers sofar failed on the following testcase, which I shall add for your convenience:L                {{0, 0}, {1, 0}, {1, 1}, {0, 1}, {2, 0}, {3, 0}, {3, 1}, {2, 1}, {1, 0}, {1, 1}, {4, 0}, {0, 0}, {1, 0}, {1, 1}, {0, 1}, {2, 0}, {3, 0}, {3, 1}, {2, 1}, {1, 0}, {2, 2}, {4, 0}};      with as longest matching sublist                {{0, 0},{1, 0}, {1, 1},{0, 1},{2, 0},{3, 0},{3, 1},{2, 1},{1, 0}}


Getting an equation of particular curve

How can I get an equation of the similar shaped curve? ![enter image description here](http://i.stack.imgur.com/2ASTq.png) I've tried to get it like `y = a + c x^2 + d x^3`:               Fit[{{-3, -3}, {0, 3}, {6, 4}}, {1, x^2, x^3}, x]      But it lacks two roots. I can't use `PolynomialFit` because of the lack of points.


Solving a nonlinear system of recurrence equations

I am having two problems regarding _Mathematica_ , and both of them are happening because it does not accept such inputs:               RSolve[ g[n + 1] == g[n]^2 + 2*f[n]^2, f[n + 1] == 2f[n]*g[n]]      and               RSolve[ g[n + 1] == g[n]^2 + sum[ f[n - 1, i], i = 0..n-1], f[n,x]== (n!)/((x!)*(n-x)!)]      And I have no idea how to provide the correct input for such equations that _Mathematica_ understands.


List of different values which have to be formatted differently

I have a large list of values which – for presentation in my LaTeX document – I need to format. For instance: I have calculated growth rates which I now would like to have formatted in the form of:                  In[2260]:= Map[{First[First[#]],NumberForm[N[Last[#]],3,2}]}&,                     CompleteQuarterlyStatDataBySubjects[[1]][[1]]]              Out[2260]= {{Australia,{}},{Austria,-1.21},{Belgium,-1.46},{Canada,-1.30},            {Czech Republic,-1.67},{Denmark,-1.87},{Estonia,-3.97},{Finland,-2.53},            {France,-1.00},{Germany,-1.74},{Greece,-1.16},{Hungary,-1.45},            {Iceland,-1.83}, {Ireland,-1.67},{Israel,{}},{Italy,-1.42},{Japan,-0.69},            {Korea, {}},{Luxembourg,-1.67},{Netherlands,-0.98},{New Zealand,-0.50},            {Norway,-0.64},{Poland,{}},{Portugal,-0.40},{Slovak Republic,{}},            {Slovenia,-3.31},{Spain,-0.71},{Sweden,{}},{Switzerland,-0.82},            {Turkey,-3.39},{United Kingdom,-1.45},{United States,-1.28}}      (the original dataset `CompleteQuarterlyStatDataBySubjects[[1]][[1]]` is at the bottom of this post) Besides growth rates I have calculated `AbsoluteTime`-Values which I would like to format as follows:               In[2271]:= Map[                  {                   First[First[#]],                   Table[                     DateString[#[[2;;-1]][[i]],{"Quarter"," ","Year"}],                     {i,Length[#[[2;;-1]]]}                   ]                  }&,                  CompleteQuarterlyStatDataBySubjects[[1]][[5]]                ]          Out[2271]= {{Australia,{DateString[{},{Quarter, ,Year}]}},{Austria,{1 2008}},                 {Belgium,{2 2008}},{Canada,{3 2008}},{Czech Republic,{3 2008}},                 {Denmark,{2 2008}},{Estonia,{2 2008}},{Finland,{2 2008}},                 {France,{1 2008}},{Germany,{1 2008}},{Greece,{3 2008}},                 {Hungary,{1 2008}},{Iceland,{3 2008}},{Ireland,{4 2007}},                 {Israel,{DateString[{},{Quarter, ,Year}]}},{Italy,{1 2008}},                 {Japan,{1 2008,3 2010}},{Korea,{DateString[{},{Quarter, ,Year}]}},                 {Luxembourg,{1 2008}},{Netherlands,{1 2008}},{New Zealand,{4 2007}},                 {Norway,{2 2008}},{Poland,{DateString[{},{Quarter, ,Year}]}},                 {Portugal,{4 2007,3 2010}},{Slovak Republic,{DateString[{},                 {Quarter, ,Year}]}},{Slovenia,{3 2008}},{Spain,{1 2008}},                 {Sweden,{DateString[{},{Quarter, ,Year}]}},{Switzerland,{2 2008}},                 {Turkey,{1 2008}},{United Kingdom,{1 2008}},{United States,{2 2008}}}      To automate the process of getting the values into the right format, I thought to use the following approach:               In[2261]:= Formats[list_,x_]:=         If[x==1,         NumberForm[N[list],{3,2}]            If[x==5,            Table[DateString[list[[i]],{"Quarter"," ","Year"}],{i,Length[list]}]            ]         ]      And then to type for example:                   Map[           {             First[First[#]],             Formats[Last[#],1]           }&,           CompleteQuarterlyStatDataBySubjects[[1]][[1]]         ]      Unfortunately that did not work! Does anyone has an idea how I can program a procedure to get my data automatically formatted? The original data is:                In[2259]:= CompleteQuarterlyStatDataBySubjects[[1]][[1]]         Out[2259]= {{{Australia,AUS,other countries,GDP,quarterly data},{}},{{Austria,AUT,western European         countries,GDP,quarterly data},-1.2056},{{Belgium,BEL,western European         countries,GDP,quarterly data},-(7288960271654/4985881289361)},{{Canada,CAN,G7,GDP,quarterly data},-1.30053},{{Czech Republic,CZE,eastern European         countries,GDP,quarterly data},-(2134917223477606900/1282008490172233089)},{{Denmark,DNK,nothern European         countries,GDP,quarterly data},-(48057014595630800665/25700334274612164804)},{{Estonia,EST,eastern European         countries,GDP,quarterly data},-3.9659},{{Finland,FIN,nothern European         countries,GDP,quarterly data},-(33199059446612625/13128459048331036)},{{France,FRA,G7,GDP,quarterly data},-(5130109517723890585/5148852459134416857)},{{Germany,DEU,G7,GDP,quarterly data},-1.73904},{{Greece,GRC,southern European         countries,GDP,quarterly data},-1.164},{{Hungary,HUN,eastern European         countries,GDP,quarterly data},-(2225003087375671762980417961289391847/1539154631936274189423508152574973424)},{{Iceland,ISL,nothern European         countries,GDP,quarterly data},-1.83398},{{Ireland,IRL,nothern European         countries,GDP,quarterly data},-1.67021},{{Israel,ISR,other countries,GDP,quarterly data},{}},{{Italy,ITA,G7,GDP,quarterly data},-1.42009},{{Japan,JPN,G7,GDP,quarterly data},-(673269612770377724744620/262544695052599501095431),-(32760683814040103590/47201698472568566589)},{{Korea,KOR,other countries,GDP,quarterly data},{}},{{Luxembourg,LUX,western European         countries,GDP,quarterly data},-1.67073},{{Netherlands,NLD,western European         countries,GDP,quarterly data},-0.97505},{{New Zealand,NZL,other countries,GDP,quarterly data},-(152151059187768664247/302333262014074402254)},{{Norway,NOR,nothern European         countries,GDP,quarterly data},-(33596749386427335752225/52657796909983176600514)},{{Poland,POL,eastern European         countries,GDP,quarterly data},{}},{{Portugal,PRT,southern European         countries,GDP,quarterly data},-0.785963,-0.398132},{{Slovak Republic,SVK,eastern European         countries,GDP,quarterly data},{}},{{Slovenia,SVN,eastern European         countries,GDP,quarterly data},-3.31102},{{Spain,ESP,southern European         countries,GDP,quarterly data},-(2414923435622638997136189344226575/3392598745831412249336953513454508)},{{Sweden,SWE,nothern European         countries,GDP,quarterly data},{}},{{Switzerland,CHE,western European         countries,GDP,quarterly data},-0.820439},{{Turkey,TUR,other countries,GDP,quarterly data},-3.38638},{{United Kingdom,GBR,G7,GDP,quarterly data},-(2047013335956949212233044315/1411710881613564347284381614)},{{United States,USA,G7,GDP,quarterly data},-(2091354065961931475/1636350606517650408)}}      and for the AbsoluteTime-Values:               In[2265]:= CompleteQuarterlyStatDataBySubjects[[1]][[5]]     Out[2265]= {{{Australia,AUS,other countries,GDP,quarterly data},{}},{{Austria,AUT,western European     countries,GDP,quarterly data},3408134400},{{Belgium,BEL,western European     countries,GDP,quarterly data},3415996800},{{Canada,CAN,G7,GDP,quarterly data},3423859200},{{Czech Republic,CZE,eastern European     countries,GDP,quarterly data},3423859200},{{Denmark,DNK,nothern European     countries,GDP,quarterly data},3415996800},{{Estonia,EST,eastern European     countries,GDP,quarterly data},3415996800},{{Finland,FIN,nothern European     countries,GDP,quarterly data},3415996800},{{France,FRA,G7,GDP,quarterly data},3408134400},{{Germany,DEU,G7,GDP,quarterly data},3408134400},{{Greece,GRC,southern European     countries,GDP,quarterly data},3423859200},{{Hungary,HUN,eastern European     countries,GDP,quarterly data},3408134400},{{Iceland,ISL,nothern European     countries,GDP,quarterly data},3423859200},{{Ireland,IRL,nothern European     countries,GDP,quarterly data},3400185600},{{Israel,ISR,other countries,GDP,quarterly data},{}},{{Italy,ITA,G7,GDP,quarterly data},3408134400},{{Japan,JPN,G7,GDP,quarterly data},3408134400,3486931200},{{Korea,KOR,other countries,GDP,quarterly data},{}},{{Luxembourg,LUX,western European     countries,GDP,quarterly data},3408134400},{{Netherlands,NLD,western European     countries,GDP,quarterly data},3408134400},{{New Zealand,NZL,other countries,GDP,quarterly data},3400185600},{{Norway,NOR,nothern European     countries,GDP,quarterly data},3415996800},{{Poland,POL,eastern European     countries,GDP,quarterly data},{}},{{Portugal,PRT,southern European     countries,GDP,quarterly data},3400185600,3486931200},{{Slovak Republic,SVK,eastern European     countries,GDP,quarterly data},{}},{{Slovenia,SVN,eastern European     countries,GDP,quarterly data},3423859200},{{Spain,ESP,southern European     countries,GDP,quarterly data},3408134400},{{Sweden,SWE,nothern European     countries,GDP,quarterly data},{}},{{Switzerland,CHE,western European     countries,GDP,quarterly data},3415996800},{{Turkey,TUR,other countries,GDP,quarterly data},3408134400},{{United Kingdom,GBR,G7,GDP,quarterly data},3408134400},{{United States,USA,G7,GDP,quarterly data},3415996800}}


FindFit not giving a good fit despite good initial parameters

I'm having a problem with `FindFit` not giving a good fit to my data, even though the initial parameters I give look really good when plotted. The fitting function is               P1[Ω_, Δ_, t_] :=        ((Ω/Sqrt[Ω^2 + Δ^2])*Sin[(1/2)*Sqrt[Ω^2 + Δ^2]*t])^2;          fitfunction[Ω_, Δ_, t_, a_, b_, c_] :=        a + b*P1[Ω, Δ + c, t];      and I give the approximate starting parameters:               centrepeak = -91;     Ωapprox = 2 π 29 10^3;     amplitude = 0.8;     offset = 0.13;     pulsetime = 16 10^-6;      Then I fit using `FindFit`:               rabifit =       FindFit[scandata,        {fitfunction[Ω, Δ, pulsetime, voffset, amp, hoffset],         amp < 1, amp > 0, voffset > 0, voffset < 0.5 },        {{Ω, Ωapprox}, {amp, amplitude}, {voffset, offset}, {hoffset, centrepeak}}, Δ]      which gives               {Ω -> 187398., amp -> 0.216895, voffset -> 0.136962, hoffset -> 93.5922}      If I plot the fitting function with my starting parameters (red line) and the fitted parameters (orange line) against the data I get the following graph: ![Plot of data and fitting function for the initial parameters \(red\) and the fitted parameters \(orange\)](http://i.stack.imgur.com/Kf4Ls.jpg) As it can be seen the initial parameters seem to give a much better fit than the fitted ones. I've tried various things, e.g., changing the fitting method, but nothing seems to work. Any suggestions for anything else I could try? The code for generating the plot is               Show[Plot[{       fitfunction[Ωapprox, 2 π Δ 10^3, pulsetime, offset, amplitude, 2 π centrepeak 10^3],        fitfunction[Ω, 2 π Δ 10^3, pulsetime, voffset, amp, 2 π hoffset 10^3] /. rabifit},       {Δ, 0, 200},       PlotRange -> {All, {0, 1}},        PlotStyle -> {Directive[Thick, Red], Directive[Thick, Orange]},        Frame -> True, FrameStyle -> 30,        FrameLabel -> {"Frequency (kHz)", "Probability in |1>"},        ImageSize -> 30*30],       ListPlot[scandata, PlotStyle -> PointSize[0.007]]]


fit recursive function to data

I have a function $g(x, n)$, which is a recursive expression: $x$ is a variable and $n$ the number of iterations. In my case $n=3$ for all $x$. An example is the following:               f[__, 0] = 1;     f[x_, n_] := x*f[x, n - 1]     g[x_, n_] := ArcTan[f[x, n]] + Cos[f[x, n]]/Exp[f[x, n]/100];          data = Table[{i, 2*g[i, 3]}, {i, -3, 3, 0.1}];      I would like to fit a function $a\times g(x,3)$ to the generated data. A succesful fit should give $a=2$. Can I get an example of how to do this in Mathematica?


How to display the indices/element positions of a ragged array?

I have a three-level ragged array like so:               array = {{{a, a, a, a}, {a, a, a, a}, {a, a, a}}, {{a}, {a, a, a,           a}, {a, a, a, a}}, {{a, a}, {a, a, a}, {a, a, a, a}, {a, a, a,           a}}, {{a, a, a, a}, {a, a, a, a}, {a, a}, {a, a, a}}, {{a, a,           a}, {a, a, a, a}, {a, a, a}, {a, a, a, a}}};     Grid[array, Frame -> All]      ![Mathematica graphics](http://i.stack.imgur.com/6UFKC.png) I want to display the indices of this array by replacing each `a` element by the 3-digit positions of that element. I also want to preserve the structure of the array i.e. no flattening of the original array should occur. Below is an excerpt of what I want my result to be; notice that each number matches up with the position of the `a` that was previously in that position, and all the the curly brackets are preserved.               {{{111, 112, 113, 114}, {121, 122, 123, 124}, {131, 132, 133}}, ...}      I tried to use `Position[array, a]` but I only got back a flattened list of all the positions of `a`, which makes sense since `Position` is only supposed to show me the positions of `a` without preserving the list hierarchy.               Position[array, a]     (* {{1, 1, 1}, {1, 1, 2}, {1, 1, 3}, {1, 1, 4}, {1, 2, 1}, {1, 2, 2}, {1,        2, 3}, {1, 2, 4}, {1, 3, 1}, {1, 3, 2}, {1, 3, 3}, {2, 1, 1}, {2,        2, 1}, {2, 2, 2}, {2, 2, 3}, {2, 2, 4}, {2, 3, 1}, {2, 3, 2}, {2, 3,        3}, {2, 3, 4}, {3, 1, 1}, {3, 1, 2}, {3, 2, 1}, {3, 2, 2}, {3, 2,        3}, {3, 3, 1}, {3, 3, 2}, {3, 3, 3}, {3, 3, 4}, {3, 4, 1}, {3, 4,        2}, {3, 4, 3}, {3, 4, 4}, {4, 1, 1}, {4, 1, 2}, {4, 1, 3}, {4, 1,        4}, {4, 2, 1}, {4, 2, 2}, {4, 2, 3}, {4, 2, 4}, {4, 3, 1}, {4, 3,        2}, {4, 4, 1}, {4, 4, 2}, {4, 4, 3}, {5, 1, 1}, {5, 1, 2}, {5, 1,        3}, {5, 2, 1}, {5, 2, 2}, {5, 2, 3}, {5, 2, 4}, {5, 3, 1}, {5, 3,        2}, {5, 3, 3}, {5, 4, 1}, {5, 4, 2}, {5, 4, 3}, {5, 4, 4}} *)      * * * **My question is:** How do I display the indices of a (ragged) array elements--preferably concatenated instead of `{_,_,_}`\-- _and_ still keep the list structures intact? * * * **PS** : Here are some other things that I've tried which did not work: 1) `array /. a -> Position[array, a]` This did not work because each `a` is replaced by a huge list of _all_ positions of a in the array. ![Mathematica graphics](http://i.stack.imgur.com/Ezuo4.png) 2) `array /. array[[i_, j_, k_]] -> 100 i + 10 j + k` This would not work either because apparently `Part` does not take patterns. ![Mathematica graphics](http://i.stack.imgur.com/K0wp4.png)


Functional-Style Partial Application and the Accumulator Pattern?

Following up on Functional-style Fixed-Length Queue Object?, I want to generalize it to a functional-style accumulator pattern. Lots of things _look like_ accumulators, loosely defined as binary functions that take a state- carrying object as a first parameter, a datum as a second parameter, and return the state-carrying object. Such an accumulator can be scanned, mapped, or (theoretically, pending answer to the cited question) folded over sequences or streams of data to yield interesting results. Some things that look like accumulators are statistics, filters, smoothers, estimators, hidden Markov models (Kalman, Viterbi), controllers, I am sure many more. For elegance, I'm interested in a functional style. To keep the example small, consider the following:               newAccumulator[] := <|"runningSum" -> 0|>;     SetAttributes[accumulate, HoldFirst];     accumulate[accumulator_, datum_?NumberQ] :=       (accumulator[["runningSum"]] += datum;        accumulator);      This will just keep a running sum, but we could easily keep higher-order statistics and such a thing can be quite rich and useful. We can use this easily to compute Gauss's Day-of-Reckoning Sum, for example;               $myAccumulator = newAccumulator[];     Scan[accumulate[$myAccumulator, #] &, Range[100]];     $myAccumulator      > >     <|"runningSum" -> 5050|> >   Now, it occurred to me, "wouldn't it be nice if we could write               Scan[partial[accumulate, $myAccumulator], Range[100]]      where               SetAttributes[partial, HoldRest];     partial[f_, arg_] := (f[arg_,#]&);      which I can unit-test as follows               partial[f, x][y]      > >     f[x, y] >   and even generalize (just a little):               partial[f_, as__] := (f[Sequence @@ (Quiet @ Join[as, ##])] &);      and unit-test               partial[f, x, y][z, w]     partial[f, x][y]     partial[f, x][]      > >     f[x, y, z, w] >     f[x, y] >     f[x] >   But, lo and behold, it doesn't work on my example:               $myAccumulator = newAccumulator[];     Scan[partial[accumulate, $myAccumulator], Range[100]]     $myAccumulator      > >     <|"runningSum" -> 0|> >   This one has me clueless. **EDIT** : The `HoldRest` attribute on `partial` does not seem to make a difference. I put it in there out of habit -- side-effecting functions often work best when they hold their arguments against premature evaluation.


Graph and Markov Chain

I have the following code:               proc = DiscreteMarkovProcess[1, {{0.6, 0.4}, {0.3, 0.7}}]          Graph[{"A", "E"}, proc, GraphStyle -> "DiagramBlue"]      How can I 'force' to show the percentage values (0.6, 0.4 etc) on each arrow? I can see the values when I mouse hover it. Thank you.


Plotting a parametric graph and a normal one on the same grid with a legend option

Here is my simple code:               f0[y_] := PDF[NormalDistribution[-1, 1], y]     f1[y_] := PDF[NormalDistribution[1, 1], y]     ParametricPlot[{{f0[y], f1[y]}, {y, f1[y]}}, {y, 0, 0.5},          PlotStyle -> {Blue, Red}, BaseStyle -> 18, AxesStyle -> Arrowheads[0.03],          PlotLegends -> Placed[LineLegend[{             Style["density composite", FontSize -> 21],             Style["density only", FontSize-> 21]             },              LegendFunction -> (Framed[#, RoundingRadius -> 2, FrameStyle -> LightGray] &),              BaseStyle -> 18], {Right, Top}]]      ![enter image description here](http://i.stack.imgur.com/ra9E5.jpg) I only get the legend "density composite" but not "density only" part. I need them in the same plot. One is for the blue curve and the other for the red one. Thank you very much


How do I plot the unit normal field for a surface?

The question is pretty much in the title; I'm about to teach my multivariable calculus students about orientations on surfaces, and I would like to be able to show them pictures. Any ideas?


Using DistributionFitTest on custom distributions in Mathematica 8

I originally posted this question on Stack Overflow, but I didn't get any answers, and I'm hoping to have better luck here. * * * I'm trying to compute the goodness-of-fit of a bi-modal Gaussian distribution. To do this, Mathematica seems to require a symbolic distribution function to which to compare. Because such a bi-modal distribution is not a stock distribution, I'm trying to define one. The obvious use of               MixtureDistribution[{fs, (1-fs),       {NormalDistribution[μS, σS], NormalDistribution[μL, σL]}]      generates a distribution that can be plotted, but the analysis used by `DistributionFitTest[]` fails. This topic has been addressed in previous questions in discussions between @Sasha and @Jagra: http://stackoverflow.com/questions/6361647/distributionfittest-for-custom- distributions-in-mathematica http://stackoverflow.com/questions/9202531/minimizing-nexpectation-for-a- custom-distribution-in-mathematica?lq=1 but I was unable to find a resolution that enabled the use of               DistributionFitTest[data,dist,"HypothesisTestData"]      when `dist` is not a built-in distribution type. Because the distribution I'm modeling is composed of simple pieces, describing the properties of the distribution is not too difficult, and I have attempted to describe as many features as I know in order to create a well defined distribution that _Mathematica_ 8 would recognize as one of its own. My attempt to define every parameter I can think of follows:               modelDist /:      PDF[modelDist[fS_, μS_, σS_, μL_, σL_], x_] :=     PDF[MixtureDistribution[{fS, 1 - fS}, {NormalDistribution[μS, σS], NormalDistribution[μL, σL]}], x];          modelDist /:      CDF[modelDist[fS_, μS_, σS_, μL_, σL_], x_] :=     CDF[MixtureDistribution[{fS, 1 - fS}, {NormalDistribution[μS, σS], NormalDistribution[μL, σL]}], x];          modelDist /:      DistributionDomain[modelDist[fS_, μS_, σS_, μL_, σL_]] :=      Interval[{-Infinity, Infinity}];          modelDist /:      Random`DistributionVector[modelDist[fS_, μS_, σS_, μL_, σL_], n_, prec_] :=      RandomVariate[MixtureDistribution[{fS, 1 - fS}, {NormalDistribution[μS, σS], NormalDistribution[μL, σL]}], n, WorkingPrecision -> prec];          modelDist /:      DistributionParameterQ[modelDist[fS_, μS_, σS_, μL_, σL_]] :=      !TrueQ[Not[Element[{fS, μS, σS, μL, σL}, Reals] && fS > 0 && fS < 1 && σS > 0 && σL > 0]];          modelDist /:      DistributionParameterAssumptions[modelDist[fS_, μS_, σS_, μL_, σL_]] :=      Element[{fS, μS, σS, μL, σL}, Reals] && fS > 0 && fS < 1 && σS > 0 && σL > 0;          modelDist /:      MomentGeneratingFunction[modelDist[fS_, μS_, σS_, μL_, σL_], t_] :=      fS E^(t μS + (t^2 σS^2)/2) + (1 - fS) E^(t μL + (t^2 σL^2)/2);          modelDist /:      CharacteristicFunction[modelDist[fS_, μS_, σS_, μL_, σL_], t_] :=      fS E^(I t μS + (t^2 σS^2)/2) + (1 - fS) E^(I t μL + (t^2 σL^2)/2)          modelDist /:      Moment[modelDist[fS_, μS_, σS_, μL_, σL_], n_] :=      Piecewise[{{fS*σS^n*(-1 + n)!!*Hypergeometric1F1[-(n/2), 1/2, -(μS^2/(2*σS^2))] + (1 - fS) * σL^n*(-1 + n)!! * Hypergeometric1F1[-(n/2), 1/2, -(μL^2/(2*σL^2))], Mod[n, 2] == 0}}, μS*σS^(-1 + n)*n!!* Hypergeometric1F1[(1 - n)/2, 3/2, -(μS^2/(2*σS^2))] + (1 - fS) * μL*σL^(-1 + n)*n!! * Hypergeometric1F1[(1 - n)/2, 3/2, -(μL^2/(2*σL^2))]];          modelDist /:      Mean[modelDist[fS_, μS_, σS_, μL_, σL_]] :=      fS μS + (1 - fS) μL          modelDist /:      Expectation[expr_, x_ \[Distributed] modelDist[fS_, μS_, σS_, μL_, σL_]] :=      fS*Expectation[expr, x \[Distributed] NormalDistribution[μS, σS]] + (1 - fS)*Expectation[expr, x \[Distributed] NormalDistribution[μL, σL]]      Everything seems to work up through the definition of Expectation, which throws > TagSetDelayed::tagpos: Tag modelDist in Expectation[expr_, > x_\\[Distributed]modelDist[fS_, \μS_, \σS_, \μL_, \σL_]] is too deep for an > assigned rule to be found. I don't know that having a definition for the expectation will magically make everything work, but it's the next step to to try, as having the expectation allows computation of the variance, and for all I know, that is the last tag that I need to define. Is there a syntax that will properly define this `Expectation` in such a way that the expression will pass straight from my `modelDist` to its constituent `NormalDistribution`s? (And if this entirely the wrong way to go about this, some advice to that effect would be appreciated.)


Understanding execution time in nested loops

I have the following simple code               finalList = {};     For[i = 1, i <= myN - 3, i++,      For[j = i + 1, j <= myN - 2, j++,       For[k = j + 1, k <= myN - 1, k++,        l = RandomInteger[{k + 1, myN}];        AppendTo[finalList, {i, j, k, l}];        ]       ]      ] // Timing      for some value of myN I obtain the following execution times               30 0.056     40 0.356     50 1.436     60 4.296     70 12.083     80 43.012     90 116.903      that grow much faster than N^3 (it's about N^6 for the first point and it is increasing for the last two points), and I cannot understand why. Any insight of why this happens?


How can I simulate this toggle mechanism?

I've been introduced to _Mathematica_ very recently. Basically, I haven't actually "solved" anything in my Mathematica lifetime, but I've done some simulations. With my fractional knowledge, I tried simulating a toggle mechanism today. Here's what I did...               ω0 = .02; ω = .02; r = 2; r1 = 6; r0 = 1.5;     rA[θ_, r_] := r*{Cos[θ], Sin[θ]};     rAy[θ_, r_] := r*Sin[θ];     rAx[θ_, r_] := r*Cos[θ];     rC[θ0_, r0_] := r0*{Cos[θ0] + 1/r0, Sin[θ0] + 3/r0};     rCy[θ0_, r0_] := r0*Sin[θ0] + 3;     rCx[θ0_, r0_] := r0*Cos[θ0] + 1;     xB[θ_, r_] := r*Cos[θ] + Sqrt[(r1^2 - (r*Sin[θ])^2)];     rB[θ_, r_] := {xB[θ, r], 0};     rBx[θ_, r_] := xB[θ, r];     rBy[θ_, r_] := 0;     Manipulate[θ = ω*t; θ0 = ω0*t;       rAO = rA[θ, r]; rBO = rB[θ, r]; rDC = rC[θ0, r0];      Graphics[{{Thick, Darker[Green], Dashed, Circle[{0, 0}, r]}, {Thick,          Dashed, Blue, Circle[{1, 3}, r0]},        {Red, EdgeForm[{Thick, Black}], White,          Rectangle[{rBO[[1]] - 0.5, rBO[[2]] - 0.5}, {rBO[[1]] + 1,            rBO[[2]] + 0.5}]},        {Thick, Darker[Red], Line[{{0, 0}, rAO, rBO}]}, {Thick,          Darker[Red], Line[{{1, 3}, rDC, rAO}]},        {Black, Disk[{0, 0}, 0.1], Disk[{1, 3}, 0.1],          Disk[{rAO[[1]], rAO[[2]]}, 0.1], Disk[{rDC[[1]], rDC[[2]]}, 0.1],          Disk[{rBO[[1]], rBO[[2]]}, 0.1]}},       PlotRange -> {{-3, 9}, {-3, 5}},        ImageSize -> {600, 250}], {{t, 20, "Motion"}, 20, N[205*Pi],        N[Pi/16]}]      I think you can figure out that there's a big issue, due to my enormous expectation from the "visualizing" without even thinking of "solving"... ![](http://i.stack.imgur.com/mcHuZ.gif) Both the cranks have the same angular velocity. Because, that's the way I've defined. I've got no other choice. But, the mechanism should begin with the top crank. That crank makes the bottom one to rotate, by transferring power through the connecting rod. Given a connecting rod of constant length (especially, less than the sum of radii of the cranks), the bottom crank cannot complete one full rotation. It can go only halfway, and then turn back. The slider motion remains the same, but the crank is causing a big trouble to the mechanism due to the ridiculous "elastic behavior" of the connecting rod. I don't want to analyze this mechanism. So, I'm cool with any answer that essentially simulates the actual mechanism (even if that's a modification of mine) as I just need the simulation only for a video (at least, for now). At the same time, I'll be very happy with "solving" the equations with constraints, because I guess those solutions may help me in the future for other mechanisms.


How can I show a rotated PDF plot superimposed on a ListPlot of the underlying data?

I have a set of 3 lifetime datasets in lists called values1, values2 and values3. values1 = {53377., 16542., 31418., 5629., 17654., 7365., 15797., 862., 76906., 10073.}; values2 = {74412., 15620., 29650., 96951., 9252., 14257., 11684., 84461., 49724., 14903.}; values3 = {69174., 77036., 115837., 105497., 103195., 55433., 90053., 45861., 57840., 33875.}; The plot of this raw data is shown below. ![enter image description here](http://i.stack.imgur.com/VU74H.png) I now use EstimatedDistribution to fit the data to individual Weibull distributions and plot their PDFs. ![enter image description here](http://i.stack.imgur.com/plOIb.png) ![enter image description here](http://i.stack.imgur.com/mXhAv.png) ![enter image description here](http://i.stack.imgur.com/CFZxx.png) What I would like to do now is to locate and align the individual PDF curves on top of the raw data plot close to their corresponding data points. The PDFs would be rotated 90 degrees clockwise thereby ending up in a vertical orientation in the final plot. At this point I don’t necessarily need the frames and labels associated with the PDF plots to be included. What is most important is that the Age to Failure axes of the Raw Data plot be aligned with that of the PDF plots so that the resulting composite plot is a true mathematically accurate representation of the information in all 4 plots. Below is a depiction of the formatting I’m after (minus the inclusion of the boxes and whiskers]. I don’t know what software tool created this plot. ![enter image description here](http://i.stack.imgur.com/zW9OC.png) The closest I’ve seen to this is in Mathematica is the BoxWhiskerChart but that apparently is unable to show the PDF. Below is my code. Thanks for any help.               values1 = {53377., 16542., 31418., 5629., 17654., 7365., 15797., 862.,     76906., 10073.};          values2 = {74412., 15620., 29650., 96951., 9252., 14257., 11684.,      84461., 49724., 14903.};          values3 = {69174., 77036., 115837., 105497., 103195., 55433., 90053.,      45861., 57840., 33875.};          category1 = Table[1, {10}];     category2 = Table[2, {10}];     category3 = Table[3, {10}];     data1 = Transpose[{category1, values1}];     data2 = Transpose[{category2, values2}];     data3 = Transpose[{category3, values3}];          plot1 = ListPlot[{data1, data2, data3}, Frame -> True,      PlotRange -> {{0, 4}, {0, 150000}},      FrameLabel -> {"Category", "Age to Failure"},      FrameTicks -> {{1, 2, 3}, {0, 25000, 50000, 75000, 100000, 125000,       150000}, None, None}, PlotLabel -> "Raw Data"]          dist1 = EstimatedDistribution[values1,      WeibullDistribution[\[Alpha], \[Beta]]]          dist2 = EstimatedDistribution[values2,      WeibullDistribution[\[Alpha], \[Beta]]]          dist3 = EstimatedDistribution[values3,      WeibullDistribution[\[Alpha], \[Beta]]]          plotrange = {0, 5*10^-5};          plot2 = Plot[PDF[dist1, t], {t, 0, 75000}, Frame -> True,      FrameLabel -> {"Age to Failure", "PDF"},      PlotLabel -> "Distribution 1 PDF", PlotRange -> plotrange]          plot3 = Plot[PDF[dist2, t], {t, 0, 100000}, Frame -> True,      FrameLabel -> {"Age to Failure", "PDF"},      PlotLabel -> "Distribution 2 PDF", PlotRange -> plotrange]          plot4 = Plot[PDF[dist3, t], {t, 0, 150000}, Frame -> True,      FrameLabel -> {"Age to Failure", "PDF"},      PlotLabel -> "Distribution 3 PDF", PlotRange -> plotrange]      Edit 1: I also looked at DistributionChart which appears to return teardrop- like objects but not the actual PDF (probability density function) plot that I am seeking. DistributionChart draws a _representation_ of the distribution of values in each Subscript[data, i]. Edit 2: Here is another example showing “vertical PDFs”, this time on a semi- log plot. I believe one of the ReliaSoft products produced this. See here. ![enter image description here](http://i.stack.imgur.com/Nu6F3.png) Edit 3: Here is George's solution ![enter image description here](http://i.stack.imgur.com/0cVmb.jpg)


How to create a parallelepiped tiling?

I know how to create parallelepiped and combine them to form a parallelepiped tiling, but the tiles overlap... I started with this code:               P1 = Graphics3D[{GeometricTransformation[{Opacity[.85], Red,           Cuboid[]}, ShearingMatrix[Pi/4, {1, 0, 0}, {-1, 1, 0}]]},        Boxed -> False]             P2 = Graphics3D[{GeometricTransformation[{Opacity[.85], Red,           Cuboid[]}, ShearingMatrix[Pi/4, {1, 0, 0}, {-1, 1, 0}]]},        Boxed -> False]          P3 = Graphics3D[{GeometricTransformation[{Opacity[.85], Red,           Cuboid[]}, ShearingMatrix[Pi/4, {1, 0, 0}, {-1, 1, 0}]]},        Boxed -> False]          Show[P1,P2,P3]       ![](http://i.stack.imgur.com/XSBP9.png) I don't know how to fix the positions of the parallelepipeds (I prefer different shapes) so that they will not overlap and no gaps between them.


BubbleChart bubble scale depends on y position

I noticed that the scaling of bubbles in the BubbleChart function depends on the y position of a bubble. Compare these two examples.               BubbleChart[{{60.0, 20.0, 50.0}, {60.0, 90.0, 50.0}},       FrameLabel -> {Style["Count", 24], Style["Total Dollars", 24]},       BubbleScale -> "Diameter", PlotRange -> {{0, 250}, {0, 200}},       ImageSize -> {400, 400}]      ![Bubble chart with small bubbles](http://i.stack.imgur.com/AqDCF.png)               BubbleChart[{{60.0, 20.0, 50.0}, {60.0, 120.0, 50.0}},       FrameLabel -> {Style["Count", 24], Style["Total Dollars", 24]},       BubbleScale -> "Diameter", PlotRange -> {{0, 250}, {0, 200}},       ImageSize -> {400, 400}]      ![Bubble chart with large bubbles](http://i.stack.imgur.com/fFyPl.png) The only difference is the y coordinate. But the bubble size changes. Any ideas?


Colorize and the Four-Color Theorem

We can write:               MorphologicalComponents[image] // Colorize      To assign a random set of colors to each component in some image. The example used for reference by Mathematica is a map of the United States: http://reference.wolfram.com/mathematica/ref/Colorize.html?q=Colorize&lang=en My question is - is it possible to ask Mathematica to specify that any two adjacent colors should have some minimum threshold distance in in their hue or RGB values (e.g. http://en.wikipedia.org/wiki/File:Map_of_United_States_vivid_colors_shown.png)? I believe asking for a four-coloring of a map is computationally non-trivial, but are there any built-in routines, perhaps with the graph analytics packages in Mathematica, to allow for this? Let's define two morphological components as adjacent if the line segments spanning the shortest distance between the two components fails to intersect any other morphological components. We can also include a distance $D$ cutoff for defining two components as adjacent. I'm certainly open to stricter definitions.


How to get a sub range of a larger matrix?

This should be an easy question but I only found a partial solution using `All`. Say I have a matrix A = 1000 x 5, how to get only a part of that matrix, say B = _n_ x 5, where _n_ can be any positive integer that's less than 1000 or the original matrix A row?


How can I efficiently enter multiple instances of data?

I would like to plot the normal distribution for a population of human heights. My question is how can I input multiple frequencies for the same variable, without writing them out one by one. e.g. I have 17 instances of 5'10", 20 of 5'11", 4 of 6'.


Advanced SQL-type select statements (filtering) on Datasets

I'm trying to improve on mathematica's handling of datasets. I'm currently writing this function that should do the following. Suppose I have a dataset with columns, e.g.               cols = {col1, col2, col3}      and I want to remove all `NA` type entries from a subset of these columns, say               subcols = {col1, col2}      To create an example dataset, let's condider:               rows = {         {0.09, 0.53, 0.32},         {"NA", "NA", 0.19},         {0.52, 0.38, "NA"},          {"NA", 0.25, 0.20},         {0.03, 0.61, 0.52}     };          dataset = Dataset[Inner[Rule, cols, #, Association]& /@ rows];      Now, I know that I can select the rows I want by the selection rule:               dataset[Select[NumberQ[#"col1"] && NumberQ[#"col2"]&]]      but I would like to create a short-hand notation for this, so that it applies to bigger datasets (with many columns). In particular, I'd like write a function `DropNA` that takes a dataset and a list of columns as input and outputs a new dataset with all unwanted rows removed. For instance, a test could be:               DropNA[dataset, subcols] == dataset[Select[NumberQ[#"col1"] && NumberQ[#"col2"]&]]      > >     True >   This is what I have so far:               DropNA[dataset_, cols_] := Module[{allCols, GoodRow},            (* get the list of all columns: *)       allCols = dataset[All, Keys] // Union // Normal;            (* some precaution: *)       dropna::badcolumn = "Dataset has an ambiguous set of columns.";       If[Length[allCols] != 1, Message[dropna::ambiguouscolumns]; Abort[]];            dropna::subsetcolumns = "One or more columns provided do not appear in the dataset.";       If[Not[SubsetQ[allCols[[1]], cols]], Message[dropna::subsetcolumns];Abort[]];            (* returns True if it encounters good row: *)       GoodRow[row_] := And @@ (NumberQ[row[#]] & /@ cols);            (* select only the good rows: *)       dataset[Select[GoodRow]]       ]      As it stands now, `DropNA` only returns the entire dataset. Does anyone have any idea what I'm missing here?


Constraining a random function

This question is a follow-up from here. I have a function that generates a list of correlations between some random variables:               varparams = Table[i, {i, 0.1, 0.9, 0.1}];          var[i_] :=       RandomChoice[{varparams[[i]], 1 - varparams[[i]]} -> {1, 0}, 10]          corrcheck[i_, j_, n_] :=       Table[BlockRandom[SeedRandom[k];           Correlation[var[i], var[j]]], {k, n}]      Now, if by chance one or both of `var[i]`,`var[j]` is a list of all 1's, then `Correlation[var[i],var[j]]` is undefined. I want to improve `corrcheck[i_, j_, n_]` so that it automatically throws away all such `vars`. My idea was to do something like this:               corrcheck[i_, j_, n_] :=       Table[BlockRandom[SeedRandom[k];         If[Mean@var[i] != 1 && Mean@var[j] != 1,          Correlation[var[i], var[j]], "N/A"]], {k, n}]      Why doesn't this work? Have I missed a better alternative? Thanks in advance.


How to remove accents from text?

I would like to know how I can remove accents from a string. For example, how can I transform `"string test áéíóú"` into `"string test aeiou"`? I have to normalize some text to make comparisons, and this would be very helpful.


Equality and Quantifiers

I am new to _Mathematica_ and to Math. I do not study math in English, so please bear with me as I try to state my questions.. This is what I am trying to "solve": $$∃!x : A(x) ⇔ ∃x : ¬A(x)$$ In words: "Is 'there is exactly one x for which the assertion A is true' equivalent to 'there is at least one x for which assertion A is not true' ?" Referred to that I have questions:   * Is this something you would normally do with _Mathematica_?    * In the program I opened a "New Notebook" and typed in:               Equivalent[!Exists[x, a[x]], Exists[x, !a[x] ]]       and it - surprise! ;) - did not work. What have I done wrong ?   * How would the answer look like ?


equation solving problems

I have some equation: $$ veq=-2-lr-l^2r+2(r+ir^3\omega) v' + (-2+r)r^2v'^2 + (-2+r) r^2 v''==0 $$ or in Mathematica form:               -2 - l r - l^2 r +      2 (r + I r^3 \[Omega]) Derivative[1][v][r] + (-2 + r) r^2 Derivative[     1][v][r]^2 + (-2 + r) r^2 (v^\[Prime]\[Prime])[r]      then generate veqexp with the code               veqexp[n_] :=      Normal[Series[     veq /. {v[r_] :> Sum[c[i]/r^i, {i, 1, n}],        v'[r_] :> Sum[-i c[i]/r^(i + 1), {i, 1, n}],        v''[r_] :>         Sum[i (i + 1) c[i]/r^(i + 2), {i, 1, n}]}, {r, \[Infinity],       n - 2}]];      I sub into this an ansatz for solution $v=\sum^n c_i r^i$. Calling this new equation in terms of the $c_i$ 'veqexp' (i.e. veq expanded). The following chunk of code can solve this for my coefficients: (note I want to solve around infinity)               vcoeffs[nn_] :=      Block[{}, Clear[c];      Do[c[i] = c[i] /. Solve[          Limit[veqexp[nn] r^(i - 2),             r -> \[Infinity]] == 0, c[i]][[1]];, {i, 1, nn}]] ;      and out correctly pop the $c_i$ coefficients in terms of $(\omega,\ell)$ parameters of my 'veq', so far so good. The problem is that these functions of $(\omega,\ell)$rapidly grow in size until by about the 30th Mathematica's memory gives out and dies. However if I try to calculate for a given $(\omega,\ell)=(0.1,1)$ so that each c[i] is just a number, I also hit problems to do with recursion that I have no idea about. For example               vcoeffs[nn_] :=      Block[{}, Clear[c];      Do[c[i] =        c[i] /. Solve[          Limit[(veqexp[nn] /. {\[Omega] -> 0.1, l -> 1}) r^(i - 2),             r -> \[Infinity]] == 0, c[i]][[1]];, {i, 1, nn}]] ;      generates errors that read                $RecursionLimit::reclim: Recursion depth of 256 exceeded. >>      when I would have expected just a series of $nn$ complex coefficients which would take no memory for Mathematica to store. Can anyone suggest a way around this? thanks


How do I introduce a new variable in a trigonometric equation?

I have the trigonometric equation \begin{equation*} \sin^8 x + 2\cos^8 x -\dfrac{1}{2}\cos^2 2x + 4\sin^2 x= 0. \end{equation*} By putting $t = \cos 2x$, I have \begin{equation*} \dfrac{3}{16} t^4+ \dfrac{1}{4}t^3 + \dfrac{5}{8}t^2 -\dfrac{7}{4}t + \dfrac{35}{16} = 0. \end{equation*} How do I tell Mathematica to do that? Mathematica code is               Sin[x]^8 + 2 Cos[x]^8 - 1/2 Cos[2 x]^2 + 4 Sin[x]^2 == 0


Help generating dynamic manipulators?

I would like to generate dynamic Manipulators for each of the selected buttons in a ToggleBar. How can I keep the state of each Manipulator in a variable? I would like to later access the values of the Manipulators for each of the selected buttons. Thanks.               DynamicModule[{stakes = {}},       Column[{TogglerBar[Dynamic[stakes], {1.5, 3.5, 7, 15, 30, 60, 100,                                            200, 300, 500, 1000}],               Dynamic[Grid[({#, Manipulator[Appearance -> Labeled]}) & /@ Sort[stakes]]]}]]


How to calculate an improper integral

How can I find the range of the parameter `a` such that the improper integral               Integrate[(x^(a - 1))/(1 + x), {x, 0, ∞}]      converges?


Why does string completion work differently between functions?

The behaviour of string completion for functions that take strings as input is not entirely clear to me. For example, when I type a function `f` I tend to go through the following steps: first I type the name of the function and open- close square brackets:               f[]      then I take the cursor one place to the left and open close quotes if `f` takes string arguments:               f[""]      and, finally, I jump one place left again and I enter the string:               f["value"]      but string completion doesn't always work with this way of entering string arguments. Although with `CountryData` it does: ![enter image description here](http://i.stack.imgur.com/a5cWX.png) other functions like `Import` no string completion occurs if you type in the brackets before the argument (which is a useful way of not losing track of open brackets). ![enter image description here](http://i.stack.imgur.com/NBud4.png) ![enter image description here](http://i.stack.imgur.com/tjp48.png) So my question is > Is there a way to force string completion for `Import` so that it works like > `CountryData` does?


Generating a list of integers that roughly satisfy a distribution

Say I have a normal distribution,               NormalDistribution[25, 7]      I'd like integers from 1 to 50, not sampled at random from that distribution, but sampled in a way that the mean is more common than the bounds, following that distribution. What is that called, and is there a way of doing it concisely within Mathematica? I suppose one way to do it would be selecting a number from 1-50 with the probabilities given by               Table[NormalDistribution[25, 7], {x, 1, 50, 1}]     {0.00015967, 0.000257934, 0.000408253, 0.000633121, 0.000962014, \     0.00143223, 0.00208921, 0.00298598, 0.00418147, 0.0057373, 0.007713, \     0.0101596, 0.0131119, 0.0165803, 0.0205426, 0.0249376, 0.0296614, \     0.0345672, 0.0394707, 0.0441593, 0.0484068, 0.051991, 0.0547124, \     0.0564132, 0.0569918, 0.0564132, 0.0547124, 0.051991, 0.0484068, \     0.0441593, 0.0394707, 0.0345672, 0.0296614, 0.0249376, 0.0205426, \     0.0165803, 0.0131119, 0.0101596, 0.007713, 0.0057373, 0.00418147, \     0.00298598, 0.00208921, 0.00143223, 0.000962014, 0.000633121, \     0.000408253, 0.000257934, 0.00015967, 0.0000968449}      Where each position is the probability that that number would be selected: 1 would show up with p = .00015967, etc. Is that right? I'm not really sure how to map and select the integers 1-50 along these probabilities, or even if that's on track. I'm not sure because I don't want it to be left to probability: the function that makes these should be deterministic. I don't think I'm describing this very well. The idea is to have parameters vary normally around the mean, 25, but are integers and not randomly sampled, as I only need a few (though in this case 50) though that number may change. I hope this makes some semblance of sense. The end result would be a list               {1, 5, 10, 13, 17, 20, 22, 23, 24, 25, 25, 26, 27, 28, 30, 33, 37, 40, 45, 50}      Or something like that, but with whatever distribution and number of numbers (I'd like to do it for something like `MixtureDistribution[{1, 1}, {NormalDistribution[25, 7], NormalDistribution[75, 7]}]` as well).


Is there a more elegant and efficient way to write brainf*** style loops in Mathematica?

I'm having some fun writing a brainf*** interpreter in Mathematica. See this wiki article for more info. It works nicely but I'd like to find an elegant, preferably functional, way to handle the looping structures. This is a simple example of what I'm hoping to do with the solution I currently have in place. The variable `ptr` is the position of a pointer in the program. The variable `paren` is used to keep track of the brackets, it increments on "[" and decrements on "]" so it should be zero when I find the proper closing bracket.               ptr = 1;     paren = 1;     lst = {"[", "[", "-", "]", ">", ">", ">", ".", "<", "<", "<", "]",              ">", ">", ">", ">", ">", ">", "."};          While[paren > 0, ptr++;           Switch[lst[[ptr]], "[", paren++, "]", paren--, _, Null]]      Which tells me the closing "]" is located at position 12 in `lst`.               In[287]:= ptr          Out[287]= 12      Is there a more elegant and/or efficient way to do this?


Microsoft SQL DatabaseLink connection using Windows Authentication

For those who use _Mathematica_ with databases in companies, a common way to securely connect to those is using Windows Authentication (detailed here). _Mathematica_ doesn't seem to support this authentication method. How can you connect to a database securely using Windows authentication?


How can Magnify be forced to ignore the notebook's window width?

In a new notebook, I can illustrate how the action of `Magnify` is cut off by the window width:               SetOptions[EvaluationNotebook[], WindowSize -> {600, 1000}]     p = Plot[x^2, {x, -1, 1}]     Magnify[p, 4]      ![enter image description here](http://i.stack.imgur.com/SaEXX.png) At this point, the plot shows only the axis labels enlarged, whereas the documentation states that `Magnify` scales all aspects of the graphic. The expected behavior is recovered if we enlarge the window:               SetOptions[EvaluationNotebook[], WindowSize -> {1700, 1000}]      Notice how the previous plot is now scaled to twice the original size in all aspects. Is there a way to use `Magnify` in windows of arbitrary size and always get a consistent result with all aspects of a graphic scaled by the same factor, as the documentation states?


How can I create a function with optional arguments and options?

Is it possible to create a function with optional arguments that also takes options? Here is a simple example. I have a function `f` with option "g". It also has optional arguments `y` and `z` which are set to default values.               Options[f] = {"g" -> Identity};          f[x_, y_: 2, z_: 3, OptionsPattern[]] :=       OptionValue["g"][x + y + z]      Now, if I give values for all of the arguments and an option value it works just fine.               In[3]:= f[1, 2, 3, "g" -> (#^2 &)]          Out[3]= 36      If I give only the required argument, no problems.               In[4]:= f[1]          Out[4]= 6      However, if I give the required arg and an option value but don't give the optional arguments, I run into trouble..               In[5]:= f[1, "g" -> (#^2 &)]          Out[5]= 4 + ("g" -> (#1^2 &))      Is there a good way around this? **EDIT:** Obviously, it is possible to write multiple definitions...               f[x_, y_, z_, OptionsPattern[]] := OptionValue["g"][x + y + z]          f[x_, y_, OptionsPattern[]] := OptionValue["g"][x + y + 3]          f[x_, OptionsPattern[]] := OptionValue["g"][x + 2 + 3]      I'm curious if there is a clean way to do it with a single definition.


What is the comment shortcut?

I went to a Wolfram Technologies workshop a few weeks ago and the presenter showed us a keyboard shortcut that when a block of input is selected, the shortcut puts the block of selected input in `(* comment *)` brackets. I've forgotten what the shortcut is though. Does anyone know what it is?


How to get a uniformly distributed list of points from a B-spline function

I created a spline function from a list of points and made a plot as follows:                 list2 = {{3.93453, -0.623168}, {3.79708, -0.187231}, {3.72835,        0.0307369}, {3.65963, 0.248705}, {3.5909, 0.466673}, {3.52218,        0.684642}, {3.44186, 1.05816}, {3.36155, 1.29764}, {3.28124,        1.5219}, {3.20093, 1.73094}, {3.12061, 1.92474}, {3.0403,        2.10331}, {2.95999, 2.26666}, {2.87968, 2.41477}, {2.79937,        2.54766}, {2.71905, 2.66532}, {2.63874, 2.76774}, {2.55843,        2.85494}, {2.41254, 2.97924}, {1.98589, 3.2791}, {1.52249,        3.51828}, {1.27967, 3.61368}, {1.03092, 3.69235}, {0.777399,        3.75392}, {0.520275, 3.7981}, {0.260741, 3.82469}, {0., 3.83357}}          g = BSplineFunction[list2,            SplineWeights -> {50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50,              50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50}]          ListPlot[Table[g[t], {t, 0, 1, 1/100}]]      I need my plot to have more evenly placed points. When I take the plot out of this sample table to a larger scale plot, there are gaping holes that are too extreme for my needs. Is there any way to adjust the density of my spline function without just adding more points? Adding more points is not proving to be an effective solution.


How one can make the boundary of the regionplot smaller or bigger?

Suppose we have a regionplot as follows:               mpion = 0.137;     meta = 0.548;     metap = 0.958;     con1 = Sqrt[meta^2 + w1^2 + w2^2 - 2  mpion^2 + 2 Sqrt[w1^2 - mpion^2]  Sqrt[w2^2 - mpion^2]];     con2 = Sqrt[meta^2 + w1^2 + w2^2 - 2  mpion^2 -2 Sqrt[w1^2 - mpion^2]  Sqrt[w2^2 -mpion^2]];          RegionPlot[      Re[con2] < metap - w1 - w2 < Re[con1], {w1, .13, .27}, {w2, .13, .27},        BoundaryStyle -> Directive[Red, Thick], FrameLabel -> {"w1", "w2"},       PlotStyle -> None, BaseStyle -> FontSize -> 16]      ![enter image description here](http://i.stack.imgur.com/wLNKO.jpg) Which we can plot it in x-y plane (x and y are defined as w1 and w2 functions):                Q = metap - meta - 2*mpion;     solw = Solve[x == Sqrt[3]/Q*(w1 - w2) && y == -(2 + meta/mpion)/Q*(w1 + w2) -            1 +  (2 + meta/mpion)/Q*(metap - meta), {w1, w2}];     w1funxy = w1 /. solw[[1]];     w2funxy = w2 /. solw[[1]];               RegionPlot[(Re[con2] < metap - w1 - w2 < Re[con1]) /.         w1 -> w1funxy /. w2 -> w2funxy, {x, -1.4, 1.4}, {y, -1.1, 1.2},        BoundaryStyle -> Directive[Blue, Thick], FrameLabel -> {"x", "y"},       BaseStyle -> FontSize -> 16, PlotStyle -> None]      ![enter image description here](http://i.stack.imgur.com/VUKZL.jpg) How can I make the boundary of the region in x-y plane smaller? just like this graph (The blue and green boundaries). I need the points in blue and green regions around x=y=0 point. I couldn't change the inequality equation of the region in the way that it gives what I want. ![enter image description here](http://i.stack.imgur.com/tHZUK.jpg)


How to find the zero of a function?

I want to find out when a function has a real root. I first made a `RegionPlot3D` when the function is zero.               Manipulate[       RegionPlot3D[(A*x)^(1 - s) -          NSum[B^(n)*(x^((1 - s)*z^n))*           Exp[(1 - z^(2 n))*(1 - s)^2*v^2/(2*(1 - z^2))], {n, 1, Infinity}] -          NSum[B^(n)*(y^((1 - s)*q^n))*           Exp[(1 - q^(2 n))*(1 - s)^2*p^2/(2*(1 - q^2))], {n, 1, Infinity}] == 0,          {x, 0.95, 1.05}, {y, 0.95, 1.05}, {z, 0.95, 0.99}],        {q, {0.95}},        {v,{0.0035}},        {p, {0.0035}},        {s,{2}},        {B,{0.95}},        {A,{0.96}}]      I got a blank cubic. As a check I plotted the function in 2D. However, the 2D plot shows that the function has a zero when `M = x =0.9528` and `K = y = 1.0396`.               Manipulate[       Plot[(A*M)^(1 - s) +          NSum[(B^n*(K^((1 - s)*(q)^n))*           Exp[(1 - (q)^(2*n))*((p)^2)*(1 - s)^2/(2*(1 - (q)^2))]), {n, 1, Infinity}] -          NSum[(B^n*(M^((1 - s)*r^n))*           Exp[(1 - r^(2*n))*(v^2)*(1 - s)^2/(2*(1 - r^2))]), {n, 1, Infinity}] ,          {r, 0.95, 0.99}],        {q, {0.95}},        {M, {0.9528}},        {K, {1.0396}},        {v,{0.0035}},        {p, {0.0035}},        {s, {2}},        {B, {0.95}},        {A, {0.96}}]      Further, I tried to zoom into the area where the 2D plot shows that a zero may exist and found that it is no longer a monotonic function (its zigzag and crosses the horizontal axis many times). What do I make of this? Does it mean that a zero exists in the complex plane?


Plot with sum and binomial command

A few days ago I asked about a problem with plotting a sum. You advise me to use Evaluate option, and that helped me very. But now I have a very similar problem, but i can't find the mistake. I have a equation: $$\sum_{i=0}^x {x\choose l}\cdot l^{10}\cdot(-1)^{(x-l)}$$ I want to draw this for $$x \in [0,10]$$ I used this command:               Plot[Evaluate[Sum[Binomial[x, l]*l^50*(-1)^(x - l), {l, 0, x}]], {x, 1,2}]      There are no errors, but also no graph. If I will expand the equation for $x=1$ I have: $${1\choose 0 }\cdot 0^{10}\cdot (-1)^{1-0} + {1 \choose 1}\cdot 1^{10}\cdot (-1)^{1-1} = 1$$ and for example for $x=5$ it is: $${5\choose 0 }\cdot 0^{10}\cdot (-1)^{5-0} + {5 \choose 1}\cdot 1^{10}\cdot (-1)^{5-1} + {5\choose 2 }\cdot 2^{10}\cdot (-1)^{5-2} + {5 \choose 3}\cdot 3^{10}\cdot (-1)^{5-3} + {5\choose 4 }\cdot 4^{10}\cdot (-1)^{5-4} + {5\choose 5 }\cdot 5^{10}\cdot (-1)^{5-5} = 5 103 000$$ So as you can see, there equation can be evaluated, so why I can't see any plotted points?


How to eliminate the backward play in Export of Manipulate?

I find that the `Export` of `Manipuate` contains backforward play, see a simplified example:               Export["try.swf",       Manipulate[       Plot[Sin[2 x + φ], {x, 0, 10}], {φ, 0, 2 π}]]      You can see the problem in the SWF file. (I'm sorry that the exported SWF file cannot be uploaded here) Actually, I have two questions here,   1. Is there any simple way to get a animation with **only forward** play? I can find nothing about this in the help documents.   2. Why is GIF not working in `Export`? That is to say, if I use `Export["try.gif", Manipulate[...]]`,the exported file, otherwise an animation, is only a static picture actually.


How to compute the inverse CDF properly?

Note: this has been fixed in version 9. * * * I want to compute the CDF and inverse CDF of the hyperbolic distribution:               α = 2; β = 3/2;     x = -3;     u = N[CDF[HyperbolicDistribution[α, β, 1, 0], x], 30]      The output of the above code is               5.36058384200167863956651004148*10^-6      A small, but not too small number. Now, since the CDF and inverse CDF are compositional inverses, I expect the output from the following line to be approximately $-3$:               xA = N[InverseCDF[HyperbolicDistribution[α, β, 1, 0], u], 30]      But _Mathematica_ instead returns               -23.0838707895835608942828900958      which is just way off. So, am I doing something wrong here? Or are _Mathematica_ 's `CDF[]` and `InverseCDF[]` functions not to be trusted for this distribution? When the above experiment is repeated with the normal distribution, there are no problems:               x = -12;     u = N[CDF[NormalDistribution[0, 1], x], 30]     xA = N[InverseCDF[NormalDistribution[0, 1], u], 30]      The output is $-12$ as expected.


Generating a polynomial that's accurate to within an error of no more than 1/10^5

I'm currently stuck on a question for class that asks... "Find a polynomial `p[x]` that you can use to calculate `6 ArcTan[x]` to within an error of no more than `10^(-5)` for all the x's with `-(1/Sqrt[3]) <= x <= 1/Sqrt[3]`." I used a series expansion below.               Clear[x];        approx6arctan[x_] = Normal[Series[6Tan[x], {x, 0, 200}]]      However, this can only generate a function that's accurate only to the fourth decimal, no matter how much I expand the series (200 is already huge). Any hints on how to generate a polynomial that's accurate to the fifth decimal? Thanks in advance.


How could I improve this Central Limit Theorem demonstration speed- and content-wise?

My purpose is to demonstrate the _Central Limit theorem_ by assuming two custom distributions, taking some random samples, calculating their means and ploting the results. Ideally, the histograms should tend to a normal distribution. The code I am using is the following:               \[ScriptCapitalD]1 = ProbabilityDistribution[        1/5 Exp[-(1/5) Abs[2 x - 3]],        {x, -∞, +∞}];          \[ScriptCapitalD]2 = ProbabilityDistribution[         If[x >= -1/2 && x <= +1/2, 1, 0],         {x, -∞, +∞}];          f[n_] := ParallelTable[         Histogram[            Mean /@ Table[RandomVariate[n, 10], {k}], PlotLabel -> "n=" <> ToString@k],         {k, 10, 170, 40}]          cltHistPlots = GraphicsGrid[         {f[\[ScriptCapitalD]1], f[\[ScriptCapitalD]2]},         Spacings -> 0]      And the graph that is generated is this: ![enter image description here](http://i.stack.imgur.com/nZPL9.png) My questions are:   1. How could I speed the process up ? The code is very slow! I think the bottleneck is in the part where `RandomVariate[]` calculates the samples.   2. A bit offtopic, but, could you think of any other addition I could make so that the audience would better understand the theorem ?


Importing numerical data from RTF file

This might be a very simple question but I have been struggling with it for a couple of hours, so thought maybe someone here can show me a quick way of solving it. I have a file in rtf format (Triangles.rtf) https://drive.google.com/file/d/0B_DoKsn6afPMRTNHUW93NEEwc1U/edit?usp=sharing Now I am trying to load the file by typing `a = Import["PATH_TO_FILE/Triangles.rtf","Table"]` which seems to return a list of lists. So far it seems fine, for example `a[[1]]` returns {3 0 2 1}. `Head[a[[1]]]` returns list and `Head[a[[1,1]]]` returns String. Then I try to convert string into number by `ToExpression[a]` but here we get a list of Null! can anyone please tell me how to convert my imported data into a 2d array (list of list that is) so that I can use the numerics?


Implementation of Incomplete Fermi-Dirac Integral in Mathematica

I'm working on a special algorithm to implement a more accurate effective mass calculation for hole carriers in silicon in _Mathematica_. This rather involved algorithm uses incomplete Fermi-Dirac Integrals of the form: $$\mathscr F_j(x,b)=\frac1{\Gamma(j+1)}\int_b^\infty \frac{t^j}{e^{t-x}+1}\mathrm dt$$               Fincomplete[j_, x_, b_] :=1/Gamma[j + 1] Integrate[t^j/(E^(t - x) + 1), {t, b, ∞},                                                        Assumptions -> j > 0]      A call to this function with $b=0$ yields the complete Fermi-Dirac integral representation by the nicely implemented `PolyLog` function within _Mathematica_ :               In[1]:=  Fincomplete[j, x, 0]     Out[1]:= -PolyLog[1 + j, -E^x]      However, if one wants to evaluate the incomplete Fermi-Dirac integral, the expression stays unevaluated, indicating that there is no straightforward solution available.               In[2]:=  Fincomplete[j,x,b]     Out[2]:= Integrate[t^j/(1 + E^(t - x)), {t, b, ∞}, Assumptions -> j > 0]/Gamma[1 + j]      Now, my question(s):   1. Any idea which of the multitude of mathematical functions within _Mathematica_ could be leveraged to implement the incomplete Fermi-Dirac integral? Could the Nielsen generalized polylogarithm function mentioned within the _Mathematica_ help system be of any service?   2. Does anybody have this integral already implemented? There are some series expansions quoted on the web, e.g. Computation of the complete and incomplete Fermi-Dirac integral. However, the reference quotes that the series expansions converge rather slowly, and I would like to leave the implementation of the reference above as last resort, since this would take some time and maybe there is an easier way in _Mathematica_? Thanks in advance for all of your help!


Doing computations in a modulo ring

I need to perform some computations in a modulo ring, like               Mod[Subfactorial[n], m]     Mod[Binomial[n, k], m]      However, this is obviously much too slow for large `n` and `k`. Does Mathematica offer a possibility to perform those computations faster by using more efficient algorithms to compute the modulo? For example, there's Andrew Granville's generalization of Lucas' theorem, which would compute the binomial coefficient much faster. I don't like to implement these by myself, because I want to use Mathematica to cross-check the results of another program of mine.


How to refuse close de Dialog when press Enter Key

As you can see in the documentation of `CreateDialog` > In dialogs created with CreateDialog, pressing Return is effectively > equivalent to clicking the DefaultButton, and Esc to clicking the > CancelButton. > > If the dialog contains no DefaultButton or CancelButton, pressing Return or > Esc will close the dialog without taking any other action. I have a input field, for example, and I often press Enter key after I wrote my inputs. That what happened is that my window close immediately after that. How can change this behavior in Dialog?


Converting expressions to InputForm strings without spaces after commas

One of the little utility packages I use needs to convert Mathematica expressions to `InputForm` text that is interpolated into a custom file format which is then parsed by another tool. That other tool, for various reasons, has to actually parse the `InputForm` expressions, but uses its own parser to do so, and that parser doesn't deal very will with commas in _Mathematica_ expressions. It will choke on something like this:               {{1, 2, 3}, {4, 5, 6}}      but works fine with this:               {{1,2,3},{4,5,6}}      By default, `ToString`, with the `InputForm` format, will stick spaces in after the commas. Currently, I use `StringReplace` to work around the problem:               stringifyForExport[form_] :=          StringReplace[             ToString[form, InputString, PageWidth -> Infinity,                  CharacterEncoding -> "ASCII"],             " " -> ""];      I'm not very satisfied with this solution because it won't work if we have any strings in `form` that contain spaces. So far this hasn't caused serious problems, but I know it's just a matter of time. Is there a better way to get rid of those spaces?


How to use a self-defined function in the Manipulate function

This is what I want               Manipulate[ Plot[ Which[h < a, 1 - 1.5 h/a + 0.5 (h/a)^3, h >= a, 0], {h, 0, 8}],                 {a, 5, 10}]      Is it possible to rewrite it as something like the following?               f[h_] := Which[ h < a, 1 - 1.5 h/a + 0.5 (h/a)^3, h >= a, 0];     Manipulate[ Plot[ f[h], {h, 0, 8}], {a, 5, 10}]      Seems it doesn't work for me. Any suggestion is appreciated.


Parallelization of the stochastic Euler scheme

I wrote a simulation to approximate the law of a stochastic differential equation via a Monte Carlo method using the stochastic Euler scheme. Then I thought, it would be a good idea to speed up things by means of parallelization, but although I think it is an easy example (and similar problems were discussed here lots of times), none of my attempts was successful. First the code (you can find some explanations below):               (* Parameters of the SDE and radius of the Ball *)     T = 10; sigma = 3.0; z = 1; R = 5*10^6;          (* w denotes the noise and h the step size *)     Euler[x_, w_, h_] := x - x^3*h + sigma*w;          (* Noise is a List of Lists of random numbers *)     MCEuler[h_, StepsMC_, Noise_] := Quiet[Check[       Total[Table[        Fold[ Euler[#1, #2, h] &, z, Noise[[i]]]        , {i, 1, StepsMC}]       ]/StepsMC,     Indeterminate     ]];          MCEulerMT[h_, StepsMC_, Noise_] :=       Total[Table[Catch[Fold[If[Abs[Euler[#1, #2, h]] >= R, Throw[0],          Euler[#1, #2, h]] &, z, Noise[[i]]]], {i, 1, StepsMC}]]/StepsMC;          Comparison[h_, StepsMC_] := Module[{Noise},       Noise = Table[RandomReal[NormalDistribution[0, Sqrt[h]], T/h], {StepsMC}];       Return[{StepsMC, h, MCEuler[h, StepsMC, Noise], MCEulerMT[h, StepsMC, Noise]}];     ];          Result =       Table[Table[Comparison[h, StepsMC], {h, {2^0, 2^-2, 2^-4, 2^-6}}], {StepsMC, {10^3}}]      MCEuler implements the Monte Carlo Simulation using the standard stochastic Euler scheme. Since the coefficients of the stochastic differential equations doesn't fulfill standard assumptions like Lipschitz-continuity, it is possible, that some "discrete trajectories" explode. Therefore, I added the `Quiet` and `Check` commands. MCEulerMT uses again the Euler scheme, but if some "discrete trajectory" leaves a ball of radius R, we set the value to zero. The Comparison-method should test both procedures on the same noise. Then I replaced the Table-Commands in MCEuler, MCEulerMT and the last line of the code (I didn't use it creating the noise, but I think there are no side- effects!?) by "ParallelTable" and the runtime was awful. It was much slower than the code above, and I tried other implementations and commands (e.g. Parallelize) but I didn't make any progress. Perhaps here are some guys, who could explain me, what's wrong about my idea, and how I could fix it.


Limit not evaluating

Why is the input `Limit[IntegerPart[Sin[x]/x], x -> 0]` not being evaluated? ![Mathematica session](http://i.stack.imgur.com/H9dz6.png)


How to Solve this ODE with Mixed Boundary condition

I have an ODE equation which is sort of               y''[x] + 2 y'[x]/x + .0001 (y[x])^3 ==0       subject to the boundary conditions               y'[0]==0  and y[Infinity]==0      Can anyone please suggest what would be a reliable process for solving this numerically in Mathematica? `y[Infinity]` can obviously be truncated down to , say, `y[20]`.


Normalize equation in NDSolve?

I have numerically solved and plotted the solution to the Mathieu equation using NDSolve successfully, as below:               ClearAll["Global`*"]     a = 0.5;     b = 0.1;     w0 = 2.0;     T = 2 Pi/w0;          f[t_] := f[t] = y''[t] + (a + b  Cos[t]) y[t] == 0          s = NDSolve[{f[t], y[0] == 1, y'[0] == 0}, y, {t, 0, 1}]          Plot[Evaluate[y[t] /. s], {t, 0, 1}, PlotRange -> All]      But now I wish the normalize the period so I can plot from `t=0 -> t=1` and get 1 full period. I can do this by hand, but how do I do this inside of the `NDSolve` function?


Shortcut to insert plaintext?

Oftentimes I would find it useful to insert plaintext, to not be evaluated as input, right next to my input code. Is there a shortcut key to insert such a plaintext input box? I have relied on comments (shortcut key `Alt`+`/`), but as I use a touchscreen display and a small Bluetooth keyboard, it is a real hassle to select a line of text and hit `Alt`+`/`. So I was looking for something easier.


Problem with ParametricPlot

I'm ploting gear curves (http://mathworld.wolfram.com/GearCurve.html), and I observe that for some parameter values `ParametricPlot[]` does not plot all the teeth:               gearCurve[a_, b_, n_] := ParametricPlot[       {         (a + 1/b Tanh[b Sin[n t]]) Cos[t],          (a + 1/b Tanh[b Sin[n t]]) Sin[t]       },        {t, 0, 2 Pi},        Axes -> False];       gearCurve[10, 5, 38]      produces the following image: ![problematic gear](http://i.stack.imgur.com/bB595.gif) What is going on?


How do I place a texture on an irregular 3D model?

I'm trying to reproduce a textured head in Mathematica, and I'm using a kind of 'net' of a head which contains all the features on the face. The texture looks like this: ![enter image description here](http://i.stack.imgur.com/LmTQl.jpg) which is supposed to look something like this:![enter image description here](http://i.stack.imgur.com/8RuWq.png) Here's the code I'm using.               ListSurfacePlot3D[Import["inputImage.obj", "VertexData"],      PlotStyle -> Texture[texture], Mesh -> None, MaxPlotPoints -> 80,      TextureCoordinateFunction -> ({#1, -#2, #3} &)]      which gives me![enter image description here](http://i.stack.imgur.com/PCxHA.jpg) Another problem is that the texture is reflected about the origin (ie the face is plastered on the back of the head as well). It should instead be black on the back of the head mesh. I suppose this is suppose to do with the head being centered at the origin. I also need to have the texture to 'follow' the head when I change the coordinates of the mesh later on. I have attempted using               Graphics3D[      {EdgeForm[],       Texture[texture],       GraphicsComplex[mesh,        Polygon[polygon, VertexTextureCoordinates -> mesh]]}]      but it gives me this instead ![enter image description here](http://i.stack.imgur.com/lpK2R.jpg) I need to be able to reproduce this in Mathematica as I have some coordinate transformations which I need to apply, and thereafter, 'wrap' the mesh with the texture. Are these possible? EDIT: The link to the model is located https://www.dropbox.com/s/3elv96e8mfodzou/fit_9D0F8093-5566-4EE4-88A7-00070C1D6305.zip EDIT 2: I've tried converting the OBJ to PLY and I did this               Import["inputImage.ply", "UserExtensions"][[2]]     Import["inputImage.ply", "UserExtensions"][[3]]      which gave an output of               "texture_u" -> {..}     "texture_v" -> {..}      where .. was a bunch of numbers which had a `Length` of 3066 for both. My guess was that these are texture coordinates (where u is horizontal and v is vertical) as per the links provided by Rahul Narain. I attempted to create a list of coordinates from these two list in the following manner               texturecoord = {Import["inputImage.ply", "UserExtensions"][[2]][[2]],         Import["inputImage.ply", "UserExtensions"][[3]][[2]]} // Transpose      Then, I tried doing               Graphics3D[      {EdgeForm[],       Texture[texture],       GraphicsComplex[mesh,        Polygon[polygon, VertexTextureCoordinates -> mesh]]}]      But that gives me this ![enter image description here](http://i.stack.imgur.com/D20xM.jpg)


Parallelizing an associative binary operation

I have an associative binary operation '`.`', which I often use in this sort of way:               result = expr1 . expr2 . expr3 . expr4      The '`.`' operation is very fast, but the individual subexpressions are often _hard_ to compute. So I would like my '`.`' operation to automatically parallelize itself, evaluating each of the separate subexpressions in separate kernels before finally taking the results and actually performing the operation. How can I achieve this in Mathematica? It seems there are several challenges. One is to prevent the subexpressions evaluating before the '`.`' operation is evaluated.


Finding maximal sublist of linearly independent vectors

Given a list of vectors `v = {v1, ..., vn}`, which is the fastest way to find a maximal sublist of linearly independent vectors? I could add the vectors one by one to a list and check for the rank of the resulting matrix, but I would like to know if there's a better solution. Thanks in advance.


10bits per rgb / 1024 shades of gray?

Can we display 10 bits per rgb in Mathematica? I'm using a quadro card and 30 bit monitor and can get a smooth gradient using Psychtoolbox in matlab. The following Mathematica should produce a bar with 8 shades of gray with 10 bits per color but I only see two, implying 8bits per color. (Stretch the bar across the full width of the screen and you'll see 8 steps if it is using 10 bits per color and 2 steps if it is only using 8).               n = 1024;     start = 512;     end = 519;     Graphics[Table[{GrayLevel[g], Rectangle[{g, 0}, {g + 1/n, .001}]}, {g,         start 1/1024, end 1/1024, 1/n}]]      I'm interested as I have 16 bit greyscale image data and the staircase effect at low bit depth reduces the ability to interpret the images efficiently without adjusting the window of 256 greys over which the 65535 greys present can be viewed. 1024 greys would be a useful improvement. This has been possible in medical imaging for several years but very expensive (tens of thousands of dollars, i.e. Dome 10MP). Now relatively "cheap" setups (like a \$1k quadro card and \$1k dell u3011 display) are able to do similar so it would be great to be able to achieve the same in Mathematica. I think it is to do with enabling opengl but thats as far as I've got.


Constraint minimization with NMinimize

I am using the following code in order to minimize the function `chi`               R = {5.68, 6.81, 7.95, 9.08, 10.22, 11.35, 12.49, 13.62, 14.76, 15.89,         17.03, 18.16, 19.30, 20.43, 21.45, 22.47, 23.50, 24.52, 25.54,         26.56, 27.58, 28.6, 29.62, 30.65, 31.67, 32.69, 33.71, 34.73};     V = {235.5, 242.9, 251.1, 262, 258.9, 255.1, 251.8, 252.1, 251, 245.5,         232.8, 232, 235.7, 229.3, 227.6, 226, 225.7, 227.5, 227.4, 225.6,         224.4, 222.3, 222.1, 224.9, 228.1, 231.1, 230.4, 226.8};     dV = {17.8, 0.8, 0.7, 2.1, 6.9, 5.7, 17.1, 7.4, 18.6, 28.8, 1, 14.2,         4.6, 13.8, 28.8, 28.8, 28.8, 28.8, 28.8, 28.8, 28.8, 28.8, 28.8,         28.8, 28.8, 28.8, 28.8, 28.8};     ICov = Inverse[DiagonalMatrix[dV]*DiagonalMatrix[dV]];     G = 6.67*10^(-20);     Msol = 2*10^30;     kk = 3*10^16;     sl = 299792;     incl = 90*Pi/180;               Vth[a_, b_, c_, d_] =        Sqrt[(G*a*Msol)/(R*kk)*(1 - Exp[-(R/d)]*(1 + R/d))]*(1 -           b*Exp[-R/c]/R);               chi = (Vth[M, \[Delta], L, Ld] - V).ICov.(Vth[M, \[Delta], L, Ld] -           V);     NMinimize[{chi, M > 0 && L > 0 && Ld > 0}, {M, \[Delta], L, Ld}]      Since `M` is a mass, and both `L` and `Ld` are lengths, and I know nothing about `[\Delta]`, the constraint should be: `M>0 && L>0 && Ld>0`: When I use it, I find:               {5848.86, {M -> 1.58505*10^6, \[Delta] -> -1.18329*10^6,        L -> 1.15986*10^6, Ld -> 3118.75}}      Since I know that the mass should be `M>2*10^11`, I tried to use this a constraint, and I find:               {40.8086, {M -> 2.41901*10^11, \[Delta] -> 8.90217, L -> 2.12644,        Ld -> 4.78551}}      Much better! Why doesn't Mathematica find it by itself? How can I improve my constraints?


Problem with Eventlocator Method for NDSolve

I want to solve the ode and plot the solution `v[x]` for different values of parameter `a` where `x=2000` (for just any fixed position x or event at x). By looking at examples of `EventLocator` available online i tried to write the code as:               data = Table[Reap[         soln =           NDSolve[{I D[v[x], x] == (0.4 + a)*v[x], v[0] == 1}, {v[x]}, {x, 0, 2000},           Method -> {"EventLocator",              "Event"          -> Abs[v[x]]^2,              "EventCondition" -> x == 1000,             "EventAction"    :> Sow[{a, Evaluate[Abs[v[x]]]^2 /. soln}]}]][[2, 1]],       {a, -1, 0, 0.3}]      But it does not give data file i wanted to grab as`{a,[Abs[v[x]]^2}`. instead it shows: > Part::partw: Part 1 of {} does not exist. >>   >  Part::partw: Part 1 of {} does not exist. >>   >  Part::partw: Part 1 of {} does not exist. >>   >  General::stop: Further output of Part::partw will be suppressed during this > calculation. >> > > {{{{v[x]->InterpolatingFunction[{{0.,2000.}},<>][x]}},{}}[[2,1]],   >  {{{v[x]->InterpolatingFunction[{{0.,2000.}},<>][x]}},{}}[[2,1]],   >  {{{v[x]->InterpolatingFunction[{{0.,2000.}},<>][x]}},{}}[[2,1]],   >  {{{v[x]->InterpolatingFunction[{{0.,2000.}},<>][x]}},{}}[[2,1]]} Any kind of help or suggestion will great .Even if you can help using other method like using for loop and logical condition that will be great too.


How to type binomial coefficient $\binom{n}{k}$

I know how to type a fraction as you would write a fraction in Mathematica (9). How do you type `Binomial[n,k]` as $\binom{n}{k}$ in Mathematica? Is there a single reference page that contains all the Mathematica operations like this, that you can type in math notation?


MapThread Alternatives

I want to add two matrices, the first one containing a 2D vector at each position the other one a list of 2D vectors. The 2D vector from the first matrix should be added to each of the 2D vectors at the same position in the other matrix. The way I know of is using MapThread, but is there a faster way? So basically I have two matrices defined like this:               MA = Table[RandomReal[], {i, 10}, {j, 10}, {k, 2}];     MB = Table[RandomReal[], {i, 10}, {j, 10}, {k, 3}, {l, 2}];      The output of `MA+MB` should be `Mout[[i,j]] = {MA[[i,j]]+MB[[i,j,1]],MA[[i,j]]+MB[[i,j,1]],MA[[i,j]]+MB[[i,j,1]]}` for each pair of indices `i,j`. The one method I am using right now is a combination of `MapThread` and `Map`:               Mout = MapThread[Function[{x,y},x+#&/@y],{MA,MB},2]      This works but is rather slow. Is there a faster and maybe more elegant way to do this?