Manipulate with formatted output

I would like to have 4 output fields for something like the following:               Manipulate[     n*x     n/x     n + x     n - x,     {n, 1, 10}, {x, 1, 10}, ControlType -> InputField]      but this just outputs all 4 calculations combined.


Gateaux (directional) derivatives and higher order differentials of a functional

I would like to calculate the Gateaux derivative of a functional (i.e. a function depending on functions). A simple example for the Dirichlet functional: $L(u(x))=\int_0^1 \frac{1}{2} (u'(x))^2 dx$ Its derivative in the direction of $v(x)$ is then calculated by: $dL[u](v)=\left.\frac{\partial}{\partial t}L(u(x)+t v(x))\right|_{t=0}=\int_0^1 u'(x) v'(x) dx$ In Mathematica I define the functional under consideration without arguments, like that:               L[u_] := Integrate[(1/2)*D[u, x]^2, {x, 0, 1}]      and in order to compute the derivative I use the following recipe:               d[functionalHead_, functions_, testfunctions_, independentvar_] :=       Block[{t},          myop[x_, y_] := Operate[x, y, 0];          (D[#, t] &)[functionalHead @@            Flatten[{             Inner[myop, Flatten[{functions}], Flatten[{independentvar}], List] +                 t*Inner[myop, Flatten[{testfunctions}], Flatten[{independentvar}],                  List]}]] /. t -> 0]          d[L, u, v, x]      > $\int_0^1 u'[x] v'[x] \, dx$ The funny list constructions in the definition of `d` is because I need to allow for multiple arguments that do not exclusively depend on the same space variables. Notice the the output functional is in a slightly different (more correct) form than the input functional. Now I would like to calculate higher order derivatives, here's the second one: $d(dL[u](v))[w]=\left.\frac{\partial}{\partial t}dL[u+t w](v)\right|_{t=0}=\int_0^1 w'(x) v'(x) dx$ and higher ones are then defined recursively (in this case the Dirichlet functional is quadratic and hence third and higher order derivatives are zero), and problems appear: If I want to use my function I have to redefine the output of the first derivative so that it looks like               dL[u_] := Integrate[D[u, x] D[v[x], x], {x, 0, 1}]      then we get               dL[u]      > >     0 >   but               d[dL, u, w, x]      > $\int_0^1 v'[x] w'[x] \, dx$ Since I need to calculate a bulk of higher (third, fourth, fifth etc.) derivatives of some nonlinear functionals the workaround of redefining without an argument is very ineffective. Does anybody have any idea how to make the process more systematic? EDIT: I came up with a solution. I redefined my derivative operator (now called `d1`) to use pure functions instead of symbols and produce a correct output which can then be used for an iteration. Here's the code:               d1[functionalHead_, functions_, independentvar_, i_: 1] :=       Block[{t,             testfunctions :=                 Flatten[ToExpression[StringReplace[ToString[{functions}],                         s : Except["," | "}" | "{" | "[" | "]"] .. :> s <>                                                                                ToString[i]]]]},                 myop[x_,y_]:=Operate[x,y,0];                (D[#,t]&)[functionalHead@@                           Flatten[                            Inner[Function,                             Flatten[{independentvar}],                             Flatten[                              Inner[myop, Flatten[{functions}],                                                                            Flatten[{independentvar}],List]                              +t*Inner[myop,Flatten[{testfunctions}],                                       Flatten[{independentvar}], List]                                   ],List]]]/.t->0];          d[functionalHead_, functions_, independentvar_, n_: 1] :=       Block[{i, tempfunc, tempfunctions, temp, dtemp},             tempfunctions = functions;             ToExpression[              ToString[temp]<>"["<>               StringReplace[ToString[{tempfunctions}],{s:"{"|               "}"..:>"",s:Except[","|"}"|"{"|"["|"]"]..:>s<>"_"}]<>"]:="                  <>ToString[functionalHead]<>"@@Flatten["               <>ToString[{tempfunctions}]<>"]"];             For[i = 1, i <= n, i++,                ToExpression[ToString[dtemp]<>"["                  <>StringReplace[ToString[{tempfunctions}],{s:"{"|                 "}"..:>"",s:Except[","|"}"|"{" |"["|"]"]..:>s<>"_"}]<>"]=d1["                 <>ToString[temp]<>","<>ToString[tempfunctions]<>","                 <>ToString[independentvar]<>","<>ToString[i]<>"];"];                ToExpression[ToString[temp]<>"["<>StringReplace[ToString[                 {tempfunctions}],{s:"{"|"}"..:>"",s:Except[","|"}"|"{"|                 "["|"]"]..:>s<>"_"}]<>"]="<>ToString[dtemp]<>"@@Flatten["                   <>ToString[{tempfunctions}]<>"]"];];             temp @@ Flatten[{tempfunctions}]]      The recursion step is sadly very messy: I wanted that the test functions are automatically named u1, v1 for the first derivative or u2 for the second and so on. This led me to a confusing manipulation of variable names which I was unable to do in a Mathematica-way so I transformed everything to strings, did the manipulation and pulled everything back as expressions. Note the `Except` command is being used because I also wanted to include greek and special characters as function names. The whole thing now works like so:               L[u_,v_,w_]:=Integrate[(1/2)*D[u[x],x]^2+(1/2)*D[v[x],x]^2,{x,0,1}]+(1/2)*w[s]^2     d[L, {u, v, w}, {x, x, s}]      > $\int_0^1 \left(u'[x] \text{u1}'[x]+v'[x] \text{v1}'[x]\right) \, dx+w[s] > \text{w1}[s]$               d[L, {u, v, w}, {x, x, s},2]      > $\int_0^1 \left(\text{u1}'[x] \text{u2}'[x]+\text{v1}'[x] > \text{v2}'[x]\right) \, dx+\text{w1}[s] \text{w2}[s]$ EDIT2: I've changed the title since it seems to be some discrepancies with respect to the terminology used in Wikipedia and in other references: to be concise, I am following the book from Ambrosetti and Prodi on nonlinear analysis.


Ignore missing data while doing a Mean

I want to compute the mean of a list while ignoring missing values, but I don't find a lot of information on how to deal with Missing data in Mathematica. I have a list like :               a = {{{0, 1}, {2, Na}} , {{0, 3}, {2, 5}}}       and I want to compute the mean but ignoring the Na values. So my output would be:               a = {{0, 2}, {2, 5}}       How can I do that? Thanks.


How to solve an operator form of an integral equation by iteration method?

How I can obtain the $n^{th}$ approximation of the following Operator form integral equation? $F(t)=A(t)+\int_0^tds B(s)F(s)$, where $A(t)=\bigg{(}\begin{matrix}t&0\\Cos(t)&1 \end{matrix}\bigg{)}$, $B(s)=\bigg{(}\begin{matrix}e^s&0\\0&e^{-s} \end{matrix}\bigg{)}$


How to find the values of $m$ so $A \cap B = \emptyset$ and $A \cup B = (-3,+\infty)$?

I have two intervals $A = (-3, m^2- 2]$ and $B=[m, +\infty)$. How to find the values of $m$ so that $A \cap B = \emptyset$ and $A \cup B = (-3,+\infty)$? I tried               {a = x > -3 && x < m^2 - 2, b = x >= m} {Reduce[a || b]}      and               {a = x > -3 && x < m^2 - 2, b = x >= m}     {Reduce[a && b]}      We have $A \cap B = \emptyset$ when and only when $$\begin{cases} m^2 - 2 > -3&\\ m^2 - 2 <m. \end{cases}$$ and $A \cup B = (-3,+\infty)$ when and only when $$\begin{cases} m^2 - 2 > -3&\\ m^2 - 2 \geqslant m. \end{cases}$$ Therefore we need to solve two systems of inequalities.


How I can make a menu with different graphs with modifiable parameters?

I want a user friendly window in which to have a menu where you can choose the chart you want to display, in which you can move parameters in order to note the width or height of the chart, but I try to declare a function which call control so that using TraditionalForm displayed as the user can understand it, but it is no longer displayed graph. My question is: How I can do to have a function declared prior to Manipulate plot and also will allow me to move the parameters?                 a = "Algebraicas";       b = "Trigonometricas";       c = "Tercer Grado";       y = w + 1;       Module[{myPlot}, myPlot[f_] := Plot[f[x], {x, -5, 5}];             Manipulate[             myPlot@selection,             {x, {a, b, c}, ControlType -> PopupMenu},                 {{selection, None}, selChoice, ControlType -> SetterBar},                     {selChoice, Which[                       x == a, {Sqrt[y] -> TraditionalForm[Sqrt[y]] &, #^2 &},                       x == b, {#^3 &, Abs@# &},                       x == c, {Sin, Cos}]}, None}]]      but I need to do is you can move the graph parameters, such as:               Manipulate[Plot[Sin[a x + b], {x, 0, 6}], {a, 1, 4}, {b, 0, 10}]      Now I want to have a label on each graph which is observed as the values are updated manipulate the slide, this is the code that I have.                Clear[a, b, c];      types = {"Algebraicas", "Logaritmicas y exponenciales",        "Trigonometricas", "Trigonometricas Inversas", "Hiperbolicas",        "Hiperbólicas Inversas"};            Manipulate[          Plot[              selection /. {a -> a0, b -> b0}, {x, -5, 5},               PlotRange -> {{-5, 5}, {-10, 10}}, PlotStyle -> {Blue, Thick},               PlotLabel -> selection],      {type, types, ControlType -> PopupMenu},          {selection, Dynamic[type /.            Thread[types -> {{Sqrt[a x + b] -> TraditionalForm[Sqrt[a x + b]],             a x^2 + b, a (x - b)^3, a Abs[x - b]}, {Log[10, 1000],             Log[E, x], Log[1000.]}, {Sin[a x + b], Cos[a x + b],             Tan[a x + b]}, {Cot[a x + b], Csc[a x + b],             Sec[a x + b]}, {"a"}, {"b"}}]],            ControlType -> SetterBar},            {{a0, 1, a}, 1, 4}, {{b0, 0, b}, 0, 10}]      This is the new code.                  Clear[Seleccion, tipos, Tipo, selecciones, funciones, a, b, c, d, a0, \        b0, c0, d0]        tipos = {"Algebraicas", "Logaritmicas y exponenciales",         "Trigonometricas", "Trigonometricas Inversas", "Hiperbolicas",         "Hiperbólicas Inversas"};        funciones = {{c ( x/d + a) + b, c Sqrt[ x/d + a] + b,         c ( x/d + a)^2 + b, c (x/d + a)^3 + b, c Abs[x/d + a] + b,         c/(x/d + a) + b, c/(x/d + a)^2 + b}, {c Log[E, x/d + a],         c Log[2, x/d + a] + b, c Log[(1/2), x/d + a] + b,         c Exp[x/d + a] + b, c 2^(x/d + a) + b,         c (1/2)^(x/d + a) + b}, {c Sin[x/d + a] + b, c Cos[x/d + a] + b,         c Tan[ x/d + a] + b, c Cot[x/d + a] + b, c Csc[x/d + a] + b,         c Sec[ x/d + a] + b}, {c ArcSin[ x/d + a] + b,         c ArcCos[ x/d + a] + b, c ArcTan[ x/d + a] + b,         c ArcCot[x/d + a] + b, c ArcCsc[x/d + a] + b,         c ArcSec[ x/d + a] + b}, {c Sinh[x/d + a] + b,         c Cosh[x/d + a] + b, c Tanh[ x/d + a] + b, c Coth[x/d + a] + b,         c Csch[x/d + a] + b,         c Sech[ x/d + a] + b}, {c ArcSinh[ x/d + a] + b,         c ArcCosh[ x/d + a] + b, c ArcTanh[ x/d + a] + b,         c ArcCoth[x/d + a] + b, c ArcCsch[x/d + a] + b,         c ArcSech[ x/d + a] + b}};             Manipulate[Seleccion = tipos /. Thread[tipos -> funciones[[All, 1]]];        Dynamic@Plot[        Seleccion /. {a -> a0, b -> b0, c -> c0, d -> d0}, {x, -5, 5},         PlotRange -> {{-5, 5}, {-10, 10}}, PlotStyle -> {Orange, Thick},         PlotLabel ->         Style [Framed[        Pane[TraditionalForm[         Seleccion /. {a -> a0, b -> b0, c -> c0, d -> d0},          3], {Automatic, 40}]], White, Background -> Lighter[Gray]],         AxesLabel -> {Style[x, Large, Bold, Blue],         Style[y, Large, Bold, Blue]},         LabelStyle -> Directive[Black, Bold], ImageSize -> 540], {Tipo,         tipos, ControlType -> PopupMenu}, {Seleccion,         Dynamic[Tipo /.         Thread[tipos ->          With[{selecciones = Map[# &, funciones, {2}]}, selecciones]]],          ControlType -> SetterBar}, {{a0, 0, "a"}, -3, 3}, {{b0, 0, "b"}, -3,         3}, {{c0, 1, "c"}, -3, 3}, {{d0, 1, "d"}, -3, 3}]


Is it possible to use Mathematica to record sound and/or vision?

I think the title says it all. I know about `ImageCapture` which seems to capture stills. Can `ImageCapture` be made to capture a movie analogous to using say QuickTime player (and export to video format)? Likewise, if a microphone is connected to your computer (e.g. something that can be used by QuickTime to record) can Mathematica record sound? **Edit** Because I was aware of `ImageCapture` prior to posting this question I did some searches looking for functions that may involve recording e.g.:               ?*ecord*      But got no hits. It is frustrating to find that capturing an image gets its own intuitive function name whereas recording sound does not. But even more frustration that on my Mac I get this:               SystemDialogInput["RecordSound"]     SystemDialogInput::unsupt: "The \!\(\"RecordSound\"\) dialog type is not currently supported on this platform. "      **Edit 2** Thanks for the frame by frame type capture solutions posted below but I was hoping for a more direct (native) solution -- even if undocumented -- that would be analogous to me just controlling QuickTime from within Mma (which can be done). As for recording sound, does anyone know why `SystemDialogInput["RecordSound"] ` isn't supported on Macs and what potential methods exist for Mac? thanks Mike **Edit 3** In Version 9 `SystemDialogInput["RecordSound"]` works on Macs.


Efficiently deleting rows in many large text files

I have 500 text files each of about 200000 rows. I need to delete one row in each of them as fast as possible (later such operations will repeat). What is the best way to do this with Mathematica? Solutions using `NETLink`, `JLink` etc. are welcome! **Update:** I have found a solution for C#: "Efficient way to delete a line from a text file" but I don't know how to adapt it for using through `NETLink`. Another option probably is to use the `java.io.RandomAccessFile` class in Java but I am not very familiar with Java and `JLink`. Any help will be appreciated!


Grid - Item - Alignment to decimal problem

Still present in version 10. * * * I've run into a `Grid` layout problem for which I don't know a solution. I want to specify alignment to a specific character such as a decimal _and_ an `ItemSize` on a per-`Item` basis. When I try to do this the decimal ends up on the right edge of the field rather than somewhere in the middle. My application is part of a larger, more complex Grid layout but here is a simple illustration:               gridIt[itemopts__] :=      Module[{x},       x = {{1.234, 12.34}, {123.4, 1234.}, {1234, 1.234}};       x = Map[Item[#, itemopts] &, x, {2}];       x = Prepend[x, {"Title", SpanFromLeft}];       Grid[x, Alignment -> {Center, Center}, Dividers -> All]      ]          gridIt[Alignment -> "."]      ![Mathematica graphics](http://i.stack.imgur.com/wiCqi.png)               gridIt[Alignment -> ".", ItemSize -> 4.4]      ![Mathematica graphics](http://i.stack.imgur.com/J2LI3.png) Why does this happen and how can I work around it?


How to make all values positive?

So I have a list of data that contain both positive and negative values, and I am wondering what I have to do in order to make all the numbers positive.


Create a CDF file with a plot that cannot be edited by double-clicking

I have created a CDF file that contains a `Manipulate` object with a plot. I intend to embed the file in a web site, so that users can use interactive sliders to change the parameters of the plot. My problem is that when opening the CDF file in a browser, the user can double-click on the plot and edit it (move lines, move points, etc.). The only interactive content I want in the web site are the sliders produced by `Manipulate`. How can I create a CDF file that doesn't allow the user to edit the plot?


Grid - sizing and spacing problems with spanning cells

I am trying to set up a `Grid` with cells that span two rows and are centered on those rows, but I am having troubles with the sizing and, therefore, spacing of the elements. For illustration I can get something that has at least part of the layout right by using `TableForm`, but this will not work in practice because the columns do not align, there is no `Dividers` option, `Item` is not fully supported, etc.               dot = Graphics[{Pink, Disk[]}, ImageSize -> 40];          dat = {{"Angel Falls", "17.7 m", "0.82", "9.2"},        {"Bridalveil Fall", "6.9 m", "0.94", "9.8"},        {"Cascata delle Marmore", "8.25 m", "0.87", "6.3"},        {"Cumberland Falls", "182.0 m", "0.87", "6.3"},        {"Dettifoss", "7.41 m", "0.88", "6.7"}};          table = {dot, {#, {##2}}} & @@@ dat;          TableForm[table, TableSpacing -> None]      ![Mathematica graphics](http://i.stack.imgur.com/JGphG.png) Notice that the pink dot is roughly centered between the two lines, and there is no excess space around the text. If the dots are resized the alignment is retained: ![Mathematica graphics](http://i.stack.imgur.com/wXQlW.png) Now compare the result of `Grid`:               {       {dot, Item[#, Alignment -> Left], \[SpanFromLeft], \[SpanFromLeft]},       {\[SpanFromAbove], Item[#2, Alignment -> "."], #3, #4 "cms"}     } & @@@ dat;          Grid[Join @@ %,      Alignment -> {Center, Center},      Spacings -> {Automatic, 0},      Dividers -> All     ]      ![Mathematica graphics](http://i.stack.imgur.com/BbbrU.png) The spacing and alignment is all wrong because the second element on the first row of each pair (e.g. "Angel Falls") is given the vertical size of the dot. If the dots are a different size the alignment changes: ![Mathematica graphics](http://i.stack.imgur.com/z7It8.png) How can I get the vertical alignment shown in the `TableForm` example while retaining all the features of `Grid`? To clarify, it is fine if the lines end up further apart when the size of the dot is increased, but they should remain centered. Also, I expect that when the size of the dot is twice as high as a line of text (or other objects) that there will be no extra space. To fully answer this question I need a way for the cell containing "Angel Falls" to have _less height_ than the dot.


How can I add points on a plot?

I have a list of points that I want to a plot, but I can't figure out how to do it with `Epilog`. Here's the code I have so far:               Gammaconst = 1.67;      Pa = 975.452; Pb = 975.452; Pc = 384.269; Pd = 384.269;     Ta = 355; Tb = 355; Tc = 295; Td = 295;     R = 8.3144; n = 0.000137;     V1 = 4.97*(10^-6); V2 = 2.736*(10^-5); V3 = 2.902*(10^-5); V4 =       6.63*(10^-6);     P[V_, T_] := n*R*T/V;     Plot [{P[V, T = 355], P[V, T = 295]}, {V, 0.000005, 0.00003       }, AxesOrigin -> {0, 0},       AxesLabel -> {"Volume (\!\(\*SuperscriptBox[\(m\), \(3\)]\))",         "Pressure (Pa)"},      Epilog -> {Line[{{V1, P[V1, 355]}, {V4, P[V4, 295]}}],        Line[{{V3, P[V3, 295]}, {V2, P[V2, 355]}}]}]     Plot[{{V1, 101325 - Pa}, {V2, 101325 - Pb}},       PlotStyle -> PointSize[0.015]]      I get a nice graph and I want to mark a few points on it to show where they are. After the first `Plot` command is a second plot containing the points I was testing with. I get an error mesage that says > "PLot called with one argument, two expected." I am now utterly convinced that the people who write error messages don't want anyone to understand them. Sorry, but this is just frustrating as all getout because the whole thing should take an hour and I have been messing with this all bloody day.


3D Printing in Mathematica Tutorials

Are there thorough tutorials on 3D printing for _Mathematica_? It seems that being able to export _Mathematica_ files for 3D printing is unfortunately still a novelty, but it's vital for my business plans. It would be much appreciated to specifically make                ContourPlot3D[3 Sin[E^x] == (x^2 + y^2 + z^2)^(.5), {x, -1, 1}, {y, -4, 4}, {z, -4, 4}]      3D printable for MakerBot. _Mathematica_ would not allow using `Thickness` for `ContourPlot3D`, but did for `ParametricPlot3D`.


Truncated Distribution Parameter Search Produces Singular Jacobian Using FindRoot

I'm trying to find the 2 parameters of a truncated Weibull distribution using version 10 and FindRoot. I would like to truncate the distribution between t =0 and t = 3600 with the probability of survival,POS(360)=0.7 and POS(1080)=0.6 If this is not possible using WeibullDistribution, any other smooth distribution will work. My code is below for the non-truncated, tmax = Infinity case which is easier to solve.               Remove["Global`*"]     {ta = 360., ra = 0.70};     {tb = 1080., rb = 0.60};     tmin = 0;     tmax = \[Infinity];     plotmax = 4320;     dist = TruncatedDistribution[{tmin, tmax},      WeibullDistribution[\[Beta], \[Eta]]];     soln = FindRoot[{SurvivalFunction[dist, ta] == ra,      SurvivalFunction[dist, tb] == rb}, {{\[Beta], .32}, {\[Eta],       8427.}}, Method -> "Newton"];     {\[Beta] = soln[[1, 2]], \[Eta] = soln[[2, 2]]}     dist = TruncatedDistribution[{tmin, tmax},      WeibullDistribution[\[Beta], \[Eta]]];     pdf[t_] := PDF[dist, t]     cdf[t_] := CDF[dist, t]     ps[t_] := SurvivalFunction[dist, t]     plot1 = Plot[pdf[t], {t, 0, plotmax}, Frame -> True,      FrameLabel -> {"Time", "PDF"},      FrameTicks -> {Range[0, plotmax, 720], Automatic, None, None},      PlotRange -> All, PlotLabel -> "PDF"];     plot2 = Plot[cdf[t], {t, 0, plotmax}, Frame -> True,      FrameLabel -> {"Time", "CDF"},      FrameTicks -> {Range[0, plotmax, 720], Automatic, None, None},      PlotRange -> {All, {0, 1.05}}, PlotLabel -> "CDF"];     plot3 = Plot[ps[t], {t, 0, plotmax}, Frame -> True,      FrameLabel -> {"Time", "Probability  of Survival"},      FrameTicks -> {Range[0, plotmax, 720], Automatic, None, None},      PlotRange -> All, PlotLabel -> "Probability of Survival"];     GraphicsRow[{plot1, plot2, plot3}, ImageSize -> 800]     check1 = {ta, ps[ta]}     check2 = {tb, ps[tb]}     sse = (ra - ps[ta])^2 + (rb - ps[tb])^2      The solution to this non-truncated case is Beta = 0.326961 Eta = 8426.8 and these are the plots, so far so good. ![enter image description here](http://i.stack.imgur.com/ectFp.jpg) Next I truncate to a tmax = 50000 and it found a solution, Beta = 0.284 Eta = 394334 Next I truncate to tmax = 37500 (note I really need 3600) and I get a this error: FindRoot::jsing: "Encountered a singular Jacobian at the point {[Beta],[Eta]} = {0.2,1.4*10^13}. Try perturbing the initial point(s)" I've tried different initial points to no avail. Does anyone have a suggestion ? If this can be made to work using another smooth distribution that would be fine. I chose the Weibull for its flexibility. Thanks for any suggestions.


Testing a package in Mathematica 9

I am in the process of writing a package, but my way of testing it just seems wrong and inefficient. Each time I edit the .m file, I save it, quit the kernel, call the package in a separate notebook and proceed to test. Is there a more efficient way to test a package without having to save/quit kernel/rerun everything?? Thanks


Difficult to solve the equation using FindInstance and not able to solve it numerically

I hope to find the range of `a` which leads to non-zero solution of `H` when you are given a specific value of B. And I hope to get the the corresponding B, range of a and number of solutions in a table. All the variables should be real. I tried to do it, the most difficult part is to determine the number of solutions when changing the value of a. And it is also difficult when I tried to manually change the value of a to get a range of the solution. Is there any systematic way of doing this ? ![enter image description here](http://i.stack.imgur.com/oC3Hb.png)


Combination and Permutation

How could I obtain the list of all the groups of 5 numbers taken from `Range[12]` such that the 2 lists have an empty intersection : `{{1,2,3,4,5},{6,7,8,9,10}}` would be a solution while `{{1,2,3,4,5}, {5,6,7,8,9}}` should be rejected as 5 is common to both. I am currently trying to do so using `Position` of empty `Intersection` very unsuccessfully.               allCombinations =       DeleteDuplicates@(Sort /@ Permutations[Range[12], {5}])          Function[base,       Flatten[        Position[         Intersection[allCombinations[[base]], allCombinations[[#]]] & /@           Drop[Range[792], {base}], {}], 1]] /@ Range[792]      With which I am trying to obtain the position of the lists in allCombination s, but I still get duplicates...


How to modify the elements of a list in a loop?

I have a list with points coordinates. And I'm trying to traverse it and perform some matrix operations on each point. But I have a problem with storing modified points in the initial list instead of the original points. Here is the complete entry point example:               (* the matrix of the linear operator of rotation around OX axis *)     rx = {         {1, 0, 0, 0},         {0, Cos[ax], -Sin[ax], 0},         {0, Sin[ax], Cos[ax], 0},         {0, 0, 0, 1}     };          (* translation matrices *)     t1 = {         {1, 0, 0, -j},         {0, 1, 0, -k},         {0, 0, 1, -l},         {0, 0, 0, 1}     };     t2 = {         {1, 0, 0, j},         {0, 1, 0, k},         {0, 0, 1, l},         {0, 0, 0, 1}     };          (* projection onto OXY plane *)     f = {         {1, 0, 0, 0},         {0, 1, 0, 0},         {0, 0, 0, 0},         {0, 0, 0, 1}     };          points = {         {{100},{0},{0},{1}},         {{155},{0},{0},{1}}     };          ax = Pi/4;     j = 100;     k = 100;     l = 0;      And this is my solution to it, which I try to improve               For[i1 = 1, i1 < 3, i1++, {         item = t1 . Part[points, i1];         item = rx . item;         item = t2 .item;         item = f . item;         xP = N[Part[item, 1]];         yP = N[Part[item, 2]];         zP = N[Part[item, 3]];         homogP = N[Part[item, 4]];         Print[{xP, yP, zP, homogP}];     }];      the output is:               {{100.},{29.2893},{0.},{1.}}          {{155.},{29.2893},{0.},{1.}}      And this seems to be correct. But if I change the `For` loop with the solution inspired by Alexei Boulbich               Map[{t1.#, rx.#, t2.#, f.#, N[#]} &, points];     Print[points];      I get this:               {{{100},{0},{0},{1}},{{155},{0},{0},{1}}}       That is the original list without any operations applied.


Why is FileNameJoin not working?

I can not figure out why the code below doesn't work?               aaa >> FileNameJoin[{Directory[],"input"}]      error message came out saying > OpenWrite::noopen: Cannot open FileNameJoin[{Directory[],"input"}]. If I evaluate               FileNameJoin[{Directory[],"input"}]      directly, then I can get               C:\Users\m&p\AppData\Local\Temp\input      And the code below always works               aaa >> "C:\\Users\\m&p\\AppData\\Local\\Temp\\input"


How do you ContourPlot3D an implicit function of x,y, and z?

This is what I am trying to do:               ContourPlot3D[4 Log[x^2 + y^2 + z^2] == 1, {x, -10, 10}, {y, -10, 10}, {z, -10, 10}]      but all I get is the empty box. Can anyone help me? Thanks!


Styling ticks, axes and other elements in a Plot of a step function

To display the effect of uniform quantization (step size Q) I would like to draw a curve as shown below ![enter image description here](http://i.stack.imgur.com/ohlaS.jpg) I tried this using               Plot[Round[n], {n, -3, 3},        Ticks -> {{-3, -2, -1, 1, 2, 3}, {-3, -2, -1, 1, 2, 3}},        AspectRatio -> Automatic, ExclusionsStyle -> Opacity[1],        AxesLabel -> {Input, Output}]       but couldn't get it to look perfectly as shown. As shown above tick lebels appear on different sides of the Y-axis. Can this be attained too?


CharacterEncoding failed when Import or Export as pdf

folowing is the content my test nb File: pdfTest.nb, contain some chinese characters:               SampleCode1:pdf输入不正常。      After Save as or Export, pdf file looks well for the Chinese content. But when Import, it seems become WindowsANSI Encoding. When I Import the pdf file               Import["E:\\Users\\Quaternions\\Desktop\\pdfTest.pdf","Plaintext",CharacterEncoding->"CP936"]      Show this               SampleCode2:pdfÊäÈë\.b2»Õý\.b3£¡£      When I Export and Re-Import the .txt file, it works fine.               Import[Export["temp1.txt",%,CharacterEncoding->"WindowsANSI"],CharacterEncoding->"CP936"]      good result:               pdf输入不正常。      my-enviroment is windows 8 mathematica 9.0 chinese version.               $CharacterEncoding     CP936      Maybe someone is hard to test. My question is: 1: How to directly import the pdf file contain chinese characters and show well. 2: if the solution for question 1 is not possible, is it necessary to Export using CharacterEncoding->"WindowsANSI" and re-Import? , ie. How to convert the characterEncoding in notebook without the export manipulation? Convert SampleCode2 to SampleCode1 _Futhermore, When I import some pdf generated by Tex or obtain other where, also will encouter with CharacterEncoding Problem. I think Import Pdf File should better add an Elements that Import pdf pages as Rasterized image list._


“Strange” behavior of Rule

According to the Help > lhs->rhs evaluates rhs immediately. How to understand the output of the following code?               ClearAll@x;     {1, 3.5} /. x_?IntegerQ -> {x}      Output is               {{1},3.5}      Since `Mathematica` evaluate the rhs **immediately** , I think the “correct” output should be this               {{x},3.5}      And of course, if x has `OwnValues`, the output will be changed.               x=”why”;     {1, 3.5} /. x_?IntegerQ -> {x}      Output is               {{"why"},3.5}      As expected. In my opinion, the two examples expose the contradictions. In the first one, `Rule` behaves like `RuleDelayed`; it relates the local x with global x. (The color of the two variables in front-end tells me this.) But in the second one, `Rule` makes a clear distinction between the local and global. (There are also something similar between `Set` and `SetDelayed`) Why does this happen? Did I misunderstand the mechanism? ## Update What I'm really confusing is Why **sometimes** _Mathematica_ **does not distinguish** the global x and the local x in Rule. ## Solution As Aky has metioned in his comments and answer. The documentiation says, > Symbols that occur as pattern names in _lhs_ are treated as local to the > rule. This is true when the symbols appear on the right-hand side of `/;` > conditions in _lhs_ , and when the symbols appear anywhere in _rhs_ , even > inside other scoping constructs. So if `x` doesn't have `OwnValues`, then the `Head` of `x` is `Symbol` and the name of x is the same as pattern name, as the documentation said , _Mathematica_ will treat the two 'x's as the same. If `x` has `OwnValues`,take `x=y` for example, (`Head` of `y` is also `Symbol`) Even if `x` (actually y) is `Symbol`, the "name" of x is y which is different from the pattern name. So in the following case,               x=y;     {1,3.5}/.x_?IntegerQ->{x}      _Mathematica_ will return `{{y},3.5}` not `{{1},3.5}`. Thanks for everyone's attention:)


How do I limit the iterations in a while loop?

Is there a way to limit the number of iterations in a while loop? Right now I am cleaning up the code, and for now if I make a mistake, the loop keeps going forever. I'd like to be able to limit the number of times it will run through while I am working on it. Is that possible?


ContourPlot from Vector Data

I have data in the form of x, y, vx, vy where vx and vy are components of the velocity vector at point x,y. I want to plot a contourplot of this. How can I do that since contourplot asks for three values?               testBC = Import["...test.dat", "Table", "IgnoreEmptyLines" -> True];     testBCx = testBC[[All, 1]];     testBCy = testBC[[All, 2]];     ux = testBC[[All, 3]];     uy = testBC[[All, 4]];     u = Transpose[{ux, uy}];     testbdry = Transpose[{testBCx, testBCy}];     ListContourPlot[testbdry, u]      I am not sure which one is right, ContourPlot or ListContourplot. I am trying to look for something that provides "heat plotting"


Clustering a set of points

I have a set of 2D points in the square defined by `{-1, -1}` and `{1, 1}`. These points typically form compact groups. I need to break them into clusters in such a way that the rectangular bounding boxes of the clusters will not overlap. The bounding boxes are expanded by a pre-specified margin, denoted `dist`. I managed to implement this by computing the pairwise Manhattan distance, building a corresponding graph and taking the connected components of the graph (see attached code). I was hoping that there would be a simper solution which avoids computing the complete pairwise distance matrix. I tried using `FindClusters`, but not having any experience with the underlying methods I did not manage to get it to return the appropriate number of clusters (it typically lumps everything together, even when points are "visually" separate). So the question is: _Is it possible to implement this using`FindClusters`?_ The key is in choosing the correct `Method` option for `FindClusters`, which is unfortunately not documented in a way that's easy to understand for someone not familiar with these methods. Requirements: The clustering does not need to be precise. If the method returns a bit fewer clusters than what I show in the image below, that's okay. I need the results for a heuristic decision anyway. But it should not lump together things which are rather far compared to the size of the visually perceived clusters. It is very easy for us humans to recognize these clusters, and I'd like to get the computer to give me same output one would naturally construct by hand after looking at the image. All points sets I have have a very similar structure to the one I show below, but the groups may have different size scales. This is why it makes sense to ask "I'd like to have the clusters similar to what I perceive visually". The method must work without any user intervention (manual estimation of parameters). * * *               pts = Import["http://ge.tt/api/1/files/7sHEVob/0/blob?download", "WDX"];          dist = 0.01;          comp = ConnectedComponents@        AdjacencyGraph[         UnitStep[2 dist - Outer[ManhattanDistance, pts, pts, 1]]];          Graphics@MapIndexed[       With[{p = pts[[#1]]}, {{GrayLevel[.9],            Rectangle[{Min[p[[All, 1]]], Min[p[[All, 2]]]} -              dist, {Max[p[[All, 1]]], Max[p[[All, 2]]]} +              dist]}, {ColorData[3][First[#2]], Point[p]}}] &, comp]      Click for a larger image: ![](http://i.stack.imgur.com/dvAjz.png)


How to make 3D object smooth?

_This thread considers mathematical methodshere to make the 3D object smooth but this question consider how to achieve the goal of smoothing a 3D object in Mathematica._ I want to get smoother geometrical objects, some messing up here. Suppose for example a tetrahedron where I would like to make the corners rounded with either convolution or interpolation. I would have to select two control points on different faces and then select one adjusting point -- I could use a NURBS aka spline approximation with a polynomial then aka Mathematica's BezierCurve[...] command. Now I am trying to do a ready command that would do this for me without me traversing different vertices and making sure of selecting right faces for control/adjusting points. Example data about the coordinates with the tetrahedron's faces here. **Does Mathematica have some ready function to do Interpolation or Convolution for geometric objects?** * * * I think the by-far-easiest solution is to use Convex hull but it hides some information if you have a lot of details. This is an answer in progress. **Different methods**   1. Convex hull of a 3D object?


Is there a callback for notebook exit?

I know that `$Epilog` is called when _Mathematica_ is exited; is there a callback upon exiting the notebook? If so, what is it?


A more efficient way of fitting a non-linear model that returns an entire list?

I have a function that takes two parameters, `del` and `nu`, and returns a list `npoints` long with a bin-width of `dt`:               ktDynaList[npoints_?NumericQ, dt_?NumericQ, del_?NumericQ, nu_?NumericQ] :=       Module[{alphaN, Npad, tt, expwei, gg, padgg, ff, FF, dkt},       alphaN = 10;       Npad = 2*npoints;       tt = Table[dt i, {i, 0, Npad - 1}];       expwei = Exp[-(alphaN/(npoints*dt))*tt];       gg = (1/3)*(1 + 2*(1 - del^2*tt^2)*Exp[-0.5 del^2 *tt^2]);       padgg = PadRight[Take[gg, npoints], Npad];       ff = Fourier[padgg*expwei*Exp[-nu*tt], FourierParameters -> {1, 1}];       FF = Exp[-nu dt]*ff/(1 - (1 - Exp[-nu dt])*ff);       dkt = Take[InverseFourier[FF, FourierParameters -> {1, 1}]/expwei, npoints];       dkt      ]      I want to fit this function to a dataset using `NonlinearModelFit`, so I have an edited version that returns one value from this array at a particular abscissa `t`:               ktDyna[npoints_?NumericQ, dt_?NumericQ, del_?NumericQ, nu_?NumericQ, t_?NumericQ] :=       Module[{alphaN, Npad, tt, expwei, gg, padgg, ff, FF, dkt},       alphaN = 10;       Npad = 2*npoints;       tt = Table[dt i, {i, 0, Npad - 1}];       expwei = Exp[-(alphaN/(npoints*dt))*tt];       gg = (1/3)*(1 + 2*(1 - del^2*tt^2)*Exp[-0.5 del^2 *tt^2]);       padgg = PadRight[Take[gg, npoints], Npad];       ff = Fourier[padgg*expwei*Exp[-nu*tt], FourierParameters -> {1, 1}];       FF = Exp[-nu dt]*ff/(1 - (1 - Exp[-nu dt])*ff);       dkt = Take[InverseFourier[FF, FourierParameters -> {1, 1}]/expwei, npoints];       dkt[[ Round[t/dt] ]]      ]      Now, this can be passed to `NonlinearModelFit`, and will fit a dataset rather successfully. However, the problem is that in its current state it is incredibly inefficient, as the `dkt` list is recalculated for every single abscissa. I'm trying to find a way of storing the `dkt` array such that it does not need to be fully recalculated for each `t` value, and am wondering if anyone in the community has encountered a problem of this type before? My current thoughts are either   1. An If statement at the beginning of the function which checks if the parameters `del` or `nu` have been varied since the last iteration - if they haven't then one can just return the list element from the previously calculated `dkt` list and avoid a lot of calculation steps. My problem here is that _Mathematica_ doesn't appear to have static variables (that I know of). Is there any way around this?   2. Some sort of flag system that can be passed between function calls which indicates if the full calculation needs to be performed, or if a previously stored list element can be returned. Or is there some other solution that doesn't require the use of `NonlinearModelFit`?


How to Merge Date and Time?

Given the following time series data where row is date and column is time intervals.                  rawdata = {{"Date", "08:00", "08:30", "09:00", "09:30", "10:00", "10:30",            "11:00", "11:30", "12:00", "12:30",            "13:00"}, {{2011, 1, 4, 0, 0, 0.}, 47., 59., 71., 77., 115., 111.,            103., 75., 101., 121., 135.}, {{2011, 1, 5, 0, 0, 0.}, 20., 51.,            33., 68., 97., 82., 101., 78., 104., 119.,            137.}, {{2011, 1, 6, 0, 0, 0.}, 3., 39., 61., 59., 63., 108., 66.,            85., 108., 119., 114.}, {{2011, 1, 7, 0, 0, 0.}, 13., 55., 74., 70.,            105., 95., 71., 82., 86., 113., 124.}}      I can't figure out how to merge date and time together so that my desired output will be               output = {{Date}, {{2011, 1, 4, 8, 0, 0.}, 47.}, {{2011, 1, 4, 8, 30, 0.},        59.}, {{2011, 1, 4, 9, 0, 0.}, 71.}, ..., {{2011, 1, 6, 13, 0, 0.},        124}}      Thank you


replacement rules from a pattern and a matching expression

(This seems to be a very basic necessity in a language having pattern-matching capabilities such as Mathematica, yet I struggled for many hours to find a common solution to this problem.) Suppose there is a pattern with some of its sub-elements named, and there is an expression that matches it. How do I generate a list of replacement rules that maps sub-element names into their values in the matching expression? E.g.,               patt=f_[_, s_, x___];     expr=ab[c, d, e, f];     mkMatchRules[expr,patt]     >> {f -> ab, s -> d, x -> Sequence[e, f]}      I have written a solution to this,               collectAllPattVars[patt_] := Union[Map[Part[#, 1] &,       Cases[patt, _Pattern, {0, Infinity}, Heads -> True]]];     mkMatchRules[expr_, patt_] := Module[       {pattVars = collectAllPattVars[patt], mkRhs},       mkRhs = Block[{$}, ReleaseHold[Hold[patt :> $] /. $ -> With[{$ = Map[List, pattVars]}, $]]];        If[MatchQ[expr, patt],          MapThread[Rule[#1, If[Length[#2] == 1, #2[[1]], Sequence @@ #2]] &,                     {pattVars, Replace[expr, mkRhs]}],          $Failed]];      which produces the result in the example above However, I hope somebody knows a more elegant way to do this.


Plotting ContourLabels on ContourPlot3D

Is there a way to add ContourLabels on ContourPlot3D ? (tried in Mathematica 9) I tried doing the following code :               f[x1_, x2_, x3_] := x1 + x2^2 + x2 x3 + 2 x3^2     h[x1_, x2_, x3_] := x1^2 + x2^2 + x3^2 - 1     a = 1;     ContourPlot3D[      h[x1, x2, x3] == 0,      {x1, -a, a}, {x2, -a, a}, {x3, -a, a},      MeshFunctions -> {f[#1, #2, #3] &},      PlotPoints -> 20,      ContourLabels -> Automatic      ]      It throws the following error :               ContourPlot3D::optx: "Unknown option ContourLabels->Automatic in ContourPlot3D[h[x1,x2,x3]==0,{x1,-a,a},{x2,-a,a},{x3,-a,a},MeshFunctions->{f[#1,#2,#3]&},PlotPoints->20,ContourLabels->Automatic]"      If I **removed** ContourLabels -> Automatic, it works fine and I get the following output ![ContourPlot's output when ContourLabels option is removed](http://i.stack.imgur.com/nMQJM.jpg) Edit 1: I would like to add the contours for the mesh (black) lines as shown in the figure


Updating the format style of input cells from an older/'pre-styled' notebook

I have been given a large notebook that was created in mathematica 6. It contains a structure of sections and subsections and the input text is formatted in an unusual (possibly just old) style (see screen grab below). ![original formatting](http://i.stack.imgur.com/ByUyG.jpg) My main aim is to update the formatting of the input cells to the standard mathematica 8 format as I find this format much easier to read/debug (example below). ![new formatting](http://i.stack.imgur.com/TRyNd.jpg) My first thought was to simply copy the entire notebook into a text editor and then copy back into a notebook. However, this results in the generation of a single large input cell that is prohibitively tedious to break up... Applying a new stylesheet does not change the input cell style. Is it possible to update the formatting/style throughout a notebook whilst preserving the cell structure and hierarchy? Edit: An excerpt from the original notebook can be found here, and here is the same excerpt after clearing formatting (but without syntax highlighting).


Define functions from two lists

I have two lists               {G[x_,y_],F[x_,y_],C[x_,y_]}       and               {x*y-x, 3x+y, x^y}      Now I need to define 3 functions               G[x_,y_]:=x*y-x;     F[x_,y_]:=3x+y;     C[x_,y_]:=x^y;      How to do it correctly?                Table[%%[[i]] := %[[i]], {i, Length[%%]}]       does not work


Setting options of expressions similar to using SetOptions on objects

**Introduction** I often have the problem that in an expression, I want to change an option. If we are sure the option is not present, we could simply use `Append[expression, opt -> val]`. But sometimes such an expression is very long and it can be a bit of a pain to see if this option is already present. _Example_ We have               Notebook[{Cell["hello", "Text"]}]      we want               Notebook[{Cell["hello", "Text"]}, Background -> LightGreen]      _Mathematica_ has some built in functions for setting options. They are `SetOptions`, `Option` in combination with `Set` (which I think does the same thing as `SetOptions`) and `CurrentValue` in combination with `Set`. None of these seem to do what I want. **Silly things I tried** The fact that we can use `Options` with `Set` may sound promising, but although we can ask the value of an option in an expression, we cannot set it. _Example_               kkkk:=f[2,q->c,z->x,zz->xx];     Options[kkkk]     Options[kkkk, q]      > >     {q -> c, z -> x, zz -> xx} >     {q -> c} >   But               Options[kkkk] = {q -> d, z -> x, zz -> xx}      gives an error and               Options[Unevaluated@kkkk] = {q -> d, z -> x, zz -> xx}      does something strange. **Nice function** So I have made my own function               setExpressionOptions[       head_[        a__,        b : Longest[ OptionsPattern[], 1],        Longest[(symb_ -> _) ..., 2],        d : OptionsPattern[]        ],       symb_ -> val_       ] := head[a, b, symb -> val, d]      _Examples of use_               setExpressionOptions[f[2, q -> b, z -> x, zz -> xx], q -> c]      > >      f[2, q -> c, z -> x, zz -> xx] >                 setExpressionOptions[f[2, z -> x, zz -> xx], q -> c]      > >      f[2, z -> x, zz -> xx, q -> c] >   The function also works with `Unevaluated`               setExpressionOptions[Unevaluated[Plot[x, {x, 0, 1}]], PlotStyle -> Red]      > >      (*a plot with a red line*) >   Note that we really need `Unevaluated` here, otherwise the expression with head `Plot` evaluates to an expression with head `Graphics`, which does not work with `PlotStyle`. **Possible extension** We can define the function `setOptions` like this               setOptions[       x_ /; MemberQ[{NotebookObject, CellObject, FrontEndObject, InputStream,           OutputStream, Symbol, String}, Head[Unevaluated@x]], y___       ] := SetOptions[x, y]          setOptions[z___] := setExpressionOptions[z]      _Examples of use_               setOptions[EvaluationNotebook[], Background -> LightGreen]      > >     (*makes the background LightGreen*) >                 setOptions[f[1], q -> r]      > >     f[1, q -> r] >   **Question** I like the functions quite a lot, but they could be better. It would be nice if we could set any number of options at once using `setExpressionOptions`. _Example of desired evaluation_               setExpressionOptionsBetter[      Notebook[{Cell["hello", "Text"]}, Background -> LightGreen],      Background -> Cyan,      DynamicUpdating -> True      ]      > >      Notebook[{Cell["hello", "Text"]}, Background -> Cyan, DynamicUpdating > -> True] >   Note that `SetOptions` works the same way; beyond position one there are any number of `Rule`s. That also makes integrating this case in `setOptions` easier. Also I am sure I left out a lot of heads in the test in `setOptions`. The Q&A How can I work out which functions work with SetOptions? sounded promising for making the list more complete, but I guess it is not helpful.   * Main question*: Can we add the additional functionality?     * _sub Question 1_ : Did I overlook anything and can this be done easier?     * _sub Question 2_ : Can this use of `Longest` lead to bad performance? (probably no)


NMaximize and Accuracy

I have a problem with NMaximize which is best depicted by the following figure. The result indicates, that the solution mathematica finds seems to be smooth except a few outliers. How can I get rid of them? I tried to change the method NMaximizes uses, e.g. SimulatedAnnealing etc. but it did not improve. Moreover, changing WorkingPrecision was also not a viable option, too (increase up to 400). Any kind of help is appreciated! ![Solution of NMaximze](http://i.stack.imgur.com/9C56L.jpg) The code is as follows:               RS[a_, p_, v_, t1_, T1_, x0_, i1_, i2_, t2_]:=Module[{z, T0, dT0, b, n1, d, i},       b := 1/2 - (a/v^2) + Sqrt[(1/2 - a/v^2)^2 + (2*p)/v^2];        n1[w_] := PDF[NormalDistribution[0, 1], w];       z[a1_] := a1/(p-a);       i[a4_] := i1 + a4*i2;       T0[a2_, a3_] := T1 + (a2)^t1*(a3)^t2;       dT0[a2_, a3_] := t1*(a2)^(t1-1)*(a3)^t2;       d[a2_, a1_, a3_, a5_] := (Log[T0[a2, a3] - Log[a5]] + (a - 1/2*(v)^2)*a3)*(v*Sqrt[a3])^(-1);       NMaximize[{((T0[a2, a3]-1)*z[a1]-a2-i[a4])*(x0/a1)^b,      a4*Exp[-p*a3]*n1[d[a2, a1, a3, a5]]*1/(v*Sqrt[a3])*dT0[a2, a3]==1      && a1 >= 0 && a2 >= 0 && a3 >= 0 && a4 >= 0 && a5 >= 1}, {a1, a2, a3, a4, a5}]      ]      while the graph is generated using, e.g.:               Plot[RS[0.03, 0.05, j, 0.1, 1.1, 1, 30, 0.1, 0.025][[2, 1, 2]], {j, 0.05, 0.25}]


Why I need Evaluate for the Plot of the probability density function of PolyaAeppliDistribution?

I encountered this when I was trying to answer this question. I just can't understand why the following code will only give a line at $y=0$:               Plot[PDF[PolyaAeppliDistribution[7, 1/4], x], {x, 0, 35}, Axes -> {False, True}]      ![enter image description here](http://i.stack.imgur.com/xwEJL.jpg) While with `Evaluate` I'll get the desired result:               Plot[Evaluate@PDF[PolyaAeppliDistribution[7, 1/4], x], {x, 0, 35}]      ![enter image description here](http://i.stack.imgur.com/a2r2N.jpg) `DiscretePlot`, which is a function with `Attributes` similar to `Plot`, doesn't suffer this:               DiscretePlot[PDF[PolyaAeppliDistribution[7, 1/4], x], {x, 0, 35}]      ![enter image description here](http://i.stack.imgur.com/C7Wvn.jpg) nor do many other distributions, for example `NormalDistribution`:               Plot[PDF[NormalDistribution[7, 2], x], {x, 0, 35}]      ![enter image description here](http://i.stack.imgur.com/65f1Q.jpg) I haven't do a complete test so I'm not sure if there's other distribution behaved like `PolyaAeppliDistribution`. Has it got any deep reasons? Or it's just a bug? I'm using _Mathematica 8_ , _Windows Vista Home Basic 32-bit_.


How can I write image to MySQL database?

I have a database, such as: ![Database schema](http://i.stack.imgur.com/qzliW.jpg) In _Mathematica_ , the final code is:               img1=Export["/home/user/Desktop/1.jpg",resultimg1];      I tried `SQLInsert[conn,"mathematica",{"image"},{img1}];` but the MySQL result is: ![Example with just image name inserted](http://i.stack.imgur.com/NS4LR.jpg) > How can I write the **image** to MySQL database?


Signed Graph from positive and negative correlations

I want to create a signed graph where the edges of my graph are either green (for a positive correlation) or red (for a negative correlation). I only managed to create a graph from a tresholded adjacency matrix so far (greater than x), but struggling with this and didn't find a function in mathematica. I'm also not sure if it's even possible :/ Is it also possible to make the edge lines thicker for a stronger correlation? Thanks in advance


Converting code in other languages to Mathematica code

Do you know of any work being done on the idea of bringing in code from languages like PERL, PHP, Python, etc.? That is import the code in some way and then convert it to _Mathematica_ code?


How to prevent auto spacing/alignment?

When using notebook, I find that sometimes when I type, it will automatically indent for me.![enter image description here](http://i.stack.imgur.com/YgBti.png) How can I block this function?


RandomVariate from 2-dimensional probability distribution

A probability distribution can be created in Mathematica (I am using 8.0.1) with e.g.               distribution1 = ProbabilityDistribution[(Sqrt[2])/Pi*(1/((1+x^4))),      {x,-Infinity,Infinity}];      Random variates from this distribution can be created with RandomVariate easily:               dataDistribution1=RandomVariate[distribution1,10^3];     Histogram[dataDistribution1](*Just an optical control*)      How can I create random variates from a 2-dimensional probability distribution? Let's say my 2-dimensional distribution is of the following form (very similar to the previous one):               distribution2=ProbabilityDistribution[((((Sqrt[2] π^(3/2) Gamma[5/4])/     (Gamma[3/4]))^(-1)))/((1+x^4+y^4)),{x,-Infinity,Infinity},     {y,-Infinity,Infinity}];      I thought it would be logical to try               dataDistribution2=RandomVariate[distribution2,10^3];      But that does not work. I get the following message then:               RandomVariate::noimp: Sampling from ProbabilityDistribution[Gamma[3/4]…}] is not implemented.      I tried a lot of variations of this approach to create random variates from such a distribution but without any success. Either I am doing a lot of things wrong (very likely in my experience ;-) or Mathematica cannot deliver random variates from 2-dimensional probability distributions. But in the help of RandomVariate (under “Simulate a multivariate continuous distribution”) one can see that this should be possible. Perhaps somebody of you can tell me, how I can generate random variates from 2 dimensional probability distributions? I would be very happy about any help!


Using an Interpolating Function as a probability density function

I have seen a couple of similar questions but have not been able to figure out a solution for my particular problem. I have a probability density function of two variables `p[x,v]` which is an interpolating function. What I really want to do is to generate a set of random `{x,v}` values based on this distribution. I tried:               dist=ProbabilityDistribution[p[x, v], {x, -4, 4}, {v, -4, 4}]     RandomVariate[dist, 10]      but get the error: > RandomVariate::noimp: "Sampling from ProbabilityDistribution[<<1>>] is not > implemented." Any ideas how I can get this working?


How to generate absolute Directories in HTML

ExportString["Test","HTML"]     Export["Test.html","test","HTML"]           <link href="HTMLFiles/m-478f1adf-0b36-429c-9ee2-ff6f5c953e52.css" rel="stylesheet" type="text/css" />      the Directory is HTMLFiles How to make it be the absolute directory, For instance               Directory[]<>"\\HTMLFiles"      One reason is Windows-Live-Writer too dummy to recognize the Directory `HTMLFiles` but Absolute Directory is ok. I done it by `StringReplace` before. Is there any setting in Mathematica?


Plot with plot markers without using ListPlot

I would like to plot a continuous function with `Plot` with plot markers as if it were a `ListPlot` plot. Simple example: I have               f[x_]:=x     Plot[f[x],{x,0,10}]      but for external reasons I need the figure to look like that of               ListPlot[Table[{x,f[x]},{x,0,10}]]      It works well. But imagine now my `f[x]` function contains several functions:               f[x_]:={x,x^2,x^3}      Plotting with plot is the same:               Plot[f[x],{x,0,10}]      However, the conversion to a set of points with `Table` is now complicated. The question is: what would be the easiest way (the shortest code) to produce a plot marker plot for such `f[x]`? Can it be done directly with Plot without using ListPlot and Table ?


Programatically adding/retaining comments within a nested list

Is it possible to convert the following list of strings to computable numbers with the comments preserved?                str = {{{"8.0,1034(*g opx ksp pl ilm liq q *)"}, {"8.0,1035(*g opx ksp pl ilm liq q *)"},               {"8.0,1037(*g opx ksp pl ilm liq q *)"}, {"8.0,1038(*g opx ksp pl ilm liq q *)"},                 {"8.0,1039(*g opx ksp pl ilm liq q *)"}, {"8.0,1040(*g opx ksp pl ilm liq q *)"}},               {{"8.0,886(*g opx ksp pl ilm liq q  *)"}, {"8.0,889 (*g opx ksp pl ilm liq q *)"},                 {"8.0,891(*g opx ksp pl ilm liq q  *)"}, {"8.0,894 (*g opx ksp pl ilm liq q  *)"},                 {"8.0,896(*g opx ksp pl ilm liq q  *)"}, {"8.0,899 (*g opx ksp pl ilm liq q  *)"}}}      I'm after something like:               strc = {{{8.0,1034(*g opx ksp pl ilm liq q *)},....      Perhaps there is a way involving programatically adding the comments back onto the numbers after the numbers have been converted to an expression? Any Suggestions?


How to replace a variable that was assigned a value before

## Question How to make the replacement $f[x] \to f[y]$ for an abitrary function $f$ if $x$ was assigned a value before? ### Example 1 How can I make the replacement $x +1 \to y + 1$ if I have assigned the variable $x$ a value before? **Problematic attempts** A first guess would be               x = 1;     x + 1 /. x -> y      > 4 This does not give $y + 1$ because $x + 1$ is evaluated to `4` before the replacement is attempted. I expected this would give $y+1$:               Unevaluated[1 + x] /. x -> y      > 4 My reasoning was that the replacement of $x$ with $y$ in               x + 1 // FullForm      Unevaluated[1 + x] // FullForm      > 4 > > Unevaluated[Plus[1,x]] gives '4' and `Unevaluated[Plus[1,y]]`, but it does not. Why? Is there a solution that works in this spirit? **Working Solution** In the post Symbolic computations with already assigned variables, I found the suggestion to use block. Indeed it works               Block[{x}, x + 1 /. x -> y]      > y + 1 ### Example 2 Let               x = {1, 3, 4};     f[x_] := Length[x];      How to replace `x` in `f[x]` with `{1, 2}`? We allready saw that `f[x] /. x -> {1, 2}` will not work. Here the construction with `Block` does not work either               Block[{x}, f[x] /. x -> {3, 2}      > 0 It gives 0 since the lefthand side of the rule is evaluated first, and gives 'Length[x] = 0'. Only then the rule is applied. I guess I need a rule in the spirit of the 'problematic attempts' in order to make the desired replacement.


How to make PlotMarkers constructed from Graphics track plot style?

In this plot the `Disk[]` markers are not colored according to the style of the line to which they belong:               SeedRandom[12]     data = Accumulate /@ RandomReal[3, {4, 10}] {1, 2, 3, 4};          ListLinePlot[data,       PlotMarkers -> Graphics[Disk[], ImageSize -> 13],       PlotLegends -> Automatic     ]      ![enter image description here](http://i.stack.imgur.com/dmRVQ.png) Curiously, note that they are colored in the legend. How can I make the lines match the legend?


is it possible to modify BaseStyle of Manipulate dynamically?

I can't decide what is a best color for the background for a Manipulate I am writing. So, I thought since this is Manipulate, why not make this part configurable as well, so one can change the RGB color (using something like 3 sliders, one for each channel), so depending on the mood at that moment, one can choose different background color until they find one that they prefer. But I am not sure how this can be done since `BaseStyle` is set when Manipulate itself is created. BaseStyle is an option and not a command. Here is a small example of a Manipulate. I did not show the sliders for selecting the RGB color, since I do not know if it is even possible to modify the BaseStyle yet. This is just a toy Manipulate that just plots a sin function with greenish color for background of the Manipulate.               Manipulate[      {},      {m, 1, 10},           Grid[{{Dynamic[          Plot[Sin[x], {x, -m, m}, ImageSize -> 200, Frame -> True,ImagePadding -> 30]]}}       ],           Paneled -> False,      ContentSize -> {0},      Frame -> False,      Alignment -> Center,      AppearanceElements -> "ManipulateMenu",      BaseStyle -> {Background -> RGBColor[.80, .80, .90]}      ]      ![Mathematica graphics](http://i.stack.imgur.com/nT0JU.png) **The question is** : How to modify the Background color dynamically using an input from the user (via sliders, not shown). Is it possible? I just like to know the syntax if possible, and I can do the rest. http://reference.wolfram.com/mathematica/ref/BaseStyle.html http://reference.wolfram.com/mathematica/ref/Background.html I am using V9. Please note that any solution can't use global variables. This is for a demo for WRI web site, and one of the rules is that no global variables are allowed (since they will interact with other copies of the Manipulate). **update** Using the official demonstration style sheet, when using `ContentSize -> {0}` and `Paneled -> False`, , Manipulate background is white by default. I thought that giving it little color might be nice. Here is an example               Manipulate[      {},      {m, 1, 10},           Grid[{{Dynamic[          Plot[Sin[x], {x, -m, m}, ImageSize -> 200, Frame -> True,            ImagePadding -> 30]]}}       ],      Paneled -> False,      ContentSize -> {0},      Alignment -> Center,      AppearanceElements -> "ManipulateMenu"      ]      ![Mathematica graphics](http://i.stack.imgur.com/g8ads.png) You might ask, well, this is because I set `Paneled->False` and this is true. But this was the only way to get rid of the small mark that remain there as result of doing `ContentSize -> {0}`. And there is no way to remove this mark. Here is an example               Manipulate[      {},      {m, 1, 10},           Grid[{{Dynamic[          Plot[Sin[x], {x, -m, m}, ImageSize -> 200, Frame -> True,            ImagePadding -> 30]]}}       ],      Paneled -> True,      ContentSize -> {0},      Alignment -> Center,      AppearanceElements -> "ManipulateMenu"      ]      ![Mathematica graphics](http://i.stack.imgur.com/x14yY.png) That little square there at the corner, is impossible to get rid off. Only way is to do `Paneled->False`. That marker is a big problem, and here is a related question I asked about it before. http://stackoverflow.com/questions/8556234/how-to-not-show-the-scrollbars- when-contentsize-does-not-fit-the-content-in-mani If I can figure a way to remove this tiny white spot, then I can leave `Paneled->True`. ps. I have to use `ContentSize -> {0}`. This is how I did the whole demo. Everything in the control area. No way to change this. Looking now at the demo I have, this white spot is very small, may be no one will notice it. At least this way I do not have to change the 'official' background color. I will check on this and see. It is just annoying one can't get rid of it. Here is a screen shot, where I set `Paneled->True` again. I put small circle around it. If the demo editor says it is ok, then I am all set, do not need to change background color. Will ask. **Update 12/23/12** Ok, figured how remove last piece of code from the Manipulate expression and replaced it with `None`. So finally the white line marker is gone. Problem resolved. Using `None` was the trick that was needed thanks to Michael E2. Here it is (it is 2 panels, and one can select full screen or not using a checkbox). One of the hardest things, is getting the sizes of the different plots correct and to fill the whole space in the grid. I spend half the time trying different values (aspect ratio, image sizes, padding, margins, etc.. for many things until I find the right combination. There got to be better way to do this but if there is, I do not know what it is). But this one is now finally done. ![enter image description here](http://i.stack.imgur.com/Adrzn.png) thanks,


How to find the sum all even numbers of this sequence?

I have a sequence $(u_{n})$ $$u_1= 1, \quad u_2 = 2, \quad u_3 = 3, \quad u_{n}= -u_{n-3} + 3u _{n-2} +2 u_{n-1}, \quad \forall n \geqslant 4.$$ I want to list the first $20$ terms of this sequence and find the sum of all terms and sum of all even numbers of $20$ terms. I tried               Clear[u];     u[1] := 1; u[2] := 2;     u[3] := 3;     u[y_] := -u[y - 3] + 3u[y - 2] + 2u[y - 1]     A := Table[ u[k], {k, 1, 20}]          Sum[ A[[i]], {i, 1, Length[A]}]      I can't find sum of even numbers. How do I tell _Mathematica_ to do that ?


How does TensorReduce use assumptions?

I would like to use `TensorReduce` by assuming that certain patterns of functions are tensors. From documentation of `TensorReduce`: > If `TensorDimensions[ten]` does not return a list of dimensions, then the > expression ten is returned unchanged. I would have inferred from above that if I modify `TensorDimensions[ten]`, `TensorReduce` should work. Thus I did               Unprotect[TensorDimensions];     TensorDimensions[f_[g__]] := d & /@ {g};     Protect[TensorDimensions];          Assuming[ t ∈ Arrays[{d, d}, Antisymmetric[All]] ,      TensorReduce @ TensorContract[ t\[TensorProduct]f[DN, DN], {1, 4}]]      However, this doesn't work. i.e. `TensorReduce` does nothing, and the result is               TensorContract[ t\[TensorProduct]f[DN, DN], {{1, 4}}]      To compare, having defined               Assuming[ t ∈ Arrays[{d, d}, Antisymmetric[All]] &&                f[DN, DN] ∈ Arrays[{d, d}],      TensorReduce @ TensorContract[ t\[TensorProduct]f[DN, DN], {1, 4}]]      > >     - TensorContract[ t\[TensorProduct]f[DN, DN], {{2, 4}}] >   the result is indeed simplified as desired: I'd like to understand what are the assumptions that `TensorReduce` really uses. Is there a way that I can work with `TensorReduce` as above, with pattern like declaration of tensors? PS: Currently I generate a list of assumptions of `f_[g__]` using `Cases`, and put those assumptions together in `Assuming`. This makes the code slow and ugly.


How NDSlove run with central difference in space, Crank-Nicolson in time, eqn is solved by Newton-Raphson iteration, and control spatial/time step?

I want to solve the following partial differential equation (PDE) by NDSolve in MMA. ![enter image description here](http://i.stack.imgur.com/M9BKg.png) I want to plot the profile of h(x,t) and find out the time at which h=0 or h->0. I tried the following code, but it does not work. There seems some singularity near h=0 and the grid spacing is too large according to the warning messages given by MMA.               mdfun = First[     h /. NDSolve[{D[h[x, t], t] + D[h[x, t]^-1*D[h[x, t], x], x] +      D[h[x, t]^3*D[h[x, t], {x, 3}], x] == 0,      h[-Pi*2^0.5, t] == h[Pi*2^0.5, t],      h[x, 0] == 1 + 0.1*Sin[x/2^0.5]},      h, {x, -Pi*2^0.5, Pi*2^0.5}, {t, 0, 10},      MaxStepSize -> 8.8857658763167324940317619801214/40]]     Plot3D[Evaluate[mdfun[x, t]], {t, 0, 4.05}, {x, -Pi*2^0.5, Pi*2^0.5},      PlotPoints -> 100]      Now I have three questions:   1. I am wondering whether MMA solves a PDE numerically by Finite Difference Method, or some other method?   2. Is there any possible to assign explicitly the method using by MMA? For example, I want to use space central difference scheme, Crank-Nicolson Method in time, and the resulting difference equation is solved by Newton-Raphson iteration.   3. NDSolve works by taking a sequence of spatial steps in x and time steps in t, then using an adaptive procedure to determine the size of these steps. How to control the spatial mesh size and time step in my program? For example, I want to firstly fix the spatial grid while reducing the time step for successive iterations until the change in the computed value is negligible, then the time step is fixed and the spatial grid is refined to run the iterations to find the solution.


Joining some strings in a list of strings

So, say I have a list of strings, representing lines in a file, like so:               Pillsy`testLines =      {"foo",       "bar\\",       "baz\\",       "quux",       "wongle\\ bongle",       "wingle",       "pringle\\",       "prongle",       "blort"};      These use the (common?) convention that if a line ends with a backslash, it should be appended to the following line, giving a result like this:               Pillsy`testResult =       {"foo", "barbazquux", "wongle\\ bongle", "wingle", "pringleprongle", "blort"};      Now, the naïve way to accomplish this is to use pattern matching, but the performance is likely to be really awful if you've got a lot of lines:               Pillsy`naiveCatenateContinuedLines[lines : {___String}] :=      lines //.       {before___, line1_, line2_, after___} /;         StringMatchQ[line1, ___ ~~ "\\" ~~ EndOfString] :>        {before, StringDrop[line1, -1] <> line2, after};      You've got two potential performance hits, one with repeated breaking of the list into `BlankNullSequence`s, and the other with repeated `StringJoin`s (I'm actually not 100% sure that the last is avoidable, but it's certainly **possible** that `StringJoin`ing many strings at once is efficient, and that would explain why `StringJoin` has the `Flat` attribute). I ended up doing what any functional programmer does when confronted with a problem they don't know how to solve: I used `Fold` to accumulate a linked list. This solution works, and seems like it could be efficient (in part by exploiting the `Flat`ness of `StringJoin`), but I haven't done actual performance testing. **EDIT** : Now I have a file to test with (linked below), and this solution runs in about 4 milliseconds. The naive solution takes about 25 milliseconds, and scales quadratically with length.               Pillsy`catenateContinuedLines[lines : {___String}] :=      Module[{catenating},       Attributes[catenating] = {HoldAllComplete};            Flatten@Fold[         Function[{acc, line},          With[{            (* This allows me to avoid repeating myself, but is a bit nuts. *)            thunk =             If[              0 < StringLength@line && StringTake[line, -1] == "\\",              With[{dropped = StringDrop[line, -1]},               catenating@StringJoin[#, dropped] &],              StringJoin[#, line] &]            },           acc /. {             {init_, catenating[arg_]} :> {init, thunk[Unevaluated@arg]},             _ -> {acc, thunk[""]}             }]],         {},         lines]]      I checked briefly to see if there was an option for `Import[file, {"Text", "Lines"}]` that would allow you to specify a line continuation character, but nothing jumped out at me. I have a solution, but it seems needlessly convoluted. **EDIT** to add: I have a semi-realistic test file that's long enough that I can do some timing, but unfortunately can't make it public. **EDIT** again to add: OK, I munged any identifying information in the file beyond all recognition, so if you want something for test timings, you can find it here.


Using Sort vs SortBy

So I have two lists, A and B. I put them into `lists = {A,B}`I want to sort A such that `Im[#1]<Im[#2]&` which I can do fine through `Sort[]` .The problem is that I want to keep the order the same so that A[[1]] stays with B[[1]] and A[[n]] stays with B[[n]]. When I try `SortBy[lists\\[Transpose],Im]` it does not sort in the same order as the sort function does, but it keeps the A[[n]] with the B[[n]] EDIT::Example (I still can't figure out how to nicely format)               A={0.651301, 0.671298, -0.000107956 + 0.735512 I,  9.93631*10^-6 + 0.764605 I, 0.965926,     0.97048, 0.0344992 + 1.4214 I,  0.0028631 + 1.4505 I, -0.0626803 + 1.78014 I, -0.12443 + 1.98252 I,  0.167724 + 2.24691 I}                    B={{-2.44558*10^-6 - 1.01111*10^-6 I, -5.65309*10^-6 + 0.000018407 I,        0.000141659 + 0.0000359384 I,        0.000116428 - 0.000796561 I, -0.00506101 - 0.000580627 I,        0.000125772 + 0.0163992 I, 0.0817805 + 9.02056*10^-16 I,        0.000126129 + 0.0177878 I, 0.00153561 - 0.000581627 I,        0.000126597 + 0.000582107 I, -9.00118*10^-7 -         0.0000107003 I, -0.0000285126 - 0.0000117884 I, -0.0000659084 +         0.000214604 I, 0.00165158 + 0.000419 I,        0.00135741 - 0.00928697 I, -0.0590055 - 0.00676943 I,        0.00146635 + 0.191195 I, 0.953465 + 0. I, 0.00147052 + 0.207385 I,        0.0179034 - 0.00678109 I,        0.00147597 + 0.00678669 I, -0.0000104943 -         0.000124753 I}, {0.000116916 - 0.000811922 I, -0.00509776 -         0.000578293 I, 0.000129979 + 0.0163556 I,        0.079143 - 1.63203*10^-14 I, 0.000130143 + 0.0177879 I,        0.00147459 - 0.000580172 I,        0.00013056 + 0.00059606 I, -2.43588*10^-6 - 0.0000107979 I,        4.37224*10^-6 + 9.43651*10^-6 I, -3.88572*10^-7 + 7.61008*10^-9 I,        7.14058*10^-8 + 9.11373*10^-8 I,        0.00140496 - 0.00975669 I, -0.0612586 - 0.00694921 I,        0.00156193 + 0.196542 I, 0.951044 + 0. I, 0.0015639 + 0.213753 I,        0.0177198 - 0.0069718 I,        0.00156891 + 0.00716271 I, -0.0000292714 - 0.000129756 I,        0.0000525402 + 0.000113396 I, -4.66939*10^-6 + 9.14486*10^-8 I,        8.58068*10^-7 + 1.09518*10^-6 I}, {-0.00335176 - 0.00246906 I,        0.000695327 + 0.0163725 I, -0.00001055 -         0.0718776 I, -0.000733202 + 0.0162968 I,        0.00326678 - 0.00242532 I, -0.000740926 + 0.000255124 I,        0.00011033 + 0.0000490118 I, -0.0000121133 - 0.0000148216 I,        2.39696*10^-8 + 2.36464*10^-6 I,        1.63148*10^-7 - 2.69095*10^-7 I, -3.15697*10^-8 + 1.27853*10^-8 I,        0.0325148 - 0.0441254 I, -0.215566 + 0.00912321 I,        0.94636 + 0. I, -0.214567 - 0.00968502 I,        0.0319261 + 0.0430159 I, -0.0033576 - 0.00975571 I, -0.000645516 +         0.00145253 I,        0.000195169 - 0.000159459 I, -0.0000311336 + 3.1102*10^-7 I,        3.54266*10^-6 + 2.14857*10^-6 I, -1.68274*10^-7 -         4.1568*10^-7 I}, {-1.79728*10^-7 -         3.0708*10^-7 I, -8.50791*10^-8 + 2.61365*10^-6 I,        0.0000132867 - 0.0000158544 I, -0.000117531 + 0.0000495126 I,        0.000766382 + 0.000269089 I, -0.00325494 - 0.0024853 I,        0.000752542 + 0.0162187 I,        8.95415*10^-7 - 0.0689027 I, -0.000751796 + 0.0162166 I,        0.0032569 - 0.00249056 I, -0.000776443 + 0.000265907 I,        4.20299*10^-6 - 2.46001*10^-6 I, -0.0000357732 - 1.16402*10^-6 I,        0.000217003 + 0.000181853 I, -0.000677703 -         0.00160864 I, -0.00368289 + 0.0104896 I,        0.0340159 - 0.0445509 I, -0.221987 + 0.010303 I,        0.943075 + 0. I, -0.221957 - 0.010287 I,        0.0340891 + 0.0445769 I, -0.00363963 -         0.0106272 I}, {-0.0000127475 + 0.0000447811 I,        0.000264418 + 0.0000598865 I,        0.000164152 - 0.0012308 I, -0.00570662 - 0.000548632 I,        0.000189568 + 0.0156506 I, 0.0523487 - 2.28983*10^-16 I,        0.000191336 + 0.0176777 I, 0.000560154 - 0.000551883 I,        0.000187274 + 0.000764703 I, -0.0000430526 - 5.84824*10^-6 I,        8.05585*10^-6 + 0.0000148798 I, -0.000220415 + 0.000774304 I,        0.00457202 + 0.00103549 I,        0.00283833 - 0.0212815 I, -0.0986724 - 0.00948632 I,        0.0032778 + 0.270612 I, 0.905154 + 0. I, 0.00330836 + 0.305662 I,        0.00968555 - 0.00954253 I,        0.00323813 + 0.0132224 I, -0.000744416 - 0.000101121 I,        0.000139292 + 0.000257285 I}, {0.000262801 + 0.0000592442 I,        0.000164475 - 0.00123486 I, -0.00571449 - 0.00054799 I,        0.000190521 + 0.015638 I, 0.0520548 - 1.61329*10^-16 I,        0.000192306 + 0.0176744 I, 0.000545908 - 0.000551356 I,        0.000188135 + 0.000766815 I, -0.0000438809 - 5.72083*10^-6 I,        8.14335*10^-6 + 0.0000150479 I, -1.6632*10^-6 + 4.54164*10^-7 I,        0.00456548 + 0.00102921 I,        0.00285732 - 0.0214524 I, -0.0992743 - 0.00951989 I,        0.0033098 + 0.27167 I, 0.904315 + 0. I, 0.00334081 + 0.307047 I,        0.00948372 - 0.00957837 I,        0.00326835 + 0.0133214 I, -0.000762316 - 0.0000993844 I,        0.000141469 + 0.000261419 I, -0.0000288938 +         7.88991*10^-6 I}, {0.00324399 + 0.0151276 I,        0.000797234 - 0.0328468 I, -0.00205405 + 0.0139652 I,        0.00309583 - 0.0034084 I, -0.00125203 + 0.000542748 I,        0.000308022 + 0.0000414382 I, -0.0000545185 - 0.0000426274 I,        4.65124*10^-6 + 0.0000121837 I,        4.78853*10^-7 - 2.32735*10^-6 I, -2.68691*10^-7 + 2.83621*10^-7 I,        6.02922*10^-8 - 1.38336*10^-8 I, -0.382907 + 0.0918831 I,        0.836255 + 0. I, -0.356603 - 0.0436393 I,        0.088636 + 0.076666 I, -0.014583 - 0.0315217 I, -0.000864141 +         0.00786298 I,        0.00105095 - 0.00141351 I, -0.000307133 + 0.000125871 I,        0.0000595133 + 0.0000107468 I, -7.38245*10^-6 - 6.66148*10^-6 I,        3.8922*10^-7 + 1.52555*10^-6 I}, {2.82086*10^-7 +         2.97789*10^-7 I, -4.59823*10^-7 -         2.41021*10^-6 I, -5.01508*10^-6 + 0.0000122796 I,        0.0000564073 - 0.0000412174 I, -0.000307185 + 0.000029994 I,        0.00120889 + 0.000596331 I, -0.00288513 - 0.00343464 I,        0.00114029 + 0.0135455 I,        0.0000642005 - 0.0325252 I, -0.0009149 + 0.0138614 I,        0.00312207 - 0.00369177 I, -7.71767*10^-6 + 7.33966*10^-6 I,        0.0000625579 - 0.0000120629 I, -0.000319098 - 0.000129588 I,        0.00107311 + 0.00146251 I, -0.000794541 -         0.00797456 I, -0.0154218 + 0.0314195 I,        0.089033 - 0.0750887 I, -0.351653 + 0.030302 I,        0.844524 + 0. I, -0.359961 - 0.0230451 I,        0.0960172 + 0.0808758 I}, {-0.000892536 - 0.0253483 I,        0.00398093 + 0.0167517 I,        0.00137243 - 0.00591337 I, -0.0015116 + 0.00179952 I,        0.000585214 - 0.000258793 I, -0.000165802 - 0.0000248498 I,        0.0000301279 + 0.0000234092 I, -2.58394*10^-6 -         7.57878*10^-6 I, -3.51243*10^-7 + 1.52852*10^-6 I,        2.06661*10^-7 - 1.94772*10^-7 I, -4.87722*10^-8 + 8.31709*10^-9 I,        0.808747 + 0. I, -0.538275 + 0.10806 I,        0.186895 + 0.0503687 I, -0.0556474 - 0.0501875 I,        0.00759005 + 0.0189387 I,        0.000977896 - 0.00525555 I, -0.000779761 + 0.000933787 I,        0.000244404 - 0.000073836 I, -0.0000483136 - 0.0000129077 I,        5.9747*10^-6 + 6.80398*10^-6 I, -2.10308*10^-7 -         1.5635*10^-6 I}, {-2.51454*10^-7 - 1.09646*10^-7 I,        8.24658*10^-7 + 1.17552*10^-6 I, -5.98381*10^-7 -         7.07371*10^-6 I, -0.0000140755 + 0.0000294825 I,        0.000112869 - 0.0000806044 I, -0.000523179 + 0.0000579476 I,        0.00169884 + 0.000648417 I, -0.00347909 - 0.00374662 I,        0.00369489 + 0.0120913 I, -0.00129613 - 0.020651 I, -0.00517517 +         0.0120722 I,        4.45129*10^-6 - 8.67954*10^-6 I, -0.0000435543 + 0.0000266477 I,        0.000252369 - 5.47974*10^-6 I, -0.00101494 - 0.00056519 I,        0.00260914 + 0.00418509 I, -0.000891151 - 0.018696 I, -0.0267954 +         0.0588452 I, 0.140712 - 0.115123 I, -0.437333 + 0.104194 I,        0.735762 + 0. I, -0.4169 - 0.210549 I}, {1.30427*10^-7 +         1.21266*10^-7 I, -2.01494*10^-7 -         8.56205*10^-7 I, -1.39899*10^-6 + 3.95881*10^-6 I,        0.0000142534 - 0.0000114838 I, -0.0000753911 + 9.27582*10^-6 I,        0.000259802 + 0.000101574 I, -0.000571574 - 0.000745225 I,        0.000756398 + 0.00272191 I,        0.00135245 - 0.0061366 I, -0.00737014 + 0.0139213 I,        0.00132698 - 0.0177768 I, -4.48592*10^-6 + 5.61005*10^-6 I,        0.0000338329 - 0.0000106751 I, -0.00016343 - 0.0000443834 I,        0.000504691 + 0.000538816 I, -0.000599442 -         0.0030045 I, -0.00330544 + 0.0107546 I,        0.028258 - 0.025227 I, -0.107208 + 0.0385957 I,        0.250884 + 0.035973 I, -0.582065 - 0.254641 I, 0.718994 + 0. I}}


Strange Tilt on error notification

I was testing the source code of the answers to this question. And when I tried this response and maxed out most of the manipulators, this is what I got. ![enter image description here](http://i.stack.imgur.com/5pBFl.png) ![enter image description here](http://i.stack.imgur.com/mqx7H.png) ![enter image description here](http://i.stack.imgur.com/lCDDa.png) ![enter image description here](http://i.stack.imgur.com/SVeP3.png) What went wrong that the errors are tilted. Can anyone explain? Here’s the link for the Notebook. P.S. These are not Photoshopped.


How do I upload a graph as an adjacency list and find the betweenness centrality?

I have an undirected simple graph in a .txt file formatted as an adjacency list like this:               100 200     200 300     300     400 500 600 700 800 900     ...      Every number is a node id and the graph is unweighted. The first number in each row is that row's node and any following numbers are adjacent nodes. In this example node 100 has node 200 as its neighbor, node 200 has nodes 100 and 300 as its neighbors, and node 300 has node 200 as its neighbor. I am trying to find the betweenness centrality of each node. I found out about the `Input`, `BetweennessCentrality`, and `FromAdjacencyLists` functions but I cannot seem to use them correctly.   Does my data need to be formatted differently?   How do I get from inputing my data to using `BetweennessCentrality`? I don't know much about using _Mathematica_ so I might be missing something obvious.


NIntegrate failling on floating value

I'm trying to take the following integral               NIntegrate[         ((Sin[Q 1]-Q 1*Cos[Q 1])/(Q 1)^3)^2          * S[Q,0.4,2]          * Q BesselJ[0,0.5Q]         , {Q,0,Infinity}]      but it fails with the following error message               First::first: "{} has a length of zero and no first element."      However, if I replaced the 0.5 in the Bessel function with a 1/2               NIntegrate[((Sin[Q 1] - Q 1*Cos[Q 1])/(Q 1)^3)^2                 * S[Q, 0.4, 2]                 * Q BesselJ[0, Q/2]                , {Q, 0, Infinity}]      I get back the result (0.046852). S[Q,0.4,2] is included below for completeness, but it's mostly just trig functions and polynomials, so I'd be surprised if it was the issue. It certainly doesn't contain a call to first. Why would the calculation fail for the floating point value but succeed on the rational one? Also, what does any of this have to do with First?               S[Q,0.4,2]==(1+0.095493 (-(0.000127501 (118891. +208412. Q^2-(392972. Q^4-104206. Q^2 (-2+3.93305 Q^2)+4953.78 (24-47.1966 Q^2+15.4689 Q^4)) Cos[1.98319 Q]+2 Q (-117892.-30305.8 Q^2) Sin[1.98319 Q]))/(Q^6 (1+1/Q^60.0000121755 (118891. +208412. Q^2-(392972. Q^4-104206. Q^2 (-2+3.93305 Q^2)+4953.78 (24-47.1966 Q^2+15.4689 Q^4)) Cos[1.98319 Q]+2 Q (-117892.-30305.8 Q^2) Sin[1.98319 Q])))-1/Q^40.00681547 ((-16109.8 Q^2+138.778 (144+31.4644 Q^2)) Cos[1.98319 Q]-4 (-4061.58 Q^2+138.778 (36+7.3277 Q^2)) Cos[2 Q]+8 Q (3217.18 Sin[1.98319 Q]-3259.16 Sin[2 Q]))+(10.0812 (Q^3 Cos[2 Q]-3.6092 (26.0526 +Q^2) Sin[2 Q]))/(678.74 Q+Q^5)))/(1-0.904507 (-(0.000127501 (118891. +208412. Q^2-(392972. Q^4-104206. Q^2 (-2+3.93305 Q^2)+4953.78 (24-47.1966 Q^2+15.4689 Q^4)) Cos[1.98319 Q]+2 Q (-117892.-30305.8 Q^2) Sin[1.98319 Q]))/(Q^6 (1+1/Q^60.0000121755 (118891. +208412. Q^2-(392972. Q^4-104206. Q^2 (-2+3.93305 Q^2)+4953.78 (24-47.1966 Q^2+15.4689 Q^4)) Cos[1.98319 Q]+2 Q (-117892.-30305.8 Q^2) Sin[1.98319 Q])))-1/Q^40.00681547 ((-16109.8 Q^2+138.778 (144+31.4644 Q^2)) Cos[1.98319 Q]-4 (-4061.58 Q^2+138.778 (36+7.3277 Q^2)) Cos[2 Q]+8 Q (3217.18 Sin[1.98319 Q]-3259.16 Sin[2 Q]))+(10.0812 (Q^3 Cos[2 Q]-3.6092 (26.0526 +Q^2) Sin[2 Q]))/(678.74 Q+Q^5)))


FullSimplify Over Reals Automatically

Frequently, Mathematica will produce some expression in a complicated form, with a number of unset variables. For me, it is rare that I would be interested in solutions that are generalized to both real and imaginary arguments, so my method is usually to run a FullSimplify on the expression, with every unset variable being assumed be an element of the reals:               FullSimplify[a+Log[Exp[b^2 - c^2]]-Log[d],         Assumptions->{a \[Element] Reals, b \[Element] Reals,                       c \[Element] Reals, d \[Element] Reals}]      This is quite cumbersome, especially if the expression has many unset parameters. My question is: Can someone write a function that automatically extracts all unset parameters in an expression, and then uses that to set the Assumptions parameter automatically? The second part I know how to do (`Element[#, Reals] & /@ pars`), but not the extracting the unset parameters part. Ideally it would only take the function itself as its argument:               fullSimplifyReals[a+Log[Exp[b^2 - c^2]]-Log[d]]      **Edit:** I am accepting Szabolics' answer for now, as it seems to do what I want it to in my limited testing. For convenience, here is the functional form of Szabolics' answer:               fullSimplifyReals[x_] := Assuming[_Symbol \[Element] Reals, FullSimplify@x];


Graph with $\{a,b\}$ as Vertex Instead of Number

I'm trying to create a graph which has $\{a,b\}$ as labels:               g := Graph[{1 \[UndirectedEdge] 9, 1 \[UndirectedEdge] 10,         1 \[UndirectedEdge] 8, 10 \[UndirectedEdge] 2,         10 \[UndirectedEdge] 5, 9 \[UndirectedEdge] 3,         9 \[UndirectedEdge] 6, 8 \[UndirectedEdge] 7,         8 \[UndirectedEdge] 4, 7 \[UndirectedEdge] 3,         7 \[UndirectedEdge] 2, 6 \[UndirectedEdge] 2,         6 \[UndirectedEdge] 4, 5 \[UndirectedEdge] 3,         5 \[UndirectedEdge] 4}]      Any help would be appreciated.


Can I define a "postfix map" operator with comparable precedence behavior to //

I am trying to define a "postfix map" operator (denoted `$OP$` for now) that behaves thus:               {1, 2, 3} $OP$ # + 1 & == {2, 3, 4}      and               {1, 2, 3} // RotateLeft $OP$ # + 1 & == {3, 4, 2}      and               {1, 2, 3} // RotateLeft $OP$ # + 1 & // Total == 9      I hope not to need parentheses when I pipe results forward using a combination of // and my custom `$OP$`. Is this possible? My guess is that it is not because there is no operator with the same precedence as `//`. I understand that I will need to use either an unassigned operator (e.g., CirclePlus) or another symbol as an infix operator; that I cannot modify precedence; and that the ability to define custom syntax is limited (e.g., `@//` can't be defined). Looking at "Operator Input Forms", it seems the closest I can get to `//` with regard to precedence is either Colon or VerticalSeparator, as               Precedence /@ {Colon, Postfix, VerticalSeparator} == {80., 70., 60.}      **Does this mean that there is simply no way to define the operator I seek in a way that will never require parentheses when it is chained with`//`?** For example, given               SetAttributes[VerticalSeparator, HoldAll];     VerticalSeparator[l_, f_] := f /@ l;      this does not work               {1, 2, 3} \[VerticalSeparator] # + 1 & // Total == {(1 + #1)[1], (1 + #1)[2], (1 + #1)[3]}      Similarly, with               SetAttributes[Colon, HoldAll];     Colon[l_, f_] := f /@ l;      this does not work               {1, 2, 3} // RotateLeft \[Colon] # + 1 & == {2, 3, 1}      I have read, for example, Prefix operator with low precedence , http://stackoverflow.com/questions/5304858/custom-postfix-notation-apply- function .


custom precedence for custom infix operator with InfixNotation

I am trying to define several custom operators with custom precedence to implement geometric algebra. Loading the notation package               << Notation`      I can define custom infix operators, e.g.               InfixNotation[ParsedBoxWrapper["\[Wedge]"],exteriorProd]      but they will inherit the precedence of [Wedge]. Next I tried to define               InfixNotation[ParsedBoxWrapper[TagBox["\[Wedge]",ext,SyntaxForm->"a\[Vee]b"]], exteriorProd]      which does the job for output, but I can not find a way whatsoever to enter this operator by keyboard (e.g. as an alias). When I try to convert the tag box to an expression it will just apply the tag to first argument... Is there any other box (besides InterpretationBox) that accepts the SyntaxForm option and does what I want? By the way,   1. SyntaxForm seems to depend very much on the argument that you write next to the "example operator", even when it looks like the operator is usually a binary/infix operator.   2. The function Infix[] (not to be confused with InfixNotation[]) seems not to be able to deal correctly with the precedence option.   3. (slightly out of context) it seems to me the function Symbolize[] shows a different behaviour than it is shown in the documentation. is it correct to assume that the Notation package is not yet very mature? Thanks a lot, Hendrik Edit: Is it viable to use "non-infix" operators instead, then "parse" (convert) the input to an "infix" form like exteriorProd[a,b,c,d] and deal with displaying it in an infix way in a separate effort?


Graphics, PlotRange and/or PlotRegion

Consider the following snippet of code:                 Module[{pts},        pts = {{0, 0}, {0, 2}, {6, 0}};        Graphics[{Blue, Polygon[pts]}, PlotRange -> {{0, 4}, {0, 4}}]       ]      A graphic is displayed that doesn't entirely fall within the plotrange. Question : I have a Panel that displays graphics of different shapes and size. When automatic resizing of the graphic is not an option what is the best way to calculate the plotrange ( or any other suitable option ) so that graphics fit ?


How to use ImageMultiply[] over a list of strings?

I'm trying to do the following:               l = FileNames[];     s[x_] := ToString[l[[x]]]     t = Table[s[x], {x, 1, Length[l]}];     i[x_] := Import[t[[x]]]     m[x_] := ImageMultiply[i[x], i[x + 1]]      This is supposed to take two images of one folder and multiply them. But I want to take two images and multiply them, then I want to take the next two, multiply them and multiply to the last multiplied images and proceed like this for all the images in the folder. I already have a table with all the file locations, the problem is that `ImageMultiply[]` doesn't take lists as inputs. I wasn't able to do something like:               ImageMultiply[t]      Which would solve the problem, but the input of this function is:               ImageMultiply[image1,image2,...]      And not:               ImageMultiply[{image1,image2, ...}]      Perhaps there is some way of _drop_ all the elements out of the list into that function, I don't know about it. I've also looked some functions that look extremelly similar to what I'm trying to do, I guess that there's some way to use `NestList[]` or `Nest[]` to do it, but I've tried a few experiments and it resulted in hazard...$^1$ $1$ - I don't remember precisely which arguments (then I chose arbitrary ones) I used in that function, but it really froze my computer.


Connecting to Raspberry Pi's Wolfram Language kernel from a PC's Mathematica front end

Recently I bought a Raspberry Pi and I installed the Wolfram Language on it. Comparing WL 10.0's commands with _Mathematica_ 9.0.1.0's commands, I found 328 additional commands and variables. I understand that WL is in a preliminary version so more commands may be added (or removed) in the near future but since this seems to be the future, I believe learning as quickly as possible the new possibilities would be a strong asset. Since my PC's front end is much faster than the RPi's, I would like to call these through my _Mathematica_ 9.0.1 front end and get the results in the same front end. This would save a lot of time lost in going forward-backward between them. So how can I call the WL kernel from my PC (I have attached both to an Ethernet LAN)?


Under what conditions does Mathematica give a natural antiderivative when integrating?

Natural antiderivative is defined as follows, using Fourier transform: $$f^{(-1)}(x)=\frac{i}{2\pi}\int_{-\infty}^{+\infty} \frac{e^{- i \omega x}}{\omega} \int_{-\infty}^{+\infty}f(t)e^{i\omega t}dt \, d\omega$$ Particularly, if $x=0$, $$f^{(-1)}(0)=\frac{i}{2\pi}\int_{-\infty}^{+\infty} \frac{1}{\omega} \int_{-\infty}^{+\infty}f(t)e^{i\omega t}dt \, d\omega$$ Expressed as _Mathematica_ code:               (I/Sqrt[2*Pi])*Integrate[(1/w)*FourierTransform[f[t], t, w], {w, -Infinity, Plus[Infinity]}]      That said, I wonder if _Mathematica_ always adheres to the rule of providing the antiderivative which would satisfy this condition. For instance, `Integrate[Sin[x], x]` gives `-Cos[x]`, which satisfies the condition as `-Cos[0] == -1`. I wonder how much this rule is adhered to in the output of `Integrate`.


Extracting counts of contiguous zeros and ones from a binary array

I'm a novice with _Mathematica_ , but you guys have been very helpful to me in the past. I have a binary array [100, J repetitions] consisting of zeroes and ones. I'd like to extract a histogram of the number of contiguous ones in these individual columns. Assuming I have some variable `f[i, j]` containing these data what I have is:               Do[       bhist = SparseArray[{1, 1} -> 0, {1, 100}, 0];        index = 1;        Do[If[f[[j, i]] == 1, index++, bhist[[index]] + 1; index = 1],          {i, 1, 100}];        bhista[j] = bhist;,        {j, 1, rep}];      where `bhist` will record the number of contiguous 1s and how many times that ensemble occurs. This will loop over all j repetitions of the monte carlo. The problem is that I seem to only be generating zeroes despite the fact that my simulation does generate contiguous 1s. Is my `If` expression setting the index to 1 before it records the value in my `bhist` variable? Or is something else going on? Furthermore, if I wanted to then extract a histogram from `bhista`, is there a more efficient way of doing this than flattening it and bin counting?


Correct way to use Notation

I have tried to create some Notation declarations as follows               << Notation`     Notation[Subscript[x_, i_] \[DoubleLongLeftRightArrow] x[i]]     Notation[OverBar[x_] \[DoubleLongLeftRightArrow] mean[x]]      Mathematica9 throws the following errors for the declarations > Notation::noexbtag: The external representation Subscript[x_, y_] does not > have an embedded TemplateBox with tag NotationTemplateTag. The Notation > statement Notation[Subscript[x_, y_][DoubleLongLeftRightArrow]x[y]] may not > have been entered using the palette, or the embedded TemplateBox may have > been deleted. The embedded TemplateBox ensures correct parsing and retention > of proper styling and grouping information. >> and > Notation::noexbtag: The external representation Overscript[x_, _] does not > have an embedded TemplateBox with tag NotationTemplateTag. The Notation > statement Notation[Overscript[x_ , _][DoubleLongLeftRightArrow]mean[x]] may > not have been entered using the palette, or the embedded TemplateBox may > have been deleted. The embedded TemplateBox ensures correct parsing and > retention of proper styling and grouping information. >> respectively. It is not really clear to me what is going on. I read the documentation for `TemplateBox` and looked up `NotationTemplateTag` which seems to have been replaced by `ParsedBoxWrapper`. After following some related function I thought the following might be what is required:               Notation[ToBoxes[Subscript[x_, y_]]\[DoubleLongLeftRightArrow] x[y]]     Notation[ToBoxes[OverBar[x_]] \[DoubleLongLeftRightArrow] mean[x]]      or perhaps               Notation[MakeBoxes[Subscript[x_, y_]]\[DoubleLongLeftRightArrow] x[y]]     Notation[MakeBoxes[OverBar[x_]] \[DoubleLongLeftRightArrow] mean[x]]      but both of those throw errors as well. So what is the right way to declare these notations? I am aware that setting up subscripts as a notation for function application is not something you would want to do in practice, but I am just experimenting. Also do I actually need to import the Notation package or `Notation` buit-in with Mathematica9?


Is there a way to riffle more than two lists?

I thought `Riffle` would generalize such that               Riffle[{a,b,c},{1,2,3},{x,y,z}]      would return               {a,1,x,b,2,y,c,3,z}      It turns out that's not the case. What's the easiest way to do a multi-list riffle?


triple NIntegrate fails

Here's m problem simpler in terms of codes               Clear["Global`*"]     e = 0.454648; A = 1.6297; rs = 3.68888; kb = 0.001872041; Na =       6.02214129*10^23;     ep = 0.2961; p = 3.78;     pot[r_] := -e (1 - (1 - Exp[-A (r - rs)])^2)          B[T_] := -2 \[Pi] Na NIntegrate[(Exp[-pot[r]/(kb T)] - 1) r^2, {r, 0,          Infinity}] 10^-24     C2[T_] := 8 \[Pi]^2 /3 Na ^2 10^-48 NIntegrate[        NIntegrate[         NIntegrate[          r12^2 (1 - Exp[-pot[r12]/(kb T)]) r13^2 (1 -              Exp[-pot[r13]/(kb T)]) (1 -              Exp[-pot[Sqrt[r12^2 + r13^2 - 2 r12 r13 n]]/(kb T)]), {r13, 0,            150}], {r12, 0, 150}], {n, 1, 150}]      My problem is that second integration function C2[T_] keeps giving me zero with 3 warnings of > NIntegrate::izero: Integral and error estimates are 0 on all integration > subregions. Try increasing the value of the MinRecursion option. If value of > integral may be 0, specify a finite value for the AccuracyGoal option. >> and if I use one NIntegrate function               C2[T_] :=       8 \[Pi]^2 /3 Na ^2 NIntegrate[        r12^2 (1 - Exp[-pot[r12]/(kb T)]) r13^2 (1 -            Exp[-pot[r13]/(kb T)]) (1 -            Exp[-pot[Sqrt[r12^2 + r13^2 - 2 r12 r13 n]]/(kb T)]), {r13, 0,          150}, {r12, 0, 150}, {n, 1, 150}]      I get 3 of this warning > NIntegrate::errprec: Catastrophic loss of precision in the global error > estimate due to insufficient WorkingPrecision or divergent integral. >> any ideas how to fix it? The original integration is ![enter image description here](http://i.stack.imgur.com/vex2k.gif)


ListPointPlot3D with connected points?

With the command `ListPlot[data,Joined -> True]` I can visually connect adjacent data points in the array with lines. However, this option appears to be missing in `ListPointPlot3D`? Is there some manner with which to join with to join (with a line) adjacent three-dimensional points? There will be a large number of points in my data structure, and I'd really like to keep the standard output format of `ListPointPlot3D`.


Is there an easy way to create a "IntensitySquaredCentroid" using ComponentMeasurements?

One of the options in ComponentMeasurements is to compute a centroid based on the pixel values of some underlying image. We can write:               ComponentMeasurements[{MorphologicalComponents[image], image}, "IntensityCentroid"][[All, 2]];      Is it possible, however, to have something like an intensity squared or cubed centroid?


PixelValue with pixel indices

How Can we use PixelValue with pixel indices?


Non linear model fit mathematica

I want to fit experimental data (temp,alpha) to the following equation for calculating k and Ea                   -Log[alpha]^n = function(k,Ea,temp)      However i do not know exact value of "n". By this time i am using trial and error for "n" and select value based on the maximum r^2 , but this is time consuming and value of may be inaccurate. Is there any method, through which i can get the optimum value on "n" based on a specified range i.e. 2 to 3, along with k and Ea for which r^2 is the best one. Here is my code. i am sorry if it seems messy                   data = Import["data.xlsx", {"Sheets", "control", All, {1, 2, 3}}];         R = 0.008314; Ea =.; k =.; RHS =.; T =.; n =.; b = 10; n =.; temp =.;         alpx =.;         RHS = Integrate[k/b Exp[-(Ea/R) (1/T - 1/370)], T];         model = RHS;         n = 3.1;         alpx = data[[All, 2]]^(1/n);         temp= data[[All, 1]];         alp = data[[All, 3]];         bb = Table[{(alpx[[i]]), temp[[i]]}, {i, 1, Length[temp]}];         sol = NonlinearModelFit[bb, model, {k, Ea}, T] //Chop;         newRHS = Normal[sol];         sol[{"BestFitParameters", "ParameterTable", "EstimatedVariance",          "ANOVATable", "RSquared"}]              Plot[(Exp[-newRHS^n]), {T, 360, 400}, PlotStyle -> {Black, Thick},          Frame -> True,          FrameLabel -> {Style["Temperature(K) ", 16],          Style["Relative crystallinity  ", 16]}, GridLines -> Automatic,          PlotLabel -> "Control", ImageSize -> Medium];


need help rotating an object about the z-axis using animation

This should be an easy question for anyone familiar with 3D animations. I have a 2D shape denoted by the equation                      ((x-1)^2+y^2) ((x+1)^2+y^2)==1      and I want to illustrate its relation to a Horn Torus. To do this, I would like to rotate it about the $z$-axis in 3-space and have an outline of the shape be created behind it. I appreciate any help you guys can give me.