title: Select a directed SubGraph without sinks and sources

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


title: How to choose the OpenCL device to use?

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


title: Automatically use InputOnly style

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


title: Recognizing a generalized function as zero

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


title: Error in the result

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


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

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


title: Map a function across a list conditionally

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


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

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


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

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


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

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


title: Notation not recursive enough?

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


title: Mathematica color schemes for the colorblind

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


title: FindInstance returns Indeterminate in version 9, but not in 8

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


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

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


title: Defining a function that differentiates another function with rule replacement

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


title: Fast Sieve Implementation

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


title: Mathematica9: NDSolve slows down after repeated calls

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


title: Systematic increase in runtime

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


title: CUDALink is not initialized

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


title: Efficient implementation of cubic equation of state

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


title: Forming an upper triangular matrix from the elements of a list

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


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

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


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

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


title: Named patterns as function argument descriptors

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


title: How to define functions for a parameter-dependent recursive sequence

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


title: NMinimize seems to call function with the same values multiple times

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


title: Meaning of backtick in floating-point literal

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


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

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


title: What is the precision of this number?

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


title: Export to text file

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


title: How to change texture of chart bar?

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


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

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


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

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


title: When I use the Labeled command my graphics shrink

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


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

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


title: Extra brackets of Position command

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


title: Ordering function with recognition of duplicates

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


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

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


