How to find the maximum value and the argument of a function of three variables y dividing into grids?

I am dealing with a non-linear function of three variables, namely R0k, R1 and alpha. To find its maximum value, I divided the three variables into grids and maximized the function by plotting the maximum value of the function on the grid of alpha, on all the grid points of the two variables. Now I want the value of all those alpha at which the function attained its maximum value. How do I find it? Here is my code:               tbl = Table[       Flatten[{R0k, R1,          Max[Table[bTransp61[(i - 1) Pi 45/180/78]^2, {i, 0, 79}]]}],         {R1, 0, 21.43, .1}, {R0k, 2*(R1/R1el)^2*R0kel - R0kel, 19.71, .1}]     tbl >> "datafile.nb"     Export["tbl.dat", tbl]     tbl2 = Table[Flatten[tbl, 1], {1}]     ListPlot3D[tbl2, PlotRange -> {0, 0.0004}]


Creating simple procedure for The Least-Square $m^\text{th}$ Degree Polynomials

I am CS major, taking Computational Numerical Analysis course. Instructor gave us freedom of choice, we were allowed to use anything or any computer language we picked, I picked Mathematica.This is my 3rd day with the program. I am writing a simple procedure to calculate the Least-Square $m^\text{th}$ Degree Polynomials based on data sample. Algorithm is somewhat simple: http://www.efunda.com/math/leastsquares/lstsqrmdcurve.cfm   This is how far I got:               y_sample = {0, 1, 2, 3, 4, 5, 6, 7, 8}     x_sample = {0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8}(*Some sample data*)          f[x_] = Sum[Subscript[a, i] x^i, {i, 0, 4}](*generating polynomial, in this case, degree of 4*)         Sum[(y_sample[[i]] - f[x_sample[[i]]])^2, {i, 0, 4}]       Last line of code should roughly correspond to $$ \Pi = \sum^n_{i = 1}\left[y_i - f(x_i)\right]^2 = \sum^n_{i=1}\left[y_i- (a_0 + a_1 x_i + a_2 x_i^2 + \ldots + a_m x_i^m)\right]^2 = \text{min} $$ List of problems and questions, I am facing:   1. Executing code above, produces number of errors that I don't mean much to me.   2. How do I differentiate in respect to all $\mathbb{a}_n$   3. Differentiation should produce number of linear equations, how do I set the results of differentiation to zero and solve for unknown coefficients.   4. Outputs are enormously long, is there a way to suppress some outputs !


How can I pass in parameters for multiple controls to a function that returns a Manipulate?

For instance, I have a some "commands" that I use regularly, for example:                 Manipulate[Plot[fun, {var, ldv, udv}, PlotRange -> {{plx1, plx2}, {ply1, ply2}}],    {av , lav, avu}].      So I define a custom function to avoid all the parethesis and braces as follows:                 cman[fun_, var_, ldv_, udv_, plx1_, plx2_, ply1_, ply2_, av_, lav_, uav_ ] :=        Manipulate[Plot[fun, {var, ldv, udv}, PlotRange -> {{plx1, plx2}, {ply1, ply2}}] ,  {av , lav, uav}].      This works exactly how I want it to, for this special case. However what do we do if we have more manipulation variables. For instance I would like to similarly flatten out the following code,                 Manipulate[Plot[fun, {var, ldv, udv}, PlotRange -> {{plx1, plx2}, {ply1, ply2}}],  {av1 , lav1, uav1}, {av2 , lav2, uav2},{av3 , lav3, uav3}, ...{avn , lavn, uan}]      (of course the three dots are not really code but just their to indicate the idea that i want to be able to stack as many manipulate variables as possible). The strategy that I came up with is as follows: I can condense the manipulation variables into one variable by starting with the , List[av1 , lav1, uav1, av2 , lav2, uav2, av3 , lav3, uav3, ...avn , lavn, uan] Then hit the list with                  Partition[List[av1 , lav1, uav1, av2 , lav2, uav2, av3 , lav3, uav3, ...avn ,       lavn, uan],3]      Which give the list,                  {{av1 , lav1, uav1}, {av2 , lav2, uav2},{av3 , lav3, uav3}, ...{avn , lavn, uan}}.      However I can not put the code in like that so I must turn this list into a sequence, for which the following is used:                 l2s[{}] := Sequence[]; l2s[L_] := Sequence[First[L], l2s[Rest[L]]]      I then attempt to flatten my code with the following:                 Cman[fun_, var_, ldv_, udv_, plx1_, plx2_, ply1_, ply2_, L__ ] :=        Manipulate[Plot[fun, {var, ldv, udv}, PlotRange -> {{plx1, plx2}, {ply1, ply2}}],        l2s[Partition[List[L], 3]]].      This gives however gives me the following error: > Manipulate::vsform: "Manipulate argument l2s[Partition[{a,0,1},3]] does not > have the correct form for a variable specification" My question is therefore twofold: 1) is their a way to make it work through the error, since                l2s[Partition[List[1, 2, 3, 4, 5, 6], 3]]      give the output Sequence[{1, 2, 3}, {4, 5, 6}]? 2) Is their another better way to do this? I want to know if I can make my approach work, so I can better understand the program. For the same reason, I am also interested in better alternatives. Note: For my practical purposes, the following code is pretty good.                 custman[fun_, var_, ldv_, udv_, plx1_, plx2_, ply1_, ply2_, L1__] :=        Manipulate[       Plot[fun, {var, ldv, udv},        PlotRange -> {{plx1, plx2}, {ply1, ply2}}], L1].      However one must use the function as follows,                custman[a x^2 + b, x, 0, 1, 0, 1, 0, 9, {a, 0, 1}, {b, 0, 1}]      I want use the function in the following way:                custman[a x^2 + b, x, 0, 1, 0, 1, 0, 9, a, 0, 1, b, 0, 1]


Find exact value

