How to localize the symbols x,y, A, B in the following program?

I see a example in Paul Wellin's _Programming with Mathematica An Introduction_ , 4th edition:               TruthTable[expr_, vars_] :=       Module[{len = Length[vars], tuples, rules, table,         head},       tuples = Tuples[{True, False}, len];       rules = Thread[vars -> #1] & /@ tuples;        table = Transpose@Join[Transpose[tuples], {expr /. rules}];head=       Append[vars,TraditionalForm[expr]];       Grid[Prepend[table /. {True -> "T", False -> "F"}, head],        Dividers -> {{1 -> {Thin, Black}, -1 -> {Thin, Black}, -2 -> {Thin,              LightGray}}, {1 -> {Thin, Black},            2 -> {Thin, LightGray}, -1 -> {Thin, Black}}},        BaseStyle -> {FontFamily -> "Times"}]];     Manipulate[      Module[{eqns = {(x - .5)^2 + y^2 < 1, (.5 + x)^2 + y^2 < 1},         c1 = {-.5, 0}, c2 = {.5, 0}},        Row[{(*IPM4`Chap05Functional`*)TruthTable[f[A, B], {A, B}],          Show[RegionPlot[f @@ eqns, {x, -2, 2}, {y, -2, 2}, Frame -> None,            PlotLabel -> f[A, B], PlotRange -> {{-2, 2}, {-1.2, 1.2}},            AspectRatio -> Automatic, MaxRecursion -> 5],           Graphics[{Circle[c1], Circle[c2], Text["A", {-0.75, .5}],             Text["B", {0.75, .5}]}], ImageSize -> Small]}]], {{f, Xor,         "Logical function"}, {And, Or, Xor, Implies, Nand, Nor}},      SaveDefinitions -> True]      I try as: TruthTable[expr_, vars_] := Module[{names, showNames, len = Length[vars], tuples, rules, table, head}, tuples = Tuples[{True, False}, len]; rules = Thread[vars -> #1] & /@ tuples; table = Transpose@Join[Transpose[tuples], {expr /. rules}]; names = Map[ToString, vars]; showNames = Map[StringSplit[#, "$"][[1]] &, names]; head = Append[showNames, StringReplace[ToString@TraditionalForm[expr], MapThread[#1 -> #2 &, {names, showNames}]]]; Grid[Prepend[table /. {True -> "T", False -> "F"}, head], Dividers -> {{1 -> {Thin, Black}, -1 -> {Thin, Black}, -2 -> {Thin, LightGray}}, {1 -> {Thin, Black}, 2 -> {Thin, LightGray}, -1 -> {Thin, Black}}}, BaseStyle -> {FontFamily -> "Times"}]] Manipulate[ Module[{A, B, x, y, eqns, c1 = {-.5, 0}, c2 = {.5, 0}, lgrid}, eqns = {(x - .5)^2 + y^2 < 1, (.5 + x)^2 + y^2 < 1}; lgrid = TruthTable[f[A, B], {A, B}]; Row[{( _IPM4`Chap05Functional`_)lgrid, Show[RegionPlot[f @@ eqns, {x, -2, 2}, {y, -2, 2}, Frame -> None, PlotLabel -> lgrid[1, 1, 3], PlotRange -> {{-2, 2}, {-1.2, 1.2}}, AspectRatio -> Automatic, MaxRecursion -> 5], Graphics[{Circle[c1], Circle[c2], Text["A", {-.9, .25}], Text["B", {.9, .25}]}], ImageSize -> Small]}]], {{f, Xor, "Logical function"}, {And, Or, Xor, Implies, Nand, Nor}}, SaveDefinitions -> True] It works. But I wonder any better solution?


Parametric plot from two NDsolve solutions

I have two independent ODE systems.               A = NDsolve[..., {x, y}, {t, 0, 10}];     B = NDsolve[..., {a, b}, {t, 0, 10}];      I can draw a `ParametricPlot` from one ODE. That is,               ParametricPlot[Evaluate[{x[t], y[t]} /. A], {t, 0, 10}]      I wonder if I can draw a `ParametricPlot` from the two independent ODE systems. That is a `ParametricPlot` of `x[t]` taken from A and `a[t]` taken from B.


Reproducing the Integral Definition of the Modified Bessel function

I need to simplify some integral expressions in terms of special functions, such as the modified Bessel function of the first kind. See for example Eq. (5) on this page. Notice that the real expressions I am working with are somewhat more complex, but I thought it might be a good idea to start by reproducing some known expression with Mathematica. However, I am failing miserably. After searching on the internal help pages and the web, I thought that this expression may do exactly what I wanted:               Assuming[{m \[Element] Integers && z \[Element] Reals},       Integrate[Exp[z*Cos[x] ]*Cos[ m * x], {x, 0, Pi}]]      But it simply outputs the same integral again. What am I doing wrong? Why does it not output the result in terms of the Bessel function?


Directional derivative of SiegelTheta

I'm working on a problem where I have to integrate both the Mathematica function SiegelTheta and some of its second order directional derivatives. Using the function works well but something goes wrong when I try to differentiate it. What I want to do is to take the second order derivative with respect to the vector $s$ in SiegelTheta[$\Omega$,s] and then dot it twice with the vectors (1,0),(1,0) or (0,1),(0,1). I want $s$ to be a two- component vector and $\Omega$ to be the matrix > $$\Omega(x,y,z) = \frac{i\sqrt{1/z - 1}}{\pi}\begin{pmatrix} (1 - y) & > (-1+x+y) \\\ (-1+x+y) & (1-x) \end{pmatrix}.$$ and after differentiating I want to let $s\to0$. Since I don't know how to take the derivative with respect to a vector I've tried doing it component- wise, using               S[Omega] = D[SiegelTheta[Omega,{s1,0}],{s1,2}]/.t1->0      and similarly for the derivative with respect to the second component of $s$. My problem is that I can't get the resulting function to take numerical values, even when evaluating it in a single point such as $(0.5,0.5,0.5)$. Upon integrating it I also get an error message saying the integrand takes non-numerical values in the whole region $x\in[0,1],y\in[0,1-x],z\in[0,1]$. To be more specific regarding the integration what I've tried using is               NIntegrate[S[Omega[x,y,z]],{x,0,1},{y,0,1-x},{z,0,1}].      My question is thus this: Do I have to somehow specify before taking the derivative that I want $\Omega$ to be a $2\times 2$ matrix and $s$ a vector with two components, and in that case how do I do that? Also, is there something happening during the differentiation that I'm not aware of that stops the function from taking numerical value? And is there something wrong with my approach to the integration? I'm far from an expert on Mathematica and would appreciate any help I could get.


What is a good way to plot some difficult implicit equations?