title: Internal`Bag inside Compile

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


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

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


title: How to label vertices in a grid with random integers?

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


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

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


title: Putting NDSolve into ParametricPlot

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


title: Listable compiled function using Map

text: I'm trying to minimize the computation time of problem which is too long to post. I use `compile`in order to gain some speed. To increase speed I would like to use the options `Parallelization -> True`and `RuntimeAttributes -> {Listable}` among others. The problem is now that some built-in functions I use, such as `Map`, do not have the attribute `Listable`. Thus, it seems that my code produces an error once the input is e.g. a list instead of a real number. To gain some insights I post some toy-code.               toy=Compile[{{h1,_Real},{list,_Real,1}},     leg=Length[list];     Map[Total[{list[[#]]}]/h1&, Range[leg]],      CompilationTarget->"C",      Parallelization->True,      RuntimeAttributes->{Listable},      RuntimeOptions -> "Speed"];      What this code does is it divides each element of `list` by `h1`. Please notice that this code does not have any meaning but to show the problem of using a non-listable function within a compile function. Now, let `h1` be some real and `list` be some random list. Then,                h1=0.1; list=RandomReal[{-1., 1.}, 100]; toy[h1, list]      works just fine. However, if one sets               h1={0.1,0.2}; toy[h1, list]       results in an error. My question is whether one of you knows a simple way to make this compiled function listable. One may use e.g. a `Do`-loop to get the result, but this is too slow. Thanks in advance I really appreciate it.


title: Creating centered inline cell in text cell

text: The cell ![enter image description here](http://i.stack.imgur.com/FHl95.png) corresponds to the textual form               Cell[TextData[{        "The ", StyleBox["average rate of change", FontWeight->"Bold"],        " in ",        Cell[BoxData[FormBox["f", TraditionalForm]]],        " on the interval ",        Cell[BoxData[FormBox[           RowBox[{"[", RowBox[{"a", ",", RowBox[{"a", "+", "h"}]}], "]"}], TraditionalForm]]],        " is the slope of the corresponding secant line: \n",        Cell[BoxData[FormBox[GridBox[{            {GridBox[{{                RowBox[{SubscriptBox["m", "sec"], "=", FractionBox[                  RowBox[{RowBox[{"f", "(", RowBox[{"a", "+", "h"}], ")"}], "-",                    RowBox[{"f", "(", "a", ")"}]}], "h"]}]}            },            GridBoxAlignment->{"Columns" -> {{"="}}}]}},           GridBoxItemSize->{"Columns" -> {{                Scaled[0.96]}}}], TraditionalForm]]],        "\nThe ", StyleBox["instantaneous rate of change", FontWeight->"Bold"],        " in ",        Cell[BoxData[FormBox["f", TraditionalForm]]],        " at ",        Cell[BoxData[FormBox["a", TraditionalForm]]],        " is "       }], "Definition",        CellChangeTimes->{{3.454944654993936*^9, 3.45494474976772*^9}, {         3.4549518777111692`*^9, 3.454951884742343*^9}, {         3.460806271054368*^9, 3.4608062731390657`*^9}, {         3.478189589239235*^9, 3.478189591304613*^9}, {3.487447061963195*^9,          3.487447061963235*^9}}]      I can't figure out how to enter this in the Mathematica user interface. It seems as though the displayed equation on the second line is an inline cell that is aligned using `GridBox`, but I don't see how to create that effect.


title: PearsonChiSquareTest: set degrees of freedom

text: How to set degrees of freedom for `PearsonChiSquareTest`? I have this:               PearsonChiSquareTest[ex,  NormalDistribution[0, Sigma], {"PValue", "DegreesOfFreedom",   "ShortTestConclusion"}, SignificanceLevel -> 0.05]      Return:               {2.95529*10^-11, 12, "Reject"}      I need to set degrees of freedom to 4-5.


title: How to delete mirror symmetric point pair efficiently

text: Look at following pic ![enter image description here](http://i.stack.imgur.com/cEceo.gif) There are five points, I can generate the following point pairs               In:= tt=Subsets[{1, 2, 3, 4, 5}, {2}]          Out:= {{1, 2}, {1, 3}, {1, 4}, {1, 5}, {2, 3}, {2, 4}, {2, 5}, {3,        4}, {3, 5}, {4, 5}}      But if I define mirror symmetry equivalence between point pairs. For example {1,2} equals {4,5}   {1,3} equals {3,5}   {1,4} equals {2,5}   {2,3} equals {3,4}   .....etc Then how to select half of the symmetric point pair from tt and keep only half of the original set. And in this case, I want keep left part, That is keep {{1, 2}, {1, 3}, {1, 4}, {1, 5}, {2, 3}, {2, 4}}


title: What does MinimalPolynomial do?

text: suppose $x^5-x-1=0$, $y^7-y-1=0$ and $z=x+y$. I want to find a minimal polynomial expression of $z$, such that $p(z)=0$, and the code can be written like this:               MinimalPolynomial[Root[#^5 - # - 1 &, 1] + Root[#^7 - # - 1 &, 1], z]      What does `MinimalPolynomial[]` do behind us (in other words, what is the algorithm?)


title: High memory use while exporting a BMP

text: Something mysterious is going on when exporting images. I'm using Mathematica 9.0.1 on Windows 7 (64 bit), and find that the memory use is excessive when exporting to a bmp. But it doesn't happen with other image formats. For example, running the following (with different values for `k`):               k = 1;  extensions = {"png", "tif", "jpg", "bmp"};  SeedRandom[42];     image = Image@RandomReal[{0, 1}, {1500, 1500, 3}];     base = MaxMemoryUsed[];     Export["C:\\mem." <> extensions[[k]], image];     {extensions[[k]], (MaxMemoryUsed[] - base)/1024.^2}     Quit[]      gives               {"png",  79.987}     {"tif",  28.617}     {"jpg",  60.453}     {"bmp", 927.602}      file sizes ( _added by s0rce_ ):               png: 12.8 MB     tif: 12.8 MB     jpg: 1.29 MB     bmp: 6.43 MB      Why does exporting a bmp require over 10 times the memory of other image formats? And what can I do about it? ## EDIT: Here's the results of some more testing (code at the end).               format  texture  type    memory(MB)  time(s)  size(KB)          png     random   real        89        3.4     15 028                      bit16        0        2.6     15 028                      byte         0        1.5      7 515             smooth   real        75        1.3        726                      bit16        0        1.2        726                      byte         0        0.5         85          tif     random   real        17        0.2     15 000                      bit16        0        0.1     15 000                      byte         0        0.1      7 500             smooth   real        17        0.3     15 000                      bit16        0        0.1     15 000                      byte         0        0.2      7 500          jpg     random   real        68        0.4      1 500                      bit16        0        0.8      1 503                      byte         0        0.7      1 500             smooth   real        68        0.3         50                      bit16        0        0.3         50                      byte         0        0.3         50          bmp     random   real      1069       25.3      7 500                      bit16      967       22.8      7 500                      byte        69    $Aborted         0             smooth   real      1055      100.8      7 500                      bit16      953       32.4      7 500                      byte        71        1.4      7 500      **Notes:**   * By default Mathematica will treat the image type as _Real_.   * When exporting, a _Real_ type image will need to be converted to an integer type. This requires extra memory and time.      * _tif_ and _png_ support 16 bit pixels, so this will be used by default for _Real_ images.     * _jpg_ and _bmp_ only support up to 8 bits per pixel.   * My computer was thrashing the memory disk cache for the _bmp smooth real_ , so it took extra time.   * The _bmp random byte_ was using 100% for 5 minutes before I gave up. **Conclusions:**   * Use **tif** for **speed**.   * Use **png** for saving **disk space**.   * Never use **jpg** because it is **lossy**.   * Never use **bmp** because it is **broken**. **Code:**               k = 1; (* 1 .. 24 *)     {e, t, c} = Tuples[{Range[4], Range[3], Range[2]}][[k]];     extensions = {"png", "tif", "jpg", "bmp"};     types = {"real", "byte", "bit16"};     compress = {"random", "smooth"};     res = 1600;     SeedRandom[42];     data = Switch[compress[[c]],       "random", RandomReal[{0, 1}, {res, res, 3}],       "smooth", Table[{i, j, 1 - i j}, {i, 0., 1, 1/(res - 1)}, {j, 0., 1, 1/(res - 1)}]     ];     image = Switch[types[[t]],       "real", Image@data,       "byte", Image[Round[(2^8 - 1) data], "Byte"],       "bit16", Image[Round[(2^16 - 1) data], "Bit16"]     ];     filename = "C:\\_" <> types[[t]] <> "_" <> compress[[c]] <> "." <> extensions[[e]];     base = MaxMemoryUsed[];     time = AbsoluteTiming[Export[filename, image]][[1]];     CellPrint@TextCell[ToString@{       filename,(MaxMemoryUsed[] - base)/1024.^2, time, FileByteCount[filename]/1024.     }, "Text", CellAutoOverwrite -> False]     Quit[]


title: How can I get a single solution to a set of inequality constraints?

text: I have a set of constraints to which I require integer solutions. However, instead of needing all possible integer solutions (as obtained by using `Solve[constraints,Variables,Integers]`), I need _any one solution only_. Here is a specific example:               variables = {       Subscript[x, 11], Subscript[x, 12], Subscript[x, 13],       Subscript[x, 14], Subscript[x, 15], Subscript[x, 16]     };          constraints =        273 + 4 Subscript[x, 11] + Subscript[x, 12] >= 0 &&       -693 - 8 Subscript[x, 11] - 3 Subscript[x, 12] + Subscript[x, 13] >= 0 &&        483 + 4 Subscript[x, 11] + 3 Subscript[x, 12] - 3 Subscript[x, 13] +         Subscript[x, 14] >= 0 &&       -Subscript[x, 12] + 3 Subscript[x, 13] - 3 Subscript[x, 14] + Subscript[x, 15] >= 0 &&       -Subscript[x, 13] + 3 Subscript[x, 14] - 3 Subscript[x, 15] + 24 Subscript[x, 16] >= 0 &&       -Subscript[x, 14] + 3 Subscript[x, 15] - 32 Subscript[x, 16] >= 0 &&       -Subscript[x, 15] + 8 Subscript[x, 16] >= 0 &&       Subscript[x, 16] >= 0 &&       Subscript[x, 11] >= 0 &&       462 + 11 Subscript[x, 11] + Subscript[x, 12] + Subscript[x, 13] + Subscript[x, 14] +          Subscript[x, 15] - 15 Subscript[x, 16] >= 0 &&       2709 + 42 Subscript[x, 11] + 8 Subscript[x, 12] + 4 Subscript[x, 13] -         4 Subscript[x, 15] + 40 Subscript[x, 16] >= 0 &&       4536 + 54 Subscript[x, 11] + 18 Subscript[x, 12] - 2 Subscript[x, 13] -          6 Subscript[x, 14] + 6 Subscript[x, 15] - 45 Subscript[x, 16] >= 0 &&       -1134 - 27 Subscript[x, 11] - 12 Subscript[x, 13] + 8 Subscript[x, 14] -         4 Subscript[x, 15] + 24 Subscript[x, 16] >= 0 &&       -6318 - 81 Subscript[x, 11] - 27 Subscript[x, 12] + 9 Subscript[x, 13] -          3 Subscript[x, 14] + Subscript[x, 15] - 5 Subscript[x, 16] >= 0 &&       273 + 4 Subscript[x, 11] + Subscript[x, 12] == Subscript[x, 16] &&       -693 - 8 Subscript[x, 11] - 3 Subscript[x, 12] + Subscript[x, 13] == Subscript[x, 11];          solutions = Solve[constraints, variables, Integers]      I get an output, but it is very long as there are many solutions. Consequently, the runtime is significant. Hence, I want to modify `Solve[]` as to stop evaluating after one solution has been found. I believe that would not run for as long as the general case. Could anyone please help me?


title: Problem with limit that requires L'Hôpital's rule to compute

text: Consider the following limit.               Limit[(a - Sqrt[a^2 + x])/(a^2 - a*Sqrt[a^2 - x]), x -> 0, Assumptions -> {a > 0}]      Mathematica 9.0.1.0 gives `-1/a`, which is the correct answer. Notice that this limit is not trivial to compute, because both the numerator and denominator vanish when `x=0`. Therefore, L'Hopital's rule is required here. Now remove the assumption.               Limit[(a - Sqrt[a^2 + x])/(a^2 - a*Sqrt[a^2 - x]), x -> 0]      For this, Mathematica gives `1/a`, which is incorrect for general `a` (although it is correct for `a<0`). Is this last result a bug, or am I missing something?


title: How do you force line spacing to be uniform when a line contains characters with vector or overdot?

text: A persistent problem I've run into is that certain character decorations within the text of a paragraph will often add extra line spacing even if there is already plenty of space between lines. This happens with things like vectors $\vec r$, overdots $\dot y$, and roots $\sqrt x$ but not to superscripts or subscripts. It is most apparent if one of these is in the middle of a large `Text` paragraph. The uneven line spacing looks rather unsightly and unprofessional. ![enter image description here](http://i.stack.imgur.com/iQYhp.png) I tried adding the option `LineSpacing -> {1.25, 0, 1.25}` to the Text cell but that doesn't seem to do anything. Even if I add more line spacing with something like `LineSpacing -> {1.5, 0, 1.5}` the character decorations still add height even though there is plenty of room for them. I would like to keep the special characters in `TraditionalForm` so they match the style used in `InlineFormula` fields if possible.


title: In .NET/Link, how do I not open multiple kernels?

text: I'm writing an ASP.NET page intended for multiple users. On the backend we have datatypes that are primarily mathematical, and interact with _Mathematica_ for string-to-double evaluations, among others. We need to make these evaluations up to 100 times per second per user, for up to 100 users, say. But every time we use NETLink to create a new kernel connection, a new instance of the _Mathematica_ kernel opens on the host machine. 10,000 copies of the _Mathematica_ kernel on a single machine is obviously undesirable. If we were guaranteed to have one user, it might work to create a global kernel and use that -- but if we have 100 users, that would create 100 kernels, which is still excessive. Is there a nice workaround for this? Perhaps a way to use .NETLink to a kernel that's already opened?


title: Control maximum value of a slider with another control

text: Is it possible to make _$y_{max}$_ of _Slider[y, {$y_{min}$,$y_{max}$}]_ depend on another control? For example, I have three variables ( _Time, Type1, Type2_ ). I want a drop down box for the user to select which type to plot. And I want the user to have the ability to scale up and down the y value (however the maximum y value should depend on the level chosen, 150000 for Type1 and 1 for Type2).               mySubset = {{0.`, 0.`, 0.`}, {60.`, 78069.`, 0.52046`}, {120.`,      81417.`, 0.54278`}, {180.`, 84765.`, 0.5651`}, {240.`, 88113.`,      0.58742`}, {300.`, 91461.`, 0.60974`}, {360.`, 94809.`,      0.63206`}, {420.`, 98157.`, 0.65438`}, {480.`, 101505.`,      0.6767`}, {540.`, 104853.`, 0.69902`}, {600.`, 108201.`,      0.72134`}, {660.`, 111549.`, 0.74366`}, {720.`, 114897.`,      0.76598`}, {780.`, 118245.`, 0.7883`}, {840.`, 121593.`,      0.81062`}, {900.`, 124941.`, 0.83294`}, {960.`, 128289.`,      0.85526`}, {1020.`, 131637.`, 0.87758`}, {1080.`, 134985.`,      0.8999`}, {1140.`, 138333.`, 0.92222`}};          yTypes = {"Type1", "Type2"}     yMax = {0., 150000., 1.}     Manipulate[      Module[{week, y},       yColumn = (Position[yTypes, yChosen][[1]])[[1]] + 1;       y = Part[mySubset, All, yColumn];       week = Part[mySubset, All, 1]/10080;       ListPlot[Transpose[{week, y}], Joined -> True,         PlotRange -> {{startTime, startTime + window}, {0, ylim}},         AxesOrigin -> {0, 0}, Frame -> True, FrameStyle -> Blue,         Background -> White, PlotStyle -> Blue, AxesStyle -> Blue,         ImageSize -> {550, 350}, ImagePadding -> 35]],      {{startTime, 0.0, "Starting Week"}, 0, 1., Appearance -> "Labeled"},      {{window, 0.1, "Number of Weeks"}, 0.1, 52., Appearance -> "Labeled"},      {{ylim, 150000, "y limit"}, 1, 150000, Appearance -> "Labeled"},      {yChosen, yTypes},      TrackedSymbols -> True,      AutorunSequencing -> {1, 2}      ]       ![enter image description here](http://i.stack.imgur.com/Z29rb.png)


title: Checking through an expression

text: I am writing a code that manipulates expressions that contains functions with an arbitrary number of arguments. An example expression is               expr = x f[a, b, c, d] - 4 f[b, a, d] + z f[] + f[a, b, d] - f[a]f[b,d]      What I would like to do is to make my code to be a little user-friendly by making it throw a message if the expression is invalid. Basically, the only symbols allowed to appear in `f` are `allowedList={a,b,d}`, and so I probably need to somehow use `Scan` to check through `expr`. (The above example should yield an 'error' since the first term has a `c` in it.) To make answering easier, please assume that the input `expr` will be such that all arguments will have `Head = Symbol`. But please allow for the possibility that multiple `f`s could be multiplied together.


title: Rate of change of dynamic variable

text: I have made a program that goes like this, the goal is to estimate the remaining time of a function (it is running a bunch of **solveChase[]** functions with different parameters which can be seen in the best answer of this question):               count=0;     count2=0;     precision=100;          Table[         {             Do[{                 Somefunction[var],                 count2++                 },                 {precision}             ];             count2=0;             count++;         },         {i,3},         {i,3}     ]      If in another cell I put:               Print[Dynamic@Round[100 (precision count + count2)/(precision max1 max2),.01], "%" ];      (which shows the percentage of all the process, from 0 to 100%) That value will change, but because of _SomeFunction[var]_ (a NDSolve result which its running time depends on i and j) not in a linear way. It has different rates of change in some parts, so it has a velocity which is **not** constant and **can** be calculated. This is a example(sorry for bad quality): ![example of not linear remaining time on some calculations](http://i.stack.imgur.com/SBjtz.gif) * * * My guess is to insert another variable _t_ , which depends on time, and then do something with it, but I don't know how to do it. Any help will be appreciated.


title: Complicated condition for system of differential equation

text: I am trying to solve a series of nonlinear differential equation with complex condition as described by block diagram below. The left figure describes general concepts and the right figure describes the equations used in each state. Here, I want to be able to plot displacement of $x1$. If possible, it would be great if you can make every equation inside a NDSolve function since later, I want to determine the connection between Amplitude $A$ and displacement $x1$ after 100th period. ![](http://i.stack.imgur.com/sL4R6.jpg) ![](http://i.stack.imgur.com/7B3pI.jpg) **EDIT 1** Here's my trial code with When Event Method:               T = 10;k = 1;m1 = 1;m2 = 1;A = 1;Fs = 2;Fk0 = 1;\[Epsilon] = 10^-5;          sol = First@NDSolve[{      x0[t] == A Sin[2 Pi t],      x2''[t] == -k/m2 x2[t] - m1/m2 (x0''[t] + x1''[t]), x2'[0] == 0,       x2[0] == 0,      Y[t] == go[t]*(x1''[t] + k/m1 x2[t] + x0''[t] + Fk0/m1 Sign[x1'[t]]) +         (1 - go[t])*x1'[t],      Y[t] == 0, go[0] == 0, x1[0] == 0,      WhenEvent[go[t] == 0 && Abs[-k m2 - m1 x0''[t]] > Fs, go[t] -> 1],      WhenEvent[go[t] == 1 && x1'[t] < \[Epsilon], go[t] -> 0]},     {x0, x1, x2, Y}, {t, 0, T}, DiscreteVariables -> go,      MaxSteps -> Infinity, SolveDelayed -> True];          Plot[{x0[t], x1[t] /. sol // Evaluate}, {t, 0, T}, Frame -> True]      It returns error code as below. ![](http://i.stack.imgur.com/Ly4HB.jpg) Which is actually a bit predictable because I tried to work around the algorithm using these 2 equations.               Y[t] == go[t]*(x1''[t] + k/m1 x2[t] + x0''[t] + Fk0/m1 Sign[x1'[t]]) +       (1 -go[t])*x1'[t],     Y[t] == 0      I have no other idea on how to change the equation from               x1'[t]=0      to               x1''[t] = -k/m1 x2[t] - x0''[t] - Fk0/m1 Sign[x1'[t]]      **EDIT 2**   I got another code below inspired by Mathematica's stick slip Tutorial Here, I assumed $x{2}[t]=0$, to make it simpler.               Clear All;     T = 10;     A = 1;     Fk0 = 10;     m1 = 1;     x0[t_] = A Sin[2 Pi t];     Fk[t_] = -Fk0  Sign[x1'[t]];     Fs = 100;     e = 10^-5;     sol =      NDSolve[{x1''[t] == If [stuck[t] == 1, 0, - x0''[t] + Fk[t]/m1],       x1[0] == 0, x1'[0] == 0,      WhenEvent[Abs[x1'[t]] < e,        stuck[t] -> Boole[Abs[-m1 x0''[t]] < Fs]],      WhenEvent[ -m1 x0''[t] < Fs, stuck[t] -> 0], stuck[0] == 0},       {x1}, {t, 0, T}, DiscreteVariables -> stuck[t],       SolveDelayed -> True];     Plot[{x0''[t], x1[t] /. sol // Evaluate}, {t, 0, T}, Frame -> True]      But it returns error below: ![](http://i.stack.imgur.com/plwuG.jpg)


title: list of vectors with prescribed sum

text: Let $a\in\mathbb{N}^n$ and $k\in\mathbb{N}\!=\!\{0,1,2,\ldots\}$. How can I efficiently generate the list $$\{(a_1,\ldots,a_k); a_1,\ldots,a_k\!\in\!\mathbb{N}^n\!\setminus\!\{0\}, a_1\!+\!\ldots\!+\!a_k\!=\!a\}?$$ It would also be desirable for the code to be short. My current, highly inefficient solution is:               Select[Tuples[Tuples[Range[0, Max @@ a], Length@a], k],        Plus @@ # == a && !MemberQ[#, Table[0, {i, n}]]&]


title: How to get diagonal matrix D from matrix multiplication of $s^{-1}$, P, and S

text: I am multiplying three matrices that should give me a diagonal matrix but instead of zeros for the other entries I get very small numbers. Can someone explain what is going on here and how I can fix it? This is what what I've been doing:               P = {{.7, .15, .15}, {.2, .8, .15}, {.1, .05, .7}}     (* {{0.7, 0.15, 0.15}, {0.2, 0.8, 0.15}, {0.1, 0.05, 0.7}} *)          S = {{7, 0, -2}, {10, -1, 1}, {4, 1, 1}}     (* {{7, 0, -2}, {10, -1, 1}, {4, 1, 1}} *)          Inverse[S].P.S     (* {{1., -1.38778*10^-17, 0.}, {-6.66134*10^-16,        0.65, -5.55112*10^-17}, {1.66533*10^-16, -1.38778*10^-17, 0.55}} *)


title: Base 2 Tick Labels for ListLogLogPlot

text: I am using `ListLogLogPlot` and would like to express the x-axis tick labels in powers of 2 instead of the default powers of 10. Does anybody have experience with this? Here is my code thus far:               mylist =        {{2^1024, 10^-307}, {2^512, 10^-153}, {2^256, 10^-76}, {2^128, 10^-38}, {2^64,10^-18},        {2^32, 10^-9}, {2^16, 10^-4}};          ListLogLogPlot[mylist,       PlotLabel -> Style["H field to break Subscript[Z, 2] symmetry (HN5)", FontSize -> 18],       PlotStyle -> {PointSize[0.015]},       Frame -> True,       PlotRange -> {{1, 10^335}, {10^-320, 10^0}},       FrameLabel -> {Style["Size, N", FontSize -> 18],       Style["H", FontSize -> 24]}, RotateLabel -> False]      ![enter image description here](http://i.stack.imgur.com/FtpPW.png)


title: Plotting the deformed shape of a rectangle

text: I want to plot a rectangle using graphics :               rc = Graphics[{Blue, Rectangle[{0, 0}, {1, 1}]}];      and add a deformation function to it: $$\chi(\mathbf X)=X_1(1+X_2)\hat{\mathbf e}_1+X_2(1+3X_1)\hat{\mathbf e}_2$$ This deformation function specifies new coordinates as functions of old ones. How can I plot the new shape?


title: Little problem with Through

text: list = Partition[Range[20], 5, 5, 1, {}]      > >     {{1, 2, 3, 4, 5}, {6, 7, 8, 9, 10}, {11, 12, 13, 14, 15}, {16, 17, 18, > 19, 20}} >                 pos = Transpose[{Through[First, Last] /@ list, Through[Last, First] /@ list}]      > >     {{1, 5}, {6, 10}, {11, 15}, {16, 20}} >   As you see, I've used `Through` twice. I think once should be enough, but I haven't been able to see how to do it with one `Through`. Any ideas?


title: How to distinguish expression from zero

text: my question is the following. I have an array, which elements are functions (say, sines of symbolic arguments). Some of the elements are zeros. I want to write code like: `If[T[i, j]!=0,(*do something*)];` But Mathematica won't compare expressions with numbers. What could you suggest? Thanks


title: Maximizing trig functions in Mathematica

text: Just to give some context, my motivation for this programming question is to understand the derivation of the CSHS inequality and basically entails maximizing the following function:               Abs[c1 Cos[2(a1-b1)]+ c2 Cos[2(a1-b2)] + c3 Cos[2(a2-b1)] + c4 Cos[2(a2-b2)]]      where a1,b1,b2,and a2 are arbitrary angles and c1,c2,c3,c4 = $\pm 1$ ONLY. I want to be able to determine the maximum value of this function along with the combination of angles that lead to this maximum. Also NO angles can be equal to each other and ONLY an odd number of terms can have negative coefficients. Eventually, I also want to repeat the calculation for a1,a2,a3,b1,b2,b3 (which will have a total of nine cosine terms) When I tried putting the following code in Mathematica, it simply spat the input back at me and did not perform any computation, can someone help me out? (note my code didn't include the c1,c2,c3,c4 parameters, I wasn't quite sure how to incorporate them)               Maximize[{Abs[Cos[2 (a1 - b1)] - Cos[2 (a1 - b2)] + Cos[2 (a2 - b1)] + Cos[2 (a2 - b2)]],               0 <= a1 <= 2 Pi , 0 <= b1 <= 2 Pi,               0 <= a2 <= 2 Pi, 0 <= b2   <= 2 Pi}, {a1, b2, a2, b1}]


title: Using the epsilon tensor in Mathematica

text: I'm having a great deal of trouble getting started on a weekly homework assignment in _Mathematica_. The assignment requires we use the epsilon tensor which is apparently built into _Mathematica_ as `Signature`. My _Mathematica_ skills are woefully inadequate, and I'm an external student so I can't consult with my peers. The first question is meant to ease us into the assignment, but after looking through _Mathematica_ documentation center, StackExchange answers and other tutorials from other universities I'm no closer to being able to complete it. If anyone could tell me how to do this first question I should be able to work through the rest of the assignment, but at the moment I just can't get started. The question (which should be simple, it's weighted very small) is: > ![http://imgur.com/fKwhPan](http://i.stack.imgur.com/HVtat.png)


I would like to show that the following (and other similar formulae) tends to zero.               Limit[Sum[(2*E*n)^w/(w^(n/2+w)), {w,2,n}],n->Infinity]      What's the right way to do this in Mathematica?


title: Deploying to the Cloud for Public Access

text: **Note:** Fixed sometime around the 18th of August 2014. Bug present from the release of 10.0.0. until then. * * * I wanted to test how a simple deployed program would appear to a non- mathematica user. I did the following, from within a Mathematica notebook:               obj = CloudDeploy[FormFunction[{"country" -> "Country"}, Show[#country["Flag"], ImageSize -> 600] &, "SVG"], Permissions -> "Public"]      As expected:               Options[obj, Permissions]           {"Owner" -> {"Read", "Write", "Execute"}, "All" -> {"Execute"}}      But when I try to access the link (from another machine), it prompts me for a userid and password for the Cloud platform. I tested this several times on different machines, and the result was always the same. Is this the intended behavior? I thought the idea was that anyone could access a deployed object, without having to sign up for an account (even a free one).


title: Convert ImageSize to FieldSize

text: How might I construct a function called `EmToPX[p]` such that the following 2 `InputField`s would be the same width. If not please explain why doing such isn't possible.               InputField["a", ImageSize -> 100]     InputField["a", FieldSize -> EmToPX[100]]      After some trial an error ~7.2 appears to be the proper number of EMs above( `InputField["a", FieldSize -> 7.2]`), but after trying to convert to a function using proper ratios it appears such technique doesn't work very well.               EmToPX[p_] := (N[         p (1.888888 + CurrentValue[EvaluationNotebook[], "FontSize"]) ]);     Manipulate[      Column[{        InputField["a", ImageSize -> EmToPX[a]],        InputField["a", FieldSize -> a],        EmToPX[7.2]        }]      , {a, 1, 100}      ]      **Background:** Ultimately I am working with `Grid` elements and would like an easy way to switch back and froth between `CellSize`,`ImageSize`,`ItemSize`,`FieldSize`.


title: how to permute bit strings and manipulate their elements

text: I want to write a `function(has 2 paremeter, n=range,k=number of 1 digits)` which finds all probable combinatorics of arbitrary bit strings and evaluate sum of tensor product and divide to `sqrt(n)` each elements. if you look at the example you all understand easily. and sorry for my bad english .               function[3,1]       > >     (1\[CircleTimes]0\[CircleTimes]0)/Sqrt[3] + (0\[CircleTimes]1\ >     \[CircleTimes]0)/Sqrt[3] + (0\[CircleTimes]0\[CircleTimes]1)/Sqrt[3] >   another example               function[4,2]      > >     (1\[CircleTimes]1\[CircleTimes]0\[CircleTimes]0)/Sqrt[4] + (1\ >     \[CircleTimes]0\[CircleTimes]1\[CircleTimes]0)/Sqrt[4] + (1\ >     \[CircleTimes]0\[CircleTimes]0\[CircleTimes]1)/Sqrt[4] + (0\ >     \[CircleTimes]1\[CircleTimes]1\[CircleTimes]0)/Sqrt[4] + (0\ >     \[CircleTimes]1\[CircleTimes]0\[CircleTimes]1)/Sqrt[4] + (0\ >     \[CircleTimes]0\[CircleTimes]1\[CircleTimes]1)/Sqrt[4] >


title: Style changes between controls and graphics

text: In the following `Manipulate`, the style (font?) of the _a_ changes between when it is a control label and when it is a label in the graphics. Is there a way to make the 'control a' look like the 'graphics a'?               Manipulate[      Graphics[{       Style[Text["a", {0, 0}], Italic, 14]},       Axes -> False, PlotRange -> 3, ImageSize -> {100, 100},        GridLines -> None],           {{a, 0, Style[Text["a"], Italic, 14]}, 0, 100, 1}]       I can't find anything in the stylesheet, that can help me. I have set the font of `Output` to _'Georgia'_ , but I assume that I need to select the font somewhere else too?


title: What do I do when I get an "Iterator does not have appropriate bounds" error?

text: I used this as input               Table[600851475143/i , {i, 1, 600851475143}]      but got an error               Table::iterb:Iterator {i,1,600851475143} does not have appropriate bounds.      But this gives me no error why?:               Table[600851475143/i , {i, 1, 13}]


title: What are the known differences between Save and DumpSave, and how to account for them?

text: **Edit: I changed the title and (slightly) the wording of this question in order to make it more easily answerable.** If I evaluate this in Mathematica 9:               SetAttributes[foo, HoldFirst]     foo[x_] :=      (T`var := x;       DeleteFile["thisisatest"];       Save["thisisatest", "T`"]      )          foo[$ProcessID]      The resulting saved file looks like this:               T`var := $ProcessID          $ProcessID = 6903      If I evaluate `Get["thisisatest"]`, mathematica complains that I shouldn't be setting the value of special symbol `$ProcessID`. If I change `Save` to `DumpSave` and try again, `Get` no longer triggers the complaint. Examination of the saved file in a text editor shows no evidence of a stored value for `$ProcessID`, though it's a little hard to tell. The behavior I want is that of `DumpSave`, but platform independent. The documentation seems to suggest that these two functions would be interchangeable, except that `Save` will append to an existing file. What are the known differences between the two functions in practice, and how does one account for them?


title: Tooltip and table in plot

text: Plot[Tooltip@{1.` k^2, 1.2` k^2, 1.4` k^2, 1.6` k^2, 1.8` k^2, 2.` k^2}, {k, -2, 2}]      gives ![enter image description here](http://i.stack.imgur.com/J0yJs.jpg) But why does               Plot[Tooltip@Evaluate@Table[a k^2, {a, 1, 2, 0.2}], {k, -2, 2}]      give ![enter image description here](http://i.stack.imgur.com/rt6Lf.jpg) with no color difference?


title: How to create 3D architectural models in this shape with interactive faces?

text: I am a non-technical person in the imageProcessing side,so I don't have any idea how can I make polygon in the below shape... ![enter image description here](http://i.stack.imgur.com/YiNQc.png) the above polygon is a 3D `Graphics` ,if I click on any face of the polygon it will show some message. I am still working on it,but i didn't get which function is better out of this `Cuboid` and `Polygon` can you give any suggestions on this?


title: Measuring fractal dimension of natural objects from digital images

text: This is a useful topic. A college physics lab, medical diagnostics, urban growth, etc. - there is a lot of applications. On **this site by Paul Bourke about Google Earth fractals** we can get a high resolution images (in this post they are low res - import from source for experiments). For example, around Lake Nasser in Egypt:               img = Import["http://paulbourke.net/fractals/googleearth/egypt2.jpg"]      ![Lake Nasser boundary](http://i.stack.imgur.com/Ws3Sp.png) The simplest method I know is **Box Counting Method** which has a lot of shortcomings. We start from extracting the boundary - which is the fractal object:               {Binarize[img], iEdge = EdgeDetect[Binarize[img]]}      ![outline of Lake Nasser](http://i.stack.imgur.com/6EQoR.png) Now we could partition image into boxes and see how many boxes have at least 1 white pixel. This is a very rudimentary implementation:               MinS = Floor[Min[ImageDimensions[iEdge]]/2];     data = ParallelTable[{1/size, Total[Sign /@ (Total[#, 2] & /@ (ImageData /@               Flatten[ImagePartition[iEdge, size]]))]}, {size, 10, MinS/2, 10}];      From this the slope is 1.69415 which is a fractal dimension that makes sense               line = Fit[Log[data], {1, x}, x]      > 13.0276 + 1.69415 x               Plot[line, {x, -6, -2}, Epilog -> Point[Log[FDL]],        PlotStyle -> Red, Frame -> True, Axes -> False]      ![plot of fractal dimension line](http://i.stack.imgur.com/Ho9Zs.png) **Benchmark:** if I run this on **high res** of **Koch snowflake** i get something like **~ 1.3** with more exact number being **4/log 3 ≈ 1.26186**. **Question: can we improve or go beyond the above box counting method?** All approaches are acceptable if they find fractal dimension from any image of natural fractal.


title: Parentheses in pure functions: # & vs. ( # &)

text: I've been using _Mathematica_ for years, and over time I have developed the habit of using:               Select[data, (# == 1 &)]      instead of               Select[data, # == 1 &]      I learned this by mimicking the style of more experienced users. I'm pretty sure that there are reasons for flanking the function with parentheses, but I'm not sure that I have seen a reason for why this is necessary or a good habit to get into. Would someone be able to comment?


title: How to generate specific function using BSpline command/

text: I want to generate an approximation function that fits a curve to points. My goal is to obtain an actual formula. Is this possible with the BSpline function? Using the following code: `pts = {{1, 1}, {2, 3}, {3, -1}, {4, 1}, {5, 0}}; f = BSplineFunction[pts]`, the PiecewiseExpand command does not work. Is there another way to obtain the formula?


title: Plot3D region bounded by equations?

text: I have four equations, $$ z = xy \\ z=0 \\ y=x^2 \\ x=y^2$$ I would like to integrate the region bounded by them. Before this, I would like to plot the region they bound, but I cannot seem to find any documentation on how to do this with `Plot3D` or `RegionPlot3D`


title: Pairwise distances of points and classification using GraphDistanceMatrix

text: # The challenge Given $n$ points in $\mathbf{R}^3$ and a cutoff distance, $d$, I would like to determine   1. all pairs of points that are separated by less than the given cutoff distance, $d$, and   2. all pairs of points that can be connected by less than 5 segments taken from the list of pairs from above. While this is straight-forward for small $n$, for large $n$ the simplistic approach given below is slow (searching for the pairs) and memory consuming (GraphDistanceMatrix seems to return a dense matrix). How could this problem be solved efficiently for $n$ of order 30000? # Inefficient sample code: Generate sample data:               n = 1000; (* desired: n=20000 *)     pos = RandomReal[{0, n^(1/3)-1}, {n, 3}];      Find close points (ad 1):               d = 0.8;     connected = Select[Subsets[Range[n], {2}], (Norm[pos[[#[[1]]]] - pos[[#[[2]]]]] < d)&];      Pairs of points closer than 5 leaps apart (ad 2):               v = Union[Flatten[connected]];     g = Graph[v,UndirectedEdge @@@ connected];     gdm = GraphDistanceMatrix[g, 4];     ind =        Select[Position[gdm, Alternatives[1, 2, 3, 4], {2}], (#[[1]] < #[[2]])&] /.          Thread[Range[Length[v]] -> v];


title: Prevent manipulations in PlotLegends

text: ![enter image description here](http://i.stack.imgur.com/kyR8i.png) Mathematica code to reproduce:               LogPlot[{x^(4/3), x*E^Sqrt[8Log2[5/2]*Log2[x]],x^2,x^(3/2), x*Log2[x]^2}, {x,10,1000000},        PlotLegends->LineLegend["Expressions",LegendMarkers->Automatic]]      How can I prevent the equations from having their form modified? It would also be nice if I could get `Log2[x]` to appear as $\log_2x$. **Note:** I want to avoid having a second copy of the expressions in the input.


title: Use Slider2D to add data points to a list

text: This bit of code sets up a list with the first entry already in it -- `{{1,1}}`               Clear[x, y]     x = 1     y = 1     datalist=List[List[x, y]]      Here is a slider by which I can alter x and y by depressing the mouse.               Slider2D[{x, y}, {{0, 0}, {5, 8}, {1, 2}}]      But when I release the mouse button nothing happens of course, except that `{x,y}` are at some new value inside the slider. Suppose I have moved the slider to location {3,6}. When I release the mouse button, I want {3,6} to be appended to datalist so it now becomes {{1,1},{3,6}} When I am tired of adding data points I want to save datalist I want to make as few changes/additions to the above code as possible. Any ideas?


title: Find partial derivatives when the number of variables is unknown

text: The idea is that I have a defined function of $n$ variables. I want to find out $n$ and get partial derivation for each of variables, Suppose you have a function               f[w_,x_,y_,z_]: = w^2+x^2+y^2+z^2      Is it possible to find partial derivation using - say - 3rd variable (in this case $y$), that is $\frac{df}{dy} = 2 y$?