Reading csv/xlsx data into Mathematica with column headings as list names

It's old question. However, I could not find satisfactory answer. Decided to post this question. I have a `.csv` file with column heading. How can I import this `.csv` file into _Mathematica_ assigning column names as list names in short and sweet way. For example, I can use the following codes.               mydata = Import[file, Path -> path];     names = Flatten[mydata[[;; 1]]];      Do[listnames[names[[i]]] =                           mydata[[2 ;;]][[All, i]], {i, 1, Dimensions[mydata[[2 ;;]]][[2]]}];      But I need to write listnames["Col names in .csv file"] to refer to each list. I can not refer `.csv` column names as list names. I need to figure out this because I have over 1000 column headings in my `.csv` data. Please help me to figure out his without long codes.


Plotting a parametric plot of two functions

I have two functions `f1(x)` and `f2(x)`. I want to plot them such that `f1` is on the axis of ordinates and `f2` on the axis of abscissae. Any ideas? Following example to it: f1(x)=2x and f2(x)=3x. The graph should then show a line through the following points: {(0,0),(2,3),(4,6),(6,9),...}


Forcing Mathematica to recognize a symbol without defining it

In the Mathematica front-end, symbols that have been defined are colored black and symbols with no definition associated are colored blue. This is useful to prevent spelling mistakes. Also, defined symbols appear in the autocomplete (as of Mathematica v9.0). I have a symbol `chrom` with no definitions associated, but I want Mathematica to recognize it. That is, I want that when I type `chrom` in the front end, it appears colored black, and I want it to appear in the autocomplete. I can't associate a definition with `chrom` (as in `chrom = ...` or `chrom[..] = ..`, because then if `chrom` appears in the evaluation of an expression, it will be replaced by the associated defined value. This is not the behavior I want. In other words, is there a Mathematica function that does the opposite of `Remove`? `Remove` removes a symbol from the symbol table. How can I add a symbol to the symbol table without associating a definition with it?


Inequality with assumptions not simplifying

Can someone explain to me why the following does not simplify to `True` (as all constituents are positive)?               FullSimplify[a+b/(c+(d-e)^2)>0,Assumptions->And@@Thread[{a,b,c,d,e}>0]]      Most special cases including `e=0` or `a=b`,... do simplify correctly. What I eventually want to do is to simplify expressions of the kind               Abs[a+b/(c+(d-e)^2)],      which should evaluate to `a+b/(c+(d-e)^2)` under given assumptions. Any workarounds? **Edit**   What I ended up doing for larger expressions was this:               expr[Abs[a+b/(c+(d-e)^2)]]/.Abs[x_]/;Simplify@Reduce[$Assumptions&&x>0]:>x      It's not particularly pretty, but it works. Thanks to ssch for the idea!


Implementation of Series function

I'm trying to evaluate the partial derivatives of some function `F[x,y]` at some point, i.e.               Limit[Limit[D[F[x,y],{x,m},{y,n}],x->x0],y->y0]      However, for higher derivatives I find that it fails to evaluate the limit. On the other hand, if I use the `Series` function               Series[F[x,y],{x,x0,m},{y,y0,n}]      It produces all the coefficients with no problem. My question is what is the difference between the two methods? what is `Series` assuming that I'm missing when I do it manually with the derivatives?


How can I get an approximate contour plot from a 3D plot?

I have some larger square, Hermitian matrices, M, (dimension 20, say, much more than 4) with 2 independent variables, call them x and y. I can plot the eigenvalues as functions of x and y with:               Plot3D[Eigenvalues[M], {x,-1,1}, {y,-1,1}]      even though I obviously have no analytic expressions for the eigenvalues as functions of x and y. I am interested in the nature of certain contours of these functions, let's say their intersections with zero. Furthermore:               ContourPlot[Eigenvalues[M], {x-1,1}, {y,-1,1}]      will give me plots (e.g. http://i.imgur.com/g9GgFSy.png?1) and in fact, the zero shown there was from a mouse-over of the central contour (cursor not present in image). So Mathematica is clearly able to plot the contours, even the analytic zero contour. However, if I change to               ContourPlot[Eigenvalues[M] == 0, {x-1,1}, {y,-1,1}]      I will get errors about " _Mathematica_ can't find all the roots of the characteristic polynomial". This simple change of commands has apparently really altered how _Mathematica_ is going about evaluating it and now it is trying (and of course failing) to solve an order-20 polynomial for analytic roots. But from the regular contour plot, I can see that it should be capable of giving me the numerical zero contour. **So how can I get _Mathematica_ to weaken the equality condition and give me the numerical zero contour approximately?** or Perhaps there is another way altogether to extract the single contour I need from the 3D plot or the full ContourPlot?


How to generate the following partitions

I have `2N` items and I need to form `2N` sets each with `N` items. The items should be evenly distributed. I don't know how to define this rigorously, but the number of common elements among any two sets should be minimized and equal to at most the average value. Also, each item appears in `N` and exactly `N` sets. For example, when `N=2`, valid sets can be `(1,2),(1,3),(2,4),(3,4)` **Edit** It is difficult to write down for `N=4`, but I'll try to: `(1,2,3,4),(1,2,5,6),(1,3,7,8),...` --- edit --- [Feel free to reword and/or remove this. DL] The result should be 2n subsets of {1,2,...,2n}, with each subset having n elements. Requirement 1: Each of the elements 1,2,...,2n exactly twice (probably this needs to be exactly n times, to get the numbers to work out). Requirement 2: Minimize the maximal intersection size of any two subsets, subject to requirement 1. --- end edit ---


Version 10 cannot print properly?

I have two problems with printing in version 10. First, I can't print correctly with a setting of printing scale For example, I have some plots in a notebook,               Grid@Table[       Plot[Sin[x], {x, 0, 2 π}, ImageSize -> Medium], {4}, {4}]      ![enter image description here](http://i.stack.imgur.com/Wh9jF.png) when I print with scale 70%, ![enter image description here](http://i.stack.imgur.com/U3t6v.png) I get something like ![enter image description here](http://i.stack.imgur.com/LcdHq.png) I always get a big blank at the top of the page, no matter what I set the margins in the printing options dialog. Second, the curve seems to be stretched after print. Here is compare between screen shot of the figure in the notebook and after print ![enter image description here](http://i.stack.imgur.com/C0ocG.png) ![enter image description here](http://i.stack.imgur.com/nxpvv.png) You can that the curve in the printed version stretches out beyond the frame. Are there ways around these problems? Currently I have to switch to older version once I need to print something. The example notebook is here I'm using 10.0 for Mac OS X x86 (64-bit) (June 29, 2014) on OS X 10.9.4.


Best way to determine polynomial coefficients in series expansion

I would like to solve the equation $$h'(\boldsymbol{x}_1)\left[B_1\boldsymbol{x}_1+g_1(\boldsymbol{x_1},h(\boldsymbol{x}_1))\right]=B_2h(\boldsymbol{x}_1)+g_2(\boldsymbol{x}_1,h(\boldsymbol{x}_1))$$ where $B_1$ is a matrix of $\mathbb{R}^2$, $B_2$ is a "matrix" of $\mathbb{R}$, $g_1:\mathbb{R}^3\longrightarrow \mathbb{R}^2$, $g_2:\mathbb{R}^3\longrightarrow\mathbb{R}$. $h$ is the unknow function, search in terms of its Taylor expansion in a neighbourhood of 0: $$h(u,v)\approx\sum_{k=0}^d \sum_{l=0}^k a_{kl}u^k\,v^l$$ I injected the second equation in the left-hand side of the first equation, denoted the result by `left`, and injected again the second equation in the right-hand side to obtain `right`. Given `left` and `right`, I want to calculate the $a_{ij}$, when it is possible (in $\mathbb{R}$). I tried several solutions:   1. use `CoefficientList` to extract the polynomial coefficients of `right-left` and solve `==0` for each term.   2. take every derivative in $u$ and $v$ and take the values in $0$, which is probably the same as what `CoefficientList` does, but manually.   3. evaluate `left` and `right` for many different values of $u$ and $v$ and solve the system. Which solution would you use, and why? In particular, how would you treat the terms of degre >$d$ when calculating the $a_{ij}$?


How do I extract a number from a string?

I want to extract the number from an alphanumeric string. This is what I tried:               StringTake["thiru3", {6, 6}]      The result I got is `3`, but it is still a `String`, which I determined by evaluating:               NumberQ[StringTake["thiru3", {6, 6}]]      which returns `False`.


Behaviour of Simplify when used with ArcTan and ComplexExpand along with assumptions

I am trying to simplify the slope of vectors with symbolic coordinates {x,y} using ArcTan[x,y] I am working with real X and Y I tried the following :               ClearAll@L;     ArcTan[L, L]     ComplexExpand@ArcTan[L, L]     Assuming[Element[L, Reals] && L > 0, ComplexExpand@ArcTan[L, L]]     % // Simplify     Simplify[ComplexExpand@ArcTan[L, L], {Element[L, Reals], L > 0}]      and got the following output:               ArcTan[L, L]     Arg[(1 + I) L]     Arg[(1 + I) L]     Arg[(1 + I) L]     \[Pi]/4      Why is there a difference between the last line               Simplify[ComplexExpand@ArcTan[L, L], {Element[L, Reals], L > 0}]      and the third-last line?               Assuming[Element[L, Reals] && L > 0, ComplexExpand@ArcTan[L, L]]


Transform an expression to remove the singularity

I have the expression `Sin[c x]/c`. Clearly it is undefined at $c=0$, but that is merely a removable singularity, since $$\frac{\sin(cx)}c=x\frac{\sin(cx)}{cx}= x\operatorname{sinc}(cx),$$ which is continuous everywhere. Is it possible to get this sort of transformation automatically in Mathematica using the built-in formula manipulation tools? I tried a few things like `FullSimplify`, `TrigReduce`, etc. but nothing helped. I'd like to be able to do this for `(1 - Cos[c x])/c`, too; that is, automatically transform it into a form that has no singularity at $c=0$.


How I can control the speed with which the cone is filled?

