Defining extra boundary conditions for NDSolve?

I have a second order reaction / diffusion type ODE of the form $\frac{D_{o}}{r^2} \frac{d}{dr}\left(r^2 \frac{dC}{dr} \right) - \frac{aC}{C+k} = 0$ where $a, k$ and $D_{o}$ are constants and $C$ is a function of $r$. I know the following; $C(r_{o}) = \omega$ , $C(r_{n}) = 0$ and $C'(r_{n}) = 0$ , where $r_{o}$ and $r_{n}$ are positions and $\omega$ is a known constant. To model this behaviour, I am using `NDSolve`, which takes two conditions for these types of ODEs. For example, this gives a potential curve between the boundaries $r_{n}$ and $r_{o}$ ;               eqn = ((Do2/(r^2))*D[(r^2*(O2'[r])), r] - (a)*((O2[r])/(O2[r] + k)));               s = NDSolve[{eqn == 0, O2[rn] == 0, O2[ro] == omega}, O2, {r, rn, ro}]      This gives me one curve which I can readily plot; however is I instead tell `NDSolve` to use different conditions like this -               s = NDSolve[{eqn == 0, O2'[rn] == 0, O2[ro] == omega}, O2, {r, rn, ro}]      I get a different curve. However, I suspect I should be getting the same curve regardless. If the problem is narrowing it down to a unique solution from an array of possible solutions, is there a way to make Mathematica take all three BCs? I'm also open to the possibility that there is a more fundamental mathematical error or perhaps a bad assumption on my part, so please by all means point it out to me if I've missed it . Thanks in advance - grateful for any advice on this!


Join all square root expressions?

Sometimes I observe _Mathematica_ produce expressions exactly like the following after a simplification step: $$\frac{a+\sqrt{-(1-b)}\sqrt{\frac{1}{b-1}}}{\sqrt{c}\sqrt{\frac{1}{c}}}$$ Now, any further generic `Simplify` or `FullSimplify` would not do any good any more. One is tempted to use `PowerExpand`, but this would just introduce an annoying `i` term in the numerator, instead of simplifying correctly. Therefore, what I have been doing is typing in simplifications like:               /.Sqrt[x_]Sqrt[y_]/(Sqrt[z_]Sqrt[m_])->Sqrt[x y]/Sqrt[z m]//Simplify      by hand. This is very annoying. Maybe there is a _Mathematica_ function which joins all the square roots in all possible places of an expression together? **EDIT** Example code to be simplified:               Sqrt[-(1 - b)] Sqrt[1/(b - 1)]      Generally, any simplification involving explicitly specifying properties of terms involved does not help really, since the amount of actions is the same as manually correcting the expression. What I am looking for is a function which merges all possible square roots together, regardless of content. **EDIT2** Please note the following triviality: a search for a function performing the merging of all square roots in an expression only makes sense if an appropriate branch for the square root functions is chosen so that $\sqrt{x}\sqrt{y}=\sqrt{x y}$ is actually true for the expressions in question. Thank you.


Wrapping grid with dynamic

I'm trying to build a sortable grid:               sortBy[data_, idx_] :=        If[idx == 0, data, Sort[data, #1[[idx]] < #2[[idx]] &]];     sortableTable[data_, header_] := DynamicModule[       {h, sort = 0},       h = MapIndexed[Button[#1, sort = #2] &, header];       Dynamic[Grid[Prepend[sortBy[data, sort], h]]]];     sortableTable[       Table[         RandomInteger[100], {i, 3}, {j, 4}],          {"First", "Second", "Third", "Fourth"}]      For some reason it is not behaving like I expected: header disappears and sorting doesn't occur. I've tried all sorts of stuff but can't make it work like intended. Any help is much appreciated.


How to scale vectors in VectorPlot?

I generated some pics from 2 datum，one in $x$ direction and the other in $y$，so I used the commands:               exfield = Range[200];     polarplane = Range[200];     Get["C:\\Users\\dc\\Desktop\\polarplane.dat"];     Get["C:\\Users\\dc\\Desktop\\exfield.dat"];     xx = Table[     Transpose[{exfield[[25, i]], polarplane[[25, i]]}], {i, 71}];     ListVectorPlot[xx]      to get the vector field. But one problem here is, all the pics generated by the commands share the same maximum length of the vector. I can only see the orientation change but no magnitude change. I need a cartain standard (for instance, 1 cm vector length for the maximum data value $a_{max}$) to generate all the pics, so I can see the relative magnitude change. But I couldn't find the options. Have anyone encountered this same problem? Thank you. And the sample datum are like:                exfield[[001]] = {                   {        a11,        ……，        a1i，     },     {        a21,        ……，        a2i，      },        ……      {        ai1,        ……，        aii，       },      }      and the sample data: data


Nested If statements

When I do this:               Apply[(If[#2 == what, "yay", If[#2 == whoops, "nay"]]) &, {-5, what}]      I get:               yay      But when I do this:               Apply[(If[#2 == what, "yay", If[#2 == whoops, "nay"]]) &, {-5, whoops}]      I get:               If[whoops == what, "yay", If[whoops == whoops, "nay"]]      This setup does work for numbers:               Apply[(If[#2 == 2, "yay", If[#2 == 3, "nay"]]) &, {-5, 3}]     nay      What I was trying to do was when I got stuck here was define a `VertexRenderingFunction` in a `GraphPlot`               VertexRenderingFunction -> ({White, EdgeForm[Black], Disk[#, {2, 1}],      Black, Text[      If[#2 == alpha1, "Alpha",        If[#2 == beta, "Beta",         If[#2 == alpha2, "Alpha",          If[#2 == gamma, "(70,55)",           If[#2 == delta, "(90,50)"]]]]], #1]} &)      What am I doing wrong? Any help will be greatly appreciated. Thanks.


Solve equations real and imaginary part separately

For my system of equations, the procedure described in Solving complex equations of using `Reduce` works no more. How can I separate the real and imaginary part of the equations? Because then I could use `Solve[equations, vars, Reals]`. Nevertheless I hope for a simpler way to overcome this issue. **Example**               Vector = {v1, v2, v3, v4};     Matrix = {{c11, c12, c13, c14},                {c21, c22, c23, c24},                {c31, c32, c33, c34},                {c41, c42, c43, c44}};     Reduce[Table[0 == Sum[Matrix[[r, k]] Vector[[k]], {k, 4}], {r, 4}] &&       Element[{v1Real, v1Complex, v2Real, v2Complex, v3Real, v3Complex, v4Real, v4Complex}, Reals],      {v1Real, v1Complex, v2Real, v2Complex, v3Real, v3Complex, v4Real, v4Complex}] /.       {v1 -> v1Real + I v1Complex, v2 -> v2Real + I v2Complex, v3 -> v3Real + I v3Complex, v4 -> v4Real + I v4Complex}


Least Square Fitting

stuck on a mathematica assignment and could really use some help. A) Fit a function with the shape log(Y) = a0 + a1log(U) to the datapoints (log(Ui), log(Yi) with an least square fitting. Show this in a plot ... B) Use your answer in A) to find a function Y = kU^n that fit to the datapoints (Ui, Yi) The U datapoints is: (600000, 200000, 60000, 10000, 2500) The Y datapoints is: (250, 60, 25, 12, 5) I've done this:               data2 = {{Log[2500], Log[5]}, {Log[10000], Log[12]}, {Log[60000],         Log[25]}, {Log[200000], Log[60]}, {Log[600000], Log[250]}}          fitExample = Fit[data2, {1, x}, x]      Am I right to be using the Fit function this way? How can I use this answer in the B question?


How to close the front end so I can clear all Global variables?

I first thought that doing Quit[] in a cell, or Evaluation->Quit kernel, is supposed to remove all Global variables, but I have a case where this is not happening, then I read that there is a command Quit from the menu to also shut down the front end, so I wanted to try that to see if that will clear those variables, which I suppose are saved by the front end. (I know I can ofcourse just type Remove["Globals`*"], but was looking looking at what seems like a symbols leakage problem with Manipulate. **Any one knows how to close the front end please?** I can't find this Quit command from the menu, which is supposed to be different from the Quit[] for the kernel? I only see Quit kernel in the menu. But when I try that, these variables are not cleared! ![enter image description here](http://i.stack.imgur.com/2Udnz.png) Again, the reason I wanted to do the above is because not all variables are cleared when I restart the kernel (either by Quit[] or by stopping the kernel from the menu: ![enter image description here](http://i.stack.imgur.com/EkBjW.png) Btw, according to this answer here Quit[] the kernel is supposed to clear all variables ! but this is not the case with me here. ps. I never even knew before there was a `Quit` command for the front end. ps. I will be happy to post the code that generates this if needed. thanks edit(1) According to help message above, it said there is **Quit** menu item to close the from end, but on windows, V 8.04, I only see Quit kernel, which is the same as Quit[] typed in the notebook. ![enter image description here](http://i.stack.imgur.com/OCO24.png)


Export a Row or Column as an image

How could I export the following as a single image and set its dimensions ?               Column[{Row[{Graphics@Disk[], Graphics@Rectangle[]}],             Row[{Graphics@Rectangle[], Graphics@Disk[]}]}]      ![enter image description here](http://i.stack.imgur.com/3diB3.png)


Practical uses of DynamicWrapper

I am looking for practical uses of the function `DynamicWrapper` . I read documentation and know whatever it says. I would appreciate a clear example of a useful dynamic interface (an app) that would be hard to implement without `DynamicWrapper`.


Solving NLODE with substitution

I am trying to get a solution to a non-linear ODE, below is the code that works for my problem.               s = NDSolve[{y'''[x] + y[x]^2 y''[x] - y'[x] == 0, y[0] == 0, y'[0] == 0, y''[1] == 1}, y, {x, 0, 1}];     Plot[Evaluate[{y[x], y'[x], y''[x]} /. s], {x, 0, 1}]      1 Question how do you get the equations of the lines that are being plotted? So say on x from 0 to 1 what is the equation of the line. 2 How do solve the same problem but using a substitution of u=dy/dx?               u''[x] + y[x]^2 u'[x] - u[x] == 0, u[0] == 0, u'[1] == 1      and we need to integrate to get the y value, not sure how to set that as a BC as well. Thank you


Managing formatted usage messages in Wolfram Workbench

We have numerous packages (defined in `.m` files) that we maintain and develop in WolframWorkbench (2.0), and in those packages, we use the traditional method of determining which symbols are public by assiging `::usage` messages to them. It's also nice to have at least that much documentation for every public symbol. I've been spending some time reviewing and improving the documentation for these public symbols, and one thing I'd like to be able to do is emulate the formatting that Wolfram uses for its own usage messages, for example: > ![Binomial::usage](http://i.stack.imgur.com/K3KAM.png) It's not particularly difficult to make that sort of formatted text in the notebook interface. However, getting that formatted text into a package file in Workbench requires copying the formatted text, pasting it into an input cell, and then copying the resulting string into Workbench:               "\!\(\*RowBox[{\"Binomial\", \"[\", RowBox[{StyleBox[\"n\", \"TI\"], \     \",\", StyleBox[\"m\", \"TI\"]}], \"]\"}]\) gives the binomial \     coefficient \!\(\*RowBox[{\"(\", GridBox[{{StyleBox[\"n\", \"TI\"]}, \     {StyleBox[\"m\", \"TI\"]}}], \")\"}]\). "          The additional copy/paste step is requiried to keep some of the quotes escaped; it goes wrong if you paste directly to Workbench. Suffice it to say, this is a pain, and editing the resulting string directly is pretty unpleasant. So far the best I've been able to figure out for editing the strings is to do something like this in a notebook file:               CellPrint[Cell[DisplayForm@Binomial::usage, Editable -> True]]      Is there a better way to do this? Just having the arguments in usage strings appear in _italics_ is a big win from a readability standpoint. **UPDATE** in respose to @István Zachar's comment: I knew about the "Show Cell Expression" menu item mentioned in the answers to your question, but I didn't realize that you could edit the displayed cell expression. That's less awkward than the `CellPrint` approach, at least. **UPDATE** the second: The main reason we don't just use autogenerated packages is that we have a setup where "build" an application from packages for deployment on remote machines, and all the packages are in Subversion. Using autogenerated packages with this workflow is very awkward.


Possible to Solve a LocationEquivalenceTest?

I have 5 groups, each containing around 20 elements. These elements are all dependent on x. For example: `Set1 = {1.5x + 1, 2x + 0.5, 1 x + 1, ...}` etc. Now, I want to compare these 5 groups and see if there is a significant difference between one or more of these groups (for `0 < x < 1`). As my data does not follow normal distribution, I use the Kruskal-Wallis test. To try and visualise this, I plugged this into _Mathematica_               Plot[LocationEquivalenceTest[{Set1, Set2, Set3, Set4, Set5}], {x, 0, 1}]      which, unexpectedly, gives a nice plot of the p-value set out over x. Now, I want to determine for what values of x the p-value is <0.05, so I thought that, since the Plot worked out nicely, I might be able to achieve that by using               Solve[LocationEquivalenceTest[{Set1, Set2, Set3, Set4 ,Set5}] == 0.05, x]      Unfortunately, that just gives me a bunch of errors saying that > The argument _list of the elements of set1_ at position 1 should be a list > containing two or more vectors of real numbers with length greater than 2. Is there a function in _Mathematica_ that does allow me to determine for which values of x the p-value would be 0.05?


Take off {} using Position []

Please consider :                subIDs = {"AK6", "CF11", "CL4", "FC21", "MK5"};           subColors = {LightOrange, LightBlue, LightYellow, LightGreen, LightRed}           Graphics[{subColors[[Flatten@Position[subIDs, #, 3]]],Rectangle[]}]&/@subIDs      ![enter image description here](http://i.stack.imgur.com/aOKVa.png) How could i avoid the output of position to be 1 for example instead of {1} which seems to be my problem.


Copying an image from the clipboard, modifying it and returning it to the clipboard

I have a Mathematica script to help me copy images from PDFs and then make the (presumably white or nearly white) background transparent. Typically, I am looking at the PDF in Adobe Acrobat and I use the snapshot tool to copy the image to Microsoft Window's clipboard. Then I paste the image into mathematica and assign it the name q. Where I typed `{IMAGE}` below is where I paste the image into the code:               q = {IMAGE};     p = ColorNegate[Binarize[ImageApply[Min, q], 0.99]];     s = SetAlphaChannel[q, p];     Export["img.png", s];      I run the code and I get a PNG with a transparent background and then I can insert the png with the transparent background into OneNote. The point of doing this is images with a transparent background are easier to arrange since the don't obscure the other texts. This makes it a snap to place graphs and equations in my notes. I would like to make this even easier by enhancing my script. This is why I am asking for help. My goals are:   1. Is there some Mathematica command I can use to copy the image from the clipboard automatically without having to manually paste it.   2. Is there a way to get Mathematica to place the image back into the clipboard with a transparent background, thus cutting out the step of using a file. What I have found is if I use a command like `CopyToClipboard[s]`, it doesn't work.   1. Are there any other enhancements that would make the whole process more automated? (A side note: it's been a while since I wrote this code, but if I remember correctly, I convert the image to black and white, figure out the background then use the pixels that were designated as background to figure out which pixels to set as transparent in the original image.)


Split a string at specific positions

Given a string of alphanumerical characters, how to split it simply and quickly at the **center** of continuous letter-substrings? Is there an elegant and fast solutions out there in the "computational universe"? The splitter should create "syllables" with one digit as a nucleus for each syllable, that is, at the end there should be **only one digit per sublist**. When there are more letter characters between digits, letters should be shared by the bordering digits (here I simulated a half share, distributing towards the right bordering digit in case of an odd number of letters), and starting and ending letter-sequences should be just attached to the closest digit.               "xxx00xxx000x0xx0xxxx000xx0xx" (* original string *)          "xxx0 | 0x | xx0 | 0 | 0 | x0x | x0xx | xx0 | 0 | 0x | x0xx" (* intermediate *)          {"xxx0", "0x", "xx0", "0", "0", "x0x", "x0xx", "xx0", "0", "0x", "x0xx"} (* end *)      Note that the string never contains spaces by default.


How to capitalize the first letter of each word in a string

The following examples only work for the first character of the whole string, but not of words.               s = "words are lowercase";     StringJoin[MapAt[ToUpperCase, Characters[s], 1]]   (* ==> "Words are lowercase" *)     StringReplacePart[#, ToUpperCase[StringTake[#, 1]], 1]&@s  (* ==> "Words are lowercase" *)      Is there any method along these lines to produce correct **title case** strings of the form:               "Words Are Lowercase"


Summation over 3 lists

I have three lists. As an example,               a = {10, 5, 6, 8, 7};     b = {4, 8, 9, 7, 9};     c = {7, 5, 12, 4, 1};      I want to get $$x(i)=\sum _{i=0}^i\frac{1}{2}\left(a_ib_i+a_{i+1}b_{i+1}\right)\left(c_{i+1}-c_i\right)$$ i goes from 1 to 4. i.e. I want to get: x(1),x(2),x(3) and x(4) So, I used following code               x=Sum[1/2*(a[[i]]*b[[i]] + a[[i + 1]]*b[[i + 1]])*(c[[i + 1]] -      c[[i]]), {i, 1, 4}]     For[i = 0, i < 4, x, Print[x]]      But, I didn't get expected output. Could anyone please tell me how to do this?


Reducing quality of Graphics3D scene to improve performance?

`ProteinData["SERPINA1", "MoleculePlot"]` gives the detailed `Graphics3D` plot below. I'd like to make many small copies of this object and place them in a single `Graphics3D` scene, but I'm running into performance problems because the molecule graphics-object is a pretty complicated mesh. Are there general methods of reducing the quality/detail of graphics objects like the one below that would allow me to place many of these in a single scene? ![enter image description here](http://i.stack.imgur.com/XlvG4.png)


How to lookup by a string key after GroupBy? Inconsistent data type handling

**This is relates to a bug was introduced in 10.0.0 and shall be fixed in 10.0.1**   **It also relates to an issue that has yet to be corrected.** * * * After applying `GroupBy` to a key all of whose `"values"` are `String`, is it possile to force the internal type representation to subsequently lookup by `"value"` rather than `Key@"value"`? `GroupBy` modifies internal type representation:               titanic = ExampleData[{"Dataset", "Titanic"}];          (* ... Vector[Struct[List["class", "age", "sex", "survived"],        List[Atom[Enumeration["1st", "2nd", "3rd"]], Atom[Integer],         Atom[Enumeration["female", "male"]], Atom[Boolean]]], AnyLength] ... *)      (so does Normal'izing following by casting back to Dataset though `AnyLength` is replaced by a numerical value, eg 1309.) Even though the keys (formerly values) are String:               titanic[GroupBy[Key@"sex"]][Keys, # -> Head[#] &]          (* {"female" -> String, "male" -> String} *)      This lookup fails:               titanic[GroupBy[Key@"sex"]]["female"]          (* ... Part female is not applicable to <|(Alternatives[Enumeration[female, \     male]] -> _List)..|> ... *)      Note: lookup query `Key@"female"` works. Strangely, works also without `Key` when `KeyDrop` is applied before `GroupBy`: `titanic[All, KeyDrop["survived"]][GroupBy[Key@"sex"]]["female"]`               (* ... {<|"class" -> "1st", "age" -> 29, "sex" -> "female"|>, ... *)      Conversely, if `Span` substitutes `KeyDrop`, the data are the same               titanic[All, 1 ;; 3][GroupBy[Key@"sex"]][Keys, # -> Head[#] &]          (* {"female" -> String, "male" -> String} *)      but lookup also fails even using `Key`:               titanic[All, 1 ;; 3][GroupBy[Key@"sex"]][Key@"female"]          (* ... Key Key["female"] is not one of {}. ... *)      I'm not sure how to interpret that message: b/c the internal the representation is `AnyType`:               Assoc[Atom[AnyType],       Vector[Assoc[Atom[String], Atom[AnyType], 3], AnyLength], AnyLength]      How to handle these various cases uniformly?


Help with Integrals (and conditional expectations) of the Beta distribution: Integrate[e^(az) z^a (1-z)^b, {z, 0, 1}]

I have a Beta distribution, and am interested in calculating expectations and conditional expectations. The domain on the distribution is $z \in [0,1]$ Ignoring constants of proportionality, the expectation of an exponential function is:               $Assumptions = z >= 0 && z <= 1 && a > 0 && b > 0 && c > 0 && d > 0 && d < 1;          Print["*******Different parameters, {a,b}"];     Integrate[Exp[c z]  z^(a - 1) (1 - z)^(b - 1), {z, 0, 1}]          Print["********Symmetric parameter, a"];     Integrate[Exp[c z]  z^(a - 1) (1 - z)^(b - 1) /. {b -> a}, {z, 0, 1}]      The output from this is:               Gamma[a] Gamma[b] Hypergeometric1F1Regularized[a, a + b, c]     (-c)^(1/2 - a) E^(c/2) Sqrt[\[Pi]]  BesselI[-(1/2) + a, -(c/2)] Gamma[a]      These are solid. The problem I am having is when calculating conditional expectations, which is effectively integration over a subset of the domain. Again ignoring constants of proportionality,               Print["********Truncated Integral on [d, 1], symmetric for simplicity"];     Integrate[Exp[c z]  z^(a - 1) (1 - z)^(b - 1) /. {b -> a}, {z, d, 1}]      This is unable to solve it. Any idea on this? Are there any tricks in mathematica, in math that I am missing?


Use Mathematica to calculate the area enclosed between two curves

use mathematica Hence, calculate the exact area enclosed by these curves using _Mathematica_. $f(x)=x^3$ and $g(x)=x^5 - 2 x^3 - 3 x$ i have got the graph...now I'm stuck with finding the area


Sorting a matrix alphanumerically

Somewhat related to Sort matrix by columns and rows without changing them, but more general. I'd like to sort a square matrix (a 3 by 3 in my case, but surely the general solution will treat any), say, `M = {{i, b, c}, {d, e, f}, {g, h, a}}`, into lexicographic form without changing `Abs[Det[M]]`, so all row, column and diagonal swaps are allowed. In the example the wanted result would be `{{a, c, f}, {h, b, e}, {g, i, d}}`. Obviously I can't split the sorting into row, column and diagonal sorts separately. (The latter CAN be split off but this would still require in my own dumb algorithm: write down the 36 permuted orderings explicitly and pick the first.) Surely you have a more intelligent (and completely unintelligible, for a n00b like me :-) sorting algorithm? (Like, sorting the list on all levels simultaneously? Only I don't know how yet. Guess it needs a lot of ampersands and octothorpes :-) BTW, I need it to sort a (formal) 9j symbol list and eliminate equivalent duplicates.


Tangent to a circle

I am trying to show vector of fixed length which is the tangent to a circle which rotates. Any suggestions on how to simplify this ? My question is not about using Manipulate etc but more is there an easier way to compute and draw the tangent ?               x[t_] := Cos[t];     y[t_] := Sin[t];     d[x_, y_] := If[y == 0, 0, -x/y];     tangent[1, 0] = Arrow[{{1, 0}, {1, 1}}];     tangent[-1, 0] = Arrow[{{-1, 0}, {-1, -1}}];     tangent[0, -1] = Arrow[{{0, -1}, {1, -1}}];     tangent[0, 1] = Arrow[{{0, 1}, {1, 1}}];     tangent[x_, y_] =        If[y > 0,         Arrow[{{x, y}, {x - Cos[ArcTan[d[x, y]]],            y - Sin[ArcTan[ d[x, y]]]}}],        Arrow[{{x, y}, {x + Cos[ArcTan[d[x, y]]],            y + Sin[ArcTan[ d[x, y]]]}}]];     Manipulate[      p = ParametricPlot[{x[t], y[t]}, {t, 0, 2 \[Pi]},         PlotRange -> {-2, 2}];      g = Graphics[{{Blue, Line[{{0, 0}, {x[a], y[a]}}]}, {Red,           tangent[x[a], y[a]]}}];      Show[{p, g}],      {a, 0, 2 \[Pi]}]      ![Moving tangent](http://i.stack.imgur.com/oYVSH.jpg) I extended my example above to include a 3D solution using suggested solutions -               Module[{x,y,z,tangent},     x[t_]:=Cos[t];     y[t_]:=Sin[t];     z[t_]:=0;     r ={{-2,2},{-2,2},{-2,2}};     p=ParametricPlot3D[{x[t],y[t],z[t]},{t,0,2\[Pi]},PlotRange->r,BoxRatios->1];     tangent[x_,y_,z_]:={Red,Arrow[{{x,y,z},{x-y,x+y,z}}]};     Manipulate[     g :=Graphics3D[{Sphere[{x[t],y[t],z[t]},0.2],     {Green,Arrow[{{x[t],y[t],z[t]},{x[t],y[t],1}}]},     {Blue,Arrow[{{0,0,0},{x[t],y[t],z[t]}}]},     tangent[x[t],y[t],0]     },PlotRange->r,BoxRatios->1];     Show[p,g],     {t,0,4\[Pi]}     ]     ]      ![3D](http://i.stack.imgur.com/DQYE2.jpg)


How to make a defined symbol stay in symbol form?               w = 3; g = 4;          {w, g}[[2]]      > `3` I want the output to be **`g`** and not `3`. For example if I I want to save different definitions by `DumpSave` in different files like below: Example: `Table[DumpSave["/Users/simonlausen/Desktop/Input/ex"<>ToString[i]<>".mx",{w,g}[[i]]],{i,1,2}]` Any Suggestions?


Creating a trigger to update a previous ListPlot output with new data

Imagine I'm running a loop that's manipulating and changing elements in an array. Is it possible for me to create a `ListPlot` output in my notebook that updates on command? I'm imagining taking something like this:               testArray = Array[{0, 0} &, 10^3];     For[i = 1, i <= 10^3, i++,            testArray[[i]] = {i, i};            If[Mod[i, 10] == 0,        Print[ListPlot[testArray, PlotRange -> All]];       ];          ];      And transforming it into something like this (with the imaginary command `fTriggerUpdateForPreviouslyExistingListPlot`):               testArray = Array[{0, 0} &, 10^3];     For[i = 1, i <= 10^3, i++,            testArray[[i]] = {i, i};            If[Mod[i, 10] == 0,        fTriggerUpdateForPreviouslyExistingListPlot[{testArray}];       ];          ];      Here, `fTriggerUpdateForPreviouslyExistingListPlot` is some kind of switch that takes a listplot, say, in another notebook (within the context of the same kernel) or the current one, and plots the new data. Is this possible? * * * The function `Monitor` comes close to what I'm looking for:               testArray = Array[{0, 0} &, 10^3];          Monitor[        For[i = 1, i <= 10^3, i++,          Pause[0.1];          testArray[[i]] = {i, i};        ];     ,     ListPlot[testArray, PlotRange -> All]];          ListPlot[testArray, PlotRange -> All]      However, this updates whenever `testArray` changes, and not on a trigger. I could create a separate `testArrayForMonitor` and move data from `testArray` to `testArrayForMonitor` to trigger an update, but this seems a bit of an odd thing to do, and incurs a significant overhead.


How to set the return type of a compiled function? (Compile::noinfo warning)

I have simple function I would like to compile, but I get a warning and a call to MainEvaluate. I would like to avoid both.               ClearAll[MakeInPeriodicCell]     On["CompilerWarnings"]     MakeInPeriodicCell =        Compile[{x, cellwidth},         First@Sort[{x, x - cellwidth, x + cellwidth}, Abs[#1] < Abs[#2] &]];     CompiledFunctionTools`CompilePrint[MakeInPeriodicCell]            (*Compile::noinfo: No information is available for compilation of      Sort[{x,x cellwidth,x+cellwidth},Abs[#1]<Abs[#2]&].      The compiler will use an external evaluation and make assumptions about the return type.*)          (*     ...     5   T(R1)2 = MainEvaluate[ Function[{x, cellwidth}, Sort[{x, x - \     cellwidth, x + cellwidth}, Abs[#1] < Abs[#2] & ]][ R0, R1]]     ...     *)      **EDIT** (I got the correct syntax for the subexpression from an answer that got deleted?) I tried setting the type of a subexpression like this:               MakeInPeriodicCell =       Compile[{x, cellwidth},        First@Sort[{x, x - cellwidth, x + cellwidth},          Abs[#1] < Abs[#2] &], {{Sort[_,_], _Real,1}}]      This gets rid of the warning, but the call to MainEvaluate remains. Can this snippet be compiled without a call to MainEvaluate? * * * **EDIT 1** Since compile is always about speed, here is some benchmark info. (the code is here, as it clutters the question a bit)               data = RandomReal[{-100, 100}, 100000];     (*Original implementation*)     m0 = MakeInPeriodicCellOrig[data, 30]; // AbsoluteTiming (*0.8370473*)     (*my revritten*)     m1 = MakeInPeriodicCellImp[data, 30]; // AbsoluteTiming  (*0.0360021*)     (*F'x answer*)     m2 = MakeInPeriodicCellFx[data, 30]; // AbsoluteTiming   (*0.0140008*)          m0 == m1 == m2 (*True*)      So getting read of MainEvaluate gives you about 20x speed-up and changing to a better algorithm another 3x. I usually have a million to ten million points, so the speed-up is very welcome.


How to remove border points from InputForm?

I have this code, and it generates the below `ListStreamPlot`. The second graph is the `ListStreamPlot` overlaid with the points comprising the `ListStreamPlot` (extracted after looking at `// InputForm`); unfortunately, the extracted points also include the border points. These "border points" are not of predictable coordinates, so there doesn't seem to be an easy way to remove them from the set. (I want this code to be as case-inspecific as possible, since I am analyzing many additional data sets.) Is there a simple way -- perhaps in the original `ListStreamPlot` code -- to remove the "border points" from the points list?               v3 = ListStreamPlot[vectorsT, StreamStyle -> "Line", StreamPoints ->        {{xcorT[[midpoint + 4]], ycorT[[midpoint + 4]]}}]          points = v3[[1, 2, 1]];          xPoints = Transpose[points][[1]];      yPoints = Transpose[points][[2]];          pointsOnly = ListPlot[Transpose[Join[{xPoints}, {yPoints}]]] ;      graph 1: ![](http://i.stack.imgur.com/M3Gps.png) graph 2: ![](http://i.stack.imgur.com/9AZJm.png) **Entire source code**               (* Set directory to that of this notebook *)     SetDirectory[NotebookDirectory[]];          (* Import CSV'd data *)     dat = Import["test_data2b.txt", "CSV"];          (* Divide data *)     datAll = Flatten[Partition[dat[[1]], 7]];     datAllCpy = datAll;          (* Divide data into components *)     (* ID *)          ID = Flatten[Partition[datAll, 1, 7]];     datAll = RotateLeft[datAll];          (* Longitude *)     LONG = Flatten[Partition[datAll, 1, 7]];     datAll = RotateLeft[datAll];          (* Latitude *)     LAT = Flatten[Partition[datAll, 1, 7]];     datAll = RotateLeft[datAll];          (* SFC_SPD *)     SPD1 = Flatten[Partition[datAll, 1, 7]];     datAll = RotateLeft[datAll];          (* SPF_SPD _KT *)     SPD2 = Flatten[Partition[datAll, 1, 7]];     datAll = RotateLeft[datAll];          (* SFC_SPD _MP *)     SPD3 = Flatten[Partition[datAll, 1, 7]];     datAll = RotateLeft[datAll];          (* SFC_DIR *)     DIR = Flatten[Partition[datAll, 1, 7]];          (* Restore original list *)     datAll = datAllCpy;          (* Make longtitudes negative *)     LONG = Abs[LONG];     LONG = 0 - LONG;          (* Convert from degrees to radians *)     DIR = DIR *(2 Pi/360);          (* Graph data as vectors *)     xcor = LONG;     ycor = LAT;     xvc = SPD1*Cos[DIR];      yvc = SPD1*Sin[DIR];     vectors = Table[{{xcor[[i]], ycor[[i]]}, {-yvc[[i]], -xvc[[i]]}}, {i, 1, Length[xcor]}];          (* Calculate midpoint of data *)     midpoint = Flatten[Position[SPD1, 0.]][[1]];          (* Transpose all points to be around origin *)     LONGT = LONG - (LONG[[midpoint]]);     LATT = LAT - LAT[[midpoint]];           (* Graph data as vectors *)     xcorT = LONGT;     ycorT = LATT;     xvcT = SPD1*Cos[DIR];      yvcT = SPD1*Sin[DIR];     vectorsT = Table[{{xcorT[[i]], ycorT[[i]]}, {-yvcT[[i]], -xvcT[[i]]}}, {i, 1, Length[xcor]}];          v3 = ListStreamPlot[vectorsT, StreamStyle -> "Line", StreamPoints -> {{xcorT[[midpoint + 4]], ycorT[[midpoint + 4]]}}]          points = v3[[1, 2, 1]];           xPoints = Transpose[points][[1]];      yPoints = Transpose[points][[2]];          pointsOnly = ListPlot[Transpose[Join[{xPoints}, {yPoints}]]] ;          Show[v3, pointsOnly]


3D plots with parallel projection

It is easy to make 3D Plots with _Mathematica_ , e.g. use:                Plot3D[Sin[x+y^2],{x,-3,3},{y,-2,2}]      But I want to have nice plots in my thesis, so I decided to use pgfplots for $\LaTeX$ together with _Mathematica_. There you can use a picture (of _Mathematica_ ) and draw with $\LaTeX$ well readable axes etc. around the picture (see e.g. p.44 et seq. here). But to use both programs together, I need plots which are in a parallel and not perspective projection. As you can see from the pic, ![Picture with perspective projection](http://i.stack.imgur.com/BNGmv.png) _Mathematica_ gives me a perspective projection. Is there a way to get a parallel projection?


Using singular value decomposition for graph clustering

I have a fairly large graph (50-60 vertices) with directed, weighted edges, and I am attempting to cluster the vertices. Prior to this, I have only worked with undirected graphs having symmetric adjacency matrices, and I am struggling to figure out an effective means of clustering for the asymmetric case. It seems like the "SingularValueDecomposition" command may be helpful, but I have no experience with this process, and I'm struggling to find an adequate tutorial online. If anyone knows of such a tutorial (or has suggestions for another means of clustering), I would appreciate the help.


Consecutive Print to target same output Cell

Is it possible to conveniently direct the output of consecutive **Print** statements to the same output **without actually accumulating the output in a temporary string/variable**. This would be useful in cases where there are a lot of small outputs say like in the example below:               For[i=1,i<=1000,i++,     Print[i," "];     ]      By default each of the Print statement produces a new output cell, which is not desirable. I would prefer a C-style dump-to-terminal output, where one just prints i with a space


Rotate doesn't work with BarChart and BoxWhiskerChart

Rotate@BarChart[RandomReal[1, {4, 5}], ChartLayout -> "Percentile"]       Even though the FullForm generated by BarChart is Graphics expression, Rotate has no effect on BarChart and many other packaged plot functions. However, it's frequently necessary to rotate, scale and align such plots to other graphics in composite data visualizations (eg, imagine a heatmap augmented with row and column descriptive statistics visualized with two corresponding BoxWhiskerChart) How can rotatable, translatable, etc. graphics be extracted from functions like BarChart and BoxWhiskerChart?


How to solve this logarithmic equation?

The equation $$x^2\cdot\log_2\dfrac{3+x}{10}-x^2\cdot\log_{\frac{1}{2}}(2 + 3x)=x^2 - 4+2\cdot\log_{\sqrt{2}}\dfrac{3x^2+11x+6}{10}$$ has two solutions for x, namely 1 and 2. I tried               Reduce[x^2*Log[2, (3 + x)/10] - x^2*Log[1/2, 2 + 3*x] ==        x^2 - 4 + 2*Log[Sqrt[2], (3*x^2 + 11*x + 6)/10], x]      and               Solve[x^2*Log[2, (3 + x)/10] - x^2*Log[1/2, 2 + 3*x] ==        x^2 - 4 + 2*Log[Sqrt[2], (3*x^2 + 11*x + 6)/10], x]      but I could not get these two solutions. How do I tell _Mathematica_ to do that?


Fixing quirky typesetting in plot labels

Consider this example plot.               Plot[      1-Exp[-x],      {x,0,3},      AxesLabel->{"thickness (μm)","power density (W/m^2)"}     ]      ![Example plot with quirky plot labels](http://i.stack.imgur.com/qLjlE.png) Let us hold the typographical quality of the labels to the standard set by LaTeX. There are four distracting quirks:   1. The "m" in "m^2" is italicized   2. The "2" in "m^2" is set high enough to be _above_ the "m"   3. The parentheses in "(W/m^2)" are comically small   4. The "µ" in "µm" is italicized  Am I entering the labels in the wrong form? How can they be fixed?


Choosing range when plotting data from array

I have loaded data from a CSV file which i want to plot in a `BarChart` but i only wish to plot `0:100` instead of the entire dataset. Is there a way to set a range for the `data`? So far i am just plotting everything:               data = Import["/Users/matek/NetworkTest/without_use_in_and_out.csv", "Table"]          Show[         BarChart[data, ChartLegends -> {"TX", "RX"}],         ImageSize -> 600     ]      `data`:               {{1,2},{3,4},{5,6},...}


Where do Mathematica's probability functions draw a line in the sand for predicates?

Thinking about a recent question mis-posted here (belonged on _math_ ), I noted the following. A contrived example - probability that _a_ or _b_ are 1:               Probability[ a == 1 || b == 1, {a \[Distributed] DiscreteUniformDistribution[{0, 1}],       b \[Distributed] DiscreteUniformDistribution[{0, 1}]}]      outputs as expected 3/4. Now if one had a more complicated predicate, say ten variates involved, it would be a messy predicate to do manually. Of course, one could use various facilities to build it auto-magically, or just use something like (keeping it simple as above, but one can see how this makes extension to many variates simple):               Probability[Total[Unitize[{a, b}]] > 0, {a \[Distributed] DiscreteUniformDistribution[{0, 1}],       b \[Distributed] DiscreteUniformDistribution[{0, 1}]}]      which returns the expected result. However, something that intuitively seems it _should_ work, like:               Probability[      Count[{a, b}, 0] != 2, {a \[Distributed] DiscreteUniformDistribution[{0, 1}],       b \[Distributed] DiscreteUniformDistribution[{0, 1}]}]      does not, and somewhat worryingly returns a result (invalid) of 1 rather than an error or warning for an unusable predicate. The same results occur with `NProbability`. (1) Is there any rhyme or reason around what works and what doesn't? (2) Is there any method to get _Mathematica_ to use such a construct directly, or at least spit back a "no can do"?


Suppress warnings in ParallelTable

I'm using `ParallelTable` to evaluate a function that involves `NIntegrate`. There are a lot of `NIntegrate::slwcon` warning messages. In fact, every kernel prints the same messages. I am aware that Mathematica is printing these warnings and now want to suppress them. I tried `Quiet[]` and `Off[NIntegrate::slwcon`. But they seem to have no effect whatsoever when using `ParallelTable`. How can I turn off (any) warning message when using `ParallelTable`?


Earth to Mars Interplanetary Travel Escape Velocity

I'm trying to create a script that simulates interplanetary travel from Earth to Mars using a Hohmann transfer, but I'm having a few difficulties getting the correct escape velocity. I'm using an x-y Heliocentric coordinate system, so I have to break down the escape velocity into its x- and y-components and then add it to the initial conditions of the spacecraft that is orbiting Earth. I've tried using some standard interplanetary escape velocity equations, but so far have come up with the spacecraft going in the right direction, but doing it with too much speed. Here's the code that solves a system of ODEs (I apologize for the horribe looking code, I'm not too sure how to add special Mathematica symbols like epsilons and sigmas to a forum post):               (*Gravitational Constant*)         G = 6.672*10^-11;         Subscript[t, max] = 100000000;         (*Masses of Sun, Earth, Mars and satellite*)         m[0] = AstronomicalData["Sun", "Mass"];         m[1] = AstronomicalData["Earth", "Mass"];          m[2] = AstronomicalData["Mars", "Mass"];         m[3] = 100;         (*Heliocentric positions of Earth, Mars and satellite*)         p[1] = AstronomicalData["Earth", {"Position", {2013, 1, 1, 0, 0, 1}}]         p[2] = AstronomicalData["Mars", {"Position", {2013, 18, 1, 0, 0, 1}}]          p[3] = AstronomicalData[         "Earth", {"Position", {2013, 1, 1, 0, 0, 1}}] + {0, -r[1] -           200000, 0};         (*Planetary radii of Sun, Earth and Mars*)         r[0] = AstronomicalData["Sun", "Radius"];         r[1] = AstronomicalData["Earth", "Radius"];         r[2] = AstronomicalData["Mars", "Radius"];         (*Heliocentric radii components of Earth and Mars*)         rex = Norm[p[1][[1]]];         rey = Norm[p[1][[2]]];         rmx = Norm[p[2][[1]]];         rmy = Norm[p[2][[2]]];         (*Heliocentric velocities of Earth, Mars and spacecraft calculated \         via central difference approximation f'(x)=(f(x+h)-f(x-h))/2h*)         v[1] = ((AstronomicalData[            "Earth", {"Position", {2013, 1, 1, 0, 0, 1.001}}] -            AstronomicalData[            "Earth", {"Position", {2013, 1, 1, 0, 0, 0.999}}]))/(2 (0.001));         v[2] = ((AstronomicalData[            "Mars", {"Position", {2013, 18, 1, 0, 0, 1.001}}] -            AstronomicalData[            "Mars", {"Position", {2013, 18, 1, 0, 0, 0.999}}]))/(2 (0.001));         (*Hyperbolic escape velocities for spacecraft travelling to Mars*)         v1x = Sqrt[(G m[0])/rex] (Sqrt[(2 rmx)/(rex + rmx)] - 1)         v1y = Sqrt[(G m[0])/rey] (Sqrt[(2 rmy)/(rey + rmy)] - 1)         (*Spacecraft initial velocity*)         v[3] = v[1] + {-v1x, -v1y, 0}         (*Softening factor*)         \[Epsilon] = 0.001;         (*Numerical solution to 4-body problem, modelling the gravitation \         interation between the Sun, Earth, Mars and an artificial satelite*)         soln = NDSolve[{         x[0]''[t] == -\!\(         \*UnderoverscriptBox[\(\[Sum]\), \(i =              0\), \(3\)]\(\((G\ m[i] \((\(x[0]\)[t] - \(x[i]\)[t])\))\)/         \*SuperscriptBox[\((         \*SuperscriptBox[\((\(x[0]\)[t] - \(x[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\((\(y[0]\)[t] - \(y[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\((\(z[0]\)[t] - \(z[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\(\[Epsilon]\), \(2\)])\), \(3/2\)]\)\),         y[0]''[t] == -\!\(         \*UnderoverscriptBox[\(\[Sum]\), \(i =              0\), \(3\)]\(\((G\ m[i] \((\(y[0]\)[t] - \(y[i]\)[t])\))\)/         \*SuperscriptBox[\((         \*SuperscriptBox[\((\(x[0]\)[t] - \(x[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\((\(y[0]\)[t] - \(y[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\((\(z[0]\)[t] - \(z[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\(\[Epsilon]\), \(2\)])\), \(3/2\)]\)\),         z[0]''[t] == -\!\(         \*UnderoverscriptBox[\(\[Sum]\), \(i =              0\), \(3\)]\(\((G\ m[i] \((\(z[0]\)[t] - \(z[i]\)[t])\))\)/         \*SuperscriptBox[\((         \*SuperscriptBox[\((\(x[0]\)[t] - \(x[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\((\(y[0]\)[t] - \(y[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\((\(z[0]\)[t] - \(z[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\(\[Epsilon]\), \(2\)])\), \(3/2\)]\)\),         x[1]''[t] == -\!\(         \*UnderoverscriptBox[\(\[Sum]\), \(i =              0\), \(3\)]\(\((G\ m[i] \((\(x[1]\)[t] - \(x[i]\)[t])\))\)/         \*SuperscriptBox[\((         \*SuperscriptBox[\((\(x[1]\)[t] - \(x[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\((\(y[1]\)[t] - \(y[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\((\(z[1]\)[t] - \(z[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\(\[Epsilon]\), \(2\)])\), \(3/2\)]\)\),         y[1]''[t] == -\!\(         \*UnderoverscriptBox[\(\[Sum]\), \(i =              0\), \(3\)]\(\((G\ m[i] \((\(y[1]\)[t] - \(y[i]\)[t])\))\)/         \*SuperscriptBox[\((         \*SuperscriptBox[\((\(x[1]\)[t] - \(x[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\((\(y[1]\)[t] - \(y[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\((\(z[1]\)[t] - \(z[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\(\[Epsilon]\), \(2\)])\), \(3/2\)]\)\),         z[1]''[t] == -\!\(         \*UnderoverscriptBox[\(\[Sum]\), \(i =              0\), \(3\)]\(\((G\ m[i] \((\(z[1]\)[t] - \(z[i]\)[t])\))\)/         \*SuperscriptBox[\((         \*SuperscriptBox[\((\(x[1]\)[t] - \(x[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\((\(y[1]\)[t] - \(y[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\((\(z[1]\)[t] - \(z[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\(\[Epsilon]\), \(2\)])\), \(3/2\)]\)\),         x[2]''[t] == -\!\(         \*UnderoverscriptBox[\(\[Sum]\), \(i =              0\), \(3\)]\(\((G\ m[i] \((\(x[2]\)[t] - \(x[i]\)[t])\))\)/         \*SuperscriptBox[\((         \*SuperscriptBox[\((\(x[2]\)[t] - \(x[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\((\(y[2]\)[t] - \(y[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\((\(z[2]\)[t] - \(z[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\(\[Epsilon]\), \(2\)])\), \(3/2\)]\)\),         y[2]''[t] == -\!\(         \*UnderoverscriptBox[\(\[Sum]\), \(i =              0\), \(3\)]\(\((G\ m[i] \((\(y[2]\)[t] - \(y[i]\)[t])\))\)/         \*SuperscriptBox[\((         \*SuperscriptBox[\((\(x[2]\)[t] - \(x[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\((\(y[2]\)[t] - \(y[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\((\(z[2]\)[t] - \(z[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\(\[Epsilon]\), \(2\)])\), \(3/2\)]\)\),         z[2]''[t] == -\!\(         \*UnderoverscriptBox[\(\[Sum]\), \(i =              0\), \(3\)]\(\((G\ m[i] \((\(z[2]\)[t] - \(z[i]\)[t])\))\)/         \*SuperscriptBox[\((         \*SuperscriptBox[\((\(x[2]\)[t] - \(x[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\((\(y[2]\)[t] - \(y[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\((\(z[2]\)[t] - \(z[i]\)[t])\), \(2\)] +           \*SuperscriptBox[\(\[Epsilon]\), \(2\)])\), \(3/2\)]\)\),         x[3]''[t] == -\!\(         \*UnderoverscriptBox[\(\[Sum]\), \(i =              0\), \(3\)]\(\((G\ m[i] \((\(x[3]\)[t] - \(x[i]\)[t])\))\)/         \*SuperscriptBox[\((         \*SuperscriptBox[\((\(x[3]\)[t] - \(x[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\((\(y[3]\)[t] - \(y[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\((\(z[3]\)[t] - \(z[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\(\[Epsilon]\), \(2\)])\), \(3/2\)]\)\),         y[3]''[t] == -\!\(         \*UnderoverscriptBox[\(\[Sum]\), \(i =              0\), \(3\)]\(\((G\ m[i] \((\(y[3]\)[t] - \(y[i]\)[t])\))\)/         \*SuperscriptBox[\((         \*SuperscriptBox[\((\(x[3]\)[t] - \(x[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\((\(y[3]\)[t] - \(y[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\((\(z[3]\)[t] - \(z[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\(\[Epsilon]\), \(2\)])\), \(3/2\)]\)\),         z[3]''[t] == -\!\(         \*UnderoverscriptBox[\(\[Sum]\), \(i =              0\), \(3\)]\(\((G\ m[i] \((\(z[3]\)[t] - \(z[i]\)[t])\))\)/          \*SuperscriptBox[\((         \*SuperscriptBox[\((\(x[3]\)[t] - \(x[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\((\(y[3]\)[t] - \(y[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\((\(z[3]\)[t] - \(z[i]\)[t])\), \(2\)] +          \*SuperscriptBox[\(\[Epsilon]\), \(2\)])\), \(3/2\)]\)\),              x[0][0] == 0, y[0][0] == 0, z[0][0] == 0, x[1][0] == p[1][[1]],          y[1][0] == p[1][[2]], z[1][0] == p[1][[3]], x[2][0] == p[2][[1]],          y[2][0] == p[2][[2]], z[2][0] == p[2][[3]], x[3][0] == p[3][[1]],          y[3][0] == p[3][[2]], z[3][0] == p[3][[3]], x[0]'[0] == 0,          y[0]'[0] == 0, z[0]'[0] == 0, x[1]'[0] == v[1][[1]],          y[1]'[0] == v[1][[2]], z[1]'[0] == v[1][[3]],          x[2]'[0] == v[2][[1]], y[2]'[0] == v[2][[2]],          z[2]'[0] == v[2][[3]], x[3]'[0] == v[3][[1]],          y[3]'[0] == v[3][[2]], z[3]'[0] == v[3][[3]]}, {x[0][t], y[0][t],          z[0][t], x[1][t], y[1][t], z[1][t], x[2][t], y[2][t], z[2][t],          x[3][t], y[3][t], z[3][t]}, {t, 0, Subscript[t, max]},          Method -> "StiffnessSwitching", MaxSteps -> 10000000]      And here's the plot code:               orbits = ParametricPlot3D[{{x[0][t], y[0][t], z[0][t]}, {x[1][t],      y[1][t], z[1][t]}, {x[2][t], y[2][t], z[2][t]}, {x[3][t],      y[3][t], z[3][t]}} /. soln, {t, 0, Subscript[t, max]},      AxesLabel -> {x, y, z}, ImageSize -> Large,      PlotRange -> {{-0.3*10^12, 0.3*10^12}, {-0.3*10^12, 0.3*10^12}, {-0.3*10^12, 0.3*10^12}}]      As you can see, the output shows the spacecraft shooting off into outer space and never returning, whereas what I would like to see is the spacecraft just getting to the orbital path of Mars (I'll worry about timing and phase angles a little later). ![enter image description here](http://i.stack.imgur.com/ppaZw.png) Does anyone know what I'm doing wrong? Any help would be appreciated, thanks guys.


Pretty InputField

I'm trying to create a "template" notebook for myself.   I want to get input from a single `InputField`, and then run a few operations on it. **How can I make the`InputFiled` (that is, the box itself) be prettier?** How can I manipulate it's style? **EDIT:**   I was asked to define prettier (which stands to reason).   So let's have _WolframAlpha's_ (website) input box as a refrence point.


How to pick increasing numbers from the list.                  lst = {5, 3, 6, 2, 7, 4, 8};      out:                    {5,6,7,8}      So many interesting answers, is it possible know the index of result elements or position of elements with respect to the old "lst"?


How to create a real-time dashboard in Mathematica?

I am trying to figure out how to use Mathematica as a real-time interface. I've used Excel/ODBC connection to a SQL database to use the graphing functions within to get my real-time dashboard. I also know there are many Python implementations (http://dashing.io/), Javascript (d3), Ruby() on watching data. I currently I not looking to do this at a big data implementation. The first piece I am looking for to do is have an updated top 10 SKU Sales that are over 30 locations that are synced back to a Sql Server Database. My thought was to use a simple `SQLExecute` statement to the database every 5 minutes or so. Currently I am trying to figure out how to reissue that command to the db to get my new numbers and automatically update the table. The second piece is to watch transaction flow at each of these locations. Here I just simply want to graph by the hour which I'd update an array with the data. I just don't know how to trigger the data execution. After some searching online, I haven't found anyone who has done this with Mathematica. Does anyone have links/examples where a dashboard is implemented into Mathematica?


Is it possible to simulate a RS latch?

Combining the solutions provided from the nice guys here to my previous two questions(first, second), Interesting enough, simulations for simple logic gates can be implemented easily. An example is given below. Is it possible to simulate logic gates involved loop-backs, such as RS Latchs or JK Flip-flops? I wonder.               (********* gates ************)     not[str : _String] :=        StringJoin[        Characters[str] /. {"1" -> False, "0" -> True} /. {False -> "0",           True -> "1"}];          nand[str : {__String}] :=        not[StringJoin[         MapThread[And,            Characters[str] /. {"0" -> False, "1" -> True}] /. {False ->             "0", True -> "1"}]];               (********* display ************)     funB[str : {__String}, opts : OptionsPattern[]] :=       Module[{fs, n, timd},        fs = Riffle[#, #]~Append~Last[#] & /@ ToExpression@Characters@str;       n = Length@First@fs;       timd = Reverse@fs~Append~PadLeft[{1}, n, {1, 0}];       ListLinePlot[MapIndexed[#1 + 2 First@#2 - 2 &, timd],         InterpolationOrder -> 0,         Frame -> True,     Epilog -> {Table[          Text[Style[ln, {12, Italic}], {ln*2 + .5, 2 *Length[str] }], {ln, 1, 8}],             Dashed, Lighter@Lighter@Blue,          Table[Line[{{ln, 0}, {ln, 2 *Length[str]}}], {ln, 1, 9*2, 2}]},       FrameTicks -> {Thread[{Range[1.5, n - 1.5, 2], Range[n/2]}],          Thread[{Range[0.5, 2 Length@timd, 2],            Join[Reverse@str, {"clock"}]}], None, None},        PlotRange -> {{0, n + 1}, Automatic}, opts]]          Dynamic[Refresh[str2 = StringRotateRight /@ str2;        funB[str2, ImageSize -> 400]  , UpdateInterval -> 0.5],       TrackedSymbols -> {}]          (********* testing ************)     inp1 = "11000000";     inp2 = "10000001";     str2 = {inp1, not[inp1], inp2,  nand[{not[inp1], inp2}]};      ![enter image description here](http://i.stack.imgur.com/xmFwa.gif) @Mr. Wizard Oh yes, it seems possible to build functions for the RS latch and JK flip-flop from their fundamental characteristics instead of just wiring the "logic gates" from strictly following their symbolic diagrams. ![enter image description here](http://i.stack.imgur.com/cwrQ5.gif)


1D Random Walk with Excluded Sites and Variable Time-Step

Here is the physical problem I would like to simulate: Consider the following variations to the 1d random walk:   1. allow for certain, random sites to be excluded with probability 1/2.    2. allow for the walker to be able to hops either 1 or 2 units to left or right   3. whether hopping 1 or 2 units is weighted by hopping rate   4. time in between hops is taken from exponential distribution with width being total hopping rate (to all 4 possible sites) In the end, I would like to find out how much slower a walker takes to reach, say x = 100, when the exclusions are present as to when they are not. The following will be my attempt at the problem. I think I have the basics down but I am hoping there are areas to decrease the computation time. These problems were alluded to earlier in the question and answers of 1D Random Walk variant. First the 4 different hop rates are defined:               kBack1[k0_] := k0 Exp[- 2 ];     kFor1[k0_] := k0 Exp[- 2 ];     kBack2[k0_] := k0 Exp[- 2  * 2];     kFor2[k0_] := k0 Exp[- 2 *2];      I know these are redundant since there are actually only two unique rates. However, I would like to eventually add a bias to the random walk which will make the 4 rates all different. Now we need to choose which site the walker will hop to and how long it takes to make the hop. So the excluded sites are accounted for by If statements. If an excluded site is nearby, there is a probability that that site is unreachable. The new site (newCoords) is chosen by weighting the different hopping rates. The time-step is sampled from the exponential distribution and the simulation time is updated.               FindRate[k0_] := Module[{},       kB1 = If[({Xi} \[Intersection] blockedSites + 1) != {},      RandomChoice[{1/2, 1/2} -> {0, kBack1[k0]}], kBack1[k0]];       kB2 = If[({Xi} \[Intersection] blockedSites + 2) != {},      RandomChoice[{1/2, 1/2} -> {0, kBack2[k0]}], kBack2[k0]];       kF1 = If[({Xi} \[Intersection] blockedSites - 1) != {},      RandomChoice[{1/2, 1/2} -> {0, kFor1[k0]}], kFor1[k0]];       kF2 = If[({Xi} \[Intersection] blockedSites - 2) != {},      RandomChoice[{1/2, 1/2} -> {0, kFor2[k0]}], kFor2[k0]];          newCoords =      RandomChoice[{kB1, kB2, kF1, kF2} -> {Xi - 1, Xi - 2, Xi + 1,        Xi + 2}];          dt = RandomReal[ExponentialDistribution[kB1 + kB2 + kF1 + kF2]];     t = simT;     {Xi, simT} = {newCoords, t + dt}     ]      EDIT: More explanation on how the hop is chosen: Consider the walker to be at point 4. The next hop is chosen in the following way. Is the walker 1 or 2 spaces away from an excluded point? Let's say point 6 is excluded. The rate (kF2) to point 6 is then 0. The other points (2,3, and 5) can be hopped to with respective rate kB2,kB1, and kF1. Which one does it hop to? Well, compare the different rates. In the example we'll have kB2, kB1 = kF1, and kF2 = 0. Which rate is chosen is decided by `RandomChoice` where the choices are weighted by the rates. END EDIT Now it's time to string the hops together               hopMod[k0_, Xf_] := Module[{},     Xi = 0; simT = 0;     blockedSites = RandomInteger[{-100, Xf-2}, 11];(*keep exclusion away from endpoint*)     NestWhileList[FindRate[k0] &, {0, 0}, Xi < Xf &]     ]      where I define a random set of excluding sites. I would prefer to not have adjacent or next-adjacent points not both be exclusions (so separated by at least 2 normal sites). Is there a way to force `RandomInteger` to not sample consecutive integers? Now calculate the time to reach a specified endpoint, Xf. And average this for n configurations.               With[{k0 = 1, Xf = 10, n = 20},(* n is # of runs to average over*)      Print[AbsoluteTiming[       Table[p[i] = hopMod[k0, Xf], {i, 1, n}];]];      iTable = Flatten[Table[p[j][[-1]][[1]]/p[j][[-1]][[2]], {j, 1, n}]]]      This took me 1.33 seconds. The time is highly varying. The time increases dramatically as Xf or increase. For some reason, when I used `ParallelTable`, I got identical results every time I calculated another iTable. Must be something with the seed going wrong. To get convergence, n needs to be increased. So how can this be sped up? Some different schemes for the hopMod module were discussed at 1D Random Walk variant. However I was not sure how to generalized all those approaches to my situation where I also need to keep track of the simulation time.


Why do EstimatedDistribution and DistributionFitTest work this way

I am fitting some time-series data to both a stable distribution and a normal distribution in order to assess the goodness of fit of each. Along the way I encountered the following confusing result. Could someone explain why this happens?               data1 ={0.0779615, 0.10661, -0.10661, -0.0253178, -0.0392207, 0.0892311, \     0.115069, 0.231802, 0.19517, 0.0279739, -0.0901511, -0.0784716, \     -0.0631789, -0.0572607, -0.0825012, 0.195567, 0.0505117, 0.183754, \     0.365871, 0.45219, 0.210721, -0.0396115, 0.0260313, 0.021456, \     -0.0318827, 0.0274891, -0.0239223, -0.00786374, 0.0194273, -0.030735, \     -0.0706707, 0.0745345, -0.0557558, 0.11472, 0.00521248, -0.0694686, \     0.0305097, 0.195748, 0.0830934, 0.205548, 0.0840846, -0.208923, \     -0.112126, 0.0727309, 0.0298448, 0.274583, 0.181881, -0.0555489, \     -0.350074, 0.0276329, 0.0780266, 0.0703987, 0.0228365}          (* First use the distribution fit test and then extract the fitted distribution *)     h1 = DistributionFitTest[data1, Automatic, "HypothesisTestData"];     h1["FittedDistribution"]      > >     NormalDistribution[0.0443194, 0.1352] >                 (* EstimatedDistribution produces the same result when called with symbolic params*)     d1 = EstimatedDistribution[data1, NormalDistribution[μ1, σ1]]      > >     Out=NormalDistribution[0.0443194, 0.1352] >                 (* Use DistributionFitTest on the estimated distribution *)     h2 = DistributionFitTest[data1, d1, "HypothesisTestData"];     h2["FittedDistribution"]      > >     Out= NormalDistribution[0.0443194, 0.1352] >                 (* Output the TestDataTable and observe very different results *)     Grid[{{h1["TestDataTable", All]}, {h2["TestDataTable", All]}}\[Transpose], Frame -> All]      ![grid output](http://i.stack.imgur.com/YDgYh.jpg) Looking inside these objects shows only one difference, which is the symbolic parameters in h1 and numeric parameters in h2, but I'm not sure why this should be, since the evaluation of the symbolic parameters should produce the same numeric results.


Set number of columns in text-based interface

Is it possible to set the number of columns in _Mathematica_ 's text-based interface? Or disable word wrapping in the text-based interface ? Specifically, my concern is output from `MatrixForm` and `TableForm`, which wraps output at about 85 columns. It seems as if the values were hardcoded in 1992. I use the text based interface within an emacs shell buffer. EDIT: The answer below that I checked green solves this problem in a few tests of commands that give long output, such as MatrixForm.


How to get the list of notebooks that are automatically opened when Mathematica starts?

How to get the list of notebooks that are automatically opened when Mathematica starts programmatically? I know a tedious approach is opening option inspector and finding and copying the list out.


the winding number for the circle map (Arnold tongue)

I want to do an iterative calculation:               f[n_, a_, b_] := Nest[# + a - b Sin[2 π #] &, 0, n]/n;      If I use i use the machine precision, it maybe produce a great error,for example:               N@f[500, 1/2, 3/5]     f[500, 0.5, 0.6]      > 0.5 > > 0.0282658 In the most of the time it can not ust infinity precision and then use N. How can I calculate this in high precision? **Edit:** this question is from this: http://en.wikipedia.org/wiki/Circle_map I want to reappear this image： ![enter image description here](http://i.stack.imgur.com/BNYAP.jpg) My code is：               f = Compile[{n, a, k}, Nest[# + a - k Sin[2 \[Pi] #] &, 0, n]/n];     dat =Outer[f[500, #2, #] &, Range[0, 1, 1/500], Range[0, 1, 1/500]]; // AbsoluteTiming     ArrayPlot[dat,         ColorFunction -> (Blend[{Black, Blue, Green, Yellow, Red}, #] &),         ColorFunctionScaling -> False, DataReversed -> True]      My rusult is: ![enter image description here](http://i.stack.imgur.com/0OxVM.jpg)


Insphere for Irregular Tetrahedron

I am looking for existing _Mathematica_ code to compute the unique sphere inscribed inside an irregular tetrahedron. I can write it myself, but I would love to find that someone already performed this calculation and can share their code. I want to take as input four points (a,b,c,d) in 3D and return the center, radius, and four tangency points of the insphere. If no one has already done this, then I will go ahead and write it myself. Responding to the request for an example:               a = {0, 0, 0};     b = {1, 0, 0};     c = {2, 1, 0};     d = {1, 3/2, 1};         ![Tetrahedron](http://i.stack.imgur.com/QOf5N.jpg) * * * **Updated**. ( _11Oct13_ ) The Wikipedia pages to which `ybeltukov` pointed _are_ correct. Here the inradius is all of $0.127$:   ![Tetra InSphere](http://i.stack.imgur.com/D0qNi.jpg)   I have the insphere center and radius, but not yet the four tangency points.... * * * And here are the four points of tangency:   ![InSphere Tangencies](http://i.stack.imgur.com/nurg2.jpg)


Why is either Listable or HoldFirst not working?

Starting with a fresh kernel, I evaluate the following:               Questions = {         (* Statement, Answer, Incorrect Answer *)         {"What is the capital of Switzerland?", "Bern", {"Vaduz", "Berlin", "Vienna"}},         {"Who is the king of the jungle?", "Lion", {"Giraffe", "Mouse", "Monkey"}},         {"2+2?" , "4", {"15", "13", "1e15"}}     } ;     Dynamic@Column@Questions          SetAttributes[DynamicInputField, {HoldFirst, Listable}];     DynamicInputField[var_, OptionsPattern[ContentType -> Expression]] :=        InputField[Dynamic[var], OptionValue[ContentType],         ContinuousAction -> True, ImageSize -> Full];          Dynamic@Grid[{        {"Statement", DynamicInputField[Questions[[1, 1]], ContentType -> String]},        {"Answer", DynamicInputField[Questions[[1, 2]], ContentType -> String]},        {Column[{"Incorrect Answers"}, BaselinePosition -> Top],          Column[DynamicInputField[#, ContentType -> String] & /@ Questions[[1, 3]],             BaselinePosition -> Top]        }     }, Alignment -> Left]      ![Statement](http://i.stack.imgur.com/dtvc6.jpg) I must say that I took me a while to find out that I needed to set HoldFirst as an attribute for my function to work at least with the first two input fields. Nevertheless, the function does not work by mapping it into a list, i.e., the three last input fields send a error, the same one I had before I set HoldFirst as an attribute:               Set::setraw : Cannot assign to raw object Vaduz.>>      What am I doing wrong? I also tried the following:               Column[DynamicInputField[Questions[[1, 3]], ContentType -> String],          BaselinePosition -> Top]      ![Attempt1](http://i.stack.imgur.com/NGfH8.jpg)               Column[Table[         DynamicInputField[Questions[[1, 3, n]], ContentType -> String],          {n, 3}], BaselinePosition -> Top]      ![Attempt2](http://i.stack.imgur.com/6xiFU.jpg) Giving the errors:               Part::pkspec1 : The expression n cannot be used as a part specification.>>      even when I put the Table inside a `With[[n=n],...]`. Moreover, why is not the same result in my two attempts of "solving" even though the function was set to be listable?


How to correctly project heat map onto map

I'm importing the NGA ASAM piracy database into Mathematica for analysis.               asamjson=Import["http://msi.nga.mil/MSI_JWS/ASAM_JSON/getJSON?typename=\     DateRange_AllRefNumbers&fromDate=19900101&toDate=20140801",       "JSON"];     Needs["GeneralUtilities`"]     asamdataset = Dataset[ToAssociations@asamjson];     piracyLocations =       Map[GeoPosition[ ToExpression@{#["lat"], #["lng"] }]   &,        asamdataset];      I can import the data fine, and get lat/longs (for some reason they're included twice in the ASAM data). I can then draw them with GeoListPlot and get map of all the piracy events.               GeoListPlot[Take[piracyLocations, 300]]      However, when I then go to make a heat map histogram things fall apart. What displayed nicely now shows up with a wildly out of skew map. It looks like I need to choose some different form of projection, but which?               dat = Map[ ToExpression@{#["lat"], #["lng"]}&,Take[asamdataset, 4000]];          histo = SmoothDensityHistogram[dat, .3,       ColorFunction -> "SunsetColors", PlotPoints -> 150, Mesh -> 20,       MeshStyle -> Opacity[.1], PlotRange -> All];          Show[histo,       Graphics[{FaceForm[], EdgeForm[Directive[White, Opacity[.7]]],       CountryData["World", "Polygon"]}]]      How do I project my heatmap of piracy events correctly onto the world? EDIT: My first problem is that Geoposition and related functions take Lat/Long pairs. Which is Y/X, whereas other Mathematica functions take X/Y pairs.


Need an efficient way to do this list manipulation

Lets say i have two lists with me as given below:               l1 = {4, 6, 8, 9, 10, 12};          l2 = {2, 3, 4, 5, 6, 7};      Now i have a function S2P(details irrelevant) which takes one argument and spits out a list.               S2P[a_] := DeleteDuplicates[Apply[Times,Partition[Flatten[IntegerPartitions[a, {2}]], 2], {1}]]      Now i want to feed S2P the elements of l2 and find which elements of l2 gives an output that is a subset of l1. For e.g               S2P[5]     (*{4, 6}*)           S2P[7]     (*{6, 10, 12}*)      These are the only two elements of l2 for which the output from S2P is a subset of l1 and im finding them like this:               t1[n_] := Module[{l3, res, len},     l3 = S2P[l2[[n]]];     len = Length[l3];     res = Count[     Flatten[Table[{l3[[i]]} == {l1[[#]]} & /@ Range[Length[l1]], {i,1,len}]],True];     If[res == len, Sow[l2[[n]]]]];          DeleteCases[t1[#] & /@ Range[Length[l2]], Null]     (*{5, 7}*)      Can someone show me how to do this more efficiently for large data. Below i have shown the actual function l1 and l2 where n can go upto 1000.               f4 = #~Extract~SparseArray[Unitize[#2 - 1]]["NonzeroPositions"] & @@      Transpose@Tally@# &; (* to keep only duplicates*)          l1[n_] :=      DeleteCases[f4[Flatten[Table[i*j, {i, 1, n}, {j, 1, n}]]], _?PrimeQ]          l2[n_] :=      DeleteDuplicates[Flatten[Table[i + j, {i, 1, n}, {j, 1, n}]]]


ParametricPlot3D with three variables

`ParametricPlot3D` can be used with one or two variables to plot paths and surfaces in 3-D such as               ParametricPlot3D[{x + y, x y, Sin[x] + Cos[y]}, {x, 0, 1}, {y, 0, 1}]      However, say I wanted to plot a 3-D solid where the x, y and z coordinates are defined in terms of 3 variables. Is there some way to use `ParametricPlot3D` or other Mathematica functions to perform this task? A simple test case could be               ParametricPlot3D[{x, y, z}, {x, 0, 1}, {y, 0, 1}, {z, 0, 1}]      which should output a cube.


BoxWhiskerChart with logarithmic axes 2

I actually already found my answer on the question, however it is not working. see BoxWhiskerChart with logarithmic axes I want to create a boxwiskerchart with a logaritmic axes. But when I try `ScalingFunctions` with "Log" I do not get the results I am suppose to get. Sometimes it does not work at all. And sometimes I get the wiskers upside down. What am I doing wrong?               data = RandomVariate[RayleighDistribution[RandomInteger[500]], {8, 50}];     BoxWhiskerChart[data, "Outliers", ChartStyle -> 56]      ![enter image description here](http://i.stack.imgur.com/aHd1r.jpg)               BoxWhiskerChart[data, "Outliers", ChartStyle -> 56, ScalingFunctions -> "Log"]      ![enter image description here](http://i.stack.imgur.com/Lfpc5.jpg) Also using Log10 does not work               BoxWhiskerChart[data, "Outliers", ChartStyle -> 56, ScalingFunctions -> "Log10"]      ![enter image description here](http://i.stack.imgur.com/zIAjn.jpg)


Weird behavior when changing parts of matrix

I have this matrix:               mat = {{1, 2, 3, 4, 5}, {6, 7, 8, 9, 10}, {11, 12, 13, 14, 15}, {16,          17, 18, 19, 20}, {21, 22, 23, 24, 25}};      and here are its second row and second column:               {mat[[2]], mat[[All, 2]]}     (* {{6, 7, 8, 9, 10}, {2, 7, 12, 17, 22}} *)      When I tried to change its second column to all zeros, this method works:               mat = {{1, 2, 3, 4, 5}, {6, 7, 8, 9, 10}, {11, 12, 13, 14, 15}, {16,          17, 18, 19, 20}, {21, 22, 23, 24, 25}};     mat[[All, 2]] = 0;     mat // MatrixForm      ![Mathematica graphics](http://i.stack.imgur.com/yY2WN.png) But using the method to change the second row, the entire row become a big zero:               mat = {{1, 2, 3, 4, 5}, {6, 7, 8, 9, 10}, {11, 12, 13, 14, 15}, {16,          17, 18, 19, 20}, {21, 22, 23, 24, 25}};     mat[[2]] = 0;     mat // MatrixForm      ![Mathematica graphics](http://i.stack.imgur.com/efWeD.png) * * * **My question is:** **1)** Why would the replacement of a row versus a column in a matrix different? **2)** Why would setting the list of all column elements to zero automatically set each of them to zero? Setting a list to a single number doesn't seem to work in isolation:               {a, b, c} = 0      ![Mathematica graphics](http://i.stack.imgur.com/usAWS.png)


graphics and manipulate stiffness method

I'm trying to create a structures analysis program based on the stiffness method. The program should analyse frames. All the program should be included in the manipulate function. What I want at first to be able to draw the structure using graphics. The problem is the user has to specify some variables in order to draw the figure(spans and floors number) which will be the variables in the manipulate. How can I do this? Since the number of objects to draw is varying how can creat one single function to do this job. I'll will explain it again. If the user chooses one span and one floor the function should draw two vertical lines with one horizontal between them. If he chooses 2 spans 2 floors he should see 3 vertical lines with 2 lines horizontally spaning between them midway and 2 horizontal lines at the top. Thank you.


Vectorizing an image like "Trace Bitmap" in Inkscape

Lately, we had a nice question about artistic image vectorization which got very nice answers. As Szabolcs pointed out himself > Since "true" vectorization performed by various specialized software is a > tough problem, I suggest to consider "artistic" approaches, which produce > inexact, but beautiful version of the original. And this is true: Sophisticated bitmap tracers like the implementation in Inkscape let you adjust how many color-levels, how detailed or how smooth the vectorized image should be. Following example was created from a Mathematica image with Inkscape: ![Mathematica graphics](http://i.stack.imgur.com/a9GPY.png) **Still, I wonder whether it is possible to implement a vectorizer which comes very close to the behavior of the above without re-implementing the algorithm but with the help of the many tools we have in Mathematica?**


How to give ClusteringComponents initial values?

I came across a variant of k-means that adds a algorithm to select good starting values called k-means++.               kMeansInitializer[data_, k_Integer] :=      Module[       {startingPoint = RandomChoice[data], getDistance, getDistances,         nextPoint},       getDistance[datum_, points_] := Min[Norm[datum - #]^2 & /@ points];       getDistances[points_] := getDistance[#, points] & /@ data;       nextPoint[points_] := RandomChoice[getDistances[points] -> data];       NestList[nextPoint, startingPoint, k - 1]       ]      After implementing the algorithm (a bit of a challenge for someone at my level) I now find I have no idea how to feed the values I generate to `ClusteringComponents` to use as initial values for use in its k-means implementation.


Using J/Link to decode Google Maps Polyline strings

I would like to use this java code inside _Mathematica_ using J/Link. It converts Google Maps API Encoded Polylines to a list of points. I tried the _Mathematica_ tutorial but got lost. There is the Java code:               private List<GeoPoint> decodePoly(String encoded) {          List<GeoPoint> poly = new ArrayList<GeoPoint>();     int index = 0, len = encoded.length();     int lat = 0, lng = 0;          while (index < len) {         int b, shift = 0, result = 0;         do {             b = encoded.charAt(index++) - 63;             result |= (b & 0x1f) << shift;             shift += 5;         } while (b >= 0x20);         int dlat = ((result & 1) != 0 ? ~(result >> 1) : (result >> 1));         lat += dlat;              shift = 0;         result = 0;         do {             b = encoded.charAt(index++) - 63;             result |= (b & 0x1f) << shift;             shift += 5;         } while (b >= 0x20);         int dlng = ((result & 1) != 0 ? ~(result >> 1) : (result >> 1));         lng += dlng;              GeoPoint p = new GeoPoint((int) (((double) lat / 1E5) * 1E6),              (int) (((double) lng / 1E5) * 1E6));                     poly.add(p);         }              return poly;     }      As example:               wjiGtdpcNrAlBJZ      should return               43.64175, -79.38651     43.64133, -79.38706     43.64127, -79.3872      I have no experience in Java. The code came from here.


Getting the 557th element of a table

> Make a table with elements $\sin(\sqrt{8 n}/4) + r\, $for $n$ from $1$ to > $1000$, where $r$ is a random real number between $-0.1$ and $0.1$ that is > different for each value of $n$. Also make a plot of all the points of this > table. What is the $557^{th}$ element of this table? Everything is working well, but I can't get the 557th element of the table. I've tried to use the `Select` command.               Select[TableSin[Sqrt[(a*n)/4]] + Random[Real, {-0.1, 0.1}], {n, 1, 1000}] ,557]      but it's not working. I can't figure out how to fix it. Can anyone give me some hints?


Simulating Stochastic Processes the MMA way

This question is really a specific problem and a methodological one concerning MMA best practices. I want to simulate a system of stochastic processes. If this were a geometric Brownian motion or random walk then the recursive (univariate) nature of the problem means `FoldList` or `Nestlist` is easy and neat to implement. However, what if I wanted to simulate an mean-reverting process which itself had a mean-reverting long run mean? Now, I cannot work out the MMA efficient way of doing it other than within a `For` loop. For example, the following code simulates an OU process for inflation with a stochastic central tendency :               Clear["Global`*"];           norθ[mu_, sigma_] := Random[NormalDistribution[mu, sigma]];      norπ[mu_, sigma_] := Random[NormalDistribution[mu, sigma]];           deltaθt[θnow_] :=-λθ*(θnow-θbar)*deltaT + σθ*norθ[0, 1]*Sqrt[deltaT]         deltaπt[πnow_] := -λπ*(πnow - θnow)*deltaT + σπ*norπ[0, 1]*Sqrt[deltaT]          λθ     = 0.07;     σθ     = 1.2;     θbar   = 2;     θnow   = 2;     λπ     = 1.;     σπ     = 1.25;     πnow   = 2;     deltaT = 1/12;     noYear = 100*12;          Process = Reap[For[i = 1, i < noYear, i++,          Sow[{i, πnow, θnow}];          πnow = deltaπt[πnow] + πnow;          θnow = deltaθt[θnow] + θnow;       ]][[2, 1]];           inflation = Process[[All, {1, 2}]];      target    = Process[[All, {1, 3}]];          ListLinePlot[{inflation, target}]


Equation Simplification in Mathematica

I wonder if the following equation could be further simplified by Mathematica. There are $22$ Integrals involved and many of them are in the range $y_l$ and $y_u$. I would guess that at least those terms could be collected in the same integral. I used the command FullSimplify but the result is the same with the input. Are there some more clever ways to simplify such type of equations?               (2*(1 - \[Epsilon]0)^2*Integrate[((Sqrt[f1[y]*l[yu]] - Sqrt[f0[y]*l[yl]     *l[yu]])*(-Sqrt[f1[y]*l[yl]] + Sqrt[f0[y]*l[yl]*l[yu]]))/(-Sqrt[l[yl]] +      Sqrt[l[yu]])^2, {y, yl, yu}] - 2*(Integrate[(Sqrt[f0[y]]*(-Sqrt[f1[y]*l[yl]] +      Sqrt[f0[y]*l[yl]*l[yu]]))/(-Sqrt[l[yl]] + Sqrt[l[yu]]), {y, yl, yu}] +      Integrate[f0[y], {y, -Infinity, yl}]*Sqrt[l[yl]])*(Integrate[(Sqrt[f0[y]]*      (Sqrt[f1[y]*l[yu]] - Sqrt[f0[y]*l[yl]*l[yu]]))/(-Sqrt[l[yl]] + Sqrt[l[yu]]),      {y, yl, yu}] + Integrate[f0[y], {y, yu, Infinity}]*Sqrt[l[yu]]) -      Sqrt[(-2*(1 - \[Epsilon]0)^2*Integrate[((Sqrt[f1[y]*l[yu]] -      Sqrt[f0[y]*l[yl]*l[yu]])*(-Sqrt[f1[y]*l[yl]] +      Sqrt[f0[y]*l[yl]*l[yu]]))/(-Sqrt[l[yl]] + Sqrt[l[yu]])^2, {y, yl, yu}] +      2*(Integrate[(Sqrt[f0[y]]*(-Sqrt[f1[y]*l[yl]] +      Sqrt[f0[y]*l[yl]*l[yu]]))/(-Sqrt[l[yl]] + Sqrt[l[yu]]), {y, yl, yu}] +      Integrate[f0[y], {y, -Infinity, yl}]*Sqrt[l[yl]])*(Integrate[(Sqrt[f0[y]]*     (Sqrt[f1[y]*l[yu]] - Sqrt[f0[y]*l[yl]*l[yu]]))/(-Sqrt[l[yl]] +      Sqrt[l[yu]]), {y, yl, yu}] + Integrate[f0[y], {y, yu, Infinity}]*     Sqrt[l[yu]]))^2 - 4*((Integrate[(Sqrt[f0[y]]*(-Sqrt[f1[y]*l[yl]] +      Sqrt[f0[y]*l[yl]*l[yu]]))/(-Sqrt[l[yl]] + Sqrt[l[yu]]), {y, yl, yu}] +      Integrate[f0[y], {y, -Infinity, yl}]*Sqrt[l[yl]])^2 -      (1 -\[Epsilon]0)^2*(Integrate[(Sqrt[f0[y]]*(-Sqrt[f1[y]*l[yl]] +      Sqrt[f0[y]*l[yl]*l[yu]])^2)/(-Sqrt[l[yl]] + Sqrt[l[yu]])^2, {y, yl, yu}] +      Integrate[f0[y], {y, -Infinity, yl}]*l[yl]))*((Integrate[(Sqrt[f0[y]]*     (Sqrt[f1[y]*l[yu]] - Sqrt[f0[y]*l[yl]*l[yu]]))/(-Sqrt[l[yl]] +      Sqrt[l[yu]]), {y, yl, yu}] + Integrate[f0[y], {y, yu, Infinity}]*     Sqrt[l[yu]])^2 - (1 - \[Epsilon]0)^2*(Integrate[(Sqrt[f1[y]*l[yu]] -      Sqrt[f0[y]*l[yl]*l[yu]])^2/(-Sqrt[l[yl]] + Sqrt[l[yu]])^2, {y, yl, yu}] +      Integrate[f0[y], {y, yu, Infinity}]*l[yu]))])/(2*((Integrate[(Sqrt[f0[y]]*     (Sqrt[f1[y]*l[yu]] - Sqrt[f0[y]*l[yl]*l[yu]]))/(-Sqrt[l[yl]] + Sqrt[l[yu]]),      {y, yl, yu}] + Integrate[f0[y], {y, yu, Infinity}]*Sqrt[l[yu]])^2 -      (1 - \[Epsilon]0)^2*(Integrate[(Sqrt[f1[y]*l[yu]] -      Sqrt[f0[y]*l[yl]*l[yu]])^2/(-Sqrt[l[yl]] + Sqrt[l[yu]])^2, {y, yl, yu}]      +Integrate[f0[y], {y, yu, Infinity}]*l[yu])))


Equivalent Nested Loop Structure

Consider the following examples:               Flatten @ Table[ f[a, b, c], {a, 1, 3}, {b, 1, 3}, {c, 1, 3}] ==     f @@@ Tuples[ Range[3], 3]          Flatten @ Table[ If[ a != b != c, f[a, b, c], Unevaluated[]],                       {a, 1, 3}, {b,  1, 3}, {c, 1, 3}] ==      f @@@ Permutations[ Range[3], {3}]          Flatten @ Table[ f[a, b, c], {a, 1, 5}, {b, a + 1, 5}, {c, b + 1, 5}] ==      f @@@ Subsets[ Range[5], {3}]      > >     True >     True >     True >   Is there a similar built-in function performing this:               Flatten @ Table[ f[a, b, c], {a, 1, 5}, {b, a, 5}, {c, b, 5}]      in a simpler way?


Solving asymptotic equations

Let's say I have several equations that have solutions given as a negative series $$y(t,x)=\sum_{n=-1}^\infty a_n(t) x^{-n}=a_{-1}x+a_0+a_1x^{-1}+\mathcal{O}(x^{-2})$$ My equations look like $$eqns=\mathcal{O}(x^{n})$$ where RHS is given for each equation. Now what that means is that after putting my ansatz of solution in the equation, all the powers smaller than ones given by RHS will cancel each other out, and I'll end up with equations for my coefficients $a_n$. For instance $$2\frac{\partial}{\partial t}y+3y=\mathcal{O}(1)$$ $$2(a_{-1}'x+a_0'+\mathcal{O}(x^{-1}))+3(a_{-1}x+a_0+\mathcal{O}(x^{-1})=\mathcal{O}(1)$$ which gives me $$2a_{-1}'x+3a_{-1}x=0$$ which can now be solved and used elsewhere, for other coefficients etc. This is simple example since I have only one solution, but in reality I'm dealing with a solution that is vector with 4 components that have similar expansion for each component, that's why I'd like to speed up the process by finding out what each component will look like. Now I can get the equations in Mathematica, and I have even made a simple ansatz (different than this ofc)               y = Sum[a[#1][n] #2^-n, {n, -1, 4}] &;      And I can input that in to my equations, and with `Collect` I can gather all the 'stuff' with all the powers of x. Now I'd like to see if there is any way that I can make Mathematica give me the coefficient equation, and all I need to do is specify which parts of the equation with series needs to be kept (in my examples all the $\mathcal{O}(1)$ parts cancel each other so I'm neglecting all the $x^0, x^{-1},...$ parts in my ansatz). Because the way I'm doing it now is just inputing it all, collecting and seeing what is $\mathcal{O}(x^n)$ for each component and manually have to solve it.


Reducing a long complex expression to a simplier one by using assumptions

so I have an ugly looking equation that I wish to solve under some specific circumstances. Using DSolve I write;                t = DSolve[{p'[r] ==  A*((r - (rc^2)/r) - ((l)*Log[((rc - r)^2 + l)/l])/r +                  (2*Sqrt[l]*rc*ArcTan[(rc - r)/Sqrt[l]])/r), p[rc] == 0},  p[r], r]      And this yields a long, ugly expression involving imaginary numbers and PolyLog functions - this is fair enough, but I'm trying to simplify it further by telling it only to look at realistic cases; $A, r, r_{c}$ are always real and positive, as is $p$. Also, $r_{c} >= r$ so that $r_{c} - r$ is always a positive number. $L$ is also always positive and orders of magnitude smaller than $r$ or $r_{c}$. So I attempted to use full simplify with these assumptions on the expression by               u = FullSimplify[t, rc > 0 && r > 0 && rc >= r && l > 0 && A > 0 && p >= 0 ]      This simplifies the expression somewhat, but still has clunky imaginary parts and I suspect it can be further simplified. I have tried Refine but this doesn't yield a better expression. Is it possible to clean this up, or do I accept this as just a complex looking expression that gives me real answers and cannot be further simplified ? Thanks!


CDF embedding in HTML

I created a working CDF file on my Mac, and I am trying to embed it into an html page, and although I followed all the steps suggested on the mathematica web embedding page, it is not working (I always get a white page when I try to open my page). This is what I have done so far:   * I exported my _Mathematica_ code as a CDF standalone "AGN-standaloneClear.cdf", checked and it is working with CDF Player   * I opened TextEdit, converted to plain text and wrote:                        <embed src="AGN-standaloneClear.cdf” width=“1380” height=“6792”>                and saved it as test.html into the same folder where the cdf is. When I try to open it with Chrome the page is completely white however, and if I try to reopen the test.html file it is completely white. I never tried to deal with html, so I think I could be doing some very noob errors that are not even explained in the guides I read so far, but however I don't know what to do. -EDIT- Here is the code that generates the white page:                                                        and here is the one that generates the cropped cdf (http://postimg.org/image/tgqa3bicl/):


Copy string with markup so it looks good on input

How can I copy a string with a bunch of `*Box` expressions without it blowing up into the raw expression?               text = Integrate::usage     (* Nice looking String *)          text//Head     (* String *)      After copying the output and pasting it into an input cell it looks like                "\!\(\*RowBox[{\"Integrate\", \"[\", RowBox[{StyleBox[\"f\", ....      Same thing happens when evaluating in place, so how can I do this without retyping the entire expression?


Setting a Counter in Mathematica Notebook

I would like to write a book using _Mathematica_ , but I will write one chapter on several files. How to tell _Mathematica_ that the `BookChapterNumber` pointer has the value pointing to the next file in the same chapter ?


NIntegrate (multi-dimensional integral)

I am interested in the numerical evaluation of the following integral: $\int \prod_{i=1}^n dx_i \delta(\sum_{i=1}^n x_i) \prod_{i=1}^n f_i(x_i)$ where $f(x)$ is a complicated function. Unfortunately NIntegrate seems to give an answer with too large errors; this seems to be problem of the multi- dimensional integral. The function contains the phase fluctuations ($\sim e^{ikx}$), which could be one of the reasons. In practice $n\sim 5$, although it is certainly better if I could take $n$ large. For comparison, I can also consider an integral $\int \prod_{i=1}^n dx_i \prod_{i=1}^n f_i(x_i)$ but instead of evaluation this whole expression in NIntegrate, I could factorize the integral to be $\prod_{i=1}^n \left(\int dx_i\, f_i(x_i)\right)$, evaluate the 1-dimensional integral first and then take a product. This seems to give an answer which is numerically much better than NIntegrating the n-dimensional integral. [I am numerically checking the known mathematical identity so I have something to compare with. The one with the delta function corresponds to $SU(N)$, the one without to $U(N)$.] The trouble with the one above, with 1 delta function, is that the integral does not factorize. However I hope there is a way to achieve numerical accuracy, rather than brute-force NIntegrate of the whole expression. In any case I would appreciate any suggestions for better numerical accuracy.


Obtain a stable solution using NDSolve

I am trying to solve a partial differential equation using `NDSolve`. When I am not specifying any method options with `NDSolve`, it gives me a solution which is quite oke but shows oscilations that are not suppose to be there. I expected to be able to solve this using options like `MaxStepSize` to get rid off or at least reduce this oscilations. However, unfortunately, when I use for example `MaxStepSize -> 0.01` I get results that do not make sense and errors like `NDSolve::mconly: For the method IDA, only machine real code is available. Unable to continue with complex values or beyond floating-point exceptions. >>` I do not really understand why I get this error. Hopefully someone could illuminate this to me. Also I guess `MaxStepSize` is not the way to give me a better solution, are there any other options to improve my solution or should I just be satisfied with the one I have so far? Thanks in advance Simplification of the code:               tmin = 0; tmax = 70;     xmin = 0; xmax = 183;     rate = 0.00084;     a = 96;     b = 5/3;          f[t_] :=  If[t > 1 && t < 30, rate, 0];          eq1 = i[x, t] == a *h[x, t]^b;     eq2 = D[i[x, t], x] + D[h[x, t], t] ==  f[t];     ic1 := h[x, 0] == 0;     ic2 := i[x, 0] == 0;     bc1 := h[0, t] == 0;          solution = NDSolve[{eq1, eq2, ic1, ic2, bc1},         {i, h}, {x, xmin, xmax}, {t, tmin, tmax}, (*MaxStepSize -> 0.01*)];     Manipulate[      Plot[Evaluate[i[x, t] /. solution], {t, 0, tmax}, PlotStyle -> Red,        ImageSize -> {350}], {x, xmin, xmax}]      ![result for x=16.4, where the top of the graph is supposed to be flat](http://i.stack.imgur.com/K946n.jpg)


Computing integrals with differential operator

I've to compute this expression $$ \hat{H} = \frac{1}{4}g_2\int d^3R\int d^3r\ \bar{\Psi}(\vec{R}+\frac{\vec{r}}{2})\bar{\Psi}(\vec{R}-\frac{\vec{r}}{2})\left[ \delta(\vec{r})\nabla_{\vec{r}}^2 +\nabla_{\vec{r}}^2\delta(\vec{r}) \right]\Psi(\vec{R}+\frac{\vec{r}}{2})\Psi(\vec{R}-\frac{\vec{r}}{2}) $$ where $\bar{\Psi}$ is the conjugate of $\Psi$. How can i calculate it with Mathematica? I don't know how to represent the differential operator and doing this kind of integral with Mathematica. ///// **Edit** ///// Instead to give me negative vote, you can explain me what i've to add to my question.


Sum all numbers from 1 to 1000 divided by either 2,3,5 or 7

How do I find the sum all numbers from 1 to 1000 divided by atleast one of 2,3,5 or 7? EDIT: I am sorry for complicating this, but I need it to work for 10^11. So anything that requires too much heap space or too long loops will fail.


Reduce cannot evaluate the inequality

Reduce[{(4 I1^2 (-2 + b (-2 + I1)^2 + 2 I1 - I1^2) +        c^2 (-3 - I1^4 + b (-3 + I1^2)^2) -        4 c I1 (-2 + I1^2 - I1^3 + b (6 - 3 I1 - 2 I1^2 + I1^3))) ((      c (-1 + I1) (c - 2 I1 + c I1))/(b I1^2 (a - r)))^b < 0, c > 0,       c < 1, b > 1, r > a, r > 0, a > 0}, I1, Reals]      The code above cannot be "reduced" in Mathematica. Could someone tell me what I am doing wrong?


Longest path in 0/1 matrix

I have a matrix of 0's and 1's forming a number of disjoint paths: * * *   ![RandomPaths](http://i.stack.imgur.com/pUlT7.jpg) * * * I would like to find the lengths of the paths, and from that "spectrum," the longest length (in the above example: 27, starting at {1,14}). (The shortest length possible is 3, just from how I generate these paths. There are never trees or cycles--just paths.) I can do it by identifying start 1-cells as either on the boundary, or having three 0-neighbors and one 1-neighbor, and then tracing from the start cell along the path. This is quite clunky. Can anyone see a slicker method? Efficiency is not my main concern at the moment. Thanks for your ideas! Here's the matrix displayed above: * * *               {{0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1,        0, 0, 0, 0, 0, 0, 0}, {1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 1, 1, 0, 1, 0,        1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1}, {0, 1, 0, 0, 0, 0, 0,        1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,        0}, {0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0,        0, 1, 0, 0, 1, 0, 0, 1, 0}, {0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 0,        1, 1, 1, 1, 0, 1, 1, 0, 0, 1, 0, 0, 1, 1, 0, 1, 1}, {0, 0, 0, 0, 1,        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0,        0, 0}, {0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 0,        0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {1, 1, 0, 0, 1, 0, 1, 1, 0, 1, 1, 0,        0, 1, 0, 0, 1, 0, 1, 1, 0, 0, 1, 1, 1, 1, 0, 0, 1, 1}, {0, 1, 0, 0,        1, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1,        0, 0, 1, 0}, {0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0,        0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0}, {1, 1, 1, 0, 1, 1, 0, 1, 1, 1,        1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 0, 1, 0, 0, 1, 0, 0, 1, 1}, {0, 0,        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0,        1, 0, 0, 0, 0}, {0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0,        0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0}, {1, 1, 0, 0, 1, 1, 0, 1, 0,        0, 1, 0, 1, 1, 0, 1, 1, 1, 0, 1, 0, 0, 1, 0, 0, 1, 1, 0, 1, 1}, {0,        0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 1,        0, 0, 0, 0, 0, 1, 0}, {0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0,        0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0}, {0, 1, 1, 1, 1, 0, 0,        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1,        0}, {0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0,        0, 1, 0, 0, 1, 0, 0, 0, 0}, {0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0,        1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0}, {0, 1, 1, 0, 1,        1, 1, 1, 0, 1, 1, 0, 1, 1, 0, 0, 1, 1, 1, 1, 1, 0, 1, 1, 0, 1, 0, 1,        1, 0}, {0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0,        0, 0, 1, 0, 0, 1, 0, 0, 0, 0}, {0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0,        0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0}, {0, 1, 0, 1,        1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 1, 1, 1, 1, 0, 0, 1,        1, 1, 1, 1}, {0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0,        0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0}, {0, 0, 0, 0, 1, 0, 0, 1, 0, 0,        1, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 1,        1, 0, 1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 0, 1, 1, 0, 1, 1, 0, 0, 1, 1, 0,        1, 1, 1, 1, 1}, {0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1,        0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0}, {0, 1, 0, 0, 0, 0, 0, 0, 0,        0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0}, {1,        1, 0, 0, 1, 1, 1, 1, 0, 0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 0, 1, 1,        0, 1, 1, 0, 1, 1, 0}, {0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0,        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}}


Tracking iterations of a function

I'm learning MMA with Wagner's book. On page 41, he uses this to display the iterative steps of a FindRoot. However, I can't seem to replicate this (code at end), perhaps due to the difference in MMA versions (his was MMA 3.0!). Using Trace doesn't seem to help; it just displays the final value of x. ![FindRoot iteration Trace](http://i.stack.imgur.com/qn7nu.png) Codes:               FindRoot[Print[x]; Sin[x] - Cos[x], {x, 0.5}]     Trace[FindRoot[Sin[x] - Cos[x], {x, 0.5}]]      **Edit** I have also tried to use his method--Print[x] within a function--for an exercise in the section and that seems to work (though with some quirk in the result). EvaluationMonitor also works, and frankly I find the latter much more intuitive. Below is my solution for the problem (code at end); I'm not sure if this is the way Sin[x] is actually sampled, so any feedback is very welcome. ![Sin\[x\] sampling animation](http://i.stack.imgur.com/XNc0A.gif) ![EvaluationMonitor](http://i.stack.imgur.com/NF3v3.png)               Plot[Sin[x], {x, \[Pi]/4, \[Pi]/2}] // InputForm     Plot[Print[x]; Sin[x], {x, \[Pi]/4, \[Pi]/2}]     Reap[Plot[Sow[x]; Sin[x], {x, \[Pi]/4, \[Pi]/2}]][[2]]     {plot, List@stepValue} =        Reap[Plot[Sin[x], {x, \[Pi]/4, \[Pi]/2},          EvaluationMonitor :> Sow[x]]];     stepValuePoints = {stepValue, Sin[stepValue]} // Transpose;     ListPlot[stepValue, AxesLabel -> {Step, x}]     Manipulate[      Show[       (* Actual y = Sin[x] curve *)       Plot[Sin[x], {x, \[Pi]/4, \[Pi]/2}, PlotStyle -> Yellow],       (* Generated mesh points *)       ListPlot[stepValuePoints, PlotStyle -> Red],       (* Arrow tail *)       ListLinePlot[{Table[stepValuePoints[[i]], {i, step - 5, step - 1}]}],       (*Arrow head *)       Graphics@{Blue,          Arrow[{stepValuePoints[[step - 1]], stepValuePoints[[step]]}]},       PlotRange -> {{\[Pi]/4, \[Pi]/2}, {Sqrt[2.]/2, 1}}], {step, 6,        Length[stepValuePoints], 1}]     anim = Table[        Show[         (* Actual y = Sin[x] curve *)         Plot[Sin[x], {x, \[Pi]/4, \[Pi]/2}, PlotStyle -> Yellow],         (* Generated mesh points *)         ListPlot[stepValuePoints, PlotStyle -> Red],         (* Arrow tail *)         ListLinePlot[{Table[            stepValuePoints[[i]], {i, step - 5, step - 1}]}],         (*Arrow head *)         Graphics@{Blue,            Arrow[{stepValuePoints[[step - 1]], stepValuePoints[[step]]}]},         PlotRange -> {{\[Pi]/4, \[Pi]/2}, {Sqrt[2.]/2, 1}}], {step, 6,          Length[stepValuePoints], 1}];     Export["anim.gif", anim, "DisplayDurations" -> 0.25]


Putting values into a grid after iteration process

I'm developing a model of thermodynamic cycle in _Mathematica_. I wrote several functions, applied them to a list containing starting values and iterated, for the model to converge.               fixed = FixedPoint[       f1[f2[Nest[f3,f4[f5[f6[Nest[f7, f8[#], 100]]]],100]]] &, startinglist, 20];      I would like to see not only final, converged values, but also values at each other point of the cycle, so I threw them into a grid:               data = {       Prepend[fixed, "starting point"],       Prepend[f8[fixed], "before condenser"],       Prepend[Nest[f7, f8[fixed], 100], "after condenser"],       Prepend[f6[Nest[f7, f8[fixed], 100]], "before pump"],       Prepend[f5[f6[Nest[f7, f8[fixed], 100]]], "after pump"],       Prepend[f4[f5[f6[Nest[f7, f8[fixed], 100]]]], "before heat exch"],        Prepend[Nest[f3, f4[f5[f6[Nest[f7, f8[fixed], 100]]]], 100], "after heat exch"],       Prepend[f2[Nest[f3,f4[f5[f6[Nest[f7, f8[fixed], 100]]]], 100]],"before turbine"],       Prepend[f1[f2[Nest[f3,f4[f5[f6[Nest[f7, f8[fixed], 100]]]], 100]]], "after turbine"]     };          Text@Grid[       Prepend[data, {"Point", "Temp [\[Degree]C]", "pressure [bar]", "enthalpy [kJ/kg]",        "enthropy [kJ\kg\K]", "density [kg/m3]", "viscosity [kg/m/s]", "quality [-]"}],       Frame -> All]      It works, but doesn't look very clean. The second thing is that while creating `data` _Mathematica_ is once again performing `Nest`, which might consume a lot of time, if I'm going to extend my model. Any other ways to do all of that quicker?


Which Mathematica syntaxes are unavailable in Wolfram Alpha?

Do you get the sense that Wolfram Alpha plays dumb sometimes? Like sometimes I can get it to obey a Flatten command by itself, or maybe Flatten _and_ Sort, but if I try to put that into a Table, it instead responds with the Mathematica documentation of the Table command. Wolfram Alpha also seems to me to be completely incapable of Plus@@ or Times@@ anything, though sometimes I can get Sum to work.


Maximum and mean of a multi-variate function over a restricted lattice

I have a function `Q`, and I want to find the maximum value, the corresponding arguments for the maximum value, and the mean over a certain range of arguments. I have the following working for finding the maximum value, which works:               Best[a_, b_, c_] :=        Max[Table[Q[a, b, c, w, v, x, y, z], {w, 0, 4}, {v, 0, 4}, {x, 0, 4}, {y, 0, 4}, {z, 0, 4}]]      Unfortunately, you can't use `ArgMax` and `Mean` in the same way as `Max`. I tried the following for finding the maximum arguments:               Args[a_, b_, c_] :=         ArgMax[{           Q[a, b, c, w, v, x, y, z],            0 <= w <= 4 && 0 <= v <= 4 && 0 <= x <= 4 && 0 <= y <= 4 && 0 <= z <= 4 &&              Element[w | v | x | y | z, Integers]         },          {w, v, x, y, z}]      This is the type of error message I get: > Part::pspec: "Part specification 1 + v is neither a machine-sized integer > nor a list of machine-sized integers. I tried similarly for the mean of the function:               M[a_, b_, c_] :=        Mean[{           Q[a, b, c, w, v, x, y, z],            0 <= w <= 4 && 0 <= v <= 4 && 0 <= x <= 4 && 0 <= y <= 4 && 0 <= z <= 4 &&              Element[w | v | x | y | z, Integers]          }]      Any help would be appreciated.