How to specify the centre or PlotRange of a Graphics3D?

When I create a `Graphics3D`, I often want to place an object right at the centre of the box. Initially I thought that the centre was specified by `{0, 0, 0}`, but I soon realised that this is actually the corner. I've realised that I can find the centre by dividing the dimensions of the box in half. For example if               PlotRange -> {{0, 100}, {0, 100}, {0, 100}}      then if I want to put my `Sphere` dead centre I'll put it at:               Sphere[{100/2, 100/2, 100/2, 1]      This is all very well if I explicitly know the dimensions of the box, but if I don't know the `PlotRange`, how can I ensure that my object is placed right at the centre? Is there a way to tell the size of the `PlotRange` if you haven't specified it explicitly? For example, consider this function:               balls = Table[Sphere[RandomReal[{0, 100}, 3], 1], {50}]~        Join~{Sphere[{50, 50, 50}, .05]};     Manipulate[      Graphics3D[       balls,       ViewPoint -> {1.3*10^-zoom, -2.4*10^-zoom, 2*10^-zoom},        SphericalRegion -> True,        PlotRange -> {{0, 100}, {0, 100}, {0, 100}}],      {zoom, 0, 3}]      ![enter image description here](http://i.stack.imgur.com/V2XzR.png) The slider controls the zoom, which in this function zooms in all the way until you hit a very small sphere. For this to work though, the sphere needs to be precisely at the centre of the plot. To ensure this precision, I manually entered the size of the plot (`PlotRange -> {{0, 100}, {0, 100}, {0, 100}}`), as well as manually control the placement of the middle sphere (`Sphere[{50, 50, 50}, .05]`). Is there a way to make sure that this sphere is placed right at the very centre of the box without needing to manually specify either the dimensions of the `PlotRange` or the coordinates of the centre sphere? I hope this clarifies what I'm trying to get at.


Replace inside a Held expression separate context

How do I replace content inside a Held expression without local values coming through? For example if you run the following code you get `g[2]` instead of `g[x]`(the intended form).               x = 2;     Replace[HoldComplete[g["x"]], {       y_String :> With[{          eval = Symbol[y]},         eval /; True]       }, {0, Infinity}]      The following questions are related   * Constructing a Sandbox   * Replace inside Held Expression **EDIT:** Although rm-rf's trick is clever it partially works. His current code adds an additional defer to the current code.               InputForm@HoldComplete[g["x"]] /.        s_String :> With[{x = ToExpression[s, InputForm, Defer]}, x /; True]      returns `HoldComplete[g[Defer[x]]]` instead of `HoldComplete[g[x]]`. Ultimately you could strip out the `Defer`s which is likely what I will end up doing.


Generate random points in a region with higher probability in a sub-region

I am trying to generate random samples of points in the unit square in such a way that points inside a given circle are twice as likely to be selected as points outside that circle. I tried to approach the problem by the 2D distribution. To do that I need to turn the function               f[x_,y_]:= If[ (x-.5)^2 + (y-.5)^2 < .1, 1, .5]      into a probability distribution for both x and y between 0 and 1. Then I would use the PDF to generate points and eventually plot them. My main struggle comes from turning the If function into a two-variable PDF.


Solving an inequality that contains Log expressions

How can I solve the following inequality:               Log[1/2 + c^2] > (1.4) (30^5) 2^(4.5) 9 (0.6) (2.8) (1 + Log[3]) (1 +Log[ Log[c + 1]])      ? I tried `Reduce`, but my computer is still computing it (c is a real number).


Does it make sense to ask for the color of a Graphics3D "voxel"?

Say I generate some Graphics3D object, e.g.:               Graphics3D[{Red, Sphere[{0, 0, 0}, 1], Blue, Sphere[{1, 0, 0}, 1]}]      Does it make sense to ask for the color of a "voxel" / volumetric pixel in this image? In other words, is it possible to call some three-dimensional analogue of PixelValue or ImageValue to determine what region in the 3D box is red or blue? What might happen at the intersection of the red and blue spheres? Shouldn't this be possible given that I can select a subregion of the graphics3D object to display in some bounding box? And if so, couldn't I just make the bounding box around the area of interest arbitrarily small, save the output as a TIFF and call ImageValue[] or PixelValue[] on the center of the TIFF image? Surely there's a better way to proceed? Update: george2079 hits the nail on the head in my opinion with his suggestion that we should think about this problem as a problem of making a 3D implementation of Rasterize[]. A problem that may or may not be relevant, though, is that most of the Graphics3D objects are hollow. To see this, try zooming around a Graphics3D output using some amazing code written by the user rm -rf: Implementing a first person view of 3D objects in a scene


Visualizing vector-spherical waves

This is a follow-up question to this one on visualizing vector-spherical harmonics. This time, I would like to visualize the vector spherical waves (including the radial dependence). The functions that I would like to plot, `VectorSphericalWaveE[J, M, kr, θ, ϕ]` and `VectorSphericalWaveM[J, M, kr, θ, ϕ]` are defined below. **Please note there was a typo in`ϵ[λ_]`, in the linked question, which I have corrected**.               Clear[ϵ]; (*Polarization vector*)     ϵ[λ_] = Switch[λ,        -1, {1, -I, 0}/Sqrt[2],         0, {0, 0, 1},         1, -{1, I, 0}/Sqrt[2]   ];          Clear[VectorSphericalHarmonicV];     VectorSphericalHarmonicV[ℓ_, J_, M_, θ_, ϕ_] /;        J >= 0 && ℓ >= 0 && Abs[J - ℓ] <= 1 && Abs[M] <= J :=        Sum[         If[Abs[M - λ] <= ℓ, ClebschGordan[{ℓ, M - λ}, {1, λ}, {J, M}], 0]*         SphericalHarmonicY[ℓ, M - λ, θ, ϕ]*ϵ[λ], {λ, -1, 1}   ]          Clear[RadialR, VectorSphericalWaveE,VectorSphericalWaveM];     RadialR[kr_, ℓ_] = I^ℓ SphericalBesselJ[ℓ, kr];     VectorSphericalWaveE[J_, M_, kr_, θ_, ϕ_] /;  J >= 0 && Abs[M] <= J :=        If[J > 0, -Sqrt[((J + 1)/(2 J + 1))] SphericalBesselJ[J - 1, kr] VectorSphericalHarmonicV[J - 1, J, M, θ, ϕ],  0]      + Sqrt[J/(2 J + 1)] SphericalBesselJ[J + 1, kr] VectorSphericalHarmonicV[J + 1, J, M, θ, ϕ];     VectorSphericalWaveM[J_, M_, kr_, θ_, ϕ_] /; J >= 0 && Abs[M] <= J :=        I SphericalBesselJ[J, kr] VectorSphericalHarmonicV[J, J,          M, θ, ϕ];      The functions `VectorSphericalWaveE` and `VectorSphericalWaveM` takes two integer arguments $J\geq 1$ and $-J\leq M \leq J$, and three continuous arguments: the radial coordinate $kr>0$, and the angular coordinates $\theta$ and $\phi$. The output is a _real_ vector. Because these functions give out real-valued vectors, I would like to visualize them using vector plot. I tried the following:               VectorPlot3D[      Re[VectorSphericalWaveM[2, 1,       Sequence @@ CoordinateTransform["Cartesian" -> "Spherical", {x, y, z}]]],          {x, -5, 5}, {y, -5, 5}, {z, -5, 5},          RegionFunction -> ((#1^2 + #2^2 + #3^2 <= 5^2) &)]      But got a crummy output (see below). I can hardly tell what's going on. I know these vector fields are supposed to be circulatory only, so it would be nice if that aspect can be emphasized in the plot. Also, is there a way to include some kind of _distance fog_ , so that arrows in the back, are greyed out? ![enter image description here](http://i.stack.imgur.com/3RjjB.jpg)


I want to draw a graph using a weighted Adjacency matrix

I have a weighted adjacency matrix as follows:               myAdjacencyMatrix = {{0, 3, 1, 3, 3, 8, 0, 0, 3, 4},       {1, 0, 2, 0, 0, 16, 5, 3, 0, 6, 1},       {2, 3, 0, 0, 1, 1, 4, 1, 1, 0, 0},       {5, 3, 3, 0, 5, 0, 2, 2, 2, 2, 1},       {1, 0, 0, 6, 0, 1, 2, 6, 10, 2, 4},       {0, 11, 3, 0, 1, 0, 8, 3, 1, 3, 3},       {2, 4, 1, 7, 6, 7, 0, 6, 0, 8, 2},       {1, 2, 1, 3, 8, 4, 4, 0, 4, 3, 0},       {0, 0, 0, 1, 4, 1, 3, 4, 0, 6, 4},       {0, 3, 0, 0, 0, 5, 2, 2, 6, 0, 4},       {0, 1, 0, 0, 2, 1, 2, 0, 1, 2, 0}}      I want to draw a graph with 11 nodes and the edges weighted as described above. If this is impossible, then I will settle for making a graph with the non-weighted adjacency matrix. If you could just give me the simple code as I am new to mathematica and am working on a tight schedule.


How can I write a Do loop that iterates over N iterators when N is not known a-priori?

For any positive integer $n$ which is not specified _a priori_ , I can make $n$-tuple vector $v$ by `v = Array[a, 1, n]`. Now, given that $n$ is a positive integer which is not specified _a priori_ , I want to write an iteration sentence which performs over $1\leq a_1,\ldots, a_n\leq 3$. ($a_i$ are integers and hence I will get $3^n$ iterations). For example, if $n=2$, my sentence plays the same role as the following loop:               Do[EXPERIMENT, {i, 3}, {j, 3}]      If $n=3$, my sentence plays the same role as the following:               Do[EXPERIMENT, {i, 3}, {j, 3}, {k, 3}].      I can do it for any given SPECIFIED integer $n$, but I want to write the universal looping sentence which iterates for $1\leq a_1,\ldots, a_n\leq 3$ ($a_i$ are integers.)


Constraint syntax compaction

Is there a more compact way to represent these constraints: `NMaximize[{a+b+c,` **`a<= 5 && b <= 5 && c <= 5`**`}, {a,b,c}]` like `for x in {a,b,c}, x <= 5` or something.


Change Ticks in PairedBarChart

I am using the PairedBarChart feature as follows:               PairedBarChart[Range[5], Range[5], BarOrigin -> "XAxis"]      ![enter image description here](http://i.stack.imgur.com/jWRWa.png) How can I (i) remove and (ii) change the number of the small tick marks on the y-axis (i.e., the ones between the numbers 1, 2, 3, ...)? Thanks for your help!


How do I determine the original aspect ratio of an imported image?

Say I import a TIFF, JPEG, or PDF image. How can I quickly determine the original aspect ratio of the image so that I can properly scale its size? I have thus far been unable to find an answer looking through the manual.


How to calculate scalar curvature Ricci tensor and Christoffel symbols in Mathematica?

I am seeking a convenient and effective way to calculate such geometric quantities. I've used packages like `TensoriaCalc`, but they don't work at all time. Sometimes, I run into the following error: > Symbol `Tensor` is Protected.   >  Symbol `TensorType` is Protected.   >  Symbol `TensorName` is Protected.   > Here is the code I'm using:               Clear [i, j, φ, τ, σ]      q["case"] = Metric[ SubMinus[i], SubMinus[j],          E^(2 φ[σ]) (\[DifferentialD]τ^2 + \[DifferentialD] σ^2),          CoordinateSystem -> {τ, σ}, TensorName -> "T", StartIndex -> 1 ]      I think the above is correct, since I merely modified the example from the package manual. It gives me the correct answer sometimes (if I only use one notebook). Also, I ran the codes from the chapter "General Relativity" in the book " _Mathmatica_ for theoretical physics" by Gerd Baumann, but none of them work Is there more efficient way to calculate them? Please give me some suggestions about this.


Define customised distribution with discontinuous CDF

I have the following CDF:                F[x_] = Piecewise[{          {0, x < 0},          {0.1 x^2, 0 <= x <= 2},          {0.4, 2 < x <= 5/2},          {0.5, 5/2 < x <= 4},          {-0.5 E^-(x - 4)^2 + 1, 4 < x}         }];      ![enter image description here](http://i.stack.imgur.com/7BPii.png) Now I define the a probability distribution as follows:                dist = ProbabilityDistribution[{"CDF", F[x]}, {x, 0, Infinity}];      G[x_] = CDF[dist, x];      But the plot of G now looks different: ![enter image description here](http://i.stack.imgur.com/Wdas4.png) It seems I lose the discontinuity point and on top of that the CDF G doesn't even go up to 1 anymore. * * * Question: Why do I lose the discontinuity of my CDF, and is there a way to avoid this issue?


Introduction of bias during brightness and contrast manipulation of an image

Quoting from Nature magazine's "Image integrity" guidelines: > Processing (such as changing brightness and contrast) is appropriate only > when it is applied equally across the entire image and is applied equally to > controls. Contrast should not be adjusted so that data disappear. Excessive > manipulations, such as processing to emphasize one region in the image at > the expense of others (for example, through the use of a biased choice of > threshold settings), is inappropriate, as is emphasizing experimental data > relative to the control. When I change the brightness and contrast of an image, say, with the following command:               ImageAdjust[ExampleImage, {contrast, brightness}]      Is it fair to say that contrast and brightness transformations are "applied equally across the entire image" in the spirit of the above quotation? Of course common sense is required in terms of not purposefully obscuring meaningful data, but are there pitfalls / issues I should otherwise be aware of specifically with regards to this sort of image manipulation in Mathematica?


Nested for loop in mathematica

I have a code in mathematica with a loop which iterates over a variable i and calculates a list of numbers h given the start parameter f:               For[i==1,i<100,i++,     h=Append[h,f*g(i)]]      Now what I want to do is to vary the parameter f. How I would have done it in Matlab (which is the only other programming language I know - yes, I suck at programming basically) is that I would have made a nested loop, so we would have something like this:               For[j==1,j<10,j++,     f=Append[f,k(j)]     For[i==1,i<100,i++,     h=Append[h,f(j)*g(i)]]     x=Append[x,Max[h]]]      Where the last line is supposed to give me Max[h] for successive iterations over j, i.e. first one is max[h] for j=1, then for j=2 etc. But this structure does not seem to work. What are my alternatives/ how can I fix it? Ps: I would love to submit my code, but it's completely unreadable due to a heavyamount of subscripts etc. Can I attach the Mathematica file somewhere?


How do I seamlessly migrate from the older Units package to Mathematica 9's Quantity objects?

I have several notebooks that make use of the `Units` package and would like to be able to work simultaneously with the older units and `Quantity` objects introduced in version 9. What is my lowest-overhead method for updating units to `Quantity` objects?


LinearProgramming behavior

Consider the following linear programming problem:               LinearProgramming[-{10, -57, -9, -24}, -( {          {0.5, -5.5, 2.5, 9},          {0.5, -1.5, -.5, 1},          {1, 0, 0, 0}         } ), -{0, 0, 1}]      (* {0., 0., 0., 0.} *)      Why is this answer being returned? Taking $\textbf{x}=\begin{pmatrix}1&0&1&0\end{pmatrix}^T$ satisfies $\textbf{x}\ge 0\land A\textbf{x}\ge \textbf{b}$, but the value of the objective function for this solution is $-1$, which is clearly smaller than $0$, the suggested "optimal" solution by _Mathematica_. I would expect _Mathematica_ to be able to solve such a small LP problem, even if it is degenerate. Am I doing something wrong here?


How can I transform a quadratic into an factored equation?

How can I transform a quadratic polynomial in x and y into an equation of the form $(x-a)^2+(y-b)^2=c$?               f = -9 x + (3 x^2)/4 + (3 y^2)/4;      Completing the Square               CompleteSquare[f_, x_] :=       Module[{a, b, c},         {c, b, a} = CoefficientList[f, x];           a (x + b/2/a)^2 + Simplify[(c - b^2/4/a)]]          CompleteSquare[f, x]          (*         3/4 (-6 + x)^2 + 3/4 (-36 + y^2)     *)      What I want is the following:               (x - 6)^2 + y^2 == 36


How can I replace part of list and have the replacement affect the initial list?

I have a list:               list = {{1,1,0.05,0.05}, {2,2,0.05,0.05}};      and I want to do this change               Replace[#[[1]], #[[1]] -> (#[[1]] + #[[3]])]& /@ list         Replace[#[[2]], #[[2]] -> (#[[2]] + #[[4]])]& /@ list       The problem is that the initial list doesn't change. My list represents $\{\{x, y, v_x, v_y\}, \{x, y, v_x, v_y\}\} $ and I want to use a replacement rule to change the position of the objects and thereby represent movement.


Visualizing directories

How do I plot the content of a directory and all its subdirectories into infinity using TreeForm? I've tried using a mix of FileNames, StringSplit and GatherBy but in the end I couldn't find even a promising start.


How to change machineprecision digits

I am trying to compute `t0`:               eq[n_, β_, λ_] := Hypergeometric1F1[1/2 (1 - λ/β), n + 1, β/2]     EDL[n_, β_, k_Integer: 1] := λ /. FindRoot[eq[n, β, λ] == 0, {λ, (2 k - 1) β}]     t0 = Table[EDL[0, β, 1], {β, 50, 100}]      When I tried this code I have a problem for $\beta$=(82, ..., 97), the answer is not accurate and I got the error message: > FindRoot::lstol: The line search decreased the step size to within tolerance > specified by AccuracyGoal and PrecisionGoal but was unable to find a > sufficient decrease in the merit function. You may need more than > MachinePrecision digits of working precision to meet these tolerances. So, I want to change the machine precision, so I tried:               t0 = SetPrecision[Table[EDL[0, β, 1], {β, 50, 100}], 30]      But I still have a problem. Please help me to change and set the machine precision.


Faster GCD Implementation

Is there any chance to write a faster GCD than the built-in one in Mathematica? @Mr.Wizard has written one in this question (although it's not for this purpose) which is 6 times slower on a 100k digits:               In[1]:= whileGCD=Module[{a=#,b=#2},While[b!=0,{a,b}={b,Mod[a,b]}];a]&;     In[2]:= Primo[n_]:=Product[i,{i,Prime[Range[n]]}]          In[10]:= prod=Primo[500000];     In[17]:= m=22Primo[20500] +1;          In[16]:= Timing[GCD[m,prod]]     Out[16]= {0.25,1}          In[12]:= Timing[whileGCD[m,prod]]     Out[12]= {1.609,1}


How can I use NestWhileList instead of While in this case?

OK, the problem occurred when I challenged with Project Euler No. 10 > The sum of the primes below 10 is 2 + 3 + 5 + 7 = 17. Find the sum of all > the primes below two million. My code is:               ClearAll[primelist, i]     primelist = {}; i = 1     While[Prime[i] < 2*10^6, AppendTo[primelist, Prime[i]];i++]     Plus @@ primelist      And I get the answer correct. I think using `While` is not a good habit in functional programming, but I can not modify my code to `NestWhileList`(or others FP-like functions). One of the proper manner is:               Plus @@ (Prime /@ NestWhileList[# + 1 &, 1, (Prime[# + 1] < 2*10^6 &)])      But I think it is not efficient, because when evaluating the `NestWhileList`, `Prime[1],Prime[2],Prime[3],...` ran the first time(in order to compare with 2*10^6), and then when mapping Prime to the list which was the result of `NestWhileList`, the same thing went once again! MMA evaluate `Prime[1],Prime[2],Prime[3],...` one more time.   1. Is there any method (or SOP) that can always change `While` to `NestWhile` or `NestWhileList`?   2. And I found that the second code above run faster much more than code 1, unbelievable.


Converting Excel serial dates with NETLink

Excel serial dates are not straightforward to convert since they include non- existent dates, e.g.               {DatePlus[{1990, 1, 0}, 59], DatePlus[{1990, 1, 0}, 60]}      > {{1990, 2, 28}, {1990, 3, 1}} ![enter image description here](http://i.stack.imgur.com/KcKuw.png) As shown, Mathematica finds date 60 is March 1st while Excel converts it to Feb 29th. To do the conversion I would like to use .NETLink with               DateTime dt = DateTime.FromOADate(60);      as given here. Can anyone help? I imagine something of the following form would work:               Needs["NETLink`"];          convertDate[serialdate_] :=      NETBlock[       InstallNET[];       (Mathematica form of DateTime.FromOADate (serialdate))       ]      **Edit** As Sjoerd pointed out, the problem is caused by an Excel bug, but only for year 1900. Conversion can be done using this:               convertDate[serialdate_] :=       If[serialdate < 61, "N/A", DatePlus[{1901, 1, 0}, serialdate - 366]]      I would still be interested to see how it would be implemented in NETLink, for future reference for applications making quick calls to .NET.


Labelling objects in a picture with numbers

I need help processing a biology bacteria picture. I just started learning _Mathematica_ and I hope you guys can use a simple method to help me solve the problem, please do not use super complicated methods. Below is what I want to do, it was done by my friend and he refuses to teach me. I want to label each bacteria cell on the picture with numbers. My thoughts are as follows:   1. Binarize the image and use `ComponentMeasurements` to find the centroids of all bacteria cells.    2. Convert the centroids (coordinates) to numbers 1 to 12 and make it into a graphic.   3. Show my original picture together with the picture numbered 1 to 12 to get my end result. However, my problem is that I do not know how to convert centroids (which are coordinate positions) into numbers. ![enter image description here](http://i.stack.imgur.com/ZmRE3.jpg) * * * Thanks Simon Woods! Here is my code and my attempt. Please correct me and see which part am I wrong. Firstly, This is the picture I started off with (named " **bacteria** ") and I want it to be labelled as shown on the above picture. ![enter image description here](http://i.stack.imgur.com/IoK07.jpg) And this is my code. I did not include how I sharpen and binarize the picture because it is quite straightforward. I will only start with the part whereby I get the centroids. i named my binarized picture as " **image** ".               morpData = MorphologicalComponents[image]     Tally@Flatten@morpData     cenData = ComponentMeasurements[morpData, {"Centroid"}]     getCenData = centroidData[[All, 2, 1]]      After these 4 steps, I managed to get the list of centroid coordinates which are               {{483.727, 478.227}, {422., 442.5}, {289.862, 331.534}, {245.261, 299.542}, {140.959, 259.041}, {404.427, 224.821}, {538.261, 223.39}, {56., 174.192}, {41., 140.844}, {190.529, 95.6238}, {277.262, 65.4048}, {491.833, 34.2778}}      This is good because I managed to identify all 12 bacteria in the picture. However, I need to know how to convert centroid coordinates to labeled numbers!! I tried, but I still cannot do it. And to prove that I really tried, this is my latest effort at trying to convert the 12 centroid coordinates into numbering and overlay with the original image. Please tell me where I went wrong:               Show[bacteria,Map[Graphics[Text[Style[getCenData[[1]], Red], getCenData[[2]]]], getCenData]]      And please, do not tell me to convert one by one, that is too troublesome.


How to match a pattern with a pattern?

**UPDATED** This question is about: "What is the pattern to match a pattern-definition, exactly as it is written?" My original question is now split according to Mr.Wizards insightful answer below. This question is about simple cases which can be solved with `Verbatim`. The other question (here) is what I should have asked originally: how to generally match and unify patterns and how to find their most general unifier. Therefore the following examples contain cases for both this and the other question. I won't modify these as it would ruin the understandability of the answers. Consider the following pattern comparisons, which intuitively suggest a matching, though all returning `False`:               MatchQ[a | b, b | a]     MatchQ[{a ..}, {a ..}]     MatchQ[{a ..}, {a ...}]      The output I would like to have is `True`. The idea is that the first argument specifies an object that can either be `a` or `b`. I scan through a lot of these objects looking for those that can stand in for either `a` or `b`, see toy example:               rules = {a -> 1, b -> 2, c -> 3, a | b -> 4, c | d -> 5, d | b | c -> 6};     Cases[rules, _?(MatchQ[First@#, a | b] &)]      > `{a -> 1, b -> 2}` Instead, I need the output to be: > `{a -> 1, b -> 2, a | b -> 4, d | b | c -> 6}`


Selecting polynomial roots and plotting against parameters

An implicit function $f(x,k)=0$ is quadratic in $x$ and contains one parameter $k$ which I must vary. Using `Solve`, I get two real solutions for each specific $k$: $x_1$ and $x_2$, of which I must choose the one that lies within $[0, 0.5]$. I must do this for a continuum of parameters $k$ between, say, $0$ and $1$. I then must plot the relevant $x$ solution against the parameter $k$ in a smooth curve. Note: I also tried the unglorious method i.e. if $k$ took discrete values, I thought I could manually select say 30 points and interpolate. But any curve fitting command I tried, using various polynomial and exponential expansions, could not give me smooth curve? Of course I hope to learn the elegant method, but under time pressure anything that gives me a smooth curve is welcome!


How to input formula embedded in text

I'm creating a styled notebook showing a simple theorem. I can set cell style as text or theorem or code to satisfy my requirement. But when I explain the theorem, I need to embed formula (not necessary for a whole line) into text. How can I do that. I didn't find any style for that.


How to remove an expression from a file?

To read in expressions from a file, one can do `ReadList[file, Expression, 3]`. How to do the opposite, i.e. remove a number of expressions from a file, modifying the file on the disk?


How to create Locator[] hierarchies?

I'd like to 'parent' Locators to one another, ideally organized in any arbitrary tree. The simplest case: If I have two Locators, A and B, then moving A will move both together, but moving B will only move that one. Any simple suggestions?


Using ImageCapture to access a USB webcam in linux

Is it possible to access a USB webcam through Mathmatica on Linux? When I run               ImageCapture[]      I get the following output               ImageCapture::notsupported: Image acquisition is not supported on Unix. >>      A quick search on Google does not return any useful solutions :(


Use _Mathematica_ to obtain an approximate value for the area between the curve $y=1/4$ and the x-axis over the interval $[1,2]$ with 50 subintervals using the left endpoint, midpoint and right endpoint approximations. Note: the entire calculation needs to be shown in _Mathematica_. Here's what I've tried:               a = 1; b = 2; n = 20;      Ln = (b - a[f)/n*Sum[f[a + (i - 1) (b - a) / n], {i, 1, n}]     LeftSum[f_, a_, b_, n_] := (b - a)/n* Sum[f[a + (i - 1) (b - a)/n], {i, 1, n}]     f[x_] := 1/xLeft = N[LeftSum[f, 1, 2, 20]]


Producing a bar chart with height and color determined by two distinct lists

I am trying to visualize a list of positive integers using a bar chart. In general, integers in that list may appear more than once. For example, I may have               list=Sort@RandomInteger[{1,10},20]      > >     {1, 2, 2, 2, 3, 4, 5, 5, 6, 7, 8, 8, 8, 8, 8, 8, 8, 9, 10, 10} >   The bar chart I have in mind has the shape of               BarChart[DeleteDuplicates[list], BarSpacing -> 0, ChartBaseStyle -> EdgeForm[]]      > ![enter image description here](http://i.stack.imgur.com/mf8bH.png) It basically forgets about the multiplicity of each integer. I prefer to have the multiplicity reflected in the color of the bars, so               BarChart[Tally[list][[All, 2]], BarSpacing -> 0,          ChartBaseStyle -> EdgeForm[], ColorFunction -> "Rainbow"]      > ![enter image description here](http://i.stack.imgur.com/jLY8r.png) has the color scheme I want on my first bar chart. Here is a slightly more general problem: > Given two lists containing the same number of positive integers, to produce > a bar chart with heights and colors determined by the respective lists.


Drawing Graph Products

I need to draw graphs that are Cartesian products of 2 graphs. I need them to look like this: ![enter image description here](http://i.stack.imgur.com/EYWYC.gif). So each copy of the factors can have `LinearEmbedding`, but the whole drawing should be based on grid-like skeleton. Clearly, vertices should be on nodes of the grid, and edges can be arbitrary. Are there any solutions? In particular, for Grid Graphs the `SpringEmbedding` gives similar result, but even for Torus Graphs result is very different. I need to draw Cartesian products of complete graphs, cycles, paths, complete bipartite graphs, and add labels to edges of the products.


Second level depth pure function?

I have the following working construction:               Select[ln125, # == Nearest[ln125, 551.748][[1]] &]      Here, `ln125` is a one dimensional list. What I want further is to apply this construction not only to `ln125`, for example, but for a list of `{ln125,ln126,ln127}`. Let's say,               f[list_]:=Select[list, # == Nearest[list, 551.748][[1]] &]      I want to do this:               f /@ {ln125,ln126,ln127}.      The question is: is it possible to acheive my goal only using pure functions? That is, without defining dummy function (`f` in my case)? The problem is that definition of `f` already has pure function (as a criteria for `Select`) and, thus, there should be two pure function of different depths (don't know how to name it correctly) at once. In other words, I want to turn the `list` variable into `#` but in a way that _Mathematica_ can distinguish which `#` goes with each different pure function.


Different Plot Filling for multiple curves

_Warning: possibly dumb question :-(_ I have two functions I want to plot with the `Filling` option, like:               Plot[{Sin[t], Cos[t]}, {t, 0, 4 Pi}, Filling -> Axis]      That's OK. But if I only want the sine filled, and try               Plot[{Sin[t], Cos[t]}, {t, 0, 4 Pi}, Filling -> {Axis, None}]      MMA returns error messages that `Axis` and `None` are not valid Filling specifications. How can I selectively apply `Filling`?


Can individual locators in LocatorPane be temporarily disabled?

This follows up on another question about the sensitivity of Locators in a a LocatorPane. I would like to be able to enable/disable individual locators in a LocatorPane. In the simplified version of the applet, pictured below, I would like to be able to disable the locators that set the slope of the red line, while allowing the locators that set the slope of the blue line to remain enabled. ![locators](http://i.stack.imgur.com/FvA81.png) Using individual `Locator`s, rather than a `LocatorPane`, is not an option. (There are some subtle issues that arise with individual locators. Essentially, multiple `Locator`s can behave in a "flaky" fashion in complex applets, in ways that `LocatorPane` does not.) Code below:               Manipulate[m = 15;      LocatorPane[Dynamic[pts],       Dynamic[ Module[{x = pts[[1, 1]], y = pts[[2, 2]], x2 = pts[[3, 1]], y2 = pts[[4, 2]]},       Graphics[{       {Blue, Line[{-m*{x2, y2}, m*{x2, y2}}]},       Line[{{x2, 0}, {x2, y2}}], Line[{{x2, y2}, {0, y2}}],       {Red, Line[{-m*{x, y}, m*{x, y}}]},       Line[{{x, 0}, {x, y}}], Line[{{x, y}, {0, y}}]},       PlotRange -> m, Axes -> True, ImageSize -> {300, 300}]]],       {{{-m, 0}, {m, 0}, {1, 0}},         {{0, -m}, {0, m}, {0, 1}},         {{-m, 0}, {m, 0}, {1, 0}},         {{0, -m}, {0, m}, {0, 1}}},      Appearance -> {Automatic, Automatic, Automatic, Automatic}],       {{pts, {{6, 0}, {0, 9}, {3, 0}, {0, 7}}}, ControlType -> None}]      The **visibility** of the locators can be individually controlled by toggling the respective locator's `Appearance` between `None` and `Automatic`. But even when the locator is invisible (i.e. `Appearance -> None`) it continues enabled. For example, the red sliders will continue to set the slope of the red line. A possible solution would be to obtain the `Appearance` setting of the red sliders and make the assignment of `x` and `y` contingent on the Appearance setting.


Under what conditions does FinancialData return a ::notent message?

I tried retrieving `FinancialData` for a few companies but when I tried doing it for NTDOY, I couldn't. As of 25/12/2012, querying                FinancialData["PK:NTDOY"]      yields > FinancialData::notent: PK:NTDOY is not a known entity, class, or tag for > FinancialData. Use FinancialData[] for a list of entities. However, this is weird for two reasons. Firstly, `PK:NTDOY` is included in the list of financial instruments Mathematica supposedly has data for:                FinancialData["*NTD*"]      yields                {"JK:INTD", "NASDAQ:GKNTD", "NASDAQ:UNTD", "PK:ANTD", "PK:NTDMF", "PK:NTDOF", "PK:NTDOY"}      Secondly, if I try using free-form input, e.g. > = NTDOY price from 25 December 2011 to 25 December 2012 I get the same (notent) output; on the other hand, if I click on the orange "Show all results" plus symbol, I get a WA-like tab filled with meaningful data, even though sometimes Mathematica crashes while computing. So my question is: what does `FinancialData` truly mean when it states that something is not "known"? Is this a software bug or is it simply that more data is available to WolframAlpha than is to Mathematica? (I'm using Mathematica 8.0.1.0, by the way.)


How to draw a great circle on a sphere?

I apologize for the text description, but new users are not allowed to post images. I want to draw a circle that cuts through the center of a sphere and has an inclination of 15 degrees with the horizontal axes (equator). Actually, there are infinite number of great circles that can satisfy this requirement. If someone can show me how to make a `Manipulation`, that will be better.


Find the dimensions of a cylindrical can that will minimize the cost of the material

> A cylindrical can is to be made to hold 1 L of oil. Find the dimensions that > will minimize the cost of the metal to manufacture the can. This is a standard calculus problem. The volume of the cylinder is: `V == π r^2 h` The area of the cylinder is: `A[r_] := 2 π r^2 + 2 π r h /. h -> V/(π r^2)` Find `r` when the slope of the area is zero:               Reduce[A'[r] == 0]      Result:               (r == -(-(1/(2 π)))^(1/3) V^(1/3) ||         r == V^(1/3)/(2 π)^(1/3) ||         r == ((-1)^(2/3) V^(1/3))/(2 π)^(1/3)) && r != 0      As you can see, when I defined `A[r]`, I replaced `h` with an expression produced by solving the volume equation for `h`. My question is, is there a way to express the problem in terms of Reduce and a set of equations, without the manual solving for `h`? I.e. something along the lines of:               A[r_] := 2 π r^2 + 2 π r h          Reduce[{A'[r] == 0, V == π r^2 h}]      Of course, that doesn't yield the correct answer because `A'[r]` doesn't treat `h` as being in terms of `r`.


Selecting elements from a list one by one

I have an list:               l = {{4,5},{7,8},{9,5},{3,2},{1,2},{13,12}}.       I want to take the elements in the list in the sequential order. For example the first element in the list is `{4,5}` and I want to select the first member in the sub-list, `4`, then I want to go to the second element in the list `{7,8}` and to take the first element `7`. This process continues up to `{13,12}` and selecting `13`. How can I do this?


Solve matrix equation A*X=X*B using LeastSquares

I want to solve matrix equation `A*X=X*B` using LeastSquares method, but it is suited for equation like A*X=B. All matrices are 3x3               A = {{a11, a12, a13}, {a21, a22, a23}, {a31, a32, a33}}          B = {{b11, b12, b13}, {b21, b22, b23}, {b31, b32, b33}}          X = {{x11, x12, x13}, {x21, x22, x23}, {x31, x32, x33}}          a33=b33=x33=1, a31=0,a32=0.      How can I do this? **Update:** I figure out that it's special type of equation I'm trying to solve a special case of Sylvester equation in my case it looks like $$A*X=X*B$$ so it can be write in form $$A*X+X*(-B)=C$$ where C consist of all 0 items. I tried to solve it in Mathematica with LyapunovSolve but it gives me a all- zero trivial solution. So I want to check if a non-trivial solution exists. It seems I find out how to test matrices A,B for non-trivial solution (but I'm not sure) if resultant equals to 0, then such solution exist.$$\mathrm{resultant}(\mathrm{det}(A-λE),\mathrm{det}(B-λE),λ)=0$$ I tried real matrices for example `A = {{0 -1 300}, {1 0 0}, {0 0 1}}`, `B = {{-0.4009 -1.0787 446.1463}, {1.6180 0.8875 -159.2272}, { 0.0003 0.0029 1}}` but there is maybe a problem because B matrix was defined experimentally and it has some small errors, with these matrices I have resultant -6.79 , but due to erorrs I don't know may be it close enough to 0? My question is: Can you write condition of existence of non-trivial solution of Sylvester equation not in abstract form but in particular formula, preferably in Mathematica. Also I don't understand why Mathematica gives me only trivial solution, when I try to solve this equation with parameters. For example I tried               am = {{a11, a12, a13}, {a21, a22, a23}, {a31, a32, a33}}          bm = {{b11, b12, b13}, {b21, b22, b23}, {b31, b32, b33}}          cm = {{0, 0, 0}, {0, 0, 0}, {0, 0, 0}}          LyapunovSolve[am,bm,cm]      which gives me all 0. Also I tried to multiply matrices and get 9 equations and solve them with function Solve which also give me all 0.


Grid without lines, but with dots

I want to build a grid to look like the top-left table shown below, but without an outside frame. ![enter image description here](http://i.stack.imgur.com/3csys.jpg) Here is what I've tried to do:               a = {         {, , 2, 2, 2, 2,},         {, , 3, , 2, 0, 3},         {, 2, 2, , 3, , 3},         {2, 2, 2, , , , 2},         {2, 3, , , 1, ,},         {2, , 1, 3, , ,},         {3, 3, 3, 2, 3, , 3}         };          f = Riffle[#, "\[CenterDot]", {1, -1, 2}] &;          f /@ Transpose[f /@ a] // Transpose // Grid      ![enter image description here](http://i.stack.imgur.com/TMtEC.png) What I don't like in my result is that I have three times more dots than I need. And I don't know how to fix it. Suggestions?


Selectively clear DownValues

How can I clear a subset of a symbol's `DownValues` ? For example, suppose I have created some DownValues for $f$ like this:               (f[Sequence @@ #] = Plus @@ #) & /@ Subsets[{1, 2, 3}];     f[x_, y_] := x y          DownValues[f]         (*  {HoldPattern[f[]] :> 0, HoldPattern[f[1]] :> 1,       HoldPattern[f[2]] :> 2, HoldPattern[f[3]] :> 3,       HoldPattern[f[1, 2]] :> 3, HoldPattern[f[1, 3]] :> 4,       HoldPattern[f[2, 3]] :> 5, HoldPattern[f[1, 2, 3]] :> 6,       HoldPattern[f[x_, y_]] :> x y}  *)      I now wish to clear all the downvalues for which $f$ has exactly $n$ numerical arguments. In other words I would like to have a function `selectiveClear[f,n]` such that this would happen:               selectiveClear[f,2]     DownValues[f]     (*  {HoldPattern[f[]] :> 0, HoldPattern[f[1]] :> 1,       HoldPattern[f[2]] :> 2, HoldPattern[f[3]] :> 3,       HoldPattern[f[1, 2, 3]] :> 6, HoldPattern[f[x_, y_]] :> x y}  *)      I have tried using `Cases` to pick a subset of the `DownValues`, but I can't seem to get the pattern correct.


Select a directed SubGraph without sinks and sources

Consider the following problem: Assume you have a large list of directed edges, that constitute a large graph. I would like to provide an initial subset of vertices and I need to know which additional vertices I need to select in order to   1. make sure that the resulting (sub)-graph is connected   2. make sure that I don't have sink/source vertices, i.e. all vertices have at least one incoming and one outgoing edge.   3. minimize the number of additional vertices I don't have a working code (at least not for V8+). But assume the following directed edges:               ex = {"9" -> "7", "4" -> "6", "1" -> "9", "3" -> "5", "10" -> "8",         "5" -> "2", "2" -> "5", "9" -> "3", "3" -> "1", "7" -> "9",         "8" -> "6", "3" -> "10", "2" -> "1", "7" -> "4", "1" -> "4",         "2" -> "7", "5" -> "6", "7" -> "2"};          gr=Graph[ex, VertexLabels -> "Name", ImagePadding -> 20]      ![enter image description here](http://i.stack.imgur.com/MzpQf.png) Say, we initially choose vertices "1" and "3" and "7", then the subgraph has source/sinks:               Subgraph[gr, {"3", "1", "7"}, VertexLabels -> "Name", ImagePadding -> 20]      ![enter image description here](http://i.stack.imgur.com/0vH7I.png) Now, a possible completion of the graph without sinks/sources would be:               sgr=Subgraph[gr, {"3", "1", "9", "7"}, VertexLabels -> "Name",       ImagePadding -> 20]      ![enter image description here](http://i.stack.imgur.com/1sqMS.png)               HighlightGraph[gr, sgr]      ![enter image description here](http://i.stack.imgur.com/xVNbL.png) I understand that this problem might not have a unique solution. Any solution is fine for me. (The upgraded Graph capabilities of V8 are still mostly unexplored area for me, so I apologize for not having a working initial solution. My V7 approach stopped working so I hesitate in postin it here.) I need to do this for a large set of directed edges (10000+) so performance might be an issue as well. **Edit(new):** Following up on Szabolcs comments & answer the following works very well.               badguys[gr_] := Union[sinks[gr], sources[gr]]     healthyGraph[gr_] := FixedPoint[VertexDelete[#, badguys[#]] &, gr]     completeNetwork::ggraphx = "At least one of the vertices `1` is a sink or source.";     completeNetworkStep[g_?GraphQ, list_] /;        And @@ (MemberQ[VertexList[g], #] & /@ list) := Module[{clist},       (* connect the vertices*)       clist = connect[g, list];       (*remove sinks*)       clist = FixedPoint[step[sinks][g, #] &, clist];       (*remove sources*)       clist = FixedPoint[step[sources][g, #] &, clist]]     completeNetwork[g_?GraphQ, list_] /;        And @@ (MemberQ[VertexList[g], #] & /@ list) := Module[{hgr},       (* clean the network from sinks/sources*)       hgr = healthyGraph[g];       (* check if list of vertices is still part of the healthy graph*)       If[        And @@ (MemberQ[VertexList[hgr], #] & /@ list),        FixedPoint[completeNetworkStep[hgr, #] &, list],        Message[completeNetwork::ggraphx, list]; {}]       ]     ShowCompleteSubgraph[g_?GraphQ, list_] :=        HighlightGraph[g, Subgraph[g, completeNetwork[g, list]]]      In many instances the algorithm works very good. Some problems remain though. Consider the following setup:               vertices = {30, 43, 57, 1, 75, 24, 74, 94, 62, 47, 51, 89, 95, 87, 5,       73, 80, 91, 3, 67, 4, 8, 93, 18, 85, 49, 39, 13, 45, 79, 96, 98,       81, 19, 21, 15, 10, 60, 77, 76};     edges = {85 -> 4, 94 -> 95, 45 -> 18, 75 -> 3, 80 -> 30, 15 -> 80,        51 -> 21, 15 -> 43, 13 -> 95, 75 -> 91, 4 -> 30, 95 -> 76,        94 -> 51, 95 -> 21, 30 -> 45, 81 -> 96, 39 -> 13, 89 -> 1, 76 -> 3,       96 -> 47, 67 -> 77, 67 -> 10, 4 -> 24, 57 -> 89, 73 -> 95,        89 -> 51, 45 -> 80, 21 -> 8, 74 -> 73, 98 -> 96, 4 -> 76, 77 -> 79,       43 -> 93, 15 -> 19, 3 -> 57, 76 -> 15, 94 -> 24, 45 -> 15,        75 -> 89, 73 -> 60, 3 -> 49, 98 -> 10, 1 -> 43, 10 -> 15, 49 -> 5,        8 -> 79, 51 -> 10, 60 -> 51, 3 -> 13, 60 -> 43, 96 -> 62, 57 -> 4,        45 -> 95, 67 -> 5, 1 -> 4, 98 -> 30, 39 -> 75, 39 -> 18, 89 -> 75,        89 -> 15, 43 -> 39, 60 -> 10, 91 -> 39, 85 -> 8, 47 -> 89,        57 -> 85, 76 -> 39, 98 -> 95, 51 -> 73, 76 -> 8, 30 -> 49,        87 -> 49, 77 -> 93, 80 -> 21, 96 -> 57, 39 -> 76, 39 -> 30,        62 -> 91, 94 -> 10, 96 -> 81, 95 -> 75, 62 -> 77, 3 -> 87,        43 -> 87, 49 -> 24, 21 -> 87, 94 -> 39, 94 -> 98, 87 -> 89,        5 -> 13, 21 -> 67, 47 -> 5, 62 -> 47, 39 -> 47, 91 -> 60, 96 -> 76,       10 -> 79};     ini1 = {45, 4, 62, 15, 51};     exgr = Graph[edges, VertexLabels -> "Name"];     {{sinks@#, sources@#} &@       Subgraph[exgr, completeNetwork[exgr, ini1]], ini1,        completeNetwork[exgr, ini1]}      > {{{}, {96}}, {45, 4, 62, 15, 51}, {1, 4, 15, 21, 30, 43, 45, 47, 51, 57, 62, > 76, 87, 89, 96}} You see that a source vertex (96) remains. The graph looks like               ShowCompleteSubgraph[exgr, completeNetwork[exgr, ini1]]      ![enter image description here](http://i.stack.imgur.com/YXyFR.png) Apparently, vertex 62 from the initial list has only outgoing edges, except for 96->62. How can we modify the algorithm to open up routes along alternative edges?


How to choose the OpenCL device to use?

`OpenCLInformation` tells me that my computer has three available OpenCL devices. How can I choose which one to use for computations? How can I verify that Mathematica is honouring this choice? * * * The rest of this post is about how I tried to do this and failed: Here's what `SystemInformation[]` (as well as `OpenCLInformation[]`) gives me: ![](http://i.stack.imgur.com/Hycwc.png) (I am using OS X 10.9.1) I tried to control the device using `$OpenCLDevice`, like this: Load OpenCLLink:               In[1]:= Needs["OpenCLLink`"]      Check what device it would use:               In[2]:= {$OpenCLPlatform, $OpenCLDevice}         Out[2]= {Automatic, Automatic}      According to the docs, >   * Set to Automatic, the OpenCL computation is performed on the fastest > device. >   * Changes to `$OpenCLDevice` performed after execution of an OpenCLLink > function are ignored. >   * If modified, then `$OpenCLPlatform` must be changed also. > So as I understand, I must set both of these variables, and I must set them _before_ running any computations. Let's do it now:               In[3]:= $OpenCLPlatform = 1;         $OpenCLDevice = 2;          In[5]:= {$OpenCLPlatform, $OpenCLDevice}         Out[5]= {1, 2}      Now let's try a simple computation borrowed from the documentation:               In[6]:= doubleFun = OpenCLFunctionLoad["       __kernel void doubleVec(__global mint * in,  mint length) {           int index = get_global_id(0);              if (index < length)           in[index] = 2*in[index];         }", "doubleVec", {{_Integer}, _Integer}, 256]          Out[6]= OpenCLFunction["<>", "doubleVec", {{_Integer}, "Integer64"}]          In[7]:= doubleFun[Range[20], 20]     Out[7]= {{2, 4, 6, 8, 10, 12, 14, 16, 18, 20, 22, 24, 26, 28, 30, 32, 34, 36, 38, 40}}      It did work, but I wonder which device was used ...               In[8]:= $OpenCLDevice     Out[8]= 3      It appears it was device 3, not device 2, which I wanted to use. How can I force the system to use device 2, which is supposed to be faster than device 3? Device 2 on my machine is an NVIDIA GPU and it works correctly with CUDALink. The documentation says that if a device works with CUDALink, it should also work with OpenCLLink.


Automatically use InputOnly style

Some of the built-in Stylesheets (e.g. _PastelColor_ ) connect together input and output cells by setting the `CellFrame` and `CellMargins` of the bottom of the input cell and the top of the output cell to zero. However, when there is no output the input cell looks ugly because it is missing the bottom part of its frame. There is a style defined in the Stylesheet called _InputOnly_ which has a full frame and looks much better, but I have to apply it manually with the Format/Style menu (select Other and type "InputOnly" into the input field). ![enter image description here](http://i.stack.imgur.com/MJ6Cs.png) Is there a way to get Mathematica to automatically use the _InputOnly_ style for input cells with no corresponding output?


Recognizing a generalized function as zero

Consider the following expression:               HeavisideTheta[x]HeavisideTheta[-x]      Mathematica will not simplify it further. But $\Theta(x)\Theta(-x)$ is zero if considered as a generalized function, since you get zero if you integrate it against any test function: $\int dx\ \Theta(x)\Theta(-x) \varphi(x) = 0$ . I have a long list of similar such expressions, in the variables $x1,x2,y1,y2$, such as:                HeavisideTheta[x1-y1] HeavisideTheta[x2-y2] HeavisideTheta[-x1,-x2,-x1+x2,y1,-y1+y2]      DiracDelta[x1+x2-y1-y2] HeavisideTheta[-x1,-x2,-x1+x2,x1-y2,-y1+y2]      For either of these, one can integrate against any test function $\varphi(x1,x2,y1,y2)$ and get zero. How can I get Mathematica to recognize such expressions as zero in a timely way? I tried defining a function:               procedure[expr_]:=      that would yield zero on such expressions. One way that works is to FourierTransform in all four variables; however, this takes hours for some of the expressions. For completeness, let me write out the full versions of the two example terms above, as they appear in my application:               -(1/4)a^2 Exp[(2a + i b)(y1-x1)-(1/4)(a + 4 i b)(x2-y2)] HeavisideTheta[x1-y1] HeavisideTheta[x2-y2] HeavisideTheta[-x1,-x2,-x1+x2,y1,-y1+y2]     2 Exp[(3/4)(y2-x1)b] DiracDelta[x1+x2-y1-y2] HeavisideTheta[-x1,-x2,-x1+x2,x1-y2,-y1+y2]      The extra prefactors don't make any difference mathematically (either term is still zero as a generalized function), but they may make it more difficult for Mathematica. Thanks!


Error in the result

I want solve the following equation: > $ x''(t) + 9 x(t) = Cos(3t) ,\; t \in [0,10] $ > > $ x(0)= x'(0) =1$ I have to use the Explicit Euler method and a partition of the interval in $N+1$ subintervals (with $N=60$). I have done this:               f[x_, {u_, v_}] = -9*u + Cos[3 x]     a = 0;     b = 10;     α = 1;     β = 1;     M = 60;     EulerExplicito[f_, α_, a_, b_, M_] := Module[{x, y, h},         h = N[(b - a)/M];         x = {a};         y = {α};         Do[AppendTo[y, y[[i]] + h*f[x[[i]], y[[i]]]];            AppendTo[x, x[[i]] + h], {i, 1, M}];         Return[Transpose[{x, y}]];         ]          aproxEuler = EulerExplicito[f, {α, β}, a, b, M]     N[aproxEuler]      I don't know what I have to change, but the result is bad.


Why FrontEnd`KernelExecute doesn't work in KeyEventTranslations.tr?

Which commands can you put in `KeyEventTranslations.tr` ? There is an extensive list of FrontEndTokens, but what else can you use? Why something like this doesn't work:               Item[KeyEvent["r", Modifiers -> {Command}],      FrontEndExecute[{         FrontEnd`KernelExecute[ToExpression["Quit[]"]],         FrontEndToken[SelectedNotebook[], "EvaluatorStart", "Local"]      }]     ],      With `FrontEnd```KernelExecute` one could put any command there, but what's the trick? ## Edit (some more observations) This does work in `MenuSetup.tr`, like explained here (and of course in the current session). Menu items can be executed by a Kernel or FrontEnd. However, for each item there can be only one MenuEvaluator, so after quitting Kernel the rest of commands will not be executed. Also, for some reason, `KernelExecute`, when started from Menu or a button (not from a Cell), is not only queued to Kernel, but has priority!


Map a function across a list conditionally

It seems that this is a really basic question, and I feel that the answer should be obvious to me. However, I am not seeing. Can you please help me? Thanks. Suppose I have a list of data `list` and a selector list `sel`. I would like to `Map` some function `f` onto elements in `list` that correspond to `True` in the selector list `sel`. Thus for the input               list = {1, 10, 100};     sel = {True, False, True};      I would like to obtain the output               {f[1], 10, f[100]}      I can think of some complicated ways to accomplish this (e.g., using `Table` to step through both `list` and `sel` using an iterator `i`; or find the positions of `True` in `sel` using `Position` and then `MapAt` at those positions), but not simple ways. Do you have any advice?


Creating a plot without an x-axis and automatic ticks for the y-axis

I am trying to plot a function with specific options for the appearance of the plot. I want the X axis to not show up, and the Y axis to be labeled normally (i.e. numbers outside the plot).. Yet, I don't get any numbers in the Y axis' ticks: ![](http://i.stack.imgur.com/baC8b.png) The code I am using is the following (the function to be plotted is different, but still returns this behavior):               Plot[5 t + 3, {t, 0, 10},         PlotRange -> All,         AxesOrigin -> {10, 0},              LabelStyle -> {FontFamily -> "Arial", Bold, 40},         Axes -> {False, True},         PlotStyle -> {{Thickness[0.007], Darker[Blue, 0.5]}},              AxesStyle -> AbsoluteThickness[3], ImageSize -> {640, 480}     ]      Could you please help me get the ticks numbered automatically?


Manipulate Exp[I θ]+b Exp[-I θ]

I've uploaded an image showing a demonstration I'd like to create, but I definitely need help. There is a lot of talent on this list, so maybe someone can help me get started learning how to add graphics to a plot and animate them. What I'd like to create is a `Manipulate` demonstration that will animate the plot of `Exp[I θ] + b Exp[-I θ]`, where `b` is a real number between 0 and 1. As you can see in the attached figure, I want to draw two circles centered at the origin, one with radius 1, the second with radius `b`. I'd like the `Manipulate` to have a slider that will allow me to vary the value of `b` between 0 and 1. Next, I want to draw the vectors `Exp[I θ]` and the vector `b Exp[-I θ]`, as pictured in the sketch. Then I want to complete the parallelogram and draw the vector `Exp[I θ] + b Exp[-I θ]`. I also want a slider for `θ`that varies from 0 to 2 π, and when I move the slider, I want to see all of the vectors move, the parallelogram adjust, and the tip of the vector `Exp[I θ] + b Exp[-I θ]` trace out the dotted ellipse. I'd really appreciate it if someone could show me how to do this. ![Exp\[I Theta\] + b Exp\[-I Theta\]](http://i.stack.imgur.com/z5xpf.png) * * * This was overlooked in the initial answers:   **How do we add the curve`Exp[I θ] + b Exp[-I θ]` to the figure?**


Why does pattern test not work in this case to restrict the function parameters?

I was looking at this Q&A about using pattern test (`pattern_?test`) vs pattern condition (`pattern_/;cond`) and came across this example where using condition was the only possible way to restrict the function parameters (function definition added by me):               Clear[fCond]     fCond[x__ /; Plus[x] == 7] := {x}^2     fCond[1, 2, 4]     (* {1, 4, 16} *)      I know that, aside from the built-in tests in MMA (IntegerQ, NumericQ, eg), one can write custom pattern tests using pure functions [2]: ![test pure function](http://i.stack.imgur.com/BCUlK.png) Hence, I was trying to be clever by using tests with sequence pattern (__) coupled with sequence argument for pure function (##). However, this did not work when plugging in values for the parameter/pattern.               Clear[fTest]     fTest[x__?(Plus[##] == 7 &)] := {x}^2     fTest[1, 2, 4]     (* fTest[1, 2, 4] *)      , even though the pure function test alone does work with the plugged in sequence               Plus[##] == 7 &[1, 2, 4]     (* True *)      Why doesn't pattern test work via this method? If so, is there any other way to do pattern test as opposed to pattern condition in this case? [2]: Ruskeepaa's Mathematica Navigator 2009 p.498


Notation not recursive enough?

My notation is not recursing enough. For example,               Notation[W[a_ | b_] ⟹ foo[a_, b_]/foo[b_]]     Notation[W[a__, b_ | c_] ⟹ W[a__ | c_]W[b_ | c_]]      Then               W[a, b, c, d | e]      will give               foo[d, e]W[a, b, c | e]/foo[e]      My question is why does the `W[a, b, c | e]` in the above not expand further until it gets to the `foo` level?


Mathematica color schemes for the colorblind

Does _Mathematica_ have a graphics option that makes plots intelligible for people with colorblindness?


FindInstance returns Indeterminate in version 9, but not in 8

Here is a trivial system of equations in three unknowns for which `FindInstance` obtains a solution:               FindInstance[      c3 + c2 == 1 && c1 == 0 && -c2 == 0, {c1, c2, c3}]          (* ==> {{c1 -> 0, c2 -> 0, c3 -> 1}} *)      But in my application, I have a linear system where I want to rule out the trivial solution `c1==c2==c3` with an inequality:               FindInstance[      (c3 != 0 || c2 != 0) && c1 == 0 && -c2 == 0, {c1, c2, c3}]          (* ==> {{c1 -> 0, c2 -> Indeterminate, c3 -> 1}} *)      This incorrectly returns `Indeterminate` for `c2` only in _Mathematica_ version 9, whereas it gives a correct result `c2 -> 0` in version 8. In general, my variables are complex so that I can't restrict the domain to `Reals` (which solves the problem in this simple example). My current solution to this issue is to replace the inequality by an equation, e.g., `Norm[{c1, c2, c3}] ==1`. But I would like to understand (if at all possible) what change between versions is causing the `Indeterminate` result. I have a version-8 notebook that suddenly produced `Indeterminate` in over half its calculations, and there is no documented change in `FindInstance` that I'm aware of. So I'd like to hear what the safest and/or most efficient way would be to rule out the trivial solution in `FindInstance` for a system of linear equations.


Why does my code work one way in Mathematica and another way in PlayerPro?

I wrote the following simple code and deployed it as a `CDF`.                  Button["Ok", (SystemDialogInput["FileSave", ".PDF"])]      If I open the `CDF` file in _Mathematica_ and click on the button, it brings up this dialog: ![enter image description here](http://i.stack.imgur.com/jNJfA.png) If I open the `CDF` file in MathematicaPlayerPro and click on the button, it brings up a different dialog: ![enter image description here](http://i.stack.imgur.com/Ai5kM.png) How can I get the same dialog from MathematicaPlayerPro as I get from _Mathematica_?


Defining a function that differentiates another function with rule replacement

This question is related to the question I posted here. In that question, I thought I have simplified my original problem into an equivalent concise version, but I found that it is not. So I decided to open this question. The goal is the same that I want to define a function `hhpar` that will differentiate `hh` with respect to x, while I changed the rule function as follows:               Clear[rule];     rulelist = {{tt -> 1, zz -> 1}, {tt -> 1, zz -> 2}, {tt -> 2,          zz -> 1}, {tt -> 2, zz -> 2}};     rule[i_] := rulelist[[i]];      The `hh` function is               Clear[hh];     hh[x_, y_, i_] := {{tt, x + Sin[x]},{y, zz}}/.rule[i];      As suggested by Szabolcs, to defined `hhpar` as               hhpar[x_,y_,i_]:=Derivative[1, 0, 0][hh][x, y, i]      will solve my former question. But it didn't work in current problem because it only gives ![result](http://i.stack.imgur.com/XW6UT.png) **Using`Trace`, I figure out that the problem is due to the failure of rule replacement before differentiation.** But how would I define `hhpar` now to solve the problem?


Fast Sieve Implementation

I'm going to write a code to compete in performance with NewPGen. The goal is to sieve numbers that have small factors. Mine is very slow in compare with NewPGen. Here's my code:               random = RandomPrime[10^1000];      list = Table[k random + 1, {k, 1, 2000}];          counter = 2000;          Do[      Do[       If[list[[index]] != 0 && Divisible[list[[index]], Prime[p]],         list[[index]] = 0; counter--],       {index, 1, 2000}],      {p, 1, 10000}]      How can I improve it to sieve more in less time? **Updated** Timing for initial code: > 31.125 then I've noticed if I remove list processing codes a whopping 15x speedup would occur!!!               Timing[      Do[       Do[        If[Divisible[n, Prime[p]], list = Delete[list, Position[list, n]];         counter--],        {n, list}],       {p, 1, 10000}]      ]      > 1.969 seconds for Sieve up to 10,000th prime > > 38.11 seconds for Sieve up to 200,000th prime (20 fold increase) The achieved speedup was for small 2K digits numbers so the only problem with my second implementation is that if my numbers have 100K or more digits then I guess iterating in first loop would makes the code so slow. Any further optimize? **Updated 2** Timings for 1000 digits numbers and sieving up to 1,000,000th prime               {3.23, Daniel Lichtblau second solution}     {6.87, Daniel Lichtblau first solution}     {48.85, Simoon Woods}     {81.96 , b.gatessucks}     {212.81, myself!}      * * * Timings for 100,000 digits numbers and sieving up to 10,000th prime !!!               {7.65, Daniel Lichtblau second solution}     {24.01, Daniel Lichtblau first solution}         {176.87, Simoon Woods}     {187.92 , b.gatessucks}      * * * Timings for 100,000 digits numbers and sieving up to 100,000th prime !                {5.00, NewPGen} (Does anybody know its sieve method?)      {148.46, Daniel Lichtblau second solution}      --- edit by DL --- I hope you will pardon an edit from me (and feel free to change or delete it if you like). I am wondering if your comparison is to what you think. The numbers you generate as k*random+1 are not of the form actually used by NewPGen. The code below looks like it might more plausibly get what you want. Here I generate 2000 values each of a bit more than 100,000 digits.               SeedRandom[111111];     k = 5;     random = RandomInteger[{10^k, 10^k + 10^(k - 1)}];     list = Table[k 10^random + 1, {k, 1, 2000}];      Size check:               Length[IntegerDigits[First[list]]]          (* Out[222]= 103210 *)      I changed the product set to simply prepend 2 rather than multiply an element by 2. No real difference here, just wanted to try it out.               npower = 4;     pprods2 =        Apply[Times,         Table[Prime[Range[10^j + 1, 10^(j + 1)]], {j, 0, npower}], 2];          pprods2 = Prepend[pprods2, 2];      Here is the test.               Timing[      res2 = Last[         Reap[Do[Do[            If[GCD[n, prod] != 1, Sow[n]; Break[]], {prod, pprods2}], {n,             list}]]];]          Length[res2[[1]]]          (* Out[220]= {26.170000, Null}          Out[221]= 1795 *)      It's not 5 seconds but also it's not 150 seconds. Somewhere around the geometric mean, actually. I do not know what NewPGen does but it is possible that it involves aggregating primes into products in a way that is more effective than what I did. --- end DL edit ---


Mathematica9: NDSolve slows down after repeated calls

I have noted that in Mathematica 9 my code, which involves a lot of calls to NDSolve, slows down considerably after some time. Apparently, the problem is NDSolve itself and it seems to be related to Mathematica 9, as the following example shows:               RunNDSolve :=  Timing[Do[NDSolve[{f''[x] == -f[x], f[0] == 1, f'[0] == 0},{f[x]}, {x, 0, 1}], {1000}]][[1]]      RunNDSolve integrates a simple differential equation 1000 times using NDSolve and returns the time needed to carry out the integrations. In Mathematica 9, RunNDSolve takes longer and longer times as it is called again, as the following example shows:               Table[{j, RunNDSolve}, {j, 50}]      In Mathematica 9 (extract of the full result):               j, RunNDSolve     1, 0.712     10, 2.649000     20, 4.869000     30, 7.326000     50, 13.372000      In Mathematica 8 (extract of the full result):               j, RunNDSolve     1, 0.5880000000000001`     10, 0.593`     20, 0.5719999999999992`     30, 0.5670000000000002`     40, 0.5770000000000017`     50, 0.5850000000000009`      Does anyone have an idea what the problem could be and how to fix it?


Systematic increase in runtime

When I run this simple code, which repeats many times the exact same operation (a differential equation), the runtime (given by `Timing`) increases systematically, from roughly 1 second to 5. I am using Math 9.0.1.0 on a MacBook Air. (Edit: the problem is not reproduced when running the same code with Mathematica 7 on a Linux machine.) Can somebody else reproduce this? Does anybody know why and what can I do to avoid it?               Clear[delta];     delta := NDSolve[{y''[n] + y'[n] - y[n] == 0, y[-3] == 1, y'[-3] == 1}, y, {n, -3, 0}];     Do[{time = Timing[Do[delta, {a, 1000}]]; Print[time]}, {i, 10}]


CUDALink is not initialized

I've upgraded to Mathematica 9.0 on Ubuntu 12.04 with the latest Nvidia driver (304.64). I load CUDA by using, as usual, `Needs["CUDALink`"]`. `CUDAQ[]` reports True.   `CUDAInformation[]` reports: > >     {1 -> {"Name" -> "GeForce GT 330M", "Clock Rate" -> 1265000, >        "Compute Capabilities" -> 1.2, "GPU Overlap" -> 1, >        "Maximum Block Dimensions" -> {512, 512, 64}, >        "Maximum Grid Dimensions" -> {65535, 65535, 1}, >        "Maximum Threads Per Block" -> 512, >        "Maximum Shared Memory Per Block" -> 16384, >        "Total Constant Memory" -> 65536, "Warp Size" -> 32, >        "Maximum Pitch" -> 2147483647, >        "Maximum Registers Per Block" -> 16384, "Texture Alignment" -> 256, >         "Multiprocessor Count" -> 6, "Core Count" -> 48, >        "Execution Timeout" -> 1, "Integrated" -> False, >        "Can Map Host Memory" -> True, "Compute Mode" -> "Default", >        "Texture1D Width" -> 8192, "Texture2D Width" -> 65536, >        "Texture2D Height" -> 32768, "Texture3D Width" -> 2048, >        "Texture3D Height" -> 2048, "Texture3D Depth" -> 2048, >        "Texture2D Array Width" -> 8192, "Texture2D Array Height" -> 8192, >        "Texture2D Array Slices" -> 512, "Surface Alignment" -> 256, >        "Concurrent Kernels" -> False, "ECC Enabled" -> False, >        "TCC Enabled" -> False, "Total Memory" -> 1073414144}} >   It seems that everything works. But if try to perform the following:               randM = RandomReal[1, {1000, 1000}];     CUDADot[randM, randM];      I get: > CUDADot::notinit: CUDALink is not initialized. What does it mean? I already tryied googling looking for the error message... nothing found. Thanks in advice to whom can shed light.


Efficient implementation of cubic equation of state

...In this case the Peng Robinson Equation of State. Equations of state are empirical equations with parameters derived from experimental data. They are used to predict pure component and mixture properties such as compressibility, fugacity, and mixture equilibriums. See Wikipedia. Although I'm dealing with a Peng-Robinson EOS here, the algorithm can be applied to any other cubic EOS such as Van der Waals or Redlich–Kwong. The equation is defined as such: $p=\frac{R T}{V_m-b}-\frac{a}{-b^2+2 b V_m+V_m^2}$ where $a=\frac{0.457235 R^2 T_c^2}{p_c} \alpha(T)$ $b = 0.07780 \frac{R T_c}{p_c}$ $\alpha(T) = [1+\kappa(1-(\frac{T}{T_c})^\frac{1}{2})]^2$ $\kappa = 0.37464+1.54226\omega-0.26992\omega^2$. Translated into polynomial form: $A = \frac{a p}{R^2 T^2}$ and $B = \frac{b p}{R T}$ which leads to the cubic form: $Z^3-(1-B)Z^2+(A-2B-3B^2)Z-(A B - B^2 -B^3)=0$ When dealing with multi-component mixtures, Van der Waals mixing rules can be implemented as such: $amix =\sum_{i=1}^N \sum_{j=1}^N x_i x_j Aij $ $bmix = \sum_{i=1}^N x_i b_i$ where $Aij = Aji = (a_i a_j)^\frac{1}{2} (1-kij)$ The experimental parameters provided from literature are $T_c$ (critical temperatures), $P_c$ (critical pressures), $R$ (universal gas constant), $\omega$ (acentric factor), and $kij$ (binary interaction parameters). The component molar compositions are $x_i$ and is $N$ in length. When solving the cubic equation there will, of course, be three roots. The max real root is the vapor root, and if a liquid phase is present, the min real root is the liquid root. The middle root is a fake root. If there is no liquid phase present, the vapor root will be the only real root. What is the most efficient (both in terms of memory and speed) way to implement this algorithm to calculate the vapor z-factor?


Forming an upper triangular matrix from the elements of a list

I asked this question before, but i was closed because it the question was not comprehensible enough. So i reworded it, hope that's ok. * * * I have a list with 6 elements.               {a1, a2, a3, a4, a5, a6}      Now, I want to generate a upper triangle matrix with the elements above as matrix elements, so that the matrix reads               {{a1, a4, a6}, {0, a2, a5}, {0, 0, a3}}      That is, the triangle upper matrix matrix shall be filled up with the elements of the list. It is not important where each element is placed. I want to do this also with larger matrices, so for example a list with 36 elements shall form a 8 x 8 upper triangle matrix. Any ideas?


Is there a way to prevent audio from becoming out of sync with graphics?

The code below could be used to say help Pre-Kindergarten and Kindergarten children learn about the numerals and numbers from one to 9. The problem is that this age group would be prone to just pressing buttons and it is easy to get the audio out of sync with the graphics. I have played around with Pause[different values] placed after the Speak statements and Enabled->False/Enabled->True as well as SynchronousUpdating -> False. I was hoping that someone might be able to tell me whether I was on the right track or if there is a different function I should look at. I would also appreciate if someone could tell me a way to follow the flow of the way the code is read by the computer (I have tried Trace with little success), that would give me an idea of where to best place Pauses, etc. (I want to thank John Fultz for contributions previously made to this manipulate.) Thank You               Manipulate[       Pane[Column[{Text[           Row[If[n < 2, {Spacer[160],              Style[nnames[[n]], Bold, Large, Hue[RandomReal[]]],              Style[" Ball", Bold, Large, Green]}, {Spacer[160],              Style[nnames[[n]], Bold, Large, Hue[RandomReal[]]],              Style[" Balls", Bold, Large, Green]}]]],          Row[Table[Graphics[{              Darker[Green], Disk[],              Text[Style[numerals[[ r]], Orange, "Label", 48], {0,                0}]}], {r, 1, n}]           ]}, BaseStyle -> {LinebreakAdjustments -> {1., 10, 0, 0,             10}}], {525, 300}],       Row[{Button[          " Start  \n ", {n = 1,           Speak["lets count the numbers 1 to 9 out loud. One"]}],         Spacer[55],         Button[          "\[FilledLeftTriangle]\[FilledLeftTriangle] Start Over", {n = 1,           Speak["one"]}],         Button[          "\[FilledLeftTriangle] Less", {If[            n < 2, {n = 1,             Speak["Today we are just working on the numbers from one to \      nine."]}, {n -= 1, Speak[n]}]}], Spacer[10],         Button[          "More \[FilledRightTriangle]", {If[            n > 8, {n = 9,             Speak["Lets learn the numbers from one to nine before we go \      on."]}, {n += 1, Speak[n]}]}],         Button[          "All \[FilledRightTriangle]\[FilledRightTriangle]", {n = 9,           Speak["nine"]}]         }],       {{n, 9, " "}, ControlType -> None},       Initialization :> (         numerals = {"1", "2", "3", "4", "5", "6", "7", "8", "9"};         nnames = {"One", "Two", "Three", "Four", "Five", "Six", "Seven",           "Eight", "Nine"};)]


Can a large Grid of 3DListPlots be rotated by a single Dynamic control?

So I have a few hundred plots in a grid, that I thought would be nice to adjust the data view with a Dynamic slider. I'm using Jens solution for the Grid plotting here . Manipulating multiple plots in this way would be a great way to compare different portions of complex 3D plots. What I have tried provides only the controls but no plot movement in each part of the grid. Here's the code:               data = {{48.76`, 63.49`, 72.76`, 76.78`, 78.02`, 78.96`, 79.73`,      80.41`, 81.21`, 81.83`, 82.39`, 83.03`, 83.56`, 84, 84.42`,      84.53`, 84.69`, 84.74`, 84.55`, 84.73`, 84.56`, 84.47`, 84.31`,      84.25`, 84.09`, 83.81`, 83.67`, 83.58`, 83.39`, 83.05`, 82.76`,      82.49`, 82.35`, 82.33`, 82.16`, 82.06`}, {42.08`, 57.42`, 67.24`,      72.1`, 73.91`, 75.4`, 76.73`, 77.54`, 77.96`, 77.76`, 77.04`,      75.64`, 74.02`, 72.55`, 71.15`, 70.15`, 70.04`, 69.92`, 69.35`,      69.21`, 69.33`, 69.99`, 70.29`, 70.17`, 69.92`, 69.77`, 70.09`,      70.87`, 71.69`, 72.08`, 71.95`, 71.48`, 70.77`, 70.14`, 69.89`,      70.46`}, {42.03`, 56.78`, 66.37`, 70.92`, 72.63`, 74, 75.27`,      76.02`, 76.44`, 76.32`, 75.7`, 74.46`, 72.96`, 71.53`, 70.1`,      69.06`, 68.94`, 68.84`, 68.22`, 68.03`, 68.19`, 68.93`, 69.25`,      69.12`, 68.84`, 68.71`, 69.1`, 69.89`, 70.76`, 71.15`, 71.03`,      70.59`, 69.92`, 69.35`, 69.18`, 69.79`}, {39.03`, 53.63`, 63.5`,      68.37`, 70.26`, 71.8`, 73.19`, 73.93`, 74.24`, 73.92`, 72.91`,      71.04`, 68.78`, 66.59`, 64.33`, 62.75`, 62.43`, 62.19`, 61.25`,      60.78`, 61.04`, 62.1`, 62.66`, 62.45`, 62.06`, 61.91`, 62.52`,      63.73`, 65.08`, 65.81`, 65.78`, 65.28`, 64.36`, 63.57`, 63.44`,      64.42`}, {31.22`, 46.21`, 57.41`, 63.54`, 66.14`, 68.43`, 70.44`,      71.39`, 71.38`, 70.37`, 68.2`, 64.36`, 59.76`, 55.23`, 50.36`,      46.94`, 45.98`, 45.24`, 43.14`, 41.64`, 42.14`, 44.33`, 45.51`,      45.06`, 44.19`, 44.02`, 45.32`, 47.88`, 50.81`, 52.62`, 52.78`,      52.06`, 50.5`, 49.01`, 49.26`, 51.58`}, {26.44`, 40.79`, 52.46`,      59, 61.93`, 64.58`, 66.88`, 67.92`, 67.76`, 66.38`, 63.6`, 58.72`,      52.92`, 47.21`, 41.06`, 36.78`, 35.48`, 34.49`, 31.86`, 29.83`,      30.43`, 33.14`, 34.6`, 34.03`, 32.93`, 32.74`, 34.34`, 37.51`,      41.2`, 43.52`, 43.79`, 42.96`, 41.05`, 39.21`, 39.61`,      42.46`}, {22.15`, 36.49`, 49.02`, 56.44`, 59.88`, 62.99`, 65.73`,      66.93`, 66.45`, 64.57`, 60.92`, 54.74`, 47.62`, 40.78`, 33.58`,      28.71`, 27.21`, 26.08`, 23.15`, 20.89`, 21.54`, 24.47`, 26.08`,      25.45`, 24.24`, 24.08`, 25.86`, 29.41`, 33.6`, 36.35`, 36.72`,      35.8`, 33.66`, 31.63`, 32.2`, 35.6`}, {20.01`, 33.94`, 46.53`,      54.05`, 57.59`, 60.8`, 63.56`, 64.79`, 64.3`, 62.28`, 58.44`,      51.89`, 44.29`, 36.94`, 29.19`, 23.96`, 22.35`, 21.13`, 18.05`,      15.69`, 16.37`, 19.42`, 21.11`, 20.41`, 19.13`, 18.95`, 20.8`,      24.56`, 29.03`, 31.97`, 32.39`, 31.44`, 29.18`, 27.01`, 27.62`,      31.29`}, {18.84`, 32.74`, 45.29`, 52.81`, 56.47`, 59.72`, 62.63`,      63.89`, 63.37`, 61.31`, 57.38`, 50.67`, 42.9`, 35.39`, 27.53`,      22.23`, 20.58`, 19.35`, 16.25`, 13.85`, 14.51`, 17.54`, 19.22`,      18.53`, 17.25`, 17.06`, 18.91`, 22.67`, 27.19`, 30.17`, 30.61`,      29.66`, 27.37`, 25.16`, 25.81`, 29.51`}, {18.4`, 32.15`, 45.16`,      53.05`, 56.88`, 60.39`, 63.55`, 64.83`, 64.16`, 61.86`, 57.5`,      50.25`, 42.03`, 34.26`, 26.29`, 21.02`, 19.39`, 18.18`, 15.16`,      12.84`, 13.47`, 16.4`, 18, 17.31`, 16.04`, 15.85`, 17.63`, 21.31`,      25.79`, 28.79`, 29.22`, 28.25`, 25.92`, 23.72`, 24.38`,      28.08`}, {17.83`, 31.87`, 44.91`, 53, 56.88`, 60.41`, 63.52`,      64.85`, 64.22`, 61.88`, 57.5`, 50.17`, 41.77`, 33.79`, 25.52`,      20.04`, 18.35`, 17.08`, 13.94`, 11.54`, 12.2`, 15.23`, 16.93`,      16.21`, 14.92`, 14.73`, 16.6`, 20.44`, 25.11`, 28.25`, 28.72`,      27.72`, 25.33`, 23.07`, 23.77`, 27.65`}, {17.54`, 31.72`, 45.01`,      53.08`, 57, 60.61`, 63.78`, 65.09`, 64.41`, 62.05`, 57.6`, 50.13`,      41.53`, 33.28`, 24.72`, 19.04`, 17.29`, 15.99`, 12.78`, 10.36`,      11.05`, 14.16`, 15.9`, 15.16`, 13.82`, 13.64`, 15.58`, 19.54`,      24.4`, 27.63`, 28.12`, 27.11`, 24.64`, 22.28`, 23.06`,      27.08`}, {17.39`, 31.68`, 45.1`, 53.25`, 57.15`, 60.74`, 63.93`,      65.22`, 64.55`, 62.22`, 57.77`, 50.24`, 41.55`, 33.19`, 24.5`,      18.73`, 16.96`, 15.64`, 12.41`, 10, 10.71`, 13.83`, 15.58`,      14.83`, 13.47`, 13.31`, 15.26`, 19.27`, 24.16`, 27.44`, 27.9`,      26.86`, 24.37`, 22, 22.75`, 26.82`}};          colors = {{0.7287575298024244`, 0.7339864463878705`,      0.7026006086390431`}, {0.6289819930163401`, 0.6365127030634212`,      0.6844689735555467`}, {0.6218872719584807`, 0.6291939975325622`,      0.6746374720508842`}, {0.5730715498598071`, 0.5857318485351554`,      0.6620239643337804`}, {0.441983024141705`, 0.4759561171496433`,      0.6487718794019985`}, {0.3606003554322766`, 0.40567334439789926`,      0.627344738546594`}, {0.29821481618583157`, 0.35028613226131583`,      0.6207483334714696`}, {0.26170396681489294`, 0.3180653165748131`,      0.6074454612600748`}, {0.24821850657723366`, 0.3062608953469176`,      0.6013376700066071`}, {0.23989935134493884`, 0.29818014681271343`,      0.6066793976522843`}, {0.2312613188553745`, 0.2914238732429747`,      0.607574894211413`}, {0.22314413852557222`, 0.28475555212948533`,      0.6097101784633595`}, {0.2204849069272225`, 0.2827947917381827`,      0.6110365712113156`}};     n = 15;     data = ConstantArray[data, n];     colors = ConstantArray[colors, n];               Manipulate[      Show[plotGrid[        Partition[         Table[ListPlot3D[data[[i]],        ColorFunction -> (Blend[RGBColor @@@ colors[[i]], #2] &),        BoxStyle -> Directive[Red, Opacity[.5]], Axes -> None,        Mesh -> None, BoundaryStyle -> Directive[Black, Thick],        PlotLegends -> Automatic], {i, n}], 5], 600, 300],        Background -> Black], {{a, 0}, 0, 4 Pi}, {{b, .01}, -Pi, Pi},       ContentSize -> {600, 300}]


Named patterns as function argument descriptors

I have a function `timeToMinutes` that takes a 24-hour time as a string argument (in digital clock format, e.g., "15:47") and converts it to the number of minutes past the last midnight. For instance, `timeToMinutes["3:45"]` yields `225`. Here is the function as I have written it:               timeToMinutes[time_] :=        Function[pair, 60*pair[[1]] + pair[[2]]]@(ToExpression /@ time~StringSplit~":");      First it splits the string at the colon, then converts the two resultant strings to a pair of expressions, then sums 60 times the first member of the pair and one times the second member of the pair. This works fine, but I would like to rewrite it using pattern matching. What I have in mind is something like:               newTimeToMinutes = Function[time:(ToString[hours_]~~":"~~ToString[mins_]), 60*hours + mins]      The argument `time` would be dissected into the two numbers on either side of the colon, furthermore, the numbers on either side of the colon would be used in their numerical form instead of their string form (this is why I would like it if I could use `ToString[hours_]` to recognize something like `"45"` as the number `45`.). Is this possible? It seems like my problem is that patterns can be used in the arguments for arbitrary functions so long as they're patterns on expression input. On the other hand, the built-in string pattern tools that can pattern match on strings like `StringReplace` expect to take a string in and return a string out.


How to define functions for a parameter-dependent recursive sequence

I am trying to generate a two variable recursive sequence For instance on Mathematica, I did               z[1] := {1, 1}     B := {{t, 1}, {-1, t}}     z[n_, t_] := B.z[n - 1, t]      When I tried to see `z[2]`, I get a bunch of gibberish. $n$ is the variable that is iterating, $t$ is just a parameter that I can throw in whenever I want. My goal is to generate a table of terms based on various iterations of $n$. From that, my sequence would be defined in terms of only $t$, then I would like test out various values of $t$ to generate a numerical sequence. There are two problems I am having: how to define the functions properly, and how to implement the recursion. I use Mathematica 8.0.4


NMinimize seems to call function with the same values multiple times

I have to minimize a function where the evaluation of one parameter set takes very long (around 5sec) and discovered alongside, that `NMinimize` seems to call this function multiple times with the exact same values. As an example, consider the code               f[x_?NumericQ] := (Print[N[x, 10]]; x^2);     NMinimize[{f[x]}, x, Method -> "RandomSearch"]      The first couple of lines of the output are:               -0.829053     -0.829053     -0.829053     -0.829052     -0.329053     -0.329053     -0.329052     -8.85837*10^-9     -8.85837*10^-9      6.0428*10^-9      Am I missing something? The same output is also produced by setting `PrecisionGoal -> 3` and `AccuracyGoal -> 3`, thus we can rule out that the numbers in the output are just identical representations of different numbers.


Meaning of backtick in floating-point literal

If I compute, say, `1/3//N`, _Mathematica_ displays               0.333333      as the result. When I copy that output to use elsewhere, the paste produces               0.3333333333333333`      What is the meaning and function of the backtick ? I realize this must be quite elementary. I stand ready to be educated. :-)


What does ` symbol in ClearAll["Global`*"] mean?

I have found an example for clearing all symbol definition by:               ClearAll["Global`*"]      But what does the symbol ` mean? It isn't the apostrophe ', yet it is not documented in _Mathematica_ help. Jim


What is the precision of this number?

In a matrix evaluation, I got the following number.               2.8330574963868513`      I understand that the number after ` shows the precision of the output number. But this one had nothing after `. So what doeas it mean? Thanks.


Export to text file

I would like to export a long Table of (complex) numbers to a text file using `Export["file.txt",%];` A sample line from the obtained file looks like this:               {0.11288378916846890559999999999`18.05263157894737, {{1.6974001229071336*^-12, -5.163757820258834*^-15 + 1.9829374389565386*^-13*I}, {-5.163757820258834*^-15 - 1.9829374389565386*^-13*I, 3.1517458450250055*^-13}}}      First, I do not understand where the ``18.05263157894737` comes from. It does not appear in the Mathematica file. How can I get rid of it? Then I would prefer a formatting of the number `s` like `1.6974001229071336e12` instead of `1.6974001229071336*^-12`. The ultimate purpose is import in Maple. So if there is such an export feature it would be welcome too. Note that I need at least 18 digits precision.


How to change texture of chart bar?

Is there anyone who know how to make diagonal lines inside the chart bar like the below picture? ![enter image description here](http://i.stack.imgur.com/6m8yE.png)


What Mathematica purchase level does CDF creation and deployment come with?

I am evaluating which purchase level of Mathematica 9 will suit my needs. I am finding some of the information provided on Mathematica's How to Buy Chart a bit vague and unclear. I need to be able to create interactive visualizations and then be able to deploy them in a webpage for others to use. I am assuming CDFs are the best choice for this (although webMathematica seems like it can do this as well). Do I need the _standard_ or _enterprise_ purchase level to be able to create and deploy these CDFs? It would also be a bonus for those accessing and interacting with the CDFs to be able to save and/or print them. Which of the packages provide this? Any light that can be shed on what each of the industry packages (standard and enterprise) provides is much appreciated.


Derivative of the Absolute Value Function in Mathematica looks very different from the actual answer

Derivative of the `Abs` Function in _Mathematica_ looks very different than the actual answer. Why? How to correct this? For example I entered `D[Abs[x - 1], x]` and got the output `Abs'[-1 + x]`. Is there a syntax error in my input?


When I use the Labeled command my graphics shrink

My first post regarding this matter was not well formulated so hopefully I have done a better job of reformulated my question here. The following code works well as far as it goes.               Manipulate[If[run == 20, run = 0];           Module[       {k1 = 0.2, k2 = 0.4, w = 1.3, A = 0.05, c = 0.01, L = 6},            M[x_, y_, L_] :=         Piecewise[{{0, y - L Sin[x] < 0}, {1, y - L Sin[x] > 0}}]*(y -            L Sin[x]);       P[x_, y_, L_] :=         Piecewise[{{0, y + L Sin[x] < 0}, {1, y + L Sin[x] > 0}}]*(y +            L Sin[x]);            sys = {x''[t] + c x'[t] -            k1 Cos[x[t]] (M[x[t], y[t], 6] - P[x[t], y[t], 6]) == A Sin[w t],         y''[t] + c y'[t] + k2 (M[x[t], y[t], 6] + P[x[t], y[t], 6]) ==           9.8};            ic = {x[0] == x0, x'[0] == xp0, y[0] == y0, y'[0] == yp0};       sol = NDSolve[{sys, ic}, {x, y}, {t, 0, 20}]];           {x1[t_], y1[t_]} = {x[t], y[t]} /. Flatten[sol];      l = 2 + 0.10 y1[run];      p = 0;      q = 1.8;           GraphicsGrid[{{Graphics[{Line[{{-5.5, -0.6}, {5.5, -0.6}}],            Line[{{-5, 3.8}, {-5, q - (.9 l + 0.6 - 5*Sin[x1[run]])}}],            Line[{{5, 3.8}, {5, q - (.9 l + 0.6 + 5*Sin[x1[run]])}}], Brown,            Thickness[0.02],            Line[{{p - 5, q - (.9 l + 0.6 - 5*Sin[x1[run]])}, {p + 5,               q - (.9 l + 0.6 + 5*Sin[x1[run]])}}]},          PlotRange -> {{-6, 6}, {-4, 6}}]}}, ImageSize -> {800, 600}],           {{x0, 0, "\!\(\*SubscriptBox[\(\[Theta]\), \(0\)]\)"}, -\[Pi]/        6, \[Pi]/6, 0.001,        Appearance -> "Labeled"}, {{xp0, 0,         "\!\(\*SubscriptBox[OverscriptBox[\(\[Theta]\), \(.\)], \     \(0\)]\)"}, -1, 1,        Appearance -> "Labeled"}, {{y0, 27.25,         "\!\(\*SubscriptBox[\(y\), \(0\)]\)"}, -30, 30,        Appearance -> "Labeled"}, {{yp0, 0,         "\!\(\*SubscriptBox[OverscriptBox[\(y\), \(.\)], \(0\)]\)"}, -10,        10, Appearance -> "Labeled"}, {{run, 0,         Text[Style["release system", FontSize -> 18]]}, 0, 20, .01,        ControlType -> Trigger, AnimationRate -> 1},       SynchronousUpdating -> True, AutorunSequencing -> {1, 2},       ControlPlacement -> Left, TrackedSymbols -> True,       FrameLabel ->        Style["Vertical and transverse motion of the Tacoma Narrows Bridge \     roadway", 20, FontFamily -> "Times"]]      Here is an image the code produces:![full size graphic](http://i.stack.imgur.com/zaNgy.png) I want to place a label to the immediate right of the horizontal bar generated by the above code. To do this I have wrapped the Labeled command around GraphicsGrid above with the code block below:               GraphicsGrid[{{Labeled[         Graphics[{Line[{{-5.5, -0.6}, {5.5, -0.6}}],            Line[{{-5, 3.8}, {-5, q - (.9 l + 0.6 - 5*Sin[x1[run]])}}],            Line[{{5, 3.8}, {5, q - (.9 l + 0.6 + 5*Sin[x1[run]])}}], Brown,            Thickness[0.02],            Line[{{p - 5, q - (.9 l + 0.6 - 5*Sin[x1[run]])}, {p + 5,               q - (.9 l + 0.6 + 5*Sin[x1[run]])}}]},          PlotRange -> {{-6, 6}, {-4, 6}}], Text["Equilibrium"], Right,          LabelStyle -> Red]}}, ImageSize -> {800, 600}]      I have included the resulting image of the now shrunken graphic. How can I keep the graphic full size? ![shrunken graphic with label](http://i.stack.imgur.com/1sDTN.png) Thanks.


Mapping over the last level of a list, or equivalent operations

I would like to style each element of my list using `Style`. But when I try               Lista = {{"a", "b", "a"}, {"n", "g", "r"}, {"d", "fgh", "Df"}}     Dimensions[Lista]     FormattedLista = Style[Lista, FontSize -> 10]     Dimensions[FormattedLista]      the structure of the original list is lost. How can I map `Style` onto elements at the last level only, i.e. without changing the structure of the list?


Extra brackets of Position command

Command `Position` always comes with two extra curly brackets {{}} when it's just one index for the location. I use [[1,1]] in front of my position commands. Is there a better way?


Ordering function with recognition of duplicates

Fairly often I have a need to get the `Ordering` of an expression but with recognition of duplicates. For example:               Ordering[{0, 4, 1, 1, 2}]      > >     {1, 3, 4, 5, 2} >   but with duplicates such as `3, 4` marked, i.e.: > >     {{1}, {3, 4}, {5}, {2}} >   I have been using a decorate-and-sort followed by `GatherBy` and `Part`:               {0, 4, 1, 1, 2} //       GatherBy[Sort[{#, Range@Length@#}\[Transpose]], First][[All, All, 2]] &      > >     {{1}, {3, 4}, {5}, {2}} >   Is there a better way?


Why doesn't DumpSave work for elements created within a local notebook context?

I recently noticed that when dealing with notebooks with local context, I cannot successfully `DumpSave` variables, or, rather, when I call `Get` on the non-empty .mx files, the notebook does not recognize the variables. As a test, I created two notebooks, one with a global context and the other with a local context, that is, for the latter notebook, I ran the command:               SetOptions[EvaluationNotebook[], CellContext->Notebook];      In both notebooks, I defined variables that contained a list of points from a standard `NormalDistribution` and plotted them using `ListPlot`. I used               DumpSave["filename.mx", {datavariable,plotvariable}];       to preserve both the data and plot. Long story short, after I save and close both notebooks and restart _Mathematica_ , neither notebook recognizes the variables used for the data or plot, but after using `Get` in the global notebook, the notebook does recognize the old variables. Furthermore, when I run a `DumpSave` command from the 'local' notebook that saves the entire context, i.e. `DumpSave["filename.mx", Evaluate@Context[]]`, I _do_ get back the definitions. This doesn't solve my problem though, as I want to preserve only a few variables in the code that I am working on: saving the entire context, or, more specifically, all of the definitions associated with the context, would require too much memory for an application I have in mind. Are there any solutions using `DumpSave` or should I resort to other methods? Update, I've pasted the exact code below:               SetOptions[EvaluationNotebook[], CellContext -> Notebook];     distribution = NormalDistribution[];      thedata = RandomVariate[distribution, 1000];      theplot = ListPlot@thedata;      DumpSave["test2.mx", {thedata, theplot}];


Internal`Bag inside Compile

Since `Internal`Bag`, `Internal`StuffBag` and `Internal`BagPart` can be compiled down, it is a precious source for various applications. There were already many questions why `AppendTo` is so slow, and which ways exist to make a dynamically grow-able array which is faster. Since inside `Compile` many tricks can simply not be used, which is for instance the case for `Sow` and `Reap`, this is a good alternative. **A fast, compiled version of`AppendTo`:** For a comparison I will use `AppendTo` directly for an easy loop. Ignore the fact that this would not be necessary here, since we know the number of elements in the result list. In a real application, you maybe wouldn't know this.               appendTo = Compile[{{n, _Integer, 0}},       Module[{i, list = Most[{0}]},         For[i = 1, i <= n, ++i,           AppendTo[list, i];         ];         list       ]     ]      Using `Internal`Bag` is not as expensive, since in the above code, the list is copied in each iteration. This is not the case for `Internal`Bag`.               stuffBag = Compile[{{n, _Integer, 0}},       Module[{i, list = Internal`Bag[Most[{0}]]},         For[i = 1, i <= n, ++i,           Internal`StuffBag[list, i];         ];         Internal`BagPart[list, All]       ]     ]      Comparing the run time of both functions uncovers the potential of `Internal`Bag`:               First[AbsoluteTiming[#[10^5]]] & /@ {appendTo, stuffBag}          (*         {4.298237, 0.003207}     *)      ## Usage and features The following information was collected from different sources. Here is an article from Daniel Lichtblau who was kind enough to give some insider information. A question on MathGroup led to a conversation with Oleksandr Rasputinov who knew about the third argument of `Internal`BagPart`. Various other posts on StackOverflow exist which I will not mention explicitly. I will restrict the following to the usage of `Internal`Bag` and `Compile` _together_. While we have 4 functions (`Internal`Bag`, `Internal`StuffBag`, `Internal`BagPart`, `Internal`BagLength`), only the first three can be compiled. Therefore, one has to explicitly count the elements which are inserted into the bag if needed (or use `Length` on `All` elements).   * `Internal`Bag[]` creates an empty bag of type real. When an `Integer` is inserted it is converted to `Real`. `True` is converted to `1.0` and `False` to `0.0`. Other types of bags are possible too. See below.   * `Internal`StuffBag[b, elm]` adds an element `elm` to the bag `b`. It is possible to create a bag of bags inside compile. This way it is easy to create a tensor of arbitrary rank.   * `Internal`BagPart[b,i]` gives the `i`-th part of the bag `b`. `Internal`BagPart[b,All]` returns a list of all. The `Span` operator `;;` can be used too. `Internal`BagPart` can have a third argument which is the used `Head` for the returned expression.    * Variables of `Internal`Bag` (or general inside `Compile`) require a hint to the compile for deducing the type. A bag of integers can be declared as `list = Internal`Bag[Most[{0}]]`   * To my knowledge supported number-types contain `Integer`, `Real` and `Complex`. ## Examples The important property of the following examples is that they are completely compiled. There is no call to the kernel, and using the `Internal`Bag` in such a way should most likely speed things up. The famous sum of Gauss; adding the numbers from 1 to 100. Note that the numbers are not explicitly added. I use the third argument to replace the `List` head with `Plus`. The only possible heads inside `Compile` are `Plus` and `Times` and `List`.               sumToN = Compile[{{n, _Integer, 0}},       Module[{i, list = Internal`Bag[Most[{0}]]},         For[i = 1, i <= n, ++i,           Internal`StuffBag[list, i];         ];         Internal`BagPart[list, All, Plus]         ]       ];     sumToN[100]      Creating a rank-2 tensor by creating the inner bag directly inside the constructor of the outer one:               tensor2 = Compile[{{n, _Integer, 0}, {m, _Integer, 0}},       Module[{list = Internal`Bag[Most[{1}]], i, j},         Table[           Internal`StuffBag[             list,              Internal`Bag[Table[j, {j, m}]]           ],         {i, n}];        Table[Internal`BagPart[Internal`BagPart[list, i], All], {i, n}]       ]     ]      An equivalent function which inserts every number separately               tensor2 = Compile[{{n, _Integer, 0}, {m, _Integer, 0}},       Module[{         list = Internal`Bag[Most[{1}]],          elm = Internal`Bag[Most[{1}]], i, j       },       Table[         elm = Internal`Bag[Most[{1}]];         Table[Internal`StuffBag[elm, j], {j, m}];         Internal`StuffBag[list, elm],        {i, n}];       Table[Internal`BagPart[Internal`BagPart[list, i], All], {i, n}]      ]     ]      A `Position` for integer matrices:               position = Compile[{{mat, _Integer, 2}, {elm, _Integer, 0}},       Module[{result = Internal`Bag[Most[{0}]], i, j},         Table[           If[mat[[i, j]] === elm,             Internal`StuffBag[result, Internal`Bag[{i, j}]]           ],         {i, Length[mat]}, {j, Length[First[mat]]}];         Table[           Internal`BagPart[pos, {1, 2}],         {pos, Internal`BagPart[result, All]}]        ], CompilationTarget -> "C", RuntimeOptions -> "Speed"           ]      This last example can easily be used to measure some timings against the kernel function:               times = Table[       Block[{data = RandomInteger[{0, 1}, {n, n}]},         Transpose[{           {n, n},            Sqrt[First[AbsoluteTiming[#[data, 1]]] & /@ {position, Position}]         }]       ], {n, 100, 1000, 200}];          ListLinePlot[Transpose[times]]       ![plot of run times](http://i.stack.imgur.com/E63wY.png) ## Open Questions   * Are there simpler/other ways to tell the compiler the type of a local variable? What bothers me here is that this is not really explained in the docs. It is only mentioned shortly how to _define_ (not _declare_ ) a tensor. When a user wants to have an empty tensor, it is completely unintuitive that he has to use a trick like `Most[{1}]`. Declaring variables would be one of the first things I need, when I would be new to `Compile`. In this tutorial, I didn't find any hint to this.   * Are there further features of `Bag` which may be important to know in combination with `Compile`?   * The timing function of `position` above leaks memory. After the run `{n, 100, 3000, 200}` there is 20GB of memory occupied. I haven't investigated this issue really deeply, but when I don't return the list of positions, the memory seems OK. Actually, the memory for the returned positions should be collected after the `Block` finishes. My system here is Ubuntu 10.04 and _Mathematica_ 8.0.4.


Are there any "RLink" like projects, which enable the interaction between R and Mathematica?

I want to borrow the vast amount of packages of R. I know there was one but it is neither sold nor supported anymore. So are there any active open source projects for linking R with Mathematica? Thank you.


How to label vertices in a grid with random integers?

I would like to assign each vertex a random number with the minimum bound equal to the smallest vertex and the maximum equal to the value of the largest without repeats. ie in a 20x20 grid, the vertices would be labeled from 1-400 without repeats but each randomly


How do I generate the upper triangular indices from a list?

I have some list               {1,2,3}.      How do I generate nested pairs such that I get               {{1,2},{1,3},{2,3}}?      That is I'd like a way to generate _upper triangular indices_. **Bonus** : a way to deal with the related problem of generating _lower triangular indices_ as well.


Putting NDSolve into ParametricPlot

I am having issues using `Manipulate` to plot the (numeric) solution to an ODE for different parameter values. I have a code that has several stages, which seem to all work when I do them one after another. This code solves a system of ODEs (for particular parameter values), then does a parametric plot of the solution. The problem is I need to put the lines together to wrap them around with `Manipulate` (for I can do this code again easily for different parameter values), and this is causing me a lot of pain. My initial code is:               (*this is my ODE*)          unforced[x0_, p0_, α_:α, δ_:δ] :=      {x'[t] == p[t],       p'[t] == -α x[t] - δ p[t] + α (x[t])^3,       x[0] == x0,       p[0] == p0     }          (*Choose some parameter values*)          α = -1, δ = 1          (*Solve my ODE*)          s = NDSolve[unforced[x0 = 1, p0 = 1], {x, p}, {t, 20}]          (*Plot It*)          ParametricPlot[Evaluate[{x[t], p[t]} /. s], {t, 0, 20}]      But now I want to be able to `Manipulate` the parameter values `α` and `δ`. So I start putting the lines of code together... and problems happen.               ParametricPlot[Evaluate[{x[t], p[t]}/.                    NDSolve[{x'[t] == p[t],                              p'[t] == -α x[t] - δ p[t] + α (x[t])^3,                              x[0] == 1, p[0] == 0}, {x, p}, {t, 20}]], {t, 0, 20}]      This plots an empty graph. This confuses me because it seems like all I did was substitute into my previous code. Because this doesn't work, I can't put a `Manipulate` around this. If it worked then I would have tried:               Manipulate[ParametricPlot[Evaluate[{x[t], p[t]} /.                     NDSolve[{x'[t] == p[t],                                 p'[t] == -α x[t] - δ p[t] + α (x[t])^3,                               x[0] == 1, p[0] == 0}, {x, p}, {t, 20}]], {t, 0, 20}],                 {{α, -1, "α"}, -2, 0}, {{δ, 0, "δ"}, 0, 2}]      How do I get around this problem?