Strange results while nesting scope constructs?

I did a handful of tests with `Block`, `With`, and `Module` and had a couple of _new_ surprises. First, I explicitly nested all pairs, producing the following nine tests, naively expecting 37 in each case:               {Block[{x=42}, Block[ {x=37},x]],      Block[{x=42}, With[  {x=37},x]],      Block[{x=42}, Module[{x=37},x]],      With[ {x=42}, Block[ {x=37},x]],      With[ {x=42}, With[  {x=37},x]],      With[ {x=42}, Module[{x=37},x]],      Module[{x=42},Block[ {x=37},x]],      Module[{x=42},With[  {x=37},x]],      Module[{x=42},Module[{x=37},x]]}      > During evaluation of In[48]:= Block::lvset: Local variable specification > {42=37} contains 42=37, which is an assignment to 42; only assignments to > symbols are allowed. >> > > Out[48]= {37, 37, 37, Block[{42 = 37}, 42], 37, 37, 37, 37, 37} The surprise is that `With...Block...` produces a collision, but `With...With...` and `With...Module...` don't. UNLESS, I try the test this way               With[{heads={Block,With,Module}},       Table[heads[[i]][{x=42},heads[[j]][{x=37},x]],{i,3},{j,3}]]      > During evaluation of In[49]:= Block::lvset: Local variable specification > {42=37} contains 42=37, which is an assignment to 42; only assignments to > symbols are allowed. >> > > During evaluation of In[49]:= With::lvset: Local variable specification > {42=37} contains 42=37, which is an assignment to 42; only assignments to > symbols are allowed. >> > > During evaluation of In[49]:= Module::lvset: Local variable specification > {42=37} contains 42=37, which is an assignment to 42; only assignments to > symbols are allowed. >> > > Out[49]= {{37, 37, 37}, {Block[{42 = 37}, 42], With[{42 = 37}, 42],   >  Module[{42 = 37}, 42]}, {37, 37, 37}} in which case ALL the `With...` cases produce collisions. I thought I was starting to understand MMA's scoping constructs :( **EDIT** : in case my question wasn't clear, I'd be grateful for the following explanations in more detail than the documentation offers: (1) why `x` collides in the explicit `With...Block...` case, (2) why `x` collides in two more cases when the nesting constructs are built using `Table` instead of explicitly. it occurred to me late to include `Function` and `Table` in the mix of scoping constructs, since they also give temporary bindings to variables. But I haven't tried that yet.


Speed Up SphericalPlot3D

I was wondering if I could speed up `SphericalPlot3D`? I tried editing `PlotPoints`, and `MaxRecursion`, but when I wrap `SphericalPlot3D` with `Manipulate` it fails. I don't want to set `ContinuousAction` to `False`.               Manipulate[ SphericalPlot3D[{r, 0, rmax}, {\[Phi], 0, phi \[Pi]},        {\[Theta], 0, theta \[Pi]}, SphericalRegion -> True, PlotRange -> 4,        Mesh -> 2, Ticks -> None],        {theta, 0.07, 1}, {phi, 0.07, 2}, {rmax, 0.07, 4}, SaveDefinitions -> True]      I wanted to layer a whole bunch of shells together to make a solid. {r, 0,rmax} specifies what range of shells' radii I want to create


How to switch between different CDFs in CDF Player?

I recently got a Mac. It has CDF Player, but not _Mathematica_. How do I get CDF Player to switch between different CDFs on OS X Lion? ## Edit I forgot to mention that I want to know how to switch between CDFs when in Full Screen mode. There must be a hot key for that. For that matter.... What's the best way to switch from Full Screen to a window with menus?


Dynamically change the variables plotted against in Plot3D

This question posed by @Cam is the closest I can find to my question but I feel that the answers don't really guide me in the way in which I'd like to proceed.... How do I dynamically change Manipulate controls? Ultimately I'd like to be able to do this with Manipulate or Dynamic however for now I'd just be satisfied to get this working in a very manual way. If I can get it going manually then adding Dynamic will (hopefully) be the easy part. I have a multivariate polynomial in (say) n variables but for simplification purposes let's call it 4 variables. I'd like to be able to use Plot3D to view the value of the function against two of the four variables but rather than specifying the variables explicitly, I'd like to be able to use some form of replacement rule to define which variables to plot against. Conceptually speaking, I would like something like the following to work:               axes = {{w, 0, 20}, {x, -3, 3}, {y, -2, 2}, {z, -1, 1}};          w = 25;     x = -3;     y = -2;     z = 3;     Plot3D[Sin[w^(1/2) + x + y^2 + z^3], axes[[1]], axes[[3]]]      One of the important things here is that the `axes` variable contains both the variable to be plotted and its range. Unless I'm mistaken, the responses in the post referenced above seemed to tackle a similar problem by substituting the variable names in the function to match the range specifications which I find confusing and hard to read, not to mention difficult to then sub in the correct ranges.


Using NVIDIA 3D Shutter Glasses with Mathematica

Mathematica has great capabilities to display 3D Graphics rendered to the 2D screen. This should make it perfectly suited to use the Graphics3D system together with an NVIDIA Graphics card, a 3D capable monitor with high frame rate and a 3D shutter glass (e.g. the NVIDIA 3D Vision sets). Now if it comes down to documentation the situation is less clear. I just found a nice Visual Studio Implementation How to control stereo-frames separately with C#? (NVIDIA 3D shutter glasses) for getting a simple 3D application (which is actually just testing that you can render two different colors for the left and the right eye), but nothing in the Mathematica documentation or on the web. Wouldn't it be nice to have the full 3D power of Mathematica with built-in support to show the Graphics3D output on a 3D Vision system? Any idea how to migrate the C# sample code to Mathematica and use the Graphics3D output to generate the stereo image pairs dynamically? Any other idea of implementation is of course welcome too!


Checking whether a number can be composed from the cube of its digit

How to check whether or not the sum of the cube of each digit of a number is equal to the number itself? In the following code, I tried to return the number in question whenever it matches the condition.               In[191]:= Func[x_]:=If[Total[Map[#^3& ,IntegerDigits[x]]]==x,x,0];     Func[300]      > Out[192]= 300 Apparently the checking seems to be wrongly done. What caused this issue? How to fix it?


Two problems with NDSolve when using Method -> Projection

I tried to solve a system first order differential equations together with a constraint equation. I use the `Method -> Projection` to check if the constraint holds at each step. However, two problems occur: The first problem is that I get the messages: > General::ovfl: Overflow occurred in computation. and General::unfl: > Underflow occurred in computation, I do not know how to handle these messages. The second problem is that I get the message: > NDSolve::nlnum: "The function value {Overflow[], Overflow[], Overflow[], > Overflow[]} is not a list of numbers with dimensions {4} at {t, u[t], x[t], > y[t], z[t]} ... I have attached the image of the code with the given explanations in (**) for convenience. I would appreciate it if anyone would give me some help.               Needs["DifferentialEquations`NDSolveProblems`"];     Needs["DifferentialEquations`NDSolveUtilities`"];     Needs["DifferentialEquations`InterpolatingFunctionAnatomy`"];      ( _Defining constant parameters_ )               θ = 0.182; w = 0; ρi = 4.2; xi = 0.0; ui = 8.71; adot = \     -6.4; zi = 26.57; om = 11.72; ti = 0.0; ts = 10000;      ( _Defining an invariant quantity that must hold true during the \ dynamical evolution of the system_ )                ina = -Exp[-3 x[t]]/(      2 (2 om + 3)) (om/6*y[t]^2 - u[t]^2*z[t]^2 + u[t]*y[t]*z[t]) +       u[t]*Exp[3 x[t]] (-16*π*ρi*Exp[3 (1 + w) (xi - x[t])])      ( _Defining the system of first order differential equations to be \ solved numerically_ )                 eqs = {x'[t] +        Exp[-3 x[t]]/(       2 (2 om + 3)*       u[t]) (om/3*y[t] +         u[t]*z[t] + θ (y[t] - 2 u[t]*z[t]) z[t]) - (θ*        Exp[3 x[t]]/u[t]) (-16 π*ρi*        Exp[3 (1 + w) (xi - x[t])]) == 0,       u'[t] + Exp[-3 x[t]]/(2 (2 om + 3)) (y[t] - 2 u[t]*z[t]) +       6 θ*      Exp[3 x[t]]*(-8 π (1 - w)*ρi*        Exp[3 (1 + w) (xi - x[t])]) == 0,       y'[t] - Exp[       3 x[t]]*(48 π*ρi*(1 - w)*Exp[3 (1 + w)*(xi - x[t])]) ==      0, z'[t] -       Exp[-3 x[t]]/(2 (2 om + 3) u[t]) (y[t] - 2 u[t]*z[t])*z[t] +       Exp[3 x[t]]/u[t] (-16 π*ρi*Exp[3 (1 + w)*(xi - x[t])]) ==      0}      (*Defing initial conditions: *)               ics = {u[ti] == ui, x[ti] == xi, z[ti] == zi,      y[ti] == -(1/(3 zi*θ + om))       3 (6 adot* E^(2 xi)*ui + ui*zi - 2 ui*zi^2*θ +        96 E^(6 xi)* π *θ *ρi +        4 adot* E^(2 xi) *ui *om +        64 E^(6 xi)* π*θ *ρi* om)}      (*Defining variables to be evaluated: *)                vars = {x, x', x'', u, u', y, z}      (*Using the NDSolve Command: *)               g = NDSolve[{eqs, ics}, vars, {t, ti, ts},      Method -> "StiffnessSwitching",      Method -> {"Projection", Method -> "ExplicitRungeKutta",      "Invariants" -> ina == 0}, InterpolationOrder -> Automatic,      WorkingPrecision -> MachinePrecision]      ![This image is a print screen of the code together with codes for convenience](http://i.stack.imgur.com/4fCoi.png)


How can I specify the arrowhead size in printers points?

Is there any way to specify the size of an arrowhead in printer's points? I'm looking for something that would have similar functionality to `AbsolutePointSize`, `AbsoluteThickness`, or `AbsoluteDashing`, except for Arrowheads. The best I have come up with is to use something like `Arrowheads[1.5/???]`, where `???` is the width of the `Graphics` object. However, this doesn't work if I don't know the width of the graphic. I've played around with using `Offset` or `Scaled`, but I haven't been able to get them to work for this purpose. **Edit:** Thanks for the suggestions so far. A few comments:   1. So far I have been using `ImageSize` combined with the `Arrowheads[1.5/???]`, but this is annoying for two reasons. First, it makes it impossible to set the height of the graphic using `ImageSize -> {{10000},{hmax}}`. Second, it means that I have to pass the ImageSize as a parameter through a series of functions that I have written.   2. The sizes `Tiny`, `Small`, `Medium`, and `Large` are exactly what I'm looking for, except that they don't seem to work with custom arrowhead graphics. In particular, the specification `Arrowheads[{{Medium, 1/2, Graphics[Line[{{-1, 1}, {1, 0}, {-1, -1}}]]}}]` within a `Graphics` command followed by an `Arrow` produces the following mysterious error: `Encountered "Graphics[Line[{{-1, 1}, {1, 0}, {-1, -1}}]]" where a Graphics was expected in the value of option Arrowheads.` **Edit 2:** Problem solved! As Brett suggests below, it works to use offset coordinates:                   MyArrows = Arrowheads[{{0.000001, 0.5,         Graphics[Line[{Offset[{-4.5, 5.4}], Offset[{4.5, 0}], Offset[{-4.5, -5.4}]}]]         }}]      When using this approach, it seems to work better on curved lines to specify a very small arrowhead size such as 0.000001. Here is some sample output using the arrowhead style above: ![Sample picture](http://i.stack.imgur.com/w0m4Z.png)


X-Y scatter plot with coloring dependent on Z value

I have an array of $(x,y,z)$ triples (array dimensions: N x 3), from which I can make a 2D scatterplot of $(x,y)$ values:               t = Table[{Sin[i], Cos[i], i}, {i, 0, 2 \[Pi], N[\[Pi]/20]}];     ListPlot[t[[All, 1 ;; 2]]]      Now, I want to color each point according to its $z$ value. I can find how to do so by creating a series of `Disk`s and putting them all into a `Graphics`, but then I have to take of absolutely all the formatting. Yet, I can't see how to leverage `ListPlot` options, such as `ColorFunction`, to achieve my goal. What would you suggest?


Using patterns in ReplaceAll to extract elements from tuples at arbitrary depths

Please consider the following: I need to extract from `MyList` all last parts of each 3-tuple.               MyList={              {{0.`, 2, 5}},              {{0.`, 1, 8},{10.`, 10, 10},{10.`, 6, 2.5}},              {{0.`, 1.25, 10},{0.`, 8.9, 100}}            };      I tried to apply the following but it did not work:               MyList /. {a_Number, b_Number, c_Number} :> c      Please note, that `a`,`b` and `c` must be of `Number`, otherwise the last 3-tuple of `MyList[[2]]` would be extracted to, since it `MyList[[2]]` itself represents a 3-tuple. The result must be:               {{5},{8,10,2.5},{10,100}}


Comparing Mathematica expressions like diff

I am looking for a way to compare (or "diff") two Mathematica expressions, similarly to how to diff utility can compare two text files and report the differences. Has anyone already written such a thing? Do you know of existing implementations? I wanted to check before trying to implement it. The Workbench's MUnit tester has something like this but I'm not sure how to invoke it separately from the testing UI. Also, I'd need something that works on held expressions as well. * * * To answer @Rojo's question: A first and simplest implementation would detect "point-differences". Assuming that the two expressions have identical structure, it would detect the leaf that differs. For example, if the expressions are               Hold@{1, f[2, g[3, 4^5]]}          Hold@{1, f[2, g[3, 4.^5]]}      it would report that the difference is at position `{1, 2, 2, 2, 1}` (because `4 =!= 4.`) A second and improved version (what I'm really looking for) would also handle additions and deletions, i.e. in               {1,2,3,4,5}          {1,2,4,5}      it would be able to match up the `4,5` part and understand that only `3` has been deleted. This would of course work also if `1,2,...` are compound expressions and not atoms, and would also work at deeper levels. I need something that works on _expressions_ and not on text, and respects the expression structure. (E.g. an atomic expression should be treated as an atom and not a set of characters. Line breaks, spaces and different notation forms such as `f@x` and `f[x]` should be handled or ignored appropriately.)


Band-pass filter an image

Ok so i have some HR-TEM images. In this technique fringes appear whereever a crystalline structure is present. This fringes are separated by a certain distance depending on the material, this is our wavelength. I would like to enter a wavelength range defined by two values, say .50 to .55 nm or in pixels. The output should be that all but these freqeuncies as defined by the WL should be filtered out of the image, a band-pass. So here's an example using some commercial software: ![Example of what i want](http://i.stack.imgur.com/gi0kV.jpg) I guess the approach is to Fourrier transform, filter out, and fourrier back. My attempt wasn't even close to getting a result... Thanks!


Feedback on my Subscript code

I have written a code, and I need a little feed back.. I want to make the `Subscript` distributive across (1) addition and (2) multiplication to mimic short-hand for added vectors. For example, in $(p+2k)_i=p_i+2k_i$ the LHS is short-hand for RHS, where the index is not allowed to be on the coefficient 2. Finally, I need exception, where the numeric quantity 0 should be allowed to take an index: that is, $0_i$ should not go to $0$. My code is:               Clear[Subscript];          Subscript[Plus[a_, b___], idx_] :=        Subscript[a, idx] + Subscript[b, idx];          Subscript[Times[a_, b___], idx_] :=        Times[Subscript[a, idx], Subscript[b, idx]];          Subscript[a_?NumberQ, idx_] /; a != 0 := a;      What I did was to define `Subscript` as functions, which is already built-in Symbol in Mathematica. The code seems to really work, but I don't know if I deserve a pat-on-the-back for being clever, or be reprimanded for overwriting a built-in Symbol (or for any other bad coding behavior). Also, is there any obvious way anyone can see this piece of code going wrong? Thanks!!


Method Shrinkwrap Messes up editting Graphics

If you try resizing or moving the `Inset` in the following interface, the `Graphics` becomes incredibly jerky and borderline unusable.               Graphics[{LightGray, Disk[],       Inset[        Graphics[{Rectangle[]}, ImageSize -> 200,          Method -> {"ShrinkWrap" -> True}]]       }]      Now if I remove `Method -> {"ShrinkWrap" -> True}` the interface (`Drawing Tools`) works fine but a border is added around the `Graphic`               Graphics[{LightGray, Disk[],       Inset[         Graphics[{Rectangle[]},           ImageSize -> 200]]       }]      Is there a way to Shrinkwrap or effectively remove the border without destroying the ability to edit `Graphics`? As an alternative, might there be a way to embed the `Inset` data directly into the `Graphics`. Currently it only serves the purpose of adding an `ImageSize` value to the `Inset` Graphics.


Create a new list under conditions from an existing one

I have an external file (data.out) which I read it with Mathematica using               data = ReadList["data.out", Number, RecordLists -> True];      This file contains three columns `(x,y,f)` of thousands of data. Here is a small sample of it:               0.30000000        0.00000000      0.1679035061279048E+02     2.30000000        0.50000000      0.1195447110986367E+01     0.10000000        0.00000000      0.2179035061279048E+02     5.80000000        2.50000000      0.7195447110986367E+01     3.00000000        0.00000000      0.4679035061279048E+02     7.90000000        7.50000000      0.1195447110986367E+01     4.70000000        2.00000000      0.8679035061279048E+01     1.20000000        4.50000000      0.2195447110986367E+01      Now I want to use Mathematica in order to manipulate the `data` list creating a new one `dataMod` which will have this structure `(x,y,f,f1)`. Obviously, there is a new element `(f1)` in the `dataMod` list. Well, if $0\leq f < 5$, $f1$ should be a random number in the interval $10^{-4}< f1 \leq \sqrt2$, if $5\leq f < 7$, $f1$ should be a random number in the interval $10^{-7}\leq f1 \leq 10^{-4}$ and if $f \geq 7$ then $f1$ should be a random number in the interval $10^{-12} < f1 < 10^{-7}$. Any ideas how to do this?


Syntax for FrontEnd`SelectionSetStyle

I know `FrontEnd`SelectionSetStyle` is undocumented, but its name suggests it does what I need. What is its syntax? I have already tried several variations of the following button on some selected code in an input cell.               Button["set",        FrontEnd`SelectionSetStyle[FontColor, RGBColor[{1, 0, 0}]];       Print[CurrentValue["SelectionData"]]]      * * * **Update** Using the kernel, the following code does what I need:               Button["set",       SetOptions[NotebookSelection[InputNotebook[]], FontColor -> RGBColor[{0, .7, .5}]];       Print[CurrentValue["SelectionData"]]]      I assume that `FrontEnd`SelectionSetStyle` can change the font color of the selection while using the front end only. If so, what is its syntax?


Simplifying an expression containing radicals

Now I'm trying to use _Mathematica_ to simplify an expression like this: $P \sqrt{-P + \sqrt{M^2 + P^2}} + \sqrt{(M^2 + P^2) (-P + \sqrt{M^2 + P^2})} - M \sqrt{P + \sqrt{M^2 + P^2}}$ where $P,M>0$ It should be zero, obviously. But _Mathematica_ cannot do this simplification. Is there any technique that will help _Mathematica_ to deal with this kind of expression?


Gradually coloring edges in terms of their vertices colors

In order to color `Edges` in a `Graph` after applying a function such as `VertexDegree` I did the following code (on _Mathematica 8.0.4_ ):               g = GridGraph[{4, 4},VertexLabels->"Name",ImagePadding->10,DirectedEdges->True];     (* highlight is taken from the documentation of VertexDegree *)     highlight = Table[       Style[VertexList[g][[i]],         ColorData["TemperatureMap"][VertexDegree[g][[i]]/Max[VertexDegree[g]]]],       {i, VertexCount[g]}];     edgeList = EdgeList@g;     Flatten@Table[{edgeList[[i]] -> (       Function[Evaluate@         Line[#, VertexColors -> {highlight[[edgeList[[i, 1]], 2]],             highlight[[edgeList[[i, 2]], 2]]}]])},       {i,Length@edgeList}];          HighlightGraph[SetProperty[g, EdgeShapeFunction -> %], highlight]      giving me: ![Graph with colored edges](http://i.stack.imgur.com/yzmhv.png) which is basically what I was waiting for in terms of what it should look like. Although since I'm using `Line[#, VertexColors -> {Color1, Color2}]` the fact that the `Edges` are either `Directed` or `Undirected` is not preserved in the `Graph`. **Thus my question is:** Is there a way to preserve the `DirectedEdge`/`UndirectedEdge` property and to gradually color the `Edges` in terms of its two vertices?


Extract a List of Co-ordinates from a List of Complex Solutions

Let's say I have this list of solutions from a previous computation:               {      {x -> -9.640491283722653` - 5.790987589334252` I},       {x -> -9.640491283722653` + 5.790987589334252` I},      {x ->  0.`- 14.792128645445802` I},      {x ->  0.`+ 14.792128645445802` I},      {x ->  9.640491283722653`- 5.790987589334252` I},      {x ->  9.640491283722653`+ 5.790987589334252` I}     }      Now, how do I extract a list of coordinates from them? Like               {      {-9.640491283722653`, - 5.790987589334252`},      {-9.640491283722653`, + 5.790987589334252`},      {0.`,- 14.792128645445802`},      {0.`,+ 14.792128645445802},      {9.640491283722653`,- 5.790987589334252`},      {9.640491283722653`,+ 5.790987589334252` }     }


How to grab CellTags from a Cell?

I am in the process of creating a palette for a specialised "Save as HTML". For context please see this. How can I grab the CellTags from a Cell[...] object? This is my first iteration, aka testing code:               PaletteNotebook[      Module[{action, create},       create := NotebookCreate[];       action[nb_] := Module[{found, out, cell},         out = create;         SelectionMove[nb, Before, Notebook];         found = NotebookFind[nb, "Input", Next, CellStyle];         If[found != $Failed,          cell = NotebookRead[nb];          NotebookWrite[out, OptionValue[cell, CellTags]] (* 1 *),          NotebookWrite[out, "Not found"]          ];         ];       Button[Style["Blog it", 12, FontFamily -> "Times"],        action[InputNotebook[]],        Appearance -> "Palette"]       ]      ]      At the moment it just dumps data into a temporary empty notebook if it finds the Input cell, but the code at (* 1 *) does not print the CellTags the cell has in the `InputNotebook[]`. I am thinking that `OptionsPattern[]` may be the answer, but I am not sure how to use it. I tried               ...     cell = NotebookRead[nb];     tags = cell /. Cell[__, OptionsPattern[]] :> OptionValue[CellTags];     NotebookWrite[out, tags],     ...      but it doesn't work either.


What is the formula for this numerical series?

I'm developing a questions game. My goal is that the score for each correct answer will increase as the user answers more questions. Initially there are 15 points for each correct answer. Every 4 questions adds 2 points to the previous value. In terms of numerical series would be something like:               15 15 15 15 17 17 17 17 19 19 19 19 21 21 21 21.      I trying to find the formula for this numerical serie but I have not had success. If anyone sees in this numerical series a "challenge" and wants to help me find the formula I will be very grateful.


Equation in implicit form

This is simple example:                v = {1.48622576, 1.53444276, 1.42299438}      v/(v + 1)      Out[1]:= {0.597784, 0.605436, 0.587288}      In the above case expression v/(v + 1) is in explicit form. I would like to find k for v = {1.48622576, 1.53444276, 1.42299438} wherein                Log(0.5(1-k))/Log(0.5(1+k))=v (expression in implicit form)


How to find longest monotonic sequence?

I have a list, for example               list = {2, 1, 3, 5, 4, 6}      How to find longest ascending sequence of this list? There are two meanings of this question:   1. Find the largest subset that $$ X_{i_1} < X_{i_2} < \ldots < X_{i_{n-1}} < X_{i_n} $$ where $$ i_1 < i_2 < \ldots < i_{n-1} < i_n $$   2. Find the largest subsequence that $$ X_i < X_{i+1} < \ldots < X_{j-1} < X_{j} $$


Compiled version of user-defined function

I have a function for parameter estimation with these codes:               iparam1[u_, data_] := Module[{t, dif, bini, binit},       t = (Mean[Transpose[data]] - Mean[Mean[Transpose[data]]])/         StandardDeviation[Mean[Transpose[data]]];       bini = N[Log[(1 - Mean[u])/Mean[u]]];       Which[4 <= bini, binit = 4, -4 >= bini, binit = -4, -4 < bini < 4,         binit = bini];       dif = b /. FindRoot[Lb[1, b, 0, t, u], {b, binit, -4, 4}];       dif]      For using this function, below functions are pre-requisite:               p3[a_, b_, c_, t_] := c + (1 - c)/(1 + Exp[-1.7*a*(t - b)])     p2[a_, b_, t_] := 1/(1 + Exp[-1.7*a*(t - b)])     w[a_, b_, c_,        t_] := (p2[a, b, t]*(1 - p2[a, b, t]))/(p3[a, b, c,           t]*(1 - p3[a, b, c, t]))     Lb[a_, b_, c_, t_, u_] := (1 - c)*(-a)*       Sum[(u[[i]] - p3[a, b, c, t[[i]]])*w[a, b, c, t[[i]]], {i, 1,          Length[t]}]      I had trouble with writing compiled equivalent of my function with `CompilationTarget -> "C"`. FYI,`a`,`b`,`c` and `t` are reals.In `iparam1`, the `data` is a matrix of 1s & 0s and `u` is a column of `data`.The output of `iparam1` is a parameter (i.e. `dif`) for given column. I searched for examples but I couldn't find out to write the complied version. Any help is appreciated. **UPDATE:** I have been noticed that `FindRoot` is not compilable.Is there a solution for making my function `iparam1` faster?


Output from Wolfram language in Python

I have a Python program which will run a script in the Wolfram language and then return to the main program. Is it possible to return values/variables to the main program? This is the code in Python running the Wolfram language code:               os.system('wolfram  -script file.wl')      Then in file.wl, for example, I can run a command such as 1+1, which will give me an output of 2. Can I then use this value 2 in the rest of my Python program?               e.g. print (ans)


ListPlot - plotting values with different range

I have three tables: `L, S` and `U`. In first table I have values from range `(0,1)`, in second from `(0,2*10^27)` and in the third one from `(0,50)`. No I want to plot all this three tables (tables have the same domain) together. But because of a very different range, I see for example only values for `U`, and rest are just like a small points very near to axes x. I was trying to use `ImageCompose`, because I have mathematica 7, so I can't use `Overlay`, but this functions are only for two plots. Is any other solution how can I plot this three functions together and make the plot more legible?


How can I find the range of my function

I am trying to find the range of `(3 Sin[x] - 3)/(2 Cos[x] + 10)`, I tried this,               Function[x, (3 Sin[x] - 3)/(2 Cos[x] + 10)]@ Interval[{-Infinity, Infinity}]      _Mathematica_ returned `Interval[{-(3/4), 0}]`, but WolframAlpha returned `-5/8 <= y <= 0`. I'm sure Wolfram | Alpha is right What's wrong with my _Mathematica_ code?


Trouble to assign solution of differential equation to a function

I have written a function to Solve the following differential equation ![enter image description here](http://i.stack.imgur.com/qsOju.png) where the number n (called in my code Nphoton) is a variable. Nevertheless I have troubles to assign the solutions `sol` of the differential equation to functions `funCa0`, `funCb0` ... The code               Do[         ToExpression[           "fun" <> ToString[vec[[i]]] <> "=Evaluate[" <>             ToString[vec[[i]]] <> "[t]/.sol][[1]]"];         , {i, 1, Length[vec]}         ];      returns the error message `ReplaceAll::reps: {sol} is neither a list of replacement rules nor a valid dispatch table, and so cannot be used for replacing. >>` I do not understand this message, what is wrong with `sol`? My entire function is (it can be run simply by pasting it):               funoscillation[Nphoton_, intialAtomState_, NphotonInitial_, g0_, g1_,wSP_, w0_] :=        Module[{g0li, g1li, Delta, Omega, vec, funvec, eqns, sol, funPlot,          solReal, end},        g0li = Conjugate[g0];        g1li = Conjugate[g1];             Delta = wSP - w0;        Omega = wSP + w0;             If[Nphoton - 1 < NphotonInitial,          Print["ATTENTION: no intial state provided"]; Goto[end];];        vec = {};        funvec = {};     Do[       AppendTo[vec, ToExpression[StringJoin["Ca", ToString[i]]]];       AppendTo[funvec,         ToExpression[StringJoin["funCa", ToString[i]]]]       , {i, 0,    Nphoton - 1}];     Do[       AppendTo[vec, ToExpression[StringJoin["Cb", ToString[i]]]];       AppendTo[funvec,         ToExpression[StringJoin["funCb", ToString[i]]]]       , {i, 0,    Nphoton - 1}];             eqns = {};        Do[         If[i == 0,          AppendTo[eqns,            ToExpression[            "Ca" <> ToString[i] <> "'[t]==-I " <> ToString[g0] <>              " Sqrt[" <> ToString[i] <>              "+1] Exp[-I " <> ToString[Delta] <> " t] Cb" <>              ToString[i + 1] <> "[t]"]];                  AppendTo[eqns,                ToExpression[                 "Cb" <> ToString[i] <> "'[t]==-I " <> ToString[g1] <>              " Sqrt[" <> ToString[i] <>                    "+1] Exp[-I " <> ToString[Omega] <> " t] Ca" <>              ToString[i + 1] <> "[t]"]];             ];                If[i > 0 && i < Nphoton - 1,             AppendTo[eqns,                ToExpression[                 "Ca" <> ToString[i] <> "'[t]==-I " <> ToString[g0] <>              " Sqrt[" <> ToString[i] <>                    "+1] Exp[-I " <> ToString[Delta] <> " t] Cb" <>              ToString[i + 1] <>                    "[t]-I " <> ToString[g1li] <> " Sqrt[" <> ToString[i] <>              "] Exp[I " <> ToString[Omega] <> " t] Cb" <>                    ToString[i - 1] <> "[t]"]];                  AppendTo[eqns,                ToExpression[                 "Cb" <> ToString[i] <> "'[t]==-I " <> ToString[g1] <>              " Sqrt[" <> ToString[i] <>                    "+1] Exp[-I " <> ToString[Omega] <> " t] Ca" <>              ToString[i + 1] <>                    "[t]-I " <> ToString[g0li] <> " Sqrt[" <> ToString[i] <>              "] Exp[I " <> ToString[Delta] <> " t] Ca" <>                    ToString[i - 1] <> "[t]"]];             ];                If[i == Nphoton - 1,             AppendTo[eqns,                ToExpression[                 "Ca" <> ToString[i] <> "'[t]==-I " <> ToString[g1li] <>              " Sqrt[" <> ToString[i] <>                    "] Exp[I " <> ToString[Omega] <> " t] Cb" <>              ToString[i - 1] <> "[t]"]];                  AppendTo[eqns,                ToExpression[                 "Cb" <> ToString[i] <> "'[t]==-I " <> ToString[g0li] <>              " Sqrt[" <> ToString[i] <>                    "] Exp[I " <> ToString[Delta] <> " t] Ca" <>              ToString[i - 1] <> "[t]"]];             ];                , {i, 0, Nphoton - 1}];                   Do[                If[i == NphotonInitial ,           If[intialAtomState == b,            AppendTo[eqns, ToExpression["Ca" <> ToString[i] <> "[0]==0"]];            AppendTo[eqns, ToExpression["Cb" <> ToString[i] <> "[0]==1"]];];           If[intialAtomState == a,            AppendTo[eqns,              ToExpression["Ca" <> ToString[i] <> "[0]==1"]];                AppendTo[eqns, ToExpression["Cb" <> ToString[i] <> "[0]==0"]];],                AppendTo[eqns, ToExpression["Ca" <> ToString[i] <> "[0]==0"]];           AppendTo[eqns, ToExpression["Cb" <> ToString[i] <> "[0]==0"]];               ];                , {i, 0, Nphoton - 1}];             sol = NDSolve[eqns, vec, {t, 0, 10}];             Do[         ToExpression[           "fun" <> ToString[vec[[i]]] <> "=Evaluate[" <>             ToString[vec[[i]]] <> "[t]/.sol][[1]]"];         , {i, 1, Length[vec]}         ];             Print[funvec];        Print[funCa0];        funPlot = Abs[(# & /@ funvec)]^2;             Plot[funPlot, {t, 0, 10}, PlotLegends -> vec, PlotRange -> All]             ];          funoscillation[2, a, 1, 1*0, 1, 2 Pi, 2 Pi]


Counting Real roots

I'm interested on how to count the number of real roots of a random polynomials in an instant, how to put the result in a table and how to plot it in a graph.I generated 1 million random polynomials following Gaussian Distribution with mean 0 and variance 1. I used this command               r:=GaussianDistribution[0,1]     y=randompol[n_,i_]:=Sum[r x^{j},{j,0,n}]     Solve[y==0,x]     CountRoots[y,x]      But the command Countroots does not apply for it says that the above generated random polynomials is not univariate. But it seems awkward that when I manually paste the generated random polynomial to the CountRoots command instead of using link, it works! But I want to do it in 1 million random polynomials and it is not practical for me to do so. I already used `y//Tableform` and `Remove[{}]` because I thought that the problem is braces since the random polynomials generated using this command `y=randompol[n_,i_]:=Sum[r x^{j},{j,0,n}]` is inside a brace while the `CountRoots` command does not require braces, but i Failed and it did not work. please help me...


saving outputs of loop

I am stuck on a problem. I have outputs generated at every iteration of a do loop. However, I want to save the outputs in some other file format, like text file etc, in such a way that i must be able to use any output from iteration later. But the more I am searching about it, the more I am getting confused. Please guide in this respect. Like I read the options 'import', 'export', 'sow', 'reap', 'get' etc but i need simple description. Please guide me in this respect.   I quote the example as   I have some initial $a$ as $V0 +\Delta V*\Delta t/T$. Then I update the value of $\Delta t $ by having an increment of value $T/ntmax$ and define $b$ as $V0 +\Delta V*\Delta t/T$ . And then I have to multiply both $a$ and $b$ as $Exp[b]*Exp[a]$   I have to repeat this process until $\Delta t $ $/T$ reaches equal to $T$, as shown in the below loop.               Do[      a = V0 + ΔV*Δt/T;      Δt = Δt + T/ntmax;      b = V0 + ΔV*Δt/T;      f = Exp[b]*Exp[a],      {Δt, T/ntmax, T, T/ntmax}]      As during each iteration I will obtain the new value of $f$. I have to plot few values of $f$. However, I want to keep the record of all, so that I may be able to plot any one of them.


Projecting curves of intersection onto a plane

Referring to this page, Plotting implicitly-defined space curves How can I project the curves of intersection onto the x-y plane?


StreamPlot in Mathematica

A $2\times 2$ linear ODE system can be visualized by `SteamPlot` in _Mathematica_. For example               StreamPlot[{y, y - x}, {x, -3, 3}, {y, -3, 3}]      which gives ![enter image description here](http://i.stack.imgur.com/OPVJc.png) Or               StreamPlot[{y, -3 y - x}, {x, -3, 3}, {y, -3, 3}]      which returns ![enter image description here](http://i.stack.imgur.com/W4Zwl.png) Here is my **question** : How can I draw a pair of eigenvectors (like arrows in this answer) in the graph?


Quickly calculating the mean / median of a function over an interval

I'd like to calculate the Mean or Median value of a function over some interval $[a,b]$. However, I can't seem to find how to do this in help. Specifically I'd like to have something that works like the following:               f = x;     funcMean[f,{x,0,1}];     out :> 0.5;      The way to actually do this is to compute the integral:               1/(b - a) * NIntegrate[f, {x, a, b}, WorkingPrecision -> 20]      But I suspect there's a built-in function to do that same? What about for calculating the Median over the same interval?


What is the correct way to use Compiled function in Table and Plot without slow down?

On V 9.01 on windows 7, all 64 bit. I am sure I am missing something simple here, but I used all the tricks of the trade that I know about, and read docs, and do not see anything that helps. Here is a compiled function made to speed up some computation. When this function is put inside `Plot` or `Table` it resort back to being slow at the speed of the original uncompiled function speed. Using `Evaluate` gives an error. Here is a MWE (This function takes about one minute to evaluate and compile, sorry that is what I am using, but it is only one line, and takes one minute to compile)               ClearAll[f, g, g0, x, b, a];     f = Function[{##} /. {x_, b_, a_} :>Piecewise[{{Exp[-b*(-Log[x])^a], 0. < x <= 1.}}]];     g = InverseFunction[f, 1, 3];     g0 = Compile[{{x, _Real}, {a, _Integer}, {b, _Integer}}, g[x, a, b]]      ![Mathematica graphics](http://i.stack.imgur.com/LQ24u.png)               Timing[g0[.1, 3, 2]]     (* {0.156001, 0.416409} *)      and               Timing[g0[#, 3, 2] & /@ Range[0, 1, .1]]      ![Mathematica graphics](http://i.stack.imgur.com/AT4Ff.png) It is fast now. Uncompiled version takes more than 60 seconds for each one computation. But when in a table, it becomes slow again, using the original version? or for some other reason               Table[Timing[g0[x, 3, 2]], {x, 0, .1, .1}]     (* {{61.308393, 0.00258519}, {61.323993, 0.416409}} *)      `Evaluate` gives error and still slow               Table[Evaluate[g0[x, 3, 2]], {x, 0, .1, .1}]     (*CompiledFunction::cfsa: "Argument x at position 1 should be a      "machine-size real number " *)      Direct use of Table is too slow, same as above.               Table[g0[x, 3, 2], {x, 0, .1, .1}]      Same issue with `Plot`. Can't use `Evaluate` and if I do not, it is slow. Using `Compiled-False` did not help (since `g0` is already compiled), it is still slow               Plot[g0[x, 3, 2], {x, 0, 1}, Method -> {Compiled -> False}]; (*slow*)     Plot[g0[x, 3, 2], {x, 0, 1}, Method -> {Compiled -> False}, Evaluated -> False];      Plot[g0[x, 3, 2], {x, 0, 1}, Evaluated -> False]; (*slow*)      **How can one use Compiled function in`Table` and `Plot` without it being slow?** Is it one of those `HoldRest`, `HoldFirst` issues or I am missing something more basic here?


Factor vector out of a matrix

I am wondering how to factor `a[1],a[2],...,a[4]` out of `sim` so that I can write `sim` as the form of a matrix times column vector `a`. (`a[1],a[2],...,a[4]` are the component of vector `a`) ? My ultimate goal is to compute the `Omega` when the determinant of the matrix is zero.               Nmax = 4;     x[0][t] = 0;     x[Nmax + 1][t] = 0;          T = 1/2 Sum[m[i] x[i]'[t]^2, {i, 1, Nmax}];     U = 1/2 Sum[k[i] (x[i][t] - x[i - 1][t])^2, {i, 1, Nmax + 1}];          L = T - U;          EL[q_] := D[L, q] - D[D[L, D[q, t]], t]          eigen = Table[EL[x[i][t]], {i, 1, Nmax}] // MatrixForm;          x[i_][t_] = a[i] E^(I \[Omega] t);          sim = eigen /. t -> 0      ![enter image description here](http://i.stack.imgur.com/E2CuU.jpg)


transformation patterns don't work with constants

I want to do the reverse of PowerExpand and convert 2*Log[x+y] to Log[(x+y)^2]. The rule:                t_ Log[x_] -> Log[x^t]      works for `a Log[y], a Log[Pi], Pi Log[a], 2 Log[a], a Log[2]` but not for `2 Log[Pi], Pi Log[2], Pi Log[EulerGamma]`. Entering:               Pi Log[Pi] /. Pi Log[Pi] -> Log[Pi^Pi]      Returns:               Pi Log[Pi]      instead of:               Log[Pi^Pi]


Match a sequence of integers

I would to match a pattern                p1 = 0,0,1,0,0      to the elements in listA. The elements are a boolean sequence that may look like this                {{0, 0, 1, 0, 0, 1, 0, 1, 1, 0, 0, 1, 0, 0}, {0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0}}      Every where p1 matches the sequence I want to change that part into                p2 = .5, .5, 1, .5, .5      that will change listA into                {{.5, .5, 1, .5, .5, 1, 0, 1, 1, .5, .5, 1, .5, .5},   {0, 0, .5, .5, 1, .5, .5, .5, .5, 1, .5, .5, 0, 0}}      Thanks!


Panel help with little program

I'd like to show the output of this program into one large `Panel`, but when I surround this code with `Panel[ ]`, it doesn't seem to work. Why is that?               listA = {};     listB = {};     "Verzameling A : " InputField[Dynamic[Null, AppendTo[listA, #] &]]           "Verzameling B : " InputField[Dynamic[Null, AppendTo[listB, #] &]]               listAShow := Sort[ DeleteDuplicates[listA]];     listBShow := Sort[ DeleteDuplicates[listB]];          "Verzameling A =" Dynamic[listAShow]     "Verzameling B =" Dynamic[listBShow]          unie := Union[listAShow, listBShow];     doorsnede := Intersection[listAShow, listBShow];          toonOpl = False;     Row@{Checkbox[Dynamic[toonOpl]], "Toon bewerkingen"}     Dynamic[If[toonOpl,       Column@{         Row@{"Unie van A en B = ", unie}         , Row@{"Doorsnede van A en B = ", doorsnede}         }, {}]]          Button["Reset alles", listA = {}; listB = {}]      Thanks all!


StandardForm on Graph edges

The `Graph` command displays edge labels in `TraditionalForm`. I instead want to use `StandardForm`. I tried `EdgeLabelStyle -> Directive[StandardForm, Background -> White]`, but of course it does not work. So how to do it, acting on `EdgeLabelStyle`? Edit: Comment to @Sjoerd examples Your Binomial example is somewhat misleading, since Binomial has an intrinsic TraditionalForm version. What we are seeing in the graph is a sort of hybrid of Standardform (for n and k) and TraditionalForm for the parenthesis (I think). This is the proof: ![Mathematica graphics](http://i.stack.imgur.com/mXV9D.png) As you see, even though I used braces in the notation, I still get the parenthesis in the graph (from the internal TraditionalForm), but the n, k are indeed in StandardForm. This shows that the "StandardForm" in EdgelabelStyle does something, but it is not enough. Perhaps it is possible to play with BaseStyle? The same thing happens if you use MakeBoxes (without ToString).


How to graph a series of coupled oscillators and watch the wave move along them

Here are the differential equations that set's up the 11 coupled oscillators.               new = Join[     Table[x[i]''[t] == - x[i][t] +       0.1*(x[i + 1][t] - 2*x[i][t] + x[i - 1][t]), {i, 1,      9}], {x[0]''[t] == -x[0][t], x[10]''[t] == x[9][t], x[0][0] == 1,      x[0]'[0] == 1, x[1]'[0] == 0, x[1][0] == 0},      Table[x[i][0] == 0, {i, 2, 10}], Table[x[i]'[0] == 0, {i, 2, 10}]]      Here are the solutions.               Solt = NDSolve[new, Table[x[i], {i, 0, 10}], {t, 25}]      Here are the individual plots.               Table[Plot[Evaluate[x[i][t] /. Solt], {t, 0, 25},      PlotRange -> All], {i, 0, 10}]      I am trying to figure out how to make a graph so along the x-axis are my i's from 0 to 10, and I can watch the wave move along each oscillator as time moves on. I keep getting errors in which it floods my notebook and doesn't stop unless I close the kernel. This is what I have so far, and I'm not sure how to incorporate time into this.               Plot[Evaluate[x[i][t] /. Solt], {i, 0, 10}]      EDIT Coupled in a circle               Stew = Join[      Table[x[i]''[t] == - x[i][t] +        0.1*(x[i + 1][t] - 2*x[i][t] + x[i - 1][t]), {i, 1,       9}], {x[10]''[t] == - x[10][t] +        0.1*(x[0][t] - 2*x[10][t] + x[9][t]),      x[0]''[t] == - x[0][t] +        0.1*(x[1][t] - 2*x[0][t] + x[10][t])}, {x[0][0] == 0,      x[0]'[0] == 0, x[1][0] == 1, x[1]'[0] == 0.5},      Table[x[i][0] == 0, {i, 2, 10}], Table[x[i]'[0] == 0, {i, 2, 10}]];      The Dsolve               Loin = NDSolve[Stew, Table[x[i], {i, 0, 10}], {t, 6.28}]      The individual graphs               Table[Plot[Evaluate[x[i][t] /. Loin], {t, 0, 6.28},      PlotRange -> All], {i, 0, 10}]      How would I go about putting the i=0 to 10 around in a circle?


Working with nested matrices

I have a matrix:               A = {{a, b}, {c, d}}      But each its element, itself, is another matrix too.               a={{0,1,1},{0,1,0}}     b={{0,0,1},{1,0,0}}          c={{0,0,0},{0,1,0}}     d={{0,0,1},{1,0,1}}      I want to comprise 'a' and 'b' with their elements; and respectively 'c' and 'd'. If just one element be similar in 'a' and 'b' and simultaneously equal to '1', (here:)               a13=b13=1      the 'b' element of 'A' must be replaced with zero. (here A12=0). Question1:   For the comparison I write bellow line, I Do not know which must be written in the A['indexes referring to location of b'] in this line:               Do[If[a[[i, j]] == b[[k, m]], A['indexes referring to location of b'] = 0], {i, 1, 2}, {j, 1,3}, {k, 1, 2}, {m, 1, 3}]      Question2: All of us know each element of a matrix has two indexes {i and j; for example Aij}. are there any possibility to devote four indexes to a one element of a Matrix(for example Aijkm? Actually, if we can devote four indexes to each A element in the above 'Do' loop, the line will be written more easily. Question3: if instead of 'a','b', 'c' and 'd' we have numerics:               A = {{1, 2}, {3, 4}}      Are the any possibility to devote a matrix to numeric!!!!!!? For example               1={{0,1,1},{0,1,0}}     2={{0,0,1},{1,0,0}}      !!


Function that prints a different value than it returns

I want to create a function something like this: `test[x_] := (Print[1]; Return[2];)` Except it prints `1` when executed as `test[a]` for any `a` on the notebook, but when used in computations uses the `2` value instead. Thus `test[2342]` will output just `1` but `test[43589] + 1` will output just `2` (because the value returned, 2, is used instead). I have looked into `Interpretation` but that returns a held object and does not allow you do perform operations like `test[1] + 123` without explicitly releasing the hold.


InverseFunction on an Interpolating Function is misbehaving

I am getting strange behavior when I try to calculate the inverse of an interpolating function for two similar data sets. My data sets are:               Array1 = {25, 425, 825, 1175, 1575, 1975, 2025, 2625, 3225, 3775, 4375, 4975, 5250, 9250,                13250, 16750, 20750, 24750, 27500, 47500, 67500, 82500, 102500}          Array2 = {13, 88, 188, 263, 338, 413, 513, 588, 613, 688, 788, 863, 938, 1013, 1113, 1188,               1250, 1950, 2650, 3350, 4050, 4750, 5450, 6150, 6700, 13700, 20700, 27700, 34700, 41700,               48700, 55700}      Let's define:               int1 = Interpolation[Array1];     int2 = Interpolation[Array2];          inv1 = InverseFunction[int1];     inv2 = InverseFunction[int2];      Now if these are behaving, then taking the inverse of the interpolating function's value for X should return X. Here's what happens when we try that for, say, 5:               N[inv1[int1[5]]]      > Out: 5.               N[inv2[int2[5]]      > Out: -1.73315 Err...this makes no sense. Is there any reason that the inverse of an interpolating function would behave as expected with one data set but not another? These data sets aren't very different so it isn't clear to me what about the second set could be causing the routine heartburn.


Using Nest inside NestList

I need results like this:               {Cos[Cos[x]], Sin[Cos[Cos[x]]],Cos[Cos[Sin[Cos[Cos[x]]]]],       Sin[Cos[Cos[Sin[Cos[Cos[x]]]]]], ... }      I've tried to use `Nest` inside `NestList`, but failed:               NestList[Sin, Nest[Cos, x, 2], 3]          (* {Cos[Cos[x]], Sin[Cos[Cos[x]]], Sin[Sin[Cos[Cos[x]]]],       Sin[Sin[Sin[Cos[Cos[x]]]]]}  *)      Any idea?


Fold Dynamic Function

I'm making on a demo working with differential equations as functions of two variables (x and y). The demo will have to Fold the differential equation with an initial y-value and a series of x-values. Here's a simple code for the demo. The output should be a list on new y-values.               DynamicModule[{dydx = Null},      Deploy@     Panel@     Grid@     Transpose@     {{"Differential equation: (dy/dx)=",         "List of Slopes:"},       {InputField[Dynamic[dydx]],         InputField[Dynamic[FoldList[dydx, 1, {0, 1, 2, 3}]]]}}]      The code doesn't work because dydx cannot be applied as a function in FoldList. "dydx" needs to be defined as a function f[y_,x_]. However, I'm not sure how to dynamically change a function using InputField.               f[y_,x_]= dydx     FoldList[f,1,{0,1,2,3}]      I'd like to have this as part of the Dynamic Module. Users would be able to input a function then receive a list of new y values.   Any advice?


Strip waste braces in nested list

I have nested lists wherein there are a lot of waste levels which looks like               l = {{{{{{2, 2}}, 3}, 2, {{2, 33}}, 4, 5}}};      I would like to reduce it to somthing like               l = {{{2, 2}, 3}, 2, {2, 33}, 4, 5};      I made the function which remove waste levels on the top level:               l = {{{{{{2, 2}}, 3}, 2, {{2, 33}}, 4, 5}}};          strip = Function[{list},                      If[(Head[list] === List) && (Length[list] > 0),                         If[Flatten[list, 1] === list[[1]],                             s = strip[list[[1]]],                             s = list],                         s = list];                      s];     strip[l]      To do it at any depth I tried to do `Map[strip[l]]` without success. How I can to apply my function to all levels? Also, I guess there more appropriate way to solve my problem.


How to control Boundary conditions after integrating over piecewise function?

The following code               Assuming[-1 < t < 1 && Element[a, Reals],       FullSimplify[       Integrate[        Piecewise[{{(1 + x)/(1 + t), -1 < x < t},                    {(1 - x)/(1 - t),  t < x < 1},                    {0,                True}}],         {x, -1, a}]]]      will result in $$ \begin{cases} 1 & a>1 \\ \frac{(a+1)^2}{2 (t+1)} & a>-1\land a<t \\ \frac{t+1}{2} & a=t \\ \frac{(a-1)^2}{2 (t-1)}+1 & a>t\land a\leq 1 \end{cases} $$ By the assumptions above, that's the same as: $$ \begin{cases} 1 & a\ge 1 \\ \frac{(a+1)^2}{2 (t+1)} & a>-1\land a\leq t \\ \frac{(a-1)^2}{2 (t-1)}+1 & a>t\land a< 1 \end{cases} $$ which is the form I'd prefer.   Is there a way to automatically tell mathematica to do that? The reason I want the second form is, that I'd need to integrate the output once again and in the first form, it would result in weird behavior, suddenly unnecessarily special-casing for $\frac{1}{\sqrt{2}}$ or things like that. (Note that there is no case for $a\leq -1$. That case gets auto-handled by Mathematica as $\{0,True\}$ and doesn't show up when you use the \TeXFormat command)


How to understand and use DSolve solution

This equation is simple to `DSolve` in _Mathematica_ , but I don't know how to use and understand solution.                DSolve[Y1''[x] - a2 Y1[x] - a1*X1[x] == 0, Y1[x], x]      $ \text{Y1}[x]\to e^{\sqrt{\text{a2}} x} C[1]+e^{-\sqrt{\text{a2}} x} C[2]+e^{-\sqrt{\text{a2}} x} \left(e^{2 \sqrt{\text{a2}} x} \int_1^x \frac{\text{a1} e^{-\sqrt{\text{a2}} K[1]} \text{X1}[K[1]]}{2 \sqrt{\text{a2}}} \, dK[1]+\int_1^x -\frac{\text{a1} e^{\sqrt{\text{a2}} K[2]} \text{X1}[K[2]]}{2 \sqrt{\text{a2}}} \, dK[2]\right) $ What is `dK1` and `dK2`, how to solve integrals [1,x], and how to use this solution `Y1[x]` to find `X1[x]` in another equation               Derivative[2][X1][x] == Y1[x]


How to set up the Fourier domain for a Fourier Transform?

I am having trouble understanding how to set up the grid in the Fourier domain, while performing Discrete Fourier Transforms. This might be a very trivial question, but I'd appreciate any help understanding this problem. I am trying use Fourier transforms to model the propagation of an electric field through space. The steps that I need to perform are:   * Take the Fourier transform of $f(x, z = 0)$ to obtain $f(k, z=0)$   * Multiply $f(k)$ by $\exp[i\,k_z\,d]$ for some propagation distance $d$ with $i = \sqrt{-1}$. Here k_z is defined as: $$ k_z = \sqrt{k^2 - k_x^2} $$ where $k$ is the known wavenumber.   * Inverse Fourier Transform back to obtain $f(x, z=d)$ I have set-up my grid for the x-dimension but I do not understand how I should go about setting up the grid for the k-dimension. My approach (as obtained from the section on FFT in Computational Methods in Physics by Joel Franklin): My $x$-grid is defined as $x_i = i\,\,dx$ for $i \in [0,N-1]$ for some number $N$. Now, I define the $k$ space with $k_j = j \times dk$ such that $dk=\frac{1}{dx \,\,N}$. This grid was created to obtain the max value of k allowed by Nyquist's theorem. Then, I execute the following:               (*fields is a list of the values of the field on the x-grid*)         klist = Table[n*dk, {n, -NN/2 , NN/2}];        four = Fourier[fields];     final= InverseFourier[        Table[four[[i]]*Exp[-I*d*Sqrt[k^2 - kxlist[[i]]^2]], {i, 1,           Length[four]}]];      The output of the above code does not give me expected results for the what the field looks like at various distances. I would appreciate any explanation about where the definitions of setting up the k-grid come from and also if someone can point out mistakes in my implementation. Thanks


Interactive 3D plot in web browser?

Are there any ways to show a mathematica plot in a web browser so that the user can rotate it and such? I am open to embedding it in a web page - or some other method such as porting it to a different language such as java or javascript.


How do I draw lines perpendicular to contour lines on ListPlot3D?

I am plotting the voltage in a pool of water with two electrodes. I have contour lines on my graph at every volt, but I would like to show the electric field lines which are going to be perpendicular to the contour lines. How can I do that? ![enter image description here](http://i.stack.imgur.com/1oSP8.png)


Can this Part shortcut key be made to work with version 9?

In version 8 I was a frequent user of the "Use shortcut keys to easily type〚 and 〛" trick. In version 9, when I try to make the necessary change to `KeyEventTranslations.tr`, the `\\[LeftDoubleBracket]` and `\\[RightDoubleBracket]` get immediately changed to doubled single-brackets (`[[` and `]]`). And indeed the shortcuts work, but they insert the doubled single-brackets instead of the single double-brackets. How can the brackets' doubleness be preserved in `KeyEventTranslations.tr`?


Using NDSolve for three variables as function of time

I want to be able to plot z, and r. Should I be using DSolve, NDSolve or something else? I've tried to clear it up a bit Thanks, Will               ClearAll["Global`*"];          (*Constants*)     rho = 1000;     g = 9.81;     Patm = 100000;     gma = 0.0728;     mu = 0.0001;     rs = 287;     T = 293.15;     Psat = 2399;          (*Variables*)     r0 = 25*(10^-6)          (*equations*)     Pl = rho*g*z[t] + Patm;          eqn1 = Pb[t] == rho*g*z[t] + Patm + (2*gma)/r[t]          eqn2 = r[t] == (((1 + (Psat/Pb[t]))*(rho*g*z[t] + Patm)*r0^3)/Pb[t])^(1/3)          eqn3 = z'[t] == -(2/9)*(1/mu)*(r[t]^2)*(Pl - Pb[t]/(rs*T))               eqn = {eqn1 && eqn2 &&  eqn3 , r[0] == 0.000025 && z[0] == 1 }               sol = NDSolve[eqn, {r[t], Pb[t], z[t]}, t, {Z[t], 1, 0}]


How do I find the number of countries that have a type of industry?

I am trying to find the number of countries that have a certain type of industry. Currently, I have this code:               countries = Flatten[CountryData[]];          listofCountries = Table[countries[[i]], {i, 1, 240}];          industries = Map[{CountryData[#, "MajorIndustries"]} &, CountryData[All]];          data = Table[industries[[i]] -> listofCountries[[i]], {i, 1, 240}];      I am not sure on how to find the number of countries that have an industry (i.e. `Coal`), or if I am headed in the correct direction. Could somebody show me the correct way to find the number of countries with an industry? EDIT: If I were trying to shade in the countries found on the world map with a color, how would I do so? (This is using the CountryData function.) I'm curious to see how much of the world has this industry, and so forth. (EDIT: How could I do it with the world map showing the boundaries of every country?) EDIT 2: How could I do the edit above with two industries? (i.e. Coal and Copper)


Coding contour integration

I am struggling to understand contour integration. How would it be applied in _Mathematica_? I am hoping that if I see it written in _Mathematica_ code, it will help me understand it. eg how would $$\int_\gamma \text{}(z) = \int_a^b \text{f}(z(t)) z'(t) \, \text{d}t$$ be coded? (Example taken form Wikipedia.)


Write list of polynomials as a matrix of coefficients times a list of monomials

I have the following problem: given a list of polynomials `P = {p1, ..., pn}` on the variables `x[1], ..., x[n]`, find a list of monic monomials `M = q1, ..., qm` on `x[1], ..., x[n]` and a matrix `A` that does not depend on `x[1], ..., x[n]` such that `A.M = P`. For example, taking `P = {x[1] x[2] + x[1]^2 x[2], a x[1]^2 + b x[2], c x[1]^2 x[2] + d x[2]^2}` a possible solution is: `M = {x[1] x[2], x[1]^2, x[2], x[2]^2, x[1]^2 x[2]}`, `A = {{1, 0, 0, 0, 1}, {0, a, b, 0, 0}, {0, 0, 0, c, d}}` I managed to find a long and clumsy solution by using a lot of replacement rules, but I want to know if there is an easy way of doing something like this. Many thanks in advance.


Stop use of Scientific Notation in Tooltips

I have a list of pairs of values that I am plotting in a ListLinePlot. I can use the tooltip functionality fine but I want to stop them from displaying in scientific notation. I have tried the following                 DisplayData20Yr = {{2010, 1.49952026`*^6}, {2011,         1.82272254`*^6}, {2012, 2.01921445`*^6}, {2013,         2.28115586`*^6}, {2014, 2.77986072`*^6}, {2015,         3.18915846`*^6}, {2016, 3.1505870500000003`*^6}, {2017,         3.44300142`*^6}, {2018, 3.58399037`*^6}, {2019,         3.67522613`*^6}, {2020, 3.88522079`*^6}, {2021,         3.90061335`*^6}, {2022, 3.9293277800000003`*^6}, {2023,         3.90820965`*^6}, {2024, 3.9495397`*^6}, {2025,         3.6954160300000003`*^6}, {2026, 3.76539612`*^6}, {2027,         3.77579118`*^6}, {2028, 3.29648289`*^6}, {2029,         1.6678326400000001`*^6}}          DisplayData20YrNoScientific =        Map[NumberForm[N[#], ExponentFunction -> (Null &)] &,         DisplayData20Yr];          ListLinePlot[Tooltip[Table[DisplayData20Yr[[i]], {i, 20}]],        Joined -> True, PlotMarkers -> {Automatic, 12}];          ListLinePlot[Tooltip[DisplayData20Yr], Joined -> True,        PlotMarkers -> {Automatic, 12}];          ListLinePlot[       Tooltip[DisplayData20Yr, Table[DisplayData20Yr[[i]], {i, 20}]],        Joined -> True, PlotMarkers -> {Automatic, 12}];      The first plot works normally with the tooltips showing in scientific notation. The second plot works in the same way as the first plot. The third plot doesn't disply tooltips at all. When I then use the DisplayData20YrNoScientific data set all three plot do not display anything at all. No lines/points or tooltips. They are blank. In my understanding the third plot should work because tooltip can be used as Tooltip[expression,label].


Manipulate changing controls

Is it possible to use `Manipulate` and `Switch` to change the `Manipulate` controls?               Manipulate[Module[{...variables...},       Switch[type,         1,         controls = ...,         2,         controls = ...]],       controls]      Where `Manipulate` controls would be different for each `type`.


ListPolarPlot not showing full plot range even with PlotRange -> All

I have a list of data `dpdOt` (given below) with associated angular coordinates `thetaplot`, which when plotted using                   thetaplot = Table[tt,{tt,0,2*Pi,2*Pi/300}]         ListPlot[Transpose[{thetaplot/Pi 180, dpdOt}], Joined -> True, PlotRange -> All]      looks like this: ![ListPlot](http://i.stack.imgur.com/dZMZB.png) However, I'd rather see this plotted as a `ListPolarPlot`, but I am having trouble with `PlotRange`. For example, when I use the command                   ListPolarPlot[Transpose[{thetaplot, dpdOt}],            Joined -> True, PolarAxes -> True,            PolarTicks -> {"Degrees", Automatic},            PolarGridLines -> True, PlotRange -> All]      I get the following plot: ![ListPolarPlot](http://i.stack.imgur.com/y5rYi.png) which is obviously not plotting the full data range. If I try and manually set `PlotRange -> 1.5`, _Mathematica_ merely gives me a zoomed out version of the same polar plot: ![enter image description here](http://i.stack.imgur.com/NwnFz.png) Does anybody have any idea how I can get _Mathematica_ to show the full dataset on my polar plot? The dataset is:                   dpdOt = {0.`, 0.009554081538201524`, 0.03657921246993372`,  0.07645719594918586`, 0.1224134613324866`, 0.16671965853831489`,  0.2020509236272155`, 0.22274769290832974`, 0.22575257105691635`,  0.21105662334588893`, 0.18158393497377667`, 0.14254991938921568`,   0.10042704400882534`, 0.06172261938230206`, 0.03180381202988293`,   0.013989865520678359`, 0.009074375607003422`, 0.015353199348562318`,   0.029133703291304467`, 0.045608259290746044`,  0.059907143344449666`, 0.06811602801815318`, 0.06805619079404875`,   0.05967798355792369`, 0.044998917623994925`, 0.027610426330823622`,   0.011863439428043385`, 0.001905442213411619`,  0.0007687312281260307`, 0.009696350336090554`,   0.027841942524898654`, 0.05240297090682485`, 0.07915899837109333`,   0.10330545634013048`, 0.12041455169350666`, 0.1273300195707255`,   0.12281593359315725`, 0.10782877955797118`, 0.08535664034364425`,   0.0598548826381265`, 0.0363874297112553`, 0.01964103546890816`,   0.013005632519217386`, 0.017901837073488084`, 0.03348933529492066`,   0.05681622331866217`, 0.08338356368455244`, 0.10801797869739073`,   0.1258838157458027`, 0.13343735028386552`, 0.12913464839968958`,   0.11375083606637912`, 0.09024321729842082`, 0.0631798709645865`,   0.03784184580594409`, 0.01917378839552386`, 0.010791123900980252`,   0.014244303123378875`, 0.028692550180028028`, 0.051059513247240756`,   0.07664648824951373`, 0.10008465443777814`, 0.11643545518106532`,   0.12221354284042615`, 0.11611806246510771`, 0.09931464269298441`,   0.07520186774030126`, 0.048703952993848255`, 0.025233271631061455`,   0.009540102126567822`, 0.004695564232203329`, 0.011429494446618007`,   0.027971655343629113`, 0.050436902199565224`, 0.07367569127391489`,   0.0924069287274574`, 0.10238447666431386`, 0.1013374846275298`,   0.08947198471813812`, 0.06941749674225801`, 0.04562682130072883`,   0.02336179577963223`, 0.007493854962987605`, 0.00139302722259097`,   0.006161200150237524`, 0.020388179378757983`, 0.04048931173627752`,   0.06154859929889949`, 0.078472675688499`, 0.08718681535608698`,   0.08559234035384577`, 0.07405894111973076`, 0.05533354561614883`,   0.03388451541925968`, 0.014833968423679648`, 0.0027301058954676103`,   0.00045163413523262254`, 0.008507481364097463`,   0.024903075095984252`, 0.0456105809967408`, 0.06553606471258362`,   0.0797558049558498`, 0.08472607856766433`, 0.0791726455592892`,   0.06443855291626575`, 0.04419570077716716`, 0.023577636442966548`,   0.007932512944609768`, 0.001492113602352463`, 0.006281152280129452`,   0.021542228899509474`, 0.04383535778027103`, 0.06781257671823812`,   0.08750405559279266`, 0.0978210472734063`, 0.09591516988165438`,   0.08205096374581881`, 0.05974878090823095`, 0.03511799119091121`,   0.015491056611719418`, 0.007644208098589879`, 0.016008842898051462`,   0.041308975498834125`, 0.0799920698716276`, 0.12466309845912157`,   0.16551502191459355`, 0.19251813998620537`, 0.1979365219231554`,   0.1786272840234142`, 0.1375777607510681`, 0.08425397825386047`,   0.0335534665496219`, 0.0034359646772461074`, 0.011591552251972725`,  0.07173765420231708`, 0.19026282194703806`, 0.3639239411625669`,   0.5791488923696507`, 0.813221884473814`, 1.037282176743776`,   1.2207136698253551`, 1.3362119128823164`, 1.3646459208863824`,   1.2988226517976427`, 1.1454201179472137`, 0.9246567650991964`,   0.6676574849266789`, 0.4118891574170705`, 0.19539424083596366`,   0.050782165477450084`, 0.`, 0.050782165477450084`,   0.19539424083596366`, 0.4118891574170705`, 0.6676574849266789`,   0.9246567650992072`, 1.1454201179472137`, 1.2988226517976427`,   1.3646459208863868`, 1.33621191288231`, 1.2207136698253502`,   1.0372821767437717`, 0.813221884473814`, 0.5791488923696507`,   0.36392394116255933`, 0.19026282194703142`, 0.07173765420231298`,   0.011591552251971629`, 0.0034359646772465858`,   0.033553466549622345`, 0.08425397825386129`, 0.13757776075106873`,   0.17862728402341452`, 0.1979365219231553`, 0.19251813998620523`,   0.16551502191459352`, 0.12466309845912063`, 0.07999206987162717`,   0.04130897549883387`, 0.016008842898051108`, 0.00764420809858988`,   0.015491056611719966`, 0.0351179911909119`, 0.05974878090823171`,   0.08205096374581904`, 0.0959151698816545`, 0.0978210472734063`,   0.08750405559279249`, 0.06781257671823812`, 0.04383535778027089`,   0.02154222889950937`, 0.006281152280129231`, 0.001492113602352463`,   0.0079325129446096`, 0.023577636442966645`, 0.044195700777166905`,   0.06443855291626631`, 0.0791726455592894`, 0.08472607856766434`,   0.07975580495584968`, 0.06553606471258311`, 0.045610580996740674`,   0.0249030750959836`, 0.008507481364097328`, 0.00045163413523252865`,   0.0027301058954676857`, 0.014833968423680205`,   0.033884515419259915`, 0.05533354561614951`, 0.07405894111973105`,  0.08559234035384577`, 0.08718681535608702`, 0.078472675688499`,   0.061548599298899026`, 0.04048931173627754`, 0.020388179378757657`,   0.006161200150237425`, 0.0013930272225909912`,   0.007493854962987713`, 0.023361795779632825`, 0.04562682130072909`,   0.06941749674225874`, 0.08947198471813836`, 0.10133748462752992`,   0.10238447666431386`, 0.0924069287274574`, 0.07367569127391442`,   0.05043690219956524`, 0.027971655343628703`, 0.011429494446618017`,   0.0046955642322033106`, 0.009540102126567813`,   0.025233271631062083`, .04870395299384845`, 0.07520186774030205`,   0.09931464269298464`, 0.11611806246510807`, 0.12221354284042608`,   0.11643545518106499`, 0.10008465443777788`, 0.07664648824951395`,   0.05105951324724025`, 0.028692550180028028`, 0.014244303123378665`,   0.010791123900980252`, 0.01917378839552417`, 0.03784184580594409`,   0.06317987096458702`, 0.09024321729842102`, 0.11375083606637972`,   0.1291346483996897`, 0.13343735028386566`, 0.1258838157458027`,   0.1080179786973901`, 0.08338356368455223`, 0.05681622331866127`,   0.03348933529492036`, 0.017901837073488223`, 0.013005632519217408`,   0.01964103546890816`, 0.03638742971125556`, 0.059854882638126314`,   0.0853566403436447`, 0.10782877955797118`, 0.12281593359315748`,   0.1273300195707255`, 0.12041455169350626`, 0.10330545634013014`,   0.07915899837109269`, 0.052402970906824456`, 0.027841942524897894`,   0.009696350336090289`, 0.0007687312281258732`,   0.0019054422134117427`, 0.011863439428043385`, 0.02761042633082383`,   0.044998917623994925`, 0.0596779835579238`, 0.06805619079404875`,   0.06811602801815296`, 0.05990714334444941`, 0.04560825929074557`,   0.029133703291304193`, 0.015353199348562014`, 0.009074375607003374`,   0.013989865520678902`, 0.031803812029883506`, 0.06172261938230317`,   0.10042704400882617`, 0.14254991938921568`, 0.18158393497377667`,   0.21105662334588893`, 0.22575257105691635`, 0.22274769290832974`,   0.2020509236272155`, 0.16671965853831489`, 0.1224134613324866`,   0.07645719594918586`, 0.03657921246993372`, 0.009554081538201524`,   0.`}


Using header files

I have a piece of code I keep using in new notebooks over and over again and I have to copy and paste it in each new notebook. Problem arises: if I update the code in one file I have to manually do it in all the other files. So I was wondering, is it possible to create one file, let's call it InitCode-7 July.nb, and use a command as an initialization cell in _Mathematica_ to load it? This way I would only have one file to change and it would apply to all the files where I use the same code. I am familiar with the concept of headers file in other programming languages but I have no idea how to do it in Mathematica. Thank you.


Solve a system of M equations without specifying M

**This post has been edited heavily in response to the comments: my initial question was very confusing.** I am trying to write my game-theoretic model in _Wolfram Language_. There is only one remaining step and I am not sure if it is within reach of _Wolfram Language_ (or _Mathematica_ ). I describe a simplified version of my problem below. # Cournot game There are $M$ firms. Each firm $i$ can produce some output $q_i\geq0$ at a cost of $c_i$ per unit. Once the firms have (simultaneously) decided on their outputs, the price is set in the market according to an inverse demand function $P(Q)=\alpha-Q$, where $Q=q_1+\ldots+q_M$ is the aggregate output and $\alpha>0$ is market size parameter. Firm $i$'s profits are $q_iP(Q)-q_ic_i=q_i(\alpha-q_1-\ldots-q_M-c_i)$. Each firm maximizes its profits taking outputs of the opponents as given. By differentiating the profit function with respect to $q_i$ and imposing the necessary condition for maximizing a function, I obtain the equilibrium outputs: $$q_i^*=\frac{1}{2}\left(\alpha-\sum_{k\neq i}q_k^*-c_k\right) \text{ for } i=\{1,\ldots,M\}.$$ A quick derivation on the piece of paper gives me the explicit solution: $$q_i^*=\frac{1}{M+1}\left(\alpha-Mc_i+\sum_{k\neq i}c_k\right)$$ **Here's the thing: I would like to obtain exactly this result (the above equation) in _Mathematica_. Is it possible?** Note: I don't want to substitute any numbers for $M, c_1, \ldots, c_M$ or $\alpha$. They are general, exogenous parameters. In other words, the above problem boils down to inverting a $M\times M$ matrix of the form: $$\left[\begin{array}{cccc} 2 & 1 & \ldots & 1\\ 1 & 2 & \ldots & 1\\ \vdots & \vdots & \ddots & \vdots \\ 1 & 1 & \ldots & 2 \end{array}\right].$$ Can one do this without specifying $M$? I hope I expressed myself clearer this time.


Defining a Unique Domain for Solving Diophantine Equations

I am working on a research problem in discrete geometry to do with sphere packings, and believe it or not, I have been able to reduce it to finding the solutions to the Diophantine equation, $$n = \frac{x + 2y + 3z}{2}, \text{ where $n,x,y,z \in \{1,2,3,4,5,6,7,8,9\}$}$$ In _Mathematica 8_ I have attempted to use the "FindInstance" command in order to find these solutions (there are a finite number of them), but I have no way to define the domain $\{1,2,3,4,5,6,7,8,9\}$, it only accepts "Reals", "Integers", etc. as a domain. Is there any way around this?               FindInstance[(x + 2 y + 3 z)/2 == 4, {x, y, z}, {1, 2, 3, 4, 5, 6, 7, 8, 9}, 10]      My idea would be to use that to find 10 instances of the solution, but the domain is undefined.


Profiler calls function without providing true arguments

I found Profile[] in the Mathematica workbench does not run on my function. To investigate, I provided a simple function,               In[]:= test[arg_] := (Print[arg]);          In[]:= Profile[test[1]]     Out[]=      1     1      This is as expected, only that the profiler called the function twice. However, after running my code, if I run the same test function again, I get               In[]:= test[arg_] := (Print[arg]);          In[]:= Profile[test[1]]     Out[]=      1     1     1     arg_     arg      Very strange that the profiler tries to call the function with arg_, instead of the given argument 1. And this is exactly the first error message I got when I use Profile to run my code. EDIT: I created an empty project and the above simple example does not make a mistake. Thus the problem should be some part of my code is incompatible with the Profiler... PS: my code is too long to be provided here. Just in case of an interest, it is at https://github.com/tririver/MathGR/tree/experimental               << MathGR/gr.m     Profile[Simp[t[DN@"a", DN@"a"]]]


Computing Slater determinants

I need to compute Slater determinants. I'm wondering if I would benefit from assigning each of my functions to a variable prior to computation. I'm working with Slater determinants, but my question goes beyond them and applies to the computation of any determinant. Say I have functions $f_n[x]$ which are sums of complex exponentials. If I want to compute the determinant of an $N\times N$ matrix, should I use the expanded form of $f_n[x]$ or variables ($a_1,a_2,b_1,b_2$, etc.), or else? Does _Mathematica_ benefit from prior "simplification" of the matrix or not? At the moment, I'm not concerned with speed because the systems I work with contain few electrons, but that will change.


How to calculate mix of 4 colors defined in CIELAB L*a*b* model?

I have 4 colors that I converted from RGB to CIELAB **L*a*b*** model.   1. How can I calculate mix of these 4 colors when I have `(L,a,b)` for each such color?   2. How can I calculate same mix, if I want to put weights `(w1, w2, w3, w4)` on such 4 colors, having 1 maximum and 0 minimum (none) weight?


How can I speed up SQL queries in Mathematica?

I have an application that queries a MySQL database many times for data. At the moment, Mathematica and MySQL are running on the same box and yet it takes over 1.6 seconds for the query to run and return a value. This feels very slow, and I was hoping somebody might give me counsel on how this might be sped up.               AbsoluteTiming[      SQLSelect[commodDB, "tbcommodprices", "price",          SQLColumn["ticker"] == "LAV05 Comdty" &&          SQLColumn["whichprice"] == "last" &&          SQLColumn["date"] == "2005-09-01"];]          {1.6093750, Null}


Is this function convex?

How can I determine convexity of the function `f = Log[ x, 1 + (x^a - 1) (x^b - 1)/(x - 1)]` with the parameters $a,\,b$ belonging to the interval $(0,1)$ in _Mathematica_?


Set gives an unexpected error message (Set::partw)

Here is a minimal example:               s = 1 /(a + b[3]) + 1 /(2 a + b[3]);     s[[1]] = Sum[s[[1]] /. b[3] -> k, {k, 3}]     s[[4]]     s[[4]] = Sum[s[[4]] /. b[3] -> k, {k, 3}]      Output:               Out[143]= 1/(1 + a) + 1/(2 + a) + 1/(3 + a)     Out[144]= 1/(2 a + b[3])      > Set::partw: Part 4 of (1/(1+a)+1/(2+a)+1/(3+a))+1/(2 a+b[3]) does not exist. > >>               Out[145]= 1/(1 + 2 a) + 1/(2 + 2 a) + 1/(3 + 2 a)      I could only make the error occur when using `Set`. As the above code shows, both `s[[4]]` and `Sum[s[[4]] /. b[3] -> k, {k, 3}]` are well defined. I have been struggling with similar errors for days, can someone please explain exactly what is happening behind the scenes?


Coefficient of determination (R squared) of EstimatedDistribution

I have estimated the distribution for a set of data as `LogisticDistribution[3.5, 1.037]`. How can I calculate and plot the coefficient of determination (R squared) with the PDF of the distribution? Here is the quantile-quantile plot: ![q-q plot](http://i.stack.imgur.com/esF2V.jpg)


How to draw a line (1D) with labeled subdivisions

I want to draw a simple line with some symbols, but so far have had no luck finding an easy way to do it in _Mathematica_. Does anyone know if _Mathematica_ can easily implement e.g. the example below? ![example](http://i.stack.imgur.com/lwbQp.jpg)


Update only one element in a dynamic grid?

I've got a grid of buttons that each display an image from an array. When a button is clicked, its image changes.               DynamicModule[{g = Table[Image[RandomReal[{0.5, 1}, {16, 16, 3}]], {19}, {19}]},       Grid[Table[With[{i = i, j = j},         Button[Dynamic[g[[i, j]]], g[[i, j]] = Image[RandomReal[1, {16, 16}]],           ImageSize -> Full, Appearance -> None]],         {i, 19}, {j, 19}], Spacings -> {0, 0}]]      The problem is that it is very slow. I presume this is because all the buttons get updated when only one is changed. This raises the general question as to how can you dynamically change only the control corresponding to the changed element in the list? I've already come up with a workaround for my particular problem:               DynamicModule[{g = Table[Image[RandomReal[{0.5, 1}, {16, 16, 3}]], {19}, {19}]},       Pane[ClickPane[Dynamic[ImageAssemble[g]],         (g[[19 - Floor[#[[2]]/16], Floor[#[[1]]/16] + 1]] =           Image[RandomReal[1, {16, 16}]])&],         ImageSize -> Full]]      This splices together a single image, works out where you clicked on it, then changes the appropriate element in the list. It doesn't answer the original question, but it's lots faster. ### Additional note: I'd quite like `g` to be available outside the grid. Then you could have multiple grids doing different things. Or some other view of the data.


Challenge: Speeding up MaxDetect for application in 3D blob detection

In image segmentation it is a common problem that objects appear clustered and are therefore undistinguishable from each other when using simple algorithms. Based on this post I obtained efficient ways to tackle the problem based on fast 3D distance transformation (`DistanceTransform3D`) and the usage of the _Mathematica_ built-in function `MaxDetect`. For details please have a look at the answer of UDB in the post. Consider two simple functions to generate a test `Image3D` containing sphere-like objects:               generateRandomObject3D[dim_, min_, max_] := Block[        {rdDim, rd, v, s1, s2},        rdDim = {RandomInteger[{min, max}], RandomInteger[{min, max}],           RandomInteger[{min, max}]};        rd = DiskMatrix[rdDim];        v = dim - 2 # - 1 & /@ rdDim;        s1 = # - RandomInteger[{1, #}] & /@ v; s2 = v - s1;        ArrayPad[rd, MapThread[List, {s1, s2}]]        ];          generateRandomImage3D[dim_, min_, max_, objNum_] := Block[        {},        Image3D[         Plus @@ Table[generateRandomObject3D[dim, min, max], {objNum}]]        ];          objects=generateRandomImage3D[64, 5, 5, 15];     colComps=Colorize@MorphologicalComponents@objects;      > ![bin](http://i.stack.imgur.com/C4bGM.png) > ![comps](http://i.stack.imgur.com/DWmvZ.png) Now we can identify the locations of the potentially clustered objects using a 3D distance transformation followed by `MaxDetect`.               AbsoluteTiming[MaxDetect[ImageAdjust@DistanceTransform3D[rand], 0.1]]      > {1.339987, ![enter image description > here](http://i.stack.imgur.com/7lJ1Q.png)} As you can see this operation already takes more than one second. If I check for the runtime of the individual steps, `DistanceTransform3D` needs about 1/4 of the time. Is there a faster way of doing this? The images I need to apply the algorithm to are much larger. Therefore, efficiency and runtime plays an important role in this case.


How to find regions that satisfy this inequality?

1. I am new to _Mathematica_ and would like to find the set $$\{ (x,y) \in \mathbb{R}^2: (3x+y\exp(xy))(x-a) + (6y + x \exp(xy))(y-b) < 0 \}$$ for some constants $a$ and $b$. How can I do this? **Added** : Is the set empty when a=-1.0643 and b=0.150?    2. My actual question may be more difficult. For this function $f:\mathbb{R}^2 \to \mathbb{R}$, defined as $$ f(x,y) := (3x+y\exp(xy))(x-a) + (6y + x \exp(xy))(y-b) $$ I would like to know its range $f(\mathbb{R}^2)$, or better yet $f(\mathbb{R}^2 - \{(a,b)\})$, or as close as possible. Can it be done in _Mathematica_ as well?


Add content to an existing .zip file

I have been looking over the .zip documentation from Mathematica (http://reference.wolfram.com/mathematica/ref/format/ZIP.html). It seems pretty straighforward to export and import from/to a .zip file, but how can i add content to an existing .zip file?


Parallel optimization of Markov Chain Monte Carlo

I'm trying to reduce the computation time of a MCMC simulation. Essentially I have a set of particles performing a random walk in a periodic random potential. The particles are independent and every 100 timesteps I perform some checks and modify the state of some of the particles. This seemed to me a perfect case to be optimized by parallelizing the simulation, but whatever I try I always make things just a little bit worse. Here is in short detail what I'm doing. First I define my random potential function U[x] as an interpolation over a simple discrete time random walk               rw[L_] := Accumulate[RandomVariate[NormalDistribution[0, 1], L]]     myrw = rw[100];     myrw = Rescale[myrw];     ifun = Interpolation[        Transpose[{Range[1, 200], Join[Reverse@myrw, myrw]}],         PeriodicInterpolation -> True];     U[x_] := ifun[x];      Here are the two functions needed to perform a single time step evolution of a particle on my potential (Metropolis-Hastings algorithm):               p[x_, prop_, T_] := Exp[-(U[prop] - U[x])/T];     MCMCEvo[x_, T_] :=      Module[{prop},       prop = RandomVariate[NormalDistribution[x, 0.1]];       Return[If[RandomReal[] < p[x, prop, T], prop, x]]       ]      Then I have a function that checks the state of the particles and with some probability modifies it and then performs 100 time steps of evolution for the whole population. It then returns the state of the particles as a function of this 100-time steps evolution.               PopulationEvolve[pop_, pdiv_, plife_] := Module[{newpop},       (*I leave this SomeFunctionOfTheStates here for the sake of completeness, but commenting it and setting newpop=pop doesn't change anything in the timings*)       newpop = SomeFunctionOfTheStates[#,pdiv,plife]&/@pop;       Return[(Join[{#[[1]], #[[2]]}, {Mean[U /@ #], Last[#]} &[NestList[MCMCEvo[#, 0.1] &, If[#[[2]] == 0, RandomReal[{0, 100}], #[[4]]],100]]])& /@ newpop]     ]      Then I generate 2 populations, one with 100 elements and one with 400 to perform some tests:               pop100 = Table[{1, 0, 0, RandomReal[{1, 100}]}, {i, 100}];     pop400 = Table[{1, 0, 0, RandomReal[{1, 100}]}, {i, 400}];      and try parallelized and unparallelized calculations (4-Cores i5-2.6GHz):               AbsoluteTiming[PopulationEvolve[pop400, 0.8, 1]][[1]]     AbsoluteTiming[Table[PopulationEvolve[pop100, 0.8, 1], {i, 4}]][[1]]     AbsoluteTiming[ParallelTable[PopulationEvolve[pop100, 0.8, 1], {i, 4}]][[1]]     0.952207     0.960080     1.088009      and these proportions doesn't change even if I make PopulationEvolve perform 1000 time steps instead of 100: in principle I would expect the ratios to change in favor of the parallelized version, since the ratio between data exchanged between the kernels and length of the computation changes.               (*With 1000 time steps*)     AbsoluteTiming[PopulationEvolve[pop400, 0.8, 1]][[1]]     AbsoluteTiming[Table[PopulationEvolve[pop100, 0.8, 1], {i, 4}]][[1]]     AbsoluteTiming[ParallelTable[PopulationEvolve[pop100, 0.8, 1], {i, 4}]][[1]]     9.723611     9.816607     10.676737      I'm not very experienced with parallel calculations but, since now, once I was sure that there was no interactions among the parallel calculations the only bottlenecks I've ever found were about passing too much data back and forth to the kernels, which doesn't seem to be the case in this example. What am I missing here and what would be a good way to parallelize this?


CCodeGenerate and calling external functions

Is it possible to use `CCodeGenerate` to generate code which calls functions from other C libraries? For example, I would like to do something like this:               CCodeGenerate[Compile[{{x}}, f[x]+1], "f1"]      where `f` is a function defined in some other library (which I would then link to the generated code). I tried to first make `f` available in _Mathematica_ via LibraryLink, but then `CCodeGenerate` issues a warning (`CCodeGenerate::wmreq`) and returns `$Failed`.


How to set focus of a dialog window?

I have a dialog, which, when pops up, requests input from the user. How can I set the window up that the focus is on the `InputField` of the new window (i.e. the caret stands in the `InputField`), so that when the user starts typing, it is immediately registered by the field? At the moment, I have to click inside the field first to make it the active control on screen.               DialogInput[{InputField["", String], Button["Ok", DialogReturn[]]}]


Composing an image with a plot

I'm trying to illustrate the solutions to a textbook problem dealing with quadratic functions. This will involve plotting a quadratic and overlaying the plot and the image. Here is the textbook scan.....![enter image description here](http://i.stack.imgur.com/La8Zs.jpg) The idea of the problem is to find several possible quadratic models that would go through the hoop. I imported this image into a variable, call it img1 I wanted to establish a "baseline" so I started with a simple plot, x intercepts of 0 and 18, and vertex at (9,14). I know, NOT a solution to the problem but I wanted to see how the plot and image would match up. I created the plot               g2 = Plot[-14/81 x (x - 18), {x, -1, 19}, PlotStyle -> Thick]      Then I put them together and tweaked the placement of the plot based on the image size.               ImageCompose[img1, g2, {983/2, 811/2}]      Which gives me this... ![enter image description here](http://i.stack.imgur.com/gvgpf.jpg) The vertex is in the right place, but the axes don't line up. Sorry if this is a dumb question, I'm not at all sure how I could get my plot to match the background image so the axes in the image would be the same as the axes in my plot.... Do I need to scale my plot, or scale my image.. or something obvious that I am missing. Any help is appreciated


How do you draw the plane on which two vectors lie?

Given two arbitrary vectors $\textbf{v}_1$ and $\textbf{v}_2$, how can I draw the plane which they span?


Interface C# STAThread

How do I convert a .NET STAThread into .NET/Link Mathematica code? Alternatively what would be the easiest way to compile and run the program below from within mathemaitca?               using System;     using Wolfram.NETLink;     using System.IO;     using System.Drawing;     using System.Windows.Forms;          public class File{      [STAThread]      public static void Main(String[] args) {         MathKernel k = new MathKernel();         k.Compute("ExportString[Graphics[Circle[]],{\"Base64\",\"PNG\"}, Background -> None]");         string input = k.Result.ToString();              byte[] bytes = Convert.FromBase64String(input);          Stream stream = new MemoryStream(bytes);         IDataObject dataObject = new DataObject();         dataObject.SetData("PNG", stream);         Clipboard.SetDataObject(dataObject, true);       }     }      I am compiling it using the following code, in case anyone wants to try it out.               csc /target:winexe /reference:Wolfram.NETLink.dll File.cs


Customizing & finding intersection points in polar plot

I want to verify a theory stating that a golden mean spiral plotted on a polar graph will have intersection points at specific values. ![golden mean spiral plotted on polar graph](http://i.stack.imgur.com/ljuGi.png) There should be 8 concentric circles, each **at the same distance** as the previous one. The radial lines should be in 10-degree increments, and the spiral should start from `0` on the first circle in the middle and end on circle #8 at `360`. The golden mean spiral should progress independently of the grid lines. If all these requirements are met, `NSolve` should reveal where the intersection points are (the theory claims - 0deg at circle #1 - 120deg at circle #2 - 190deg at circle #3 - 240deg at circle #4 - 280deg at circle #5 - 360deg at circle #8). If the initial stretch of the spiral proves the theory wrong, trying to stretch the spiral between any 2 intersection points might do it. ![enter image description here](http://i.stack.imgur.com/Ii22f.png)


Stealth daylight saving shift in SQL data

I'm querying a SQL database with `DatabaseLink` and resulting `SQLDateTime` objects are shifted by an hour during daylight saving time. The dates are stored in the database without a DST shift, so it seems like Mathematica is applying the change. How can I eliminate the spurious shift? A workaround, such as getting `AbsoluteTime`-style integers instead of `SQLDateTime` expressions would be fine.


Multiplying expressions within a list of pure functions

Let's say I have a list of pure functions that are nice algebraic expressions: say               l = {(#1 - 1)&, (#1^2 + #1)&, (#1^3 - 1)&}      What's an easy way to get a pure function that will give the product of these expressions? For example, in the above I'd like to get a function f with               f = (#1 - 1)(#1^2 + #1)(#1^3 - 1)&      I've tried `(Times @@ Identity @@@ l)&`, but this just gives `(#1 - 1)(#1^2 + #1)(#1^3 - 1)`. Essentially, it seems my difficulty is converting a `List` of `Function` expressions to a `Function[Times[...]]` expression, and I can't see how to "strip off" the functions without messing up the referencing of the `Slot[1]` expressions inside. Thanks for any help.


Mathematica program for PLUR decomposition of a symbolic matrix using full pivoting

I wanted to ask if there is a Mathematica program for PLUR decomposition of a symbolic matrix M, such that M = P*L*U*R, using FULL (row and column) pivoting, and where R = reduced row echelon form of M. The entries of the matrix M are rational numbers, floating point numbers and symbolic expressions.


What is the definition of FitResiduals

What is the definition of `FitResiduals` in Mathematica? I could not find its definition in the Mathematica help. Is it the same as chi squared?


NMinimize usage

I would like to minimize functions including the following.               NMinimize[{1 - (1 - 1/n)^x - x/n, n > x, x > 1}, {n, x}]      However _Mathematica_ complains about values not being real. How should I do this?


Comparison Operation for Nested Matrices

I have a nested matrix `n` as bellow               n = {{a, b}, {c, d}}     a = {{0, t, q, dh}, {0, 1, 0, th}, {1, 0, 0, sh}}     b = {{0, t, q, dh}, {0, 0, 0, th}, {0, 0, 1, sh}}     c = {{0, t, q, dh}, {1, 0, 1, th}, {0, 0, 0, sh}}     d = {{0, t, q, dh}, {0, 1, 0, th}, {1, 0, 0, sh}}      ![enter image description here](http://i.stack.imgur.com/4TsWq.png) containing letters and numbers. I am going to do a particular operation in each row yielding the result shown bellow: ![enter image description here](http://i.stack.imgur.com/zQT7u.png) > >      {{{{0, t, q, dh}, {0, 1, 0, th}, {1, 0, 1, sh}}}, >       {{{0, t, q, dh}, {1, 1, 1, th}, {1, 0, 0, sh}}}}M >


Delay of events detection dependent of "MouseDown" position

Let's say we have a `Rectangle` with color which depends of `CurrentValue["MouseOver"]`:               Deploy@Framed@Graphics[            Dynamic @ {If[CurrentValue["MouseOver"], Red, Green], Rectangle[]}            , ImagePadding -> 10]      ![enter image description here](http://i.stack.imgur.com/nLw4h.png)   * With cursor over the `Rectangle[]` the color switches to `Red` as expected,   * also if one put the `"MouseDown"` and drag it around it is still `Red`,   * however if you put the `"MouseDown"` outside the rectangle, on the padded area, and drag it to the rectangle **it will not switch the color till`"MouseUp"`**. **Is there any way to avoid such behaviour in general?** I can create some workarounds for particular situations but I'm looking for a general solution. I was thinking about `EventHandler`'s `PassEvents` options but it seems it is a deeper problem ( _I've failed with this approach :)_ ). * * * It looks like the problem is the `"MouseDown"` event is blocking some functions, for example:   * `Dynamic@CurrentValue["ControlKey"]` is not working while the mouse button is down.   * I've faced it before with `MouseAppearance`: Problem MouseAppearance updating while “MouseDown”


How to copy text from InputField

The problem when you copy text from one InputFiled to another. Inserts in unnecessary places gap. For example copy the text "#bbb" (without the quotes) from one field to another get "# bbb" (without the quotes).


Importing multiple files using a for-loop

once again I am stuck solving a seemingly easy problem :( I would like to make a List of tables by importing data from several txt- Files. Importing the data into a table works so far and I am able to do ListPlots etc. The txt-file-names follow a simple pattern: `txtFile_1.txt, txtFile_2.txt, ...` **My take on the problem is the following:**                   testList = List[1, 2, 3, 4]         For[i = 1, i < 4, i++             testList[[i]] =             Import["C:\\txtFiles\\txtFile_" <> ToString[i] <> ".txt" <>               ToString[i] <> ".txt", "Data"];          ]      _Background:_ I would like to have the tables in the list to be able to access them via `testList[[i]]` and in order to do consecutive ListPlots via a `for`-loop etc...


Label points in plot with a text

I'm a newbie at Mathematica and I couldn't find how to label the maximum and the zero of a simple function in `Plot` with their names:               rho[r_] = 1 - r^2;     Plot[rho[r], {r, -1, 1}, AxesLabel -> {r, \[Rho]}]       and i want to show the maximum on the plot with               Subscript[\[Rho], c]      and the point rho[1] with               Subscript[R, TF]


Plot a 3D vector field from a file

I have a data file with six columns {x,y,z} and {ux,uy,uz} respectively, and I would like to plot the 3D vector field. http://www.mediafire.com/download/udoa61hu0m6itrc/campo.txt I'm trying to do this,               te = Import["C:\\Users\\oliver\\Documents\\campo.txt",                  "Table", "IgnoreEmptyLines" -> True];     x = te[[All, 1]];     y = te[[All, 2]];     z = te[[All, 3]];     ux = te[[All, 4]];     vy = te[[All, 5]];     wz = te[[All, 6]];     point = Transpose[{x, y, z}];     vel = Transpose[{ux, vy, wz}];          ListVectorPlot3D[Transpose[{point, vel}], PlotRange -> Full,VectorPoints -> All]       The vector field must be as this picture, http://www.mediafire.com/download/9ddgux4ralx712k/1.jpg ![enter image description here](http://i.stack.imgur.com/2Ltcp.jpg)


Can I improve the importing speed of Excel data?

I have data in an Excel spreadsheet that has 4 rows and 1,000 columns. I am using `Import` as follows:               fittedMatrix  = Table[          Import["sheet.xlsx", {"Sheets", "MC", #, i}] & /@ Range[2, 5],           {i, 2, 1001}     ]; // AbsoluteTiming      which is importing on a column by column basis -- a thousand imports per spreadsheet. Is there a way to import row by row basis? Hopefully, this would improve the speed of import. Or would it be better to transpose my data within Excel first? EDIT: I tried transposing within Excel first to get dimensions of 1,000 x 4 and tried again using:               fittedMatrix=Table[          Import["sheet.xlsx",{"Sheets","mcTransposed", #,i}] &/Range[2,1001],             {i,2,5}     ];//AbsoluteTiming        but now it is giving:               {{1/2 (Import[sheet.xlsx,{Sheets,mcTransposed,#1,i}]&),       1/3 (Import[sheet.xlsx,{Sheets,mcTransposed,#1,i}]&),       1/4 (Import[sheet.xlsx,{Sheets,mcTransposed,#1,i}]&),       1/5 (Import[sheet.xlsx,{Sheets,mcTransposed,#1,i}]&),       1/6 (Import[sheet.xlsx,{Sheets,mcTransposed,#1,i}]&),       1/7 (Import[sheet.xlsx,{Sheets,mcTransposed,#1,i}]&),       1/8 (Import[sheet.xlsx,{Sheets,mcTransposed,#1,i}]&),       1/9 (Import[sheet.xlsx,{Sheets,mcTransposed,#1,i}]&),       1/10 (Import[sheet.xlsx,{Sheets,mcTransposed,#1,i}]&),       1/11 (Import[sheet.xlsx,{Sheets,mcTransposed,#1,i}]&),        instead of my actual Excel data?


NonLinearModelFit with Two Dimensional List of Weights

I'm currently trying to fit Planck's law (`B[λ, T]`) to measurements, thereby determining Planck's constant. I have a list of triplets containing wavelength, temperature and measured intensity and a list of triplets with their errors, like:               datalist  = {{λ1, T1, B1}, {λ2, T2, B2}, ...}         errorlist = {{σλ1, σT1, σB1}, {σλ2, σT2, σB2}, ...}      Although `NonlinearModelFit` can fit functions of the type `R2 → R`, it seems to only accept a one dimensional list as `Weights`. This is what I tried:               NonlinearModelFit[datalist, B[λ, T], {{h, hlit}}, {λ,T}, Weights -> (errorlist)^-2]      I could of course propagate the partial uncertainties to create one uncertainty for each triplet, thereby have a one dimensional `Weights` list instead, but it seems a bit unethic. Would it be possible to fit Planck's curve to my measurements without having to combine the errors first? **Edit** : Here's the exact error message that I get: > NonlinearModelFit::wts: The value of option Weights -> > {{100.,100.,2500.},{11.1111,25.,25.},{11.1111,2.77778,11.1111}} should be a > list of real numbers or a pure function. >> (I used this data and function as an example: http://pastebin.com/pqxDfe4u)


What is the fastest way to get a list of subexpressions and their positions?

I have spent quite some time trying to figure out what the fastest way is to get a list lists of all subexpressions and their positions. I have tried things with MapIndexed, which seems ideal in cases where we have an expression in which no functions with Hold-Attributes are present that we can let evaluate freely. For Held expressions, however, I found using MapIndexed complicated and I was unable to get a practical solution using this. Furthermore, I have tried things with Extract and Position. All these things were hinted at in the comments of/answers to the positionFunction question by Mr.Wizard, which caused me to be interested in this. Because I have spent time on this and because I feel this is quite a fundamental question, I would like to get some feedback. To be fair, I am also quite glad with my own answer, as it is considerably faster than the alternatives I found (although it took me a long time), but if there are better alternatives I would be even gladder to know. Lastly, it may be nice for me to refer to this Q&A later, if I ever write a good answer to Mr.Wizards question. **The question is** : What is the fastest way to get a list of lists of subexpressions and their positions, that works with held expressions?    **Test expressions** Let's make a big expression to do tests with. Let               body[i_][n_] := If[n < i, head[body[i][n + 1], body[i][n + 1]], 1];     tree12 = head[body[12][1]];     tree3 = head[body[3][1]];      We have               LeafCount[tree12] == 2^12 && LeafCount[tree3] == 2^3      > (True)


Problem with interpolation

I have a problem with the function interpolation. when I use it my points are all very shifted. Do you have an idea of the solution?               data = Import["EQE.txt", "Table", "HeaderLines" -> 3];     eqelambda = Table[{data[[n, 1]], data[[n, 5]]}, {n, Length[data[[All, 1]]]}];          h[x_] := hplanck*c/(x*10^-9)     f[x_] := Log[-Log[1 - x]]          data11 = h /@ eqelambda[[All, 1]];     data12 = f /@ eqelambda[[All, 2]];     data1 = Table[{data11[[n]], data12[[n]]}, {n, Length[data11]}];     intdata1 = Interpolation[data1];     ListPlot[data1]     Plot[intdata1[x], {x, 0, 1.8}]      Data files here: https://www.dropbox.com/sh/4ztzyv4zjwwlh1y/u1P_ELgBVA