Montgomery Modular Exponentiation

I'm trying to write a Montgomery exponentiation based on this which can compete with Mathematica `PowerMod`. We know that `PowerMod` uses square and multiply technique. The speedup must be obtained by replacing modular operation mod n with modular operation mod 2^x. Can we accomplish this in Mathematica such that it take over from `PowerMod`? This is my implementation: Global variables:               RLength = 0; R = 0; RM1=0; RInverse = 0; NPrime = 0; verbose = False;      and the MontExp (b^e mod n):               MontExp[b_, e_, n_] := (RLength = BitLength[n]; R = 2^RLength; RM1=R-1;        RInverse = PowerMod[R, -1, n]; NPrime = PowerMod[-n, -1, R];        M = Mod[b*R, n]; Result = Mod[R, n];        If[verbose,         Print["MontParams: R=", R, ", RInverse=", RInverse, " ,NPrime=",          NPrime, " ,M=", M]];       Do[Result = Mont[Result, Result, n];         If[expBit == 1, Result = Mont[Result, M, n]], {expBit,          IntegerDigits[e, 2]}]; Result = Mont[Result, 1, n]; Return[Result])      Mont function version 0:               Mont[u_, v_, n_] := (z = Mod[u*v*RInverse, n];        If[verbose, Print["Monto ", u, " * ", v, " => ", z]]; Return[z]);       Mont function version 1:               Mont[u_, v_, n_] := (t = u*v;         z = BitShiftRight[(t + Mod[t*NPrime, R] n), RLength];         If[verbose, Print["Monto ", u, " * ", v, " => ", z]]; Return[z]);      Mont function version 2:               Mont[u_, v_, n_] := (t = u*v;         z = BitShiftRight[(t + BitAnd[t*NPrime, RM1] n), RLength];         If[verbose, Print["Monto ", u, " * ", v, " => ", z]]; Return[z]);      and Timings:               p = 2^20000 + 1;      Mathematica PowerMod:               Timing[PowerMod[2, p, p] == 2]      > {1.529, False} Mont v0 > {3.432, False} Mont v1 > {7.332, False} Mont v2 > {3.541, False} As you can see as I tried to improve it with binary shifts instead of modular operations, it had negative impact on the speed. That's probably because of non-native implementation in Mathematica. Any idea to improve it? -- **Update** I've learnt that `Mod[b, 2^n] == BitAnd[b, 2^n-1]` so I changed the Version 2 to use `BitAnd`, but yet no gain in compare to original `PowerMod`... **Update 2** It seems that because of its reliance on shifts, the speedups are only for 2^k+1 numbers. However I saw an amazing result from @Simoon-Woods answer:               list = (2^# + 1) & /@ Range[5000, 100000, 5000];          PowerModTimings = First[Timing[PowerMod[2, #, #]]] & /@ list         {0.047,0.265,0.717,1.529,2.871,4.336,6.506,9.173,11.934,16.879,20.623,25.772,30.373,37.3,45.49,55.131,63.274,73.788,85.114,96.112}          MontExpTimingsV2 = First[Timing[MontExp[2, #, #]]] & /@ list (*Mont version 2*)         {0.063,0.156,0.312,0.483,5.258,0.92,4.711,1.56,8.081,18.642,2.949,3.51,16.13,18.268,36.91,5.569,15.413,28.236,106.143,60.388}          MontExpTimingsV0 = First[Timing[MontExp[2, #, #]]] & /@ list (*Mont version 0*)     {0.047,0.093,0.188,0.234,2.418,0.53,2.246,0.858,3.417,8.58,1.451,1.669,7.051,8.003,18.221,2.824,6.91,13.245,51.231,29.047}      And plotting the result:               ListLinePlot[{PowerModTimings, MontExpTimingsV2, MontExpTimingsV0}]      ![enter image description here](http://i.stack.imgur.com/nEDRT.jpg) **Update 3** I've added timings for `Mont` version 0 based on @Simon-Woods answer. Great timings ...


Append in For loop does not work

I need to break my for loop in case of an thrown message and append s to the result list. Breaking the loop works, but my result is empty. I can not use `Table[]` because it does not support `Break[]`. EDIT: s has the form of list, so I get a Table structure for result EDIT 2: `AppendTo[]` yields empty result too.               result = {};     For[i = 0, i < 6, i++,       s = {Quiet[         Check[If[i == 3, Message[FindRoot::jsing, x, 1], i], "Nan",           FindRoot::jsing]]};      If[s == "Nan", Break[], AppendTo[result, s]];      ]     result      yields:               {}      Any help appreciated.


Exporting strings without the quotes

I'm trying to export the following string               "sep = ,"      to a CSV-file, as to be able to define the separation symbol, but when using the following command,               Export["test.csv", Join[{"sep = ,"}, RandomInteger[{-5, 5}, {5, 3}]], "CSV"]      I get the quotes around the string in the first line:               "sep = ,"     -4,5,0     5,-4,-1     0,5,2     -1,2,4     -1,-4,-1      This obviously isn't recognised by Excel and it doesn't open correctly. I've tried changing the string to something like               Style["sep=,", ShowStringCharacters -> False]      and then export again, but then I just get this whole command into the CSV- file. Is there a method to export this string without the quotes attached to them into a CSV-file? Thanks for all help!


CMYK colours changing