Here are several equations, it seems that Mathematica couldn't plot them well, although I set PlotPoints>100                ContourPlot[Csc[1. - x^2] Cot[2. - y^2] - x*y == 0,         {x, -10, 10}, {y, -10, 10}, PlotPoints -> 120]      ![enter image description here](http://i.stack.imgur.com/LwOZ0.jpg) I tried               cf = Compile[{{d, _Real}},         Do[If[Abs[Csc[1. - x^2] Cot[2. - y^2] - x y] < 0.02,           Sow@{x, y}], {x, -10, 10, d}, {y, -10, 10, d}],         CompilationTarget -> "C", Parallelization -> True,         RuntimeOptions -> "Speed"];               Graphics[{AbsolutePointSize@1, Point@Reap[cf[0.002]][[2, 1]]}]      but I don't know how to join the points. Is there other better method do it? ![enter image description here](http://i.stack.imgur.com/lkORL.jpg)


Summation of If statements

The following made me curious. Suppose you want to sum the if statement `If[x[i] < 1., x[i]^2, 0.]` over `i=1,2`, i.e.               Sum[If[x[i] < 1., x[i]^2, 0.], {i, 1, 2}].       Mathematica returns               If[x[1] < 1., x[i]^2, 0.] + If[x[2] < 1., x[i]^2, 0.].      Notice the `i`'s if the statement is true. However, I thought a more "natural" representation of the sum should look like               If[x[1] < 1., x[1]^2, 0.] + If[x[2] < 1., x[2]^2, 0.].      Does anybody can enlighten me on this one? Thanks in advance.


Derivative of Interpolating Function

Let's assume that Sol is the solution of NDSolve, given as an InterpolatingFunction               f     InterpolatingFunction[{{0.,10.},{0.,100.}},<>]      If I want to plot it, for a fixed x, it is sufficient to write               Plot[f[0,t],{t,0,T},PlotRange->All,Frame->True]      Why, if I want to define the partial derivative of f, I cannot use the following code?               GradTheta[t] = D[f[x, t], x]          ReplaceAll::reps: {InterpolatingFunction[{{0.,10.},{0.,100.}},{3,10,1,{25,103},{6,4},0,0,0,0},<<1>>,{Developer`PackedArrayForm,{<<1>>},{<<1>>}},{Automatic,Automatic}]} is neither a list of replacement rules nor a valid dispatch table, and so cannot be used for replacing. >>


Solving $k\log(n) - k\log(k) \leq u$

How can I persuade _Mathematica_ to help me find solutions to the inequality $k\ln(n) - k\ln(k) \leq u$ over the reals, assuming $u \geq n \geq k \geq 1$. When I evaluate               Reduce[{k*Log[n] - k*Log[k] <= u, u > n, k > 1, n > k}, k, Reals]      _Mathematica_ can't find a solution. However, $k=2, n=e^2, u = 8$ is a solution, for example.


Problem when merging cells including commentary

This is a more of a problem report than a question. When merging the two cells Cell1:               foo     (*foobar*)     bar      and Cell2:               foobar      the line immediately before the comment together with the comment line embark on a journey into another universe, leaving nothing behind than a vicious red box and the farewell greeting "A RowBox with an invalid first argument was encountered. The first argument to RowBox must be a list." _Mathematica_ 9


Adding elements to a collection of lists

I would like to add element `a` at the start of a series of lists. For example I have a collection of lists called               LISTS1 = {{1,2,3,4,5,},{2,3,4,5,6},{3,4,5,6,7,},{4,5,6,7,8,}}      Now I want to add a `0` to the beginning of the first list, two `0`s to the second list and so on, to get:               {{0,1,2,3,4,5,},{0,0,2,3,4,5,6},{0,0,0,3,4,5,6,7,},{0,0,0,0,4,5,6,7,8,}}.      I suspect this needs to be done using the `Prepend` command in combination with something to change the numbers of elements to add for each individual list in the collection.


2D Heat equation: inconsistent boundary and initial conditions

I'm attempting to use NDSolve on a 2D boundary value problem with initial conditions. Upon running my code, I get the following message: _"NDSolve::ibcinc: Warning: Boundary and initial conditions are inconsistent."_ After much head-scratching, I can't seem to find my mistake. It seems to me that my initial condition is consistent with my boundary conditions:               k = 1 / (5*(Pi^2));     soln = NDSolve[       {       (* PDE *)       D[u[x, y, t], t] == k*(D[u[x, y, t], x, x] + D[u[x, y, t], y, y]),            (* initial condition *)       u[x, y, 0] == y + Cos[Pi*x] Sin[2*Pi*y],            (* boundary conditions *)       u[x, 0, t] == 0,       u[x, 1, t] == 1,       (D[u[x, y, t], x] /. x -> 0) == 0,       (D[u[x, y, t], x] /. x -> 1) == 0       },      u,      {x, 0, 1},      {y, 0, 1},      {t, 0, 1}      ]      Any advice is greatly appreciated, Rick


Why FieldSeparators is printing a lot of quotation marks instead of just spaces?

In the following code `"FieldSeparators"->" "` prints a lot of quotation marks in the output file, instead of just spaces. What's wrong with it?               SetDirectory[NotebookDirectory[]];     s = 30; sy = s;     nmin = 0; nmax = 3; xmin = 0; xmax = 3;          out = Flatten[             Table[{N[n] // ToString[PaddedForm[#, {6, 5}, NumberPadding -> {" ", " "}]] &,                    N[x] // ToString[PaddedForm[#, {6, 5}, NumberPadding -> {" ", " "}]] &,                     N[BesselJ[n, 3 x]] /. {                       Indeterminate -> "nan", ComplexInfinity -> "nan", Infinity -> "inf"} //                       ToString[ PaddedForm[#, {6, 5}, NumberPadding -> {" ", " "}]] &},                   {n, nmin, nmax, (nmax - nmin)/(s - 1)},                    {x, xmin, xmax, (xmax - xmin)/(sy - 1)}], 1];          $file = OpenWrite["bessel.txt"];           Export[$file, out[[1 ;; s]], "Table", "FieldSeparators" -> " "];          For[ i = 2, i <= s, i++,           WriteString[$file, "\n\n"]                Export[$file, out[[1 + (i - 1)*s ;; i*s]], "Table", "FieldSeparators" -> " "]]          Close[$file];


To obtain an equation for a given curve

I have obtained the graph, ![enter image description here](http://i.stack.imgur.com/zF1jj.jpg) I would like to know its equation. The graph seems to be a hyperbolic spiral which, its equation reads, $r = a/\theta$. I read here and also, but these are concerning the Cartesian coordinate system. How could one implement these methods for my case, i. e. the polar coordinate system? ### Edit (1) Here is the code:               ParametricPlot[       {Im[(4.85263 + I 1.15883) Exp[(-0.455 + I 1.099) t] +            (-2.21527 + I 2.36121) Exp[(0.455 + I 1.099) t] +            (-2.35438 + I 1.36651) Exp[(0.455 - I 1.099) t] +            (0.717016 - I 0.836553) Exp[(-0.455 - I 1.099) t]],         Im[(4.85263 + I 1.15883) (-0.455 + I 1.099) Exp[(-0.455 + I 1.099) t] +            (-2.21527 + I 2.36121) (0.455 + I 1.099) Exp[(0.455 + I 1.099) t] +            (-2.35438 + I 1.36651) (0.455 - I 1.099) Exp[(0.455 - I 1.099) t] +            (0.717016 - I 0.836553) (-0.455 - I 1.099) Exp[(-0.455 - I 1.099) t]]},        {t, 0, 4.47}]      ### Edit (2) Actually, by the above approach, I would like to obtain an explicit equation from some given parametric equations. I do not know whether there exist other approaches or not.


Using least independent rectangle area to separate every point

## Description I want to add vertical line and horizonal lines between data to make every point have an independent rectangle area. In addtion, every independent rectangle has a number $1,2,3,4,5,\ldots$ ## Algorithm I have a method that adds a line between two points to separate them. However, it will yield many rectangles`(as the Kuba's answer shows)`. So I add a condition that _if the coordinate difference of two adjacent points is less than Δ, the line between them will be deleted._ Using this condition to reduce the number of rectangles. The ideal result would appear as shown below: ![enter image description here](http://i.stack.imgur.com/PGSpt.png) ## My method for use with a large data set **_Function GridLineData_** (yield the coordinate of line that between two points)               GridLineData[data_List, Δ_] := Block[      {sortData, length, OriginData, deleteData},       sortData = DeleteDuplicates@(Sort@data);       length = Length@sortData;       OriginData =         Append[           Prepend[sortData, 2 sortData[[1]] - sortData[[2]]],          2 sortData[[length]] - sortData[[length - 1]]];       deleteData =          List /@ (First /@ Select[          Thread[List[Range[length - 1], Differences@sortData]],         #[[2]] < Δ &]) + 1;       Delete[Total@#/2 & /@ Partition[OriginData, 2, 1], deleteData]     ]      **_Function GridNumber_** (yield the number that in one direction of point)               GridNumber[data_List, Δ_] := Block[        {length, intervalData},        length = Length@GridLineData[data, Δ] - 1;        intervalData =         Interval /@ (Partition[GridLineData[data, Δ], 2, 1]);        First@Pick[Range@length, IntervalMemberQ[intervalData, #]] & /@ data     ]      **_Function Grid2DNumber_** (yield the number that in two directions of point)               Grid2DNumber[data_List, Δx_, Δy_] := Block[      {xGridNumber, yGridNumber},       xGridNumber = GridNumber[data[[All, 1]], Δx];       yGridNumber = GridNumber[data[[All, 2]], Δy];       Thread[List[xGridNumber, yGridNumber]]     ]      **_Function FinalNumber_** (yield the number of point )               FinalNumber[data_List, Δx_, Δy_] := Block[      {length},       length = Length@GridLineData[data[[All, 1]], Δx] - 1;      (#[[2]] - 1) length + #[[1]] & /@        Grid2DNumber[data, Δx, Δy]     ]      **_Function ResultShow_**                 ResultShow[data_List, Δx_, Δy_,imageSize_, plotRange_, axes_] := Block[        {xGridLineData, yGridLineData},       xGridLineData = GridLineData[data[[All, 1]], Δx];       yGridLineData = GridLineData[data[[All, 2]], Δy];       ListPlot[           data, GridLines -> {xGridLineData, yGridLineData},           GridLinesStyle -> Directive[Red, Dashed], Axes -> axes,           AxesStyle -> Arrowheads[.02], ImageSize -> imageSize,            PlotRange -> plotRange,           AxesLabel -> (Style[#, FontFamily -> Times, 15, Italic] & /@ {"x", "y"}),           Epilog -> Style[Text @@@Thread[List[ FinalNumber[data, Δx, Δy], data]], Pink]          ]      ]      **Running**                 data= {{0.028, 0.}, {-0.02, 0.}, {0.024, 0.}, {0.02, 0.}, {0.016, 0.}, {0.012, 0.},         {0.008, 0.}, {0.004, 0.}, {0., 0.}, {-0.004,  0.}, {-0.008, 0.}, {-0.012, 0.},          {-0.016, 0.}, {-0.02, 0.01}, {-0.02, 0.0025}, {-0.02, 0.005}, {-0.02, 0.0075},         {-0.044, 0.01}, {-0.020587, 0.013708}, {-0.022292, 0.017053}, {-0.024947,0.019708},         {-0.028292, 0.021413}, {-0.032, 0.022}, {-0.035708, 0.021413},{-0.039053,0.019708},         {-0.041708, 0.017053}, {-0.043413,0.013708}, {-0.044, -0.022}, {-0.044, 0.006},          {-0.044, 0.002}, {-0.044, -0.002}, {-0.044, -0.006}, {-0.044, -0.01},          {-0.044,-0.014}, {-0.044, -0.018}, {0.028, -0.022}, {-0.0395,-0.022},          {-0.035, -0.022}, {-0.0305, -0.022}, {-0.026, -0.022}, {-0.0215, -0.022},         {-0.017, -0.022}, {-0.0125, -0.022}, {-0.008,-0.022}, {-0.0035, -0.022},          {0.001, -0.022}, {0.0055, -0.022}, {0.01, -0.022}, {0.0145, -0.022},         {0.019,-0.022}, {0.0235, -0.022}, {0.028, -0.018333}, {0.028, -0.014667},          {0.028, -0.011}, {0.028, -0.0073333}, {0.028, -0.0036667}, {-0.026706, -0.010328},         {-0.034728, -0.012831}, {0.018467, -0.012376}, {-0.033672, -0.0044266},          {-0.024279,0.011578}, {0.019797, -0.0054822}, {-0.038043, -0.013453},          {0.018601, -0.015411}, {-0.032133, 0.017284}, {0.022207, -0.01367},          {0.02517,-0.015686}, {0.02067, -0.019352}, {0.02517, -0.019352},          {0.022473,-0.0077456}, {0.021436, -0.0024283}, {0.025436, -0.006095},         {0.025436, -0.0024283}, {-0.035176, -0.01611}, {-0.036746, -0.019366},         {-0.041246, -0.015366}, {-0.041246, -0.019366}, {-0.014588, -0.010238},          {-0.010401, -0.010522}, {-0.0059502, -0.010666}, {-0.001707, -0.01075},         {0.0027348, -0.010777}, {0.0069474, -0.010685}, {0.011809, -0.010525},          {0.015791, -0.010112}, {-0.031333, -0.011604}, {-0.034199, -0.0089465},          {-0.034029, 0.0073707}, {-0.019569, -0.0096572}, {-0.023365, -0.0086418},          {-0.027463, -0.0060338}, {-0.030117, -0.0044689}, {-0.036952, 0.0042677},         {-0.03296, 0.011412}, {0.019397, -0.0083713}, {0.01274, -0.0065207},          {0.004545, -0.0070253}, {-0.0039107, -0.0070327}, {-0.012341, -0.0066635},          {-0.027235, -0.014212}, {-0.017628, -0.013516},          {-0.0081969, -0.01424}, {0.00069536, -0.01441}, {0.0099993, -0.014277},          {-0.037067, -0.0056532}, {-0.032986, -0.0011756}, {-0.033618, 0.0019697},          {-0.030062, 0.0019274}, {-0.029626, 0.0091141}, {-0.020326, -0.0053632},          {-0.026776, -0.0027828}, {-0.027211, 0.00041043}, {-0.026736, 0.010116},          {-0.040682, 0.0058344}, {-0.04027, 0.00043337}, {-0.04027, -0.0035666},         {-0.040797, -0.0080866}, {-0.040797, -0.012087}, {-0.025425, 0.015104},         {-0.028425, 0.017284}, {-0.036536, 0.015541}, {-0.039536, 0.013361},          {-0.040682,0.0098344}, {0.018361, -0.0030539}, {0.014361, -0.0030539},          {0.010379, -0.0034667}, {0.0063788, -0.0034667}, {0.0021662, -0.0035585},          {-0.0018338, -0.0035585}, {-0.0060769, -0.0034742}, {-0.010077, -0.0034742},          {-0.014264, -0.0031893}, {-0.018264, -0.0031893}, {0.025037, -0.012651},          {0.025037, -0.008984}, {-0.033431, -0.018744}, {-0.028931, -0.018744},          {-0.024304, -0.017468}, {-0.019804, -0.017468}, {-0.014824, -0.018048},          {-0.010324, -0.018048}, {-0.0058733, -0.018192}, {-0.0013733, -0.018192},          {0.0030686, -0.018218}, {0.0075686, -0.018218}, {0.012431, -0.018058},         {0.016931, -0.018058}, {-0.027843, 0.0035557}, {-0.027805,  0.0060751},          {-0.022061, -0.0021739}, {-0.024557, -0.0011545}, {-0.024953, 0.0045581},          {-0.022496, 0.0010194}, {-0.022496,  0.0035194}, {-0.022458, 0.0060387},          {-0.022458, 0.0085387}, {-0.024915, 0.0070774}, {-0.024991, 0.0020387},         {-0.024122, -0.0043477}, {-0.030694, 0.0050727}, {0.014861, -0.014117},         {0.0051372, -0.014437}, {-0.0037465, -0.014383}, {-0.012647, -0.014096},         {-0.022609,-0.012936}, {-0.031862, -0.015489}, {0.022073, -0.010635},          {-0.016529, -0.0063786}, {-0.0081538, -0.0069485}, {0.00033243, -0.007117},         {0.0087576, -0.0069335}, {0.016721, -0.0061079}, {-0.037363, 0.0096687},         {-0.028557, 0.013155}, {-0.037594, -0.010173}, {-0.036541, -0.0011333},         {-0.02943, -0.0012179}, {-0.030803, -0.0077199}, {-0.038491, -0.016732},         {0.022872, -0.0048566}, {0.02234, -0.016705}};            ResultShow[data, .0005, .0005, 800, {All, All}, {False, True}]      Yield ![enter image description here](http://i.stack.imgur.com/4ienB.png) ## Question As can be seen from the figure,some points share the same rectangle (are not independent as I require). So my question is _how can I modify my algorithm to achieve the effect of using least independent rectangle area to separate every point._


Demonstrating Ackermann's Function

The Ackermann function is an extremely fast growing function. There are some slightly different versions of the function, but the one that I am looking for can be defined as: $$ A_0(x)=x+1 \\\ A_{k+1}(x)=A_k^x(x) $$ where $A_k^i = \underbrace{A_k \circ \dots \circ A_k}_i$. It can be defined in `Mathematica` as,               A[0, 1, x_] := x + 1;     A[k_, 1, x_] := A[k - 1, x, x];     A[k_, i_, x_] := Nest[Function[y, A[k, 1, y]], x, i];      There might be faster implementations (I am looking for it too), but the above one works correctly. I want to demonstrate the function for a number of students and for myself so that it is understood deeply. How can I demonstrate how rapidly the Ackermann's function grows? Note that while computing the function for large numbers take a long time, there are fast lower bound for the function. For instance we know: $$A_0(x) = x + 1$$ $$A_1(x) = A_0^x(x) = 2x$$ $$A_2(x) = A_1^x(x) = x2^x \ge 2^x$$ $$A_3(x) = A_2^x(x) \ge \underbrace{2^{2^{{ ... }^2}}}_x = 2 \uparrow x $$ $$A_4(x) = A_3^x(x) \ge \underbrace{2\uparrow(2\uparrow\dots\uparrow(2\uparrow 2)\dots)}_x=2\uparrow\uparrow x$$


Numerical saddle point problem of a function of many variables

I want to find the following saddle point of the function of 10 variables: ![saddle_point](http://www.zaslike.com/files/2bc0lawbriuzydi6re38.png). I am not able to find the stationary points by setting the first derivatives to 0, so I need do optimize the function numerically. I think that that performing the above-mentioned optimization is equivalent to finding a set of {a1,a2,a3,a4,a5} that would maximize the following function:               InnerMin[a1,a2,3,a4,a5]:=NMinimize[f[a1,a2,a3,a4,a5,b1,b2,b3,b4,b5],{b1,b2,b3,b4,b5}]      That is how I would do the inner minimization, so I get the value of that function for the values of a1,a2,a3,a4 and a5 I provide as an input. Does anybody know how to find in practice a set of a1, a2, a3, a4 and a5 that would maximize the InnerMin function, or in the other words how to perform the outer optimization numerically (coupled with the inner minimization via the InnerMin function)?


EdgeRenderingFunction and Graph input output structure

I am trying to create an `EdgeRenderingFunction` but the `more information` does not help me at all as far as explaining what the mathematical structure of the input is and at what level , the number of @s, mathematica makes the function act and the mathematical structure of the output. I would like to be able to create a pure function that does:   * If the initial vertex is "j" then color should be "color[j]"   * If the end vertex is "k" then the thickness should be "Thickness[k]"   * If the relation is `"->"` then the label should be whatever" and position "somewhere", if the relation is `"-"` then the label should be "whateverelse" and position "somewhere else". Wolfram more information says: `EdgeRenderingFunction->g specifies that each edge should be rendered with the graphics primitives given by g[{ri..},{vi..},lbij], where ri , rj are the beginning and ending points of the edge,vi ,vj are the beginning and ending vertices, lbij the is any label specified for the edge. ` Typically, in math, if `"g"` is a function then `g[something]` signifies that the `"something"`is the **_input_** and `"g[something]"` is the **_output_**. But if `"ri"` are coordinates, `"vi"` are vertices and `"lb"` are labels then the `"something"`is intended to be the **_output_** of g[ ** _input_** ]. So I'm a bit confused by the "more information" and would appreciate some help here. My other questions are:   1. What is the mathematical structure of the input graph {1->2}? Someone showed me yesterday in chat but I have forgotten how to replicate it, that: `{1->2}` is collection of lists where the first list carries the vertices in order and the second list carries the direction in order. `{1->2} is stored as {{1,2},{Rule[1,2]}}`   1. what does this Rule look like? How can I write functions on this rule? Confusingly               (#2[[1]] &) @@ {{1, 2}, {"a"}}     a      But                (#2[[1]] &) @@ {1 -> 2}      2      but with an error message      On the other hand                (#[[2]] &) @@ {1 -> 2}      2      No errors.      So if a `Graph` is stored as a list of lists that I am atting `@@` at a second level then shouldn't I have found the Rule between 1 and 2?   1. How many `@@@` levels is mathematica gonna make my `edgerenderingfunction` act on to the input?


What are the most common (usual) ways to make palettes with non-trivial functionality?

What are the best (most robust and most convenient) ways to create palettes that can be installed permanently (using `Palettes -> Install Palette...`) and are safe to use? I'd be interested in how other people have done this in the past to learn more about idiomatic front end programming. I put some code illustrating the pattern I am using now at the end of this post. I'd appreciate some comments on it. **Notes and requirements:**   1. The palette should always work, regardless of whether the kernel has been quit or an evaluation is running.   2. The palette may have more than one button which share some code between them.   3. It must not pollute the `Global`` context or change the kernel state in a way that might break something unexpectedly.   4. I'm looking for an easy way to define palettes (minimal boilerplate code and extra work)   5. It would be nice (non-essential) if several versions of the palette could coexist independently (my current approach doesn't have this because it uses its own context to hide its function definition, but everything in this context is shared)   6. It would also be nice (non-essential) to integrate documentation in an easy way (help button bringing it up maybe?) * * * My current approach is illustrated below. It "localizes" its symbols by putting them in a separate context, and uses `DynamicModule` to ensure that all the definitions are done before any button code is run.               SetAttributes[paletteButton, HoldAll]     paletteButton[name_, tooltip_, func_, opt : OptionsPattern[]] :=       Tooltip[Button[name, Unevaluated[func], Appearance -> "Palette",         opt], tooltip, TooltipDelay -> Automatic]          Begin["SomePalette`"];          PaletteNotebook[      DynamicModule[{},       Column[{         paletteButton["One", "Button one", function[1]],         paletteButton["Two", "Button two", function[2]]         }],            Initialization :> (         function[x_] := MessageDialog[x]         )       ],      WindowTitle -> "Some Palette"      ]          End[];


Importing videos in Mathematica

Mathematica's `Import` command is purportedly able to import .AVI files. However, I find that many files that I want to import do only result in MMA showing a blank frame or another placeholder. All or some of my video-players are able to show these AVI files. This is an example where it works as advertised:               Import["http://er.jsc.nasa.gov/seh/jfkrice.avi", {"ImageList", 2}]      ![Mathematica graphics](http://i.stack.imgur.com/oarxf.png) However,               Import["http://people.sc.fsu.edu/~jburkardt/data/avi/ccvt_box.avi", {"ImageList", 2}]      doesn't work (VLC does). I get an empty white frame. More examples:               Import["http://people.sc.fsu.edu/~jburkardt/data/avi/sine_wave.avi", {"ImageList", 2}]      (works on VLC and mediaplayer classic)               Import["http://people.sc.fsu.edu/~jburkardt/data/avi/star_collapse.avi", {"ImageList", 2}]      **BIG-126 MB!!**   Should have looked like this: ![Mathematica graphics](http://i.stack.imgur.com/DZ32z.png) and works on Windows Media Player, VLC and mediaplayer classic, but I get a white box in MMA. This is on windows 7-64/MMA8.04. I have the k-lite codecs pack installed. * * * **UPDATE** Responding to Thomas' comment below I found most of the sample files I linked to in my original post gone. I tried to gather a new set and found some that worked and some that don't: Importable:               Import[#, "VideoEncoding"] & /@       {"http://er.jsc.nasa.gov/seh/jfkrice.avi",        "http://redmine.yorba.org/attachments/615/MVI_0572.AVI",       "http://www-eng-x.llnl.gov/documents/a_video.avi",       "http://redmine.yorba.org/attachments/628/MVI_4981.AVI",       "http://www.csoft.co.uk/video/original/earth.avi",       "http://www.mysticfractal.com/video/fp.avi",        "http://www.softage.ru/files/video-codec/uncompressed/suzie.avi",        "http://archive.org/download/Architects_of_Tomorrow/2007-12-10-02-39-00.avi"}      > {"msvc", "MJPG", "msvc", "MJPG", "msvc", "msvc", "YUV", "Uncompressed"} Don't import:               Import[#, "VideoEncoding"] & /@      {"https://code.ros.org/trac/opencv/export/7213/trunk/opencv/samples/cpp/tutorial_code/HighGUI/video-input-psnr-ssim/video/Megamind.avi",       "http://samples.mplayerhq.hu/avi/verona60avi56k.avi",       "http://samples.mplayerhq.hu/avi/filedoesitbetter.avi",       "http://www.infognition.com/ScreenPressor/browsing-divx.avi"       }      > {"XVID", "MP42", "MJPG", "DX50"}


How to receive the result of the integral $ \int\frac{1}{x}dx$ is $\ln|x|$?

When I input `\[Integral]1/x \[DifferentialD]x` in _Mathematica_ , I get `Log[x]`. How can I make the result of the integral $\displaystyle \int\dfrac{1}{x}dx$ to be $\ln|x|$?


Can kernel-specific variables be accessed from stylesheets?

I'm trying to create a modified version of the `Default.nb` StyleSheet that adds a docked cell to act as a status bar along the top of every notebook to display some basic information (user login name and login time, generated when my set of packages is loaded). My current implementation, which isn't functioning as I want it to, assigns the cell data I want to display in the status bar to a variable in the `Global` context:               $StatusBar = ToBoxes[Dynamic[Row[{           Item[            If[ValueQ[$PersonID],             Style[$PersonName <> " logged in at " <> $LoginTime,               Darker[Darker[Green]], FontFamily -> "Arial"],             Style["Not logged in!", Darker[Red], FontFamily -> "Arial"]             ]            ]           }],          TrackedSymbols :> {$PersonID, $PersonName, $LoginTime}]];      I've created a new stylesheet that inherits everything from `Default.nb`, but with modified Notebook Options Settings to add the desired `DockedCells` (I've omitted the non-relevant Options):               Cell[StyleData["Notebook"],           DockedCells->Cell[BoxData[$StatusBar]],           <...>     ]      Unfortunately, the `DockedCells` Option defined in the `StyleSheet` doesn't seem to recognize the `$StatusBar` variable I've created to populate it. All I get is a docked cell displaying `$StatusBar` (verbatim). I'm not sure if this is a context issue, an evaluation order issue, or something else altogether. It would be even more convenient if I could define the `$StatusBar` variable within the stylesheet so that it doesn't have to be recreated when my packages are loaded. However, I'm skeptical that this is possible. Is there any way to actually evaluate code within a StyleSheet?


How to expand all portions of an expression?

Consider a toy expression:               expr = Sin[x (a + b)]/(y (z + c))      I would like to expand all parentheses to get something like:               Sin[a x + b x]/(c y + y z)      I have been able to expand the argument of the `Sin` term using:               MapAll[Expand,expr]     (* Out[] = Sin[a x + b x]/(y (c + z)) *)      However, this leaves the denominator unexpanded. Is there a way to expand the entire expression?


How to display a different number of significant digits in each column of TableForm output?

Say I create a table with three columns of numbers. Is there a way to control the number of significant digits displayed in each column. To make this concrete, take the following command:               Table[{m, Sum[1/2.^n, {n, 1, m}], Sum[1./n, {n, 1, m}]}, {m, 1, 20.}] // TableForm      This produces the following table:               1   0.5         1.     2   0.75        1.5     3   0.875       1.83333     ...     18  0.999996    3.49511     19  0.999998    3.54774     20  0.999999    3.59774      The first column is fine as whole numbers, but I want the second column to have more decimal places, say, eight places, and the third column to have, say, four places. I tried putting one of the `Sum[]` functions inside the `N[]` function, but this had absolutely no effect. Is there another way to individually format each column of output?


Manipulating an equation into standard quadratic form?

Say I have an equation of the form $$u s + \frac{1}{v} + \frac{1}{p s + q} = 0$$ (or _any_ form that can be written as a standard quadratic, really, the above form is just an example; they'll all be equal to 0 from the start, however) and I want it in the form $$ s^2 + b s + c = 0 $$ i.e. the coefficient on $s^2$ is 1. How do I do this using Mathematica? More specifically, I'm interested in finding $b$ and $c$, but if the equation is written in this form, grouped properly, doing that is very easy by eye.


What is " (Dialog) Input [ ] := " after evaluating a cell?

I have done a time-consuming run and calculation. After many hours ( about 7 hours!), the black color which shows that the cell is evaluating, turn into gray and a strange text appears like this :               (Dialog) Input[157]:= (* my code in the cell *)      Does anyone know what it is and why this is happening ?!


Which Mathematica files may be deleted to save space

After installation Mathematica 8 for Linux takes more than 3GB in the /usr/local/Wolfram/ directory. I suspect that not all of it is relevant if I want to do some occasional computations. Are there subdirectories which can be deleted safely to save some space?


How to solve a system of partial differential equations?

Edit: since the upgrade to _Mathematica_ 10, this problem seems solved I just want to solve a system of partial differential equations, for example: $$ \left\\{ \begin{array}{l} \frac{\partial}{\partial a}[f(a, b, c)] = 4 \sin^2(b) \cos(c) \\\ \frac{1}{a} \times \frac{\partial}{\partial b}[f(a, b, c)] = 4 \cos(c) \sin(2b) \\\ \frac{1}{a \sin(b)} \times \frac{\partial}{\partial c}[f(a, b, c)] = -4 \sin(b) \sin(c) \\\ \end{array} \right. $$ And when I try to solve this system in _Mathematica_ , the output does not help:               In[1]:= DSolve[     {         D[f[a, b, c], a] == 4 Sin[b]^2 Cos[c],         (1/a) *D[f[a, b, c], b] == 4 Cos[c] Sin[2 b],         (1/(a Sin[b]))*D[f[a, b, c], c] == -4 Sin[b] Sin[c]     }, f[a, b, c], {a, b, c}]          Out[1]= DSolve[     {         Derivative[1, 0, 0][f][a, b, c] == 4*Cos[c]*Sin[b]^2,         Derivative[0, 1, 0][f][a, b, c]/a == 4*Cos[c]*Sin[2*b],         (Csc[b]*Derivative[0, 0, 1][f][a, b, c])/a == -4*Sin[b]*Sin[c]     }, f[a, b, c], {a, b, c}]      Obviously, this output is useless… Probably I doing something wrong… Thank you for your help Note : The solution is $f(a, b, c) = 4a \sin^2(b) \cos(c) + K$ (K : the integration constant).


Local variable names - Is there an easy way?

I apologize first, because this has been asked, like in Treat all variables as local in a module [duplicate] Variable scope similar to other languages But I don't get how to use them. Some codes in these answers don't work when I just copy-paste blindly (because I really don't understand them.) Are the above methods the standard way to "Treat variables as local by default (No need to specify them, like in Module)" in _Mathematica_? If so, please give me a working example, please. I think there should be a standard way to do this, but I can't find it in the documentation.


How to change a parameter dynamically inside NDSolve

I have no idea how to dynamically update a parameter inside `NDSolve`. For example consider following first-order DE:               Eq = x'[t] + (x[t] - λ) == 0;      where `λ` is a parameter. I want to solve this ODE but this parameter might change when `x'[t]` turns to zero:               WhenEvent[x'[t] == 0, λ -> x[t]].      I tried following code, but that doesn't work. Any idea?               λ = 1;     Eq = x'[t] + (x[t] - λ) == 0;     sol = NDSolve[{Eq, x[0] == 0,                    WhenEvent[x'[t] == 0., λ -> x[t]]                   }, x, {t, 0, 5}][[1]]


Remote kernel shuts down after several seconds

I have Mathematica 9 installed on two Windows Server 2008 R2 machines. Now i want to try using one of them as a frontend with local kernels and the other one for remote kernels. OpenSSH 6.5 for Windows is installed on both machines and key authentication is configured without a passphrase. SSH connection works normally. Here is the frontend configuration. In Preferences -> Parallel -> Remote Kernels i Add Host and use the custom launch command:               ssh -l username `1` "c:/progra~1/wolfra~1/mathematica/9.0/mathkernel.exe -mathlink -linkmode Connect `4` -linkname '`2`' -subkernel -noinit >& /dev/null &      For test purposes i set 2 remote and 2 local kernels in settings. After that in the notebook i try to call               Parallel`Settings`$MathLinkTimeout = 40     LaunchKernels[]      and launch Task Manager on both machines. At first two cmd windows appear and instantly close. Then i can see that two MathKernel.exe processes start on BOTH machines, but after nearly 20 seconds kernels shut down on remote machine. Local kernels stay running. After timeout i see an error output.               SubKernels`Protected`kernelFlush::time: Operation LinkWrite timed out after 40 seconds.     KernelObject::rdead: Subkernel connected through remote[1.1.1.1] appears dead. >>     SubKernels`Protected`kernelFlush::time: Operation LinkWrite timed out after 40 seconds.     KernelObject::rdead: Subkernel connected through remote[1.1.1.1] appears dead. >>     Out[9]= {KernelObject[7,local],KernelObject[8,local],$Failed,$Failed}      What am i missing? A solution would be greatly appreciated. Update: According to Szabolcs's comments i tried some other things.   1. My ssh command really had an open quote - removed.   2. Changed /dev/null redirections to ssh -f and -n keys.   3. Changed mathkernel.exe to math.exe in the path   4. Tried this solution. It works, so it's not a problem of connection or firewall. So now my ssh command looks like:               ssh -f -n user@remote_ip c:/progra~1/wolfra~1/mathematica/9.0/math -mathlink -linkmode Connect -linkprotocol TCPIP -linkname 'some_port@local_ip,some_port2@local_ip' -subkernel -noinit      And it doesn't work with the same behavior. When i try to run this command in the command line, math.exe starts on remote machine and then closes itself. After that on the local machine in the command line i see this message:               LinkConnect::linkc:     -- Message text not found -- (     LinkObject[some_port@local_ip,some_port2@local_ip, 3, 1])


Testing for arbitrary algebraic expression in given variable

I want to test, for example with `MatchQ`, if the argument of a function is an arbitrary expression in a single or several variables whose names can be assumed to be known. Except of these variables the expression should contain only numeric values. An approach would be to generate a list of unknowns in an expression and to compare this list to a given one. But I do not know either how to create that list for an arbitrary expression. By expression I mean a mathematical expression here. **Edit** Exampe:               (1-Exp[I*(x-5.6)*23.4])*Log[Abs[x-4.3]]/(1.7+3.2*I-x^2)      should be matched if I require it to be an expression in `x` and               (1-Exp[I*(x-y)*23.4])*Log[Abs[x-4.3]]/(1.7+3.2*I-x^2)      should not be matched in this case. Note that this does not mean that you can assume that the expression contains only these functions and rationals. My function               func[expr_?...,var]:=Module[{},...]      should evaluate only if the expression is e.g. of the first kind               func[(1-Exp[I*(x-5.6)*23.4])*Log[Abs[x-4.3]]/(1.7+3.2*I-x^2),x]


Basic question about Dynamic

Please consider the following:               InputField[Dynamic[X1], Number, Alignment -> Center];     InputField[Dynamic[X2], Number, Alignment -> Center];     Slider[Dynamic[Y1], {0, 200, 1}];     Slider[Dynamic[Y2], {0, 200, 1}];     Dynamic[FK, Dynamic[X1*(1 + Y1/100)]];     Dynamic[MK, Dynamic[X2*(1 + Y2/100)]];     Dynamic[HK, Dynamic[FK + MK]];     HeadTest = NumberQ[#] & /@ {X1, X2, Y1, Y2, FK, MK, HK}      Why would `FK`,`MK` and `HK` not have the head `Number`? (I guess I just did not understand how to use `Dynamic` and `DynamicModule`.)


Trouble avoiding computation in DynamicModule when input field is not defined

I'm having trouble detecting when my InputForm supplied String variable has a value. After looking at: How to compute values only if input fields are filled? I tried a StringQ test:               Clear[foo]     foo[t_] := If [ StringQ[t], {t, "defined"}, {t, "undefined"} ]          DynamicModule[{symbol},      Column[{        Row[{"Text field:", InputField[Dynamic[symbol], String]}],        foo[ Dynamic[symbol] ]        } ]      ]      Before the field is supplied this gives me what I expected: ![before field keyed](http://i.stack.imgur.com/uVCHv.jpg) but after keying the field, I see that my test hasn't worked: ![after keying text](http://i.stack.imgur.com/Uyj05.jpg) Based on How can I make sure all InputFields have values before processing a nb form? I tried:               Clear[foo]     foo[t_] := If [ !Equal[t, ""], {t, "defined"}, {t, "undefined"} ]          DynamicModule[{symbol = ""},      Column[{        Row[{"Text field:", InputField[Dynamic[symbol], String]}],        foo[ Dynamic[symbol] ]        } ]      ]      but this produces a kind of odd unevaluated If block: ![other try](http://i.stack.imgur.com/SuUlW.jpg) I'm clearly doing something wrong with how I'm testing or using the input variable or form, but it's not obvious to me what that is?


Non Commutative Multiply

> **Possible Duplicate:**   >  Non-commutative symbolic linear algebra I want to multiply two matrices, for example,               A = {{e, f}, {g, h}}     B = {{a, b}, {c, d}}      Using `A.B`, _Mathematica_ returns               {{a e + b g, a f + b h}, {c e + d g, c f + d h}}      I would like to get, however, the following result:               {{e a + f c, e b + f d}, {g a + h c, g b + h d}}      since, for me, the entries `{a,b,c,d,e,f,g,h}` are operators, i.e. they are non-commutative. I could solve this problem clearing the attribute `Orderless` in the built-in function `Times`:               ClearAttributes[Times, Orderless]      I know, however, this can be dangerous. I tried to define a function               Times2[a_,b_]:=Times[a,b]      and then use `ClearAttributes[Times2, Orderless]` but it doesn't work. How could I solve this problem? Thanks in advance


How to accelerate updating some parts of sparse matrices?

I am trying to update some parts of an specific matrix as rapidly as possible. In what follows, I first set up the basics things that I want to use               Clear["Global`*"]     SeedRandom[1234];     d = 300;     A = RandomReal[20, {d, d}];     n = Dimensions[A][[1]];     i = 1; num = 2;     Id = SparseArray[{{k_, k_} -> 1.}, {n, n}];     LU = LinearSolve[A];     mat = (1./(Norm[A, 2]^2))*ConjugateTranspose[A];     mat // MatrixPlot      wherein `Id`, denotes the Identity matrix, A is a dense input matrix, and then I wish to update the matrix `mat`, (which is an approximate inverse of the matrix `A`), by entering `num=2`, columns of the exact inverse that will be obtained by solving two linear systems (using `LinearSolveFunction`). To this end, I use the following piece of code, in which after obtaining the `num=2` columns of the matrix inverse, they must be replaced as the first and the second columns of the matrix `mat` at the end of each cycle of `While`: (please forgive me, if I write the codes in a very rough way!)               While[i <= num,       {ll = Id[[All, i]];        ith = Chop@LU[ll];        mat[[All, i]] = ith;        i++}       ];     mat // MatrixPlot      Considering the above dense matrix A, it works and can update the columns of the matrix `mat`. My problem is here, if I use a sparse matrix, then for low dimensions it works rapidly, while for higher dimensions it takes too much time to update the columns of the matrix `mat`. I mean, if we use the following matrix               A = SparseArray[{{i_, i_} ->       RandomReal[3], {i_, j_} /; Abs[i - j] == 1 -> RandomReal[2],     {i_, j_} /; Abs[i - j] == 8 -> RandomReal[1]}, {d, d}];      while `d=3000`. I would like to ask you experts about that: how we could accelerate (in terms of computational time) this process for dense and sparse matrices in a simple uniform piece of code? Any tip or help will be cheerfully thanked.


Mathematica rule substitution memory

First I present the specific programming question, and then I provide further background details. Given an expression in Mathematica, say `f=3x+7y`, there are two common ways to substitute information for `x` and `y`. The first is to use the `/.` rule, so something like                t=f/.{x->0,y->0};      would make the value of `t` equal to `0`. And the other is a more general substitution for `x` and `y` everywhere they appear, such as                x=0; y=0;      t=f;      This also makes the value of `t` equal to `0`. The difference in memory usage, however, becomes apparent with more complicated polynomials. I have uploaded a text file with a complicated polynomial to MediaFire : http://www.mediafire.com/?0ea3mhtqmc8c3r2 (it is about 4MB, and I'm not aware of a better way of sharing it). If you download it and then load it into Mathematica as I will demonstrate, you can see for yourself the significant memory loss: **Substitution Method**                In[1]:= << "/home/username/Downloads/p";      In[2]:= MaxMemoryUsed[]      Out[2]= 79833424      In[3]:= MemoryInUse[]      Out[3]= 76373112      In[4]:= t = p /. {x -> 0, y -> 0, z -> 0};      In[5]:= MaxMemoryUsed[]      Out[5]= 152124264      In[6]:= MemoryInUse[]      Out[6]= 112876080      **General Assignment Method**                In[1]:= << "/home/username/Downloads/p";      In[2]:= MaxMemoryUsed[]      Out[2]= 79831632      In[3]:= MemoryInUse[]      Out[3]= 75415960      In[4]:= x = 0; y = 0; z = 0;      In[5]:= MaxMemoryUsed[]      Out[5]= 79831632      In[6]:= MemoryInUse[]      Out[6]= 75420744      In[7]:= t = p;      In[8]:= MaxMemoryUsed[]      Out[8]= 112888664      In[9]:= MemoryInUse[]      Out[9]= 112875336      As you can see, during the substitution operation there was about 40MB of additional memory used to perform the substitution. The substitution method also takes much longer than the general method. The difference in the two methods becomes much higher (several GB) as the complexity of the polynomial increases, and ends up maxing out the available RAM. The problem is that for my program I cannot set `x, y, z` equal to zero in general. This seems to be an inefficiency with the way Mathematica performs substitutions. I would appreciate any suggestions for working around this problem. * * * **Further Background** The reason I cannot simply employ the general method is that the next step requires that I take derivatives of the original polynomial with respect to the variables `x, y, z`. The process would ideally be iterated as follows: Step 1: Given `p`, write the result of `p/.{x->0,y->0,z->0}` to a file. Step 2: Take derivatives of `p` with respect to `x, y, z`. Step 3: Perform some algebraic operations with the derivatives, creating the more complicated polynomials p1 and p2. Step 4: Repeat the process on each of p1 and p2. Since the process runs out of RAM when using the substitution rule, I have been working around this by performing several iterations of the process _without_ writing the output of `p/.{x->0,y->0,z->0}` to a file, and then applying the "General Assignment Method" (setting `x=0; y=0; z=0;` and writing the evaluation of each polynomial to a file). This is an unsatisfactory workaround, however, because it is impossible to know the proper number of iterations which will be required, and so it is possible that after performing all the iterations and writing the results to a file that I will need to run it again, this time performing more iterations. If the results could be written out to a file in the intermediate steps, I would be able to check them and determine if I should let the iteration continue or if I can stop it.


How to transfer my Mathematica Student licence from Linux to windows

I would like to ask if it is possible to transfer my windows licence to linux. I have already filled out system transfer form, but in the list of downloadable software I can see only windows version. Thank you for help.


Incorporating an additional graphics element when using Animate and ParametricPlot3D

I'm trying to animate some curves that wrap around a cylinder. OK so far:               Animate[ParametricPlot3D[{{Cos[α t], Sin[α t],      Sqrt[1 - α^2] t}, {Cos[α t],      Sin[α t], -Sqrt[1 - α^2] t}}, {α, -1, 1},      PlotRange -> {{-1, 1}, {-1, 1}, {-2 π, 2 π}}], {t, 0,      2 π}, AnimationRunning -> False]      But I'm struggling to incorporate the cylinder itself:               Graphics3D[Cylinder[{{0, 0, -2 π}, {0, 0, 2 π}}, 1]]      You can probably see the problem: the curves run around an invisible cylinder. I'd be much happier if I could see it! I've tried to squeeze the cylinder in in a few different ways (putting it into the `Animate[ParametricPlot3D[...]]` in different places, and using `Epilog`), but no luck. Any suggestions?


Scaling the time axis of an interpolated function (as in a solution from NDSolve)

I'm wondering how I can change the units of the x (time) axis when plotting a solution from NDSolve. I have obtained three solutions to a system of differential equations, all of which exist over the time scale [0 s, 1 ms]. However, I'm really only interested in the range [0 s, 5 ns]. To avoid having (x 10^-9) appended to every value along the x-axis when I plot these three functions (since the equations are solved in terms of seconds, not nanoseconds), I'd like to somehow scale the time axis to read 0, 1, 2, 3 ... (ns). It's fairly easy when working with symbolically specified functions- just multiply t by some constant wherever it appears in the function. However, this isn't possible here, since the solutions to the system are interpolated functions returned by NDSolve. Is there any efficient way to achieve this?


Bar Chart: How to adjust the font size for the bar labels as the chart size is manipulated

I have data that represents the binding energy of oxygen on different surfaces. Each bar is a different transition metal, and the length of the bar is the binding energy of oxygen. How do I make the font size of the labels larger while still keeping them centered on the bars? The way I have it right now, the chart works when it is large enough. When it is too small, the font overlaps and does not look good?               newElementsSmall = {"Sc", "Ti", "V", "Cr", "Mn", "Fe", "Co", "Ni",      "Cu", "Zn", "Zr", "Nb", "Tc", "Ru", "Rh", "Pd", "Ag", "Hf", "Ta",      "Re", "Os", "Ir", "Pt", "Au"}          stackData = {-1.69071, -1.48652, -1.42055, -1.16451, -2.51796, \     -1.81939, -1.04659, -1.14478, -1.2814, -2.13397, -1.30394, -1.29924, \     -1.35072, -1.49208, -0.966458, -1.0429, -1.41273, -1.31235, -2.3501, \     -1.45391, -1.25234, -0.963033, -1.10553, -1.01026}          BarChart[ stackData, ChartLabels -> {Placed[newElementsSmall, Above]},     PlotLabel -> Style["6M1@32Ag", Bold, 50], ChartLegends -> {"eV"} ]      ![overlap when small](http://i.stack.imgur.com/eZYbd.jpg) ![No overlap when large](http://i.stack.imgur.com/iV20t.jpg)


How to select all elements above the main diagonal of matrix? I need to create a list of them.


Computing symbolic norm of a vector

Consider the code:               n1 := Cos[α] Sin[β]     n2 := Sin[α] Sin[β]     n3 := Cos[β]     n := {n1, n2, n3}     Norm[n]      Why the result is               Sqrt[Abs[Cos[β]]^2 + Abs[Cos[α] Sin[β]]^2 + Abs[Sin[α] Sin[β]]^2]      that is $$\sqrt{\left| \sin (\alpha ) \sin (\beta )\right| ^2+\left| \cos (\alpha ) \sin (\beta )\right| ^2+\left| \cos (\beta )\right| ^2}$$ instead of $1$? How to compute the norm in a symbolic way simplifying some trigonometric identities?


How can I model composite 3D structures?

I know that Mathematica isn't built to model 3D, but most of my models are equation-defined so here's my question: is it somehow possible to combine ad- hoc 3D objects as well as ordinary/parametric/closed-form 3-dimensional plots into a single rendering? I know about the ability to export and recombine elsewhere, but I don't want to do that right now. (Also, for some reason, SolidWorks crashes when importing complicated models.)


Advice on Gather

Is there a better way to write this gather? I have a list of particles, "particlelist", and a list of particle coordinates, "coordlist" and I want to put all the particles into a 3-dimensional ng x ng x ng array of cubic boxes of width d. Each coordinate takes values between xmin and xmin + d x ng. boxIndx contains the correct box for any particle given the particle coordinates. I can then place the appropriate particle into its proper box. The code below is easy to read but it is a little slow. I know that AppendTo's are supposed to be no-no's but replacing it with Reap and Sow results in even slower times. The test problem typically takes .13-.17 on my Mac laptop. Thanks.               BoxEmUp3[coordlist_, particlelist_, ng_, d_, xmin_] :=         Module[{ParticleListByBox,particleIndx, boxIndx},            ParticleListByBox = ConstantArray[{}, ng^3];       Do[        boxIndx = 1 + Floor[(coordlist[[particleIndx, 1 ;; 3]] - xmin)/d].{1, ng, ng^2};             AppendTo[ParticleListByBox[[boxIndx]], particlelist[[particleIndx]]];,             {particleIndx, Length[particlelist]}];       Return[ParticleListByBox];]          xyztst = RandomReal[{-10, 10}, {10^6, 3}];     free = RandomSample[Range[10^6], 10^4];     BoxEmUp3[xyztst[[free]], free, 20, 1., -10] // Timing


How to calcuate the sum of 1/x, where x is an integer not containing the digit 9 and 10,000,000 ≤ x ≤ 88,888,888

My code is:               nonine[x_] := If[StringMatchQ[IntegerString[x], "*9*"], False, True];     SetAttribute[nonine, Listable];          tbl = Select[Range[10^2, 888], nonine[#] &];          Total[1.0/tbl]      got out of memory problem.


random split a dataset

I've got a very simple problem, but not so trivial. I need to split a dataset (input and output data) in three part randomly: training set 70%, validation set 20% and is test set 10%. First of all this splitting have to be random, but reproducible, so I set SeedRandom. So I produce this simple code to split in two part (70% and 30%), but I've some problem to split in three part (70%, 20% and 10%). input is a matrix and oputput a list of numbers, for example:               input= {{0.688217, 0.362944, 0.468409, 0.133651}, {0.746246, 0.365313,      0.661147, 0.124928}, {0.688217, 0.362944, 0.892652,      0.133651}, {0.736027, 0.327411, 0.429482, 0.138367}, {0.765381,      0.390355, 0.81139, 0.148402}, {0.869656, 0.485533, 0.851523,      0.200265}, {0.757873, 0.412183, 0.573253, 0.174008}, {0.64025,      0.323266, 0.477443, 0.1111}, {0.648592, 0.327327, 0.614614,      0.115339}, {0.993743, 0.701184, 0.71341, 0.290435}, {0.763712,      0.542893, 0.685418, 0.22885}};          output={0.707695, 0.641002, 0.576708, 0.514697, 0.454514, 0.395702,      0.338031, 0.280931, 0.224174,0.1211,0.23234};          SeedRandom[1234];     index = RandomSample[Range[Length[input]], IntegerPart[Length[input]*0.3]];     indexp = Partition[index, 1];     inputv = {};     outputv = {};     (*Validation TEST*)     inputv = Table[Append[inputv, input[[i]]], {i, index}];     outputv = Table[Append[outputv, output[[i]]], {i, index}];     (*Test TEST*)     inputt = Delete[input, indexp];     outputt = Delete[output, indexp];          inputv = Flatten[inputv, 1];     outputv = Flatten[outputv];      Could you help me? Thanks...


Build recursion in parallel?

_Problem_ Let's define a simple recursion.               f[1] = 1;     f[n_] := f[n] = f[n - 1]*n;      If I evaluate f in parallel               ParallelTable[f[i], {i, 10}];      and then query f               ?f     Global`f     f[1]=1     f[n_]:=f[n]=f[n-1] n      _Question_ How can I tell the sub kernels to build up the recursion, so that               ?f          Global`f          f[1]=1     ....     f[10]=3628800          f[n_]:=f[n]=f[n-1] n      Thanks ! PS: of course the actual function is not that trivial.


Mathematica8 can compile this function but Mathematica 9 can't if I set CompilationTarget -> "C"

Following code worked on Mathematica 8, but in Mathematica 9 it can't be compiled, it return this message > CompiledFunction::cflist: Nontensor object generated; proceeding with > uncompiled evaluation. >> How can I fix this?               Clear[cf1];     cf1 = Compile[{},        Module[{s = 0.0},         Do[           If[s > 15, Print@i; Break[]];           s = s + 1.0/i;           , {i, 10^7}];         ], CompilationTarget -> "C"];          cf1[]


Point-like function but with diamond instead of circle

I would like to use something like `Point[x,y]` to plot diamonds instead of small circles ("points"). I'm creating charts from scratch inside a `Graphics` expression using my own graphics functions. I've looked through the documentation and questions here and haven't found anything about how to do it.


splitting a list into files

Given is a list with x, y, z coordinates: > {{100, 94, -1.112}, {100.05, 94, -1.112}, {100.1, 94, -0.982}, ..., {100, > 94.25, -1.112}, {100.05, 94.25, -0.855}, {100.1, 94.25, -0.728}, ..., > {139.95, 114.75, 1.184},{140, 114.75, 1.184}} I want to split this list into files with y = constant, y should moreover form the name of the new file (see the code below) and only the (x, z) values should be written into the file. Getting the name for the first file I use this code:               liste = ReadList[inffile, {Number, Number, Number}];     y = liste[[All, 2]];     fil = IntegerString[IntegerPart[First[y]*100], 10, 5];     newfile = ToString[fil] <> ".dat";     wfile = OpenWrite[newfile, FormatType -> TraditionalForm];      Which is the best way to extract now all (x,y,z) with the same y (y = 94) from this list, to write all of them into the new file, and to continue with the next new file with the next y-value (y = 94.25)? Thanks a lot


Custom contour labels in ContourPlot

Suppose I wanted to draw the zero contour for the function $$d^2-g.$$ I could use the following code:               ContourPlot[d^2-g,{g,0,1},{d,0,1},Contours->{0},                     ContourStyle->Black,ContourShading->None,FrameLabel->{"g","d"}]      Which produces this: ![contour plot](http://i.stack.imgur.com/ZvUY1.png) Taking this one step further, I might want to plot the zero contour for $$td^2-g.$$ at various values of $t$, which I could achieve functionally with               Show[Table[ContourPlot[t*d^2-g,{g,0,1},{d,0,1},Contours->{0},                ContourStyle->Black,ContourShading->None,FrameLabel->{"g","d"}],{t,0.1,1,0.1}]]      producing this: ![multi-contour plot](http://i.stack.imgur.com/zu9W4.png) Now, to make this easier to understand, I want to label each contour with its corresponding value of $t$, but this is where I run into trouble. I had thought that this could be achieved with the option               ContourLabels->t      but that yields this: ![enter image description here](http://i.stack.imgur.com/CGFlA.png) (it seems to have moved the labels rather than changing them). Does anyone know how to get Mathematica to draw a label equal to the relevant value of t on each of these contours? Secondly, assuming I can get that working, how can I reposition the labels towards the top of the contours so that they appear where the contours are furthest apart.


How to link a button to a manipulate play

I am wondering how I can link a button to the play button shown if you expand "Show Animation Control", So something like,               Manipulate[x, {x, 0, 1}, Row[{Button["Play", ImageSize -> 80]}]]      But where pushing the button "plays" x


solve non-linear system of equations

I have a system of equations and I want to solve it to get x, y $$\begin{cases} u= C_{1}+(x-C_{1})(1+k_{1}((x-C_{1})(x-C_{1})+(y-C_{2})(y-C_{2}))) \\\ \\\ v= C_{2}+(y-C_{2})(1+k_{2}((x-C_{1})(x-C_{1})+(y-C_{2})(y-C_{2}))) \end{cases}$$ If it possible I want to know how can it can be done in C++ too. Update: `Solve[]` gives me very large output, so the problem is that I want to place solution in my C++ aplication and $C_1$, $C_2$, $k_1$, $k_2$ are variables. `CForm[]` doesn't help, I need more simple and suitable form for C++ to use.


How to add a short wav music clip into a Mathematica animation

I have the following Mathematica animation:               Animate[Plot[k*x^2, {x, -2, 2},        PlotRange -> {{-2, 2}, {-10, 10}}], {k, -2, 2, 0.1}]      I also have a sound file in the same Mathematica file, which is A VERY SHORT music clip, in "wav" format. The clip is about 32 seconds long. Now I want to integrate this sound file into the above animation: The following command will do the job, but it will make the animation WAY TOO sluggish, and almost useless:               Animate[Plot[k*x^2, {x, -2, 2}, PlotRange -> {{-2, 2}, {-10, 10}},        Epilog -> {EmitSound[snd]}], {k, -2, 2, 0.1}]      Could you please suugest a better way of doing it? Thank you very much!


Dealing with dynamic tables

Making dynamic vector variables is difficult in Mathematica. For example:               X=Table[ToExpression["x" <> ToString@i], {i, 0,4}];     X[[2]]      Yields x1. However, if we make X a dynamic variable, then               n=4;     Row[{SetterBar[Dynamic@n, Range[1, 10, 1]], "     Length of X."}]         X=Table[ToExpression["x" <> ToString@i], {i, 0,n}];     X[[2]]      Yields "Part 2 of {x0,x1,x2,x3,x4} does not exist". How do I make dynamically updating vector objects of variable length?


Combining images and plots in LevelScheme figures

I've found that the `LevelSchemes` package is extremely useful when combining several plots with precise control over where to place legends, making plots withing plots other neat stuff like that, however I ran into problems when I tried to combine a graphics object (like a .png file) and a plot. Here is what I am trying to do: I have a plot depicting the squeezing parameter value in depending on the external electric field strength. ![Plot without the picture](http://i.stack.imgur.com/SGcQP.png) I wanted to obtain something that looks like this: ![This is what I want made by hand in a graphics editor \(Inkscape\)](http://i.stack.imgur.com/WfGGd.png) To achieve said result I tried something like this:               Figure[      {       (*Main panel*)       FigurePanel[        {{0, 1}, {0, 1}}, PlotRange -> {{0, 1}, {-0.6, 20}},         FrameTicks -> {Automatic, Automatic}, FontSize -> 15,         LabB -> textit["x"], BufferB -> 2.5, TickFontSize -> 12        ],       DataPlot[        dati, Tag -> set[1]        ],       ScaledLabel[{0.5, 0.2},         "some value=" <>          ToString[Some expression that returns a number],         FontSize -> 13],           (*Smaller Pannel*)       ScaledFigurePanel[        {{0, 0.55}, {0.55, 0.95}},        PlotRange -> {Automatic, Automatic}        ],        (*AMPSPlot is essentially SphericalPlot3D that takes a nxn matrix as an argument.        It is found in the ADM package*)       RawGraphics[        Rasterize[         Axes3D[AMPSPlot[           WignerRotate[            gdm[Flatten[sols[[30, 2]]]], {optlen[              gdm[Flatten[sols[[30, 2]]]]], 0, 0}], PlotRange -> All,            Boxed -> False, Axes -> False]]]]            },      PlotRange -> {{-0.2, 1.1}, {-0.2, 1.1}}, ImageSize -> 100*{6, 4}           ]      but I get something like this: !["This doesn't work at all"](http://i.stack.imgur.com/5tgSG.png) Is there any way to incoorporate pictures in graphics by `LevelScheme`? The main goal I am trying to do this is to see how the graphs look every time I tweak which set of parameters I've used, without going through the fiddly process of merging them in Inkscape.


How can the opacity of a dense data set be automatically chosen?

### The problem In a dense data set plotted with opaque points, data points can pile on top of each other. This can cause serious problems with the interpretation of the plots. I'll use as an example a scatterplot of normally distributed points.               theData = RandomReal[NormalDistribution[], {100000, 2}];      Unless one is careful, these plots end up showing a solid disk around the origin, which obscures the distribution since point densities above a certain level appear clipped. This also gives inappropriate emphasis to outliers, by plotting them with the same intensity as what might be a pile of a million points close together at the origin. Here is the same plot shown at different sizes.               Row[ListPlot[      theData,      AspectRatio -> Automatic, ImageSize -> #, PlotStyle -> Directive[Black]     ] & /@ {90, 180, 360}]      ![enter image description here](http://i.stack.imgur.com/WSEwg.png) An artificial black disk appears at the origin and its apparent size depends on the plot size, even though the data are identical. Here is the same plot with different settings for PointSize.               Row[ListPlot[      theData,      AspectRatio -> Automatic, ImageSize -> Medium, PlotStyle -> Directive[Black, PointSize[#]]     ] & /@ {0.01, 0.005, 0.0025}]      ![enter image description here](http://i.stack.imgur.com/bX6oY.png) The disk appears a different size depending on point size, even though the data are identical. Here are plots of successively smaller subsets of the data.               Row[ListPlot[      theData[[;; #]],      AspectRatio -> Automatic, ImageSize -> Medium, PlotStyle -> Directive[Black]     ] & /@ {100000, 50000, 25000}]      ![enter image description here](http://i.stack.imgur.com/bw5uG.png) The distributions are obviously all the same, but they look different in the plot because of the pileup of points. ### Solving pileup by changing opacity For a given point size, one solution is to choose the minimum opacity where the darkest pixel in the plot is black. Here is an ugly, slow, procedural, brute-force way of choosing the correct opacity:               Block[      {darkestPixel},      darkestPixel=1;      idealOpacity=0;      While[       darkestPixel>0,       idealOpacity=idealOpacity+0.001;       darkestPixel=Min@Flatten@ImageData@ColorConvert[        Rasterize@ListPlot[         theData,         AspectRatio->Automatic,ImageSize->Medium,         PlotStyle->Directive[Black,PointSize[0.01],Opacity[idealOpacity]],Axes->False        ],       "Grayscale"       ]      ]     ]      Here are the resulting plots for different subsets of the data:               Row[ListPlot[      theData[[;; #[[1]]]],      AspectRatio -> Automatic, ImageSize -> Medium,       PlotStyle -> Directive[Black, PointSize[0.01], Opacity[#[[2]]]]     ] & /@ {{100000, 0.018}, {50000, 0.042}, {25000, 0.1}}]      ![enter image description here](http://i.stack.imgur.com/3MBGh.png) ### Solving pileup by changing point size Another way is to choose a fixed opacity and increase the size of the points until the darkest pixel is black.               Block[      {darkestPixel},      darkestPixel = 1;      idealPointSize = 0;      While[       darkestPixel > 0,       idealPointSize = idealPointSize + 0.001;       darkestPixel = Min@Flatten@ImageData@ColorConvert[        Rasterize@         ListPlot[theData,          AspectRatio->Automatic, ImageSize->Medium,           PlotStyle->Directive[Black,PointSize[idealPointSize],Opacity[0.05]],Axes->False         ],        "Grayscale"       ]      ]     ]      The results for different subsets of the data:               Row[      ListPlot[       theData[[;;#[[1]]]],       AspectRatio->Automatic,ImageSize->Medium,       PlotStyle->Directive[Black,PointSize[#[[2]]],Opacity[0.05]]      ]&/@{{100000,0.003},{50000,0.01},{25000,0.015}}     ]      ![enter image description here](http://i.stack.imgur.com/MYlLR.png) ### The question What's the best way to quickly and automatically choose the correct opacity, point size or combination of the two so that there is no "clipping" in a dense plot? Is it possible to do this inside of `PlotStyle` instead of as a pre- processing step? For bonus points, explain the best way to do this for multiple data sets on the same plot.


How can I provide dividers and control item alignment in a Grid?

I make a `Grid` with multiple Rows and Columns. I want to apply different types of Dividers and Alignment to that `Grid`. ![enter image description here](http://i.stack.imgur.com/7nVsA.png) If you can observe above picture, 1.First row `Alignment` is `Left`,and remaining all the rows `Alignment` is `center`. 2.in the second row only `Dividers` are appeared I want like this,for this purpose I wrote a simple code but it was nor working                Grid[{{Style["Life Alerts", Bold, 20], SpanFromLeft, SpanFromLeft},             {Style["Alert", Bold, 15], Style["<>", Bold, 15],              Style["%Life", Bold, 15],              Style["OnDay", Bold, 15]            },            {Style["L1", Bold, 15],              Style["<", Bold, 15], Style["90", Bold, 15],              Style["0.35", Bold, 15]            },            {Style["L2", Bold, 15],              Style[">", Bold, 15], Style["90", Bold, 15],              Style["0.35", Bold, 15]            },            {Style["L3", Bold, 15],              Style[">", Bold, 15],              Style["90", Bold, 15],              Style["0.35", Bold, 15]            }           },          Alignment -> {{Left}, Center}, Background -> {None, {Yellow}}, Frame -> True,         FrameStyle -> Directive[Thickness[4], Black], Spacings -> {1, 1},         Dividers -> {{}, {True, True, True}}]      Already I seen documentation still I didn't get it can anybody help me?


Unexpected behavior of Compile, Return and ;

Could somebody explain why               test = Compile[{{x}},           Return[x];         ];     test[0.]      returns               Compile::cret: "The type of return values in Return[x]; are different. Evaluation will use the uncompiled function. "      while               test = Compile[{{x}},           Return[x]         ];     test[0.]      works as expected? Notice that the only difference is the semicolon at the end of `Return`.


Simplifying expressions involving Divisible

FullSimplify[ Divisible[p^2 - 1, 24] , Element[p, Primes] && p > 3]      Should evaluate to `True`, but I get > >     Divisible[-1 + p^2, 24] >   Compare with               FullSimplify[Divisible[(6 k - 1)^2 - 1, 24], k \[Element] Integers]       Which does evaluate to > >     True >


My code is not converging using NIntegrate. Why? Help please

I have been trying to see why this integration is not converging but to no avail. The output gives only the y-values but fail to give any real value for x-values. Rather I always have something like this:               0.1, -1, Re[ NIntegrate[ Abs[x + y - 1]^k*Sign[x + y - 1]*f[x, y, θ, ρ],                               {x, 0, 1}, {y, 0, 1}, WorkingPrecision -> 100]],     2 - 2*Re[CDF[StudentTDistribution[1.1], ComplexInfinity]] 0.1, -0.7,      Re[ NIntegrate[ Abs[x + y - 1]^k*Sign[x + y - 1]*f[x, y, θ, ρ],                      {x, 0, 1}, {y, 0, 1}, WorkingPrecision -> 100]],     0.22388681701262803 0.1, -0.39999999999999997,      Re[ NIntegrate[ Abs[x + y - 1]^k*Sign[x + y - 1]*f[x, y, θ, ρ],                      {x, 0, 1}, {y, 0, 1}, WorkingPrecision -> 100]],      0.33847856188105085 0.1, -0.09999999999999998,      Re[ NIntegrate[ Abs[x + y - 1]^k*Sign[x + y - 1]*f[x, y, θ, ρ],                      {x, 0, 1}, {y, 0, 1}, WorkingPrecision -> 100]],      0.43918067389892146      0.1, 0.2, Re[ NIntegrate[ Abs[x + y - 1]^k*Sign[x + y - 1]*f[x, y, θ, ρ],                               {x, 0, 1}, {y, 0, 1}, WorkingPrecision -> 100]],     0.5383910479350043 "      The code is this:               ClearAll[A, f, θ, ρ, data, θmin, θmax, ρmin, ρmax, θinc, ρinc, c1, c2];     θmin = 0.1; θmax = 5; ρmin = -1; ρmax = 1; θinc = 0.01; ρinc = 0.3; k = 3;     data = {};     A[w_, θ_, ρ_] :=  w (CDF[StudentTDistribution[θ + 1], Sqrt[(1 + θ)/(1 -   ρ^2)] ( (w/(1 - w))^(1/θ) - ρ)]) + (1 - w) (CDF[ StudentTDistribution[θ + 1], Sqrt[(1 + θ)/(1 - ρ^2)] (((1 - w)/ w)^(1/θ) - ρ)]);     c1[x_, y_, θ_, ρ_] := Exp[Log[x y] A[Log[y]/Log[x y], θ, ρ]];     c2[x_, y_, θ_, ρ_] :=  x + y - 1 + c1[1 - x, 1 - y, θ, ρ];     f[x_, y_, θ_, ρ_] := D[c1[x, y, θ, ρ], x, y];     stream = OpenWrite["./data2011", BinaryFormat -> True];       For[θ = θmin, θ <= θmax, θ += θinc, ρmin = -1; ρmax = 1;      For[ρ = ρmin, ρ < ρmax, ρ += ρinc,        Print["θ=", θ, ", ρ=", ρ];     list = Re[{{θ, ρ, NIntegrate[ Abs[x + y - 1]^k Sign[x + y - 1] f[x, y, θ, ρ], {x, 0, 1}, {y, 0, 1}, WorkingPrecision -> 100], 2 - 2 A[1/2, θ, ρ]}}];     Export[stream, Table@list, "CSV"];          WriteString[stream, "\n"];]]


Rescuing a vertically clipped histogram

I recently ran a rather time intensive calculation and plotted the results in a histogram by simply called Histogram[data]. However, because of a rather serious error on my part, I recently lost my original data and all I have is the histogram plot. I need to change the vertical cut-off on the histogram (it will cut off any bars with an event count >= N). I can hover over the bars and read the values, so I know the information is there, but how can I change the value of N for the vertical cutoff?


Function behavior based on Head

I'm figuring how to implement a function behavior based on the Head of its argument. I mean               Unprotect@Head;     Head[p_[x]]:= Kind;     Protect@Head;     function[h_]:= 0;     function[p_Kind]:= 1;          Head[f[x]]     function[f[x]]     function[f]      the first instance of `function` should evaluate to `1` whereas the second instance should evaluate to `0`. However, both evaluate to `0`. Notice that `Head[f[x]]` evaluate to `Kind` as expected. Where am I doing mistake(s)? Thank you very much


NSolve or Reduce for obtaining the results and connecting roots

Here I have one problem how to solve numerically equation for different values of one parameter x. I used just two digits because of length, but for x=0.57 I should have one real root and for others 0.6, 0.7 ... complex roots. These seven points I want to plot in complex (Re,Im) plane with line. The first problem is that NSolve doesn't work, with Reduce I can obtain some results with problems. Another problem is to understand what's happen when x-> Infinity                     x = {0.57, 0.6, 0.7, 0.8, 0.9, 1, 1.1};                NSolve[1/Sqrt[y]           0.02 (1.`5. I (64.`5. + 2.10 Sqrt[y]) Sqrt[-64.`5. +            4.21 Sqrt[y]] + (64.`5. - 2.10 Sqrt[y]) Sqrt[           64.`5. + 4.21 Sqrt[y]]) Sqrt[-64.`5. + 4.21 Sqrt[y]] Sqrt[           64.`5. + 4.21 Sqrt[y]] + 0.03 Sqrt[y] - # == 0, y] & /@ x


Sort matrix rows iteratively according to sum of some columns

I have a matrix say               matinitial =       {{41, 42, 43, 44, 45, 46, 47, 48, 49, 410},        {11, 12, 13, 14, 15, 16, 17, 18, 19, 10},        {21, 22, 23, 24, 25, 26, 27, 28, 29, 210},        {31, 32, 33, 34, 35, 36, 37, 38, 39, 310}};      I want to form matrices `matfinal[i],` where i runs from 1 to 6 in this example.My `matfinal[i]` should be equal to matinitial after sorting rows based on sum of columns from `i` to `i + 4`. I tried the following codes :               Do[matfinal[i] = SortBy[matinitial,Total[matinitial[[All, i ;; i + 4]], {2}]], {i, 1, 6}];      But I do not get the results I desire. For example, my matfinal[1] should be equal to matinitial sorted based on Total of first four columns:               {41 + 42 + 43 + 44, 11 + 12 + 13 + 14, 21 + 22 + 23 + 24, 31 + 32 + 33 + 34} = {170, 50, 90, 130}.      Therefore,               matfinal[1]={{11, 12, 13, 14, 15, 16, 17, 18, 19, 10},                 {21, 22, 23, 24, 25, 26, 27, 28, 29, 210},                 {31, 32, 33, 34, 35, 36, 37, 38, 39, 310},                 {41, 42, 43, 44, 45, 46, 47, 48, 49, 410}};      Please note, in my real world problem my matinitial matrix is 100 by 20000 in size.Any help is greatly appreciated.And also, thank you for your help in advance!! :))


How can I decide whether a closed surface is intersected by a triangle?

A closed surface consisted of `Polygons` or `GraphicsComplex` and a triangle made by 3 points are in a 3D space. How can I decide whether intersected or not. I have tried by using `RegionMember` but It does not work. (this code is typed in _version 10_ )               g1 = RevolutionPlot3D[{2 + Cos[t], Sin[t]}, {t, 0, 2 Pi},        PlotPoints -> 2];     surface =        GraphicsComplex[g1[[1, 1]], {Opacity[0.7], g1[[1, 2, 1, 1, 5, 1]]}];          triangles = {        Polygon[{{0, 0, 0}, {0, 2, 2}, {0, -1, 2}}],        Polygon[{{2, 0, 0}, {2, 2, 2}, {2, -1, 2}}],        Polygon[{{-3, 0, -3}, {3, 2, 2}, {-3, -1, 2}}]};      examples               Grid[{{"Not Intersected", "Inside 1-Point,        Intersected", "Outside 3-Point,        Intersected"},       Table[Graphics3D[{surface, Opacity[0.7], Green, t},         Boxed -> False], {t, triangles}]}, Frame -> All]      ![Mathematica graphics](http://i.stack.imgur.com/DSKTg.png) I want to make a function that is decide whether intesected or not like this: ![enter image description here](http://i.stack.imgur.com/f0let.png) I expect like this results. ![enter image description here](http://i.stack.imgur.com/kIqme.png) **Is there any idea or algorithm paper?** * * * **My Wrong Try**               makeSurfaceEq[v_List, {x_, y_, z_}] :=      Module[{a, b, c, d, eq},        eq = a x + b y + c z + d == 0;        eq = eq /. NSolve[(a #1 + b #2 + c #3 + d == 0 &) @@@ v];        eq = If[eq[[0]] === List, eq[[1]]];        eq /. {a | b | c | d -> 1}        ] /; Length[v] >= 3     polygonToSurfaceInEq[v_, f_, {x_, y_, z_}] := Module[{cOfG, eqs, ineq},       cOfG = Mean@v;       eqs = makeSurfaceEq[v[[#]], {x, y, z}] & /@ f;       Table[         ineq = eqs[[i]] /. Equal -> Greater;         If[ineq /. Thread[{x, y, z} -> cOfG], ineq, ! ineq],         {i, Length[eqs]}] /.        {Greater -> GreaterEqual, Less -> LessEqual}       ]      here is something wrong result. and though a point is in closed surface, **the command** > polygonToSurfaceInEq **is not applied for a like torus.**               intersectedQ[polygons_, triangle_] := Module[{},       f = Function @@ {{x, y, z},          And @@ polygonToSurfaceInEq[            polygons[[1]],            Cases[polygons, Polygon[a_] -> a, \[Infinity]][[1]],            {x, y, z}]          };       Or @@ f @@@ triangle[[1]]       ]      my try is this.               intersectedQ[surface, triangles[[1]]]      > True 3 points are all outside of the surface.               intersectedQ[surface, triangles[[2]]]      > False * * * **Wrong Try2** Pickett's answer is good approach but is not a answer of my question. The closed surface is made by polygons and **bounded by polygons surfaces**. The following example show that I mean.               intersectQ[polygon_] := With[{distFunc = RegionDistance@Polygon[polygon]},         Length@Select[           findPossibleIntersections[polygon, surface[[1]], 0.01],            distFunc@# < 0.05 &] > 0];     intersectQ@{{1.8, 1.2, 0.9}, {1.5, 1, 2}, {1.5, 2, 2}}      > False This is inside of surface, but this code answer FALSE.               Graphics3D[{surface,       Opacity[.7], Green,        Polygon[{{1.8, 1.2, 0.9}, {1.5, 1, 2}, {1.5, 2, 2}}],       Opacity[1], Red, Point[{1.8, 1.2, 0.9}]},      Boxed -> False]      ![enter image description here](http://i.stack.imgur.com/4ipUw.png)


Slider with non-linear behavior

I am trying to develop a small tool and I am stuck on a very simple problem. This how I want it to look: ![enter image description here](http://i.stack.imgur.com/LPh6y.png) I have               minValue = steps = 100.000     valueRange = 500.000.000 - 100.000     newPercent = where the circle is right now (0-100%)     newValue = minValue + (valueRange * newPercent / 100.0);      The range is very big, and it is very hard to set the right value at the beginning, but when the value is above 200 million, I don't care about 100000. So I wont to make it exponential; e.g., $x=y^2$ That what I was thinking. http://www.wolframalpha.com/share/clip?f=d41d8cd98f00b204e9800998ecf8427e9onr7i6926 I want to make the first steps with 100.000 and them more and more. Maybe like this? http://www.wolframalpha.com/share/clip?f=d41d8cd98f00b204e9800998ecf8427ev8h6m2vulq Maybe I am totally wrong. Any suggestions?


Asymmetric X and Y error bars on ListLogPlot

The wonderful error bar log plots package `ErrorBarLogPlots` from `V6` no longer positions labels correctly (since `v9` or maybe `v8`) so I used the same function with `Prolog` to place a list of labels. Then in `v10 beta` `PlotRangePadding` no longer works either and I can't find a work around for that, so I tried to go back to basics and use the very elegant solution by Belisarius' et.al in: Plotting Error Bars on a Log Scale I was able to modify this to make asymmetric $Y$ error bars, then I tried to add $X$-errors and got tied up in knots with the `Joined` and `Filling` commands. **The aim** is to plot a set of $5$ lists of `xy` values, `{xy, xyP, xyM, xPy, xMy}` where `P` and `M` refer to the plus and minus error of the $x$ or $y$ value preceding it, with a `Filling` / `Joined` statement that joins the first point to the other 4 points. Ideally the plot symbols should also switch between vertical and horizontal bars for the $x$ and $y$ error points and something else for the $x, y$ point. (I asked Support about including an `errorlistlogplot` command in _Mathematica_ but I expect it won't make it into `v10`). The lines below generate and plot the `5` sets of points. Is there a straightforward combination of `Filling` / `Joined` statements to achieve this?               SeedRandom[1234]     dataX = Sort@RandomReal[{0.5, 1}, 10];     dataY = RandomReal[{0.5, 1}, 10];     {errorYP, errorYM, errorXP, errorXM} = RandomReal[.5, {4, 10}];     dataYP = dataY + errorYP;     dataYM = dataY - errorYM;     dataXP = dataX + errorXP;     dataXM = dataX - errorXM;     xy = Transpose[{dataX, dataY}];     xyP = Transpose[{dataX, dataYP}];     xyM = Transpose[{dataX, dataYM}];     xPy = Transpose[{dataXP, dataY}];     xMy = Transpose[{dataXM, dataY}];          ePlot[plotFun_, data_] := plotFun[data, Filling -> Automatic, PlotRange -> All,                                             Joined -> {False, False, False, False, False}];          ePlot[ListLogPlot, {xy, xyP, xyM, xPy, xMy}]      ![enter image description here](http://i.stack.imgur.com/xVSE7.png)


How do I create a list of 25 random quadratic equations in the form ax^2+bx+c?

My teacher suggests using the RandomInteger command along with the Factor command, but I cannot figure out the syntax. A, b, and c need to be non zero integers between -10 and 10.


Change font of formula number in DisplayFormulaNumbered

I am trying to change the font of the formula number in a cell which has style DisplayFormulaNumbered. I can easily change the font of the formula I enter by selecting it and using the format menu. But the number to the right of the formula wont change. Any help with this would be greatly appreciated. I am using mathematica 9.


Solving a system of DAE on mathematica

I am having trouble solving a system of Differential Algebraic equations of mathematica, the solution I get is just zeros although it should give me an answer, here is my code:               eqns = {AL1''[z] -           AR1''[z] - (1/z)*(AL1'[z] - AR1'[z]) + (MW^2)*(AL1[z] -              AR1[z]) - (\[Alpha]*(z)^(2 + 2*\[Beta]))*(AL1[z] - AR1[z]) ==          0, AL2''[z] -           AR2''[z] - (1/z)*(AL2'[z] - AR2'[z]) + (MW^2)*(AL2[z] -              AR2[z]) - (\[Alpha]*(z)^(2 + 2*\[Beta]))*(AL2[z] - AR2[z]) ==          0, AL3''[z] -           AR3''[z] - (1/z)*(AL3'[z] - AR3'[z]) + (MZ^2)*(AL3[z] -              AR3[z]) - (\[Alpha]*(z)^(2 + 2*\[Beta]))*(AL3[z] - AR3[z]) ==          0, AL1''[z] +           AR1''[z] - (1/z)*(AL1'[z] + AR1'[z]) + (MW^2)*(AL1[z] +              AR1[z]) == 0,         AL2''[z] +           AR2''[z] - (1/z)*(AL2'[z] + AR2'[z]) + (MW^2)*(AL2[z] +              AR2[z]) == 0,         AL3''[z] +           AR3''[z] - (1/z)*(AL3'[z] + AR3'[z]) + (MZ^2)*(AL1[z] +              AR1[z]) == 0, B''[z] - B'[z]/z + (MZ^2)*B[z] == 0};          bcs = {AL1'[10^-8] == 0, AL2'[10^-8] == 0, AL3'[10^-8] == 0,         AR1[10^-8] - Sqrt[-1]*AR2[10^-8] == 0,         AR1[10^-8] + Sqrt[-1]*AR2[10^-8] == 0,         B'[10^-8] + (1/2.49144)*AR3'[10^-8] == 0,        AR3[10^-8] - B[10^-8] == 0, AL1[1/372.5] == 0, AL2[1/372.5] == 0,         AL3[1/372.5] == 0, AR1'[1/372.5] - Sqrt[-1]*AR2'[1/372.5] == 0,         AR1'[1/372.5] + Sqrt[-1]*AR2'[1/372.5] == 0,         B[1/372.5] + (1/2.49144)*AR3[1/372.5] == 0,         AR3'[1/372.5] - B'[1/372.5] == 0};          params = {MW -> 912, MZ -> 918, \[Beta] -> 2, g -> 0.6356, V -> 300,         RUV -> 10^-8, \[Alpha] -> (1 + \[Beta])*           Log[RTeV/             RUV]*(((g V)/(RTeV^(1 + \[Beta])))^2)/(2*(1 - (RUV/RTeV)^(2 +                    2*\[Beta]))) /. {g -> 0.6356, V -> 300, RUV -> 10^-8,           RTeV -> 1/372.5, \[Beta] -> 2}};           sol = First[       NDSolve[{eqns, bcs} /. params, {AL1, AL2, AL3, AR1, AR2, AR3,          B}, {z, 10^-8, 1/372.5}, Method -> {"Shooting"}]]


Graph generation given number of edges and nodes

I was wondering if it is possible to have Mathematica generate all graphs with a given number of edges and nodes (and possibly restricting the adjacencies) and draw them I know that there are some commands in Mathematica but I don't quite seem to find this particular one if it exists. For the physicists among you: I'm basically looking for a way to generate all possible Feynman diagrams at 4 loops given only cubic interaction for 1 or 2 external particles excluding internal bubble graphs :)


Changing the background images of a slideshow presentation

_Mathematica 9_ lets you create presentations with background images. There are 6 default stylesheets for this: Earth, Garnet, Sapphire, Opal, Sunrise, Steel and Water. ![enter image description here](http://i.stack.imgur.com/V2Jpm.png) For your existing presentations I have found that you can apply the new appearance by selecting one of those stylesheets and copying the very first cell in a blank presentation created with the desired stylesheet. My question is: What is the recommended procedure to change the background image to something else? I have already found that the background images are controlled by the following cells in the stylesheet:               Cell[       StyleData["Notebook", "SlideShow"],       BackgroundAppearance -> FrontEnd`FileName[{"SlideShow"}, "EarthBackground.png"]]          Cell[       StyleData["FirstSlide"],       PrivateCellOptions ->          {"PagewiseNotebookBaseStyle" ->            {System`BackgroundAppearance ->              FrontEnd`FileName[{"SlideShow"}, "EarthTitleBackground.png"]}}]      And I can indeed put an adiditional background image file inside the `$InstallationDirectory/SystemFiles/FrontEnd/SystemResources/SlideShow` directory, but If I do that it will not be portable. So it is possible to use a background image that is contained inside the presentation notebook?


What devices are supported by the connected devices framework?

One of the new features in v10 is support for connected devices. How can I find out if a particular device is supported by Mathematica? Is there a complete list? Is support being added continually? The documentation says: > Many classes of devices listed in the Wolfram Connected Devices Project are > immediately supported within the Wolfram Language. Out of curiosity, I connected a Garmin nüvi50 and ran `FindDevices` to see if it would recognize it and be able to import tracks. I got the result:               {DeviceObject[{"Camera", 1}], DeviceObject[{"FunctionDemo", 1}],       DeviceObject[{"RandomSignalDemo", 1}], DeviceObject[{"WriteDemo", 1}]}       The only device it recognized here was the built-in camera. Is `FindDevices` generally sufficient to find out of a device is supported, or is manual configuration necessary for some devices?


Discontinuous Forcing for a Cancer Model -- Issues with v9 NDSolve

I'm new here, so please be gentle with me and hopefully the post is appropriate and not too basic. I am a math teacher and use modeling in my courses. I had working code (in v8 of Mathematica) for a cancer model with discontinuous forcing and now that previously working code doesn't work with v9. The model can be found displayed at ![Antiangiogenic Model](http://www.biomathdynamics.com/antiangiogenics/antiangiogenicModel.jpg) The following code worked in Mathematica version 8 but now doesn't work under version 9 (I haven't tried it in v10 yet):               lambda1 = 0.192; lambda2 = 0.000; b = 5.85; d = 0.00873; dose = 30;      efficacy = 0.66; clearance = 1.7; numberofdoses = 30; doseinterval = 2;      t0 = 0; tfinal = 84; v0 = 185; k0 = 625; is = 840;          h[t_] = Integrate[Sum[DiracDelta[tau - doseinterval*i], {i, 1, numberofdoses}]*Exp[-clearance*(t - tau)], {tau, 0, t}];          f := -lambda1*v[t]*Log[v[t]/k[t]];          g := -lamda2*k[t] + b*v[t] - d*k[t]*(v[t])^(2/3) - efficacy*dose*h[t]*k[t];          eqns := {v'[t] == f, k'[t] == g, v[0] == vinit, k[0] == kinit};          sol := NDSolve[eqns /. {vinit -> v0, kinit -> k0}, {v[t], k[t]}, {t, t0, tfinal}, MaxSteps -> 10000, MaxStepSize -> 1];          g1 := Plot[h[t], {t, t0, tfinal}, PlotStyle -> {Thick, Black}, AxesLabel -> {time, " "}, PlotLabel -> Treatment, ImageSize -> is];          g2 := Plot[Evaluate[{v[t], k[t]} /. sol], {t, t0, tfinal}, PlotStyle -> {{Thick, Blue}, {Thick, Red}}, AxesLabel -> {time, volume}, ImageSize -> is, PlotRange -> All, PlotLabel -> Response];          g3 := ParametricPlot[Evaluate[{v[t], k[t]} /. sol], {t, t0, tfinal}, ImageSize -> is, PlotStyle -> {Thick, Black}, AxesLabel -> {Vasculature, Tumor}];          g4 := Show[GraphicsGrid[{{g1}, {g2}, {g3}}]];          g4      Partial output, found at the link below, should be obtained ![Output for TNP470 Parameters](http://www.biomathdynamics.com/antiangiogenics/tnp470.jpg) What gives? I get the following beginning error message:               NDSolve::deqn: Equation or list of equations expected instead of ConditionalExpression[(k^\[Prime])[t]==-lamda2 k[t]-1.04875*10^45 E^(-1.7 t) (1. HeavisideTheta[Plus[<<2>>]]+0.0333733 HeavisideTheta[Plus[<<2>>]]+<<27>>+1.50857*10^-43 HeavisideTheta[Plus[<<2>>]]) (-0.5+1. HeavisideTheta[t]) k[t]-0.00873 k[t] v[t]^(2/3)+5.85 v[t],t\[Element]Reals] in the first argument {(v^\[Prime])[t]==-0.192 Log[v[t]/k[t]] v[t],ConditionalExpression[(k^\[Prime])[t]==-lamda2 k[t]-1.04875*10^45 E^(-1.7 t) (1. HeavisideTheta[<<1>>]+0.0333733 HeavisideTheta[<<1>>]+<<27>>+1.50857*10^-43 HeavisideTheta[<<1>>]) (-0.5+1. HeavisideTheta[<<1>>]) k[t]-<<1>>+5.85 v[t],t\[Element]<<5>>],<<1>>,k[0]==625}. >>      And there are other error messages seemingly related to this issue. Can you please help me out so I can get the model up and running for my students again? Thanks in advance for any help. I get the sense it's in how NDSolve handles discontinuous forcing functions. Is there a workaround? Mike


Are there tools for getting Mathematica 9 Notebooks working in Mathematica 10?

As often happens with Mathematica updates, nearly all of my notebooks no longer work as they did with the previous version. The upgrade from 9 to 10 has changed the appearance or introduced errors into almost every figure or graphic I create. I'm also encountering many errors in code that has worked without error since version 7. Many of these errors are quite surprising (e.g. calculations that suddenly give division by zero errors on the same data that I've always used, out of range errors when indexing lists that have not changed since running in version 9, graphics suddenly scaling to different sizes than before, etc.), and very difficult to locate (they are generally in large notebooks that I've been using for years). _Is there a tool for analyzing version 9 code for potential issues in version 10?_ I've enabled the notebook compatibility scanning feature; but that does not detect anything in any of my affected notebooks: ![](http://i.stack.imgur.com/tIZit.png) * * * As I spend hours going through my code to track down the sources of my many 10-induced bugs, I've come across the following, so far:   * `DateDifference` now returns a `Quantity` so that comparisons need to be wrapped in `QuantityMagnitude` (documented).   This leads to all kinds of errors, as many tests, filters and comparisons now fail (`x≠x days` for example), resulting in lots of empty lists.   * `DateListPlot` seems to behave as if `Joined` is `True` by default (apparently not documented).    * Default line weights and point sizes have changed in many (all?) plots, with now clear way to restore them to exactly what they were before.   This is vexing if you've got any kind of document production or style guidelines you've been following: all your code will now need to be adjusted to produce the results you've had.   * I `DateListPlot`, if two points have the same time coordinate, only one is plotted; the others are ignored. In addition, I'm getting at least a strong subjective impression that many operations are _much_ slower, especially file imports (e.g. importing several GPX files taking hours — so far — rather than minutes, in 9). There also appears to be some pollution of the global namespace taking place: I can get errors and very long delays in execution depending on the order in which I run different notebooks. I've had no luck tracking down the source of this behavior; but it's quite consistent.


Compile issues, scoping and order of evaluation

I have a few questions about compiling functions, which I think are all related to scoping and order of evaluation. I will illustrate them by a minimal example of the problem I have. I'm sorry for the lengthy question. The setup code is this,               mat = {{0, 1}, {1, 0}};          expr = {a^2 - ma + 3 x^3, a mb^2 + 2 b x, mc a - mb ma x^6};     Do[exprIndexed[i] = expr[[i]], {i, 1, 3}]     x = {5, -2};     atest = {1, 2}; btest = {2, 1}; ctest = {0, 0};      I have a list of expressions expr, each of which represents a vector. The first depends only on `a`, `ma` stands for the matrix `mat` times the vector `a`, and `x` is a constant known vector. The second depends on `a` and `b` and the last on `a, b, c`. I want to write for each of these expressions a compiled code that evaluates them. In particular I want to be able to define these compiled functions inside a do loop, I want them to really fully compile, and I want it to evaluate as much as it can without knowing the variables (`a`, `{a, b}` and `{a, b, c}` respectively). One attempt is this: (NOTE: i'm omitting everywhere the last argument `CompilationOptions -> {"InlineExternalDefinitions" -> True}, CompilationTarget -> "C"` for brevity)               Compile[Evaluate[({#, _Real, 1} &) /@ Take[{a, b, c}, i]],       ma = mat.a;        If[i > 1, mb = mat.b];        If[i > 2, dc = mat.c];       exprIndexed[i],       {{exprIndexed[i], _Real, 1}, {ma, _Real, 1}, {mb, _Real,1}, {mat, _Real, 2}}]      (A not so important question I have here is: when it is and when it's not necessary to include these type specifications at the end) Plugging in by hand `i = 1`, and copying for `i = 2`, etc., this code works. Wrapping it in a `Do`, e.g.               Do[comp[i]= (expr above)]      does not work. _Mathematica_ gives > CompiledFunction::cfse: Compiled expression {373. +a^2,-25.+a^2} should be a > machine-size integer. >> However, writing               loopCode[i_] := (code above)     Do[comp[i] = loopCode[i]]      does work. I wonder why this is so? Although the code works, it does not compile completely (I checked this by doing `Export["test.c", comp[1]]`). The reason is that the assignments set the global value of e.g. da, so must talk to _Mathematica_. This can be fixed by changing the body of the compile to               Module[{ma = mat.a},     exprIndexed[i]]      Now it works and compiles, but it cannot be defined in a loop. Explicitly, I tried,               loopComp[i_] :=        Compile[Evaluate[({#, _Real, 1} &) /@ Take[{a, b, c}, i]],         Module[{da = mat.a}, exprIndexed[i]],           {{exprIndexed[i], _Real, 1}, {da, _Real, 1}, {db, _Real, 1}, {mat, _Real, 2}}]          Do[comp[i] = loopComp[i], {i, 1, 3}]      I haven't found a way to automate the assignment of `ma`, `mb` and `mc`, i.e. to get `Module[{ma=mat.a},...]` for `i=1`, `Module[{ma=mat.a, mb=mat.b},...}]` for `i=2` etc., so `comp[2]` and `comp[3]` shouldn't work, but at least `comp[1]` should, but it does not.               comp[1][atest]       gives the error > CompiledFunction::cfte: Compiled expression da should be a rank 1 tensor of > machine-size real numbers. >> and the output > >     {376 - da, -20 - da} >   I think the issue is in the scoping of `Do`, `Module` and `Compile`, but I don't know how to fix it. The final issue is this. Even in the working versions of this code (just by explicitly copy-pasting and inserting the `i = 1, 2, 3` ) each time it runs everything is computed, i.e. the `x^6` is not computed by compile once and for all, but every time the code is run. Note that if `x` is defined before expr is defined, then this does not happen, but then there is another problem in that i.e. `x + a` will become `{5 + a, -2 + a}` and when `a` is plugged in we get a matrix instead of a vector. So I want to evaluate as much as possible, while still getting a vector as output.