I want to know exact x'[t] value where z[t]=0 I know approximate x'[t] value is 107 but I cannot find how to find exact x'[t] value                   (*1 mph = 0.44704 m/s         50000ft=15240m*)              g = 9.81;         {d, Subscript[c, 1], Subscript[c, 2]} = {0.2 2, 1.55 10^-4 d, 0.22 d^2};         mass = 100;              ls0 = NDSolve[{x''[t] + Subscript[c, 2]/mass ((x'[t] + 26.8)^2 + z'[t]^2)^(1/2) (x'[t] + 26.8) == 0, z''[t] + Subscript[c, 2]/mass ((x'[t] + 26.8)^2 + z'[t]^2)^(1/2) z'[t] + g == 0, z[0] == 15240, z'[0] == 0, x'[0] == 107, x[0] == 0}, {x, z}, {t, 0, 1000}]          ParametricPlot[     Evaluate[{x[t], z[t]} /. ls0], {t, 0, 110}, PlotRange -> All, AxesLabel -> {speed, flying altitude}, AspectRatio -> 1/GoldenRatio]      ![enter image description here](http://i.stack.imgur.com/QI2ni.png) ![enter image description here](http://i.stack.imgur.com/iqIg5.png)


How to insert a plot into another plot

I would like to know whether there is a way to insert a plot into another plot. I would like to do some plot from a function an then, inside this plot, in the right down corner add a smaller plot of the same function covering a smaller region. I tried with Epilog but it's not possible that way, it gives me a fail Thanks in advance!


How to insert a plot into another overlay plot

I want to insert a plot into another overlay plot. Here is my code:               xy1 = Table[{i, 2*i}, {i, 1, 10}];     xy2 = Table[{i, i^2}, {i, 1, 10}];     xy3 = Table[{i, i^3}, {i, 1, 10}];     p1 = ListPlot[xy1, FrameLabel -> {"x", "2x"},         PlotStyle -> {Directive[Red, Dashed], Red},         Frame -> {True, True, True, False}, ImagePadding -> 40,         FrameStyle -> {Automatic, Red, Automatic, Automatic},         PlotMarkers -> {\[FilledCircle]}, Joined -> True, PlotRange -> All];     p2 = ListPlot[xy2, FrameLabel -> {"x", "", "", "x^2"},          PlotStyle -> Blue, Frame -> {False, False, False, True},         ImagePadding -> 40,         FrameStyle -> {Automatic, Automatic, Automatic, Blue},         FrameTicks -> {None, None, None, All},         PlotMarkers -> \[FilledUpTriangle], Joined -> True,         PlotRange -> All];     p3 = ListPlot[xy3, FrameLabel -> {"x", "x^3"},  PlotStyle -> Green,        Frame -> {True, True, True, True}, PlotMarkers -> \[EmptyCircle],        Joined -> True, PlotRange -> All]     p12 = Overlay[{p1, p2}]     p123 = Graphics[{p12, Inset[p3]}]     p1232 = Graphics[{Rectangle[{0, 0}, {2, 2}, p12],         Rectangle[{0.3, 0.25}, {0.9, 0.9}, p3]}]     p1233 = Graphics[{First[p12],         Inset[p3, {5, 20}, Automatic, Scaled[.8]]}, PlotRange -> All,        AbsoluteOptions[p12]]      p12 is the overlay plot of p1 and p2, having two y axes. I want to insert p3 into p12. I have read this post: How to insert a plot into another plot And tried three ways to do the job, with the result figure represented as p123, p1232, and p1233 respectively. However, none of p123, p1232, and p1233 is successful: p123: ![enter image description here](http://i.stack.imgur.com/e8YxW.png) p1232: ![enter image description here](http://i.stack.imgur.com/el5wp.png) p1233: ![enter image description here](http://i.stack.imgur.com/reKcv.png) Among them p123 and p1233 caused errors. P1232 is close to what I want, but still is very weird. I want to insert p3 into the blank area of p12. Can anyone please help?


How to add a subplot in corner of plot?

How is something like the plot with subplot shown in this image achieved with Mathematica? ![subplot with subplot](http://i.stack.imgur.com/9SCvq.jpg)


How to enlarge a part of a figure and then put them together for completion?

![](http://i.stack.imgur.com/S0wsU.jpg) The small figure in the lower right corner is a magnified version of a part of the large figure. Are there any simple method to obtain the magnified figure from the the original one? Moreover, I want to know how to put the two figures together?


Is there any other built-in color scheme for highlighting text?

Blue variable name and black key words seem boring to me now. I find that the color scheme of this site is better. Can I apply that in my notebook?


Are there functions or packages in Mathematica to sort subsets in lex order, colex, revlex, etc.?

I am looking for non-canonical sorts of lists. A function that would give:               Sort[X, "order type"]      With "order type" being colex, revlex, etc.


Inaccurate data range in ListPlot

I want to have axes x on my `ListPlot` as the range (1,1386), but when I run my code               l =  Table[        Sum[Binomial[k, j]*j^a*(-1)^(k - j), {j, 0, k}], {k, 1, 1386}];     For[i = 0, i < 3, i++, AppendTo[l, 0]]     m = Table[Sum[Binomial[k, j]*j^b*(-1)^(k - j), {j, 0, k}], {k, 1, 1389}];     p = ((2000^1389)/(2000^1386))*(l/m);     t = Table[       N[Reduce[ 1/(1 + f) <= p[[i]] <= 1 + f && f >= 0 , f], 100], {i, 1,         Length[p]}]     t = Cases[t, Except[False]]     tt = t[[All, 2]]          ListPlot[tt,         Filling -> Top,         GridLines -> Automatic,         PlotStyle -> {Red, PointSize[Large]},         PlotMarkers -> {Automatic, Medium}, DataRange -> {1, 1386},          AxesLabel -> {k, alpha}]      the plot has range to 1400 (I mean the last number marked on the axes is 1400) How can I fix that to have the last marked value as 1386?


Slow integration of interpolating function

I have a large file with irregularly spaced data in the format:               {{"2012/08/06 21:05:22", 29}, {"2012/08/06 21:10:14",        28}, {"2012/08/06 21:15:12", 29}, {"2012/08/06 21:20:14",        29}, {"2012/08/06 21:30:12", 28}, {"2012/08/06 21:35:12",        28}, {"2012/08/06 21:40:13", 30}, {"2012/08/06 21:45:13",        30}, {"2012/08/06 22:00:13", 29}, {"2012/08/06 22:05:08", 28}}      The whole file is about 100000 lines long and can be downloaded here: 2.4 MB csv file I have converted the time strings with `AbsoluteTime` and removed comments and empty lines:               imp = DeleteCases[{#[[1]],           Mean[DeleteCases[            ToExpression[             Map[If[Head[#] === String,                 StringReplace[#, "#" ~~ __ -> ""], #] &, #[[2 ;; -1]]]],             Null]]} & /@        Rest[Import["dht22.csv", "Data"]][[         1 ;; -1]], {_, Mean[{}]}];     absTimp = {AbsoluteTime[#[[1]]], #[[2]]} & /@ imp;      Now I want to calculate hourly means of this data. This is problematic because there can be hours and even days when no data was recorded, and the data is not recorded exactly on the hour, it has some seconds or minutes of delay. So I want to interpolate the data and calculate hourly means of the interpolated function. I have this code:               interpolation = Interpolation[absTimp, InterpolationOrder -> 1]          timeFirst = imp[[1, 1]];     listFirst = DateList[timeFirst];     start = AbsoluteTime[Join[listFirst[[1 ;; 3]], {listFirst[[4]] + 1, 0, 0}]];          timeLast = imp[[-1, 1]];     listLast = DateList[timeLast];     end = AbsoluteTime[Join[listLast[[1 ;; 3]], {listLast[[4]] - 1, 0, 0}]];          AbsoluteTiming[      Table[Integrate[interpolation[x], {x, t, t + 3600}], {t, start,          Min[ (* shorter range for testing *)          end,          start + 3600*24          ], 3600}]/3600]      This calculation for 25 hourly means takes 2 seconds if I use `Integrate` and 3.5 seconds with `NIntegrate` on my computer, so it's clearly unusable for my large data set. How can I improve the speed of the calculation?


Ternary and binary searches in Mathematica?

Does Mathematica implement binary search to find a 0, and ternary search to find a local min/max?:   * http://en.wikipedia.org/wiki/Binary_search   * http://en.wikipedia.org/wiki/Ternary_search As nearly as I can tell, there's no "BinarySearch" method for FindRoot, nor a "TernarySearch" method for FindMaximum. I realize these are numerical, not symbolic, methods, but I was surprised Mathematica doesn't implement them. I even ran into a case where binary search would have worked, but FindRoot didn't. It would be easy to implement both in Mathematica, but I can't believe it's not already included?


How to solve for an Z-Score of a T-Distribution?

I'm looking for the Z-Score for a distribution, where the integrated area sums up to 0.90. Unfortunately I always get an error from Mathematica, `"nonnumerical value"`. Does someone know why?               Solve[NIntegrate[PDF[StudentTDistribution[49], x], {x, -Infinity, y}] == 0.95, y]      I tried as well               Solve[StudentTPValue[x, 49] == 0.10, x]      How can one get only the value as an output? I ultimately want to test a hypothesis value to check if they are in the `0.95±∞` part of a Student-t distribution.


Selective blurring of areas of image to make seamless tiles

I'm trying to make seamless tiles - images that can be repeated on a grid without it being obvious where the joins are. So far, I've followed the classic strategy of getting the edges working correctly:               i = ImageResize[ExampleData[{"TestImage", "Mandrill"}], 300];     requarter[im_] :=       Module[{width = First[ImageDimensions[im]],          height = Last[ImageDimensions[im]]},         iq = ImagePad[          ImagePad[im, {{width/2., width/-2.}, {0, 0}},            "Periodic"], {{0, 0}, {height/2., height/-2.}}, "Periodic"]];          irq = requarter[i]      and this quartered will tile well, except that the seams going through the middle (formerly the edges) have to be smoothed out. Somehow I need to blur these lines slightly, or make them overlap in some way, without affecting the rest of the image. What's the best way to do this? Perhaps the classic approach is wrong? ![an unfortunate quartered mandrill](http://i.stack.imgur.com/h3VyK.png)


Why LinearModelFit is slower than NonlinearModelFit?

Why `LinearModelFit` is slower than `NonlinearModelFit`?               data = Table[{x, 0.68 x - 0.33 + RandomReal[1000]}, {x, 0, 200000}];          nlm = NonlinearModelFit[data, a + b x, {a, b}, x] // AbsoluteTiming     > {0.081027, FittedModel[500.052 +0.679998 x]}          lm = LinearModelFit[data, {1, x}, x] // AbsoluteTiming     > {1.168421, FittedModel[500.052 +0.679998 x]}      It's almost 16 times slower, than `NonlinearModelFit`!


Symbolic calculation

Is there any software where this kind of symbolic calculation is possible?               s = 0     for i = 1 to m        j = 2 i + a - t        if (j > 0) s = s + a      I want s as a function of m,a,t, where m,a,t are integers. This is a toy example. In my calculation a lot of if/else, minimum of two values, etc., are involved.


Evaluating a function on permutations of its arguments

Say I have a function "temp" of $n+1$ variables, $y,z1,z2,z3,...,zn$. I want to test if my function has certain symmetries like swapping $y$ with square of any $z$, swapping any two of the zs, replacing any z by its inverse, swapping any two zs by each other's inverse etc. As of now I am having to type all of these cases explicitly by hand like for $n=3$ I am asking Mathematica to compute these differences for me (..if the symmetry exists then the answer would be 0..)                Print[FullSimplify[temp[y, z1, z2, z3] - temp[z1^2, y^(1/2), z2, z3]]];       Print[FullSimplify[temp[y, z1, z2, z3] - temp[z2^2, z1, y^(1/2), z3]]];       Print[FullSimplify[temp[y, z1, z2, z3] - temp[z3^2, z1, z2, y^(1/2)]]];       Print[FullSimplify[temp[y, z1, z2, z3] - temp[y, z2, z1, z3]]];       Print[FullSimplify[temp[y, z1, z2, z3] - temp[y, z3, z2, z1]]];       Print[FullSimplify[temp[y, z1, z2, z3] - temp[y, z1, z3, z2]]];       Print[FullSimplify[temp[y, z1, z2, z3] - temp[y, 1/z2, 1/z1, z3]]];       Print[FullSimplify[temp[y, z1, z2, z3] - temp[y, z1, 1/z3, 1/z2]]];       Print[FullSimplify[temp[y, z1, z2, z3] - temp[y, 1/z3, z2, 1/z1]]];       Print[FullSimplify[temp[y, z1, z2, z3] - temp[y, 1/z1, z2, z3]]];       Print[FullSimplify[temp[y, z1, z2, z3] - temp[y, z1, 1/z2, z3]]];       Print[FullSimplify[temp[y, z1, z2, z3] - temp[y, z1, z2, 1/z3]]];       Clearly doing the same with a large value of $n$ would get quite out of hand! I would like to know if there is a way to automate this.   * In general I would like to say have a $n \times n$ matrix acting on the zs (..thought of like a column n-vector..) and be able to test whether the function "temp" remains invariant under it.  I wonder if Mathematica can generate representation matrices for groups. Like if I want to actually test that "temp" is invariant under a fundamental/vector action of the group $U(n)$ on the zs then I would like in the above case the $n\times n$ matrix to be that representation of the $U(n)$ group.


Extracting polygons from 3D contour plot surface

**Edit: This question turned out to be two parts so I am going to make this question about only the first part a kguler provided an excellent answer.** Here is a better representation. My actual data consists of many points which I bin onto a grid.               data = RandomVariate[NormalDistribution[1, 3], {10^5, 3}];     rounded = Round@data;     gathered = Gather[rounded];     offset = -Min /@ Transpose@rounded + 1;     counts = Length /@ gathered;     (*I offset the data so I can use SparseArray from 1*)     coords = offset + # & /@ (First /@ gathered);      sparesearray = SparseArray[coords -> counts];      Each grid contains the count of the number of points that were in the grid cube (voxel). I now create a contour plot.               ListContourPlot3D[sparesearray, Contours -> {2.5}]      ![Mathematica graphics](http://i.stack.imgur.com/1Y3oa.png) In this case its ugly since its random data. However, in my real data it has discrete volumes. I want to find the points in the original data (or the offset data). I could simply use the bins with more than `n` counts but I was hoping to take advantage of the interpolation that `ListContourPlot3D` uses. How do I extract the polygons rendered by `ListContourPlot3D`? **early version below for posterity:** I have a set of data points in 3D and I want to extract the subset of points that is contained within the surface generated by a contour plot.               data = Table[x^2 + y^2 + z^2 + RandomReal[0.1], {x, -2, 2, 0.2}, {y, -2, 2,        0.2}, {z, -2, 2, 0.2}]      The sample data here is on a regular grid but my real data is not on a regular grid. It is defined: `(x, y, z, value)`.               plot = ListContourPlot3D[data, Contours -> {1}, Mesh -> None]      ![Mathematica graphics](http://i.stack.imgur.com/CBuik.png) `InputForm` returns a `GraphicsComplex` object but I'm not really sure how to determine the polygons in the surface and then how to determine which of the points are inside the surface and which are outside.


Push-pin Art – Convert image to R-Y-B-W-Blk color space

After seeing an example of what is called “Push-pin Art”, I assumed that _Mathematica_ would be able to handle the kind of image processing required to convert an image to this format. I am not well versed in the area of imagine processing: its vocabulary or methods so after several attempts, I decided to get help. What I would like to do:   1. Take any image and convert it to a Red-Yellow-Blue-White-Black color space with the ability to designate a desired resolution (width and height of the resulting pixel array) - i.e. to find a minimum acceptable image resolution.   2. Also, generate a list (2D array) of the colors used in the resulting image e.g. the color names: {{Y,B,R,R},{W,Blk,Y,B},{etc.}}. When I say RYBWBlk color space I mean that each pixel is forced to only one of these colors, where the eye itself does the blending. Attempts: [Using _Mathematica_ version 8]   * In _Mathematica_ , it did not seem possible to create my own indexed color scheme. Table[ColorData[i,"Image"],{i,ColorData["Indexed"]}]//TableForm   * The RYB… color space is not available to convert to.   * Posterization did not appear to give me control over the colors chosen, only the number of colors.  ImageEffect[Import["http://i.stack.imgur.com/wtgxH.jpg"],{"Posterization",8}]   * ColorQuantize seemed like a possible help but no success here. The following YouTube video and link show Exactly what I would like to be able to accomplish using _Mathematica_ alone. Photoshop image processing example. http://www.youtube.com/watch?v=USzbw90wOKM&feature=endscreen Further explanation. http://www.instructables.com/id/How-to-Make-a-Push-Pin-Portrait/


RegionPlot of a Double integration

Hey guys I have a problem where I want to sketch the region of integration:               Integrate[x Cos[y^2], {x, 0, 3}, {y, x^2, 9}]      I know I have to use `RegionPlot` but it is not working out for me. This is what I am doing: `RegionPlot[x^2, {x, 0, 3}, {y, 0, 9}]` Can anyone help me out?


Precision of sliders in WebMathemtica

I have been developing a manipulate plot to put on the web. One of my parameters varies over a small interval, `{{D32, 2.38*10^-3, "D32"}, 0.001227, 0.0049108}.` This is not an issue if I embed my code as a CDF, but I am also hoping to post it with WebMathematica. WebMathematica shows `D32` to be `0.00` and does not allow the user to adjust the toggle bar. I have tried `{{D32, 2.38*10^-3, "D32"}, 0.001227`15, 0.0049108`15}`, but am not sure what to do from there. Does anyone have any thoughts, or is webMathemtica's kernel simply reaching a limit of precision on this calculation.


How can I express an algebraic expression as a product?

I have a simply expression that I can see that I can express as a product.               -3.041109351939086` y^8.498317296251567` -       19.00693344961927` y^8.648317296251566` +       0.19006933449619273` y^9.498317296251567` +       x^4.676655975278822` (3.0411093519390855` y^3.8216613209727446` +          19.00693344961927` y^3.9716613209727445` -          0.19006933449619273` y^4.821661320972744`)      **EDIT: (To explain what I mean by product)** The above expression is this: $x^{4.67666} \left(-0.190069 y^{4.82166}+19.0069 y^{3.97166}+3.04111 y^{3.82166}\right)+0.190069 y^{9.49832}-19.0069 y^{8.64832}-3.04111 y^{8.49832}$ Eyeballing it I see that the term $ \left(-0.190069 y^{1}+19.0069 y^{0.15}+3.04111 y^{0}\right)$ is a common one and the above expression one can be written as: $ \left(-0.190069 y^{1}+19.0069 y^{0.15}+3.04111 y^{0}\right) \left(x^{4.67666}y^{3.82166}-y^{8.49832}\right)$ This is one way to write things as a product. I can always take $y^{3.82166}$ out as well and write it as: $ \left(-0.190069 y^{1}+19.0069 y^{0.15}+3.04111 y^{0}\right) \left(x^{4.67666}-y^{4.67666}\right)y^{3.82166}$   1. Other than re-writing it by hand, is there a command that I can use to write this expression as a product of two or more other expressions?   2. Is there something I can do in general? Something that takes common factors out where the factors can be large expressions that I am not aware of upfront? The point is that I am trying to figure out the signs of various expressions, hence the need to write things as products. Also, I am anticipating that the imprecise nature of numerical solving means that expressions that may be factors might not show up that way in MMA since different numbers are truncated differently. Still.... I'd appreciate tips even if they are conditional on the numbers being integers.


TableAlignments -> Left not working

Bug present in versions 7 through 10.0.0. * * * For a very simple dataset `TableAlignments->Left` does not work:               table = {{"chi1", {0.5732772714880409`, 0.37224553853824593`,          0.4406080034309774`}}, {"chi2", {0.11746301802400358`,          0.2410578341291309`,          0.20673964872863448`}}, {"chi3", {Missing["Only 1 points"],          Missing["Only 1 points"]}}, {"chi4", {0.05693578150660176`,          0.06300145309006996`,          0.09833005450944177`}}, {"chi5", {0.08916843025621737`,          0.07612462967770783`, 0.05993923221739268`}}}     tableImage =       TableForm[table,        TableHeadings -> {None, {"Dihedral", "\[Tau] per state [ns]"}},        TableAlignments -> Left]      ![Wrong output](http://i.stack.imgur.com/0i3F4.png) `TableAlignments->Right` seems to work ![Correct right-aligned output](http://i.stack.imgur.com/IX9TC.png) Am I missing something simple?


FullSimplify inconsistency

I'm pulling my hair out with this one. I have two complex functions f and g, ρ is real.               f = (-1)^(2/3) + 3/4 (1 - I Sqrt[3]) ρ -1/2 Sqrt[-(1 + (-1)^(1/3))^2 ρ (-4 + 3 ρ)];     g = (-1)^(2/3) + 3/4 (1 - I Sqrt[3]) ρ + 1/2 Sqrt[-(1 + (-1)^(1/3))^2 ρ (-4 + 3 ρ)];      I wish to simplify both, and specifically factor out the complex term out of the radical.               FullSimplify[ExpToTrig[f], 0 < ρ < 1]      > 1/4 (-2 + 2 I Sqrt[3] + (3 - 3 I Sqrt[3]) ρ + (-3 - I Sqrt[3]) Sqrt[(4 - 3 > ρ) ρ])               FullSimplify[ExpToTrig[g], 0 <= ρ <= 1]      > 1/4 (-2 + 2 I Sqrt[3] + (3 - 3 I Sqrt[3]) ρ + Sqrt[(-6 - 6 I Sqrt[3]) ρ (-4 > + 3 ρ)]) Mathematica does this with f but not with g! Then I try               f1 = -(1/2) Sqrt[-(1 + (-1)^(1/3))^2 ρ (-4 + 3 ρ)];     g1 = +(1/2) Sqrt[-(1 + (-1)^(1/3))^2 ρ (-4 + 3 ρ)];          FullSimplify[ExpToTrig[f1], 0 < ρ < 1]      > -(1/4) I (-3 I + Sqrt[3]) Sqrt[(4 - 3 ρ) ρ]               FullSimplify[ExpToTrig[g1], 0 <= ρ <= 1]      > 1/4 (3 + I Sqrt[3]) Sqrt[(4 - 3 ρ) ρ] How can I get Mathematica to consistently factor out the (3 + I Sqrt[3]) from the radical in both f and g?


How to construct a treemap using non-rectangles?

I've written the standard version of a tree map (a graphic that shows nested data) and I'm looking to improve on this layout by switching to different types of polygons or perhaps circles. Can anyone see a way to adapt this code in the style of a Voronoi diagram or otherwise? ![enter image description here](http://i.stack.imgur.com/3z5jd.png) ![enter image description here](http://i.stack.imgur.com/0c4Cf.png) Here is the code:               $buf = .05; $3Dbuf = .1; $3DQ = True;     ToList[x_List] := x;     ToList[x_] := {x};     FlatJoin[list___] := Join @@ (ToList /@ {list});     Second[x_] := x[[2]];          $frameStyle = Sequence[EdgeForm[Directive[Opacity[0.6], Black, Thin]], GrayLevel[.7], Opacity[.1]];         $leafStyle = Sequence[EdgeForm[Directive[Black, Thin]], GrayLevel[1], Opacity[1]];              drawRectangle[{p1_, p2_}, area_List, max_, depth_] /; Length[area] > 1 :=          {{$frameStyle,               If[$3DQ, Cuboid[Append[p1, depth], Append[p2, depth]], Rectangle[p1, p2]]},         {First @ TreeMap[area, (1-$buf)p1 + $buf p2, (1-$buf)p2 + $buf p1, max, depth + $3Dbuf]}};              drawRectangle[{p1_, p2_}, _, max_, depth_] := {$leafStyle,                If[$3DQ, Cuboid[Append[p1, depth], Append[p2, depth]], Rectangle[p1, p2]]};                   TreeMap[areas2_, lowerLeft2_, upperRight_, max_, depth_:0] := Module[             {                 width, height, area, aspectRatio, fixedLengthDirection,                 fittedAreas, i, j, varLength, fixedLength, incs, last,                 aspectRatios, incsPts, lowers, uppers, layout, vl, recs,                 prims, lowerLeft, areas, areas1             },                  prims = {};             areas1 = areas2 / Total[areas2, {1, Infinity}] * Apply[Times, upperRight - lowerLeft2];             areas = Total[areas1, {2,Infinity}];             lowerLeft = lowerLeft2;             For[j = 1, j <= Length[areas], Null,                  {width, height} = Subtract[upperRight, lowerLeft];             area = width * height;             aspectRatio = width / height;                  If[aspectRatio < 1,                 fixedLength = width;                 fixedLengthDirection = "Horizontal",                 fixedLength = height;                 fixedLengthDirection = "Vertical"             ];                  If[j == Length[areas],                  AppendTo[prims,  drawRectangle[{lowerLeft, upperRight}, Last @ areas1, max, depth]]; Break[]];                  For[i = j, i <= Length[areas], i++,                 fittedAreas = areas[[j;;i]];                 varLength = Total[fittedAreas] / fixedLength;                 incs = fittedAreas / varLength;                 If[i > 1 && Max[varLength / incs] >= max, Break[]];                 layout = {varLength, incs, areas1[[j;;i]]};             ];             j = i;                  If[fixedLengthDirection === "Vertical",                 incsPts = FlatJoin[Second[lowerLeft], Second[lowerLeft] + Accumulate[layout[[2]]]];                 lowers = Thread[{First[lowerLeft], Most[incsPts]}];                 uppers = Thread[{First[lowerLeft] + layout[[1]], Rest[incsPts]}];                 recs = Transpose[{lowers, uppers}]             ,                 incsPts = FlatJoin[First[lowerLeft], First[lowerLeft] + Accumulate[layout[[2]]]];                 lowers = Thread[{Most[incsPts], Second[lowerLeft]}];                 uppers = Thread[{Rest[incsPts], Second[lowerLeft] + layout[[1]]}];                 recs = Transpose[{lowers, uppers}]             ];                  AppendTo[prims, MapThread[                 drawRectangle[##, max, depth]&, {recs, layout[[3]]}]];                 lowerLeft = If[fixedLengthDirection === "Vertical",                 {First[lowerLeft] + layout[[1]], Second @ lowerLeft},                  {First @ lowerLeft, Second[lowerLeft] + layout[[1]]}             ];             ];                   If[$3DQ, Graphics3D[#, Boxed -> False,                  Background -> Black]&, Graphics][{prims}]         ];


How do I reorder vertices in a graph?

I have a directed acyclic graph $g$, and I'd like to re-order the vertices in this graph object such that when I call               VertexList[myGraph]      the vertices appear in topologically sorted order. The naive solution is to make a new graph as follows:               myGraph = Graph[TopologicalSort[g], EdgeList[g]]      but it seems that the graph object sorts its vertices. So this method is no good.


How can one define an infix operator with an arbitrary unicode character?

You can setup "UsefulFunction[a, b]" to use custom infix notation "a [LeftRightArrow] b" as follows:               Needs["Notation`"];     AddInputAlias["4" -> ParsedBoxWrapper["\[LeftRightArrow]"]];     InfixNotation[ParsedBoxWrapper["\[LeftRightArrow]"], FlatJoin];      ![enter image description here](http://i.stack.imgur.com/RyG04.png) But using a unicode character that does not have a mathematica definition (e.g. "\\[name]") such as "\:27d7" gives you an error: ![enter image description here](http://i.stack.imgur.com/4ibPi.png) Now the syntax highlighting is broken, and that is really my question: _how can you tell mathematica to correctly syntax highlight new unicode infix operators?_ (Note: the messages can by avoided by adding internal information on the character as follows:               Notation`Private`internalCharacterInformation["⋗"] = {"0x2295", "Infix", "450", "None", "3", "3", "MyOp"}; InfixNotation[ParsedBoxWrapper["⋗"], FlatJoin]      **Edit:** I'm now pretty sure that the answer will involve editing /Applications/Mathematica.app/SystemFiles/FrontEnd/TextResources/UnicodeCharacters.tr and adding something like               0x22D7      \[FlatJoin]     ($fj$   $&FlatJoin;$   $\oplus$)        Infix       320     None        4       4      and then using the Notations package...


Issue with PathGraph

I am having a strange issue with `PathGraph`. Executing               PathGraph[{a, b, c}]      or `PathGraph[{1,2,3}]`, etc., returns a path-graph with three vertices as expected. However, executing:               In[10]:= PathGraph[{v1, v2, v3}]     Out[10]= PathGraph[{v1, v2, v3}]      That is, it stays unevaluated instead of returning the `Graph` object. I tried several variations and apparently the issue occurs whenever `v2` is among the vertices. That is all of `PathGraph[{a1, v2, a3}]`, `PathGraph[{v2, x}]`, `PathGraph[{1, 2, v2, x}]`, etc. remain unevaluated after execution. I tried this on two computers, both with clean Kernels (with no definitions made or packages loaded, etc.). Mathematica version: 8.0.0.0 Can anyone reproduce this? Is this a bug? **Update: This is working correctly in version 9.**


Recovering data points from an image

Unfortunately, some data can only be obtained in picture form (Japanese publications anyone?). Since this cannot be worked with, it has to be converted to a dataset that can; I was wondering whether this could be done in Mathematica. Consider the following example image: ![enter image description here](http://i.stack.imgur.com/wdTu4.png) The task consists of two steps:   1. Extract a point set from the graph   2. Finding a function that takes out the distortion and applying it to the data set Is there some streamlined way of doing this in Mathematica? The result should be a point set that is as accurate as possible, think of something whose `Interpolation` could be easily and accurately ploted. Bonus points for no _Get Coordinates_ to trace the graph. Here's the code used to generate the image above:               img = ImagePerspectiveTransformation[         Rasterize[             Plot[x^((x - 2)^2 E^-x) + E^-x, {x, 0, 10}, PlotStyle -> Thick],             ImageSize -> 400         ],         {{1, 0.1`, 0}, {0.1`, 1, 0}, {0, 0.1`, 1}},         Padding -> White     ]


Grid generation around airfoil from data

Here is the data http://wikisend.com/download/405620/datapoints.dat I have (x,y) data for a grid around an airfoil and I am trying to figure out how I can draw radial and polar lines for the grid to look like a mesh. I have tried ListPlot and ListLinePlot, but I have only managed to get circular lines, but not radial ones. Here is what the data looks like: ![Airfoil](http://i.stack.imgur.com/HTcHG.png) and here is ListLinePlot ![Airfoil LLplot](http://i.stack.imgur.com/5L6b2.png) How can I improve these images?


Displaying a series obtained by evaluating a Taylor series

### Description of problem I would like to use Mathematica to display the series obtained by substituting a value for $x$ in a Taylor series expansion. The terms of the series will be rational numbers, so they should be in their reduced forms. For example, consider the following partial sum:               In[1]:= taylor=Series[Log[1+x],{x,0,6}] // Normal     Out[1]= x-x^2/2+x^3/3-x^4/4+x^5/5-x^6/6      If I use `ReplaceAll` to carry out the substitution $x=1$, then I will get               In[2]:= taylor /. {x->1}     Out[2]= 37/60      as opposed to $1-\frac{1}{2}+\frac{1}{3}-\frac{1}{4}+\frac{1}{5}-\frac{1}{6}$. * * * ### First attempt The first thing which comes to mind is the following:               In[3]:= HoldForm[Evaluate[taylor]] /. {x->1}     Out[3]= 1-1^2/2+1^3/3-1^4/4+1^5/5-1^6/6      Now I just need to replace each of the terms with its simplified versions. The first problem is that `Evaluate` only works on level 1, so the following code does not work.               In[4]:= Map[Evaluate,%,{2}]     Out[4]= Evaluate[1]+Evaluate[-(1^2/2)]+Evaluate[1^3/3]+Evaluate[-(1^4/4)]+Evaluate[1^5/5]+Evaluate[-(1^6/6)]      **Is there a way to carry out an evaluation deep inside`HoldForm`?** I also tried applying `Replace` at level 2, but the correct replacement rule still eludes me.               In[5]:= Replace[                HoldForm[Evaluate[taylor]] /. {x->1},                {x_->Evaluate[x]},                {2}]     Out[5]= 1-1^2/2+1^3/3-1^4/4+1^5/5-1^6/6      If I knew the appropriate replacements to carry out without peeking inside `HoldForm`, say `x_->0`, then the code above would work. **How can I carry out the idea behind`In[5]`?** * * * ### Second attempt If I am satisfied with just having a list of the terms, the following is certainly good enough:               In[6]:= List@@taylor/.{x->1}     Out[6]= {1,-(1/2),1/3,-(1/4),1/5,-(1/6)}      I can use `HoldForm` to prevent `Plus` from collapsing the series while retaining the pretty typesetting on the front end:               In[7]:= HoldForm[Plus[1,-(1/2),1/3,-(1/4),1/5,-(1/6)]]     Out[7]= 1+-(1/2)+1/3+-(1/4)+1/5+-(1/6)      So splicing the sequence portion of `Out[6]` into `HoldForm[Plus[...]]` is just what I need. My plan was to use the splicing trick with `Sequence`, but that does not work within `HoldForm`. For example,               In[8]:= HoldForm[Plus[Sequence[1,2]]]     Out[8]= +Sequence[1,2]      **Is there a way to splice`Out[6]` into `HoldForm[Plus[...]]`?**


Faster list duplicate 'limiter'

Given some list, e.g., `{5, 3, 2, 3, 1, 0, 1, 3, 5, 5, 4, 5, 1, 2, 5, 2, 2, 0, 1, 4}`, I need to limit the duplicates, if any, to an arbitrarily chosen number. The excess duplicates are to be chopped from the end of the list, order of list must be otherwise untouched. For example, with a limit of 2, the above example would become `{5, 3, 2, 3, 1, 0, 1, 5, 4, 2, 0, 4}`. List can contain pretty much anything that would make sense. I'm using               Module[{o = Ordering@#},        o[[o]] = Join @@ Range /@ Tally[#[[o]]][[All, 2]];        Pick[#, UnitStep[#2 - o], 1]] &[yourListHere, dupeLengthLimitHere]      which is fairly quick, wondering if there's a better can-opener for this.


Two controls to Manipulate all elements of a list

Say, I have a list `list` and I don't want to assign different names to all its elements. What I want to do it to be able to interactively manipulate any of the elements of `list`. And if my selection of an element changes, then the slider of its value has to reset to its current value. This is what I have tried (in fact, all this happens inside a massive `DynamicModule` inside a `Manipulate`):               list=Table[0,{i,1,100}];     Manipulate[     Refresh[x=list[[elementChoice]], TrackedSymbols:>{elementChoice}];     Refresh[list[[elementChoice]]=x, TrackedSymbols:>{x}];     ,     {{elementChoice,1,"Element's number"},1,Length[list],1},{{x,0,"element's value"},0,1}]      but it just resets `x` to zero if I try to change it.


Symbolic matrix calculus: What's new in Version 9

I have seen some of the related posts, which ask about doing matrix calculation on tensors unknown dimensions. One of the posts mentioned that version 9 has some capability, but it was concerned about simple matrix algebra, but not calculus. I would specifically like to know if with the addition of Tensor package in version 9, if the following is possible: $a, \lambda \in R^n$, and $C\in R^{n\times n}$ Here $n$ is unknown/symbolic variable. I am trying to find derivative of expressions which involve matrix-vector products such as (to give a simple example) $f(a,\lambda)=\dfrac{\lambda^T Ca}{\sqrt{a^T C a}}$ I would like to know if using Mathematica we can find expressions of $\dfrac{\partial f}{\partial a}$ etc. Thanks.


Print argument of function that exceeds $RecursionLimit

Is there a way to print the argument of a function which results in a `$RecursionLimit::reclim` error? As an example, cosider the code               fib[n_] := If[n == 1, 1, n*fib[n - 1]];     fib[5]     (* 120 *)     fib[1023]     (* $RecursionLimit::reclim: Recursion depth of 1024 exceeded. *)      the ideal output should be something like _120_ _Recursion error for n=1023_ _$RecursionLimit::reclim: Recursion depth of 1024 exceeded._ Any suggestions?


The mysterious gap inside Grid

There's this gap inside Grid which I cannot seem to remove. Perhaps someone knows how.               blocks = Table[{Graphics[{Darker@Green, Rectangle[{0, 0}, {1000, 200}]}]}, {i, 6}]     myGrid = Grid[blocks, Spacings -> {0, 0}, Frame -> All]      ![At 100% resolution.](http://i.stack.imgur.com/yAW6l.png) All nice and even at 100% zoom. Now if I zoom in on this to say 640% inside the notebook: ![At 640% resolution](http://i.stack.imgur.com/2rPM4.png) Extra space appears below each item as shown. The orange box received by clicking on the graphics suggests that Grid is responsible for the gap but Spacings have already been set to 0. Ssing Magnify will also cause the issue to appear at lower zoom rates. Does anyone know a fix for this in Grid? Or do I have to resort to GraphicsGrid which doesn't have this issue. EDIT: This is the result produced from using the code as provided by Mike's answer (copy and pasted). ![Mike](http://i.stack.imgur.com/Yg4rG.png) And this one with it magnified so the code can be included in the screenshot. ![magnified](http://i.stack.imgur.com/itDWd.png) I'm going to re-emphasize that this issue only occurs when I zoom in far enough or use Magnify. Edit2: I'm on Mathematica 9.0.0


How DSolve with a multisymbol function argument

I used DSolve on a differential equation e got the following result: ![enter image description here](http://i.stack.imgur.com/mBcY0.png) You may notice that C[ 1 ] is a function of the variables r and z in a defined form. If I substitute this result in my differential equation, it is the solution - nice. Now I can plug this in my other differential equation to build a differential equation in C[ 1 ]: ![enter image description here](http://i.stack.imgur.com/5MZFd.png) The question is, how can I use DSolve on this? If I do: ![enter image description here](http://i.stack.imgur.com/lNKAA.png) I get: ![enter image description here](http://i.stack.imgur.com/8bgoe.png) ![enter image description here](http://i.stack.imgur.com/ifEEc.png)


Removing the edge features of an image while enhancing internal connectors

I picked up the following leaf today while going for a walk. ![enter image description here](http://i.stack.imgur.com/cnvC4.jpg) And wanted then to run the same analysis that @Vitaly Kaurov did for rivers under this posting Measuring Fractal Dimensions of natural objects from digital images and then also proceed to measure the length of branches and angles of the ribs and veins of the leaf as shown in this other posting. how-to-measure-segment-length-and-branch-angle The final objective would be to collect different leaves from different species and prepare some sort of visualization of the different species. I played around with different ImageProcessing functions, the best I could do was the following.               leaf = ImageRotate[Import["http://i.stack.imgur.com/cnvC4.jpg"], \[Pi]/2];     leafBW = ColorSeparate[leaf, "RGB"][[3]];     ribs = ImageAdd[MinDetect[leafBW, 0.27], MaxDetect[leafBW, 0.27]]      ![Processed Leaf](http://i.stack.imgur.com/S4khO.png) The questions are:   1. Is there a better way to process the image to maximize the details of ribs and secondary veins?   2. How can we eliminate the edge of the leaf from the image?


Multi-legend issue in ChartLegends?

Been fiddling around with the legends and trying to place one in each corner and I bumped into an issue:               BarChart[{{12, 14, 16, 18}, {8, 10, 11, 12}, {2, 5, 6, 7}, {1, 3, 5, 7}},        ChartStyle -> {Green, Blue, Red, Orange}, ChartLegends ->            MapThread[Placed[PointLegend[{#1},{TextCell[#2,TextAlignment->Left]},       LegendMarkers->{#3},LegendMarkerSize->20,LabelStyle->{FontFamily->"Arial",18}       ,Spacings->{0.2,0.2}],#4]&,{{Green, Blue, Red, Orange},        {"A","B","D","C"},{{"\[FilledSquare]",22},{"\[FilledCircle]",22},{"\[FilledUpTriangle]",22}       ,{"\[FilledDiamond]",22}},{{0.8,0.1},{0.1,0.1},       {0.1,0.8},{0.8,0.8}}}]]      ![Result](http://i.stack.imgur.com/48Lby.png) which doesn't show all 4 legends. But this works for PlotLegends as below               ListPlot[{{{0.2, 0.4}, {0.4, 0.8}}, {{0.1, 0.5}, {0.3, 0.7}}, {{0.4, 0.7},        {0.7, 1.1}}, {{0.1, 0.7}, {0.8, 0.5}}}, Joined -> True, PlotStyle-> {Green, Blue, Red, Orange},       PlotMarkers -> {\[FilledSquare], \[FilledCircle], \[FilledUpTriangle], \[FilledCircle]}       , PlotLegends -> MapThread[Placed[PointLegend[{#1},       {TextCell[#2,TextAlignment->Left]},LegendMarkers->{#3},LegendMarkerSize->20,       LabelStyle->{FontFamily->"Arial",18},Spacings->{0.2,0.2}],#4]&,{{Green,        Blue, Red, Orange},{"A","B","D","C"},{{"\[FilledSquare]",22},{"\       [FilledCircle]",22},{"\[FilledUpTriangle]",22},{"\[FilledDiamond]",22}},       {{0.8,0.1},{0.1,0.1},{0.1,0.8},{0.8,0.8}}}]]      ![enter image description here](http://i.stack.imgur.com/pcox1.png) A workaround possibly is using Epilog to inset the legends into their positions. But I was wondering if anyone knew why this did not work for ChartLegends? **Edit** : Added image for ListPlot, and fixed the syntax.


Complex number operations: telling Mathematica variables are real

I want to do `Conjugate[a + b*I]`, but when I do that, the solution is `Conjugate[a] - I*Conjugate[b]`; when for me, a and b are reals. I want to obtain the following expresion : `a-b*I` The same problem exists with the function `Abs`.


Finding mappings between expressions

Suppose we have an expression of the form: $j=\frac{A\left(t\right)}{B\left(t\right)}=\frac{C\left(s\right)}{D\left(s\right)}$ That is, $j$ can be expressed either as a function of $t$, or as a function of $s$. Is it possible to use Mathematica to find the substitution $t\rightarrow h\left(s\right)$ which takes us from the first of these forms for $j$ to the second, assuming both are known? Actually, my own problem is slightly more complicated than this. Suppose again that we have: $j=\frac{A\left(t\right)}{B\left(t\right)}$ And that we know this form of $j$ exactly (specifically, I am looking at the Index 36 $j$-invariants on page 5 here: http://mysite.science.uottawa.ca/asebbar/publi/mcse.pdf). This time, we want to find a substitution $t\rightarrow h\left(z_{1},z_{2}\right)$ which puts $j$ into the form: $j=\frac{4f\left(z_{1},z_{2}\right)^{3}}{4f\left(z_{1},z_{2}\right)^{3}-27g\left(z_{1},z_{2}\right)^{2}}$ Where $f$ is a homogenous polynomial of degree 8 in each of the $z_i$, and $g$ is a homogenous polynomial of degree 12 in each of the $z_i$. Is it possible to write a Mathematica script to identify these kinds of substitutions? Many thanks! **Edit:** Here is the first $j$ from the linked document, in Mathematica input form:               j1:={(t^3+4)^3(t^3+6t^2+4)^3(t^6-6t^5+36t^4+8t^3-24t^2+16)^3}/     {t^6(t+1)^3(t^2-t+1)^3(t-2)^6(t^2+2t+4)^6}      **Edit 2:** Here are some explicit $j$ for the first part of my question:               j2s:={16(1+14s^4+s^8)^3}/{s^4(s^4-1)^4}          j2t:={(t^4-4t^3+8t^2+16t+16)^3(t^4+4t^3+8t^2-16t+16)^3}/     {t^4(t-2)^4(t+2)^4(t^2+4)^4}      According to page 21 here, the subsitution in this case is $s\rightarrow t/2$.


Programmatic approach to HDR photography with Mathematica image processing functions

The **High dynamic range imaging (HDR or HDRI)** direction in photography and image processing became very popular recently. Besides obvious photo art applications (see examples), there are many great opportunities in computer vision and graphics.The German Max Planck Institute has a page dedicated to the pipeline of related technologies, publications and discussions. I wonder if our community has members who are knowledgeable enough to reproduce a correct algorithm in Mathematica's top level image processing functions. I hope the answers may also serve as a good intro to methodology from the programmatic point of view. **I am sure code will be quite short and consider this to be a very practical down to earth question.** There are many Photoshop-like tutorials online. I won't link to them because they are quite easy to find and I cannot judge which one reflects the right approach. Read a concept article about HDR here. I found this interesting research site with Mathematica notebook and manual provided (read down the page). Unfortunately it gives only part of the process – tone mapping, and is written in Mathematica version 6, while there have been many image processing upgrades in the current version 8. **Precise question formulation:**   * Consider a set of images taken at different exposures – like these public images   * Write Mathematica code that produces an HDR image – like the one here labeled “Local tone mapping”   * Implement any HDR algorithm (there are a few) by any Mathematica means possible **Additional resources.**   * A review of HDR algorithms   * A classical image set to test an HDR technique is Paul Debevec's HDR photo of Stanford Memorial Church. So I think we can also try to get something like this out of original set of images found on this page.   * This is a related Mathematica.SE question.


Is this a good way to assign a Solve result to a function?

My code:               (* v1 = ripple minimum, v2 = ripple maximum *)     Clear[ripple, v1, v2, dc, rc, t0];      r = Solve[{v1 + (1 - v1) (1 - E^(-dc t0/rc)) == v2 && v2 E^(-(1 - dc) t0/rc) == v1 &&            ripple == v2 - v1}, {v1, v2, ripple}]      which returns ![enter image description here](http://i.stack.imgur.com/iXeba.png) Now I wanted to assign the expression for ripple to a function, and after a couple of failed attempts I came up with this:               ripple[t0_, rc_, dc_] := Evaluate[First[r][[3,2]]]      This works, but I don't know if this is good practice, and I don't want to get bad habits. So, what's the "right" way to do this?


How to make a stereogram in Mathematica? (2)

Given a tiled background and a depth map, both of the same dimension, I tried to produce a stereogram using the following codes which was adopted from the method given by Simon Woods, but in a simplified way. However, there are defects in the outcomes. What is wrong in the codes?               depMap = Import["http://i.stack.imgur.com/RvZZT.jpg"];     flower = Import["http://i.stack.imgur.com/9vmBl.jpg"];     {wid, hei} = ImageDimensions[flower]     imData = ConstantArray[{0, 0, 0}, {hei, wid}];     imc = ImageCrop[flower, {32, hei}, Right];     exflower = ImageData[ImageAssemble[{flower, imc}]];     shift = Round[32 ImageData[depMap]] ;          For[r = 1, r <= hei, r++,       For[c = 1, c <= wid, c++,        imData[[r, c]] = exflower[[r, c + shift[[r, c]]]]]];     Image[imData]      Depth map: `(800x632)` ![enter image description here](http://i.stack.imgur.com/RvZZT.jpg) Tiled background: `(800x632)` ![enter image description here](http://i.stack.imgur.com/9vmBl.jpg) Outcome: A pyramid of flowers is expected, but instead there are a triangular stack and a triangular hole. ![enter image description here](http://i.stack.imgur.com/5ns4e.jpg)


Notebook with a WindowOpacity too small becomes "click-through" for mouse

I created a notebook and was manipulating its `WindowOpacity` option:               nb = CreateDocument[];     Manipulate[SetOptions[nb, WindowOpacity -> op], {{op, .3}, 0, 1}]      It works fine as a half-transparent window when the option has a value not too small, say `0.3` (Have written something in `nb` to make it more prominent against the web brower window behind): ![Mathematica graphics](http://i.stack.imgur.com/kZsjk.png) But when the value of the option is less than a certain threshold (in my case `0.004`), the `nb` window seems to be "click-through" for mouse, eventhough it should be still in place in front of the web brower window: ![Mathematica graphics](http://i.stack.imgur.com/Fo0uw.png) **The question:** Is this "click-through" behavior a feature or a bug-like thing? And why such a nonzero threshold? ps. My environment is _Windows 7_ (x64) and _Mathematica_ 8.0.4.


Drawing outside Plot area

I want to programmatically draw some objects outside the Plot area in my Plot's Epilog, like in this dummy: ![enter image description here](http://i.stack.imgur.com/143S4.png) I found `PlotRangeClipping` and hoped that would be the solution, but setting it to False only gives me a very little bit of extra space: ![enter image description here](http://i.stack.imgur.com/nYJ8E.png) How can I get that extra space? For extra credit: I want my arrows smaller and my text bigger. `ArrowHeads` give all kinds of sizes, but I can't seem to control it. Also, my text is positioned a bit more to the right than the arrows, but I'd like to align it left, so that I can use the same X-coordinate. Lastly, below's my code. Constructive criticism is welcome, if you're curious enough to read it :-).               dc1 = 0.1; dc2 = 0.6; period = 1; rc = 3; y0 = dc1; mint = -4; maxt = 20;      maxt2 = maxt - (maxt - mint)/5; tsplit = 0;      rectangleWave[t_, period_, duty_] := UnitBox[Mod[t/period, 1.]/(2. duty)];     pwm1[t_] := rectangleWave[t, period, dc1];      pwm2[t_] := rectangleWave[t, period, dc2];      pwm[t_, tsplit_] := Piecewise[{{pwm1[t], t < tsplit}, {pwm2[t], t >= tsplit}}];     step[t_, tstep_, dc1_, dc2_] := dc1 + (dc2 - dc1) UnitStep[t - tstep];          (* ripple functions *)     Clear[ripple, v1, v2, duty, t0, rc1];      r = Solve[{v1 + (1 - v1) (1 - E^(-duty t0/rc1)) == v2 &&          v2 E^(-(1 - duty) t0/rc1) == v1 && ripple == v2 - v1}, {v1, v2, ripple}];     ripplemin[t0_, rc1_, duty_] = First[v1 /. r];     ripplemax[t0_, rc1_, duty_] = First[v2 /. r];     rippleampl[t0_, rc1_, duty_] = First[ripple /. r];     y0 = ripplemin[period, rc, dc1];          (* main function *)     ss = NDSolve[{rc  y'[t] + y[t] == step[t, tsplit, dc1, dc2], y[0] == dc1},         y, {t, mint, maxt}];      s = NDSolve[{rc  y'[t] + y[t] == pwm[t, tsplit], y[mint] == y0},          y, {t, mint, maxt}, MaxStepSize -> 0.05];          (* find end ripple *)     ripple = rippleampl[period, rc, dc2]; NumberForm[ripple, {3, 3}]     rpmin = ripplemin[period, rc, dc2];     rpmax = ripplemax[period, rc, dc2];          (* Plot *)     Plot[{pwm[t, tsplit], Evaluate[y[t] /. s], step[t, tsplit, dc1, dc2],          Evaluate[y[t] /. ss]}, {t, mint, maxt}, Exclusions -> None,          ImageSize -> {480, 300}, PlotRange -> All, PlotPoints -> 1000,          PlotStyle -> {Automatic, Automatic, Thick}, Axes -> {True, False},          PlotRangeClipping -> False,          Epilog -> {{Table[{Dotted, Line[{{mint, i}, { maxt, i}}]}, {i, 0, 1, 0.2}]},             {Dashed, Line[{{maxt2, rpmin}, {2 maxt, rpmin}}]},              {Dashed, Line[{{maxt2, rpmax}, {2 maxt, rpmax}}]},             {Text[NumberForm[ripple, {3, 3}], {maxt + 1, dc2}]},             {Arrow[{{maxt + 0.1, rpmax + 0.1}, {maxt + 0.1, rpmax}}]},               {Arrow[{{maxt + 0.1, rpmin - 0.1}, {maxt + 0.1, rpmin}}]} }]


Is this 30% slowdown in Mathematica 10 due to DownValues lookup time?

Running several numerical self-programmed packages I realized already some time ago that Mathematica 10 needed between 20 and 40% more time. I did already report this of course with a simple example to Wolfram support, but have somehow not got any official response. Investigating a bit more I would like to ask with this specific example (which seems to be even more terrifying under Linux, don't know MacOSX) why this slowdown happens. Is it maybe the DownValues lookup time? Is there some other reason? Like the kernel is slowed down due to the massive amount of new functions or packages? Or nobody cares anymore about performance for user-programs longer than one line? Or should we cloud-less users all just wait for a better Mathematica 10.0.1 release? This                  zeit[dval_, m_] :=            With[{dv = dval, n = m},             Block[{f},                   Do[f[i, x_] := x*i,                      {i, dv}                  ];                   First[                     Timing[                          Table[f[i, 42], {i, dv}, {n}]]]]          ];         Timing[checkit = Table[ zeit[dv, n],                                  {dv, 200, 600, 200},                                  { n, 200, 600, 200}]; ]      runs about 35 % slower in Mathematica 10.0.0 on Windows 8.1 compared to Mathematica 9.0.1 on the same computer. Dividing the values for `checkit` in V10 by the values from V9 gives for me approximately:               {{1.29, 1.39, 1.36}, {1.36, 1.33, 1.35}, {1.38, 1.36, 1.35}}      What timings do others get?


Definite Integral. Perfomance problem

I have a notebook in Mathematica 4. I'm trying to convert it to use in Mathematica 9. One of the problem is the long computation of definite integral. In Mathematica 4 the result of the following code ![code](http://i.imgur.com/0ILEIew.png) is ~18.4 and ~0.66 seconds, but the same code in Mathematica 4 gives me 0.266 and 0.031 ! Why? upd. The code itself:               B[i_,j_]:=Integrate[(x-i)^i x^j,{x,-5,5}];     Timing[Sum[B[i,1],1,10];]      The real program is much more complex. This is just the small part of it.


Get the first element after the first sequence of length N of consecutively increasing values

I'm looking for an efficient way of extracting the first element after the first sequence of N consecutive elements in which the values are increasing. If these are the data of a toy example:               data = {{1, 4}, {2, 3}, {3, 4}, {4, 5}, {5, 6}, {6, 4}, {7, 6}, {8,         3}, {9, 4}, {10, 5}, {11, 6}, {12, 7}, {13, 8}, {14, 9}, {15, 10}};      and I would like to get the first element after the first sequence of 5 consecutive increasing values (from those in second position), I should obtain the row {13,8}. I was playing around with:               Split[data, #2[[2]] > #1[[2]] &]      that groups my data in sequences of increasing values, but I wasn't able to find a way to add the additional constraints I need. Any hint is much appreciated.


How To Span Table Headings?

What I am doing wrong? I would like to get a header to the table and based on your code I tried this:               hdr = {{"Calculated Coordinates", SpanFromLeft}, {"No", "x", "y"}};     hdr1 = Grid[hdr, Frame -> All];          legendmarkers=Range@Length@data;
                         legendlabels=Map[Style[AccountingForm[#, 10], FontSize -> 20, FontFamily -> "Calibri"] &, data, {-1}];
                         styledheaders=Style[#,Bold,FontSize -> 22,FontFamily -> "Calibri"] & /@ {hdr1};
                         legendGrd = Grid[Prepend[Transpose[Join[{legendmarkers},      Transpose[legendlabels]]], styledheaders], Frame -> All,     BaseStyle -> {FontSize -> 20, FontFamily -> "Calibri"},     FrameStyle -> GrayLevel[.9], Alignment -> {Center, Center},     Background -> {None, {GrayLevel[.5], {GrayLevel[.8]}}}]      The result is: ![Legend](http://i.stack.imgur.com/woyJl.jpg) "Calculated Coordinates" should span all three columns, and "No", "x", and "y" should be the header of the corresponding columns. What must I do to get this? Again, thanks a lot!!


How to map rotate, pan, zoom to manipulate controls

I am wondering if there is a way to restrict the motion of the rotate mouse cursor in when moving around a 3d plot. For example, I want the y direction of the cursor to correspond to pulling the z axis toward or away from me (the camera), and the x direction to rotate the graphic around the z axis. I can do something similar using,               Manipulate[      Graphics3D[{Sphere[{1, 0, 0}, 0.05], Sphere[{0, 0, 0}, 0.2],      {Arrow[{{0, 0, 0}, {1.1, 0, 0}}], Text["x", {1.2, 0, 0}],        Arrow[{{0, 0, 0}, {0, 1.1, 0}}], Text["y", {0, 1.2, 0}],       Arrow[{{0, 0, 0}, {0, 0, 1.1}}], Text["z", {0, 0, 1.2}]}},      ViewVector -> {40 {Cos[a] Sin[b], Sin[a] Sin[b], Cos[b]}, {0, 0, 0}},      ViewAngle -> 4 Degree ,     SphericalRegion -> True,     Boxed -> False     ],     {{a, 0.3}, -2 \[Pi], 2 \[Pi]},     {{b, 1.347}, -2 \[Pi], 2 \[Pi]}     ]      where sliding $a$ rotates the graphic around the z axis (or rather the viewpoint) and sliding $b$ pulls the z axis in or out. # Edit to make description clearer The 3 dimensional ViewVector seems to be changed somehow by the 2 dimensional "double arrow Rotation" cursor when clicking and dragging on the plot. I am not even sure how this is possible, but is it possible to restrict it so that only 2 of the 3 Euler angles (e.g. rotation about the z axis and inclination of the x-y plane) are changed? The third Euler angle is natively controlled by the "additional rotation" cursor, which is available when you put the cursor in the corner.


Socket communication and player pro

I'd like to create a simple communication channel between MMA and the animation package 'Maya'. This is possible over sockets ( very simple, just sending and receiving strings). I've got this working perfectly, by writing a simple .NET dll which sends and receives strings and calling this DLL with NET link. However, player pro doesn't support NET link so I'm unable to deploy this outside MMA. Is there any way to send and receive strings over TCP/IP sockets in a way that Player Pro would support? Thanks!


Implementation of builtin function Fold

In the documentation for fold, it says                   Fold[f,x,list] gives the last element of FoldList[f,x,list].      But this is surely not the way it is implemented, right? In those cases where each step of the `Fold` returns a large object, it would be a huge waste of memory to actually store the whole list and then just pick the last element at the end. How can I test this? Does `Trace` work as advertised, or does it skip printing intermediate steps sometimes?


In a Manipulate[], control timing of Autorun

I've made a gauge like instrument that will get used to prompt someone to maintain rhythmic breathing patterns during heart/brain coherence training.               Manipulate[ListLinePlot[(Table[#, {10}] & /@ Range[10]) a,       PlotRange -> {{0, 11}, {0, 10}},       AspectRatio -> 3.5,       ImageSize -> 100,       PlotStyle -> LightGray,       Axes -> {False, True},       Filling -> Axis,       FillingStyle -> LightGreen,       Frame -> True,       FrameTicks -> {{True, True}, {None, None}}       ], {a, 0, 1},      Paneled -> False,      ControlType -> None,      AutorunSequencing -> 3      ]      Note that after executing the code you'll need to click on the `+` in the upper right corner of the output to get to `Autorun`, which will get you the following: ![enter image description here](http://i.stack.imgur.com/iwDIu.png) This nicely runs up and down, but now I'd like the ability to set four things programatically.   * A default speed at which the gauge will run up (e.g., 5 seconds);    * A default speed at which the gauge will run down (e.g., 4 seconds);    * A timed delay at the bottom (e.g., 2 seconds, which I currently kind of hack with `AutorunSequencing -> 3`); and    * A timed delay at the top. I had originally tried doing this with `Animate[]`, but it seemed to have too many limitations. Maybe the same holds for `Manipulate[]` and I have to go to basics with `Dynamic[]`. I thought it worth asking. Any suggestions welcomed.


How can I install a new stylesheet in CDF Player?

I've created my own stylesheet and I would like to install it in the CDF 9 directory, so when I apply it to a new _Mathematica_ notebook and save it as CDF file, it will show it correctly. I used this path in my computer: `C:\Program Files (x86)\Wolfram Research\Wolfram CDF\Player\9.0\SystemFiles\FrontEnd\StyleSheets` but it doesn't seem to work. I tried the same thing with CDF 8 and it works.


Methods for NSolve

I've been using `NSolve` a moderate (50-100 equations) size system of linear equations and it has been working splendidly (`Solve` on the other hand is extremely slow) and I thought I'd look up the method it is using is there anyway to: a) See which method Mathematica chooses to use for a particular set of equations? b) See what are the available methods to NSolve. The documentation for `NSolve` doesn't show anything specific under Details and Options.


Need assistance with plotting Cell Center Points and Normals (ListPlot, ListVectorPlot)

This is the CellCenter datapoints and associated Normals data: http://wikisend.com/download/458974/CellCenters-and-Normals.dat The dat file contains data points for x,y coordinates and x,y coordinates of four normal vectors associated with these coordinates. I don't know if I have done this right, so I am trying to plot up my datapoints and the four normals associated with each datapoint. I should be able to plot the datapoints and the four normals emerging from the datapoints ( with the tail of each normal ending at appropriate datapoint) I don´t really know how to scale my vector plots so the arrows will fit to the meshgrid and cell center points.               CellDataNormals =      Import["C:\\Users...\\CellCenters-and-Normals.dat", "Table",      "IgnoreEmptyLines" -> True];          CellCenterx = CellDataNormals[[All, 1]];     CellCentery = CellDataNormals[[All, 2]];     CellCenter = Transpose[{CellCenterx, CellCentery}];          NormalEastx = CellDataNormals[[All, 3]];     NormalEasty = CellDataNormals[[All, 4]];     NormalEast = Transpose[{NormalEastx, NormalEasty}];           NormalNorthx = CellDataNormals[[All, 5]];     NormalNorthy = CellDataNormals[[All, 6]];     NormalNorth = Transpose[{NormalNorthx, NormalNorthy}];          NormalWestx = CellDataNormals[[All, 7]];     NormalWesty = CellDataNormals[[All, 8]];     NormalWest = Transpose[{NormalWestx, NormalWesty}];          NormalSouthx = CellDataNormals[[All, 9]];     NormalSouthy = CellDataNormals[[All, 10]];     NormalSouth = Transpose[{NormalSouthx, NormalSouthy}];           CenterPoints =      ListPlot[CellCenter, PlotRange -> {{-11, 11}, {-11, 11}}];          NEast = ListVectorPlot[Transpose[{CellCenter, NormalEast}]];          NNorth = ListVectorPlot[Transpose[{CellCenter, NormalNorth}]];          NWest = ListVectorPlot[Transpose[{CellCenter, NormalWest}]];          NSouth = ListVectorPlot[Transpose[{CellCenter, NormalSouth}]];          Show[CenterPoints, NEast, NNorth, NWest, NSouth]      ![enter image description here](http://i.stack.imgur.com/jlT67.png) Is there a way I can scale all this and plot it on the same graph so that it looks prettier :) ? I don't really know how to scale the size of my datapoints and vector arrows.


How do I evaluate several n-th derivatives of a function at one point?

I have a question where I have to compute a `Table` containing $f^{(n)}(0)$ for `n = 1, ..., 5`, where $f^{(n)}$ denotes the $n$th derivative of $f$. For the function $f(x)=x\mathrm{e}^{-x}$, I have:               f[x_]:=xe^-x     Table[D[f[x],{x,n}],{n,1,5}]//TableForm      How can I solve for the value of each derivative at 0?


How do I get a general form for n-th derivative of a function?

I tried the following but it basically returns unevaluated:               In[1]:= D[ArcTan[x], {x, n}]     Out[1]= Derivative[n][ArcTan][x]          In[2]:= FunctionExpand[Derivative[n][ArcTan][x], Element[n, Integers] && n > 0]     Out[2]= Derivative[n][ArcTan][x]      Is it possible to request Mathematica to expand it as a function of two variables `x, n`?


Logarithmic curve fit in data

I have the following data which are the theoretical:               cycles={70954, 55331, 43274, 33942, 26701, 21065, 16667, 13225, 10524, 8398,      6721, 5394, 4341, 3503, 2835, 2300, 1871, 1526, 1248, 1023, 841, 693,      572, 473, 393, 326, 271, 226, 189, 158, 132, 110, 92, 77, 64, 53, 44,      36, 29, 23, 17, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,      2, 2, 2, 2, 2, 2, 2, 2, 2}          sigma={500, 505, 510, 515, 520, 525, 530, 535, 540, 545, 550, 555, 560,      565, 570, 575, 580, 585, 590, 595, 600, 605, 610, 615, 620, 625, 630,      635, 640, 645, 650, 655, 660, 665, 670, 675, 680, 685, 690, 695, 700,      705, 710, 715, 720, 725, 730, 735, 740, 745, 750, 755, 760, 765, 770,      775, 780, 785, 790, 795, 800, 805, 810, 815, 820, 825, 830, 835}      and here the experiment points.               ExpDatMPa={835.03, 823.4, 793.06, 704.82, 609.83, 602.62, 598.09, 595.61,      591.55, 584.71, 551.18, 541.23, 539.32, 385.34, 385.21}          ExpDatN = {23, 69, 43, 328, 5941, 4506, 1876, 7898, 27015, 19154,        130885, 431405, 84036, 1003250, 113442}      I plot both of them using `ListLogLinearPlot`               ListLogLinearPlot[{Transpose[{cycles, sigma}],        Transpose[{ExpDatN, ExpDatMPa}]},       AxesLabel -> {"Cycles [N]", "Stress Mpa"}, PlotRange -> Axis,       Joined -> {True, False},PlotLabel -> "S-N Cyclic Fatigue Life at R = -1 "]      ![enter image description here](http://i.stack.imgur.com/oJUky.jpg) Now I want to draw a logarithmic curve fit through the experimental points. I have searched through the help on _Mathematica_ but could not find something which would help me understand how I could do it. Can somebody give me a hand?


Creating and using an explicit piecewise function in a convenient way

I have a set of data points that define a function in the form               curvePts = {data1,data2,...}      where               data1 = {{x11,y11},{x12,y12},...}     data2 = {{x21,y21},{x22,y22},...}     ...      For example               pts = {Table[{x, Tan[x]}, {x, 0, \[Pi]/2, 0.01}],        Table[{x, Tan[x]}, {x, 2 \[Pi], 5 \[Pi]/2, 0.01}]}      Now, I want to construct a piecewise function that interpolates `pts`, **but I need an explicit representation**. In that respect, I've built the following function:               pPieces[pts_, n_] := Function[\[FormalX], Module[{noCurves, resN, tmpParts, polis,         domains},         noCurves = Length@pts;         resN = Table[Mod[Length@pts[[i]], n + 1], {i, 1, noCurves}];         tmpParts = Flatten[Table[Partition[pts[[i]], n + 1, n, {1, 2}, {}], {i, 1,             noCurves}], 1];         polis = Table[Fit[tmpParts[[i]], Table[y^k, {k, 0, Length@tmpParts[[i]] - 1}], y],             {i, 1, Length@tmpParts}];         domains = tmpParts[[All, {1, -1}]][[All, {1, -1}, 1]];         Piecewise[MapThread[{#1, #2[[1]] <= y < #2[[2]]} &, {polis, domains}],             Indeterminate] /. y -> \[FormalX]       ]     ];      which, in a nutshell, determines the number of disjoint `data`, then partitions the data into $n+1$ sets of points to do a $n$-th orded polynomial interpolation (leaving the end points with the appropriate $m$-th order polynomial approximation $(m<n)$), and joins it by using `PieceWise`. (Why I'm using `\[FormalX]` and replacement rules is more because of ignorance than knowledge). My ultimate goal is to use `NSolve` with this explicit piecewise polynomial function. This in fact works with my naive example:               AbsoluteTiming[NSolve[pPieces[pts, 3]@x - 10 == 0, x, Reals]]          (* {0.098064, {{x -> 1.47112}, {x -> 7.7543}}} *)      Of course, there is no need for me to do all this with the example I've provided; in reality I'm working with very sinuous data with lots of points and I'm trying to solve a `37 x 37` system of (transcendental) equations, **and I need all the real solutions** (the main reason behind all the problem). If I solve a simple `2 x 2` system where `pts1 = 885` and `pts2 = 1027`, it takes forever. Here is an example of the real data, and a simple `2x2` system (computed in an i7):               AbsoluteTiming[NSolve[{215.879 x - 182.66 y + D[pPieces[pts1, 20]@x, x] ==          0, -163.841 x + 139.778 y + D[pPieces[pts2, 20]@y, y] == 0}, {x, y}, Reals]]          (* {1888.208001, {{x -> -3.46927, y -> -4.06635}, {x -> -0.675128, y -> -0.79221},         {x -> -0.141648, y -> -0.165793}, {x -> 0.032764, y -> 0.0397147},         {x -> 0.405087, y -> 0.4732}}} *)      where `n = 20` has been chosen _arbitrarily_ (in order to speed up computation, _allegedly_ ). **A note:** My full problem requires me to find _all_ real solutions for a large system of $k \times k$ coupled transcendental equations of the form $$ \vec{p_i} \cdot \vec{z} + f_i(z_i) = 0, \quad 1 \le i \le k, \quad \vec{z} \in \Omega \subset \mathbb{R}^k, $$ where $\vec{p_i}$ are constant vectors, and the $f$'s are real functions extracted from datasets of the type `pts1` and `pts2`, evaluated at the $i$-th component of $\vec{z}$. I know, and I've been using `FindRoot`, `Interpolation` and the custom `FindAllCrossings2D` and `FindAllCrossings3D` (refs here and here) to attack parts of the problem, but I haven't been able to work with the full system, and this is my $n$-th approach to solve it. Any suggestions on how to tackle it will be very appreciated. **EDIT** I've calculated the time to run the code with respect to $n$, as can be seen in the figure ($n=4$ being _optimal_ ). It's clear that a compromise must be found between the number of points taken to do the `Fit`, due the complexity of the domain in `NSolve`. I'm guessing some sort of adaptive algorithm to produce different fits for parts of the data, in order to maintain fidelity, but also to reduce the number of parts for the `PieceWise` function must be developed. Any ideas in this regard? $\hskip1.7in$![enter image description here](http://i.stack.imgur.com/nhj3c.png)


How to calculate a gradient at x=0?

I am solving a second order differential equation for n[x]. I solved it with both DSolve and NDSolve. A plot of n as a function of x looks great. Than **I want to calculate a gradient of n[x] at a point x=0 and plot it as a function of V. I don't know how to execute this.** I calculated gradient at every point and plot it. I get expected shape of the curve and there is also V on x axis, but the values of y axis are to high. Here is the code:               eq = Gx + D[Dif*\!\(     \*SubscriptBox[\(\[PartialD]\), \(x\)]\(n[x]\)\), x] -          Kr (n[x] - n0) == 0;     bcs = {n'[d] == 0, n[0] == n0*Exp[(e \[Alpha] V)/(kb T)]};     \[Alpha] = 0.25;     e = 1.602*10^-19;     kb = 1.38*10^-23;     T = 300;     d = 20*10^-6;     Gx = 10^17;     Dif = 4*10^-9;     Kr = 3.1*10^-9;     n0 = 10^21;     sol := {V,        D[#, x] &@        NDSolve[{eq, bcs}, n[x], {x, 0, d}, MaxSteps -> 50000][[1, 1, 2]]}     res = Table[sol, {V, 0, 0.7, 0.05}];     ListPlot[Table[res, {x, 0, d}], Joined -> True, Frame -> True,       ImageSize -> 500]      Gx is a complicated function of x because I integrate a list as input. So, my result of DSolve is very big. I need to stop the calculation of gradient as soon as it becomes zero. When the plot of n'[x] at x=0 cross the x axis (with values of V on it) my calculation should stop and the appropriate result (graph) should be displayed. I don't need the negative values of the derivative, so there is no need for Mathematica for further calculations. What is the best way to execute this? But I have another problem there because my result is to high and it never changes the sign. In theory it should.. My result should look like: Because I cannot post the images, you can see the desired graph on the link: https://www.google.si/search?hl=sl&rlz=1C1TEUA_enSI493SI493&q=current+voltage+characteristics+DSSC&bav=on.2,or.r_qf.&biw=1600&bih=785&um=1&ie=UTF-8&tbm=isch&source=og&sa=N&tab=wi&ei=YspCUb3GFYvUsgaTnYGoCA#imgrc=wX5CgAQmm0sdkM%3A%3BJbeOH9F0mOvjNM%3Bhttp%253A%252F%252Fars.els- cdn.com%252Fcontent%252Fimage%252F1-s2.0-S0025540812004047-gr9.jpg%3Bhttp%253A%252F%252Fwww.sciencedirect.com%252Fscience%252Farticle%252Fpii%252FS0025540812004047%3B384%3B314 On x axis is voltage, on y axis is current density, which I should calculate from the gradient at a point x=0: J=(dn[x]/dx)x=0. The current is related to a density gradient, the diffusion coefficient being the proportionality constant. But if I multiply the resulted derivative with Dif, it doesn't change enough. If I multiply the whole equation with e, which gives me correct units, the result is too small. From the picture above is evident, that my values on y axis are changing to slowly. Thank you for your answers!


Unexpected behaviour of SeriesCoefficient?

Following this question/answer I discovered and played with `SeriesCoefficient`. In particular, I tried               SeriesCoefficient[Exp[λ x - x^2], {x, 0, n}]       which nicely returns               (* Piecewise[{{HermiteH[n, λ/2]/n!, n >= 0}}, 0] *)      **Question** On the other hand, why does               SeriesCoefficient[Exp[ x - x^2], {x, 0, n}]       (a special case of the above) returns               (* Piecewise[      {{DifferenceRoot[Function[           {\[FormalY], \[FormalN]},            {2*\[FormalY][\[FormalN]] - \[FormalY][1 + \[FormalN]] +               (2 + \[FormalN])*\[FormalY][2 + \[FormalN]] ==              0, \[FormalY][0] == 1, \[FormalY][1] ==              1}]][n], n >= 0}}, 0] *)


How to restore the font size and other options to default Globally

I have messed up the font size globally. I was playing with SetOptions and I think I have accidentally changed the font setting of the FronEnd setting globally as can be seen here. ![enter image description here](http://i.stack.imgur.com/mNBo3.jpg) I tried to uninstall Mathematical and instal it again but that did not help. how can I reset the font size to default.


Changing axes in ContourPlot

I'm new using mathematica. I'm plotting a funcion that depends on two variables (r and C) let's say z= r^2+c^2 When I use ContourPlot, level curves are shown in a r-C plane. I'm trying to obtain the curves but in a r-Z plane and r-C Plane and if this were possible, gave a label to any curve For instance, the curves in the r-Z plane has a different behaviour when I change C Does anyone know how to do that? ? :S thanks!


Combine a dynamic module with a manipulation

I would like to combine a dynamic module with a manipulation, whilst maintaining the functionality of both. I have tried things like `Show` and `Epilog -> Inset@...`, but neither seem to work. The code for both dynamic module & manipulation are as follows:               Manipulate[     Plot[x^n, {x, 0, 5}, PlotRange -> {{0, 5}, {0, 5}}, GridLines -> {Range@5, Range@5},      GridLinesStyle -> Directive[GrayLevel[0.8], Dashed], AspectRatio -> Automatic,      PlotStyle -> Thick, Axes -> False, ImageSize -> 200], {n, -3, 3},          DynamicModule[{x = 11}, Grid[Map[Button[ToString@#, x = #, Background ->      Dynamic[If[Divisible[#, x], Green, Red]], ImageSize -> {40, 40}, Appearance ->      "Frameless"] &, RandomInteger[{1, 10}, {5, 5}], {2}], Frame -> All,      FrameStyle -> Dashed, Spacings -> {.2, .2}]]]      produces: ![enter image description here](http://i.stack.imgur.com/6EFDA.gif) Functionality in the above illustration is preserved, but I would really like one to overlay the other (plot on top 'layer'). I have included the grid on both to show how I would like to align them. I have looked here, and here, to no avail :( _This is a slimmed-down version of a previous (deleted) post - I hope it is a little clearer :)_


How do you convert a string containing a number in C scientific notation to a Mathematica number?

Suppose I have a string containing the C-representation of a floating point number, for example               s = "1.23e-5"      and I want to convert this to a Mathematica number. How can I do this? `ToExpression[s]` gives `Plus[-5, Times[1.23`, e]]`.


Faster way to convert real strings into numbers

Working with big files, I have to convert some numbers that are in string format into real MMA numbers. I know that I can use `ToExpression` but it's slow when compared to another forms. For instance, for Integer case we can compare:               dataInt = ToString /@ RandomInteger[1000, {10^5}];     d1 = FromDigits /@ dataInt; // AbsoluteTiming     d2 = ToExpression /@ dataInt; // AbsoluteTiming          {0.050298, Null}     {0.475669, Null}      It's almost 10 times faster to use `FromDigits`. The question is, how can I make a equivalent for Real cases? Like:               dataReal = ToString /@ RandomReal[1000, {10^5}];     d1 = someFunction/@dataReal;//AbsoluteTiming     d2 = ToExpression/@dataReal;//AbsoluteTiming      I haven't found some Mathematica function to `someFunction`. I miss one way to force `ToExpression` to interpret the string in some specific way.


ReadList with type Expression unable to read scientific notation?

I have a file that defines an array of numbers like this:               freq["AQs"] = 8.846947803007962E-4     ...      I am reading the file with `ReadList["myfile.txt", Expression]` but Mathematica reads the above entry as `20.0` `instead of 0.000884695`. How can I read the array correctly? Thanks.


Sum over n variables

What is the most painless way to sum over n variables, for example, if the range of summation is $i_1 < i_2 < i_3 < \dots < i_n$, where $n$ is an argument of the function in question? Is there a package for this and more complex summation ranges? I am not happy with programming loops all the time for this common summation range and if one has a large summation range, one cannot just use a combinat command to generate all subsets of a certain size, if this takes too much memory. Example: $$f(n)=\sum_{0 < i_1 < i_2 < \dots < i_n < 2n+1} \qquad \prod_{1\le r < s \le n} (i_s-i_r) $$


Syntax for integrating over limits specified by a Table

I wish to use `NIntegrate` to compute multidimensional integrals. However, I don't want to manually input the limits for the dimensions. I want to store the integration limits in a list and have `NIntegrate` to run with the limits in that list. I hope the following example is illustrative:               vars = {x, y, z, u, v};     func = x + y + u + z;     limits = Table[{vars[[i]], -∞, ∞},{i, 1, Length[vars]}]      > {{x, -∞, ∞}, {y, -∞, ∞}, {z, ∞, ∞}, {u, -∞, ∞}, {v, -∞, ∞}} Now I add constraints on the integration variables:               consts =        x >= 0 &&        3152 + 81 y - 4 (788+20 y) >= 0 &&        -3572 + u + 4 v + 16 x - 76 y - 4 (314 + 13 y) + 6 (788 + 20 y)+2 z >= 0 &&        1649 - 4 u - 15 v - 66 x + 28 y + 6 (314 + 13 y) - 4 (788 + 20 y) - 6 z >= 0 &&        788 + 6 u + 20 v + 111 x + 20 y - 4 (314 + 13 y) + 6 z >= 0;      I now try the syntax which seems intuitive to me, for integrating over the limits specified by `limits` :               NIntegrate[func Boole[consts], limits]      During evaluation of the above, I get the result: > NIntegrate::vars: Integration range specification limits is not of the form > {x, xmin, ..., xmax}. >>   >  NIntegrate[func Boole[consts], limits] Could anyone kindly help me find the right syntax to achieve integration over the limits specified in `limits`?


Save a notebook with "input" and "output" on the left of all cells

How to make Mathematica save a notebook with "input 1" and "output 1" on the left of cells? If I open a saved notebook, those tags are gone.


Generating a function which outputs possible chemical reactions

I want to make a list of chemical reactions and I write them down in a $\require{mhchem}\LaTeX$ format. They are of the following form $$NA_n^i+MB_m^j \rightarrow \hat NA_{\hat n}^{\hat i}+\hat MA_{\hat m}^{\hat j},$$ the relevant part is $$NA_n^i+MB_m^j$$ which depends on up to 8 parameters $$A,B,N,M,n,m,i,j,$$ i.e. atomar species $A$, quantity $N$, number of elements in the molecule $n$ and an index $i$ for modi like excitation $A^*$ or ionization $A^+,A^-$. Like e.g. $$\cf{O}^*+\cf{2Cl2^-}.$$ I want to create an "object" of function               reactions[A,B,N,M,n,m,i,j,k]      with values $k$, where $k=1$ evaluates to the TeX-form $NA_n^i+MB_m^j$, $k=2$ is some string with information, and the tricky part $k=3$ gives the list of permissible products of the reaction. This amounts to implement conservation of atomar species, but as $\ce{2O->O2}$ is legal, I think $n+N=const.$ is the bound. Then there is charge conservation. I know that there is a ToTeXForm function so, while I'm open for optimization, this problem should be easy to handle. But how would I go about solving this, I guess, combinatorial problem? Does _Mathematica_ want me to write some subroutine, which gets called by my function. Or do you do this all at once? Is there a method to add more values to $k$ afterwards, i.e. if I want to add information later. And does updating of the $k=2$ string just amount to redefining the string all reactions[...,3]:="new information"? You see, I'm thinking about this from an object oriented point of view, but this might be wrong. The last step would be to also take into account that there are object like $\cf{CH4}$, which can decompose into e.g. $\cf{C}+\cf{2H2}$, but enough for now. * * * **My progress**                tex[{A_, N_, n_, q_}] :=       If[Head[A] === List,       tex[N] <> " + " <> tex[A] <> " + " <> tex[n] <> " + " <> tex[q],       ToString[N] <> " " <> ToString[A] <> "_" <> ToString[n] <> "^" <>       ToString[q]]      tex[{a_, b_, c_}] := tex[a] <> " + " <> tex[b] <> " + " <> tex[c]      tex[{Q_, e_}] :=       If[Head[Q] === List, tex[Q] <> " + " <> tex[e],       ToString[Q] <> " " <> ToString[e]]      tex[{a_}] := tex[a]      Example                tex@{{CH, 2, 4, 0}}      tex@{{H, 2, 2, 0}, {O, 1, 2, 1}}      ![enter image description here](http://i.imgur.com/PULgs.png)                norm[{{A_, N_, n_, q_}}] := {{A, N*n, 1, q}}      norm[{A_, N_, n_, q_}] := norm[{{A, N, n, q}}]      norm[{{A_, N_, n_, q_}, {B_, M_, m_, p_}}] :=       If[A === B, {{A, N*n + M*m, 1, q + p}}, {{A, N*n, 1, q + p}, {B, M*m,      1, 0}}]      norm[{{A_, N_, n_, q_}, {Q_, e_}}] := {{A, N*n, 1, q - Q}}      norm[{{A_, N_, n_, q_}, {B_, M_, m_, p_}, {Q_, e_}}] :=       If[A === B, {{A, N*n + M*m, 1, q + p - Q}}, {{A, N*n, 1,      q + p - Q}, {B, M*m, 1, 0}}]           summands[int_] := Table[{int - index, index}, {index, 0, Floor[int/2]}]      divisors[int_] := {int/#, #} & /@ Divisors[int]           split[t_] := ({{t[[1, 1]], First[#], 1, t[[1, 4]]}, {t[[1, 1]],        Last[#], 1, t[[1, 4]]}} &) /@ summands[t[[1, 2]]]           shift[t_] :=       If[t[[2]] == 0, {t}, ({t[[1]], First[#], Last[#], t[[4]]} &) /@divisors[t[[2]]]]           multiplyTemp[term_] :=      Flatten[      Map[Table[{#[[1, ind1]], #[[2, ind2]]}, {ind1, 1,        Length[#[[1]] ]}, {ind2, 1, Length[#[[2]] ] }] &,      Map[shift, split[norm[term]], {2}]],2]           multiply[term_] :=       Map[Function[termvar, Select[termvar, (Not[#[[2]] == 0] &)]],       DeleteDuplicates[multiplyTemp[term], (#1 === Reverse[#2] &)]]           products[t_] :=      Which[      Length[norm[t]] == 1, multiply[t],      Length[norm[t]] == 2,       Flatten[Table[       Flatten[{#[[1, ind1]], #[[2, ind2]]}, 1], {ind1, 1,         Length[First[#]]}, {ind2, 1, Length[Last[#]]}] &@     (multiply /@ t), 1]]      Example                myTerm := {{CH, 2, 3, 0}}      (tex@myTerm " \[LongRightArrow] " <> # &) /@       tex /@ (products@myTerm)    // TableForm      ![enter image description here](http://i.imgur.com/BGfO7.png)                myTerm := {{H, 2, 2, 0}, {O, 1, 1, 1}}      (tex@myTerm " \[LongRightArrow] " <> # &) /@       tex /@ (products@myTerm)    // TableForm      ![enter image description here](http://i.imgur.com/fkEfD.png) **elaboration** So I realized that if I'm going to generate all possible outcomes of a reaction, based on atomic species number and charge conservation, the general expression $$NA_n^i+Qe$$ can be normalized to $$(N\cdot n)A_1^{i-Q}$$ before the generation. This generalizes to $$NA_n^i+MA_m^i+Qe$$ and $$NA_n^i+MB_m^i+Qe, $$ with $A\ne B$. There are some If-clauses in the code which result from special treatment of $A\ne B$. So firstly I normalize ( _norm_ ), then generate all the possible decompositions ( _split_ ) $$(N\cdot n)A_1^i \Rightarrow (N\cdot n-k)A_1^i+kA_1^i$$ and then I generate all the combinations $KA_k^i, \ \ \ \ \ \ K\cdot k==N\cdot n$. These are the functions _shift_ and _multiply_ , where _multiplyTemp_ is just the result pre filter (deletion of expressions $0A_k^i$ and dublicates). I'm open for suggestions regarding the above code up to now. I stick to reactions with integer coefficients here, but in case one wants to generalize that, one would just have to change the _shift_ function to do something else. Next step are the charge conservation shift. The total charge of an expression is easy to read off. I guess it makes sense to define a global variable _ionizationlevel_ (which we will usually set to 1 or 2, since higher ionizations aren't that common) and then take every list from _products_ and generate a couple of new lists consisting of the same species, but with charges shifted around between the species as well as possible freed electrons $Q e$. Them manybe comes the question of putting species together. This will give a lot of new options of course. Any ideas how to implement it?


Specifying parts from lists for plotting using Show

I have the following data:                 setA = {       {875, 0.399483},        {880, 0.391583},        {885, 0.383609}};       setB = {       {645, 0.690354},        {650, 0.685416},        {655, 0.680413}};      I'm trying to plot the data from both sets on the same plot. I can do the following:               var[set_,col_] := set[[All, col]];          setAx = var[setA,1]; setAy = var[setA,2];      setBx = var[setB,1]; setBy = var[setB,2];      then plot:               valplot[var1_, var2_, opts_] :=      ListPlot[Transpose[{var1, var2}], PlotRange -> All,      PlotStyle -> {Red}, Joined -> False, opts]          setsAandBPlots = GraphicsGrid[{                       {setAyPlot = valplot[setAx, setAy, AxesLabel -> {"variable x", "variable y"}]}                              (* ,etc... *)                         }, ImageSize -> 300]      This is pretty clunky, I know (i'm very new to programming - and i'm starting with mathematica...). I want to make a series of these plots comparing different sets (and the _actual_ datasets i'm using are much larger than these - many more rows and columns) I would like to be able plot multiple subsets (e.g. "(setAx and setbx) versus (setAy and SetBy)", etc...) on the same plots (defined by different colored markers) using something like "Show". There must be a neat(er) way to do it using, say, "Position" and "Intersection" to pick the individual values for plotting. I guess I'm asking if any one can help me find a more general/programatic way to populate the lists "setAx, setAy,setBx, etc..." without having to write them out long-hand? Cheers! EDIT: Sorry I oversimplified my data. It looks more like this:               setA = {{8.0, 830, 0.466626, 1.720689,0.200740, 0.018637, 0.009023, 0.029482, 0.091949, 0.074304, 0, 0},              {8.0, 835, 0.459588, 1.742870, 0.202380, 0.019201, 0.010261, 0.032965, 0.093269, 0.074717, 0, 0}};      setB = {{8.0, 845, 0.445114, 1.787952, 0.205660, 0.020367, 0.013240, 0.041201, 0.095895, 0.075504, 0, 0},              {8.0, 850, 0.437659, 1.810861, 0.207301, 0.020968, 0.015022, 0.046038, 0.097197, 0.075877, 0, 0}};      so, the data is essentially of the form {{A1x, A1y, A1z,…},{A2x,…}}; {{B1x, B1y, B1z,…},{B2x,…}};. I'd like to be able to plot various combinations with axes: x vs. z, y vs. z etc. ListPlot alone won't help me do this... hence the use of new lists of the form Transpose[{Ax, Az}] etc..


Arithmetic operation on the value returned by Solve

I want to modify the value that is returned by Solve. Example:               SolC1 = Solve[Sin[ π x / L] == 1, x]     {{x -> L/2}}      I need to add n to x so that x becomes `n + L/2`. Both of the following I tried yields unwanted result in the succeeding calculation.               SolC1 = (x -> L/2) + n     ----     SolC1 = SolC1 + n      I particularly need the proper way to do this because `x` can have other variables depending on other `Solve` execution.


Is there a way to simplify this replacement rule

I have a rather big expression which contains many sums of form `q x + w y`. I know that `y` is much smaller than `x` and i want to omit it where possible, namely if both `q` and `w` are integers. So i apply the replacement rule               q_?IntegerQ x + w_?IntegerQ y -> q x      However this rule obviously doesn't work if either `q` or `w` (or both) is equal to unity because `FullForm` of `q x` contains `Times` and one of `x` doesn't. So to get replacement done i need to use the ugly set of rules               { q_?IntegerQ x + w_?IntegerQ y -> q x , x + w_?IntegerQ y -> x , ... }      and in place of dots there are two more rules with `w` and both `w` and `q` omitted. So the question is whether it is possible (in general) to somehow simplify this ugly set to anything more simple.


Managing Stack Exchange favorites via Documentation Center

My Stack Exchange favorites are getting bigger and bigger. It is becoming unmanageable and is getting hard to find what I look for. A related question is _Sort favorite questions_. Is it possible to use the structure of Mathematica's _Documentation Center_ to arrange my favorite questions by subject? For instance, adding a subtopic with links to Stack Exchange. Is it to difficult to do?


Automatically assign solutions to equation as constants

Consider the following code:               ClearAll[K, L, λ, q, r, w]          TC[K_, L_, q] := w*L + r*K + 10*q     Phi[K_, L_, λ_] := TC[K, L, q] - λ*(10*K^(4/5)*(L - 40)^(1/5) - q)     Phi[K, L, λ]          FullSimplify[{       D[Phi[K, L, λ], K],       D[Phi[K, L, λ], L],       D[Phi[K, L, λ], λ]       }]          FullSimplify[      Solve[{        D[Phi[K, L, λ], K] == 0,        D[Phi[K, L, λ], L] == 0,        D[Phi[K, L, λ], λ] == 0        }, {K, L, λ}]      ]          r = 64;     w = 32;     FullSimplify[TC[K, L, q]]      Is it possible to automatically assign the real-valued solutions for `K` and `L` to get the output               2 (640 + (5 + 4 2^(1/5)) q)      with executing the last command? **Update** After hints from Artes, I've managed to always get the function `TC` for real- valued `K` and `L`. However, how do I print only the _real-values_ [which I forgot to mention the first time I updated the question] of `K` and `L` when I solve the system of equations? When executing               F[k_, l_] := 10*k^(4/5)*(l - 40)^(1/5)     TC[k_, l_, q_] := w*l + r*k + 10*q     Phi[k_, l_, λ_] := TC[k, l, q] - λ*(F[k, l] - q)     expressions = {D[Phi[k, l, λ], k], D[Phi[k, l, λ], l], D[Phi[k, l, λ, λ]};     FullSimplify[Solve[expressions == {0, 0, 0}, {k, l, λ}]]      I get five solutions;               {{k -> (q w^(1/5))/(5 2^(3/5) r^(1/5)),        l -> 40 + (q r^(4/5))/(20 2^(3/5) w^(4/5)), λ] -> (        r^(4/5) w^(1/5))/(        4 2^(3/5))}, {k -> -(((-1)^(1/5) q w^(1/5))/(5 2^(3/5) r^(1/5))),        l -> 40 - ((-1)^(1/5) q r^(4/5))/(20 2^(3/5) w^(4/5)), λ ->         r^(4/5) w^(1/5) Root[-1 + 8192 #1^5 &, 2]}, {k -> ((-1)^(2/5) q w^(         1/5))/(5 2^(3/5) r^(1/5)),        l -> 1/40 (1600 + ((-2)^(2/5) q r^(4/5))/w^(           4/5)), λ -> ((-1)^(2/5) r^(4/5) w^(1/5))/(        4 2^(3/5))}, {k -> -(((-1)^(3/5) q w^(1/5))/(5 2^(3/5) r^(1/5))),        l -> 40 - ((-(1/2))^(3/5) q r^(4/5))/(         20 w^(4/5)), λ -> -(((-1)^(3/5) r^(4/5) w^(1/5))/(         4 2^(3/5)))}, {k -> ((-1)^(4/5) q w^(1/5))/(5 2^(3/5) r^(1/5)),        l -> 40 + ((-1)^(4/5) q r^(4/5))/(         20 2^(3/5) w^(4/5)), λ -> ((-1)^(4/5) r^(4/5) w^(1/5))/(        4 2^(3/5))}}      P.S. `q`, `r`, and `w` are all positive numbers.


Setting an element of an array to a value

This may be a simple syntax question, but for some reason I've been having trouble with it. Suppose we have an array `arr`, and we want to set one of the elements to a particular value (say, 7). It's easy to do this manually:               arr = {{1, 2}, {3, 4}};     arr[[1, 2]] = 7;     arr          Out: {{1, 7}, {3, 4}}      How do we do this when the index we want to modify is stored as a list? It's easy to use `Extract` to return the current element at that location:               indices = {2, 2};     Extract[arr, indices]          Out: 4      But attempting to set it equal to a value (say, 13) gives errors:               Extract[arr, indices] = 13          Out: Set::write: Tag Extract in Extract[{{1,7},{3,4}},{2,2}] is Protected. >>      Similarly, using `Part` gives errors when done the naive way:               arr[[##]] & @@ indices = 13          Out: Set::write: Tag Apply in (arr[[##1]]&)@@{2,2} is Protected. >>      Of course, I can sort of do it manually in the following way:               arr[[indices[[1]], indices[[2]]]] = 13     arr          Out: {{1, 7}, {3, 13}}      But this becomes cumbersome when dealing with arrays which are very deep. So the question is, is there a way to set an element in an array to a value without having to enter the expression manually?


How to reverse the direction of the y axes on Graphics

Question related to this one, except I need the same for the Graphics. Lets say I have the following drawings:               Graphics[{         Line[{ Q, P, V }] ,       Arrow[{P, P + v }] ,       Arrow[{P, P + vx }] ,       Arrow[{P, P + vy}] ,            {Dashed,         Line[{Q + (dir1*d1), P + v,  V + (dir2*d2)}]        },            FontSize -> 16, Background -> RGBColor[1, 1, 1, 1],       Text["Q", Q],       Text["P", P],       Text["V", V],       }, Axes -> True]      But on my drawing sysytem (this drawing should illustrate part of it work), the screen coordinates goes from top to bottom (in reverse order). So I want to reverse it somehow.


Numeric values from transform

How would I create a table of values from a transformation? eg:               r1 = 1; r2 = 1000; primorial[n_] := Times @@ Prime[Range[n]];     plot = ListLinePlot[Table[N[Log[primorial[n]]], {n, r1, r2}]];     plot /. L_Line :> {GeometricTransformation[L, ReflectionTransform[{-1, 1}]]}      How could I convert the transform of 'plot' into a list of numeric values?


Why do Permute and PermutationReplace not invert one another?

Why do `Permute` and `PermutationReplace` not invert one another, as stated in the documentation? If we have an identity permutation list (a list of the form `Range[n]`)               In[1]:= list1 = {1, 2, 3};      then `Permute` and `PermutationReplace` invert one another:               In[2]:= cycle = Cycles[{{1, 2, 3}}];             Permute[PermutationReplace[list1, cycle], cycle] == list1     Out[3]= True          In[4]:= PermutationReplace[Permute[list1, cycle], cycle] == list1     Out[4]= True      But this does not necessarily hold for lists not of the form `Range[n]`:               In[5]:= list2 = {3, 2, 1};             PermutationReplace[Permute[list2, cycle], cycle] == list2     Out[6]= False          In[7]:= Permute[PermutationReplace[list2, cycle], cycle] == list2     Out[7]= False      Why is this so?


Plot The Cornu Parametric Spiral

How to plot the Cornu parametric Spiral in 3D With Mathematica. The 2D is quite easy. Thx. For more details you need to be familiar with the Cornu statement. $$\begin{cases} x(t)=\int_{0}^{t}cos(u^{2})du\\\ y(t)=\int_{0}^{t}sin(u^{2})du. \end{cases}$$