If I draw a coloured diagram like `Graphics[{CMYKColor[0, 0.83, 1, 0], Rectangle[{0, 0}], CMYKColor[1, 0, 0, 0], Rectangle[{0.5, 0.5}]}]` and select the red rectangle using Drawing Tools Colours, it gives a different colour than I originally input. ![enter image description here](http://i.stack.imgur.com/qJGn8.png) When I exported the image as an eps and opened it in Illustrator, the red was back to [0,0.83,1,0]. Why are the colour sliders in Mathematica giving a different value?


Distance between 3D curves

I would like to determine the distance bewteen two representations of the Lorenz Attractor. I have two 3D representations for different initial conditions and I want to calculate the distance between those curves. The problem is that I have written this for the first and the second and there are only `x0`, `yo` and `z0` that are different.               NDSolve[{x'[t] == -10 (x[t] - y[t]),        y'[t] == -x[t] z[t] + 28 x[t] - y[t], z'[t] == x[t] y[t] - 8/3*z[t],       x[0] == y[0] == 1, z[0] == 2}, {x, y, z}, {t, 0, 200},        MaxSteps -> Infinity]     ParametricPlot3D[Evaluate[{x[t], y[t], z[t]} /. %], {t, 0, 200},        PlotPoints -> 10000, ColorFunction -> (ColorData["Rainbow"][#4] &)]      I can't use the `EuclideanDistance` since I don't have the expression of the curves and I'm blocked. I would like to draw the difference between `Sqrt(x^2+y^2+z^2)` of the 2 curves. Thanks !


Creating a new list by dropping sub elements of the original list

Suppose I have a nested listed as follows,               {{{1,2},{3,4,5},{2,3}},{{2,3,4},{5,4,1},{1,4,3}},{{3,4,5},{3,4,5}}}      Where the elements are, > >     {{1,2},{3,4,5},{2,3}} >   >     {{2,3,4},{5,4,1},{1,4,3}} >   >     {{3,4,5},{3,4,5}} >   I would I create a new list where I drop any sub element that has 1 or 2 in its first part. The output should then look like this, > >     {{{3,4,5}},{{5,4,1}},{{3,4,5},{3,4,5}}} >


How to tell when a job is too big for the pattern matcher?

Pattern matching is great but it has its limitations. Consider sorting a list of numbers from smallest to largest:               RandomSample[Range[10]] //. {a___, b_, c_, d___} /; b > c :> {a, c, b, d}      > {1, 2, 3, 4, 5, 6, 7, 8, 9, 10} However, running               RandomSample[Range[1000]] //. {a___, b_, c_, d___} /; b > c :> {a, c, b, d}      > ReplaceRepeated::rrlim: Exiting after {<<1000>>} scaned 65536 times. >>   >  {1, 2, 3, 4, 5, 6, 7, 9, 11, 13, <<990>>} is a different story. The code takes a long time to run and the resulting output is not sorted properly. Now, obviously, we would want to use `Sort` in this type of scenario, but now I'm curious to know: at what point does a job become too computationally intensive for the pattern matcher?


Defining and isolating a region of an image internal to a bounding curve

I was recently looking over this very nice question by March Ho: Counting elements which are inside another element on a different colour channel There are often times where I find myself wanting to draw a curve or define a polytope to cut out and isolate a part of an image for further analysis. One solution, for example, would be to define a set of polytope vertices, e.g.:               poly = {{658.`, 1224.`}, {672.`, 1054.`}, {507.`, 871.`}, {358.`, 876.`}, {344.`, 1432.`}, {483.`, 1410.`}};      And then calculate a winding number for each pixel in the image, or equivalently apply InPolygonQ, to define a "cutout" region. Here's a naive approach:               CutoutRegion = ImageData[pic];     ImageDimX = ImageDimensions[pic][[1]]     ImageDimY = ImageDimensions[pic][[2]]     Length[CutoutRegion[[1]]]          For[y = 1, y <= ImageDimY, y++,       For[x = 1, x <= ImageDimX, x++,         pt = {x, (ImageDimY-y)};           If[Graphics`Mesh`InPolygonQ[poly, pt] == True,            CutoutRegion[[y, x]] = 1;            ,            CutoutRegion[[y, x]] = 0;           ];       ];      ];          ImageMultiply[Image[CutoutRegion], pic]      This works, however very slowly, and it's a little bit clumsy to define a region of interest with a polygon. Really you'd want to freehand draw something. My question is:   * Is there a trivial way to speedup the above approach?   * Is there a more elegant way to "hand" or "mouse" define a region of interest in an image and isolate it to generate a final product similar to the output of the above approach?


Using select to pick out elements of nested lists in an odd way

Suppose I have a nested list such as,               {{{A, B}, {A, D}}, {{C, D}, {A, A}, {H, A}}, {{A, H}}}      Where the elements of interest are, > >     {{A, B}, {A, D}} >   >     {{C, D}, {A, A}, {H, A}} >   >     {{A, H}} >   How would I use select to pick up only elements that contain two or more `A`s in the first part of their sub-elements. In this example I would want the following as an output, > >     {{A,B},{A,D}} >


How can I permute a multiset?

I have a multiset {1, 3, 3, 1, 2} and would like to randomly permute the classes like so: {2, 1, 1, 2, 3} or {3, 2, 2, 3, 1}, what is the simplest and most efficient way to do this? In reality the input set would be like `RandomInteger[1000, 1000000]` _Edit_ The tricky part of this question is that the positions of the same integers must remain the same! Only the representatives are permuted, but the positions of the classes of integers need to remain the same.


Page Break Adjustment In Long Documents

Has anyone else had trouble in relocating page breaks in a long document? In a ~45 page long document I wanted to keep certain things on the same page. The system worked on the first three or four changes although it took a rather long time on each adjustment. On the next change the program seemed to lock up in a loop. The text on the screen vanished and the program was unresponsive. The CPU meter indicated MMA was working rather hard. I had to Alt F4 to get out. I repeated the problem twice. Other than breaking the document into small pieces does anyone have a suggestion?


Markup of CDF file, e.g. highlighting text

Is it possible to markup (i.e. highlight or underline) text in a deployed cdf file and then save it? I think I know the answer (no), but since it seems a basic necessity for a document format that aspires to be used for textbooks, I thought I would ask if anybody had succeeded in such a task. Other similar tasks might include margin notes. I have tried a little out myself and failed with the following code:                   highlight :=             SetOptions[NotebookSelection[EvaluationNotebook[]], Background -> Yellow];         highlightButton := Button["Highlight", highlight];         SetOptions[EvaluationNotebook[],           DockedCells -> Cell[BoxData[ToBoxes[highlightButton]], "DockedCell"]]      When this is executed in Mathematica, I get a nice Button in my `DockedCell` that allows me to highlight text, by first selecting the text and then hitting the button. However, this functionality disappears when I try to deploy as a CDF. Am I right that this is impossible? I am pretty sure that even if I managed to get the text highlighted, from CDF Player, there won't be any saving anyway, but at least it could be printed (perhaps to a pdf).


LeastSquare Solution for the Continuous Time Lyapunov Equation

I have been working with a problem which involves solving the continuous time Lyapunov equation $$A R + R A^\top = G$$ for the symmetric positive definite matrix $R$. Here $A$ is real, invertible and sparse and $G$ is diagonal but singular. I am solving this equation for various matrices $A$ using `LyapunovSolve`. However, in some situations I get the error message _"LyapunovSolve::nuniq: The matrix equation has no unique solution"_ I can always transform this into an equation for each entry using `CoefficientArrays` and then solve with `LeastSquares`. This however, I have found to be incredibly slower than `LyapunovSolve`. Notwithstanding, it does yield a solution whose error (measured via the norm $\|A R + R A^\top - G\|$) is quite satisfactory. My question is the following: is it possible to obtain with `LyapunovSolve` a solution which, albeit not unique, is the best possible solution (in the least square sense)? Below is an example matrix for reference (hopefully, copying it into a notebook should work) Thank you in advance.               G = DiagonalMatrix[SparseArray[{11 -> 2., 20 -> 1.}, {20}]]          A = SparseArray[{{1, 11} -> -1., {2, 12} -> -1., {3, 13} -> -1.,                     {4, 14} -> -1., {5, 15} -> -1., {6, 16} -> -1.,                     {7, 17} -> -1., {8, 18} -> -1., {9, 19} -> -1.,                     {10, 20} -> -1., {11, 1} -> 10.5, {11, 2} -> -1.,                     {11, 3} -> -1., {11, 4} -> -1., {11, 5} -> -1.,                     {11, 6} -> -1., {11, 7} -> -1., {11, 8} -> -1.,                     {11, 9} -> -1., {11, 11} -> 1., {12, 1} -> -1.,                     {12, 2} -> 7., {12, 3} -> -1., {12, 4} -> -1.,                     {12, 5} -> -1., {12, 6} -> -1., {12, 8} -> -1.,                     {12, 10} -> -1., {13, 1} -> -1., {13, 2} -> -1.,                     {13, 3} -> 8., {13, 4} -> -1., {13, 5} -> -1.,                     {13, 6} -> -1., {13, 7} -> -1., {13, 9} -> -1.,                     {13, 10} -> -1., {14, 1} -> -1., {14, 2} -> -1.,                     {14, 3} -> -1., {14, 4} -> 6., {14, 5} -> -1.,                     {14, 7} -> -1., {14, 9} -> -1., {15, 1} -> -1.,                     {15, 2} -> -1., {15, 3} -> -1., {15, 4} -> -1.,                     {15, 5} -> 6., {15, 6} -> -1., {15, 8} -> -1.,                     {16, 1} -> -1., {16, 2} -> -1., {16, 3} -> -1.,                     {16, 5} -> -1., {16, 6} -> 7., {16, 7} -> -1.,                     {16, 8} -> -1., {16, 9} -> -1., {17, 1} -> -1.,                     {17, 3} -> -1., {17, 4} -> -1., {17, 6} -> -1.,                     {17, 7} -> 5., {17, 10} -> -1., {18, 1} -> -1.,                     {18, 2} -> -1., {18, 5} -> -1., {18, 6} -> -1.,                     {18, 8} -> 4., {19, 1} -> -1., {19, 3} -> -1.,                     {19, 4} -> -1., {19, 6} -> -1., {19, 9} -> 5.,                     {19, 10} -> -1., {20, 2} -> -1., {20, 3} -> -1.,                     {20, 7} -> -1., {20, 9} -> -1., {20, 10} -> 5.5,                     {20, 20} -> 1.}, {20, 20}]


Is there a built-in function to find the adjoint of a matrix?

I've been looking for a function that helps me get the adjoint matrix o a given one, I found that you can get the cofactors of a matrix but only by using the "Combinatorica" package, which I couldn't get. If you know any command or if you know effective ways of creating a function that does this, please help me.


Evaluation of Notebook chosen by FileNameSetter

Please consider the following: I have created a GUI where I can choose the path of a notebook (which I need for later calculation) via `FileNameSetter[Dynamic[path1], "Open", {"Mathematica Notebook" -> {"*.nb"}}]` Now I would like Mathematica to evaluate the chosen notebook immediately after setting the path. Has anyone an idea?


How can I create jpeg images of a given file size?

### Cross-posted at Wolfram Community I would like to have a function makeJPG[megabytes_] that generates random jpg images of given file sizes with itf filesize (in megabytes) watermarked on the image itself. This is tricky because jpg compression isn't constant. Here's my first pass at it (but the watermark is squished, and the filesizes are not accurate):               (*Estimated by hand*)     points =       {{0.841, 1241.906471417973`}, {2.399941`, 2000}, {9.597819`, 4000}, {38.390543`, 8000}};     ifun = Interpolation[points];          makeJPG[megabytes_] :=        Module[{dim = IntegerPart @ ifun[megabytes], numberWatermark},         numberWatermark =            Rasterize[Style[ToString[megabytes],              FontFamily -> "Helvetica Neue"], ImageSize -> {dim, dim}];         Export[ToString[megabytes]~~".jpg",            ImageAdd[Image[RandomReal[1, {dim, dim, 3}]],              ImageSubtract[Image @ numberWatermark, 0.7]]]]      **Motivation** The application here is an iphone app that I need to test on images of different megapixels.


Bifurcation with a system of equations

I'm trying to plot a flip bifurcation diagram for a dynamical system of equations as follows:               x'[t] == v[t]     v'[t] == x[t] - A x[t]^3 + R*Cos[\[Omega]*t] - B v[t]      but am having trouble writing the code to get a bifurcation diagram to plot. I have numerical values for A,B, & Omega, and am trying to plot the diagram for R. Other similar questions and references online don't seem to be helpful (either not nonlinear or not a system of equations).


Compiling function with predefined expression

I'm using the Compile function in Mathematica to compute say the following :               f=Compile[{x,_Real},Cos[x]]      Then I can compute f[x] for x taking any real value. Ok, let's say now that I have an expression like `tmp=Cos[x]`. My question is the following: Is there a way that I can compile the expression assigned to `tmp` without explicitly typing "Cos[x]" in the `Compile` function ? I.e. I want to do something like :               f=Compile[{x,_Real},tmp]      But that won't work it seems. In principle I'd like the value assigned to tmp to be a somewhat huge and complicated symbolic function of `x` that I would like to compile for numerical efficiency.


ContextPath and autocompletion with subpackages

I'm developing a larger package which includes several subpackages. My problem is, that I can't introduce the symbols in the subpackages to the autocompletion by loading the main package, but by calling a subpackage. Let's explain this with an example: I have a main package, called `main` which loads the subpackages `sub1`, `sub2` and `sub3`. The directory should look like               main     ├── Kernel     │   └── init.m     ├── main.m     ├── sub1.m     ├── sub2.m     └── sub3.m      The package `main` loads all three subpackages in its `BeginPackage` statement, while the package `sub1` loads `sub2` and `sub3`. The respective `init.m` looks like:               Get["main`sub3`"]     Get["main`sub2`"]     Get["main`sub1`"]     Get["main`main`"]      The big problem I have is, that by calling               Needs["main`"]      I can see all symbols in `main`, but not those in the subpackages (though, they are usable). By calling               Needs["main`sub1`"]      I can see all symbols in the subpackages without any problems but can't load `main` anymore, because then some definitions are redone, which leads to error messages about protected symbols. The most interesting thing is, that the `$ContextPath` includes the subpackages in both cases. Is there a nice possibility to get the symbols of the subpackages into the autocompletion? * * * _Update_ : By prepending the path of a subpackage to the `$ContextPath`, I can load the corresponding symbols of that package into the autocompletion.               $ContextPath = Prepend[$ContextPath, "main`sub1`"]      Unfortunately, this is not very nice and yields duplicates in the `$ContextPath`. Is there a better, automatic way to achieve this?


Plot the velocity

So I am trying to find the connection between Forcing Amplitude and Velocity in a differential equation (Which is the part of system of differential equations). Those system differential equations are $$y''(t)+500y'(t)+100y(t)=-A(\cos(500t)+2\cos(1000t))$$ $$300x'(t)=1000y(t)+500y'(t)-35\tanh(50x'(t))$$ Practically, I am trying to graph the change in parameter $A$ which is Forcing Amplitude, and its effect on $x'(t)$. I am not looking for instantaneous velocity, so for example calculating $x(t)/t$ when $t$ is big enough I think is sufficient. I succeed to use Manipulate to graph $x(t)$ versus $t$ on various $A$ as below.               Manipulate[{xy = NDSolve[{      y''[t] + 500 y'[t] + 250 y[t] == -a*(Cos[500 t] + 2*Cos[1000 t]),y[0] == 0, y'[0] == 0,      333 x'[t] == 250 y[t] + 500*y'[t] - 35*Tanh[50 x'[t]], x[0] == 0},      {x, y}, {t, 0, 0.1}], Plot[{x[t] /. xy}, {t, 0, 0.1}],      MaxSteps -> Infinity}, {a, 0, 100}]      EDIT: I might be a bit unclear in writing my question. So my question is : Is it possible to take A as x axis and average velocity x'(t) as y axis?


How can I set global computation options ($MaxPiecewiseCases) for parallel kernels?

I'm trying to do a calculation in parallel that requires setting $MaxPiecewiseCases. How can I do this? This small test case doesn't work for me:               $MaxPiecewiseCases = 1000;     Print[$MaxPiecewiseCases];     ParallelEvaluate[$MaxPiecewiseCases = 500; Print[$MaxPiecewiseCases]];      Instead the output is:               During evaluation of In[118]:= 1000     (kernel 7) 100     (kernel 8) 100     (kernel 9) 100     ...


Mathematica Presentation Cell Formatting

