Output most efficient Fortran code by mathematica

I am trying to output most efficient Fortran code by mathematica 9.0 with the method Simon provided: How can I get Mathematica to produce better Fortran code? The expressions is as follows:               v = Det[{{1, 1, 1, 1}, {x1, x2, x3, x4}, {y1, y2, y3, y4}, {z1, z2,           z3, z4}}]/6;     b1 = -Det[{{1, 1, 1}, {y2, y3, y4}, {z2, z3, z4}}];     c1 = Det[{{1, 1, 1}, {x2, x3, x4}, {z2, z3, z4}}];     d1 = -Det[{{1, 1, 1}, {x2, x3, x4}, {y2, y3, y4}}];     b2 = Det[{{1, 1, 1}, {y1, y3, y4}, {z1, z3, z4}}];     c2 = -Det[{{1, 1, 1}, {x1, x3, x4}, {z1, z3, z4}}];     d2 = Det[{{1, 1, 1}, {x1, x3, x4}, {y1, y3, y4}}];     b3 = -Det[{{1, 1, 1}, {y1, y2, y4}, {z1, z2, z4}}];     c3 = Det[{{1, 1, 1}, {x1, x2, x4}, {z1, z2, z4}}];     d3 = -Det[{{1, 1, 1}, {x1, x2, x4}, {y1, y2, y4}}];     b4 = Det[{{1, 1, 1}, {y1, y2, y3}, {z1, z2, z3}}];     c4 = -Det[{{1, 1, 1}, {x1, x2, x3}, {z1, z2, z3}}];     d4 = Det[{{1, 1, 1}, {x1, x2, x3}, {y1, y2, y3}}];     bcdv = {b1, c1, d1, b2, c2, d2, b3, c3, d3, b4, c4, d4, v};      The code to produce Fortran code is as follows:               out = Experimental`OptimizeExpression[FullSimplify[bcdv],          "OptimizationSymbol" -> tmp] /.         HoldPattern[          Experimental`OptimizedExpression[           Block[{tempVars__},             CompoundExpression[defs : Set[_, _] ..., expr_]]]] :>          Block[{Set =             ToString[#1] <> " = " <> ToString[FortranForm[#2]] &},           List[defs, expr]];     out2 = out // Flatten // ExportString[#, "Table"] &      However, it produced the following code (with the number of production operations be 69):               tmp9 = -z3     tmp6 = -z4     tmp3 = -z2     tmp15 = tmp6 + z3     tmp33 = -z1     tmp10 = tmp9 + z4     tmp26 = -y3     tmp23 = -y4     tmp39 = tmp6 + z1     tmp17 = tmp3 + z4     tmp7 = tmp6 + z2     tmp34 = tmp33 + z4     tmp47 = -y1     tmp20 = -y2     tmp56 = tmp3 + z1     tmp13 = tmp9 + z2     tmp37 = tmp33 + z3     tmp51 = tmp33 + z2     tmp30 = tmp9 + z1     tmp4 = tmp3 + z3     tmp53 = tmp39*y2     tmp10*y2 + tmp7*y3 + tmp4*y4     tmp15*x2 + tmp17*x3 + tmp13*x4     x3*(tmp23 + y2) + x4*(tmp20 + y3) + x2*(tmp26 + y4)     tmp15*y1 + tmp34*y3 + tmp30*y4     tmp10*x1 + tmp39*x3 + tmp37*x4     x4*(tmp26 + y1) + x1*(tmp23 + y3) + x3*(tmp47 + y4)     tmp53 + tmp17*y1 + tmp51*y4     tmp7*x1 + tmp34*x2 + tmp56*x4     x2*(tmp23 + y1) + x4*(tmp47 + y2) + x1*(tmp20 + y4)     tmp13*y1 + tmp37*y2 + tmp56*y3     tmp4*x1 + tmp30*x2 + tmp51*x3     x3*(tmp20 + y1) + x1*(tmp26 + y2) + x2*(tmp47 + y3)     (-(x2*y3*z1) + x2*y4*z1 + x1*y3*z2 - x1*y4*z2 + x2*y1*z3 - x1*y2*z3 + \     x1*y4*z3 - x2*y4*z3 + x4*(-(y2*z1) + y3*z1 + y1*z2 - y3*z2 - y1*z3 + \     y2*z3) + (-(x2*y1) + x1*y2 - x1*y3 + x2*y3)*z4 + x3*(tmp53 - y4*z1 - \     y1*z2 + y4*z2 + y1*z4))/6      The ideal code is as follows, with the number of production operations be 29:               x1=x(2)-x(1)     y1=y(2)-y(1)     z1=z(2)-z(1)     x2=x(3)-x(2)     y2=y(3)-y(2)     z2=z(3)-z(2)     x3=x(4)-x(3)     y3=y(4)-y(3)     z3=z(4)-z(3)     x4=x(1)-x(4)     y4=y(1)-y(4)     z4=z(1)-z(4)     B1=Y3*Z2-Y2*Z3     B2=Y3*Z4-Y4*Z3     B3=Y1*Z4-Y4*Z1     B4=Y1*Z2-Y2*Z1     C1=X2*Z3-X3*Z2     C2=X4*Z3-X3*Z4     C3=X4*Z1-X1*Z4     C4=X2*Z1-X1*Z2     D1=X3*Y2-X2*Y3     D2=X3*Y4-X4*Y3     D3=X1*Y4-X4*Y1     D4=X1*Y2-X2*Y1     V=(x(1)*b1+x(2)*b2+x(3)*b3+x(4)*b4)/6.0d0      Is there any better way to produce high efficient Fortran code? Thanks, Tang Laoya


How to create a stacked-alphabet image efficiently?

By adopting the answers from Mr. Wizard to my previous question, I tried to create a stacked-alphabet image from a person's portrait, the alphabets were taken from the name of the portrait subject. Here is an example of _Marilyn Monroe_. _Marilyn Monroe_ 's portrait: ![enter image description here](http://i.stack.imgur.com/h76V5.jpg) Result: ![enter image description here](http://i.stack.imgur.com/YTDf1.jpg) The problem is: Why some of the alphabets," _i_ ", " _l_ " and their combined alphabets turned into color images. And how to obtain a faster version of the code below. ![enter image description here](http://i.stack.imgur.com/xVlg9.jpg)                (* change alphabets to images *)     alpha2Im[allst_] :=        ImageResize[        ImageCrop@         Graphics[          Text[Style[#, 24, FontFamily -> "Helvetica",               Antialiasing -> True]] &~MapThread~{allst }  ] , {18, 18}];           (* choose appropriate alphabet-image from the alphabet image list  *)     chooseAlp[imV_, len_] := (For[i = 1, i <= len, i++,        If[alphImageGrayPair[[i]][[2]] >= imV,          Return[alphImageGrayPair[[i]][[1]]] ];       ])          Clear[i, l, r];     name = "Marilyn Monroe";     im = Import["http://i.stack.imgur.com/MnwCU.jpg"] ;          alphabets =        Subsets[Union@Characters@StringReplace[name, " " -> ""], 2];     alphImageLst = alpha2Im[#] & /@ alphabets ;     alphGrayValLst = Mean@Flatten@ImageData[#] & /@ alphImageLst;     alphImageGrayPair =        Sort[MapThread[         List, {alphImageLst, alphGrayValLst}], #1[[2]] < #2[[2]] &];          imD = ImageData@im;     {imW, imH} = ImageDimensions@im  ;          avg = ConstantArray[0, {imW/4, imH/4}];      ddata = Partition[imD, {4, 4}, 4];     For[i = 1, i <= imH/4, i++,       For[j = 1, j <= imW/4, j++,        avg[[i, j]] = Mean@Flatten[ddata[[i, j]], 1];]]          allStrips = {};     strip = {};     For[j = 1, j <= imH/4, j++,       strip = {};        For[k = 1, k <= imW/4, k++,        AppendTo[  strip, chooseAlp[  avg[[j, k]], imW/4 ] ];        ];       AppendTo[allStrips, strip ];        ];     allStrips // ImageAssemble


Plotting partial sums and its Cesàro means

I have the function as shown in the first line of the code and its partial sum in the second line of the code below.               f[x_] := Abs[x];     s[k_, x_] := (Pi/2) + Sum[((-1)^(n) - 1) 2/(Pi n^(2)) Cos[n x], {n, 1, k}]       Then I have the Cesàro means of the function: $$F_{n}(f)=\frac{1}{n} \sum^{n-1}_{m=0} S_{m}(f)$$ Originally I plot just the function and its partial sum with the code               Plot[Evaluate[{f[x], partialsums}], {x, -0.5, 0.5}      Now if I want to add in the 4th term of the Cesàro means, may I know how can I do so? I made a few changes and there is always a `+` symbol appearing inline which I believe is due to some mistake in my program The original plot without the Cesàro means is               f[x_] := Abs[x];     s[k_, x_] := Pi/2 + Sum[((-1)^(n) - 1) 2/(Pi n^(2)) Cos[n x], {n, 1, k}]      partialsums = Table[s[n, x], {n, 4}];     Plot[Evaluate[{f[x], partialsums}], {x, -0.5, 0.5}]      When I introduce the `Piecewise` function to add the Cesàro means to my graph, no drawings were generated. Please help.


Symbolic solution to ODE, pure InverseFunction not evaluated

I'm new to _Mathematica_ and I don't understand why in the solution of the following ODE, the `#1` in the pure function is not immediately replaced by the corresponding `[t/4 + C[1]]`. It seems as if the program wanted to compute the "InverseFunction" operator before inserting the bracket into the solution. I don't see why it should matter mathematically to replace the `#1` by the bracket only after computing the inverse function. Further, why is the `InverseFunction` not computed? I was expecting to get one branch together with the message that there might be other branches.               sol = DSolve[{a'[t] ==      1/2 (-(3/2) + Sqrt[(-(3/2) - a[t])^2 - 2 a[t]] - a[t])}, a[t], t]          {{a[t] -> InverseFunction[      1/8 (-ArcSinh[(1 + 2 #1)/(2 Sqrt[2])] - 6 Log[#1] +           3 Log[9 + 2 #1 + 3 Sqrt[9 + 4 #1 + 4 #1^2]] - 2 #1 - Sqrt[          9 + 4 #1 + 4 #1^2]) &][t/4 + C[1]]}}


Pass the list of variables into function to change their values

I'm new to Mathematica, so I don't really know, how do what I want, and I don't even know how to google it. Doing one Mathematica task for my supervisor, I faced the following problem. I need to write a function with such a syntax:               f[{{var1, val1}, {var2, val2}, ..., {varn, valn}}]      Here $var_i$ is a variable and $val_i$ is a value, which will be assigned to this variable. So this functions is a "parallel" analogue of the function Set[]. $var_i$ has already its value, and it can be evaluated (but it's not what I want). Number of variables $n$ can vary. Apparently, I need to set Hold attribute for $f$, but what should I do next? The first thing I've tried to do was just `f[l_] := l[[All, 1] = l[[All, 2]]`, but it didn't worked due to some part assignment restrictions. But if I try to extract variables like `vars = l[[All, 1]]` and than do `vars = l[[All, 2]]`, it doesn't work too, because `vars` just become replaced with values from `l[[All, 2]]`. I know, I must use Hold[] and Unveluated[] somehow, but I don't know how to apply them here. **P.S.** The problem I've really faced is sligtly different: I want to build function, which argument is `{{var1, a1, b1, n1}, ...}` and which will iterate over $var_i$ from $a_i$ to $b_i$ with step $n_i$. I try to implement "parallel" Set[] first, because of its simplicity. **P.S.S.** Sorry for my English, it's not my native language.


Simplify — is this simplest result Mathematica can provide?

I have a question about `Simplify`: When I do a simplification the returned result is not as simple as I want. When I ask for the Norm of an complex expression, _Mathematica_ just returns `Norm[expr]`. I don't know how to make it simpler, is this the final form that Mathematica can give?               Simplify[Conjugate[h^4 k^2 + 2 I h^2 k m V + (-1 + E^(2 I k l)) m^2 V^2],        {k, V, m, h, l} ∈ Reals]      When evaluating the above code, Mathematica just returns `Conjugate[...]`, but what I need is a form without `Conjugate` in the front, just replace $i$ to $-i$ as usual math calculation.


Data fitting with Image processing feature detection

I have some 2D data that once plotted looks like the following               dat=Import["data.mat","Data"];     picList=ListPlot[,Axes-> None,Frame-> None,AspectRatio-> 1];     e=ColorConvert[Rasterize[picList],"Grayscale"];     Show[picList,Frame-> True]      ![enter image description here](http://i.stack.imgur.com/FX6XO.png) Now I wrote the following image processing function to detect the outer circular region where the point density starts to **decrease**. I want to fit that region with a certain parametric curve. For example a circle with unknown radius $r$. I want to achieve this through an automatic code without any manual input (one can use `Manipulate` with `ListPlot` for instance). I have included extensive commenting for better understanding my approach for a solution. **The Function:**               FinalFit[res_, TotalVariationFilter$Regularization_: .2,      TotalVariationFilter$MaxIterations_: 10,      GradientFilter$PixelRadius_: 1, BoundingBoxPoints_: 50,      ExtraImage_: False] :=      Block[{picList, e, addedIm, Finres, dimX, dimY, imRange, plotrange,      datim, res1, intData, finder, fun, xvals, yvals, boxdat, circledat,     arrow, Pic, r},     (*------ Take the 2D data points and plot it *)     picList =      ListPlot[res, Axes -> None, Frame -> None, AspectRatio -> 1];     (*------      Create a raster image from the plot and convert it to Grayscale *)     e = ColorConvert[Rasterize[picList], "Grayscale"];     (*------ Reduce the noise in the outward part of the cluster *)     addedIm =      ImageAdd[       TotalVariationFilter[Binarize[e],        TotalVariationFilter$Regularization,        MaxIterations -> TotalVariationFilter$MaxIterations], e] //      Binarize;     (*------ Get the ridges of gradient lines in the binarize image *)     Finres = (GradientFilter[addedIm, GradientFilter$PixelRadius,        "NonMaxSuppression" -> True] // Binarize);     (*------ Dimension of the input raster "e" *)     {dimX, dimY} = N[ImageDimensions@e];     imRange = {{1., dimX}, {1., dimY}};     (*------ Extract the 2D data range *)     plotrange = AbsoluteOptions[picList, PlotRange][[1]][[2]];     (*------ Get the image data from last image with gradient lines *)     datim = Reverse@ImageData[Finres];     res1 = Table[{i, j, N[datim[[i, j]]]}, {i, 1, dimX}, {j, 1, dimY}];     (*------ Rescale the contour/     gradient line according to the 2D data range "Bad Coding!" *)     intData =      Join[Transpose@       RescalingTransform[imRange, plotrange][        Flatten[Table[{i, j}, {i, 1, dimX}, {j, 1, dimY}], 1]], {Last@        Transpose@Flatten[res1, 1]}] // Transpose;     (*------      Form a Nearest function with the above obtained points constituting \     the target contour *)     (*------ Select the points on the contour as their third co-     ordinate correspond to the pixel value of "1." *)     finder = Nearest[Take[Select[intData, #[[3]] == 1. &], All, 2]];     (*------      On the contour line image discretize the boundary with uniformly \     seperated points *)     (*------ User specifies the number of total bounding points *)     (*------ Start of "Bad Codeing!" *)     xvals =      Range[#[[1]], #[[2]], (#[[2]] - #[[1]])/(BoundingBoxPoints/           4)] & /@ {plotrange[[1]]} // Flatten;     yvals =      Range[#[[1]], #[[2]], (#[[2]] - #[[1]])/(BoundingBoxPoints/           4)] & /@ {plotrange[[2]]} // Flatten;     boxdat =      DeleteDuplicates@(Join[       Join[Map[{#, yvals // First} &, xvals],         Map[{#, yvals // Last} &, xvals]],        Join[Map[{xvals // First, #} &, yvals],         Map[{xvals // Last, #} &, yvals]]]);     (*------ End of "Bad Codeing!" *)     (*------ Find the points on the quasi-     circular contour that is Nearest to the discrete boundary  *)     circledat = Map[First@finder[#] &, boxdat];     (*------ Start Visualization *)     arrow =      Show[Flatten@      MapThread[       Graphics[{Thickness[.002],           Red, {Arrowheads[.02], Arrow[{#1, #2}]}}] &, {boxdat,         circledat}], Frame -> True];      Pic = Show[{arrow,       ListPlot[{boxdat, circledat[[FindCurvePath[circledat][[1]]]],         circledat}, AspectRatio -> 1, PlotStyle -> Thick,        Frame -> True, Axes -> None, Joined -> {False, True, False}]}];     If[ExtraImage == True, Print[Pic]];     (*------ End Visualization *)     (*------ Find the possible radius *)     r = Median[EuclideanDistance[#, {0., 0.}] & /@ circledat];     {r, Rasterize[     Show[Show[picList, Frame -> True],       ParametricPlot[{r Cos[theta], r Sin[theta]}, {theta, 0., 2 Pi},        Axes -> None, PlotStyle -> {{Thick, Red}}]], RasterSize -> 800]}     ]      **The Output:** Now If we call the above function with following arguments               FinalFit[dat, .85, 100, 21, 200, True]      we get the following results ![enter image description here](http://i.stack.imgur.com/ajxZS.png)   1. In the first pic we can see from the image boundary we detect the points on the outer contour.   2. The second picture draws the circle with a radius that is the median of the norms of the vectors connecting the origin with points forming the target contour. **Proof of Robustness:** ![enter image description here](http://i.stack.imgur.com/7nkne.jpg) **Questiion:** So far my problem is solved but I am sure one can do this probably more efficiently and elegantly. Any idea for betterment will be helpful. On a sleepless night thought to write a elaborate post....Hope I don't overrun your patience for reading it.. BR


How to tell NDSolve about known relations of the exact solution

The solution to this system of differential equations:               NDSolve[{         x''[t] == k[t] y'[t], y''[t] == -k[t] x'[t],          x'[0] == A, y'[0] == 0, x[0] == 0, y[0] == 0},        {x, y}, {t, 0, 10}]      satisfies this equation:               x'[t]^2 + y'[t]^2 == A      But when `NDSolve` solves the system, the speed will eventually move away from it's initial value `A`. Is there anyway to make `NDSolve` keep the speed normalized?


Problem with Union and Intersection

Consider the following:               list={{a,b,c},{c,d,e},{d,e,f},...{x_,y_,z_}};      I would like to apply `Union` on the elements of the list in the following way               Union[{a,b,c},{c,d,e},{d,e,f},...{x_,y_,z_}];      The problem `Union[list]` does not return the desired result when applied on `list`. Please consider the following example:               list={{10,2,3},{2,3,4},{2,3,50}};     Union[list]      The same problem occures with `Intersection`.               (* Out={{10,2,3},{2,3,4},{2,3,50}} *)      Instead of               Union[{10,2,3},{2,3,4},{2,3,50}]     (* Out={2,3,4,10,50} *)


One Integral — Two Results

I compared Mathematica's default integral evaluation to what you get by computing the indefinite integral and then plugging in the limits. (I did this because the latter approach was much faster for some integrals.) I got two different results:               integral=-Log[-a+b+2 a x+2 a Sqrt[(-1+x) x]]+Log[-a+b-2 b x+2 b Sqrt[(-1+x) x]]          integralDefault=Assuming[a>0&&b>0,Integrate[integral,{x,0,1}]]//Timing     (*I Pi/2*)          integralInDef[x]=Assuming[a>0&&b>0,Integrate[integral,x]]//Timing;     integralDef=Assuming[a>0&&b>0,Limit[integralInDef[x][[2]],x->1]-Limit[integralInDef[x][[2]],x->0]]//Timing     (*-I (a^2-8 a b+b^2) Pi/(4 a b)*)      The first result agrees with the numeric value. Is this a known bug?


Expression giving multiple plots of a function, where each plot varies according to the value for a certain parameter

How can I plot multiple plots for M = 10, 20, 50?               f[x_] = Piecewise[{{1, 0 <= x <= 1}, {-1, -1 <= x <= 0}}];          M = 50;          c = Parallelize[        Table[(2*n + 1)/2 Integrate[f[x]*LegendreP[n, x], {x, -1, 1}], {n,           1, M}]];      I would like to plot for each M at once.               Plot[{Sum[c[[n]]*LegendreP[n, x], {n, 1, M}], f[x]}, {x, -1, 1},       PlotStyle -> {{Red}, {Thick, Blue}}, GridLines -> Automatic]      How can I do this?


Why doesn't Mathematica  expand Cos[x]^3 Sin[x]^2?

I found some examples of Mathematica's commands usage in an old manual but the program gives me different result than expected               Expand[Cos[x]^3 Sin[x]^2, Trig -> True]      should give               Cos[x]/8 - Cos[3x]/16 - Cos[5x]/16      but returns an unaltered expression. I tried out `Expand` with `Sin[x+y]` added to the expression, factored that and then I get what I expected in the first place. Why is that? I am surprised because I found that example in a book about Mathematica at my university's library. Although the book is from 1991 I don't think an unaltered expression is what `Expand` should return. Am I wrong?


Intersection of conditions

If I have a list of conditions:               {cond1,cond2,cond3}      and I want to use an `If[]` statement to test the intersection of these conditions (or, more generally, any subset of them, but let's start with the basic case first):               If[cond1&&cond2&&cond3,a,b]      How would I do that?


Coupled ODEs with boundary conditions - DSolve Error

I'm relatively new to mathematica and I can't find the error here. I suspect it has something to do with the fact that vx, vy, vz aren't blue on my mathematica - as in, they already have some assigned values. But I don't know how that would have happened. I get the error "Supplied equations are not differential equations of the given functions." Code:               DSolve[{vx'[t] == (fx*c^2 - vx[t]*(fx*vx[t] + fy*vy[t] + fz*vz[t]))/(m*(c^2*Sqrt[          1 - (vx[t]^2 + vy[t]^2 + vz[t]^2)/c^2] + vx[t]^2 + vy[t]^2 + vz[t]^2)),              vy'[t] == (fy*c^2 - vy[t]*(fx*vx[t] + fy*vy[t] + fz*vz[t]))/(m*(c^2*Sqrt[          1 - (vx[t]^2 + vy[t]^2 + vz[t]^2)/c^2] + vx[t]^2 + vy[t]^2 + vz[t]^2)),              vz'[t] == (fz*c^2 - vz[t]*(fx*vx[t] + fy*vy[t] + fz*vz[t]))/(m*(c^2*Sqrt[          1 - (vx[t]^2 + vy[t]^2 + vz[t]^2)/c^2] + vx[t]^2 + vy[t]^2 + vz[t]^2)), vx[0] == 1, vy[0] == 1, vz[0] == 1}, {vx, vy, vz},t]


solve ODE with divergencies

The solutions of the second order differential equation $$\frac{1}{\eta}\frac{d}{d\eta}\left(\eta \frac{df}{d\eta}\right)+\left(1-\frac{s^2}{\eta^2}\right)f-f^3=0$$ is shown in Fig. 5.2 below, for two different values of $s$. ![solution](http://i.stack.imgur.com/7WP6a.png) The result is taken from the book "Bose-Einstein Condensation", by Pitaevskii&Stringari (2003). As the authors comment, $\lim_{\eta \rightarrow 0} f(\eta) = \eta^{|s|}$, whereas for $\eta \rightarrow \infty$, the limit is 1. This can also be seen from the plot above. The problems arise due to the divergencies at $\eta=0$. The one in the first term is relatively easy to take care of, but I do not know how to get rid of the divergency in the term $\frac{s^2}{\eta^2}$. For the $s=2$ case, where $f$ goes to zero as $\eta^2$, this term has the limit 1: $$\lim_{\eta \rightarrow 0} \frac{4}{\eta^2}f = 4,$$ so I tried to make use of that. Here is what I came up with so far:               ClearAll[f1, f2, f3];     f1[\[Eta]_ /; \[Eta] > 0] = 1.;     f1[\[Eta]_ /; \[Eta] == 0] = 2.;     f2[\[Eta]_ /; \[Eta] > 0] = 1./\[Eta];     f2[\[Eta]_ /; \[Eta] == 0] = 0.;     f3[\[Eta]_ /; \[Eta] > 0] = 4./\[Eta]^2 f[\[Eta]];     f3[\[Eta]_ /; \[Eta] == 0] = 4.;          NDSolve[{f1[\[Eta]] \!\(     \*SubscriptBox[\(\[DifferentialD]\), \(\[Eta], \[Eta]\)]\(f[\[Eta]]\)\     \) + f2[\[Eta]] \!\(     \*SubscriptBox[\(\[DifferentialD]\), \(\[Eta]\)]\(f[\[Eta]]\)\) +      f[\[Eta]] - f3[\[Eta]] - f[\[Eta]]^3 == 0, f[0] == 0, f[10] == 1},     f[\[Eta]], {\[Eta], 0, 10}]      Although this gets rid of the divergencies for the particular case of $s=2$, it results in another series of errors and no result is obtained. Edit: I am particularly interested in the case $s=1$.


ColorFunction in Histogram[]

Let's say I have a `Histogram`:               Histogram[RandomVariate[NormalDistribution[10, 2], 500]]      ![Histogram](http://i.stack.imgur.com/s8zAD.jpg) and I want the bars positioned to the left of 8 on the horizontal axis to be a different colour. The _Mathematica_ documentation shows how to do this for the height of bars, but not for their position:               Histogram[RandomVariate[NormalDistribution[10, 2], 500],       ColorFunction -> (Which[# < 40, Yellow, 40 <= # < 90, Red, True, Blue] &),       ColorFunctionScaling -> False]      ![Histogram2](http://i.stack.imgur.com/bKZPg.jpg) How do I call the positions of the bars from Histogram and put them into my `ColorFunction`?


ListPlot with Joined set to True

Let               f[x_]=9x^2-2x-3;      I want to make a table of `f` at `x ={-1, -0.5, 0, 0.5, 1, 1.5, 2}`. Plot these values with `ListPlot` \+ option `Joined` set to `True` Make a "normal" plot of `f` on the interval [-1, 2] * * *               Table[{f[x]}, {x, -1, 2, 0.5}]          Curves := Riffle[Table[{f[x]}, {x, -1, 2, 0.5}], Table[{f[x]}, {x, -1, 2, 0.5}]]     ListLinePlot[Curves]     Plot[f[x], {x, -1, 2}]      Is this ok for this task? Because i think with `Joined` the points dont get joined but are still separate, but I don't know if that's normal because of `ListPlot`. And with `Plot` I don't think I got the right function, but if I do:               Plot[f[x], {x, -1, 2}]      then I miss the points $-.5, .5, 1.5$. Or shouldn't that be a problem since the question is not that specific? Thanks in advance!


How to express the original ideal elements in the Groebner basis?

Suppose I call               GroebnerBasis[{f1, f2, ...}, {x1,x2, ...}]      The output is a list               {g1,g2,...}      For each $g_j$, there should be an expression $g_j = \sum f_i h_{ij}$ for some polynomials $h_{ij}$. How do I make Mathematica output the $h$'s? * * * In case there is a better approach, I'll tell you my actual goal. I have polynomials $\\{ f_1, f_2, \ldots, \\}$ which generate an ideal $I$, and an element $q$ which I know to be invertible in the quotient ring $\mathbb{R}[x_1, x_2, \ldots]/I$. I want to generate an explicit polynomial representative for $q^{-1}$. My plan is to compute the Groebner basis of the ideal $\langle f_1, f_2, \ldots, q \rangle$, which will be $\\{ 1 \\}$, and find the expression $1 = \sum f_i h_i + pq$; the answer is then $p$. Calling `PolynomialReduce[1,{f1, f2, ..., q}]` does not have the intended effect because `{f1, f2, ..., q}` is not a Groebner basis.


Smooth/histogram a 2D set

I have a 2D dataset like this one: `{{x1,y1}, {x2,y2},...}` I need to smooth/histogram the data in such a way that binning is over the x-coordinate, while counting/height is over the y-coordinate. Let me explain. Given the following input, bin-width=0.2 and height-function=Mean[].               data = {{0.1,1.0}, {0.2,2.0}, {0.3,3.0}, {0.35,3.5}, {0.4,4.0}, {0.5,5.0}};      The output would be:               {(1 + 2)/2, (3 + 3.5 + 4)/3, 5/1}      The average of y-values from the first two data points goes into the first bin, the following three points form the second bin etc...


How to view all graphs available in GraphData?

Is there a "gallery" view of all the graphs available in `GraphData`? I realize that some graphs may not lend themselves to such representation (e.g. some may have so many nodes that their thumbnails would all be unrecognizable, and indistinguishable, dark blobs). But even a gallery limited to those graphs that lend themselves to such representation would be of great help. EDIT: the "gallery" does not need to be represented within Mathematica itself. A web page, PDF document, etc. would do just as well.


Compiling LinearSolve[] or creating a compilable procedural version of it

Earlier today I had a discussion with a representative at Premier Support about the 2 questions I've asked here over the past couple of days:   * Seeking strategies to deploy a function securely without a front-end   * Can on launch a player pro kernel independently of the front front end Neither the conversation nor the answers to the above questions have produced a solution as good as compiling my function to C code. This leaves me with some problems as the function I need to deploy uses 4 high-level Mathematica functions which don't (or maybe don't readily) compile:               CholeskyDecomposition[]     IdentityMatrix[]     LinearSolve[]     Simplify[]      Yesterday I made some progress developing/adapting solutions for procedural versions of `CholeskyDecomposition[]` and `IdentityMatrix[]`, so these at least should compile. Given the anticipated use of my function, maybe I can get away without using `Simplify[]`. This would leave me still needing a procedural equivalent to `LinearSolve[]` or some means of compiling it. Maybe simpler because, I don't need a `myLinearSolve[]` to do everything Mathematica's version does. Interestingly, in my conversation with the guy from support, he suggested that given the limited nature of what I wanted to do, he thought that setting options on `LinearSolve[]` should give me a reduced scope version of `LinearSolve[]` that Mathematica could compile. He couldn't specify which options. So let's explore this. A typical use of `LinearSolve[]` in my current function looks like this:               c = {0.516344, 0.287671, 0.216344, 0.176796, 1};       A = {{0, 1, 1/2, 1/2, 1/2}, {0, 0, Sqrt[3]/2, 1/(2 Sqrt[3]), 1/(2 Sqrt[3])}, {0, 0, 0, Sqrt[2/3], 1/(2 Sqrt[6])}, {0, 0, 0, 0, Sqrt[5/2]/2}, {1, 1, 1, 1, 1}};          LinearSolve[A, c]          {0.173339, 0.206027, 0.187944, 0.209058, 0.223631}      No symbolic processing. No imaginary numbers. No `SparseArray` objects. `A` always a square matrix; `c` always a vector; and its usage always outputs a real vector. **Question 1** \-- Does anyone have any insight into how to set options for the above use of LinearSolve[] so it will compile or if this is even possible? _Note: Oleksandr's answer inWhy is MainEvaluate being used when LinearSolve can be compiled? may have some bearing on this._ ... If no way forward comes from the above, I may still have a chance to implement a limited procedurally based `proceduralLinearSolve[]`. If very distant memory serves me, one can use the inverse of a square matrix for some problems addressable with `LinearSolve[]`. This might give me a more specific way forward except Mathematica's implementation of it, `Inverse[]`, doesn't fall on the list of compilable functions either. I have found some code for calculating the inverse of a square matrix. Not even certain of the language, but I can probably follow its logic and port it to a proceduralInverse[] function in Mathematica. This background takes me to my second question... **Question 2** \-- Does creating a `proceduralLinearSolve[]` or `proceduralInverse[]` seem like a viable way to go (has anyone tried this kind of thing and succeeded) and/or can anyone point me in the direction of resources or solutions that could help me do this?


How to add derivatives to Hermite Interpolation?

I try to use               InterpolatingPolynomial[{f[1]=2,f'[1]=3,f[2]=6, f'[2]=7, f''[2]=8}, Method->"Hermite"]      in WolframAlpha, but it's wrong.


Why do plot functions fail to plot expressions containing piecewise functions?

Why do both of the following plots appear empty in _Mathematica_? I tried evaluating the functions $\chi_+$ and $\chi_-$ at various points and it seems valid, so why does _Mathematica_ not plot them? ![enter image description here](http://i.stack.imgur.com/xbGqn.png)               λ[t_] := 1 + 2 t;     Subscript[t, final] = 2;     τ[u_] := Subscript[t, final] - u;          SubPlus[χ][t_, u_] := Piecewise[{{λ[t], t < τ[u]}, {λ[τ[u]], t > τ[u]}}];     SubMinus[χ][t_, u_] := Piecewise[{{λ[0], t < u}, {λ[t - u], t > u}}];          Plot[SubPlus[χ][t, .4] - SubMinus[χ][t, .4], {t, 0, Subscript[t, final]}]     Plot3D[SubPlus[χ][t, u] - SubMinus[χ][t, u], {t, 0, Subscript[t, final]}, {u, 0, 1}]


Specifying independence of a variable in a function

I am dealing with a function of a finite number of variables and among the operations I wish to do is to differentiate it repeatedly with respect with any of the variables. Now this function happens to be defined in terms of an unknown function, which only depends on a proper subset of the variables. I would like to tell this to Mathematica; i.e., for the purposes of differentiation, the unknown function is independent of a number of the variables. The following minimal example shows what I am trying to do (and failing). Here `f` is supposed to be a function of only `y`, whereas `g` is defined in terms of `f` and is a function of both `x` and `y`.               g = x f + y      (* f x + y *)          f /: D[f, x, NonConstants -> {f}] := 0          D[g, x, NonConstants -> {f}]     (* f *)          D[g, x, y, NonConstants -> {f}]     (* D[f, y, NonConstants -> {f}] *)          D[g, y, x, NonConstants -> {f}]     (* D[f, y, NonConstants -> {f}] + x D[f, x, y, NonConstants  -> {f}] *)      I can assume that f is infinitely continuously differentiable, whence mixed partials commute and hence the second term should be absent. I could try to substitute `In[2]` by a more comprehensive rule which tests whether the variables on which `f` does not depend appear in `v` where `v` is defined by `D[f,v__, NonConstants->{f}]`. However I wonder whether there is perhaps a simpler way to do this. Thanks in advance.


Rationalize the Denominator by Default

In Mathematica 7, if I input Sqrt[2/7], Mathematica outputs $\sqrt{\frac{2}{7}}$, but I want it to output $\frac{\sqrt{14}}{7}$ instead. How do I make Mathematica output values without radicals in the denominator by default? I already tried this solution without success:               rat[p_] := If[FreeQ[Denominator[p], Power[_, Rational[_, _]]], 0, 1]     FullSimplify[Sqrt[2/7], ComplexityFunction -> rat]      I guess I need a better ComplexityFunction, and some way to make it default instead of having to explicitly use FullSimplify every time. edit: It would be great if the solution also worked for more complex expressions. For example: $\frac{1}{\sqrt{2}}\rightarrow\frac{\sqrt{2}}{2}$ and $\frac{1}{5-2\sqrt{3}}\rightarrow\frac{5}{13}+\frac{2\sqrt{3}}{13}$


Guiding Mathematica to perform specific simplifications

I would like _Mathematica_ to cancel out a specific term as much as possible. One of my computations simplify to               ((Pi*((l^2 + m^2 + 1)           * ((l^2 + m^2 + 1) * Derivative[0, 1][w][l, m]^2               + Derivative[1, 0][w][l, m] * ((l^2 + m^2 + 1) * Derivative[1, 0][w][l, m] - 4*m)              + 4*l*Derivative[0, 1][w][l, m])           + 4*(l^2 + m^2)))       / (l^2 + m^2 + 1))      I would like it to eliminate the `l^2 + m^2 + 1` term as much as possible. `Distrubute` goes part of the way:                (4 * (l^2 + m^2) * Pi / (1 + l^2 + m^2)^2        + ((Pi*(4*l*Derivative[0, 1][w][l, m]               + (1 + l^2 + m^2) * Derivative[0, 1][w][l, m]^2               + Derivative[1, 0][w][l, m]                 *(-4*m + (1 + l^2 + m^2)*Derivative[1, 0][w][l, m])))          / (1 + l^2 + m^2)))      Now I would like to cancel out the two occurences in the numerateor of the second term. I have tried various combinations of `Cancel`, `Apart`, `Expand`, `Factor` and `Simplify`, but none of those went in the right direction.


Fitting to a sigmoidal model

I am trying to fit a set of stochastic data to a sigmoidal function, but it's not working. Can you please help? Here is the function I am trying to fit to my data.               1/(Exp[-4*(1 - X1^-1)*t]*(((1 - X1^-1) - z0)/z0) + 1)      and the normalized data is given below.               {{0.000405699, 0.0330812}, {0.000405699, 0.0161187}, {0.0126174,        0.0317448}, {0.0126174, 0.0161246}, {0.024829,        0.0310185}, {0.024829, 0.0161306}, {0.0370407,        0.029316}, {0.0370407, 0.0161366}, {0.0492524,        0.0285898}, {0.0492524, 0.0161425}, {0.061464,        0.0283517}, {0.061464, 0.0161485}, {0.0736757,        0.0286017}, {0.0736757, 0.0170087}, {0.0858874,        0.0300721}, {0.0980991, 0.0327627}, {0.110311, 0.0366737}, {0.12354,        0.0386327}, {0.119469, 0.0296003}, {0.135752,        0.0433674}, {0.132699, 0.0344881}, {0.147408, 0.0454782}, {0.141858,        0.0388857}, {0.160175, 0.050447}, {0.156104, 0.0430418}, {0.170758,        0.0602799}, {0.171369, 0.0468322}, {0.1789, 0.0705345}, {0.182563,        0.0544647}, {0.182563, 0.045056}, {0.187448, 0.0759569}, {0.187651,        0.0659992}, {0.192739, 0.0904569}, {0.195792, 0.0520915}, {0.19681,        0.0752781}, {0.202153, 0.0984058}, {0.203934, 0.084312}, {0.206308,        0.0598579}, {0.209022, 0.105548}, {0.215128, 0.113605}, {0.213092,        0.0935421}, {0.218035, 0.0680014}, {0.22259, 0.121988}, {0.223269,        0.104823}, {0.227339, 0.133787}, {0.228357, 0.0758305}, {0.234317,        0.120936}, {0.229374, 0.111416}, {0.236611, 0.143961}, {0.238024,        0.0842737}, {0.240569, 0.13058}, {0.242604, 0.155232}, {0.249218,        0.164967}, {0.249218, 0.140988}, {0.248913, 0.0921538}, {0.247692,        0.131194}, {0.259349, 0.175277}, {0.258886, 0.15048}, {0.256851,        0.141815}, {0.260107, 0.101004}, {0.265331, 0.159026}, {0.267841,        0.189047}, {0.268045, 0.114272}, {0.271708, 0.203034}, {0.270589,        0.173855}, {0.273133, 0.126447}, {0.276186, 0.214037}, {0.272115,        0.165253}, {0.279849, 0.226541}, {0.279239, 0.139263}, {0.284618,        0.237066}, {0.284327, 0.20199}, {0.280256, 0.183683}, {0.284666,        0.152201}, {0.288107, 0.246377}, {0.28738, 0.211937}, {0.284327,        0.191251}, {0.291111, 0.260081}, {0.291111, 0.226644}, {0.290885,        0.164082}, {0.295521, 0.273995}, {0.296248, 0.239164}, {0.293486,        0.176612}, {0.300609, 0.253252}, {0.294503, 0.214687}, {0.301016,        0.287177}, {0.300609, 0.186552}, {0.304389, 0.297429}, {0.304389,        0.262389}, {0.300609, 0.229333}, {0.30468, 0.195508}, {0.30875,        0.306767}, {0.30875, 0.278801}, {0.30875, 0.267411}, {0.305901,        0.240172}, {0.309913, 0.205071}, {0.312239, 0.314901}, {0.311076,        0.25371}, {0.313839, 0.21494}, {0.315874, 0.329011}, {0.316688,        0.293847}, {0.316891, 0.223337}, {0.320962, 0.280139}, {0.318113,        0.270931}, {0.315874, 0.263754}, {0.320671, 0.344507}, {0.321301,        0.232638}, {0.323902, 0.308666}, {0.325033, 0.359218}, {0.326305,        0.24463}, {0.327831, 0.322701}, {0.327649, 0.293047}, {0.330121,        0.373224}, {0.331138, 0.335809}, {0.327068, 0.282796}, {0.33063,        0.255158}, {0.33487, 0.384941}, {0.334802, 0.343572}, {0.33487,        0.306719}, {0.335209, 0.263763}, {0.338407, 0.397233}, {0.338407,        0.354871}, {0.340443, 0.318408}, {0.340297, 0.274993}, {0.34335,        0.409265}, {0.344028, 0.368065}, {0.344804, 0.329456}, {0.344368,        0.284635}, {0.347014, 0.418994}, {0.349165, 0.382072}, {0.349049,        0.340504}, {0.349456, 0.295865}, {0.351491, 0.429857}, {0.356071,        0.443435}, {0.356071, 0.398863}, {0.351491, 0.388976}, {0.356172,        0.353321}, {0.356172, 0.309975}, {0.358411, 0.454877}, {0.358411,        0.41036}, {0.362798, 0.369538}, {0.360446, 0.325133}, {0.364155,        0.467571}, {0.362889, 0.420759}, {0.365331, 0.335387}, {0.368678,        0.487424}, {0.363703, 0.47831}, {0.367483, 0.439715}, {0.365738,        0.42962}, {0.368995, 0.388912}, {0.36913, 0.378246}, {0.368904,        0.34847}, {0.370623, 0.4994}, {0.371844, 0.453968}, {0.373653,        0.402931}, {0.370826, 0.359332}, {0.37566, 0.370683}, {0.376423,        0.511722}, {0.376932, 0.466235}, {0.379476, 0.410956}, {0.379694,        0.529885}, {0.375915, 0.519319}, {0.380276, 0.479155}, {0.381568,        0.425031}, {0.379985, 0.389722}, {0.375915, 0.380202}, {0.3858,        0.549448}, {0.384056, 0.538726}, {0.3858, 0.497881}, {0.38202,        0.488569}, {0.387109, 0.439954}, {0.386498, 0.403784}, {0.38958,        0.561792}, {0.389754, 0.510832}, {0.392197, 0.451965}, {0.392875,        0.57595}, {0.392197, 0.521523}, {0.393941, 0.463681}, {0.391906,        0.426652}, {0.390161, 0.414378}, {0.394232, 0.585225}, {0.398642,        0.596332}, {0.397963, 0.538244}, {0.394232, 0.528114}, {0.399783,        0.478993}, {0.400338, 0.466613}, {0.396267, 0.439031}, {0.402082,        0.611902}, {0.398303, 0.6028}, {0.402373, 0.556216}, {0.398303,        0.545688}, {0.403391, 0.495316}, {0.401355, 0.453068}, {0.406104,        0.623793}, {0.40814, 0.568879}, {0.409904, 0.509377}, {0.410967,        0.63787}, {0.406444, 0.630627}, {0.410514, 0.580254}, {0.410223,        0.481366}, {0.407122, 0.469301}, {0.414178, 0.523291}, {0.413364,        0.65245}, {0.413364, 0.591678}, {0.414924, 0.49908}, {0.411532,        0.49078}, {0.418655, 0.536546}, {0.418316, 0.663337}, {0.417638,        0.602321}, {0.420284, 0.674419}, {0.422726, 0.547165}, {0.419877,        0.512018}, {0.423404, 0.684939}, {0.422726, 0.622162}, {0.421369,        0.611353}, {0.42447, 0.557626}, {0.424422, 0.525078}, {0.424761,        0.696167}, {0.425779, 0.634297}, {0.428606, 0.569133}, {0.428323,        0.539663}, {0.429849, 0.706908}, {0.429849, 0.643269}, {0.433581,        0.722002}, {0.432563, 0.655778}, {0.433807, 0.586383}, {0.434938,        0.576825}, {0.435277, 0.55974}, {0.431885, 0.547535}, {0.436159,        0.733441}, {0.435955, 0.665054}, {0.43833, 0.598247}, {0.439687,        0.744987}, {0.439415, 0.675892}, {0.436973, 0.569138}, {0.442315,        0.609411}, {0.442061, 0.75292}, {0.442265, 0.684387}, {0.445566,        0.766834}, {0.445405, 0.697798}, {0.445792, 0.624056}, {0.4443,        0.589203}, {0.441043, 0.580122}, {0.450406, 0.782505}, {0.450202,        0.712776}, {0.452803, 0.641795}, {0.448506, 0.60136}, {0.453255,        0.793929}, {0.454476, 0.723346}, {0.456744, 0.651362}, {0.451898,        0.612832}, {0.458489, 0.805123}, {0.457326, 0.734037}, {0.459361,        0.661222}, {0.455697, 0.625379}, {0.463771, 0.744633}, {0.463431,        0.672024}, {0.460379, 0.638707}, {0.465467, 0.81429}, {0.467841,        0.755008}, {0.467095, 0.683667}, {0.465467, 0.650425}, {0.470555,        0.823713}, {0.46852, 0.660311}, {0.474626, 0.690883}, {0.476661,        0.832868}, {0.476254, 0.767727}, {0.47605, 0.704173}, {0.473608,        0.672395}, {0.479714, 0.712668}, {0.476661, 0.680816}, {0.481749,        0.842267}, {0.482767, 0.782716}, {0.487855, 0.71975}, {0.481749,        0.689971}, {0.487855, 0.851862}, {0.487855, 0.794556}, {0.487855,        0.734089}, {0.48582, 0.705349}, {0.492739, 0.742402}, {0.487855,        0.714137}, {0.493961, 0.861506}, {0.494251, 0.806082}, {0.498031,        0.754852}, {0.493961, 0.725122}, {0.501423, 0.874087}, {0.500575,        0.817931}, {0.502509, 0.767447}, {0.505155, 0.829465}, {0.500066,        0.743064}, {0.507868, 0.774796}, {0.509952, 0.885899}, {0.509225,        0.838254}, {0.511057, 0.787514}, {0.506172, 0.757345}, {0.515535,        0.89632}, {0.51567, 0.848142}, {0.517706, 0.798719}, {0.519402,        0.858394}, {0.522047, 0.809778}, {0.523133, 0.90851}, {0.522862,        0.819882}, {0.525762, 0.868648}, {0.529578, 0.830332}, {0.531468,        0.922519}, {0.530596, 0.878754}, {0.534259, 0.838486}, {0.535684,        0.889764}, {0.534666, 0.848151}, {0.537719, 0.932232}, {0.541111,        0.898431}, {0.541111, 0.861089}, {0.543825, 0.941632}, {0.543486,        0.906486}, {0.543825, 0.869755}, {0.550948, 0.951609}, {0.549931,        0.916252}, {0.549931, 0.879276}, {0.553798, 0.888138}, {0.558072,        0.923944}, {0.560107, 0.895146}, {0.561634, 0.959823}, {0.567231,        0.933638}, {0.566213, 0.905765}, {0.570792, 0.968413}, {0.570284,        0.900154}, {0.573744, 0.91685}, {0.577814, 0.941746}, {0.576389,        0.905648}, {0.581704, 0.975819}, {0.582834, 0.924322}, {0.582495,        0.914072}, {0.58894, 0.95005}, {0.589619, 0.934284}, {0.590491,        0.984994}, {0.592332, 0.943364}, {0.590636, 0.922496}, {0.598777,        0.959012}, {0.600958, 0.993262}, {0.600304, 0.934417}, {0.603575,        0.944416}, {0.606919, 0.96851}, {0.610424, 1.00115}, {0.611716,        0.95239}, {0.615399, 0.976161}, {0.612007, 0.944106}, {0.6206,        1.00954}, {0.622387, 0.957803}, {0.624727, 0.983925}, {0.63236,        1.01995}, {0.631487, 0.994114}, {0.631342, 0.967838}, {0.640246,        1.00407}, {0.640161, 0.9778}, {0.643554, 1.02869}, {0.642536,        0.997571}, {0.649223, 1.00981}, {0.651695, 0.985616}, {0.654748,        1.00618}, {0.655765, 1.03427}, {0.660853, 1.01344}, {0.663906,        0.989039}, {0.667977, 1.03818}, {0.672047, 1.01491}, {0.676118,        0.993438}, {0.680189, 1.04225}, {0.685277, 1.02208}, {0.681206,        1.01492}, {0.68833, 0.996983}, {0.6924, 1.04592}, {0.697488,        1.02606}, {0.694436, 1.01883}, {0.700541, 1.00041}, {0.704612,        1.04971}, {0.708682, 1.02323}, {0.711445, 1.0317}, {0.712753,        1.00444}, {0.716824, 1.05399}, {0.723075, 1.03307}, {0.719877,        1.02665}, {0.724965, 1.00896}, {0.729035, 1.0579}, {0.735955,        1.03489}, {0.737176, 1.01238}, {0.741247, 1.06095}, {0.74689,        1.03829}, {0.749388, 1.01739}, {0.753459, 1.06377}, {0.760027,        1.04149}, {0.7616, 1.02138}, {0.76567, 1.06536}, {0.771776,        1.04416}, {0.773811, 1.02666}, {0.777882, 1.06732}, {0.783988,        1.04621}, {0.786023, 1.03246}, {0.790094, 1.06891}, {0.795737,        1.05007}, {0.798235, 1.03784}, {0.802305, 1.07148}, {0.80719,        1.04473}, {0.809138, 1.05608}, {0.814517, 1.07283}, {0.818442,        1.04347}, {0.820962, 1.05819}, {0.822319, 1.04842}, {0.826729,        1.07466}, {0.832834, 1.06405}, {0.833598, 1.05077}, {0.83894,        1.07613}, {0.845046, 1.06222}, {0.845046, 1.05124}, {0.851152,        1.07602}, {0.857258, 1.06414}, {0.856444, 1.05111}, {0.863364,        1.07529}, {0.869469, 1.06407}, {0.869469, 1.04906}, {0.876593,        1.07191}, {0.880954, 1.06055}, {0.881681, 1.04687}, {0.887787,        1.07473}, {0.893893, 1.0592}, {0.893893, 1.04602}, {0.900461,        1.07728}, {0.906104, 1.0592}, {0.906104, 1.04578}, {0.91221,        1.0805}, {0.918316, 1.05836}, {0.918316, 1.04286}, {0.924422,        1.09033}, {0.924422, 1.07483}, {0.930528, 1.058}, {0.930528,        1.04213}, {0.936634, 1.09339}, {0.936634, 1.07228}, {0.943466,        1.06027}, {0.942739, 1.04165}, {0.948845, 1.09364}, {0.949049,        1.06728}, {0.95546, 1.06133}, {0.954951, 1.0408}, {0.961057,        1.09364}, {0.967977, 1.06106}, {0.967163, 1.03873}, {0.973269,        1.09328}, {0.978912, 1.061}, {0.979374, 1.03849}, {0.98548,        1.09329}, {0.989551, 1.05379}, {0.991586, 1.0673}, {0.991586,        1.03801}, {0.997692, 1.09354}, {1.00176, 1.04949}, {1.0038,        1.06865}, {1.0038, 1.03741}, {1.0099, 1.09367}, {1.01397,        1.04381}, {1.01601, 1.07122}, {1.01674, 1.03614}, {1.02212,        1.09233}, {1.02822, 1.07147}, {1.02822, 1.03711}, {1.03433,        1.08965}, {1.04043, 1.0683}, {1.04043, 1.03602}, {1.04654,        1.08697}, {1.05264, 1.06574}, {1.05264, 1.03621}, {1.05875,        1.08283}, {1.06486, 1.06319}, {1.06486, 1.03512}, {1.07096,        1.08064}, {1.07707, 1.05953}, {1.07707, 1.03473}, {1.08317,        1.0765}, {1.08928, 1.05722}, {1.08826, 1.03577}, {1.09437,        1.03264}, {1.09539, 1.07431}, {1.10149, 1.05421}, {1.10556,        1.03249}, {1.1076, 1.07151}, {1.1137, 1.05125}, {1.11777,        1.0335}, {1.11981, 1.06846}, {1.12591, 1.04784}, {1.131,        1.04156}, {1.12999, 1.02665}, {1.13202, 1.067}, {1.14118,        1.04352}, {1.1422, 1.022}, {1.14423, 1.06481}, {1.15543,        1.04454}, {1.15441, 1.01796}, {1.15644, 1.06372}, {1.16662,        1.04597}, {1.16662, 1.01284}, {1.16866, 1.06177}, {1.17849,        1.05519}, {1.17883, 1.0392}, {1.17883, 1.00869}, {1.19104,        1.05483}, {1.19104, 1.03689}, {1.19104, 1.00382}, {1.20398,        1.05795}, {1.20326, 1.0347}, {1.20326, 0.998943}, {1.215,        1.05836}, {1.21547, 1.03361}, {1.21547, 0.994922}, {1.22611,        1.0551}, {1.22768, 1.03142}, {1.22768, 0.989192}, {1.23785,        1.05924}, {1.23785, 1.04582}, {1.23989, 1.02861}, {1.23989,        0.983463}, {1.25007, 1.05742}, {1.25007, 1.04066}, {1.2521,        1.02728}, {1.2521, 0.978709}, {1.26228, 1.05523}, {1.26228,        1.03453}, {1.26504, 1.02731}, {1.26431, 0.972858}, {1.27449,        1.05304}, {1.27673, 1.02893}, {1.27551, 1.02259}, {1.27653,        0.968096}, {1.2867, 1.05097}, {1.28874, 1.0225}, {1.28874,        0.962485}, {1.29891, 1.04902}, {1.30138, 1.0185}, {1.30095,        0.956889}, {1.31112, 1.04659}, {1.31214, 1.01571}, {1.31316,        0.95299}, {1.32334, 1.04379}, {1.32639, 1.01392}, {1.32537,        0.951166}, {1.33555, 1.0416}, {1.33758, 1.01207}, {1.33758,        0.948975}, {1.34776, 1.03831}, {1.34903, 1.01476}, {1.3498,        0.947761}, {1.35244, 1.00636}, {1.35997, 1.0349}, {1.36201,        1.01903}, {1.36201, 0.945814}, {1.36404, 1.0028}, {1.37218,        1.03271}, {1.37422, 1.02026}, {1.37422, 0.943746}, {1.37625,        0.99919}, {1.38439, 1.02717}, {1.38716, 1.02147}, {1.38643,        0.941555}, {1.38847, 0.995494}, {1.39864, 1.02446}, {1.39864,        0.940097}, {1.40068, 0.992571}, {1.41158, 1.02355}, {1.41085,        0.93937}, {1.41289, 0.991723}, {1.42307, 1.02294}, {1.42307,        0.938522}, {1.4251, 0.99356}, {1.43528, 1.02883}, {1.43528,        1.01809}, {1.43528, 0.93682}, {1.43731, 0.99503}, {1.44749,        1.03213}, {1.44749, 1.01639}, {1.44749, 0.935239}, {1.44952,        0.995768}, {1.4597, 1.03397}, {1.4597, 1.01347}, {1.4597,        0.935001}, {1.46174, 0.997727}, {1.47191, 1.03568}, {1.47191,        1.01201}, {1.47191, 0.934397}, {1.47395, 0.998953}, {1.48412,        1.03874}, {1.48412, 1.00933}, {1.48412, 0.933549}, {1.48616,        1.00042}, {1.49634, 1.04045}, {1.4968, 1.00444}, {1.49634,        0.932212}, {1.50855, 1.03708}, {1.50855, 1.00462}, {1.50855,        0.930998}, {1.52076, 1.03034}, {1.52076, 1.00288}, {1.52076,        0.928197}, {1.53297, 1.024}, {1.53297, 1.00215}, {1.53297,        0.92564}, {1.54518, 1.01766}, {1.546, 0.999476}, {1.54518,        0.923572}, {1.55739, 1.01083}, {1.55638, 1.00038}, {1.55739,        0.920771}, {1.5619, 0.995405}, {1.56961, 1.00522}, {1.56961,        0.917482}, {1.57368, 0.994242}, {1.58182, 1.00335}, {1.58182,        0.91578}, {1.58661, 0.990605}, {1.59403, 1.00475}, {1.59403,        0.913345}, {1.5981, 0.990466}, {1.60353, 0.988277}, {1.60624,        1.00671}, {1.60624, 0.913717}, {1.61382, 0.993538}, {1.61866,        1.00361}, {1.61845, 0.983891}, {1.61845, 0.915309}, {1.62645,        0.999515}, {1.63066, 0.980969}, {1.63066, 0.916536}, {1.6327,        1.00528}, {1.64288, 0.978534}, {1.64288, 0.917518}, {1.64491,        1.00597}, {1.65509, 0.975489}, {1.65509, 0.918988}, {1.65794,        1.00795}, {1.6673, 0.97281}, {1.6673, 0.921679}, {1.66933,        1.00918}, {1.67951, 0.970742}, {1.67951, 0.922295}, {1.68155,        1.01773}, {1.68155, 1.00638}, {1.69172, 0.968429}, {1.69172,        0.922545}, {1.69376, 1.01859}, {1.69376, 1.00699}, {1.70393,        0.968435}, {1.70393, 0.91767}, {1.70597, 1.01688}, {1.70597,        1.00663}, {1.71615, 0.967831}, {1.71615, 0.91316}, {1.71716,        1.01048}, {1.7253, 1.00803}, {1.72836, 0.966617}, {1.72836,        0.908407}, {1.73604, 1.00869}, {1.7365, 0.890961}, {1.74057,        0.965402}, {1.74057, 0.903654}, {1.74871, 1.00839}, {1.74944,        0.89278}, {1.75278, 0.965164}, {1.75258, 0.898681}, {1.76165,        1.00565}, {1.76092, 0.89204}, {1.76499, 0.964682}, {1.77313,        1.00813}, {1.77313, 1.00093}, {1.77313, 0.89193}, {1.7772,        0.964444}, {1.78377, 0.888352}, {1.78534, 1.00325}, {1.78942,        0.96384}, {1.7945, 0.890655}, {1.79756, 1.00283}, {1.80163,        0.961771}, {1.80773, 0.894095}, {1.80977, 1.00286}, {1.81384,        0.959092}, {1.81893, 0.901496}, {1.82198, 1.00254}, {1.82198,        0.891429}, {1.82605, 0.956536}, {1.83216, 0.909922}, {1.83419,        1.00175}, {1.83826, 0.954589}, {1.83826, 0.891254}, {1.84509,        0.916396}, {1.8464, 1.00094}, {1.85047, 0.95191}, {1.85658,        0.923236}, {1.85943, 0.998062}, {1.86269, 0.94972}, {1.86879,        0.929648}, {1.87083, 0.996694}, {1.8749, 0.947895}, {1.881,        0.93423}, {1.88304, 0.998591}, {1.88711, 0.947047}, {1.89321,        0.935457}, {1.89525, 1.00297}, {1.89525, 0.995254}, {1.89932,        0.947907}, {1.90543, 0.935951}, {1.90746, 1.00036}, {1.91153,        0.948401}, {1.91764, 0.935957}, {1.91967, 1.00808}, {1.91967,        0.99795}, {1.92374, 0.948407}, {1.92985, 0.936451}, {1.93188,        1.00943}, {1.93188, 0.999176}, {1.93596, 0.949145}, {1.94206,        0.937067}, {1.9441, 1.01151}, {1.9441, 1.00016}, {1.94817,        0.950249}, {1.95427, 0.937683}, {1.95631, 1.01286}, {1.95631,        1.00102}, {1.96038, 0.951842}, {1.96648, 0.937201}, {1.96852,        1.0142}, {1.96852, 1.0031}, {1.97259, 0.952092}, {1.9787,        0.934461}, {1.98073, 1.01319}, {1.98073, 1.00408}, {1.9848,        0.952708}, {1.99091, 0.928549}, {1.99294, 1.00781}, {1.99701,        0.955033}, {2.00312, 0.920867}, {2.00515, 1.01148}, {2.0021,        1.00556}, {2.00923, 0.956137}, {2.01519, 0.912679}, {2.01737,        1.0098}, {2.02144, 0.957729}, {2.02754, 0.905746}, {2.03004,        1.00877}, {2.03365, 0.960176}, {2.03961, 0.897524}, {2.04179,        1.00799}, {2.04586, 0.961524}, {2.04993, 0.890931}, {2.054,        1.01522}, {2.054, 1.00265}, {2.05807, 0.963605}, {2.06214,        0.884859}, {2.06621, 1.01718}, {2.06621, 1.00156}, {2.07028,        0.964587}, {2.07537, 0.883479}, {2.07842, 1.01706}, {2.07842,        1.0045}, {2.0825, 0.964349}, {2.0861, 0.892746}, {2.09064,        1.01307}, {2.08555, 1.00706}, {2.09471, 0.963501}, {2.09623,        0.903736}, {2.10285, 1.01814}, {2.10299, 0.912303}, {2.10692,        0.961798}, {2.11099, 0.920858}, {2.11587, 1.02337}, {2.11099,        1.01732}, {2.11913, 0.96095}, {2.12117, 0.929979}, {2.12625,        1.03009}, {2.12727, 1.01855}, {2.13134, 0.959491}, {2.13032,        0.941204}, {2.13602, 1.03895}, {2.13948, 1.01856}, {2.13948,        0.950587}, {2.14457, 0.96023}, {2.14762, 1.04556}, {2.15169,        1.01917}, {2.15577, 0.968187}, {2.15577, 0.956819}, {2.16034,        1.05191}, {2.16391, 1.01881}, {2.16543, 0.97827}, {2.16798,        0.956214}, {2.17205, 1.05233}, {2.17612, 1.01821}, {2.17815,        0.981846}, {2.18019, 0.953047}, {2.18426, 1.04604}, {2.18833,        1.01724}, {2.19036, 0.98112}, {2.1924, 0.94866}, {2.19647,        1.03799}, {2.20258, 1.03161}, {2.20054, 1.01676}, {2.20258,        0.980028}, {2.20461, 0.944883}, {2.21203, 1.02712}, {2.21275,        1.01518}, {2.21479, 0.979545}, {2.21682, 0.94074}, {2.22496,        1.02116}, {2.22496, 1.01287}, {2.227, 0.978819}, {2.22904,        0.936841}, {2.23616, 1.01446}, {2.23785, 1.00872}, {2.23921,        0.978093}, {2.24125, 0.932454}, {2.24939, 1.0108}, {2.24939,        1.00275}, {2.25142, 0.978221}, {2.25346, 0.928555}, {2.2616,        1.0102}, {2.2616, 0.999093}, {2.26364, 0.977251}, {2.26567,        0.927951}, {2.27381, 1.01228}, {2.27381, 1.00142}, {2.27585,        0.976768}, {2.27788, 0.931617}, {2.28649, 1.01055}, {2.28093,        1.00423}, {2.28806, 0.97531}, {2.29009, 0.93443}, {2.2987,        1.01402}, {2.29315, 1.00765}, {2.30027, 0.97434}, {2.30231,        0.939195}, {2.31045, 1.01663}, {2.31248, 0.97398}, {2.31452,        0.94213}, {2.32368, 1.02288}, {2.31961, 1.01596}, {2.32469,        0.973253}, {2.32673, 0.946529}, {2.33406, 1.0238}, {2.33691,        0.972039}, {2.33894, 0.94983}, {2.34708, 1.02737}, {2.34912,        0.970703}, {2.35115, 0.953619}, {2.35976, 1.03056}, {2.36133,        0.970586}, {2.36336, 0.955944}, {2.3715, 1.03612}, {2.3715,        1.02795}, {2.37354, 0.96925}, {2.37558, 0.95595}, {2.38372,        1.04028}, {2.38372, 1.02637}, {2.38575, 0.96767}, {2.38779,        0.956078}, {2.39593, 1.04358}, {2.39593, 1.02479}, {2.39796,        0.965601}, {2.4, 0.957182}, {2.40814, 1.04737}, {2.40814,        1.02198}, {2.40967, 0.962007}, {2.4173, 0.958655}, {2.42035,        1.05079}, {2.42035, 1.0204}, {2.42849, 0.959856}, {2.43256,        1.05299}, {2.43256, 1.01834}, {2.43969, 0.960455}, {2.4407,        1.0541}, {2.44477, 1.01737}, {2.45393, 0.958298}, {2.45699,        1.01871}, {2.46309, 1.05431}, {2.46469, 0.961767}, {2.46574,        0.95182}, {2.4692, 1.02104}, {2.4753, 1.05155}, {2.47734,        0.964542}, {2.47734, 0.946298}, {2.48141, 1.02538}, {2.48752,        1.04659}, {2.48752, 0.939652}, {2.48955, 0.965402}, {2.49362,        1.02874}, {2.49973, 1.04216}, {2.499, 0.933591}, {2.50176,        0.968336}, {2.50656, 1.03363}, {2.51214, 1.03875}, {2.51194,        0.927461}, {2.51397, 0.970051}, {2.51988, 1.0329}, {2.52435,        1.04008}, {2.52415, 0.921121}, {2.52619, 0.971399}, {2.53026,        1.02961}, {2.53636, 1.04365}, {2.53636, 0.914537}, {2.5384,        0.973114}, {2.54247, 1.02693}, {2.54857, 1.04731}, {2.54857,        0.910394}, {2.55061, 0.972265}, {2.55468, 1.02791}, {2.56079,        1.05061}, {2.56079, 0.910888}, {2.56282, 0.969709}, {2.56689,        1.03207}, {2.573, 1.05331}, {2.573, 0.913213}, {2.57503,        0.965565}, {2.5791, 1.03651}, {2.58521, 1.05711}, {2.58521,        0.916025}, {2.58724, 0.962399}, {2.59131, 1.04197}, {2.59742,        1.05954}, {2.59742, 0.91774}, {2.59946, 0.958866}, {2.60353,        1.04624}, {2.60963, 1.06248}, {2.60963, 0.920919}, {2.61167,        0.955455}, {2.61574, 1.05113}, {2.62184, 1.06553}, {2.62184,        0.923243}, {2.62388, 0.952044}, {2.62795, 1.05669}, {2.62999,        0.910068}, {2.63449, 1.06565}, {2.63406, 0.925812}, {2.63609,        0.949365}, {2.64077, 1.05946}, {2.6422, 0.91105}, {2.64627,        1.06689}, {2.64627, 0.927282}, {2.6483, 0.948151}, {2.65339,        1.06064}, {2.65441, 0.91069}, {2.65848, 0.927532}, {2.66051,        0.948767}, {2.66458, 1.06232}, {2.66502, 1.05261}, {2.67069,        0.927538}, {2.67273, 0.949383}, {2.6768, 1.05836}, {2.6768,        1.0485}, {2.6829, 0.927544}, {2.68494, 0.951341}, {2.68901,        1.05523}, {2.68901, 1.04311}, {2.69511, 0.92755}, {2.69715,        0.952446}, {2.70122, 1.05142}, {2.70122, 1.03836}, {2.70733,        0.927556}, {2.70936, 0.952452}, {2.71343, 1.04752}, {2.71343,        1.03352}, {2.71954, 0.927562}, {2.72157, 0.953922}, {2.72564,        1.04362}, {2.72564, 1.02824}, {2.73175, 0.927324}, {2.73378,        0.955514}, {2.73785, 1.04033}, {2.73785, 1.02605}, {2.74396,        0.926842}, {2.746, 0.957107}, {2.75007, 1.03643}, {2.75007,        1.02813}, {2.75617, 0.926604}, {2.75821, 0.959553}, {2.76155,        1.03497}, {2.76838, 0.925389}, {2.77042, 0.962}, {2.77403,        1.03735}, {2.7806, 0.924541}, {2.78263, 0.964446}, {2.78467,        1.02973}, {2.7867, 1.04645}, {2.79281, 0.922838}, {2.79484,        0.967015}, {2.79688, 1.02803}, {2.79891, 1.05195}, {2.80502,        0.922844}, {2.80705, 0.969584}, {2.80909, 1.02609}, {2.81112,        1.05788}, {2.81723, 0.922484}, {2.81927, 0.97142}, {2.8213,        1.02316}, {2.82232, 1.06043}, {2.82944, 0.922978}, {2.83148,        0.973745}, {2.83351, 1.02146}, {2.84216, 0.927988}, {2.84369,        0.974849}, {2.84572, 1.02293}, {2.85183, 1.06076}, {2.85387,        0.935663}, {2.8559, 0.974977}, {2.85794, 1.02538}, {2.86201,        0.943941}, {2.86404, 1.05894}, {2.86811, 0.974617}, {2.87015,        1.02673}, {2.87396, 0.95255}, {2.87625, 1.05663}, {2.88032,        0.974086}, {2.88236, 1.0282}, {2.88599, 0.962056}, {2.88847,        1.05297}, {2.89355, 0.970521}, {2.89457, 1.02942}, {2.90068,        1.0509}, {2.90475, 0.975916}, {2.90678, 1.03138}, {2.91289,        1.04725}, {2.91798, 0.987955}, {2.91696, 0.975348}, {2.91899,        1.03456}, {2.9251, 1.04469}, {2.92917, 0.995636}, {2.92917,        0.974525}, {2.93121, 1.03457}, {2.93731, 1.04592}, {2.94138,        0.999547}, {2.93935, 0.975262}, {2.94342, 1.03494}, {2.94952,        1.04897}, {2.95258, 1.00031}, {2.95563, 1.03677}, {2.95868,        1.05118}, {2.96784, 0.997608}, {2.96886, 0.988456}}


Custom display format for custom operator

I've tried searching here and in the WRI documentation, but I haven't found what I'm looking for in either place. I'm defining a `dx` operator to act as a shorthand for `D[#,x]`, based on this question. In my case, I want _Mathematica_ to produce an output form with the text `d/dx` _expression_ `= [...]`, where by `[...]` I mean the actual symbolic meaning of my `dx` operator (i.e., `D[#, x]`). I have tried this:               Format[dx[a_] := "\!\(\*FractionBox[\(d\), \(dx\)]\)"  a  "="  D[a, x]]      I've also tried               Format[dx[#], TraditionalForm] :=        DisplayForm[         RowBox[{FractionBox["\DifferentialD]", "\[DifferentialD]x"],         #, "=", D[#, x]}]];      and various other similar things, none of which produce the correct expression. I would appreciate help with getting this right.


Plotting 3D piecewise function with distinct colors

I want to draw the following picture in Mathematica as shown below with distinct color for each section. ![enter image description here](http://i.stack.imgur.com/Bwawn.png)


How do I draw multiple 3D shapes defined by lists of points?

I'm attempting to draw $N$ cones on a 3D object, where each cone is specified by a pair of 3D coordinates. The first coordinate is for the cone's base, the second one for the cone's apex. Here, I have two lists - ConeBases and ConeVertices - where cone $k$ is specified by the pair of coordinates at the $k$th positions of the ConeBases and ConeVertices lists (i.e. ConeBases[[k]] and ConeVertices[[k]]). To specify a single cone of base radius (ConeRadius = 1), we can write:               ConeRadius=1;     Graphics3D[Cone[{{0, 0, 0}, {0, 0, 1}}, ConeRadius]]        However, how could I automatically generate the $N$ cones using my lists of base and apex coordinates? What if I also had a list of base radii for the cones? The naive solution here, which is what I've been doing, is to generate a string individually specifying each cone. Is there a better way to proceed?


How to access graphics from .Net in mathematica?

I would like to use Wolfram.NETLink.MathKernel.Graphics to Retrieve an image generated from a Mathematica command. Which Mathematica command do I use to do this. **EDIT:**               using System;     using System.Collections.Generic;     using System.ComponentModel;     using System.Data;     using System.Drawing;     using System.Linq;     using System.Text;     using System.Threading.Tasks;     using System.Windows.Forms;     using Wolfram.NETLink;     using System.IO;          namespace WindowsFormsApplication1     {     public partial class Form1 : Form     {         public Form1()         {             InitializeComponent();         }              private void button1_Click(object sender, EventArgs e)         {             /*             MathKernel kernel = new MathKernel();             kernel.Compute("ExportString[Graphics[Rectangle[]],{\"Base64\",\"EMF\"}]");             byte[] decodedBytes = Convert.FromBase64String(kernel.Result.ToString());             File.WriteAllBytes("C:\\temp\\output.emf", decodedBytes);             */             MathKernel k = new MathKernel();             k.CaptureGraphics = true;             k.GraphicsFormat = "GIF";             k.Compute("Show[Graphics[Rectangle[]]]");             k.Graphics[0].Save("C:\\temp\\file.gif", System.Drawing.Imaging.ImageFormat.Gif);              }     }     }


Image analysis for extracting lines between cells

I have a `2D` image as shown here and need to extract the spatial information about the curves in between each cell division. I have been able to analyze the image and output $\;(x,y)\;$ coordinates where the brightest values `(1.0)` are located in the grid of pixels. How might I be able to process the image to remove noise (inside the cells) leaving only the lines describing the cell outlines? ![enter image description here](http://i.stack.imgur.com/IyUPZ.jpg)


Replace parameter of NDSolve by a Function

I dont know how to replace the paremeter inside of an interpolation function result from `NDSolve` by a function of another parameter. This is it: I have a function `h[r_,f1[k],f2[k],f3[k],k]:=` defined. Then using `NDSolve like here               sol = NDSolve[ k D[ f1[k], k] == F[ f2[k], f3[k]],                    k D[ f2[k], k] == F[ f1[k], f3[k]],                    k D[ f3[k], k] == F[ f1[k], f2[k]],                     f1[1] == 1, f2[1] == 1, f3[1] == 1,                     { f1[k], f2[k], f3[k]}, { k, kmin, kmax}];      After this, I have a function defined by               k[r] = Interpolation[ Table[{ r, NIntegrate[ g[R], { R, 0, r}]},                                 { r, rmin, rmax, rstep}]];      If I do the plot of `k[r]` I dont have any problem, the same for the plot for the solution of `NDSolve`.               Plot[{ Evaluate[ f1[k] /. sol]}, { k, kmin, kmax}]      That I want its the next, replace the solution for the `NDSolve` in the original function `h[ r, ...]` and the function `k[r]` inside the interpotation function of the NDSolve, someting like this               Plot[ h[ r, Evaluate[ Evaluate[ f1[k] /. sol]/. k -> k[r]]],            k[r], Evaluate[ Evaluate[ f2[k] /. sol]/. k -> k[r]],            Evaluate[ Evaluate[ f3[k] /. sol]/. k -> k[r]]], { r, rmin, rmax}]      But this doesn´t yield any result, the graphic is empty. Any ideas?


Problem in simulating discrete time stochastic

I have been playing with some stochastic questions and specially the problem here.It seems no matter for the first time in bet, gambler is going to lose the first bet.Am I right?How can we correct the algorithm here?               timstep = 5;     win = BinomialProcess[.99];     samplepaths = 1;     process = RandomFunction[Evaluate[win], {0, timstep - 1}, samplepaths];     ListLinePlot[process, Frame -> False,      AxesLabel -> {Style["Time Step", Bold], Style["Number", Bold]},      PlotStyle -> {{Dashed, Black, Opacity[.9]}}, ImageSize -> 600]          x1 = 100;     alpha = 0.5;(*assume some value for alpha*)WinEvents =      process["States"];     ST[WinEvents_?ListQ, x1_, alpha_, SimTime_] :=      Module[{},      FoldList[Max[If[#2 == 1, (1 + alpha) #1, (1 - alpha) #1], 0.] &,      x1, Prepend[Differences@WinEvents, First@WinEvents]]];     simdat = ST[#, x1, alpha, timstep] & /@ WinEvents; Show[     ListLinePlot[Legended[Mean[simdat], ""], PlotRange -> All,      PlotStyle -> {{AbsoluteThickness[3.5], Opacity[.9], Red}},      ImageSize -> 600],      ListLinePlot[simdat, PlotRange -> All,      PlotStyle -> {{Dashed, Black, Opacity[.7]}}],      ListPlot[simdat, PlotRange -> All], Frame -> True]      ![enter image description here](http://i.stack.imgur.com/ZN71z.jpg) ![enter image description here](http://i.stack.imgur.com/KFKOH.jpg)


Evaluate Numerator and Denominator Separately

I have this function.               SetAttributes[zf,HoldAllComplete];     zf[x_] :=        If[Denominator[Unevaluated[x]] == 0,          Numerator[Unevaluated[x]],          Numerator[Unevaluated[x]]];      It is supposed to just return the numerator anytime the denominator is 0.               zf[1/0]      > 1               Cos[-(3*Pi)/2]      > 0               zf[1/Cos[-(3*Pi)/2]]      > ComplexInfinity It works fine when the denominator is literally 0, but it fails when there are functions/variables, such as when `Cos[x] == 0`. How would I go about evaluating the denominator separately, then if that equals zero, drop the denominator, and evaluate the numerator only without evaluating the entire fraction? Basically my question is how do I make `zf[1/Cos[-(3*Pi)/2]]` output `1`?


Unable to import functions from external file

I'm fairly new to Mathematica but I'm in the process of setting up some basic analysis based off someone else's work. They had a number of shared functions stored in a shared code directory and were using `Get` to import them; however, their code was stored in `.txt` files. I'd like to replicate that setup but use `.m` files instead to take advantage of Mathematica formatting / debugging, but when I try to import the code from my files the function definitions don't seem to come through. `Get` isn't returning any errors, but my functions seems to remain undefined (e.g. name in blue, returned as symbolic). Any help would be greatly appreciated, thanks!


How to put a list of values on a single axis and add custom labels

I have a table in the following format: Apple 2 Pear 3 Banana 5 Orange 6.5 .... I would like to put the values on a single horizontal axis and add corresponding descriptive labels (apple, pear, banana etc.) next to the values. How can I do that in Mathematica? Many thanks!


In FinancialData what is the difference between FractionalChange and Change?

In `FinancialData` there are two similarly named properties one can request for a given stock symbol: `Change` and `FractionalChange`. What is the difference between these two properties?


NonlinearModelFit returning nonsense for very simple data

In fitting the following data, if I first log transform the y-values and use `LinearModelFit` I get a set of parameters that fits the data:               data = {{248, 0.032}, {280, 0.0498}, {327, 0.0971}, {360, 0.162}};     loggedData = ReplaceList[data, {__, {x_Integer, y_Real}, ___} -> {x, Log[y]}];     linFit = LinearModelFit[loggedData, t, t];          linFit["BestFitParameters"]          {-7.03516, 0.0144417}      However, if I instead use `NonlinearModelFit` on the data directly (not log transformed), I get nonsense               data = {{248, 0.032}, {280, 0.0498}, {327, 0.0971}, {360, 0.162}};     NonlinearModelFit[data, a Exp[b t], {a, b}, t]["BestFitParameters"]           {a -> 0., b -> 1.}         Have I found the one set of points that `NonlinearModelFit` cannot handle? It seems that any other exponential data I feed in can be fit just fine by `NonlinearModelFit`. Are there any additional directives I can give to `NonlinearModelFit` to get a sensible result?


OpenCLLink eating up all host memory

I am calling lots of OpenCL functions from Mathematica. The problem is that the memory the kernel uses grows and grows until the RAM is fully occupied. I have created a small piece of code to demonstrate the behaviour.               Needs["OpenCLLink`"];     openclPlatform = 1; openclDevice = 1;          For[i = 0, i < 1000, i++,      OpenCLMersenneTwister[1, Platform -> openclPlatform,         Device -> openclDevice];       ]      (OpenCLMersenneTwister is a predefined function by Mathematica) When running that piece of code multiple times I can see that the RAM usage of MathKernel.exe grows and no memory is freed. Is it a bug in Mathematica or is my code wrong? Thanks


Add Point to Plot3D

I'd like to simply add a nice thick point in $(0,0,0)$ to `Plot3D[(y^2/x), {x, -3, 3}, {y, -3, 3}]`. The solutions I came across to add anything to `Plot3D`, mostly involved MeshFunctions. However I don't see how I could manipulate the mesh to give the desired result. Any help would be appreciated.


How to calculate number of cards' permutations in card game

I have trick taking based card game with 32 cards. Initially each player has 8 cards. After each trick number of cards in all players' hands are decreasing by one. I'm writing an AI Bot which knows only its own cards (8 cards), so 24 are unknown in its point of view. When it searches for a best move/card to play it iterates 4000 times (hard-coded number) using Monte Carlo Tree Search, and on each iteration it assigns a permutation of cards for the other 3 players (thus, I have a game with perfect information for a current iteration). For example if P0 is Bot player, and P1, P2, P3 are the other players, then here is number of cards distribution (after every trick):               ------------------------------------ P1 ---- P2 ---- P3 ---- NC ------     Searching a best move for Trick 1:    8       8       8 ---> 24 cards     Searching a best move for Trick 2:    7       7       7 ---> 21 cards     Searching a best move for Trick 3:    6       6       6 ---> 18 cards     ....     ....     Searching a best move for Trick 8:    1       1       1 ---> 3 cards      How to calculate number available cards permutations in order to avoid hard- coded iterations, because on Trick 8 there is only one permutation of 3 cards but algorithm still iterates 4000 times. I know permutations are calculates as factorial, but the problem is more complicated because of fact that each permutation is divided on 3 groups (3 players), and cards' permutations in each player's hand must be ignored. Examples of card distribution on Trick 6:               1)     Trick 6: --- P1 ---- P2 ---- P3                 1 2 3    3 4 5   6 7 8           2)      Trick 6: --- P1 ---- P2 ---- P3                 2 1 3    3 4 5   8 7 6           3)     Trick 6: --- P1 ---- P2 ---- P3                 1 3 2    3 5 4   6 7 8      1), 2) and 3) should be counted as one permutation.


How to use a 3×3 covariance matrix to plot an error ellipsoid?

I have a 3×3 error covariance in _Mathematica_ , but I don't know how to use it for plotting the error ellipsoid. It would be great if you can show me how I can do that for the below covariance matrix:               CovMat= {{88.5333, -33.6, -5.33333},               {-33.6, 15.4424, 2.66667},               {-5.33333, 2.66667, 0.484848}}          eigenvalues= {0.0098, 0.4046, 104.7}          eigenvectors= {{0.93, 0.36, -0.03}, {-0.36, 0.9, -0.23}, {-0.06, 0.23, 0.97}}      And as the last question, how can I project this ellipsoid onto 2D planes?


Experimental`NumericalFunction in NMinimize solution

I try to make a number of optimizations using this code:               Gmin = 0.3;     Gmax = 3;     Gd = 0.3;     Tmin = 3;     Tmax = 30;     Td = 3;     Vmin = 150;     Vmax = 1500;     Vd = 150;     sols = Flatten[       ParallelTable[{Gcur, Tcur, Vcur,          Quiet[NMinimize[{Abs[x1] + Abs[x2] + Abs[x3] + Abs[x4] + Abs[x5],              Abs[0.055*(x1 + 11) + 0.065*(x2 - 13) + 0.068*(x3 - 47) +                  0.071*(x4 - 50) + 0.07*(x5 - 43) + 0.852] <= Gcur &&               Abs[-8.567*(x1 + 11) - 9.057*(x2 - 13) - 9.154*(x3 - 47) -                  8.937*(x4 - 50) - 8.608*(x5 - 43) - 1359.469] <= Tcur &&               Abs[55.818*(x1 + 11) + 62.22*(x2 - 13) + 64.286*(x3 - 47) +                  64.945*(x4 - 50) + 63.306*(x5 - 43) + 4747.69] <=                Vcur}, {x1, x2, x3, x4, x5}(*,             Method->"DifferentialEvolution"*)]][[1]]}        , {Gcur, Gmin, Gmax, Gd}, {Tcur, Tmin, Tmax, Td}, {Vcur, Vmin,          Vmax, Vd}        ], 2]      As a result i have a nested list of solutions:               {{0.3, 3, 150, 1355.75}, {0.3, 3, 300, 1330.44}, ...}      Most of solutions are normal, but some look like:               {0.3,9,900,Experimental`NumericalFunction[{Hold[Abs[-599.245]+Abs[-142.174]+Abs[1.74305]+Abs[307.535]+Abs[415.575]],Block},{0,{{1,0,Hold[-599.245],0,0},{1,1,Hold[-142.174],0,0},{1,2,Hold[1.74305],0,0},{1,3,Hold[307.535],0,0},{1,4,Hold[415.575],0,0}}},{{{1,5,817},{{Automatic,Automatic,None,1,Automatic},{Automatic,Automatic,None,1,Automatic}}}},{0,3,0},{908,MachinePrecision,{{Automatic},{Hold[Abs[-599.245]+Abs[-142.174]+Abs[1.74305]+Abs[307.535]+Abs[415.575]],Block}},True,{{Automatic,CleanUpRegisters->False,WarningMessages->False,EvaluateSymbolically->False,RuntimeErrorHandler->($Failed&)},Automatic,MVM},Experimental`NumericalFunction,Automatic,None},{None,None,None}]}      What does it all mean? How can i avoid this? Thanks.


Time range selector à la InteractiveTradingChart

I have time series data and I would like to interactively select a part of it. This problem is beautifully solved in the lower part of the InteractiveTradingChart command: ![enter image description here](http://i.stack.imgur.com/55MFh.png) I would like to be able to do the same for my own data. Before I reinvent the wheel I would like to know if this is already available somewhere. In case I do have to reinvent it, this is what I have already done:               data=Map[{#,RandomChoice[{.75,.15,.05,.04,.01}->{0,1,2,3,5}]}&,DateRange[{2013,1,1},{2013,12,31}]];          g=DateListPlot[data,Joined->True,Filling->Bottom,AspectRatio->1/10,Frame->None,Axes->{True,True},PlotRange->{0,5},ImageSize->640];          Module[{windowSize=QuantityMagnitude@UnitConvert[Quantity[3,"Month"],"Second"]},       Grid[         {{Dynamic@Show[g,              Epilog->{EdgeForm[Gray], FaceForm[Cyan], Opacity[0.5],                      Rectangle[{x-windowSize/2, 0},                                {x+windowSize/2, Max[Last/@data]}],                       FaceForm[LightGray], Opacity[1],                       Rectangle[{x-1.05windowSize/2, .25Max[Last/@data]},                                 {x-0.95windowSize/2, .75Max[Last/@data]}],                      Rectangle[{x+0.95windowSize/2, .25Max[Last/@data]},                                {x+1.05windowSize/2, .75Max[Last/@data]}]                     }]},         {Slider[Dynamic[x],                  {AbsoluteTime[{2013,1,1}], AbsoluteTime[{2013,12,31}]},                 Appearance->"UpArrow", ImageSize->640]}}]]      ![Mathematica graphics](http://i.stack.imgur.com/hQkdE.png)


Something faster than Do loops with AppendTo

I am an "old" programmer used to _Fortran_ and _Pascal_. I can't get rid of `For`, `Do` and `While` loops, but I know _Mathematica_ can do things much faster! I am using the following code               SeedRandom[3]     n = 10;     v1 = Range[n];     v2 = RandomReal[250., n];          a = {};     Do[        Do[         AppendTo[a, (v2[[i]] - v2[[j]])/(v1[[i]] - v1[[j]])          ],         {j, i - 1, 1, -1}], {i, n, 2, -1}        ]; // Timing      If `n` is small, it runs fast enough, but for bigger `n` it slows down. I usually deal with `n > 600`. How can the code be made faster?


How can I highlight the vanishing-partials in an interactive 3D plot?

I am using `Manipulate` and `Plot3D` to plot a function with two real variables and two extra parameters.               f[x_, y_, alpha_, gamma_] := x*y + alpha*x - Log[Power[x, gamma]*y]        Manipulate[         Plot3D[f[x, y, alpha, gamma], {x, 0, 5}, {y, 0, 5},          PlotStyle -> Opacity[0.4]],         {alpha, -100, 100, 0.1}, {gamma, -100,          100, 0.1}]      I want to dynamically highlight/plot the 3D curve (or set of points) of the vanishing partials (`D[f, x] == D[f, y] == 0`) over the function, and have it update according to the parameter values manipulated. I know I should probably use `NDSolve` for this, But I need the solution to be updated and displayed on parameter changes. How do I do that?


Change the size of a graphic inside a legend

I have this graph:               ShowLegend[     Plot[Sin[x], {x, 0, 10}, Filling -> Axis, FillingStyle -> {Red, Blue}],      {{{Graphics[{Blue, Disk[{0, 0}, 1]}, ImageSize -> 5], Sin[x] > 0}, {Graphics[{Red, Disk[{0, 0}, 1]}], Sin[x] < 0}}}]      ![enter image description here](http://i.stack.imgur.com/56SYv.gif) and I would like to change the size of the disks in the legend. Unfortunately, using the ImageSize option doesn't work `Graphics[{Red, Disk[{0, 0}, 1]},ImageSize -> 2]` What should I do in this case?


Calling Correct Function for Plotting DiracDelta

I am wondering what is the correct function in Mathematica to plot the true impulse function, better known as the `DiracDelta[]` function. When using this inside of a function or just the function itself when plotting, it renders output = zero. Quick example:               Plot[DiracDelta[x], {x,-1,1}]      I am wondering, is this the correct delta function which is infinite in height at zero and zero everywhere else. I have seen other functions such as `KroneckerDelta[]`, but this seems to do the same exact thing. The code is below:               eqn1wb := (2 ((I Pi f) Exp[(-I) 2 Pi f]) ((1/2) DiracDelta[f-2] +                DiracDelta[f+2]))/(1 + I 2 Pi f);      wb1 = Plot[Re[eqn1wb], {f, -5, 5},      PlotRange :> All, PlotStyle :> {Thick, Red},     AspectRatio :> 1,     GridLines :> {{-4, -2, 2, 4}, {1.0, 0.5, -0.5, -1.0}},      PlotLabel :> "Re(w) - Frequency Response",      AxesLabel :> {"f", "W(f)"}     ]


Plot Fourier transform of $\sin (2 t)$

I'm trying to plot the Fourier transform of $\sin (2 t)$. I tried using the FourierTransform Function (I'm expecting a peak at `w = 2`) but it gives me undefined at `w = 2` because the DiracDelta function is not defined at `DiracDelta[0]`. Is there any way around this? I used               Plot[FourierTransform[Sin[2*t], t, w], {w, -3, 3}, PlotRange -> Full]      ![enter image description here](http://i.stack.imgur.com/45s3t.png) which has gaps at 2 and -2, but no height. How do I get a peak with some height there?


Fitting piecewise functions

I have several large data sets which follow the following pattern: A position is measured, a force is applied until a new equilibrium is found.   I'd like to find a fit for the position, at least at the plateaus, and preferably of the inter lying section, which in this case approaches a line.   I tried fitting the data with `Clip`, and with `Piecewise`.               nlm = NonlinearModelFit[v40s1000h,Piecewise[{{a, x < A}, {b, x > B}}], {a, b, A, B, c, d}, x]        This creates a decent fit only if I specify the values for A and B, but then I have to estimate those values for each data set manually. It also doesn't really work to just add `NMinimize`, or add the piecewise part for the middle bit.   Is There anything else I can try? ![Setting the A to 200 and B to 250 works decently.](http://i.stack.imgur.com/Dsbuf.png) s000.tinyupload.com/?file_id=35616536027018518052 << file


Determining whether or not an expression is an integer

I'd like to define a function that controls if a certain number is an integer, rational, algebraic and so far. First, I tried generating a list of those numbers:               ZL = {1, 3, Pi, E, Sqrt[2], Zeta[3]}       I then created my functions like so:               TestI[x_] := If[x ∈ Integers, x "is Integer", x "is no Integer"]      It works so far. I now tried to define a For-function like this:               For[i = 1, i <= Length[ZL], i++, Print[TestZ[Part[ZL, i]]]]      However, when I evaluate the above expression, the output is like               is integer     3 is integer     ...     is no integer E       How can I achieve an output that says:               1 is Integer     3 is Integer     ...     \e is no Integer      and so on?


Manipulating a Graphics3D output with a large number of geometric primitives

I'm attempting to view and rotate a Graphics3D object with a very large set of geometric primitives ($\approx 10^6$ objects such as spheres or lines), and everything is functioning very slowly. Are there any tricks for speeding up object display / manipulations or to spread the burden of redrawing the image over multiple cores? Also, how can I specify that the object should initially appear larger in the Mathematica workbook? More specifically, I mean that I would like to specify that the output for some Graphics3D[...] command should initially be displayed at a specified size in the workbook?


Bug in mathematica analytic integration?

I found _Mathematica_ provides me a wrong answer for a relatively simple analytically solvable integral:               Integrate[Exp[-I θ]/(1 + b Cos[θ]), {θ, 0, 2 π},           Assumptions -> b < 1 && b > -1]      Provides as a result `(2π)/b`, which is incorrect. The integral can be computed easily writing the integrand as a geometric series. Additionally, you can compute it numerically               NIntegrate[Exp[-I θ]/(1 + b Cos[θ]), {θ, 0, 2 π}]      which produces the right result, different from `(2π)/b`. Is this a very bad bug? or am I doing something wrong? What could be the reason for this error?


Normal and Tangent of Acceleration in 3D

I need to figure out how to find the Normal and Tangent of acceleration. I know the formula for the tangent of acceleration is $((Acceleration . Velocity)/(Velocity.Velocity))*Velocity$ and the normal of acceleration is the same but with $Velocity$ replaced with the perpendicular of velocity. I think my errors arise because I am trying to manipulate parametric functions incorrectly. Any and all help would be appreciated. Anyways, here is my attempt:               Clear[t,x,y,z,P,velocity,acceleration,atan,tanvector];     x[t_] = 2 Sin[t];      y[t_] = 6 Sin[t/2]^2;     z[t_] = 3 Cos[t];     P[t_] = {x[t], y[t], z[t]};           curveplot = ParametricPlot3D[P[t],{t,1,6},PlotStyle->Thickness[0.01]];     velocity[t_] = {x'[t], y'[t], Z'[t]};     acceleration[t_] = {x''[t], y''[t], z''[t]};          atan[t_] = ((acceleration[t].velocity[t])/(velocity[t].velocity[t]))*velocity[t];     tanvector[t_]:= Vector[atan[t],Tail->P[t],VectorColor->Blue]          Show[curveplot,Table[tanvector[t],{t,1,6,(6-1)/10}],       PlotRange -> All, AxesLabel -> {"x","y","z"}]      This question is different from Finding unit tangent, normal, and binormal vectors for a given r(t) because I am asking for the tangent and normal of acceleration using the equation : $((Acceleration . Velocity)/(Velocity.Velocity))*Velocity$ I am missing an undertanding of how to manipulate paramteric plots.


Make a scatter plot from two columns of matrix

I have imported my text-type data as a matrix. I want to make a scatter plot (`ListPlot`) using one column as _x-axis_ and other columns as _y-axis_. Is there a function `F` which can make a scatter plot in the following form?               F[matrix[[All, 1]], {matrix[[All,2],...,matrix[[All,n]]]]


How to draw a higher-genus surface

**NB** : By _higher-genus surface_ , I mean a closed orientable surface of genus at least 2. This question has come up before on math.SE, and even MathOverflow, but most posters suggested using either Blender or Inkscape. However, I would like to draw these higher-genus surfaces in Mathematica, because I am trying to create a Manipulate which takes as input a word in the fundamental group of such a surface, and outputs the corresponding geodesic, drawn on the surface. So, for example, let's say I am trying to draw a genus 2 surface. What I am doing now is the following:               torus = ParametricPlot3D[{(2 + Cos[s]) Cos[t], (2 + Cos[s]) Sin[t],      Sin[s]}, {t, 0, 2 Pi}, {s, 0, 2 Pi}, Mesh -> None, Axes -> False,      Boxed -> False, PlotStyle -> Opacity[.3],      RegionFunction -> Function[{x, y, z, u, v}, x < 2]];     antitorus =      Graphics3D[     Translate[     GeometricTransformation[torus[[1]],      ReflectionTransform[{1, 0, 0}, {2, 0, 0}]], {1, 0, 0}],      Boxed -> False, Axes -> False];     bound = ParametricPlot3D[{{t, (2 + Cos[s]) Sqrt[       1 - 4/((2 + Cos[s])^2)],      Sin[s]}, {t, -(2 + Cos[s]) Sqrt[1 - 4/((2 + Cos[s])^2)],      Sin[s]}}, {s, 0, 2 Pi}, {t, 2, 3}, PlotStyle -> {Opacity[.7]},      Axes -> False, Boxed -> False, Mesh -> None, PlotPoints -> 100];     Show[antitorus,torus,bound,Lighting->"Neutral"]      This gives me this (not-so-bad!) picture: ![enter image description here](http://i.stack.imgur.com/kaYtA.png) I am wondering what other methods there are for creating these surfaces, perhaps with a smoother finished product than the one I currently have. And of course, ideally, I would eventually draw the two "building blocks" of all such surfaces, the once- and twice-punctured tori. Then I could dynamically build these surfaces on the fly...


How to generate a random data set with determined expected value and variance?

Recently I am doing my math homework and there is a question asking me to Come up with a dataset X that has at least 10 distinct numbers in it such that Expect[X] = 3.7, and Var[X] = 2.1. Actually I did not know how to use Mathematica before, so I really have no idea how to generate. I read many sources and wrote a code `X=RandomVariate[NormalDistribution [3.7, Sqrt [2.1]], 10]` Unfortunately it does not work...Can anyone tell me what's wrong? Thanks a lot!


Failure message from Reduce

I am getting the message > Reduce::nsmet: This system cannot be solved with the methods available to > Reduce. while trying to solve the following equation:               Assuming[n ∈ Integers, Reduce[p + 2 s == (2 r (p + 2 b) + 2 b + p) (2 r + 1)^n, r, Reals]]      How can I get my code to work?


Combining 3 graphics of different coordinate systems

I have 3 graphics in different coordinate systems and I want to join them in as in the following figure. ![Sample Figure](http://s10.postimage.org/5jqklnrk9/Figure_3_7_1_pp_67.jpg)   This is just a sample figure, not the real one. My functions are as follows.               y[t_]=Sin[Pi t]/(Pi t);     ar={1.415,2.495,3.526,4.462,5.421,6.477} (* Aproximate roots of y'[t] *);     rr=Join[{0},Table[t/.FindRoot[D[y[t],t]==0,{t,ar[[k]]}],{k,1,Length[ar]}],{7}] (* Real roots y'[t] *);     \[Theta][t_]=Piecewise[Table[{ArcTan[y[t]/(t^2 y'[t])]+k Pi,rr[[k]]<=t<rr[[k+1]]},{k,1,Length[rr]-1}]] (* Phase function *);     \[Rho][t_]=Sqrt[(y[t])^2 + (t^2 y'[t])^2] (* Amplitude function*) ;      The first graphic is generated by               p1=Plot[\[Theta][t],{t,0,5},Ticks->{None,Table[{k \[Pi],k "\[Pi]"}, {k,0,4}]},AxesLabel->{"t","\[Theta]"},AxesStyle->Directive[14],AxesOrigin->{0,0},PlotRange->Full]      ![p1](http://s12.postimage.org/6l1vv2inh/Figure3_7_1a.jpg) the second graphic is generated by               p2=Plot[y[t],{t,0,5},Ticks->{Table[{k,""},{k,1,5}],{1}},AxesLabel->{"t","y"},AxesStyle->Directive[14],AxesOrigin->{0,0},PlotRange->Full]      ![p2](http://s7.postimage.org/qpzeezlm3/Figure3_7_1b.jpg) the third and last one is generated by               p3=PolarPlot[\[Rho][t],{t,0,5},Ticks->None,AxesLabel->{"\[Theta]","\[Rho]"},AxesStyle->Directive[14],AxesOrigin->{0,0}]      ![p3](http://s11.postimage.org/9e9agbrmr/Figure3_7_1c.jpg) * * * **Properties of the graphic is as follows.**   1\. Origins of _p1_ and _p2_ must be on the same vertical line, and the origins of _p2_ and _p3_ must be on the same horizontal line (as shown on the sample figure).   2\. The horizontal lines passing at the points $\pi$, $2\pi$, $3\pi$, $4\pi$ located on the $\theta$-axis of _p1_ and the vertical lines passing at the zeros of the curve (which are explicitly $1,2,\cdots$ since $y(t)=\sin(\pi t)/(\pi t)=0$ at such points) in _p2_ must intersect on the curve in _p1_ (see the sample figure).   3.The list of extreme points of the curve in _p2_ are listed in _rr_ , i.e., if $t$ is in _rr_ then $y'(t)=0$ and thus $\rho(t)=|y(t)|$. For such points the distance from $t$-axis to the function $y$ in _p2_ is equal to the length from the _Origin_ to the corresponding peak point of the curve in _p3_. This requires scaling of _p3_ so that the lengths are equal. It would be very good to have them just in the right position, I guess I can draw the lines myself... Many thanks.   **bkarpuz** * * * **Edit**. After reading **Yves Klett** 's comment decided to show what I have tried. I did everything manually as I don't really understand the command _Inset_ very well.               p1 = Plot[\[Theta][t], {t, 0.7, 4.2}, Ticks -> {None, None},         AxesLabel -> {"\!\(\*     StyleBox[\"t\",\nFontSlant->Italic]\)", "\!\(\*TagBox[     StyleBox[\"\[Theta]\",\nFontSize->14,\nFontSlant->Italic],     (StyleForm[#, 14, Italic]& )]\)"}, AxesStyle -> Directive[14],         AxesOrigin -> {0, 0}, PlotRange -> {{0, 4.5}, {0, 14}},         AspectRatio -> 1];     p2 = Show[        Plot[y[t], {t, 0.7, 4.2}, Ticks -> {Table[{k, ""}, {k, 1, 5}], {}},          AxesLabel -> {"\!\(\*     StyleBox[\"t\",\nFontSlant->Italic]\)", "\!\(\*TagBox[     StyleBox[\"y\",\nFontSize->14,\nFontSlant->Italic],     (StyleForm[#, 14, Italic]& )]\)"}, AxesStyle -> Directive[14],          AxesOrigin -> {0, 0}, PlotRange -> {{0, 4.5}, {-2, 2}},          AspectRatio -> 1],         ListPlot[Table[{rr[[k]], y[rr[[k]]]}, {k, 2, 4}], Filling -> Axis,          PlotStyle -> PointSize[Small]]];     pl = Table[{rr[[k]], \[Rho][rr[[k]]]}, {k, 2, 4}];     p3 = Show[        PolarPlot[\[Rho][t], {t, 0.7, 4.2}, Ticks -> None,          AxesLabel -> {"\[Theta]", "\[Rho]"}, AxesStyle -> Directive[14],          PlotStyle -> PointSize[Tiny], AspectRatio -> 1],         Table[ListPolarPlot[{{0, 0}, pl[[k]]}, Joined -> True,           PlotStyle -> {PointSize[Tiny],             Directive[Hue[0.67, 0.6, 0.6], Opacity[0.2]]}], {k, 1,           Length[pl]}], ListPolarPlot[pl]];      The figures are drawn above               Show[Graphics[{Inset[p2, {0, -0.35}, Right, 0.8],         Inset[p1, {0, 0.55}, Right, 0.8],         Inset[p3, {0.24, -0.415}, Left, 0.6]}, PlotRange -> 1],       Graphics[{Dotted, Line[{{-0.6215, -0.41}, {-0.6215, 0.3152}}],         Line[{{-0.4634, -0.41}, {-0.4634, 0.4762}}],         Line[{{-0.30515, -0.41}, {-0.30515, 0.6326}}]}],       Graphics[{Dotted, Line[{{-0.7778, 0.3152}, {-0.6215, 0.3152}}],         Line[{{-0.7778, 0.4762}, {-0.4634, 0.4762}}],         Line[{{-0.7778, 0.6326}, {-0.30515, 0.6326}}]}],       Graphics[{Point[{-0.6215, 0.3152}], Point[{-0.4634, 0.4762}],         Point[{-0.30515, 0.6326}]}],       Graphics[{Text[StyleForm["\[Pi]", 14], {-0.8, 0.3152}, {1, 0}],         Text[StyleForm["2\[Pi]", 14], {-0.8, 0.4762}, {1, 0}],         Text[StyleForm["3\[Pi]", 14], {-0.8, 0.6326}, {1, 0}],}]]      I obtained all the points in the last part from the plain figure by _Get Coordinates_ and drew the lines. On the other hand, to fit the _Origins_ of _p1_ and _p2_ , I drew them with _Ticks->None_ and then put the _Ticks_ manually on the figure obtained by _Inset_. However, the figure still seems to be inconvenient with _p3_ as it does not satisfy _Property 3 (scaling)_ mentioned above.


List creation/manipulation

I'd like to a create a list from `A = {{a}, {b}, {c}}` by taking each elements `n` times in the following form: > >     B={{a},{a},{a},{b},{b},{b},{c},{c},{c}} >   Any idea?


List manipulation: position & max value combination

Starting with               {{0, 0, 0}, {1, 1, 2}, {2, 3, 3}, {3, 4, 5}}      I would like to get               {{0, 2, 3, 5}, {1, 3, 2, 3}}      where the first list returned is the highest value reached in each of the first lists, and the second output is the position of the highest values that were reached in each list. I have been trying different combinations of `Max` and `Position`, but have been unsuccessful.


Finding the position in a list where the maximum or minimum value occurs

We can use `Max[exampleList]` or `Min[exampleList]` to find the maxima and minima of `exampleList`, however, is there a similar standalone function that returns something like `{position in array, maximum value in the array}` or `{position in array, minimum value in the array}`, i.e. both the position and value of the maximum or minimum element in `exampleList`? It seems awkward to have to write `Position[exampleList,Max[exampleList]]` or `Position[exampleList,Min[exampleList]]`?


Table - find index of the maximum element

Let's suppose that I have table `t = {1.23, 3.4, 10, 34, 1.78, 0.98, 12.56}`. To take the biggest element I can use `Max[t]` function. But I want to take not only the maximum element, but also the index of the element (so, which element in table it is). Is any function which helps to take the indes of element, when I know the value of this element?


How to use a custom CDF in a Kolmogorov-Smirnov test

How do I use a custom CDF that I defined for a Kolmogorov-Smirnov test. I have one input vector of data whose CDF I claim to have derived but want to check whether it agrees with my closed form result. In order to do so, I am wondering whether there is a way to feed the command not just two data vectors but one data vector and one CDF. In http://reference.wolfram.com/language/ref/KolmogorovSmirnovTest.html, one can only specify the distributions by name but mine is a new one that has no name (yet;-)). Thanks! Hirek


Comparing elements of the $n^{\text{th}}$ sublist in a ragged list with the $n^{\text{th}}$ member of a sequence

I have a list of lists that are not of the same length (for example, `{{6}, {14}, {6, 26, 30}}`), but I have to compare every element in the $n^{\text{th}}$ sublist with the corresponding $n^{\text{th}}$ odd number. So, 6 in the first sublist with 1 (first odd number), 14 in the second sublist with 3 (second odd number), 6 with 5 (third odd number), 26 with 5, 30 with 5, etc. I tried to make another list with odd numbers, but I really don't know how to program the case when the comparison is with only one element in the sublist (e.g. sublists 1 and 2) and with multi-element sublists (e.g., 3rd sublist).


Copy As PDF in MMA 10

Wondering if this is a known issue.. I usually export graphics and Grids using the Copy As PDF menu item. The results looked quite good in MMA 9 on Yosemite. However in MMA 10 on Yosemite, the PDF doesn’t match what I see on screen. Specifically the Font kerning and Fonts look way off… Copy to BitMap function seems to work fine... Here’s some sample code               fstyle12 = Sequence[{FontFamily -> "Myriad Pro", FontTracking -> "Plain",      FontSize -> 12, LineIndent -> 0}];          fstyle12SemiCondensed = Sequence[{FontFamily -> "Myriad Pro",      FontTracking -> "SemiCondensed", FontSize -> 12, LineIndent -> 0}];          fstyle12Extended = Sequence[{FontFamily -> "Myriad Pro", FontTracking -> "Extended",      FontSize -> 12, LineIndent -> 0}];          testText = "Handgloves, Jackdaws, Foxes & Quartz \[Mu]\[Alpha]\[Beta]\[Gamma]\[Delta]";               Grid[       {       {Item[Text[testText, BaseStyle -> Evaluate@fstyle12Extended], Alignment -> Left]}       ,{Item[Text[testText, BaseStyle -> Evaluate@fstyle12], Alignment -> Left]}       ,{Item[Text[testText, BaseStyle -> Evaluate@fstyle12SemiCondensed], Alignment -> Left]}       }     , Frame -> False]      Produces the following results in MMA10 and when copied to PDF…. ![Output in MMA10 and in Preview](http://i.stack.imgur.com/uO9ry.png)


Help with writing a polynomial series

I want to write and evaluate an expression something like               Sum[x[i] Product[y[j], {j(!=i), 1, n}], {i, 1, n}]      but with correct syntax, where n is a any number (say 4 as a concrete example).


Understanding Villegas-Gayley

_Temporary message: I have written another question about the behaviour the code by Oleksandr R. . Sadly I clicked "discard" and that was lost. I am a bit demotivated now and in order to not let the work pile up I chosen the least juicy part of the question to be the new shortened version. Retract your upvote if you will._ In this nice answer, Mr.Wizard writes               mk : MakeBoxes[(Hold | HoldForm | HoldComplete | HoldPattern)[__], _] :=       Block[{$hldGfx = True, Graphics, Graphics3D}, mk] /; ! TrueQ[$hldGfx]      which is an application of the Villegas-Gayley pattern Question: How does the Villegas-Gayley pattern work?


How to build an interface that plots an equation given as text by a user?

I would like to create a window where a student may enter an equation and, by clicking on a button, the function gets plotted. * * * In the original Spanish: > Quiero realizar una ventana en la cual el alumno tenga la opción de ingresar > una ecuación la cual al presionar un botón se grafique.


Nicely illustrating the evolution and end-state of a discrete-time Markov chain

I'm simulating a discrete time Markov process on a finite state space corresponding to a linear interval $(x_1, x_2, ..., x_N) \in X$, where each time step $t_i$ involves updating the state of some number of agents labeled `"Red"` and `"Blue"`. At any time point $t_i$ I have an array that keeps track of the positions and colors of the agents along the interval:               agentArray[[t]] = {         {"Blue", 9}, {"Red", 8}, {"Blue", 9}, {"Blue", 9}, {"Blue", 8}, {"Blue", 8},         {"Blue", 8}, {"Blue", 6}, {"Blue", 9}, {"Blue", 9}, {"Blue", 8}, {"Blue", 8},         {"Red", 7}, {"Blue", 8}, {"Blue", 8}, {"Blue", 3}};      I'd like to first and foremost have a nice way in which to illustrate the occupancy levels (for agents of the types "Red" and "Blue") of the discrete states $1$ through $N$ in the Markov chain at some time point $t_i$. Given that _Wolfram Research_ recently extensively updated their Markov processes toolkit in _Mathematica_ , is there a nice way to do this automatically? Something like a heat map superimposed on a graph representation of the linear interval, with explicitly stated counts for the number of red and blue agents at each vertex? Secondly, I was wondering if there was a way to make an animation showing the evolution of the Markov process? Something like the aforementioned graphic where we sample the state of the Markov chain at every $k$th time point? * * * Specifically: How do we use the aforementioned data structure to show a graph, with heat/color encoded "Red" and "Blue" occupancy levels at each vertex, with the occupancy counts also explicitly written in text above each vertex?


How can a Button be shifted to perform its action

I have a `Panel` with 4 `Inputfields` and a `Button`. When a `Button` is clicked, it shifts itself and adds two `Inputfields` in its place. Before clicking `Button`, ![enter image description here](http://i.stack.imgur.com/ANanA.png) and after clicking `Button`. ![enter image description here](http://i.stack.imgur.com/VF7ei.png) I want to know how can I shift Button ?


Open two copies of the same notebook

Is there a way to open one notebook in two (or more) different windows? This can be helpful when working with a long notebook and one wants to edit one part of it while looking at a different part. Otherwise, you have to jump back and forth... **Edit:** Per @Guillochon comment, splitting the window where the notebook is open is indeed a nice option. **Edit 2** : Having a secondary "read-only" window can also be a nice compromise.