My idea is: By calculating the speed ie VelVol = v2 * t; where v2 is the volume of the second cone (the amount of "water" that is inserted into the cone) You can see that I have 4 slider (The first two control the dimensions of the cone to fill up the last 2 sliders are: One volume and speed another time)               Clear[f, v, r1, v1, h1, v2, r2, h2, t];        Manipulate[        H[h1_, r1_, v_] := CubeRoot[(3 v)*(Power[h1, 2])/N[(Power[r1, 2])* Pi]];        R[r1_, h1_] := N[r1 * H[h1, r1, v]/h1];        v1[h1_, r1_] := (Pi/3)*Power[r1, 2]*h1;        v2 = N[Pi/3]*Power[R[r1, h1], 2]*H[h1, r1, v];        VelVol = t/v2;        Graphics3D[        {         LightBlue, Opacity[.5],         Cone[{{0, 0, h1}, {0, 0, 0}}, r1],         {Blue, Opacity[0.8],          Cone[{{0, 0, H[h1, r1, v]}, {0, 0, 0}}, R[r1, h1]]}         }, Boxed -> True, Axes -> {True, True, True},          ViewPoint -> {0.1, 10, 2},          PlotRange -> {{-5, 5}, {-5, 5}, {0, 5}}], {{r1, 1, "Radio Mayor"},          0, 10}, {{h1, 1, "Altura Mayor"}, 0,          10}, {{VelVol, 1, "Velocidad del volumen"}, 0,          10}, {{t, 1, "Tiempo"}, 0, 10}]                                                               Contribution @Belisarius      I really need your help because I can not move more ----------------------- _-----------------------_ ------------------------------- I try to add the label that appears as the volume is changing as time goes by but the label is not updated, what can I do to be updated as the slider is moved?               H[h1_, r1_, v_] := CubeRoot[(3 v)*h1^2/(r1^2*Pi)];     R[r1_, h1_, v_] := r1*H[h1, r1, v]/h1;     v2 := N[Pi/3]*Power[R[r, h, t], 2]*H[h, r, t];          Manipulate[        Graphics3D[{LightBlue, Opacity[.5],           Cone[{{0, 0, h}, {0, 0, 0}}, r], {Blue, Opacity[0.8],           Cone[{{0, 0, H[h, r, t]}, {0, 0, 0}}, R[r, h, t]]}},           Boxed -> True, Axes -> {True, True, True},           ViewPoint -> {0.1, 10, 2}, PlotRange -> {{-5, 5}, {-5, 5}, {0, 5}},           PlotLabel ->  Style[Panel[v2], White, Background -> Lighter[Gray]]],          {{r, 4, "Radio Mayor"}, 0, 10}, {{h, 4, "Altura Mayor"}, 0,            10}, {{t, 0, "Tiempo"}, 0, 60}]                                                           Contribution @bill s      You're right and is updated but what gives me the value of time and not the volume, how I can fix this problem if I'm supposed to call the sending function v2 (which is the volume of liquid)? ![enter image description here](http://i.stack.imgur.com/MZefb.png)


Ticks in ListLogPlot using LevelScheme

I am using for the first time the package LevelScheme and I don't succeed in ploting the ticks of the logaritmic vertical scale. Anyone with the same problem? I post an example of the problem: ListLogPlot[{{{0.049999999999999996`, 6.80342021478184`}, {20.000000000000068`, 0.6797510625196234`}}, {{0.049999999999999996`, 6.851041750035086`}, {20.000000000000068`, 734391.1255889923`}}, {{0.049999999999999996`, 6.854580160605345`}, {20.`, 6.854580160605345`}}, {{0.049999999999999996`, 1.058498594291096`*^-8}, {20.000000000000068`, 0.6774391003463082`}}}, PlotRange -> {{0, 20}, {0.01, 1000000}}, Joined -> True, PlotStyle -> {{AbsoluteThickness[2.5], Darker[Opacity[1, Blue], 0.15]}, {AbsoluteThickness[2.5], Darker[Opacity[1, Red], 0.15]}, {Dotted, AbsoluteThickness[2.5], Lighter[Opacity[0.75, Gray], 0.15]}, {Dashed, AbsoluteThickness[2.5], Lighter[Opacity[0.75, Black], 0.15]}}, Epilog -> {AbsolutePointSize[8], Darker[Opacity[1, Blue], 0.15], Point[{4.099999999999999, Log[3.1337978336706916]}]}, Axes -> False, Frame -> True, FrameStyle -> Directive[AbsoluteThickness[1.5]], FrameTicks -> {LinTicks[0, 20], LogTicks[10, -2, 6], None, None}, FrameTicksStyle -> Directive[Black, 28, FontFamily -> "Helvetica Neue"], FrameLabel -> {Style["x", Black, 28, FontFamily -> "Helvetica Neue"], Style["y", Black, 28, FontFamily -> "Helvetica Neue"]}, LabelStyle -> {Black, 28, FontFamily -> "Helvetica Neue"}, ImagePadding -> {{120, 20}, {90, 20}}, PlotLegends -> {Placed[ LineLegend[{Style["A", Black, 20, FontFamily -> "Helvetica Neue"], Style["B", Black, 20, FontFamily -> "Helvetica Neue"], Style["C", Black, 20, FontFamily -> "Helvetica Neue"], Style["D", Black, 20, FontFamily -> "Helvetica Neue"]}, LegendMarkerSize -> {40, 30}], {0.25, 0.75}], Placed[PointLegend[{Style["Point", Black, 20, FontFamily -> "Helvetica Neue"]}, LegendMarkers -> "[FilledCircle]", LegendMarkerSize -> {40, 30}], {0.25, 0.75}]}, ImageSize -> 1000] ![enter image description here](http://i.stack.imgur.com/xSqyh.jpg)


Strange ParallelMap behavior

Let the symbol `V` denote an element of some vector space and `nV` its norm. Let `lin` be a linear function, i.e. pull out factors that are not vectors:               lin[c_*x_?CustomVectorQ]:=c*lin[x]     CustomVectorQ[x_]:=MatchQ[x,V]      Let `f` be a (for simplicity constant) function generating an expression using `lin`               f[dummy_]:=lin[V/nV]      and `subst` shall be a simplification `subst[exp_]:=exp/.lin[V]->0`. Now, the odd thing is that if I apply `sf=subst@f@#&` to some list, the result differs depepnding on whether one uses `Map` or `ParallelMap`.               Map[sf,{dummy}]     ParallelMap[sf,{dummy}]      gives `{0}` and `{lin[V]/nV}`, respectively. Adding a debugging function `printf[exp_] := Module[{}, Print["Into subst: ", exp]; exp]`, `subst@printf@f@#&` seems to suggest, that the parallel computation does not use the downvalues of `lin` and thus `subst` does not work. Does anyone know why this happens and what can be done about it?


Creating an image from data not in grayscale

I can Import data from excel and create a gray-scale image using               Image[data, "Real"]      But I want to change from grayscale and as an example use red as the color


Strange function definition result

I'm relatively new to Mathematica, and I'm trying to define a function f(k) that would do the following: > For any positive integer $k$, a finite sequence $a_i$ of fractions > $\frac{x_i}{y_i}$ is defined by: $$a_1 = \frac{1}{k}\\ a_i = > \frac{x_{i-1}+1}{y_{i-1}-1}$$ When $a_i$ reaches some integer $n$, the > sequence stops. (That is, when $y_i=1$.) Define $f(k) = n$. -- Project Euler I have the following function written:               f[k_, sofar_] = Module[{num, result},       result =        If[sofar == 0,1/k,((num = Numerator[sofar]) + 1)/(num/sofar - 1)         ];       If[IntegerQ[result],result,f[k,result]]      ];     f[k_] = f[k, 0]      But I get the result `{ComplexInfinity,List}` and I don't understand why. What am I doing wrong?


Preventing Grid from resizing when the item height is increased

I created a grid of size 200,200 and placed a button in it of size 200×200.               Grid[{{Button["Button", Null, ImageSize -> {200, 200}]}},             Background -> Red, ItemSize -> {15, 15},             Alignment -> {Center, Center}, Frame -> True]      ![Mathematica graphics](http://i.stack.imgur.com/KhfCr.png) When I tried increasing the width of the button, the edges on the 2 sides didn't appear as expected, but when I increased the height of the button, the grid itself gets enlarged to the button's height. I don't want this enlargement to happen. How can I avoid it?


How to express endogenous variables in terms of exogenous variables?

I have 11 endogenous variables _(RD, NR, WR, Q, NQ, R, L, W, NU, C1, C2)_ and two exogenous variables _(EE, K)_. I'm trying to find $RD = f(EE, K),\, NR = f(EE, K),\, ...,\, C2 = f(EE, K)$. Hence, I tried the following code:               {e, α, σ, δ, β1, β2, β3, a, ε, η, q, θ, ω} =        {1.1, 0.66, 0.7, 0.04, 0.6, 0.02, 0.38, 0.1, 1, 0.55, 1.01, 7.7, 0.7}          Eliminate[{        RD == (e NR)^α,         α e^α NR^(α - 1) == WR/(EE q),         WR == θ EE^a,         Q == (β1 NQ^((σ - 1)/σ) + β2 R^((σ - 1)/σ) + β3 k^((σ - 1)/σ))^(σ/(σ - 1)),         β1 (Q/NQ)^(1/σ) == W,         β2 (Q/R)^(1/σ) == EE q,         NR + NQ + NU == 1 - L,         W (NR + NU) == WR NR,         (a/(1 - a)) (C1/C2) == EE,         L == (a^a (1 - a)^(1 - a) EE^-a W)^- ε,         ω Q EE^η - EE C2 -EE q (R - RD) == 0},        {RD, NR, WR, Q, NQ, R, L, W, NU, C1, C2}]      Also, I tried `Solve[{above 11 eqations}, {EE,K}]` and `Reduce`, and still it does not work. Could anyone give me some hints?


How to make a table of $\sum_{i=1}^n$?

I want to create a table of $\displaystyle \sum_{i=1}^n i^k$ for $1\le k\le 5$. The output I want to obtain is a `TeXForm` output as follows. \begin{align} \sum_{i=1}^n i &=\frac1 2 n(n-1)\\ \sum_{i=1}^n i^2 &=\frac1 2 n(n-1)(2n+1)\\ &\vdots \end{align} My attempt is as follows but it does not produce what I want to achieve.               Sum[i^k, {i, 1, n}] // Table[Factor[#], {k, 1, 5}] & // TableForm


Quickly look-up usages, options and attributes of symbols

When I'm writing code in the front-end, I find myself very often looking up the list of options of a symbol over and over again in the documentation center. In most cases you find there a list of available options, but sometimes not and you may end up typing `Options[Get]` in your current notebook. Even worse is the situation with `Attributes` which are extremely helpful especial when you do something with non-standard evaluation. In this case, I often just want to know _Does a function hold its arguments?_ or _Is this function listable?_ to give two examples. **Question:** Isn't there a one-click palette solution for this?


MathLink Graphical Output (Plots) to File

In a custom Mathematica frontend based on MathLink I try to make use of plots produced in Notebooks. The idea is to write them to files whenever they get produced. According to C-code snippets I found online the following should store all plots in postscript cells in a Mathematica file "picture_book" if `$Display = "stdout"` is executed in the beginning:               case DISPLAYPKT:       if(MLGetString(link, &output_string)){         if(first_PS_piece){           first_PS_piece = FALSE;           if(picture_book){             fprintf(picture_book, "%s", ps_cellheader);           }         }         if(picture_book){           fprintf(picture_book, "%s", output_string);         }         MLDisownString(link, output_string);       }       break;          case DISPLAYENDPKT:       if(MLGetString(link, &output_string)){         if(picture_book){           fprintf(picture_book, "%s", output_string);         }         MLDisownString(link, output_string);       }       first_PS_piece = TRUE;       break;      However, when I run `$Display = "stdout"` at first, I get the error message               Graphics::opset: Option DefaultAxesStyle is not set in Options[Graphics].      twice, each time I try `Plot`. Trying to set `DefaultAxesStyle` did not work. The code above appears in the loop which handles the output after running Mathematica commands with MathLink. I verified that it retrieves other output packets (not shown), but `DISPLAYPKT` packages are never received. This code might be outdated and so I wonder if I need to do anything else in order to obtain proper output packets. Note that I am on Linux. A different (disfavored) approach would be to use the `Export["plot.eps",plot]` function in order to export each plot to a separate file. How would I achieve this with minimal impact on existing Notebooks? I.e. can I redefine the `Plot` command such that each is automatically exported to a separate file with automatic naming? **Edit** After some changes my frontend receives textual Output of the following kind when I call `Plot` or similar (abreviated example output)               Graphics[{{{}, {}, {Hue[0.67, 0.6, 0.6], Line}}}, {AspectRatio -> GoldenRatio^(-1), Axes -> True, AxesLabel -> {None, None},  AxesOrigin -> {1., 0.05}, Method -> {},  PlotRange -> {{1, 3}, {0.04978707039998921, 0.3678794261559552}},  PlotRangeClipping -> True, PlotRangePadding ->   {Scaled[0.02], Scaled[0.02]}}]      If I execute these outputs manually inside a Notebook in the default frontend it seems to produce the plots. Is it a consistent approach to detect this `Graphics[]` output and to write it to a file (which kind of file) and then execute that file manually (or later automatically) in the Mathematica interface to produce visual plots? Or could this output be missing some information or be more general for different plot commands? **Edit 2** Motivated by the answers and comments below and the Mathematica documentation I tried the command:               Off[FrontEndObject::notavail]; Get["Version5`Graphics`"]; Plot[Sin[t], {t, 0, Pi}]      Together with custom `Format` definitions for `Graphics` (and similar) this would re-enable the 'old fashioned' way of retrieving display output described above. However I do not completely understand how to deal with the abbreviate postscript output (shown below in shortened form). Obviously postscript is missing some definitions to render it. How do I convert this to a complete consistent postscript file?               %!     %%Creator: Mathematica     %%AspectRatio: .61803      MathPictureStart     /Mabs {     Mgmatrix idtransform     Mtmatrix dtransform     } bind def     /Mabsadd { Mabs     3 -1 roll add     3 1 roll add     exch } bind def     %% Graphics     %%IncludeResource: font Courier     %%IncludeFont: Courier     /Courier findfont 10  scalefont  setfont     % Scaling calculations     0 0.31831 0 0.618034 [     [.15915 -0.0125 -9 -9 ]     Mfstroke     % End of Graphics     MathPictureEnd     :[font = postscript; PostScript; formatAsPostScript; output; inactive; pictureLeft = 100; pictureWidth = 300; pictureHeight = 300;]      It is probably not feasible without the official front end, is it? **Edit 3** Following advice given below in comments I tried the following definitions to print all plots to files. Is this consistent or is there a better way to do it? (First I had tried to redefine `Graphics` and `Graphics3D` directly, because it seems more elegant to me. However this resulted in recursions or it would have no effect whatsoever.)               useMyGraphics[vars__] :=       Block[{Graphics = myGraphics, Graphics3D = myGraphics3D}, vars]     Format[myGraphics[vars__]] :=       Export["picture.png", Graphics[vars], ImageResolution -> 300]     Format[myGraphics3D[vars__]] :=       Export["picture3D.png", Graphics3D[vars], ImageResolution -> 300]     Protect[myGraphics];     Protect[myGraphics3D];     Protect[useMyGraphics];     $Pre = useMyGraphics


Google Code Jam: Mountain View code review

After participating in Google Code Jam 2012 Round 2, it occurred to me that the Mountain View problem boiled down to solving a set of linear inequalities, which could be done in Mathematica. I've only tinkered with Mathematica programming before, but I tried it out to see how hard it was for this problem. I got it to work (for the "small" input set only) with a lot of effort. I felt like I must be doing some things the hard way and would like feedback on the proper Mathematica idioms for file I/O and expression building (and anything else). You may have to read the problem description (link above), but the basics are:   * You read test cases from an input file, C.in.   * You write answers to an output file, C.out.   * Each input case contains a number of mountains and a constraint number for each mountain.   * Each output line contains a list of possible mountain heights or the word "Impossible" My program follows. During development, I send output to stdout. `debug` toggles that. I put it early because I thought I might use it for `Print` statements.               debug = False;      This function solves a single case, including reading input and writing output.               solveCase[in_, out_, cn_] :=        Module[{nm, im, highest, vars, constraints, i, j, k, rhs, lhs, yk,          yi, yj, answer},      Read the input: the number of mountains and the apparent highest mountain that can be seen from each of the first nm-1 mountains.                   nm = Read[in, Number];         highest = Array[0, nm - 1];         For[im = 1, im <= nm - 1, im++,           highest[[im]] = Read[in, Number];          ];      Start setting up expressions to pass later to `FindInstance`. Is there a way to solve for a vector of variables without giving each one a separate name? Not finding any, I create the variables as `h1`, `h2`, ... and the initial constraints as `h1 >= 0`, `h2 >= 0`, ...                   vars =           Function[x, ToExpression["h" <> ToString[x]]] /@ Range[nm];         constraints =           Function[x, ToExpression["h" <> ToString[x]] >= 0] /@ Range[nm];      Convert the `highest` info into a list of constraints. When mountain `i` sees mountain `k` as the highest, it means the slope of the line between their peaks is above the line for each `j` between `i` and `k` and above or at the line for each `j` after `k`.                   For[i = 1, i <= nm - 1, i++,          k = highest[[i]];          For[j = i + 1, j <= nm, j++,           If[j == k, Continue[]];      Build constraint, `(hk - hi) * (j - i) GT/GE (hj - hi) * (k - i)`. This part seems especially clumsy. I ended up resorting to strings, but there must be a way to do it at the expression level.                     yk  = "h" <> ToString[k];           yi = "h" <> ToString[i];           yj = "h" <> ToString[j];           lhs = ToExpression["(" <> yk <> " - " <> yi <> ") * " <> ToString[j - i]];           rhs = ToExpression["(" <> yj <> " - " <> yi <> ") * " <> ToString[k - i]];           If[i < j, AppendTo[constraints, Greater[lhs, rhs]],             AppendTo[constraints, GreaterEqual[lhs, rhs]]];           ];          ];      The real work:                   answer = FindInstance[constraints, vars, Integers];      Write the output as `Case #N: h1 h2 ...`.                   WriteString[out, "Case #", cn, ": "];         If[Length[answer] > 0,          answer = answer[[1]][[ All, 2]];          For[i = 1, i <= nm , i++, WriteString[out,  answer[[i]]];            If[i < nm, WriteString[out, " "], WriteString[out, "\n"]]],          WriteString[out, "Impossible\n"]];         ;        ];      The "main" program. Set up in and out and cycle through the cases. I'm guessing the entire program should go in a `Module` with local-only variables.               in = OpenRead["~/Documents/math/C.in"];     If[debug, out = OutputStream["stdout", 1],        out = OpenWrite["~/Documents/math/C.out"]];     ncases = Read[in, Number];     For[ic = 1, ic <= ncases, ic++, solveCase[in, out, ic]];     Close[in];     If[! debug, Close[out]];      This method takes forever for the 1000+ mountain case, so if there is a better way than `FindInstance`, I'd like to hear about that, too. Or maybe the code needs to take into account higher level constraints rather than solving the most general form of the problem. Note: After seeing no use of Mathematica (Code Jam Language Stats) in previous contests, I realized Mathematica is not allowed because there is no free version, so this is even more of an academic exercise than I intended.


Creating a slider that instead of setting, increases/decreases a variable

**The objective:** Create a slider that, when displaced from the center, increases-decreases the value of another variable at a rate proportional to the displacement. So, I create a slider that automatically comes back to the center               Slider[Dynamic[var, {(var = #) &, (var = 0.) &}], {-1, 1}]      Now I want a second variable to be dynamically increased/decreased when `var!=0.` **My ideas are:**   1. insert in the previous dynamic, something that does the updating   2. use an animator with its speed set by `var` when `var!=0.` that updates the value **Problems with the above:**   1. How to control the speed of the updating given that I can't know for sure the intervals in which `val` will be updated, and `UpdateIntervals` sets an upper bound?   2. How to make it work without it showing in the screen? Any other alternatives are welcome (ideally I'd like an elegant solution).


How to set a variable between 1 and 0, and how to check the FOC is greater or small than 0 by assumption?

I have the following notebook:               $Assumptions = Flatten[{Thread[{c0, c1, p, w, e} > 0],Thread[0 <= {{r, i, x, alpha, beta, gamma, {1 - alpha - beta - gamma}, {1 + r - i}, {1 - x}} <= 1}], Element[{c0, c1, p, w, e, r, i, x, alpha, beta, gamma, {1 - alpha - beta - gamma}, {1 + r - i}, {1 - x}}, Reals]}]          case11 = ((1 - x)*alpha*(c0 + e + w + w/(1 + r - i)));          case12 = ((1 - x)*gamma*(c0 + w - p/(1 + r - i)));          case13 = x*(c0 - p);          case21 = ((1 - x)*(1 - alpha - beta - gamma)*(c0 + c1/(1 + r - i) + e+ w+ w/(1 + r - i)));          case22 = ((1 - x)*beta*(c0 + c1/(1 + r - i) - p/(1 + r - i) + w));          case23 = (x*(c0 - p));          f = case11 + case12 + case13;          h = case21 + case22 + case23;          g = e + w + w/(1 + r - i);          occc=g/h;          ocdc=g/f;      I would like to check if `D[occc,p]` is positive, i tried to run the `Positive`, but seems it does not work, it did not give me True of False as a result. I believe I need to have more condition to make `D[occc,p` to be positive, I would like to know those conditions,the word "conditions" i would like to see is something like c0>p, can _Mathematica_ tell me? Thanks


How to get the correct answer when solve this equation?

I want to find the values of the parameter $m$ to the graph of the funtion $$x^4 - 2 m x^2 + m + 1$$ has three extremal points make an equilateral triangle. I tried               Clear[f];     f[x_] := x^4 - 2 m x^2 + m + 1     sol = Solve[D[f[x], x] == 0, x]     t = x /. sol;     a = {t[[1]], f[x /. sol[[1]]]};     b = {t[[2]], f[x /. sol[[2]]]};     c = {t[[3]], f[x /. sol[[3]]]};     ab = EuclideanDistance[a, b];     bc = EuclideanDistance[b, c];     ac = EuclideanDistance[a, c];     Solve[{ab == bc, bc == ac, ac == ab}, m, Reals]      The correct answer is $m =\sqrt[3]{3}$. But, when I tried               Solve[{ab == bc, bc == ac, ac == ab, m > 0}, m, Reals]      Mathematica out put empty set. How to get the correct answer? And how to reduce my code?


Nesting multiple functions of multiple variables

I was wondering how one would go about nesting multiple functions of, say, two variables. The problem comes from trying to implement the Chirikov standard map without using "for" cycles. I found a demonstration project that did it, but I couldn't figure out the code. I would appreciate any kind of help, thanks. Just for the sake of information, the Chirikov standard map can be defined as $$\begin{aligned} y' &= y + \varepsilon \sin(x) \\ x' &= x + y' \end{aligned}$$


SetOptions or other approach to imposing default styling of text in a BarChart Legend?

Gustavo Delfino's answer to an earlier question showed that it is possible to use the third argument to `Placed` to format text in a `BarChart` legend as desired. For example, without this argument, the legend text in the example below would still be small and in Times, even though I have used `SetOptions` to style `BaseStyle` for `BarChart`, `Graphics`, etc.               BarChart[RandomVariate[NormalDistribution[0, 0.6], 40],       ChartStyle -> Join[ConstantArray[Green, {39}], {Orange}],       ChartLegends -> Placed[Join[ConstantArray[None, {39}], {"Preliminary estimates"}],         Bottom, Style[#, FontFamily -> "Arial", FontSize -> 14] &]]      ![enter image description here](http://i.stack.imgur.com/XuLmE.png) Is there a way to set this globally? I’d like to enforce the font style of legends in a package, the way I have already done for the frame around the legend using Mr.Wizard’s answer to an earlier question of mine on StackOverflow. I would have thought some setting of `BaseStyle` should work but these are the only (undocumented) options that `Legending`GridLegend` takes:               Options[Legending`GridLegend]          {"LegendPlacementFunction" -> Automatic,       LegendAppearance -> Automatic,       Legending`LegendContainer -> Automatic,       Legending`LegendHeading -> None, Legending`LegendImage -> Automatic,       Legending`LegendImage -> Automatic,       Legending`LegendLayout -> Automatic,       Legending`LegendPosition -> Automatic,       Legending`LegendSize -> Automatic}


Selective inclusion of elements in BarChart Legend

Further to my previous question, is there a concise way - amenable to automated setting in a package so that it can be accessed globally - to eliminate some legend item that would otherwise show? For example, in this example, I'd like to only show the orange rectangle and text "Preliminary estimates". ![enter image description here](http://i.stack.imgur.com/Wcznl.png) I tried a couple of replacement rules, by analogy with belisarius’s answer for reversing stacked bar chart legends, such as the example below, but it doesn’t seem to make any difference.               BarChart[RandomVariate[NormalDistribution[0, 0.6], 40],       ChartStyle -> Join[ConstantArray[Green, {39}], {Orange}],       ChartLegends ->       Placed[Join[ConstantArray[None, {39}], {"Preliminary estimates"}],       Bottom]] /. Pane[Row[x_]] :> Pane[Row[Last[x]]]


NDSolve solution violates initial conditions

I have the following code:               solution = NDSolve[{5269.333333333333` Cos[a[t]] + 1.` Cos[a[t]] l[t] +       83.33333333333333` Cos[a[t] - c[t]] Derivative[1][c][t]^2 +       172.66666666666666` Derivative[2][a][t] +       8.` Cos[a[t] + b[t]] Derivative[2][b][t] ==      8.` Sin[a[t] + b[t]] Derivative[1][b][t]^2 +       83.33333333333333` Sin[a[t] - c[t]] Derivative[2][c][t],       Cos[b[t]] l[t] + 6 Cos[a[t] + b[t]] Derivative[2][a][t] +       8 Derivative[2][b][t] ==      64 Cos[b[t]] + 6 Sin[a[t] + b[t]] Derivative[1][a][t]^2,       1.` Sin[c[t]] + 0.015625` Derivative[2][c][t] ==      0.03125` Cos[a[t] - c[t]] Derivative[1][a][t]^2 +       0.03125` Sin[a[t] - c[t]] Derivative[2][a][t],      6 Sin[a[t]] + 8 Sin[b[t]] == 3 Sqrt[2],      4 a[0] == \[Pi], b[0] == 0, c[0] == 0,      Derivative[1][a][0] == 0,      Derivative[1][b][0] == 0,      Derivative[1][c][0] == 0},     {a[t], b[t], c[t], l[t]},     {t, 0., 0.25}, Method -> {"IndexReduction" -> Automatic}];          asol[t_] = a[t] /. Flatten[solution];     Print["a[0]=", asol[0] , "= and a'[t]=", Derivative[1][asol][0]]      Note that I have a'[t] = Derivative[1][a][0] == 0 among the initial conditions. Yet, the output of this cell is               a[0]=0.785398= and a'[t]=6.06109      a'[t] != 0! I tried restarting Mathematica and pasting this into a new notebook, same thing. When I plot a[t], it indeed trends up instead of starting with a slope of 0. I suspect the odds of me discovering a bug in NDSolve the first time I use it are about 0 (or 0.`5) so I suspect I am not using it right. What am I doing wrong here? Why is Mathematica giving me a solution that is NOT a solution? Any pointer appreciated.


How to pick an element of a row corresponding to the minimum in a particular column?

How can I find what value in column 1 of my list corresponds to the minimum value in column 2?


Improve Plot3D resolution near max/mins

I have the following function $$V(r) = \sum_{i=1}^N 4 \epsilon_i \left(\frac{\sigma_i^{12}}{\|r-r_{0i}\|^{12}}-\frac{\sigma_i^6}{\|r-r_{0i}\|^6}\right)$$ which -for those interested- corresponds to a sum of Lennard-Jones potentials, with the following real life set of parameters               sig = {0.329633, 0.0400014, 0.405359, 0.235197, 0.387541, 0.235197,            0.235197, 0.387541, 0.235197, 0.235197, 0.387541, 0.235197,            0.235197, 0.387541, 0.235197, 0.235197, 0.329633, 0.0400014,            0.0400014, 0.0400014, 0.356359, 0.302906, 0.329633, 0.0400014,            0.387541, 0.235197, 0.235197, 0.356359, 0.302906, 0.329633,            0.0400014, 0.405359, 0.235197, 0.387541, 0.235197, 0.235197,            0.405359, 0.235197, 0.36705, 0.235197, 0.235197, 0.235197, 0.36705,            0.235197, 0.235197, 0.235197, 0.356359, 0.302906, 0.329633,            0.0400014, 0.405359, 0.235197, 0.387541, 0.235197, 0.235197,            0.387541, 0.235197, 0.235197, 0.356359, 0.302906, 0.329633,            0.0400014, 0.0400014, 0.356359, 0.302906, 0.329633, 0.0400014,            0.405359, 0.235197, 0.405359, 0.235197, 0.36705, 0.235197, 0.235197,            0.235197, 0.387541, 0.235197, 0.235197, 0.36705, 0.235197, 0.235197,            0.235197, 0.356359, 0.302906}          eps = {0.8368, 0.192464, 0.08368, 0.092048, 0.23012, 0.092048, 0.092048,            0.23012, 0.092048, 0.092048, 0.23012, 0.092048, 0.092048, 0.23012,            0.092048, 0.092048, 0.8368, 0.192464, 0.192464, 0.192464, 0.46024,            0.50208, 0.8368, 0.192464, 0.23012, 0.092048, 0.092048, 0.46024,            0.50208, 0.8368, 0.192464, 0.08368, 0.092048, 0.23012, 0.092048,            0.092048, 0.08368, 0.092048, 0.33472, 0.092048, 0.092048, 0.092048,            0.33472, 0.092048, 0.092048, 0.092048, 0.46024, 0.50208, 0.8368,            0.192464, 0.08368, 0.092048, 0.23012, 0.092048, 0.092048, 0.23012,            0.092048, 0.092048, 0.29288, 0.50208, 0.8368, 0.192464, 0.192464,            0.46024, 0.50208, 0.8368, 0.192464, 0.08368, 0.092048, 0.08368,            0.092048, 0.33472, 0.092048, 0.092048, 0.092048, 0.23012, 0.092048,            0.092048, 0.33472, 0.092048, 0.092048, 0.092048, 0.46024, 0.50208}          r0 = {{0.681, -2.673}, {0.605, -2.736}, {0.715, -2.578}, {0.812, -2.583},           {0.628, -2.607}, {0.654, -2.698}, {0.533, -2.609}, {0.63, -2.515},           {0.559, -2.545}, {0.609, -2.423}, {0.763, -2.509}, {0.825, -2.446},           {0.804, -2.6}, {0.742, -2.461}, {0.709, -2.367}, {0.829, -2.465},           {0.642, -2.547}, {0.629, -2.515}, {0.675, -2.642}, {0.555, -2.543},           {0.693, -2.445}, {0.778, -2.359}, {0.585, -2.422}, {0.526, -2.499},           {0.55, -2.291}, {0.543, -2.236}, {0.459, -2.299}, {0.638, -2.219},           {0.661, -2.105}, {0.715, -2.293}, {0.688, -2.387}, {0.829, -2.244},           {0.791, -2.156}, {0.867, -2.346}, {0.893, -2.431}, {0.946, -2.309},           {0.754, -2.38}, {0.674, -2.422}, {0.697, -2.255}, {0.627, -2.281},           {0.77, -2.205}, {0.657, -2.197}, {0.802, -2.482}, {0.729, -2.503},           {0.825, -2.566}, {0.883, -2.448}, {0.956, -2.216}, {1.034, -2.126},           {0.986, -2.287}, {0.921, -2.356}, {1.104, -2.268}, {1.178, -2.271},           {1.13, -2.381}, {1.056, -2.379}, {1.217, -2.362}, {1.135, -2.523},           {1.218, -2.53}, {1.055, -2.534}, {1.137, -2.64}, {1.171, -2.628},           {1.083, -2.751}, {1.043, -2.753}, {1.08, -2.832}, {1.099, -2.133},           {1.196, -2.059}, {0.987, -2.095}, {0.911, -2.161}, {0.964, -1.963},           {1.042, -1.957}, {0.833, -1.955}, {0.818, -1.859}, {0.844, -2.053},           {0.759, -2.051}, {0.92, -2.024}, {0.861, -2.146}, {0.714, -1.996},           {0.729, -2.089}, {0.708, -1.934}, {0.581, -1.991}, {0.505, -2.018},           {0.565, -1.898}, {0.586, -2.053}, {0.98, -1.845}, {1.047, -1.739}}      which -again, for those interested- correspond to a 2D projection of the first five residues of a S4S5 alpha helix for the Kv1.2 Ion Channel. Defining $V(r)$ as               v[r_, r0_, s_, ep_] := 4 ep (s^12/EuclideanDistance[r, r0]^12 -                                  s^6/EuclideanDistance[r, r0]^6);      I can plot the potential with               Plot3D[Sum[v[{x, y}, r0[[i]], sig[[i]], eps[[i]]], {i, 1, 84}],             {x, -0.5, 2}, {y, -3.5, -1},             PlotStyle -> Directive[Opacity[0.35], Blue],             AxesLabel -> {x, y}, PlotRange -> {-5, 1}     ]      obtaining the following output ![plot of sum of potentials](http://i.stack.imgur.com/aYHDa.png) or, using `PlotPoints -> 50` ![refined plot of sum of potentials](http://i.stack.imgur.com/rLRqh.png) where the minima/maxima can be seen really well. The thing is, I have a lot of these objects, with a lot more elements, and a lot of minima/maxima, in a way that is very expensive for my (old) computer to simply increase `PlotPoints` for smoother graphics, and I was wondering, due the fact that $V(r)$ rapidly decreases, **if there is a way to ask _MMA_ to increase resolution near the minima/maxima, and reduce it far from the data set** `r0`. Hope my question is clear _and interesting_. **--FINAL EDIT--** First of all, I want to thank you all for your comments and answers. If I could, I'd accept _all of them_ , since each one gave me the insight needed to solve my problem. For obvious reasons, Silvia's answer deserves maximum recognition, but readers should also check PlatoManiac and  Sjoerd C. de Vries responses, as they will provide a full picture. Now, to honour the work of all the people involved, I'll show you the beautiful application of the code they've worked out. Here is a caricaturization of the _S4S5 linker_ helix, believed to play a major role in the opening and closing of voltage gated potassium channels. ![S4S5 linker helix](http://i.stack.imgur.com/IiqxA.png) This helix generates all sort of van der Waals interactions, that can be modelled by the Lennard-Jones potential. For specific reasons, I need to see how this potential looks on a given plane, namely the _XY_ plane, and it is very important to capture all the maxima and minima of it, as it will provide a full picture of the dynamics in that plane. Thanks to Silvia's code, one can see: a view from below of the potential generated by the helix, ![View from below](http://i.stack.imgur.com/Y9H3t.png) a sideways view, where the peaks are actually minima, ![Sideways veiw, the peaks are actually minima](http://i.stack.imgur.com/EJ5yn.png) and a view form above, ![View from above](http://i.stack.imgur.com/WSC5p.png) What you are seeing is the van der Waals interactions generated by the helix over that plane, and if you're wondering what does that sharp barrier around the helix is, it's the macroscopic consequence of Pauli's Exclusion Principle! **Thank you all for your help, you've put a big smile on my face!**


Historical Prices via FinancialData

I downloaded the historical stock prices for some stocks in the period 1990-2013 via FinancialData some months ago and computed the financial returns. Now I downloaded the data again for the same stocks in the same period but obtain slightly diffrent returns. Why is this so? I use the same code. These are the historical prices, they should not change. Are the prices being adjusted every couple of moths somehow?


Quiet doesn't work with FindRoot when using Brent method

The following has no solution:               FindRoot[x == 1, {x, 0.25, 0, 0.5}]      And Mathematica correctly warns us: > FindRoot::reged: The point {0.5} is at the edge of the search region > {0.,0.5} in coordinate 1 and the computed search direction points outside > the region. If we use `Quiet`, we correctly suppress the message. The following is exactly the same system, but here we ask for a specific numerical method               FindRoot[x == 1, {x, 0, 0.5}, Method -> "Brent"]      And we receive a similar warning: > FindRoot::bbrac: Method -> Brent is only applicable to univariate real > functions and requires two real starting values that bracket the root. But this time, if we add `Quiet`, we still receive the same warning. Why isn't `Quiet` working (is it a bug)?


Access wi-fi raw data

I would like to know if anyone has any idea of how to access live wi-fi raw data from my computer (in monitor and promicuous mode). I would like to develop a code to get the MAC address of every device around me, including cellphones that are not connected to any network (I know every smartphone sends wi-fi signal when they're on). Since I've discovered that the latest versions of MacBooks can use the wi-fi board in monitor and promicuous mode, I'm trying to access it's raw data. I don't even know if it's possible with Mathematica (but if it is, it would be perfect to handle the data the way I want). If you know whether and how it could be done, please help me. If it can't be done in Mathematica, could you indicate a programming language that allows to access this kind of data? I'm asking this here because i've done some tests in Wireshark and was able to get the MAC address of my own iPhone when I turned the wi-fi on. The problem is that I can only capture a lot of data and analyse it AFTERWARDS. I would like to analyse the wi-fi data as soon as it's been captured. I've searched about it on internet and even how to do that with arduino, but without any luck. Thanks for your help in advance! **UPDATE:** Thanks to rm -rf I'm able to get information from my wifi and display in Mathematica. The next step is sniff all wifi devices (more precisely smartphones) that are on. The important part is that they must not be necessarily connected to any network! I found the command "airport sniff [channel]" that can be used from Terminal. It creates a temporary .cap file in the /tmp folder, but i'm not able to read it. I'm not quite sure if it's the right path. I would be glad if someone could help me a little bit further here =]


Is Package development (via InitializationCells) compatible with creating new Notations (via MakeExpressions)?

Can new (lower-level) notations be readily used within package code? There are a few notational additions that might improve my code base but I'm not sure if these will end up being more trouble than they are worth. For example, take a first step in an attempt to implement a more “natural” and “efficient” struct; Using `MakeExpression`               MakeExpression[RowBox[{lhs___, x__, "\[CenterDot]", y__, rhs___}],StandardForm] :=      MakeExpression[RowBox[{lhs, RowBox[{x, "[", y, "]"}], rhs}],StandardForm];      yields a more OO-like notation `In[2]:= obj."field1"."field2"` `Out[2]:= obj["field1"]["field2"]` [Here the `.` is mimicking Mma's `\\[CenterDot]` -SE won't let newbies post images)] In any (frontend) package development however, placing `obj."field1"."field2"` within an initialization cell causes this exact form to be placed in the corresponding .m file. It is this form that is subsequently loaded in by `Get` i.e. _without_ any of the frontend parsing provided by the `MakeExpression` definition. Hence the intended notation does not take effect in packages (instead `CenterDot` in `CenterDot[obj,"field1","field2"]` becomes unintentionally defined but a priori I want to avoid overloading `CenterDot` for efficiency/inheritance/encapsulation reasons). One hack is to forcibly activate the frontend's parser while loading in packages by invisibly opening up the .m file and evaluating all initialization cells - something along the lines of:               ParsingGet[pathTomFile_] := With[{nb = NotebookOpen[pathTomFile, Visible -> False]},     FrontEndTokenExecute[nb, "EvaluateInitialization"];     NotebookClose@nb]      This then creates such messiness as having to explicitly integrate with `Get`'s package name arguments, multi-argument `BeginPackage` calls, "stub symbols" and avoiding developmental surprises such as `obj."field1"."field2"` not reflecting package updates in single frontend tests such as `(ParsingGet[mfilepath]; obj."field1"."field2")` (the kernel will grab `obj."field1"."field2"` and not let go). I’m a bit wary of going down a path that seems to quickly set off a series of cascading hacks but on the other hand I’m wondering if I’ve missed something (an `InitializionCell`-like option value?) or if anyone has extensively used such notational (or perhaps more accurately _language_ ) changes in package development? One might expect they should be able to play nicely together since a whole package has been devoted to these lower-level notations in Mma (Jason Harris’s Notation package) and anyone going down this more involved notational route would surely want to harness them in their own packages at some point?


Make a map of squares

I'm trying to use Mathematica to make a map similar to the one here ![target](http://i.stack.imgur.com/TUDRh.png) i.e. a US map where each state is represented by a square of a given size, located as close as possible to its true geographical position while not overlapping with other squares. I get the data for the squares as follows:               usa = Import[        "http://code.google.com/apis/kml/documentation/us_states.kml",        "Data"];     transform[s_] := StringTrim[s, Whitespace ~~ "(" ~~ ___ ~~ ")"]     polygons =       Thread[transform[          "PlacemarkNames" /. usa[[1]]] -> ("Geometry" /. usa[[1]])];     (* Remove Alaska and Hawai *)     polygons =       Join[{polygons[[1]]}, polygons[[3 ;; 10]], polygons[[12 ;;]]];     centers = First /@ polygons[[All, 2, 1]];     area[poly_] :=      Apply[Plus,        Flatten[First@poly Map[({1, -1} Reverse[#] &),           RotateLeft[First@poly]]]]/2     areas = Table[Total[area /@ polygons[[i, 2, 2 ;;]]], {i, 1, 48}];     sizes = Sqrt /@ areas;      which uses the true area of the state as square area, which is enough for now. I can plot them:               Graphics[Table[{RGBColor[RandomReal[], RandomReal[], RandomReal[]],         Rectangle[{centers[[i, 1]] - sizes[[i]]/2,           centers[[i, 2]] - sizes[[i]]/2},         {centers[[i, 1]] + sizes[[i]]/2,           centers[[i, 2]] + sizes[[i]]/2}]}, {i, 1, 48}]]      ![works](http://i.stack.imgur.com/kzyw8.png) * * * Starting now, I demonstrate how far I've managed to go on my own. I want to move the squares to non-overlapping positions. I try to minimize the following score function:               dist[c1_, c2_, s1_, s2_] := Module[{dx, dy},        dx = Abs[c1[1] - c2[1]]; dy = Abs[c1[2] - c2[2]];        Max[0, dx - s1 - s2] + Max[0, dy - s1 - s2]        ];     res = FindMinimum[       Sum[Sum[dist[c[i], c[j], sizes[[i]], sizes[[j]]], {j, i + 1, 48}], {i, 1, 48}],        Flatten[Table[{c[i][j], centers[[i, j]]}, {i, 1, 48}, {j, 1, 2}], 1]]      but plotting this gives terrible results:               Graphics[Table[{RGBColor[RandomReal[], RandomReal[], RandomReal[]],          Rectangle[{c[i][1] - sizes[[i]]/2, c[i][2] - sizes[[i]]/2},          {c[i][1] + sizes[[i]]/2, c[i][2] + sizes[[i]]/2}]}, {i, 1, 48}] /. res[[2]]]      I have not been able to see what is the issue with my code, because the score function clearly shouldn't be zero for this particular solution, but I am at loss to understand why. Any hint about that, or advice on tackling the problem in a different way, is welcome! ![Doesn't work](http://i.stack.imgur.com/mkaw2.png)


Solve system of non commutative operators

I'd like to use mathematica to solve systems of linear equations, where the entries are non commutative matrices. I just tried the NC package but it doesn't help so far. For example I can solve:                In[1]: NCSolve[a0 ** b0 + a1 ** b1 + a2 ** b2 + a3 ** b3 == 1, a0]     Out[1]: {a0 -> inv[b0] - a1 ** b1 ** inv[b0] - a2 ** b2 ** inv[b0] - a3 ** b3 ** inv[b0]}      what's fine. But NCSolve only works for one equation with one unknown. So I'd like to know if there is any tool to solve e.g.:               IN[2]: Solve[{a0 ** b0 + a1 ** b1 + a2 ** b2 + a3 ** b3 == 1,             a1 ** b0 + a0 ** b1 + I*(a2 ** b3 - a3 ** b2) == 0,             a2 ** b0 + a0 ** b2 + I*(a3 ** b1 - a1 ** b3) == 0,             a3 ** b0 + a0 ** b3 + I*(a1 ** b2 - a2 ** b1) == 0}, {a0, a1, a2,             a3}]      Unfortunately this isn't possible as I posted it and also it doesn't work with NCSolve. Any ideas or suggestions are welcome. Additionally I'd like to know a way how to type this using matrices of non commuting matrices. I.e. what I posted before is just finding the inverse of in the Pauli-Spin basis of a 2x2 matrix, it would be nice to type something like               In[3]: a = a0*PauliMatrix[0] + a1*PauliMatrix[1] + a2*PauliMatrix[2] + a3*PauliMatrix[3]            b = b0*PauliMatrix[0] + b1*PauliMatrix[1] + b2*PauliMatrix[2] + b3*PauliMatrix[3]            NCSolve[a ** b == 1, {a0,a1,a2,a3]      Thanks a lot!


Very fast way to do a coordinate frame transform

I need a function that rotates and translates a huge amount of line segments. For example, I have a set of line segments in the form `{{x0,y0,z0},{x1,y1,z1}}`               data = RandomReal[{-1, 1}, {20000, 2, 3}]      and three vectors               n = {n1,n2,n3}     s = {s1,s2,s3} (* Orthogonal to n *)     p = {p1,p2,p3}      I want to perform a rigid (right handed) transformation that sends `p` to the origin, `n` to the $z$ axis and $s$ to the $y$ axis, in order to apply it to `data`. I know about `RotationMatrix`, `RotationTransform`, and I have coded a (very ugly) solution but, due to inexperience and the amount of data, I'm struggling with performance. I would be very grateful if someone can provide a fast solution and, if possible, to explain why is fast. **EDIT** Here is the _ugly_ code, for my own embarrassment               rotZ = RotationTransform[{n, {0, 0, 1}}];     rotY = RotationTransform[{s, {0, 1, 0}}];     RT[v_]:= rotY[rotZ[-p + #]] & /@ v;      and then               dataTrans = RT /@ data      Taking               n = RandomReal[{-1, 1}, 3];     s = {-n[[2]], n[[1]], 0}; (* n and s are orthogonal *)     p = RandomReal[{-1, 1}, 3];      then               Timing[RT /@ data][[1]]     (*    3.60422    *)      In an Intel Core2 Duo CPU T8100 @2.10GHz, 4gb ram Ubuntu 12.04, Mathematica 8 distribution.


trouble with Dynamic range in SetterBar

It appears that I can set the range to a `Dynamic` variable in a `Manipulate` control, but not in a `SetterBar` control? :               Manipulate[      tick;      Dynamic@If[ tabNumber == dynTab, Plot[ x^2, {x, 0, 1}],        Plot[ 1 - x^2, {x, 0, 1}]]      , TabView[ {        "dynamic range" -> Column[ tabNumber = dynTab ; {           Row[{Manipulator[              Dynamic[m2, (m2 = #; tick = Not[tick]) &], {2, Dynamic@range,                2}], " ", Dynamic[m2] }],           Row[{SetterBar[Dynamic[s2, (s2 = #; tick = Not[tick]) &],              Range[Dynamic@range]], " ", Dynamic[s1] }]           }],        "static range" -> Column[ tabNumber = staticTab ; {           Row[{Manipulator[              Dynamic[m1, (m1 = #; tick = Not[tick]) &], {2, 8, 2}], " ",             Dynamic[m1] }],           Row[{SetterBar[Dynamic[s1, (s1 = #; tick = Not[tick]) &],              Range[8]], " ", Dynamic[s1] }]           }]        }, Dynamic @tabNumber ]      , {{tick, False}, None}      , {{tabNumber, 1}, None}, {{dynTab, 1}, None}, {{staticTab, 2}, None}      , {{m1, 2}, None}, {{m2, 2}, None}, {{s1, 2}, None}, {{s2, 2}, None}      , {{range, 8}, None}      , TrackedSymbols :> {tick}, ControlPlacement -> Left      ]      This produces an error 'Range::range: "Range specification in Range[range] does not have appropriate bounds. "': ![Range error](http://i.stack.imgur.com/2fZNZ.png) Observe that the `Manipulate` in the same tab that uses a `Dynamic` range works fine. The other tab (not shown in the image) that uses static ranges is fine (for both `Manipulate` and `SetterBar`)? [EDIT:] Nasser suggested Evaluate@With[{range = ...}, ...], which assumed range was constant, as in the example above. Here's an example that is more representitive of what I'm attempting to do (with range based on the count of the number of `Locators` in a `LocatorPane`, which can be added with Alt-Click in that pane).               Manipulate[tick;      If[tabNumber == dynTab, Plot[x^2, {x, 0, 1}],       Plot[1 - x^2, {x, 0, 1}]]      , TabView[{        "use n-loc as range" -> Column[tabNumber = dynTab; {           "dynamic range manipulators:",           Row[{Manipulator[Dynamic[m2, (m2 = #; tick = Not[tick]) &],              Dynamic@{1, 2 range}], " ", Dynamic[m2]}],           Row[{SetterBar[Dynamic[s2, (s2 = #; tick = Not[tick]) &],              Dynamic@Range[range]], " ", Dynamic[s1]}],           "static range manipulators:",           Row[{Manipulator[              Dynamic[m1, (m1 = #; tick = Not[tick]) &], {1, 4}], " ",             Dynamic[m1]}],           Row[{SetterBar[Dynamic[s1, (s1 = #; tick = Not[tick]) &],              Range[4]], " ", Dynamic[s1]}]           }],        "loc" -> Column[tabNumber = staticTab; {           LocatorPane[ Dynamic[u, (               u = # ;               range = (Dimensions[u] // First);               tick = Not[tick]) &],            Plot[x^3, {x, -1, 1}, PlotRange -> {{-1, 1}, {-1, 1}}],            LocatorAutoCreate -> True,            ContinuousAction -> False            ]           , Row[{"u = ", Dynamic@u}]           }]        }, Dynamic@tabNumber]      , {{tick, False}, None}      , {{u, {{0.5, 0.3}, {0.3, 0.9}}}, None}      , {{tabNumber, 1}, None} , {{dynTab, 1}, None} , {{staticTab, 2}, None}      , {{m1, 2}, None} , {{m2, 2}, None} , {{s1, 2}, None} , {{s2, 2}, None}      , {{range, 2}, None}      , TrackedSymbols :> {tick}, ControlPlacement -> Left      (*use a global (comment out range above to try) ... doesn't work: *)      (*, Initialization\[RuleDelayed] { range = 2 ; }*)      ]      In this example, I put the Dynamic outside of the Range expression. This eliminates the error text, but still doesn't work. The SetterBar shows up as text: SetterBar[2, {1,2}]


Generating a broken or snipped axis in ListPlot

I have two data sets, `data1` and `data2`. For example:               data1 = {{1, 1.1}, {2, 1.5}, {3, 0.9}, {4, 2.3}, {5, 1.1}};     data2 = {{1, 1001.1}, {2, 1001.5}, {3, 1000.9}, {4, 1002.3}, {5, 1001.1}};     ListPlot[data1, PlotRange -> All, Joined -> True, Mesh -> Full, PlotStyle -> Red]     ListPlot[data2, PlotRange -> All, Joined -> True, Mesh -> Full, PlotStyle -> Blue]      ![ListPlot 1](http://i.stack.imgur.com/6AMcJ.gif) Their $y$- _values_ are in vastly different regimes, but their _oscillations_ in $y$ are comparable, and I'd like to compare them visually using `ListPlot`. But if I simply overlay them, it is nearly impossible to see and compare their oscillations, because of the scaling:               Show[{       ListPlot[data1, PlotRange -> {{1, 5}, {-100, All}}, Joined -> True, Mesh -> Full,          PlotStyle -> Red, AxesOrigin -> {1, -50}],       ListPlot[data2, Joined -> True, Mesh -> Full, PlotStyle -> Blue]     }]      ![ListPlot 2](http://i.stack.imgur.com/PLDGg.gif) Is there a way to "break" or "snip" the $y$ axis so that I can compare `data1` and `data2` on the same plot? There is no data in the range ~3 to ~1000, so I would like to snip this $y$-range out, if possible, and perhaps include a jagged symbol to show that this has been done.


How do I overlay multiple graphics on one plot?

I am plotting n spectrum using:                 FileNameSetter[Dynamic[xx]]       v = Table[Flatten[Import[ xx[[i]] ], 1], {i, 1, Length[xx]}];       ListLinePlot[Table[v[[jj]], {jj, 1, Length[v]}],        PlotRange -> Full, AxesOrigin -> {0, 0}, PlotStyle -> Thick]      where `v[[jj]]` represens the data that I am plotting. The problem with that approach is if `v[[1, x]] < v[[jj, x]]`, I cannot view the first spectrum. Below is part of the result that I got. It has two graphics, but it is almost impossible to see the blue one. I would like to overlay all the graphics in such a way that I can see all, like showed in this post, but in an easier way, since I cannot understand `viewport` and all that. Is there a simpler way to do this? ### Edit Here is an example of data: Spectrum1 Spectrum2 I did some modifications in the code, so now it is more general:                 FileNameSetter[Dynamic[xx]]       v = Table[Flatten[Import[ xx[[i]] ], 1], {i, 1, Length[xx]}];       ww = {};       color = {Blue, Red, Green, Black, White, Gray, Cyan, Magenta, Yellow, Brown, Orange, Pink, Purple};       With[{opt =            Sequence[PlotRange -> {{500, 3000}, {0.9, 10000000}},           ImagePadding -> 35, ImageSize -> 1000,            BaseStyle -> {18, Bold}]},         For[jk = 1, jk <= Length[v], jk++,         If[jk != 1,           ww = Join[              ww, {ListLogPlot[v[[jk, 1000 ;;]], PlotStyle -> color[[jk]], Frame -> {{1, 0}, {1, 0}}, Joined -> True, opt]}],           ww = Join[ww, {ListLogPlot[v[[jk, 1000 ;;]], PlotStyle -> color[[jk]], Frame -> {{1, 0}, {1, 0}}, Joined -> True, opt]}]            ];          ];         Overlay[ww]         ]      An advantage is that I can overlap 11 graphics together with the same scale (I put the scale but hand, but in principle it is easy to modify that). I have still two problems:   1. I can't label the axes;   2. I can't put a legend without loosing the same scale for all graphics. Any suggestions?


Do I have to code each case of this Grid full of plots separately?

I have written some custom functions to draw multi-panel graphs like this one: ![enter image description here](http://i.stack.imgur.com/6IYPr.png) It's done by passing a matrix of (custom) plotting functions to a `MultiPanelGraph` function, which pulls apart the head, argument and options of those plots, adds a few of its own, and then puts it all together. There is also some funkiness to deal with plot labels and footnotes, but I've removed these from the code below for simplicity. The `PanelHeightFactor` type options are custom options to the custom functions for the individual plots. Likewise the `MultiPanel` option tells the custom functions for the individual plots to, for example, turn off ticks and tick marks on particular sub-plots so that they all fit together neatly as shown in the picture above, and to turn the `PlotLabel` into a panel label inside the plot frame using `Prolog`.               Attributes[MultiPanelGraph]={HoldFirst};     MultiPanelGraph[{{l_[largs__,lopts___Rule], r_[rargs__,ropts___Rule]}},       mpopts:OptionsPattern[{MultiPanelGraph,myLineGraph}]] :=      Module[{ (* there was some stuff here *)},With[{         wl = PanelWidthFactor /.{lopts}/.{PanelWidthFactor->1/2},         wr = PanelWidthFactor /.{ropts}/.{PanelWidthFactor->1/2},         Grid[{{l @@ Join[{largs},{lopts},             {MultiPanel-> {All,Left},PanelHeightFactor->1,PanelWidthFactor->wl,             ImageMargins->0}],               r @@ Join[{rargs},{ropts},             {MultiPanel->{All,Right},PanelHeightFactor->1,             PanelWidthFactor->wr,ImageMargins->0}]}},          Sequence @@ FilterRules[Join[{mpopts},{lopts},{ropts}],Grid],         Spacings -> {0,0} , ItemSize -> {{4.8+42.*wl, 4.+42.*wr},Full}, Alignment -> Left]      It works fine (aside from some issues to do with `ImageSize` being measured in points and `ItemSize` being measured in x-heights or some silly thing - a topic for another question), but I would have to code every single case - 2 by 1, 2 by 2, 3 by 4, whatever else some manager decides he or she wants - separately. Doable, but tedious. I can imagine capturing the dimensions of the grid to get the appropriate default `PanelWidthFactor` and `PanelHeightFactor`, but beyond that I don’t know if there is a neat way to capture all the possible cases in one definition of the function. Does anyone have any suggestions for coding this in a way that doesn’t require each separate case to be coded to match separately? It would have to handle telling the subplot which ticks to use depending on its position. **EDIT: A couple of additional business requirements that might be useful to know:**   * It's essential for the plot frame to be the same width and height, regardless of how many panels there are, unless this is explicitly overridden (in my code, by having an explicit `PanelHeightFactor` or `PanelWidthFactor` option in the code for the subgraph).   * Panels can be of dated data (`DateListPlot` or a custom `DateListBarChart`) or undated data (`ListPlot`, `BarChart`), but never both in the same chart.   * The subplots will have some options (namely footnotes and source notes) that need to be captured and merged to be shown down the bottom of the main plot.


Multiple ranges in one plot

> **Possible Duplicate:**   >  1 Plot, 2 Scale/Axis   >  Generating a broken or snipped axis in ListPlot I have data in several ranges which I, when I plot together, is not very useful. I was thinking about removing the regions where no data exist (see data.png), e.g. shrink the plot scale in those regions. In other words, specifying multiple ranges for the PlotRange option: PlotRange-> {{xrange1,xrange2, xrange3},yrange} How would I go about this? ![enter image description here](http://i.stack.imgur.com/af9JN.png)


Creating Plot with varying scale

I have four series of data that I would like to plot side by side. They look something like this: ![enter image description here](http://i.stack.imgur.com/2vp9m.jpg) As the y-coordinate goes from 80 to 50 In the first series, the x-coordinate varies from around 20 to 10 In the second series, the x-coordinate varies from around 10 to 5 In the third series, the x-coordinate moves between from around 459.9 to 460.05 In the fourth series, the x-coordinate moves between from around 460.1 to 460.05 I would like to present the four series in the same plot so that the scaling of the x-axis is as show in the picture, where the scale is normal up to 20, then just shrinks between 20 and 459 and then expands between 459 and 461. Thanks


Combine Plots into a single non-rasterized Graphic with no spacing

Suppose that I have two plots, `pl1` and `pl2`:               pl1 = Plot[x, {x, 0, 1}, Frame -> True, ImageSize -> 350]     pl2 = Plot[x^2, {x, 0, 1}, Frame -> True, ImageSize -> 350]      ![pl1](http://i.stack.imgur.com/Rl6lc.png) ![pl2](http://i.stack.imgur.com/kyTjV.png) I would like to **(1) combine** these plots side-by-side in a **(2) non- rasterized** graphic with **(3) no spacing**. I get pretty close to my desired result by using `Grid` with `Spacings -> 0`:               Grid[{{pl1, pl2}}, Spacings -> 0]      ![grid](http://i.stack.imgur.com/XdZE6.png) The above satisfies my requirements **(2)** and **(3)** : the result is **non- rasterized** , and there is **no spacing** between the plots. However, the above doesn't satisfy my requirement **(1)** , that the plots be **combined** into a _single_ `Graphic` object. That is, if I click on either of the plots, I see that they are separate `Graphic` objects: ![gridA](http://i.stack.imgur.com/XF1K9.png) ![gridB](http://i.stack.imgur.com/2sYch.png) So the above approach doesn't satisfy all of my requirements. (Why do I need the plots to be combined in a single `Graphic`? The reason is that I want to be able to place other `Graphic` objects -- e.g., text, arrows, shapes, etc. -- that _span_ the two plots.) Another possibility is to use `ImageAssemble`, but unfortunately this leads to a rasterized image:               ImageAssemble[{{pl1, pl2}}]      ![imageassemble](http://i.stack.imgur.com/7Lray.png) A third possibility is to use `GraphicsGrid` with `Spacings -> 0`:               GraphicsGrid[{{pl1, pl2}}, Spacings -> 0]      ![graphicsgrid](http://i.stack.imgur.com/UMui5.png) It seems that this produces a single `Graphic` object ( **(1)** ) that is not rasterized ( **(2)** ), but, unfortunately, there is spacing between the plots. Do you have any suggestions? Is there any way to remove the spacing/padding in `GraphicsGrid`?


Sharing an axis between two plots

> **Possible Duplicate:**   >  1 Plot, 2 Scale/Axis   >  Do I have to code each case of this Grid full of plots separately? What's the most straightforward way to share an axis between two plots in Mathematica? Here's an example, showing the x-axis being shared between the 1st and 2nd, and the 2nd and 3rd plots: ![enter image description here](http://i.stack.imgur.com/Rodfs.png) Gridding plots in Mathematica is already a challenge, and the standard trick for doing so seems to be giving all the images being gridded the same ImagePadding option (as is done here). This doesn't really work well when trying to have two plots share the same axis, and typically requires much fine-tuning on my part to get things looking good, with problems involving superflous tick labels that are hidden beneath other plots, and clipping of the y-axis tick labels.


Plotting functions against the same x-axis but different y-axes?

> **Possible Duplicate:**   >  1 Plot, 2 Scale/Axis The title speaks for itself really. Suppose I have two functions of the same variable that I'd like to visualise on the same plot (with the same x-axis) but their units and scales are totally different. Is it possible to draw separate y-axes for them? Further, is it possible to use, for example, a log scale for one of the functions and a linear scale for the other?


Creating a grid of plots

I'm really a noob on _Mathematica_. I would like to create a layout of multiple plots in _Mathematica_. I've a function that calculates the solution, over time, of a system of differential equations. The results are to be plotted. In order to compare different solutions, I want a plot showing a 6X6 grid of `LogPlot`s. I'm adding an example of my code               function[a0_, b0_, c0_, d0_, e0_, f0_] :=       Block[{replacerules, sssol},         replacerules = {a -> a0, b -> b0, c -> c0, d -> d0};         sssol  = NSolve[Sys /. replacerules, {x,y,z}], ];         numint = NDSolve[ SysDiff /. sssol ,{x,y,z},{t, 0, 100},];         p = LogPlot[x[t] /.numint, y[t] /.numint, z[t] /.numint];         Return[p]]          Manipulate[       GraphicsGrid[ Table[function[a, b, c, d, e, f],        {a, -1, 4},        {b, -1, 4}]],       {c, -10, -4},       {d,  -4,  2, 1},       {e,   1, 20, 1}]      This is a really really simplified version of the code. I hope it can help. My function takes as input some parameters and uses them to calculate the solution of a system of differential equations. Then everything is plotted with the help of Manipulate and Table to combine different parameters values.


Plot two functions with different ranges into one plot

L = 1; ϕ = 1 Pi/180; KL = 1; KT = 1;          plot1 = Plot[(4*(-θ+ϕ)*KT+L^2/Cos[θ]*(1/Cos[ϕ]-1/Cos[θ])*KL*Tan[θ])/(L*(1/Cos[θ])^2),                   {θ, -ϕ, ϕ }]                    plot2 = Plot[-1/(2*L)*Cos[θ]^2*1/    Tan[θ]*(4*KT + KL*L^2*(1/Cos[θ])^2 -                   KL*L^2*(1/Cos[θ])^3*1/Cos[ϕ] + 2*KL*L^2*(1/Cos[θ])^2*Tan[θ]^2 -                   KL*L^2*1/Cos[θ]*1/Cos[ϕ]*Tan[θ]^2),                   {θ, -ϕ, ϕ},    PlotRange -> Automatic]                    Show[plot1, plot2, PlotRange -> Automatic]      As shown I can plot functions seperately and then use `Show` to plot them in one graph. The reason I do not get a good picture is because of different plot ranges. How could I change this? Thanks


1 Plot, 2 Scale/Axis

![enter image description here](http://i.stack.imgur.com/IAOnA.png) I would like to plot those two datasets on top of each other. But they have very different range on the $y$ axis. How can I have two different axis? I found the following on the help menu but quite esoteric for me and I can`t adapt it to data (vs. function):               TwoAxisPlot[{f_, g_}, {x_, x1_, x2_}] :=       Module[{fgraph, ggraph, frange, grange, fticks,         gticks}, {fgraph, ggraph} =         MapIndexed[     Plot[#, {x, x1, x2}, Axes -> True,        PlotStyle -> ColorData[1][#2[[1]]]] &, {f, g}]; {frange,      grange} = (PlotRange /. AbsoluteOptions[#, PlotRange])[[       2]] & /@ {fgraph, ggraph}; fticks = N@FindDivisions[frange, 5];       gticks = Quiet@     Transpose@{fticks,        ToString[NumberForm[#, 2], StandardForm] & /@         Rescale[fticks, frange, grange]};      Show[fgraph,       ggraph /.      Graphics[graph_, s___] :>       Graphics[       GeometricTransformation[graph,         RescalingTransform[{{0, 1}, grange}, {{0, 1}, frange}]], s],         Axes -> False, Frame -> True,         FrameStyle -> {ColorData[1] /@ {1, 2}, {Automatic, Automatic}},          FrameTicks -> {{fticks, gticks}, {Automatic, Automatic}}]]


Combining plots (almost there!)

> **Possible Duplicate:**   >  1 Plot, 2 Scale/Axis I aim to combine two plots in which the YY axes have different scales: one goes `PlotRange->{0,100}` while the other goes `PlotRange->{0,2.5*^-5}`. I've been trying to do this for several hours and, although I think I'm almost there, I cant seem to make it. Here's the input code:               (*not very important, is one of the functions to be plotted*)     P[st_, base_, int_] :=      Module[{nper, period, length, tcap, tarteriols, tvenuls, ttotaloxi},       period = 60/((4/3 Pi (0.1/2)^3)/48);       length = 2;       nper = (t - st)/period;       If[0 <= (t - st) - period Floor@nper < length, base + int, base]       ]      The problem is in this one for sure:               Combineplots[{hout_, maxrange_}, {t_, t0_, tf_}] :=          Module[{relgraf, ihgraf, relrange, ih2o2range, relticks,             ih2o2ticks},           relgraf =             Plot[Evaluate[{10 t} /. setpars /. pa[h2o2out]], {t, t0, tf},             LabelStyle -> {FontFamily -> "Arial", Bold, 40},             PlotStyle -> {{Thickness[0.011],                 Darker[Green, 0.5]}, {Thickness[0.011],                 Darker[Red, 0.2]}, {Thickness[0.007],                 Darker[Blue, 0.3]}, {Thickness[0.007], Darker[Orange, 0.3]}}];                 ih2o2graf =         Plot[Pulse[2, 1*^-9, h2o2out], {t, t0, tf},          LabelStyle -> {FontFamily -> "Arial", Bold, 40},         PlotStyle -> {Thickness[0.007], Black}];       relrange = ({0, 100});       ih2o2range = ({0, maxrange});            Show[relgraf,         ih2o2graf /.          Graphics[graf_, s___] :>           Graphics[           GeometricTransformation[graf,             RescalingTransform[{{0, 10}, ih2o2range}, {{0, 10},               relrange}]], s], Axes -> True,             Frame -> {{True, True}, {True, False}},        FrameStyle -> AbsoluteThickness[3],        FrameTicks -> {{Automatic, {{1/200000, "5"}, {1/100000, "10"}, {3/             200000, "15"}, {1/50000, "20"}, {1/40000, "25"}, {3/100000,              "30"}}}, {Automatic, None}}, ImageSize -> Medium]]     Combineplots[{2*^-5, 3*^-5}, {t, 0, 10}]      I've been able to plot both together correctly, with exception for the right YY axis: ![enter image description here](http://i.stack.imgur.com/yjGry.png) Yet, the ticks theoretically are placed at the correct place (using the same tick marks in a single plot I get the correct marking:) ![enter image description here](http://i.stack.imgur.com/Iif0I.png) Do you guys think you can give me some clue please? Thanks so much!


How do I determine if there's an arithmetic sequence within a list?

> **Possible Duplicate:**   >  find subsequences of constant increase Given an arbitrarily long list of integers (let's say they are sorted), how would one determine if any 3 (or more) of those integers make up an arithmetic sequence? (an arithmetic sequence is where the difference between consecutive terms is the same) Also how would one determine all such sequences in a given list? For instance, I'd like this function to return               In[] = FindArithmSeq[{2,5,6,8,10,12}]     Out[]= {{2,5,8}, {2,6,10}, {6,8,10}, {8,10,12}, {6,8,10,12}}      Thanks in advance!


How is the mysterious Raw function used?

I have never seen an example use for the mysterious `Raw` function: > **Raw[ _h_ , _"hexstring"_ ]**   >  constructs a raw data object with head h, and with contents corresponding > to the binary bit pattern represented by the string hexstring, interpreted > as a hexadecimal number. The documentation also makes clear that it must be used carefully: >   * Raw should be used only under very special circumstances. > >   * It is possible to crash Mathematica by creating a fundamental > Mathematica data object with Raw, and specifying illegal internal data for > it. If you create an object with head Real, but with internal data > incompatible with Mathematica Real numbers, you may end up crashing your > whole Mathematica session. > > In fact it also states: _As of Version 6.0, Raw is no longer supported._ Pre-v6.0 documentation gives _some_ indication of application, no details, and more admonition: > As an optimization for some special kinds of computations, the raw data in > Mathematica atomic objects can be given explicitly using `Raw[head, > "hexstring"]`. The data is specified as a string of hexadecimal digits, > corresponding to an array of bytes. When no special output form exists, > `InputForm` prints special objects using `Raw`. _The behavior of`Raw` > differs from one implementation of Mathematica to another; its general use > is strongly discouraged._ Nevertheless I regularly find use for other deprecated functions such as `Compose` and `ToHeldExpression`, and I am curious. How can one use this function?


Unique[] symbol not properly tracked

In a nutshell, why does this work (change `y` and see how the value updates)               ClearAll[y];     Dynamic[x,      Initialization :> (x = Symbol["y"])]      and then on a separate cell               y = 98;      but this doesn't? (assign the printed variable whatever value and see how it doesn't update)               Dynamic[x,      Initialization :> (x = Unique[])]      You can also write `Dynamic[the printed var]` in a separate cell and see how it doesn't update either. For now, I'll be using something that works and I would have never thought I would be using               Dynamic[x,      Initialization :> (x = (Remove[#]; Symbol[#]) &@ToString@Unique[])]      My current weird conclusion: _"If a variable was declared by`Unique[]` inside a `Dynamic` update, then it will never be tracked by any `Dynamic` "_


Clean up list of partial outputs for memory

_Context_ I run long Mathematica sessions; sometimes I have Output up to Out[3000+]. Hence I would like to be able to clear out some previous outputs which do use lots of memory. _Attempt_ I am aware of clearing some outputs via unprotecting `Out` as follows               In[1]:= MemoryInUse[]/10^9.      Out[1]= 0.0179439               In[2]:= a = Table[1, {10^8}];     In[3]:= MemoryInUse[]/10^9.      Out[3]= 0.419424               In[4]:= Unprotect[Out];     In[5]:= Out[2] =.     In[6]:= Protect[Out];     In[7]:= MemoryInUse[]/10^9.      Out[7]= 0.0297147 My problem is if I have 3000+ outputs, which one are using a lot of memory so I can decide if it is safe to clear them. _Question_ What I am after is a way of finding out which amongst the previous `Out` are using most of the memory? I would like to have a function, say `MemoryHog[n]` which would return a list of numbers corresponding to the `n`th sorted Outputs using most memory.


Is it possible to produce anaglyphs with Mathematica?

I'd like to prepare some presentations in Mathematica to help students visualize functions of two variables (it's a usual calculus course). I thought it would be both cool and useful to have the graphs as red/cyan anaglyphs. Is it possible to do that, and if yes, how? **Edit:** Simon Woods' answer below is great, but it produces a static image. I'd prefer an interactive version (rotatable - is it a word? - with a mouse); if this is not possible, then I'd like to have at least an animation. (I guess the latter shouldn't be too hard - I'd only have to put suitable commands in some loop, export the images and mount them as an animation; the point is, I'm a Mathemathica newbie and don't know (yet) how to do it - but I can probably figure that out on my own.)


Counting negative values in list

I would like to count the negative values of a list. My approach was `Count[data, -_]` which doesn't work. How can I tell _Mathematica_ to count all numbers with a negative sign?


How to punch a hole in some 3D distribution of points

Suppose we have a long list of 3D Cartesian coordinates, defining a distribution of random points in 3D space. How could we remove all the points inside a sphere of radius `sphereRadius` located at coordinates `sphereLocation = {X, Y, Z}`? This Boolean subtraction is probably trivial, but I didn't found any useful info on how to do it with _Mathematica_ 7.0. Maybe it isn't trivial, after all. * * * **Generalisation :** How can we do the same with an arbitrary closed surface, instead of a sphere, if the hole is defined as a deformed sphere ?               holeLocation = {X, Y, Z};     hole[theta_, phi_] = holeLocation  +          radius[theta, phi] {Sin[theta]Cos[phi], Sin[theta]Sin[phi], Cos[theta]};      where `theta` and `phi` are the usual spherical coordinates.


Plotting an epicycloid

I am fairly new to _Mathematica_ and I cannot figure out how to plot an epicycloid. I have plotted some neat looking things in my attempts, but can't make one. I am not looking to make an animation, just the result of an epicycloid. Would I use a `PolarPlot` or `ParametricPlot`? How do I get a static picture of an epicycloid?


Frame thickness in Framed[]

I need to change the frame thickness in `Framed[]` in order to create a legend box. How can I set the frame thickness in `Framed[]`? `Framed[1/x + y, FrameStyle->Thick]` does not work...


Parameters in NDSolve for an Accurate Graphical Output -- What to Tweak?

Friday Greetings, I'm working on an ODE system as a basic model for cancer treatment: $\begin{array}{c} \frac{{dN}}{{dt}} = kN\left( {1 - \frac{N}{\alpha }} \right) - \mu CN\\ \frac{{dC}}{{dt}} = d\left( t \right) - \lambda C - \gamma CN\\ N\left( {{t_0}} \right) = {N_0}\\ C\left( {{t_0}} \right) = {C_0} \end{array}$ where $d\left( t \right) = \left\{ {\begin{array}{*{20}{c}} {{\rm{dosage}}}&{}&{n\left( {T - 1} \right) < t < n\left( {T - \tau } \right)}\\ 0&{}&{n\left( {T - \tau } \right) < t < nT} \end{array}} \right.\,\,\,\,{\rm{with}}\,\,\,\,n \in \left\{ {1,\,2,\,3,\,...} \right\}$ Ultimately I want to produce an accurate graph of the treatment and response. Here is my code:               k = 1; alpha = 1; mu = 1; lambda = 1; gamma = 0.5; tnot = 0;     nnot = 0.1; cnot = 0; tmax = 84;     nmin = -0.1; nmax = 1.15; cmin = -0.1; cmax = 1.15;     doseinterval = 10/24; wholeinterval = 2; numberofdoses = 30;     applieddosingPeriodic[t_] := If[t < wholeinterval*numberofdoses, If[Mod[t, wholeinterval] < doseinterval, dosage, 0], 0];     paramSolnCancerTreatPeriodic = ParametricNDSolveValue[{n'[t] == k*n[t]*(1 - n[t]/alpha) - mu*c[t]*n[t], c'[t] == applieddosingPeriodic[t] - lambda*c[t] - gamma*c[t]*n[t], n[tnot] == nnot, c[tnot] == cnot}, {n, c}, {t, tnot, tmax}, {dosage}, MaxStepSize -> 0.01];     nPlotCancerTreatPeriodic[dosage_] := Plot[paramSolnCancerTreatPeriodic[dosage][[1]][t], {t, tnot, tmax}, PlotStyle -> {Thick, Blue}, AxesLabel -> {Style[t, 16], Row[{Style["N", 16, Blue], Style[", ", 16, Black], Style["C", 16, Red]}]}, PlotLabel -> Style["Cancer Treatment with Periodic Dosing", 16], PlotRange -> {{tnot - 2, tmax + 2}, {nmin, nmax}}, Epilog -> {Black, PointSize[Large], Point[{{tnot, nnot}, {tnot, cnot}, {tmax, paramSolnCancerTreatPeriodic[dosage][[1]][tmax]}, {tmax, paramSolnCancerTreatPeriodic[dosage][[2]][tmax]}}], Green, PointSize[Medium], Point[{tnot, nnot}], Point[{tnot, cnot}], Red, Point[{tmax, paramSolnCancerTreatPeriodic[dosage][[1]][tmax]}], Point[{tmax, paramSolnCancerTreatPeriodic[dosage][[2]][tmax]}]}];     cPlotCancerTreatPeriodic[dosage_] := Plot[paramSolnCancerTreatPeriodic[dosage][[2]][t], {t, tnot, tmax}, PlotStyle -> {Thick, Red}, AxesLabel -> {Style[t, 16], Row[{Style["N", 16, Blue], Style[", ", 16, Black], Style["C", 16, Red]}]}, PlotLabel -> Style["Cancer Treatment with Periodic Dosing", 16], PlotRange -> {{tnot - 2, tmax + 2}, {cmin, cmax}}, Epilog -> {Black, PointSize[Large], Point[{{tnot, nnot}, {tnot, cnot}, {tmax, paramSolnCancerTreatPeriodic[dosage][[1]][tmax]}, {tmax, paramSolnCancerTreatPeriodic[dosage][[2]][tmax]}}], Green, PointSize[Medium], Point[{tnot, nnot}], Point[{tnot, cnot}], Red, Point[{tmax, paramSolnCancerTreatPeriodic[dosage][[1]][tmax]}], Point[{tmax, paramSolnCancerTreatPeriodic[dosage][[2]][tmax]}]}];     frameCancerTreatPeriodic[dosage_] := Show[nPlotCancerTreatPeriodic[dosage], cPlotCancerTreatPeriodic[dosage], ImageSize -> 1040];     frameCancerTreatPeriodic[1.0]      The last command produces the following image: ![graphical output with aberration](http://www.biomathdynamics.com/mmartin/cancerPeriodicTreatError.jpg) Notice the slight aberration in the blue response. The adaptive stepsize in ParametricNDSolveValue (or, ultimately, NDSolve) is too large for one part of the graph (around a time of 25 to 30). I've tried tweaking several of the different options/parameters for NDSolve, but nothing seems to efficiently work. I have the sense that it's something simple that I'm just missing. I would appreciate your input and guidance on that as I clean up my modeling efforts in this domain. Ultimately, I am making an animated gif as the dosage parameter is varied and, depending on the dosage, the aberration may be evident or not. Thank you in advance for any help/advise. Regards, Mike


Specifying string patterns in DeleteCases

It seems that `DeleteCases` is not compatible with string patterns, at least directly (see, for example, this question). Is this true? If so, why is this the case? It seems that the earlier question did not really address this. For example, suppose that I have a list of strings and I want to delete all strings which contain the letter `"X"`:               DeleteCases[{"ab", "aXb"}, ___ ~~ "X" ~~ ___]      gives undesired output:               {"ab", "aXb"}      One workaround is               Select[{"ab", "aXb"}, ! StringMatchQ[#, ___ ~~ "X" ~~ ___] &]      which gives the correct output:               {"ab"}      But _why_ doesn't `DeleteCases[{"ab", "aXb"}, ___ ~~ "X" ~~ ___]` work?


Error when attempting to save Notebook. Cause and solution?

I am experiencing an error attempting to save a modified Notebook in _Mathematica_ 10 under Windows. The error I get is: > >     Could not access the directory X:\Docs\\Mathematica. You should check > that directory's permissions. >   Note the doubled `\\\`. The correct path is `X:\Docs\Mathematica`. `NotebookDirectory[]` returns the correct (escaped) path:               NotebookDirectory[]      > >     "X:\\Docs\\Mathematica\\" >   **_Correction** : This is happening with multiple (all?) Notebooks in this path in the current session._ Has anyone else experienced this error? How can I determine its cause and seek a solution?


Positioning Labeled points in ListPlot gives unexpected results and errors

Original question can be seen in the edit history.... ## UPDATE: a simpler example - same "problem"               i = Table[Labeled[{Re[5 Exp[I 5/2 t]], Im[5 Exp[I 5/2 t]]},t, {Right, Top}], {t, 0, 6}]      > {{5,0} 0 ,{5 Cos[5/2],5 Sin[5/2]} 1 ,{5 Cos5,5 Sin5} 2,{5 Cos[15/2],5 > Sin[15/2]} 3 ,{5 > Cos[10],5 Sin[10]} 4 ,{5 Cos[25/2],5 Sin[25/2]} 5 ,{5 > Cos[15],5 Sin[15]} 6 }               ListPlot[i]      ![enter image description here](http://i.stack.imgur.com/TMqv3.png) Without `PlotMarkers` as an option, it will not work...               ListPlot[i, PlotMarkers -> {Automatic, Large}]      ![enter image description here](http://i.stack.imgur.com/JTstg.png) With `PlotMarkers` it works but the labels are offset to the reverse of the specified coordinates. Is this not unusual behaviour? Any suggestions on how to fix this? I'm running ![enter image description here](http://i.stack.imgur.com/v0D2J.png)


A function that (also) changes a replacement rule

I'd like to write a function operating on a list, returning a list, but also changing a replacement rule. Let's say I have a list of replacement rules:               data={     ...     a->3,     ...     };      Now I write a function:               f1[{b_,c_}]:={b+1,c+1};      What I would also like this function to do is to change the replacement rule of `data` list, so that after the function is evaluated (with any list as an input), the variable `a` would take the value of the evaluated `c+1` expression, or `f1[[2]]` if You will. Seems like an easy task, but somehow confuses me. **Edit:** As an input I would like a list `l={2,3}`, and `{3,4}` as an output, and a replacement rule `a->3` changed into `a->f1[[2]]`. In general, my problem is that I want another function later on to access a value produced by `f1`, but I would like that other function to call this value from external list and not explicitly from `f1`.


Von Mangoldt function

Can anybody evaluate the following sum for me $$ \sum\limits_{n=2}^\infty(-1)^n\left(\frac{\psi(n)}{n}-\frac{\Lambda(n)}{2n}\right) $$ where $\psi(n)$ is the Chebyshev function and $\Lambda(n)$ is the von Mangoldt function. Is there any efficient algorithm to evaluate such sum? I used the following code               f[n_]=Sum[MangoldtLambda[i],{i,1,n}];          Sum[(-1)^n(f[n]/n-MangoldtLambda[n]/(2n)),{n,2,Infinity}]


Pulling powers to the outside of expressions (inverting PowerExpand)

Is there something like an inverse of `PowerExpand` that pulls powers to the outside of expressions: $$ x^2 y^2 \leadsto (x y)^2 \\ x^2/y^2 \leadsto (x/y)^2 $$ I am happy to assume that $x$ and $y$ are positive reals, but I do not see any of the algebraic commands that would do this even with the right assumption.


Position with Except returns first item {0} and last item {}. Why?

Here is a simple list:               l={1, 0, 2, 1, 0, 1, 0, 1, 2, 0, 2, 0, 1, 0, 1, 0, 0}      To get the position of non-zero elements I use `Position` with `Except`:               Position[l,Except[0]]      Mathematica 9.0.1 returns               {{0}, {1}, {3}, {4}, {6}, {8}, {9}, {11}, {13}, {15}, {}}      I can't figure out why the first element is `{0}` and the last one is `{}`. If I use `Cases` it works as expected:               Cases[l,Except[0]]          {1, 2, 1, 1, 1, 2, 2, 1, 1}      What am I missing here?


Why does this numeric integral fail to converge?

I have an integral over a region (rpp):                   Msq2[w1_,         w2_] := (12.8228 + 10.518/(0.948338 - 2.0134 w1 - 2.0134 w2) -           6.69841/(1.72935 - 2.0134 w1 - 2.0134 w2) -           57.4434/(2.01348 - 2.0134 w1 - 2.0134 w2) -           13.4997/(3.45415 - 2.0134 w1 - 2.0134 w2) +           9.50782 (1/(-0.110612 + 2.0134 w1) +              1/(-0.110612 + 2.0134 w2)) -           82.5202 (1/(1.14046 + 2.0134 w1) + 1/(1.14046 + 2.0134 w2)))^2;          r1 = Sqrt[0.283 + (Sqrt[-0.018769 + w1^2] + Sqrt[-0.018769 + w2^2])^2];          r2 = Sqrt[0.283 + (Sqrt[-0.018769 + w1^2] - Sqrt[-0.018769 + w2^2])^2];          mphy = 1.007;          rpp = RegionPlot[        Re[r2] < mphy - w1 - w2 < Re[r1], {w1, .11, .4}, {w2, .11, .4},          BoundaryStyle -> Blue, FrameLabel -> {"w1", "w2"},         PlotRangePadding -> 0];       w1min = w2min = Min@rpp[[1, 1, All, 1]];       w1max = w2max = Max@rpp[[1, 1, All, 1]];          NIntegrate[       Boole[Re[r2] < mphy - w1 - w2 < Re[r1]] 1/(64*Pi^3*mphy)*        Msq2[w1, w2], {w1, w1min, w1max}, {w2, w2min, w2max},        AccuracyGoal -> 14] // Chop      With 2 errors mathematica give the following answer (Numerical integration converging too slowly):               Out[8]= 119.375      I tried to correct the problem by evaluating the following expression:               NIntegrate[      Piecewise[{{1/(64*Pi^3*mphy)*Msq2[w1, w2],          Re[r2] <= mphy - w1 - w2 <= Re[r1]}}], {w1, w1min, w1max}, {w2,        w2min, w2max}, MaxRecursion -> 50, AccuracyGoal -> 20,       Method -> {GlobalAdaptive, MaxErrorIncreases -> 10000}]      But the problem remains:               Out[12]= 3095.25      it seems it doesn't converge. I used some other NIntegrate integration strategies but none of them works. With which method does this integal converge and gives a precise and correct answer? Is there any method which gives a correct answer? What is the real problem? I don't understand what's going on. @Retay: If I replace Msq2b instead of Msq2, the integral converges. Msq2 and Msq2b are very close to each other ( compare their plots). So what is the problem with Msq2?                Msq2b[w1_,             w2_] := (10.8 + 11.85/(0.959 - 2.013*w1 - 2.013*w2) -               6.9768/(1.8059 - 2.01383*w1 - 2.01383*w2) -               60.9431/(2.04286 - 2.01383*w1 - 2.01383*w2) -                  13.21819/(3.4901 - 2.013830*w1 - 2.01383*w2) +                10.461347*(1/(-0.072247 + 2.0138303*w1) +                  1/(-0.072247 + 2.013830*w2)) -                  82.309287*(1/(1.14002 + 2.013830*w1) +                  1/(1.14002 + 2.01383*w2)))^2;          Plot3D[1/(64*Pi^3*mphy)*Msq2[w1, w2], {w1, w1min, w1max}, {w2, w2min,        w2max}, RegionFunction ->        Function[{w1, w2, z}, Re[r2] <= mphy - w1 - w2 <= Re[r1]] ,       BoxRatios -> {1, 1, 4}]               Plot3D[1/(64*Pi^3*mphy)*Msq2b[w1, w2], {w1, w1min, w1max}, {w2, w2min,        w2max}, RegionFunction ->        Function[{w1, w2, z}, Re[r2] <= mphy - w1 - w2 <= Re[r1]] ,       BoxRatios -> {1, 1, 4}]


How do I inherit a specific cell option from another style (without copy paste)?

How can I define a style with `FontSize` from **Section** and `CellFrame` from **Program**?