In one of the _Mathematica_ (v9) slide templates, they have an example cell that looks like this: ![enter image description here](http://i.stack.imgur.com/nHoMb.jpg) Where there is a "SideCaption" that appears to be the _Mathematica_ -equivalent of a text box to the right of the image. I can't for the life of me figure out how this is replicate this other than copying the cell and pasting elsewhere. I did find this code looking at the notebook file however:               Cell["SideCaption How do I get this?", "SideCaption"]      Is this something I can generate programmatically, or something that needs to be copied when used elsewhere? I could see this format being used in more places than presentations.


Weird NDSolve behavior with Piecewise (MMA9)

`NDSolve` in Mathematica 9.0.0 (MacOS) is behaving strangely with a piecewise right hand side. The following code (a simplified version of my real problem):               sol = NDSolve[{x'[t] ==              Piecewise[{{2, 0 <= Mod[t, 1] < 0.5},                         {-1, 0.5 <= Mod[t, 1] < 1}}             ], x[0] == 0}, x, {t, 0, 1}];     Print[x[1] /. sol[[1]]];      gives the correct answer of 0.5 about 50% of the time, but often returns -0.5 and -1 instead. Rerunning it gives apparently random results. It always gives the correct result in Mathematica 8. Here's what I've figured out so far:   1. It apparently has something to do with the `Mod[t,1]`, because it works fine with just "t" in the `Piecewise`. Unfortunately I'm looking at a piecewise periodic system (not just from t=0 to 1).   2. It's only the first segment of the solution from t=0 to t=0.5 that varies from run to run.   3. Using initial condition `x[10^-100]==0` fixes the problem, but this is an ugly hack. Can anyone replicate this strange behavior, know what's behind it, or have a better suggested fix?


Color function doesn't span the whole color range in MatrixPlot

In matrix visualization, for instance,               MatrixPlot[{{1, 2}, {3, 4}}, PlotRangePadding -> 0,       ColorFunction -> "Rainbow"]      ![matrix](http://i.stack.imgur.com/kJZBc.png) the color map does not cover the whole color range as shown in the following density plot.               DensityPlot[x, {x, 1, 4}, {y, 0, 0.1}, AspectRatio -> 0.2,       PlotRangePadding -> 0, ColorFunction -> "Rainbow", Frame -> True,       FrameTicks -> None]      ![color bar](http://i.stack.imgur.com/lAjy3.png) I need to add the density plot as a color bar, while not using the Legend. So, how to solve this problem?


Postfix with two arguments

This must be duplicate but can't find any related post. I'm want to pas it two argument in postfix like `f[a_,b_]:=a+b;` `1,2//f` More generally, can somebody explain me in detail, how to use the @f ,~~f~~, and //f


First pair out of order

I would like to know how to efficiently determine the first pair of elements in a list that are not in order according to some predicate p. That is, list[i] > list[j] according to p, and i is the smallest index for which this is true. It is easy, but gauche, using nested loops.


How to plot layered graphs?

Given a directed acyclic graph, there is always a possibility to plot the graph as layers, where nodes always send edges into one direction (usually down), to successive layers, and never backwards. The `"LayeredDrawing"` option value for `GraphLayout` fails miserably. There is the built-in (but somewhat obsolete) `LayeredGraphPlot`, which can do this, but it is obviously not part of the new `Graph`-paradigm. What would be an efficient and elegant algorithm to lay such a graph in 2D?               Row@{       Graph[{1 -> 2, 1 -> 3, 2 -> 3, 1 -> 4, 2 -> 4, 1 -> 5},         ImageSize -> 200, VertexLabels -> (# -> # & /@ Range@5),         GraphLayout -> "LayeredDrawing", ImagePadding -> 10],            LayeredGraphPlot[{1 -> 2, 1 -> 3, 2 -> 3, 1 -> 4, 2 -> 4, 1 -> 5},         VertexLabeling -> True, ImageSize -> 200]       }      ![Mathematica graphics](http://i.stack.imgur.com/7S8KV.png) Note, that while `TopologicalSort` gives a top-down sorting of vertices, usually there are multiple solutions for topological sorting, thus multiple ways to layer the same graph. Also, the algorithm must take into account that not all children of a parent should end up on the same layer (see e.g. vertex `1` in the right plot). A nice algorithm for laying out arrows is welcome as well.


Using Graph to cull correlated lists

I have a set of lists that represent molecular descriptors. I need to identify which descriptors are highly correlated and eliminate the correlated pairs. I can represent the connectivity by assigning a number to each descriptor-list and creating edges that correspond to my correlation criteria, generating images that look like this: ![Mathematica graphics](http://i.stack.imgur.com/JoGcx.png) It is not too difficult to find the vertices that have many connections, and I can cull this dataset down to the following types of elements:               edges = # /. List -> DirectedEdge & /@ {{1, 2}, {2, 3}, {1, 3}, {4,           5}, {5, 6}, {7, 8}, {8, 9}, {9, 10}, {11, 12}, {13, 14}, {14,           15}, {15, 16}, {16, 17}, {18, 19}, {19, 20}, {20, 21}, {21, 18}};     ranks = {4, 12, 6, 3, 21, 14, 1, 17, 20, 13, 2, 19, 11, 15, 10, 8, 9,         7, 5, 16, 18};     Graph[Labeled[#, ranks[[# /. DirectedEdge -> List]]] & /@ edges,       ImagePadding -> 10, VertexLabels -> "Name"]      ![Mathematica graphics](http://i.stack.imgur.com/xVBcx.png) Each vertex has a rank assigned to it, and these ranks are shown as edge labels (the 1st element corresponds to the rank at the tail of the directed edge, so the rank of vertex 20 is 16. What I am struggling with now is culling this list further according to the following rules:   1. Maximize number of vertices remaining   2. Keep vertices with the lowest rank   3. When keeping pairs of vertices in chains and rings, use the sum of the ranks as the comparator.   4. Tiebreaker: random choice Based on these rules, the sample graph should result in the following output (with the possible exception of vertices 17 and 15, which are tied with keeping 16/14).               desiredoutput = {20, 18, 1, 17, 15, 10, 7, 4, 6, 11};      I've noted that @MrWizard has looked at finding neighbors which may be of help, but I'm still fumbling with applying that code to my situation. # Examples Take the chain of length 4. By inspection, the maximum number of vertices we could keep without there being a correlation (edge) between the two is 2. The combinations can be found by determining the permutation of `Range@4` and delete cases where the numbers in the pair are consecutive. Then replacing the pairs with rank values to determine the pair of vertices to keep:               DeleteCases[Permutations[Range@4, {2}], {x_, y_} /; Abs[x - y] == 1 || y < x]     (* {{1, 3}, {1, 4}, {2, 4}} *)     Total /@ (% /. {1 -> 13, 2 -> 20, 3 -> 17, 4 -> 1})     {30, 14, 21}      Because pair {1,4}, which corresponds to vertices 10 and 7, has the lowest combined rank, these are the two vertices that will be kept in the chain. A 3-membered chain will always lose its middle vertex, since rule 1 states that we are trying to maximize the number of vertices in the result. The 3-membered ring will reduce to only one vertex, so we take the vertex with the smallest rank, which by inspection is vertex 1. My problem boils down to identifying the 'shape' of a feature in the graph (chain, ring) so that the appropriate rule can be applied, and then modifying the above process so that it does not require manual interaction.


Centrality measures for single nodes

I am producing a graph, generated by a list of adjacent nodes. (The list looks like `{1 ->583, 1->2977, 2->14, 4->1293, 5->221, ...}`. Each node of my graph is a number. I wanted to get the centrality measures for this graph so I used:               bc = BetweennessCentrality[graph1]      This yields the entire list of centrality measures, (in the order in which the nodes appear in my list i guess?)               {6., 0., 0., 0., 0., 3., 5., 0., 0., 0., 0., 0., 1., 0., 0., 0., 0.,      1., 0., 0., 0., 1., 0., 0., 0., 0., 0., 0., 1., 0., 0., 0., 0., 0.,      0., 0., 1., 0., 0., 0., 0., 0., 0., 0., 0., 1., 0., 0., 0., 0.}      I would like to find a way to obtain the centrality measure for a precise node, say, node 2. I only know of this kind of way :               bc[[2]]      But this only gives me the second entry in the obtained list, not the centrality measure for node number 2. What I would really need is to generate a list with the first 10 nodes in my graph and their respective centrality measures.


Machine Epsilon

I'm trying to evaluate the machine epsilon of my computer (see below). I wrote this:               eps = 1.0;     p = 0;     While[(1.0 + eps) > 1.0, eps = eps/2.0; p += 1];     eps     p     eps*2      and got:               1.42109*10^-14     46     2.84217*10^-14      which is not what I expected (IEEE754). So I did this               EngineeringForm[1.0 + 2 * eps, 20]     EngineeringForm[1.0 + eps, 20]     EngineeringForm[1.0 + (eps/2.0), 20]     EngineeringForm[1.0 + (eps/4.0), 20]     EngineeringForm[1.0 + (eps/16.0), 20]     EngineeringForm[1.0 + (eps/32.0), 20]      and got that:               1.000000000000028     1.000000000000014     1.000000000000007     1.000000000000004     1.000000000000001     1.      which seems to contradict the termination condition of the 'while' loop. So I would like to understand what's going on under Mathematica's hood. I tried to look for some information on Mathematica's internal float representation without success. Any help to explain these results is welcome. I'm sorry if my question is a bit vague. Eric Context: SystemInformationData[{"Kernel" -> {"Version" -> "9.0 for Mac OS X x86 (64-bit) (January 24, 2013)", "ReleaseID" -> "9.0.1.0 (4055646, 4055073)", ...}] EDIT I was suggested the following program that works directly for some reason:               eps = 1.0;     n = 0;     While[(1.0 + eps) - 1.0 > 0.0,       eps = eps/2;       n++;     ];     eps*2     n     Log[2, eps*2]


Different actions with dragging and clicking points in same graphic

On a graphic (in this example a simple plot), I need two points to move when I drag with the mouse, and these points must move to location {1,1} when I click on them. This is how I got it to work, but I don't think it's a good way.                DynamicModule[{pt = {{1, 2}, {2, 3}}},       EventHandler[  LocatorPane[Dynamic[pt], Plot[t, {t, -3, 3}],        Appearance -> Graphics[Circle[], ImageSize -> 10]],       "MouseClicked" :> (pt =       ReplacePart[pt,        First@Flatten@          Sort[MapIndexed[{#2, Norm[MousePosition["Graphics"] - #]} &,             pt], #1[[2]] < #2[[2]] &] -> {-1, -1}]),       "MouseDragged" :> (pt =       ReplacePart[pt,        First@Flatten@          Sort[MapIndexed[{#2, Norm[MousePosition["Graphics"] - #]} &,             pt], #1[[2]] < #2[[2]] &] -> MousePosition["Graphics"]])]]      Any suggestions for improvement?


Showing the correlation of two variables using a plot

I have a list of $\{x_i,y_i\}$ pairs and I want to show that $x_i$'s and $y_i$'s have positive correlation. The result of `Correlation[Transpose[data][[1]], Transpose[data][[2]]]` is `0.856906` and `ListPlot[data, PlotRange -> All, AxesLabel -> {X, Y}]` results in the following plot: ![ListPlot of the simulation data](http://i.stack.imgur.com/WTzZ5.png) I just wonder if there is any other (better) type of plot in Mathematica to show the correlation between the variables?


How to make a single-variable out of a NDSolve solution?

So I've got this line that contains the solution of a partial, non- extraordinary differential equation (because Mathematica doesn't handle extraordinary partial differential equations):               phi6m = NDSolveValue[{D[u[t, x], t, t] -       D[u[t, x], x, x] == -6 u[t, x]^5 + 10.5 u[t, x]^3 - 4.5 u[t, x],    u[0, x] == Tanh[x], Derivative[1, 0][u][0, x] == 0, u[t, -7] == -1,     u[t, 7] == 1}, u, {t, 0, 6}, {x, -7, 7}]      And now I wish to compute the following as a function of time, as well as its derivative with respect to time: $ E(t)=\int_{-7}^{7} dx (\frac{\partial u}{\partial x})^2+(u(t,x)^2-1)^2(u(t,x)^2-0.625)$ where u is the solution given by the aforementionned line of code. But now I wish to take the function, as well as its derivative, and plot it into a graph... what I tried allowed me to take the function at a fixed time value, here t=0.1:               phi62 = phi6m[0.1, x];     energiephi6 = D[phi62, x]^2 + (phi62^2 - 1)^2 (phi62^2 - 0.625);     energietotale = NIntegrate[energiephi6, {x, -7, 7}]      But not to make something plottable as a function of time, much less a derivative of the aforementionned function with respect to time. Is there anything else I can do to resolve the issue?


How can I name patterns in a Switch expression?

Suppose I have an expression and want to match it against successive patterns and return an expression corresponding to the first pattern that matched. In that case, I can use               Switch[expr,       pat1, val1,       pat2, val2,       …]      For example,               Switch[x,       _Integer, "This is an integer"],       _Real , "This is a real"],       _, "This is something else"]      However, the `vali` cannot refer to parts of the `pati` by name. i.e. I cannot do:               Switch[x,       i_Integer, ToString[i] <> " is an integer",       x_Real , ToString[x] <> " is a real",       e_, ToString[e] <> " is something else"]      Ocaml has the `match` function, which is used as:               match expr in:     | pat1 -> val1     | pat2 -> val2     ...      where the `vali` can refer to named parts of the `pati`. How can this most elegantly be accomplished in Mathematica?


Problem when defining variable in Mathematica

I'm trying to run this:               domain := {n, 0, 10};     Plot[n, domain]      but it doesn't work. Instead, it generates the message               Plot::pllim: Range specification domain is not of the form {x, xmin, xmax}.      and returns               Plot[n, domain].      Why? I've also tried alternatives such as using `=`, or trying to define `Domain[n_] = {n, 0, 10}` but it all seemed to be of no avail.


Extracting coefficients from a partial differential equation

Frequently, I come across the following problem: How to rewrite a complicated partial differential equation in a more clear way? I would like to create some order by collecting terms that are equal. For example, this rather messy equation $0 = \frac{1}{4} l^4 m^4 y F^{(0,1)}(x,y)-6 l^2 M^2 y F^{(0,1)}(x,y)+\Lambda F^{(0,1)}(x,y)$, can be written more clear as $0 = \text{newform} = a_{0001} F^{(0,1)}(x,y)+a_{0101} y F^{(0,1)}(x,y)$ with $a_{0101}=\frac{l^4 m^4}{4}-6 l^2 M^2$ and $a_{0001}=\Lambda$. My question is how to determine the coefficients from a given PDE? To make it more tangible, suppose I have a partial differential equation of f(x,y) that is quadratic in f and has order 6 derivatives in derivatives. It can be written as $0 = \sum_{i,j,k,l} a_{i j k l} x^i y^{j}F^{(k,l)}(x,y) + \sum_{i,j,k,l,m,n} b_{i j k l m n} x^i y^{j}F^{(k,l)}(x,y)F^{(m,n)}(x,y)$ I want to use Mathematica to   1. Rewrite the PDE into the above form; i.e. replace calculate all the coefficients   2. Do not include terms with that have a zero coefficient in this new form   3. Create a replacement rule for each coefficient.   4. Check that this new form of writing eq is indeed equivalent.  How can I do this? If point 1 - 3 are established, then point 4 is easy: Just check that the following adds up to zero               oldform - newform /. substitutionrule       To give you an idea, these are some of the terms that appear in my PDE. $\small{l^4 m^4 F(x,y) -57 l^4 \Lambda M^2 F(x,y) + l^4 m^4 y F^{(0,1)}(x,y)+ 57 l^4 \Lambda M^2 y F^{(0,1)}(x,y)-24 l^2 M^2 y F^{(0,1)}(x,y)}$ $+ \small{2 M^2 y^8 F^{(0,1)}(x,y) F^{(0,5)}(x,y)-4 M^2 y^8 F^{(2,4)}(x,y)+4 M^2 y^6 F(x,y) F^{(0,4)}(x,y) = 0}$ Here is the `InputForm` of this 'toy PDE'               eqn = l^4*m^4*F[x, y] - 57*l^4*Lambda*M^2*F[x, y] + l^4*m^4*y*Derivative[0, 1][F][x, y]      - 24*l^2*M^2*y*Derivative[0, 1][F][x, y]     + 57*l^4*Lambda*M^2*y*Derivative[0, 1][F][x, y]      + 4*M^2*y^6*F[x, y]*Derivative[0, 4][F][x, y]      +  2*M^2*y^8*Derivative[0, 1][F][x, y]*Derivative[0, 5][F][x, y]     - 4*M^2*y^8*Derivative[2, 4][F][x, y]      And more convenient to copy into a notebook is this form               eqn = l^4*m^4*F[x, y] - 57*l^4*Lambda*M^2*F[x, y] + l^4*m^4*y*Derivative[0, 1][F][x, y] - 4*l^2*M^2*y*Derivative[0, 1][F][x, y] +  57*l^4*Lambda*M^2*y*Derivative[0, 1][F][x, y] + 4*M^2*y^6*F[x, y]*Derivative[0, 4][F][x, y] +  2*M^2*y^8*Derivative[0, 1][F][x,y]*Derivative[0, 5][F][x, y] - 4*M^2*y^8*Derivative[2, 4][F][x, y]      Update: Pillsy gave a nice solution that does exactly (1)-(4). To see what kind of powers of x, y, $\partial_x$ and $\partial_y$ are contained in the example PDE I use his code, and I add               Total[coeffRules /. {(a[i_, j_, k_, l_] -> coeff_) :>      Subscript[a, i, j, k, l]*x^i*y^j*      Derivative[k, l][F], (b[i_, j_, k_, l_, m_, n_] -> coeff_) :>      Subscript[b, i, j, k, l, m, n]*x^i*y^j*      Derivative[k, l][F] Derivative[m, n][F]}]      This gives $\small{y^8 a_{0,8,2,4} F^{(2,4)}+3 y a_{0,1,0,1} F^{(0,1)}+2 F a_{0,0,0,0}+y^8 b_{0,8,0,1,0,5} F^{(0,1)} F^{(0,5)}+F y^6 b_{0,6,0,0,0,4} F^{(0,4)}}$ Now it is much easer to see what kind of PDE this is. There is one more thing I would like to ask. How can I avoid the double counting of terms that results for example in the factor 3 in $3 y a_{0,1,0,1} F^{(0,1)}$? This works, I think               % /. {Times[a_Integer, b_] -> b, Times[b_, a_Integer] -> b}      $\small{y^8 a_{0,8,2,4} F^{(2,4)}+y a_{0,1,0,1} F^{(0,1)}+F a_{0,0,0,0}+y^8 b_{0,8,0,1,0,5} F^{(0,1)} F^{(0,5)}+F y^6 b_{0,6,0,0,0,4} F^{(0,4)}}$


Create jacobian Function from a vector Function

This is related to this question and maybe this question. I wanted a function that takes an n-parameter vector function and outputs a Jacobian matrix function, also n-parameter. I think this works:               J[f_]:=Module[        {x=Unique[],v},        v=Thread[Subscript[x, Range[Length[{##}]]]];        Outer[D,f@@v,v]/.Thread[v->{##}]     ]&          J[Function[{x,y},{x y+x^2-2,Cos[x-y]Sin[x]-y}]][1.5,2.5]          D[{x y+x^2-2,Cos[x-y]Sin[x]-y},{{x,y}}]/.Thread[{x,y}->{1.5,2.5}]      but I was wondering if there is a cleaner way that doesn't use rules. I'm posting this question even though it's basically solved, because it took me a while, as do most problems involving manipulating pure functions.


Is it possible to make more room in a graph layout for my VertexRenderingFunction?

Consider the graph produced by:               M = {{0, 0, 1, 0}, {1, 0, 0, 1}, {1, 1, 0, 0}, {0, 1, 0, 0}};     GraphPlot[M, DirectedEdges -> True,       VertexRenderingFunction -> ({EdgeForm[Black], LightRed,           Disk[#1, {.7, .1}], Black, Text[Subscript["C", #2], #1]} &)]      ![Output](http://i.stack.imgur.com/K5hmB.jpg) Is it possible to tweak the layout so that more room is left around the vertices for use by the VertexRenderingFunction? (I want to be able to put more text in each of the labels.)


PlotLegends and ImageSize

I have _Mathematica_ 9.0.1, and I have problems with `PlotLegends` breaking the `ImageSize` directive. I defined               cm = 72 / 2.54;      to work with centimeters. I would like an output PDF with a width of, say, 9 cm.               Plot[Evaluate[       Exp[-4 f] /. {{f -> t}, {f -> t^2}}], {t, 0, 3},        BaseStyle -> {FontSize -> 11, AbsoluteThickness[1.5]},        PlotStyle -> {Blue, Red},        AxesLabel -> {"t"},         PlotLabel -> "Negativity",        ImageSize -> 9 cm,         PlotLegends -> Placed[{"OU", "FBM"}, {.8, .5}]]     Export["Neg_long_OU_FBM.pdf", %];      With this command, I obtain a PDF with size 6.48 × 4.31 cm. If I remove the `PlotLegends` option, I get the correct width of 9 cm. If I leave `PlotLegends` without the `Placed` directive (the legend is placed at the right of the Plot), I get 9.42 × 4.38 cm. Is this an expected behavior? How can I produce an output PDF with a 9 cm width and the legend inside the plot?


Problem with Eigenvectors when given a matrix containing approximate numbers and symbols

I'm trying to diagonalize a certain 2 x 2 matrix, but _Mathematica_ refuses to find the eigenvectors. In particular, when I input               Eigenvectors[{{1.8741*10^7 + 1.40161*10^6 B, 2.79374*10^7},                    {2.79374*10^7, -3.1235*10^7 - 1.40161*10^6 B}}]      (B is a parameter). I receive the error > Eigenvectors::eivec0: Unable to find all eigenvectors and the bogus output > >     {{0, 0}, {0, 0}} >   On the other hand, _Mathematica_ has no problem with the eigenvalues, for some reason. Can someone help me figure out what's going on here?


Autoupdate Section Numbers? - Technical Document Authoring with Mathematica

Technical document authoring systems are structured ways to create, manage, and update documentation for various mediums such as print, pdf, web, etc. Take a look at this technical document ported to a mobile device/tablet: ![technicaldocument_on_tablet](http://www.safetyawakenings.com/wp- content/uploads/2013/12/nfpa-101.jpg) As you can see there is a structured format for the chapters and subsections in each chapter.   Chapter 1   1.1 First Section of Chapter 1   1.1.1 First Subsection of 1.1   1.1.2 Second Subsection of 1.1   1.2 Second Section of Chapter 1   1.2.1 First Subsection of 1.2   In this way, if the author were to add a new Section in the middle of a Chapter, all other numbers would need to be updated as it would disrupt the order. For example, in the image above, imagine I inserted a new Section, called "General 2", under the "7.1 General" section.      Then "7.2 Means of Egress Components" would need to become 7.3 instead of 7.2, and so on. I am hoping there is a straightforward way mathematica can auto-update section numbers in a technical document, as in the above scenario, so that it is a viable solution for technical authoring.


Detecting changes of variables' values

Is it possible to detect (and create a trigger for) an event when any of the variables defined in the notebook changes its value (for any reason)? I need to know which variable got changed and what the new value is. Here are some details: I have a client-server application, where the client is my Mathematica notebook. I also have a Java layer in between. The server runs MongoDB database and when any client modifies it, the server sends updates to all other clients. Specifically, to the Java layer. The job of the Java layer is to keep an up-to-date local copy of the database, and to relay all updates to the Mathematica client.               Needs["JLink`"]     InstallJava[];     ReinstallJava[ClassPath -> "/Users/verse/Desktop/java-ddp-client.jar"];     LoadJavaClass["java.lang.System"];     LoadJavaClass["java.lang.Object"];     LoadJavaClass["java.lang.reflect.Array"];     LoadJavaClass["com.wolfram.jlink.JLinkClassLoader"];     LoadJavaClass["me.kutrumbos.examples.MessageHandler"];                              url = "localhost"; port = 3000;     client = JavaNew["me.kutrumbos.DdpClient", url,         MakeJavaObject[port]];     observer =        JavaNew["me.kutrumbos.examples.ObservableDdpClientObserver"];     collections = {};     onCollectionUpdate[msg_] :=        Module[{}, collections = observer@getJSONObjectsList["test"];];                              observer@addMessageHandler[        ImplementJavaInterface["me.kutrumbos.examples.MessageHandler",          "update" -> "onCollectionUpdate"]];                              client@addObserver[observer];     ( _ShowJavaConsole[];_ )     client@connect[];      ` In this example, variable `collections` gets updated by the Java layer every time there is a change in the underlying database. It does not happen through the `Set` command inside the notebook. I need to know when this does happen and I need to properly update other variables. Conversely, when any of the relevant variables change inside the notebook, I need to be able to update the database on the server using an API request. To send such a request, I need to know which variable has changed and what the new value is.


Does the Im function work with symbolic arguments?

Does the `Im` function work with symbolic arguments?               Clear[ y, t, k, ω ]          A ( Cos[ k y ] + I Sin[ k y ] ) 2I Sin[ ω t ] //ComplexExpand          (* Output: 2 I A Cos[ k y] Sin[ t ω ] - 2 A Sin[ k y ] Sin[ t ω ] *)          Im[ % ]          (* Output: -2 Im[ A Sin[ k y ] Sin[ t ω ] ] + 2 Re[ A Cos[ k y ] Sin[ t ω ] ] *)      Expected output: `-2 A Sin[ k y ] Sin[ t ω ]`


Multiple Linear Regression - obtaining equation with constant term

I am trying to use the LinearModelFit function to obtain a linear regression of my 5 inputs for my single output. I have the input data:                   MasterDataInputs={{"payload", "travel_empty_time", "travel_loaded_time",        "net_loaded_lift", "idle_time"}, {16241., 89126., 81075., 7747.,        84323.}, {2364., 10879., 10811., 1421., 12708.}, {4297., 22730.,        24092., 373., 16606.}, {5494., 30667., 32297., 999.,        20341.}, {3926., 22025., 20520., 3410., 23993.}, {6193., 31027.,        28319., 4948., 30262.}, {5709., 27699., 25351., 1990.,        26282.}, {2178., 13410., 14036., 1433., 12485.}, {3605., 18509.,        17690., 2238., 12170.}, {5620., 28632., 24355., 3538.,        27632.}, {4352., 25259., 28307., 2176., 16712.}, {12550., 59921.,        59001., 3095., 58977.}, {5520., 30586., 26967., 4121.,        17851.}, {3193., 19732., 19310., 2769., 15507.}, {9732., 56096.,        57320., 8088., 45418.}, {4531., 23906., 30182., 3789.,        18930.}, {4521., 27455., 26796., 3356., 21291.}, {4286., 25317.,        27807., 2777., 15309.}, {4226., 24740., 31243., 3056.,        20926.}, {3060., 20052., 22617., 2144., 12753.}, {4738., 28425.,        24036., 4534., 24927.}, {7900., 46413., 47040., 4764.,        37522.}, {6964., 41928., 36873., 3729., 32866.}, {19063., 99629.,        102567., 4959., 70360.}, {5043., 30703., 28573., 2819.,        23747.}, {8070., 43767., 41004., 2281., 33673.}, {4580., 25321.,        25370., 2562., 21293.}, {7012., 47499., 38037., 6957.,        35961.}, {1616., 8119., 7718., -18., 6468.}, {2853., 16548., 16089.,        2572., 12738.}, {13729., 94984., 83507., 7410., 71171.}, {5644.,        33104., 36720., 3420., 31578.}, {8280., 57066., 49212., 4818.,        38604.}, {5620., 34289., 30598., 3970., 26980.}, {5881., 35405.,        37019., 4177., 34324.}, {3364., 21765., 20473., 2613.,        13166.}, {5174., 31533., 29321., 4872., 27182.}, {5435., 35767.,        31029., 3773., 31672.}, {5880., 39594., 33352., 6140.,        35198.}, {3814., 23659., 26286., 2724., 18484.}, {1271., 7350.,        7163., 1319., 9607.}, {9463., 60296., 63248., 9054.,        45353.}, {3243., 22832., 25124., 3451., 15275.}, {8022., 48725.,        48224., 8829., 38922.}, {1805., 11246., 12426., 687., 9147.}}      and the outputs:               MasterDataOutput ={"fuel output", 2099.749899, 1384.120668, 1620.060306, 1755.348166, \     1595.189198, 1798.31186, 1722.579319, 1411.483751, 1537.460621, \     1730.932625, 1671.089154, 2010.22954, 1760.840169, 1536.90848, \     2126.08609, 1691.889546, 1688.623823, 1670.48431, 1681.022846, \     1549.985641, 1695.898173, 1979.419182, 1897.569649, 2280.36639, \     1732.712557, 1933.740813, 1666.700071, 1966.088623, 1304.244403, \     1480.054095, 2105.763533, 1799.491245, 2029.785039, 1793.720838, \     1825.476258, 1563.436693, 1761.070177, 1785.978395, 1854.485829, \     1628.997857, 1281.707381, 2152.698111, 1595.443235, 2061.991531, \     1366.867529}      I have tried the following after searching this forum and the help:               LinearModelFit[{MasterDataInputs[[2 ;;]], MasterDataOutput[[2 ;;]]},        MasterDataInputs[[1]]]       which resulted in an equation without a constant. I need a constant in my equation so I tried:               LinearModelFit[{MasterDataInputs[[2 ;;]], MasterDataOutput[[2 ;;]]},        MasterDataInputs[[1]], IncludeConstantBasis -> True] // Normal      which still gives me no constant even though the help says it should. I have also tried the below:               LinearModelFit[{MasterDataInputs[[2 ;;]], MasterDataOutput[[2 ;;]]},        IncludeConstantBasis -> True] // Normal      and all variation without the //Normal at the end. Please will someone help, I need a linear regression equation with a constant term.


Poor CUDALink performance, when calling a kernel multiple times

When working on a project of mine I noticed that CUDALink shows very poor performance when calling CUDA kernels multiple times in a loop-construct. To demonstrate this I put together this little example which calls a simple array addition kernel multiple times:               << CUDALink`          src = "__global__ void addKernel(float *c, const float *a, const \     float *b)     {       int i = threadIdx.x + blockIdx.x * blockDim.x;       c[i] = a[i] + b[i];     }";     fun = CUDAFunctionLoad[src, "addKernel", {{"Float", _, "Output"}, {"Float", _, "Input"},      {"Float", _, "Input"}}, 256, TargetPrecision -> "Single"];               a = ConstantArray[3., 256 * 256];     b = ConstantArray[2., 256 * 256];     c = ConstantArray[1., 256 * 256];          gpuA = CUDAMemoryLoad[a, TargetPrecision -> "Single"];     gpuB = CUDAMemoryLoad[b, TargetPrecision -> "Single"];     gpuC = CUDAMemoryLoad[c, TargetPrecision -> "Single"];          CUDAMemoryCopyToDevice[gpuA];     CUDAMemoryCopyToDevice[gpuB];     CUDAMemoryCopyToDevice[gpuC];          runtimes = {};     For[max = 1, max <= 1000, max++,      For[i = 1, i <= max, i++,       fun[gpuC, gpuA, gpuB];      ] // AbsoluteTiming // First // AppendTo[runtimes, #] &;     ]      Then I called the same kernel-code using a C compiler (Visual Studio 2012) with the same array length and the same number of Iterations (this is essentially the NVidia sample code that comes up, when you start a CUDA Project):               #include "cuda_runtime.h"     #include "device_launch_parameters.h"          #include <time.h>     #include <stdio.h>     #include <fstream>     #include <iomanip>          cudaError_t addWithCuda(int *c, const int *a, const int *b, unsigned int size);          __global__ void addKernel(float *c, const float *a, const float *b)     {         int i = threadIdx.x + blockIdx.x * blockDim.x;         c[i] = a[i] + b[i];     }          int main()     {         const int arraySize = 256*256;         float a[arraySize];         float b[arraySize];         float c[arraySize];              for(int i = 0; i < arraySize; i++)         {             a[i]=1.0f;             b[i]=2.0f;             c[i]=0.0f;         }              float *dev_a = 0;         float *dev_b = 0;         float *dev_c = 0;         cudaError_t cudaStatus;         std::fstream runtimes;         runtimes.open("runtimes.txt", std::fstream::out);              // Choose which GPU to run on, change this on a multi-GPU system.         cudaStatus = cudaSetDevice(0);         if (cudaStatus != cudaSuccess) {             fprintf(stderr, "cudaSetDevice failed!  Do you have a CUDA-capable GPU installed?");             goto Error;         }              // Allocate GPU buffers for three vectors (two input, one output)    .         cudaStatus = cudaMalloc((void**)&dev_c, arraySize * sizeof(float));         if (cudaStatus != cudaSuccess) {             fprintf(stderr, "cudaMalloc failed!");             goto Error;         }              cudaStatus = cudaMalloc((void**)&dev_a, arraySize * sizeof(float));         if (cudaStatus != cudaSuccess) {             fprintf(stderr, "cudaMalloc failed!");             goto Error;         }              cudaStatus = cudaMalloc((void**)&dev_b, arraySize * sizeof(float));         if (cudaStatus != cudaSuccess) {             fprintf(stderr, "cudaMalloc failed!");             goto Error;         }              // Copy input vectors from host memory to GPU buffers.         cudaStatus = cudaMemcpy(dev_a, a, arraySize * sizeof(float), cudaMemcpyHostToDevice);         if (cudaStatus != cudaSuccess) {             fprintf(stderr, "cudaMemcpy failed!");             goto Error;         }              cudaStatus = cudaMemcpy(dev_b, b, arraySize * sizeof(float), cudaMemcpyHostToDevice);         if (cudaStatus != cudaSuccess) {             fprintf(stderr, "cudaMemcpy failed!");             goto Error;         }              clock_t timer;              //Get runtimes         //--------------------------------------------         for(int max = 1; max <= 1000; max++)         {             cudaDeviceSynchronize();             timer = clock();                  for(int i = 1; i <= max; i++)             {                 // Add vectors in parallel.                 // Launch a kernel on the GPU with one thread for each element.                 addKernel<<<256, 256>>>(dev_c, dev_a, dev_b);                          // Check for any errors launching the kernel                 cudaStatus = cudaGetLastError();                 if (cudaStatus != cudaSuccess) {                     fprintf(stderr, "addKernel launch failed: %s\n", cudaGetErrorString(cudaStatus));                     goto Error;                 }             }                  // cudaDeviceSynchronize waits for the kernel to finish, and returns             // any errors encountered during the launch.             cudaStatus = cudaDeviceSynchronize();             if (cudaStatus != cudaSuccess) {                 fprintf(stderr, "cudaDeviceSynchronize returned error code %d after launching addKernel!\n", cudaStatus);                 goto Error;             }                  timer = clock()-timer;                  runtimes << std::setprecision(9) << ((double)timer / (double)CLOCKS_PER_SEC) << std::endl;         }         //---------------------------------------------              // Copy output vector from GPU buffer to host memory.         cudaStatus = cudaMemcpy(c, dev_c, arraySize * sizeof(float), cudaMemcpyDeviceToHost);         if (cudaStatus != cudaSuccess) {             fprintf(stderr, "cudaMemcpy failed!");             goto Error;         }              Error:         cudaFree(dev_c);         cudaFree(dev_a);         cudaFree(dev_b);              runtimes.close();              // cudaDeviceReset must be called before exiting in order for profiling and         // tracing tools such as Nsight and Visual Profiler to show complete traces.         cudaStatus = cudaDeviceReset();         if (cudaStatus != cudaSuccess) {             fprintf(stderr, "cudaDeviceReset failed!");             return 1;         }              return 0;     }      The resulting runtimes (on my GT650M): ![Runtime Comparison](http://i.stack.imgur.com/Ftcrc.jpg) Can anybody explain this behavior and how to adjust my Mathematica Code to prevent this effect?


What would be the inverse function for the following condition?

![enter image description here](http://i.stack.imgur.com/KJw87.jpg) I tried the problem but i couldn't take above condition in question in terms of f(x)


Why do DateList, DateString, and AstronomicalData ignore $TimeZone?

My reading of the documentation for `DateList` and `DateString` lead me to believe that both functions use `$TimeZone` to determine the time zone to use in interpreting their inputs. Thus, for example, if the local machine time zone is UTC-5, `$TimeZone` is `-5`, and the time at Greenwich, corresponding to a given time in the local time zone can be found by specifying `TimeZone -> 0` as an option:               DateList[{2012, 10, 8, 7}, TimeZone -> 0]     {2012, 10, 8, 12, 0, 0.}          DateString[{2012, 10, 8, 7}, TimeZone -> 0]     "Mon 8 Oct 2012 12:00:00"      To base these calculations off a different time zone, one should simply have to change the value of `$TimeZone`, either temporarily, using `Block`, or globally, by unprotecting and changing `$TimeZone`. But neither of these approaches works as expected. Both behave as if the _machine's time zone_ , and _not_ `$TimeZone` is being used to determine the local time zone:               Block[{$TimeZone = 0}, DateList[{2012, 10, 8, 7}, TimeZone -> 0]]     {2012, 10, 8, 12, 0, 0.}          Block[{$TimeZone = 0}, DateString[{2012, 10, 8, 7}, TimeZone -> 0]]     "Mon 8 Oct 2012 12:00:00"          (* Machine time zone is UTC-5 throughout; $TimeZone = 0 until changed below *)     Unprotect[$TimeZone]; $TimeZone = 0;          DateList[{2012, 10, 8, 7}, TimeZone -> 0]     {2012, 10, 8, 12, 0, 0.}          DateString[{2012, 10, 8, 7}, TimeZone -> 0]     "Mon 8 Oct 2012 12:00:00"      And even weirder:               DateList[{2012, 10, 8, 7}]     {2012, 10, 8, 7, 0, 0.}          DateList[{2012, 10, 8, 7}, TimeZone -> $TimeZone]     {2012, 10, 8, 12, 0, 0.}      And yet more timey-wimey:               AstronomicalData["Sun", {"RightAscension", {2012, 10, 8, 7}}]     12.958492          AstronomicalData["Sun", {"RightAscension", {2012, 10, 8, 7}}, TimeZone -> 0]     12.958492          AstronomicalData["Sun", {"RightAscension", {2012, 10, 8, 7}}, TimeZone -> $TimeZone]     12.958492      which all seems okay until1               Unprotect[$TimeZone]; $TimeZone = -5          AstronomicalData["Sun", {"RightAscension", {2012, 10, 8, 7}}]     12.958492          AstronomicalData["Sun", {"RightAscension", {2012, 10, 8, 7}}, TimeZone -> 0]     12.945765          AstronomicalData["Sun", {"RightAscension", {2012, 10, 8, 7}}, TimeZone -> $TimeZone]     12.958492      The second set of `AstronomicalData` calculations (with `$TimeZone = -5`, the machine time zone) is at least consistent with what `DateList` and `DateString` seem to be doing: input is interpreted as being in the machine time zone (regardless of `$TimeZone`), unless a different time zone is specified using `TimeZone`. But that seems to be precisely the problem: if the time zone specified with `TimeZone` matches `$TimeZone`, it's ignored, _even if the machine time zone is different_. So in the first set of `AstronomicalData` calculations (with `$TimeZone = 0`), when `TimeZone` is '0' or `$TimeZone`, the option is just ignored, and `AstronomicalData` reports data for the default, machine time zone instead. If `$TimeZone` is merely the default setting for `TimeZone` _options_ and not the default time zones for _executing time zone dependent functions_ , how do I get date and time functions to work in another time zone by default (without changing the machine's clock)? * * * 1\. I know the Sun's RA isn't the best value to use to spot differences over hour time scales, but since I can't get a straight answer from Wolfram (after 2 weeks of trying) about whether _Mathematica_ ephemerides incorporate parallax or atmospheric effects, I wanted to be sure I had used something that would be immune to those effects when viewed from two different locations, since I don't specify those in the example.


Non-linear inequalities

I have five sets of inequalities and equations:   $$A_1:=\\{(b,c);b^2+9c^2-3c<0\\},$$ $$A_2:=\\{(b,c);\frac{\sqrt{b^2+9c^2-3c}-b+6c}{c}\leq0, \frac{-\sqrt{b^2+9c^2-3c}-b+6c}{c}\leq0\\},$$ $$A_3:=\\{(b,c);\frac{\sqrt{b^2+9c^2-3c}-b+6c}{c}\leq0, \frac{-\sqrt{b^2+9c^2-3c}-b+6c}{c}=12\\},$$ $$A_4:=\\{(b,c);\frac{-\sqrt{b^2+9c^2-3c}-b+6c}{c}\leq0, \frac{\sqrt{b^2+9c^2-3c}-b+6c}{c}=12\\},$$ $$A_5:=\\{(b,c);\frac{\sqrt{b^2+9c^2-3c}-b+6c}{c}=12, \frac{-\sqrt{b^2+9c^2-3c}-b+6c}{c}=12\\}.$$ I would like to plot $\cup_{i=1}^5A_i$ and the triangle $B:=\\{(b,c):3c>2b-1, 3c>-2b-1,1>3c\\}$ in one single figure to see for example whether $B\subset \cup_{i=1}^5A_i$. How to do this?


simplifying $\frac{\log x^a}{a} = \log x$

If one makes the assumptions $x>0,a>0$, then $\frac{1}{a}\log x^a = \log x$. Thus, in Mathematica, `Simplify[1/a*Log[x^a], {a > 0, x > 0}]` returns `Log[x]`. If the argument of the logarithm becomes more complicated, the assumption one must declare becomes proportionately more complicated. For instance, `Simplify[1/a*Log[(x + Log[x]*Cos[x])^a], {a > 0, x + Log[x]*Cos[x] > 0}]`. Of course, one could also use `Simplify[1/a*Log[(x + Log[x]*Cos[x])^a], {a > 0, x > 1}]`; however, one may not always know the range of the argument of the logarithm. Is there a way to specify that the argument of the logarithm is non-negative without spelling out the entire argument in the assumption? Perhaps, one could simply declare to Mathematica that complex numbers should be ignored?


Measure a DensityHistogram[] pair similarity

I study human vision and more specifically eye-movements. _"If we display 2 symmetrical patterns (20 min one after the other), will our gaze distribution be symmetric is my research question."_ The 2 figures at the bottom row below is what is displayed to subjects for 3 seconds. One pattern, then, later in the experiment, its symmetrical transform. Above are their respective **Gaze Density histograms**. That is the distribution of where their eyes were while observing the stimuli. The Blue square is the Center Of Gravity of the stimuli. How can I measure their similarity ? If I have some ideas, I think Mathematica offers great means of image analysis that could be used here. ![enter image description here](http://i.stack.imgur.com/aLd1c.png) You could find here the data : `allSymFix` : 93 sublist for the 93 stimuli pairs I present, along with a manipulate to see all the histograms `allSymFix[[1,1]]` are all the gaze observed on stimuli 1 original version.   `allSymFix[[1,2]]` on its symmetrical transform ![enter image description here](http://i.stack.imgur.com/OJlNY.png) How can I measure the similarity within each `allSymFix[[original stimuli]]`. I will then compare it with the similarity computed on random pairs assembled


Injecting a sequence of expressions into a held expression

Consider the following toy example:               Hold[{1, 2, x}] /. x -> Sequence[3, 4]      It will give               Hold[{1, 2, Sequence[3, 4]}]      because `Sequence[]` (like `Unevaluated`) is expanded only in the first level of heads with attribute `HoldAll`. **How can I obtain`Hold[{1,2,3,4}]`?** What is the simplest way to do this? **Notes:**   * Use case: I am trying to generate a piece of code that will be passed to `Compile`. I need to inject a variable number of iterators (which I have as a list) into a `Do` expression:              Hold[Do[code, iterators]] /. iterators -> Sequence[{i,5}, {j,5}]        * I would prefers solutions that don't match on the expression enclosing `x`. I would not like to repeat this expression (a `Do` in this case) in my code.   * It's perhaps worth pointing out that              Hold[{1, 2, f[3, 4]}] //. f[x___] :> x      returns              Hold[{1, 2, Sequence[3, 4]}]      so I can't easily implement a manual sequence-flattening step. * * * ### Answers Based on **Leonid's code** we can write a `flattenSequence[]` function that will flatten out all `Sequence` expressions at any level:               flattenSequence[expr_] :=       expr //. f_[left___, Verbatim[Sequence][middle___], right___] :>         f[left, middle, right]          flattenSequence[Hold[{1, Sequence[2, 3]}]]          (* ==> Hold[{1, 2, 3}] *)      Based on **Mr.Wizard's code** we can write a general function for injecting subexpressions into other expressions while supporting `Sequence`:               ClearAll[inject1, inject]          SetAttributes[inject1, HoldFirst]     Quiet[      inject1[expr_, (Rule|RuleDelayed)[var_Symbol, values : Verbatim[Sequence][__]]] :=       Replace[Unevaluated[values], Sequence[var__] :> expr];      inject1[expr_, (Rule|RuleDelayed)[var_Symbol, value_]] :=       Replace[Unevaluated[value], var_ :> expr],           {RuleDelayed::rhs}     ]          SetAttributes[inject, HoldAll]     inject[rules_, expr_] :=      Internal`InheritedBlock[       {Rule, RuleDelayed},       SetAttributes[{Rule, RuleDelayed}, HoldFirst];       ReleaseHold@Fold[inject1, HoldComplete[expr], rules]      ]      Usage:               inject[{a -> Sequence[b, 3], b :> 1 + 1}, Hold[{a, b}]]          (* ==> Hold[{1 + 1, 3, 1 + 1}] *)      The replacements are done one after the other, so the second one can use the result of the first. `Rule` and `RuleDelayed` are both handled correctly.


How to solve the liar problem?

In an island live two kinds of people: liar and truth-teller, the former only tells lies and the latter only tells truth, now there're two men **A** and **B** from the island, A said: "B is a truth-teller." B said: "We two are different kinds of people." Please identify the sort of them. If we mark **A** with `a` and **B** with `b` and use `True` to represent truth-teller, the answer is apparently `b == False && a == False` . This seems to be easy to translate into mathematica code, I first tried:               Reduce[{Refine[a, b == True] == False, Refine[b, a == True] == True}]     (* b == True && a == False *)      …What's this? Maybe I have some misunderstandings for the Functions… I didn't think much and tried another approach:               Reduce[{Implies[b == True, a == ! b], Implies[a == True, b == True]}, {a, b}]     (* (a == False && b == True) || (a - True) (-b + True) != 0 *)      …What's this? Maybe I have some misunderstandings for the Functions… I didn't think much and tried my third approach:               Reduce[{If[b == True, a == ! b, a == b], If[a == True, b == True, b == False]}]     (*b == False && a == False && False - True != 0*)      …This time I get the right answer, but what's `False - True != 0`!? `Reduce` doesn't know booleans? Surely I'm not solving the problem in the right way, how to get the answer properly with mma? And I would be appreciate if you can tell me where I'm wrong in the first two samples. * * * …I forgot a important thing: in logic, if $p$ is false and $q$ is true, then $p\Rightarrow q$ is still true, so my first two translations for the liar problem is incomplete and the third one is correct because I unconsciously add the missing rule in `If`, so my second sample should be modified to:               Reduce[Implies[b == True, a == ! b] &&             Implies[b == False, a == b] &&             Implies[a == True, b == True] &&             Implies[a == False, b == False], {a, b}]     (*         (a == False && b == False && False - True != 0) ||         (a - False) (-b + False) (a - True) (b - True) != 0       *)      Though the result is still a little strange, at least this time the right answer is involved in it, and together with the comment from @Daniel Lichtblau it's not that unacceptable now. And of course the answer from @halirutan using `!Xor` is terser. And had I noticed the correct syntax for `SatisfiabilityInstances` earlier, perhaps I would have lost my curiosity and this question wouldn't exist anymore…:               SatisfiabilityInstances[Implies[b == True, a == ! b] &&                              Implies[b == False, a == b] &&                              Implies[a == True, b == True] &&                              Implies[a == False, b == False], {a, b}]     (* {{False, False}} *)          SatisfiabilityInstances[If[b == True, a == ! b, a == b] &&                              If[a == True, b == True, b == False], {a, b}]     (* {{False, False}} *)      However, I'm still unable to give a good explanation for my first sample: as we've seen, it gives an answer similar to the second sample, but:               SatisfiabilityInstances[Refine[a, b == True] == ! b &&                              Refine[a, b == False] == b &&                              Refine[b, a == True] == True &&                              Refine[b, a == False] == False, {a, b}]      (* {} *)      …Why? * * * …I get the truth: `Refine` is not available for the logical judgement，and the "right" answer for the first sample is just a illusion, that's just because `a` and `b` don't have a explicit relationship so the assumption inside `Refine` is considered as something meaningless by `Reduce`, the process is similar to:               Reduce[{Refine[a, b == 3] == 1, Refine[b, a == 4] == 2}]     (* b == 2 && a == 1 *)      OK, now it's all clear 囧.


Rational display with Quantity

Why is that `Power[Quantity["ElectricConstant"],-1]` is represent different of `Power[Pi,-1]` What I am doing wrong ?


x/.NSolve[f==g,x] does not work when f or g is the output of NDSolve!

I have been trying to put Points at the intersection of two curves, one of which is the ouput of a differential equation solved with NDSolve. The output being an Interpolation, NSolve cannot find the intersection coordinates.


Unusual Slow Down with LocatorPane/DynamicModule

I have coded up a little interactive DynamicModule to help me with image processing/segmentation of stacks of timelapse microscopy images. I am experiencing a crippling slow down in the responsiveness of the locators in the LocatorPane after I display a labeled overlay outside of the LocatorPane. Below is a screenshot of the DynamicModule as the user sees it with the LocatorPane in the center of the screen (with the red locator disk on the blue cell), smaller images that show labels and highlighted contours on the left- side and buttons that call functions on the right side: ![enter image description here](http://i.stack.imgur.com/s0z6P.png) In the above LocatorPane the red locator is reasonably responsive and can be used to mouseover and select various components for functions like joining, swapping and relabeling the components. However, when I toggle an overlay of components labels on in the upperleft panel (toggle control using the CheckBox is below the left panel image) the locators in the central LocatorPane becomes terribly sluggish (almost unusable). Here is what the screenshot looks like with the label overlay toggled on: ![enter image description here](http://i.stack.imgur.com/dK8YM.png) All I am doing is here is displaying an overlay of the labels on the centroids of the components on the same colorized watershed components image that is used for the LocatorPane (I wanted to put the overlay of the labels in a different display than the LocatorPane to keep the LocatorPane display from being too busy). It is unclear to me why overlaying the labels on an image outside of the LocatorPane should slow down the locator responsiveness within the LocatorPane. Note that when I toggle the overlay of the labels off the LocatorPane becomes responsive again. I have also tried to use ImageCompose instead of Show[Overlay[...]] and get the same results with the unresponsive LocatorPane. Here is the stripped down code showing how I am implementing the overlay, the plot labeling function and the LocatorPane:               (* Dynamic Overlay Code*)          Dynamic[                Which[              (* this Which statement is used for responding to toggling the     labels on/off *)            showLabels == False,                   Column[         {              Dynamic[Image[Colorize[watershedMatrix[[currentFrame]]],              ImageSize -> 450]]              }         ] (* close showLabels==False Column *)            ,            showLabels == True,                   Column[               {                   plotLabelerFunctionOutput =               Setting[Dynamic[            PlotLabelerFunction[watershedMatrix[[currentFrame]]]]];                            Dynamic[                    Show[Colorize[watershedMatrix[[currentFrame]]],            plotLabelerFunctionOutput[[2]], ImageSize -> 450]                  ] (* close Dynamic enclosing overlay *)                      }               ] (* close showLabels==True Column *)            ] (* close showLabels Which *)           ]  (* close Dynamic wrapping whole showLabels Which *)                         (* labeling function code that generates the text overlay of labels at the centroid positions of the components *)               PlotLabelerFunction[matrixIn_List] :=           Block[{centroids, areas, textTable, labelsOnlyPlot, riffledList,         riffledSortedList},                 centroids = ComponentMeasurements[matrixIn, "Centroid"];                 textTable = ParallelTable[              Text[Style[centroids[[i, 1]], Large, Red, Bold],           N[centroids[[i, 2]]]],              {i, 1, Length[centroids]}];                       labelsOnlyPlot =         Graphics[textTable, Axes -> False, AxesOrigin -> {1, 1},          PlotRange -> {{1, Dimensions[matrixIn][[1]]}, {1,             Dimensions[matrixIn][[2]]}}];                 (* note that I have also tried to generate labeled plot with with ImageCompose as follows:               Return[ImageCompose[matrixIn//Colorize,labelsOnlyPlot]]       *)            Return[{textTable, labelsOnlyPlot}];            ] (* close Block *)                         (* LocatorPane Code *)          LocatorPane[Dynamic[pts],       Dynamic@Image[Colorize[watershedMatrix[[currentFrame]]],         ImageSize -> 800], LocatorAutoCreate -> True,       Appearance -> {Graphics[{Red, Disk[]}, ImageSize -> 10],         Graphics[{Blue, Disk[]}, ImageSize -> 10]}]      The sluggishness of the locators when the labels are toggled on really limits the usefulness of this code. Any ideas for restoring the locator's responsiveness would be most appreciated. Thanks.


How to export multiple Barcharts from Mathematica to $\LaTeX$

I have to make a document with multiple bar charts and export it:               A = BarChart[Table[CAB[[1, i]], {i, 16}], ChartLabels -> {"1", "2", "3", "4", "5", "6", "7",          "8", "9", "10", "11", "12", "13", "14", "15", "16"}];     Export["Barcharts_2.tex", A];      This is not a problem, but when I try to export multiple bar charts (in my case sixteen):               A = (BarChart[Table[CAB[[1, i]], {i, 16}]]          BarChart[Table[CAB[[2, i]], {i, 16}]])     Export["Barcharts_2.tex", A];      I get this error:               TeXForm::unspt       Could anyone help me with this?


I need to calculate sin[x] series summation for sin[A] where A is a 3X3 matrix

I am evaluating $\sin(A)$ where $A$ is a $3\times 3$ matrix. I have calculated it but now I want to check this with a Taylor series expansion of `Sin[x]`.   What I am using is               myfn= With[{B = N[A]},                  Sum[ MatrixPower[B, 2 k + 1]/Factorial[2 k + 1], {k, 0, 4}]]      But I have to put $(-1)^k$ as well in the summation list. I dun know how to do it either it takes $1$ or $-1$ but it's not changing a sign whenever I am trying to evaluate               With[{B = N[A]},            Sum[ MatrixPower[B, 2 k + 1]*(-1^k)/ Factorial[2 k + 1], {k, 0, 4}]]      I am seriously stuck, could anyone help?


Using RecurrenceTable index to call elements of a vector

I am having trouble doing something that seems straightforward. I have a recursive sequence that I would like to produce which looks as follows:               a2 = {1, 2, 3}     RecurrenceTable[{a1[n + 1] == a1[n] + a2[[n]], a1[1] == 1}, a1, {n, 1, 3}]      This seems like it should work, but _Mathematica_ is complaining about `n` not being an integer when I try to call the $n$-th part of `a2`. What I am really interested in is a very large `RecurrenceTable` of this form rather than what I have posted. Since `RecurrenceTable` seems to be much more efficient at generating large recursive sequences than any other functions I have been able to find, I would love to find a way to be able to use it.


Solving Inequalities with Gamma Function

I am wondering why _Mathematica_ outputs that the following system "cannot be solved with the methods available to Reduce". $\frac{\Gamma(\frac{1}{2}+n)}{n-1}<\frac{\Gamma(\frac{1}{2}+k)}{k-1}$ with $k, n \in N$. I used the command               Reduce[Gamma[1/2 + n]/(-1 + n) < Gamma[1/2 + k]/(-1 + k) && k > 1 && n > 1, {n}, Integers]      and tried unsuccessfully to solve for $k$ and $n$. I suppose, I do something improper and _Mathematica_ is capable to solve those kind of inequalities. So, what did I do wrong?


Adding plot legends in version 8

I use _Mathematica_ to draw the displacement, velocity, and acceleration of one point in a graphic.               FinalGraphics[Joint_, plotRange_List, opt_String] :=        Module[{JointDisplacement, JointVelocity, JointAccelaration},         JointDisplacement = Plot[Joint, {t, plotRange[[1, 1]], plotRange[[1, 2]]}];       JointVelocity =          Plot[Evaluate @ D[Joint, t], {t, 0, 5}, PlotStyle -> {Black, Dashed}];       JointAccelaration =           Plot[Evaluate @ D[Joint, {t, 2}], {t, 0, 5}, PlotStyle -> {Thick, Orange, Dashed}];        Column[{          Show[{JointDisplacement, JointVelocity, JointAccelaration},             AxesLabel -> {Style["t(s)", 15], ""},             AxesStyle -> Arrowheads[.04],             PlotRange -> plotRange,             ImageSize -> 450,             GridLines -> {None, Automatic}], opt},          Center]]      Now I use my function:               Joint1 =        -0.609735 + 0.0436332 t^2 + 0.0327806 t^3 - 0.0133248 t^4 + 0.00120561 t^5;     FinalGraphics[Joint1, {{0, 5}, {-.6, .5}}, "Graphic5.1  the displacement, velocity, acceleration of joint1"]      ![enter image description here](http://i.stack.imgur.com/wnsKS.jpg) However, the above graphic lacks plotlegends, so I rewrite my code:               Needs["PlotLegends`"]     FinalGraphicsLegend[Joint_, plotRange_List] :=        Module[{},        Plot[{Joint, Evaluate @ D[Joint, t], Evaluate @ D[Joint, {t, 2}]},           {t, plotRange[[1, 1]], plotRange[[1, 2]],           PlotLegend -> {"displacement", "velocity", "acceleration"}}]]      but it fails.               FinalGraphicsLegend[Joint1, {{0, 5}, {-.6, .5}}]      > General::ivar: 0.00010214285714285715` is not a valid variable. >> So my question is: how do I correct the function `FinalGraphicsLegend` or add plot legends to the function `FinalGraphic`?


How to extract edgeweights from a graph

I have a graph with weighted edges, and I'd like to obtain the edge weights of the edges in the graph. Is there a nicer way of doing this than getting the `WeightedAdjacencyMatrix` of the graph? A list of weights that's 1-1 with the `EdgeList` of the graph would be great.


How to highlight the whole selected cell

Is there any way to highlight the whole selected cell? some times if I want to delete a certain cell and if the code is long and cells are without output, it is hard to know which cell that you are selecting. For example, in this simple file, I want to select a certain cell as seen: ![enter image description here](http://i.stack.imgur.com/Vv9Mr.jpg) If I want to select the second cell, I may make mistake and select the above or below cell (especially if the code is long). is there any way to highlight the whole cell once I selected it from the right?


Define shifted pdf

I defined a PDF called dist, for example like this one:               dist = ProbabilityDistribution[       Convolve[PDF[NormalDistribution[4, 5], x],         PDF[NormalDistribution[3, 1], x], x, t], {t, -Infinity, Infinity}]      Is it possible to get also a shifted PDF? For example $p_1(x)=dist(x), p_2(x)=dist(x-c)$ where c is a constant


combining and comparing lists

I have 2 lists (of lists), where most of the contained lists match. That is, the lists contained in list1 mostly match the lists contained in list2. In this simplified example each of the inner lists has 3 elements. When a sub list of list1 and a sublist of list2 have their 1st 2 values the same, I want to compare the 3rd value. I have another list, "problems", that contains the first 2 elements of each sub list that creates a problem for me. My sample code follows:               problems = {{1, 2}, {1, 3}, {2, 2}};     list1 = {{1, 2, 12}, {1, 3, 13}, {1, 2, 14}, {4, 5, 11}};     list2 = {{1, 2, 22}, {1, 3, 23}, {2, 2, 26}, {4, 5, 11}, {1, 3, 13}};          want = {{1, 2, {12, 14}, {22}}, {1, 3, {13}, {13, 23}}, {2, 2, {}, {26}}};          list1a = Flatten[(Cases[list1, {#[[1]], #[[2]], __}] & /@ problems) /. {} -> {{}}, 1]     list1b = GatherBy[list1a, If[# == {}, True, {#[[1]], #[[2]]}] &]       The list labelled "want" is what I'd like to get at the end of this. Actually, I just want to have something that will contain those 1st two elements, and then show the comparison of the 3rd elements. The GatherBy seems to be getting me closer to what I want, but I can't figure out how to correctly group it so that it looks like "want". I'm hoping that someone can suggest a better way to approach this.


Hue shade colours

Looking at the plot below, how can I know what colours made the `Hue` shade?               Plot3D[Cos[x - y + x], {x, -10, 10}, {y, -10, 10}, ColorFunction -> Hue]      I want to have only the RGB or HTML color values used by `Hue`. I have copied the colors from rm -rf♦'s answer:               FF0000     FF9800     CCFF00     33FF00     00FF66     00FFFF     0066FF     CB00FE     FF0099     FF0000      but with an imprecise tool; how can I have the correct colors used by _Mathematica_ , when I use the `ColorFunction -> Hue` command?


Crash when displaying / rasterizing graphics with textures at high resolutions

**CAUTION/Disclaimer: execution of some of the code below can result in a complete crash of Mathematica or even your system. Save all your work and do not try in a productive situation.** For a graphical application, I need to export graphics containing several hi- res textures at large image sizes. Consider the following (minimal example) code wich is largely harmless:               Graphics[{Texture[Graphics[Circle[]]],        Polygon[{{0, 0}, {1, 0}, {1, 1}, {0, 1}},         VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]},       ImageSize -> 400]      ![](http://i.stack.imgur.com/NoDqf.png) **But** upping `ImageSize` past a given (probably hardware-dependent, in my case ~4000) threshold will crash the frontend+kernel               Graphics[{Texture[Graphics[Circle[]]],        Polygon[{{0, 0}, {1, 0}, {1, 1}, {0, 1}},         VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]},       ImageSize -> 4000]      To make things worse, this also seems to depend on the graphics driver version. I use a NVIDIA GTX 485M card, and with the 296.10 driver, I can go up to about `ImageSize -> 8000` while with any _newer_ driver version the system stalls at `ImageSize -> 4000`. Does anyone know a workaround? Always reverting to an obsolete driver (which e.g. does not work with `CUDALink` anymore) is not optimal. **Addendum: Question, Part Two** As pointed out by @cormullion, setting the global preferences for the antialiasing quality in the Preferences dialog helps already a lot and allows much larger `ImagesSize`s. Now, how to go about setting/resetting the value of `HardwareAntialiasingQuality` programmatically?


a basic question about getting the value of a parameter

i am new with Mathematica. i am trying to write a simple code. for example:               phiu = 2          Yfu = (phi_u/(phi_u + 17.18))      but when i run it, it gives me (phi_u/(phi_u + 17.18)) instead of (2/(2 + 17.18))=0.104275. what can i do to get the value of Yfu? thank you


How can I find out where a key binding is coming from?

Related: Automating Esc [[ Esc formatting? In previous versions of Mathematica, I could add these lines to my _KeyTranslations.tr_ file, to map Ctrl+[ to [[:               Item[KeyEvent["8", Modifiers -> {Control}],             FrontEndExecute[{                 FrontEnd`NotebookWrite[FrontEnd`InputNotebook[],                     "\[LeftDoubleBracket]", After]             }]],     Item[KeyEvent["9", Modifiers -> {Control}],             FrontEndExecute[{                 FrontEnd`NotebookWrite[FrontEnd`InputNotebook[],                     "\[RightDoubleBracket]", After]             }]],       (I had to modify @rmrf's original key binding, because there are no [ and ] keys on a German keyboard. They're under the 8 and 9 keys, so I mapped those. I also had to comment out the other occurrence of `KeyEvent["9", Modifiers -> {Control}`, in the same file.) In Mathematica 10, this works for Ctrl+8, but not for Ctrl+9, so I'm guessing Ctrl+9 is bound to something else. Is there a way to find out where Ctrl+9 is mapped (so I can change it there)? It's not listed under tutorial/KeyboardShortcutListing, and I couldn't find it by grep'ing for `KeyEvent["9"` in the SystemFiles folder


Convert values at level {3} in a list to percentages

I have the list               m = {{x == 0, y == 0.29264681456942615}, {x == 30 , y == 0.2419119568894183},          {x == 50 , y == 0.1485164898707659}, {x == 70 , y == 0.05437093382683481},          {x == 90 , y == 1.`}}       and I want to change the unit into percent only for `y` value. So the output that I want will be               m = {{x == 0, y == 29.264681456942615%}, {x == 30 , y == 24.19119568894183%},          {x == 50 , y == 14.85164898707659%}, {x == 70 , y == 5.437093382683481},          {x == 90 , y == 100%}}       How can I do this??


In finding a logarithmic fit for some data (of the form a*Log[b*x]), WolframAlpha succeeds where Mathematica 7.0 fails, why?

I would like to fit a function of the form: $a \log(b x)$ to a set of data:               data = {{10, 10/153}, {100, 100/1833}, {200, 200/3814}, {300, 300/5847}, {500, 500/10006},             {625, 625/12649}}      The input string to WolframAlpha: `"log fit {{10, N[10/153,16]},{100,N[100/1833,16]},{200,N[200/3814,16]},{300,N[300/5847,16]},{500,N[500/10006,16]},{625,N[625/12649,16]}}"` produces a nice logarithmic fit of this data. However, using `FindFit` with my copy of _Mathematica_ 7.0 produces nonsensical values for $(a,b)$ and/or complex functions. How did WolframAlpha produce this fit, and how might I find this fit using my copy of _Mathematica_?


Speeding up Nonlinearmodelfit by constraining parameters?

I have a complicated parametric PDE that can be fitted to some data with NonlinearModelFit, but takes several hours to estimate the best values of the four free parameters. Currently, the code constrains these parameters ($kme,kmn,j$ and $eo$) to a realistic range as shown below;               NonlinearModelFit[Table[{i 10^-6, fp[[i]]}, {i, Length@fp}], {(Eb1 /. First[x])[kme, kmn, j, eo][r, 14400], 0.1 <= kme <= 30, 0 <= kmn <= 30, 0 <= j <= 1, 1 <= eo <= 100},  {kme, kmn, j, eo}, r]      I'm looking to reduce the time taken to evaluate this; I'm happy with 2 decimal places of accuracy, so I was wondering if either of the two following ideas would work;   1. Reduce working precision - would reducing the working precision markedly speed up calculation? It seems to be the case; adding WorkingPrecision -> 3 returned a plausible looking answer in moments but warned me bout being below MinPrecision. I've now increased this to 5 and it's been running over 40 minutes with no output yet so I'm not convinced this is a good solution.    2. Discretely specify parameter range; This option appeals most to me if it's possible: Instead of specifying the range of parameters, if is possible to list the values that Mathematica should try? I've attempted something along those lines where I've given the values in lists, like                NonlinearModelFit[Table[{i 10^-6, fp[[i]]}, {i, Length@fp}], {(Eb1 /. First[x])[kme, kmn, j, eo][r, 14400], {kme, 0.1,30,0.1}, {kmn,0,30,0.1}, {j,0,1,0.01}, {eo,1,100,1},  {kme, kmn, j, eo}, r]      But this syntax generates errors. Is there a way to pass these options in NonlinearModelFit or better option for reducing the computational time? I'm open to any suggestion and happy to improve on my somewhat sparse Mathematica knowledge!


Export grayscale png

The help for the `Export` function is absolutely unclear. How can I specify options for my output format? According to the documentation, PNG supports grayscale output. But this doesn't work, I still get an RGB image.               Export["somefile.png", something, "ColorSpace" -> "Grayscale"]


Control BarLegend size

I want to plot a big 2D array of experiment data. I need plot axes and tick labels as well as a bar legend using `BarLegend`:               ArrayPlot[      Array[RandomInteger[100] &, {100, 100}],      PlotLegends -> Placed[Automatic, Below],      ImageSize -> 200,      PlotLabel -> "Test",      FrameLabel -> {"Axes", "Dimensions"},      FrameTicks -> Automatic,      BaseStyle -> {FontSize -> 14}     ]      The output I get is ![output of the test script](http://i.stack.imgur.com/m5eI4.png) I am not happy with the size of the `BarLegend`. I would like to have the `BarLegend` with the width and horizontal offset of the actual plot. It properly scales with the image size, if I don't use the `PlotLabel`, `FrameTicks` and `FrameLabel` but I need all of them. I would be happy also with the solutions, which does work in general case, but needs adjusting some number by hand. So far I have figured out, that I can change the horizontal offset with `PlotLegends -> Placed[BarLegend[Automatic, LegendMargins -> {{20, 20}, {0, 0}}], Below]`, but this does not make the legend smaller. As the `BarLegend` does not return `Graphics`, I can not just use `Scale[BarLegend["BlueGreenYellow", LegendMargins -> {{20, 20}, {0, 0}}], 2]` etc. Side note: For plotting experiment data I use `ArrayPlot` instead of `ListContourPlot` and similar because they get very slow for big arrays. And at least `ListContourPlot` suffers from the same problem.


Obtaining better quality in ListPlot

I have a data file which can be downloaded from here. In order to plot this, I use the following Mathematica code               SetDirectory[" ... "];     data = Import["pss_data.dat", "Table"];     S0 = ListPlot[data, Axes -> False, Frame -> True,      FrameLabel -> {"x", OverDot["x"]}, RotateLabel -> False,      FrameStyle -> Directive[FontSize -> 17, FontFamily -> "Helvetica"],      PlotStyle -> {Black, PointSize[0.001]},      PlotRange -> {{-10.1, 11}, {-45, 45}}, ImageSize -> 550]     Export["pss_plot.eps", S0, "EPS"];      However, the quality of the plot is not satisfactory. Let me be more specific. I realized, that the element which causes the problem is indeed the `PointSize` option. Here is a magnification of the .eps output created using Mathematica ![enter image description here](http://i.stack.imgur.com/os9us.jpg) OK, this is a decent plot, but take a look at this one created using gnuplot ![enter image description here](http://i.stack.imgur.com/qjtd5.png) Now, the problem it is far from obvious. The dots which represent the points are way too big in the Mathematica plot. I tried to reduce the `PointSize` of them, but it seems that it cannot be smaller 0.001. You may insert 0.0001 but these is no effect. I even tried to `Rasterize` the plot before export it to .eps but again I could not achieve the desired quality. So, my question: Is it possible to achieve the same plot using Mathematica? Well, it should be. In fact, the question can be rephrased as: How could we shrink more the `PointSize` in `ListPlot`? Many thanks in advance. EDIT: Following Jens's method the output .eps file is the following: ![enter image description here](http://i.stack.imgur.com/ocR3E.png) Obviously, almost the entire right part of the plot is missing. Only if I set `Magnification -> 1` I can obtain all the plot. But then, zooming in you can see that the dots are still big enough as in my initial output. So, back to square one!


Assigning a given value if a function returns an error

This question has to do with error handling, I guess. I am using Brent's Method in order to numerically find the root of a function. This is just an example of what I am doing:               functionexample[a_, b_, c_, x_] := Sin[a*x] + Cos[b*x] + Log[c*x]     rootexample[a_, b_, c_, result_] :=       FindRoot[functionexample[a, b, c, x] == result, {x, 1, 12},          Method -> "Brent", PrecisionGoal -> 16][[1]][[2]]     a = 1     b = 1     c = 1     Plot[{functionexample[a, b, c, x], 2, 4}, {x, 1, 12},       PlotRange -> Automatic]     rootexample[a, b, c, 2]     rootexample[a, b, c, 4]      And this is what I get: ![MWE Mathematica](http://i.stack.imgur.com/5Ed1V.png) So, at the end `rootexample[1, 1, 1, 4]` (that's when Brent's Method returns an error message) seems to take value 4. I would like to define `rootexample[a_, b_, c_, result_]` in such a way that when an error arises in the root finding procedure, an special value is assigned to the result of the function (something like `""` or `Null` or `None` or something similar). [ **EDIT:** The idea is: if there is a root, then return the root; if not, then return `None`.] I mean, I would like to properly control/handle possible errors coming from Brent's Method within the definition of the function `rootexample`. I have no idea about how to do this.


How do I plot Thomae's function in Mathematica?

I wanted to plot this function $$f(x) =\begin{cases} 1 & \text{if } x= 0 \\\ \tfrac1{q} & \text{if } x = \tfrac{p}{q}\\\ 0 & \text{if } x \in \mathbb{R}-\mathbb{Q} \end{cases}$$ so I wrote               FuncThomae[x_] := If[ExactNumberQ[Rationalize[x]], If[x == 0, a = 1,                        L = #^-1 & /@ Divisors[Numerator[Rationalize[x]]]], a = 0]      and               ListDomain[xmin_, xmax_] := Table[Outer[List, {x}, FuncThomae[x]],                                 {x,xmin,xmax,0.001}] // Flatten[#, 1] &      My result doesn't take all the real numbers (nor negatives) in its domain, and for $-1$ to $1$, it should have looked like so: ![plot of Thomae's function](http://i.stack.imgur.com/AggGo.png) but my function does not cater to negatives, nor does it look like the above plot. It looks like this from 2 to 5: ![erroneous plot](http://i.stack.imgur.com/VofGg.png) Nearly similar, but not quite. Can someone help me to perfect the function? Wanted to duplicate this


Converting a notebook to plain text programmatically

It is possible to export a notebook to plain text format (practically just extracting all the text from it and discarding formatting) using the `File -> Save As...` menu item. **How can a notebook be exported to plain text programmatically, without making use of any GUI?** With all the other document formats, such as PDF, HTML, NB, LaTeX, etc. it is possible to simply use `Export`:               ExportString[NotebookGet@EvaluationNotebook[], "LaTeX"]      This does not work with the export format `"Text"` though. It simply exports the notebook expression in a Mathematica expression format. Is there an export format which will export the contents of the notebook to plain text instead of the expression representing it? I would prefer a method that can produce an in-memory string as well (just like `ExportString`), and can avoid writing on disk. **EDIT:** Based on this answer, I found `First@FrontEndExecute[ FrontEnd`ExportPacket[NotebookGet@InputNotebook[], "InputText"]]`. I'd prefer something documented though, if it exists.


How do I get Mathematica to recognize a C compiler on a 64-bit Windows machine?

Mathematica does not recognize any C compiler on my computer. I run Mathematica 8.0.4.0 on Windows 7. I've tried to make sure various C compilers are installed on my computer, but I'm not sure how to get Mathematica to recognize the installation. If the compiler is installed correctly, should Mathematica automatically recognize it, or do I have to point Mathematica to a very specific folder to find it? I edited this post according to some of the comments below by @Szabolcs and @. I've been through http://stackoverflow.com/a/6549505/695132 , and step 2 appears to fail. I've already been to http://forums.wolfram.com/mathgroup/archive/2011/Nov/msg00024.html, and I installed Microsoft Windows SDK v7.1 for Windows 7 and .NET Framework 4 for xI64. http://www.microsoft.com/en-us/download/details.aspx?id=8442 I also got the Microsoft Visual C++ 2010 Service Pack 1 Compiler Update for the Windows SDK 7.1: http://www.microsoft.com/download/en/details.aspx?id=4422 Please forgive me for not knowing how to check to see if the compiler is working. I simply don't even know where to start with Visual Studios and all that.               Needs["CCompilerDriver`"]     DefaultCCompiler[]     CCompilers[Full]     CCompilers[]      gives the following output:               $Failed     {}     {{"Name" -> "Intel Compiler",        "Compiler" -> CCompilerDriver`IntelCompiler`IntelCompiler,        "CompilerInstallation" -> None,        "CompilerName" -> Automatic}, {"Name" -> "Generic C Compiler",        "Compiler" -> CCompilerDriver`GenericCCompiler`GenericCCompiler,        "CompilerInstallation" -> None, "CompilerName" -> Automatic}}      I get the following error when I try to compile:               CreateLibrary::instl: The compiler installation directive "CompilerInstallation" -> C:\Program Files (x86)\Microsoft Visual Studio 10.0\SDK does not indicate a usable installation of Visual Studio. >>      My question is similar to this question thread, but I don't have enough reputation to ask on that thread. http://stackoverflow.com/questions/6537457/gcc-installed-mathematica-still- wont-compile-to-c I also have "gcc" show up in a search in various folders under Python27 and MinGW, but Mathematica doesn't seem to know about it. I don't care which compiler I use; I just want an easy installation. I spent a day trying all sorts of stuff mentioned on various forums, but nothing is working. Why does Mathematica not come out of the box with a working compiler?